diff -Nrcpad gcc-4.0.2/gcc/ada/5xcrtl.ads gcc-4.1.0/gcc/ada/5xcrtl.ads
*** gcc-4.0.2/gcc/ada/5xcrtl.ads	Thu Mar 18 15:18:36 2004
--- gcc-4.1.0/gcc/ada/5xcrtl.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                        GNAT RUN-TIME COMPONENTS                          --
- --                                                                          --
- --                         S Y S T E M . C R T L                            --
- --                                                                          --
- --                                S p e c                                   --
- --                                                                          --
- --           Copyright (C) 2004 Free Software Foundation, Inc.              --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This package provides the low level interface to the C Run Time Library
- --  on 64 bit VMS
- 
- with System.Parameters;
- package System.CRTL is
- pragma Preelaborate (CRTL);
- 
-    subtype chars is System.Address;
-    --  Pointer to null-terminated array of characters
- 
-    subtype FILEs is System.Address;
-    --  Corresponds to the C type FILE*
- 
-    subtype int is Integer;
- 
-    type long is range -(2 ** (System.Parameters.long_bits - 1))
-       .. +(2 ** (System.Parameters.long_bits - 1)) - 1;
- 
-    subtype off_t is Integer;
- 
-    type size_t is mod 2 ** Standard'Address_Size;
- 
-    function atoi (A : System.Address) return Integer;
-    pragma Import (C, atoi, "decc$atoi");
- 
-    procedure clearerr (stream : FILEs);
-    pragma Import (C, clearerr, "decc$clearerr");
- 
-    function fclose (stream : FILEs) return int;
-    pragma Import (C, fclose, "decc$fclose");
- 
-    function fdopen (handle : int; mode : chars) return FILEs;
-    pragma Import (C, fdopen, "decc$fdopen");
- 
-    function fflush (stream : FILEs) return int;
-    pragma Import (C, fflush, "decc$fflush");
- 
-    function fgetc (stream : FILEs) return int;
-    pragma Import (C, fgetc, "decc$fgetc");
- 
-    function fgets (strng : chars; n : int; stream : FILEs) return chars;
-    pragma Import (C, fgets, "decc$fgets");
- 
-    function fopen (filename : chars; Mode : chars) return FILEs;
-    pragma Import (C, fopen, "decc$fopen");
- 
-    function fputc (C : int; stream : FILEs) return int;
-    pragma Import (C, fputc, "decc$fputc");
- 
-    function fputs (Strng : chars; Stream : FILEs) return int;
-    pragma Import (C, fputs, "decc$fputs");
- 
-    procedure free (Ptr : System.Address);
-    pragma Import (C, free, "decc$free");
- 
-    function freopen
-      (filename : chars;
-       mode     : chars;
-       stream   : FILEs)
-       return     FILEs;
-    pragma Import (C, freopen, "decc$freopen");
- 
-    function fseek
-      (stream : FILEs;
-       offset : long;
-       origin : int)
-       return   int;
-    pragma Import (C, fseek, "decc$fseek");
- 
-    function ftell (stream : FILEs) return long;
-    pragma Import (C, ftell, "decc$ftell");
- 
-    function getenv (S : String) return System.Address;
-    pragma Import (C, getenv, "decc$getenv");
- 
-    function isatty (handle : int) return int;
-    pragma Import (C, isatty, "decc$isatty");
- 
-    function lseek (fd : int; offset : off_t; direction : int) return off_t;
-    pragma Import (C, lseek, "decc$lseek");
- 
-    function malloc (Size : size_t) return System.Address;
-    pragma Import (C, malloc, "decc$_malloc64");
- 
-    procedure memcpy (S1 : System.Address; S2 : System.Address; N : size_t);
-    pragma Import (C, memcpy, "decc$_memcpy64");
- 
-    procedure memmove (S1 : System.Address; S2 : System.Address; N : size_t);
-    pragma Import (C, memmove, "decc$_memmove64");
- 
-    procedure mktemp (template : chars);
-    pragma Import (C, mktemp, "decc$_mktemp64");
- 
-    function read (fd : int; buffer : chars; nbytes : int) return int;
-    pragma Import (C, read, "decc$read");
- 
-    function realloc
-      (Ptr : System.Address; Size : size_t) return System.Address;
-    pragma Import (C, realloc, "decc$_realloc64");
- 
-    procedure rewind (stream : FILEs);
-    pragma Import (C, rewind, "decc$rewind");
- 
-    function setvbuf
-      (stream : FILEs;
-       buffer : chars;
-       mode   : int;
-       size   : size_t)
-       return   int;
-    pragma Import (C, setvbuf, "decc$setvbuf");
- 
-    procedure tmpnam (string : chars);
-    pragma Import (C, tmpnam, "decc$_tmpnam64");
- 
-    function tmpfile return FILEs;
-    pragma Import (C, tmpfile, "decc$tmpfile");
- 
-    function ungetc (c : int; stream : FILEs) return int;
-    pragma Import (C, ungetc, "decc$ungetc");
- 
-    function unlink (filename : chars) return int;
-    pragma Import (C, unlink, "decc$unlink");
- 
-    function write (fd : int; buffer : chars; nbytes : int) return int;
-    pragma Import (C, write, "decc$write");
- end System.CRTL;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/9drpc.adb gcc-4.1.0/gcc/ada/9drpc.adb
*** gcc-4.0.2/gcc/ada/9drpc.adb	Thu Jul 15 20:34:34 2004
--- gcc-4.1.0/gcc/ada/9drpc.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/ChangeLog gcc-4.1.0/gcc/ada/ChangeLog
*** gcc-4.0.2/gcc/ada/ChangeLog	Wed Sep 21 03:55:43 2005
--- gcc-4.1.0/gcc/ada/ChangeLog	Tue Feb 28 08:28:11 2006
***************
*** 1,20 ****
! 2005-09-20  Release Manager
  
! 	* GCC 4.0.2 released.
  
! 2005-07-07  Release Manager
  
! 	* GCC 4.0.1 released.
  
! 2005-04-24  Laurent GUERBY  <laurent@guerby.net>
  
! 	PR ada/18847
! 	* a-nudira.adb (Value): Check for valid string.
! 	* a-nuflra.adb (Value): Likewise.
  	
! 2005-04-20  Release Manager
  
! 	* GCC 4.0.0 released.
  
  2005-04-07  Laurent GUERBY  <laurent@guerby.net>
  	    John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
--- 1,4741 ----
! 2006-02-28  Release Manager
  
! 	* GCC 4.1.0 released.
  
! 2006-02-23  Mark Mitchell  <mark@codesourcery.com>
  
! 	Backport:
! 	2005-12-05  Paolo Bonzini  <bonzini@gnu.org>
!         * Makefile.in (gnatlib): Fix regex, using \. instead of . when a
! 	period is meant.
! 	
! 2006-02-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	Backport from mainline:
! 	2006-02-13  Geert Bosch  <bosch@adacore.com>
! 	            Gary Dismukes  <dismukes@adacore.com>
  
! 	* a-tifiio.adb (Put_Digits): Test Last against To'First - 1 instead of
! 	0, since the lower bound of the actual string may be greater than one.
! 
! 	PR ada/20753
! 
! 	(Put): Fix condition to raise Layout_Error when invalid
! 	layout is requested.
! 
! 2006-02-09  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
! 
! 	* Make-lang.in (check-gnat): Run run_acats with $(SHELL).
! 
! 2006-02-03  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
! 
! 	PR target/25926
! 	* initialize.c (__gnat_initialize): Provide HP-UX 10 host and target
! 	implementation that calls __main.
! 
! 2006-01-25  Peter O'Gorman  <peter@pogma.com>
! 
! 	PR bootstrap/25859
! 	* Makefile.in (GCC_LINK): Remove quotes.
! 	(tools targets): Link with either $(GNATLINK) --GCC="$(GCC_LINK)"
! 	or $(GCC_LINK).
! 
! 	(powerpc-darwin): Pass -shared-libgcc when building shared library.
! 
! 2006-01-24  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	PR ada/18819
! 	* exp_util.adb (Remove_Side_Effects): Lift enclosing type conversion
! 	nodes for elementary types in all cases.
! 
! 2006-01-20  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
! 
! 	PR ada/24533
! 	* s-osinte-linux-hppa.ads: Reduce alignment of atomic_lock_t to 8.
! 
! 2005-12-28  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
! 
! 	* s-osinte-linux-hppa.ads: Correct alignment of atomic_lock_t.
! 
! 2005-12-15  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	PR ada/18659
! 	PR ada/18819
! 	* misc.c (tree_sra_requested): New global.
! 	(gnat_init_options): Detect -ftree-sra.
! 	(gnat_post_options): Enable Tree-SRA only if specifically requested.
! 
! 2005-11-21  Joel Sherrill <joel.sherrill@oarcorp.com>
! 
! 	* socket.c: Add extern int h_errno for rtems since networking header
! 	files are not available at this point in a tool bootstrap. Newlib
! 	only has basic C library header files.
! 
! 2005-11-19  Richard Guenther  <rguenther@suse.de>
! 	Roger Sayle  <roger@eyesopen.com>
! 
! 	PR ada/23717
! 	* misc.c (internal_error_function): Don't use vsprintf to format
! 	the error message text, instead use pp_format_text and the new
! 	pretty printer APIs.  This allows handling of %qs, %w, etc.
! 
! 2005-11-18  Laurent GUERBY  <laurent@guerby.net>
! 
!         PR ada/24857
!         * Makefile.in: Use s-auxdec-empty for RTEMS.
! 
! 2005-11-17  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 
! 	PR ada/22333
! 	* trans.c (gnat_gimplify_expr, case ADDR_EXPR): Always make
! 	a temporary if taking the address of something that is neither
! 	reference, declaration, or constant, since the gimplifier
! 	can't handle that case.
! 
! 2005-11-17  Laurent GUERBY  <laurent@guerby.net>
! 
! 	PR ada/24857
! 	* s-auxdec-empty.ads, s-auxdec-empty.adb: New files.
  	
! 2005-11-16  Richard Guenther  <rguenther@suse.de>
  
! 	* Makefile.in: Add EH_MECHANISM=-gcc to s390(x) linux.
! 
! 2005-11-16  Joel Sherrill <joel.sherrill@oarcorp.com>
! 
!         PR ada/24855
!         * raise-gcc.c: Add missing stdarg.h include.
!  
! 2005-11-16  Richard Guenther  <rguenther@suse.de>
! 
! 	* Make-lang.in (ada/decl.o): Add $(EXPR_H) dependency.
! 	(ada/misc.o): Likewise.
! 
! 2005-11-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* g-soccon.ads: Minor reformatting. Update comments.
! 
! 	* gsocket.h: Include <sys/times.h> in the VxWorks case, in order to
! 	gain visibility on the declaration of struct timeval.
! 
! 	* g-soccon-freebsd.ads,
! 	g-soccon-darwin.ads,
! 	g-soccon-tru64.ads,
! 	g-soccon-aix.ads,
! 	g-soccon-irix.ads,
! 	g-soccon-hpux.ads,
! 	g-soccon-solaris.ads,
! 	g-soccon-vms.ads,
! 	g-soccon-mingw.ads,
! 	g-soccon-vxworks.ads (SIZEOF_tv_sec, SIZEOF_tv_usec): New constants.
! 
! 	* g-soccon-hpux-ia64.ads, g-soccon-linux-ppc.ads,
! 	g-soccon-solaris-64.ads, g-soccon-linux-64.ads,
! 	g-soccon-linux-x86.ads: New files.
! 
! 	* g-socthi-mingw.adb: 
! 	(Socket_Error_Message): Remove redundant use of GNAT.Sockets.Constants
! 
! 	* g-socthi-vxworks.ads, g-socthi-vms.ads, g-socthi-mingw.ads
! 	(time_t, suseconds_t): New types constructed to match the tv_sec
! 	and tv_usec fields of C struct timeval.
! 	(Timeval): Construct structure in terms of the new types.
! 	(Host_Errno): New function (imported from socket.c), returns last hosts
! 	database error.
! 
! 	* g-socthi-vxworks.adb:  Add error handling circuitry.
! 
! 	* g-socket.ads, g-socket.adb (To_Timeval): Reflect change of type for
! 	components of struct timeval.
! 	(Get_Host_By_Name, Get_Host_By_Address): Fix error reporting circuitry.
! 	(Check_Selector): In error conditions, clear internal socket sets to
! 	avoid a memory leak.
! 	(Get_Socket_Option, Set_Socket_Option): Support for Multicast_If,
! 	Send_Timeout, Receive_Timeout.
! 
! 	* g-socthi.ads (time_t, suseconds_t): New types constructed to match
! 	the tv_sec and tv_usec fields of C struct timeval.
! 	(Timeval): Construct structure in terms of the new types.
! 	(Host_Errno): New function (imported from socket.c), returns last hosts
! 	database error.
! 
! 	* socket.c (__gnat_get_h_errno): New function to retrieve h_errno, the
! 	hosts database last error code.
! 
! 	* gen-soccon.c: Complete value expansion should not be performed on
! 	TARGET, as it has the form of a math expression, and some components
! 	may be platform-defined macros.
! 	For VxWorks, generate the OK and ERROR values.
! 	New constants giving the sizes of the components of C struct timeval.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	PR ada/18434
! 
! 	* types.ads: Include All_Checks in Suppress_Array
! 
! 	* checks.adb (Check_Needed): Remove kludge for a/=b rewritten as
! 	not(a=b), since we no longer do this rewriting, and hence it is not
! 	needed.
! 	(Elaboration_Checks_Suppressed): Add special casing to
! 	deal with different cases of static and dynamic elaboration checks (all
! 	checks does not count in the first case, but does in the second).
! 	(Expr_Known_Valid): Do not assume that the result of any arbitrary
! 	function call is valid, since this is not the case.
! 	(Ensure_Valid): Do not apply validity check to a real literal
! 	in a universal or fixed context
! 
! 	* exp_ch4.adb (Expand_N_Op_Ne): Don't expand a/=b to not(a=b) for
! 	elementary types using the operator in standard. It is cleaner not to
! 	modify the programmers intent, especially in the case of floating-point.
! 	(Rewrite_Comparison): Fix handling of /= (this was always wrong, but
! 	it did not matter because we always rewrote a/=b to not(a=b).
! 	(Expand_Allocator_Expression): For an allocator expression whose nominal
! 	subtype is an unconstrained packed type, convert the expression to its
! 	actual constrained subtype.
! 	Implement warning for <= or >= where < or > not possible
! 	Fix to Vax_Float tests (too early in many routines, causing premature
! 	Vax_Float expansions.
! 
! 	* sem_prag.adb (Analyze_Pragma, case Obsolescent): Allow this pragma
! 	to be used with packages and generic packages as well as with
! 	subprograms.
! 	(Suppress): Set All_Checks, but not Elaboration_Check, for case
! 	of pragma Suppress (All_Checks)
! 	(Analyze_Pragma, case Warnings): Implement first argument allowed to be
! 	a string literal for precise control over warnings.
! 	Avoid raise of pragma in case of unrecognized pragma and just return
! 	instead.
! 
! 	* sem_prag.ads: Minor reformatting
! 
! 	* switch-c.adb (Scan_Front_End_Switches): Replace "raise Bad_Switch;"
! 	with call to new procedure Bad_Switch. Call Scan_Pos with new parameter
! 	Switch. Do not handle any exception.
! 	Include -gnatwx as part of -gnatg (warn on redundant parens)
! 	Allow optional = after -gnatm
! 	(Scan_Front_End_Switches): The -gnatp switch sets All_Checks, but no
! 	longer sets Elaboration_Checks.
! 	Code to set warning mode moved to Sem_Warn
! 	so that it can be shared by pragma processing.
! 
! 	* s-mastop-tru64.adb (Pop_Frame): Remove redundant parentheses in if
! 	statement.
! 
! 	* s-taprop-solaris.adb: 
! 	Change some <= to =, to avoid new warning
! 
! 	* a-exexda.adb, prj-proc.adb: 
! 	Fix obvious typo (Num_Tracebacks compared <= 0 instead of < 0)
! 	Fix obvious typo (Total_Errors_Detected <= 0 should be = 0)
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_vfpt.adb: Handle /= case
! 	(Expand_Vax_Conversion): Properly recognize Conversion_OK flag
! 	so that we do not get duplicate scaling for fixed point conversions.
! 
! 	* s-vaflop.ads, s-vaflop.adb: (Ne_F): New function
! 
! 2005-11-14  Matthew Gingell  <gingell@adacore.com>
! 
! 	* system-lynxos-ppc.ads, system-lynxos-x86.ads: 
! 	Increase default priority on Lynx from 15 to 17, and meet the Ada
! 	requirement that Default_Priority be ((Priority'First +
! 	Priority'Last) / 2) by increasing the range of Interrupt_Priority.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
! 	mlib-tgt-hpux.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb,
! 	mlib-tgt-solaris.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-alpha.adb,
! 	mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb, mlib-tgt-vxworks.adb,
! 	mlib-tgt-darwin.adb, mlib-tgt.adb, mlib-tgt.ads,
! 	mlib-tgt-lynxos.adb (DLL_Prefix): New function
! 
! 2005-11-14  Doug Rupp  <rupp@adacore.com>
! 
! 	* system-vms.ads, system-vms_64.ads: ADA$GNAT: New exported object in
! 	private part.
! 
! 2005-11-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-traces-default.adb, s-trafor-default.ads,
! 	s-tratas-default.adb: Fix compilation errors.
! 
! 2005-11-14  Jose Ruiz  <ruiz@adacore.com>
! 
! 	* s-taprop-posix.adb (Initialize_Lock): Destroy mutex attribute before
! 	raising the exception so the memory used is freed.
! 
! 2005-11-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* adaint.h, adaint.c (__gnat_is_cross_compiler): New constant.
! 	(Gnat_Install_Locks, __gnatlib_install_locks): Removed, no longer used.
! 	(convert_address): Update comments and list of platforms using this.
! 
! 	* s-tasini.adb (Gnat_Install_Locks, __gnatlib_install_locks): Removed,
! 	no longer used.
! 
! 2005-11-14  Pascal Obry  <obry@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 
! 	* gnatdll.adb (Parse_Command_Line): Remove redundant use of
! 	GNAT.Command_Line.
! 
! 	* memroot.adb: Remove redundant with/use clause on
! 	System.Storage_Elements.
! 
! 2005-11-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* a-except.adb (Zero_Cost_Exceptions): Removed, no longer used.
! 	(builtin_longjmp, Process_Raise_Exceeption): Move setjmp/longjmp
! 	related code to a-exexpr.adb
! 	(Save_Occurrence_And_Private): Move GCC EH related code to
! 	a-exexpr-gcc.adb
! 	(Raise_Current_Excep): Add new variable Id with pragma
!         volatile, to ensure that the variable lives on stack.
! 
! 	* a-exexpr-gcc.adb, raise-gcc.c: New file.
! 
! 	* a-exexpr.adb (builtin_longjmp, Propagate_Exception): Moved here code
! 	from a-except.adb.
! 	Move GCC EH related code to a-exexpr-gcc.adb
! 
! 	* Makefile.in: Add or update g-soccon LIBGNAT pairs for Linux/PPC and
! 	64-bit Solaris
! 	Split the Linux version of g-soccon into separate variants for 32 and 64
! 	bit platforms.
! 	(gnatlib): Use $(AR_FOR_TARGET) and $(RANLIB_FOR_TARGET)
! 	vice $(AR) and $(RANLIB). Remove use of host variable $(RANLIB_FLAGS).
! 	install-gnatlib: Use $(RANLIB_FOR_TARGET) vice $(RANLIB). Remove use
! 	of host variable $(RANLIB_FLAGS).
! 	(alpha64-dec-*vms*): Fix translations for 64 bit compiler.
! 	Code clean up: remove unused/obsolete targets.
! 	(EH_MECHANISM): New variable introduced to differenciate between the
! 	two EH mechanisms statically.
! 	(gnatlib-zcx, gnatlib-sjlj): Force EH_MECHANISM manually.
! 	(LIBGNAT_OBJS): Add raise-gcc.o
! 	(LIBGNAT_TARGET_PAIRS for ppc-vxworks): Use an specialized version of
! 	s-osinte.adb, s-tpopsp.adb, and system.ads for the run time that
! 	supports VxWorks 6 RTPs.
! 	(EXTRA_GNATRTL_NONTASKING_OBJS for ppc-vxworks): Remove the use of
! 	i-vxworks and i-vxwoio from the run time that supports VxWorks 6 RTPs.
! 
! 	* raise.c: Move all GCC EH-related routines to raise-gcc.c
! 
! 2005-11-14  Jose Ruiz  <ruiz@adacore.com>
! 
! 	* s-tassta.adb (Create_Task): Move the code in charge of resetting the
! 	deferral level, when abort is not allowed, to a later stage (the
! 	Task_Wrapper).
! 	(Task_Wrapper): If Abort is not allowed, reset the deferral level since
! 	it will not get changed by the generated code. It was previously done
! 	in Create_Task.
! 
! 2005-11-14  Thomas Quinot  <quinot@adacore.com>
! 	    Olivier Hainque  <hainque@adacore.com>
! 	    Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* decl.c:
! 	Factor common code to build a storage type for an unconstrained object
! 	from a fat or thin pointer type and a constrained object type.
! 	(annotate_value): Handle BIT_AND_EXPR.
! 	(annotate_rep): Don't restrict the back annotation of inherited
! 	components to the type_annotate_only case.
! 	(gnat_to_gnu_entity) <E_Array_Type>: Do not invoke create_type_decl if
! 	we are not defining the type.
! 	<E_Record_Type>: Likewise.
! 	(gnat_to_gnu_entity) <object, renaming>: Adjust comments and structure
! 	to get advantage of the new maybe_stabilize_reference interface, to
! 	ensure that what we reference is indeed stabilized instead of relying
! 	on assumptions on what the stabilizer does.
! 	(gnat_to_gnu_entity) <E_Incomplete_Type>: If the entity is an incomplete
! 	type imported through a limited_with clause, use its non-limited view.
! 	(Has_Stdcall_Convention): New macro, to centralize the Windows vs others
! 	differentiation.
! 	(gnat_to_gnu_entity): Use Has_Stdcall_Convention instead of a spread mix
! 	of #if sections + explicit comparisons of convention identifiers.
! 	(gnat_to_gnu_entity) <E_Variable>: Decrement force_global if necessary
! 	before early-returning for certain types when code generation is
! 	disabled.
! 	(gnat_to_gnu_entity) <object>: Adjust comment attached to the
! 	nullification of gnu_expr we do for objects with address clause and
! 	that we are not defining.
! 	(elaborate_expression_1): Do not create constants when creating
! 	variables needed by the debug info: the dwarf2 writer considers that
! 	CONST_DECLs is used only to represent enumeration constants, and emits
! 	nothing for them.
! 	(gnat_to_gnu_entity) <object>: When turning a non-definition of an
! 	object with an address clause into an indirect reference, drop the
! 	initializing expression.
! 	Include "expr.h".
! 	(STACK_CHECK_BUILTIN): Delete.
! 	(STACK_CHECK_PROBE_INTERVAL): Likewise.
! 	(STACK_CHECK_MAX_FRAME_SIZE): Likewise.
! 	(STACK_CHECK_MAX_VAR_SIZE): Likewise.
! 	(gnat_to_gnu_entity): If gnat_entity is a renaming, do not mark the tree
! 	corresponding to the renamed object as ignored for debugging purposes.
! 
! 	* trans.c (tree_transform, case N_Attribute_Reference, case Attr_Size &
! 	related): For a prefix that is a dereference of a fat or thin pointer,
! 	if there is an actual subtype provided by the front-end, use that
! 	subtype to build an actual type with bounds template.
! 	(tree_transform, case N_Free_Statement): If an Actual_Designated_Subtype
! 	is provided by the front-end, use that subtype to compute the size of
! 	the deallocated object.
! 	(gnat_to_gnu): When adding a statement into an elaboration procedure,
! 	check for a potential violation of a No_Elaboration_Code restriction.
! 	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
! 	with extra arguments to control whether to recurse through non-values
! 	and to let the caller know if the stabilization has succeeded.
! 	(gnat_stabilize_reference): Now a simple wrapper around
! 	maybe_stabilize, for common uses without restriction on lvalues and
! 	without need to check for the success indication.
! 	(gnat_to_gnu, call_to_gnu): Adjust calls to gnat_stabilize_reference, to
! 	pass false instead of 0 as the FORCE argument which is a bool.
! 	(Identifier_to_gnu): Remove checks ensuring that an renamed object
! 	attached to a renaming pointer has been properly stabilized, as no such
! 	object is attached otherwise.
! 	(call_to_gnu): Invoke create_var_decl to create the temporary when the
! 	function uses the "target pointer" return mechanism.
! 	Reinstate conversion of the actual to the type of the formal
! 	parameter before any other specific treatment based on the passing
! 	mechanism. This turns out to be necessary in order for PLACEHOLDER
! 	substitution to work properly when the latter type is unconstrained.
! 
! 	* gigi.h (build_unc_object_type_from_ptr): New subprogram, factoring a
! 	common pattern.
! 	(maybe_stabilize_reference): New function, like gnat_stabilize_reference
! 	with extra arguments to control whether to recurse through non-values
! 	and to let the caller know if the stabilization has succeeded.
! 
! 	* utils2.c (gnat_build_constructor): Only sort the fields for possible
! 	static output of record constructor if all the components are constant.
! 	(gnat_build_constructor): For a record type, sort the list of field
! 	initializers in increasing bit position order.
! 	Factor common code to build a storage type for an unconstrained object
! 	from a fat or thin pointer type and a constrained object type.
! 	(build_unary_op) <ADDR_EXPR>: Always recurse down conversions between
! 	types variants, and process special cases of VIEW_CONVERT expressions
! 	as their NOP_EXPR counterpart to ensure we get to the
! 	CORRESPONDING_VARs associated with CONST_DECls.
! 	(build_binary_op) <MODIFY_EXPR>: Do not strip VIEW_CONVERT_EXPRs
! 	on the right-hand side.
! 
! 	* utils.c (build_unc_object_type_from_ptr): New subprogram, factoring
! 	a common pattern.
! 	(convert) <VIEW_CONVERT_EXPR>: Return the inner operand directly if we
! 	are converting back to its original type.
! 	(convert) <JM input>: Fallthrough regular conversion code instead of
! 	extracting the object if converting to a type variant.
! 	(create_var_decl): When a variable has an initializer requiring code
! 	generation and we are at the top level, check for a potential violation
! 	of a No_Elaboration_Code restriction.
! 	(create_var_decl): call expand_decl for CONST_DECLs, to set MODE, ALIGN
! 	SIZE and SIZE_UNIT which we need for later back-annotations.
! 	* utils.c: (convert) <STRING_CST>: Remove obsolete code.
! 	<VIEW_CONVERT_EXPR>: Do not lift the conversion if the target type
! 	is an unchecked union.
! 	(pushdecl): Set DECL_NO_STATIC_CHAIN on imported nested functions.
! 	(convert) <VIEW_CONVERT_EXPR>: When the types have the same
! 	main variant, just replace the VIEW_CONVERT_EXPR.
! 	<UNION_TYPE>: Revert 2005-03-02 change.
! 
! 	* repinfo.h, repinfo.ads: Add tcode for BIT_AND_EXPR.
! 
! 	* repinfo.adb (Print_Expr, Rep_Value): Handle Bit_And_Expressions.
! 
! 2005-11-14  Matthew Heaney  <heaney@adacore.com>
! 
! 	* a-crbtgo.ads, a-crbtgo.adb, a-coorse.ads, a-coorse.adb, a-convec.ads, 
! 	a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohama.ads, a-cohama.adb, 
! 	a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb, a-cidlli.ads, 
! 	a-cidlli.adb, a-cdlili.ads, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, 
! 	a-cihase.adb, a-cihase.ads, a-cohase.adb, a-cohase.ads, a-ciorma.ads, 
! 	a-coorma.ads, a-ciormu.ads, a-coormu.ads, a-ciorma.adb, a-coorma.adb: 
! 	Compiles against the spec for ordered maps described in sections
! 	A.18.6 of the most recent (August 2005) AI-302 draft.
! 
! 2005-11-14  Olivier Hainque  <hainque@adacore.com>
! 
! 	* cuintp.c (UI_To_gnu): Use a proper type for intermediate computations
! 	to ensure bias adjustments take place when need be and to prevent
! 	occurrences of intermediate overflows.
! 
! 2005-11-14  Matthew Gingell  <gingell@adacore.com>
! 	    Olivier Hainque  <hainque@adacore.com>
! 
! 	* tb-gcc.c (trace_callback): Work around problem with _Unwind_GetIP on
! 	ia64 HP-UX.
! 
! 	* tracebak.c (ia64 configuration): Enable _Unwind_Backtrace driven
! 	tracebacks on ia64 HP-UX and provide explanatory comment.
! 	Enable backtraces on ia64 GNU/Linux.
! 	(x86 configuration): Bump FRAME_LEVEL to 1 to ensure we retrieve a real
! 	base pointer from builtin_frame_address. Adjust BASE_SKIP accordingly.
! 
! 2005-11-14  Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* rtsfind.ads, exp_util.adb, exp_util.ads, exp_disp.adb, exp_disp.ads,
! 	exp_ch7.adb, sem_ch9.adb, snames.adb, snames.ads,
! 	exp_ch9.adb, exp_ch9.ads, exp_ch6.adb, exp_ch3.adb, exp_ch3.ads,
! 	einfo.ads, einfo.adb: Complete support for Ada 2005 interfaces.
! 
! 	* a-tags.ads, a-tags.adb: Major rewrite and additions to implement
! 	properly new Ada 2005 interfaces (AI-345) and add run-time checks (via
! 	assertions).
! 
! 	* exp_dbug.ads, exp_dbug.adb (Get_Secondary_DT_External_Name): New
! 	subprogram that generates the external name associated with a
! 	secondary dispatch table.
! 	(Get_Secondary_DT_External_Name): New subprogram that generates the
! 	external name associated with a secondary dispatch table.
! 
! 2005-11-14  Emmanuel Briot  <briot@adacore.com>
! 
! 	* xref_lib.adb (Parse_Identifier_Info): It is possible for an entity
! 	line in the ALI file to include both an instantiation reference, and a
! 	returned value.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* clean.adb (Check_Project): Look for Ada code in extending project,
! 	even if Ada is not specified as a language.
! 	Use new function DLL_Prefix for DLL_Name
! 	(Clean_Interface_Copy_Directory): New procedure
! 	(Clean_Library_Directory): New procedure
! 	(Clean_Directory): Remove procedure, no longer used
! 	(Clean_Project): Do not delete any file in an externally built project
! 
! 	* prj-env.adb (Set_Ada_Paths.Add.Recursive_Add): Add the object
! 	directory of an extending project, even when there are no Ada source
! 	present.
! 	(Ada_Objects_Path.Add): Add Library_ALI_Dir, not Library_Dir to the path
! 	(Set_Ada_Paths.Add.Recursive_Add): Ditto
! 
! 	* mlib-prj.adb (Check_Library): For all library projects, get the
! 	library file timestamp.
! 	(Build_Library): Copy ALI files in Library_ALI_Dir, not in Library_Dir
! 	(Build_Library): Use new function DLL_Prefix for the DLL_Name
! 	(Clean): Remove procedure, no longer used
! 	(Ultimate_Extension_Of): New function
! 	(Build_Library): When cleaning the library directory, only remove an
! 	existing library file and any ALI file of a source of the project.
! 	When cleaning the interface copy directory, remove any source that
! 	could be a source of the project.
! 
! 	* prj.ads, prj.adb (Project_Empty): Add values of new components
! 	Library_TS and All_Imported_Projects.
! 	(Project_Empty): Add values for new components of Project_Data:
! 	Library_ALI_Dir and Display_Library_ALI_Dir
! 
! 	* prj-attr.adb: New project level attribute name Library_ALI_Dir
! 
! 	* prj-nmsc.adb (Check_Library_Attributes): Take into account new
! 	attribute Library_ALI_Dir.
! 	(Check_Library_Attributes): The library directory cannot be the same as
! 	any source directory of the project tree.
! 	(Check_Stand_Alone_Library): The interface copy directory cannot be
! 	the same as any source directory of the project tree.
! 
! 	* mlib.adb: Use Prj.Com.Fail, instead of Osint.Fail directly, to delete
! 	all temporary files.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_elab.adb: Change name Is_Package to Is_Package_Or_Generic_Package
! 	(Check_Elab_Call): A call within a protected body is never an
! 	elaboration call, and does not require checking.
! 	(Same_Elaboration_Scope): Take into account protected types for both
! 	entities.
! 	(Activate_Elaborate_All_Desirable): New procedure
! 
! 	* ali.ads, ali.adb: Implement new AD/ED for Elaborate_All/Elaborate
! 	desirable
! 
! 	* binde.adb: Implement new AD/ED for Elaborate_All/Elaborate desirable
! 	(Elab_Error_Msg): Use -da to include internal unit links, not -de.
! 
! 	* lib-writ.ads, lib-writ.adb: 
! 	Implement new AD/ED for Elaborate_All/Elaborate desirable
! 	Use new Elaborate_All_Desirable flag in N_With_Clause node
! 
! 	* sinfo.ads, sinfo.adb (Actual_Designated_Subtype): New attribute for
! 	N_Free_Statement nodes.
! 	Define new class N_Subprogram_Instantiation
! 	Add Elaborate_Desirable flag to N_With_Clause node
! 	Add N_Delay_Statement (covering two kinds of delay)
! 
! 	* debug.adb: Introduce d.f flag for compiler
! 	Add -da switch for binder
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Cyrille Comar  <comar@adacore.com>
! 
! 	* exp_aggr.adb (Build_Record_Aggr_Code): Do not create master entity
! 	for task component, in the case of a limited aggregate. The enclosed
! 	object declaration will create it earlier. Otherwise, in the case of a
! 	nested aggregate, the object may appear in the wrong scope.
! 	(Convert_Aggr_In_Object_Decl): Create a transient scope when needed.
! 	(Gen_Assign): If the component being assigned is an array type and the
! 	expression is itself an aggregate, wrap the assignment in a block to
! 	force finalization actions on the temporary created for each row of the
! 	enclosing object.
! 	(Build_Record_Aggr_Code): Significant rewrite insuring that ctrl
! 	structures are initialized after all discriminants are set so that
! 	they can be accessed even when their offset is dynamic.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 
! 	* sem_attr.adb: Implement Machine_Rounding attribute
! 	(Analyze_Access_Attribute): The access attribute may appear within an
! 	aggregate that has been expanded into a loop.
! 	(Check_Task_Prefix): Add semantic check for attribute 'Callable and
! 	'Terminated whenever the prefix is of a task interface class-wide type.
! 	(Analyze_Attribute): Add semantic check for attribute 'Identity whenever
! 	the prefix is of a task interface class-wide type.
! 
! 	* s-vaflop-vms-alpha.adb: Valid_D, Valid_F, Valid_G: Make Val constant
! 	to avoid warnings.
! 
! 	* s-fatgen.ads, s-fatgen.adb (Machine_Rounding): New function
! 	Remove pragma Inline for [Unaligned_]Valid.
! 	Add comments that Valid routines do not work for Vax_Float
! 
! 	* exp_attr.adb: Implement Machine_Rounding attribute
! 
! 	* snames.h: Add entry for Machine_Rounding attribute
! 
! 2005-11-14  Javier Miranda  <miranda@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 
! 	* exp_attr.adb (Expand_N_Attribute_Reference, cases of Attribute_Size
! 	and related): For a prefix that is an explicit dereference of an
! 	access to unconstrained packed array type, annotate the dereference
! 	with an actual subtype so GIGI can make a correct size computation.
! 	(Expand_N_Attribute_Reference): In case of 'Unchecked_Access and
! 	'Unrestricted_Access, if the designated type is an interface we
! 	add a type conversion to force the displacement of the pointer
! 	to the secondary dispatch table.
! 	Use Universal_Real instead of Long_Long_Float when we need a high
! 	precision float type for the generated code (prevents gratuitous
! 	Vax_Float stuff when pragma Float_Representation (Vax_Float) used)
! 	(Expand_N_Attribute_Reference): Add support for attribute 'Callable and
! 	'Terminated for task interface class-wide objects. Generate a call to
! 	the predefined dispatching routine used to retrieve the _task_id from
! 	a task corresponding record.
! 	(Expand_Fpt_Attribute): Major change to properly handle Vax_Float
! 
! 	* sem_disp.adb: Change name Is_Package to Is_Package_Or_Generic_Package
! 	(Check_Dispatching_Operation): Protect the frontend againts
! 	previously detected errors.
! 
! 	* Makefile.rtl: Add new instantiations of system.fat_gen
! 
! 	* s-fatflt.ads, s-fatlfl.ads, s-fatllf.ads, s-fatsfl.ads: 
! 	Change name of instantiated package for better consistency
! 	with newly added system.fat_gen instantiations.
! 
! 	* s-filofl.ads, s-fishfl.ads, s-fvadfl.ads, s-fvaffl.ads,
! 	s-fvagfl.ads: New files.
! 
! 2005-11-14  Cyrille Comar  <comar@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_ch5.adb (Expand_N_Assignment_Statement, Tagged_Case): For an
! 	assignment of a value of a tagged type that has been rewritten to a
! 	block statement, it is known by construction that no checks are
! 	necessary for the statements within the block: analyze it with checks
! 	suppressed.
! 	(Expand_N_If_Statement): When killing a dead then-branch in an
! 	if-statement that has elsif_parts, recompute the Current_Value node
! 	for any entity whose value is known from the condition of the first
! 	elsif_part.
! 	(Expand_N_Return_Statement): When returning a mutable record, convert
! 	the return value into its actual subtype in order to help the backend
! 	to return the actual size instead of the maximum. This is another
! 	aftermath of not returning mutable records on the sec-stack anymore.
! 
! 	* sem_ch5.ads, sem_ch5.adb (Analyze_Iteration_Scheme): Minor change to
! 	handling of error msg for suspicious reverse range iteration.
! 	(Check_Possible_Current_Value_Condition): Move declaration from body to
! 	spec, to allow this subprogram to be called from exp_ch5.
! 
! 2005-11-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Append_Array_Traversal): Modify constrained case to
! 	generate a set of nested array aggregates instead of a single flat
! 	aggregate for multi-dimensional arrays.
! 
! 2005-11-14  Pascal Obry  <obry@adacore.com>
! 
! 	* expect.c (__gnat_kill) [Win32]: Fix implementation, the pid returned
! 	by spawnve is a process handle, no need to convert. Add a parameter
! 	close to control wether the process handle must be closed.
! 	(__gnat_waitpid): Fix implementation, the pid returned by spawnve is
! 	a process handle, not need to convert.
! 	(__gnat_kill) [*]: Add dummy parameter close to match the Win32 spec.
! 
! 	* g-expect.adb: (Kill): Document the new close parameter.
! 	(Close): Do not release the process handle in the kill there as
! 	waitpid() is using it.
! 	(Send_Signal): Release the process handle.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_fixd.adb: Use Universal_Real instead of Long_Long_Float when we
! 	need a high precision float type for the generated code (prevents
! 	gratuitous Vax_Float stuff when pragma Float_Representation (Vax_Float)
! 	used).
! 
! 	* exp_imgv.adb: Use Universal_Real instead of Long_Long_Float when we
! 	need a high precision float type for the generated code (prevents
! 	gratuitous Vax_Float stuff when pragma Float_Representation (Vax_Float)
! 	used).
! 	(Expand_Width_Attribute): In configurable run-time, the attribute is not
! 	allowed on non-static enumeration subtypes. Force a load error to emit
! 	the correct diagnostic.
! 
! 2005-11-14  Thomas Quinot  <quinot@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_intr.adb (Expand_Unc_Deallocation): If GIGI needs an actual
! 	subtype to compute the size of the designated object at run-time,
! 	create such a subtype and store it in the Actual_Designated_Subtype
! 	attribute of the N_Free_Statement.
! 	Generate itype for classwide designated object in both cases of
! 	user-specified storage pool: specific and class-wide, not only in the
! 	specific case.
! 	Raise CE when trying to set a not null access type object to null.
! 	(Expand_Dispatching_Constructor_Call): Retrieve subprogram actual with
! 	an explicit loop, because freeze nodes make its position variable.
! 
! 	* sem_intr.adb (Check_Intrinsic_Call): Given warning for freeing not
! 	null object.
! 
! 2005-11-14  Javier Miranda  <miranda@adacore.com>
! 
! 	* exp_strm.adb (Build_Stream_Attr_Profile, Build_Stream_Function,
! 	Build_Stream_Procedure): Add the null-excluding attribute to the first
! 	formal.
! 	This has no semantic meaning under Ada95 mode but it is a
! 	requirement under Ada05 mode.
! 
! 	* par-ch3.adb (P_Access_Definition): Addition of warning message if
! 	the null exclusion is used under Ada95 mode
! 	(P_Null_Exclusion): The qualifier has no semantic meaning in Ada 95.
! 	(P_Access_Definition): Remove assertion that forbids the use of
! 	the null-exclusion feature in Ada95.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* impunit.adb: Exclude container helper units not intended for use by
! 	users.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* freeze.adb (Freeze_Entity): For an access formal that is an access
! 	to subprogram, freeze the anonymous subprogram type at the same time,
! 	to prevent later freezing in the wrong scope, such as the enclosing
! 	subprogram body.
! 	(Freeze_Entity): Freeze the equivalent_type of an access_to_protected_
! 	subprogram whenever available.
! 
! 2005-11-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	PR ada/23732
! 	* gnatvsn.ads (Library_Version): Bump to 4.1
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* g-debpoo.adb (Set_Valid): Use Integer_Address instead of
! 	Storage_Offset to avoid wrap around causing invalid results.
! 
! 2005-11-14  Pascal Obry  <obry@adacore.com>
! 
! 	* gnatbind.adb (Is_Cross_Compiler): New function returning True for
! 	cross-compiler.
! 	(Scan_Bind_Arg): Fail with an error message if -M option is used
! 	on a native compiler.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 
! 	* gprep.adb: Implement -C switch to scan comments
! 
! 	* scng.adb: Scan comment symbol separately if Replace_In_Comments set
! 
! 	* scans.ads: Comment updates (including new use of Tok_Comment in
! 	preprocessing)
! 
! 	* opt.ads: Add documentation for flags that are used by gprmake,
! 	currently and in the next version of gprmake.
! 	(Verbosity_Level): New variable
! 	Add Replace_In_Comments switch
! 
! 	* vms_data.ads: Add VMS equivalent for new gnatmake switches -vl, -vm
! 	and -vm.
! 	Add /REPLACE_IN_COMMENTS for gnatprep -C switch
! 
! 2005-11-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* g-regpat.adb (Fail): raise Expression_Error including the diagnostic
! 	message, friendlier.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* g-spitbo.adb: (Hash): Rotate by 3 instead of 1
! 
! 2005-11-14  Doug Rupp  <rupp@adacore.com>
! 
! 	* init.c [VMS]: Don't install __gnat_error_handler if DBG$TDBG defined.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* interfac.ads: Change declarations of IEEE float types so that we no
! 	longer need a separate version of this package for VMS.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* lib-xref.adb (Generate_Definition, Generate_Reference): Treat the
! 	internal entity created for the declaration of a child subprogram body
! 	with no spec as coming from source, to generate proper cross-reference
! 	information.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* make.adb (Compile_Sources): Change verbose message to minimum
! 	verbosity level High for "is in an Ada library", "is a read-only
! 	library" and "is an internal library",
! 	(Create_Binder_Mapping_File): Path name of ALI file for library project
! 	must include the library directory, not the object directory.
! 	(Scan_Make_Arg): Make sure that Switch.M.Scan_Make_Switches is called
! 	for new switches -vl, -vm and -vh.
! 	(Verbose_Msg): Add new defaulted parameter Minimum_Verbosity
! 	(Check): Use minimum verbosity Medium for some Verbose_Msg calls
! 	(Compile_Sources): Do not attempt to compile if an ALI file is missing
! 	in a project that is externally built.
! 	(Compute_All_Imported_Projects): New procedure
! 	(Gnatmake): Check if importing libraries should be regenerated because
! 	at least an imported library is more recent.
! 	(Initialize): For each project compute the list of the projects it
! 	imports directly or indirectly.
! 	(Add_Library_Search_Dir): New procedure, used in place of
! 	Add_Lib_Search_Dir in procedure Scan_Make_Arg so that absolute paths are
! 	put in the search paths.
! 	(Add_Source_Search_Dir): New procedure, used in place of
! 	Add_Src_Search_Dir in procedure Scan_Make_Arg so that absolute paths are
! 	put in the search paths.
! 	(Mark_Directory): Resolve the absolute path the directory before marking
! 	it.
! 
! 	* switch-m.adb (Scan_Make_Switches): Replace "raise Bad_Switch;" with
! 	call to new procedure Bad_Switch. Call Scan_Pos with new parameter
! 	Switch. Do not handle any exception.
! 	(Scan_Make_Switches): Increment Ptr for new switches -vl, -vm and -vh
! 	so that the switch is recognized as valid.
! 	(Scan_Make_Switches): Implement new switches -vl, -vm and -vh.
! 
! 2005-11-14  GNAT Script  <nobody@adacore.com>
! 
! 	* Make-lang.in: Makefile automatically updated
! 
! 2005-11-14  Pascal Obry  <obry@adacore.com>
! 
! 	* mdll.adb (Build_Reloc_DLL): Fix parameter handling when a map file is
! 	used.
! 	(Ada_Build_Reloc_DLL): Fix parameter handling when a map file is used.
! 	In both cases the last argument was dropped.
! 
! 2005-11-14  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* namet.h: (Column_Numbe): New type.
! 	(Get_Column_Number): Define to sinput__get_column_number.
! 	(Instantiation): Define to sinput__instantiation.
! 	(Get_Column_Number): Declare.
! 	(Instantiation): Likewise.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* par-ch10.adb (P_Compilation_Unit): Add defenses against junk unit
! 	syntax, which could cause compiler hangs.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-ext.adb: Take into account new environment variable
! 	GPR_PROJECT_PATH. Warn if both GPR_PROJECT_PATH and ADA_PROJECT_PATH
! 	are defined.
! 	(Prj.Ext elaboration): For each directory in the ADA_PROJECT_PATH,
! 	normalize its path name, making it absolute and resolving symbolic
! 	links, and replace the original if resolved path is different.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-part.adb (Create_Virtual_Extending_Project): Put virtual project
! 	into Prj.Tree.Tree_Private_Part.Projects_Htable for GPS.
! 
! 2005-11-14  Emmanuel Briot  <briot@adacore.com>
! 
! 	* prj-pp.adb (Print): Do not output the with statement if the
! 	associated name is empty, which happens for virtual extending projects.
! 	(Print): Preserve the "extends all" attribute when printing the project.
! 
! 	* prj-tree.ads (String_Value_Of): Add comment about returned value for
! 	a virtual extending project.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_aggr.adb (Resolve_Aggregate): An others choice is legal on the
! 	rhs of an assignment even if the type is unconstrained, when the
! 	context is non-expanding.
! 	In an inlined body, if the context type is private,
! 	resolve with its full view, which must be a composite type.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch10.adb: Change name Is_Package to Is_Package_Or_Generic_Package
! 	Do not give obsolescent warning on with of subprogram (since we
! 	diagnose calls)
! 	(Analyze_With_Clause): Add test for obsolescent package
! 	(Install_Context_Clauses): If the unit is the body of a child unit, do
! 	not install twice the private declarations of the parents, to prevent
! 	circular lists of Use_Clauses in a parent.
! 	(Implicit_With_On_Parent): Do add duplicate with_clause on parent when
! 	compiling body of child unit.
! 	Use new class N_Subprogram_Instantiation
! 	(Expand_With_Clause): If this is a private with_clause for a child unit,
! 	appearing in the context of a package declaration, then the implicit
! 	with_clauses generated for parent units are private as well.
! 	(License_Check): Do not generate message if with'ed unit is internal
! 
! 2005-11-14  Gary Dismukes  <dismukes@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_ch12.ads, sem_ch12.adb (Map_Entities): Exclude entities whose
! 	names are internal, because they will not have a corresponding partner
! 	in the actual package.
! 	(Analyze_Formal_Package): Move the setting of the formal package spec's
! 	Generic_Parent field so that it occurs prior to analyzing the package,
! 	to allow proper operation of Install_Parent_Private_Declarations.
! 	(Analyze_Package_Instantiation): Set the instantiated package entity's
! 	Package_Instantiation field.
! 	(Get_Package_Instantiation_Node): Move declaration to package spec.
! 	Retrieve the N_Package_Instantiation node when the Package_Instantiation
! 	field is present.
! 	(Check_Generic_Child_Unit): Within an inlined call, the only possible
! 	instantiation is Unchecked_Conversion, for which no parents are needed.
! 	(Inline_Instance_Body): Deinstall and record the use_clauses for all
! 	parent scopes of a scope being removed prior to inlining an instance
! 	body.
! 	(Analyze_Package_Instantiation): Do not perform front-end inlining when
! 	the current context is itself an instance within a non-instance child
! 	unit, to prevent scope stack errors.
! 	(Save_References): If the node is an aggregate that is an actual in a
! 	call, rewrite as a qualified expression to preserve some type
! 	information, to resolve possible ambiguities in the instance.
! 	(Instance_Parent_Unit): New global variable to record the ultimate
! 	parent unit associated with a generic child unit instance (associated
! 	with the existing Parent_Unit_Visible flag).
! 	(type Instance_Env): New component Instance_Parent_Unit for stacking
! 	parents recorded in the global Instance_Parent_Unit.
! 	(Init_Env): Save value of Instance_Parent_Unit in the Instance_Env
! 	stack.
! 	(Install_Spec): Save the parent unit entity in Instance_Parent_Unit when
! 	it's not a top-level unit, and only do this if Instance_Parent_Unit is
! 	not already set. Replace test of Is_Child_Unit with test of parent's
! 	scope against package Standard. Add comments and a ??? comment.
! 	(Remove_Parent): Revise condition for resetting Is_Immediately_Visible
! 	on a child instance parent to test that the parent equals
! 	Instance_Parent rather than simply checking that the unit is not a
! 	child unit.
! 	(Restore_Env): Restore value of Instance_Parent_Unit from Instance_Env.
! 	(Validate_Derived_Interface_Type_Instance): Verify that all ancestors of
! 	a formal interface are ancestors of the corresponding actual.
! 	(Validate_Formal_Interface_Type): Additional legality checks.
! 	(Analyze_Formal_Derived_Interface_Type): New procedure to handle formal
! 	interface types with ancestors.
! 	(Analyze_Formal_Package): If formal is a renaming, use renamed entity
! 	to diagnose attempts to use generic within its own declaration.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_ch3.ads, sem_ch3.adb (Build_Discriminal): Add link to original
! 	discriminant.
! 	(Build_Private_Derived_Type): The entity of the created full view of the
! 	derived type does not come from source. If after installing the private
! 	declarations of the parent scope the parent is still private, use its
! 	full view to construct the full declaration of the derived type.
! 	(Build_Derived_Record_Type): Relax the condition that controls the
! 	execution of the check that verifies that the partial view and
! 	the full view agree in the set of implemented interfaces. In
! 	addition, this test now only takes into account the progenitors.
! 	(Derive_Interface_Subprograms): No need to derive subprograms
! 	of ancestors that are interfaces.
! 	(Derive_Subprograms): Remove formal No_Predefined_Prims and the
! 	associated code.
! 	Change name Is_Package to Is_Package_Or_Generic_Package
! 	(Complete_Subprograms_Derivation): Handle the case in which the full
! 	view is a transitive derivation of the ancestor of the partial view.
! 	(Process_Full_View): Rename local subprogram Find_Interface_In_
! 	Descendant to Find_Ancestor_Interface to leave the code more clear.
! 	Remove wrong code that avoids the generation of an error message
! 	when the immediate ancestor of the partial view is an interface.
! 	In addition some minor reorganization of the code has been done to
! 	leave it more clear.
! 	(Analyze_Type_Declaration): If type has previous incomplete tagged
! 	partial view, inherit properly its primitive operations.
! 	(Collect_Interfaces): Make public, for analysis of formal
! 	interfaces.
! 	(Analyze_Interface_Declaration): New procedure for use for regular and
! 	formal interface declarations.
! 	(Build_Derived_Record_Type): Add support for private types to the code
! 	that checks if a tagged type implements abstract interfaces.
! 	(Check_Aliased_Component_Type): The test applies in the spec of an
! 	instance as well.
! 	(Access_Type_Declaration): Clean up declaration of malformed type
! 	declared as an access to its own classwide type, to prevent cascaded
! 	crash.
! 	(Collect_Interfaces): For private extensions and for derived task types
! 	and derived protected types, the parent may be an interface that must
! 	be included in the interface list.
! 	(Access_Definition): If the designated type is an interface that may
! 	contain tasks, create Master_Id for it before analyzing the expression
! 	of the declaration, which may be an allocator.
! 	(Record_Type_Declaration): Set properly the interface kind, for use
! 	in allocators, the creation of master id's for task interfaces, etc.
! 
! 2005-11-14  Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch6.adb (Check_Conformance): The null-exclusion feature can be
! 	omitted in case of stream attribute subprograms.
! 	(Check_Inline_Pragma): Handle Inline and Inline_Always pragmas that
! 	appear immediately after a subprogram body, when there is no previous
! 	subprogram declaration.
! 	Change name Is_Package to Is_Package_Or_Generic_Package
! 	(Process_Formals): A non null qualifier on a non null named access
! 	type is not an error, and is a warning only if Redundant_Constructs
! 	are flagged.
! 
! 2005-11-14  Gary Dismukes  <dismukes@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch7.adb (Install_Parent_Private_Declarations): New procedure
! 	nested within Analyze_Package_Specification to install the private
! 	declarations and use clauses within each of the parent units of a
! 	package instance of a generic child package.
! 	(Analyze_Package_Specification): When entering a private part of a
! 	package associated with a generic instance or formal package, the
! 	private declarations of the parent must be installed (by calling new
! 	procedure Install_Parent_Private_Declarations).
! 	Change name Is_Package to Is_Package_Or_Generic_Package
! 	(Preserve_Full_Attributes): For a synchronized type, the corresponding
! 	record is absent in a generic context, which does not indicate a
! 	compiler error.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch8.adb (Analyze_Subprogram_Renaming): In a generic context, do
! 	not try to rewrite a renamed stream attribute, because the operations
! 	on the type may not have been generated.
! 	Handle properly a renaming_as_body generated for a stream operation
! 	whose default is abstract because the object type itself is abstract.
! 	(Find_Type): If the type is incomplete and appears as the prefix of a
! 	'Class reference, it is tagged, and its list of primitive operations
! 	must be initialized properly.
! 	(Chain_Use_Clauses): When chaining the use clauses that appear in the
! 	private declaration of a parent unit, prior to compiling the private
! 	part of a child unit, find on the scope stack the proper parent entity
! 	on which to link the use clause.
! 	(Note_Redundant_Use): Emit a warning when a redundant use clause is
! 	detected.
! 	(Analyze_Object_Renaming): An attribute reference is not a legal object
! 	if it is not a function call.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_eval.adb: Implement d.f flag
! 	(Subtype_Statically_Match): A generic actual type has unknown
! 	discriminants when the corresponding actual has a similar partial view.
! 	If the routine is called to validate the signature of an inherited
! 	operation in a child instance, the generic actual matches the full view,
! 
! 2005-11-14  Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_res.adb (Resolve_Call): Provide a better error message whenever
! 	a procedure call is used as a select statement trigger and is not an
! 	entry renaming or a primitive of a limited interface.
! 	(Valid_Conversion): If the operand has a single interpretation do not
! 	remove address operations.
! 	(Check_Infinite_Recursion): Skip freeze nodes when looking for a raise
! 	statement to inhibit warning.
! 	(Resolve_Unary_Op): Do not produce a warning when
! 	processing an expression of the form -(A mod B)
! 	Use Universal_Real instead of Long_Long_Float when we need a high
! 	precision float type for the generated code (prevents gratuitous
! 	Vax_Float stuff when pragma Float_Representation (Vax_Float) used)
! 	(Resolve_Concatenation_Arg): Improve error message when argument is an
! 	ambiguous call to a function that returns an array.
! 	(Make_Call_Into_Operator, Operand_Type_In_Scope): Do not check that
! 	there is an implicit operator in the given scope if we are within an
! 	instance: legality check has been performed on the generic.
! 	(Resolve_Unary_Op): Apply warnings checks on argument of Abs operator
! 	after resolving operand, to avoid false warnings on overloaded calls.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	PR ada/15604
! 
! 	* sem_type.adb (Covers): In an inlined body, a composite type matches
! 	a private type whose full view is a composite type.
! 	(Interface_Present_In_Ancestor): Protect the frontend against
! 	previously detected errors to ensure that its compilation
! 	with assertions enabled gives the same output that its
! 	compilation without assertions.
! 	(Interface_Present_In_Ancestor): Add support for private types.
! 	Change name In_Actual to In_Generic_Actual (clean up)
! 	(Disambiguate): New predicate In_Actual, to recognize expressions that
! 	appear in the renaming declaration generated for generic actuals, and
! 	which must be resolved in the outer context.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_util.ads, sem_util.adb: Change name Is_Package to
! 	Is_Package_Or_Generic_Package.
! 	(Check_Obsolescent): New procedure.
! 	(Set_Is_Public): Remove obsolete junk test.
! 	(Set_Public_Status): Do not set Is_Public on an object whose declaration
! 	occurs within a handled_sequence_of_statemets.
! 	(Is_Controlling_Limited_Procedure): Factor some of the logic, account
! 	for a parameterless procedure.
! 	(Enter_Name): Recognize renaming declarations created for private
! 	component of a protected type within protected operations, so that
! 	the source name of the component can be used in the debugger.
! 
! 2005-11-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_warn.ads, sem_warn.adb (Publicly_Referenceable): Generic formals
! 	of a generic subprogram are not visible outside the body.
! 	(Set_Warning_Switch): New procedure (code to set warning mode moved
! 	here from Switch.C so that it can be shared by pragma processing.
! 	(Check_References): Special case warning for non-modified non-imported
! 	volatile objects.
! 	* par-prag.adb: Modify processing of pragma Warnings to accomodate new
! 	form with a string literal argument
! 
! 2005-11-14  Javier Miranda  <miranda@adacore.com>
! 
! 	* s-finroo.ads, s-finroo.adb (Read): Addition of "not null" to the
! 	anonymous access.
! 	(Write): Addition of "not null" to the anonymous access.
! 	(Read): Addition of "not null" to the anonymous access.
! 	(Write): Addition of "not null" to the anonymous access.
! 
! 	* s-strxdr.adb, s-stratt.ads, s-stratt.adb (I_AD, I_AS, I_B, I_C, I_F,
! 	I_I, I_LF, I_LI, I_LLF, I_LLI, I_LLU, I_LU, I_SF, I_SI, I_SSI, I_SSU,
! 	I_SU, I_U, I_WC): Addition of "not null" to the anonymous access.
! 	(W_AD, W_AS, W_B, W_C, W_F, W_I, W_LF, W_LI, W_LLF, W_LLI, W_LLU,
! 	W_LU, W_SF, W_SI, W_SSI, W_SSU, W_SU, W_U, W_WC): Addition of
! 	"not null" to the anonymous access.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* s-stoele.adb: Fix code for Address mod Storage_Offset for negative
! 	offset values
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* switch.adb (Bad_Switch): New procedure
! 	(Scan_Nat, Scan_Pos): Directly call Osint.Fail with the appropriate
! 	message when in error.
! 
! 	* switch.ads (Bad_Switch, Bad_Switch_Value, Missing_Switch_Value,
! 	Too_Many_Output_Files): Remove declarations, no longer used.
! 	(Scan_Nat): New parameter Switch
! 	(Scan_Pos): Ditto
! 	(Bad_Switch): New procedure
! 
! 	* switch-b.adb (Scan_Binder_Switches): Replace "raise Bad_Switch;"
! 	with call to new procedure Bad_Switch. Call Scan_Pos and Scan_Natwith
! 	new parameter Switch. Replace "raise Too_Many_Output_Files;" with call
! 	to Osint.Fail. Do not handle any exception.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* tempdir.adb (Tempdir): Do not use environment variable TMPDIR if it
! 	designates a non existent directory.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* xgnatugn.adb: Replace invalid membership test by 'Valid
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* makegpr.adb (Gprmake): Do not attempt to build the global archive if
! 	there is no object directory.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* usage.adb: Minor adjustment to output format, use nn instead of nnn
! 	(so that -gnateInnn does not run into next column)
! 
! 2005-11-14  Ed Falis  <falis@adacore.com>
! 
! 	* s-bitops.adb (Bits_Array): corrected comment: "unconstrained" =>
! 	"constrained"
! 
! 2005-11-14  Cyrille Comar  <comar@adacore.com>
! 
! 	* s-chepoo.ads: Add comments on Dereference.
! 	Remove unnecessary inherited abstract primitives.
! 	Cosmetic cleanup.
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_cat.ads (Validate_Access_Type_Declaration): Remove declaration
! 	node parameter, not needed, since it is available as Declaration_Node.
! 
! 2005-11-14  Geert Bosch  <bosch@adacore.com>
! 
! 	* s-exnllf.adb (Exn_LLF): Fix comment to be more precise and
! 	grammatically correct.
! 
! 2005-11-14  Vincent Celier  <celier@adacore.com>
! 
! 	* s-fileio.ads: Correct spelling error in comment
! 
! 2005-11-14  Cyrille Comar  <comar@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 	    Ben Brosgol  <brosgol@adacore.com>
! 	    Jose Ruiz  <ruiz@adacore.com>
! 	    Pascal Obry  <obry@adacore.com>
! 
! 	* gnat_ugn.texi: 
! 	Document that -fstack-check is needed for strict compliance with the
! 	Ada 95 Reference Manual.
! 	Correct reference to VAX systems to meet HP guidelines
! 	Add documentation for new gnatmake switches -vl, -vm and -vh
! 	Replace DEC Ada by HP Ada
! 	Replace DIGITAL by HP
! 	Remove empty section on tools in compatibility section
! 	Clarify the Windows convention semantics.
! 	Document the Win32 calling convention.
! 	The Stdcall, Win32 and DLL convention are synonyms.
! 	Add a note in -gnatR description about zero size record components
! 	Note on new >= and <= warnings for -gnatwc
! 	Document that equal sign after -gnatm is optional.
! 	Note that strip is working fine on DLL built with a Library
! 	Project. The restriction apply only to DLL built with gnatdll.
! 	Update section about the way to debug a DLL.
! 	Update information about the DLL convention.
! 	Document -C switch for gnatprep
! 	Document new attribute Library_ALI_Dir
! 	Update elaboration doc to include implicit Elaborate pragmas now
! 	generated for subprogram instantiations.
! 	Document limitation on executable names that include spaces for --GCC,
! 	--GNATBIND, and --GNATLINK switches.
! 	Document that -w causes -gnatws to be added at start of gcc switches
! 
! 	* gnat_rm.texi: Document that -mieee is needed for generating infinite
! 	and NaN values in case of overflow on machines that are not fully
! 	compliant with the IEEE floating-point standard.
! 	Create a section describing the set of compiler options needed for
! 	strict compliance with the Ada 95 Reference Manual.
! 	Add documentation for pragma Obsolescent applied to a package
! 	Clarify potential issues of mixed language programs related to the
! 	I/O buffering enabling in the elaboration of the GNAT runtime.
! 	Add extra documentation for pragma Restrictions (No_Elaboration_Code)
! 	This documentation only patch adds extra documentsion for pragma
! 	Restrictions (No_Elaboration_Code), explaining why it is not possible
! 	to document this restriction in terms of allowed source constructs.
! 	Document string literal form of pragma Warnings
! 	Document new attribute Library_ALI_Dir
! 	Add documentation on stable attributes in project files that was missing
! 
! 	* gnat-style.texi: Indicate that paragraphs within a single comment
! 	should be separated by empty comment lines
! 
! 	* ug_words: Added replacements for -gnat95 and -gnat05 (/95 and
! 	/05 respectively)
! 
! 	* bindusg.adb: Minor cleanup, put -m before -M for consistency
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-secain.adb, a-slcain.adb, a-shcain.adb, a-chtgke.ads, a-chtgke.adb,
! 	a-stwiha.adb, a-strhas.adb, a-chzla1.ads, a-chzla9.ads, a-stzbou.adb,
! 	a-stzbou.ads, a-stzfix.adb, a-stzhas.adb, a-stzmap.adb, a-stzmap.ads,
! 	a-stzsea.adb, a-stzsea.ads, a-stzsup.adb, a-stzsup.ads, a-stzunb.adb,
! 	a-stzunb.ads, a-szuzha.adb, a-szuzha.ads, a-szuzti.adb, a-szuzti.ads,
! 	a-ztcoau.adb, a-ztcoau.ads, a-ztcoio.adb, a-ztcstr.adb, a-ztcstr.ads,
! 	a-ztdeau.adb, a-ztdeau.ads, a-ztdeio.adb, a-ztdeio.ads, a-ztedit.adb,
! 	a-ztedit.ads, a-ztenau.ads, a-ztenio.adb, a-ztenio.ads, a-ztexio.adb,
! 	a-ztexio.ads, a-ztfiio.adb, a-ztfiio.ads, a-ztflau.adb, a-ztflau.ads,
! 	a-ztflio.adb, a-ztflio.ads, a-ztgeau.adb, a-ztgeau.ads, a-ztinau.adb,
! 	a-ztinau.ads, a-ztinio.adb, a-ztmoau.ads, a-ztmoio.adb, a-ztmoio.ads,
! 	a-zttest.adb, g-enblsp-vms-alpha.adb, g-enblsp-vms-alpha.adb,
! 	g-enblsp-vms-ia64.adb, g-enblsp-vms-ia64.adb, system-linux-hppa.ads,
! 	a-chacon.adb, a-chacon.ads, a-wichun.adb, a-wichun.ads, a-zchuni.adb,
! 	a-zchuni.ads, g-trasym-vms-alpha.adb, g-trasym-vms-ia64.adb,
! 	system-hpux-ia64.ads, g-soccon-unixware.ads, g-soliop-unixware.ads,
! 	g-soccon-interix.ads, g-soliop-solaris.ads, g-eacodu-vms.adb,
! 	g-expect-vms.adb, g-socthi-vms.adb, g-soliop-mingw.ads,
! 	a-intnam-unixware.ads, a-intnam-lynxos.ads, a-intnam-tru64.ads,
! 	a-intnam-aix.ads, a-intnam-linux.ads, a-intnam-linux.ads,
! 	a-intnam-dummy.ads, a-numaux-libc-x86.ads, a-intnam-interix.ads,
! 	a-intnam-solaris.ads, a-calend-vms.adb, a-calend-vms.ads,
! 	a-intnam-vms.ads, a-calend-mingw.adb, a-intnam-mingw.ads,
! 	a-intnam-vxworks.ads, a-numaux-vxworks.ads, system-unixware.ads,
! 	system-linux-ia64.ads, a-intnam-freebsd.ads, system-freebsd-x86.ads,
! 	system-lynxos-ppc.ads, system-linux-x86_64.ads, a-stunha.adb,
! 	a-cgaaso.ads, a-cgaaso.adb, a-chtgop.adb, a-cgcaso.adb, a-cgarso.adb,
! 	a-cohata.ads, a-crbtgk.adb, a-crbltr.ads, a-coprnu.adb, a-rbtgso.adb,
! 	a-intnam-darwin.ads, system-darwin-ppc.ads, gprmake.adb, makegpr.ads,
! 	system-tru64.ads, system-aix.ads, system-solaris-x86.ads,
! 	system-irix-o32.ads, s-interr-sigaction.adb, system-irix-n32.ads,
! 	s-parame-mingw.adb, system-hpux.ads, s-traceb-hpux.adb,
! 	system-linux-x86.ads, s-inmaop-dummy.adb, system-os2.ads,
! 	system-interix.ads, system-solaris-sparc.ads,
! 	system-solaris-sparcv9.ads, s-inmaop-vms.adb,
! 	s-mastop-vms.adb, expander.adb, expander.ads, s-gloloc-mingw.adb,
! 	system-mingw.ads, system-vms-zcx.ads, s-osinte-fsu.adb,
! 	s-traceb-mastop.adb, a-exextr.adb, a-exstat.adb, a-filico.ads,
! 	a-finali.ads, a-interr.ads, a-intsig.adb, a-intsig.ads,
! 	a-except.ads, a-numaux-x86.ads, a-astaco.adb, a-calend.adb,
! 	a-calend.ads, a-chahan.adb, a-chahan.ads, a-chlat9.ads,
! 	a-colien.adb, a-colien.ads, a-colire.adb, a-colire.ads,
! 	a-comlin.adb, a-comlin.ads, a-cwila1.ads, a-cwila9.ads,
! 	a-elchha.adb, a-decima.adb, a-decima.ads, a-diocst.ads,
! 	a-direio.adb, a-direio.ads, a-excach.adb, a-excach.adb,
! 	a-exctra.ads, ali-util.adb, a-ngcefu.adb, a-ngcoty.adb,
! 	a-ngcoty.ads, a-nudira.adb, a-nudira.ads, a-nuflra.adb,
! 	a-numaux.ads, a-reatim.ads, a-sequio.adb, a-sequio.ads,
! 	a-siocst.ads, a-ssicst.ads, a-stmaco.ads, a-storio.adb,
! 	a-strbou.adb, a-strbou.ads, a-stream.ads, a-strfix.adb,
! 	a-strmap.adb, a-strmap.ads, a-strsea.adb, a-strsea.ads,
! 	a-strsup.adb, a-strsup.ads, a-strunb.adb, a-strunb.ads,
! 	a-stwibo.adb, a-stwibo.ads, a-stwifi.adb, a-stwima.adb,
! 	a-stwima.ads, a-stwise.adb, a-stwise.ads, a-stwisu.adb,
! 	a-stwisu.ads, a-stwiun.adb, a-stwiun.ads, a-suteio.adb,
! 	a-suteio.ads, a-swmwco.ads, a-swuwti.adb, a-swuwti.ads,
! 	a-sytaco.adb, a-sytaco.ads, a-tasatt.adb, a-taside.adb,
! 	a-taside.ads, a-teioed.adb, a-textio.adb, a-textio.ads,
! 	a-ticoau.adb, a-ticoau.ads, a-ticoio.adb, a-tideau.adb,
! 	a-tideio.adb, a-tienau.adb, a-tienio.adb, a-tifiio.adb,
! 	a-tiflio.adb, a-tigeau.adb, a-tigeau.ads, a-tiinau.adb,
! 	a-tiinio.adb, a-timoau.adb, a-timoio.adb, a-timoio.ads,
! 	a-tiocst.ads, a-titest.adb, atree.adb, a-witeio.adb,
! 	a-witeio.ads, a-wtcoau.adb, a-wtcoau.ads, a-wtcoio.adb,
! 	a-wtcstr.ads, a-wtdeau.adb, a-wtdeio.adb, a-wtedit.adb,
! 	a-wtedit.ads, a-wtenau.adb, a-wtenio.adb, a-wtfiio.adb,
! 	a-wtflio.adb, a-wtgeau.adb, a-wtinau.adb, a-wtinio.adb,
! 	a-wtmoau.adb, a-wtmoio.adb, a-wttest.adb, back_end.adb,
! 	bindgen.adb, butil.adb, butil.ads, checks.ads, cio.c, comperr.adb,
! 	csets.ads, cstand.adb, debug.ads, elists.ads, errno.c, errout.adb,
! 	errout.ads, erroutc.adb, erroutc.ads, errutil.adb, errutil.ads,
! 	errutil.ads, err_vars.ads, eval_fat.adb, exp_ch11.adb, exp_ch11.ads,
! 	exp_ch2.adb, exp_ch7.ads, exp_imgv.ads, exp_pakd.adb, exp_prag.adb,
! 	exp_prag.ads, exp_tss.adb, exp_tss.ads, exp_vfpt.ads, fe.h, fmap.adb,
! 	freeze.ads, frontend.adb, frontend.ads, g-arrspl.adb, g-arrspl.ads,
! 	g-awk.adb, g-awk.ads, g-boumai.ads, g-calend.adb, g-calend.ads,
! 	g-catiio.adb, g-comlin.adb, g-comlin.ads, g-comlin.ads, g-comlin.ads,
! 	g-comver.adb, g-crc32.adb, g-crc32.ads, g-ctrl_c.ads, g-curexc.ads,
! 	g-debpoo.ads, g-debuti.adb, g-diopit.adb, g-diopit.ads, g-dirope.adb,
! 	g-dirope.ads, g-dyntab.adb, g-dyntab.ads, g-excact.adb, g-excact.ads,
! 	g-except.ads, g-exctra.adb, g-exctra.ads, g-expect.ads, g-flocon.ads,
! 	g-hesorg.ads, g-io.adb, g-locfil.ads, g-md5.adb, g-md5.ads, g-md5.ads,
! 	g-moreex.adb, g-signal.ads, g-signal.adb, gnatbind.ads, gnatchop.adb,
! 	gnatcmd.adb, gnatfind.adb, gnatlbr.adb, gnatmake.ads, gnatmem.adb,
! 	gnatprep.adb, gnatprep.ads, gnatsym.adb, gnatxref.adb, g-os_lib.adb,
! 	g-os_lib.ads, g-pehage.adb, g-pehage.ads, gprep.ads, g-regexp.adb,
! 	g-regexp.ads, g-regist.adb, g-regist.ads, g-regpat.ads, g-semaph.adb,
! 	g-socthi.adb, g-soliop.ads, g-spipat.adb, g-spipat.ads, g-sptabo.ads,
! 	g-sptain.ads, g-sptavs.ads, g-string.ads, g-tasloc.adb, g-tasloc.ads,
! 	g-trasym.adb, g-trasym.ads, i-fortra.adb, i-fortra.ads, inline.adb,
! 	layout.adb, live.adb, make.ads, makeutl.ads, makeutl.adb, mdll-fil.adb,
! 	mdll-fil.ads, mdll-utl.ads, memroot.ads, memtrack.adb, mlib.ads,
! 	mlib-fil.adb, mlib-fil.ads, mlib-prj.ads, mlib-utl.adb, mlib-utl.ads,
! 	nlists.adb, nlists.ads, osint.adb, osint.ads, osint-c.adb, osint-l.adb,
! 	osint-l.ads, osint-m.ads, output.adb, par.adb, par.adb, par.ads,
! 	par-ch11.adb, par-ch12.adb, par-ch2.adb, par-ch4.adb, par-ch5.adb,
! 	par-ch6.adb, par-ch9.adb, par-endh.adb, par-labl.adb, par-load.adb,
! 	par-tchk.adb, prep.adb, prepcomp.adb, prepcomp.ads, prj-attr.ads,
! 	prj-com.ads, prj-dect.adb, prj-dect.ads, prj-env.ads, prj-err.ads,
! 	prj-ext.ads, prj-makr.adb, prj-makr.ads, prj-nmsc.ads, prj-pars.adb,
! 	prj-pars.ads, prj-part.ads, prj-pp.ads, prj-proc.ads, prj-strt.adb,
! 	prj-strt.ads, prj-tree.adb, prj-util.adb, prj-util.ads, rtsfind.adb,
! 	sem.adb, sem.ads, sem_case.adb, sem_case.ads, sem_ch11.adb,
! 	sem_ch4.adb, sem_ch6.ads, sem_ch7.ads, sem_dist.ads, sem_elab.ads,
! 	sem_elim.ads, sem_eval.ads, sem_intr.ads, sem_maps.adb, sem_maps.ads,
! 	sem_maps.ads, sem_res.ads, sem_type.ads, sfn_scan.adb, sfn_scan.ads,
! 	s-imgwch.ads, s-imgwiu.adb, s-imgwiu.ads, s-inmaop.ads, sinput.adb,
! 	sinput.ads, s-pack03.adb, s-pack03.ads, s-pack05.adb, s-pack05.ads,
! 	s-pack06.adb, s-pack06.ads, s-pack07.adb, s-pack07.ads, s-pack09.adb,
! 	s-pack09.ads, s-pack10.adb, s-pack10.ads, s-pack11.adb, s-pack11.ads,
! 	s-pack12.adb, s-pack12.ads, s-pack13.adb, s-pack13.ads, s-pack14.adb,
! 	s-pack14.ads, s-pack15.adb, s-pack15.ads, s-pack17.adb, s-pack17.ads,
! 	s-pack18.adb, s-pack18.ads, s-pack19.adb, s-pack19.ads, s-pack20.adb,
! 	s-pack20.ads, s-pack21.adb, s-pack21.ads, s-pack22.adb, s-pack22.ads,
! 	s-pack23.adb, s-pack23.ads, s-pack24.adb, s-pack24.ads, s-pack25.adb,
! 	s-pack25.ads, s-pack26.adb, s-pack26.ads, s-pack27.adb, s-pack27.ads,
! 	s-pack28.adb, s-pack28.ads, s-pack29.adb, s-pack29.ads, s-pack30.adb,
! 	s-pack30.ads, s-pack31.adb, s-pack31.ads, s-pack33.adb, s-pack33.ads,
! 	s-pack34.adb, s-pack34.ads, s-pack35.adb, s-pack35.ads, s-pack36.adb,
! 	s-pack36.ads, s-pack37.adb, s-pack37.ads, s-pack38.adb, s-pack38.ads,
! 	s-pack39.adb, s-pack39.ads, s-pack40.adb, s-pack40.ads, s-pack41.adb,
! 	s-pack41.ads, s-pack42.adb, s-pack42.ads, s-pack43.adb, s-pack43.ads,
! 	s-pack44.adb, s-pack44.ads, s-pack45.adb, s-pack45.ads, s-pack46.adb,
! 	s-pack46.ads, s-pack47.adb, s-pack47.ads, s-pack48.adb, s-pack48.ads,
! 	s-pack49.adb, s-pack49.ads, s-pack50.adb, s-pack50.ads, s-pack51.adb,
! 	s-pack51.ads, s-pack52.adb, s-pack52.ads, s-pack53.adb, s-pack53.ads,
! 	s-pack54.adb, s-pack54.ads, s-pack55.adb, s-pack55.ads, s-pack56.adb,
! 	s-pack56.ads, s-pack57.adb, s-pack57.ads, s-pack58.adb, s-pack58.ads,
! 	s-pack59.adb, s-pack59.ads, s-pack60.adb, s-pack60.adb, s-pack60.ads,
! 	s-pack61.adb, s-pack61.ads, s-pack62.adb, s-pack62.ads, s-pack63.adb,
! 	s-pack63.ads, s-parint.adb, s-parint.adb, s-parint.ads, sprint.ads,
! 	s-purexc.ads, s-restri.ads, s-restri.adb, s-scaval.adb, s-scaval.ads,
! 	s-secsta.adb, s-secsta.ads, s-sequio.adb, s-sequio.ads, stand.ads,
! 	s-tasuti.adb, s-traceb.adb, s-traceb.ads, stringt.adb, stringt.ads,
! 	styleg.ads, s-valboo.adb, s-valboo.ads, s-valcha.adb, s-valcha.ads,
! 	s-valdec.adb, s-valdec.ads, s-valint.adb, s-valint.ads, s-valint.ads,
! 	s-vallld.adb, s-vallld.ads, s-vallli.adb, s-vallli.ads, s-valllu.adb,
! 	s-valllu.ads, s-valrea.adb, s-valrea.ads, s-valuns.adb, s-valuns.ads,
! 	s-valuti.adb, s-valuti.ads, s-valwch.ads, s-veboop.adb, s-veboop.ads,
! 	s-vercon.adb, s-vercon.ads, s-wchcnv.adb, s-wchcnv.ads, s-wchcon.ads,
! 	s-wchjis.adb, s-wchjis.ads, s-wchstw.adb, s-wchstw.adb, s-wchstw.ads,
! 	s-wchwts.adb, s-wchwts.ads, s-widboo.adb, s-widboo.ads, s-widcha.adb,
! 	s-widcha.ads, s-widenu.adb, s-widenu.ads, s-widlli.adb, s-widlli.ads,
! 	s-widllu.adb, s-widllu.ads, s-widwch.adb, s-widwch.ads, s-wwdcha.adb,
! 	s-wwdcha.ads, s-wwdenu.adb, s-wwdenu.ads, symbols.adb, symbols.ads,
! 	table.ads, targparm.adb, targparm.ads, tb-alvms.c, tb-alvxw.c,
! 	tbuild.adb, tree_io.ads, treepr.adb, treeprs.adt, ttypef.ads,
! 	ttypes.ads, types.adb, uintp.adb, uintp.ads, uname.ads, urealp.ads,
! 	usage.ads, validsw.ads, vxaddr2line.adb, widechar.adb, widechar.ads,
! 	xeinfo.adb, xnmake.adb, xref_lib.ads, xr_tabls.adb, xr_tabls.ads,
! 	xsinfo.adb, xtreeprs.adb, xsnames.adb, vms_conv.ads, vms_conv.adb,
! 	a-dirval.ads, a-dirval.adb, a-dirval-mingw.adb, a-direct.ads,
! 	a-direct.adb, indepsw.ads, prj-attr-pm.ads, system-linux-ppc.ads,
! 	a-numaux-darwin.ads, a-numaux-darwin.adb,
! 	a-swuwha.ads, a-stunha.ads: Minor reformatting
! 
! 2005-11-14  Robert Dewar  <dewar@adacore.com>
! 
! 	PR ada/18434
! 	* osint-m.adb: Add pragma Elaborate_All for Osint
! 
! 2005-11-10  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	PR ada/23995
! 	* trans.c (call_to_gnu): Restore statement lost in translation.
! 
! 2005-11-08  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* init.c: Use the Linux-specific section for the IA-64/Linux target.
! 	(__gnat_adjust_context_for_raise): Add conditional code so that the
! 	IA-64 is also supported.
! 
! 2005-11-03  James E Wilson  <wilson@specifix.com>
! 
! 	PR ada/23427
! 	* trans.c (gnat_to_gnu): Use TYPE_SIZE_UNIT not TYPE_SIZE in
! 	TREE_OVERFLOW check.
! 
! 2005-09-21  Olivier Hainque  <hainque@adacore.com>
! 
! 	PR ada/22418
! 	* decl.c (maybe_pad_type): Use proper bitsizetype for XVZ objects,
! 	as we create them to store a size in bits.
! 
! 2005-10-21  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	PR ada/21937
! 	PR ada/22328
! 	PR ada/22381
! 	PR ada/22383
! 	PR ada/22419
! 	PR ada/22420
! 	* utils2.c (build_return_expr): New helper function.
! 	* gigi.h (build_return_expr): Declare it.
! 	* trans.c (Subprogram_Body_to_gnu): Use build_return_expr instead
! 	of manually building the RETURN_EXPR tree.
! 	(call_to_gnu): Pass MODIFY_EXPR through build_binary_op.
! 	(gnat_to_gnu) <N_Return_Statement>: Pass MODIFY_EXPR through
! 	build_binary_op for the "target pointer" case.  Use build_return_expr
! 	instead of manually building the RETURN_EXPR tree.
! 
! 2005-09-16  Laurent GUERBY  <laurent@guerby.net>
! 
! 	PR ada/23788
! 	* s-tpinop.ads: Make this unit Preelaborate.
! 
! 2005-09-16  Andreas Jaeger  <aj@suse.de>
! 
! 	* socket.c: Add string.h for memcpy.
! 
! 2005-09-05  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* dec-io.ads, dec-io.adb: Removed, no longer used.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* a-calend-mingw.adb: Add call to OS_Primitives.Initialize;
! 
! 	* s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb,
! 	s-taprop-os2.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb,
! 	s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-tru64.adb,
! 	s-taprop-lynxos.adb: Move with clauses outside Warnings Off now that
! 	dependent units are Preelaborate.
! 	(Initialize): Call Interrupt_Managemeent.Initialize and
! 	OS_Primitives.Initialize to ensure proper initialization of this unit.
! 	Remove use of System.Soft_Links
! 	Make this unit Preelaborate.
! 
! 	* s-stache.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads,
! 	s-taspri-vms.ads, s-tasinf-solaris.ads, s-taspri-os2.ads,
! 	s-taspri-lynxos.ads, s-taspri-hpux-dce.ads, s-taspri-tru64.ads,
! 	s-tasinf-tru64.ads, s-tasinf-irix.ads, s-tasinf-irix-athread.ads,
! 	s-proinf-irix-athread.adb, s-proinf-irix-athread.ads,
! 	s-tratas.ads, s-tasinf.ads: Minor reformatting.
! 	Add pragma Preelaborate, since these packages are suitable for this
! 	categorization.
! 	Update comments.
! 
! 	* s-traent-vms.ads, s-intman-dummy.adb,
! 	s-taprop-dummy.adb: Make this unit Preelaborate.
! 
! 	* s-osprim-vxworks.adb, s-osprim-vms.adb, s-osprim-vms.ads,
! 	s-osprim-mingw.adb, s-intman-vxworks.ads, s-intman-vxworks.adb,
! 	s-intman-vms.adb, s-intman-mingw.adb, s-intman-vms.ads,
! 	s-osprim-unix.adb, s-osprim-os2.adb, s-osprim-solaris.adb,
! 	s-intman-solaris.adb, s-intman-irix-athread.adb,
! 	s-intman-irix.adb: Mark this unit Preelaborate.
! 	(Initialize): New procedure.
! 	Update comments.
! 
! 	* s-taspri-linux.ads: Removed.
! 
! 	* s-tpopsp-solaris.adb (Initialize): Create the key in this procedure,
! 	as done by other implementations (e.g. posix).
! 
! 	* s-taprop.ads (Timed_Delay): Update spec since the caller now is
! 	responsible for deferring abort.
! 	Mark this unit Preelaborate.
! 
! 	* s-taprob.adb, s-tarest.adb: Call System.Tasking.Initialize to ensure
! 	proper initialization of the tasking run-time.
! 
! 	* s-tasdeb.ads: Mark this unit Preelaborate.
! 	(Known_Tasks): Add explicit default value to avoid elaboration code.
! 
! 	* s-inmaop-vms.adb (Elaboration code): Add call to
! 	Interrupt_Management.Initialize since the elaboration code depends on
! 	proper initialization of this package.
! 
! 	* s-intman.ads, s-inmaop-posix.adb, s-intman-posix.adb,
! 	s-osprim.ads, s-taprop-posix.adb, s-taspri-posix.ads,
! 	s-osprim-posix.adb: Make this unit Preelaborate.
! 
! 	* a-calend.adb: Add call to OS_Primitives.Initialize
! 
! 	* a-elchha.adb: Update use of Except.Id.Full_Name.
! 	Minor reformatting.
! 	Remove use of Ada.Exceptions.Traceback when possible, cleaner.
! 
! 	* a-dynpri.adb, a-sytaco.adb, a-sytaco.ads:
! 	Move with clauses outside Warnings Off now that dependent units are
! 	Preelaborate.
! 	Use raise xxx with "..."; Ada 2005 form.
! 
! 	* a-taside.ads, a-taside.adb:
! 	Remove some dependencies, to make it easier to make this unit truly
! 	Preelaborate.
! 	Rewrite some code to be conformant with Preelaborate rules.
! 
! 	* g-os_lib.adb: Remove non-preelaborate code so that this unit can be
! 	marked Preelaborate in the future.
! 
! 	* s-proinf.ads, g-string.ads, s-auxdec.ads, s-auxdec-vms_64.ads: Make
! 	these units Preelaborate.
! 
! 	* s-exctab.adb: Update use of Except.Id.Full_Name.
! 
! 	* s-soflin.ads, s-soflin.adb: Mark this unit Preelaborate_05.
! 	(Set_Exc_Stack_Addr_Soft, Get_Exc_Stack_Addr_NT, Set_Exc_Stack_Addr_NT,
! 	Set_Exc_Stack_Addr): Removed, no longer used.
! 	Remove reference to *Machine_State_Addr*, no longer needed.
! 
! 	* s-stalib.ads: Mark this unit as Preelaborate[_05].
! 	(Exception_Data): Full_Name is now a System.Address so that this unit
! 	can be made Preelaborate.
! 	Clean up/simplify code thanks to Full_Name being a System.Address.
! 	Remove obsolete pragma Suppress (All_Checks), no longer needed.
! 
! 	* s-taskin.ads, s-taskin.adb:
! 	Move with clauses outside Warnings Off now that dependent units are
! 	Preelaborate.
! 	Make this unit Preelaborate.
! 	(Initialize): New proceduure, replace elaboration code and makes the
! 	set up of the tasking run-time cleaner.
! 	(Detect_Blocking): Now a function instead of a deferred boolean, to
! 	obey Preelaborate rules.
! 
! 	* s-tassta.adb (Finalize_Global_Tasks): Remove Get/Set_Exc_Stack_Addr
! 	soft links, no longer used.
! 
! 	* s-traces.ads, s-traent.ads: Add pragma Preelaborate, since these
! 	packages are suitable for this categorization.
! 
! 	* s-solita.adb: Replace use of Ada.Exception by raise xxx with "..."
! 	since we compile run-time sources in Ada 2005 mode.
! 	(Timed_Delay_T): Call Abort_Defer/Undefer around Timed_Delay, to
! 	avoid having s-taprop*.adb depend on s-soflin and to avoid code
! 	duplication.
! 	Remove reference to *Machine_State_Addr*, no longer needed.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-mastop-tru64.adb, s-mastop-irix.adb, s-mastop-vms.adb
! 	(Enter_Handler, Set_Signal_Machine_State): Removed, no longer used.
! 	Remove reference to System.Exceptions.
! 
! 	* s-mastop-x86.adb: Removed, no longer used.
! 
! 	* s-traceb-mastop.adb: Adjust calls to Pop_Frame.
! 
! 	* a-excach.adb: Minor reformatting.
! 
! 	* a-except.ads, a-except.adb: Remove global Warnings (Off) pragma, and
! 	instead fix new warnings that were hidden by this change.
! 	(AAA, ZZZ): Removed, replaced by...
! 	(Code_Address_For_AAA, Code_Address_For_ZZZ): ... these functions, who
! 	are used instead of constants, to help make Ada.Exception truly
! 	preelaborate.
! 	(Rcheck_*, Raise_Constraint_Error, Raise_Program_Error,
! 	Raise_Storage_Error): File is now a System.Address, to simplify code.
! 	(Elab code): Removed, no longer used.
! 	(Null_Occurrence): Remove Warnings Off and make this construct
! 	preelaborate.
! 	Remove code related to front-end zero cost exception handling, since
! 	it is no longer used.
! 	Remove -gnatL/-gnatZ switches.
! 
! 	* a-exexda.adb (Append_Info_Exception_Name, Set_Exception_C_Msg):
! 	Update use of Except.Msg.
! 
! 	* gnat1drv.adb, inline.adb, bindgen.adb, debug.adb, exp_ch11.ads,
! 	freeze.adb, frontend.adb, lib.adb, exp_ch11.adb: Remove code related
! 	to front-end zero cost exception handling, since it is no longer used.
! 	Remove -gnatL/-gnatZ switches.
! 
! 	* lib-writ.ads: Minor reformatting
! 	Remove doc of UX
! 
! 	* Makefile.rtl: Remove references to s-except*, s-mastop-x86*
! 
! 	* Make-lang.in: Remove references to s-except.ads
! 
! 	* s-except.ads: Removed, no longer used.
! 
! 	* s-mastop.ads, s-mastop.adb:
! 	(Enter_Handler, Set_Signal_Machine_State): Removed, no longer used.
! 	Remove reference to System.Exceptions.
! 
! 	* raise.h, usage.adb, targparm.adb, targparm.ads, switch-m.adb,
! 	switch-b.adb: Remove code related to front-end zero cost exception
! 	handling, since it is no longer used.
! 	Remove -gnatL/-gnatZ switches.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* exp_ch4.adb (Expand_N_In): Replace test of expression in its own
! 	type by valid test and generate warning.
! 	(Tagged_Membership): Generate call to the run-time
! 	subprogram IW_Membership in case of "Iface_CW_Typ in Typ'Class"
! 	Change formal name Subtype_Mark to Result_Definition in several calls to
! 	Make_Function_Specification.
! 	(Expand_Allocator_Expression): Add tests for suppression of the AI-344
! 	check for proper accessibility of the operand of a class-wide allocator.
! 	The check can be left out if checks are suppressed or if the expression
! 	has a specific tagged type whose level is known to be safe.
! 
! 	* exp_ch5.adb (Expand_N_Assignment_Statement): Simplify the code that
! 	generates the run-time check associated with null-excluding entities.
! 	(Expand_N_Return_Statement): Add tests to determine if the accessibility
! 	check on the level of the return expression of a class-wide function
! 	can be elided. The check usually isn't needed if the expression has a
! 	specific type (unless it's a conversion or a formal parameter). Also
! 	add a test for whether accessibility checks are suppressed. Augment
! 	the comments to describe the conditions for performing the check.
! 
! 2005-09-01  Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* a-tags.adb (IW_Membership): Give support to
! 	"Iface_CW_Typ in T'Class". For this purpose the functionality of this
! 	subprogram has been extended to look for the tag in the ancestors tag
! 	table.
! 	Update the structure of the GNAT Dispatch Table to reflect the
! 	additional two tables used in dispatching selects.
! 	Introduce appropriate array types and record components in
! 	Type_Specific_Data to reflect the two tables.
! 	(Get_Entry_Index, Set_Entry_Index): Retrieve and set the entry index in
! 	the TSD of a tag, indexed by position.
! 	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Retrieve and set the primitive
! 	operation kind in the TSD of a tag, indexed by position.
! 
! 	* a-tags.ads: Introduce an enumeration type to capture different
! 	primitive operation kinds. Define a constant reflecting the number of
! 	predefined primitive operations.
! 	(Get_Entry_Index, Set_Entry_Index): Set and retrieve the entry index
! 	of an entry wrapper.
! 	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Set and retrieve the kind of
! 	callable entity of a primitive operation.
! 
! 	* exp_ch3.adb (Freeze_Record_Type): Generate the declarations of the
! 	primitive operations used in dispatching selects for limited
! 	interfaces, limited tagged, task and protected types what implement a
! 	limited interface.
! 	(Freeze_Type): Generate the bodies of the primitive operations used in
! 	dispatching selects for limited tagged, task and protected types that
! 	implement a limited interface. Generate statements to populate the two
! 	auxiliary tables used for dispatching in select statements.
! 	(Freeze_Record_Type): Add call to initialize the dispatch table entries
! 	associated with predefined interface primitive operations.
! 	(Build_Dcheck_Function): Change Set_Subtype_Mark to
! 	Set_Result_Definition.
! 	(Build_Variant_Record_Equality): Change Subtype_Mark to
! 	Result_Definition.
! 	(Freeze_Enumeration_Type): Change Subtype_Mark to Result_Definition.
! 	(Predef_Spec_Or_Body): Change Subtype_Mark to Result_Definition.
! 	(Build_Assignment): Simplify the code that adds the run-time-check.
! 	(Expand_N_Object_Declaration): Code cleanup.
! 
! 	* exp_ch7.adb (Make_Clean): Select the appropriate type for locking
! 	entries when there is a protected type that implements a limited
! 	interface.
! 
! 	* exp_ch9.adb: Add package Select_Expansion_Utilities that contains
! 	common routines used in expansion of dispatching selects.
! 	(Add_Private_Declarations): Select the appropriate protection type when
! 	there is a protected type that implements a limited interface.
! 	(Build_Parameter_Block): Generate a wrapped parameter block.
! 	(Build_Protected_Subprogram_Body): Select the appropriate type for
! 	locking entries when there is a protected type that implements a
! 	limited interface.
! 	(Build_Wrapper_Spec): Set the flag and wrapped entity for procedures
! 	classified as entry wrappers.
! 	(Expand_N_Asynchronous_Select): Add support for expansion of dispatching
! 	asynchronous selects.
! 	(Expand_N_Conditional_Entry_Call): Add support for expansion of
! 	dispatching conditional selects.
! 	(Expand_N_Protected_Type_Declaration): Select the appropriate type for
! 	protection when there is a protected type that implements limited
! 	interfaces.
! 	(Expand_N_Timed_Entry_Call): Add support for expansion of dispatching
! 	timed selects.
! 	(Extract_Dispatching_Call): Extract the entity of the name of a
! 	dispatching call, the object parameter, actual parameters and
! 	corresponding formals.
! 	(Make_Initialize_Protection): Correct logic of protection initialization
! 	when there is a protected type that implements a limited interface.
! 	(Parameter_Block_Pack): Populate a wrapped parameter block with the
! 	values of actual parameters.
! 	(Parameter_Block_Unpack): Retrieve the values from a wrapped parameter
! 	block and assign them to the original actual parameters.
! 
! 	* exp_ch9.ads (Subprogram_Protection_Mode): New type.
! 	(Build_Protected_Sub_Specification): Change the type and name of the
! 	last formal to account for the increased variety of protection modes.
! 
! 	* einfo.ads, einfo.adb (Was_Hidden): New attribute. Present in all
! 	entities. Used to save the value of the Is_Hidden attribute when the
! 	limited-view is installed.
! 	(Is_Primitive_Wrapper, Set_Is_Primitive_Wrapper): Retrieve and change
! 	the attribute of procedures classified as entry wrappers.
! 	(Wrapped_Entity, Set_Wrapped_Entity): Retrieve and change the wrapped
! 	entity of a primitive wrapper.
! 	(Write_Entity_Flags): Output the name and value of the
! 	Is_Primitive_Wrapper attribute.
! 	(Write_Field27_Name): Output the name and entity of the field Wrapped_
! 	Entity.
! 	(Underlying_Type): If we have an incomplete entity that comes from
! 	the limited view then we return the Underlying_Type of its non-limited
! 	view if it is already available.
! 	(Abstract_Interface_Alias): Flag applies to all subrogram kinds,
! 	including operators.
! 	(Write_Field26_Name): Add entry for Overridden_Operation
! 	(Overridden_Operation): New attribute of functions and procedures.
! 
! 	* exp_disp.ads, exp_disp.adb (Default_Prim_Op_Position): Return a
! 	predefined position in the dispatch table for the primitive operations
! 	used in dispatching selects.
! 	(Init_Predefined_Interface_Primitives): Remove the hardcoded number of
! 	predefined primitive operations and replace it with
! 	Default_Prim_Op_Count.
! 	(Make_Disp_Asynchronous_Select_Spec, Make_Disp_Conditional_Select_Spec,
! 	Make_Disp_Get_Prim_Op_Kind_Spec, Make_Disp_Timed_Select_Spec): Update
! 	the names of the generated primitive operations used in dispatching
! 	selects.
! 	(Init_Predefined_Interface_Primitives): No need to inherit primitives in
! 	case of abstract interface types. They will be inherit by the objects
! 	implementing the interface.
! 	(Make_DT): There is no need to inherit the dispatch table of the
! 	ancestor interface for the elaboration of abstract interface types.
! 	The dispatch table will be inherited by the object implementing the
! 	interface.
! 	(Copy_Secondary_DTs): Add documentation.
! 	(Validate_Position): Improve this static check in case of
! 	aliased subprograms because aliased subprograms must have
! 	the same position.
! 	(Init_Predefined_Interface_Primitives): New subprogram that initializes
! 	the entries associated with predefined primitives of all the secondary
! 	dispatch tables.
! 	(Build_Anonymous_Access_Type): Removed.
! 	(Expand_Interface_Actuals): With the previous cleanup there is no need
! 	to build an anonymous access type. This allows further cleanup in the
! 	code generated by the expander.
! 	(Expand_Interface_Conversion): If the actual is an access type then
! 	build an internal function to handle the displacement. If the actual
! 	is null this function returns null because no displacement is
! 	required; otherwise performs a type conversion that will be
! 	expanded in the code that returns the value of the displaced actual.
! 	(Expand_Interface_Actuals): Avoid the generation of unnecessary type
! 	conversions that have no effect in the generated code because no
! 	displacement is required. Code cleanup; use local variables to
! 	avoid repeated calls to the subprogram directly_designated_type().
! 
! 	* exp_util.ads, exp_util.adb (Is_Predefined_Dispatching_Operation):
! 	Classify the primitive operations used in dispatching selects as
! 	predefined.
! 	(Implements_Limited_Interface): Determine whether some type either
! 	directly implements a limited interface or extends a type that
! 	implements a limited interface.
! 	(Build_Task_Image_Function): Change Subtype_Mark to Result_Definition.
! 	(Expand_Subtype_From_Expr): Do not build actual subtype if the
! 	expression is limited.
! 	(Find_Interface_Tag): Add code to handle class-wide types and
! 	entities from the limited-view.
! 
! 	* rtsfind.ads: Add entries in RE_Id and RE_Unit_Table for
! 	Get_Entry_Index, Get_Prim_Op_Kind, POK_Function, POK_Procedure,
! 	POK_Protected_Entry, POK_Protected_Function, POK_Protected_Procedure,
! 	POK_Task_Entry, POK_Task_Procedure, Prim_Op_Kind, Set_Entry_Index,
! 	Set_Prim_Op_Kind.
! 
! 	* sem_ch9.adb (Analyze_Triggering_Alternative): Check for legal type
! 	of procedure name or prefix that appears as a trigger in a triggering
! 	alternative.
! 
! 	* uintp.ads: Introduce constants Uint_11 and Uint_13.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-tataat.adb, a-tasatt.adb:
! 	Replace calls to Defer/Undefer_Abortion by Defer/Undefer_Abort.
! 
! 	* s-tasini.ads, s-tasini.adb (Defer_Abortion, Undefer_Abortion): Moved
! 	these procedures to body, and renamed Abort_Defer, Abort_Undefer.
! 	(Get_Exc_Stack_Addr, Set_Exc_Stack_Addr): Removed, no
! 	longer used.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 	    Jose Ruiz  <ruiz@adacore.com>
! 
! 	* s-taprop-vxworks.adb:
! 	Move with clauses outside Warnings Off now that dependent units are
! 	Preelaborate.
! 	(Initialize): Call Interrupt_Managemeent.Initialize to ensure proper
! 	initialization of this unit.
! 	(Specific): Add new procedures Initialize and Delete so that this
! 	package can be used for VxWorks 5.x and 6.x
! 	(ATCB_Key, ATCB_Key_Address): Moved to Specific package body to hide
! 	differences between VxWorks 5.x and 6.x
! 	Minor reformatting.
! 	(Timed_Delay): Remove calls to Defer/Undefer_Abort, now performed by
! 	caller.
! 	Use only Preelaborate-compatible constructs.
! 
! 	* s-tpopsp-vxworks.adb (ATBC_Key, ATCB_Key_Addr): Moved from
! 	Primitives.Operations.
! 	(Delete, Initialize): New procedures.
! 
! 	* s-osinte-vxworks.adb: Body used to handle differences between
! 	VxWorks 5.x and 6.x
! 	(kill, Set_Time_Slice, VX_FP_TASK): New functions.
! 
! 	* s-osinte-vxworks.ads: Minor reformatting.
! 	Add VxWworks 6.x specific functions (only called from VxWorks 6 files).
! 	(VX_FP_TASK): Now a function, to handle differences between VxWorks 5
! 	and 6.
! 	(Set_Time_Slice): New function, replacing kerneltimeSlice to share code
! 	between Vxworks 5 and 6.
! 	(taskLock, taskUnlock): Removeed, no longer used.
! 
! 	* adaint.c: The wait.h header is not located in the sys directory on
! 	VxWorks when using RTPs.
! 	(__gnat_set_env_value): Use setenv instead of putenv on VxWorks when
! 	using RTPs.
! 	(__gnat_dup): dup is available on Vxworks when using RTPs.
! 	(__gnat_dup2): dup2 is available on Vxworks when using RTPs.
! 
! 	* cal.c: Use the header time.h for Vxworks 6.0 when using RTPs.
! 
! 	* expect.c: The wait.h header is not located in the sys directory on
! 	VxWorks when using RTPs.
! 
! 2005-09-01  Thomas Quinot  <quinot@adacore.com>
! 
! 	* g-soccon-vms.adb: Renamed to g-soccon-vms.ads
! 
! 	* g-soccon-vms.ads: Renamed from g-soccon-vms.adb
! 
! 	* g-soccon.ads, g-soccon-tru64.ads, g-soccon-aix.ads,
! 	g-soccon-darwin.ads, g-soccon-irix.ads, g-soccon-hpux.ads,
! 	g-soccon-solaris.ads, g-soccon-mingw.ads, g-soccon-vxworks.ads,
! 	g-soccon-freebsd.ads: Add new constants:
! 	 IP_MULTICAST_IF
! 	 SO_RCVTIMEO/SO_SNDTIMEO
! 	 IOV_MAX
! 
! 	* gen-soccon.c:
! 	Move all target-specific file inclusions and macro definitions to
! 	gsocket.h, in order to ensure that any C code in socket.c will see a
! 	set of constants that is consistent with the contents of g-soccon.ads.
! 
! 	* gsocket.h: Code imported from gen-soccon.c:
! 	Move all target-specific file inclusions and macro definitions to
! 	gsocket.h, in order to ensure that any C code in socket.c will see a set
! 	of constants that is consistent with the contents of g-soccon.ads.
! 	This change also makes gen-soccon self-contained (removing dependencies
! 	upon GCC internal headers).
! 
! 	* g-socket.adb (Send_Vector): Make calls to Writev at most IOV_MAX
! 	iovecs at a time.
! 	(To_Inet_Addr): Now a procedure instead of a function, more efficient.
! 
! 	* socket.c: Minor reformatting.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
! 	* fname-sf.adb, mlib-tgt.ads,
! 	back_end.adb, casing.adb, g-debpoo.adb, g-excact.adb, g-spipat.adb,
! 	g-spipat.ads, g-thread.adb, lib-list.adb, makeutl.adb, mlib.adb,
! 	osint.adb, par-ch10.adb, par-load.adb, prep.adb, prj.adb, prj-attr.ads,
! 	prj-env.ads, prj-err.adb, prj-err.ads, prj-ext.adb, prj-ext.ads,
! 	prj-makr.adb, prj-makr.ads, prj-pars.ads, prj-part.adb, prj-strt.adb,
! 	prj-tree.ads, prj-util.ads, sem_dist.adb, sinput-c.ads, sinput-l.ads,
! 	sinput-p.ads, styleg-c.ads, xr_tabls.adb, prj-attr-pm.ads,
! 	makegpr.adb: Remove redundant use_clauses.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-stoele.ads, s-stopoo.ads, s-stratt.ads, s-strops.ads, s-unstyp.ads,
! 	s-valboo.ads, s-valcha.ads, s-valdec.ads, s-valenu.ads, s-valint.ads,
! 	s-vallld.ads, s-vallli.ads, s-valllu.ads, s-valrea.ads, s-valuns.ads,
! 	s-valuti.ads, s-valwch.ads, s-veboop.ads, s-vector.ads, s-vercon.ads,
! 	s-wchcnv.ads, s-wchcon.ads, s-wchjis.ads, s-wchstw.ads, s-wchwts.ads,
! 	s-widboo.ads, s-widcha.ads, s-widenu.ads, s-widlli.ads, s-widllu.ads,
! 	s-widwch.ads, s-wwdcha.ads, s-wwdenu.ads, s-wwdwch.ads, system.ads,
! 	table.ads, types.ads, system-vms_64.ads, s-crtl-vms64.ads,
! 	s-addope.ads, system-darwin-ppc.ads, system-vxworks-x86.ads,
! 	s-vxwork-x86.ads, system-linux-ppc.ads, i-vxwork-x86.ads,
! 	a-numaux-darwin.ads, a-crbtgo.ads, a-crbtgk.ads, a-crbltr.ads,
! 	a-coprnu.ads, a-convec.ads, a-contai.ads, a-coinve.ads, a-cohata.ads,
! 	a-cohama.ads, a-cihama.ads, a-cidlli.ads, a-cdlili.ads,
! 	a-numaux-libc-x86.ads, a-numaux-vxworks.ads, system-linux-ia64.ads,
! 	system-freebsd-x86.ads, system-unixware.ads, system-lynxos-ppc.ads,
! 	system-lynxos-x86.ads, system-linux-x86_64.ads, system-tru64.ads,
! 	s-vxwork-alpha.ads, system-aix.ads, system-vxworks-sparcv9.ads,
! 	system-solaris-x86.ads, system-irix-o32.ads, system-irix-n32.ads,
! 	s-parame-hpux.ads, system-hpux.ads, system-vxworks-m68k.ads,
! 	s-vxwork-m68k.ads, system-linux-x86.ads, system-vxworks-mips.ads,
! 	s-vxwork-mips.ads, system-os2.ads, system-interix.ads,
! 	s-vxwork-ppc.ads, system-solaris-sparc.ads, s-vxwork-sparcv9.ads,
! 	system-solaris-sparcv9.ads, s-parame-vms.ads, system-vms.ads,
! 	s-osinte-mingw.ads, system-mingw.ads, s-parame-vms-restrict.ads,
! 	system-vms-zcx.ads, s-parame-ae653.ads, system-vxworks-ppc.ads,
! 	s-parame-vxworks.ads, system-vxworks-alpha.ads, interfac-vms.ads,
! 	a-numaux-x86.ads, a-astaco.ads, a-chahan.ads, a-charac.ads,
! 	a-chlat1.ads, a-chlat9.ads, a-colire.adb, a-colire.ads, a-comlin.ads,
! 	a-cwila1.ads, a-cwila9.ads, ada.ads, a-decima.ads, a-exextr.adb,
! 	a-filico.ads, a-finali.ads, a-interr.ads, a-ioexce.ads, a-dynpri.ads,
! 	a-ngcefu.ads, a-ngcefu.adb, a-ngcoty.adb, a-ngcoty.ads, a-ngelfu.ads,
! 	a-nudira.adb, a-nudira.ads, a-nuflra.adb, a-numaux.ads, a-numeri.ads,
! 	a-reatim.adb, a-stmaco.ads, a-storio.ads, a-strbou.ads, a-stream.ads,
! 	a-strfix.ads, a-string.ads, a-strmap.ads, a-strsea.ads, a-strsup.ads,
! 	a-strunb.ads, a-stunau.ads, a-stwibo.ads, a-stwifi.ads, a-stwima.ads,
! 	a-stwise.ads, a-stwisu.ads, a-stwiun.ads, a-swmwco.ads, a-textio.ads,
! 	csets.ads, debug.ads, dec.ads, g-curexc.ads, get_targ.ads,
! 	g-except.ads, system-linux-hppa.ads, a-chacon.ads, a-widcha.ads,
! 	a-zchara.ads, system-hpux-ia64.ads, a-ciorma.ads, a-coorma.ads,
! 	a-ciormu.ads, a-coormu.ads, a-rbtgso.ads, a-chzla1.ads, a-chzla9.ads,
! 	a-stzbou.ads, a-stzfix.ads, a-stzmap.ads, a-stzsea.ads, a-stzsup.ads,
! 	a-stzunb.ads, a-swunau.ads, a-szunau.ads, gnat.ads, g-regpat.ads,
! 	g-speche.ads, g-spitbo.ads, g-table.ads, g-tasloc.ads, g-trasym.ads,
! 	i-c.ads, i-cpoint.ads, i-cpp.ads, i-cstrin.ads, i-fortra.ads,
! 	interfac.ads, i-os2err.ads, i-os2lib.ads, i-os2syn.ads, i-os2thr.ads,
! 	i-vxwork.ads, output.ads, s-arit64.ads, s-atacco.ads, s-boarop.ads,
! 	s-casuti.ads, s-crtl.ads, s-exctab.ads, s-exnint.ads, s-exnllf.ads,
! 	s-exnlli.ads, s-expint.ads, s-explli.ads, s-expllu.ads, s-expmod.ads,
! 	s-expuns.ads, s-fatflt.ads, s-fatgen.ads, s-fatlfl.ads, s-fatllf.ads,
! 	s-fatsfl.ads, s-finimp.ads, s-finroo.ads, s-fore.ads, s-geveop.ads,
! 	s-htable.ads, s-imgbiu.ads, s-imgboo.ads, s-imgcha.ads, s-imgdec.ads,
! 	s-imgenu.ads, s-imgint.ads, s-imgllb.ads, s-imglld.ads, s-imglli.ads,
! 	s-imgllu.ads, s-imgllw.ads, s-imgrea.ads, s-imguns.ads, s-imgwch.ads,
! 	s-imgwiu.ads, s-io.ads, s-maccod.ads, s-mantis.ads, s-memcop.ads,
! 	s-pack03.ads, s-pack05.ads, s-pack06.ads, s-pack07.ads, s-pack09.ads,
! 	s-pack10.ads, s-pack11.ads, s-pack12.ads, s-pack13.ads, s-pack14.ads,
! 	s-pack15.ads, s-pack17.ads, s-pack18.ads, s-pack19.ads, s-pack20.ads,
! 	s-pack21.ads, s-pack22.ads, s-pack23.ads, s-pack24.ads, s-pack25.ads,
! 	s-pack26.ads, s-pack27.ads, s-pack28.ads, s-pack29.ads, s-pack30.ads,
! 	s-pack31.ads, s-pack33.ads, s-pack34.ads, s-pack35.ads, s-pack36.ads,
! 	s-pack37.ads, s-pack38.ads, s-pack39.ads, s-pack40.ads, s-pack41.ads,
! 	s-pack42.ads, s-pack43.ads, s-pack44.ads, s-pack45.ads, s-pack46.ads,
! 	s-pack47.ads, s-pack48.ads, s-pack49.ads, s-pack50.ads, s-pack51.ads,
! 	s-pack52.ads, s-pack53.ads, s-pack54.ads, s-pack55.ads, s-pack56.ads,
! 	s-pack57.ads, s-pack58.ads, s-pack59.ads, s-pack60.ads, s-pack61.ads,
! 	s-pack62.ads, s-pack63.ads, s-parame.ads, s-pooglo.ads, s-pooloc.ads,
! 	s-poosiz.ads, s-powtab.ads, s-purexc.ads, s-sopco3.ads, s-sopco4.ads,
! 	s-sopco5.ads: Minor reformatting: reindent pragma Pure/Preelaborate
! 	and always use the no parameter form for consistency.
! 
! 	* gnat-style.texi: Document rules about Preelaborate/Pure pragmas.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* binde.adb: Minor reformatting
! 	(Find_Elab_Order): Output warning if -p used with static elab order
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* checks.adb (Check_Needed): New procedure, deals with removing checks
! 	based on analysis of short-circuited forms. Also generates warnings for
! 	improper use of non-short-circuited forms.
! 	Code clean ups.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-ztexio.adb, a-textio.adb, a-witeio.adb: Replace bad range checks
! 	with 'Valid tests.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* errout.ads, errout.adb (Fix Error_Msg_F): Fix implementation to meet
! 	spec.
! 	Implement new insertion char < (conditional warning)
! 	* errutil.adb, erroutc.adb: Implement new insertion char <
! 	(conditional warning).
! 	* sem_elab.adb, prj-dect.adb, erroutc.ads, err_vars.ads
! 	(Error_Msg_Warn): New variable for < insertion char.
! 	* prj-nmsc.adb: Implement new errout insertion char < (conditional
! 	warning).
! 	(Check_For_Source): Change value of Source_Id only after the current
! 	source has been dealt with.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 	    Doug Rupp  <rupp@adacore.com>
! 
! 	* exp_attr.adb: Handle vax fpt for 'Valid attribute
! 	* exp_vfpt.ads, exp_vfpt.adb: (Expand_Vax_Valid): New procedure
! 	* s-vaflop-vms-alpha.adb, s-vaflop.ads, s-vaflop.adb
! 	(Valid_D, Valid_F, Valid_G): New functions
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* exp_ch6.adb (Expand_Call): If an actual is a function call rewritten
! 	from object notation, the original node is unanalyzed and carries no
! 	semantic information, so that accessiblity checks must be performed on
! 	the type of the actual itself.
! 	(Expand_N_Subprogram_Declaration): Change last actual parameter for
! 	compatibility with Build_Protected_Sub_Specification.
! 	(Check_Overriding_Inherited_Interfaces): Add suport to handle
! 	overloaded primitives.
! 	(Register_Interface_DT_Entry): Use the new name of the formal
! 	the the calls to Expand_Interface_Thunk
! 
! 	* exp_dbug.ads: Augment comments on encoding of protected types to
! 	include the generation of dispatching subprograms when the type
! 	implements at least one interface.
! 
! 	* lib.ads: Extend information in Load_Stack to include whether a given
! 	load comes from a Limited_With_Clause.
! 
! 	* lib-load.adb (From_Limited_With_Chain): New predicate to determine
! 	whether a potential circularity is harmless, because it includes units
! 	loaded through a limited_with clause. Extends previous treatment which
! 	did not handle properly arbitrary combinations of limited and
! 	non-limited clauses.
! 
! 2005-09-01  Nicolas Setton  <setton@adacore.com>
! 
! 	* exp_dbug.adb (Get_Encoded_Name): Fixed bug that caused biaised types
! 	to be encoded as typ___XBLU_lowerbound__upperbound instead of
! 	typ___XB_lowerbound__upperbound.
! 
! 2005-09-01  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Add_RACW_TypeCode, Add_RAS_TypeCode): Do not generate
! 	dummy access formal for RACW/RAS TypeCode TSS.
! 	(Build_TypeCode_Call): Do not generate dummy null access actual for
! 	calls to the TypeCode TSS.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_intr.adb (Expand_Source_Name): For Enclosing_Entity, generate
! 	fully qualified name, to distinguish instances with the same local name.
! 
! 	* g-souinf.ads (Enclosing_Entity): Document that entity name is now
! 	fully qualified.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_pakd.adb (Create_Packed_Array_Type): Properly handle very large
! 	packed arrays.
! 
! 2005-09-01  Jerome Lambourg  <lambourg@adacore.com>
! 
! 	* g-expect.adb (Non_Blocking_Spawn): Initialize the filters field to
! 	(Free): New deallocation procedure for filter elements
! 	(Close): Deallocate any existing filter for the concerned connection
! 
! 2005-09-01  Laurent Pautet  <pautet@adacore.com>
! 
! 	* g-pehage.ads, g-pehage.adb (Select_Char_Position): When no character
! 	position set is provided, we compute one in order to reduce the maximum
! 	length of the keys.  This computation first selects a character
! 	position between 1 and the minimum length of the keys in order to
! 	avoid reducing one of the keys to an empty string.
! 	(Initialize, Compute): When the ratio V to K is too low, the algorithm
! 	does not converge. The initialization procedure now comes with a
! 	maximum number of iterations such that when exceeded, an exception is
! 	raised in Compute. The user can initialize this ratio to another value
! 	and try again
! 	Reformating and updated headers.
! 
! 2005-09-01  Javier Miranda  <miranda@adacore.com>
! 
! 	* itypes.ads, itypes.adb (Create_Null_Excluding_Itype): New subprogram
! 	that given an entity T creates and returns an Itype that duplicates the
! 	contents of T. The returned Itype has the null-exclusion
! 	attribute set to True, and its Etype attribute references T
! 	to keep the association between the two entities.
! 	Update copyright notice
! 
! 	* sem_aggr.adb (Check_Can_Never_Be_Null,
! 	Aggregate_Constraint_Checks, Resolve_Aggregate,
! 	Resolve_Array_Aggregate, Resolve_Record_Aggregate): Code cleanup.
! 
! 	* sem_ch5.adb (Analyze_Assignment): Code cleanup.
! 
! 2005-09-01  Gary Dismukes  <dismukes@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 
! 	* layout.adb (SO_Ref_From_Expr): Change Subtype_Mark to
! 	Result_Definition.
! 
! 	* par-ch6.adb (P_Subprogram): Handle parsing of Access_Definitions in
! 	function specs.
! 	Call Set_Result_Definition instead of Set_Subtype_Mark.
! 	(P_Subprogram_Specification): Add parsing of anonymous access result
! 	plus null exclusions. Call Set_Result_Definition instead of
! 	Set_Subtype_Mark.
! 
! 	* par-ch3.adb: Add support for LIMITED NEW for Ada 2005 AI-419
! 	(P_Access_Type_Definition): Add parsing for an anonymous access result
! 	subtype, plus parsing for null exclusions. Call Set_Result_Definition
! 	instead of Set_Subtype_Mark.
! 
! 	* sinfo.adb: Add support for LIMITED NEW for Ada 2005 AI-419
! 	(Null_Exclusion_Present): Allow this flag for N_Function_Specification.
! 	(Result_Definition): New function for N_Function_Specifications.
! 	(Subtype_Mark): No longer allowed for N_Access_Function_Definition and
! 	N_Function_Specification.
! 	(Set_Null_Exclusion_Present): Allow this flag for
! 	N_Function_Specification.
! 	(Set_Result_Definition): New procedure for N_Function_Specifications.
! 	(Set_Subtype_Mark): No longer allowed for N_Access_Function_Definition
! 	and N_Function_Specification.
! 
! 	* sinfo.ads: Update grammar rules for 9.7.2: Entry_Call_Alternative,
! 	Procedure_Or_Entry_Call; 9.7.4: Triggering_Statement.
! 	Add support for LIMITED NEW for Ada 2005 AI-419
! 	Update the syntax of PARAMETER_AND_RESULT_PROFILE to reflect the new
! 	syntax for anonymous access results.
! 	Replace Subtype_Mark field by Result_Definition in
! 	N_Function_Specification and N_Access_Definition specs.
! 	Add Null_Exclusion_Present to spec of N_Function_Specification.
! 	(Result_Definition): New function for N_Function_Specification and
! 	N_Access_Function_Definition.
! 	(Set_Result_Definition): New procedure for N_Function_Specification and
! 	N_Access_Function_Definition.
! 
! 	* sprint.adb (S_Print_Node_Actual): Change Subtype_Mark calls to
! 	Result_Definition for cases of N_Access_Function_Definition and
! 	N_Function_Specification.
! 	Print "not null" if Null_Exclusion_Present on N_Function_Specification.
! 
! 2005-09-01  Vincent Celier  <celier@adacore.com>
! 
! 	* lib-writ.adb: Update Copyright notice
! 	(Write_With_Lines): On platforms where file names are case-insensitive,
! 	record the file names in lower case.
! 	(Write_ALI): For D lines, on platforms where file names are
! 	case-insensitive, record the file names in lower case.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Emmanuel Briot  <briot@adacore.com>
! 
! 	* lib-xref.adb (Output_Overridden_Op): Display information on
! 	overridden operation.
! 
! 	* lib-xref.ads: Add documentation on overridden operations.
! 
! 	* ali.ads (Xref_Entity_Record): Add support for storing the overriding
! 	information.
! 
! 	* ali.adb (Get_Typeref): New subprogram. Adds support for parsing the
! 	overriding entity information.
! 
! 2005-09-01  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-prj.adb (Copy_Interface_Sources): Copy all interface sources,
! 	including those that are inherited.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* opt.ads, opt.adb: Add new switches Debug_Pragmas_Enabled[_Config]
! 
! 	* par-prag.adb: Implement new pragma Debug_Policy
! 
! 	* sem_prag.adb Implement new pragma Debug_Policy
! 	(Analyze_Pragma, case Pack): do not let pragma Pack override an explicit
! 	Component_Size attribute specification. Give warning for ignored pragma
! 	Pack.
! 
! 	* snames.h, snames.ads, snames.adb: Introduce entries in
! 	Preset_Names for Name_Disp_Asynchronous_Select,
! 	Name_Disp_Conditional_Select, Name_Disp_Get_Prim_Op_Kind,
! 	Name_Disp_Timed_Select.
! 	New pragma Debug_Policy
! 
! 	* switch-c.adb (Scan_Front_End_Switches): Set Ada 2005 mode
! 	explicitly.
! 	Switch -gnata also sets Debug_Pragmas_Enabled
! 
! 	* sem.adb, par.adb (Set_Opt_Config_Switch): Add parameter Main_Unit to
! 	handle an explicit -gnata when compiling predefined files.
! 
! 2005-09-01  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-env.adb (Set_Ada_Paths.Add.Recursive_Add): Do not add the object
! 	directories of projects that have no Ada sources.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* scng.adb (Check_End_Of_Line): Count characters, rather than bytes
! 	(makes a difference for wide characters)
! 
! 	* widechar.adb, widechar.ads:
! 	Add Wide_Char_Byte_Count feature to count chars vs bytes
! 
! 2005-09-01  Thomas Quinot  <quinot@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_attr.adb (Resolve_Attribute, case 'Address): For an illegal
! 	'Address attribute reference with an overloaded prefix, use the
! 	location of the prefix (not the location of the attribute reference) as
! 	the error location.
! 	(Analyze_Attribute, case 'Size): The name of an enumeration literal, or
! 	a function renaming thereof, is a valid prefix for 'Size (where it is
! 	intepreted as a function call).
! 	(Statically_Denotes_Entity): New predicate to determine whether the
! 	prefix of an array attribute can be considered static.
! 
! 	PR ada/9087
! 	(Eval_Attr): Fix failure to evaluate Component_Size for
! 	unconstrained arrays (resulted in wrong value in packed case, since
! 	back end cannot handle this case)
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_cat.adb (Check_Categorization_Dependencies): Add more detail to
! 	error msgs for most common cases.
! 	Use new errout insertion char < (conditional warning)
! 
! 2005-09-01  Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch10.adb (In_Chain): Moved from the scope of a subprogram to
! 	become local to the whole package.
! 	(Install_Limited_Withed_Unit): Instead of unchaining real entities if
! 	the package was already analyzed the new algorithm "replaces" the
! 	real entities by the shadow ones. This is required to ensure that
! 	the order of these entities in the homonym chains does not change;
! 	otherwise we can have undefined references at linking time because
! 	in case of conflicts the external name of the entities will have
! 	a suffix that depends on the order of the entities in the chain.
! 	(Remove_Limited_With_Clause): Complementary code that completes the
! 	new algorithm and replaces the shadow entities by the real ones.
! 	(Install_Limited_Withed_Unit): When unchaining entities before the
! 	installation of the shadow entities, only regular entities of the
! 	public part must be taken into account. This is required to
! 	keep this routine in synch with the work done by Remove_Limited_
! 	With_Clause
! 	(Install_Limited_With_Clause): Introduce implicit limited_with_clause
! 	even if unit is analyzed, because the analysis of the unit is
! 	idempotent in any case, and the limited view of the unit may have to
! 	be installed for proper visibility.
! 	(Expand_Limited_With_Clause): Even if the unit in the implicit
! 	with_clause has been analyzed already, a limited view of the package
! 	must be built for the current context, if it does not exist yet.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 
! 	* sem_ch12.adb (Instantiate_Subprogram_Body): When creating the
! 	defining entity for the instance body, make a new defining identifier
! 	rather than copying the entity of the spec, to prevent accidental
! 	sharing of the entity list.
! 	(Check_Private_View): When exchanging views of private types, build the
! 	list of exchanged views as a stack, to ensure that on exit the exchanges
! 	are undone in the proper order.
! 	(Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation):
! 	Restore the compilation environment in case of instantiation_error.
! 	(Analyze_Generic_Subprogram_Declaration): Handle creation of type entity
! 	for an anonymous access result.
! 	(Instantiate_Generic_Subprogram): Subtype_Mark => Result_Definition
! 	(Formal_Entity): Handle properly the case of a formal package that
! 	denotes a generic package renaming.
! 
! 2005-09-01  Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_ch13.adb (Analyze_Enumeration_Representation_Clause): Reject the
! 	clause if the array aggregate is surrounded by parentheses.
! 
! 2005-09-01  Cyrille Comar  <comar@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_ch3.ads, sem_ch3.adb (Analyze_Object_Declaration): Go to the
! 	underlying type
! 	to check if a type is Constrained in cases related to code generation
! 	(rather than semantic checking) since otherwise we do not generate
! 	similar code for mutable private types depending if their
! 	discriminants are visible or not.
! 	(Check_Abstract_Overriding): Do not complain about failure to override
! 	the primitive operations used in dispatching selects since they will
! 	always be overriden at the freeze point of the type.
! 	(Access_Definition): Separate out handling for resetting the scope
! 	of an anonymous access function result type. Retrieve the scope
! 	of the associated function rather than using Current_Scope, which
! 	does not have a consistent value (depends on whether we're in the
! 	middle of analyzing formal parameters). Add ??? comment about
! 	finding a cleaner way to handle the special cases of scope setting.
! 	(Process_Incomplete_Dependents): A protected operation is never a
! 	dispatching operation (only its wrapper may be).
! 	(Build_Derived_Record_Type): In case of tagged private types that
! 	implement interfaces add derivation of predefined primitive
! 	operations.
! 	(Derive_Subprograms): Replace the Is_Interface_Derivation parameter
! 	by two parameters that are used in case of derivation from abstract
! 	interface types: No_Predefined_Prims is used to avoid the derivation
! 	of predefined primitives from the interface, and Predefined
! 	Prims_Only is used to complete the derivation predefined primitives
! 	in case of private tagged types implementing interfaces.
! 	Fix typo in comments
! 	(Find_Interface_In_Descendant): Protect the frontend against
! 	wrong code with large circularity chains.
! 	(Is_Private_Overriding): Add support for entities overriding interface
! 	subprograms. The test failed because Entities associated with overriden
! 	interface subprograms are always marked as hidden (and used to build
! 	the secondary dispatch table); in this case the overriden entity is
! 	available through the field abstract_interface_alias (cf. override_
! 	dispatching_operation)
! 	(Access_Definition): Set the scope of the type to Current_Scope for the
! 	case of a function with an anonymous access result type.
! 	(Access_Subprogram_Declaration): Handle creation of the type entity for
! 	an access-to-function type with an anonymous access result.
! 	(Check_Anonymous_Access_Types): Change Subtype_Mark to Result_Definition
! 	in handling for N_Access_Function_Definition.
! 	(Analyze_Subtype_Declaration): Modify the text of error message.
! 	(Derived_Type_Declaration): Modify the text of error message.
! 	(Process_Subtype): Modify the text of error message plus cleanup
! 	of one redundant error message.
! 	(Analyze_Component_Declaration): Code cleanup.
! 	(Analyze_Object_Declaration): Code cleanup.
! 	(Analyze_Subtype_Declaration): Propagate the null-exclusion
! 	attribute in case of access types. Code cleanup.
! 	(Array_Type_Declaration): Code cleanup.
! 	(Process_Discriminants): Create the new null-excluding itype
! 	if required. Code cleanup.
! 	(Process_Subtype): Create the new null-excluding itype if
! 	required. Code cleanup.
! 	(Build_Derived_Record_Type): Code cleanup to avoid calling
! 	twice the subprogram derive_subprograms in case of private
! 	types that implement interfaces. In this particular case the
! 	subprogram Complete_Subprograms_Derivation already does the
! 	job associated with the second call.
! 
!         * exp_strm.adb (Build_Elementary_Input_Call): Add an explicit
!         conversion to the full view when generating an operation for a
!         discriminant whose type may currently be private.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_ch4.adb (Transform_Object_Operation): In a context off the form
! 	V (Obj.F), the rewriting does not involve the indexed component, but
! 	only the selected component itself.
! 	Do not apply the transformation if the analyzed node is an actual of a
! 	call to another subprogram.
! 	(Complete_Object_Operation): Retain the entity of the
! 	dispatching operation in the selector of the rewritten node. The
! 	entity will be used in the expansion of dispatching selects.
! 	(Analyze_One_Call): Improve location of the error message associated
! 	with interface.
! 	(Analyze_Selected_Component): No need to resolve prefix when it is a
! 	function call, resolution is done when parent node is resolved, as
! 	usual.
! 	(Analyze_One_Call): Add a flag to suppress analysis of the first actual,
! 	when attempting to resolve a call transformed from its object notation.
! 	(Try_Object_Operation, Transform_Object_Operastion): Avoid makind copies
! 	of the argument list for each interpretation of the operation.
! 	(Try_Object_Operation): The designated type of an access parameter may
! 	be an incomplete type obtained through a limited_with clause, in which
! 	case the primitive operations of the type are retrieved from its full
! 	view.
! 	(Analyze_Call): If this is an indirect call, and the return type of the
! 	access_to_subprogram is incomplete, use its full view if available.
! 
! 2005-09-01  Javier Miranda  <miranda@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 
! 	* sem_ch6.ads, sem_ch6.adb (Check_Conformance): In case of anonymous
! 	access types the null-exclusion and access-to-constant attributes must
! 	also match.
! 	(Analyze_Return_Statement): When the result type is an anonymous access
! 	type, apply a conversion of the return expression to the access type
! 	to ensure that appropriate accessibility checks are performed.
! 	(Analyze_Return_Type): For the case of an anonymous access result type,
! 	generate the Itype and set Is_Local_Anonymous_Access on the type.
! 	Add ??? placeholder for check to disallow returning a limited object
! 	in Ada 2005 unless it's an aggregate or a result of a function call.
! 	Change calls from Subtype_Mark to Result_Definition.
! 	(Analyze_Subprogram_Body): Change formal Subtype_Mark to
! 	Result_Definition in call to Make_Function_Specification.
! 	(Build_Body_To_Inline): Change Set_Subtype_Mark to
! 	Set_Result_Definition.
! 	(Make_Inequality_Operator): Change formal Subtype_Mark to
! 	Result_Definition in call to Make_Function_Specification.
! 	(Process_Formals): Create the new null-excluding itype if required.
! 	(New_Overloaded_Entity): For an entity overriding an interface primitive
! 	check if the entity also covers other abstract subprograms in the same
! 	scope. This is required to handle the general case, that is, overriding
! 	other interface primitives and overriding abstract subprograms inherited
! 	from some abstract ancestor type.
! 	(New_Overloaded_Entity): For an overriding entity that comes from
! 	source, note the operation that it overrides.
! 	(Check_Conformance, Type_Conformant): Addition of one new formal
! 	to skip controlling formals in the analysis. This is used to
! 	handle overloading of abstract interfaces.
! 	(Base_Types_Match): Add missing case for types imported from
! 	limited-with clauses
! 	(New_Overloaded_Entity): Add barrier to protect the use of
! 	the "alias" attribute.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch8.adb (Analyze_Renamed_Entry): For a renaming_as_declaration,
! 	verify that the procedure and the entry are mode conformant.
! 	(Analyze_Subprogram_Renaming): Emit a warning if an operator is renamed
! 	as a different operator, which is often a cut-and-paste error.
! 
! 2005-09-01  Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_disp.adb (Check_Controlling_Formals): Anonymous access types
! 	used in controlling parameters exclude null because it is necessary to
! 	read the tag to dispatch, and null has no tag.
! 	(Override_Dispatching_Operation): If the previous operation is inherited
! 	from an interface, it becomes hidden  and does not participate in later
! 	name resolution.
! 
! 2005-09-01  Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 
! 	* sem_res.adb (Resolve_Membership_Op): In case of the membership test
! 	"Iface_CW_Typ in T'Class" we have nothing else to do in the frontend;
! 	the expander will generate the corresponding run-time check to evaluate
! 	the expression.
! 	(Resolve_Call): Check for legal type of procedure name or prefix that
! 	appears as a trigger in a triggering alternative.
! 	(Valid_Conversion): If expression is ambiguous and the context involves
! 	an extension of System, remove System.Address interpretations.
! 	(Resolve_Qualified_Expression): Reject the case of a specific-type
! 	qualification applied to a class-wide argument. Enhance comment
! 	to explain checking of Original_Node.
! 	(Resolve_Type_Conversion): The location of the error message was not
! 	general enough to handle the general case and hence it has been removed.
! 	In addition, this patch improves the text of the message.
! 	(Resolve_Type_Conversion): Add missing support for access to interface
! 	types.
! 	(Resolve_Type_Conversion): If the target is a class-wide interface type,
! 	do not expand if the expression is the actual in a call, because proper
! 	expansion will take place when the call itself is expanded.
! 	(Resolve_Allocator): If the context is an unchecked conversion, the
! 	allocator inherits its storage pool, if any, from the target type of
! 	the conversion.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_type.adb (Add_One_Interp): If a candidate operation is an
! 	inherited interface operation that has an implementation, use the
! 	implementation to avoid spurious ambiguities.
! 	(Interface_Present_In_Ancestor): In case of concurrent types we can't
! 	use the Corresponding_Record_Typ attribute to look for the interface
! 	because it is set by the expander (and hence it is not always
! 	available). For this reason we traverse the list of interfaces
! 	(available in the parent of the concurrent type).
! 	(Interface_Present_In_Ancestor): Handle entities from the limited view
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_util.ads, sem_util.adb (Gather_Components): Omit interface tags
! 	from the list of required components.
! 	(Is_Controlling_Limited_Procedure): Determine whether an entity is a
! 	primitive procedure of a limited interface with a controlling first
! 	parameter.
! 	(Is_Renamed_Entry): Determine whether an entry is a procedure renaming
! 	of an entry.
! 	(Safe_To_Capture_Value): A value (such as non_null) is not safe to
! 	capture if it is generated in the second operand of a short-circuit
! 	operation.
! 	Do not capture values for variables with address clauses.
! 	(Is_Object_Reference): Treat a function call as an object reference only
! 	if its type is not Standard_Void_Type.
! 
! 2005-09-01  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_warn.adb (Warn_On_Known_Condition): Refine warning when applied
! 	to a variable that is statically known to be constant.
! 
! 2005-09-01  Geert Bosch  <bosch@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 
! 	* ttypef.ads (VAXDF_Safe_First): Use correct value for constant.
! 	(VAXGF_Safe_First): Idem.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 	    Arnaud Charlet  <charlet@adacore.com>
! 
! 	* g-dirope.ads: Minor reformatting
! 	Document that bounds of result of Base_Name match the input index
! 	positions.
! 	Add documentation on environment variable syntax for Expand_Path
! 
! 	* gnat_ugn.texi: Update documentation to include mention of -m switches
! 	Document new treatment of wide characters in max line length
! 	style check.
! 	Remove -gnatL/-gnatZ switches, no longer used.
! 	Add note on pragmas Assertion_Policy and Debug_Policy in discussion
! 	of -gnata switch.
! 
! 	* gnat_rm.texi: Add doc for two argument form of pragma
! 	Float_Representation.
! 	Add documentation for pragma No_Strict_Aliasing
! 	Add note that explicit component clause overrides pragma Pack.
! 	Add documentation of pragma Debug_Policy
! 
! 2005-09-01  Matthew Heaney  <heaney@adacore.com>
! 
! 	* a-cihase.adb, a-coorse.ads, a-coorse.adb, a-cohama.adb,
! 	a-ciorse.ads, a-ciorse.adb, a-cihama.adb, a-cdlili.adb,
! 	a-cidlli.adb, a-chtgop.adb, a-cihase.adb, a-cihase.ads,
! 	a-cohase.adb, a-cohase.adb, a-cohase.ads: Synchronized with latest
! 	draft (Draft 13, August 2005) of Ada Amendment 1.
! 
! 2005-09-01  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* Makefile.in: Adjust the libgnat target pairs for Xscale to ARM.
! 	Note that the platform-specific version of g-soccon.ads for VMS is now
! 	named g-soccon-vms.ads (it was previously g-soccon-vms.adb, although it
! 	really is a package spec).
! 	Replace s-taspri-linux.ads by s-taspri-posix.ads
! 	Remove references to s-mastop-x86.adb
! 
! 	* system-vxworks-xscale.ads: Removed, no longer used.
! 	* s-vxwork-xscale.ads: Removed, no longer used.
! 
! 2005-09-01  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-dirval-mingw.adb, a-direct.adb, a-coinve.adb,
! 	g-dynhta.adb, g-dynhta.ads, cstand.adb, exp_smem.adb, g-debuti.ads,
! 	g-dirope.adb, g-table.adb, lib-sort.adb, sem_maps.adb,
! 	exp_fixd.adb, exp_aggr.adb, a-intnam-mingw.ads, a-intnam-vxworks.ads,
! 	g-arrspl.adb, g-arrspl.ads, g-awk.adb, g-awk.ads, g-boubuf.ads,
! 	g-boubuf.ads, g-boubuf.ads, g-bubsor.ads, g-bubsor.adb, g-busora.adb,
! 	g-busora.ads, g-busorg.adb, g-busorg.ads, g-calend.adb, g-calend.ads,
! 	g-casuti.adb, g-casuti.ads, g-catiio.adb, g-catiio.ads, g-cgi.adb,
! 	g-cgi.ads, g-cgicoo.adb, g-cgicoo.ads, g-cgideb.adb, g-cgideb.ads,
! 	g-comlin.adb, g-comver.ads, g-semaph.ads, g-socthi.ads,
! 	sem_ch7.adb, a-direio.adb, a-caldel.ads, i-cstrea-vms.adb,
! 	a-ztedit.adb, a-ztenau.adb, g-socthi-vms.adb, g-socthi-vms.ads,
! 	g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vxworks.ads,
! 	a-intnam-irix.ads, a-intnam-irix.ads, a-intnam-hpux.ads,
! 	a-intnam-os2.ads, a-intnam-os2.ads, a-caldel-vms.adb, a-calend-vms.adb,
! 	a-calend-vms.ads, g-heasor.adb, g-heasor.ads, g-hesora.adb,
! 	g-hesora.ads, g-hesorg.adb, g-hesorg.ads, g-htable.adb, g-htable.ads,
! 	g-io.adb, g-io.ads, g-io_aux.adb, g-io_aux.ads, g-locfil.ads,
! 	g-memdum.adb, g-memdum.ads, g-traceb.adb, g-traceb.ads, i-cobol.adb,
! 	i-cobol.ads, i-cstrea.ads, i-cstrin.adb, a-wtedit.adb, a-tifiio.adb,
! 	a-wtenau.adb, a-wtenau.adb, a-teioed.adb: Minor reformatting
! 
! 2005-08-29  Arnaud Charlet  <charlet@adacore.com>
! 
! 	PR ada/23187
! 	* adaint.c
! 	(GNAT_MAXPATH_LEN): Use default value if MAXPATHLEN is undefined.
! 
! 2005-08-29  Arnaud Charlet  <charlet@adacore.com>
! 	    Doug Rupp  <rupp@adacore.com>
! 
! 	* s-stalib.adb: Add missing pragma Warnings (On) to reenable Warnings
! 	when needed.
! 	(Inside_Elab_Final_Code): Moved to init.c to avoid having to keep
! 	this code in the GNAT run-time.
! 
! 	* decl.c, fe.h: Replace GCC_ZCX by Back_End_Exceptions.
! 
! 	PR ada/21053
! 	* init.c (__gnat_error_handler [many]): Mark "msg" as const
! 	(__gnat_error_handler [HPUX]): Mark siginfo parameter as unused
! 
! 	(__gnat_inside_elab_final_code): Moved here from
! 	Standard_Library and only defined for the compiler.
! 	__gnat_error_handler [VMS]: Adjust sigargs to account for PC & PSL.
! 	(__gnat_inum_to_ivec): Do not define this function on VxWorks when
! 	using RTPs because directly vectored Interrupt routines are not
! 	supported on this configuration.
! 	(getpid): Do not redefine this function on VxWorks when using RTPs
! 	because this primitive is well supported by the RTP libraries.
! 	(copy_msg): Correct the code that checks for buffer overflow.
! 	Discovered during code reading.
! 
! 2005-08-29  Olivier Hainque  <hainque@adacore.com>
! 
! 	* decl.c (gnat_to_gnu_entity) <E_Variable>: When allocating storage for
! 	a library level mutable variable with an initializer, tell
! 	build_allocator to ignore the initializer's size. It may not be large
! 	enough for all the values that might be assigned to the variable later
! 	on.
! 
! 2005-08-29  Arnaud Charlet  <charlet@adacore.com>
! 	    Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* trans.c: Protect < in error msg with quote
! 	Replace GCC_ZCX by Back_End_Exceptions.
! 	(addressable_p) <COMPONENT_REF>: Also return 1 if the field
! 	has been sufficiently aligned in the record.
! 
! 2005-08-15  James E. Wilson  <wilson@specifix.com>
! 
! 	* system-linux-alpha.ads: Change ia64 to alpha.
! 
! 2005-08-01  Kazu Hirata  <kazu@codesourcery.com>
! 
! 	* decl.c, utils.c: Fix comment typos.
! 
! 2005-07-29  Kazu Hirata  <kazu@codesourcery.com>
! 
! 	* decl.c, init.c, initialize.c: Fix comment typos.
! 
! 2005-07-20  Giovanni Bajo  <giovannibajo@libero.it>
! 
! 	Make CONSTRUCTOR use VEC to store initializers.
! 	* decl.c (gnat_to_gnu_entity): Update to cope with VEC in
! 	CONSTRUCTOR_ELTS.
! 	* trans.c (extract_values): Likewise.
! 	* utils.c (convert, remove_conversions): Likewise.
! 	* utils2.c (contains_save_expr_p, build_binary_op, build_unary_op,
! 	gnat_build_constructor): Likewise.
! 
! 2005-07-09  Andrew Pinski  <pinskia@physics.uc.edu>
! 
! 	* decl.c (components_to_record): Use DECL_FCONTEXT instead of
! 	DECL_SECTION_NAME.
! 	(compare_field_bitpos): Likewise.
! 
! 2005-07-09  Andrew Pinski  <pinskia@physics.uc.edu>
! 
! 	* utils.c (create_var_decl): Only set DECL_COMMON on
! 	VAR_DECLs. Only set SET_DECL_ASSEMBLER_NAME on
! 	VAR_OR_FUNCTION_DECL_P.
! 
! 2005-07-08  Daniel Berlin  <dberlin@dberlin.org>
! 
! 	* utils.c (create_param_decl): DECL_ARG_TYPE_AS_WRITTEN is
! 	removed.
! 
! 2005-07-07  Pascal Obry  <obry@adacore.com>
! 
! 	* g-socthi-mingw.adb (C_Inet_Addr): New body used to convert the
! 	returned type on Windows.
! 
! 	* g-socthi-mingw.ads (C_Inet_Addr): Remove pragma Import for this
! 	routine.
! 
! 	* g-socket.adb (Inet_Addr): Check for empty Image and raises an
! 	exception in this case.
! 	Simplify the code as "Image (Image'Range)" = "Image".
! 
! 2005-07-07  Vincent Celier  <celier@adacore.com>
! 
! 	* bindgen.adb (Gen_Output_File_C): When switch -a was specified, put
! 	the destructor/constructor attributes for <lib>final/<lib>init.
! 
! 	* gnatbind.adb (Gnatbind): Allow -a to be used in conjunction with -C
! 
! 2005-07-07  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* decl.c (gnat_to_gnu_entity) <E_Procedure>: Do not strip the padding
! 	type if the parameter is not passed by copy but reference by default.
! 
! 2005-07-07  Javier Miranda  <miranda@adacore.com>
! 
! 	* exp_ch3.adb (Build_Record_Init_Proc/Freeze_Record_Type):
! 	Reimplementation of the support for abstract interface types in order
! 	to leave the code more clear and easy to maintain.
! 
! 	* exp_ch6.adb (Freeze_Subprogram): Reimplementation of the support for
! 	abstract interface types in order to leave the code clearer and easier
! 	to maintain.
! 
! 	* exp_disp.ads, exp_disp.adb (Fill_DT_Entry): Part of its functionality
! 	is now implemented by the new subprogram Fill_Secondary_DT_Entry.
! 	(Fill_Secondary_DT_Entry): Generate the code necessary to fill the
! 	appropriate entry of the secondary dispatch table.
! 	(Make_DT): Add code to inherit the secondary dispatch tables of
! 	the ancestors.
! 
! 	* exp_util.adb (Find_Interface_Tag/Find_Interface_ADT): Instead of
! 	implementing both functionalities by means of a common routine, each
! 	routine has its own code.
! 
! 2005-07-07  Javier Miranda  <miranda@adacore.com>
! 
! 	* freeze.adb (Freeze_Entity): Check wrong uses of tag incomplete types.
! 
! 	* par-ch3.adb (P_Type_Declaration): Give support to tagged incomplete
! 	types:
! 	--
! 	  type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [IS TAGGED];
! 	--
! 
! 	* sem_attr.adb (Check_Not_Incomplete_Type): Additional checks for wrong
! 	use of tag incomplete types.
! 
! 	* sem_ch3.adb (Analyze_Incomplete_Type): Add mininum decoration to
! 	give support to tagged incomplete types.
! 
! 	* sem_ch5.adb (Analyze_Case_Statement): In generated code, if the
! 	expression is a discriminant reference and its type is private, as can
! 	happen within a stream operation for a mutable record, use the full
! 	view of the type to resolve the case alternatives.
! 	(Analyze_Assignment): Check wrong dereference of incomplete types.
! 
! 	* sem_ch6.adb (Process_Formals): Allow the use of tagged incomplete
! 	types.
! 
! 	* sem_res.adb (Resolve_Explicit_Dereference): Allow the use of tagged
! 	incomplete types.
! 
! 	* sinfo.adb (Taggged_Present/Set_Taggged_Present): Applicable to
! 	N_Incomplete_Type_Declaration nodes.
! 
! 	* sinfo.ads (N_Incomplete_Type_Declaration): Addition of attribute
! 	Tag_Present to give support to tagged incomplete types:
! 	--
! 	  type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [IS TAGGED];
! 	--
! 
! 2005-07-07  Olivier Hainque  <hainque@adacore.com>
! 
! 	PR ada/22301
! 
! 	* raise.c: Only include unwind.h if IN_RTS, and provide dummy type
! 	definitions for the Unwind wrappers in the compiler case.
! 
! 2005-07-07  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* par-load.adb (Load): If a child unit is loaded through a limited_with
! 	clause, each parent must be loaded as a limited unit as well.
! 
! 	* sem_ch10.adb (Previous_Withed_Unit): Better name for
! 	Check_Withed_Unit. Return true if there is a previous with_clause for
! 	this unit, whether limited or not.
! 	(Expand_Limited_With_Clause): Do not generate a limited_with_clause on
! 	the current unit.
! 	(Is_Visible_Through_Renamings): New local subprogram of install_limited
! 	_withed_unit that checks if some package installed through normal with
! 	clauses has a renaming declaration of package whose limited-view is
! 	ready to be installed. This enforces the check of the rule 10.1.2 (21/2)
! 	of the current Draft document for Ada 2005.
! 	(Analyze_Context): Complete the list of compilation units that
! 	are allowed to contain limited-with clauses. It also contains
! 	checks that were previously done by Install_Limited_Context_Clauses.
! 	This makes the code more clear and easy to maintain.
! 	(Expand_Limited_With_Clause) It is now a local subprogram of
! 	Install_Limited_Context_Clauses, and contains the code that adds
! 	the implicit limited-with clauses for parents of child units.
! 	This functionality was prevously done by Analyze_Context.
! 
! 	* sem_ch4.adb (Analyze_Selected_Component): Check wrong use of
! 	incomplete type.
! 
! 	* sem_ch7.adb (Analyze_Package_Declaration): Check if the package has
! 	been erroneously named in a limited-with clause of its own context.
! 	In this case the error has been previously notified by Analyze_Context.
! 
! 2005-07-07  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch8.adb (Find_Direct_Name): Handle properly the case of a
! 	generic package that contains local declarations with the same name.
! 	(Analyze_Object_Renaming): Check wrong renaming of incomplete type.
! 
! 2005-07-07  Bernard Banner  <banner@adacore.com>
! 
! 	* tracebak.c: Refine tracebacks to use Unwind_Backtrace scheme on
! 	ia64 platform only on platforms that you the GCC unwind library
! 	rather than the system unwind library.
! 
! 2005-07-07  Thomas Quinot  <quinot@adacore.com>
! 
! 	* expect.c: Minor reformatting
! 
! 2005-07-07  Sergey Rybin  <rybin@adacore.com>
! 
! 	* vms_data.ads: Add VMS qualifiers for new gnatpp switch
! 	--no-separate-is
! 
! 	* gnat_ugn.texi: Add description for new gnatpp option
! 	(--no-separate-is)
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* g-expect-vms.adb, g-expect.ads, g-expect.adb
! 	(Get_Command_Output): New subprogram to launch a process and get its
! 	standard output as a string.
! 
! 2005-07-04  Eric Botcazou  <ebotcazou@adacore.com>
! 	    Olivier Hainque  <hainque@adacore.com>
! 
! 	* s-mastop-tru64.adb (Pop_Frame): Use exc_lookup_function_entry to
! 	fetch a code-range descriptor associated with the machine state. On
! 	failure set the machine state's PC to 0; on success, pass the
! 	descriptor to exc_virtual_unwind.
! 
! 	* init.c (Tru64 section): New function __gnat_set_code_loc.
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
! 	mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb,
! 	mlib-tgt-mingw.adb, mlib-tgt-darwin.adb (Build_Dynamic_Library):
! 	Remove all auto-initialization code, as this is now done through the
! 	constructor mechanism.
! 
! 	* adaint.h, adaint.c (__gnat_binder_supports_auto_init,
! 	__gnat_sals_init_using_constructors): New functions.
! 
! 	* bindgen.adb (Gen_Output_File_Ada): Generate pragmas
! 	Linker_Constructor and Linker_Destructor when switch -a is used.
! 
! 	* bindusg.adb: Add line for new switch -a
! 
! 	* gnatbind.adb (Gnatbind_Supports_Auto_Init): New Boolean function
! 	(Gnatbind): When switch -a is used, check if it is allowed
! 
! 	* switch-b.adb (Scan_Binder_Switches): Process new switch -a
! 
! 2005-07-04  Joel Brobecker  <brobecker@adacore.com>
! 
! 	* a-tags.adb (Type_Specific_Data): Define Tags_Table as a small array.
! 	This prevents us from hitting a limitation during the debug info
! 	generation when using stabs.
! 	(Prims_Ptr): Likewise.
! 
! 2005-07-04  Gary Dismukes  <dismukes@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* checks.adb (Null_Exclusion_Static_Checks): In the case of
! 	N_Object_Declaration, only perform the checks if the Object_Definition
! 	is not an Access_Definition.
! 
!         * sem_ch3.adb (Access_Subprogram_Declaration): Add test for the case
!         where the parent of an the access definition is an N_Object_Declaration
!         when determining the Associated_Node_For_Itype and scope of an
!         anonymous access-to-subprogram type.
! 
! 	* exp_ch6.adb (Expand_N_Subprogram_Declaration): Set the
! 	Corresponding_Spec on the body created for a null procedure. Add ???
! 	comment. Remove New_Copy_Tree call on body argument to
! 	Set_Body_To_Inline.
! 
! 	* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): For an out parameter with
! 	discriminants, use the type of the actual as well, because the
! 	discriminants may be read by the called subprogram.
! 
! 	* sem_ch3.adb (Access_Type_Declaration): If the designated type is an
! 	access type we do not need to handle non-limited views.
! 	(Build_Derived_Record_Type): Additional check to check that in case of
! 	private types, interfaces are only allowed in private extensions.
! 
! 2005-07-04  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* decl.c (prepend_attributes) <Pragma_Linker_Constructor>: New case.
! 	<Pragma_Linker_Destructor>: Likewise.
! 
! 	* einfo.ads (Has_Gigi_Rep_Item): Document Pragma_Linker_Constructor and
! 	Pragma_Linker_Destructor.
! 
! 	* gigi.h (attr_type): Add ATTR_LINK_CONSTRUCTOR and
! 	ATTR_LINK_DESTRUCTOR.
! 	(static_ctors, static_dtors): New variables.
! 
! 	* misc.c (gnat_expand_body): Output current function as constructor
! 	and destructor if requested.
! 
! 	* par-prag.adb: Add processing for pragma Linker_Constructor and
! 	Linker_Destructor.
! 
! 	* sem_prag.adb (Find_Unique_Parameterless_Procedure): New function
! 	extracted from Check_Interrupt_Or_Attach_Handler.
! 	(Check_Interrupt_Or_Attach_Handler): Invoke it.
! 	Implement pragma Linker_Constructor and Linker_Destructor with the
! 	help of Find_Unique_Parameterless_Procedure.
! 	Replace Name_Alias with Name_Target for pragma Linker_Alias.
! 
! 	* snames.h, snames.ads, snames.adb:
! 	Add Name_Linker_Constructor and Name_Linker_Destructor.
! 	Add Pragma_Linker_Constructor and Pragma_Linker_Destructor.
! 	* snames.adb: Remove Name_Alias.
! 
! 	* trans.c: Include cgraph.h.
! 	(build_global_cdtor): New function.
! 	(Compilation_Unit_to_gnu): Build global constructor and destructor if
! 	needed.
! 	(tree_transform) <N_Identifier>: Substitute renaming of view-conversions
! 	of objects too.
! 	(addressable_p) <COMPONENT_REF>: Unconditionally test
! 	DECL_NONADDRESSABLE_P on STRICT_ALIGNMENT platforms.
! 
! 	* utils.c (process_attributes) <ATTR_LINK_ALIAS>: Do not assemble the
! 	variable if it is external.
! 
! 	(static_ctors, static_dtors): New global variables.
! 	(process_attributes) <ATTR_LINK_CONSTRUCTOR>: New case.
! 	<ATTR_LINK_DESTRUCTOR>: Likewise.
! 	(end_subprog_body): Chain function as constructor and destructor
! 	if requested.
! 
! 	* exp_util.adb (Force_Evaluation): Unconditionally invoke
! 	Remove_Side_Effects with Variable_Ref set to true.
! 	(Remove_Side_Effects): Handle scalar types first. Use a renaming
! 	for non-scalar types even if Variable_Ref is true and for class-wide
! 	expressions.
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_attr.adb (Mod): Evaluate condition expression with checks off,
! 	to prevent spurious warnings.
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Build_TypeCode_Call): Remove incorrect processing for
! 	Itypes. Itypes are really unexpected there.
! 	(Build_TypeCode_Function): Generalise special processing for Itypes to
! 	handle the case of numeric implicit base types as well as enumerated
! 	ones.
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_intr.adb (Expand_Unc_Deallocation): If the designated type is
! 	controlled, indicate the expected type of the dereference that is
! 	created for the call to Deep_Finalize, to prevent spurious errors when
! 	the designated type is private and completed with a derivation from
! 	another private type.
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* make.adb (Change_To_Object_Directory): When unable to change the
! 	current dir to the object directory, output the full path of the
! 	directory.
! 
! 2005-07-04  Matthew Gingell  <gingell@adacore.com>
! 
! 	* Makefile.in: Replace indepsw-linux.adb by indepsw-gnu.adb
! 
! 	* indepsw-linux.adb: Replace by...
! 
! 	* indepsw-gnu.adb: ...this new file
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-prj.adb (Auto_Initialize): New constant String
! 	(SALs_Use_Constructors): New Boolean function
! 	(Build_Library): Call gnatbind with Auto_Initialize switch when
! 	SALs_Use_Constructors returns True.
! 
! 	* mlib-tgt.ads: Minor reformatting
! 
! 	* mlib-utl.ads: Minor reformatting
! 
! 	* opt.ads: (Use_Pragma_Linker_Constructor): New Boolean flag
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* par-ch9.adb (P_Task, P_Protected): Indicate that single task and
! 	single protected declarations can have an interface list.
! 	(P_Entry_Declaration): Add handler for Error_Resync, which can be raised
! 	with seriously malformed entry declarations, and lead to compilation
! 	abandoned messages.
! 
! 2005-07-04  Javier Miranda  <miranda@adacore.com>
! 
! 	* par-load.adb: Load the context items in two rounds.
! 
! 2005-07-04  Robert Dewar  <dewar@adacore.com>
! 
! 	* scng.adb: Do not consider Mod used as an attribute to be a keyword
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_ch10.adb (Build_Limited_Views): A type declared with a private
! 	type extension needs a limited view.
! 	Remove previous restriction on private types available through the
! 	limited-view (only tagged private types were previously allowed).
! 	(Install_Withed_Unit): In the code that implements the
! 	legality rule given in AI-377, exclude a child unit with the name
! 	Standard, because it is a homonym of the Standard environment package.
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_ch4.adb (Transform_Object_Operation): For an actual that is an
! 	overloaded function call, carry interpretations from the original tree
! 	to the copy.
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch6.adb (Conforming_Types): If the types are anonymous access
! 	types check whether some designated type is a limited view, and use
! 	the non-limited view if available.
! 
! 2005-07-04  Gary Dismukes  <dismukes@adacore.com>
! 
! 	* sem_eval.adb (Subtypes_Statically_Match): Use the discriminant
! 	constraint of full view of a private view T1 if present, when T2 is a
! 	discriminated full view.
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_res.adb (Resolve_Actuals): Do not resolve the expression of an
! 	actual that is a view conversion of a bit packed array reference.
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_type.adb (Covers): Verify that Corresponding_Record_Type is
! 	present before checking whether an interface type covers a synchronized
! 	type.
! 
! 2005-07-04  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_util.adb (Is_Object_Reference): An indexed or selected component
! 	whose prefix is an implicit dereference is an object reference. Removes
! 	spurious errors when compiling with -gnatc.
! 
! 2005-07-04  Robert Dewar  <dewar@adacore.com>
! 
! 	PR ada/22039
! 
! 	* s-sopco3.ads, s-sopco4.ads, s-sopco5.ads: Minor documentation fix
! 
! 2005-07-04  Matthew Gingell  <gingell@adacore.com>
! 
! 	* tracebak.c: Enable tracebacks on ia64 platforms
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* vms_conv.adb (Initialize): Allow multiple ALI files to be given to
! 	the GNAT BIND command, as gnatbind accepts multiples ALI files with
! 	the -L or -n switches.
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* makegpr.adb (Build_Global_Archive): Make sure the list of sources is
! 	correctly computed and the main project data is not modified while
! 	doing so.
! 	(Add_C_Plus_Plus_Link_For_Gnatmake): Always link with the C++ compiler
! 	(Choose_C_Plus_Plus_Link_Process): Do not generate shell script
! 	c++linker as this does not work on some platforms.
! 
! 2005-07-04  Matthew Heaney  <heaney@adacore.com>
! 
! 	* a-convec.ads, a-coinve.ads: Declaration of subtype Extended_Index
! 	was changed.
! 	* a-coinve.adb: Perform constraint checks explicitly.
! 
! 2005-07-04  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
! 	* Make-lang.in: (ada/targtyps.o): Add missing TREE_H dependency.
! 	new target gen-soccon.
! 
! 2005-07-04  Robert Dewar  <dewar@adacore.com>
! 
! 	* s-mastop-irix.adb, s-mastop-vms.adb: Minor reformatting
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* g-socket.ads (Check_Selector): Minor rewording of comment.
! 
! 2005-07-04  Vincent Celier  <celier@adacore.com>
! 
! 	* vms_data.ads: Add VMS qualifiers for new gnatpp switch --eol=
! 
! 2005-07-04  Thomas Quinot  <quinot@adacore.com>
! 
! 	* gen-soccon.c: Add constants SO_SNDTIMEO and SO_RCVTIMEO.
! 
! 2005-07-04  Sergey Rybin  <rybin@adacore.com>
! 
!         * gnat_ugn.texi: Add description of --eol gnatpp option
! 
! 2005-07-04  Eric Botcazou  <ebotcazou@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 
!         * gnat_rm.texi: Add a note that pragma Unreferenced is not appropriate
! 	if the user wants all calls of a subprogram to be flagged,
! 	independently of whether they are made from within the same unit or
! 	another unit.
!         Mention restriction for pragma Linker_Alias on some platforms.
!         Document pragma Linker_Constructor and Linker_Destructor.
!         Rewrite documentation of Weak_External, Linker_Section and
!         Linker_Alias pragmas.
! 
! 2005-07-04  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-stausa.ads, s-stausa.adb: New files.
! 
! 2005-06-30  Kelley Cook
! 
! 	* all files:  Update FSF address in copyright headers.
! 	* gen-soccon.co (main): Output new FSF address in generated files.
! 
! 2005-06-28  Paul Brook  <paul@codesourcery.com>
! 
! 	* misc.c (gnat_init_gcc_eh): Call default_init_unwind_resume_libfunc.
! 
! 2005-06-14  Olivier Hainque  <hainque@adacore.com>
! 	    Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* s-mastop-irix.adb (Pop_Frame): Revert shorcuts avoiding calls to
! 	exc_unwind, now that we are generating proper .debug_frame output for
! 	that target.
! 
! 	* tracebak.c: Remove the mips-irix section, as we are now using the
! 	s-mastop based unwinder again.
! 	Under SPARC/Solaris, take into account the stack bias to compute the
! 	frame offset.  The stack bias is 0 for the V8 ABI and 2047 for the V9
! 	ABI.
! 
! 2005-06-14  Doug Rupp  <rupp@adacore.com>
! 
! 	* g-trasym-vms.adb: renamed g-trasym-vms-alpha.adb
! 
! 	* g-trasym-vms-alpha.adb, g-trasym-vms-ia64.adb: New files
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* a-strhas.ads, a-secain.adb, a-secain.ads, a-rbtgso.ads, a-cgaaso.adb,
! 	a-cgaaso.ads, a-cgarso.adb, a-cgcaso.adb, a-cgarso.ads, a-cgcaso.ads,
! 	a-contai.ads, a-coprnu.ads, a-coprnu.adb: Fix header style (spaces in
! 	package name).
! 
! 	* a-intnam-lynxos.ads, a-intnam-unixware.ads, a-intnam-tru64.ads,
! 	a-intnam-aix.ads, a-intnam-irix.ads, a-excpol-interix.adb,
! 	a-intnam-hpux.ads, a-intnam-linux.ads, a-intnam-dummy.ads,
! 	a-intnam-os2.ads, a-numaux-libc-x86.ads, a-intnam-interix.ads,
! 	a-intnam-solaris.ads, a-caldel-vms.adb, a-calend-vms.ads,
! 	a-intnam-vms.ads, a-excpol-abort.adb, a-intnam-mingw.ads,
! 	a-intnam-vxworks.ads, a-numaux-vxworks.ads, s-osinte-unixware.adb,
! 	s-osinte-unixware.ads, s-osinte-lynxos-3.adb, s-osinte-lynxos-3.ads,
! 	s-osinte-hpux.ads, s-osinte-solaris-posix.ads, a-intnam-freebsd.ads,
! 	s-osinte-freebsd.adb, s-osinte-freebsd.ads, s-osinte-lynxos.adb,
! 	s-osinte-lynxos.ads, s-tpopsp-lynxos.adb, s-osinte-tru64.adb,
! 	s-osinte-tru64.ads, s-tpopsp-posix-foreign.adb, s-vxwork-alpha.ads,
! 	s-osinte-aix.adb, s-osinte-aix.ads, s-osinte-aix-fsu.ads,
! 	s-osinte-irix.adb, s-osinte-irix.ads, s-interr-sigaction.adb,
! 	s-osinte-irix-athread.ads, s-osinte-hpux-dce.adb,
! 	s-osinte-hpux-dce.ads, s-osinte-posix.adb, s-osinte-linux.ads,
! 	s-vxwork-m68k.ads, s-osinte-linux-fsu.ads, s-vxwork-mips.ads,
! 	s-osinte-dummy.ads, s-interr-dummy.adb, s-osinte-os2.adb,
! 	s-osinte-os2.ads, s-osprim-os2.adb, s-osinte-interix.ads,
! 	s-osprim-unix.adb, s-vxwork-ppc.ads, s-osinte-solaris.adb,
! 	s-osinte-solaris.ads, s-osprim-solaris.adb, s-tpopsp-solaris.adb,
! 	s-vxwork-sparcv9.ads, s-osinte-solaris-fsu.ads, s-interr-vms.adb,
! 	s-osinte-vms.adb, s-osinte-vms.ads, s-osprim-vms.adb,
! 	s-osprim-vms.ads, s-tpopde-vms.adb, s-tpopde-vms.ads,
! 	s-osprim-mingw.adb, s-vxwork-xscale.ads, s-interr-vxworks.adb,
! 	s-osinte-vxworks.adb, s-osinte-vxworks.ads, s-osprim-vxworks.adb,
! 	s-tfsetr-vxworks.adb, s-tpopsp-vxworks.adb, s-intman-posix.adb,
! 	s-osinte-fsu.adb, s-osprim-posix.adb, s-tfsetr-default.adb,
! 	s-tpopsp-posix.adb, s-traces-default.adb, s-trafor-default.adb,
! 	s-trafor-default.ads, s-tratas-default.adb, a-numaux-x86.adb,
! 	a-numaux-x86.ads, a-astaco.adb, a-astaco.ads, a-caldel.adb,
! 	a-caldel.ads, a-charac.ads, a-chlat1.ads, a-chlat9.ads, a-colien.adb,
! 	a-colien.ads, a-colire.adb, a-colire.ads, a-comlin.adb, a-cwila1.ads,
! 	a-cwila9.ads, ada.ads, a-decima.adb, a-diocst.ads, a-direio.adb,
! 	a-dynpri.adb, a-dynpri.ads, a-excpol.adb, a-flteio.ads, a-fwteio.ads,
! 	a-inteio.ads, a-interr.adb, a-intnam.ads, a-intsig.adb, a-intsig.ads,
! 	a-ioexce.ads, a-iwteio.ads, a-lfteio.ads, a-lfwtio.ads, a-liteio.ads,
! 	a-liwtio.ads, a-llftio.ads, a-llfwti.ads, a-llitio.ads, a-lliwti.ads,
! 	a-ncelfu.ads, a-ngcefu.adb, a-ngcefu.ads, a-ngcoty.adb, a-ngelfu.adb,
! 	a-ngelfu.ads, a-nlcefu.ads, a-nlcoty.ads, a-nlelfu.ads, a-nllcef.ads,
! 	a-nllcty.ads, a-nllefu.ads, a-nscefu.ads, a-nscoty.ads, a-nselfu.ads,
! 	a-nucoty.ads, a-nudira.adb, a-nuelfu.ads, a-nuflra.adb, a-numaux.ads,
! 	a-numeri.ads, a-reatim.adb, a-retide.adb, a-retide.ads, a-sequio.adb,
! 	a-sequio.ads, a-sfteio.ads, a-sfwtio.ads, a-siocst.ads, a-siteio.ads,
! 	a-siwtio.ads, a-ssicst.ads, a-ssitio.ads, a-ssiwti.ads, a-stmaco.ads,
! 	a-storio.adb, a-strbou.adb, a-strfix.adb, a-string.ads, a-strmap.adb,
! 	a-strsea.adb, a-strsup.adb, a-strunb.ads, a-ststio.adb, a-stunau.adb,
! 	a-stunau.ads, a-stwibo.adb, a-stwifi.adb, a-stwifi.ads, a-stwima.adb,
! 	a-stwise.adb, a-stwisu.adb, a-suteio.adb, a-suteio.ads, a-swuwti.adb,
! 	a-swuwti.ads, a-teioed.adb, a-ticoau.adb, a-ticoau.ads, a-ticoio.adb,
! 	a-tideau.adb, a-tideio.adb, a-tienau.adb, a-tienio.adb, a-tifiio.adb,
! 	a-tiflio.adb, a-tigeau.adb, a-tigeau.ads, a-tiinio.adb, a-timoau.adb,
! 	a-timoio.adb, a-timoio.ads, a-tiocst.ads, a-titest.adb, a-titest.ads,
! 	a-witeio.adb, a-wtcoau.adb, a-wtcoau.ads, a-wtcoio.adb, a-wtcoio.ads,
! 	a-wtcstr.ads, a-wtdeau.adb, a-wtdeio.adb, a-wtenau.adb, a-wtenio.adb,
! 	a-wtfiio.adb, a-wtflio.adb, a-wtgeau.adb, a-wtinau.adb, a-wtinio.adb,
! 	a-wtinio.ads, a-wtmoau.adb, a-wtmoio.adb, a-wttest.adb, calendar.ads,
! 	dec.ads, dec-io.adb, dec-io.ads, directio.ads, errno.c, g-bubsor.adb,
! 	g-bubsor.ads, g-busora.adb, g-busora.ads, g-busorg.adb, g-busorg.ads,
! 	g-casuti.adb, g-casuti.ads, g-debuti.ads, g-heasor.adb, g-heasor.ads,
! 	g-hesora.adb, g-hesora.ads, g-hesorg.adb, g-hesorg.ads, g-htable.adb,
! 	g-htable.ads, g-io.adb, g-io.ads, g-io_aux.adb, g-io_aux.ads,
! 	g-memdum.adb, g-memdum.ads, g-sestin.ads, g-signal.ads, g-signal.adb,
! 	gnat.ads, g-souinf.ads, g-speche.adb, g-speche.ads, g-table.adb,
! 	g-table.ads, g-thread.adb, g-thread.ads, ioexcept.ads, i-vxwoio.adb,
! 	i-vxwoio.ads, math_lib.adb, s-assert.adb, s-assert.ads, s-asthan.ads,
! 	s-bitops.adb, s-bitops.ads, s-boarop.ads, s-carsi8.adb, s-carsi8.ads,
! 	s-carun8.adb, s-carun8.ads, s-casi16.adb, s-casi16.ads, s-casi32.adb,
! 	s-casi32.ads, s-casi64.adb, s-casi64.ads, s-casuti.adb, s-casuti.ads,
! 	s-caun16.adb, s-caun16.ads, s-caun32.adb, s-caun32.ads, s-caun64.adb,
! 	s-caun64.ads, s-direio.adb, s-direio.ads, sequenio.ads, s-errrep.adb,
! 	s-errrep.ads, s-exnint.adb, s-exnint.ads, s-exnllf.adb, s-exnllf.ads,
! 	s-exnlli.adb, s-exnlli.ads, s-expint.adb, s-expint.ads, s-explli.adb,
! 	s-explli.ads, s-expllu.adb, s-expllu.ads, s-expmod.adb, s-expmod.ads,
! 	s-expuns.adb, s-expuns.ads, s-fore.adb, s-fore.ads, s-geveop.adb,
! 	s-geveop.ads, s-htable.adb, s-htable.ads, s-imgbiu.adb, s-imgbiu.ads,
! 	s-imgboo.adb, s-imgboo.ads, s-imgcha.adb, s-imgcha.ads, s-imgdec.adb,
! 	s-imgdec.ads, s-imgenu.adb, s-imgenu.ads, s-imgint.adb, s-imgint.ads,
! 	s-imgllb.adb, s-imgllb.ads, s-imglld.adb, s-imglld.ads, s-imglli.adb,
! 	s-imglli.ads, s-imgllu.adb, s-imgllu.ads, s-imgllw.adb, s-imgllw.ads,
! 	s-imgrea.ads, s-imguns.adb, s-imguns.ads, s-imgwiu.adb, s-imgwiu.ads
! 	s-interr.ads, s-io.adb, s-mantis.adb, s-mantis.ads, s-osprim.ads,
! 	s-pack03.adb, s-pack03.ads, s-pack05.adb, s-pack05.ads, s-pack06.adb,
! 	s-pack06.ads, s-pack07.adb, s-pack07.ads, s-pack09.adb, s-pack09.ads,
! 	s-pack10.adb, s-pack10.ads, s-pack11.adb, s-pack11.ads, s-pack12.adb,
! 	s-pack12.ads, s-pack13.adb, s-pack13.ads, s-pack14.adb, s-pack14.ads,
! 	s-pack15.adb, s-pack15.ads, s-pack17.adb, s-pack17.ads, s-pack18.adb,
! 	s-pack18.ads, s-pack19.adb, s-pack19.ads, s-pack20.adb, s-pack20.ads,
! 	s-pack21.adb, s-pack21.ads, s-pack22.adb, s-pack22.ads, s-pack23.adb,
! 	s-pack23.ads, s-pack24.adb, s-pack24.ads, s-pack25.adb, s-pack25.ads,
! 	s-pack26.adb, s-pack26.ads, s-pack27.adb, s-pack27.ads, s-pack28.adb,
! 	s-pack28.ads, s-pack29.adb, s-pack29.ads, s-pack30.adb, s-pack30.ads,
! 	s-pack31.adb, s-pack31.ads, s-pack33.adb, s-pack33.ads, s-pack34.adb,
! 	s-pack34.ads, s-pack35.adb, s-pack35.ads, s-pack36.adb, s-pack36.ads,
! 	s-pack37.adb, s-pack37.ads, s-pack38.adb, s-pack38.ads, s-pack39.adb,
! 	s-pack39.ads, s-pack40.adb, s-pack40.ads, s-pack41.adb, s-pack41.ads,
! 	s-pack42.adb, s-pack42.ads, s-pack43.adb, s-pack43.ads, s-pack44.adb,
! 	s-pack44.ads, s-pack45.adb, s-pack45.ads, s-pack46.adb, s-pack46.ads,
! 	s-pack47.adb, s-pack47.ads, s-pack48.adb, s-pack48.ads, s-pack49.adb,
! 	s-pack49.ads, s-pack50.adb, s-pack50.ads, s-pack51.adb, s-pack51.ads,
! 	s-pack52.adb, s-pack52.ads, s-pack53.adb, s-pack53.ads, s-pack54.adb,
! 	s-pack54.ads, s-pack55.adb, s-pack55.ads, s-pack56.adb, s-pack56.ads,
! 	s-pack57.adb, s-pack57.ads, s-pack58.adb, s-pack58.ads, s-pack59.adb,
! 	s-pack59.ads, s-pack60.adb, s-pack60.ads, s-pack61.adb, s-pack61.ads,
! 	s-pack62.adb, s-pack62.ads, s-pack63.adb, s-pack63.ads, s-scaval.adb,
! 	s-scaval.ads, s-sequio.adb, s-sequio.ads, s-stache.adb, s-stache.ads,
! 	s-stratt.adb, s-stratt.ads, s-strcom.adb, s-strcom.ads, s-strops.adb,
! 	s-strops.ads, s-taasde.ads, s-tadeca.adb, s-tadeca.ads, s-tadert.adb,
! 	s-tadert.ads, s-taenca.adb, s-taenca.ads, s-taprob.adb, s-taprob.ads,
! 	s-tarest.adb, s-tarest.ads, s-tasdeb.adb, s-tasdeb.ads, s-tasini.adb,
! 	s-tasini.ads, s-taskin.adb, s-taskin.ads, s-tasque.adb, s-tasque.ads,
! 	s-tasren.ads, s-tasres.ads, s-tassta.adb, s-tassta.ads, s-tasuti.adb,
! 	s-tasuti.ads, s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads,
! 	s-tpoben.adb, s-tpoben.ads, s-tpobop.ads, s-tporft.adb, s-tposen.ads,
! 	s-traces.adb, s-traces.ads, s-tratas.adb, s-tratas.ads, s-valint.ads,
! 	s-unstyp.ads, s-veboop.adb, s-veboop.ads, s-vector.ads, s-vercon.adb,
! 	s-vercon.ads, s-wchcnv.adb, s-wchcnv.ads, s-wchjis.adb, s-wchjis.ads,
! 	s-wchstw.adb, s-wchstw.ads, s-wchwts.adb, s-wchwts.ads, s-widboo.adb,
! 	s-widboo.ads, s-widcha.adb, s-widcha.ads, s-widenu.adb, s-widenu.ads,
! 	s-widlli.adb, s-widlli.ads, s-widllu.adb, s-widllu.ads, s-wwdcha.ads,
! 	s-wwdenu.adb, s-wwdwch.ads, text_io.ads, s-stchop.ads, s-stchop.adb,
! 	s-stchop-vxworks.adb, a-intnam-darwin.ads, s-osinte-darwin.adb,
! 	s-osinte-darwin.ads, s-vxwork-x86.ads, a-numaux-darwin.ads,
! 	a-numaux-darwin.adb, a-chzla1.ads, a-chzla9.ads, a-lfztio.ads,
! 	a-liztio.ads, a-llfzti.ads, a-llizti.ads, a-sfztio.ads, a-siztio.ads,
! 	a-ssizti.ads, a-stzbou.adb, a-stzfix.adb, a-stzfix.ads, a-stzmap.adb,
! 	a-stzsea.adb, a-stzsup.adb, a-swunau.adb, a-swunau.ads, a-szuzti.adb,
! 	a-szuzti.ads, a-tiunio.ads, a-wwunio.ads, a-ztcoau.adb, a-ztcoau.ads,
! 	a-ztcoio.adb, a-ztcoio.ads, a-ztcstr.ads, a-ztdeau.adb, a-ztdeio.adb,
! 	a-ztenio.adb, a-ztexio.adb, a-ztfiio.adb, a-ztflio.adb, a-ztgeau.adb,
! 	a-ztinau.adb, a-ztinio.adb, a-ztinio.ads, a-ztmoau.adb, a-ztmoio.adb,
! 	a-zttest.adb, a-zzunio.ads, g-utf_32.adb: Fix header style.
! 	"GNU Ada" to GNAT, use proper casing for RUN-TIME.
! 
! 2005-06-14  Jose Ruiz  <ruiz@adacore.com>
! 	    Arnaud Charlet  <charlet@adacore.com>
! 
! 	* a-sytaco.ads, a-sytaco.adb (Suspension_Object): These objects are no
! 	longer protected objects. They have been replaced by lower-level
! 	suspension objects made up by a mutex and a condition variable (or
! 	their equivalent given a particular OS) plus some internal data to
! 	reflect the state of the suspension object.
! 	(Initialize, Finalize): Add this initialization procedure for
! 	Suspension_Object, which is a controlled type.
! 	(Finalize): Add the finalization procedure for Suspension_Object,
! 	which is a controlled type.
! 
! 	* a-sytaco-vxworks.ads, a-sytaco-vxworks.adb: Remove this version of
! 	Ada.Synchronous_Task_Control because there is no longer a need for a
! 	VxWorks specific version of this package. Target dependencies
! 	has been moved to System.Task_Primitives.Operations.
! 
! 	* s-osinte-mingw.ads (pCRITICAL_SECTION): Remove this type which is no
! 	longer needed.
! 	(InitializeCriticalSection, EnterCriticalSection,
! 	LeaveCriticalSection, DeleteCriticalSection): Replace the type
! 	pCriticalSection by an anonymous access type so that we avoid problems
! 	of accessibility to local objects.
! 
! 	* s-taprop.ads, s-taprop-posix.adb, s-taprop-vxworks.adb,
! 	s-taprop-mingw.adb, s-taprop-vms.adb, s-taprop-solaris.adb,
! 	s-taprop-os2.adb, s-taprop-dummy.adb, s-taprop-hpux-dce.adb,
! 	s-taprop-linux.adb, s-taprop-irix.adb, s-taprop-irix-athread.adb,
! 	s-taprop-tru64.adb, s-taprop-lynxos.adb (Elaboration Code): No longer
! 	set the environment task mask here.
! 	(Current_State): Add this function that returns the state of the
! 	suspension object.
! 	(Set_False): Add this procedure that sets the state of the suspension
! 	object to False.
! 	(Set_True): Add this procedure that sets the state of the suspension
! 	object to True, releasing the task that was suspended, if any.
! 	(Suspend_Until_True): Add this procedure that blocks the calling task
! 	until the state of the object is True. Program_Error is raised if
! 	another task is already waiting on that suspension object.
! 	(Initialize): Add this procedure for initializing the suspension
! 	object. It initializes the mutex and the condition variable which are
! 	used for synchronization and queuing, and it sets the internal state
! 	to False.
! 	(Finalize): Add this procedure for finalizing the suspension object,
! 	destroying the mutex and the condition variable.
! 
! 	* s-taspri-posix.ads, s-taspri-vxworks.ads, s-taspri-mingw.ads,
! 	s-taspri-vms.ads, s-taspri-solaris.ads, s-taspri-os2.ads,
! 	s-taspri-dummy.ads, s-taspri-hpux-dce.ads, s-taspri-linux.ads,
! 	s-taspri-tru64.ads, s-taspri-lynxos.ads (Suspension_Object): New object
! 	which provides a low-level abstraction (using operating system
! 	primitives) for Ada.Synchronous_Task_Control.
! 	This object is made up by a mutex (for ensuring mutual exclusion), a
! 	condition variable (for queuing threads until the condition is
! 	signaled), a Boolean (State) indicating whether the object is open,
! 	and a Boolean (Waiting) reflecting whether there is a task already
! 	suspended on this object.
! 
! 	* s-intman.ads, s-intman-irix.adb, s-intman-irix-athread.adb,
! 	s-intman-dummy.adb, s-intman-solaris.adb, s-intman-vms.adb,
! 	s-intman-vms.ads, s-intman-mingw.adb,
! 	(Initialize_Interrupts): Removed, no longer used.
! 
! 	* s-inmaop-posix.adb, s-inmaop-vms.adb, s-inmaop-dummy.adb,
! 	(Setup_Interrupt_Mask): New procedure.
! 
! 	* s-intman-vxworks.ads, s-intman-vxworks.adb:  Update comments.
! 
! 	* s-inmaop.ads (Setup_Interrupt_Mask): New procedure
! 
! 	* s-interr.adb: Add explicit call to Setup_Interrupt_Mask now that
! 	this is no longer done in the body of s-taprop
! 	(Server_Task): Explicitely test for Pending_Action in case
! 	System.Parameters.No_Abort is True.
! 
! 	* s-taasde.adb: Add explicit call to Setup_Interrupt_Mask now that this
! 	is no longer done in the body of s-taprop
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* system-unixware.ads, system-linux-ia64.ads, system-freebsd-x86.ads,
! 	system-lynxos-ppc.ads, system-lynxos-x86.ads, system-linux-x86_64.ads,
! 	system-tru64.ads, system-aix.ads, system-vxworks-sparcv9.ads,
! 	system-vxworks-xscale.ads, system-solaris-x86.ads, system-irix-o32.ads,
! 	system-irix-n32.ads, system-hpux.ads, system-vxworks-m68k.ads,
! 	system-linux-x86.ads, system-vxworks-mips.ads, system-vxworks-mips.ads,
! 	system-os2.ads, system-interix.ads, system-solaris-sparc.ads,
! 	system-solaris-sparcv9.ads, system-vms.ads, system-mingw.ads,
! 	system-vms-zcx.ads, system-vxworks-ppc.ads, system.ads,
! 	system-darwin-ppc.ads, system-vxworks-x86.ads, system-linux-ppc.ads,
! 	system-linux-hppa.ads, system-vms_64.ads,
! 	system-vxworks-alpha.ads: Minor comment update for
! 	AI-362 (unit is Pure).
! 
! 	* a-chahan.ads, a-chahan.adb: Move Wide_Wide functions to Conversions
! 	Add pragma Pure_05 for AI-362
! 	Make remaining conversion functions obsolescent in Ada 95
! 
! 	* impunit.adb: Change a-swunha to a-swuwha and a-szunha to a-szuzha
! 	Make Ada.Wide_Characters[.Unicode] available in Ada 95 mode
! 	Add entries for a-wichun and a-zchuni
! 	Add a-widcha a-zchara for AI-395
! 	Add a-chacon (Ada.Characters.Conversions) to list of Ada 2005 routines
! 
! 	* Makefile.rtl: Change a-swunha to a-swuwha and a-szunha to a-szuzha
! 	Add entries for a-wichun.o and a-zchuni.o
! 	Entries for a-widcha.o and a-zchara.o
! 	Add entry for a-chacon.o
! 
! 	* a-ztenau.adb: Add with of Ada.Characters.Conversions
! 
! 	* a-chacon.ads, a-chacon.adb: New files.
! 
! 	* a-taside.adb, a-exstat.adb, a-excach.adb: Add warnings off to allow
! 	categorization violations.
! 
! 	* a-strmap.ads: Add pragma Pure_05 for AI-362
! 	* a-strmap.ads: Add note on implicit categorization for AI-362
! 
! 	* a-tgdico.ads, a-taside.ads: Add pragma Preelaborate_05 for AI-362
! 
! 	* par-prag.adb: Dummy entry for pragma Persistent_BSS
! 	Set Ada_Version_Explicit, for implementation of AI-362
! 	Add processing for pragma Pure_05 and Preelaborate_05
! 	Add entry for Assertion_Policy pragma
! 
! 	* sem.adb: Make sure predefined units are compiled with GNAT_Mode true
! 	when needed for proper processing of categorization stuff
! 
! 	* sem_cat.adb:
! 	For several cases, make errors in preealborate units warnings,
! 	instead of errors, if GNAT_Mode is set. For AI-362.
! 
! 	* sem_elab.adb (Check_Elab_Call): Call to non-static subprogram in
! 	preelaborate unit is now warning if in GNAT mode
! 
! 	* s-stoele.ads: Document AI-362 for pragma preelaborate
! 
! 2005-06-14  Doug Rupp  <rupp@adacore.com>
! 
! 	* s-parame-vms.ads, s-parame-hpux.ads, s-parame-vms-restrict.ads,
! 	s-parame-ae653.ads, s-parame.ads, s-parame-vxworks.ads:
! 	Default_Exception_Msg_Max_Length: new parameter.
! 
! 	* a-except.ads: (Exception_Msg_Max_Length): Set to
! 	System.Parameters.Default_Exception_Msg_Max_Length
! 	Add pragma Preelaborate_05 for AI-362
! 	Add warnings off to allow categorization violations for AI-362
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* gnatsym.adb: Adapt to modification of package Symbols: procedure
! 	Process is now in package Processing.
! 
! 	* symbols.ads, symbols.adb:
! 	(Processing): New package, containing procedure Process
! 
! 	* symbols-vms-alpha.adb:
! 	Replaced by symbols-vms.adb and symbols-processing-vms-alpha.adb
! 
! 	* symbols-vms.adb, symbols-processing-vms-alpha.adb,
! 	symbols-processing-vms-ia64.adb: New files.
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* mlib-tgt-mingw.adb (Build_Dynamic_Library): Replace the previous
! 	implementation. This new version generates the proper DllMain routine
! 	to initialize the SAL. The DllMain is generated in Ada and compiled
! 	before being added as option to the library build command.
! 
! 2005-06-14  Doug Rupp  <rupp@adacore.com>
! 	    Pascal Obry  <obry@adacore.com>
! 
! 	* adaint.c (__gnat_to_canonical_file_spec): Check for error returns in
! 	call to decc$translate_vms.
! 	(__gnat_locate_regular_file): Check if the path_val contains quotes. We
! 	need to remove those quotes before catenating the filename.
! 	(__gnat_locate_exec_on_path): improvements to the Win32 section:
! 	* avoid allocating the memory twice for better efficiency;
! 	* allocate 32K buffer for environment expansion as suggested by MSDN;
! 	* prepend ".;" to the path so that current directory is searched too.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-except.adb (Exception_Identity): return Null_Id for null occurrence
! 	instead of raising CE (AI-241)
! 	Add warnings off to allow categorization violations for AI-362
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* ali-util.adb, gnatbind.adb: Remove references to
! 	Force_RM_Elaboration_Order.
! 
! 	* switch-b.adb: Remove recognition of -f switch
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* a-stzunb.adb, a-stwiun.adb, a-strunb.adb (Realloc_For_Chunk): New
! 	implementation which is slightly more efficient.
! 
! 2005-06-14  Gary Dismukes  <dismukes@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 
! 	* exp_ch4.adb (Expand_Allocator_Expression): When an initialized
! 	allocator's designated type is a class-wide type, and compiling for
! 	Ada 2005, emit a run-time check that the accessibility level of the
! 	type given in the allocator's expression is not deeper than the level
! 	of the allocator's access type.
! 
! 	(Tagged_Membership): Modified to gives support to abstract interface
! 	types.
! 
! 	* a-tags.ads, a-tags.adb (type Type_Specific_Data): Add component
! 	Access_Level.
! 	(Descendant_Tag): New predefined function
! 	(Is_Descendant_At_Same_Level): New predefined function
! 	(Get_Access_Level): New private function
! 	(Set_Access_Level): New private procedure
! 	(IW_Membership): New function. Given the tag of an object and the tag
! 	associated with an interface, evaluate if the object implements the
! 	interface.
! 	(Register_Interface_Tag): New procedure used to initialize the table of
! 	interfaces used by the IW_Membership function.
! 	(Set_Offset_To_Top): Initialize the Offset_To_Top field in the prologue
! 	of the dispatch table.
! 	(Inherit_TSD): Modified to copy the table of ancestor tags plus the
! 	table of interfaces of the parent.
! 	(Expanded_Name): Raise Tag_Error if the passed tag equals No_Tag.
! 	(External_Tag): Raise Tag_Error if the passed tag equals No_Tag.
! 	(Parent_Tag): Return No_Tag in the case of a root-level tagged type,
! 	and raise Tag_Error if the passed tag equalis No_Tag, to conform with
! 	Ada 2005 semantics for the new predefined function.
! 
! 	* exp_attr.adb (Expand_N_Attribute, case Attribute_Input): Generate
! 	call to Descendant_Tag rather than Internal_Tag.
! 	(Expand_N_Attribute, case Attribute_Output): Emit a check to ensure that
! 	the accessibility level of the attribute's Item parameter is not deeper
! 	than the level of the attribute's prefix type. Tag_Error is raised if
! 	the check fails. The check is only emitted for Ada_05.
! 	(Find_Stream_Subprogram): If a TSS exists on the type itself for the
! 	requested stream attribute, use it.
! 	(Expand_N_Attribute_Reference): If the designated type is an interface
! 	then rewrite the referenced object as a conversion to force the
! 	displacement of the pointer to the secondary dispatch table.
! 	(Expand_N_Attribute_Reference, case 'Constrained): Return false if this
! 	is a dereference of an object with a constrained partial view.
! 
! 	* exp_ch5.adb (Expand_N_Return_Statement): When a function's result
! 	type is a class-wide type, emit a run-time check that the accessibility
! 	level of the returned object is not deeper than the level of the
! 	function's master (only when compiling for Ada 2005).
! 
! 	* exp_disp.ads, exp_disp.adb (Ada_Actions, Action_Is_Proc,
! 	Action_Nb_Arg): Add entries for new Get_Access_Level and
! 	Set_Access_Level routines in these tables.
! 	(Make_DT): Generate a call to set the accessibility level of the
! 	tagged type in its TSD.
! 	(Make_DT): Code cleanup. The functionality of generating all the
! 	secondary dispatch tables has been moved to freeze_record_type.
! 	(Make_Abstract_Interface_DT): Minor code cleanup.
! 	(Set_All_DT_Position): Code cleanup. As part of the code cleanup
! 	this subprogram implements a new algorithm that provides the
! 	same functionality and it is more clear in case of primitives
! 	associated with abstract interfaces.
! 	(Set_All_Interfaces_DTC_Entity): Removed. As part of the code
! 	clean up, the functionality of this subprogram is now provided
! 	by Set_All_DT_Position.
! 	(Write_DT): New subprogram: a debugging procedure designed to be called
! 	within gdb to display the dispatch tables associated with a tagged
! 	type.
! 	(Collect_All_Interfaces): New subprogram that collects the whole list
! 	of interfaces that are directly or indirectly implemented by a tagged
! 	type.
! 	(Default_Prim_Op_Position): New subprogram that returns the fixed
! 	position in the dispatch table of the default primitive operations.
! 	(Expand_Interface_Actuals): New subprogram to generate code that
! 	displaces all the actuals corresponding to class-wide interfaces to
! 	reference the interface tag of the actual object.
! 	(Expand_Interface_Conversion): New subprogram. Reference the base of
! 	the object to give access to the interface tag associated with the
! 	secondary dispatch table.
! 	(Expand_Interface_Thunk): New subprogram that generates the code of the
! 	thunk. This is required for compatibility with the C+ ABI.
! 	(Make_Abstract_Interface_DT): New subprogram that generate the
! 	declarations for the secondary dispatch tables associated with an
! 	abstract interface.
! 	(Set_All_Interfaces_DTC_Entity): New subprogram that sets the DTC_Entity
! 	attribute for each primitive operation covering interface subprograms
! 	(Expand_Dispatching_Call, Fill_DT_Entry, Make_DT, Set_All_DT_Position):
! 	These subprograms were upgraded to give support to abstract interfaces
! 
! 	* rtsfind.ads (type RE_Id): Add RE_Descendant_Tag,
! 	RE_Is_Descendant_At_Same_Level, RE_Get_Access_Level, and
! 	RE_Set_Access_Level.
! 	(RE_Unit_Table): Add entries for new Ada.Tags operations.
! 	Add support to call the followig new run-time subprograms:
! 	IW_Membership, Register_Interface_Tag, and Set_Offset_To_Top
! 
! 	* sem_ch3.adb (Constant_Redeclaration): Allow a deferred constant to
! 	match its full declaration when both have an access definition with
! 	statically matching designated subtypes.
! 	(Analyze_Component_Declaration): Delete commented out code that was
! 	incorrectly setting the scope of an anonymous access component's type.
! 	(Process_Discriminants): Set Is_Local_Anonymous_Access for the type of
! 	an access discriminant when the containing type is nonlimited.
! 	(Make_Incomplete_Type_Declaration): Create an incomplete type
! 	declaration for a record type that includes self-referential access
! 	components.
! 	(Check_Anonymous_Access_Types): Before full analysis of a record type
! 	declaration, create anonymous access types for each self-referential
! 	access component.
! 	(Analyze_Component_Declaration, Array_Type_Declaration): Indicate that
! 	an access component in this context is a Local_Anonymous_Access, for
! 	proper accessibility checks.
! 	(Access_Definition): Set properly the scope of the anonymous access type
! 	created for a stand-alone access object.
! 	(Find_Type_Of_Object): An object declaration may be given with an access
! 	definition.
! 	(Complete_Subprograms_Derivation): New subprogram used to complete
! 	type derivation of private tagged types implementing interfaces.
! 	In this case some interface primitives may have been overriden
! 	with the partial-view and, instead of re-calculating them, they
! 	are included in the list of primitive operations of the full-view.
! 	(Build_Derived_Record_Type): Modified to give support to private
! 	types implemening interfaces.
! 	(Access_Definition): Reject ALL on anonymous access types.
! 	(Build_Derived_Record_Type): In the case of Ada 2005, allow a tagged
! 	type derivation to occur at a deeper accessibility level than the
! 	parent type.
! 	For the case of derivation within a generic body however, disallow the
! 	derivation if the derived type has an ancestor that is a formal type
! 	declared in the formal part of an enclosing generic.
! 	(Analyze_Object_Declaration): For protected objects, remove the check
! 	that they cannot contain interrupt handlers if not declared at library
! 	level.
! 	(Add_Interface_Tag_Components): New subprogram to add the tag components
! 	corresponding to all the abstract interface types implemented by a
! 	record type or a derived record type.
! 	(Analyze_Private_Extension_Declaration, Build_Derived_Record_Type,
! 	Derived_Type_Declaration, Find_Type_Name, Inherit_Components,
! 	Process_Full_View, Record_Type_Declaration): Modified to give
! 	support to abstract interface types
! 	(Collect_Interfaces): New subprogram that collects the list of
! 	interfaces that are not already implemented by the ancestors
! 	(Process_Full_View): Set flag Has_Partial_Constrained_View appropriately
! 	when partial view has no discriminants and full view has defaults.
! 	(Constrain_Access): Reject a constraint on a general access type
! 	if the discriminants of the designated type have defaults.
! 	(Access_Subprogram_Declaration): Associate the Itype node with the inner
! 	full-type declaration or subprogram spec. This is required to handle
! 	nested anonymous declarations.
! 	(Analyze_Private_Extension_Declaration, Build_Derived_Record_Type,
! 	Derived_Type_Declaration, Find_Type_Name, Inherit_Components,
! 	Process_Full_View, Record_Type_Declaration): Modified to give
! 	support to abstract interface types
! 	(Derive_Subprograms): Addition of a new formal to indicate if
! 	we are in the case of an abstact-interface derivation
! 	(Find_Type_Of_Subtype_Indic): Moved from the body of the package
! 	to the specification because it is requied to analyze all the
! 	identifiers found in a list of interfaces
! 
! 	* debug.adb: Complete documentation of flag "-gnatdZ"
! 
! 	* exp_ch3.adb: Implement config version of persistent_bss pragma
! 	(Check_Stream_Attributes): Use Stream_Attribute_Available instead of
! 	testing for TSS presence to properly enforce visibility rules.
! 	(Freeze_Record_Type): Code cleanup. Modified to call the subprogram
! 	Make_Abstract_Interfaces_DT to generate the secondary tables
! 	associated with abstract interfaces.
! 	(Build_Init_Procedure): Modified to initialize all the tags
! 	corresponding.
! 	(Component_Needs_Simple_Initialization): Similar to other tags,
! 	interface tags do not need initialization.
! 	(Freeze_Record_Type): Modified to give support to abstract interface
! 	types.
! 	(Expand_N_Object_Declaration): Do not generate an initialization for
! 	a scalar temporary marked as internal.
! 
! 	* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Handle properly an
! 	in-out parameter that is a component in an initialization procedure,
! 	whose constraint might depend on discriminants, and that may be
! 	misaligned because of packing or representation clauses.
! 	(Is_Legal_Copy): New predicate to determine whether a possibly
! 	misaligned in-out actual can actually be passed by copy/return. This
! 	is an error in case the type is by_reference, and a warning if this is
! 	the consequence of a DEC import pragma on the subprogram.
! 	(Expand_Call, Freeze_Subprogram): Modified to give support to abstract
! 	interface types
! 	(Expand_Inlined_Call): Mark temporary generated for the return value as
! 	internal, so that no useless scalar normalization is generated for it.
! 	(Expand_N_Subprogram_Declaration): Save unanalyzed body so calls to
! 	null procedure can always be inlined.
! 	(Expand_N_Subprogram_Declaration): If this is the declaration of a null
! 	procedure, generate an explicit empty body for it.
! 
! 	* exp_util.ads, exp_util.adb (Find_Interface_ADT): New subprogram.
! 	Given a type implementing an interface, returns the corresponding
! 	access_disp_table value.
! 	(Find_Interface_Tag): New subprogram. Given a type implementing an
! 	interface, returns the record component containing the tag of the
! 	interface.
! 	(Find_Interface_Tag): New overloaded subprogram. Subsidiary to the
! 	previous ones that return the corresponding tag and access_disp_table
! 	entities.
! 	(Is_Predefined_Dispatching_Operation): Determines if a subprogram
! 	is a predefined primitive operation.
! 	(Expand_Subtype_From_Expr): If the expression is a selected component
! 	within an initialization procedure, compute its actual subtype, because
! 	the component may depend on the discriminants of the enclosing record.
! 
! 	* i-cpp.ads, i-cpp.adb:
! 	This package has been left available for compatibility with previous
! 	versions of the frontend. As part of the new layout this is now a
! 	dummy package that uses declarations available at a-tags.ads
! 
! 	* par-ch3.adb (P_Identifier_Declarations): Give an error for use of
! 	"constant access" and "aliased [constant] access" when not compiling
! 	with -gnat05.
! 	Suppress Ada 2005 keyword warning if -gnatwY used
! 	(P_Identifier_Declarations): Add support for object declarations with
! 	access definitions.
! 	(Private_Extension_Declaration): Complete the documentation
! 	(P_Derived_Type_Def_Or_Private_Ext_Decl): Fill the inteface_list
! 	attribute in case of private extension declaration
! 	(P_Type_Declaration): Mark as "abstract" the type declarations
! 	corresponding with protected, synchronized and task interfaces
! 	(P_Declarative_Items): "not" and "overriding" are overriding indicators
! 	for a subprogram or instance declaration.
! 
! 	* sem_ch12.adb (Analyze_Subprogram_Instantiation): Verify that an
! 	instantiation that is a dispatching operation has controlling access
! 	parameters that are null excluding.
! 	Save and restore Ada_Version_Explicit, for implementation of AI-362
! 	(Validate_Derived_Type_Instance): Add check for abstract interface
! 	types.
! 	(Analyze_Formal_Package): Establish Instantiation source for the copy of
! 	the generic that is created to represent the formal package.
! 	(Analyze_Package_Instantiation): Instantiate body immediately if the
! 	package is a predefined unit that contains inlined subprograms, and
! 	we are compiling for a Configurable_Run_Time.
! 	(Instantiate_Formal_Subprogram): Indicate that null default subprogram
! 	If the program has a null default, generate an empty body for it.
! 
! 	* sem_ch6.adb, sem_ch9.adb (Analyze_Subprograms_Declaration): Update
! 	error message condition, null procedures are correctly detected now.
! 	(New_Overloaded_Entity): Bypass trivial overriding indicator check
! 	for subprograms in the context of protected types. Instead, the
! 	indicator is examined in Sem_Ch9 while analysing the subprogram
! 	declaration.
! 	(Check_Overriding_Indicator): Check consistency of overriding indicator
! 	on subprogram stubs as well.
! 	(Analyze_Subprogram_Declaration): Diagnose null procedures declared at
! 	the library level.
! 	(Analize_Subprogram_Specification): When analyzing a subprogram in which
! 	the type of the first formal is a concurrent type, replace this type
! 	by the corresponding record type.
! 	(Analyze_Subprogram_Body): Undo the previous work.
! 	(Analyze_Procedure_Call): If the call has the form Object.Op, the
! 	analysis of the prefix ends up analyzing the call itself, after which
! 	we are done.
! 	(Has_Interface_Formals): New subprogram subsidiary to analyze
! 	subprogram_specification that returns true if some non
! 	class-wide interface subprogram is found
! 	(New_Overloaded_Entity): Modified to give support to abstract
! 	interface types
! 	(Conforming_Types): In Ada 2005 mode, conformance checking of anonymous
! 	access to subprograms must be recursive.
! 	(Is_Unchecked_Conversion): Improve the test that recognizes
! 	instantiations of Unchecked_Conversion, and allows them in bodies that
! 	are to be inlined by the front-end. When the body comes from an
! 	instantiation, a reference to Unchecked_Conversion will be an
! 	Expanded_Name, even though the body has not been analyzed yet.
! 	Replace Is_Overriding and Not_Overriding in subprogram_indication with
! 	Must_Override and Must_Not_Override, to better express intent of AI.
! 	(Analyze_Subprogram_Body): If an overriding indicator is given, check
! 	that it is consistent with the overrinding status of the subprogram
! 	at this point.
! 	(Analyze_Subprogram_Declaration): Indicate that a null procedure is
! 	always inlined.
! 	If the subprogram is a null procedure, indicate that it does not need
! 	a completion.
! 
! 	* sem_disp.adb (Check_Controlling_Type): Give support to entities
! 	available through limited-with clauses.
! 	(Check_Dispatching_Operation): A stub acts like a body, and therefore is
! 	allowed as the last primitive of a tagged type if it has no previous
! 	spec.
! 	(Override_Dispatching_Operation, Check_Dispatching_Operation): Modified
! 	to give support to abstract interface types
! 
! 	* sem_res.adb (Valid_Conversion): Perform an accessibility level check
! 	in the case where the target type is an anonymous access type of an
! 	object or component (that is, when Is_Local_Anonymous_Access is true).
! 	Prevent the special checks for conversions of access discriminants in
! 	the case where the discriminant belongs to a nonlimited type, since
! 	such discriminants have their accessibility level defined in the same
! 	way as a normal component of an anonymous access type.
! 	(Resolve_Allocator): When an allocator's designated type is a class-wide
! 	type, check that the accessibility level of type given in the
! 	allocator's expression or subtype indication is not statically deeper
! 	than the level of the allocator's access type.
! 	(Check_Discriminant_Use): Diagnose discriminant given by an expanded
! 	name in a discriminant constraint of a record component.
! 	(Resolve_Explicit_Dereference): Do not check whether the type is
! 	incomplete when the dereference is a use of an access discriminant in
! 	an initialization procedure.
! 	(Resolve_Type_Conversion): Handle conversions to abstract interface
! 	types.
! 	(Valid_Tagged_Conversion): The conversion of a tagged type to an
! 	abstract interface type is always valid.
! 	(Valid_Conversion): Modified to give support to abstract interface types
! 	(Resolve_Actuals): Enable full error reporting on view conversions
! 	between unrelated by_reference array types.
! 	The rule for view conversions of arrays with aliased components is
! 	weakened in Ada 2005.
! 	Call to obsolescent subprogram is now considered to be a violation of
! 	pragma Restrictions (No_Obsolescent_Features).
! 	(Check_Direct_Boolean_Operator): If the boolean operation has been
! 	constant-folded, there is nothing to check.
! 	(Resolve_Comparison_Op, Resolve_Equality_Op, Resolve_Boolean_Op): Defer
! 	check on possible violation of restriction No_Direct_Boolean_Operators
! 	until after expansion of operands, to prevent spurious errors when
! 	operation is constant-folded.
! 
! 	* sem_type.ads, sem_type.adb (Covers, Intersect_Types, Specific_Type,
! 	Has_Compatible_Type): Modified to give support to abstract interface
! 	types.
! 	(Interface_Present_In_Ancestor): New function to theck if some ancestor
! 	of a given type implements a given interface
! 
! 	* sem_ch4.adb (Analyze_Call): Handle properly an indirect call whose
! 	prefix is a parameterless function that returns an access_to_procedure.
! 	(Transform_Object_Operation): Handle properly function calls of the
! 	form Obj.Op (X), which prior to analysis appear as indexed components.
! 	(Analyze_One_Call): Complete the error notification to help new Ada
! 	2005 users.
! 	(Analyze_Allocator): For an allocator without an initial value, where
! 	the designated type has a constrained partial view, a discriminant
! 	constraint is illegal.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-textio.adb (Set_Col): Fix two errors noticed recently, having to
! 	do with treatment of Set_Col when positioned at end of line character.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* atree.adb: (Elist*): Protect against uninitialized field
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* checks.adb (Install_Null_Excluding_Check): Do not generate checks
! 	for an attribute reference that returns an access type.
! 	(Apply_Discriminant_Check): No need for check if (designated) type has
! 	constrained partial view.
! 
! 	(Apply_Float_Conversion_Check): Generate a short-circuit expression for
! 	both bound checks, rather than a conjunction.
! 	(Insert_Valid_Check): If the expression is an actual that is an indexed
! 	component of a bit-packed array, force expansion of the packed element
! 	reference, because it is specifically inhibited elsewhere.
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* clean.adb (Clean_Project): Correctly delete executable specified as
! 	absolute path names.
! 
! 	* make.adb (Gnatmake): Allow relative executable path names with
! 	directory information even when project files are used.
! 	(Change_To_Object_Directory): Fail gracefully when unable to change
! 	current working directory to object directory of a project.
! 	(Gnatmake): Remove exception handler that could no longer be exercized
! 	(Compile_Sources.Compile): Use deep copies of arguments, as some of them
! 	may be deallocated by Normalize_Arguments.
! 	(Collect_Arguments): Eliminate empty arguments
! 
! 	* gnatcmd.adb (All_Projects): New Boolean flag, initialized to False,
! 	and set to True when -U is used for GNAT PRETTY or GNAT METRIC.
! 	(Check_Project): Return False when Project is No_Project. Return True
! 	when All_Projects is True.
! 	(GNATCmd): Recognize switch -U for GNAT PRETTY and GNAT METRIC and set
! 	All_Projects to True.
! 	Minor reformatting
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Hristian Kirtchev  <kirtchev@adacore.com>
! 	    Gary Dismukes  <dismukes@adacore.com>
! 
! 	* einfo.ads, einfo.adb (Is_Local_Anonymous_Access): New flag on
! 	anonymous access types, to indicate that the accessibility level of
! 	the type is determined by that of the enclosing declaration.
! 	(Has_Persistent_BSS): New flag
! 	(Set_Is_Primitive_Wrapper): Upgrade the barrier to allow the usage
! 	of this attribute with functions.
! 	(Is_Primitive_Wrapper): Remove the barrier.
! 	(Has_Specified_Stream_Input, Has_Specified_Stream_Output,
! 	Has_Specified_Stream_Read, Has_Specified_Stream_Write):
! 	New subprograms.
! 	(Set_Has_Specified_Stream_Input, Set_Has_Specified_Stream_Output,
! 	Set_Has_Specified_Stream_Read, Set_Has_Specified_Stream_Write):
! 	New subprograms.
! 	(Is_Pure_Unit_Access_Type): New flag
! 	(Abstract_Interfaces): Complete the assertion to cover all usages.
! 	(Set_Is_Interface): Complete the assertion to cover all usages.
! 	(Is_Primitive_Wrapper): New attribute.
! 	(Is_Obsolescent): Now applies to all entities (though it is only set
! 	for subprograms currently)
! 	New flag:  Has_Constrained_Partial_View, to implemente Ada 2005 AI-363,
! 	which solves various problems concerning access subtypes.
! 	(Has_Persistent_BSS): New flag
! 	(Is_Primitive_Wrapper, Set_Primitive_Wrapper): Code cleanup.
! 	Remove these subprograms because this attribute is currently
! 	not used.
! 	New entity flags:
! 	Has_Specified_Stream_Input (Flag190)
! 	Has_Specified_Stream_Output (Flag191)
! 	Has_Specified_Stream_Read (Flag192)
! 	Has_Specified_Stream_Write (Flag193)
! 	Present in all type and subtype entities. Set for a given view if the
! 	corresponding stream-oriented attribute has been defined by an
! 	attribute definition clause. When such a clause occurs, a TSS is set
! 	on the underlying full view; the flags are used to track visibility of
! 	the attribute definition clause for partial or incomplete views.
! 	(Is_Pure_Unit_Access_Type): New flag
! 	Clarify use of Is_Internal.
! 	(Is_Primitive_Wrapper): New attribute present in primitive subprograms
! 	internally generated to wrap the invocation of tasks and protected
! 	types that implement interfaces.
! 	(Implementation_Base_Type): Documentation correction
! 	(Is_Obsolescent): Now applies to all entities (though it is only set
! 	for subprograms currently)
! 	New flag:  Has_Constrained_Partial_View, to implement Ada 2005 AI-363,
! 	which solves various problems concerning access subtypes.
! 
! 	* exp_ch9.adb (Type_Conformant_Parameters): Introduce mode conformance
! 	for examined parameters. Identify unequal parameter list lengths as
! 	non-conformant parameters.
! 	(Overriding_Possible): Do not check for "All" qualifier in declaration
! 	of controlling access parameter, following prescription of AI-404.
! 	(Build_Entry_Wrapper_Spec, Build_Entry_Wrapper_Body): New subprograms
! 	that build the procedure body that wraps an entry invocation
! 	(Build_Corresponding_Record, Build_Protected_Sub_Specification,
! 	Expand_N_Protected_Body, Expand_N_Protected_Type_Declaration,
! 	Expand_N_Task_Body, Expand_N_Task_Type_Declaration): Modified to
! 	give support to abstract interface types
! 
! 	* freeze.adb (Freeze_Entity): Issue error message if
! 	Is_Pure_Unit_Access_Type set, unless we are in Ada 2005 mode and the
! 	type has no storage pool (Ada 2005) AI-366.
! 	Also modified to give support to abstract interface types
! 	(Freeze_Subprogram): Issue an error for a dispatching subprogram with an
! 	Inline_Always pragma.
! 
! 	* par-ch9.adb (P_Task_Items): Reserved words "not" or "overriding" may
! 	now begin an entry declaration.
! 	(P_Entry_Or_Subprogram_With_Indicator): New procedure in
! 	P_Protected_Operation_Declaration_Opt. Parse an entry declaration or
! 	a subprogram declaration preceded by an overriding indicator.
! 	(P_Protected_Operation_Declaration_Opt): Add case for parsing entry
! 	declarations or subprogram declarations preceded by reserved words
! 	"not" or "overriding".
! 	(P_Entry_Declaration): Update comment. Parse and check overriding
! 	indicator, set semantic flags of entry declarations.
! 	(P_Task): New error message in case of private applied
! 	to a task type declaration.
! 	(P_Protected): New error message in case of private applied
! 	to a task type declaration.
! 
! 	* sem_ch7.adb (Preserve_Full_Attributes): Modified to handle the case
! 	in which the full view of a type implementing an interface is a
! 	concurrent type.
! 	(Has_Overriding_Pragma): Remove obsolete implementation of AI-218.
! 	Declare_Inherited_Private_Subprograms): If an explicit operation
! 	overrides an operation that is inherited in the private part, mark the
! 	explicit one as overriding, to enable overriding indicator checks.
! 	(Preserve_Full_Attributes): Propagate Is_Unchecked_Union attribute from
! 	full view to partial view, to simplify handling in back-end.
! 
! 	* sprint.adb: Print interface lists where needed: derived types,
! 	protected types, task types.
! 	output "is null" for null procedures. Part of implementation of
! 
! 	* sem_cat.adb (Validate_Access_Type_Declaration): Implement AI-366
! 	relaxation of rules for access types in pure, shared passive partitions.
! 
! 	* exp_strm.adb (Build_Mutable_Record_Read_Procedure): Reorganize to
! 	first read discriminants into temporary objects, performing checks on
! 	the read values, then possibly performing discriminant checks on the
! 	actual (if it is constrained), and only finally reading the components
! 	into a constrained temporary object.
! 	(Build_Elementary_Input_Call): Adjust the specific circuitry for the
! 	case of reading discriminants of a mutable record type to recognize
! 	the new form of the code generated by
! 	Build_Mutable_Record_Read_Procedure.
! 
! 	* exp_tss.ads, exp_tss.adb (Make_Init_Proc_Name): Reimplement in terms
! 	of a simple call to Make_TSS_Name.
! 	(Make_TSS_Name_Local): Add the TSS name as the last thing in the name
! 	buffer, in order for Is_TSS to work correctly on local TSS names.
! 
! 	* sem_attr.ads, sem_attr.adb (Resolve_Attribute, case 'Access): Use flag
! 	Is_Local_Anonymous_Access to check legaliy of attributes in the
! 	context of  access components and stand-alone access objects.
! 	(Stream_Attribute_Available): In Ada 95 mode, a stream attribute is
! 	treated as available for a limited private type if there is an
! 	attribute_definition_clause that applies to its full view, but not in
! 	other cases where the attribute is available for the full view
! 	(specifically, the sole fact that the full view is non-limited does not
! 	make the attribute available for the partial view).
! 	(Build_Access_Subprogram_Type): Diagnose attempt to apply 'access to a
! 	non-overloaded intrinsic subprogram.
! 	(Check_Stream_Attribute): Reject an attribute reference for an
! 	unavailable stream attribute even if the prefix is not a limited type
! 	(case of a 'Input attribute reference for an abstract, non-classwide
! 	type)
! 	(Stream_Attribute_Available): New function to determine whether a stream
! 	attribute is available at a place.
! 	(Check_Attribute): Use Stream_Attribute_Available instead of just
! 	testing for TSS presence on the implementation base type.
! 	(Analyze_Attribute): Modified to give support to task interfaces.
! 	(Analyze_Access_Attribute): Add error check for use of an Access (or
! 	Unrestricted_Access) attribute with a subprogram marked as
! 	Inline_Always.
! 	(Analyze_Attribute, case Attribute_Address): Add error check for use of
! 	an Address attribute with a subprogram marked as Inline_Always.
! 	Update Eval_Attribute to handle new value of Width from AI-395
! 
! 	* sem_ch13.adb (Analyze_Stream_TSS_Definition): New subprogram.
! 	(Analyze_Attribute_Definition_Clause, cases Input, Output, Read, Write):
! 	Factor common code across the stream-oriented attribute circcuits into
! 	a new subprogram, Analyze_Stream_TSS_Definition. The new uniform
! 	processing is functionally identical to the previous duplicated one,
! 	except that an expression that denotes an abstract subprogram will now
! 	be rejected, as mandated by AI-195 item 5.
! 
! 	* sem_util.ads, sem_util.adb (Type_Access_Level): Use flag
! 	Is_Local_Anonymous_Access to apply accessibility checks to access
! 	components and stand-alone access objects.
! 	(Has_Discriminant_Dependent_Constraint): Moved to spec for use
! 	elsewhere.
! 	(Is_Potentially_Persistent_Type): New function
! 	(Is_Dependent_Component_Of_Mutable_Object): If the enclosing object is
! 	a heap-object whose type has a constrained partial view, the object is
! 	unconstrained and the component may depend on a discriminant, making its
! 	renaming illegal.
! 
! 	* sinfo.ads, sinfo.adb
! 	(Must_Not_Override): Flag applicable to N_Entry_Declaration.
! 	(Must_Override): Flag applicable to N_Entry_Declaration.
! 	Indicate that interface_list can appear in single task and single
! 	protected declarations.
! 	Replace Is_Overriding and Not_Overriding with Must_Override and
! 	Must_Not_Override, to better express intent of AI.
! 	Is_Overriding, Not_Overriding: Ada2005 flags that indicate the presence
! 	of an overriding indicator in a subprogram or instance.
! 	Ada 2005 (AI-248) Null_Present can appear in a procedure specification.
! 	Add the overriding indicator [[not] overriding] construct to the
! 	following grammar productions:
! 	 ENTRY_DECLARATION
! 	 GENERIC_INSTANTIATION
! 	 SUBPROGRAM_SPECIFICATION
! 
! 	* par-ch10.adb (P_Compilation_Unit): Subprogram declaration or body
! 	can start with an overriding indicator.
! 
! 	* par-ch6.adb (P_Subprogram): Recognize overriding indicator, and set
! 	flags accordingly on subrogram specifications or instances.
! 
! 	* sem_ch8.adb:
! 	(Analyze_Subprogram_Renaming): For a renaming_as_body, verify that the
! 	overriding_indicator, if present, is consistent with status of spec.
! 	Improve error message for null-excluding checks on controlling access
! 	parameters.
! 	(Check_In_Previous_With_Clause): Protect the frontend against
! 	previously reported critical errors in the context clauses.
! 	Save and restore Ada_Version_Explicit, for implementation of AI-362
! 	(Analyze_Subprogram_Renaming): If the new entity is a dispatching
! 	operation verify that controlling formals of the renamed entity that
! 	are access parameters are explicitly non-null.
! 	(Find_Expanded_Name): Improve error message when prefix is an illegal
! 	reference to a private child unit.
! 
! 	* exp_imgv.adb, s-imgwch.ads, s-imgwch.adb, s-valwch.adb,
! 	s-valwch.ads, s-widwch.adb, s-widwch.ads, s-wwdcha.adb, s-wwdwch.adb:
! 	Rewrite to correspond to new wide character names in AI-395
! 
!         * par-ch12.adb (P_Formal_Subprogram_Declaration): Recognize null
!         default procedures.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 
! 	* errout.ads, errout.adb (Error_Msg_NW): Only emit warning on user
! 	code, not on the bodies of predefined operations, to cut down on
! 	spurious noise.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_aggr.adb (Aggr_Size_OK): An array with no components can always
! 	be expanded in place. The size computation does not require a
! 	subtraction, which would raise an exception on a compiler built with
! 	assertions when the upper bound is Integer'first.
! 	(Flatten): For an array of composite components, take into account the
! 	size of the components to determine whether it is safe to expand the
! 	array into a purely positional representation.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_ch2.adb (Param_Entity): Take the case of an expanded_name
! 	denoting a formal parameter into account.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_ch7.adb (Find_Node_To_Be_Wrapped): If the node appears within
! 	the entry_call alternative of a conditional entry call, wrap the
! 	conditional entry call itself.
! 
! 2005-06-14  Nicolas Setton  <setton@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_dbug.ads, exp_dbug.adb (Get_Variant_Part): Fix the encoding of
! 	the "simple_choice" member in a variant record, in accordance with the
! 	description in the package spec: the information output for a constant
! 	should be "S number", not "SS number".
! 	(Get_Encoded_Name): Return at once if not generating code. Avoids name
! 	overflow problem when compiling with -gnatct, for ASIS/gnatmetrics.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Add_RACW_Primitive_Declarations_And_Bodies): For an
! 	RACW without any primitives, do not generate the if statement for
! 	dispatching by name in the PolyORB/DSA case, as it would be malformed
! 	(it would have an Elsif_Parts list that is not No_List, but with a
! 	length of 0).
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_intr.adb, par-ch5.adb: Minor fix to error message text
! 
! 2005-06-14  Jose Ruiz  <ruiz@adacore.com>
! 
! 	* fe.h: Add entry for Opt.Exception_Locations_Suppressed so that gigi
! 	can determine whether pragma Suppress_Exception_Locations is in effect.
! 
! 	* utils2.c (build_call_raise): Do not pass the file name to the
! 	exception handler if pragma Suppress_Exception_Locations is in effect.
! 	(build_allocator): Add and process arg IGNORE_INIT_TYPE.
! 
! 2005-06-14  Emmanuel Briot  <briot@adacore.com>
! 
! 	* g-debpoo.adb (Deallocate, Dereference): Improve output.
! 
! 2005-06-14  Nicolas Roche  <roche@adacore.com>
! 
! 	* g-diopit.adb (Wildcard_Iterator): Return directly if Path is equal
! 	to ""
! 	(Next_Level): Fix minor bug in handling of ../dir case
! 	(Read): Add dir separator to Directory name so that "" is understood as
! 	 "/"
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* g-dynhta.ads, g-dynhta.adb (Reset): Free the table itself after
! 	releasing the items.
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 	    Cyrille Comar  <comar@adacore.com>
! 
! 	* g-os_lib.ads, g-os_lib.adb (Non_Blocking_Spawn): Two new versions
! 	with output file descriptor and with output file name.
! 	(Dup, Dup2): Now global procedures as they are used by two subprograms
! 	(Copy): Allocate the 200K buffer on the heap rather than on the stack.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	PR ada/6717
! 
! 	* g-socket.ads, g-socket.adb (Inet_Addr): Special case the all-ones
! 	broadcast address.
! 	(Create_Selector): Bind listening socket used to create the signalling
! 	socket pair to 127.0.0.1 to limit the scope for 'theft' of connection.
! 	Set listen backlog to 1 to ensure that we detect socket theft by a
! 	failure of our own connect(2) call.
! 	(Check_Selector): Improve documentation of the selector mechanism.
! 	(Broadcast_Inet_Addr): New constant.
! 
! 2005-06-14  Gary Dismukes  <dismukes@adacore.com>
! 
! 	* layout.adb (Discrimify): Remove resetting of Vtype to the underlying
! 	type which turns out to be an incomplete and incorrect fix.
! 	(Layout_Array_Type): Use Underlying_Type when checking whether the scope
! 	of the type is declared in a record (for determination of insertion
! 	type).
! 	(SO_Ref_From_Expr): Test whether Vtype denotes a partial or full view of
! 	a private type and ensure that the primary entity is used for the type
! 	of the newly created function's V formal by taking the Etype of the
! 	view.
! 
! 2005-06-14  Javier Miranda  <miranda@adacore.com>
! 	    Jose Ruiz  <ruiz@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* lib-load.ads, lib-load.adb (Load_Unit): Addition of a new parameter
! 	that indicates if we are parsing a compilation unit found in a
! 	limited-with clause.
! 	It is use to avoid the circularity check.
! 
! 	* par.ads, par.adb (Par): Addition of a new parameter to indicate if
! 	we are parsing a compilation unit found in a limited-with clause. This
! 	is use to avoid the circularity check.
! 
! 	* par-load.adb (Load): Indicate Lib.Load_Unit if we are loading the
! 	unit as a consequence of parsing a limited-with clause. This is used
! 	to avoid the circularity check.
! 
! 	* sem_ch10.adb: Suppress Ada 2005 unit warning if -gnatwY used
! 	(Analyze_Context): Limited-with clauses are now allowed
! 	in more compilation units.
! 	(Analyze_Subunit_Context, Check_Parent): Protect the frontend
! 	againts previously reported critical errors in context clauses
! 	(Install_Limited_Withed_Unit): Code cleanup plus static detection
! 	of two further errors: renamed subprograms and renamed packages
! 	are not allowed in limited with clauses.
! 	(Install_Siblings): Do not install private_with_clauses on the package
! 	declaration for a non-private child unit.
! 	(Re_Install_Parents): When a parent of the subunit is reinstalled,
! 	reset visibility of child units properly.
! 	(Install_Withed_Unit): When a child unit appears in a with_clause of its
! 	parent, it is immediately visible.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 	    Emmanuel Briot  <briot@adacore.com>
! 
! 	* lib-xref.ads, lib-xref.adb (Generate_Definition): Treat any entity
! 	declared within an inlined body as referenced, to prevent spurious
! 	warnings.
! 	(Output_One_Ref): If an entity renames an array component, indicate in
! 	the ALI file that this aliases (renames) the array. Capture as well
! 	function renamings that rename predefined operations.
! 	Add information about generic parent for package and subprogram
! 	instances.
! 	(Get_Type_Reference): For a subtype that is the renaming of an actual in
! 	an instantiation, use the first_subtype to ensure that we don't generate
! 	cross-reference information for internal types.
! 	For objects and parameters of a generic private type, retain the '*'
! 	indicator to distinguish such an entity from its type.
! 
!         * ali.ads (Xref_Entity_Record): New fields Iref_File_Num and Iref_Line,
!         to store information about instantiated entities.
! 
!         * ali.adb (Scan_ALI): Add support for parsing the reference to the
!         generic parent
! 
!         * xref_lib.adb (Skip_To_Matching_Closing_Bracket): New subprogram
!         (Parse_Identifier_Info, Parse_Token): Add support for the generic parent
!         information.
! 
! 2005-06-10  Doug Rupp  <rupp@adacore.com>
! 	    Arnaud Charlet  <charlet@adacore.com>
! 	    Olivier Hainque  <hainque@adacore.com>
! 	    Jose Ruiz  <ruiz@adacore.com>
! 
! 	* Make-lang.in: Add initialize.o when needed.
! 	Remove obsolete references to RT_FLAGS.
! 	Add missing dependencies for sdefault.o
! 
! 	* initialize.c: New file.
! 
! 	* init.c [VMS] Declare ADA$ externs weak to fix build problem in IVMS.
! 	[VMS] cond_signal_table: Fix problem in declaration.
! 	[VMS] __gnat_error_handler: rewrite.
! 	Move all __gnat_initialize() routines to initialize.c
! 	Specialize the former "hpux" section to "hppa hpux", as this is what the
! 	section really is here for and we now have other hpux ports that need
! 	different contents.
! 	(__gnat_adjust_context_for_raise) i386-linux: First version of this
! 	function for this target. Adjust PC by one in the machine context. This
! 	adjustment was previously done in the MD_FALLBACK_FRAME_STATE_FOR, but
! 	it is more reliable to do that in the signal handler itself.
! 	(__gnat_install_handler) i386-linux: Set SA_SIGINFO in the sigaction
! 	flags, so that the handler is passed the context structure to adjust
! 	prior to the raise.
! 	(__gnat_error_handler) i386-linux: Adjust the signature to match what a
! 	SA_SIGINFO sigaction should look like. Call
! 	__gnat_adjust_context_for_raise before actually raising. Cleanup unused
! 	Machine_State_Operations stuff.
! 	Add conditional code so that the x86_64 is also supported.
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* mdll.adb (Get_Dll_Name): New routine that returns the DLL name given
! 	the library name.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* opt.ads, opt.adb: New flags for persistent_bss mode
! 	Add Ada_Version_Explicit, for implementation of AI-362
! 	Add Assertions_Enabled_Config and associated handling
! 	Needed since setting can be changed with Assertion_Policy pragma
! 	Add new flag Warn_On_Ada_2005_Compatibility
! 
! 	* switch-c.adb: Recognize -gnatwy/Y
! 	Set Ada_Version_Explicit, for implementation of AI-362
! 	The -gnatg switch now includes -gnatyu
! 
! 	* usage.adb: Add -gnatwy/Y
! 	Remove wrong asterisk on -gnatwX line
! 	Add line for -gnatyu switch
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* osint.adb (Add_Default_Search_Dirs): Put source and object
! 	directories of project files before directories coming from
! 	ADA_INCLUDE_PATH and ADA_OBJECTS_PATH.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	PR ada/15613
! 
! 	* par-ch2.adb (Scan_Pragma_Argument): New procedure
! 	(P_Pragma): Implement RM 2.8(4) check for no pos args after named args
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* prep.adb (Preprocess): Ignore error when scanning the first token of
! 	a line.
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-nmsc.adb (Suffix_For): Change default suffix for C++ to ".cpp"
! 	(Check_Stand_Alone_Library): If the specified reference symbol file does
! 	not exist, only issue a warning when the symbol policy is not
! 	Controlled. And, when symbol policy is Compliant, set the symbol
! 	policy to Autonomous.
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-part.adb (Pre_Parse_Context_Clause): Call Set_Is_Not_Last_In_List
! 	when the project file in a with clause is not the last one, that is the
! 	project file name is followed by a comma.
! 	* prj-pp.adb: (First_With_In_List): New Boolean global variable
! 	(Print): Issue list of project files separated by commas in with clauses
! 	according to the values returned by Is_Not_Last_In_List.
! 	* prj-tree.ads, prj-tree.adb: (Is_Not_Last_In_List): New function
! 	(Set_Is_Not_Last_In_List): New procedure
! 
! 2005-06-14  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* s-atacco.ads: Put a pragma No_Strict_Aliasing on Object_Pointer.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* scng.adb: Add call to new Check_EOF routine
! 	(Accumulate_Checksum): Properly handle wide wide char >= 2 ** 24
! 	Add some comments regarding wide character handling
! 
! 	* style.ads, styleg.ads, styleg.adb: Implement new style switch -gnatyu
! 
! 	* stylesw.ads, stylesw.adb: Implement new style switch -gnatyu
! 
! 	* g-utf_32.ads, g-utf_32.adb (Is_UTF_32_Non_Graphic): Other_Format
! 	characters are now considered graphic characters and hence yield false
! 	in this call.
! 
!         * nmake.adt: Modify header so that xnmake does not generate output
!         files with multiple blank lines.
! 
!         * treeprs.adt: Remove a blank line so that output from xtreeprs does
!         not have an extra blank line
! 
! 2005-06-14  Gary Dismukes  <dismukes@adacore.com>
! 
! 	* sem_aggr.adb (Aggregate_Constraint_Checks): Apply a conversion to the
! 	expression when the component type is an anonymous access type to
! 	ensure that appropriate accessibility checks are done.
! 
! 	* sem_ch5.adb (Analyze_Assignment): Apply a implicit conversion to the
! 	expression of an assignment when the target object is of an anonymous
! 	access type. This ensures that required accessibility checks are done.
! 	(One_Bound): Move the check for type Universal_Integer to
! 	Process_Bounds.
! 	(Process_Bounds): Check whether the type of the preanalyzed range is
! 	Universal_Integer, and in that case set Typ to Integer_Type prior
! 	to setting the type of the original range and the calls to One_Bound.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_case.adb (Expand_Others_Choice): Improve warning.
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_eval.adb (Subtypes_Statically_Match): Use discriminant
! 	constraint of full view if present, when other type is discriminated.
! 	(Eval_Relational_Op): Recognize tests of pointer values against Null,
! 	when the pointer is known to be non-null, and emit appropriate warning.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	PR ada/10671
! 
! 	* sem_prag.adb: Implement pragma Persistent_BSS
! 	Remove obsolete pragma Persistent_Data, Persistent_Object
! 	Set Ada_Version_Explicit, for implementation of AI-362
! 	Test Ada_Version_Explicit for Preelaborate_05 and Pure_05
! 	Add processing for pragma Pure_05 and Preelaborate_05
! 	Add processing for Assertion_Policy pragma
! 	Add pragma identifiers for Assert
! 	(Analyze_Pragma, case Assert): Check number of arguments
! 	(Process_Inline): Additional guard against an illegal program, where the
! 	argument of the pragma is undefined, and warnings on redundant
! 	constructs are enabled.
! 	(Analyze_Pragma, case Obsolescent): Allow an optional second argument
! 	Ada_05 to this pragma, specifying that the pragma is only active in
! 	Ada_05 mode.
! 	(Check_Arg_Order): New procedure
! 	Add appropriate calls to this procedure throughout
! 	Also throughout, check entity name before doing any other checks
! 
! 	* snames.h snames.ads, snames.adb: Add pragma Persistent_BSS
! 	Remove obsolete pragma Persistent_Data, Persistent_Object
! 	Add entries for pragma Pure_05 and Preelaborate_05
! 	Add entries for Assertion_Policy pragma and associated names
! 	Add some names for pragma argument processing
! 
! 	* tbuild.ads, tbuild.adb: (Make_Linker_Section_Pragma): New function
! 
! 2005-06-14  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_warn.adb (Warn_On_Known_Condition): If the constant expression
! 	appears within a negation (either from source or as a rewriting of
! 	inequality) adjust text of warning accordingly.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* s-strxdr.adb: Follow AI95-00132
! 
! 2005-06-14  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* s-tasren.adb (Exceptional_Complete_Rendezvous): Fix race condition.
! 
! 2005-06-14  Arnaud Charlet  <charlet@adacore.com>
! 	    Jose Ruiz  <ruiz@adacore.com>
! 
! 	* s-tposen.adb, s-tpobop.adb
! 	(Exceptional_Complete_Rendezvous): Save the occurrence and not only
! 	the exception id.
! 	(PO_Do_Or_Queue): Before queuing a task on an entry queue we check that
! 	there is no violation of the Max_Entry_Queue_Length restriction (if it
! 	has been set); Program_Error is raised otherwise.
! 	(Requeue_Call): Before requeuing the task on the target entry queue we
! 	check that there is no violation of the Max_Entry_Queue_Length
! 	restriction (if it has been set); Program_Error is raised otherwise.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* styleg.adb: Fix several remaining problems in -gnatyu switch
! 	Blank line count not reset at start
! 	Scanning outside source buffer in some cases
! 	Confusing message for blanks at end of file
! 	Non-empty blank lines not recognized
! 
! 	* nmake.adt: Modify header so that xnmake does not generate output
! 	files with multiple blank lines.
! 
!         * treeprs.adt: Remove a blank line so that output from xtreeprs does
!         not have an extra blank line
! 
! 2005-06-14  Sergey Rybin  <rybin@adacore.com>
! 
! 	* styleg-c.adb (Body_With_No_Spec): Remove ':' from warning message.
! 
! 2005-06-14  Doug Rupp  <rupp@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 
! 	* vms_conv.ads, vms_conv.adb: Remove "Library" command.
! 	Update copyright.
! 
! 	* vms_data.ads: Add entry for -gnaty/Y [NO]ADA_2005_COMPATIBILITY
! 	Remove "Library" command.
! 	Change keyword for style check -gnatyd from NOCRLF to
! 	DOS_LINE_ENDINGS.
! 	Remove useless second style check keyword NONE
! 	Remove help documentation for inexistent style check keyword
! 	RM_COLUMN_LAYOUT.
! 	Add help documentation for style check keywords DOS_LINE_ENDINGS,
! 	UNNECESSARY_BLANK_LINES and XTRA_PARENS
! 	Add UNNECESSARY_BLANK_LINES for -gnatyu
! 	Add qualifiers /ALL_PROJECTS (-U) for GNAT PRETTY and GNAT METRIC
! 
!         * ug_words: Add entry for -gnaty/Y [NO]ADA_2005_COMPATIBILITY
! 
! 2005-06-14  Vincent Celier  <celier@adacore.com>
! 
! 	* makegpr.adb (Compile_Link_With_Gnatmake): Invoke gnatmake with -d if
! 	gprmake was invoked with -d.
! 	(Compile_Sources): If -d was used, output the "completed ..." message
! 	for each compilation.
! 	(Scan_Arg): Recognize new switch -d
! 	When -c and at least one main is specified, set
! 	Unique_Compile to True to guarantee that no other sources will be
! 	compiled.
! 
! 2005-06-14  Matthew Heaney  <heaney@adacore.com>
! 
! 	* a-swunha.ads, a-swunha.adb: Removed. Replaced by a-swuwha.ad[sb]
! 	* a-swuwha.ads, a-swuwha.adb: New files
! 
! 	* a-szunha.ads, a-szunha.adb: Removed, replaced by a-szuzha.ad[sb]
! 	* a-szuzha.ads, a-szuzha.adb: New files.
! 
! 	* a-rbtgso.adb, a-crbtgo.ads, a-crbtgo.adb, a-crbtgk.ads,
! 	a-crbtgk.adb, a-crbltr.ads, a-coorse.ads, a-coorse.adb, a-convec.ads,
! 	a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohata.ads, a-cohama.ads,
! 	a-cohama.adb, a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb,
! 	a-cidlli.ads, a-cidlli.adb, a-chtgop.ads, a-chtgop.adb, a-cdlili.ads,
! 	a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb,
! 	a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads,
! 	a-swunha.adb, a-stunha.adb, a-ciorma.adb, a-coorma.adb, a-shcain.ads,
! 	a-shcain.adb, a-chtgke.ads, a-chtgke.adb, a-stwiha.ads, a-stwiha.adb,
! 	a-strhas.adb, a-stzhas.adb: synchronized to the latest version of the
! 	Ada 2005 RM.
! 
! 2005-06-10  Eric Botcazou  <ebotcazou@adacore.com>
! 	    Olivier Hainque  <hainque@adacore.com>
! 	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 	    Pascal Obry  <obry@adacore.com>
! 
! 	* gigi.h: (build_allocator): Add arg IGNORE_INIT_TYPE.
! 
! 	* trans.c (call_to_gnu): Issue a warning for users of Starlet when
! 	making a temporary around a procedure call because of non-addressable
! 	actual parameter.
! 	(process_freeze_entity): If entity is a private type, capture size
! 	information that may have been computed for the full view.
! 	(tree_transform, case N_Allocator): If have initializing expression,
! 	check type for Has_Constrained_Partial_View and pass that to
! 	build_allocator.
! 	(tree_transform, case N_Return_Statement): Pass extra arg to
! 	build_allocator.
! 
! 	* decl.c (annotate_value): Remove early return if -gnatR is not
! 	specified.
! 	(gnat_to_gnu_field): Don't make a packable type for a component clause
! 	if the position is byte aligned, the field is aliased, and the clause
! 	size isn't a multiple of the packable alignment. It serves no useful
! 	purpose packing-wise and would be rejected later on.
! 	(gnat_to_gnu_entity, case object): Pass extra arg to build_allocator.
! 
! 	PR ada/20515
! 	(gnat_to_gnu_entity): Remove use of macro _WIN32 which is wrong in the
! 	context of cross compilers. We use TARGET_DLLIMPORT_DECL_ATTRIBUTES
! 	instead.
! 	(create_concat_name): Idem.
! 
! 2005-06-10  Robert Dewar  <dewar@adacore.com>
! 	    Eric Botcazou  <ebotcazou@adacore.com>
! 	    Ben Brosgol  <brosgol@adacore.com>
! 	    Cyrille Comar  <comar@adacore.com>
! 	    Sergey Rybin  <rybin@adacore.com>
! 	    Pascal Obry  <obry@adacore.com>
! 
! 	* gnat_rm.texi: Add documentation for pragma Persistent_BSS
! 	Document second argument (Ada_05) of pragma Obsolescent
! 	Add note that call to subprogram marked with pragma Obsolescent
! 	is now considered to be a violation of program Restrictions
! 	(No_Obsolescent_Features).
! 	(Implementation Defined Pragmas) <Machine_Attribute>: Make it clear
! 	that only machine-dependent attributes are supported.
! 
! 	* gnat_ugn.texi:
! 	Commented out menu lines and empty section for gnatclean examples
! 	Document -gnatwy/Y
! 	Fix some over long lines
! 	Clarify and enhance documentation of ADA_PROJECT_PATH.
! 	Rework section 2.11.2(3) about linking with a non-GNU compiler.
! 	Mention new switch -fcallgraph-info.
! 	Mention new switch -fstack-usage.
! 	For gnatpp, replace '-notab' with '-N' and add this option to Index
! 	Corrected VMS example.
! 	VMS keyword for style check -gnatyd is DOS_LINE_ENDINGS, no NOCRLF
! 	Minor reformatting
! 	Add documentation for -gnatyu switch (unnecessary blank lines)
! 	Document new switch -U for GNAT PRETTY and GNAT METRIC
! 	Add note about Stdcall being handled as C convention on non Windows OS.
! 	Remove some junk typo in description of gnatbind -S switch
! 	Remove reference to Extensions_Allowed pragma
! 	Document the new order of the directories to be searched (source and
! 	object directories of project files before directories in ADA_*_PATH
! 	environment variables.
! 
!         * g-trasym.ads: Document that IRIX is supported
! 
! 2005-06-10  Arnaud Charlet  <charlet@adacore.com>
! 
! 	* Makefile.in: Add initialize.o when needed.
! 	Adapt to new VMS package body Symbols and subunits
! 	No specialized version of a-sytaco is needed for VxWorks.
! 
! 	* a-wichun.ads, a-wichun.adb, a-zchuni.ads, a-zchuni.adb: New files.
! 	* a-zchara.ads, a-widcha.ads: New files.
! 
! 	* system-hpux-ia64.ads: New file.
! 
! 	* i-vxwork-x86.ads, i-vxwork.ads (intContext): Add this function which
! 	is imported from the VxWorks kernel.
! 
! 2005-06-14  Robert Dewar  <dewar@adacore.com>
! 
! 	* g-soliop-mingw.ads, g-soccon-vms.adb, a-swmwco.ads, exp_smem.adb,
! 	fmap.adb, a-szmzco.ads, s-traent-vms.adb, s-traent-vms.ads,
! 	a-direio.ads, a-exctra.ads, a-exexda.adb, a-exextr.adb, a-stream.ads,
! 	s-restri.ads, s-restri.adb, s-traent.adb, s-traent.ads, a-slcain.adb,
! 	a-stzhas.ads, a-tiinau.adb, comperr.adb, exp_ch11.adb, g-boubuf.adb,
! 	g-calend.adb, g-debpoo.ads, g-moreex.ads, gprep.adb, g-regpat.ads,
! 	i-cexten.ads, i-os2thr.ads, makeutl.ads, memroot.adb, mlib-prj.adb,
! 	namet.adb, namet.ads, prj-makr.adb, prj-proc.adb, sem_dist.adb,
! 	sem_elim.ads, s-valint.adb, s-vallli.adb, s-vallli.adb, s-vallli.ads,
! 	s-valllu.adb, s-valllu.ads, s-valrea.adb, s-valrea.ads, scn.adb,
! 	s-tasinf.adb, targparm.adb, uname.adb, uname.ads, xnmake.adb,
! 	xsinfo.adb, a-direct.ads: Remove extra blank lines. Minor reformatting.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* xeinfo.adb: Fix typo in comment
! 
! 2005-06-14  Javier Miranda  <miranda@adacore.com>
! 
! 	* repinfo.ads: Fix typo in comment
! 
! 2005-06-14  Gary Dismukes  <dismukes@adacore.com>
! 
! 	* s-finimp.adb (Parent_Tag): Delete this imported function (function
! 	Parent_Tag is now in the visible part of Ada.Tags).
! 	(Get_Deep_Controller): Call Ada.Tags.Parent_Tag directly instead of
! 	using imported function.
! 
! 2005-06-14  Bernard Banner  <banner@adacore.com>
! 
! 	* vxaddr2line.adb: Add support for Windows hosted x86 vxworks. Should
! 	also apply for handling support for VxSim 653.
! 
! 2005-06-14  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* xsnames.adb: Add automatic generation of snames.h.
! 
! 2005-06-14  Thomas Quinot  <quinot@adacore.com>
! 
! 	* gen-soccon.c: Add IP_MULTICAST_IF constant
! 	Minor reformatting and adjustments to prevent warnings.
! 
! 2005-06-14  Pascal Obry  <obry@adacore.com>
! 
! 	* seh_init.c: Do not include <sys/stat.h>. This is not needed.
! 
! 2005-06-03  Andrew Pinski  <pinskia@physics.uc.edu>
! 
! 	* trans.c (gnat_gimplify_expr): Call
! 	recompute_tree_invarant_for_addr_expr when we change
! 	the operand of the ADDR_EXPR.
! 
! 2005-05-31  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
! 
! 	* misc.c: Don't include errors.h.
! 
! 2005-05-29  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
! 
! 	* raise.c (db): Add ATTRIBUTE_PRINTF_2.
! 
! 2005-05-29  Kazu Hirata  <kazu@cs.umass.edu>
! 
! 	* cal.c, decl.c, init.c, raise.c, trans.c, utils2.c: Fix
! 	comment typos.
! 	* gnat_rm.texi, gnat_ugn.texi: Fix typos.
! 
! 2005-05-16  Nathanael Nerode <neroden@gcc.gnu.org>
! 
! 	PR ada/20270
! 	* Makefile.in: Make TGT_LIB behave correctly.
! 
! 2005-04-23  DJ Delorie  <dj@redhat.com>
! 
! 	* misc.c: Adjust warning() callers.
! 
! 2005-04-16  Laurent GUERBY  <laurent@guerby.net>
! 
!         PR ada/18847
!         * a-nudira.adb (Value): Check for valid string.
!         * a-nuflra.adb (Value): Likewise.
! 
! 2005-04-11  Richard Sandiford  <rsandifo@redhat.com>
! 
! 	* lang.opt: Refer to the GCC internals documentation instead of c.opt.
! 
! 2005-04-10  Kazu Hirata  <kazu@cs.umass.edu>
! 
! 	* adaint.c, init.c, tracebak.c: Fix comment typos.
! 	* gnat-style.texi, gnat_rm.texi, gnat_ugn.texi: Fix typos.
  
  2005-04-07  Laurent GUERBY  <laurent@guerby.net>
  	    John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
***************
*** 23,74 ****
  	* system-hpux.ads: Define Signed_Zeros to be True.
  	* system-linux-hppa.ads, s-osinte-linux-hppa.ads: New files.
  
! 2005-04-07  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/18659
! 	PR ada/18819
! 	* misc.c (tree_sra_requested): New global.
! 	(gnat_init_options): Detect -ftree-sra.
! 	(gnat_post_options): Enable Tree-SRA only if specifically requested.
  
! 2005-04-04  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/19956
! 	Backport from mainline:
  
! 	2005-03-29  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
  	* utils.c (finish_record_type): Use variable_size when setting sizes.
  
! 2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/20255
! 	Backport from mainline:
  
! 	2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 	* utils.c (convert) <UNION_TYPE>: Accept slight type variations when
! 	converting to an unchecked union type.
  
  2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/18727
! 	Backport from mainline:
  
! 	2005-03-15  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 	* exp_ch13.adb (Expand_N_Freeze_Entity): If Freeze_Type returns True,
! 	replace the N_Freeze_Entity with a null statement.
! 	* exp_ch3.adb (Freeze_Type): Now a function that returns True if
! 	the N_Freeze_Entity is to be deleted.
! 	* exp_ch3.ads (Freeze_Type): Now a function that returns Boolean.
! 	* freeze.adb (Undelay_Type): New Subprogram.
! 	(Set_Small_Size): Pass T, the type to modify; all callers changed.
! 	(Freeze_Entity, Freeze_Record_Type): Change the way we handle types
! 	within records; allow them to have freeze nodes if their base types
! 	aren't frozen yet.
! 	* sem_ch3.adb (Constrain_Access, Constrain_Array): Allow itypes to be
! 	delayed.
! 	* gigi.h (gnat_to_gnu_field_decl): New decl.
! 	* decl.c (gnat_to_gnu_entity, case E_Array_Subtype): Call
! 	copy_alias_set.
  	(gnat_to_gnu_field_decl): New function.
  	(substitution_list, annotate_rep): Call it.
  	(gnat_to_gnu_entity, case E_Record_Subtype): Likewise.
--- 4744,5771 ----
  	* system-hpux.ads: Define Signed_Zeros to be True.
  	* system-linux-hppa.ads, s-osinte-linux-hppa.ads: New files.
  
! 2005-04-01  Kazu Hirata  <kazu@cs.umass.edu>
  
! 	* adaint.c, cal.c, decl.c, gigi.h, gmem.c, init.c, link.c,
! 	raise.c, tracebak.c, trans.c, utils2.c, utils.c: Fix comment
! 	typos.
  
! 2005-03-30  Tom Tromey  <tromey@redhat.com>
  
! 	* decl.c (gnat_substitute_in_type): Don't handle FILE_TYPE.
  
! 2005-03-30  Aaron W. LaFramboise  <aaronavay62@aaronwl.com>
! 
! 	* adaint.c (_gnat_set_close_on_exec): Mark parameters unused.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_res.adb (Resolve_Real_Literal): Generate warning if static
! 	fixed-point expression has value that is not a multiple of the Small
! 	value.
! 
! 	* opt.ads (Warn_On_Bad_Fixed_Value): New flag
! 
! 	* s-taprop-tru64.adb (RT_Resolution): Return an integer number of
! 	nanoseconds.
! 
! 	* ug_words: Add entry for [NO_]BAD_FIXED_VALUES for -gnatwb/-gnatwB
! 
! 2005-03-29  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-tgt-vms-ia64.adb, mlib-tgt-vms-alpha.adb
! 	(Build_Dynamic_Library.Version_String): Return the empty string when
! 	Lib_Version is empty or when the symbol policy is not Autonomous.
! 
! 	* symbols-vms-alpha.adb (Finalize): For symbol policy Compliant, when
! 	a symbol is not in the reference symbol file, increase the Major ID
! 	and set the Minor ID to 0.
! 	Use gsmatch=lequal instead of gsmatch=equal
! 
! 2005-03-29  Doug Rupp  <rupp@adacore.com>
! 
! 	* adaint.c (__gnat_to_canonical_file_spec [VMS]): Check for logical
! 	name and translate.
! 
! 2005-03-29  Javier Miranda  <miranda@adacore.com>
! 
! 	* a-tags.ads, a-tags.adb (Get_TSD): Subprogram removed.
! 	(Inherit_DT): The first formal has been redefined as a Tag.
! 	This allows us the removal of the subprogram Get_TSD.
! 	(TSD): Replace the call to Get_TSD by the actual code.
! 
! 	* exp_disp.ads, exp_disp.adb: Remove support to call Get_TSD.
! 	(Make_DT): Upgrade the call to Inherit_TSD according to the
! 	new interface: the first formal is now a Tag.
! 
! 	* i-cpp.ads, i-cpp.adb (CPP_Inherit_DT): The first formal has been
! 	redefined as a Tag.
! 	This change allows us to remove the subprogram Get_TSD.
! 	(CPP_Get_TSD): Subprogram removed.
! 	(TSD): Replace the call to CPP_Get_TSD by the actual code.
! 
! 	* rtsfind.ads: Remove support to call the run-time
! 	subprogram Get_TSD
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* errutil.adb, errout.adb:
! 	Minor comment updates on Line_Terminator references
! 
! 	* par-ch10.adb: Add ??? comment about line terminator
! 
! 	* styleg.adb (Check_Line_Terminator): Add check for new switch -gnatyd
! 	(check dos line terminator).
! 	(Check_Line_Max_Length): New procedure, split off from the existing
! 	Check_Line_Terminator routine. Separating this out allows -gnatyf to
! 	be properly recognized.
! 
! 	* styleg.adb: Add ??? comment for line terminator reference
! 
! 	* scng.adb (Check_End_Of_Line): Fix bug of -gnatyf being ignored
! 	(Check_End_Of_Line): Add -gnatyd handling (check dos line terminators)
! 
! 	* styleg.ads (Check_Line_Terminator): Add check for new switch -gnatyd
! 	(check dos line terminator).
! 	(Check_Line_Max_Length): New procedure, split off from the existing
! 	Check_Line_Terminator routine. Separating this out allows -gnatyf to
! 	be properly recognized.
! 
! 	* stylesw.ads, stylesw.adb:
! 	Add handling for new -gnatyd switch (check dos line terminator)
! 
! 	* switch-c.adb: Recognize new -gnatyd switch (check dos line terminator)
! 	Recognize -gnatwb/-gnatwB switches
! 	Include Warn_On_Bad_Fixed_Value for -gnatg
! 
! 	* usage.adb:
! 	Add line for new -gnatyd switch (check dos line terminator)
! 
! 	* usage.adb: Add lines for -gnatwb/-gnatwB
! 
! 	* vms_data.ads: Add entry for NOCRLF (-gnatyd)
! 
! 	* vms_data.ads: [NO_]BAD_FIXED_VALUES synonym for -gnatwb/-gnatwB
! 
! 	* gnat_ugn.texi: Fix overlong lines
! 	Document new -gnatyd switch
! 	Document new -gnatwb/-gnatwB switches
! 
! 2005-03-29  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_ch4.adb (Has_Unconstrained_UU_Component): Use the base type in
! 	order to retrieve the component list of the type, before examining
! 	individual components.
! 
! 	* sem_type.adb (Covers): Types are compatible if one is the base type
! 	of the other, even though their base types might differ when private
! 	views are involved.
! 
! 2005-03-29  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Add_RAST_Features, PolyORB version): Set the From_Any,
! 	To_Any and TypeCode TSSs on RAS types directly using Set_TSS, instead
! 	of using Set_Renaming_TSS. This ensures that the TSS bodies are not
! 	analyzed if expansion is disabled (which could otherwise cause spurious
! 	error messages if expansion has been disabled due to previous
! 	(unrelated) errors).
! 
! 	* sem_prag.adb (Analyze_Pragma, case Asynchronous): If RAS expansion
! 	is disabled, the entity denoted by the argument is the access type
! 	itself, not an underlying record type, so there is no need to go back
! 	to the Corresponding_Remote_Type.
! 
! 2005-03-29  Gary Dismukes  <dismukes@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_intr.adb (Expand_Dispatching_Constructor_Call): New procedure to
! 	expand a call to an instance of
! 	Ada.Tags.Generic_Dispatching_Constructor into a dispatching call to the
! 	Constructor actual of the instance. A class-wide membership
! 	check is also generated, to ensure that the tag passed to the instance
! 	denotes a type in the class.
! 	(Expand_Intrinsic_Call): Call Expand_Dispatching_Constructor in the case
! 	of Name_Generic_Dispatching_Constructor.
! 
! 	* Makefile.rtl: Add a-tgdico.ads to the list of library units (new Ada
! 	05 unit for AI-260-02).
! 
! 	* a-tgdico.ads: New file.
! 
! 	* impunit.adb (Non_Imp_File_Names_05): Add entry "a-tgdico" for new
! 	predefined Ada 05 generic unit Ada.Tags.Generic_Dispatching_Constructor.
! 
! 	* snames.ads, snames.adb (Preset_Names): Add entry for
! 	Generic_Dispatching_Constructor.
! 
! 	PR ada/20300
! 
! 	* sem_ch8.adb (Find_Direct_Name): Go to root type for check of
! 	character type cases.
! 	(Analyze_Subprogram_Renaming): Add special handling for
! 	the case of renaming of stream attributes when the renaming denotes a
! 	generic formal subprogram association for an abstract formal subprogram.
! 	Check that the attribute is a primitive stream attribute (and not
! 	a class-wide stream attribute) and then rewrite the attribute name
! 	as the name of the appropriate compiler-generated stream primitive.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* exp_util.adb (Remove_Side_Effects): Properly propagate arguments to
! 	recursive calls.
! 	(Is_Possibly_Unaligned_Object): Correct typo that
! 	resulted in inaccurate result for unaligned scalars within records.
! 
! 2005-03-29  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* freeze.adb (Freeze_Record_Type): If the type of the component is an
! 	itype whose parent is controlled and not yet frozen, do not create a
! 	freeze node for the itype if expansion is disabled.
! 
! 2005-03-29  Vincent Celier  <celier@adacore.com>
! 
! 	* make.adb (Gnatmake): Don't fail if the main project file is declared
! 	as having no Ada sources. Do not display message "no sources to
! 	compile" in quiet output.
! 
! 2005-03-29  Doug Rupp  <rupp@adacore.com>
! 
! 	* Makefile.in [VMS] (EXTRA_GNATTOOLS): Add vms_help and gnat.hlp as
! 	extra tools.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* par-ch12.adb (P_Generic): Give better msg for illegal private generic
! 	child.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* par-ch3.adb (P_Type_Declaration): Fix bad error recovery after
! 	missing TYPE Improve the error message generated when compiling a
! 	limited interface in Ada83 or Ada95 mode.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* par-ch4.adb (P_Name): When a bad attribute is returned, return error,
! 	rather than proceed ahead using a junk attribute name.
! 
! 2005-03-29  Vincent Celier  <celier@adacore.com>
! 
! 	* prj.ads, prj.adb: (Project_Data): Add new component Display_Name
! 
! 	* prj-part.adb (Parse_Single_Project): Set the location of a project
! 	on its defining identifier, rather than on the reserved word "project".
! 
! 	* prj-proc.adb (Expression): Adapt to the fact that default of external
! 	references may be string expressions, not always literal strings.
! 	(Recursive_Process): Set Display_Name equal to Name
! 	when Location is No_Location, that is when there is no actual file.
! 	Get the Display_Name of the project from the source, when it is not a
! 	virtual project.
! 	(Process): Use the Display_Name in error messages
! 
! 	* prj-strt.adb (External_Reference): Allow default to be string
! 	expressions, not only literal strings.
! 
! 2005-03-29  Vincent Celier  <celier@adacore.com>
! 
! 	* prj-nmsc.adb (Check_Stand_Alone_Library): Do not forbid the symbol
! 	file and the reference symbol file to be the same file.
! 
! 2005-03-29  Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_cat.adb (Validate_Remote_Types_Type_Conversion): Perform check to
! 	forbid conversion of a local access-to-subprogram type to a remote one.
! 
! 	* sem_util.adb (Wrong_Type): For a record type that is the expanded
! 	equivalent type for a remote access-to-subprogram type, go back to the
! 	original RAS entity when displaying an error message, so the casing is
! 	the original source casing.
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_ch11.adb (Analyze_Raise_Statement): Change message for warning
! 	on param update.
! 
! 2005-03-29  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch4.adb (Analyze_Selected_Component): Do not generate an actual
! 	subtype if code is being pre-analyzed, to prevent un-expanded
! 	references to protected formals, among others.
! 	(Analyze_Explicit_Dereference): If the overloaded prefix includes some
! 	interpretation that can be a call, include the result of the call as a
! 	possible interpretation of the dereference.
! 
! 	* sem_ch5.adb (Process_Bounds): Determine type of range by
! 	pre-analyzing a copy of the original range, and then analyze the range
! 	with the expected type.
! 
! 	* sem_res.adb (Check_Parameterless_Call): For an explicit dereference
! 	with an overloaded prefix where not all interpretations yield an
! 	access to subprogram, do not rewrite node as a call.
! 	(Resolve_Explicit_Dereference): Recognize the previous case and rewrite
! 	the node as a call once the context identifies the interpretation of
! 	the prefix whose call yields the context type.
! 	(Valid_Conversion): For the case of a conversion between
! 	local access-to-subprogram types, check subtype conformance using
! 	Check_Subtype_Conformant instead of Subtype_Conformant, to have a more
! 	detailed error message.
! 
! 2005-03-29  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch6.adb (Set_Formal_Mode): If the subtype has a non_null
! 	indicator, indicate that the formal can never be null.
! 	(Process_Formals): If a formal has a non_null indicator, insert the
! 	resulting subtype immediately before the enclosing subprogram decl,
! 	and not at the beginning of the corresponding declarative part, to
! 	prevent access before elaboration (Ada2005).
! 
! 2005-03-29  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 
! 	PR ada/19956
  	* utils.c (finish_record_type): Use variable_size when setting sizes.
  
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
  
! 	* xtreeprs.adb, xnmake.adb: Use Stream_IO instead of Text_IO to
! 	guarantee Unix style line terminators for the output files, even when
! 	running on windows.
  
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-direct.ads, a-direct.adb (Start_Search): Free allocated search
! 	buffer if an exception is raised.
! 
! 2005-03-29  Ed Falis  <falis@adacore.com>
! 
! 	* cio.c: Undefine putchar and getchar for VTHREADS: incompatible with
! 	VxWorks 653 1.4
! 
! 2005-03-29  Robert Dewar  <dewar@adacore.com>
! 
! 	* sem_util.ads: Minor reformatting
! 	* gnat_rm.texi: Minor editing.
! 
! 2005-03-29  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* decl.c (gnat_to_gnu_entity) <E_Variable>: Rework comment.
! 	* trans.c (tree_transform) <N_Identifier>: Use correct predicates.
! 
! 2005-03-24  Aaron W. LaFramboise  <aaronavay62@aaronwl.com>
! 
! 	* adaint.c (__gnat_portable_spawn): Adjust cast.
! 
! 2005-03-23  Joseph S. Myers  <joseph@codesourcery.com>
! 
! 	* misc.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Remove.
! 
! 2005-03-17  Pascal Obry  <obry@adacore.com>
! 
! 	* adaint.h, adaint.c (__gnat_waitpid): Moved to expect.c where it is
! 	used.
! 
! 	* expect.c (__gnat_waitpid): Moved here from adaint.c.
! 	Reimplement under Win32 using Win32 API.
! 
! 	(__gnat_kill) [Win32]: Properly close the process handle before leaving
! 	this routine.
  
  2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	* ada-tree.h: (DECL_RENAMING_GLOBAL_P): New predicate.
! 	(DECL_RENAMED_OBJECT): New accessor macro.
! 	(SET_DECL_RENAMED_OBJECT): New setter macro.
  
! 	* decl.c (gnat_to_gnu_entity) <E_Variable>: Stabilize the renamed
! 	object in all cases.  Attach the renamed object to the VAR_DECL.
! 	(gnat_to_gnu_field): Do not lift the record wrapper if the size of the
! 	field is not prescribed.
! 
! 	* misc.c (gnat_handle_option): Handle -gnatO separately.
! 	(gnat_print_decl) <VAR_DECL>: New case.
! 	Print the DECL_RENAMED_OBJECT node.
! 
! 	* lang.opt:  Declare separate -gnatO option.
! 
! 	* trans.c (tree_transform) <N_Identifier>: If the object is a renaming
! 	pointer, replace it with the renamed object.
! 	<N_Validate_Unchecked_Conversion>: Warn for a conversion to a fat
! 	pointer type if the source is not a fat pointer type whose underlying
! 	array has the same non-zero alias set as that of the destination array.
! 
! 2005-03-17  Javier Miranda  <miranda@adacore.com>
! 
! 	* a-tags.ads, a-tags.adb (Get_Expanded_Name): Removed.
! 	(Get_Inheritance_Depth): Removed.
! 	(Set_Inheritance_Depth): Removed.
! 
! 	* rtsfind.ads, exp_disp.ads, exp_disp.adb: Remove support to call the
! 	subprogram Get_Expanded_Name because it is not referenced by the
! 	frontend.
! 
! 	* i-cpp.ads, i-cpp.adb (CPP_Get_Expanded_Name): Removed.
! 	(CPP_Get_Inheritance_Depth): Removed.
! 	(CPP_Set_Inheritance_Depth): Removed.
! 
! 	* tbuild.ads, tbuild.adb (Make_DT_Component): Removed.
! 
! 2005-03-17  Robert Dewar  <dewar@adacore.com>
! 
! 	* checks.adb (Apply_Array_Size_Check): Completely remove this for GCC
! 	3, since we now expect GCC 3 to do all the work.
! 
! 2005-03-17  Javier Miranda  <miranda@adacore.com>
! 
! 	* einfo.adb (First_Private_Entity, Set_First_Private_Entity): Addition
! 	of one barrier to avoid wrong usage of this attribute.
! 
! 	* sem_ch12.adb (Formal_Entity): Fix erroneous usage of the attribute
! 	First_Private_Entity.
! 
! 	* sem_ch7.adb (Install_Visible_Declarations): Add a barrier to protect
! 	the subprogram against wrong usage.
! 	Adapt the code to traverse the entities in the
! 	scope of a record_type because in addition to its usage regarding
! 	packages, this subprogram is also called by Expand_N_Freeze_Entity
! 	to install the visible declarations of the enclosing scope of a
! 	record_type_with_private to establish the proper visibility before
! 	freezing the entity and related subprograms.
! 
! 2005-03-17  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_ch2.adb (In_Assignment_Context): Recognize slice assignments to
! 	entry formals.
! 
! 2005-03-17  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_ch3.adb (Check_Attr): New subprogram.
! 	(Check_Stream_Attribute): Move the code for 13.13.2(9/1) enforcement
! 	into a new Check_Attr subprogram, in order to provide a more
! 	explanatory error message (including the name of the missing attribute).
! 	(Stream_Operation_OK): Renamed from Stream_Operations_OK. This
! 	subprogram determines whether a default implementation exists for a
! 	given stream attribute.
! 	(Make_Predefined_Primitive_Specs, Predefined_Primitive_Bodies):
! 	Determine whether to generate a default implementation for each stream
! 	attribute separately, as this depends on the specific attribute.
! 
! 	* exp_strm.adb (Make_Field_Attribute): For the case of an illegal
! 	limited extension where a stream attribute is missing for a limited
! 	component (which will have been flagged in Exp_Ch3.Sem_Attr), do not
! 	generate a bogus reference to the missing attribute to prevent
! 	cascaded errors. Instead, generate a null statement.
! 
! 	* sem_attr.adb (Check_Stream_Attribute): A stream attribute is
! 	available for a limited type if it has been specified for an ancestor
! 	of the type.
! 
! 2005-03-17  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_ch6.adb (Expand_Inlined_Call): handle the case when the renamed
! 	entity is an operator.
! 
! 2005-03-17  Thomas Quinot  <quinot@adacore.com>
! 
! 	* exp_dist.adb (Get_PCS_Name): Move from Exp_Dist body to Sem_Dist
! 	spec, to make this predicate available to other units.
! 
! 	* rtsfind.adb (Check_RPC): Use Sem_Dist.Get_PCS_Name instead of
! 	reimplementing it.
! 
! 	* sem_ch8.adb: Disable expansion of remote access-to-subprogram types
! 	when no distribution runtime library is available.
! 
! 	* sem_res.adb, sem_dist.adb: Disable expansion of remote
! 	access-to-subprogram types when no distribution runtime library is
! 	available.
! 	(Get_PCS_Name): Move from Exp_Dist body to Sem_Dist spec, to make this
! 	predicate available to other units.
! 
! 	* sem_dist.ads (Get_PCS_Name): Move from Exp_Dist body to Sem_Dist
! 	spec, to make this predicate available to other units.
! 
! 2005-03-17  Vincent Celier  <celier@adacore.com>
! 
! 	* make.adb (Insert_Project_Sources): Make sure the Q is always
! 	initialized.
! 
! 	* prj-nmsc.adb (Check_Ada_Naming_Scheme_Validity): Check Naming against
! 	the default for the tree, not the global default naming.
! 
! 	* prj-proc.adb (Recursive_Process): No need to put the default naming
! 	in the project data, it's already there.
! 
! 2005-03-17  Doug Rupp  <rupp@adacore.com>
! 
! 	* Makefile.in: (ia64-hp-*vms*): Use s-crtl-vms64.ads.
! 
!         * 5xcrtl.ads: Renamed to...
!         * s-crtl-vms64.ads: ...this new file
! 
! 2005-03-17  Robert Dewar  <dewar@adacore.com>
! 
! 	PR ada/19519
! 
! 	* namet.adb (Copy_One_Character): Set proper wide character encoding
! 	for upper half character if we have upper half encoding.
! 
! 2005-03-17  Robert Dewar  <dewar@adacore.com>
! 
! 	* par.adb (Par): Improved msg for attempt to recompile predefined unit
! 
! 2005-03-17  Thomas Quinot  <quinot@adacore.com>
! 
! 	* sem_ch13.adb (New_Stream_Function, New_Stream_Procedure): For a
! 	tagged limited type, the TSS is a newly built renaming declaration:
! 	insert it using Set_TSS, not Copy_TSS.
! 
! 2005-03-17  Javier Miranda  <miranda@adacore.com>
! 
! 	* sem_ch4.adb (Try_Primitive_Operation, Class_Wide_Operation and
! 	Try_Object_Operation): Analyze the object that is accessible
! 	through the prefix of the subprogram call before we apply
! 	the transformation of the object-operation notation.
! 
! 2005-03-17  Jose Ruiz  <ruiz@adacore.com>
! 
! 	* s-taprob.adb (Initialize_Protection): Initialize the protected
! 	object's owner to Null_Task.
! 	(Lock): If pragma Detect_Blocking is in effect and the caller of this
! 	procedure is already the protected object's owner then Program_Error
! 	is raised. In addition the protected object's owner is updated.
! 	(Lock_Read_Only): If pragma Detect_Blocking is in effect and the caller
! 	of this procedure is already the protected object's owner then
! 	Program_Error is raised.
! 	In addition the protected object's owner is updated.
! 	(Unlock): Remove the ownership of the protected object.
! 
! 	* s-taprob.ads (Protection): Add the field Owner, used to store the
! 	protected object's owner.
! 	This component is needed for detecting one type of potentially blocking
! 	operations (external calls on a protected subprogram with the same
! 	target object as that of the protected action). Document the rest of
! 	the components.
! 
! 	* s-tposen.adb, s-tpoben.adb (Initialize_Protection_Entries):
! 	Initialize the protected object's owner to Null_Task.
! 	(Lock_Read_Only_Entries): If pragma Detect_Blocking is in effect and the
! 	caller of this procedure is already the protected object's owner then
! 	Program_Error is raised.
! 	Do not raise Program_Error when this procedure is called from a
! 	protected action.
! 	(Unlock_Entries): Remove the ownership of the protected object.
! 	(Lock_Entries): If pragma Detect_Blocking is in effect and the caller
! 	of this procedure is already the protected object's owner then
! 	Program_Error is raised.
! 	Do not raise Program_Error when this procedure is called from
! 	a protected action.
! 
! 	* s-tposen.ads, s-tpoben.ads (Protection_Entries): Add the field Owner,
! 	used to store the protected object's owner.
! 
! 	* s-tpobop.adb (Protected_Entry_Call): If pragma Detect_Blocking is in
! 	effect and this procedure (a potentially blocking operation) is called
! 	from whithin a protected action, Program_Error is raised.
! 	(Timed_Protected_Entry_Call): If pragma Detect_Blocking is in effect
! 	and this procedure (a potentially blocking operation) is called from
! 	whithin a protected action, Program_Error is raised.
! 
! 2005-03-17  Vincent Celier  <celier@adacore.com>
! 	    Nicolas Setton  <setton@adacore.com>
! 
! 	* mlib-tgt-darwin.adb (Build_Dynamic_Library): Remove the "-fini"
! 	switch, not supported by the linker on Darwin. Add '_' before
! 	<library>init, as this character is added unconditionally by the
! 	compiler.
! 	(Is_Archive_Ext): Replace the wrong library extension ".dyld" by the
! 	correct one ".dylib". This fixes detection of the archive files when
! 	building library projects.
! 
! 2005-03-17  Vincent Celier  <celier@adacore.com>
! 
! 	* switch-m.adb (Normalize_Compiler_Switches): Recognize switches
! 	-gnat83, -gnat95 and -gnat05.
! 
! 2005-03-17  Vasiliy Fofanov  <fofanov@adacore.com>
! 
! 	* gnat_ugn.texi: Document gnatmem restriction
! 
! 2005-03-17  Thomas Quinot  <quinot@adacore.com>
! 
! 	* snames.adb: Document new TSS names introduced by exp_dist/exp_tss
! 	cleanup
! 
! 2005-03-17  Robert Dewar  <dewar@adacore.com>
! 
! 	* s-interr.ads, s-interr.adb, sem_ch3.adb, prj.ads, prj.adb,
! 	a-interr.adb, a-interr.ads, s-interr-sigaction.adb, s-interr-dummy.adb,
! 	s-interr-vms.adb, s-interr-vxworks.adb: Minor reformatting
! 
! 	* casing.adb: Comment improvements
! 
! 2005-03-17  Pascal Obry  <obry@adacore.com>
! 
! 	* g-expect.adb: Minor reformatting.
! 
! 2005-03-15  Zack Weinberg  <zack@codesourcery.com>
! 
! 	* Make-lang.in (doc/gnat_ugn_unw.info, doc/gnat_rm.info)
! 	(doc/gnat_ugn_unw.dvi, doc/gnat_rm.dvi): Add gcc-vers.texi
! 	to dependencies.
! 
! 2005-03-15  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-tgt-darwin.adb (Library_Exist_For, Library_File_Name_For):
! 	Add new parameter In_Tree to specify the project tree: needed
! 	by the project manager. Adapt to changes in project manager
! 	using new parameter In_Tree.
! 
! 2005-03-15  Jakub Jelinek  <jakub@redhat.com>
! 
! 	* Make-lang.in (ada/treeprs.ads, ada/einfo.h, ada/sinfo.h,
! 	ada/nmake.adb, ada/nmake.ads): Use unique subdirectories of
! 	ada/bldtools to avoid make -jN failures.
! 
! 2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* trans.c (gnat_to_gnu) <N_Return_Statement>: Set gnu_result
! 	to NULL_TREE on entry.
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* system-unixware.ads, system-linux-ia64.ads, system-freebsd-x86.ads,
! 	system-lynxos-ppc.ads, system-lynxos-x86.ads, system-linux-x86_64.ads,
! 	system-tru64.ads, system-aix.ads, system-vxworks-sparcv9.ads,
! 	system-vxworks-xscale.ads, system-solaris-x86.ads, system-irix-o32.ads,
! 	system-irix-n32.ads, system-hpux.ads, system-vxworks-m68k.ads,
! 	system-linux-x86.ads, system-vxworks-mips.ads, system-os2.ads,
! 	system-interix.ads, system-solaris-sparc.ads,
! 	system-solaris-sparcv9.ads, system-vms.ads, system-mingw.ads,
! 	system-vms-zcx.ads, system-vxworks-ppc.ads, system-vxworks-alpha.ads,
! 	system-vms_64.ads, system-darwin-ppc.ads, system-vxworks-x86.ads,
! 	system-linux-ppc.ads, system-linux-alpha.ads, system-linux-sparc.ads,
! 	system-linux-s390.ads, system-linux-s390x.ads: Add line defining
! 	Compiler_System_Version to be False.
! 
! 	* opt.ads: Add new flag Opt.Address_Is_Private
! 
! 	* targparm.ads, targparm.adb: Set new flag Opt.Address_Is_Private
! 	Add new parameter Compiler_System_Version to avoid checking for
! 	completeness of parameters when compiler is compiling itself.
! 	Allows old versions of GNAT to be compiled with new compiler.
! 
! 2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* s-osinte-tru64.ads, s-osinte-tru64.adb (Get_Stack_Base): New function
! 	(Hide_Yellow_Zone): New procedure to hide the Yellow Zone of the
! 	calling thread.
! 	(Stack_Base_Available): New flag.
! 	(Get_Page_Size): New overloaded functions imported from C.
! 	(PROT_NONE, PROT_READ, PROT_WRITE, PROT_EXEC, PROT_ALL,
! 	PROT_ON, PROT_OFF): New constants.
! 	(mprotect): New function imported from C.
! 	(pthread_teb_t): New record type.
! 
! 	* s-taprop-tru64.adb: (Enter_Task): Invoke Hide_Yellow_Zone.
! 	(Create_Task): Account for the Yellow Zone and the guard page.
! 
! 2005-03-15  Vincent Celier  <celier@adacore.com>
! 
! 	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
! 	mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb,
! 	mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-mingw.adb,
! 	mlib-tgt-vxworks.adb, mlib-tgt-lynxos.adb (Library_Exist_For,
! 	Library_File_Name_For): Add new parameter In_Tree
! 	to specify the project tree: needed by the project manager.
! 	Adapt to changes in project manager using new parameter In_Tree.
! 	Remove local imports, use functions in System.CRTL.
! 
! 	* make.adb, clean.adb, gnatcmd.adb (Project_Tree): New constant needed
! 	to use the project manager.
! 
! 	* makeutl.ads, makeutl.adb (Linker_Options_Switches): New parameter
! 	In_Tree to designate the project tree. Adapt to changes in the project
! 	manager, using In_Tree.
! 
! 	* mlib-prj.ads, mlib-prj.adb (Build_Library, Check_Library,
! 	Copy_Interface_Sources): Add new parameter In_Tree to specify the
! 	project tree: needed by the project manager.
! 	(Build_Library): Check that Arg'Length >= 6 before checking if it
! 	contains "--RTS=...".
! 
! 	* mlib-tgt.ads, mlib-tgt.adb (Library_Exist_For,
! 	Library_File_Name_For): Add new parameter In_Tree to specify the
! 	project tree: needed by the project manager.
! 
! 	* prj.ads, prj.adb: Major modifications to allow several project trees
! 	in memory at the same time.
! 	Change tables to dynamic tables and hash tables to dynamic hash
! 	tables. Move tables and hash tables from Prj.Com (in the visible part)
! 	and Prj.Env (in the private part). Move some constants from the visible
! 	part to the private part. Make other constants deferred.
! 	(Project_Empty): Make it a variable, not a function
! 	(Empty_Project): Add parameter Tree. Returns the data with the default
! 	naming data of the project tree Tree.
! 	(Initialize): After updating Std_Naming_Data, copy its value to the
! 	component Naming of Project Empty.
! 	(Register_Default_Naming_Scheme): Use and update the default naming
! 	component of the project tree, instead of the global variable
! 	Std_Naming_Data.
! 	(Standard_Naming_Data): Add defaulted parameter Tree. If project tree
! 	Tree is not defaulted, return the default naming data of the Tree.
! 	(Initial_Buffer_Size): Constant moved from private part
! 	(Default_Ada_Spec_Suffix_Id, Default_Ada_Body_Suffix_Id, Slash_Id); new
! 	variables initialized in procedure Initialize.
! 	(Add_To_Buffer): Add two in out parameters to replace global variables
! 	Buffer and Buffer_Last.
! 	(Default_Ada_Spec_Suffix, Default_Body_Spec_Suffix, Slash): New
! 	functions.
! 	Adapt to changes to use new type Project_Tree_Ref and dynamic tables and
! 	hash tables.
! 	(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
! 	for the project tree.
! 	(Project_Tree_Data, Project_Tree_Ref, No_Project): Declare types and
! 	constant at the beginning of the package spec, so that they cane be used
! 	in subprograms before their full declarations.
! 	(Standard_Naming_Data): Add defaulted parameter of type Project_Node_Ref
! 	(Empty_Project): Add parameter of type Project_Node_Ref
! 	(Private_Project_Tree_Data): Add component Default_Naming of type
! 	Naming_Data.
! 	(Buffer, Buffer_Last): remove global variables
! 	(Add_To_Buffer): Add two in out parameters to replace global variables
! 	Buffer and Buffer_Last.
! 	(Current_Packages_To_Check): Remove global variable
! 	(Empty_Name): Move to private part
! 	(No-Symbols): Make it a constant
! 	(Private_Project_Tree_Data): New type for the private part of the
! 	project tree data.
! 	(Project_Tree_Data): New type for the data of a project tree
! 	(Project_Tree_Ref): New type to designate a project tree
! 	(Initialize, Reset, register-Default_Namng-Scheme): Add a new parameter
! 	for the project tree.
! 
! 	* prj-attr.ads: Add with Table; needed, as package Prj no longer
! 	imports package Table.
! 
! 	* prj-com.adb: Remove empty, no longer needed body
! 
! 	* prj-com.ads: Move most of the content of this package to package Prj.
! 
! 	* prj-dect.ads, prj-dect.adb (Parse): New parameters In_Tree to
! 	designate the project node tree and Packages_To_Check to replace
! 	global variable Current_Packages_To_Check.
! 	Add new parameters In_Tree and Packages_To_Check to local subprograms,
! 	when needed. Adapt to changes in project manager with project node tree
! 	In_Tree.
! 
! 	* prj-env.ads, prj-env.adb: Add new parameter In_Tree to designate the
! 	project tree to most subprograms. Move tables and hash tables to
! 	private part of package Prj.
! 	Adapt to changes in project manager using project tree In_Tree.
! 
! 	* prj-makr.adb (Tree): New constant to designate the project node tree
! 	Adapt to change in project manager using project node tree Tree
! 
! 	* prj-nmsc.ads, prj-nmsc.adb (Check_Stand_Alone_Library): Correctly
! 	display the Library_Src_Dir and the Library_Dir.
! 	Add new parameter In_Tree to designate the project node tree to most
! 	subprograms. Adapt to changes in the project manager, using project tree
! 	In_Tree.
! 	(Check_Naming_Scheme): Do not alter the casing on platforms where
! 	the casing of file names is not significant.
! 	(Check): Add new parameter In_Tree to designate the
! 
! 	* prj-pars.ads, prj-pars.adb (Parse): Add new parameter In_Tree to
! 	designate the project tree.
! 	Declare a project node tree to call Prj.Part.Parse and Prj.Proc.Process
! 
! 	* prj-part.ads, prj-part.adb (Buffer, Buffer_Last): Global variables,
! 	to replace those that were in the private part of package Prj.
! 	Add new parameter In__Tree to designate the project node tree to most
! 	subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.
! 	(Post_Parse_Context_Clause): When specifying the project node of a with
! 	clause, indicate that it is a limited with only if there is "limited"
! 	in the with clause, not necessarily when In_Limited is True.
! 	(Parse): Add new parameter In_Tree to designate the project node tree
! 
! 	* prj-pp.ads, prj-pp.adb (Pretty_Print): Add new parameter In_Tree to
! 	designate the project node tree. Adapt to change in Prj.Tree with
! 	project node tree In_Tree.
! 
! 	* prj-proc.ads, prj-proc.adb (Recursive_Process): Specify the project
! 	tree In_Tree in the call to function Empty_Process to give its initial
! 	value to the project data Processed_Data.
! 	Add new parameters In_Tree to designate the project tree and
! 	From_Project_Node_Tree to designate the project node tree to several
! 	subprograms. Adapt to change in project manager with project tree
! 	In_Tree and project node tree From_Project_Node_Tree.
! 
! 	* prj-strt.ads, prj-strt.adb (Buffer, Buffer_Last): Global variables,
! 	to replace those that were in the private part of package Prj.
! 	Add new parameter In_Tree to designate the project node tree to most
! 	subprograms. Adapt to change in Prj.Tree with project node tree In_Tree.
! 
! 	* prj-tree.ads, prj-tree.adb: Add new parameter of type
! 	Project_Node_Tree_Ref to most subprograms.
! 	Use this new parameter to store project nodes in the designated project
! 	node tree.
! 	(Project_Node_Tree_Ref): New type to designate a project node tree
! 	(Tree_Private_Part): Change table to dynamic table and hash tables to
! 	dynamic hash tables.
! 
! 	* prj-util.ads, prj-util.adb: Add new parameter In_Tree to designate
! 	the project tree to most subprograms. Adapt to changes in project
! 	manager using project tree In_Tree.
! 
! 	* makegpr.adb (Project_Tree): New constant needed to use project
! 	manager.
! 
! 2005-03-15  Olivier Hainque  <hainque@adacore.com>
! 
! 	* s-intman-posix.adb (Notify_Exception): Adjust signature, as handler
! 	for sigactions with SA_SIGINFO set. Call
! 	__gnat_adjust_context_for_raise before raising, to perform the
! 	potentially required adjustments to the machine context for the GCC
! 	unwinder.
! 
! 	* raise.h (__gnat_adjust_context_for_raise): New prototype.
! 
! 	* init.c (__gnat_adjust_context_for_raise) HPUX: Initial revision.
! 	Adjust PC by one in the provided machine context.
! 	(__gnat_install_handler) HPUX: Set SA_SIGINFO in the sigaction flags,
! 	so that the handler is passed the context structure to adjust prior to
! 	the raise.
! 	(__gnat_error_handler) HPUX: Adjust the signature to match what an
! 	SA_SIGINFO sigaction should look like. Call
! 	__gnat_adjust_context_for_raise before actually raising.
! 	(__gnat_adjust_context_for_raise): Default noop to help PC
! 	adjustments before raise from signal handlers.
! 	(__gnat_error_handler): Indirectly call a predicate function to
! 	determine if a condition should be resignaled or not.
! 	(__gnat_set_resignal_predicate): User interface to modify the predicate.
! 	(__gnat_default_resignal_p): Default GNAT predicate.
! 
! 2005-03-15  Doug Rupp  <rupp@adacore.com>
! 
! 	* adaint.c: Prefix #include of VMS system header files with vms/
! 	[VMS] (HOST_EXECUTABLE_SUFFIX, HOST_OBJECT_SUFFIX): Define for VMS.
! 	Do not define a dummy function "convert_addresses" under Darwin,
! 	not needed.
! 
! 	* tb-alvms.c, expect.c: Prefix #include of VMS system header files
! 	with vms/
! 
! 2005-03-15  Nicolas Setton  <setton@adacore.com>
! 
! 	* tracebak.c: Under Darwin, use the same unwinding mechanisms as under
! 	PPC/AIX.
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-reatim.ads, a-reatim.adb: Add functions Minutes and Seconds for
! 	AI-386.
! 
! 	* a-retide.ads: Minor comment changes
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* a-stzunb.adb, a-stzunb.adb a-stzunb.ads, a-stzunb.ads,
! 	a-stwiun.ads, a-stwiun.adb, a-strunb.ads, a-strunb.adb: Move
! 	Realloc_For_Chunk to private part of package.
! 	New subprograms for AI-301
! 
! 	* a-szuzti.adb, a-suteio.adb, a-swuwti.adb: Improve efficiency of
! 	Get_Line procedure.
! 	Avoid unnecessary use of Get/Set_Wide_String
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	PR ada/13470
! 
! 	* a-stunau.ads, a-stunau.adb:
! 	Change interface to allow efficient (and correct) implementation
! 	The previous changes to allow extra space in unbounded strings had
! 	left this interface a bit broken.
! 
! 	* a-suteio.adb: Avoid unnecessary use of Get/Set_String
! 
! 	* g-spipat.ads, g-spipat.adb: New interface for Get_String
! 	Minor reformatting (function specs)
! 
! 	* g-spitbo.adb: New interface for Get_String
! 
! 	* g-spitbo.ads: Minor reformatting
! 
! 	* a-swunau.ads, a-swunau.adb: New interface for Get_Wide_String
! 
! 	* a-szunau.ads, a-szunau.adb: New interface for Get_Wide_Wide_String
! 
! 2005-03-15  Javier Miranda  <miranda@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Thomas Quinot  <quinot@adacore.com>
! 	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 
! 	* atree.ads, atree.adb: Add support for Elist24 field
! 
! 	* atree.h: Fix wrong definition of Field27
! 	Add support for Elist16 field
! 	Add support for Elist24 field
! 
! 	* einfo.ads, einfo.adb (Abstract_Interfaces,
! 	Set_Abstract_Interfaces): New subprograms.
! 	(Abstract_Interface_Alias, Set_Abstract_Interface_Alias): New
! 	subprograms.
! 	(Access_Disp_Table, Set_Access_Disp_Table): Modified to handle a list of
! 	entities rather than a single node.
! 	(Is_Interface, Set_Is_Interface): New subprogram
! 	(First_Tag_Component): New syntesized attribute
! 	(Next_Tag_Component): New synthesized attribute
! 	(Write_Entity_Flags): Upgraded to write Is_Interface
! 	(Write_Field24_Name): Upgraded to write Abstract_Interfaces
! 	(Write_Field25_Name): Upgraded to write Abstract_Interface_Alias
! 	(Task_Body_Procedure): New subprogram to read this attribute.
! 	(Set_Task_Body_Procedure): New subprogram to set this attribute.
! 	(Has_Controlled_Component): Now applies to all entities.
! 	This is only a documentation change, since it always worked to apply
! 	this to other than composite types (yielding false), but now this is
! 	official.
! 	Update documentation on Must_Be_Byte_Aligned for new spec
! 
! 	* tbuild.adb, exp_dist.adb, exp_disp.adb, exp_ch3.ads, exp_ch3.adb,
! 	exp_attr.adb, exp_aggr.adb, exp_ch4.adb, exp_ch5.adb: Upgrade all the
! 	uses of the Access_Disp_Table attribute to reference the first dispatch
! 	table associated with a tagged type. As
! 	part of the implementation of abstract interface types,
! 	Access_Disp_Table has been redefined to contain a list of dispatch
! 	tables (rather than a single dispatch table).
! 	Similarly, upgrade all the references to Tag_Component by the
! 	new attribute First_Tag_Component.
! 	(Find_Inherited_TSS): Moved to exp_tss.
! 	Clean up test in Expand_N_Object_Declaration for cases
! 	where we need to do a separate assignment of the initial value.
! 	(Expand_N_Object_Declaration): If the expression in the
! 	declaration of a tagged type is an aggregate, no need to generate an
! 	additional tag assignment.
! 	(Freeze_Type): Now a function that returns True if the N_Freeze_Entity
! 	is to be deleted.
! 	Bit packed array ops are only called if operands are known to be
! 	aligned.
! 	(Component_Equality): When returning an N_Raise_Program_Error statement,
! 	ensure that its Etype is set to Empty to avoid confusing GIGI (which
! 	expects that only expressions have a bona fide type).
! 	(Make_Tag_Ctrl_Assignment): Use Build_Actual_Subtype to correctly
! 	determine the amount of data to be copied.
! 
! 	* par.adb (P_Interface_Type_Definition): New subprogram that parses the
! 	new syntax rule of Ada 2005 interfaces (for AI-251 and AI-345):
! 	    INTERFACE_TYPE_DEFINITION ::=
! 	      [limited | task | protected | synchronized] interface
! 		[AND interface_list]
! 
! 	* par-ch3.adb (P_Type_Declaration): Modified to give support to
! 	interfaces.
! 	(P_Derived_Type_Def_Or_Private_Ext_Decl): Modified to give support to
! 	interfaces.
! 	(P_Interface_Type_Definition): New subprogram that parses the new
! 	syntax rule of Ada 2005 interfaces
! 	(P_Identifier_Declarations): fix two occurrences of 'RENAMES' in error
! 	messages by the correct RENAMES (quotes removed).
! 
! 	* sem_prag.adb: Upgrade all the references to Tag_Component by the new
! 	attribute First_Tag_Component.
! 
! 	* sinfo.ads, sinfo.adb: Remove OK_For_Stream flag, not used, not needed
! 	(Interface_List, Set_Interface_List): New subprograms.
! 	(Interface_Present, Set_Interface_Present): New subprograms.
! 	(Limited_Present, Set_Limited_Present): Available also in derived
! 	type definition nodes.
! 	(Protected_Present, Set_Protected_Present): Available also in
! 	record type definition and
! 	derived type definition nodes.
! 	(Synchronized_Present, Set_Synchronized_Present): New subprograms.
! 	(Task_Present, Set_Task_Present): New subprogram.
! 	(Task_Body_Procedure): Removed.
! 	(Set_Task_Body_Procedure): Removed.
! 	These subprogram have been removed because the attribute
! 	Task_Body_Procedure has been moved to the corresponding task type
! 	or task subtype entity to leave a field free to store the list
! 	of interfaces implemented by a task (for AI-345)
! 	Add Expression field to N_Raise_Statement node for Ada 2005 AI-361
! 	(Null_Exclusion_Present): Change to Flag11, to avoid conflict with
! 	expression flag Do_Range_Check
! 	(Exception_Junk): Change to Flag7 to accomodate above change
! 	(Box_Present, Default_Name, Specification, Set_Box_Present,
! 	Set_Default_Name, Set_Specification): Expand the expression
! 	"X in N_Formal_Subprogram_Declaration" into the corresponding
! 	two comparisons. Required to use the csinfo tool.
! 
! 	* exp_ch11.adb (Expand_N_Raise_Statement): Deal with case where
! 	"with string" given.
! 
! 	* sem_ch11.adb (Analyze_Raise_Statement): Handle case where string
! 	expression given.
! 
! 	* par-ch11.adb (P_Raise_Statement): Recognize with string expression
! 	in 2005 mode
! 
! 	* exp_ch9.adb (Build_Task_Proc_Specification): Modified to use entity
! 	attribute Task_Body_Procedure rather than the old semantic field that
! 	was available in the task_type_declaration node.
! 
! 	* par-ch12.adb (P_Formal_Type_Definition): Modified to handle formal
! 	interface type definitions.
! 	(P_Formal_Derived_Type_Definition): Modified to handle the list of
! 	interfaces.
! 
! 	* par-ch9.adb (P_Task): Modified to handle the list of interfaces in a
! 	task type declaration.
! 	(P_Protected): Modified to handle the list of interfaces in a
! 	protected type declaration.
! 
! 2005-03-15  Doug Rupp  <rupp@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 
! 	* bindgen.adb (Gen_Main_C): Change WBI __posix_exit to decc$posix_exit
! 	(Gen_Output_File_C): Likewise.
! 	(Gen_Main_C): Issue #include <stdlib.h> to avoid warning
! 
! 2005-03-15  Thomas Quinot  <quinot@adacore.com>
! 
! 	* checks.adb (Get_E_First_Or_Last): When the expression being retrieved
! 	is an N_Raise_Constraint_Error node, create a new copy of it without
! 	going through a call to Duplicate_Subexpr.
! 
! 2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
! 	    Nicolas Setton  <setton@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	PR ada/19900
! 	PR ada/19408
! 	PR ada/19140
! 	PR ada/20255
! 
! 	* decl.c (gnat_to_gnu_field): Reject aliased components with a
! 	representation clause that prescribes a size not equal to the rounded
! 	size of their types.
! 	(gnat_to_gnu_entity, case E_Component): Always look at
! 	Original_Record_Component if Present and not the entity.
! 	(gnat_to_gnu_entity, case E_Record_Subtype): Rework handling of subtypes
! 	of tagged extension types by not making field for components that are
! 	inside the parent.
! 	(gnat_to_gnu_entity) <E_Record_Type>: Fix typo in the alignment formula
! 	(gnat_to_gnu_entity) <E_Variable>: Do not convert again the
! 	expression to the type of the object when the object is constant.
! 	Reverse defer_debug_incomplete_list before traversing it, so that trees
! 	are processed in the order at which they were added to the list. This
! 	order is important when using the stabs debug format.
! 	If we are deferring the output of debug information, also defer this
! 	output for a function return type.
! 	When adding fields to a record, prevent emitting debug information
! 	for incomplete records, emit the information only when the record is
! 	complete.
! 	(components_to_record): New parameter defer_debug.
! 	(gnat_to_gnu_entity, case E_Array_Subtype): Call copy_alias_set.
  	(gnat_to_gnu_field_decl): New function.
  	(substitution_list, annotate_rep): Call it.
  	(gnat_to_gnu_entity, case E_Record_Subtype): Likewise.
***************
*** 76,151 ****
  	No longer update discriminants to not be a COMPONENT_REF.
  	(copy_alias_set): Strip padding from input type; also handle
  	unconstrained arrays properly.
- 	* trans.c (gnat_to_gnu, case N_Selected_Component): Call
- 	gnat_to_gnu_field_decl.
- 	(assoc_to_constructor): Likewise.
  
! 2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/19408
! 	PR ada/19900
! 	Backport from mainline:
  
- 	2005-03-15  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
  	* exp_util.adb (Remove_Side_Effects): Properly test for
  	Expansion_Delayed and handle case when it's inside an
  	N_Qualified_Expression.
! 	* decl.c (gnat_to_gnu_entity, case E_Component): Always look at
! 	Original_Record_Component if Present and not the entity.
! 	(gnat_to_gnu_entity, case E_Record_Subtype): Rework handling of subtype
! 	of tagged extension types by not making field for components that are
! 	inside the parent.
  	* trans.c (gnat_to_gnu, case N_Aggregate): Verify that
  	Expansion_Delayed is False.
  	(assoc_to_constructor): Ignore fields that have a
  	Corresponding_Discriminant.
!     
! 2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
! 	PR ada/19140
! 	Backport from mainline:
  
! 	2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 	* decl.c (gnat_to_gnu_entity) <E_Variable>: Do not convert again the
! 	expression to the type of the object when the object is constant.
! 	* trans.c (gnat_to_gnu) <N_Return_Statement>: Restructure.  Set
! 	gnu_result to NULL_TREE on entry.  If the function returns "by
! 	target", dereference the target pointer using the type of the
! 	actual return value.
! 	<all>: Be prepared for a null gnu_result.
! 	* utils2.c (build_binary_op): Fix typo.
  
! 2005-03-17  Eric Botcazou  <ebotcazou@adacore.com>
  
  	PR ada/20344
- 	Backport from mainline:
  
! 	2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
  	* lang.opt: Fix specification of -fRTS=.
- 	* misc.c (gnat_handle_option): Accept OPT_fRTS_, not OPT_fRTS.
-     
- 2005-03-15  Jakub Jelinek  <jakub@redhat.com>
  
! 	* Make-lang.in (ada/treeprs.ads, ada/einfo.h, ada/sinfo.h,
! 	ada/nmake.adb, ada/nmake.ads): Use unique subdirectories of
! 	ada/bldtools to avoid make -jN failures.
  
  2005-03-08  Laurent Guerby <laurent@guerby.net>
  
  	* system-linux-sparc.ads: Fix typo in previous commit.
  
! 2005-03-07  James A. Morrison <phython@gcc.gnu.org>	
!             Laurent Guerby <laurent@guerby.net>
  
  	PR ada/20035
  	* system-linux-sparc.ads: New.
  	* Makefile.in: Add sparc linux entry.
! 	
  2005-02-13  Andrew Pinski  <pinskia@physics.uc.edu>
  
  	PR ada/19942
! 	* utils.c (gnat_type_for_mode): Return null instead of ICE because we asked
! 	for an unknown mode.
  
  2005-02-12  Richard Henderson  <rth@redhat.com>
  
--- 5773,6135 ----
  	No longer update discriminants to not be a COMPONENT_REF.
  	(copy_alias_set): Strip padding from input type; also handle
  	unconstrained arrays properly.
  
! 	* gigi.h (write_record_type_debug_info): New function.
! 	Convert to use ANSI-style prototypes. Remove unused
! 	declarations for emit_stack_check, elab_all_gnat and
! 	set_second_error_entity.
! 	(gnat_to_gnu_field_decl): New decl.
  
! 	* utils.c (write_record_type_debug_info): New function.
! 	(finish_record_type): Delegate generation of debug information to
! 	write_record_type_debug_info.
! 	(update_pointer_to): Remove unneeded calls to rest_of_decl_compilation.
! 	(update_pointer_to): Fix pasto.
! 	(convert) <UNION_TYPE>: Accept slight type variations when
! 	converting to an unchecked union type.
! 
! 	* exp_ch13.adb (Expand_N_Freeze_Entity): If Freeze_Type returns True,
! 	replace the N_Freeze_Entity with a null statement.
! 
! 	* freeze.adb (Freeze_Expression): If the freeze nodes are generated
! 	within a constrained subcomponent of an enclosing record, place the
! 	freeze nodes in the scope stack entry for the enclosing record.
! 	(Undelay_Type): New Subprogram.
! 	(Set_Small_Size): Pass T, the type to modify; all callers changed.
! 	(Freeze_Entity, Freeze_Record_Type): Change the way we handle types
! 	within records; allow them to have freeze nodes if their base types
! 	aren't frozen yet.
  
  	* exp_util.adb (Remove_Side_Effects): Properly test for
  	Expansion_Delayed and handle case when it's inside an
  	N_Qualified_Expression.
! 
! 	* sem_ch3.adb (Derived_Type_Declaration): New predicate
! 	Comes_From_Generic, to recognize accurately that the parent type in a
! 	derived type declaration can be traced back to a formal type, because
! 	it is one or is derived from one, or because its completion is derived
! 	from one.
! 	(Constrain_Component_Type): If component comes from source and has no
! 	explicit constraint, no need to constrain in in a subtype of the
! 	enclosing record.
! 	(Constrain_Access, Constrain_Array): Allow itypes to be delayed.
! 	Minor change to propagate Is_Ada_2005 flag
! 
  	* trans.c (gnat_to_gnu, case N_Aggregate): Verify that
  	Expansion_Delayed is False.
  	(assoc_to_constructor): Ignore fields that have a
  	Corresponding_Discriminant.
! 	(gnat_to_gnu) <N_Return_Statement>: Restructure. If the
! 	function returns "by target", dereference the target pointer using the
! 	type of the actual return value.
! 	<all>: Be prepared for a null gnu_result.
! 	(processed_inline_subprograms): Check flag_really_no_inline
! 	instead of flag_no_inline.
! 	(set_second_error_entity): Remove unused function.
! 	(gnat_to_gnu, case N_Selected_Component): Call
! 	gnat_to_gnu_field_decl.
! 	(assoc_to_constructor): Likewise.
  
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
  
! 	* exp_pakd.adb (Create_Packed_Array_Type): Do not set
! 	Must_Be_Byte_Aligned for cases where we do not need to use a
! 	System.Pack_nn unit.
  
! 	* exp_ch6.adb (Expand_Call): Call Expand_Actuals for functions as well
! 	as procedures.
! 	Needed now that we do some processing for IN parameters as well. This
! 	may well fix some unrelated errors.
! 	(Expand_Call): Handle case of unaligned objects (in particular those
! 	that come from packed arrays).
! 	(Expand_Inlined_Call): If the subprogram is a renaming as body, and the
! 	renamed entity is an inherited operation, re-expand the call using the
! 	original operation, which is the one to call.
! 	Detect attempt to inline parameterless recursive subprogram.
! 	(Represented_As_Scalar): Fix to work properly with private types
! 	(Is_Possibly_Unaligned_Object): Major rewrite to get a much more
! 	accurate estimate. Yields True in far fewer cases than before,
! 	improving the quality of code that depends on this test.
! 
! 	* exp_util.adb (Kill_Dead_Code): For a package declaration, iterate
! 	over both visible and private declarations to remove them from tree,
! 	and mark subprograms declared in package as eliminated, to prevent
! 	spurious use in subsequent compilation of generic units in the context.
! 
! 	* exp_util.ads: Minor cleanup in variable names
! 
! 	* sem_eval.ads, sem_eval.adb: Minor reformatting
! 	(Compile_Time_Known_Bounds): New function
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_ch7.adb (Convert_View): Use base types of underlying types when
! 	determining whether an unchecked conversion is needed for the argument
! 	of an initialization call.
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* exp_intr.adb (Expand_Unc_Conversion): As a target type, use the type
! 	that appears in the instantiation rather than the internal subtype
! 	generated in the wrapper package, to avoid anomalies in gigi when the
! 	target is derived from a private type whose full view is an access type.
  
+ 2005-03-15  Robert Dewar  <dewar@adacore.com>
+ 
+ 	* exp_smem.adb, sem_attr.adb: Remove OK_For_Stream flag, not used,
+ 	not needed.
+ 	Add documentation to replace the use of this flag
+ 	Fix kludge for Maximum_Alignment on x86 so that it does not apply to
+ 	the x86_64.
+ 
+ 2005-03-15  Thomas Quinot  <quinot@adacore.com>
+ 
+ 	* exp_tss.ads, exp_tss.adb (Find_Inherited_TSS): New subprogram, moved
+ 	here from exp_attr so it can be shared between exp_attr and exp_dist.
+ 	(TSS_Names): Renamed from OK_TSS_Names. This array contains the list of
+ 	all TSS names, not a subset thereof, and the previous name introduced
+ 	an unnecessarily confusion that a distinction might exist between
+ 	"OK" TSS names and some "not OK" TSS names.
+ 
+ 2005-03-15  Doug Rupp  <rupp@adacore.com>
+ 
+ 	* gnatchop.adb (Locate_Executable): Normalize the possibly VMS style
+ 	Command_Name.
+ 
+ 2005-03-15  Pascal Obry  <obry@adacore.com>
+ 	    Eric Botcazou  <ebotcazou@adacore.com>
+ 
+ 	PR ada/20226
  	PR ada/20344
  
! 	* init.c (__gnat_initialize): Do not call __gnat_install_SEH_handler()
! 	when IN_RTS. This is to work around a bootstrap path problem.
! 
! 	* misc.c (gnat_parse_file): Create a SEH (Structured Exception Handler)
! 	table and pass it to __gnat_install_SEH_handler().
! 	(gnat_handle_option): Accept OPT_fRTS_, not OPT_fRTS.
! 
  	* lang.opt: Fix specification of -fRTS=.
  
! 2005-03-15  Doug Rupp  <rupp@adacore.com>
! 	    Bernard Banner  <banner@adacore.com>
! 	    Vincent Celier  <celier@adacore.com>
! 	    Arnaud Charlet  <charlet@adacore.com>
! 
! 	PR ada/6852
! 	This change works fine when gnatlib is built from the gcc directory,
! 	but does not work when using the libada Makefile, since GCC_FOR_TARGET
! 	is not passed to ada/Makefile.in, so more work is needed by a
! 	Makefile/configure expert.
! 
! 	* Makefile.in(gnatlib): Use $(GCC_FOR_TARGET) for compiling library.
! 	set GMEM_LIB on ia64 linux to add optional support for gnatmem.
! 	Setup gnatlink switch -M for x86_64 linux, as it is already setup
! 	for Linux x86.
! 	(gnatlib-shared-default): Use GNATLIBCFLAGS as well.
! 	Run ranlib on libgccprefix.a
! 	Define PREFIX_OBJS for Darwin, to build libgccprefix.
! 	(ADA_INCLUDE_SRCS): Split Ada packages.
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* Make-lang.in: Add g-utf_32 unit for gnat and gnatbind
! 
! 	* impunit.adb: Add GNAT.UTF_32
! 
! 	* scng.adb: Use gnat.utf_32 instead of widechar for utf_32 stuff
! 
! 	* widechar.ads, widechar.adb: Remove redundant UTF-32 tables (scng
! 	now uses GNAT.UTF_32).
! 
! 	* g-utf_32.ads, g-utf_32.adb: This is a new unit with full
! 	capabilities for categorizing characters using Unicode categories
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch10.adb (Build_Ancestor_Name): If the ancestor is an
! 	instantiation that has been rewritten as a package body, retrieve spec
! 	to generate proper name for implicit_with_clause.
! 	(Install_Parents): Recognize a parent that is an instantiation but has
! 	been rewritten as a package declaration during analysis.
! 
! 2005-03-15  Javier Miranda  <miranda@adacore.com>
! 	    Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch12.adb (Instantiate_Object): If the analysis of the actual
! 	parameter reported some error we immediately return. This improves the
! 	behaviour of the frontend in case of errors.
! 	(Install_Parent, Remove_Parent): Introduce new flag
! 	Parent_Unit_Visible, to preserve the proper visibility of the ultimate
! 	ancestor of a generic child unit, when the child is being instantiated.
! 	(Inline_Instance_Body): If we are compiling the private
! 	part or the body of a child unit, restore the proper visibility of the
! 	parents after compiling the instance body.
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 	    Javier Miranda  <miranda@adacore.com>
! 
! 	PR ada/15608
! 	* sem_util.adb (Get_Task_Body_Procedure): Type may be the completion
! 	of a private type, in which case it is underlying_type that denotes
! 	the proper task. Also modified to use the new entity attribute
! 	that is directly available in the task type and task subtype entities
! 	(Build_Actual_Subtype_Of_Component): Handle properly multidimensional
! 	arrays when other dimensions than the first are constrained by
! 	discriminants of an enclosing record.
! 	(Insert_Explicit_Dereference): If the prefix is an indexed component or
! 	a combination of indexed and selected components, find ultimate entity
! 	and generate the appropriate reference for it, to suppress spurious
! 	warnings.
! 	(Note_Possible_Modification): If an entity name has no entity, return.
! 	(Is_Variable): A function call never denotes a variable.
! 	(Requires_Transient_Scope): For record types, recurse only on
! 	components, not on internal subtypes that may have been generated for
! 	constrained components.
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch4.adb (Analyze_Concatenation): Do not consider operators marked
! 	Eliminated as candidates for resolution. Both efficient, and avoids
! 	anomalies with operators declared in deleted code.
! 	(Process_Implicit_Dereference_Prefix): Use this procedure whenever
! 	expansion is disabled (as when compiling a generic) to prevent spurious
! 	warnings on prefixes of selected components.
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch6.adb (Is_Private_Declaration): Verify that the declaration is
! 	attached to a list before checking whether it appears in the private
! 	declarations of the current package.
! 	(Make_Inequality_Operator): Insert declaration in proper declarative
! 	list rather than just setting the Parent field, so that
! 	Is_Private_Declaration can handle it properly.
! 
! 2005-03-15  Ed Schonberg  <schonberg@adacore.com>
! 
! 	* sem_ch8.adb (Analyze_Subprogram_Renaming): In a generic, if this is
! 	a renaming a body, check that the renamed subprogram in not intrinsic.
! 	(Find_Direct_Name): If several use_visible entities hide
! 	each other, and the context is a predefined file compiled through
! 	rtsfind, keep only the entity that comes from a predefined file.
! 
! 2005-03-15  Geert Bosch  <bosch@adacore.com>
! 
! 	* s-fatgen.adb (Valid): Extend special exceptions to account for long
! 	long float padding to also cover AMD64 and IA64.
! 
! 2005-03-15  Gary Dismukes  <dismukes@adacore.com>
! 
! 	* s-imgwch.adb: Add with and use of Interfaces.
! 	(Img_Wide_Character): Change type of Val to Unsigned_16.
! 	(Img_Wide_Wide_Character): Change type of Val to Unsigned_32.
! 
! 2005-03-15  Matthew Gingell  <gingell@adacore.com>
! 
! 	* sysdep.c: Implement __gnat_localtime_r as call to localtime_r on AIX.
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* usage.adb: Add missing lines for -gnat95 and -gnat05 switches
! 
! 	* sem_ch7.adb: Minor change to propagate Is_Ada_2005 flag
! 
! 	* i-c.adb: Clarify that AI-258 behavior is also intended in Ada 95
! 
! 2005-03-15  Robert Dewar  <dewar@adacore.com>
! 
! 	* s-bitops.adb, s-bitops.ads,
! 	s-taprop-os2.adb, s-intman-vms.ads, s-intman-vxworks.ads,
! 	s-taprop-vxworks.adb, a-caldel.ads, a-calend.adb, a-tasatt.adb,
! 	tbuild.ads, s-finimp.adb, s-imgwch.adb, s-intman.ads, s-intman.ads,
! 	s-memory.adb, s-soflin.ads, s-taasde.ads, s-taprob.adb, s-taprop.ads,
! 	s-taprop.ads, s-tasini.adb, s-tasini.ads, s-tasini.ads, s-tasini.ads,
! 	s-taskin.ads, s-tasren.adb, s-tassta.adb, s-tassta.ads, s-tassta.ads,
! 	s-tasuti.ads, s-tataat.ads, s-tataat.ads, s-tataat.ads, s-tataat.ads,
! 	s-tpoben.adb, s-tpoben.adb, s-tpobop.ads: Update comments. Minor
! 	reformatting.
! 
! 2005-03-15  Eric Botcazou  <ebotcazou@adacore.com>
! 
! 	* utils2.c (build_binary_op): Fix typo.
! 
! 2005-03-15  Doug Rupp  <rupp@adacore.com>
! 
! 	* s-crtl.ads (popen,pclose): New imports.
! 
! 2005-03-15  Cyrille Comar  <comar@adacore.com>
! 
! 	* comperr.adb (Compiler_Abort): remove references to obsolete
! 	procedures in the bug boxes for various GNAT builds.
! 
! 2005-03-15  Vincent Celier  <celier@adacore.com>
! 
! 	* snames.ads, snames.adb: Save as Unix text file, not as DOS text file
! 
! 2005-03-15  Geert Bosch  <bosch@adacore.com>
! 	    Arnaud Charlet  <charlet@adacore.com>
! 	    Robert Dewar  <dewar@adacore.com>
! 	    Cyrille Comar  <comar@adacore.com>
! 	    Sergey Rybin  <rybin@adacore.com>
! 
! 	* gnat_ugn.texi: Remove extended inline assembly example, as it was far
! 	too specific and long-winded to be appropriate for the GNAT User's
! 	Guide.
! 	Warn about use of GCC switches not documented in the GNAT User's Guide,
! 	as these may cause generated code to not conform to Ada semantics.
! 	Remove mention of -gdwarf-2 for sparc64, since this is now the default.
! 	Add documentation for -gnat95 and -gnat05 switches
! 	Remove paragraph documenting obsolete way to refer to third party
! 	libraries.
! 	Add a few references to Ada_05 that were missing.
! 	Update documentation on -gnatZ/-gnatL.
! 	Document limitation when using -m64 under Solaris.
! 	Change the "Name Casing" subsection of the pretty-printer section
! 	according to the changes in the dictionary processing.
! 
! 	* gnat_rm.texi: Document the Ada_05 pragma.
! 	Section on record representation clauses describes the new more
! 	relaxed rules about placement of large packed bit array components.
! 	Add documentation of GNAT.UTF_32
! 
! 2005-03-12  Daniel Berlin <dberlin@dberlin.org>
! 
! 	* misc.c (gnat_post_options): Turn off structural
! 	aliasing for now.
  
  2005-03-08  Laurent Guerby <laurent@guerby.net>
  
  	* system-linux-sparc.ads: Fix typo in previous commit.
  
! 2005-03-07  James A. Morrison <phython@gcc.gnu.org>
! 	    Laurent Guerby <laurent@guerby.net>
  
  	PR ada/20035
  	* system-linux-sparc.ads: New.
  	* Makefile.in: Add sparc linux entry.
! 
! 2005-02-27  Danny Smith  <dannysmith@users.sourceforge.net>
! 
! 	* seh_init.c (__gnat_SEH_error_handler): Mark third and fourth
! 	parameters as unused.
! 
! 2005-02-26  Nathanael Nerode  <neroden@gcc.gnu.org>
! 	Partial merge from libada-gnattools-branch:
! 
! 	2004-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
! 	* Makefile.in: Move gnattools{1,1re,2,3,4} and corresponding flags
! 	into code in gnattools/Makefile.in.  Remove direct dependencies on
! 	stamp-tools by tools clauses.
! 	2004-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
! 	* config-lang.in: Add gnattools to $lang_dirs.
! 
  2005-02-13  Andrew Pinski  <pinskia@physics.uc.edu>
  
  	PR ada/19942
! 	* utils.c (gnat_type_for_mode): Return null instead of ICE because
! 	we asked for an unknown mode.
  
  2005-02-12  Richard Henderson  <rth@redhat.com>
  
***************
*** 335,341 ****
  	(Structured Exception handling).
  	(Gen_Main_C): Idem.
  
! 	* bindgen.adb: 
  	(Gen_Main_Ada): Set the default exit code if specified.
  	(Gen_Main_C): Likewise.
  	Part of *DC20-006.
--- 6319,6325 ----
  	(Structured Exception handling).
  	(Gen_Main_C): Idem.
  
! 	* bindgen.adb:
  	(Gen_Main_Ada): Set the default exit code if specified.
  	(Gen_Main_C): Likewise.
  	Part of *DC20-006.
***************
*** 589,596 ****
  
  2005-02-09  Robert Dewar  <dewar@adacore.com>
  
!         * a-strunb.ads, a-strunb.adb: Add missing pragma Ada_05 statements
!         Fix name of Set routine
  
  	* a-strfix.ads, a-strfix.adb: Add new index functions from AI-301 to
  	fixed packages.
--- 6573,6580 ----
  
  2005-02-09  Robert Dewar  <dewar@adacore.com>
  
! 	* a-strunb.ads, a-strunb.adb: Add missing pragma Ada_05 statements
! 	Fix name of Set routine
  
  	* a-strfix.ads, a-strfix.adb: Add new index functions from AI-301 to
  	fixed packages.
***************
*** 632,638 ****
  
  	Fix for c330001 - PR ada/19386
  
! 	* decl.c: 
  	(gnat_to_gnu_field): Do not necessarily invoke make_packable_type
  	on the field if Pragma Component_Alignment (Storage_Unit).
  	(gnat_to_gnu_entity, case object): Do not treat a renaming that has
--- 6616,6622 ----
  
  	Fix for c330001 - PR ada/19386
  
! 	* decl.c:
  	(gnat_to_gnu_field): Do not necessarily invoke make_packable_type
  	on the field if Pragma Component_Alignment (Storage_Unit).
  	(gnat_to_gnu_entity, case object): Do not treat a renaming that has
***************
*** 843,849 ****
  
  2005-02-09  Pascal Obry  <obry@adacore.com>
  
! 	* gnat_ugn.texi: 
  	Document the procedure to debug the DllMain routine on Windows.
  	Add note about -funwind-tables and mixed Ada and C/C++ programming in
  	ZCX mode.
--- 6827,6833 ----
  
  2005-02-09  Pascal Obry  <obry@adacore.com>
  
! 	* gnat_ugn.texi:
  	Document the procedure to debug the DllMain routine on Windows.
  	Add note about -funwind-tables and mixed Ada and C/C++ programming in
  	ZCX mode.
***************
*** 856,862 ****
  
  2005-02-09  Robert Dewar  <dewar@adacore.com>
  
! 	* gnat_rm.texi: 
  	Changes to document new wide wide character support
  	For AI-285
  	Update documentation on Normalize_Scalars and Initialize_Scalars
--- 6840,6846 ----
  
  2005-02-09  Robert Dewar  <dewar@adacore.com>
  
! 	* gnat_rm.texi:
  	Changes to document new wide wide character support
  	For AI-285
  	Update documentation on Normalize_Scalars and Initialize_Scalars
***************
*** 937,944 ****
  2005-01-27  Laurent GUERBY <laurent@guerby.net>
  
  	* Makefile.in: Rename GNAT RTEMS specific files.
! 	* 5rtpopsp.adb, 4rintnam.ads, 5rosinte.adb,  
!  	5rosinte.ads, 5rparame.adb: Replaced by files below.
  	* s-tpopsp-rtems.adb, a-intman-rtems.ads, s-osinte-rtems.adb,
  	s-osinte-rtems.ads, s-parame-rtems.adb: Replace files above.
  
--- 6921,6928 ----
  2005-01-27  Laurent GUERBY <laurent@guerby.net>
  
  	* Makefile.in: Rename GNAT RTEMS specific files.
! 	* 5rtpopsp.adb, 4rintnam.ads, 5rosinte.adb,
! 	5rosinte.ads, 5rparame.adb: Replaced by files below.
  	* s-tpopsp-rtems.adb, a-intman-rtems.ads, s-osinte-rtems.adb,
  	s-osinte-rtems.ads, s-parame-rtems.adb: Replace files above.
  
***************
*** 947,960 ****
  
  	PR ada/19488
  	* 5rosinte.ads: Add No_Key constant.
!         * 5rtpopsp.adb: Initialize ATCB_Key with No_Key and fix style.
!         * gsocket.h: Do not include <sys/socket.h> with RTEMS either.
  
  2005-01-26  Laurent GUERBY <laurent@guerby.net>
  
  	PR ada/19414
  	* i-cobol.adb (Valid_Numeric): Handle zero length case.
! 	
  2005-01-20  Richard Henderson  <rth@redhat.com>
  
  	* Makefile.in (alpha-linux, LIBGNAT_TARGET_PAIRS): Use
--- 6931,6944 ----
  
  	PR ada/19488
  	* 5rosinte.ads: Add No_Key constant.
! 	* 5rtpopsp.adb: Initialize ATCB_Key with No_Key and fix style.
! 	* gsocket.h: Do not include <sys/socket.h> with RTEMS either.
  
  2005-01-26  Laurent GUERBY <laurent@guerby.net>
  
  	PR ada/19414
  	* i-cobol.adb (Valid_Numeric): Handle zero length case.
! 
  2005-01-20  Richard Henderson  <rth@redhat.com>
  
  	* Makefile.in (alpha-linux, LIBGNAT_TARGET_PAIRS): Use
***************
*** 1034,1040 ****
  	pragma restrictions.
  	New entry for Ada 2005 attribute Mod.
  
! 	* par-prag.adb: 
  	Add recognition of new pragma Restrictions No_Dependence
  	Recognize restriction No_Obsolescent_Features at parse time
  
--- 7018,7024 ----
  	pragma restrictions.
  	New entry for Ada 2005 attribute Mod.
  
! 	* par-prag.adb:
  	Add recognition of new pragma Restrictions No_Dependence
  	Recognize restriction No_Obsolescent_Features at parse time
  
***************
*** 1150,1156 ****
  	* eval_fat.adb: (Eps_Model,Eps_Denorm): Remove, no longer used.
  	(Succ): Re-implement using Scaling, Exponent and Ceiling attributes.
  	(Pred): Implement in terms of Succ.
! 	
  	* trans.c (convert_with_check): Reimplement conversion of float to
  	integer.
  
--- 7134,7140 ----
  	* eval_fat.adb: (Eps_Model,Eps_Denorm): Remove, no longer used.
  	(Succ): Re-implement using Scaling, Exponent and Ceiling attributes.
  	(Pred): Implement in terms of Succ.
! 
  	* trans.c (convert_with_check): Reimplement conversion of float to
  	integer.
  
***************
*** 1175,1181 ****
  
  2005-01-03  Thomas Quinot  <quinot@adacore.com>
  
! 	* exp_dist.adb: 
  	Declare subprogram index in Build_RPC_Receiver_Body, to reduce the
  	amount of PCS-specific code in RACW stubs generation.
  	(Copy_Specification): Set Etype on copied formal parameter entities, as
--- 7159,7165 ----
  
  2005-01-03  Thomas Quinot  <quinot@adacore.com>
  
! 	* exp_dist.adb:
  	Declare subprogram index in Build_RPC_Receiver_Body, to reduce the
  	amount of PCS-specific code in RACW stubs generation.
  	(Copy_Specification): Set Etype on copied formal parameter entities, as
***************
*** 1613,1622 ****
  	(Insert_Partition_Check): Use runtime library function to perform
  	E.4(19) check.
  
!         * rtsfind.ads: New entity System.PolyORB_Interface.Make_Ref
!         (RE_Same_Partition): New entity, from s-parint.
  
!         * s-parint.ads, s-parint.adb (Same_Partition): New subprogram.
  
  2004-12-07  Gary Dismukes  <dismukes@adacore.com>
  
--- 7597,7606 ----
  	(Insert_Partition_Check): Use runtime library function to perform
  	E.4(19) check.
  
! 	* rtsfind.ads: New entity System.PolyORB_Interface.Make_Ref
! 	(RE_Same_Partition): New entity, from s-parint.
  
! 	* s-parint.ads, s-parint.adb (Same_Partition): New subprogram.
  
  2004-12-07  Gary Dismukes  <dismukes@adacore.com>
  
***************
*** 2500,2506 ****
  
  2004-10-05  Vincent Celier  <celier@gnat.com>
  
!         * mlib-tgt.ads: (Build_Dynamic_Library): New parameter Options_2
  
  2004-10-04  Laurent GUERBY <laurent@guerby.net>
  
--- 8484,8490 ----
  
  2004-10-05  Vincent Celier  <celier@gnat.com>
  
! 	* mlib-tgt.ads: (Build_Dynamic_Library): New parameter Options_2
  
  2004-10-04  Laurent GUERBY <laurent@guerby.net>
  
***************
*** 14864,14870 ****
  	into Command, an array conversion is illegal here. Uncovered by
  	ACATS B460005.
  
! 2001/11/28  Geert Bosch <bosch@gnat.com>
  
  	* init.c: Minor whitespace changes.
  
--- 20848,20854 ----
  	into Command, an array conversion is illegal here. Uncovered by
  	ACATS B460005.
  
! 2001-11-28  Geert Bosch <bosch@gnat.com>
  
  	* init.c: Minor whitespace changes.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/Make-lang.in gcc-4.1.0/gcc/ada/Make-lang.in
*** gcc-4.0.2/gcc/ada/Make-lang.in	Tue Mar 15 20:52:43 2005
--- gcc-4.1.0/gcc/ada/Make-lang.in	Thu Feb  9 17:30:56 2006
***************
*** 1,6 ****
  # Top level -*- makefile -*- fragment for GNU Ada (GNAT).
  #   Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
! #   2003, 2004 Free Software Foundation, Inc.
  
  #This file is part of GCC.
  
--- 1,6 ----
  # Top level -*- makefile -*- fragment for GNU Ada (GNAT).
  #   Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
! #   2003, 2004, 2005, 2006 Free Software Foundation, Inc.
  
  #This file is part of GCC.
  
***************
*** 16,23 ****
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 59 Temple Place - Suite 330,
! #Boston, MA 02111-1307, USA.
  
  # This file provides the language dependent support in the main Makefile.
  # Each language makefile fragment must provide the following targets:
--- 16,23 ----
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 51 Franklin Street, Fifth Floor,
! #Boston, MA 02110-1301, USA.
  
  # This file provides the language dependent support in the main Makefile.
  # Each language makefile fragment must provide the following targets:
*************** ADA_TOOLS_FLAGS_TO_PASS=\
*** 105,118 ****
  # Object files for gnat1 from C sources.
  GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
   ada/cio.o ada/targtyps.o ada/decl.o ada/misc.o ada/utils.o ada/utils2.o \
!  ada/trans.o ada/cuintp.o ada/argv.o ada/raise.o ada/init.o ada/tracebak.o
  
  # Object files from Ada sources that are used by gnat1
  
  GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
   ada/a-elchha.o ada/a-ioexce.o \
   ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
!  ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/s-except.o ada/ali.o \
   ada/alloc.o ada/atree.o ada/butil.o ada/casing.o ada/checks.o ada/comperr.o \
   ada/csets.o ada/cstand.o ada/debug.o ada/debug_a.o ada/einfo.o ada/elists.o \
   ada/errout.o ada/erroutc.o ada/err_vars.o ada/eval_fat.o ada/exp_attr.o \
--- 105,119 ----
  # Object files for gnat1 from C sources.
  GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
   ada/cio.o ada/targtyps.o ada/decl.o ada/misc.o ada/utils.o ada/utils2.o \
!  ada/trans.o ada/cuintp.o ada/argv.o ada/raise.o ada/init.o ada/tracebak.o \
!  ada/initialize.o
  
  # Object files from Ada sources that are used by gnat1
  
  GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
   ada/a-elchha.o ada/a-ioexce.o \
   ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
!  ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/ali.o \
   ada/alloc.o ada/atree.o ada/butil.o ada/casing.o ada/checks.o ada/comperr.o \
   ada/csets.o ada/cstand.o ada/debug.o ada/debug_a.o ada/einfo.o ada/elists.o \
   ada/errout.o ada/erroutc.o ada/err_vars.o ada/eval_fat.o ada/exp_attr.o \
*************** GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o
*** 123,129 ****
   ada/exp_prag.o ada/exp_smem.o ada/exp_strm.o ada/exp_tss.o ada/exp_util.o \
   ada/exp_vfpt.o ada/expander.o ada/fname.o ada/fname-uf.o ada/fmap.o \
   ada/freeze.o ada/frontend.o ada/gnat.o ada/g-hesora.o ada/g-htable.o \
!  ada/g-os_lib.o ada/g-speche.o ada/g-string.o ada/s-crc32.o ada/get_targ.o \
   ada/gnatvsn.o ada/hlo.o ada/hostparm.o ada/impunit.o ada/interfac.o \
   ada/itypes.o ada/inline.o ada/krunch.o ada/lib.o ada/layout.o ada/lib-load.o \
   ada/lib-util.o ada/lib-xref.o ada/lib-writ.o ada/live.o ada/namet.o \
--- 124,131 ----
   ada/exp_prag.o ada/exp_smem.o ada/exp_strm.o ada/exp_tss.o ada/exp_util.o \
   ada/exp_vfpt.o ada/expander.o ada/fname.o ada/fname-uf.o ada/fmap.o \
   ada/freeze.o ada/frontend.o ada/gnat.o ada/g-hesora.o ada/g-htable.o \
!  ada/g-os_lib.o ada/g-speche.o ada/g-string.o ada/g-utf_32.o \
!  ada/s-crc32.o ada/get_targ.o \
   ada/gnatvsn.o ada/hlo.o ada/hostparm.o ada/impunit.o ada/interfac.o \
   ada/itypes.o ada/inline.o ada/krunch.o ada/lib.o ada/layout.o ada/lib-load.o \
   ada/lib-util.o ada/lib-xref.o ada/lib-writ.o ada/live.o ada/namet.o \
*************** GNATBIND_OBJS = \
*** 161,166 ****
--- 163,169 ----
   ada/cstreams.o   \
   ada/final.o      \
   ada/init.o       \
+  ada/initialize.o \
   ada/seh_init.o   \
   ada/link.o       \
   ada/raise.o      \
*************** GNATBIND_OBJS = \
*** 192,197 ****
--- 195,201 ----
   ada/g-htable.o   \
   ada/g-os_lib.o   \
   ada/g-string.o   \
+  ada/g-utf_32.o   \
   ada/gnat.o       \
   ada/gnatbind.o   \
   ada/gnatvsn.o    \
*************** GNATBIND_OBJS = \
*** 211,217 ****
   ada/s-casuti.o   \
   ada/s-crc32.o    \
   ada/s-crtl.o     \
-  ada/s-except.o   \
   ada/s-exctab.o   \
   ada/s-htable.o   \
   ada/s-imgenu.o   \
--- 215,220 ----
*************** gnat-cross: force
*** 285,290 ****
--- 288,303 ----
  	make $(GNAT1_ADA_OBJS) CC="gcc -B../stage1/" CFLAGS="-S -gnatp" \
  		$(FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS) HOST_CFLAGS= HOST_CC=cc
  
+ gen-soccon: force
+ 	$(MAKE) -C ada $(FLAGS_TO_PASS)  \
+ 	   GNATLIBFLAGS="$(GNATLIBFLAGS)" \
+ 	   GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
+ 	   TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
+ 	   THREAD_KIND="$(THREAD_KIND)" \
+ 	   TRACE="$(TRACE)" \
+ 	   LIBGNAT_OBJS=gen-soccon \
+ 	   gnatlib
+ 
  gt-ada-decl.h gt-ada-trans.h gt-ada-utils.h gtype-ada.h : s-gtype ; @true
  
  # Build hooks:
*************** doc/gnat_ugn_unw.texi: $(srcdir)/ada/gna
*** 377,392 ****
  	ada/doctools/xgnatugn unw $(srcdir)/ada/gnat_ugn.texi \
  	   $(srcdir)/ada/ug_words doc/gnat_ugn_unw.texi
  
! doc/gnat_ugn_unw.info: doc/gnat_ugn_unw.texi \
!    $(docdir)/include/fdl.texi $(docdir)/include/gcc-common.texi
  	if [ x$(BUILD_INFO) = xinfo ]; then \
  	  rm -f $(@)*; \
  	  $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include \
              -I$(srcdir)/ada -o $@ $<; \
  	else true; fi
  
! doc/gnat_rm.info: ada/gnat_rm.texi $(docdir)/include/fdl.texi \
!    $(docdir)/include/gcc-common.texi
  	if [ x$(BUILD_INFO) = xinfo ]; then \
  	  rm -f $(@)*; \
  	  $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include \
--- 390,407 ----
  	ada/doctools/xgnatugn unw $(srcdir)/ada/gnat_ugn.texi \
  	   $(srcdir)/ada/ug_words doc/gnat_ugn_unw.texi
  
! doc/gnat_ugn_unw.info: doc/gnat_ugn_unw.texi			\
!    $(docdir)/include/fdl.texi $(docdir)/include/gcc-common.texi	\
!    gcc-vers.texi
! 
  	if [ x$(BUILD_INFO) = xinfo ]; then \
  	  rm -f $(@)*; \
  	  $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include \
              -I$(srcdir)/ada -o $@ $<; \
  	else true; fi
  
! doc/gnat_rm.info: ada/gnat_rm.texi $(docdir)/include/fdl.texi	\
!    $(docdir)/include/gcc-common.texi gcc-vers.texi
  	if [ x$(BUILD_INFO) = xinfo ]; then \
  	  rm -f $(@)*; \
  	  $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include \
*************** install-info:: $(DESTDIR)$(infodir)/gnat
*** 415,426 ****
  dvi:: doc/gnat_ugn_unw.dvi \
        doc/gnat_rm.dvi doc/gnat-style.dvi
  
! doc/gnat_ugn_unw.dvi: doc/gnat_ugn_unw.texi \
! 	$(docdir)/include/fdl.texi $(docdir)/include/gcc-common.texi
  	$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
  
! doc/gnat_rm.dvi: ada/gnat_rm.texi \
! 	$(docdir)/include/fdl.texi $(docdir)/include/gcc-common.texi
  	$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
  
  doc/gnat-style.dvi: ada/gnat-style.texi $(docdir)/include/fdl.texi
--- 430,441 ----
  dvi:: doc/gnat_ugn_unw.dvi \
        doc/gnat_rm.dvi doc/gnat-style.dvi
  
! doc/gnat_ugn_unw.dvi: doc/gnat_ugn_unw.texi $(docdir)/include/fdl.texi	\
! 	$(docdir)/include/gcc-common.texi gcc-vers.texi
  	$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
  
! doc/gnat_rm.dvi: ada/gnat_rm.texi $(docdir)/include/fdl.texi	\
! 	$(docdir)/include/gcc-common.texi gcc-vers.texi
  	$(TEXI2DVI) -c -I $(abs_docdir)/include -o $@ $<
  
  doc/gnat-style.dvi: ada/gnat-style.texi $(docdir)/include/fdl.texi
*************** ACATSDIR = $(TESTSUITEDIR)/ada/acats
*** 809,815 ****
  check-gnat:
  	test -d $(ACATSDIR) || mkdir -p $(ACATSDIR)
  	testdir=`cd ${srcdir}/${ACATSDIR}; ${PWD_COMMAND}`; \
! 	export testdir; cd $(ACATSDIR); $${testdir}/run_acats $(CHAPTERS)
  
  .PHONY: check-gnat
  
--- 824,830 ----
  check-gnat:
  	test -d $(ACATSDIR) || mkdir -p $(ACATSDIR)
  	testdir=`cd ${srcdir}/${ACATSDIR}; ${PWD_COMMAND}`; \
! 	export testdir; cd $(ACATSDIR); $(SHELL) $${testdir}/run_acats $(CHAPTERS)
  
  .PHONY: check-gnat
  
*************** ada/stamp-sdefault : $(srcdir)/version.c
*** 938,944 ****
  
  ada/sdefault.o : ada/sdefault.ads ada/sdefault.adb ada/types.ads \
     ada/unchdeal.ads ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
!    ada/unchconv.ads ada/osint.ads
  
  ADA_TREE_H = ada/ada-tree.h ada/ada-tree.def
  
--- 953,959 ----
  
  ada/sdefault.o : ada/sdefault.ads ada/sdefault.adb ada/types.ads \
     ada/unchdeal.ads ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
!    ada/unchconv.ads ada/osint.ads ada/g-os_lib.ads ada/g-string.ads
  
  ADA_TREE_H = ada/ada-tree.h ada/ada-tree.def
  
*************** ada/final.o    : ada/final.c $(CONFIG_H)
*** 1005,1019 ****
  ada/link.o     : ada/link.c
  
  ada/cio.o     : ada/cio.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) $(RT_FLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  ada/init.o    : ada/init.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h ada/raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) $(RT_FLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  ada/raise.o   : ada/raise.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h ada/raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) $(RT_FLAGS) \
  		 $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  # Need to keep the frame pointer in this file to pop the stack properly on
--- 1020,1038 ----
  ada/link.o     : ada/link.c
  
  ada/cio.o     : ada/cio.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  ada/init.o    : ada/init.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h ada/raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) \
! 	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
! 
! ada/initialize.o : ada/initialize.c
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  ada/raise.o   : ada/raise.c $(CONFIG_H) $(SYSTEM_H) ada/adaint.h ada/raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ALL_ADA_CFLAGS) \
  		 $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  # Need to keep the frame pointer in this file to pop the stack properly on
*************** ada/decl.o : ada/decl.c $(CONFIG_H) $(SY
*** 1030,1039 ****
     flags.h toplev.h convert.h target.h ada/ada.h ada/types.h ada/atree.h \
     ada/nlists.h ada/elists.h ada/uintp.h ada/sinfo.h ada/einfo.h ada/snames.h \
     ada/namet.h ada/stringt.h ada/repinfo.h ada/fe.h $(ADA_TREE_H) ada/gigi.h \
!    gt-ada-decl.h
  
  ada/misc.o : ada/misc.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
!    $(RTL_H) expr.h insn-codes.h insn-flags.h insn-config.h recog.h flags.h \
     diagnostic.h output.h except.h $(TM_P_H) langhooks.h debug.h \
     $(LANGHOOKS_DEF_H) libfuncs.h $(OPTABS_H) ada/ada.h ada/types.h \
     ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h ada/einfo.h ada/namet.h \
--- 1049,1058 ----
     flags.h toplev.h convert.h target.h ada/ada.h ada/types.h ada/atree.h \
     ada/nlists.h ada/elists.h ada/uintp.h ada/sinfo.h ada/einfo.h ada/snames.h \
     ada/namet.h ada/stringt.h ada/repinfo.h ada/fe.h $(ADA_TREE_H) ada/gigi.h \
!    gt-ada-decl.h $(EXPR_H)
  
  ada/misc.o : ada/misc.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
!    $(RTL_H) $(EXPR_H) insn-codes.h insn-flags.h recog.h flags.h \
     diagnostic.h output.h except.h $(TM_P_H) langhooks.h debug.h \
     $(LANGHOOKS_DEF_H) libfuncs.h $(OPTABS_H) ada/ada.h ada/types.h \
     ada/atree.h ada/nlists.h ada/elists.h ada/sinfo.h ada/einfo.h ada/namet.h \
*************** ada/misc.o : ada/misc.c $(CONFIG_H) $(SY
*** 1041,1048 ****
     ada/adadecode.h opts.h options.h target.h real.h
  
  ada/targtyps.o : ada/targtyps.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
!    ada/ada.h ada/types.h ada/atree.h ada/nlists.h ada/elists.h ada/uintp.h \
!    ada/sinfo.h ada/einfo.h ada/namet.h ada/snames.h ada/stringt.h \
     ada/urealp.h ada/fe.h $(ADA_TREE_H) ada/gigi.h
  
  ada/trans.o : ada/trans.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
--- 1060,1067 ----
     ada/adadecode.h opts.h options.h target.h real.h
  
  ada/targtyps.o : ada/targtyps.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
!    $(TREE_H) ada/ada.h ada/types.h ada/atree.h ada/nlists.h ada/elists.h \
!    ada/uintp.h ada/sinfo.h ada/einfo.h ada/namet.h ada/snames.h ada/stringt.h \
     ada/urealp.h ada/fe.h $(ADA_TREE_H) ada/gigi.h
  
  ada/trans.o : ada/trans.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
*************** ada/a-chlat1.o : ada/ada.ads ada/a-chara
*** 1073,1095 ****
     ada/system.ads 
  
  ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
!    ada/a-elchha.adb ada/system.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/s-traent.ads ada/unchconv.ads 
  
  ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
     ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
     ada/a-elchha.ads ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads \
     ada/a-uncdea.ads ada/interfac.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-except.ads ada/s-mastop.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads \
!    ada/unchconv.ads 
  
  ada/a-ioexce.o : ada/ada.ads ada/a-except.ads ada/a-ioexce.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/ada.o : ada/ada.ads ada/system.ads 
  
--- 1092,1112 ----
     ada/system.ads 
  
  ada/a-elchha.o : ada/ada.ads ada/a-except.ads ada/a-elchha.ads \
!    ada/a-elchha.adb ada/system.ads ada/s-parame.ads ada/s-stalib.ads \
     ada/s-traent.ads ada/unchconv.ads 
  
  ada/a-except.o : ada/ada.ads ada/a-except.ads ada/a-except.adb \
     ada/a-excach.adb ada/a-exexda.adb ada/a-exexpr.adb ada/a-exextr.adb \
     ada/a-elchha.ads ada/a-excpol.adb ada/a-exstat.adb ada/a-unccon.ads \
     ada/a-uncdea.ads ada/interfac.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traceb.ads \
!    ada/s-traent.ads ada/s-traent.adb ada/s-unstyp.ads ada/unchconv.ads 
  
  ada/a-ioexce.o : ada/ada.ads ada/a-except.ads ada/a-ioexce.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/ada.o : ada/ada.ads ada/system.ads 
  
*************** ada/ali-util.o : ada/ada.ads ada/a-excep
*** 1097,1113 ****
     ada/ali-util.ads ada/ali-util.adb ada/alloc.ads ada/binderr.ads \
     ada/casing.ads ada/csets.ads ada/debug.ads ada/err_vars.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads \
!    ada/rident.ads ada/scans.ads ada/scng.ads ada/scng.adb ada/sinput.ads \
!    ada/sinput.adb ada/sinput-c.ads ada/snames.ads ada/stringt.ads \
!    ada/stringt.adb ada/styleg.ads ada/styleg.adb ada/stylesw.ads \
!    ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
--- 1114,1131 ----
     ada/ali-util.ads ada/ali-util.adb ada/alloc.ads ada/binderr.ads \
     ada/casing.ads ada/csets.ads ada/debug.ads ada/err_vars.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/g-utf_32.adb ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/namet.ads ada/namet.adb ada/opt.ads \
!    ada/osint.ads ada/output.ads ada/rident.ads ada/scans.ads ada/scng.ads \
!    ada/scng.adb ada/sinput.ads ada/sinput.adb ada/sinput-c.ads \
!    ada/snames.ads ada/stringt.ads ada/stringt.adb ada/styleg.ads \
!    ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-htable.adb ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
*************** ada/ali.o : ada/ada.ads ada/a-except.ads
*** 1117,1127 ****
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-htable.adb ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/alloc.o : ada/alloc.ads ada/system.ads 
  
--- 1135,1145 ----
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-htable.adb ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/alloc.o : ada/alloc.ads ada/system.ads 
  
*************** ada/atree.o : ada/ada.ads ada/a-except.a
*** 1129,1143 ****
     ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/back_end.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/back_end.ads ada/back_end.adb ada/casing.ads \
--- 1147,1161 ----
     ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/back_end.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/back_end.ads ada/back_end.adb ada/casing.ads \
*************** ada/back_end.o : ada/ada.ads ada/a-excep
*** 1149,1177 ****
     ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/switch.ads ada/switch-c.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/bcheck.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/ali-util.ads \
     ada/ali-util.adb ada/alloc.ads ada/bcheck.ads ada/bcheck.adb \
     ada/binderr.ads ada/butil.ads ada/casing.ads ada/csets.ads \
     ada/debug.ads ada/err_vars.ads ada/fname.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/namet.ads \
!    ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads \
!    ada/scans.ads ada/scng.ads ada/scng.adb ada/sinput.ads ada/sinput-c.ads \
!    ada/snames.ads ada/stringt.ads ada/styleg.ads ada/styleg.adb \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/binde.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
     ada/binde.ads ada/binde.adb ada/binderr.ads ada/butil.ads \
--- 1167,1195 ----
     ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/switch.ads ada/switch-c.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/bcheck.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/ali-util.ads \
     ada/ali-util.adb ada/alloc.ads ada/bcheck.ads ada/bcheck.adb \
     ada/binderr.ads ada/butil.ads ada/casing.ads ada/csets.ads \
     ada/debug.ads ada/err_vars.ads ada/fname.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads \
!    ada/rident.ads ada/scans.ads ada/scng.ads ada/scng.adb ada/sinput.ads \
!    ada/sinput-c.ads ada/snames.ads ada/stringt.ads ada/styleg.ads \
!    ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/binde.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
     ada/binde.ads ada/binde.adb ada/binderr.ads ada/butil.ads \
*************** ada/binde.o : ada/ada.ads ada/a-except.a
*** 1179,1205 ****
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/namet.ads ada/namet.adb ada/opt.ads \
     ada/output.ads ada/rident.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/widechar.ads 
  
  ada/binderr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/binderr.ads \
     ada/binderr.adb ada/butil.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/bindgen.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
!    ada/binde.ads ada/bindgen.ads ada/bindgen.adb ada/butil.ads \
!    ada/casing.ads ada/debug.ads ada/fname.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/opt.ads \
!    ada/osint.ads ada/osint-b.ads ada/output.ads ada/rident.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-memory.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strops.ads \
     ada/s-sopco3.ads ada/s-sopco4.ads ada/s-sopco5.ads ada/s-traent.ads \
--- 1197,1224 ----
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/namet.ads ada/namet.adb ada/opt.ads \
     ada/output.ads ada/rident.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/binderr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/binderr.ads \
     ada/binderr.adb ada/butil.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/bindgen.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
!    ada/binde.ads ada/bindgen.ads ada/bindgen.adb ada/casing.ads \
!    ada/debug.ads ada/fname.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/namet.ads ada/opt.ads ada/osint.ads \
!    ada/osint-b.ads ada/output.ads ada/rident.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-memory.ads ada/s-parame.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strops.ads \
     ada/s-sopco3.ads ada/s-sopco4.ads ada/s-sopco5.ads ada/s-traent.ads \
*************** ada/butil.o : ada/ada.ads ada/a-except.a
*** 1216,1253 ****
     ada/butil.adb ada/debug.ads ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/opt.ads ada/output.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/casing.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/casing.adb ada/csets.ads ada/csets.adb ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/widechar.ads 
  
  ada/checks.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/itypes.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
!    ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \
!    ada/sem.ads ada/sem_cat.ads ada/sem_ch7.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
--- 1235,1273 ----
     ada/butil.adb ada/debug.ads ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/opt.ads ada/output.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/casing.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/casing.adb ada/csets.ads ada/csets.adb ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/widechar.ads 
  
  ada/checks.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch7.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-load.ads ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/rtsfind.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch3.ads \
!    ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_dist.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
*************** ada/comperr.o : ada/ada.ads ada/a-except
*** 1267,1278 ****
     ada/output.adb ada/sdefault.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/treepr.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/csets.o : ada/csets.ads ada/csets.adb ada/gnat.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/system.ads \
--- 1287,1298 ----
     ada/output.adb ada/sdefault.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/sinput.adb ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/treepr.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/csets.o : ada/csets.ads ada/csets.adb ada/gnat.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/system.ads \
*************** ada/cstand.o : ada/ada.ads ada/a-except.
*** 1285,1294 ****
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/fname.ads ada/freeze.ads \
     ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/layout.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
     ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
     ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
--- 1305,1314 ----
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/fname.ads ada/freeze.ads \
     ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/layout.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/rident.ads ada/rtsfind.ads \
     ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
     ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
*************** ada/cstand.o : ada/ada.ads ada/a-except.
*** 1296,1308 ****
     ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
     ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/urealp.adb ada/widechar.ads 
  
  ada/debug.o : ada/debug.ads ada/debug.adb ada/system.ads 
  
--- 1316,1329 ----
     ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
     ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
!    ada/widechar.ads 
  
  ada/debug.o : ada/debug.ads ada/debug.adb ada/system.ads 
  
*************** ada/debug_a.o : ada/ada.ads ada/a-except
*** 1310,1323 ****
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
     ada/debug_a.adb ada/einfo.ads ada/elists.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/nlists.ads ada/nlists.adb ada/opt.ads \
!    ada/output.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/einfo.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 1331,1344 ----
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
     ada/debug_a.adb ada/einfo.ads ada/elists.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/einfo.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/einfo.o : ada/ada.ads ada/a-except.a
*** 1326,1353 ****
     ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/snames.adb \
     ada/stand.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/elists.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/elists.ads ada/elists.adb ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
     ada/output.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/err_vars.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/err_vars.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-memory.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/errout.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 1347,1375 ----
     ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/snames.adb \
     ada/stand.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/elists.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/elists.ads ada/elists.adb ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
     ada/output.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/err_vars.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/err_vars.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/errout.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/errout.o : ada/ada.ads ada/a-except.
*** 1361,1371 ****
     ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb \
--- 1383,1393 ----
     ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb \
*************** ada/erroutc.o : ada/ada.ads ada/a-except
*** 1373,1382 ****
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/output.adb ada/rident.ads ada/sinput.ads ada/sinput.adb \
     ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 1395,1404 ----
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/output.adb ada/rident.ads ada/sinput.ads ada/sinput.adb \
     ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/eval_fat.o : ada/ada.ads ada/a-excep
*** 1387,1405 ****
     ada/rident.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tree_io.ads ada/ttypef.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/urealp.adb 
  
  ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_aggr.adb ada/exp_ch11.ads ada/exp_ch2.ads \
!    ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
--- 1409,1427 ----
     ada/rident.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tree_io.ads ada/ttypef.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/exp_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_aggr.adb ada/exp_ch2.ads ada/exp_ch3.ads \
!    ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_pakd.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
*************** ada/exp_aggr.o : ada/ada.ads ada/a-excep
*** 1413,1447 ****
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
     ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/validsw.ads 
  
  ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_attr.ads ada/exp_attr.adb \
!    ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_imgv.ads ada/exp_pakd.ads ada/exp_strm.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
--- 1435,1470 ----
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
     ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_attr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \
!    ada/exp_attr.ads ada/exp_attr.adb ada/exp_ch2.ads ada/exp_ch7.ads \
!    ada/exp_ch9.ads ada/exp_imgv.ads ada/exp_pakd.ads ada/exp_strm.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_ch7.ads \
!    ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
*************** ada/exp_attr.o : ada/ada.ads ada/a-excep
*** 1451,1481 ****
     ada/widechar.ads 
  
  ada/exp_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/casing.adb ada/checks.ads \
!    ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads \
!    ada/exp_ch11.adb ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_ch5.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/exp_ch12.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
--- 1474,1498 ----
     ada/widechar.ads 
  
  ada/exp_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/casing.adb ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch11.adb \
!    ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
!    ada/fname-uf.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads \
!    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \
!    ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_ch8.ads \
!    ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/exp_ch12.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
*************** ada/exp_ch12.o : ada/ada.ads ada/a-excep
*** 1485,1498 ****
     ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
     ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
     ada/rident.ads ada/rtsfind.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/exp_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
--- 1502,1515 ----
     ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
     ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
     ada/rident.ads ada/rtsfind.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/exp_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
*************** ada/exp_ch13.o : ada/ada.ads ada/a-excep
*** 1506,1521 ****
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch2.ads \
     ada/exp_ch2.adb ada/exp_ch7.ads ada/exp_smem.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
--- 1523,1539 ----
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads ada/exp_ch2.ads \
     ada/exp_ch2.adb ada/exp_ch7.ads ada/exp_smem.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
*************** ada/exp_ch2.o : ada/ada.ads ada/a-except
*** 1523,1538 ****
     ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
     ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
     ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_util.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/validsw.ads 
  
  ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
--- 1541,1556 ----
     ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
     ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
     ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
*************** ada/exp_ch3.o : ada/ada.ads ada/a-except
*** 1540,1584 ****
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
     ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads \
     ada/exp_ch3.adb ada/exp_ch4.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_disp.ads ada/exp_dist.ads ada/exp_smem.ads ada/exp_strm.ads \
!    ada/exp_tss.ads ada/exp_tss.adb ada/exp_util.ads ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/sem.ads ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_mech.ads ada/sem_res.ads ada/sem_util.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
!    ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads \
!    ada/exp_ch4.ads ada/exp_ch4.adb ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_disp.ads ada/exp_fixd.ads ada/exp_pakd.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/exp_vfpt.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_cat.ads \
!    ada/sem_ch13.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb \
     ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
!    ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
--- 1558,1602 ----
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
     ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads \
     ada/exp_ch3.adb ada/exp_ch4.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_disp.ads ada/exp_dist.ads ada/exp_pakd.ads ada/exp_smem.ads \
!    ada/exp_strm.ads ada/exp_tss.ads ada/exp_tss.adb ada/exp_util.ads \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/namet.ads \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
!    ada/rtsfind.ads ada/sem.ads ada/sem_attr.ads ada/sem_ch3.ads \
!    ada/sem_ch8.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads \
!    ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch3.ads ada/exp_ch4.ads \
!    ada/exp_ch4.adb ada/exp_ch7.ads ada/exp_ch9.ads ada/exp_fixd.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/exp_vfpt.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads \
!    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/sem.ads ada/sem_cat.ads ada/sem_ch13.ads \
!    ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb \
     ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
!    ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
*************** ada/exp_ch4.o : ada/ada.ads ada/a-except
*** 1589,1617 ****
  ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch5.ads \
!    ada/exp_ch5.adb ada/exp_ch7.ads ada/exp_dbug.ads ada/exp_pakd.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch13.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
     ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
--- 1607,1636 ----
  ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \
!    ada/exp_ch5.ads ada/exp_ch5.adb ada/exp_ch7.ads ada/exp_dbug.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_ch13.ads \
!    ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
     ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
*************** ada/exp_ch6.o : ada/ada.ads ada/a-except
*** 1619,1679 ****
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch3.ads \
     ada/exp_ch6.ads ada/exp_ch6.adb ada/exp_ch7.ads ada/exp_ch9.ads \
     ada/exp_dbug.ads ada/exp_disp.ads ada/exp_dist.ads ada/exp_intr.ads \
     ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
     ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_ch12.ads ada/sem_ch13.ads \
!    ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
!    ada/widechar.ads 
! 
! ada/exp_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
!    ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_ch7.adb \
!    ada/exp_ch9.ads ada/exp_dbug.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/exp_util.adb ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/sem.ads \
!    ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
     ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
     ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch8.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_ch8.ads \
     ada/exp_ch8.adb ada/exp_dbug.ads ada/exp_tss.ads ada/exp_util.ads \
     ada/exp_util.adb ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
--- 1638,1699 ----
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch3.ads \
     ada/exp_ch6.ads ada/exp_ch6.adb ada/exp_ch7.ads ada/exp_ch9.ads \
     ada/exp_dbug.ads ada/exp_disp.ads ada/exp_dist.ads ada/exp_intr.ads \
     ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
     ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads \
!    ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_eval.ads ada/sem_mech.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
!    ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
     ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
     ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads 
! 
! ada/exp_ch7.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
!    ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch7.ads \
!    ada/exp_ch7.adb ada/exp_ch9.ads ada/exp_dbug.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/sem.ads ada/sem_ch3.ads ada/sem_ch7.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch8.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_aggr.ads ada/exp_ch7.ads ada/exp_ch8.ads \
     ada/exp_ch8.adb ada/exp_dbug.ads ada/exp_tss.ads ada/exp_util.ads \
     ada/exp_util.adb ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
*************** ada/exp_ch8.o : ada/ada.ads ada/a-except
*** 1681,1723 ****
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \
     ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
!    ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_ch9.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads \
!    ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_ch9.adb ada/exp_dbug.ads ada/exp_smem.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/fname.ads ada/fname-uf.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch11.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads 
  
  ada/exp_code.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
--- 1701,1745 ----
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \
     ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/validsw.ads 
  
  ada/exp_ch9.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \
!    ada/exp_ch11.ads ada/exp_ch3.ads ada/exp_ch6.ads ada/exp_ch7.ads \
!    ada/exp_ch9.ads ada/exp_ch9.adb ada/exp_dbug.ads ada/exp_smem.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
!    ada/itypes.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_ch11.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_elab.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
!    ada/widechar.ads 
  
  ada/exp_code.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
*************** ada/exp_code.o : ada/ada.ads ada/a-excep
*** 1725,1744 ****
     ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_code.ads \
     ada/exp_code.adb ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_cat.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
     ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
     ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
--- 1747,1766 ----
     ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_code.ads \
     ada/exp_code.adb ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_cat.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_eval.adb \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
     ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
     ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
*************** ada/exp_dbug.o : ada/ada.ads ada/a-excep
*** 1755,1778 ****
     ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
  ada/exp_disp.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads \
     ada/exp_ch7.ads ada/exp_disp.ads ada/exp_disp.adb ada/exp_tss.ads \
     ada/exp_tss.adb ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
     ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_ch8.ads \
--- 1777,1799 ----
     ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
  ada/exp_disp.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \
     ada/exp_ch7.ads ada/exp_disp.ads ada/exp_disp.adb ada/exp_tss.ads \
     ada/exp_tss.adb ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
     ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_ch8.ads \
*************** ada/exp_disp.o : ada/ada.ads ada/a-excep
*** 1781,1792 ****
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
--- 1802,1813 ----
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
*************** ada/exp_dist.o : ada/ada.ads ada/a-excep
*** 1794,1813 ****
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/exp_dist.ads ada/exp_dist.adb ada/exp_strm.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/fname.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_ch3.ads \
!    ada/sem_ch8.ads ada/sem_dist.ads ada/sem_util.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
     ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
     ada/unchdeal.ads ada/urealp.ads 
  
--- 1815,1835 ----
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
     ada/exp_dist.ads ada/exp_dist.adb ada/exp_strm.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/fname.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem.ads \
!    ada/sem_ch3.ads ada/sem_ch8.ads ada/sem_dist.ads ada/sem_eval.ads \
!    ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
     ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
     ada/unchdeal.ads ada/urealp.ads 
  
*************** ada/exp_fixd.o : ada/ada.ads ada/a-excep
*** 1823,1834 ****
     ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/exp_imgv.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
--- 1845,1856 ----
     ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/exp_imgv.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
*************** ada/exp_imgv.o : ada/ada.ads ada/a-excep
*** 1840,1861 ****
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem_res.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/exp_intr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch4.ads \
!    ada/exp_ch7.ads ada/exp_code.ads ada/exp_fixd.ads ada/exp_intr.ads \
!    ada/exp_intr.adb ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
     ada/itypes.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
     ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
--- 1862,1884 ----
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/sem_res.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/exp_intr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_aggr.ads \
!    ada/exp_ch11.ads ada/exp_ch4.ads ada/exp_ch7.ads ada/exp_code.ads \
!    ada/exp_disp.ads ada/exp_fixd.ads ada/exp_intr.ads ada/exp_intr.adb \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
     ada/itypes.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
     ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
*************** ada/exp_intr.o : ada/ada.ads ada/a-excep
*** 1864,1873 ****
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
!    ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
--- 1887,1896 ----
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
!    ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
*************** ada/exp_pakd.o : ada/ada.ads ada/a-excep
*** 1880,1886 ****
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_dbug.ads \
     ada/exp_pakd.ads ada/exp_pakd.adb ada/exp_tss.ads ada/exp_util.ads \
     ada/exp_util.adb ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
--- 1903,1909 ----
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_dbug.ads \
     ada/exp_pakd.ads ada/exp_pakd.adb ada/exp_tss.ads ada/exp_util.ads \
     ada/exp_util.adb ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
*************** ada/exp_pakd.o : ada/ada.ads ada/a-excep
*** 1888,1904 ****
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
     ada/rtsfind.ads ada/sem.ads ada/sem_ch13.ads ada/sem_ch3.ads \
!    ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_util.ads \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/validsw.ads 
  
  ada/exp_prag.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/casing.adb ada/csets.ads ada/debug.ads \
--- 1911,1927 ----
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
     ada/rtsfind.ads ada/sem.ads ada/sem_ch13.ads ada/sem_ch3.ads \
!    ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads 
  
  ada/exp_prag.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/casing.adb ada/csets.ads ada/debug.ads \
*************** ada/exp_prag.o : ada/ada.ads ada/a-excep
*** 1911,1924 ****
     ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_eval.ads \
     ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/snames.adb ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
     ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/types.ads \
!    ada/types.adb ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/exp_smem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 1934,1947 ----
     ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_eval.ads \
     ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/snames.adb ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
     ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/exp_smem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/exp_smem.o : ada/ada.ads ada/a-excep
*** 1930,1941 ****
     ada/rtsfind.ads ada/sem.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/exp_strm.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 1953,1965 ----
     ada/rtsfind.ads ada/sem.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/exp_strm.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/exp_strm.o : ada/ada.ads ada/a-excep
*** 1944,1958 ****
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads \
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/exp_tss.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 1968,1982 ----
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads \
     ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/exp_tss.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/exp_tss.o : ada/ada.ads ada/a-except
*** 1965,1980 ****
     ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/exp_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_ch11.ads \
     ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
     ada/fname.ads ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
--- 1989,2004 ----
     ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/exp_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_aggr.ads \
     ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
     ada/fname.ads ada/fname-uf.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
*************** ada/exp_util.o : ada/ada.ads ada/a-excep
*** 1987,1999 ****
     ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads 
  
  ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 2011,2024 ----
     ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/stringt.adb ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
!    ada/validsw.ads 
  
  ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/exp_vfpt.o : ada/ada.ads ada/a-excep
*** 2003,2014 ****
     ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
     ada/sem_res.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
!    ada/ttypef.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/expander.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
--- 2028,2040 ----
     ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
     ada/sem_res.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypef.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/urealp.adb 
  
  ada/expander.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
*************** ada/expander.o : ada/ada.ads ada/a-excep
*** 2019,2043 ****
     ada/exp_ch7.ads ada/exp_ch8.ads ada/exp_ch9.ads ada/exp_prag.ads \
     ada/expander.ads ada/expander.adb ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/rtsfind.ads ada/sem.ads ada/sem_ch8.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/fmap.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/fmap.ads ada/fmap.adb ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/fname-uf.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/casing.ads ada/debug.ads ada/fmap.ads ada/fname.ads \
--- 2045,2069 ----
     ada/exp_ch7.ads ada/exp_ch8.ads ada/exp_ch9.ads ada/exp_prag.ads \
     ada/expander.ads ada/expander.adb ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/rtsfind.ads ada/sem.ads ada/sem_ch8.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/fmap.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/fmap.ads ada/fmap.adb ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/fname-uf.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/casing.ads ada/debug.ads ada/fmap.ads ada/fname.ads \
*************** ada/fname-uf.o : ada/ada.ads ada/a-excep
*** 2045,2073 ****
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/krunch.ads ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/fname.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/fname.ads ada/fname.adb ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/opt.ads ada/output.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/freeze.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_pakd.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/expander.ads ada/fname.ads ada/freeze.ads \
     ada/freeze.adb ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/itypes.ads ada/layout.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
     ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
--- 2071,2099 ----
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/krunch.ads ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/fname.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/fname.ads ada/fname.adb ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads \
     ada/opt.ads ada/output.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/freeze.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/expander.ads ada/fname.ads ada/freeze.ads \
     ada/freeze.adb ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/itypes.ads ada/layout.ads \
!    ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
     ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
*************** ada/freeze.o : ada/ada.ads ada/a-except.
*** 2080,2117 ****
     ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
     ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
     ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/frontend.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads \
     ada/cstand.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch11.ads \
!    ada/exp_dbug.ads ada/fmap.ads ada/fname.ads ada/fname-uf.ads \
!    ada/frontend.ads ada/frontend.adb ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
     ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
!    ada/live.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/osint.ads ada/output.ads ada/par.ads \
!    ada/prepcomp.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch8.ads ada/sem_elab.ads ada/sem_prag.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/g-hesora.o : ada/gnat.ads ada/g-hesora.ads ada/g-hesora.adb \
     ada/system.ads 
--- 2106,2145 ----
     ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
     ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
     ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/frontend.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads \
     ada/cstand.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_dbug.ads \
!    ada/fmap.ads ada/fname.ads ada/fname-uf.ads ada/frontend.ads \
!    ada/frontend.adb ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
     ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
!    ada/live.ads ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/osint.ads ada/output.ads \
!    ada/par.ads ada/prepcomp.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_ch8.ads ada/sem_elab.ads ada/sem_prag.ads \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/sprint.ads \
!    ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/g-hesora.o : ada/gnat.ads ada/g-hesora.ads ada/g-hesora.adb \
     ada/system.ads 
*************** ada/g-speche.o : ada/gnat.ads ada/g-spec
*** 2132,2137 ****
--- 2160,2168 ----
  ada/g-string.o : ada/gnat.ads ada/g-string.ads ada/g-string.adb \
     ada/system.ads ada/unchdeal.ads 
  
+ ada/g-utf_32.o : ada/gnat.ads ada/g-utf_32.ads ada/g-utf_32.adb \
+    ada/system.ads 
+ 
  ada/get_targ.o : ada/get_targ.ads ada/get_targ.adb ada/system.ads \
     ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
     ada/unchconv.ads ada/unchdeal.ads 
*************** ada/gnat1drv.o : ada/ada.ads ada/a-excep
*** 2154,2166 ****
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
     ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-assert.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads 
  
  ada/gnatbind.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/ali-util.ads \
     ada/alloc.ads ada/bcheck.ads ada/binde.ads ada/binderr.ads \
--- 2185,2198 ----
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
     ada/sinput-l.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-assert.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \
!    ada/widechar.ads 
  
  ada/gnatbind.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/ali-util.ads \
     ada/alloc.ads ada/bcheck.ads ada/binde.ads ada/binderr.ads \
*************** ada/gnatbind.o : ada/ada.ads ada/a-excep
*** 2169,2182 ****
     ada/g-os_lib.ads ada/g-string.ads ada/gnatbind.ads ada/gnatbind.adb \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/opt.ads \
     ada/osint.ads ada/osint-b.ads ada/output.ads ada/rident.ads \
!    ada/switch.ads ada/switch-b.ads ada/system.ads ada/s-casuti.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strops.ads \
!    ada/s-sopco3.ads ada/s-sopco4.ads ada/s-sopco5.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/gnatvsn.o : ada/gnatvsn.ads ada/gnatvsn.adb ada/system.ads \
     ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
--- 2201,2214 ----
     ada/g-os_lib.ads ada/g-string.ads ada/gnatbind.ads ada/gnatbind.adb \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/opt.ads \
     ada/osint.ads ada/osint-b.ads ada/output.ads ada/rident.ads \
!    ada/snames.ads ada/switch.ads ada/switch-b.ads ada/system.ads \
!    ada/s-casuti.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-strops.ads ada/s-sopco3.ads ada/s-sopco4.ads \
!    ada/s-sopco5.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/gnatvsn.o : ada/gnatvsn.ads ada/gnatvsn.adb ada/system.ads \
     ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
*************** ada/impunit.o : ada/ada.ads ada/a-except
*** 2196,2226 ****
     ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/widechar.ads 
  
  ada/inline.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_ch11.ads ada/exp_ch7.ads ada/exp_tss.ads \
!    ada/exp_tss.adb ada/exp_util.ads ada/fname.ads ada/fname-uf.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/inline.adb ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/rtsfind.ads ada/sem_ch10.ads \
!    ada/sem_ch12.ads ada/sem_ch8.ads ada/sem_util.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/interfac.o : ada/interfac.ads ada/system.ads 
  
--- 2228,2258 ----
     ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/inline.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_tss.adb \
!    ada/exp_util.ads ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/inline.adb \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/namet.ads \
!    ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
!    ada/rtsfind.ads ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch8.ads \
!    ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/interfac.o : ada/interfac.ads ada/system.ads 
  
*************** ada/itypes.o : ada/ada.ads ada/a-except.
*** 2232,2242 ****
     ada/output.ads ada/sem.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/krunch.o : ada/hostparm.ads ada/krunch.ads ada/krunch.adb \
     ada/system.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
--- 2264,2274 ----
     ada/output.ads ada/sem.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/krunch.o : ada/hostparm.ads ada/krunch.ads ada/krunch.adb \
     ada/system.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
*************** ada/layout.o : ada/ada.ads ada/a-except.
*** 2247,2324 ****
     ada/errout.ads ada/erroutc.ads ada/exp_ch3.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/layout.ads \
!    ada/layout.adb ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/repinfo.ads ada/repinfo.adb ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_ch13.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/lib-load.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
     ada/erroutc.ads ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib-load.ads \
!    ada/lib-load.adb ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \
!    ada/output.ads ada/par.ads ada/restrict.ads ada/rident.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/sinput-l.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/lib-util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/lib-util.ads ada/lib-util.adb \
     ada/namet.ads ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/lib-writ.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
     ada/atree.ads ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
     ada/errout.ads ada/erroutc.ads ada/fname.ads ada/fname-uf.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib-util.ads ada/lib-util.adb ada/lib-writ.ads ada/lib-writ.adb \
!    ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/osint.ads ada/osint-c.ads \
!    ada/output.ads ada/par.ads ada/restrict.ads ada/rident.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
!    ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
!    ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/lib-xref.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 2279,2358 ----
     ada/errout.ads ada/erroutc.ads ada/exp_ch3.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/layout.ads ada/layout.adb ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/repinfo.ads \
!    ada/repinfo.adb ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_ch13.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/lib-load.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/einfo.adb ada/elists.ads ada/err_vars.ads ada/errout.ads \
     ada/erroutc.ads ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib-load.ads ada/lib-load.adb ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/osint.ads ada/osint-c.ads ada/output.ads ada/par.ads \
!    ada/restrict.ads ada/rident.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/sinput-l.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/lib-util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/lib-util.ads ada/lib-util.adb \
     ada/namet.ads ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/lib-writ.o : ada/ada.ads ada/a-except.ads ada/ali.ads ada/alloc.ads \
     ada/atree.ads ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \
     ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
     ada/errout.ads ada/erroutc.ads ada/fname.ads ada/fname-uf.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/lib.ads ada/lib-util.ads ada/lib-util.adb ada/lib-writ.ads \
!    ada/lib-writ.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/osint.ads ada/osint-c.ads ada/output.ads ada/par.ads \
!    ada/restrict.ads ada/rident.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-casuti.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/lib-xref.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/lib-xref.o : ada/ada.ads ada/a-excep
*** 2328,2341 ****
     ada/hostparm.ads ada/lib.ads ada/lib-util.ads ada/lib-util.adb \
     ada/lib-xref.ads ada/lib-xref.adb ada/namet.ads ada/nlists.ads \
     ada/nlists.adb ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
!    ada/sem_prag.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/lib.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 2362,2377 ----
     ada/hostparm.ads ada/lib.ads ada/lib-util.ads ada/lib-util.adb \
     ada/lib-xref.ads ada/lib-xref.adb ada/namet.ads ada/nlists.ads \
     ada/nlists.adb ada/opt.ads ada/osint.ads ada/osint-c.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/sem.ads ada/sem_prag.ads \
!    ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/widechar.ads 
  
  ada/lib.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/lib.o : ada/ada.ads ada/a-except.ads
*** 2346,2357 ****
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/widechar.ads 
  
  ada/live.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 2382,2393 ----
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/live.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/live.o : ada/ada.ads ada/a-except.ad
*** 2362,2398 ****
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/memtrack.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-io.ads \
!    ada/system.ads ada/s-memory.ads ada/memtrack.adb ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb ada/unchconv.ads 
  
  ada/namet.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/namet.adb ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-carun8.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/nlists.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/nmake.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
--- 2398,2436 ----
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/memtrack.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-io.ads \
!    ada/system.ads ada/s-memory.ads ada/memtrack.adb ada/s-parame.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb \
!    ada/unchconv.ads 
  
  ada/namet.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/namet.adb ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-carun8.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/nlists.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinput.ads \
!    ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/nmake.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
*************** ada/nmake.o : ada/ada.ads ada/a-except.a
*** 2401,2438 ****
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/opt.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
!    ada/opt.adb ada/system.ads ada/s-exctab.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/osint-b.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/osint.ads \
     ada/osint-b.ads ada/osint-b.adb ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/osint-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads \
     ada/osint-c.ads ada/osint-c.adb ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/widechar.ads 
  
  ada/osint.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/fmap.ads ada/gnat.ads ada/g-htable.ads \
--- 2439,2477 ----
     ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/opt.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
!    ada/opt.adb ada/system.ads ada/s-exctab.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/osint-b.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/osint.ads \
     ada/osint-b.ads ada/osint-b.adb ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/osint-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads \
     ada/osint-c.ads ada/osint-c.adb ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/osint.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/fmap.ads ada/gnat.ads ada/g-htable.ads \
*************** ada/osint.o : ada/ada.ads ada/a-except.a
*** 2440,2450 ****
     ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads ada/osint.adb \
     ada/output.ads ada/sdefault.ads ada/system.ads ada/s-casuti.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-strops.ads ada/s-sopco3.ads \
!    ada/s-sopco4.ads ada/s-sopco5.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/output.o : ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/output.ads ada/output.adb ada/system.ads ada/s-exctab.ads \
--- 2479,2490 ----
     ada/namet.ads ada/namet.adb ada/opt.ads ada/osint.ads ada/osint.adb \
     ada/output.ads ada/sdefault.ads ada/system.ads ada/s-casuti.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-htable.adb ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strops.ads \
!    ada/s-sopco3.ads ada/s-sopco4.ads ada/s-sopco5.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/widechar.ads 
  
  ada/output.o : ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/output.ads ada/output.adb ada/system.ads ada/s-exctab.ads \
*************** ada/par.o : ada/ada.ads ada/a-except.ads
*** 2456,2485 ****
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
     ada/errout.ads ada/erroutc.ads ada/fname.ads ada/fname-uf.ads \
     ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-speche.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-load.ads ada/lib-sort.adb ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/osint.ads ada/output.ads ada/par.ads ada/par.adb ada/par-ch10.adb \
!    ada/par-ch11.adb ada/par-ch12.adb ada/par-ch13.adb ada/par-ch2.adb \
!    ada/par-ch3.adb ada/par-ch4.adb ada/par-ch5.adb ada/par-ch6.adb \
!    ada/par-ch7.adb ada/par-ch8.adb ada/par-ch9.adb ada/par-endh.adb \
!    ada/par-labl.adb ada/par-load.adb ada/par-prag.adb ada/par-sync.adb \
!    ada/par-tchk.adb ada/par-util.adb ada/restrict.ads ada/rident.ads \
!    ada/scans.ads ada/scans.adb ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
!    ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/snames.adb \
!    ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
!    ada/widechar.ads 
  
  ada/prep.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
--- 2496,2525 ----
     ada/einfo.adb ada/elists.ads ada/elists.adb ada/err_vars.ads \
     ada/errout.ads ada/erroutc.ads ada/fname.ads ada/fname-uf.ads \
     ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-speche.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/osint.ads ada/output.ads ada/par.ads ada/par.adb \
!    ada/par-ch10.adb ada/par-ch11.adb ada/par-ch12.adb ada/par-ch13.adb \
!    ada/par-ch2.adb ada/par-ch3.adb ada/par-ch4.adb ada/par-ch5.adb \
!    ada/par-ch6.adb ada/par-ch7.adb ada/par-ch8.adb ada/par-ch9.adb \
!    ada/par-endh.adb ada/par-labl.adb ada/par-load.adb ada/par-prag.adb \
!    ada/par-sync.adb ada/par-tchk.adb ada/par-util.adb ada/restrict.ads \
!    ada/rident.ads ada/scans.ads ada/scans.adb ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
!    ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \
!    ada/snames.adb ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-crc32.ads \
!    ada/s-crc32.adb ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/validsw.ads ada/widechar.ads 
  
  ada/prep.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
*************** ada/prep.o : ada/ada.ads ada/a-except.ad
*** 2488,2511 ****
     ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads \
     ada/prep.adb ada/scans.ads ada/sinput.ads ada/snames.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/casing.ads ada/csets.ads ada/debug.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/gnat.ads \
     ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/lib.ads ada/lib-writ.ads ada/namet.ads ada/opt.ads ada/osint.ads \
!    ada/output.ads ada/prep.ads ada/prepcomp.ads ada/prepcomp.adb \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sinput.ads \
!    ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/stringt.ads \
!    ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-crc32.adb ada/s-exctab.ads ada/s-memory.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
--- 2528,2552 ----
     ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads \
     ada/prep.adb ada/scans.ads ada/sinput.ads ada/snames.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/casing.ads ada/csets.ads ada/debug.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/gnat.ads \
     ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/lib-writ.ads ada/namet.ads \
!    ada/namet.adb ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads \
!    ada/prepcomp.ads ada/prepcomp.adb ada/scans.ads ada/scn.ads \
!    ada/scng.ads ada/scng.adb ada/sinput.ads ada/sinput.adb \
!    ada/sinput-l.ads ada/snames.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
*************** ada/repinfo.o : ada/ada.ads ada/a-except
*** 2521,2531 ****
     ada/repinfo.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/restrict.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 2562,2573 ----
     ada/repinfo.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/widechar.ads 
  
  ada/restrict.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/restrict.o : ada/ada.ads ada/a-excep
*** 2538,2548 ****
     ada/rident.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/rident.o : ada/rident.ads ada/system.ads ada/s-rident.ads 
  
--- 2580,2591 ----
     ada/rident.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/rident.o : ada/rident.ads ada/system.ads ada/s-rident.ads 
  
*************** ada/rtsfind.o : ada/ada.ads ada/a-except
*** 2554,2577 ****
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads \
     ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
     ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/rtsfind.ads \
!    ada/rtsfind.adb ada/sem.ads ada/sem_ch7.ads ada/sem_util.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tbuild.ads ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/s-addope.o : ada/system.ads ada/s-addope.ads ada/s-addope.adb \
     ada/unchconv.ads 
  
  ada/s-assert.o : ada/ada.ads ada/a-except.ads ada/system.ads \
     ada/s-assert.ads ada/s-assert.adb ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-carun8.o : ada/system.ads ada/s-addope.ads ada/s-addope.adb \
     ada/s-carun8.ads ada/s-carun8.adb ada/s-stoele.ads ada/s-stoele.adb \
--- 2597,2623 ----
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads \
     ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
     ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb ada/sem.ads \
!    ada/sem_ch7.ads ada/sem_dist.ads ada/sem_util.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/s-addope.o : ada/system.ads ada/s-addope.ads ada/s-addope.adb \
     ada/unchconv.ads 
  
  ada/s-assert.o : ada/ada.ads ada/a-except.ads ada/system.ads \
     ada/s-assert.ads ada/s-assert.adb ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/unchconv.ads 
  
  ada/s-carun8.o : ada/system.ads ada/s-addope.ads ada/s-addope.adb \
     ada/s-carun8.ads ada/s-carun8.adb ada/s-stoele.ads ada/s-stoele.adb \
*************** ada/s-crc32.o : ada/interfac.ads ada/sys
*** 2584,2596 ****
  
  ada/s-crtl.o : ada/system.ads ada/s-crtl.ads ada/s-parame.ads 
  
- ada/s-except.o : ada/ada.ads ada/a-except.ads ada/system.ads \
-    ada/s-except.ads ada/s-stalib.ads ada/s-traent.ads ada/unchconv.ads 
- 
  ada/s-exctab.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-htable.adb ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-htable.o : ada/ada.ads ada/a-uncdea.ads ada/system.ads \
     ada/s-htable.ads ada/s-htable.adb 
--- 2630,2640 ----
  
  ada/s-crtl.o : ada/system.ads ada/s-crtl.ads ada/s-parame.ads 
  
  ada/s-exctab.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-htable.adb ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/unchconv.ads 
  
  ada/s-htable.o : ada/ada.ads ada/a-uncdea.ads ada/system.ads \
     ada/s-htable.ads ada/s-htable.adb 
*************** ada/s-htable.o : ada/ada.ads ada/a-uncde
*** 2598,2606 ****
  ada/s-imgenu.o : ada/system.ads ada/s-imgenu.ads ada/s-imgenu.adb \
     ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
  
! ada/s-mastop.o : ada/ada.ads ada/a-except.ads ada/system.ads \
!    ada/s-except.ads ada/s-mastop.ads ada/s-mastop.adb ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-memory.o : ada/ada.ads ada/a-except.ads ada/system.ads \
     ada/s-crtl.ads ada/s-memory.ads ada/s-memory.adb ada/s-parame.ads \
--- 2642,2649 ----
  ada/s-imgenu.o : ada/system.ads ada/s-imgenu.ads ada/s-imgenu.adb \
     ada/s-secsta.ads ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
  
! ada/s-mastop.o : ada/system.ads ada/s-mastop.ads ada/s-mastop.adb \
!    ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
  
  ada/s-memory.o : ada/ada.ads ada/a-except.ads ada/system.ads \
     ada/s-crtl.ads ada/s-memory.ads ada/s-memory.adb ada/s-parame.ads \
*************** ada/s-secsta.o : ada/ada.ads ada/a-excep
*** 2617,2625 ****
     ada/s-traent.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/s-soflin.o : ada/ada.ads ada/a-except.ads ada/system.ads \
!    ada/s-except.ads ada/s-mastop.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-soflin.adb ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-sopco3.o : ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-strops.ads ada/s-sopco3.ads ada/s-sopco3.adb \
--- 2660,2668 ----
     ada/s-traent.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/s-soflin.o : ada/ada.ads ada/a-except.ads ada/system.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-soflin.adb \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-sopco3.o : ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-strops.ads ada/s-sopco3.ads ada/s-sopco3.adb \
*************** ada/s-stache.o : ada/system.ads ada/s-st
*** 2637,2645 ****
     ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
  
  ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.ads \
!    ada/s-memory.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stalib.adb ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/unchconv.ads 
  
  ada/s-stoele.o : ada/system.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/unchconv.ads 
--- 2680,2688 ----
     ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads 
  
  ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stalib.adb ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/unchconv.ads 
  
  ada/s-stoele.o : ada/system.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/unchconv.ads 
*************** ada/s-wchjis.o : ada/system.ads ada/s-wc
*** 2666,2713 ****
  ada/scans.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/output.ads ada/scans.ads ada/scans.adb \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/scn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
!    ada/scans.ads ada/scn.ads ada/scn.adb ada/scng.ads ada/scng.adb \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
     ada/snames.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
!    ada/widechar.ads 
  
  ada/scng.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/namet.ads ada/opt.ads ada/output.ads ada/scans.ads \
!    ada/scng.ads ada/scng.adb ada/sinput.ads ada/snames.ads ada/stringt.ads \
!    ada/styleg.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
     ada/debug_a.adb ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/expander.ads \
!    ada/fname.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hlo.ads \
!    ada/hostparm.ads ada/inline.ads ada/lib.ads ada/lib.adb \
     ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
     ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/sem.ads ada/sem.adb \
--- 2709,2758 ----
  ada/scans.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/output.ads ada/scans.ads ada/scans.adb \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/scn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/g-utf_32.adb ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/scans.ads ada/scn.ads ada/scn.adb ada/scng.ads \
!    ada/scng.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
     ada/snames.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/urealp.adb ada/widechar.ads 
  
  ada/scng.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/namet.ads ada/opt.ads \
!    ada/output.ads ada/scans.ads ada/scng.ads ada/scng.adb ada/sinput.ads \
!    ada/snames.ads ada/stringt.ads ada/styleg.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/sem.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/debug_a.ads \
     ada/debug_a.adb ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \
!    ada/expander.ads ada/fname.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/lib.ads ada/lib.adb \
     ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
     ada/nlists.ads ada/nlists.adb ada/opt.ads ada/output.ads \
     ada/restrict.ads ada/rident.ads ada/sem.ads ada/sem.adb \
*************** ada/sem.o : ada/ada.ads ada/a-except.ads
*** 2717,2779 ****
     ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_prag.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/fname.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-speche.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_aggr.adb ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch8.ads \
     ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
     ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/validsw.ads ada/widechar.ads 
  
  ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
     ada/a-except.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
     ada/casing.ads ada/checks.ads ada/checks.adb ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/itypes.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/sdefault.ads ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_attr.adb ada/sem_cat.ads ada/sem_ch4.ads ada/sem_ch6.ads \
!    ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \
!    ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/snames.ads ada/snames.adb ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
     ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
     ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
--- 2762,2827 ----
     ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_prag.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_aggr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch7.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_aggr.adb \
!    ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch8.ads \
     ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads \
     ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
!    ada/widechar.ads 
  
  ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
     ada/a-except.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
     ada/casing.ads ada/checks.ads ada/checks.adb ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_aggr.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_disp.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/expander.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/itypes.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/nlists.ads ada/nlists.adb \
!    ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/sdefault.ads ada/sem.ads \
!    ada/sem_aggr.ads ada/sem_attr.ads ada/sem_attr.adb ada/sem_cat.ads \
!    ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads ada/sem_res.adb \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
!    ada/snames.adb ada/sprint.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/system.ads ada/s-carun8.ads ada/s-exctab.ads \
!    ada/s-exctab.adb ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
     ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
     ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
     ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
*************** ada/sem_case.o : ada/ada.ads ada/a-excep
*** 2792,2802 ****
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_cat.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 2840,2851 ----
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tbuild.ads ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sem_cat.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/sem_cat.o : ada/ada.ads ada/a-except
*** 2809,2827 ****
     ada/sem_cat.adb ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_ch10.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/impunit.ads ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
     ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
     ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
--- 2858,2877 ----
     ada/sem_cat.adb ada/sem_eval.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sem_ch10.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/impunit.ads ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
     ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
     ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
*************** ada/sem_ch10.o : ada/ada.ads ada/a-excep
*** 2835,2847 ****
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
--- 2885,2897 ----
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch11.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
*************** ada/sem_ch11.o : ada/ada.ads ada/a-excep
*** 2854,2865 ****
     ada/sem_ch11.adb ada/sem_ch5.ads ada/sem_ch8.ads ada/sem_res.ads \
     ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \
--- 2904,2915 ----
     ada/sem_ch11.adb ada/sem_ch5.ads ada/sem_ch8.ads ada/sem_res.ads \
     ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/checks.ads \
*************** ada/sem_ch12.o : ada/ada.ads ada/a-excep
*** 2868,2895 ****
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch12.adb \
!    ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
!    ada/sem_ch8.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
!    ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads 
  
  ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
--- 2918,2946 ----
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads \
!    ada/sem_ch12.adb ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads \
!    ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_elab.ads \
!    ada/sem_elim.ads ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads ada/sinput-l.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/urealp.adb ada/widechar.ads 
  
  ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/debug.ads ada/einfo.ads \
*************** ada/sem_ch13.o : ada/ada.ads ada/a-excep
*** 2904,2916 ****
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/sem_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
--- 2955,2967 ----
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/sem_ch2.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
*************** ada/sem_ch2.o : ada/ada.ads ada/a-except
*** 2921,2959 ****
     ada/sem_ch2.ads ada/sem_ch2.adb ada/sem_ch8.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-carun8.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/eval_fat.ads ada/exp_ch11.ads ada/exp_ch2.ads \
!    ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_dist.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/exp_util.adb ada/expander.ads ada/fname.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/layout.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_aggr.ads ada/sem_attr.ads ada/sem_case.ads ada/sem_case.adb \
!    ada/sem_cat.ads ada/sem_cat.adb ada/sem_ch13.ads ada/sem_ch3.ads \
!    ada/sem_ch3.adb ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch7.ads \
!    ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_elim.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \
!    ada/sem_mech.ads ada/sem_res.ads ada/sem_res.adb ada/sem_smem.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
!    ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
--- 2972,3012 ----
     ada/sem_ch2.ads ada/sem_ch2.adb ada/sem_ch8.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-carun8.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch2.ads \
!    ada/exp_ch3.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_dist.ads \
!    ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb \
!    ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/interfac.ads ada/itypes.ads ada/layout.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_attr.ads ada/sem_case.ads ada/sem_case.adb ada/sem_cat.ads \
!    ada/sem_cat.adb ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch3.adb \
!    ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
!    ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \
!    ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_mech.ads \
!    ada/sem_res.ads ada/sem_res.adb ada/sem_smem.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
!    ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
*************** ada/sem_ch3.o : ada/ada.ads ada/a-except
*** 2965,2989 ****
  ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch4.ads \
!    ada/sem_ch4.adb ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \
!    ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads ada/sem_intr.ads \
!    ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
--- 3018,3043 ----
  ada/sem_ch4.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/exp_ch7.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-speche.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/itypes.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch4.adb \
!    ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_elab.ads ada/sem_eval.ads ada/sem_intr.ads ada/sem_res.ads \
!    ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
     ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
     ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
     ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
*************** ada/sem_ch5.o : ada/ada.ads ada/a-except
*** 2995,3021 ****
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_ch2.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
!    ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_case.ads \
!    ada/sem_case.adb ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch5.ads \
!    ada/sem_ch5.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
--- 3049,3076 ----
     ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
     ada/csets.ads ada/debug.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/eval_fat.ads \
!    ada/exp_ch2.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_case.ads ada/sem_case.adb ada/sem_cat.ads \
!    ada/sem_ch3.ads ada/sem_ch5.ads ada/sem_ch5.adb ada/sem_ch8.ads \
!    ada/sem_disp.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
!    ada/sprint.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
     ada/widechar.ads 
  
*************** ada/sem_ch6.o : ada/ada.ads ada/a-except
*** 3025,3047 ****
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch12.ads \
!    ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
!    ada/sem_ch6.adb ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_elim.ads ada/sem_eval.ads ada/sem_mech.ads ada/sem_prag.ads \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
!    ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
--- 3080,3103 ----
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
!    ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch12.ads ada/sem_ch3.ads \
!    ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch6.adb \
!    ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elim.ads \
!    ada/sem_eval.ads ada/sem_mech.ads ada/sem_prag.ads ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
!    ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
*************** ada/sem_ch7.o : ada/ada.ads ada/a-except
*** 3055,3065 ****
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_dbug.ads \
     ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
     ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
     ada/scng.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch10.ads \
     ada/sem_ch12.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
--- 3111,3121 ----
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_dbug.ads \
     ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
     ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
     ada/scng.adb ada/sem.ads ada/sem_cat.ads ada/sem_ch10.ads \
     ada/sem_ch12.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch7.ads \
*************** ada/sem_ch7.o : ada/ada.ads ada/a-except
*** 3069,3110 ****
     ada/snames.ads ada/snames.adb ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch8.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads ada/expander.ads \
!    ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/inline.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_cat.ads ada/sem_ch12.ads ada/sem_ch3.ads ada/sem_ch4.ads \
!    ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_ch8.adb ada/sem_disp.ads \
!    ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads ada/sem_intr.ads \
!    ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinfo-cn.ads ada/sinput.ads ada/sinput.adb ada/snames.ads \
!    ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch9.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
--- 3125,3167 ----
     ada/snames.ads ada/snames.adb ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch8.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/exp_ch7.ads ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-speche.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch12.ads \
!    ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_ch8.adb ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_intr.ads ada/sem_res.ads ada/sem_res.adb \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
!    ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_ch9.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
*************** ada/sem_ch9.o : ada/ada.ads ada/a-except
*** 3112,3135 ****
     ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/eval_fat.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
!    ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/itypes.ads ada/lib.ads \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch3.ads \
!    ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_ch9.ads ada/sem_ch9.adb ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_elab.ads ada/sem_eval.ads ada/sem_intr.ads ada/sem_res.ads \
!    ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/sinput.adb ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
--- 3169,3193 ----
     ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/eval_fat.ads ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_ch9.ads \
!    ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/expander.ads ada/fname.ads ada/fname-uf.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch4.ads \
!    ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_ch9.ads \
!    ada/sem_ch9.adb ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_intr.ads ada/sem_res.ads ada/sem_res.adb \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
     ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
*************** ada/sem_disp.o : ada/ada.ads ada/a-excep
*** 3144,3153 ****
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
     ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/lib-xref.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
     ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
     ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_disp.adb \
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
--- 3202,3211 ----
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_ch7.ads \
     ada/exp_disp.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
!    ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/rident.ads ada/rtsfind.ads \
     ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
     ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_disp.adb \
     ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
*************** ada/sem_disp.o : ada/ada.ads ada/a-excep
*** 3155,3186 ****
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/widechar.ads 
  
  ada/sem_dist.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/exp_dist.ads ada/exp_tss.ads ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/lib.ads ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/sem.ads ada/sem_dist.ads \
     ada/sem_dist.adb ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
!    ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_elab.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
--- 3213,3243 ----
     ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
     ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
     ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_dist.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/exp_dist.ads ada/exp_tss.ads ada/gnat.ads ada/g-htable.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/namet.ads ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
!    ada/opt.ads ada/output.ads ada/rtsfind.ads ada/sem.ads ada/sem_dist.ads \
     ada/sem_dist.adb ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
     ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
     ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sem_elab.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
*************** ada/sem_elab.o : ada/ada.ads ada/a-excep
*** 3188,3213 ****
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/expander.ads ada/fname.ads ada/fname-uf.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_cat.ads \
!    ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_elab.ads ada/sem_elab.adb \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_elim.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
--- 3245,3271 ----
     ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \
     ada/exp_util.ads ada/expander.ads ada/fname.ads ada/fname-uf.ads \
     ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_cat.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_elab.ads \
!    ada/sem_elab.adb ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
!    ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/sem_elim.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads \
     ada/alloc.ads ada/atree.ads ada/atree.adb ada/casing.ads ada/debug.ads \
*************** ada/sem_elim.o : ada/ada.ads ada/a-excep
*** 3219,3256 ****
     ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
     ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
     ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_eval.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/expander.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch4.ads ada/sem_ch6.ads \
!    ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \
!    ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
     ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads 
  
  ada/sem_intr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
--- 3277,3315 ----
     ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
     ada/stand.ads ada/stringt.ads ada/system.ads ada/s-exctab.ads \
     ada/s-htable.ads ada/s-htable.adb ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_eval.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
     ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
     ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/expander.ads ada/fname.ads ada/freeze.ads \
!    ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_cat.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads ada/sem_res.adb \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
     ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads 
  
  ada/sem_intr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
*************** ada/sem_intr.o : ada/ada.ads ada/a-excep
*** 3263,3274 ****
     ada/sem_eval.ads ada/sem_intr.ads ada/sem_intr.adb ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_maps.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 3322,3334 ----
     ada/sem_eval.ads ada/sem_intr.ads ada/sem_intr.adb ada/sem_util.ads \
     ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sem_maps.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/sem_maps.o : ada/ada.ads ada/a-excep
*** 3278,3288 ****
     ada/sem_maps.ads ada/sem_maps.adb ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_mech.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
--- 3338,3348 ----
     ada/sem_maps.ads ada/sem_maps.adb ada/sinfo.ads ada/sinfo.adb \
     ada/sinput.ads ada/snames.ads ada/stand.ads ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_mech.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
*************** ada/sem_mech.o : ada/ada.ads ada/a-excep
*** 3293,3365 ****
     ada/sem_mech.ads ada/sem_mech.adb ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sem_prag.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/casing.adb ada/checks.ads \
!    ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
!    ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
!    ada/erroutc.ads ada/eval_fat.ads ada/exp_ch7.ads ada/exp_dist.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads \
!    ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/itypes.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/lib-writ.ads ada/lib-xref.ads ada/namet.ads \
     ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \
     ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
     ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch4.ads \
!    ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_eval.adb \
!    ada/sem_intr.ads ada/sem_mech.ads ada/sem_prag.ads ada/sem_prag.adb \
!    ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_vfpt.ads ada/sem_warn.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads ada/sinput.adb \
!    ada/snames.ads ada/snames.adb ada/stand.ads ada/stringt.ads \
     ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
     ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/types.adb \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
!    ada/widechar.ads 
! 
! ada/sem_res.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
!    ada/csets.ads ada/debug.ads ada/debug_a.ads ada/debug_a.adb \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_ch11.ads \
!    ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/exp_util.adb ada/expander.ads ada/fname.ads ada/fname-uf.ads \
!    ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_aggr.ads ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch4.ads \
!    ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads \
!    ada/sem_elab.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \
!    ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
--- 3353,3426 ----
     ada/sem_mech.ads ada/sem_mech.adb ada/sem_util.ads ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_prag.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
!    ada/elists.adb ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
!    ada/eval_fat.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_dist.ads \
     ada/exp_tss.ads ada/exp_util.ads ada/expander.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-speche.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/lib-writ.ads ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/nmake.adb ada/opt.ads ada/output.ads ada/restrict.ads \
!    ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
!    ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads ada/sem_aggr.ads \
!    ada/sem_attr.ads ada/sem_cat.ads ada/sem_ch13.ads ada/sem_ch3.ads \
!    ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_disp.ads \
!    ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_intr.ads ada/sem_mech.ads ada/sem_prag.ads \
!    ada/sem_prag.adb ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads \
!    ada/sem_util.ads ada/sem_util.adb ada/sem_vfpt.ads ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads ada/sinput.ads \
!    ada/sinput.adb ada/snames.ads ada/snames.adb ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-carun8.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-exctab.adb \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/ttypes.ads ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/urealp.adb ada/validsw.ads ada/widechar.ads 
! 
! ada/sem_res.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
!    ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
!    ada/csets.ads ada/debug.ads ada/debug_a.ads ada/debug_a.adb \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/eval_fat.ads ada/exp_aggr.ads \
!    ada/exp_ch2.ads ada/exp_ch7.ads ada/exp_disp.ads ada/exp_pakd.ads \
!    ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \
!    ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads \
     ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
     ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \
     ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
     ada/scng.adb ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
!    ada/sem_cat.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads \
!    ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
!    ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \
!    ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
!    ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
     ada/stringt.adb ada/style.ads ada/styleg.ads ada/styleg.adb \
     ada/styleg-c.ads ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
     ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
     ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
     ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
*************** ada/sem_smem.o : ada/ada.ads ada/a-excep
*** 3376,3411 ****
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sem_smem.ads \
     ada/sem_smem.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_type.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/err_vars.ads \
!    ada/errout.ads ada/erroutc.ads ada/exp_tss.ads ada/exp_util.ads \
!    ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
!    ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_res.ads ada/sem_type.ads ada/sem_type.adb ada/sem_util.ads \
!    ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tree_io.ads ada/ttypes.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/sem_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/casing.adb ada/checks.ads \
--- 3437,3473 ----
     ada/nlists.adb ada/opt.ads ada/output.ads ada/sem_smem.ads \
     ada/sem_smem.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/snames.ads ada/stand.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_type.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
!    ada/einfo.ads ada/einfo.adb ada/elists.ads ada/elists.adb \
!    ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/exp_tss.ads \
!    ada/exp_util.ads ada/fname.ads ada/freeze.ads ada/get_targ.ads \
!    ada/gnat.ads ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads \
!    ada/g-string.ads ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads \
!    ada/interfac.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads \
!    ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads \
!    ada/scng.adb ada/sem.ads ada/sem_ch6.ads ada/sem_ch8.ads \
!    ada/sem_eval.ads ada/sem_res.ads ada/sem_type.ads ada/sem_type.adb \
!    ada/sem_util.ads ada/sem_util.adb ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sem_util.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/casing.adb ada/checks.ads \
*************** ada/sem_util.o : ada/ada.ads ada/a-excep
*** 3414,3438 ****
     ada/eval_fat.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/rtsfind.adb \
!    ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb ada/sem.ads \
!    ada/sem_cat.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_eval.ads \
!    ada/sem_eval.adb ada/sem_res.ads ada/sem_type.ads ada/sem_util.ads \
!    ada/sem_util.adb ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/sinput.adb ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
!    ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads ada/system.ads \
!    ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
--- 3476,3501 ----
     ada/eval_fat.ads ada/exp_tss.ads ada/exp_util.ads ada/fname.ads \
     ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
!    ada/lib-sort.adb ada/lib-xref.ads ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/rtsfind.ads \
!    ada/rtsfind.adb ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sem.ads ada/sem_cat.ads ada/sem_ch7.ads ada/sem_ch8.ads \
!    ada/sem_dist.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads \
!    ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
!    ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-carun8.ads ada/s-crc32.ads \
!    ada/s-crc32.adb ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
!    ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
     ada/widechar.ads 
  
*************** ada/sem_vfpt.o : ada/ada.ads ada/a-excep
*** 3444,3455 ****
     ada/rident.ads ada/sem_vfpt.ads ada/sem_vfpt.adb ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/targparm.ads ada/tree_io.ads ada/ttypef.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_warn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
--- 3507,3518 ----
     ada/rident.ads ada/sem_vfpt.ads ada/sem_vfpt.adb ada/sinfo.ads \
     ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
!    ada/ttypef.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sem_warn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/checks.ads ada/csets.ads ada/debug.ads \
*************** ada/sem_warn.o : ada/ada.ads ada/a-excep
*** 3457,3466 ****
     ada/errout.ads ada/erroutc.ads ada/exp_tss.ads ada/exp_util.ads \
     ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/lib.ads \
!    ada/lib.adb ada/lib-list.adb ada/lib-sort.adb ada/lib-xref.ads \
!    ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
!    ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
     ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
--- 3520,3529 ----
     ada/errout.ads ada/erroutc.ads ada/exp_tss.ads ada/exp_util.ads \
     ada/fname.ads ada/freeze.ads ada/get_targ.ads ada/gnat.ads \
     ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/g-utf_32.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-sort.adb \
!    ada/lib-xref.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads ada/rident.ads \
     ada/rtsfind.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
     ada/sem.ads ada/sem_ch8.ads ada/sem_eval.ads ada/sem_res.ads \
     ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb ada/sem_warn.ads \
*************** ada/sem_warn.o : ada/ada.ads ada/a-excep
*** 3468,3559 ****
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sinfo-cn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo-cn.ads \
!    ada/sinfo-cn.adb ada/sinput.ads ada/snames.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/sinfo.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/nlists.ads ada/nlists.adb \
!    ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sinput-c.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
     ada/alloc.ads ada/casing.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/sinput.ads \
     ada/sinput-c.ads ada/sinput-c.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/sinput-d.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/osint.ads \
     ada/osint-c.ads ada/output.ads ada/sinput.ads ada/sinput-d.ads \
     ada/sinput-d.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/sinput-l.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/gnat.ads ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/interfac.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/osint.ads ada/output.ads ada/prep.ads \
!    ada/prepcomp.ads ada/scans.ads ada/scn.ads ada/scng.ads ada/scng.adb \
!    ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput-l.ads \
!    ada/sinput-l.adb ada/snames.ads ada/stringt.ads ada/style.ads \
!    ada/styleg.ads ada/styleg.adb ada/styleg-c.ads ada/stylesw.ads \
!    ada/system.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-secsta.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sinput.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/namet.adb \
     ada/opt.ads ada/output.ads ada/sinput.ads ada/sinput.adb ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-secsta.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/snames.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/snames.ads ada/snames.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/sprint.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 3531,3625 ----
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
     ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/tbuild.ads ada/tree_io.ads ada/ttypes.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sinfo-cn.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads \
!    ada/sinfo-cn.ads ada/sinfo-cn.adb ada/sinput.ads ada/snames.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/sinfo.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/nlists.ads \
!    ada/nlists.adb ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/sinput-c.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
     ada/alloc.ads ada/casing.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/namet.ads ada/opt.ads ada/output.ads ada/sinput.ads \
     ada/sinput-c.ads ada/sinput-c.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/sinput-d.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/osint.ads \
     ada/osint-c.ads ada/output.ads ada/sinput.ads ada/sinput-d.ads \
     ada/sinput-d.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/sinput-l.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
     ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
     ada/gnat.ads ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/g-utf_32.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads ada/namet.ads \
!    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/opt.ads ada/osint.ads \
!    ada/output.ads ada/prep.ads ada/prepcomp.ads ada/scans.ads ada/scn.ads \
!    ada/scng.ads ada/scng.adb ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
!    ada/sinput-l.ads ada/sinput-l.adb ada/snames.ads ada/stringt.ads \
!    ada/style.ads ada/styleg.ads ada/styleg.adb ada/styleg-c.ads \
!    ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-crc32.adb \
!    ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/sinput.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/namet.adb \
     ada/opt.ads ada/output.ads ada/sinput.ads ada/sinput.adb ada/system.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/widechar.ads 
  
  ada/snames.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/snames.ads ada/snames.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/sprint.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/sprint.o : ada/ada.ads ada/a-except.
*** 3566,3593 ****
     ada/sinput-d.ads ada/snames.ads ada/sprint.ads ada/sprint.adb \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/stand.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads ada/stand.ads \
     ada/stand.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/stringt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/types.adb ada/unchconv.ads \
!    ada/unchdeal.ads 
  
  ada/style.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 3632,3659 ----
     ada/sinput-d.ads ada/snames.ads ada/sprint.ads ada/sprint.adb \
     ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
     ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
     ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/stand.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads ada/stand.ads \
     ada/stand.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/stringt.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
     ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/types.adb \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/style.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/style.o : ada/ada.ads ada/a-except.a
*** 3599,3609 ****
     ada/snames.ads ada/stand.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/styleg-c.adb ada/stylesw.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/styleg-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 3665,3675 ----
     ada/snames.ads ada/stand.ads ada/style.ads ada/styleg.ads \
     ada/styleg.adb ada/styleg-c.ads ada/styleg-c.adb ada/stylesw.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/styleg-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/styleg-c.o : ada/ada.ads ada/a-excep
*** 3612,3630 ****
     ada/output.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
     ada/stand.ads ada/styleg.ads ada/styleg-c.ads ada/styleg-c.adb \
     ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/styleg.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/opt.ads ada/output.ads ada/scans.ads ada/sinput.ads ada/styleg.ads \
     ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/stylesw.o : ada/gnat.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/stylesw.ads ada/stylesw.adb \
--- 3678,3697 ----
     ada/output.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
     ada/stand.ads ada/styleg.ads ada/styleg-c.ads ada/styleg-c.adb \
     ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/styleg.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/casing.ads \
     ada/csets.ads ada/debug.ads ada/err_vars.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/opt.ads ada/output.ads ada/scans.ads ada/sinput.ads ada/styleg.ads \
     ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/stylesw.o : ada/gnat.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/stylesw.ads ada/stylesw.adb \
*************** ada/stylesw.o : ada/gnat.ads ada/g-strin
*** 3634,3659 ****
  ada/switch-b.o : ada/ada.ads ada/a-except.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/opt.ads ada/osint.ads ada/switch.ads ada/switch-b.ads \
!    ada/switch-b.adb ada/system.ads ada/s-exctab.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/switch-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/opt.ads ada/osint.ads ada/output.ads \
     ada/prepcomp.ads ada/stylesw.ads ada/switch.ads ada/switch-c.ads \
     ada/switch-c.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/validsw.ads 
  
  ada/switch.o : ada/ada.ads ada/a-except.ads ada/switch.ads ada/switch.adb \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/system.o : ada/system.ads 
  
--- 3701,3726 ----
  ada/switch-b.o : ada/ada.ads ada/a-except.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads \
     ada/opt.ads ada/osint.ads ada/switch.ads ada/switch-b.ads \
!    ada/switch-b.adb ada/system.ads ada/s-exctab.ads ada/s-parame.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/switch-c.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/lib.ads ada/opt.ads ada/osint.ads ada/output.ads \
     ada/prepcomp.ads ada/stylesw.ads ada/switch.ads ada/switch-c.ads \
     ada/switch-c.adb ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/validsw.ads 
  
  ada/switch.o : ada/ada.ads ada/a-except.ads ada/switch.ads ada/switch.adb \
     ada/system.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
!    ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/system.o : ada/system.ads 
  
*************** ada/targparm.o : ada/ada.ads ada/a-excep
*** 3667,3695 ****
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/namet.adb \
     ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-rident.ads \
!    ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
!    ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
!    ada/targparm.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/widechar.ads 
  
  ada/tbuild.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
!    ada/elists.ads ada/fname.ads ada/gnat.ads ada/g-hesora.ads \
!    ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
!    ada/hostparm.ads ada/lib.ads ada/lib.adb ada/lib-list.adb \
!    ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
!    ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
!    ada/restrict.ads ada/rident.ads ada/sinfo.ads ada/sinfo.adb \
!    ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
--- 3734,3763 ----
     ada/debug.ads ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/namet.ads ada/namet.adb \
     ada/opt.ads ada/osint.ads ada/output.ads ada/rident.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/targparm.ads ada/targparm.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads 
  
  ada/tbuild.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads ada/einfo.adb \
!    ada/elists.ads ada/elists.adb ada/fname.ads ada/gnat.ads \
!    ada/g-hesora.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
!    ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/lib.adb \
!    ada/lib-list.adb ada/lib-sort.adb ada/namet.ads ada/namet.adb \
!    ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads \
!    ada/output.ads ada/restrict.ads ada/rident.ads ada/sinfo.ads \
!    ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/stand.ads \
!    ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
!    ada/s-htable.ads ada/s-imgenu.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
!    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
*************** ada/tree_gen.o : ada/ada.ads ada/a-excep
*** 3698,3714 ****
     ada/osint.ads ada/osint-c.ads ada/output.ads ada/repinfo.ads \
     ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_gen.ads ada/tree_gen.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads 
  
  ada/tree_io.o : ada/ada.ads ada/a-except.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/tree_io.ads ada/tree_io.adb \
!    ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/treepr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
--- 3766,3782 ----
     ada/osint.ads ada/osint-c.ads ada/output.ads ada/repinfo.ads \
     ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/stand.ads \
     ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_gen.ads \
!    ada/tree_gen.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/tree_io.o : ada/ada.ads ada/a-except.ads ada/debug.ads ada/gnat.ads \
     ada/g-os_lib.ads ada/g-string.ads ada/output.ads ada/system.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-parame.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/tree_io.ads \
!    ada/tree_io.adb ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
  
  ada/treepr.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
     ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
*************** ada/treepr.o : ada/ada.ads ada/a-except.
*** 3720,3739 ****
     ada/sem_mech.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/treepr.ads ada/treepr.adb ada/treeprs.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/treeprs.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/output.ads ada/sinfo.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/treeprs.ads ada/types.ads \
!    ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/ttypef.o : ada/system.ads ada/ttypef.ads 
  
--- 3788,3808 ----
     ada/sem_mech.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/treepr.ads ada/treepr.adb \
!    ada/treeprs.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads 
  
  ada/treeprs.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/output.ads ada/sinfo.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/treeprs.ads \
!    ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads 
  
  ada/ttypef.o : ada/system.ads ada/ttypef.ads 
  
*************** ada/ttypes.o : ada/get_targ.ads ada/syst
*** 3742,3759 ****
     ada/unchconv.ads ada/unchdeal.ads 
  
  ada/types.o : ada/ada.ads ada/a-except.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/types.ads ada/types.adb \
!    ada/unchconv.ads ada/unchdeal.ads 
  
  ada/uintp.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
     ada/output.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-htable.adb ada/s-memory.ads ada/s-stalib.ads ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads 
  
  ada/uname.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
--- 3811,3828 ----
     ada/unchconv.ads ada/unchdeal.ads 
  
  ada/types.o : ada/ada.ads ada/a-except.ads ada/system.ads ada/s-carun8.ads \
!    ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-parame.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/types.ads \
!    ada/types.adb ada/unchconv.ads ada/unchdeal.ads 
  
  ada/uintp.o : ada/ada.ads ada/a-except.ads ada/a-uncdea.ads ada/alloc.ads \
     ada/debug.ads ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads \
     ada/output.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
!    ada/s-htable.adb ada/s-memory.ads ada/s-parame.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
     ada/unchconv.ads ada/unchdeal.ads 
  
  ada/uname.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/atree.ads \
*************** ada/uname.o : ada/ada.ads ada/a-except.a
*** 3765,3792 ****
     ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
!    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
!    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
!    ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
!    ada/uname.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
  
  ada/urealp.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-memory.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
!    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
!    ada/urealp.adb 
  
  ada/usage.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/usage.ads ada/usage.adb 
  
  ada/validsw.o : ada/gnat.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/system.ads ada/s-exctab.ads \
--- 3834,3862 ----
     ada/opt.ads ada/output.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
     ada/sinput.adb ada/snames.ads ada/stand.ads ada/stringt.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imgenu.ads \
!    ada/s-memory.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
!    ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
!    ada/uname.ads ada/uname.adb ada/unchconv.ads ada/unchdeal.ads \
!    ada/urealp.ads ada/widechar.ads 
  
  ada/urealp.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-htable.ads ada/g-os_lib.ads ada/g-string.ads \
     ada/gnatvsn.ads ada/hostparm.ads ada/opt.ads ada/output.ads \
     ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-memory.ads \
!    ada/s-parame.ads ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads \
!    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
!    ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
!    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb 
  
  ada/usage.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
     ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/namet.ads ada/opt.ads ada/osint.ads ada/output.ads \
!    ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-parame.ads \
!    ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
!    ada/table.ads ada/table.adb ada/tree_io.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/usage.ads ada/usage.adb 
  
  ada/validsw.o : ada/gnat.ads ada/g-string.ads ada/gnatvsn.ads \
     ada/hostparm.ads ada/opt.ads ada/system.ads ada/s-exctab.ads \
*************** ada/validsw.o : ada/gnat.ads ada/g-strin
*** 3795,3804 ****
  
  ada/widechar.o : ada/ada.ads ada/a-except.ads ada/gnat.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/opt.ads ada/system.ads ada/s-exctab.ads ada/s-soflin.ads \
!    ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
!    ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcnv.ads ada/s-wchcnv.adb \
!    ada/s-wchcon.ads ada/s-wchjis.ads ada/types.ads ada/unchconv.ads \
!    ada/unchdeal.ads ada/widechar.ads ada/widechar.adb 
  
  # end of regular dependencies
--- 3865,3874 ----
  
  ada/widechar.o : ada/ada.ads ada/a-except.ads ada/gnat.ads \
     ada/g-string.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
!    ada/opt.ads ada/system.ads ada/s-exctab.ads ada/s-parame.ads \
!    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
!    ada/s-stoele.adb ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcnv.ads \
!    ada/s-wchcnv.adb ada/s-wchcon.ads ada/s-wchjis.ads ada/types.ads \
!    ada/unchconv.ads ada/unchdeal.ads ada/widechar.ads ada/widechar.adb 
  
  # end of regular dependencies
diff -Nrcpad gcc-4.0.2/gcc/ada/Makefile.generic gcc-4.1.0/gcc/ada/Makefile.generic
*** gcc-4.0.2/gcc/ada/Makefile.generic	Wed Sep  1 11:51:48 2004
--- gcc-4.1.0/gcc/ada/Makefile.generic	Thu Jan  1 00:00:00 1970
***************
*** 1,503 ****
- # Generic Makefile to support compilation for multiple languages.
- # See also Makefile.prolog
- #
- #   Copyright (C) 2001-2004 Free Software Foundation, Inc.
- 
- # This file is part of GCC.
- 
- # GCC is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2, or (at your option)
- # any later version.
- 
- # GCC is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- # GNU General Public License for more details.
- 
- # You should have received a copy of the GNU General Public License
- # along with GCC; see the file COPYING.  If not, write to
- # the Free Software Foundation, 59 Temple Place - Suite 330,
- # Boston, MA 02111-1307, USA.
- 
- # This Makefile provides a very generic framework of the following
- # functionalities:
- #
- # Multi-language support (currently any combination of Ada/C/C++ supported)
- # Automatic handling of source dependencies
- # Handling of various C/C++ compilers
- # Handling of Ada sources using the GNAT toolchain
- # Complete build process (compile/bind/link)
- # Individual compilation (on a file, or on a language)
- # Handling of an object directory
- 
- # Here are the rules that can be used from the command line:
- #
- # build:         complete compile/bind/link process
- # compile:       compile all files that are not up-to-date
- # link:          bind/link
- # ada:           compile all Ada files that are not up-to-date
- # c:             ditto for C files
- # c++:           ditto for C++ files
- # <ada file>:    compile the specified file if needed.
- # <object file>: compile the corresponding C/C++ source file if needed.
- # clean:         remove all temporary files
- 
- # This Makefile expects the following variables to be set by the caller
- # (typically another Makefile):
- #
- # ADA_SPEC         extension of Ada spec files (optional, default to .ads)
- # ADA_BODY         extension of Ada body files (optional, default to .adb)
- # C_EXT            extension of C files (optional, default to .c)
- # CXX_EXT          extension of C++ files (optional, default to .cc)
- # OBJ_EXT          extension of object files (optional, default to .o)
- # SRC_DIRS         blank separated list of source directories
- # C_SRCS           explicit list of C sources (optional)
- # C_SRCS_DEFINED   if set, indicates that C_SRCS is already set
- # CXX_SRCS         explicit list of C++ sources (optional)
- # CXX_SRCS_DEFINED is set, indicates that CXX_SRCS is already set
- # OBJ_DIR          a single directory where object files should be put
- # EXEC_DIR         a single directory where executables should be put (optional)
- # LANGUAGES        a blank separated list of languages supported, e.g "ada c"
- #                  the current list of recognized languages is: ada, c, c++
- # CC               name of the C compiler (optional, default to gcc)
- # CXX              name of the C++ compiler (optional, default to gcc)
- # AR_CMD           command to create an archive (optional, default to "ar rc")
- # AR_EXT           file extension of an archive (optional, default to ".a")
- # RANLIB           command to generate an index (optional, default to "ranlib")
- # GNATMAKE         name of the GNAT builder (optional, default to "gnatmake")
- # ADAFLAGS         additional Ada compilation switches, e.g "-gnatf" (optional)
- # CFLAGS           default C compilation switches, e.g "-O2 -g" (optional)
- # CXXFLAGS         default C++ compilation switches (optional)
- # LIBS             libraries to link with (optional)
- # LDFLAGS          linker switches (optional)
- # ADA_SOURCES      list of main Ada sources (optional)
- # EXEC             name of the final executable (optional)
- # MAIN             language of the main program (optional)
- # MAIN_OBJECT      main object file (optional)
- # PROJECT_FILE     name of the project file, without the .gpr extension
- # DEPS_PROJECTS    list of project dependencies (optional)
- 
- # SILENT           (optional) when defined, make -s will not output anything
- #                  when all commands are successful.
- 
- # Set the source search path for C and C++ if needed
- 
- ifndef MAIN
-    MAIN=ada
- endif
- 
- ifndef ADA_SPEC
-    ADA_SPEC=.ads
- endif
- 
- ifndef ADA_BODY
-    ADA_BODY=.adb
- endif
- 
- ifndef CC
-    CC=gcc
- endif
- 
- ifndef CXX
-    CXX=gcc
- endif
- 
- ifndef CXX_EXT
-    CXX_EXT=.cc
- endif
- 
- vpath %$(C_EXT) $(SRC_DIRS)
- vpath %$(CXX_EXT) $(SRC_DIRS)
- 
- ifndef OBJ_EXT
-    OBJ_EXT=.o
- endif
- 
- ifndef AR_EXT
-    AR_EXT=.a
- endif
- 
- ifndef AR_CMD
-    AR_CMD=ar rc
- endif
- 
- ifndef RANLIB
-    RANLIB=ranlib
- endif
- 
- ifndef GNATMAKE
-    GNATMAKE:=gnatmake
- endif
- 
- ifndef ARCHIVE
-    ARCHIVE=$(OBJ_DIR)/lib$(PROJECT_BASE)-full$(AR_EXT)
- endif
- 
- ifeq ($(EXEC_DIR),)
-    EXEC_DIR=$(OBJ_DIR)
- endif
- 
- # Define display to echo only when SILENT is not defined
- 
- ifdef SILENT
- define display
-    @gprcmd ignore
- endef
- 
- else
- define display
-    @echo
- endef
- endif
- 
- # Make sure gnatmake is called silently when SILENT is set
- ifdef SILENT
-    GNATMAKE:=$(GNATMAKE) -q
- endif
- 
- # If C/C++ compiler is gcc, make sure gcc is called with the switch indicating
- # the language, in case the extension is not standard.
- 
- ifeq ($(strip $(filter-out %gcc,$(CC))),)
-    C_Compiler=$(CC) -x c
- else
-    C_Compiler=$(CC)
- endif
- 
- ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
-    CXX_Compiler=$(CXX) -x c++
- else
-    CXX_Compiler=$(CXX)
- endif
- 
- # Set the object search path
- 
- vpath %$(OBJ_EXT) $(OBJ_DIR)
- vpath %$(AR_EXT) $(OBJ_DIR)
- 
- # A target can't have a character ':' otherwise it will confuse make. We
- # replace ':' by a pipe character. Note that there is less chance than a pipe
- # character be part of a pathname on UNIX and this character can't be used in
- # a pathname on Windows.
- 
- clean_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=clean_%))
- compile_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=compile_%))
- object_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=object_%))
- ada_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=ada_%))
- c_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c_%))
- c++_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c++_%))
- 
- # Default target is to build (compile/bind/link)
- all: build
- 
- clean: $(clean_deps) internal-clean
- build: $(compile_deps) internal-compile internal-build
- compile: $(compile_deps) internal-compile $(ADA_SOURCES)
- ada: $(ada_deps) internal-ada
- archive-objects: $(object_deps) internal-archive-objects
- c: $(c_deps) internal-c
- c++: $(c++deps) internal-c++
- 
- $(clean_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:clean_%=%))) -f Makefile.$(notdir $@) internal-clean
- 
- $(compile_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:compile_%=%))) -f Makefile.$(notdir $@) internal-compile
- 
- $(object_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:object_%=%))) -f Makefile.$(notdir $@) internal-archive-objects ARCHIVE=$(ARCHIVE)
- 
- $(ada_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:ada_%=%))) -f Makefile.$(notdir $@) internal-ada
- 
- $(c_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c_%=%))) -f Makefile.$(notdir $@) internal-c
- 
- $(c++_deps): force
- 	@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c++_%=%))) -f Makefile.$(notdir $@) internal-c++
- 
- ifneq ($(EXEC),)
-    EXEC_RULE=-o $(EXEC)
- endif
- 
- PROJECT_BASE = $(notdir $(PROJECT_FILE))
- 
- # Set C/C++ linker command & target
- 
- ifeq ($(filter c++,$(LANGUAGES)),c++)
-    LINKER = $(CXX)
- 
-    ifeq ($(filter ada,$(LANGUAGES)),ada)
-       # C++ and Ada mixed
-       LARGS = --LINK=$(LINKER)
- 
-       ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
-          # Case of GNAT and a GNU C++ compiler
- $(LINKER):
- 
-       else
-          # Case of GNAT and a non GNU C++ compiler
-          LINKER = $(OBJ_DIR)/c++linker
- 
- $(LINKER): Makefile.$(PROJECT_BASE)
- 	@echo \#!/bin/sh > $(LINKER)
- 	@echo $(CXX) $$\* $(shell gcc -print-libgcc-file-name) >> $(LINKER)
- 	@chmod +x $(LINKER)
-       endif
-    endif
- else
-    ifeq ($(strip $(LANGUAGES)),c)
-       # Case of C only
-       LINKER = $(CC)
-    endif
- endif
- 
- C_INCLUDES := $(foreach name,$(SRC_DIRS),-I$(name))
- ALL_CFLAGS = $(CFLAGS) $(DEP_CFLAGS)
- ALL_CXXFLAGS = $(CXXFLAGS) $(DEP_CFLAGS)
- LDFLAGS := $(LIBS) $(LDFLAGS)
- 
- # Compute list of objects based on languages
- 
- ifeq ($(strip $(filter c,$(LANGUAGES))),c)
-    # Compute list of C sources automatically unless already specified
- 
-    ifndef C_SRCS_DEFINED
-       ifndef C_SRCS
-          C_SRCS := \
-            $(foreach name,$(SRC_DIRS),$(notdir $(wildcard $(name)/*$(C_EXT))))
-       endif
-    endif
- 
-    C_OBJECTS := $(C_SRCS:$(C_EXT)=$(OBJ_EXT))
-    OBJECTS += $(C_OBJECTS)
- endif
- 
- ifeq ($(strip $(filter c++,$(LANGUAGES))),c++)
-    # Compute list of C++ sources automatically unless already specified
- 
-    ifndef CXX_SRCS_DEFINED
-       ifndef CXX_SRCS
-          CXX_SRCS := \
-          $(foreach name,$(SRC_DIRS),$(notdir $(wildcard $(name)/*$(CXX_EXT))))
-       endif
-    endif
- 
-    CXX_OBJECTS := $(CXX_SRCS:$(CXX_EXT)=$(OBJ_EXT))
-    OBJECTS += $(CXX_OBJECTS)
- endif
- 
- OBJ_FILES := $(foreach name,$(OBJECTS),$(OBJ_DIR)/$(name))
- 
- # To handle C/C++ dependencies, we associate a small file for each
- # source that will list the dependencies as a make rule, so that we can then
- # include these rules in this makefile, and recompute them on a file by file
- # basis
- 
- DEP_FILES := $(OBJ_FILES:$(OBJ_EXT)=.d)
- 
- # Ada compilations are taken care of automatically, so do not mess with Ada
- # objects, only with main sources.
- 
- ifeq ($(strip $(OBJECTS)),)
- internal-compile:
- internal-archive-objects:
- 
- else
- internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
- 
- lib$(PROJECT_BASE)$(AR_EXT): $(OBJECTS)
- 	@$(display) creating archive file for $(PROJECT_BASE)
- 	cd $(OBJ_DIR); $(AR_CMD) $@ $(strip $(OBJECTS))
- 	-$(RANLIB) $(OBJ_DIR)/$@
- 
- internal-archive-objects: $(OBJECTS)
- #	@echo $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
- #	cd $(OBJ_DIR); $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
- #	-$(RANLIB) $(OBJ_DIR)/$@
- 
- endif
- 
- # Linking rules
- 
- # There are three cases:
- #
- # - C/C++ sources
- #
- # - Ada/C/C++, main program is in Ada
- #
- # - Ada/C/C++, main program is in C/C++
- 
- ifeq ($(strip $(filter-out c c++,$(LANGUAGES))),)
- # link with C/C++
- ifeq ($(MAIN_OBJECT),)
- link:
- 	@echo link: no main object specified, exiting...
- 	exit 1
- else
- ifeq ($(EXEC),)
- 
- link:
- 	@echo link: no executable specified, exiting...
- 	exit 1
- else
- 
- link: $(EXEC_DIR)/$(EXEC) archive-objects
- $(EXEC_DIR)/$(EXEC): $(OBJECTS)
- 	@$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
- 	@$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
- endif
- endif
- 
- internal-build: internal-compile link
- 
- else
- ifeq ($(strip $(filter-out c c++ ada,$(LANGUAGES))),)
- # link with Ada/C/C++
- 
- ifeq ($(MAIN),ada)
- # Ada main
- link: $(LINKER) archive-objects force
- 	@$(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
- 	@$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
- 		 -largs $(LARGS) $(LDFLAGS)
- 
- internal-build: $(LINKER) archive-objects force
- 	@$(display) $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
- 	@$(GNATMAKE) -P$(PROJECT_FILE) $(EXEC_RULE) $(ADA_SOURCES) $(ADAFLAGS) \
- 	 -largs $(LARGS) $(LDFLAGS)
- 
- else
- # C/C++ main
- 
- link: $(LINKER) archive-objects force
- 	@$(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
- 	@$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
- 		 -largs $(OBJ_DIR)/$(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
- 
- internal-build: $(LINKER) archive-objects force
- 	@$(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS)
- 	@$(GNATMAKE) $(EXEC_RULE) \
- 		 -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
- 		 -largs $(OBJ_DIR)/$(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
- endif
- 
- else
- # unknown set of languages, fail
- link:
- 	@echo do not know how to link with the following languages: $(LANGUAGES)
- 	exit 1
- endif
- endif
- 
- # Automatic handling of dependencies
- 
- ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
- # Compiler is GCC, take avantage of the preprocessor option -MD and
- # the CPATH environment variable
- 
- empty:=
- space:=$(empty) $(empty)
- path_sep:=$(shell gprcmd path_sep)
- SRC_DIRS_PATH:= $(subst $(space),$(path_sep),$(SRC_DIRS))
- export CPATH:=$(SRC_DIRS_PATH)$(path_sep)$(CPATH)
- 
- DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
- 
- define post-compile
-   @gprcmd deps $(OBJ_EXT) $(OBJ_DIR)/$(*F).d gcc
- endef
- 
- # Default rule to create dummy dependency files the first time
- 
- $(OBJ_DIR)/%.d:
- 	@echo $(*F)$(OBJ_EXT): > $@
- 
- else
- # Compiler unknown, use a more general approach based on the output of $(CC) -M
- 
- ALL_CFLAGS := $(ALL_CFLAGS) $(C_INCLUDES)
- ALL_CXXFLAGS := $(ALL_CXXFLAGS) $(C_INCLUDES)
- 
- DEP_FLAGS  = -M
- DEP_CFLAGS =
- 
- define post-compile
- endef
- 
- $(OBJ_DIR)/%.d: %$(C_EXT)
- 	@$(CC) $(DEP_FLAGS) $(ALL_CFLAGS) $< > $@
- 	@gprcmd deps $(OBJ_EXT) $@
- 
- $(OBJ_DIR)/%.d: %$(CXX_EXT)
- 	@$(CXX) $(DEP_FLAGS) $(ALL_CXXFLAGS) $< > $@
- 	@gprcmd deps $(OBJ_EXT) $@
- endif
- 
- ifneq ($(DEP_FILES),)
- -include $(DEP_FILES)
- endif
- 
- # Compilation rules
- 
- # File rules
- 
- # Compile C files individually
- %$(OBJ_EXT) : %$(C_EXT)
- 	@$(display) $(C_Compiler) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
- ifndef FAKE_COMPILE
- 	@$(C_Compiler) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
- 	@$(post-compile)
- endif
- 
- # Compile C++ files individually
- %$(OBJ_EXT) : %$(CXX_EXT)
- 	@$(display) $(CXX_Compiler) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
- ifndef FAKE_COMPILE
- 	@$(CXX_Compiler) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
- 	@$(post-compile)
- endif
- 
- # Compile Ada body files individually
- %$(ADA_BODY) : force
- 	$(GNATMAKE) -c -P$(PROJECT_FILE) $@ $(ADAFLAGS)
- 
- # Compile Ada spec files individually
- %$(ADA_SPEC) : force
- 	$(GNATMAKE) -c -P$(PROJECT_FILE) $@ $(ADAFLAGS)
- 
- # Languages rules
- 
- # Compile all Ada files in the project
- internal-ada :
- 	$(GNATMAKE) -c -P$(PROJECT_FILE) $(ADAFLAGS)
- 
- # Compile all C files in the project
- internal-c : $(C_OBJECTS)
- 
- # Compile all C++ files in the project
- internal-c++ : $(CXX_OBJECTS)
- 
- .PHONY: force internal-clean internal-archive internal-build internal-compile internal-ada internal-c internal-c++ build compile clean ada c c++
- 
- internal-clean:
- 	@$(display) $(RM) $(OBJ_DIR)/*$(OBJ_EXT)
- 	@$(RM) $(OBJ_DIR)/*$(OBJ_EXT)
- 	@$(display) $(RM) $(OBJ_DIR)/*.ali
- 	@$(RM) $(OBJ_DIR)/*.ali
- 	@$(display) $(RM) $(OBJ_DIR)/b~*
- 	@$(RM) $(OBJ_DIR)/b~*
- 	@$(display) $(RM) $(OBJ_DIR)/b_*
- 	@$(RM) $(OBJ_DIR)/b_*
- 	@$(display) $(RM) $(OBJ_DIR)/*$(AR_EXT)
- 	@$(RM) $(OBJ_DIR)/*$(AR_EXT)
- 	@$(display) $(RM) $(OBJ_DIR)/*.d
- 	@$(RM) $(OBJ_DIR)/*.d
- ifneq ($(EXEC),)
- 	@$(display) $(RM) $(EXEC_DIR)/$(EXEC)
- 	@$(RM) $(EXEC_DIR)/$(EXEC)
- endif
- 
- force:
- 
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/Makefile.in gcc-4.1.0/gcc/ada/Makefile.in
*** gcc-4.0.2/gcc/ada/Makefile.in	Thu Apr  7 20:03:50 2005
--- gcc-4.1.0/gcc/ada/Makefile.in	Fri Feb 24 03:49:43 2006
***************
*** 15,22 ****
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 59 Temple Place - Suite 330,
! #Boston, MA 02111-1307, USA.
  
  # The makefile built from this file lives in the language subdirectory.
  # Its purpose is to provide support for:
--- 15,22 ----
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 51 Franklin Street, Fifth Floor,
! #Boston, MA 02110-1301, USA.
  
  # The makefile built from this file lives in the language subdirectory.
  # Its purpose is to provide support for:
*************** SYSLIBS = @GNAT_LIBEXC@
*** 193,201 ****
  # List of extra object files linked in with various programs.
  EXTRA_GNATTOOLS_OBJS = ../../prefix.o ../../version.o
  
- # List extra gnattools
- EXTRA_GNATTOOLS =
- 
  # List of target dependent sources, overridden below as necessary
  TARGET_ADA_SRCS =
  
--- 193,198 ----
*************** LIBIBERTY = ../../libiberty/libiberty.a
*** 248,254 ****
  # and the system's installed libraries.
  LIBS = $(LIBINTL) $(LIBIBERTY) $(SYSLIBS)
  LIBDEPS = $(LIBINTL_DEP) $(LIBIBERTY)
! TOOLS_LIBS = $(LIBGNAT) $(EXTRA_GNATTOOLS_OBJS) link.o ../../../libiberty/libiberty.a $(SYSLIBS)
  
  # Specify the directories to be searched for header files.
  # Both . and srcdir are used, in that order,
--- 245,253 ----
  # and the system's installed libraries.
  LIBS = $(LIBINTL) $(LIBIBERTY) $(SYSLIBS)
  LIBDEPS = $(LIBINTL_DEP) $(LIBIBERTY)
! # Default is no TGT_LIB; one might be passed down or something
! TGT_LIB =
! TOOLS_LIBS = $(LIBGNAT) $(EXTRA_GNATTOOLS_OBJS) link.o ../../../libiberty/libiberty.a $(SYSLIBS) $(TGT_LIB)
  
  # Specify the directories to be searched for header files.
  # Both . and srcdir are used, in that order,
*************** s-osprim.adb<s-osprim-posix.adb \
*** 349,354 ****
--- 348,358 ----
  s-taprop.adb<s-taprop-dummy.adb \
  s-taspri.ads<s-taspri-dummy.ads
  
+ # When using the GCC exception handling mechanism, we need to use an
+ # alternate body for a-exexpr.adb (a-exexpr-gcc.adb)
+ 
+ EH_MECHANISM=
+ 
  # Default shared object option. Note that we rely on the fact that the "soname"
  # option will always be present and last in this flag, so that we can have
  # $(SO_OPTS)libgnat-x.xx
*************** LIB_VERSION = $(strip $(shell grep ' Lib
*** 382,493 ****
  # $(strip STRING) removes leading and trailing spaces from STRING.
  # If what's left is null then it's a match.
  
- ifeq ($(strip $(filter-out %86 os2 OS2 os2_emx,$(arch) $(osys))),)
-   LIBGNAT_TARGET_PAIRS = \
-   a-excpol.adb<a-excpol-abort.adb \
-   a-intnam.ads<a-intnam-dummy.ads \
-   a-numaux.adb<a-numaux-x86.adb \
-   a-numaux.ads<a-numaux-x86.ads \
-   s-inmaop.adb<s-inmaop-dummy.adb \
-   s-interr.adb<s-interr-dummy.adb \
-   s-intman.adb<s-intman-dummy.adb \
-   s-mastop.adb<s-mastop-x86.adb \
-   s-osinte.adb<s-osinte-os2.adb \
-   s-osinte.ads<s-osinte-os2.ads \
-   s-osprim.adb<s-osprim-os2.adb \
-   s-parame.adb<s-parame-os2.adb \
-   system.ads<system-os2.ads \
-   s-taprop.adb<s-taprop-os2.adb \
-   s-taspri.ads<s-taspri-os2.ads
- 
-   EXTRA_GNATRTL_NONTASKING_OBJS = \
-   i-os2err.o \
-   i-os2lib.o \
-   i-os2syn.o \
-   i-os2thr.o
- endif
- 
- ifeq ($(strip $(filter-out %86 interix%,$(arch) $(osys))),)
-   LIBGNAT_TARGET_PAIRS = \
-   a-excpol.adb<a-excpol-interix.adb \
-   a-intnam.ads<a-intnam-interix.ads \
-   a-numaux.adb<a-numaux-x86.adb \
-   a-numaux.ads<a-numaux-x86.ads \
-   g-soccon.ads<g-soccon-interix.ads \
-   s-inmaop.adb<s-inmaop-posix.adb \
-   s-intman.adb<s-intman-posix.adb \
-   s-mastop.adb<s-mastop-x86.adb \
-   s-osinte.adb<s-osinte-fsu.adb \
-   s-osinte.ads<s-osinte-interix.ads \
-   s-osprim.adb<s-osprim-unix.adb \
-   s-taprop.adb<s-taprop-posix.adb \
-   system.ads<system-interix.ads \
-   s-taspri.ads<s-taspri-posix.ads \
-   s-tpopsp.adb<s-tpopsp-posix.adb
- 
-   THREADSLIB = -lgthreads -lmalloc
-   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
- endif
- 
- # sysv5uw is SCO UnixWare 7
- ifeq ($(strip $(filter-out %86 sysv5uw%,$(arch) $(osys))),)
-   LIBGNAT_TARGET_PAIRS = \
-   a-excpol.adb<a-excpol-abort.adb \
-   a-intnam.ads<a-intnam-unixware.ads \
-   a-numaux.adb<a-numaux-x86.adb \
-   a-numaux.ads<a-numaux-x86.ads \
-   s-inmaop.adb<s-inmaop-posix.adb \
-   s-intman.adb<s-intman-posix.adb \
-   s-mastop.adb<s-mastop-x86.adb \
-   s-osinte.ads<s-osinte-unixware.ads \
-   s-osinte.adb<s-osinte-unixware.adb \
-   s-osprim.adb<s-osprim-unix.adb \
-   s-taprop.adb<s-taprop-posix.adb \
-   s-taspri.ads<s-taspri-posix.ads \
-   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
-   system.ads<system-unixware.ads \
-   g-soccon.ads<g-soccon-unixware.ads \
-   g-soliop.ads<g-soliop-unixware.ads
- 
-   THREADSLIB = -lthread
-   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
-   SO_OPTS = -Wl,-h,
-   GNATLIB_SHARED = gnatlib-shared-dual
-   LIBRARY_VERSION := $(LIB_VERSION)
- endif
- 
- ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
-   LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
-   a-intnam.ads<a-intnam-vxworks.ads \
-   a-numaux.ads<a-numaux-vxworks.ads \
-   s-inmaop.adb<s-inmaop-posix.adb \
-   s-interr.adb<s-interr-vxworks.adb \
-   s-intman.ads<s-intman-vxworks.ads \
-   s-intman.adb<s-intman-vxworks.adb \
-   s-osinte.adb<s-osinte-vxworks.adb \
-   s-osinte.ads<s-osinte-vxworks.ads \
-   s-osprim.adb<s-osprim-vxworks.adb \
-   s-parame.ads<s-parame-vxworks.ads \
-   s-stchop.adb<s-stchop-vxworks.adb \
-   s-taprop.adb<s-taprop-vxworks.adb \
-   s-tpopsp.adb<s-tpopsp-vxworks.adb \
-   s-taspri.ads<s-taspri-vxworks.ads \
-   s-vxwork.ads<s-vxwork-alpha.ads \
-   g-soccon.ads<g-soccon-vxworks.ads \
-   g-socthi.ads<g-socthi-vxworks.ads \
-   g-socthi.adb<g-socthi-vxworks.adb \
-   system.ads<system-vxworks-alpha.ads
- 
-   EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
-   EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
- endif
- 
  ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
--- 386,393 ----
*************** endif
*** 525,551 ****
  
  ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-interr.adb<s-interr-vxworks.adb \
    s-intman.ads<s-intman-vxworks.ads \
    s-intman.adb<s-intman-vxworks.adb \
-   s-osinte.adb<s-osinte-vxworks.adb \
    s-osinte.ads<s-osinte-vxworks.ads \
    s-osprim.adb<s-osprim-vxworks.adb \
    s-parame.ads<s-parame-vxworks.ads \
    s-stchop.adb<s-stchop-vxworks.adb \
    s-taprop.adb<s-taprop-vxworks.adb \
    s-taspri.ads<s-taspri-vxworks.ads \
-   s-tpopsp.adb<s-tpopsp-vxworks.adb \
    s-vxwork.ads<s-vxwork-ppc.ads \
    g-soccon.ads<g-soccon-vxworks.ads \
    g-socthi.ads<g-socthi-vxworks.ads \
!   g-socthi.adb<g-socthi-vxworks.adb \
!   system.ads<system-vxworks-ppc.ads
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
  
--- 425,446 ----
  
  ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-interr.adb<s-interr-vxworks.adb \
    s-intman.ads<s-intman-vxworks.ads \
    s-intman.adb<s-intman-vxworks.adb \
    s-osinte.ads<s-osinte-vxworks.ads \
    s-osprim.adb<s-osprim-vxworks.adb \
    s-parame.ads<s-parame-vxworks.ads \
    s-stchop.adb<s-stchop-vxworks.adb \
    s-taprop.adb<s-taprop-vxworks.adb \
    s-taspri.ads<s-taspri-vxworks.ads \
    s-vxwork.ads<s-vxwork-ppc.ads \
    g-soccon.ads<g-soccon-vxworks.ads \
    g-socthi.ads<g-socthi-vxworks.ads \
!   g-socthi.adb<g-socthi-vxworks.adb
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
  
*************** ifeq ($(strip $(filter-out powerpc% wrs 
*** 558,571 ****
      s-tfsetr.adb<s-tfsetr-vxworks.adb 
    endif
  
!   EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
    EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
  endif
  
  ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
--- 453,479 ----
      s-tfsetr.adb<s-tfsetr-vxworks.adb 
    endif
  
!   ifeq ($(strip $(filter-out rtp,$(THREAD_KIND))),)
!     LIBGNAT_TARGET_PAIRS += \
!     s-osinte.adb<s-osinte-vxworks-rtp.adb \
!     s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
!     system.ads<system-vxworks-ppc-rtp.ads
! 
!     EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
!   else
!     LIBGNAT_TARGET_PAIRS += \
!     s-osinte.adb<s-osinte-vxworks.adb \
!     s-tpopsp.adb<s-tpopsp-vxworks.adb \
!     system.ads<system-vxworks-ppc.ads
! 
!     EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
!   endif
! 
    EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
  endif
  
  ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
*************** endif
*** 594,601 ****
  
  ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    i-vxwork.ads<i-vxwork-x86.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
--- 502,507 ----
*************** ifeq ($(strip $(filter-out %86 wrs vxwor
*** 633,642 ****
    EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
  endif
  
! ifeq ($(strip $(filter-out xscale% coff wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
--- 539,546 ----
    EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
  endif
  
! ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
*************** ifeq ($(strip $(filter-out xscale% coff 
*** 651,661 ****
    s-taprop.adb<s-taprop-vxworks.adb \
    s-taspri.ads<s-taspri-vxworks.ads \
    s-tpopsp.adb<s-tpopsp-vxworks.adb \
!   s-vxwork.ads<s-vxwork-xscale.ads \
    g-soccon.ads<g-soccon-vxworks.ads \
    g-socthi.ads<g-socthi-vxworks.ads \
    g-socthi.adb<g-socthi-vxworks.adb \
!   system.ads<system-elf-sparc.ads
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
  
--- 555,565 ----
    s-taprop.adb<s-taprop-vxworks.adb \
    s-taspri.ads<s-taspri-vxworks.ads \
    s-tpopsp.adb<s-tpopsp-vxworks.adb \
!   s-vxwork.ads<s-vxwork-arm.ads \
    g-soccon.ads<g-soccon-vxworks.ads \
    g-socthi.ads<g-socthi-vxworks.ads \
    g-socthi.adb<g-socthi-vxworks.adb \
!   system.ads<system-vxworks-arm.ads
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
  
*************** endif
*** 665,672 ****
  
  ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
    LIBGNAT_TARGET_PAIRS = \
-   a-sytaco.ads<a-sytaco-vxworks.ads \
-   a-sytaco.adb<a-sytaco-vxworks.adb \
    a-intnam.ads<a-intnam-vxworks.ads \
    a-numaux.ads<a-numaux-vxworks.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
--- 569,574 ----
*************** ifeq ($(strip $(filter-out sparc sun sol
*** 713,718 ****
--- 615,621 ----
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-solaris.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lposix4 -lthread
    MISCLIB = -lposix4 -lnsl -lsocket
    SO_OPTS = -Wl,-h,
*************** ifeq ($(strip $(filter-out sparc sun sol
*** 721,744 ****
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
  
-   ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
-     LIBGNAT_TARGET_PAIRS = \
-     a-intnam.ads<a-intnam-solaris.ads \
-     s-inmaop.adb<s-inmaop-posix.adb \
-     s-intman.adb<s-intman-solaris.adb \
-     s-osinte.adb<s-osinte-fsu.adb \
-     s-osinte.ads<s-osinte-solaris-fsu.ads \
-     s-osprim.adb<s-osprim-solaris.adb \
-     s-taprop.adb<s-taprop-posix.adb \
-     s-taspri.ads<s-taspri-posix.ads \
-     s-tpopsp.adb<s-tpopsp-posix.adb \
-     g-soccon.ads<g-soccon-solaris.ads \
-     g-soliop.ads<g-soliop-solaris.ads \
-     system.ads<system-solaris-sparc.ads
- 
-     THREADSLIB = -lgthreads -lmalloc
-   endif
- 
    ifeq ($(strip $(filter-out pthread PTHREAD,$(THREAD_KIND))),)
      LIBGNAT_TARGET_PAIRS = \
      a-intnam.ads<a-intnam-solaris.ads \
--- 624,629 ----
*************** ifeq ($(strip $(filter-out sparc sun sol
*** 771,777 ****
      s-tasinf.ads<s-tasinf-solaris.ads \
      s-taspri.ads<s-taspri-solaris.ads \
      s-tpopsp.adb<s-tpopsp-solaris.adb \
!     g-soccon.ads<g-soccon-solaris.ads \
      g-soliop.ads<g-soliop-solaris.ads \
      system.ads<system-solaris-sparcv9.ads
    endif
--- 656,662 ----
      s-tasinf.ads<s-tasinf-solaris.ads \
      s-taspri.ads<s-taspri-solaris.ads \
      s-tpopsp.adb<s-tpopsp-solaris.adb \
!     g-soccon.ads<g-soccon-solaris-64.ads \
      g-soliop.ads<g-soliop-solaris.ads \
      system.ads<system-solaris-sparcv9.ads
    endif
*************** ifeq ($(strip $(filter-out %86 solaris2%
*** 784,790 ****
    a-intnam.ads<a-intnam-solaris.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-solaris.adb \
-   s-mastop.adb<s-mastop-x86.adb \
    s-osinte.adb<s-osinte-solaris.adb \
    s-osinte.ads<s-osinte-solaris.ads \
    s-osprim.adb<s-osprim-solaris.adb \
--- 669,674 ----
*************** ifeq ($(strip $(filter-out %86 linux%,$(
*** 814,859 ****
    a-intnam.ads<a-intnam-linux.ads \
    a-numaux.adb<a-numaux-x86.adb \
    a-numaux.ads<a-numaux-x86.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
-   s-mastop.adb<s-mastop-x86.adb \
    s-osinte.adb<s-osinte-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-x86.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
- 
-   ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
-     LIBGNAT_TARGET_PAIRS = \
-     a-intnam.ads<a-intnam-linux.ads \
-     a-numaux.adb<a-numaux-x86.adb \
-     a-numaux.ads<a-numaux-x86.ads \
-     s-inmaop.adb<s-inmaop-posix.adb \
-     s-intman.adb<s-intman-posix.adb \
-     s-mastop.adb<s-mastop-x86.adb \
-     s-osinte.adb<s-osinte-fsu.adb \
-     s-osinte.ads<s-osinte-linux-fsu.ads \
-     s-osprim.adb<s-osprim-posix.adb \
-     s-taprop.adb<s-taprop-posix.adb \
-     s-taspri.ads<s-taspri-posix.ads \
-     s-tpopsp.adb<s-tpopsp-posix.adb \
-     system.ads<system-linux-x86.ads
- 
-     THREADSLIB = -lgthreads -lmalloc
-   endif
  endif
  
  ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
--- 698,725 ----
    a-intnam.ads<a-intnam-linux.ads \
    a-numaux.adb<a-numaux-x86.adb \
    a-numaux.ads<a-numaux-x86.ads \
+   g-soccon.ads<g-soccon-linux-x86.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
    s-osinte.adb<s-osinte-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-x86.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
  endif
  
  ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
*************** ifeq ($(strip $(filter-out %86 freebsd%,
*** 864,870 ****
    g-soccon.ads<g-soccon-freebsd.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
-   s-mastop.adb<s-mastop-x86.adb \
    s-osinte.adb<s-osinte-freebsd.adb \
    s-osinte.ads<s-osinte-freebsd.ads \
    s-osprim.adb<s-osprim-posix.adb \
--- 730,735 ----
*************** ifeq ($(strip $(filter-out s390% linux%,
*** 893,899 ****
      s-osinte.ads<s-osinte-linux.ads \
      s-osprim.adb<s-osprim-posix.adb \
      s-taprop.adb<s-taprop-linux.adb \
!     s-taspri.ads<s-taspri-linux.ads \
      s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
      s-parame.adb<s-parame-linux.adb \
      system.ads<system-linux-s390x.ads
--- 758,764 ----
      s-osinte.ads<s-osinte-linux.ads \
      s-osprim.adb<s-osprim-posix.adb \
      s-taprop.adb<s-taprop-linux.adb \
!     s-taspri.ads<s-taspri-posix.ads \
      s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
      s-parame.adb<s-parame-linux.adb \
      system.ads<system-linux-s390x.ads
*************** ifeq ($(strip $(filter-out s390% linux%,
*** 906,912 ****
      s-osinte.ads<s-osinte-linux.ads \
      s-osprim.adb<s-osprim-posix.adb \
      s-taprop.adb<s-taprop-linux.adb \
!     s-taspri.ads<s-taspri-linux.ads \
      s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
      s-parame.adb<s-parame-linux.adb \
      system.ads<system-linux-s390.ads
--- 771,777 ----
      s-osinte.ads<s-osinte-linux.ads \
      s-osprim.adb<s-osprim-posix.adb \
      s-taprop.adb<s-taprop-linux.adb \
!     s-taspri.ads<s-taspri-posix.ads \
      s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
      s-parame.adb<s-parame-linux.adb \
      system.ads<system-linux-s390.ads
*************** ifeq ($(strip $(filter-out s390% linux%,
*** 915,920 ****
--- 780,786 ----
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
*************** ifeq ($(strip $(filter-out mips sgi irix
*** 945,970 ****
      GNATLIB_SHARED = gnatlib-shared-default
  
    else
!     LIBGNAT_TARGET_PAIRS = \
!     a-intnam.ads<a-intnam-irix.ads \
!     s-inmaop.adb<s-inmaop-dummy.adb \
!     s-interr.adb<s-interr-sigaction.adb \
!     s-intman.adb<s-intman-irix-athread.adb \
      s-mastop.adb<s-mastop-irix.adb \
-     s-osinte.adb<s-osinte-irix.adb \
-     s-osinte.ads<s-osinte-irix-athread.ads \
      s-osprim.adb<s-osprim-posix.adb \
-     s-proinf.adb<s-proinf-irix-athread.adb \
-     s-proinf.ads<s-proinf-irix-athread.ads \
-     s-taprop.adb<s-taprop-irix-athread.adb \
-     s-tasinf.adb<s-tasinf-irix-athread.adb \
-     s-tasinf.ads<s-tasinf-irix-athread.ads \
-     s-taspri.ads<s-taspri-posix.ads \
      s-traceb.adb<s-traceb-mastop.adb \
      g-soccon.ads<g-soccon-irix.ads \
      system.ads<system-irix-o32.ads
    endif
  
    TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-irix.adb
    TGT_LIB = -lexc
    MISCLIB = -lexc
--- 811,825 ----
      GNATLIB_SHARED = gnatlib-shared-default
  
    else
!     LIBGNAT_TARGET_PAIRS += \
      s-mastop.adb<s-mastop-irix.adb \
      s-osprim.adb<s-osprim-posix.adb \
      s-traceb.adb<s-traceb-mastop.adb \
      g-soccon.ads<g-soccon-irix.ads \
      system.ads<system-irix-o32.ads
    endif
  
+   EH_MECHANISM=-gcc
    TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-irix.adb
    TGT_LIB = -lexc
    MISCLIB = -lexc
*************** ifeq ($(strip $(filter-out hppa% hp hpux
*** 989,994 ****
--- 844,850 ----
    g-soccon.ads<g-soccon-hpux.ads \
    system.ads<system-hpux.ads
  
+   EH_MECHANISM=-gcc
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
  endif
  
*************** ifeq ($(strip $(filter-out hppa% hp hpux
*** 1009,1014 ****
--- 865,871 ----
    system.ads<system-hpux.ads
  
    TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-hpux.adb
+   EH_MECHANISM=-gcc
    TGT_LIB = /usr/lib/libcl.a
    THREADSLIB = -lpthread
    GMEM_LIB = gmemlib
*************** ifeq ($(strip $(filter-out hppa% hp hpux
*** 1017,1043 ****
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
    GNATLIB_SHARED = gnatlib-shared-dual
    LIBRARY_VERSION := $(LIB_VERSION)
- 
-   ifeq ($(strip $(filter-out dce DCE,$(THREAD_KIND))),)
-     LIBGNAT_TARGET_PAIRS = \
-     a-excpol.adb<a-excpol-abort.adb \
-     a-intnam.ads<a-intnam-hpux.ads \
-     s-inmaop.adb<s-inmaop-posix.adb \
-     s-interr.adb<s-interr-sigaction.adb \
-     s-intman.adb<s-intman-posix.adb \
-     s-osinte.adb<s-osinte-hpux-dce.adb \
-     s-osinte.ads<s-osinte-hpux-dce.ads \
-     s-parame.ads<s-parame-hpux.ads \
-     s-osprim.adb<s-osprim-posix.adb \
-     s-taprop.adb<s-taprop-hpux-dce.adb \
-     s-taspri.ads<s-taspri-hpux-dce.ads \
-     s-tpopsp.adb<s-tpopsp-posix.adb \
-     g-soccon.ads<g-soccon-hpux.ads \
-     system.ads<system-hpux.ads
- 
-     TGT_LIB =
-     THREADSLIB = -lcma
-   endif
  endif
  
  ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
--- 874,879 ----
*************** ifeq ($(strip $(filter-out ibm aix%,$(ma
*** 1057,1079 ****
    THREADSLIB = -lpthreads
    PREFIX_OBJS=$(PREFIX_REAL_OBJS)
  
-   ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
-     LIBGNAT_TARGET_PAIRS = \
-     a-intnam.ads<a-intnam-aix.ads \
-     s-inmaop.adb<s-inmaop-posix.adb \
-     s-intman.adb<s-intman-posix.adb \
-     s-osinte.adb<s-osinte-fsu.adb \
-     s-osinte.ads<s-osinte-aix-fsu.ads \
-     s-osprim.adb<s-osprim-posix.adb \
-     s-taprop.adb<s-taprop-posix.adb \
-     s-taspri.ads<s-taspri-posix.ads \
-     s-tpopsp.adb<s-tpopsp-posix.adb \
-     g-soccon.ads<g-soccon-aix.ads \
-     system.ads<system-aix.ads
- 
-     THREADSLIB = -lgthreads -lmalloc
-   endif
- 
    TOOLS_TARGET_PAIRS = \
    mlib-tgt.adb<mlib-tgt-aix.adb \
    indepsw.adb<indepsw-aix.adb
--- 893,898 ----
*************** ifeq ($(strip $(filter-out ibm aix%,$(ma
*** 1082,1095 ****
  endif
  
  ifeq ($(strip $(filter-out lynxos,$(osys))),)
!   TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-lynxos.adb 
  
    ifeq ($(strip $(filter-out %86 lynxos,$(arch) $(osys))),)
      LIBGNAT_TARGET_PAIRS = \
      a-numaux.adb<a-numaux-x86.adb \
      a-numaux.ads<a-numaux-x86.ads \
      a-intnam.ads<a-intnam-lynxos.ads \
-     s-mastop.adb<s-mastop-x86.adb \
      s-inmaop.adb<s-inmaop-posix.adb \
      s-intman.adb<s-intman-posix.adb \
      s-osinte.adb<s-osinte-lynxos.adb \
--- 901,915 ----
  endif
  
  ifeq ($(strip $(filter-out lynxos,$(osys))),)
!   TOOLS_TARGET_PAIRS = \
!   mlib-tgt.adb<mlib-tgt-lynxos.adb \
!   indepsw.adb<indepsw-gnu.adb
  
    ifeq ($(strip $(filter-out %86 lynxos,$(arch) $(osys))),)
      LIBGNAT_TARGET_PAIRS = \
      a-numaux.adb<a-numaux-x86.adb \
      a-numaux.ads<a-numaux-x86.ads \
      a-intnam.ads<a-intnam-lynxos.ads \
      s-inmaop.adb<s-inmaop-posix.adb \
      s-intman.adb<s-intman-posix.adb \
      s-osinte.adb<s-osinte-lynxos.adb \
*************** ifeq ($(strip $(filter-out lynxos,$(osys
*** 1107,1133 ****
      a-intnam.ads<a-intnam-lynxos.ads \
      s-inmaop.adb<s-inmaop-posix.adb \
      s-intman.adb<s-intman-posix.adb \
!     s-osinte.adb<s-osinte-lynxos-3.adb \
!     s-osinte.ads<s-osinte-lynxos-3.ads \
      s-osprim.adb<s-osprim-posix.adb \
!     s-taprop.adb<s-taprop-posix.adb \
!     s-taspri.ads<s-taspri-posix.ads \
!     s-tpopsp.adb<s-tpopsp-posix.adb \
      system.ads<system-lynxos-ppc.ads
- 
-     ifeq ($(strip $(filter-out pthread PTHREAD,$(THREAD_KIND))),)
-       LIBGNAT_TARGET_PAIRS = \
-       a-intnam.ads<a-intnam-lynxos.ads \
-       s-inmaop.adb<s-inmaop-posix.adb \
-       s-intman.adb<s-intman-posix.adb \
-       s-osinte.adb<s-osinte-lynxos.adb \
-       s-osinte.ads<s-osinte-lynxos.ads \
-       s-osprim.adb<s-osprim-posix.adb \
-       s-taprop.adb<s-taprop-lynxos.adb \
-       s-taspri.ads<s-taspri-lynxos.ads \
-       s-tpopsp.adb<s-tpopsp-lynxos.adb \
-       system.ads<system-lynxos-ppc.ads
-     endif
    endif
  endif
  
--- 927,939 ----
      a-intnam.ads<a-intnam-lynxos.ads \
      s-inmaop.adb<s-inmaop-posix.adb \
      s-intman.adb<s-intman-posix.adb \
!     s-osinte.adb<s-osinte-lynxos.adb \
!     s-osinte.ads<s-osinte-lynxos.ads \
      s-osprim.adb<s-osprim-posix.adb \
!     s-taprop.adb<s-taprop-lynxos.adb \
!     s-taspri.ads<s-taspri-lynxos.ads \
!     s-tpopsp.adb<s-tpopsp-lynxos.adb \
      system.ads<system-lynxos-ppc.ads
    endif
  endif
  
*************** ifeq ($(strip $(filter-out rtems%,$(osys
*** 1142,1147 ****
--- 948,955 ----
    s-parame.adb<s-parame-rtems.adb \
    s-taprop.adb<s-taprop-posix.adb \
    s-taspri.ads<s-taspri-posix.ads \
+   s-auxdec.ads<s-auxdec-empty.ads \
+   s-auxdec.adb<s-auxdec-empty.adb \
    s-tpopsp.adb<s-tpopsp-rtems.adb
  endif
  
*************** ifeq ($(strip $(filter-out alpha% dec os
*** 1164,1169 ****
--- 972,978 ----
  
    TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-tru64.adb
  
+   EH_MECHANISM=-gcc
    GMEM_LIB=gmemlib
    THREADSLIB = -lpthread -lmach -lexc -lrt
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
*************** ifeq ($(strip $(filter-out alpha% dec os
*** 1171,1212 ****
    LIBRARY_VERSION := $(LIB_VERSION)
  endif
  
! ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(host))),)
  
  soext  = .exe
  hyphen = _
  LN = cp -p
  LN_S = cp -p
  
- ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
- AR = iar
- endif
- 
  .SUFFIXES: .sym
  
  .o.sym: 
  	@ gnu:[bin]vmssymvec $<
  endif
  
! ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),)
  ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
    LIBGNAT_TARGET_PAIRS_AUX1 = \
    g-enblsp.adb<g-enblsp-vms-ia64.adb \
    s-auxdec.ads<s-auxdec-vms_64.ads \
!   s-crtl.ads<s-crtl-vms.ads \
    s-osinte.adb<s-osinte-vms-ia64.adb \
    s-osinte.ads<s-osinte-vms-ia64.ads \
    system.ads<system-vms_64.ads
  else
! ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(targ))),)
    LIBGNAT_TARGET_PAIRS_AUX1 = \
    g-enblsp.adb<g-enblsp-vms-alpha.adb \
    s-asthan.adb<s-asthan-vms-alpha.adb \
!   s-crtl.ads<s-crtl-vms.ads \
    s-osinte.adb<s-osinte-vms.adb \
    s-osinte.ads<s-osinte-vms.ads \
    s-vaflop.adb<s-vaflop-vms-alpha.adb \
!   system.ads<system-vms-zcx.ads
  endif
  endif
  ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),)
--- 980,1021 ----
    LIBRARY_VERSION := $(LIB_VERSION)
  endif
  
! ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(host))),)
  
  soext  = .exe
  hyphen = _
  LN = cp -p
  LN_S = cp -p
  
  .SUFFIXES: .sym
  
  .o.sym: 
  	@ gnu:[bin]vmssymvec $<
  endif
  
! ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ))),)
  ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
    LIBGNAT_TARGET_PAIRS_AUX1 = \
    g-enblsp.adb<g-enblsp-vms-ia64.adb \
+   g-trasym.adb<g-trasym-vms-ia64.adb \
    s-auxdec.ads<s-auxdec-vms_64.ads \
!   s-crtl.ads<s-crtl-vms64.ads \
    s-osinte.adb<s-osinte-vms-ia64.adb \
    s-osinte.ads<s-osinte-vms-ia64.ads \
+   s-vaflop.adb<s-vaflop-vms-ia64.adb \
    system.ads<system-vms_64.ads
  else
! ifeq ($(strip $(filter-out alpha64 dec vms% openvms% alphavms%,$(targ))),)
    LIBGNAT_TARGET_PAIRS_AUX1 = \
    g-enblsp.adb<g-enblsp-vms-alpha.adb \
+   g-trasym.adb<g-trasym-vms-alpha.adb \
    s-asthan.adb<s-asthan-vms-alpha.adb \
!   s-auxdec.ads<s-auxdec-vms_64.ads \
!   s-crtl.ads<s-crtl-vms64.ads \
    s-osinte.adb<s-osinte-vms.adb \
    s-osinte.ads<s-osinte-vms.ads \
    s-vaflop.adb<s-vaflop-vms-alpha.adb \
!   system.ads<system-vms_64.ads
  endif
  endif
  ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),)
*************** endif
*** 1226,1238 ****
    a-intnam.ads<a-intnam-vms.ads \
    a-numaux.ads<a-numaux-vms.ads \
    g-expect.adb<g-expect-vms.adb \
!   g-soccon.ads<g-soccon-vms.adb \
    g-socthi.ads<g-socthi-vms.ads \
    g-socthi.adb<g-socthi-vms.adb \
-   g-trasym.adb<g-trasym-vms.adb \
    i-cstrea.adb<i-cstrea-vms.adb \
-   i-cpp.adb<i-cpp-vms.adb \
-   interfac.ads<interfac-vms.ads \
    s-inmaop.adb<s-inmaop-vms.adb \
    s-interr.adb<s-interr-vms.adb \
    s-intman.adb<s-intman-vms.adb \
--- 1035,1044 ----
    a-intnam.ads<a-intnam-vms.ads \
    a-numaux.ads<a-numaux-vms.ads \
    g-expect.adb<g-expect-vms.adb \
!   g-soccon.ads<g-soccon-vms.ads \
    g-socthi.ads<g-socthi-vms.ads \
    g-socthi.adb<g-socthi-vms.adb \
    i-cstrea.adb<i-cstrea-vms.adb \
    s-inmaop.adb<s-inmaop-vms.adb \
    s-interr.adb<s-interr-vms.adb \
    s-intman.adb<s-intman-vms.adb \
*************** endif
*** 1252,1273 ****
  ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
    TOOLS_TARGET_PAIRS= \
    mlib-tgt.adb<mlib-tgt-vms-ia64.adb \
!   symbols.adb<symbols-vms-ia64.adb
  else
    TOOLS_TARGET_PAIRS= \
    mlib-tgt.adb<mlib-tgt-vms-alpha.adb \
!   symbols.adb<symbols-vms-alpha.adb
  endif
  
    GNATLIB_SHARED=gnatlib-shared-vms
! ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(targ))),)
    EXTRA_LIBGNAT_SRCS=vmshandler.asm
    EXTRA_LIBGNAT_OBJS=vmshandler.o
  endif
    EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o
    EXTRA_GNATTOOLS = \
!      ../../gnatlbr$(exeext) \
!      ../../gnatsym$(exeext)
    # This command transforms (YYYYMMDD) into YY,MMDD
    GSMATCH_VERSION := $(shell grep "^ *Gnat_Static_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
    TOOLS_LIBS_LO := --for-linker=sys\\$$\$$library:trace.exe
--- 1058,1084 ----
  ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
    TOOLS_TARGET_PAIRS= \
    mlib-tgt.adb<mlib-tgt-vms-ia64.adb \
!   symbols.adb<symbols-vms.adb \
!   symbols-processing.adb<symbols-processing-vms-ia64.adb
  else
    TOOLS_TARGET_PAIRS= \
    mlib-tgt.adb<mlib-tgt-vms-alpha.adb \
!   symbols.adb<symbols-vms.adb \
!   symbols-processing.adb<symbols-processing-vms-alpha.adb
  endif
  
+   EH_MECHANISM=-gcc
    GNATLIB_SHARED=gnatlib-shared-vms
! ifeq ($(strip $(filter-out alpha64 dec vms% openvms% alphavms%,$(targ))),)
    EXTRA_LIBGNAT_SRCS=vmshandler.asm
    EXTRA_LIBGNAT_OBJS=vmshandler.o
  endif
    EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o
    EXTRA_GNATTOOLS = \
!      ../../gnatlbr$(exeext)  \
!      ../../gnatsym$(exeext)  \
!      ../../vms_help$(exeext) \
!      ../../gnat.hlp
    # This command transforms (YYYYMMDD) into YY,MMDD
    GSMATCH_VERSION := $(shell grep "^ *Gnat_Static_Version_String" $(fsrcpfx)gnatvsn.ads | sed -e 's/.*(\(.*\)).*/\1/' -e 's/\(..\)\(..\)\(....\)/\2,\3/')
    TOOLS_LIBS_LO := --for-linker=sys\\$$\$$library:trace.exe
*************** ifeq ($(strip $(filter-out cygwin32% min
*** 1286,1292 ****
    s-inmaop.adb<s-inmaop-dummy.adb \
    s-interr.adb<s-interr-sigaction.adb \
    s-intman.adb<s-intman-mingw.adb \
-   s-mastop.adb<s-mastop-x86.adb \
    s-memory.adb<s-memory-mingw.adb \
    s-osinte.ads<s-osinte-mingw.ads \
    s-osprim.adb<s-osprim-mingw.adb \
--- 1097,1102 ----
*************** ifeq ($(strip $(filter-out cygwin32% min
*** 1303,1308 ****
--- 1113,1119 ----
    mlib-tgt.adb<mlib-tgt-mingw.adb \
    indepsw.adb<indepsw-mingw.adb
  
+   EH_MECHANISM=-gcc
    MISCLIB = -lwsock32
    GMEM_LIB = gmemlib
    PREFIX_OBJS = $(PREFIX_REAL_OBJS)
*************** endif
*** 1319,1339 ****
  ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-linux.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
    s-osinte.adb<s-osinte-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-ppc.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
--- 1130,1152 ----
  ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-linux.ads \
+   g-soccon.ads<g-soccon-linux-ppc.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
    s-osinte.adb<s-osinte-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-ppc.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
*************** ifeq ($(strip $(filter-out sparc% linux%
*** 1350,1364 ****
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-sparc.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
--- 1163,1178 ----
    s-osinte.ads<s-osinte-linux.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-sparc.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
*************** ifeq ($(strip $(filter-out hppa% linux%,
*** 1375,1389 ****
    s-osinte.ads<s-osinte-linux-hppa.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-hppa.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
--- 1189,1204 ----
    s-osinte.ads<s-osinte-linux-hppa.ads \
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
    s-parame.adb<s-parame-linux.adb \
    system.ads<system-linux-hppa.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    THREADSLIB = -lpthread
    GNATLIB_SHARED = gnatlib-shared-dual
    GMEM_LIB = gmemlib
*************** ifeq ($(strip $(filter-out %ia64 linux%,
*** 1395,1400 ****
--- 1210,1216 ----
    LIBGNAT_TARGET_PAIRS = \
    a-intnam.ads<a-intnam-linux.ads \
    a-numaux.ads<a-numaux-libc-x86.ads \
+   g-soccon.ads<g-soccon-linux-64.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
*************** ifeq ($(strip $(filter-out %ia64 linux%,
*** 1402,1417 ****
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    system.ads<system-linux-ia64.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    MISCLIB=
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
    PREFIX_OBJS=$(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
  endif
--- 1218,1235 ----
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    system.ads<system-linux-ia64.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    MISCLIB=
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
+   GMEM_LIB = gmemlib
    PREFIX_OBJS=$(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
  endif
*************** ifeq ($(strip $(filter-out alpha% linux%
*** 1426,1438 ****
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    system.ads<system-linux-alpha.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-linux.adb
  
    MISCLIB=
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
--- 1244,1257 ----
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    system.ads<system-linux-alpha.ads
  
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
  
+   EH_MECHANISM=-gcc
    MISCLIB=
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
*************** ifeq ($(strip $(filter-out %x86_64 linux
*** 1445,1450 ****
--- 1264,1270 ----
    a-intnam.ads<a-intnam-linux.ads \
    a-numaux.adb<a-numaux-x86.adb \
    a-numaux.ads<a-numaux-x86.ads \
+   g-soccon.ads<g-soccon-linux-64.ads \
    s-inmaop.adb<s-inmaop-posix.adb \
    s-intman.adb<s-intman-posix.adb \
    s-osinte.ads<s-osinte-linux.ads \
*************** ifeq ($(strip $(filter-out %x86_64 linux
*** 1452,1461 ****
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-linux.ads \
    system.ads<system-linux-x86_64.ads
  
!   TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-linux.adb
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
    GMEM_LIB = gmemlib
--- 1272,1285 ----
    s-osprim.adb<s-osprim-posix.adb \
    s-taprop.adb<s-taprop-linux.adb \
    s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
!   s-taspri.ads<s-taspri-posix.ads \
    system.ads<system-linux-x86_64.ads
  
!   TOOLS_TARGET_PAIRS =  \
!     mlib-tgt.adb<mlib-tgt-linux.adb \
!     indepsw.adb<indepsw-gnu.adb
! 
!   EH_MECHANISM=-gcc
    THREADSLIB=-lpthread
    GNATLIB_SHARED=gnatlib-shared-dual
    GMEM_LIB = gmemlib
*************** ifeq ($(strip $(filter-out powerpc darwi
*** 1482,1496 ****
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-darwin.adb
  
    GNATLIB_SHARED = gnatlib-shared-darwin
!   SO_OPTS = -Wl,-flat_namespace
    RANLIB = ranlib -c
    GMEM_LIB = gmemlib
! 
    LIBRARY_VERSION := $(LIB_VERSION)
    soext = .dylib
  endif
  
  # The runtime library for gnat comprises two directories.  One contains the
  # Ada source files that the compiler (gnat1) needs -- these files are listed
  # by ADA_INCLUDE_SRCS -- and the other contains the object files and their
--- 1306,1327 ----
    TOOLS_TARGET_PAIRS =  \
      mlib-tgt.adb<mlib-tgt-darwin.adb
  
+   EH_MECHANISM=-gcc
    GNATLIB_SHARED = gnatlib-shared-darwin
!   SO_OPTS = -Wl,-flat_namespace -shared-libgcc
    RANLIB = ranlib -c
    GMEM_LIB = gmemlib
!   PREFIX_OBJS=$(PREFIX_REAL_OBJS)
    LIBRARY_VERSION := $(LIB_VERSION)
    soext = .dylib
  endif
  
+ ifneq ($(EH_MECHANISM),)
+   LIBGNAT_TARGET_PAIRS += a-exexpr.adb<a-exexpr$(EH_MECHANISM).adb
+   EXTRA_LIBGNAT_SRCS+=raise$(EH_MECHANISM).c
+   EXTRA_LIBGNAT_OBJS+=raise$(EH_MECHANISM).o
+ endif
+ 
  # The runtime library for gnat comprises two directories.  One contains the
  # Ada source files that the compiler (gnat1) needs -- these files are listed
  # by ADA_INCLUDE_SRCS -- and the other contains the object files and their
*************** endif
*** 1502,1514 ****
  # subdirectory and copied.
  LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
    errno.c exit.c cal.c ctrl_c.c \
!   raise.h raise.c sysdep.c aux-io.c init.c seh_init.c \
    final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c gsocket.h \
    $(EXTRA_LIBGNAT_SRCS)
  
  LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \
!   raise.o sysdep.o aux-io.o init.o seh_init.o cal.o final.o \
!   tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS)
  
  # NOTE ??? - when the -I option for compiling Ada code is made to work,
  #  the library installation will change and there will be a
--- 1333,1345 ----
  # subdirectory and copied.
  LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
    errno.c exit.c cal.c ctrl_c.c \
!   raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \
    final.c tracebak.c tb-alvms.c tb-alvxw.c expect.c mkdir.c socket.c gsocket.h \
    $(EXTRA_LIBGNAT_SRCS)
  
  LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \
!   raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o \
!   final.o tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS)
  
  # NOTE ??? - when the -I option for compiling Ada code is made to work,
  #  the library installation will change and there will be a
*************** GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS
*** 1528,1571 ****
  ADA_INCLUDE_SRCS =\
   ada.ads calendar.ads directio.ads gnat.ads interfac.ads ioexcept.ads \
   machcode.ads text_io.ads unchconv.ads unchdeal.ads \
!  sequenio.ads system.ads Makefile.adalib memtrack.adb \
!  a-*.adb a-*.ads g-*.ad? i-*.ad? \
!  s-[a-o]*.adb s-[p-z]*.adb \
!  s-[a-o]*.ads s-[p-z]*.ads
  
  LIBGNAT=../rts/libgnat.a 
! TOOLS_FLAGS_TO_PASS=		\
!         "CC=$(CC)" 		\
!         "CFLAGS=$(CFLAGS)"	\
! 	"LDFLAGS=$(LDFLAGS)"	\
!         "ADAFLAGS=$(ADAFLAGS)"	\
!         "INCLUDES=$(INCLUDES_FOR_SUBDIR)"\
! 	"ADA_INCLUDES=$(ADA_INCLUDES) $(ADA_INCLUDES_FOR_SUBDIR)"\
! 	"libsubdir=$(libsubdir)"	\
! 	"exeext=$(exeext)"	\
! 	"fsrcdir=$(fsrcdir)"	\
! 	"srcdir=$(fsrcdir)"	\
!         "TOOLS_LIBS=$(TOOLS_LIBS) $(TGT_LIB)"	\
! 	"GNATMAKE=$(GNATMAKE)"	\
! 	"GNATLINK=$(GNATLINK)"	\
! 	"GNATBIND=$(GNATBIND)"
! 
! GCC_LINK="$(CC) -static-libgcc $(ADA_INCLUDES)"
! 
! # Build directory for the tools. Let's copy the target-dependent
! # sources using the same mechanism as for gnatlib. The other sources are 
! # accessed using the vpath directive below
! 
! ../stamp-tools:
! 	-$(RM) tools/*
! 	-$(RMDIR) tools
! 	-$(MKDIR) tools
! 	-(cd tools; $(LN_S) ../sdefault.adb .)
! 	-$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \
! 	          $(RM) tools/$(word 1,$(subst <, ,$(PAIR)));\
! 	          $(LN_S) $(fsrcdir)/$(word 2,$(subst <, ,$(PAIR))) \
! 	                tools/$(word 1,$(subst <, ,$(PAIR)));)
! 	touch ../stamp-tools
  
  # when compiling the tools, the runtime has to be first on the path so that
  # it hides the runtime files lying with the rest of the sources
--- 1359,1370 ----
  ADA_INCLUDE_SRCS =\
   ada.ads calendar.ads directio.ads gnat.ads interfac.ads ioexcept.ads \
   machcode.ads text_io.ads unchconv.ads unchdeal.ads \
!  sequenio.ads system.ads memtrack.adb \
!  a-[a-o]*.adb a-[p-z]*.adb a-[a-o]*.ads a-[p-z]*.ads g-*.ad? i-*.ad? \
!  s-[a-o]*.adb s-[p-z]*.adb s-[a-o]*.ads s-[p-z]*.ads  
  
  LIBGNAT=../rts/libgnat.a 
! GCC_LINK=$(CC) -static-libgcc $(ADA_INCLUDES)
  
  # when compiling the tools, the runtime has to be first on the path so that
  # it hides the runtime files lying with the rest of the sources
*************** ifeq ($(TOOLSCASE),cross)
*** 1585,1710 ****
    vpath %.h   ../
  endif
  
- # gnatmake/link tools cannot always be built with gnatmake/link for bootstrap 
- # reasons: gnatmake should be built with a recent compiler, a recent compiler
- # may not generate ALI files compatible with an old gnatmake so it is important
- # to be able to build gnatmake without a version of gnatmake around. Once 
- # everything has been compiled once, gnatmake can be recompiled with itself 
- # (see target gnattools1-re) 
- gnattools1: ../stamp-tools ../stamp-gnatlib
- 	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
- 	  TOOLSCASE=native \
- 	  ../../gnatmake$(exeext) ../../gnatlink$(exeext) ../../gnatbl$(exeext)
- 
- # gnatmake/link can be built with recent gnatmake/link if they are available.
- # This is especially convenient for building cross tools or for rebuilding
- # the tools when the original bootstrap has already be done.
- gnattools1-re: ../stamp-tools
- 	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
- 	  TOOLSCASE=cross INCLUDES="" gnatmake-re gnatlink-re
- 
- # these tools are built with gnatmake & are common to native and cross
- gnattools2: ../stamp-tools
- 	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
- 	  TOOLSCASE=native \
- 	  ../../gnatchop$(exeext) ../../gnat$(exeext) ../../gnatkr$(exeext) \
- 	  ../../gnatls$(exeext) ../../gnatprep$(exeext) \
- 	  ../../gnatxref$(exeext) \
- 	  ../../gnatfind$(exeext) ../../gnatname$(exeext) \
- 	  ../../gnatclean$(exeext) ../../gprmake$(exeext)
- 
- # These tools are only built for the native version.
- gnattools3: ../stamp-tools
- ifneq ($(EXTRA_GNATTOOLS),)
- 	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
- 	  TOOLSCASE=native top_builddir=../../.. $(EXTRA_GNATTOOLS)
- endif
- 
- # those tools are only built for the cross version
- gnattools4: ../stamp-tools
- 	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
- 	  TOOLSCASE=cross top_buildir=../../.. \
-            ../../vxaddr2line$(exeext)
  
! ../../gnatchop$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatchop --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatchop 
! 	$(GNATLINK) -v gnatchop -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnat$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatcmd --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatcmd 
! 	$(GNATLINK) -v gnatcmd -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatkr$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatkr --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatkr 
! 	$(GNATLINK) -v gnatkr -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatls$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatls --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatls 
! 	$(GNATLINK) -v gnatls -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatname$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatname --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatname 
! 	$(GNATLINK) -v gnatname -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gprmake$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gprmake --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gprmake
! 	$(GNATLINK) -v gprmake -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatprep$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatprep --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatprep 
! 	$(GNATLINK) -v gnatprep -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatxref$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatxref --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatxref 
! 	$(GNATLINK) -v gnatxref -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatfind$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatfind --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatfind 
! 	$(GNATLINK) -v gnatfind -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatclean$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatclean --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatclean
! 	$(GNATLINK) -v gnatclean -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatsym$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatsym --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatsym
! 	$(GNATLINK) -v gnatsym -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../gnatdll$(exeext): ../stamp-tools
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatdll --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) $(GNATBIND_FLAGS) gnatdll
! 	$(GNATLINK) -v gnatdll -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
! ../../vxaddr2line$(exeext): ../stamp-tools
  	$(GNATMAKE) -c  $(ADA_INCLUDES) vxaddr2line --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line 
! 	$(GNATLINK) -v vxaddr2line -o $@ --GCC=$(GCC_LINK) $(CLIB)
  
! gnatmake-re: ../stamp-tools link.o
  	$(GNATMAKE) $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)"
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatmake 
  	$(GNATLINK) -v gnatmake -o ../../gnatmake$(exeext) \
! 		--GCC=$(GCC_LINK) $(TOOLS_LIBS)
  
  # Note the use of the "mv" command in order to allow gnatlink to be linked with
  # with the former version of gnatlink itself which cannot override itself.
! gnatlink-re: ../stamp-tools link.o
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatlink --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlink 
  	$(GNATLINK) -v gnatlink -o ../../gnatlinknew$(exeext) \
! 		    --GCC=$(GCC_LINK) $(TOOLS_LIBS)
  	$(MV)  ../../gnatlinknew$(exeext)  ../../gnatlink$(exeext)
    
  # Needs to be built with CC=gcc
--- 1384,1469 ----
    vpath %.h   ../
  endif
  
  
! ../../gnatchop$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatchop --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatchop 
! 	$(GNATLINK) -v gnatchop -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnat$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatcmd --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatcmd 
! 	$(GNATLINK) -v gnatcmd -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatkr$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatkr --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatkr 
! 	$(GNATLINK) -v gnatkr -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatls$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatls --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatls 
! 	$(GNATLINK) -v gnatls -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatname$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatname --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatname 
! 	$(GNATLINK) -v gnatname -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gprmake$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gprmake --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gprmake
! 	$(GNATLINK) -v gprmake -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatprep$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatprep --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatprep 
! 	$(GNATLINK) -v gnatprep -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatxref$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatxref --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatxref 
! 	$(GNATLINK) -v gnatxref -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatfind$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatfind --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatfind 
! 	$(GNATLINK) -v gnatfind -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatclean$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatclean --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatclean
! 	$(GNATLINK) -v gnatclean -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatsym$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatsym --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatsym
! 	$(GNATLINK) -v gnatsym -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../gnatdll$(exeext): 
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatdll --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) $(GNATBIND_FLAGS) gnatdll
! 	$(GNATLINK) -v gnatdll -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
! ../../vxaddr2line$(exeext): 
  	$(GNATMAKE) -c  $(ADA_INCLUDES) vxaddr2line --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxaddr2line 
! 	$(GNATLINK) -v vxaddr2line -o $@ --GCC="$(GCC_LINK)" $(CLIB)
  
! gnatmake-re:  link.o
  	$(GNATMAKE) $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)"
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatmake 
  	$(GNATLINK) -v gnatmake -o ../../gnatmake$(exeext) \
! 		--GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  
  # Note the use of the "mv" command in order to allow gnatlink to be linked with
  # with the former version of gnatlink itself which cannot override itself.
! gnatlink-re:  link.o
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatlink --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlink 
  	$(GNATLINK) -v gnatlink -o ../../gnatlinknew$(exeext) \
! 		    --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
  	$(MV)  ../../gnatlinknew$(exeext)  ../../gnatlink$(exeext)
    
  # Needs to be built with CC=gcc
*************** gnatlink-re: ../stamp-tools link.o
*** 1713,1727 ****
  
  # Likewise for the tools
  ../../gnatmake$(exeext): $(P) b_gnatm.o link.o $(GNATMAKE_OBJS)
! 	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatm.o $(GNATMAKE_OBJS) \
! 	      $(TOOLS_LIBS)
  
  ../../gnatlink$(exeext): $(P) b_gnatl.o link.o $(GNATLINK_OBJS)
! 	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatl.o $(GNATLINK_OBJS) \
! 	      $(TOOLS_LIBS)
  
  ../../gnatbl$(exeext): gnatbl.o
! 	$(CC) -o $@ $(ALL_CFLAGS) $(LDFLAGS) gnatbl.o $(TOOLS_LIBS)
  
  gnatbl.o: gnatbl.c adaint.h
  	$(CC) $(ALL_CFLAGS) $(INCLUDES) -c $< $(OUTPUT_OPTION)
--- 1472,1486 ----
  
  # Likewise for the tools
  ../../gnatmake$(exeext): $(P) b_gnatm.o link.o $(GNATMAKE_OBJS)
! 	$(GCC_LINK) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatm.o $(GNATMAKE_OBJS) \
! 		    $(TOOLS_LIBS)
  
  ../../gnatlink$(exeext): $(P) b_gnatl.o link.o $(GNATLINK_OBJS)
! 	$(GCC_LINK) $(ALL_CFLAGS) $(LDFLAGS) -o $@ b_gnatl.o $(GNATLINK_OBJS) \
! 		    $(TOOLS_LIBS)
  
  ../../gnatbl$(exeext): gnatbl.o
! 	$(GCC_LINK) -o $@ $(ALL_CFLAGS) $(LDFLAGS) gnatbl.o $(TOOLS_LIBS)
  
  gnatbl.o: gnatbl.c adaint.h
  	$(CC) $(ALL_CFLAGS) $(INCLUDES) -c $< $(OUTPUT_OPTION)
*************** install-gnatlib: ../stamp-gnatlib
*** 1751,1757 ****
  	-$(INSTALL_DATA) rts/g-trasym$(objext) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
  	-cd rts; for file in *$(arext);do \
  	    $(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
! 	    $(RANLIB) $(RANLIB_FLAGS) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \
  	done
  	-$(foreach file, $(EXTRA_ADALIB_FILES), \
  	    $(INSTALL_DATA_DATE) rts/$(file) $(DESTDIR)$(ADA_RTL_OBJ_DIR) && \
--- 1510,1516 ----
  	-$(INSTALL_DATA) rts/g-trasym$(objext) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
  	-cd rts; for file in *$(arext);do \
  	    $(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
! 	    $(RANLIB_FOR_TARGET) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \
  	done
  	-$(foreach file, $(EXTRA_ADALIB_FILES), \
  	    $(INSTALL_DATA_DATE) rts/$(file) $(DESTDIR)$(ADA_RTL_OBJ_DIR) && \
*************** install-gnatlib: ../stamp-gnatlib
*** 1824,1836 ****
  # Example: cd rts; ar rc libfoo.a $(LONG_LIST_OF_OBJS)
  # is guaranteed to overflow the buffer.
  
  gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2
! 	$(MAKE) -C rts CC="../../xgcc -B../../" \
  	        INCLUDES="$(INCLUDES_FOR_SUBDIR) -I./../.." \
                  CFLAGS="$(GNATLIBCFLAGS_FOR_C)" \
  		srcdir=$(fsrcdir) \
  	        -f ../Makefile $(LIBGNAT_OBJS)
! 	$(MAKE) -C rts CC="../../xgcc -B../../" \
  	        ADA_INCLUDES="" \
                  CFLAGS="$(GNATLIBCFLAGS)" \
  	        ADAFLAGS="$(GNATLIBFLAGS)" \
--- 1583,1604 ----
  # Example: cd rts; ar rc libfoo.a $(LONG_LIST_OF_OBJS)
  # is guaranteed to overflow the buffer.
  
+ # ??? GCC_FOR_TARGET is supposed to be passed from the top level
+ # Makefile, but this is not the case from e.g. libada, so provide a suitable
+ # default
+ GCC_FOR_TARGET=./xgcc -B./ $(FLAGS_FOR_TARGET)
+ 
  gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2
! 	$(MAKE) -C rts \
! 		CC="`echo \"$(GCC_FOR_TARGET)\" \
! 		| sed -e 's,^\./xgcc,../../xgcc,' -e 's,-B\./,-B../../,'`" \
  	        INCLUDES="$(INCLUDES_FOR_SUBDIR) -I./../.." \
                  CFLAGS="$(GNATLIBCFLAGS_FOR_C)" \
  		srcdir=$(fsrcdir) \
  	        -f ../Makefile $(LIBGNAT_OBJS)
! 	$(MAKE) -C rts \
! 		CC="`echo \"$(GCC_FOR_TARGET)\" \
! 		| sed -e 's,^\./xgcc,../../xgcc,' -e 's,-B\./,-B../../,'`" \
  	        ADA_INCLUDES="" \
                  CFLAGS="$(GNATLIBCFLAGS)" \
  	        ADAFLAGS="$(GNATLIBFLAGS)" \
*************** gnatlib: ../stamp-gnatlib1 ../stamp-gnat
*** 1838,1855 ****
  	        -f ../Makefile \
  	        $(GNATRTL_OBJS)
  	$(RM) rts/libgnat$(arext) rts/libgnarl$(arext)
! 	$(AR) $(AR_FLAGS) rts/libgnat$(arext) \
  	   $(addprefix rts/,$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS))
          ifneq ($(PREFIX_OBJS),)
! 		$(AR) $(AR_FLAGS) rts/libgccprefix$(arext) $(PREFIX_OBJS);
          endif
! 	-$(RANLIB) $(RANLIB_FLAGS) rts/libgnat$(arext)
! 	$(AR) $(AR_FLAGS) rts/libgnarl$(arext) \
  	   $(addprefix rts/,$(GNATRTL_TASKING_OBJS))
! 	-$(RANLIB) $(RANLIB_FLAGS) rts/libgnarl$(arext)
          ifeq ($(GMEM_LIB),gmemlib)
! 		$(AR) $(AR_FLAGS) rts/libgmem$(arext) rts/memtrack.o
! 		-$(RANLIB) $(RANLIB_FLAGS) rts/libgmem$(arext)
          endif
  	$(CHMOD) a-wx rts/*.ali
  	touch ../stamp-gnatlib
--- 1606,1626 ----
  	        -f ../Makefile \
  	        $(GNATRTL_OBJS)
  	$(RM) rts/libgnat$(arext) rts/libgnarl$(arext)
! 	$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnat$(arext) \
  	   $(addprefix rts/,$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS))
          ifneq ($(PREFIX_OBJS),)
! 		$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgccprefix$(arext) \
! 		  $(PREFIX_OBJS);
! 		$(RANLIB_FOR_TARGET) rts/libgccprefix$(arext)
          endif
! 	$(RANLIB_FOR_TARGET) rts/libgnat$(arext)
! 	$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnarl$(arext) \
  	   $(addprefix rts/,$(GNATRTL_TASKING_OBJS))
! 	$(RANLIB_FOR_TARGET) rts/libgnarl$(arext)
          ifeq ($(GMEM_LIB),gmemlib)
! 		$(AR_FOR_TARGET) $(AR_FLAGS) rts/libgmem$(arext) \
! 		  rts/memtrack.o
! 		$(RANLIB_FOR_TARGET) rts/libgmem$(arext)
          endif
  	$(CHMOD) a-wx rts/*.ali
  	touch ../stamp-gnatlib
*************** gnatlib-shared-default:
*** 1862,1873 ****
  	     THREAD_KIND="$(THREAD_KIND)" \
               gnatlib
  	$(RM) rts/libgna*$(soext)
! 	cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
  		-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
  		$(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(MISCLIB) -lm
! 	cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
  		-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(GNATRTL_TASKING_OBJS) \
  		$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
--- 1633,1646 ----
  	     THREAD_KIND="$(THREAD_KIND)" \
               gnatlib
  	$(RM) rts/libgna*$(soext)
! 	cd rts; ../../xgcc -B../../ -shared $(GNATLIBCFLAGS) \
! 		$(TARGET_LIBGCC2_CFLAGS) \
  		-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
  		$(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(MISCLIB) -lm
! 	cd rts; ../../xgcc -B../../ -shared $(GNATLIBCFLAGS) \
! 		$(TARGET_LIBGCC2_CFLAGS) \
  		-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
  		$(GNATRTL_TASKING_OBJS) \
  		$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
*************** gnatlib-shared:
*** 1988,1994 ****
  	     TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
               $(GNATLIB_SHARED)
  
! gnatlib-sjlj: ../stamp-gnatlib1
  	sed -e 's/ZCX_By_Default.*/ZCX_By_Default            : constant Boolean := False;/' rts/system.ads > rts/s.ads
  	$(MV) rts/s.ads rts/system.ads
  	$(MAKE) $(FLAGS_TO_PASS) \
--- 1761,1768 ----
  	     TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
               $(GNATLIB_SHARED)
  
! gnatlib-sjlj:
! 	$(MAKE) $(FLAGS_TO_PASS) EH_MECHANISM="" ../stamp-gnatlib1
  	sed -e 's/ZCX_By_Default.*/ZCX_By_Default            : constant Boolean := False;/' rts/system.ads > rts/s.ads
  	$(MV) rts/s.ads rts/system.ads
  	$(MAKE) $(FLAGS_TO_PASS) \
*************** gnatlib-sjlj: ../stamp-gnatlib1
*** 1997,2003 ****
  	     THREAD_KIND="$(THREAD_KIND)" \
  	     TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" gnatlib
  
! gnatlib-zcx: ../stamp-gnatlib1
  	sed -e 's/ZCX_By_Default.*/ZCX_By_Default            : constant Boolean := True;/' rts/system.ads > rts/s.ads
  	$(MV) rts/s.ads rts/system.ads
  	$(MAKE) $(FLAGS_TO_PASS) \
--- 1771,1778 ----
  	     THREAD_KIND="$(THREAD_KIND)" \
  	     TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" gnatlib
  
! gnatlib-zcx:
! 	$(MAKE) $(FLAGS_TO_PASS) EH_MECHANISM="-gcc" ../stamp-gnatlib1
  	sed -e 's/ZCX_By_Default.*/ZCX_By_Default            : constant Boolean := True;/' rts/system.ads > rts/s.ads
  	$(MV) rts/s.ads rts/system.ads
  	$(MAKE) $(FLAGS_TO_PASS) \
*************** adadecode.o : adadecode.c adadecode.h
*** 2072,2111 ****
  aux-io.o  : aux-io.c
  argv.o    : argv.c
  cal.o     : cal.c
! deftarg.o  : deftarg.c
  errno.o   : errno.c
! exit.o    : raise.h exit.c
  expect.o  : expect.c
! final.o   : raise.h final.c
  gmem.o    : gmem.c
  link.o    : link.c
  mkdir.o   : mkdir.c
  socket.o  : socket.c gsocket.h
  sysdep.o  : sysdep.c
  
  gen-soccon: gen-soccon.c gsocket.h
! 	$(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
! 		$(ALL_CPPFLAGS) $(INCLUDES) -DTARGET=\"$(target_alias)\" \
  		$< $(OUTPUT_OPTION)
  
  cio.o     : cio.c
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  init.o    : init.c ada.h types.h raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  # No optimization to compile this file as optimizations (-O1 or above) breaks
  # the SEH handling on Windows. The reasons are not clear.
  seh_init.o : seh_init.c raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) -O0 \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
- raise.o   : raise.c raise.h
- 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) $(RT_FLAGS) \
- 		 $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
- 
  # Need to keep the frame pointer in this file to pop the stack properly on
  # some targets.
  tracebak.o  : tracebak.c tb-alvms.c tb-alvxw.c
--- 1847,1888 ----
  aux-io.o  : aux-io.c
  argv.o    : argv.c
  cal.o     : cal.c
! deftarg.o : deftarg.c
  errno.o   : errno.c
! exit.o    : adaint.h exit.c
  expect.o  : expect.c
! final.o   : final.c
  gmem.o    : gmem.c
  link.o    : link.c
  mkdir.o   : mkdir.c
  socket.o  : socket.c gsocket.h
  sysdep.o  : sysdep.c
+ raise-gcc.o : raise-gcc.c raise.h
+ raise.o   : raise.c raise.h
  
  gen-soccon: gen-soccon.c gsocket.h
! 	$(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
! 		-UIN_GCC -DTARGET=\"$(target_alias)\" \
  		$< $(OUTPUT_OPTION)
  
  cio.o     : cio.c
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  init.o    : init.c ada.h types.h raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
! 	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
! 
! initialize.o : initialize.c
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  # No optimization to compile this file as optimizations (-O1 or above) breaks
  # the SEH handling on Windows. The reasons are not clear.
  seh_init.o : seh_init.c raise.h
! 	$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) -O0 \
  	         $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
  
  # Need to keep the frame pointer in this file to pop the stack properly on
  # some targets.
  tracebak.o  : tracebak.c tb-alvms.c tb-alvxw.c
*************** tracebak.o  : tracebak.c tb-alvms.c tb-a
*** 2118,2126 ****
  
  force:
  
! # Gnatlbr is only used on VMS
  
  ../../gnatlbr$(exeext): ../../prefix.o
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatlbr --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlbr
! 	$(GNATLINK) -v gnatlbr -o $@ --GCC=$(GCC_LINK) $(TOOLS_LIBS)
--- 1895,1912 ----
  
  force:
  
! # Gnatlbr, Vms_help, and Gnat.hlp are only used on VMS
  
  ../../gnatlbr$(exeext): ../../prefix.o
  	$(GNATMAKE) -c $(ADA_INCLUDES) gnatlbr --GCC="$(CC) $(ALL_ADAFLAGS)"
  	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) gnatlbr
! 	$(GNATLINK) -v gnatlbr -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
! 
! ../../vms_help$(exeext):
! 	$(GNATMAKE) -c $(ADA_INCLUDES) vms_help --GCC="$(CC) $(ALL_ADAFLAGS)"
! 	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vms_help
! 	$(GNATLINK) -v vms_help -o $@ --GCC="$(GCC_LINK)" $(TOOLS_LIBS)
! 
! ../../gnat.hlp: ../../vms_help$(exeext)
! 	../../vms_help$(exeext) $(fsrcdir)/gnat.help_in \
! 	                        $(fsrcdir)/vms_data.ads ../../gnat.hlp
diff -Nrcpad gcc-4.0.2/gcc/ada/Makefile.prolog gcc-4.1.0/gcc/ada/Makefile.prolog
*** gcc-4.0.2/gcc/ada/Makefile.prolog	Wed Feb 18 11:52:55 2004
--- gcc-4.1.0/gcc/ada/Makefile.prolog	Thu Jan  1 00:00:00 1970
***************
*** 1,67 ****
- # Makefile included at the beginning of the makefiles generated by gpr2make
- # to support compilation for multiple languages.
- # See also Makefile.generic
- #
- #   Copyright (C) 2001-2004 Free Software Foundation, Inc.
- 
- # This file is part of GCC.
- 
- # GCC is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2, or (at your option)
- # any later version.
- 
- # GCC is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- # GNU General Public License for more details.
- 
- # You should have received a copy of the GNU General Public License
- # along with GCC; see the file COPYING.  If not, write to
- # the Free Software Foundation, 59 Temple Place - Suite 330,
- # Boston, MA 02111-1307, USA.
- 
- # all reserved variables are saved in <VAR>.saved
- 
- BASE_DIR.saved := $(BASE_DIR)
- C_EXT.saved:=$(C_EXT)
- CXX_EXT.saved:=$(CXX_EXT)
- OBJ_EXT.saved:=$(OBJ_EXT)
- SRC_DIRS.saved:=$(SRC_DIRS)
- C_SRCS.saved:=$(C_SRCS)
- CXX_SRCS.saved:=$(CXX_SRCS)
- OBJ_DIR.saved:=$(OBJ_DIR)
- LANGUAGES.saved:=$(LANGUAGES)
- CC.saved:=$(CC)
- CXX.saved:=$(CXX)
- AR_CMD.saved:=$(AR_CMD)
- AR_EXT.saved:=$(AR_EXT)
- GNATMAKE.saved:=$(GNATMAKE)
- ADAFLAGS.saved:=$(ADAFLAGS)
- CFLAGS.saved:=$(CFLAGS)
- CXXFLAGS.saved:=$(CXXFLAGS)
- FLDFLAGS.saved:=$(FLDFLAGS)
- LIBS.saved:=$(LIBS)
- LDFLAGS.saved:=$(LDFLAGS)
- ADA_SOURCES.saved:=$(ADA_SOURCES)
- EXEC.saved:=$(EXEC)
- EXEC_DIR.saved:=$(EXEC_DIR)
- MAIN.saved:=$(MAIN)
- PROJECT_FILE.saved:=$(PROJECT_FILE)
- DEPS_PROJECTS.saved:=$(DEPS_PROJECTS)
- 
- # Default settings
- 
- LANGUAGES:=ada
- C_EXT:=.c
- CXX_EXT:=.cc
- AR_EXT=.a
- OBJ_EXT=.o
- CC=gcc
- FLDFLAGS:=
- 
- # Default target is to build (compile/bind/link)
- # Target build is defined in Makefile.generic
- 
- default: build
- 
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/Makefile.rtl gcc-4.1.0/gcc/ada/Makefile.rtl
*** gcc-4.0.2/gcc/ada/Makefile.rtl	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/Makefile.rtl	Tue Nov 15 13:57:25 2005
***************
*** 15,22 ****
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 59 Temple Place - Suite 330,
! #Boston, MA 02111-1307, USA.
  
  # This makefile fragment is included in the ada Makefile (both Unix
  # and NT and VMS versions).
--- 15,22 ----
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 51 Franklin Street, Fifth Floor,
! #Boston, MA 02110-1301, USA.
  
  # This makefile fragment is included in the ada Makefile (both Unix
  # and NT and VMS versions).
*************** GNATRTL_NONTASKING_OBJS= \
*** 79,84 ****
--- 79,85 ----
    a-cgaaso$(objext) \
    a-cgarso$(objext) \
    a-cgcaso$(objext) \
+   a-chacon$(objext) \
    a-chahan$(objext) \
    a-charac$(objext) \
    a-chlat1$(objext) \
*************** GNATRTL_NONTASKING_OBJS= \
*** 205,217 ****
    a-suteio$(objext) \
    a-swmwco$(objext) \
    a-swunau$(objext) \
!   a-swunha$(objext) \
    a-swuwti$(objext) \
    a-szmzco$(objext) \
    a-szunau$(objext) \
!   a-szunha$(objext) \
    a-szuzti$(objext) \
    a-tags$(objext) \
    a-teioed$(objext) \
    a-textio$(objext) \
    a-ticoau$(objext) \
--- 206,219 ----
    a-suteio$(objext) \
    a-swmwco$(objext) \
    a-swunau$(objext) \
!   a-swuwha$(objext) \
    a-swuwti$(objext) \
    a-szmzco$(objext) \
    a-szunau$(objext) \
!   a-szuzha$(objext) \
    a-szuzti$(objext) \
    a-tags$(objext) \
+   a-tgdico$(objext) \
    a-teioed$(objext) \
    a-textio$(objext) \
    a-ticoau$(objext) \
*************** GNATRTL_NONTASKING_OBJS= \
*** 233,238 ****
--- 235,242 ----
    a-tiunio$(objext) \
    a-unccon$(objext) \
    a-uncdea$(objext) \
+   a-wichun$(objext) \
+   a-widcha$(objext) \
    a-witeio$(objext) \
    a-wtcoau$(objext) \
    a-wtcoio$(objext) \
*************** GNATRTL_NONTASKING_OBJS= \
*** 252,257 ****
--- 256,263 ----
    a-wtmoio$(objext) \
    a-wttest$(objext) \
    a-wwunio$(objext) \
+   a-zchara$(objext) \
+   a-zchuni$(objext) \
    a-ztcoau$(objext) \
    a-ztcoio$(objext) \
    a-ztcstr$(objext) \
*************** GNATRTL_NONTASKING_OBJS= \
*** 369,375 ****
    s-crc32$(objext)  \
    s-direio$(objext) \
    s-errrep$(objext) \
-   s-except$(objext) \
    s-exctab$(objext) \
    s-exnint$(objext) \
    s-exnllf$(objext) \
--- 375,380 ----
*************** GNATRTL_NONTASKING_OBJS= \
*** 386,394 ****
--- 391,404 ----
    s-fatsfl$(objext) \
    s-ficobl$(objext) \
    s-fileio$(objext) \
+   s-filofl$(objext) \
+   s-fishfl$(objext) \
    s-finimp$(objext) \
    s-finroo$(objext) \
    s-fore$(objext)   \
+   s-fvadfl$(objext) \
+   s-fvaffl$(objext) \
+   s-fvagfl$(objext) \
    s-geveop$(objext) \
    s-htable$(objext) \
    s-imgbiu$(objext) \
diff -Nrcpad gcc-4.0.2/gcc/ada/a-astaco.adb gcc-4.1.0/gcc/ada/a-astaco.adb
*** gcc-4.0.2/gcc/ada/a-astaco.adb	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-astaco.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-astaco.ads gcc-4.1.0/gcc/ada/a-astaco.ads
*** gcc-4.0.2/gcc/ada/a-astaco.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-astaco.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L         --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . A S Y N C H R O N O U S _ T A S K _ C O N T R O L         --
  --                                                                          --
***************
*** 13,32 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
!    --  This unit is not implemented in typical GNAT implementations that
!    --  lie on top of operating systems, because it is infeasible to implement
!    --  in such environments. The RM anticipates this situation (RM D.11(10)),
!    --  and permits an implementation to leave this unimplemented even if the
!    --  Real-Time Systems annex is fully supported.
  
!    --  If a target environment provides appropriate support for this package,
!    --  then the Unimplemented_Unit pragma should be removed from this spec,
!    --  and an appropriate body provided. The framework for such a body is
!    --  included in the distributed sources.
  
  with Ada.Task_Identification;
  
  package Ada.Asynchronous_Task_Control is
  
     pragma Unimplemented_Unit;
  
--- 13,34 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This unit is not implemented in typical GNAT implementations that lie on
! --  top of operating systems, because it is infeasible to implement in such
! --  environments. The RM anticipates this situation (RM D.11(10)), and permits
! --  an implementation to leave this unimplemented even if the Real-Time Systems
! --  annex is fully supported.
  
! --  If a target environment provides appropriate support for this package, then
! --  the Unimplemented_Unit pragma should be removed from this spec, and an
! --  appropriate body provided. The framework for such a body is included in the
! --  distributed sources.
  
  with Ada.Task_Identification;
  
  package Ada.Asynchronous_Task_Control is
+    pragma Preelaborate_05;
+    --  In accordance with Ada 2005 AI-362
  
     pragma Unimplemented_Unit;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-caldel-vms.adb gcc-4.1.0/gcc/ada/a-caldel-vms.adb
*** gcc-4.0.2/gcc/ada/a-caldel-vms.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-caldel-vms.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version.
  
  with System.OS_Primitives;
  --  Used for Max_Sensible_Delay
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version
  
  with System.OS_Primitives;
  --  Used for Max_Sensible_Delay
diff -Nrcpad gcc-4.0.2/gcc/ada/a-caldel.adb gcc-4.1.0/gcc/ada/a-caldel.adb
*** gcc-4.0.2/gcc/ada/a-caldel.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-caldel.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-caldel.ads gcc-4.1.0/gcc/ada/a-caldel.ads
*** gcc-4.0.2/gcc/ada/a-caldel.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-caldel.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-1998, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . C A L E N D A R . D E L A Y S                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package implements Calendar.Time delays using protected objects.
  
  --  Note: the compiler generates direct calls to this interface, in the
  --  processing of time types.
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package implements Calendar.Time delays using protected objects
  
  --  Note: the compiler generates direct calls to this interface, in the
  --  processing of time types.
***************
*** 39,56 ****
  package Ada.Calendar.Delays is
  
     procedure Delay_For (D : Duration);
!    --  Delay until an interval of length (at least) D seconds has passed,
!    --  or the task is aborted to at least the current ATC nesting level.
!    --  This is an abort completion point.
!    --  The body of this procedure must perform all the processing
!    --  required for an abortion point.
  
     procedure Delay_Until (T : Time);
!    --  Delay until Clock has reached (at least) time T,
!    --  or the task is aborted to at least the current ATC nesting level.
!    --  The body of this procedure must perform all the processing
!    --  required for an abortion point.
  
     function To_Duration (T : Time) return Duration;
  
  end Ada.Calendar.Delays;
--- 39,55 ----
  package Ada.Calendar.Delays is
  
     procedure Delay_For (D : Duration);
!    --  Delay until an interval of length (at least) D seconds has passed, or
!    --  the task is aborted to at least the current ATC nesting level. This is
!    --  an abort completion point. The body of this procedure must perform all
!    --  the processing required for an abort point.
  
     procedure Delay_Until (T : Time);
!    --  Delay until Clock has reached (at least) time T, or the task is aborted
!    --  to at least the current ATC nesting level. The body of this procedure
!    --  must perform all the processing required for an abort point.
  
     function To_Duration (T : Time) return Duration;
+    --  Convert Time to Duration
  
  end Ada.Calendar.Delays;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-calend-mingw.adb gcc-4.1.0/gcc/ada/a-calend-mingw.adb
*** gcc-4.0.2/gcc/ada/a-calend-mingw.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-calend-mingw.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1997-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Windows NT/95 version.
  
  with System.OS_Primitives;
  --  used for Clock
--- 31,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Windows NT/95 version
! 
! --  Why do we need separate version ???
! --  Do we need *this* much code duplication???
  
  with System.OS_Primitives;
  --  used for Clock
*************** package body Ada.Calendar is
*** 173,179 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DD;
--- 176,181 ----
*************** package body Ada.Calendar is
*** 203,209 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DS;
--- 205,210 ----
*************** package body Ada.Calendar is
*** 262,268 ****
  
        end if;
  
!       --  Date_Int is the number of seconds from Epoch.
  
        Date_Int := Long_Long_Integer
          (Int_Date * Sec_Unit / system_time_ns) + epoch_1970;
--- 263,269 ----
  
        end if;
  
!       --  Date_Int is the number of seconds from Epoch
  
        Date_Int := Long_Long_Integer
          (Int_Date * Sec_Unit / system_time_ns) + epoch_1970;
*************** package body Ada.Calendar is
*** 366,372 ****
           Sub_Sec : constant Duration := Seconds - Duration (Int_Secs);
        begin
           Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) +
!            Sub_Sec;
        end;
  
        if Add_One_Day then
--- 367,373 ----
           Sub_Sec : constant Duration := Seconds - Duration (Int_Secs);
        begin
           Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) +
!                    Sub_Sec;
        end;
  
        if Add_One_Day then
*************** package body Ada.Calendar is
*** 391,394 ****
--- 392,397 ----
        return DY;
     end Year;
  
+ begin
+    System.OS_Primitives.Initialize;
  end Ada.Calendar;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-calend-vms.adb gcc-4.1.0/gcc/ada/a-calend-vms.adb
*** gcc-4.0.2/gcc/ada/a-calend-vms.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-calend-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version.
  
  with System.Aux_DEC; use System.Aux_DEC;
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version
  
  with System.Aux_DEC; use System.Aux_DEC;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-calend-vms.ads gcc-4.1.0/gcc/ada/a-calend-vms.ads
*** gcc-4.0.2/gcc/ada/a-calend-vms.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-calend-vms.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         A D A . C A L E N D A R                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         A D A . C A L E N D A R                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version.
  
  with System.OS_Primitives;
  package Ada.Calendar is
--- 35,41 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version
  
  with System.OS_Primitives;
  package Ada.Calendar is
diff -Nrcpad gcc-4.0.2/gcc/ada/a-calend.adb gcc-4.1.0/gcc/ada/a-calend.adb
*** gcc-4.0.2/gcc/ada/a-calend.adb	Mon Sep 13 10:18:38 2004
--- gcc-4.1.0/gcc/ada/a-calend.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Calendar is
*** 91,105 ****
     --  The following constants are used in adjusting Ada dates so that they
     --  fit into a 56 year range that can be handled by Unix (1970 included -
     --  2026 excluded). Dates that are not in this 56 year range are shifted
!    --  by multiples of 56 years to fit in this range
     --  The trick is that the number of days in any four year period in the Ada
     --  range of years (1901 - 2099) has a constant number of days. This is
     --  because we have the special case of 2000 which, contrary to the normal
!    --  exception for centuries, is a leap year after all.
!    --  56 has been chosen, because it is not only a multiple of 4, but also
!    --  a multiple of 7. Thus two dates 56 years apart fall on the same day of
!    --  the week, and the Daylight Saving Time change dates are usually the same
!    --  for these two years.
  
     Unix_Year_Min : constant := 1970;
     Unix_Year_Max : constant := 2026;
--- 91,106 ----
     --  The following constants are used in adjusting Ada dates so that they
     --  fit into a 56 year range that can be handled by Unix (1970 included -
     --  2026 excluded). Dates that are not in this 56 year range are shifted
!    --  by multiples of 56 years to fit in this range.
! 
     --  The trick is that the number of days in any four year period in the Ada
     --  range of years (1901 - 2099) has a constant number of days. This is
     --  because we have the special case of 2000 which, contrary to the normal
!    --  exception for centuries, is a leap year after all. 56 has been chosen,
!    --  because it is not only a multiple of 4, but also a multiple of 7. Thus
!    --  two dates 56 years apart fall on the same day of the week, and the
!    --  Daylight Saving Time change dates are usually the same for these two
!    --  years.
  
     Unix_Year_Min : constant := 1970;
     Unix_Year_Max : constant := 2026;
*************** package body Ada.Calendar is
*** 125,131 ****
        pragma Unsuppress (Overflow_Check);
     begin
        return (Left + Time (Right));
- 
     exception
        when Constraint_Error =>
           raise Time_Error;
--- 126,131 ----
*************** package body Ada.Calendar is
*** 135,141 ****
        pragma Unsuppress (Overflow_Check);
     begin
        return (Time (Left) + Right);
- 
     exception
        when Constraint_Error =>
           raise Time_Error;
--- 135,140 ----
*************** package body Ada.Calendar is
*** 149,155 ****
        pragma Unsuppress (Overflow_Check);
     begin
        return Left - Time (Right);
- 
     exception
        when Constraint_Error =>
           raise Time_Error;
--- 148,153 ----
*************** package body Ada.Calendar is
*** 159,165 ****
        pragma Unsuppress (Overflow_Check);
     begin
        return Duration (Left) - Duration (Right);
- 
     exception
        when Constraint_Error =>
           raise Time_Error;
--- 157,162 ----
*************** package body Ada.Calendar is
*** 219,225 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DD;
--- 216,221 ----
*************** package body Ada.Calendar is
*** 234,240 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DM;
--- 230,235 ----
*************** package body Ada.Calendar is
*** 249,255 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DS;
--- 244,249 ----
*************** package body Ada.Calendar is
*** 291,301 ****
  
        D := Duration (Date);
  
!       --  First of all, filter out completely ludicrous values. Remember
!       --  that we use the full stored range of duration values, which may
!       --  be significantly larger than the allowed range of Ada times. Note
!       --  that these checks are wider than required to make absolutely sure
!       --  that there are no end effects from time zone differences.
  
        if D < LowD or else D > HighD then
           raise Time_Error;
--- 285,295 ----
  
        D := Duration (Date);
  
!       --  First of all, filter out completely ludicrous values. Remember that
!       --  we use the full stored range of duration values, which may be
!       --  significantly larger than the allowed range of Ada times. Note that
!       --  these checks are wider than required to make absolutely sure that
!       --  there are no end effects from time zone differences.
  
        if D < LowD or else D > HighD then
           raise Time_Error;
*************** package body Ada.Calendar is
*** 306,316 ****
        --  required range of years (the guaranteed range available is only
        --  EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1.
  
!       --  If we have a value outside this range, then we first adjust it
!       --  to be in the required range by adding multiples of 56 years.
!       --  For the range we are interested in, the number of days in any
!       --  consecutive 56 year period is constant. Then we do the split
!       --  on the adjusted value, and readjust the years value accordingly.
  
        Year_Val := 0;
  
--- 300,310 ----
        --  required range of years (the guaranteed range available is only
        --  EPOCH through EPOCH + N seconds). N is in practice 2 ** 31 - 1.
  
!       --  If we have a value outside this range, then we first adjust it to be
!       --  in the required range by adding multiples of 56 years. For the range
!       --  we are interested in, the number of days in any consecutive 56 year
!       --  period is constant. Then we do the split on the adjusted value, and
!       --  readjust the years value accordingly.
  
        Year_Val := 0;
  
*************** package body Ada.Calendar is
*** 325,337 ****
        end loop;
  
        --  Now we need to take the value D, which is now non-negative, and
!       --  break it down into seconds (to pass to the localtime_r function)
!       --  and fractions of seconds (for the adjustment below).
  
        --  Surprisingly there is no easy way to do this in Ada, and certainly
!       --  no easy way to do it and generate efficient code. Therefore we
!       --  do it at a low level, knowing that it is really represented as
!       --  an integer with units of Small
  
        declare
           type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
--- 319,331 ----
        end loop;
  
        --  Now we need to take the value D, which is now non-negative, and
!       --  break it down into seconds (to pass to the localtime_r function) and
!       --  fractions of seconds (for the adjustment below).
  
        --  Surprisingly there is no easy way to do this in Ada, and certainly
!       --  no easy way to do it and generate efficient code. Therefore we do it
!       --  at a low level, knowing that it is really represented as an integer
!       --  with units of Small
  
        declare
           type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
*************** package body Ada.Calendar is
*** 356,373 ****
        Day      := Tm_Val.tm_mday;
  
        --  The Seconds value is a little complex. The localtime function
!       --  returns the integral number of seconds, which is what we want,
!       --  but we want to retain the fractional part from the original
!       --  Time value, since this is typically stored more accurately.
  
        Seconds := Duration (Tm_Val.tm_hour * 3600 +
                             Tm_Val.tm_min  * 60 +
                             Tm_Val.tm_sec)
                     + Frac_Sec;
  
!       --  Note: the above expression is pretty horrible, one of these days
!       --  we should stop using time_of and do everything ourselves to avoid
!       --  these unnecessary divides and multiplies???.
  
        --  The Year may still be out of range, since our entry test was
        --  deliberately crude. Trying to make this entry test accurate is
--- 350,367 ----
        Day      := Tm_Val.tm_mday;
  
        --  The Seconds value is a little complex. The localtime function
!       --  returns the integral number of seconds, which is what we want, but
!       --  we want to retain the fractional part from the original Time value,
!       --  since this is typically stored more accurately.
  
        Seconds := Duration (Tm_Val.tm_hour * 3600 +
                             Tm_Val.tm_min  * 60 +
                             Tm_Val.tm_sec)
                     + Frac_Sec;
  
!       --  Note: the above expression is pretty horrible, one of these days we
!       --  should stop using time_of and do everything ourselves to avoid these
!       --  unnecessary divides and multiplies???.
  
        --  The Year may still be out of range, since our entry test was
        --  deliberately crude. Trying to make this entry test accurate is
*************** package body Ada.Calendar is
*** 404,411 ****
     begin
        --  The following checks are redundant with respect to the constraint
        --  error checks that should normally be made on parameters, but we
!       --  decide to raise Constraint_Error in any case if bad values come
!       --  in (as a result of checks being off in the caller, or for other
        --  erroneous or bounded error cases).
  
        if        not Year   'Valid
--- 398,405 ----
     begin
        --  The following checks are redundant with respect to the constraint
        --  error checks that should normally be made on parameters, but we
!       --  decide to raise Constraint_Error in any case if bad values come in
!       --  (as a result of checks being off in the caller, or for other
        --  erroneous or bounded error cases).
  
        if        not Year   'Valid
*************** package body Ada.Calendar is
*** 433,442 ****
        TM_Val.tm_mon  := Month - 1;
  
        --  For the year, we have to adjust it to a year that Unix can handle.
!       --  We do this in 56 year steps, since the number of days in 56 years
!       --  is constant, so the timezone effect on the conversion from local
!       --  time to GMT is unaffected; also the DST change dates are usually
!       --  not modified.
  
        while Year_Val < Unix_Year_Min loop
           Year_Val := Year_Val + 56;
--- 427,436 ----
        TM_Val.tm_mon  := Month - 1;
  
        --  For the year, we have to adjust it to a year that Unix can handle.
!       --  We do this in 56 year steps, since the number of days in 56 years is
!       --  constant, so the timezone effect on the conversion from local time
!       --  to GMT is unaffected; also the DST change dates are usually not
!       --  modified.
  
        while Year_Val < Unix_Year_Min loop
           Year_Val := Year_Val + 56;
*************** package body Ada.Calendar is
*** 450,457 ****
  
        TM_Val.tm_year := Year_Val - 1900;
  
!       --  Since we do not have information on daylight savings,
!       --  rely on the default information.
  
        TM_Val.tm_isdst := -1;
        Result_Secs := mktime (TM_Val'Unchecked_Access);
--- 444,451 ----
  
        TM_Val.tm_year := Year_Val - 1900;
  
!       --  Since we do not have information on daylight savings, rely on the
!       --  default information.
  
        TM_Val.tm_isdst := -1;
        Result_Secs := mktime (TM_Val'Unchecked_Access);
*************** package body Ada.Calendar is
*** 459,472 ****
        --  That gives us the basic value in seconds. Two adjustments are
        --  needed. First we must undo the year adjustment carried out above.
        --  Second we put back the fraction seconds value since in general the
!       --  Day_Duration value we received has additional precision which we
!       --  do not want to lose in the constructed result.
  
        return
          Time (Duration (Result_Secs) +
                Duration_Adjust +
                (Seconds - Duration (Int_Secs)));
- 
     end Time_Of;
  
     ----------
--- 453,465 ----
        --  That gives us the basic value in seconds. Two adjustments are
        --  needed. First we must undo the year adjustment carried out above.
        --  Second we put back the fraction seconds value since in general the
!       --  Day_Duration value we received has additional precision which we do
!       --  not want to lose in the constructed result.
  
        return
          Time (Duration (Result_Secs) +
                Duration_Adjust +
                (Seconds - Duration (Int_Secs)));
     end Time_Of;
  
     ----------
*************** package body Ada.Calendar is
*** 478,487 ****
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
- 
     begin
        Split (Date, DY, DM, DD, DS);
        return DY;
     end Year;
  
  end Ada.Calendar;
--- 471,481 ----
        DM : Month_Number;
        DD : Day_Number;
        DS : Day_Duration;
     begin
        Split (Date, DY, DM, DD, DS);
        return DY;
     end Year;
  
+ begin
+    System.OS_Primitives.Initialize;
  end Ada.Calendar;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-calend.ads gcc-4.1.0/gcc/ada/a-calend.ads
*** gcc-4.0.2/gcc/ada/a-calend.ads	Mon Jun  7 14:16:15 2004
--- gcc-4.1.0/gcc/ada/a-calend.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cdlili.adb gcc-4.1.0/gcc/ada/a-cdlili.adb
*** gcc-4.0.2/gcc/ada/a-cdlili.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cdlili.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.DOUBLY_LINKED_LISTS                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --   A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,59 ****
  ------------------------------------------------------------------------------
  
  with System;  use type System.Address;
  with Ada.Unchecked_Deallocation;
  
  package body Ada.Containers.Doubly_Linked_Lists is
  
-    procedure Free is
-      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
- 
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    procedure Delete_Node
!      (Container : in out List;
!       Node      : in out Node_Access);
  
     procedure Insert_Internal
       (Container : in out List;
        Before    : Node_Access;
        New_Node  : Node_Access);
  
     ---------
     -- "=" --
     ---------
--- 34,57 ----
  ------------------------------------------------------------------------------
  
  with System;  use type System.Address;
+ 
  with Ada.Unchecked_Deallocation;
  
  package body Ada.Containers.Doubly_Linked_Lists is
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    procedure Free (X : in out Node_Access);
  
     procedure Insert_Internal
       (Container : in out List;
        Before    : Node_Access;
        New_Node  : Node_Access);
  
+    function Vet (Position : Cursor) return Boolean;
+ 
     ---------
     -- "=" --
     ---------
*************** package body Ada.Containers.Doubly_Linke
*** 88,125 ****
     ------------
  
     procedure Adjust (Container : in out List) is
!       Src    : Node_Access := Container.First;
!       Length : constant Count_Type := Container.Length;
  
     begin
        if Src = null then
           pragma Assert (Container.Last = null);
!          pragma Assert (Length = 0);
           return;
        end if;
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!       pragma Assert (Length > 0);
  
        Container.First := null;
        Container.Last := null;
        Container.Length := 0;
  
        Container.First := new Node_Type'(Src.Element, null, null);
- 
        Container.Last := Container.First;
!       loop
!          Container.Length := Container.Length + 1;
!          Src := Src.Next;
!          exit when Src = null;
           Container.Last.Next := new Node_Type'(Element => Src.Element,
                                                 Prev    => Container.Last,
                                                 Next    => null);
           Container.Last := Container.Last.Next;
!       end loop;
  
!       pragma Assert (Container.Length = Length);
     end Adjust;
  
     ------------
--- 86,126 ----
     ------------
  
     procedure Adjust (Container : in out List) is
!       Src : Node_Access := Container.First;
  
     begin
        if Src = null then
           pragma Assert (Container.Last = null);
!          pragma Assert (Container.Length = 0);
!          pragma Assert (Container.Busy = 0);
!          pragma Assert (Container.Lock = 0);
           return;
        end if;
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!       pragma Assert (Container.Length > 0);
  
        Container.First := null;
        Container.Last := null;
        Container.Length := 0;
+       Container.Busy := 0;
+       Container.Lock := 0;
  
        Container.First := new Node_Type'(Src.Element, null, null);
        Container.Last := Container.First;
!       Container.Length := 1;
! 
!       Src := Src.Next;
!       while Src /= null loop
           Container.Last.Next := new Node_Type'(Element => Src.Element,
                                                 Prev    => Container.Last,
                                                 Next    => null);
           Container.Last := Container.Last.Next;
!          Container.Length := Container.Length + 1;
  
!          Src := Src.Next;
!       end loop;
     end Adjust;
  
     ------------
*************** package body Ada.Containers.Doubly_Linke
*** 140,151 ****
     -----------
  
     procedure Clear (Container : in out List) is
     begin
!       Delete_Last (Container, Count => Container.Length);
     end Clear;
  
     --------------
!    -- Continue --
     --------------
  
     function Contains
--- 141,188 ----
     -----------
  
     procedure Clear (Container : in out List) is
+       X : Node_Access;
+ 
     begin
!       if Container.Length = 0 then
!          pragma Assert (Container.First = null);
!          pragma Assert (Container.Last = null);
!          pragma Assert (Container.Busy = 0);
!          pragma Assert (Container.Lock = 0);
!          return;
!       end if;
! 
!       pragma Assert (Container.First.Prev = null);
!       pragma Assert (Container.Last.Next = null);
! 
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       while Container.Length > 1 loop
!          X := Container.First;
!          pragma Assert (X.Next.Prev = Container.First);
! 
!          Container.First := X.Next;
!          Container.First.Prev := null;
! 
!          Container.Length := Container.Length - 1;
! 
!          Free (X);
!       end loop;
! 
!       X := Container.First;
!       pragma Assert (X = Container.Last);
! 
!       Container.First := null;
!       Container.Last := null;
!       Container.Length := 0;
! 
!       Free (X);
     end Clear;
  
     --------------
!    -- Contains --
     --------------
  
     function Contains
*************** package body Ada.Containers.Doubly_Linke
*** 165,187 ****
        Position  : in out Cursor;
        Count     : Count_Type := 1)
     is
     begin
!       if Position = No_Element then
           return;
        end if;
  
!       if Position.Container /= List_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
        for Index in 1 .. Count loop
!          Delete_Node (Container, Position.Node);
  
!          if Position.Node = null then
!             Position.Container := null;
              return;
           end if;
        end loop;
     end Delete;
  
     ------------------
--- 202,258 ----
        Position  : in out Cursor;
        Count     : Count_Type := 1)
     is
+       X : Node_Access;
+ 
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Delete");
! 
!       if Position.Node = Container.First then
!          Delete_First (Container, Count);
!          Position := No_Element; --  Post-York behavior
           return;
        end if;
  
!       if Count = 0 then
!          Position := No_Element;  --  Post-York behavior
!          return;
!       end if;
! 
!       if Container.Busy > 0 then
           raise Program_Error;
        end if;
  
        for Index in 1 .. Count loop
!          X := Position.Node;
!          Container.Length := Container.Length - 1;
  
!          if X = Container.Last then
!             Position := No_Element;
! 
!             Container.Last := X.Prev;
!             Container.Last.Next := null;
! 
!             Free (X);
              return;
           end if;
+ 
+          Position.Node := X.Next;
+ 
+          X.Next.Prev := X.Prev;
+          X.Prev.Next := X.Next;
+ 
+          Free (X);
        end loop;
+ 
+       Position := No_Element;  --  Post-York behavior
     end Delete;
  
     ------------------
*************** package body Ada.Containers.Doubly_Linke
*** 192,201 ****
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       Node : Node_Access := Container.First;
     begin
!       for J in 1 .. Count_Type'Min (Count, Container.Length) loop
!          Delete_Node (Container, Node);
        end loop;
     end Delete_First;
  
--- 263,294 ----
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       X : Node_Access;
! 
     begin
!       if Count >= Container.Length then
!          Clear (Container);
!          return;
!       end if;
! 
!       if Count = 0 then
!          return;
!       end if;
! 
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       for I in 1 .. Count loop
!          X := Container.First;
!          pragma Assert (X.Next.Prev = Container.First);
! 
!          Container.First := X.Next;
!          Container.First.Prev := null;
! 
!          Container.Length := Container.Length - 1;
! 
!          Free (X);
        end loop;
     end Delete_First;
  
*************** package body Ada.Containers.Doubly_Linke
*** 207,261 ****
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       Node : Node_Access;
!    begin
!       for J in 1 .. Count_Type'Min (Count, Container.Length) loop
!          Node := Container.Last;
!          Delete_Node (Container, Node);
!       end loop;
!    end Delete_Last;
! 
!    -----------------
!    -- Delete_Node --
!    -----------------
! 
!    procedure Delete_Node
!      (Container : in out List;
!       Node      : in out Node_Access)
!    is
!       X : Node_Access := Node;
  
     begin
!       Node := X.Next;
!       Container.Length := Container.Length - 1;
  
!       if X = Container.First then
!          Container.First := X.Next;
  
!          if X = Container.Last then
!             pragma Assert (Container.First = null);
!             pragma Assert (Container.Length = 0);
!             Container.Last := null;
!          else
!             pragma Assert (Container.Length > 0);
!             Container.First.Prev := null;
!          end if;
  
!       elsif X = Container.Last then
!          pragma Assert (Container.Length > 0);
  
           Container.Last := X.Prev;
           Container.Last.Next := null;
  
!       else
!          pragma Assert (Container.Length > 0);
! 
!          X.Next.Prev := X.Prev;
!          X.Prev.Next := X.Next;
!       end if;
  
!       Free (X);
!    end Delete_Node;
  
     -------------
     -- Element --
--- 300,333 ----
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       X : Node_Access;
  
     begin
!       if Count >= Container.Length then
!          Clear (Container);
!          return;
!       end if;
  
!       if Count = 0 then
!          return;
!       end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       for I in 1 .. Count loop
!          X := Container.Last;
!          pragma Assert (X.Prev.Next = Container.Last);
  
           Container.Last := X.Prev;
           Container.Last.Next := null;
  
!          Container.Length := Container.Length - 1;
  
!          Free (X);
!       end loop;
!    end Delete_Last;
  
     -------------
     -- Element --
*************** package body Ada.Containers.Doubly_Linke
*** 263,268 ****
--- 335,346 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position), "bad cursor in Element");
+ 
        return Position.Node.Element;
     end Element;
  
*************** package body Ada.Containers.Doubly_Linke
*** 280,287 ****
     begin
        if Node = null then
           Node := Container.First;
!       elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
        end if;
  
        while Node /= null loop
--- 358,370 ----
     begin
        if Node = null then
           Node := Container.First;
! 
!       else
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Position), "bad cursor in Find");
        end if;
  
        while Node /= null loop
*************** package body Ada.Containers.Doubly_Linke
*** 314,447 ****
  
     function First_Element (Container : List) return Element_Type is
     begin
        return Container.First.Element;
     end First_Element;
  
!    -------------------
!    -- Generic_Merge --
!    -------------------
  
!    procedure Generic_Merge
!      (Target : in out List;
!       Source : in out List)
!    is
!       LI : Cursor := First (Target);
!       RI : Cursor := First (Source);
  
     begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
  
!       while RI.Node /= null loop
!          if LI.Node = null then
!             Splice (Target, No_Element, Source);
!             return;
!          end if;
  
!          if RI.Node.Element < LI.Node.Element then
!             declare
!                RJ : constant Cursor := RI;
!             begin
!                RI.Node := RI.Node.Next;
!                Splice (Target, LI, Source, RJ);
!             end;
  
!          else
!             LI.Node := LI.Node.Next;
!          end if;
!       end loop;
!    end Generic_Merge;
  
!    ------------------
!    -- Generic_Sort --
!    ------------------
  
!    procedure Generic_Sort (Container : in out List) is
  
!       procedure Partition
!         (Pivot : in Node_Access;
!          Back  : in Node_Access);
  
!       procedure Sort (Front, Back : Node_Access);
  
!       ---------------
!       -- Partition --
!       ---------------
  
!       procedure Partition
!         (Pivot : Node_Access;
!          Back  : Node_Access)
        is
!          Node : Node_Access := Pivot.Next;
  
        begin
!          while Node /= Back loop
!             if Node.Element < Pivot.Element then
!                declare
!                   Prev : constant Node_Access := Node.Prev;
!                   Next : constant Node_Access := Node.Next;
! 
!                begin
!                   Prev.Next := Next;
! 
!                   if Next = null then
!                      Container.Last := Prev;
!                   else
!                      Next.Prev := Prev;
!                   end if;
! 
!                   Node.Next := Pivot;
!                   Node.Prev := Pivot.Prev;
  
!                   Pivot.Prev := Node;
  
!                   if Node.Prev = null then
!                      Container.First := Node;
!                   else
!                      Node.Prev.Next := Node;
!                   end if;
  
!                   Node := Next;
                 end;
  
              else
!                Node := Node.Next;
              end if;
           end loop;
!       end Partition;
  
        ----------
        -- Sort --
        ----------
  
!       procedure Sort (Front, Back : Node_Access) is
!          Pivot : Node_Access;
  
        begin
!          if Front = null then
!             Pivot := Container.First;
!          else
!             Pivot := Front.Next;
           end if;
  
!          if Pivot /= Back then
!             Partition (Pivot, Back);
!             Sort (Front, Pivot);
!             Sort (Pivot, Back);
           end if;
-       end Sort;
  
!    --  Start of processing for Generic_Sort
  
!    begin
!       Sort (Front => null, Back => null);
  
!       pragma Assert (Container.Length = 0
!                        or else
!                          (Container.First.Prev = null
!                             and then Container.Last.Next = null));
!    end Generic_Sort;
  
     -----------------
     -- Has_Element --
--- 397,590 ----
  
     function First_Element (Container : List) return Element_Type is
     begin
+       if Container.First = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.First.Element;
     end First_Element;
  
!    ----------
!    -- Free --
!    ----------
  
!    procedure Free (X : in out Node_Access) is
!       procedure Deallocate is
!          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     begin
!       X.Prev := X;
!       X.Next := X;
!       Deallocate (X);
!    end Free;
  
!    ---------------------
!    -- Generic_Sorting --
!    ---------------------
  
!    package body Generic_Sorting is
  
!       ---------------
!       -- Is_Sorted --
!       ---------------
  
!       function Is_Sorted (Container : List) return Boolean is
!          Node : Node_Access := Container.First;
  
!       begin
!          for I in 2 .. Container.Length loop
!             if Node.Next.Element < Node.Element then
!                return False;
!             end if;
  
!             Node := Node.Next;
!          end loop;
  
!          return True;
!       end Is_Sorted;
  
!       -----------
!       -- Merge --
!       -----------
  
!       procedure Merge
!         (Target : in out List;
!          Source : in out List)
        is
!          LI : Cursor := First (Target);
!          RI : Cursor := First (Source);
  
        begin
!          if Target'Address = Source'Address then
!             return;
!          end if;
  
!          if Target.Busy > 0
!            or else Source.Busy > 0
!          then
!             raise Program_Error;
!          end if;
  
!          while RI.Node /= null loop
!             if LI.Node = null then
!                Splice (Target, No_Element, Source);
!                return;
!             end if;
  
!             if RI.Node.Element < LI.Node.Element then
!                declare
!                   RJ : Cursor := RI;
!                begin
!                   RI.Node := RI.Node.Next;
!                   Splice (Target, LI, Source, RJ);
                 end;
  
              else
!                LI.Node := LI.Node.Next;
              end if;
           end loop;
!       end Merge;
  
        ----------
        -- Sort --
        ----------
  
!       procedure Sort (Container : in out List) is
! 
!          procedure Partition
!            (Pivot : in Node_Access;
!             Back  : in Node_Access);
! 
!          procedure Sort (Front, Back : Node_Access);
! 
!          ---------------
!          -- Partition --
!          ---------------
! 
!          procedure Partition
!            (Pivot : Node_Access;
!             Back  : Node_Access)
!          is
!             Node : Node_Access := Pivot.Next;
! 
!          begin
!             while Node /= Back loop
!                if Node.Element < Pivot.Element then
!                   declare
!                      Prev : constant Node_Access := Node.Prev;
!                      Next : constant Node_Access := Node.Next;
! 
!                   begin
!                      Prev.Next := Next;
! 
!                      if Next = null then
!                         Container.Last := Prev;
!                      else
!                         Next.Prev := Prev;
!                      end if;
! 
!                      Node.Next := Pivot;
!                      Node.Prev := Pivot.Prev;
! 
!                      Pivot.Prev := Node;
! 
!                      if Node.Prev = null then
!                         Container.First := Node;
!                      else
!                         Node.Prev.Next := Node;
!                      end if;
! 
!                      Node := Next;
!                   end;
! 
!                else
!                   Node := Node.Next;
!                end if;
!             end loop;
!          end Partition;
! 
!          ----------
!          -- Sort --
!          ----------
! 
!          procedure Sort (Front, Back : Node_Access) is
!             Pivot : Node_Access;
! 
!          begin
!             if Front = null then
!                Pivot := Container.First;
!             else
!                Pivot := Front.Next;
!             end if;
! 
!             if Pivot /= Back then
!                Partition (Pivot, Back);
!                Sort (Front, Pivot);
!                Sort (Pivot, Back);
!             end if;
!          end Sort;
! 
!       --  Start of processing for Sort
  
        begin
!          if Container.Length <= 1 then
!             return;
           end if;
  
!          pragma Assert (Container.First.Prev = null);
!          pragma Assert (Container.Last.Next = null);
! 
!          if Container.Busy > 0 then
!             raise Program_Error;
           end if;
  
!          Sort (Front => null, Back => null);
  
!          pragma Assert (Container.First.Prev = null);
!          pragma Assert (Container.Last.Next = null);
!       end Sort;
  
!    end Generic_Sorting;
  
     -----------------
     -- Has_Element --
*************** package body Ada.Containers.Doubly_Linke
*** 449,455 ****
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       return Position.Container /= null and then Position.Node /= null;
     end Has_Element;
  
     ------------
--- 592,599 ----
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
     end Has_Element;
  
     ------------
*************** package body Ada.Containers.Doubly_Linke
*** 466,475 ****
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
        if Count = 0 then
--- 610,621 ----
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null then
!          if Before.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad cursor in Insert");
        end if;
  
        if Count = 0 then
*************** package body Ada.Containers.Doubly_Linke
*** 477,486 ****
           return;
        end if;
  
        New_Node := new Node_Type'(New_Item, null, null);
        Insert_Internal (Container, Before.Node, New_Node);
  
!       Position := Cursor'(Before.Container, New_Node);
  
        for J in Count_Type'(2) .. Count loop
           New_Node := new Node_Type'(New_Item, null, null);
--- 623,640 ----
           return;
        end if;
  
+       if Container.Length > Count_Type'Last - Count then
+          raise Constraint_Error;
+       end if;
+ 
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        New_Node := new Node_Type'(New_Item, null, null);
        Insert_Internal (Container, Before.Node, New_Node);
  
!       Position := Cursor'(Container'Unchecked_Access, New_Node);
  
        for J in Count_Type'(2) .. Count loop
           New_Node := new Node_Type'(New_Item, null, null);
*************** package body Ada.Containers.Doubly_Linke
*** 508,517 ****
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
        if Count = 0 then
--- 662,673 ----
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null then
!          if Before.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad cursor in Insert");
        end if;
  
        if Count = 0 then
*************** package body Ada.Containers.Doubly_Linke
*** 519,528 ****
           return;
        end if;
  
        New_Node := new Node_Type;
        Insert_Internal (Container, Before.Node, New_Node);
  
!       Position := Cursor'(Before.Container, New_Node);
  
        for J in Count_Type'(2) .. Count loop
           New_Node := new Node_Type;
--- 675,692 ----
           return;
        end if;
  
+       if Container.Length > Count_Type'Last - Count then
+          raise Constraint_Error;
+       end if;
+ 
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        New_Node := new Node_Type;
        Insert_Internal (Container, Before.Node, New_Node);
  
!       Position := Cursor'(Container'Unchecked_Access, New_Node);
  
        for J in Count_Type'(2) .. Count loop
           New_Node := new Node_Type;
*************** package body Ada.Containers.Doubly_Linke
*** 595,606 ****
       (Container : List;
        Process   : not null access procedure (Position : Cursor))
     is
        Node : Node_Access := Container.First;
     begin
!       while Node /= null loop
!          Process (Cursor'(Container'Unchecked_Access, Node));
!          Node := Node.Next;
!       end loop;
     end Iterate;
  
     ----------
--- 759,784 ----
       (Container : List;
        Process   : not null access procedure (Position : Cursor))
     is
+       C : List renames Container'Unrestricted_Access.all;
+       B : Natural renames C.Busy;
+ 
        Node : Node_Access := Container.First;
+ 
     begin
!       B := B + 1;
! 
!       begin
!          while Node /= null loop
!             Process (Cursor'(Container'Unchecked_Access, Node));
!             Node := Node.Next;
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Doubly_Linke
*** 622,627 ****
--- 800,809 ----
  
     function Last_Element (Container : List) return Element_Type is
     begin
+       if Container.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Last.Element;
     end Last_Element;
  
*************** package body Ada.Containers.Doubly_Linke
*** 647,656 ****
           return;
        end if;
  
!       if Target.Length > 0 then
!          raise Constraint_Error;
        end if;
  
        Target.First := Source.First;
        Source.First := null;
  
--- 829,840 ----
           return;
        end if;
  
!       if Source.Busy > 0 then
!          raise Program_Error;
        end if;
  
+       Clear (Target);
+ 
        Target.First := Source.First;
        Source.First := null;
  
*************** package body Ada.Containers.Doubly_Linke
*** 667,672 ****
--- 851,858 ----
  
     procedure Next (Position : in out Cursor) is
     begin
+       pragma Assert (Vet (Position), "bad cursor in procedure Next");
+ 
        if Position.Node = null then
           return;
        end if;
*************** package body Ada.Containers.Doubly_Linke
*** 680,685 ****
--- 866,873 ----
  
     function Next (Position : Cursor) return Cursor is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Next");
+ 
        if Position.Node = null then
           return No_Element;
        end if;
*************** package body Ada.Containers.Doubly_Linke
*** 714,719 ****
--- 902,909 ----
  
     procedure Previous (Position : in out Cursor) is
     begin
+       pragma Assert (Vet (Position), "bad cursor in procedure Previous");
+ 
        if Position.Node = null then
           return;
        end if;
*************** package body Ada.Containers.Doubly_Linke
*** 727,732 ****
--- 917,924 ----
  
     function Previous (Position : Cursor) return Cursor is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Previous");
+ 
        if Position.Node = null then
           return No_Element;
        end if;
*************** package body Ada.Containers.Doubly_Linke
*** 751,757 ****
        Process  : not null access procedure (Element : in Element_Type))
     is
     begin
!       Process (Position.Node.Element);
     end Query_Element;
  
     ----------
--- 943,975 ----
        Process  : not null access procedure (Element : in Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       declare
!          C : List renames Position.Container.all'Unrestricted_Access.all;
!          B : Natural renames C.Busy;
!          L : Natural renames C.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Doubly_Linke
*** 766,772 ****
        X : Node_Access;
  
     begin
!       Clear (Item);  --  ???
        Count_Type'Base'Read (Stream, N);
  
        if N = 0 then
--- 984,990 ----
        X : Node_Access;
  
     begin
!       Clear (Item);
        Count_Type'Base'Read (Stream, N);
  
        if N = 0 then
*************** package body Ada.Containers.Doubly_Linke
*** 806,873 ****
        end loop;
     end Read;
  
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Position : Cursor;
!       By       : Element_Type)
     is
     begin
!       Position.Node.Element := By;
!    end Replace_Element;
! 
!    ------------------
!    -- Reverse_Find --
!    ------------------
! 
!    function Reverse_Find
!      (Container : List;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
!       Node : Node_Access := Position.Node;
  
!    begin
!       if Node = null then
!          Node := Container.Last;
!       elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       while Node /= null loop
!          if Node.Element = Item then
!             return Cursor'(Container'Unchecked_Access, Node);
!          end if;
! 
!          Node := Node.Prev;
!       end loop;
! 
!       return No_Element;
!    end Reverse_Find;
  
!    ---------------------
!    -- Reverse_Iterate --
!    ---------------------
  
!    procedure Reverse_Iterate
!      (Container : List;
!       Process   : not null access procedure (Position : Cursor))
!    is
!       Node : Node_Access := Container.Last;
!    begin
!       while Node /= null loop
!          Process (Cursor'(Container'Unchecked_Access, Node));
!          Node := Node.Prev;
!       end loop;
!    end Reverse_Iterate;
  
!    ------------------
!    -- Reverse_List --
!    ------------------
  
!    procedure Reverse_List (Container : in out List) is
        I : Node_Access := Container.First;
        J : Node_Access := Container.Last;
  
--- 1024,1069 ----
        end loop;
     end Read;
  
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor)
+    is
+    begin
+       raise Program_Error;
+    end Read;
+ 
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Container : in out List;
!       Position  : Cursor;
!       New_Item  : Element_Type)
     is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unchecked_Access then
           raise Program_Error;
        end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
!       end if;
  
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
  
!       Position.Node.Element := New_Item;
!    end Replace_Element;
  
!    ----------------------
!    -- Reverse_Elements --
!    ----------------------
  
!    procedure Reverse_Elements (Container : in out List) is
        I : Node_Access := Container.First;
        J : Node_Access := Container.Last;
  
*************** package body Ada.Containers.Doubly_Linke
*** 911,923 ****
           end if;
        end Swap;
  
!    --  Start of processing for Reverse_List
  
     begin
        if Container.Length <= 1 then
           return;
        end if;
  
        Container.First := J;
        Container.Last := I;
        loop
--- 1107,1126 ----
           end if;
        end Swap;
  
!    --  Start of processing for Reverse_Elements
  
     begin
        if Container.Length <= 1 then
           return;
        end if;
  
+       pragma Assert (Container.First.Prev = null);
+       pragma Assert (Container.Last.Next = null);
+ 
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        Container.First := J;
        Container.Last := I;
        loop
*************** package body Ada.Containers.Doubly_Linke
*** 940,946 ****
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!    end Reverse_List;
  
     ------------
     -- Splice --
--- 1143,1214 ----
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!    end Reverse_Elements;
! 
!    ------------------
!    -- Reverse_Find --
!    ------------------
! 
!    function Reverse_Find
!      (Container : List;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
!       Node : Node_Access := Position.Node;
! 
!    begin
!       if Node = null then
!          Node := Container.Last;
! 
!       else
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
!       end if;
! 
!       while Node /= null loop
!          if Node.Element = Item then
!             return Cursor'(Container'Unchecked_Access, Node);
!          end if;
! 
!          Node := Node.Prev;
!       end loop;
! 
!       return No_Element;
!    end Reverse_Find;
! 
!    ---------------------
!    -- Reverse_Iterate --
!    ---------------------
! 
!    procedure Reverse_Iterate
!      (Container : List;
!       Process   : not null access procedure (Position : Cursor))
!    is
!       C : List renames Container'Unrestricted_Access.all;
!       B : Natural renames C.Busy;
! 
!       Node : Node_Access := Container.Last;
! 
!    begin
!       B := B + 1;
! 
!       begin
!          while Node /= null loop
!             Process (Cursor'(Container'Unchecked_Access, Node));
!             Node := Node.Prev;
!          end loop;
! 
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
!    end Reverse_Iterate;
  
     ------------
     -- Splice --
*************** package body Ada.Containers.Doubly_Linke
*** 952,961 ****
        Source : in out List)
     is
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
        if Target'Address = Source'Address
--- 1220,1231 ----
        Source : in out List)
     is
     begin
!       if Before.Container /= null then
!          if Before.Container /= Target'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad cursor in Splice");
        end if;
  
        if Target'Address = Source'Address
*************** package body Ada.Containers.Doubly_Linke
*** 964,970 ****
--- 1234,1255 ----
           return;
        end if;
  
+       pragma Assert (Source.First.Prev = null);
+       pragma Assert (Source.Last.Next = null);
+ 
+       if Target.Length > Count_Type'Last - Source.Length then
+          raise Constraint_Error;
+       end if;
+ 
+       if Target.Busy > 0
+         or else Source.Busy > 0
+       then
+          raise Program_Error;
+       end if;
+ 
        if Target.Length = 0 then
+          pragma Assert (Target.First = null);
+          pragma Assert (Target.Last = null);
           pragma Assert (Before = No_Element);
  
           Target.First := Source.First;
*************** package body Ada.Containers.Doubly_Linke
*** 987,992 ****
--- 1272,1279 ----
           Target.First := Source.First;
  
        else
+          pragma Assert (Target.Length >= 2);
+ 
           Before.Node.Prev.Next := Source.First;
           Source.First.Prev := Before.Node.Prev;
  
*************** package body Ada.Containers.Doubly_Linke
*** 1006,1194 ****
        Before   : Cursor;
        Position : Cursor)
     is
-       X : Node_Access := Position.Node;
- 
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Position.Container /= null
!         and then Position.Container /= List_Access'(Target'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if X = null
!         or else X = Before.Node
!         or else X.Next = Before.Node
        then
           return;
        end if;
  
!       pragma Assert (Target.Length > 0);
  
        if Before.Node = null then
!          pragma Assert (X /= Target.Last);
  
!          if X = Target.First then
!             Target.First := X.Next;
              Target.First.Prev := null;
           else
!             X.Prev.Next := X.Next;
!             X.Next.Prev := X.Prev;
           end if;
  
!          Target.Last.Next := X;
!          X.Prev := Target.Last;
  
!          Target.Last := X;
           Target.Last.Next := null;
  
           return;
        end if;
  
        if Before.Node = Target.First then
!          pragma Assert (X /= Target.First);
  
!          if X = Target.Last then
!             Target.Last := X.Prev;
              Target.Last.Next := null;
           else
!             X.Prev.Next := X.Next;
!             X.Next.Prev := X.Prev;
           end if;
  
!          Target.First.Prev := X;
!          X.Next := Target.First;
  
!          Target.First := X;
           Target.First.Prev := null;
  
           return;
        end if;
  
!       if X = Target.First then
!          Target.First := X.Next;
           Target.First.Prev := null;
  
!       elsif X = Target.Last then
!          Target.Last := X.Prev;
           Target.Last.Next := null;
  
        else
!          X.Prev.Next := X.Next;
!          X.Next.Prev := X.Prev;
        end if;
  
!       Before.Node.Prev.Next := X;
!       X.Prev := Before.Node.Prev;
  
!       Before.Node.Prev := X;
!       X.Next := Before.Node;
     end Splice;
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Source   : in out List;
!       Position : Cursor)
     is
-       X : Node_Access := Position.Node;
- 
     begin
        if Target'Address = Source'Address then
           Splice (Target, Before, Position);
           return;
        end if;
  
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Position.Container /= null
!         and then Position.Container /= List_Access'(Source'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if X = null then
!          return;
        end if;
  
!       pragma Assert (Source.Length > 0);
!       pragma Assert (Source.First.Prev = null);
!       pragma Assert (Source.Last.Next = null);
  
!       if X = Source.First then
!          Source.First := X.Next;
!          Source.First.Prev := null;
  
!          if X = Source.Last then
              pragma Assert (Source.First = null);
              pragma Assert (Source.Length = 1);
              Source.Last := null;
           end if;
  
!       elsif X = Source.Last then
!          Source.Last := X.Prev;
           Source.Last.Next := null;
  
        else
!          X.Prev.Next := X.Next;
!          X.Next.Prev := X.Prev;
        end if;
  
        if Target.Length = 0 then
-          pragma Assert (Before = No_Element);
           pragma Assert (Target.First = null);
           pragma Assert (Target.Last = null);
  
!          Target.First := X;
!          Target.Last := X;
  
        elsif Before.Node = null then
!          Target.Last.Next := X;
!          X.Next := Target.Last;
  
!          Target.Last := X;
           Target.Last.Next := null;
  
        elsif Before.Node = Target.First then
!          Target.First.Prev := X;
!          X.Next := Target.First;
  
!          Target.First := X;
           Target.First.Prev := null;
  
        else
!          Before.Node.Prev.Next := X;
!          X.Prev := Before.Node.Prev;
  
!          Before.Node.Prev := X;
!          X.Next := Before.Node;
        end if;
  
        Target.Length := Target.Length + 1;
        Source.Length := Source.Length - 1;
     end Splice;
  
     ----------
     -- Swap --
     ----------
  
!    --  Is this defined when I and J designate elements in different containers,
!    --  or should it raise an exception (Program_Error)???
! 
!    procedure Swap (I, J : in Cursor) is
!       EI : constant Element_Type := I.Node.Element;
     begin
!       I.Node.Element := J.Node.Element;
!       J.Node.Element := EI;
     end Swap;
  
     ----------------
--- 1293,1539 ----
        Before   : Cursor;
        Position : Cursor)
     is
     begin
!       if Before.Container /= null then
!          if Before.Container /= Target'Unchecked_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad Before cursor in Splice");
        end if;
  
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Target'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Position), "bad Position cursor in Splice");
! 
!       if Position.Node = Before.Node
!         or else Position.Node.Next = Before.Node
        then
           return;
        end if;
  
!       pragma Assert (Target.Length >= 2);
! 
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
  
        if Before.Node = null then
!          pragma Assert (Position.Node /= Target.Last);
  
!          if Position.Node = Target.First then
!             Target.First := Position.Node.Next;
              Target.First.Prev := null;
           else
!             Position.Node.Prev.Next := Position.Node.Next;
!             Position.Node.Next.Prev := Position.Node.Prev;
           end if;
  
!          Target.Last.Next := Position.Node;
!          Position.Node.Prev := Target.Last;
  
!          Target.Last := Position.Node;
           Target.Last.Next := null;
  
           return;
        end if;
  
        if Before.Node = Target.First then
!          pragma Assert (Position.Node /= Target.First);
  
!          if Position.Node = Target.Last then
!             Target.Last := Position.Node.Prev;
              Target.Last.Next := null;
           else
!             Position.Node.Prev.Next := Position.Node.Next;
!             Position.Node.Next.Prev := Position.Node.Prev;
           end if;
  
!          Target.First.Prev := Position.Node;
!          Position.Node.Next := Target.First;
  
!          Target.First := Position.Node;
           Target.First.Prev := null;
  
           return;
        end if;
  
!       if Position.Node = Target.First then
!          Target.First := Position.Node.Next;
           Target.First.Prev := null;
  
!       elsif Position.Node = Target.Last then
!          Target.Last := Position.Node.Prev;
           Target.Last.Next := null;
  
        else
!          Position.Node.Prev.Next := Position.Node.Next;
!          Position.Node.Next.Prev := Position.Node.Prev;
        end if;
  
!       Before.Node.Prev.Next := Position.Node;
!       Position.Node.Prev := Before.Node.Prev;
  
!       Before.Node.Prev := Position.Node;
!       Position.Node.Next := Before.Node;
! 
!       pragma Assert (Target.First.Prev = null);
!       pragma Assert (Target.Last.Next = null);
     end Splice;
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Source   : in out List;
!       Position : in out Cursor)
     is
     begin
        if Target'Address = Source'Address then
           Splice (Target, Before, Position);
           return;
        end if;
  
!       if Before.Container /= null then
!          if Before.Container /= Target'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad Before cursor in Splice");
        end if;
  
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Source'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Position), "bad Position cursor in Splice");
! 
!       if Target.Length = Count_Type'Last then
!          raise Constraint_Error;
        end if;
  
!       if Target.Busy > 0
!         or else Source.Busy > 0
!       then
!          raise Program_Error;
!       end if;
  
!       if Position.Node = Source.First then
!          Source.First := Position.Node.Next;
  
!          if Position.Node = Source.Last then
              pragma Assert (Source.First = null);
              pragma Assert (Source.Length = 1);
              Source.Last := null;
+ 
+          else
+             Source.First.Prev := null;
           end if;
  
!       elsif Position.Node = Source.Last then
!          pragma Assert (Source.Length >= 2);
!          Source.Last := Position.Node.Prev;
           Source.Last.Next := null;
  
        else
!          pragma Assert (Source.Length >= 3);
!          Position.Node.Prev.Next := Position.Node.Next;
!          Position.Node.Next.Prev := Position.Node.Prev;
        end if;
  
        if Target.Length = 0 then
           pragma Assert (Target.First = null);
           pragma Assert (Target.Last = null);
+          pragma Assert (Before = No_Element);
  
!          Target.First := Position.Node;
!          Target.Last := Position.Node;
! 
!          Target.First.Prev := null;
!          Target.Last.Next := null;
  
        elsif Before.Node = null then
!          pragma Assert (Target.Last.Next = null);
!          Target.Last.Next := Position.Node;
!          Position.Node.Prev := Target.Last;
  
!          Target.Last := Position.Node;
           Target.Last.Next := null;
  
        elsif Before.Node = Target.First then
!          pragma Assert (Target.First.Prev = null);
!          Target.First.Prev := Position.Node;
!          Position.Node.Next := Target.First;
  
!          Target.First := Position.Node;
           Target.First.Prev := null;
  
        else
!          pragma Assert (Target.Length >= 2);
!          Before.Node.Prev.Next := Position.Node;
!          Position.Node.Prev := Before.Node.Prev;
  
!          Before.Node.Prev := Position.Node;
!          Position.Node.Next := Before.Node;
        end if;
  
        Target.Length := Target.Length + 1;
        Source.Length := Source.Length - 1;
+ 
+       Position.Container := Target'Unchecked_Access;
     end Splice;
  
     ----------
     -- Swap --
     ----------
  
!    procedure Swap
!      (Container : in out List;
!       I, J      : Cursor)
!    is
     begin
!       if I.Node = null
!         or else J.Node = null
!       then
!          raise Constraint_Error;
!       end if;
! 
!       if I.Container /= Container'Unchecked_Access
!         or else J.Container /= Container'Unchecked_Access
!       then
!          raise Program_Error;
!       end if;
! 
!       if I.Node = J.Node then
!          return;
!       end if;
! 
!       if Container.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (I), "bad I cursor in Swap");
!       pragma Assert (Vet (J), "bad J cursor in Swap");
! 
!       declare
!          EI : Element_Type renames I.Node.Element;
!          EJ : Element_Type renames J.Node.Element;
! 
!          EI_Copy : constant Element_Type := EI;
! 
!       begin
!          EI := EJ;
!          EJ := EI_Copy;
!       end;
     end Swap;
  
     ----------------
*************** package body Ada.Containers.Doubly_Linke
*** 1200,1226 ****
        I, J      : Cursor)
     is
     begin
!       if I = No_Element
!         or else J = No_Element
        then
           raise Constraint_Error;
        end if;
  
!       if I.Container /= List_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
!       end if;
! 
!       if J.Container /= I.Container then
           raise Program_Error;
        end if;
  
-       pragma Assert (Container.Length >= 1);
- 
        if I.Node = J.Node then
           return;
        end if;
  
!       pragma Assert (Container.Length >= 2);
  
        declare
           I_Next : constant Cursor := Next (I);
--- 1545,1572 ----
        I, J      : Cursor)
     is
     begin
!       if I.Node = null
!         or else J.Node = null
        then
           raise Constraint_Error;
        end if;
  
!       if I.Container /= Container'Unrestricted_Access
!         or else I.Container /= J.Container
!       then
           raise Program_Error;
        end if;
  
        if I.Node = J.Node then
           return;
        end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (I), "bad I cursor in Swap_Links");
!       pragma Assert (Vet (J), "bad J cursor in Swap_Links");
  
        declare
           I_Next : constant Cursor := Next (I);
*************** package body Ada.Containers.Doubly_Linke
*** 1253,1264 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type)) is
     begin
!       Process (Position.Node.Element);
     end Update_Element;
  
     -----------
     -- Write --
     -----------
--- 1599,1780 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out List;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type))
!    is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unchecked_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Update_Element");
! 
!       declare
!          B : Natural renames Container.Busy;
!          L : Natural renames Container.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
+    ---------
+    -- Vet --
+    ---------
+ 
+    function Vet (Position : Cursor) return Boolean is
+    begin
+       if Position.Node = null then
+          return Position.Container = null;
+       end if;
+ 
+       if Position.Container = null then
+          return False;
+       end if;
+ 
+       if Position.Node.Next = Position.Node then
+          return False;
+       end if;
+ 
+       if Position.Node.Prev = Position.Node then
+          return False;
+       end if;
+ 
+       declare
+          L : List renames Position.Container.all;
+       begin
+          if L.Length = 0 then
+             return False;
+          end if;
+ 
+          if L.First = null then
+             return False;
+          end if;
+ 
+          if L.Last = null then
+             return False;
+          end if;
+ 
+          if L.First.Prev /= null then
+             return False;
+          end if;
+ 
+          if L.Last.Next /= null then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev = null
+            and then Position.Node /= L.First
+          then
+             return False;
+          end if;
+ 
+          if Position.Node.Next = null
+            and then Position.Node /= L.Last
+          then
+             return False;
+          end if;
+ 
+          if L.Length = 1 then
+             return L.First = L.Last;
+          end if;
+ 
+          if L.First = L.Last then
+             return False;
+          end if;
+ 
+          if L.First.Next = null then
+             return False;
+          end if;
+ 
+          if L.Last.Prev = null then
+             return False;
+          end if;
+ 
+          if L.First.Next.Prev /= L.First then
+             return False;
+          end if;
+ 
+          if L.Last.Prev.Next /= L.Last then
+             return False;
+          end if;
+ 
+          if L.Length = 2 then
+             if L.First.Next /= L.Last then
+                return False;
+             end if;
+ 
+             if L.Last.Prev /= L.First then
+                return False;
+             end if;
+ 
+             return True;
+          end if;
+ 
+          if L.First.Next = L.Last then
+             return False;
+          end if;
+ 
+          if L.Last.Prev = L.First then
+             return False;
+          end if;
+ 
+          if Position.Node = L.First then
+             return True;
+          end if;
+ 
+          if Position.Node = L.Last then
+             return True;
+          end if;
+ 
+          if Position.Node.Next = null then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev = null then
+             return False;
+          end if;
+ 
+          if Position.Node.Next.Prev /= Position.Node then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev.Next /= Position.Node then
+             return False;
+          end if;
+ 
+          if L.Length = 3 then
+             if L.First.Next /= Position.Node then
+                return False;
+             end if;
+ 
+             if L.Last.Prev /= Position.Node then
+                return False;
+             end if;
+          end if;
+ 
+          return True;
+       end;
+    end Vet;
+ 
     -----------
     -- Write --
     -----------
*************** package body Ada.Containers.Doubly_Linke
*** 1278,1282 ****
        end loop;
     end Write;
  
! end Ada.Containers.Doubly_Linked_Lists;
  
--- 1794,1805 ----
        end loop;
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Doubly_Linked_Lists;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cdlili.ads gcc-4.1.0/gcc/ada/a-cdlili.ads
*** gcc-4.0.2/gcc/ada/a-cdlili.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cdlili.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.DOUBLY_LINKED_LISTS                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --   A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 43,49 ****
        return Boolean is <>;
  
  package Ada.Containers.Doubly_Linked_Lists is
!    pragma Preelaborate (Doubly_Linked_Lists);
  
     type List is tagged private;
  
--- 43,49 ----
        return Boolean is <>;
  
  package Ada.Containers.Doubly_Linked_Lists is
!    pragma Preelaborate;
  
     type List is tagged private;
  
*************** package Ada.Containers.Doubly_Linked_Lis
*** 63,111 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type));
! 
!    procedure Replace_Element
!      (Position : Cursor;
!       By       : Element_Type);
  
     procedure Move
       (Target : in out List;
        Source : in out List);
  
!    procedure Prepend
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Append
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
     procedure Insert
       (Container : in out List;
        Before    : Cursor;
!       New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
-       Before    : Cursor;
        New_Item  : Element_Type;
-       Position  : out Cursor;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
!       Before    : Cursor;
!       Position  : out Cursor;
        Count     : Count_Type := 1);
  
     procedure Delete
--- 63,113 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out List;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out List;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Move
       (Target : in out List;
        Source : in out List);
  
!    procedure Insert
       (Container : in out List;
+       Before    : Cursor;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
+       Before    : Cursor;
        New_Item  : Element_Type;
+       Position  : out Cursor;
        Count     : Count_Type := 1);
  
     procedure Insert
       (Container : in out List;
        Before    : Cursor;
!       Position  : out Cursor;
        Count     : Count_Type := 1);
  
!    procedure Prepend
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Append
       (Container : in out List;
!       New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
     procedure Delete
*************** package Ada.Containers.Doubly_Linked_Lis
*** 121,139 ****
       (Container : in out List;
        Count     : Count_Type := 1);
  
!    generic
!       with function "<" (Left, Right : Element_Type)
!          return Boolean is <>;
!    procedure Generic_Sort (Container : in out List);
! 
!    generic
!       with function "<" (Left, Right : Element_Type)
!          return Boolean is <>;
!    procedure Generic_Merge (Target : in out List; Source : in out List);
! 
!    procedure Reverse_List (Container : in out List);
  
!    procedure Swap (I, J : in Cursor);
  
     procedure Swap_Links
       (Container : in out List;
--- 123,133 ----
       (Container : in out List;
        Count     : Count_Type := 1);
  
!    procedure Reverse_Elements (Container : in out List);
  
!    procedure Swap
!      (Container : in out List;
!       I, J      : Cursor);
  
     procedure Swap_Links
       (Container : in out List;
*************** package Ada.Containers.Doubly_Linked_Lis
*** 147,158 ****
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
!       Position : Cursor);
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
-       Source   : in out List;
        Position : Cursor);
  
     function First (Container : List) return Cursor;
--- 141,152 ----
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
!       Source   : in out List;
!       Position : in out Cursor);
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Position : Cursor);
  
     function First (Container : List) return Cursor;
*************** package Ada.Containers.Doubly_Linked_Lis
*** 163,171 ****
  
     function Last_Element (Container : List) return Element_Type;
  
!    function Contains
!      (Container : List;
!       Item      : Element_Type) return Boolean;
  
     function Find
       (Container : List;
--- 157,169 ----
  
     function Last_Element (Container : List) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
! 
!    procedure Next (Position : in out Cursor);
! 
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Previous (Position : in out Cursor);
  
     function Find
       (Container : List;
*************** package Ada.Containers.Doubly_Linked_Lis
*** 177,189 ****
        Item      : Element_Type;
        Position  : Cursor := No_Element) return Cursor;
  
!    function Next (Position : Cursor) return Cursor;
! 
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Next (Position : in out Cursor);
! 
!    procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
--- 175,183 ----
        Item      : Element_Type;
        Position  : Cursor := No_Element) return Cursor;
  
!    function Contains
!      (Container : List;
!       Item      : Element_Type) return Boolean;
  
     function Has_Element (Position : Cursor) return Boolean;
  
*************** package Ada.Containers.Doubly_Linked_Lis
*** 195,213 ****
       (Container : List;
        Process   : not null access procedure (Position : Cursor));
  
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
     type Node_Type is
!       record
           Element : Element_Type;
           Next    : Node_Access;
           Prev    : Node_Access;
        end record;
  
-    function "=" (L, R : Node_Type) return Boolean is abstract;
- 
     use Ada.Finalization;
  
     type List is
--- 189,217 ----
       (Container : List;
        Process   : not null access procedure (Position : Cursor));
  
+    generic
+       with function "<" (Left, Right : Element_Type) return Boolean is <>;
+    package Generic_Sorting is
+ 
+       function Is_Sorted (Container : List) return Boolean;
+ 
+       procedure Sort (Container : in out List);
+ 
+       procedure Merge (Target, Source : in out List);
+ 
+    end Generic_Sorting;
+ 
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
     type Node_Type is
!       limited record
           Element : Element_Type;
           Next    : Node_Access;
           Prev    : Node_Access;
        end record;
  
     use Ada.Finalization;
  
     type List is
*************** private
*** 215,220 ****
--- 219,226 ----
          First  : Node_Access;
          Last   : Node_Access;
          Length : Count_Type := 0;
+         Busy   : Natural := 0;
+         Lock   : Natural := 0;
       end record;
  
     procedure Adjust (Container : in out List);
*************** private
*** 235,241 ****
  
     for List'Write use Write;
  
!    Empty_List : constant List := List'(Controlled with null, null, 0);
  
     type List_Access is access constant List;
     for List_Access'Storage_Size use 0;
--- 241,247 ----
  
     for List'Write use Write;
  
!    Empty_List : constant List := (Controlled with null, null, 0, 0, 0);
  
     type List_Access is access constant List;
     for List_Access'Storage_Size use 0;
*************** private
*** 246,252 ****
           Node      : Node_Access;
        end record;
  
     No_Element : constant Cursor := Cursor'(null, null);
  
  end Ada.Containers.Doubly_Linked_Lists;
- 
--- 252,269 ----
           Node      : Node_Access;
        end record;
  
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
+    procedure Write
+      (Stream : access Root_Stream_Type'Class;
+       Item   : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
     No_Element : constant Cursor := Cursor'(null, null);
  
  end Ada.Containers.Doubly_Linked_Lists;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgaaso.adb gcc-4.1.0/gcc/ada/a-cgaaso.adb
*** gcc-4.0.2/gcc/ada/a-cgaaso.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgaaso.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.GENERIC_ANONYMOUS_ARRAY_SORT                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --        G E N E R I C _ A N O N Y M O U S _ A R R A Y _ S O R T           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgaaso.ads gcc-4.1.0/gcc/ada/a-cgaaso.ads
*** gcc-4.0.2/gcc/ada/a-cgaaso.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgaaso.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.GENERIC_ANONYMOUS_ARRAY_SORT                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --        G E N E R I C _ A N O N Y M O U S _ A R R A Y _ S O R T           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgarso.adb gcc-4.1.0/gcc/ada/a-cgarso.adb
*** gcc-4.0.2/gcc/ada/a-cgarso.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgarso.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.GENERIC_ARRAY_SORT                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . C O N T A I N E R S . G E N E R I C _ A R R A Y _ S O R T     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgarso.ads gcc-4.1.0/gcc/ada/a-cgarso.ads
*** gcc-4.0.2/gcc/ada/a-cgarso.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgarso.ads	Thu Jun 16 08:26:28 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.GENERIC_ARRAY_SORT                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . C O N T A I N E R S . G E N E R I C _ A R R A Y _ S O R T     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
*************** generic
*** 24,28 ****
  procedure Ada.Containers.Generic_Array_Sort (Container : in out Array_Type);
  
  pragma Pure (Ada.Containers.Generic_Array_Sort);
- 
- 
--- 24,26 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgcaso.adb gcc-4.1.0/gcc/ada/a-cgcaso.adb
*** gcc-4.0.2/gcc/ada/a-cgcaso.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgcaso.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.GENERIC_CONSTRAINED_ARRAY_SORT               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --       G E N E R I C _ C O N S T R A I N E D _ A R R A Y _ S O R T        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cgcaso.ads gcc-4.1.0/gcc/ada/a-cgcaso.ads
*** gcc-4.0.2/gcc/ada/a-cgcaso.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cgcaso.ads	Thu Jun 16 08:26:28 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.GENERIC_CONSTRAINED_ARRAY_SORT               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,9 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --       G E N E R I C _ C O N S T R A I N E D _ A R R A Y _ S O R T        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chacon.adb gcc-4.1.0/gcc/ada/a-chacon.adb
*** gcc-4.0.2/gcc/ada/a-chacon.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-chacon.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,267 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --              A D A . C H A R A C T E R S . H A N D L I N G               --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- This specification is derived from the Ada Reference Manual for use with --
+ -- GNAT. The copyright notice above, and the license provisions that follow --
+ -- apply solely to the  contents of the part following the private keyword. --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package body Ada.Characters.Conversions is
+ 
+    ------------------
+    -- Is_Character --
+    ------------------
+ 
+    function Is_Character (Item : Wide_Character) return Boolean is
+    begin
+       return Wide_Character'Pos (Item) < 256;
+    end Is_Character;
+ 
+    function Is_Character (Item : Wide_Wide_Character) return Boolean is
+    begin
+       return Wide_Wide_Character'Pos (Item) < 256;
+    end Is_Character;
+ 
+    ---------------
+    -- Is_String --
+    ---------------
+ 
+    function Is_String (Item : Wide_String) return Boolean is
+    begin
+       for J in Item'Range loop
+          if Wide_Character'Pos (Item (J)) >= 256 then
+             return False;
+          end if;
+       end loop;
+ 
+       return True;
+    end Is_String;
+ 
+    function Is_String (Item : Wide_Wide_String) return Boolean is
+    begin
+       for J in Item'Range loop
+          if Wide_Wide_Character'Pos (Item (J)) >= 256 then
+             return False;
+          end if;
+       end loop;
+ 
+       return True;
+    end Is_String;
+ 
+    -----------------------
+    -- Is_Wide_Character --
+    -----------------------
+ 
+    function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
+    begin
+       return Wide_Wide_Character'Pos (Item) < 2**16;
+    end Is_Wide_Character;
+ 
+    --------------------
+    -- Is_Wide_String --
+    --------------------
+ 
+    function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
+    begin
+       for J in Item'Range loop
+          if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
+             return False;
+          end if;
+       end loop;
+ 
+       return True;
+    end Is_Wide_String;
+ 
+    ------------------
+    -- To_Character --
+    ------------------
+ 
+    function To_Character
+      (Item       : Wide_Character;
+       Substitute : Character := ' ') return Character
+    is
+    begin
+       if Is_Character (Item) then
+          return Character'Val (Wide_Character'Pos (Item));
+       else
+          return Substitute;
+       end if;
+    end To_Character;
+ 
+    function To_Character
+      (Item       : Wide_Wide_Character;
+       Substitute : Character := ' ') return Character
+    is
+    begin
+       if Is_Character (Item) then
+          return Character'Val (Wide_Wide_Character'Pos (Item));
+       else
+          return Substitute;
+       end if;
+    end To_Character;
+ 
+    ---------------
+    -- To_String --
+    ---------------
+ 
+    function To_String
+      (Item       : Wide_String;
+       Substitute : Character := ' ') return String
+    is
+       Result : String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
+       end loop;
+ 
+       return Result;
+    end To_String;
+ 
+    function To_String
+      (Item       : Wide_Wide_String;
+       Substitute : Character := ' ') return String
+    is
+       Result : String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
+       end loop;
+ 
+       return Result;
+    end To_String;
+ 
+    -----------------------
+    -- To_Wide_Character --
+    -----------------------
+ 
+    function To_Wide_Character
+      (Item : Character) return Wide_Character
+    is
+    begin
+       return Wide_Character'Val (Character'Pos (Item));
+    end To_Wide_Character;
+ 
+    function To_Wide_Character
+      (Item       : Wide_Wide_Character;
+       Substitute : Wide_Character := ' ') return Wide_Character
+    is
+    begin
+       if Wide_Wide_Character'Pos (Item) < 2**16 then
+          return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
+       else
+          return Substitute;
+       end if;
+    end To_Wide_Character;
+ 
+    --------------------
+    -- To_Wide_String --
+    --------------------
+ 
+    function To_Wide_String
+      (Item : String) return Wide_String
+    is
+       Result : Wide_String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
+       end loop;
+ 
+       return Result;
+    end To_Wide_String;
+ 
+    function To_Wide_String
+      (Item       : Wide_Wide_String;
+       Substitute : Wide_Character := ' ') return Wide_String
+    is
+       Result : Wide_String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) :=
+            To_Wide_Character (Item (J), Substitute);
+       end loop;
+ 
+       return Result;
+    end To_Wide_String;
+ 
+    ----------------------------
+    -- To_Wide_Wide_Character --
+    ----------------------------
+ 
+    function To_Wide_Wide_Character
+      (Item : Character) return Wide_Wide_Character
+    is
+    begin
+       return Wide_Wide_Character'Val (Character'Pos (Item));
+    end To_Wide_Wide_Character;
+ 
+    function To_Wide_Wide_Character
+      (Item : Wide_Character) return Wide_Wide_Character
+    is
+    begin
+       return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
+    end To_Wide_Wide_Character;
+ 
+    -------------------------
+    -- To_Wide_Wide_String --
+    -------------------------
+ 
+    function To_Wide_Wide_String
+      (Item : String) return Wide_Wide_String
+    is
+       Result : Wide_Wide_String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
+       end loop;
+ 
+       return Result;
+    end To_Wide_Wide_String;
+ 
+    function To_Wide_Wide_String
+      (Item : Wide_String) return Wide_Wide_String
+    is
+       Result : Wide_Wide_String (1 .. Item'Length);
+ 
+    begin
+       for J in Item'Range loop
+          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
+       end loop;
+ 
+       return Result;
+    end To_Wide_Wide_String;
+ 
+ end Ada.Characters.Conversions;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chacon.ads gcc-4.1.0/gcc/ada/a-chacon.ads
*** gcc-4.0.2/gcc/ada/a-chacon.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-chacon.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,88 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --              A D A . C H A R A C T E R S . H A N D L I N G               --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- This specification is derived from the Ada Reference Manual for use with --
+ -- GNAT. The copyright notice above, and the license provisions that follow --
+ -- apply solely to the  contents of the part following the private keyword. --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package Ada.Characters.Conversions is
+    pragma Pure;
+ 
+    function Is_Character (Item : Wide_Character)      return Boolean;
+    function Is_String    (Item : Wide_String)         return Boolean;
+    function Is_Character (Item : Wide_Wide_Character) return Boolean;
+    function Is_String    (Item : Wide_Wide_String)    return Boolean;
+ 
+    function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean;
+    function Is_Wide_String    (Item : Wide_Wide_String)    return Boolean;
+ 
+    function To_Wide_Character (Item : Character) return Wide_Character;
+    function To_Wide_String    (Item : String)    return Wide_String;
+ 
+    function To_Wide_Wide_Character
+      (Item : Character) return Wide_Wide_Character;
+ 
+    function To_Wide_Wide_String
+      (Item : String) return Wide_Wide_String;
+ 
+    function To_Wide_Wide_Character
+      (Item : Wide_Character) return Wide_Wide_Character;
+ 
+    function To_Wide_Wide_String
+      (Item : Wide_String) return Wide_Wide_String;
+ 
+    function To_Character
+      (Item       : Wide_Character;
+       Substitute : Character := ' ') return Character;
+ 
+    function To_String
+      (Item       : Wide_String;
+       Substitute : Character := ' ') return String;
+ 
+    function To_Character
+      (Item       : Wide_Wide_Character;
+       Substitute : Character := ' ') return Character;
+ 
+    function To_String
+      (Item       : Wide_Wide_String;
+       Substitute : Character := ' ') return String;
+ 
+    function To_Wide_Character
+      (Item       : Wide_Wide_Character;
+       Substitute : Wide_Character := ' ') return Wide_Character;
+ 
+    function To_Wide_String
+      (Item       : Wide_Wide_String;
+       Substitute : Wide_Character := ' ') return Wide_String;
+ 
+ end Ada.Characters.Conversions;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chahan.adb gcc-4.1.0/gcc/ada/a-chahan.adb
*** gcc-4.0.2/gcc/ada/a-chahan.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-chahan.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Latin_1;      use Ada.Characters.Latin_1;
! with Ada.Strings.Maps;            use Ada.Strings.Maps;
! with Ada.Strings.Maps.Constants;  use Ada.Strings.Maps.Constants;
  
  package body Ada.Characters.Handling is
  
--- 31,39 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Latin_1;     use Ada.Characters.Latin_1;
! with Ada.Strings.Maps;           use Ada.Strings.Maps;
! with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
  
  package body Ada.Characters.Handling is
  
*************** package body Ada.Characters.Handling is
*** 304,314 ****
        return Wide_Character'Pos (Item) < 256;
     end Is_Character;
  
-    function Is_Character (Item : Wide_Wide_Character) return Boolean is
-    begin
-       return Wide_Wide_Character'Pos (Item) < 256;
-    end Is_Character;
- 
     ----------------
     -- Is_Control --
     ----------------
--- 304,309 ----
*************** package body Ada.Characters.Handling is
*** 410,426 ****
        return True;
     end Is_String;
  
-    function Is_String (Item : Wide_Wide_String) return Boolean is
-    begin
-       for J in Item'Range loop
-          if Wide_Wide_Character'Pos (Item (J)) >= 256 then
-             return False;
-          end if;
-       end loop;
- 
-       return True;
-    end Is_String;
- 
     --------------
     -- Is_Upper --
     --------------
--- 405,410 ----
*************** package body Ada.Characters.Handling is
*** 430,459 ****
        return (Char_Map (Item) and Upper) /= 0;
     end Is_Upper;
  
-    -----------------------
-    -- Is_Wide_Character --
-    -----------------------
- 
-    function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
-    begin
-       return Wide_Wide_Character'Pos (Item) < 2**16;
-    end Is_Wide_Character;
- 
-    --------------------
-    -- Is_Wide_String --
-    --------------------
- 
-    function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
-    begin
-       for J in Item'Range loop
-          if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
-             return False;
-          end if;
-       end loop;
- 
-       return True;
-    end Is_Wide_String;
- 
     --------------
     -- To_Basic --
     --------------
--- 414,419 ----
*************** package body Ada.Characters.Handling is
*** 490,507 ****
        end if;
     end To_Character;
  
-    function To_Character
-      (Item       : Wide_Wide_Character;
-       Substitute : Character := ' ') return Character
-    is
-    begin
-       if Is_Character (Item) then
-          return Character'Val (Wide_Wide_Character'Pos (Item));
-       else
-          return Substitute;
-       end if;
-    end To_Character;
- 
     ----------------
     -- To_ISO_646 --
     ----------------
--- 450,455 ----
*************** package body Ada.Characters.Handling is
*** 574,593 ****
        return Result;
     end To_String;
  
-    function To_String
-      (Item       : Wide_Wide_String;
-       Substitute : Character := ' ') return String
-    is
-       Result : String (1 .. Item'Length);
- 
-    begin
-       for J in Item'Range loop
-          Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
-       end loop;
- 
-       return Result;
-    end To_String;
- 
     --------------
     -- To_Upper --
     --------------
--- 522,527 ----
*************** package body Ada.Characters.Handling is
*** 623,640 ****
        return Wide_Character'Val (Character'Pos (Item));
     end To_Wide_Character;
  
-    function To_Wide_Character
-      (Item       : Wide_Wide_Character;
-       Substitute : Wide_Character := ' ') return Wide_Character
-    is
-    begin
-       if Wide_Wide_Character'Pos (Item) < 2**16 then
-          return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
-       else
-          return Substitute;
-       end if;
-    end To_Wide_Character;
- 
     --------------------
     -- To_Wide_String --
     --------------------
--- 557,562 ----
*************** package body Ada.Characters.Handling is
*** 652,718 ****
        return Result;
     end To_Wide_String;
  
-    function To_Wide_String
-      (Item       : Wide_Wide_String;
-       Substitute : Wide_Character := ' ') return Wide_String
-    is
-       Result : Wide_String (1 .. Item'Length);
- 
-    begin
-       for J in Item'Range loop
-          Result (J - (Item'First - 1)) :=
-            To_Wide_Character (Item (J), Substitute);
-       end loop;
- 
-       return Result;
-    end To_Wide_String;
- 
-    ----------------------------
-    -- To_Wide_Wide_Character --
-    ----------------------------
- 
-    function To_Wide_Wide_Character
-      (Item : Character) return Wide_Wide_Character
-    is
-    begin
-       return Wide_Wide_Character'Val (Character'Pos (Item));
-    end To_Wide_Wide_Character;
- 
-    function To_Wide_Wide_Character
-      (Item : Wide_Character) return Wide_Wide_Character
-    is
-    begin
-       return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
-    end To_Wide_Wide_Character;
- 
-    -------------------------
-    -- To_Wide_Wide_String --
-    -------------------------
- 
-    function To_Wide_Wide_String
-      (Item : String) return Wide_Wide_String
-    is
-       Result : Wide_Wide_String (1 .. Item'Length);
- 
-    begin
-       for J in Item'Range loop
-          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
-       end loop;
- 
-       return Result;
-    end To_Wide_Wide_String;
- 
-    function To_Wide_Wide_String
-      (Item : Wide_String) return Wide_Wide_String
-    is
-       Result : Wide_Wide_String (1 .. Item'Length);
- 
-    begin
-       for J in Item'Range loop
-          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
-       end loop;
- 
-       return Result;
-    end To_Wide_Wide_String;
- 
  end Ada.Characters.Handling;
--- 574,577 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chahan.ads gcc-4.1.0/gcc/ada/a-chahan.ads
*** gcc-4.0.2/gcc/ada/a-chahan.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-chahan.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,43 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  package Ada.Characters.Handling is
! pragma Preelaborate (Handling);
  
     ----------------------------------------
     -- Character Classification Functions --
--- 35,44 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package Ada.Characters.Handling is
!    pragma Preelaborate;
!    pragma Pure_05;
!    --  In accordance with Ada 2005 AI-362
  
     ----------------------------------------
     -- Character Classification Functions --
*************** pragma Preelaborate (Handling);
*** 90,143 ****
     -- Classifications of Wide_Character and Characters --
     ------------------------------------------------------
  
!    function Is_Character (Item : Wide_Character)           return Boolean;
!    function Is_Character (Item : Wide_Wide_Character)      return Boolean;
!    function Is_String    (Item : Wide_String)              return Boolean;
!    function Is_String    (Item : Wide_Wide_String)         return Boolean;
!    function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean;
!    function Is_Wide_String (Item : Wide_Wide_String)       return Boolean;
  
!    ---------------------------------------------------------------------------
!    -- Conversions between Wide_Wide_Character, Wide_Character and Character --
!    ---------------------------------------------------------------------------
  
!    function To_Character
!      (Item       : Wide_Character;
!       Substitute : Character := ' ')      return Character;
  
     function To_Character
!      (Item       : Wide_Wide_Character;
!       Substitute : Character := ' ')      return Character;
  
     function To_String
       (Item       : Wide_String;
!       Substitute : Character := ' ')      return String;
! 
!    function To_String
!      (Item       : Wide_Wide_String;
!       Substitute : Character := ' ')      return String;
  
     function To_Wide_Character
!      (Item : Character)                   return Wide_Character;
!    function To_Wide_Character
!      (Item       : Wide_Wide_Character;
!       Substitute : Wide_Character := ' ') return Wide_Character;
  
     function To_Wide_String
!      (Item : String)                      return Wide_String;
!    function To_Wide_String
!      (Item       : Wide_Wide_String;
!       Substitute : Wide_Character := ' ') return Wide_String;
! 
!    function To_Wide_Wide_Character
!      (Item : Character)                   return Wide_Wide_Character;
!    function To_Wide_Wide_Character
!      (Item : Wide_Character)              return Wide_Wide_Character;
! 
!    function To_Wide_Wide_String
!      (Item : String)                      return Wide_Wide_String;
!    function To_Wide_Wide_String
!      (Item : Wide_String)                 return Wide_Wide_String;
  
  private
     pragma Inline (Is_Control);
--- 91,139 ----
     -- Classifications of Wide_Character and Characters --
     ------------------------------------------------------
  
!    --  Ada 2005 AI 395: these functions are moved to Ada.Characters.Conversions
!    --  and are considered obsolete in Ada.Characters.Handling. We deal with
!    --  this by using the special Ada_05 form of pragma Obsolescent which is
!    --  only active in Ada_05 mode.
  
!    function Is_Character (Item : Wide_Character) return Boolean;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.Is_Character", Ada_05);
  
!    function Is_String (Item : Wide_String) return Boolean;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.Is_String", Ada_05);
! 
!    ------------------------------------------------------
!    -- Conversions between Wide_Character and Character --
!    ------------------------------------------------------
! 
!    --  Ada 2005 AI 395: these functions are moved to Ada.Characters.Conversions
!    --  and are considered obsolete in Ada.Characters.Handling. We deal with
!    --  this by using the special Ada_05 form of pragma Obsolescent which is
!    --  only active in Ada_05 mode.
  
     function To_Character
!      (Item       : Wide_Character;
!       Substitute : Character := ' ') return Character;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.To_Character", Ada_05);
  
     function To_String
       (Item       : Wide_String;
!       Substitute : Character := ' ') return String;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.To_String", Ada_05);
  
     function To_Wide_Character
!      (Item : Character) return Wide_Character;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.To_Wide_Character", Ada_05);
  
     function To_Wide_String
!      (Item : String)return Wide_String;
!    pragma Obsolescent
!      ("(Ada 2005) use Ada.Characters.Conversions.To_Wide_String", Ada_05);
  
  private
     pragma Inline (Is_Control);
*************** private
*** 157,162 ****
     pragma Inline (Is_Character);
     pragma Inline (To_Character);
     pragma Inline (To_Wide_Character);
-    pragma Inline (To_Wide_Wide_Character);
  
  end Ada.Characters.Handling;
--- 153,157 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-charac.ads gcc-4.1.0/gcc/ada/a-charac.ads
*** gcc-4.0.2/gcc/ada/a-charac.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-charac.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       A D A . C H A R A C T E R S                        --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       A D A . C H A R A C T E R S                        --
  --                                                                          --
***************
*** 14,19 ****
  ------------------------------------------------------------------------------
  
  package Ada.Characters is
! pragma Pure (Characters);
  
  end Ada.Characters;
--- 14,19 ----
  ------------------------------------------------------------------------------
  
  package Ada.Characters is
!    pragma Pure;
  
  end Ada.Characters;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chlat1.ads gcc-4.1.0/gcc/ada/a-chlat1.ads
*** gcc-4.0.2/gcc/ada/a-chlat1.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-chlat1.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . C H A R A C T E R S . L A T I N _ 1                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . C H A R A C T E R S . L A T I N _ 1                --
  --                                                                          --
***************
*** 14,20 ****
  ------------------------------------------------------------------------------
  
  package Ada.Characters.Latin_1 is
! pragma Pure (Latin_1);
  
     ------------------------
     -- Control Characters --
--- 14,20 ----
  ------------------------------------------------------------------------------
  
  package Ada.Characters.Latin_1 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chlat9.ads gcc-4.1.0/gcc/ada/a-chlat9.ads
*** gcc-4.0.2/gcc/ada/a-chlat9.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-chlat9.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . C H A R A C T E R S . L A T I N _ 9                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2002 Free Software Foundation, Inc.             --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . C H A R A C T E R S . L A T I N _ 9                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,46 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides definitions for Latin-9 (ISO-8859-9) analogous to
  --  those defined in the standard package Ada.Characters.Latin_1 for Latin-1.
  
  package Ada.Characters.Latin_9 is
! pragma Pure (Latin_9);
  
     ------------------------
     -- Control Characters --
--- 36,46 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides definitions for Latin-9 (ISO-8859-15) analogous to
  --  those defined in the standard package Ada.Characters.Latin_1 for Latin-1.
  
  package Ada.Characters.Latin_9 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chtgke.adb gcc-4.1.0/gcc/ada/a-chtgke.adb
*** gcc-4.0.2/gcc/ada/a-chtgke.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-chtgke.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                 ADA.CONTAINERS.HASH_TABLES.GENERIC_KEYS                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --             H A S H _ T A B L E S . G E N E R I C _ K E Y S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Containers.Hash_Tables.
*** 40,46 ****
     --------------------------
  
     procedure Delete_Key_Sans_Free
!      (HT   : in out HT_Type;
        Key  : Key_Type;
        X    : out Node_Access)
     is
--- 41,47 ----
     --------------------------
  
     procedure Delete_Key_Sans_Free
!      (HT   : in out Hash_Table_Type;
        Key  : Key_Type;
        X    : out Node_Access)
     is
*************** package body Ada.Containers.Hash_Tables.
*** 49,66 ****
  
     begin
        if HT.Length = 0 then
!          X := Null_Node;
           return;
        end if;
  
        Indx := Index (HT, Key);
        X := HT.Buckets (Indx);
  
!       if X = Null_Node then
           return;
        end if;
  
        if Equivalent_Keys (Key, X) then
           HT.Buckets (Indx) := Next (X);
           HT.Length := HT.Length - 1;
           return;
--- 50,70 ----
  
     begin
        if HT.Length = 0 then
!          X := null;
           return;
        end if;
  
        Indx := Index (HT, Key);
        X := HT.Buckets (Indx);
  
!       if X = null then
           return;
        end if;
  
        if Equivalent_Keys (Key, X) then
+          if HT.Busy > 0 then
+             raise Program_Error;
+          end if;
           HT.Buckets (Indx) := Next (X);
           HT.Length := HT.Length - 1;
           return;
*************** package body Ada.Containers.Hash_Tables.
*** 70,80 ****
           Prev := X;
           X := Next (Prev);
  
!          if X = Null_Node then
              return;
           end if;
  
           if Equivalent_Keys (Key, X) then
              Set_Next (Node => Prev, Next => Next (X));
              HT.Length := HT.Length - 1;
              return;
--- 74,87 ----
           Prev := X;
           X := Next (Prev);
  
!          if X = null then
              return;
           end if;
  
           if Equivalent_Keys (Key, X) then
+             if HT.Busy > 0 then
+                raise Program_Error;
+             end if;
              Set_Next (Node => Prev, Next => Next (X));
              HT.Length := HT.Length - 1;
              return;
*************** package body Ada.Containers.Hash_Tables.
*** 87,93 ****
     ----------
  
     function Find
!      (HT  : HT_Type;
        Key : Key_Type) return Node_Access is
  
        Indx : Hash_Type;
--- 94,100 ----
     ----------
  
     function Find
!      (HT  : Hash_Table_Type;
        Key : Key_Type) return Node_Access is
  
        Indx : Hash_Type;
*************** package body Ada.Containers.Hash_Tables.
*** 95,114 ****
  
     begin
        if HT.Length = 0 then
!          return Null_Node;
        end if;
  
        Indx := Index (HT, Key);
  
        Node := HT.Buckets (Indx);
!       while Node /= Null_Node loop
           if Equivalent_Keys (Key, Node) then
              return Node;
           end if;
           Node := Next (Node);
        end loop;
  
!       return Null_Node;
     end Find;
  
     --------------------------------
--- 102,121 ----
  
     begin
        if HT.Length = 0 then
!          return null;
        end if;
  
        Indx := Index (HT, Key);
  
        Node := HT.Buckets (Indx);
!       while Node /= null loop
           if Equivalent_Keys (Key, Node) then
              return Node;
           end if;
           Node := Next (Node);
        end loop;
  
!       return null;
     end Find;
  
     --------------------------------
*************** package body Ada.Containers.Hash_Tables.
*** 116,125 ****
     --------------------------------
  
     procedure Generic_Conditional_Insert
!      (HT      : in out HT_Type;
!       Key     : Key_Type;
!       Node    : out Node_Access;
!       Success : out Boolean)
     is
        Indx : constant Hash_Type := Index (HT, Key);
        B    : Node_Access renames HT.Buckets (Indx);
--- 123,132 ----
     --------------------------------
  
     procedure Generic_Conditional_Insert
!      (HT       : in out Hash_Table_Type;
!       Key      : Key_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean)
     is
        Indx : constant Hash_Type := Index (HT, Key);
        B    : Node_Access renames HT.Buckets (Indx);
*************** package body Ada.Containers.Hash_Tables.
*** 127,138 ****
        subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
  
     begin
!       if B = Null_Node then
           declare
              Length : constant Length_Subtype := HT.Length;
           begin
!             Node := New_Node (Next => Null_Node);
!             Success := True;
  
              B := Node;
              HT.Length := Length + 1;
--- 134,149 ----
        subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
  
     begin
!       if B = null then
!          if HT.Busy > 0 then
!             raise Program_Error;
!          end if;
! 
           declare
              Length : constant Length_Subtype := HT.Length;
           begin
!             Node := New_Node (Next => null);
!             Inserted := True;
  
              B := Node;
              HT.Length := Length + 1;
*************** package body Ada.Containers.Hash_Tables.
*** 144,163 ****
        Node := B;
        loop
           if Equivalent_Keys (Key, Node) then
!             Success := False;
              return;
           end if;
  
           Node := Next (Node);
  
!          exit when Node = Null_Node;
        end loop;
  
        declare
           Length : constant Length_Subtype := HT.Length;
        begin
           Node := New_Node (Next => B);
!          Success := True;
  
           B := Node;
           HT.Length := Length + 1;
--- 155,178 ----
        Node := B;
        loop
           if Equivalent_Keys (Key, Node) then
!             Inserted := False;
              return;
           end if;
  
           Node := Next (Node);
  
!          exit when Node = null;
        end loop;
  
+       if HT.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        declare
           Length : constant Length_Subtype := HT.Length;
        begin
           Node := New_Node (Next => B);
!          Inserted := True;
  
           B := Node;
           HT.Length := Length + 1;
*************** package body Ada.Containers.Hash_Tables.
*** 169,175 ****
     -----------
  
     function Index
!      (HT  : HT_Type;
        Key : Key_Type) return Hash_Type is
     begin
        return Hash (Key) mod HT.Buckets'Length;
--- 184,190 ----
     -----------
  
     function Index
!      (HT  : Hash_Table_Type;
        Key : Key_Type) return Hash_Type is
     begin
        return Hash (Key) mod HT.Buckets'Length;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chtgke.ads gcc-4.1.0/gcc/ada/a-chtgke.ads
*** gcc-4.0.2/gcc/ada/a-chtgke.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-chtgke.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,28 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                 ADA.CONTAINERS.HASH_TABLES.GENERIC_KEYS                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! -- This specification is adapted from the Ada Reference Manual for use with --
! -- GNAT.  In accordance with the copyright of that document, you can freely --
! -- copy and modify this specification,  provided that if you redistribute a --
! -- modified version,  any changes that you have made are clearly indicated. --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  generic
     with package HT_Types is
       new Generic_Hash_Table_Types (<>);
  
-    type HT_Type is new HT_Types.Hash_Table_Type with private;
- 
     use HT_Types;
  
-    Null_Node : Node_Access;
- 
     with function Next (Node : Node_Access) return Node_Access;
  
     with procedure Set_Next
--- 2,45 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --             H A S H _ T A B L E S . G E N E R I C _ K E Y S              --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- This specification is derived from the Ada Reference Manual for use with --
! -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the  contents of the part following the private keyword. --
  --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
  generic
     with package HT_Types is
       new Generic_Hash_Table_Types (<>);
  
     use HT_Types;
  
     with function Next (Node : Node_Access) return Node_Access;
  
     with procedure Set_Next
*************** package Ada.Containers.Hash_Tables.Gener
*** 41,64 ****
     pragma Preelaborate;
  
     function Index
!      (HT  : HT_Type;
        Key : Key_Type) return Hash_Type;
     pragma Inline (Index);
  
     procedure Delete_Key_Sans_Free
!      (HT   : in out HT_Type;
        Key  : Key_Type;
        X    : out Node_Access);
  
!    function Find (HT  : HT_Type; Key : Key_Type) return Node_Access;
  
     generic
        with function New_Node
          (Next : Node_Access) return Node_Access;
     procedure Generic_Conditional_Insert
!      (HT      : in out HT_Type;
!       Key     : Key_Type;
!       Node    : out Node_Access;
!       Success : out Boolean);
  
  end Ada.Containers.Hash_Tables.Generic_Keys;
--- 58,81 ----
     pragma Preelaborate;
  
     function Index
!      (HT  : Hash_Table_Type;
        Key : Key_Type) return Hash_Type;
     pragma Inline (Index);
  
     procedure Delete_Key_Sans_Free
!      (HT   : in out Hash_Table_Type;
        Key  : Key_Type;
        X    : out Node_Access);
  
!    function Find (HT  : Hash_Table_Type; Key : Key_Type) return Node_Access;
  
     generic
        with function New_Node
          (Next : Node_Access) return Node_Access;
     procedure Generic_Conditional_Insert
!      (HT       : in out Hash_Table_Type;
!       Key      : Key_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean);
  
  end Ada.Containers.Hash_Tables.Generic_Keys;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chtgop.adb gcc-4.1.0/gcc/ada/a-chtgop.adb
*** gcc-4.0.2/gcc/ada/a-chtgop.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-chtgop.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.HASH_TABLES.GENERIC_OPERATIONS               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 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- --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       A D A . C O N T A I N E R S .                      --
! --       H A S H _ T A B L E S . G E N E R I C _ O P E R A T I O N S        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Containers.Hash_Tables.
*** 41,54 ****
     procedure Free is
       new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);
  
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    procedure Rehash
-      (HT   : in out Hash_Table_Type;
-       Size : Hash_Type);
- 
     ------------
     -- Adjust --
     ------------
--- 42,47 ----
*************** package body Ada.Containers.Hash_Tables.
*** 68,74 ****
--- 61,69 ----
        end if;
  
        HT.Buckets := new Buckets_Type (Src_Buckets'Range);
+       --  TODO: allocate minimum size req'd.  (See note below.)
  
+       --  NOTE: see note below about these comments.
        --  Probably we have to duplicate the Size (Src), too, in order
        --  to guarantee that
  
*************** package body Ada.Containers.Hash_Tables.
*** 80,90 ****
        --  If we relax the requirement that the hash value must be the
        --  same, then of course we can't guarantee that following
        --  assignment that Dst = Src is true ???
  
        for Src_Index in Src_Buckets'Range loop
           Src_Node := Src_Buckets (Src_Index);
  
!          if Src_Node /= Null_Node then
              declare
                 Dst_Node : constant Node_Access := Copy_Node (Src_Node);
  
--- 75,104 ----
        --  If we relax the requirement that the hash value must be the
        --  same, then of course we can't guarantee that following
        --  assignment that Dst = Src is true ???
+       --
+       --  NOTE: 17 Apr 2005
+       --  What I said above is no longer true.  The semantics of (map) equality
+       --  changed, such that we use key in the left map to look up the
+       --  equivalent key in the right map, and then compare the elements (using
+       --  normal equality) of the equivalent keys.  So it doesn't matter that
+       --  the maps have different capacities (i.e. the hash tables have
+       --  different lengths), since we just look up the key, irrespective of
+       --  its map's hash table length.  All the RM says we're required to do
+       --  it arrange for the target map to "=" the source map following an
+       --  assignment (that is, following an Adjust), so it doesn't matter
+       --  what the capacity of the target map is.  What I'll probably do is
+       --  allocate a new hash table that has the minimum size necessary,
+       --  instead of allocating a new hash table whose size exactly matches
+       --  that of the source.  (See the assignment that immediately precedes
+       --  these comments.)  What we really need is a special Assign operation
+       --  (not unlike what we have already for Vector) that allows the user to
+       --  choose the capacity of the target.
+       --  END NOTE.
  
        for Src_Index in Src_Buckets'Range loop
           Src_Node := Src_Buckets (Src_Index);
  
!          if Src_Node /= null then
              declare
                 Dst_Node : constant Node_Access := Copy_Node (Src_Node);
  
*************** package body Ada.Containers.Hash_Tables.
*** 100,106 ****
              end;
  
              Src_Node := Next (Src_Node);
!             while Src_Node /= Null_Node loop
                 declare
                    Dst_Node : constant Node_Access := Copy_Node (Src_Node);
  
--- 114,120 ----
              end;
  
              Src_Node := Next (Src_Node);
!             while Src_Node /= null loop
                 declare
                    Dst_Node : constant Node_Access := Copy_Node (Src_Node);
  
*************** package body Ada.Containers.Hash_Tables.
*** 145,152 ****
        Node  : Node_Access;
  
     begin
        while HT.Length > 0 loop
!          while HT.Buckets (Index) = Null_Node loop
              Index := Index + 1;
           end loop;
  
--- 159,170 ----
        Node  : Node_Access;
  
     begin
+       if HT.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        while HT.Length > 0 loop
!          while HT.Buckets (Index) = null loop
              Index := Index + 1;
           end loop;
  
*************** package body Ada.Containers.Hash_Tables.
*** 158,164 ****
                 Bucket := Next (Bucket);
                 HT.Length := HT.Length - 1;
                 Free (Node);
!                exit when Bucket = Null_Node;
              end loop;
           end;
        end loop;
--- 176,182 ----
                 Bucket := Next (Bucket);
                 HT.Length := HT.Length - 1;
                 Free (Node);
!                exit when Bucket = null;
              end loop;
           end;
        end loop;
*************** package body Ada.Containers.Hash_Tables.
*** 172,178 ****
       (HT : in out Hash_Table_Type;
        X  : Node_Access)
     is
!       pragma Assert (X /= Null_Node);
  
        Indx : Hash_Type;
        Prev : Node_Access;
--- 190,196 ----
       (HT : in out Hash_Table_Type;
        X  : Node_Access)
     is
!       pragma Assert (X /= null);
  
        Indx : Hash_Type;
        Prev : Node_Access;
*************** package body Ada.Containers.Hash_Tables.
*** 186,192 ****
        Indx := Index (HT, X);
        Prev := HT.Buckets (Indx);
  
!       if Prev = Null_Node then
           raise Program_Error;
        end if;
  
--- 204,210 ----
        Indx := Index (HT, X);
        Prev := HT.Buckets (Indx);
  
!       if Prev = null then
           raise Program_Error;
        end if;
  
*************** package body Ada.Containers.Hash_Tables.
*** 203,209 ****
        loop
           Curr := Next (Prev);
  
!          if Curr = Null_Node then
              raise Program_Error;
           end if;
  
--- 221,227 ----
        loop
           Curr := Next (Prev);
  
!          if Curr = null then
              raise Program_Error;
           end if;
  
*************** package body Ada.Containers.Hash_Tables.
*** 217,291 ****
        end loop;
     end Delete_Node_Sans_Free;
  
-    ---------------------
-    -- Ensure_Capacity --
-    ---------------------
- 
-    procedure Ensure_Capacity
-      (HT : in out Hash_Table_Type;
-       N  : Count_Type)
-    is
-       NN : Hash_Type;
- 
-    begin
-       if N = 0 then
-          if HT.Length = 0 then
-             Free (HT.Buckets);
- 
-          elsif HT.Length < HT.Buckets'Length then
-             NN := Prime_Numbers.To_Prime (HT.Length);
- 
-             --  ASSERT: NN >= HT.Length
- 
-             if NN < HT.Buckets'Length then
-                Rehash (HT, Size => NN);
-             end if;
-          end if;
- 
-          return;
-       end if;
- 
-       if HT.Buckets = null then
-          NN := Prime_Numbers.To_Prime (N);
- 
-          --  ASSERT: NN >= N
- 
-          Rehash (HT, Size => NN);
-          return;
-       end if;
- 
-       if N <= HT.Length then
-          if HT.Length >= HT.Buckets'Length then
-             return;
-          end if;
- 
-          NN := Prime_Numbers.To_Prime (HT.Length);
- 
-          --  ASSERT: NN >= HT.Length
- 
-          if NN < HT.Buckets'Length then
-             Rehash (HT, Size => NN);
-          end if;
- 
-          return;
-       end if;
- 
-       --  ASSERT: N > HT.Length
- 
-       if N = HT.Buckets'Length then
-          return;
-       end if;
- 
-       NN := Prime_Numbers.To_Prime (N);
- 
-       --  ASSERT: NN >= N
-       --  ASSERT: NN > HT.Length
- 
-       if NN /= HT.Buckets'Length then
-          Rehash (HT, Size => NN);
-       end if;
-    end Ensure_Capacity;
- 
     --------------
     -- Finalize --
     --------------
--- 235,240 ----
*************** package body Ada.Containers.Hash_Tables.
*** 305,316 ****
  
     begin
        if HT.Length = 0 then
!          return Null_Node;
        end if;
  
        Indx := HT.Buckets'First;
        loop
!          if HT.Buckets (Indx) /= Null_Node then
              return HT.Buckets (Indx);
           end if;
  
--- 254,265 ----
  
     begin
        if HT.Length = 0 then
!          return null;
        end if;
  
        Indx := HT.Buckets'First;
        loop
!          if HT.Buckets (Indx) /= null then
              return HT.Buckets (Indx);
           end if;
  
*************** package body Ada.Containers.Hash_Tables.
*** 331,337 ****
        end if;
  
        for J in Buckets'Range loop
!          while Buckets (J) /= Null_Node loop
              Node := Buckets (J);
              Buckets (J) := Next (Node);
              Free (Node);
--- 280,286 ----
        end if;
  
        for J in Buckets'Range loop
!          while Buckets (J) /= null loop
              Node := Buckets (J);
              Buckets (J) := Next (Node);
              Free (Node);
*************** package body Ada.Containers.Hash_Tables.
*** 370,376 ****
  
        loop
           L_Node := L.Buckets (L_Index);
!          exit when L_Node /= Null_Node;
           L_Index := L_Index + 1;
        end loop;
  
--- 319,325 ----
  
        loop
           L_Node := L.Buckets (L_Index);
!          exit when L_Node /= null;
           L_Index := L_Index + 1;
        end loop;
  
*************** package body Ada.Containers.Hash_Tables.
*** 385,391 ****
  
           L_Node := Next (L_Node);
  
!          if L_Node = Null_Node then
              if N = 0 then
                 return True;
              end if;
--- 334,340 ----
  
           L_Node := Next (L_Node);
  
!          if L_Node = null then
              if N = 0 then
                 return True;
              end if;
*************** package body Ada.Containers.Hash_Tables.
*** 393,399 ****
              loop
                 L_Index := L_Index + 1;
                 L_Node := L.Buckets (L_Index);
!                exit when L_Node /= Null_Node;
              end loop;
           end if;
        end loop;
--- 342,348 ----
              loop
                 L_Index := L_Index + 1;
                 L_Node := L.Buckets (L_Index);
!                exit when L_Node /= null;
              end loop;
           end if;
        end loop;
*************** package body Ada.Containers.Hash_Tables.
*** 404,425 ****
     -----------------------
  
     procedure Generic_Iteration (HT : Hash_Table_Type) is
!       Node : Node_Access;
  
     begin
!       if HT.Buckets = null
!         or else HT.Length = 0
!       then
           return;
        end if;
  
!       for Indx in HT.Buckets'Range loop
!          Node := HT.Buckets (Indx);
!          while Node /= Null_Node loop
!             Process (Node);
!             Node := Next (Node);
           end loop;
!       end loop;
     end Generic_Iteration;
  
     ------------------
--- 353,384 ----
     -----------------------
  
     procedure Generic_Iteration (HT : Hash_Table_Type) is
!       Busy : Natural renames HT'Unrestricted_Access.all.Busy;
  
     begin
!       if HT.Length = 0 then
           return;
        end if;
  
!       Busy := Busy + 1;
! 
!       declare
!          Node : Node_Access;
!       begin
!          for Indx in HT.Buckets'Range loop
!             Node := HT.Buckets (Indx);
!             while Node /= null loop
!                Process (Node);
!                Node := Next (Node);
!             end loop;
           end loop;
!       exception
!          when others =>
!             Busy := Busy - 1;
!             raise;
!       end;
! 
!       Busy := Busy - 1;
     end Generic_Iteration;
  
     ------------------
*************** package body Ada.Containers.Hash_Tables.
*** 436,475 ****
        N, M    : Count_Type'Base;
  
     begin
-       --  As with the sorted set, it's not clear whether read is allowed to
-       --  have side effect if it fails. For now, we assume side effects are
-       --  allowed since it simplifies the algorithm ???
-       --
        Clear (HT);
  
-       declare
-          B : Buckets_Access := HT.Buckets;
-       begin
-          HT.Buckets := null;
-          HT.Length := 0;
-          Free (B); -- can this fail???
-       end;
- 
        Hash_Type'Read (Stream, Last);
  
!       if Last /= 0 then
           HT.Buckets := new Buckets_Type (0 .. Last);
        end if;
  
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
!       while N > 0 loop
           Hash_Type'Read (Stream, I);
           pragma Assert (I in HT.Buckets'Range);
!          pragma Assert (HT.Buckets (I) = Null_Node);
  
           Count_Type'Base'Read (Stream, M);
           pragma Assert (M >= 1);
           pragma Assert (M <= N);
  
           HT.Buckets (I) := New_Node (Stream);
!          pragma Assert (HT.Buckets (I) /= Null_Node);
!          pragma Assert (Next (HT.Buckets (I)) = Null_Node);
  
           Y := HT.Buckets (I);
  
--- 395,440 ----
        N, M    : Count_Type'Base;
  
     begin
        Clear (HT);
  
        Hash_Type'Read (Stream, Last);
  
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
! 
!       if N = 0 then
!          return;
!       end if;
! 
!       if HT.Buckets = null
!         or else HT.Buckets'Last /= Last
!       then
!          Free (HT.Buckets);
           HT.Buckets := new Buckets_Type (0 .. Last);
        end if;
  
!       --  TODO: should we rewrite this algorithm so that it doesn't
!       --  depend on preserving the exactly length of the hash table
!       --  array?  We would prefer to not have to (re)allocate a
!       --  buckets array (the array that HT already has might be large
!       --  enough), and to not have to stream the count of the number
!       --  of nodes in each bucket.  The algorithm below is vestigial,
!       --  as it was written prior to the meeting in Palma, when the
!       --  semantics of equality were changed (and which obviated the
!       --  need to preserve the hash table length).
! 
!       loop
           Hash_Type'Read (Stream, I);
           pragma Assert (I in HT.Buckets'Range);
!          pragma Assert (HT.Buckets (I) = null);
  
           Count_Type'Base'Read (Stream, M);
           pragma Assert (M >= 1);
           pragma Assert (M <= N);
  
           HT.Buckets (I) := New_Node (Stream);
!          pragma Assert (HT.Buckets (I) /= null);
!          pragma Assert (Next (HT.Buckets (I)) = null);
  
           Y := HT.Buckets (I);
  
*************** package body Ada.Containers.Hash_Tables.
*** 477,484 ****
  
           for J in Count_Type range 2 .. M loop
              X := New_Node (Stream);
!             pragma Assert (X /= Null_Node);
!             pragma Assert (Next (X) = Null_Node);
  
              Set_Next (Node => Y, Next => X);
              Y := X;
--- 442,449 ----
  
           for J in Count_Type range 2 .. M loop
              X := New_Node (Stream);
!             pragma Assert (X /= null);
!             pragma Assert (Next (X) = null);
  
              Set_Next (Node => Y, Next => X);
              Y := X;
*************** package body Ada.Containers.Hash_Tables.
*** 487,492 ****
--- 452,459 ----
           end loop;
  
           N := N - M;
+ 
+          exit when N = 0;
        end loop;
     end Generic_Read;
  
*************** package body Ada.Containers.Hash_Tables.
*** 514,527 ****
           return;
        end if;
  
        for Indx in HT.Buckets'Range loop
           X := HT.Buckets (Indx);
  
!          if X /= Null_Node then
              M := 1;
              loop
                 X := Next (X);
!                exit when X = Null_Node;
                 M := M + 1;
              end loop;
  
--- 481,496 ----
           return;
        end if;
  
+       --  TODO: see note in Generic_Read???
+ 
        for Indx in HT.Buckets'Range loop
           X := HT.Buckets (Indx);
  
!          if X /= null then
              M := 1;
              loop
                 X := Next (X);
!                exit when X = null;
                 M := M + 1;
              end loop;
  
*************** package body Ada.Containers.Hash_Tables.
*** 534,540 ****
                 X := Next (X);
              end loop;
  
!             pragma Assert (X = Null_Node);
           end if;
        end loop;
     end Generic_Write;
--- 503,509 ----
                 X := Next (X);
              end loop;
  
!             pragma Assert (X = null);
           end if;
        end loop;
     end Generic_Write;
*************** package body Ada.Containers.Hash_Tables.
*** 567,580 ****
           return;
        end if;
  
!       if Target.Length > 0 then
!          raise Constraint_Error;
        end if;
  
!       Free (Target.Buckets);
  
!       Target.Buckets := Source.Buckets;
!       Source.Buckets := null;
  
        Target.Length := Source.Length;
        Source.Length := 0;
--- 536,553 ----
           return;
        end if;
  
!       if Source.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       Clear (Target);
  
!       declare
!          Buckets : constant Buckets_Access := Target.Buckets;
!       begin
!          Target.Buckets := Source.Buckets;
!          Source.Buckets := Buckets;
!       end;
  
        Target.Length := Source.Length;
        Source.Length := 0;
*************** package body Ada.Containers.Hash_Tables.
*** 591,701 ****
        Result : Node_Access := Next (Node);
  
     begin
!       if Result /= Null_Node then
           return Result;
        end if;
  
        for Indx in Index (HT, Node) + 1 .. HT.Buckets'Last loop
           Result := HT.Buckets (Indx);
  
!          if Result /= Null_Node then
              return Result;
           end if;
        end loop;
  
!       return Null_Node;
     end Next;
  
!    ------------
!    -- Rehash --
!    ------------
  
!    procedure Rehash
!      (HT   : in out Hash_Table_Type;
!       Size : Hash_Type)
     is
!       subtype Buckets_Range is Hash_Type range 0 .. Size - 1;
  
!       Dst_Buckets : Buckets_Access := new Buckets_Type (Buckets_Range);
!       Src_Buckets : Buckets_Access := HT.Buckets;
  
!       L  : Count_Type renames HT.Length;
!       LL : constant Count_Type := L;
  
-    begin
-       if Src_Buckets = null then
-          pragma Assert (L = 0);
-          HT.Buckets := Dst_Buckets;
           return;
        end if;
  
!       if L = 0 then
!          HT.Buckets := Dst_Buckets;
!          Free (Src_Buckets);
           return;
        end if;
  
!       --  We might want to change this to iter from 1 .. L instead ???
  
!       for Src_Index in Src_Buckets'Range loop
  
!          declare
!             Src_Bucket : Node_Access renames Src_Buckets (Src_Index);
!          begin
!             while Src_Bucket /= Null_Node loop
!                declare
!                   Src_Node   : constant Node_Access := Src_Bucket;
!                   Dst_Index  : constant Hash_Type :=
!                                  Index (Dst_Buckets.all, Src_Node);
!                   Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);
!                begin
!                   Src_Bucket := Next (Src_Node);
!                   Set_Next (Src_Node, Dst_Bucket);
!                   Dst_Bucket := Src_Node;
!                end;
  
!                pragma Assert (L > 0);
!                L := L - 1;
  
!             end loop;
  
!          exception
!             when others =>
  
!                --  Not clear that we can deallocate the nodes,
!                --  because they may be designated by outstanding
!                --  iterators.  Which means they're now lost... ???
  
!                --                 for J in NB'Range loop
!                --                    declare
!                --                       Dst : Node_Access renames NB (J);
!                --                       X   : Node_Access;
!                --                    begin
!                --                       while Dst /= Null_Node loop
!                --                          X := Dst;
!                --                          Dst := Succ (Dst);
!                --                          Free (X);
!                --                       end loop;
!                --                    end;
!                --                 end loop;
  
  
!                Free (Dst_Buckets);
!                raise;
!          end;
  
!          --  exit when L = 0;
!          --  need to bother???
  
!       end loop;
  
!       pragma Assert (L = 0);
  
!       HT.Buckets := Dst_Buckets;
!       HT.Length := LL;
  
!       Free (Src_Buckets);
!    end Rehash;
  
! end Ada.Containers.Hash_Tables.Generic_Operations;
  
--- 564,731 ----
        Result : Node_Access := Next (Node);
  
     begin
!       if Result /= null then
           return Result;
        end if;
  
        for Indx in Index (HT, Node) + 1 .. HT.Buckets'Last loop
           Result := HT.Buckets (Indx);
  
!          if Result /= null then
              return Result;
           end if;
        end loop;
  
!       return null;
     end Next;
  
!    ----------------------
!    -- Reserve_Capacity --
!    ----------------------
  
!    procedure Reserve_Capacity
!      (HT : in out Hash_Table_Type;
!       N  : Count_Type)
     is
!       NN : Hash_Type;
  
!    begin
!       if HT.Buckets = null then
!          if N > 0 then
!             NN := Prime_Numbers.To_Prime (N);
!             HT.Buckets := new Buckets_Type (0 .. NN - 1);
!          end if;
  
!          return;
!       end if;
! 
!       if HT.Length = 0 then
!          if N = 0 then
!             Free (HT.Buckets);
!             return;
!          end if;
! 
!          if N = HT.Buckets'Length then
!             return;
!          end if;
! 
!          NN := Prime_Numbers.To_Prime (N);
! 
!          if NN = HT.Buckets'Length then
!             return;
!          end if;
! 
!          declare
!             X : Buckets_Access := HT.Buckets;
!          begin
!             HT.Buckets := new Buckets_Type (0 .. NN - 1);
!             Free (X);
!          end;
  
           return;
        end if;
  
!       if N = HT.Buckets'Length then
           return;
        end if;
  
!       if N < HT.Buckets'Length then
!          if HT.Length >= HT.Buckets'Length then
!             return;
!          end if;
  
!          NN := Prime_Numbers.To_Prime (HT.Length);
  
!          if NN >= HT.Buckets'Length then
!             return;
!          end if;
  
!       else
!          NN := Prime_Numbers.To_Prime (Count_Type'Max (N, HT.Length));
  
!          if NN = HT.Buckets'Length then -- can't expand any more
!             return;
!          end if;
!       end if;
  
!       if HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       Rehash : declare
!          Dst_Buckets : Buckets_Access := new Buckets_Type (0 .. NN - 1);
!          Src_Buckets : Buckets_Access := HT.Buckets;
  
!          L : Count_Type renames HT.Length;
!          LL : constant Count_Type := L;
  
+          Src_Index : Hash_Type := Src_Buckets'First;
  
!       begin
!          while L > 0 loop
!             declare
!                Src_Bucket : Node_Access renames Src_Buckets (Src_Index);
  
!             begin
!                while Src_Bucket /= null loop
!                   declare
!                      Src_Node : constant Node_Access := Src_Bucket;
  
!                      Dst_Index : constant Hash_Type :=
!                        Index (Dst_Buckets.all, Src_Node);
  
!                      Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);
  
!                   begin
!                      Src_Bucket := Next (Src_Node);
  
!                      Set_Next (Src_Node, Dst_Bucket);
  
!                      Dst_Bucket := Src_Node;
!                   end;
! 
!                   pragma Assert (L > 0);
!                   L := L - 1;
!                end loop;
!             exception
!                when others =>
!                   --  If there's an error computing a hash value during a
!                   --  rehash, then AI-302 says the nodes "become lost."  The
!                   --  issue is whether to actually deallocate these lost nodes,
!                   --  since they might be designated by extant cursors.  Here
!                   --  we decide to deallocate the nodes, since it's better to
!                   --  solve real problems (storage consumption) rather than
!                   --  imaginary ones (the user might, or might not, dereference
!                   --  a cursor designating a node that has been deallocated),
!                   --  and because we have a way to vet a dangling cursor
!                   --  reference anyway, and hence can actually detect the
!                   --  problem.
! 
!                   for Dst_Index in Dst_Buckets'Range loop
!                      declare
!                         B : Node_Access renames Dst_Buckets (Dst_Index);
!                         X : Node_Access;
!                      begin
!                         while B /= null loop
!                            X := B;
!                            B := Next (X);
!                            Free (X);
!                         end loop;
!                      end;
!                   end loop;
  
+                   Free (Dst_Buckets);
+                   raise Program_Error;
+             end;
+ 
+             Src_Index := Src_Index + 1;
+          end loop;
+ 
+          HT.Buckets := Dst_Buckets;
+          HT.Length := LL;
+ 
+          Free (Src_Buckets);
+       end Rehash;
+    end Reserve_Capacity;
+ 
+ end Ada.Containers.Hash_Tables.Generic_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chtgop.ads gcc-4.1.0/gcc/ada/a-chtgop.ads
*** gcc-4.0.2/gcc/ada/a-chtgop.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-chtgop.ads	Thu Jun 16 08:56:24 2005
***************
*** 2,13 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.HASH_TABLES.GENERIC_OPERATIONS               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
- --             Copyright (C) 2004 Free Software Foundation, Inc.            --
- --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
  -- copy and modify this specification,  provided that if you redistribute a --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       A D A . C O N T A I N E R S .                      --
! --       H A S H _ T A B L E S . G E N E R I C _ O P E R A T I O N S        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
  -- copy and modify this specification,  provided that if you redistribute a --
*************** generic
*** 22,33 ****
     with package HT_Types is
       new Generic_Hash_Table_Types (<>);
  
-    type Hash_Table_Type is new HT_Types.Hash_Table_Type with private;
- 
     use HT_Types;
  
-    Null_Node : in Node_Access;
- 
     with function Hash_Node (Node : Node_Access) return Hash_Type;
  
     with function Next (Node : Node_Access) return Node_Access;
--- 21,28 ----
*************** package Ada.Containers.Hash_Tables.Gener
*** 72,78 ****
  
     function Capacity (HT : Hash_Table_Type) return Count_Type;
  
!    procedure Ensure_Capacity
       (HT : in out Hash_Table_Type;
        N  : Count_Type);
  
--- 67,73 ----
  
     function Capacity (HT : Hash_Table_Type) return Count_Type;
  
!    procedure Reserve_Capacity
       (HT : in out Hash_Table_Type;
        N  : Count_Type);
  
*************** package Ada.Containers.Hash_Tables.Gener
*** 108,111 ****
        HT     : out Hash_Table_Type);
  
  end Ada.Containers.Hash_Tables.Generic_Operations;
- 
--- 103,105 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chzla1.ads gcc-4.1.0/gcc/ada/a-chzla1.ads
*** gcc-4.0.2/gcc/ada/a-chzla1.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-chzla1.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . C H A R A C T E R S . W I D E _ W I D E _ L A T I N _ 1      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . C H A R A C T E R S . W I D E _ W I D E _ L A T I N _ 1      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Wide_Latin_1 is
! pragma Pure (Wide_Wide_Latin_1);
  
     ------------------------
     -- Control Characters --
--- 37,43 ----
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Wide_Latin_1 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-chzla9.ads gcc-4.1.0/gcc/ada/a-chzla9.ads
*** gcc-4.0.2/gcc/ada/a-chzla9.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-chzla9.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . C H A R A C T E R S . W I D E _ W I D E _ L A T I N _ 9      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . C H A R A C T E R S . W I D E _ W I D E _ L A T I N _ 9      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Wide_Latin_9 is
! pragma Pure (Wide_Wide_Latin_9);
  
     ------------------------
     -- Control Characters --
--- 37,43 ----
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Wide_Latin_9 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cidlli.adb gcc-4.1.0/gcc/ada/a-cidlli.adb
*** gcc-4.0.2/gcc/ada/a-cidlli.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cidlli.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --        I N D E F I N I T E _ D O U B L Y _ L I N K E D _ L I S T S       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Unchecked_Deallocation;
*** 39,62 ****
  package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
  
     procedure Free is
-      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
- 
-    procedure Free is
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    procedure Delete_Node
!      (Container : in out List;
!       Node      : in out Node_Access);
  
     procedure Insert_Internal
       (Container : in out List;
        Before    : Node_Access;
        New_Node  : Node_Access);
  
     ---------
     -- "=" --
     ---------
--- 40,60 ----
  package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
  
     procedure Free is
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    procedure Free (X : in out Node_Access);
  
     procedure Insert_Internal
       (Container : in out List;
        Before    : Node_Access;
        New_Node  : Node_Access);
  
+    function Vet (Position : Cursor) return Boolean;
+ 
     ---------
     -- "=" --
     ---------
*************** package body Ada.Containers.Indefinite_D
*** 77,91 ****
        L := Left.First;
        R := Right.First;
        for J in 1 .. Left.Length loop
!          if L.Element = null then
!             if R.Element /= null then
!                return False;
!             end if;
! 
!          elsif R.Element = null then
!             return False;
! 
!          elsif L.Element.all /= R.Element.all then
              return False;
           end if;
  
--- 75,81 ----
        L := Left.First;
        R := Right.First;
        for J in 1 .. Left.Length loop
!          if L.Element.all /= R.Element.all then
              return False;
           end if;
  
*************** package body Ada.Containers.Indefinite_D
*** 108,113 ****
--- 98,105 ----
        if Src = null then
           pragma Assert (Container.Last = null);
           pragma Assert (Container.Length = 0);
+          pragma Assert (Container.Busy = 0);
+          pragma Assert (Container.Lock = 0);
           return;
        end if;
  
*************** package body Ada.Containers.Indefinite_D
*** 118,158 ****
        Container.First := null;
        Container.Last := null;
        Container.Length := 0;
  
!       Dst := new Node_Type'(null, null, null);
  
!       if Src.Element /= null then
           begin
!             Dst.Element := new Element_Type'(Src.Element.all);
           exception
              when others =>
!                Free (Dst);
                 raise;
           end;
-       end if;
- 
-       Container.First := Dst;
- 
-       Container.Last := Dst;
-       loop
-          Container.Length := Container.Length + 1;
-          Src := Src.Next;
-          exit when Src = null;
- 
-          Dst := new Node_Type'(null, Prev => Container.Last, Next => null);
- 
-          if Src.Element /= null then
-             begin
-                Dst.Element := new Element_Type'(Src.Element.all);
-             exception
-                when others =>
-                   Free (Dst);
-                   raise;
-             end;
-          end if;
  
           Container.Last.Next := Dst;
           Container.Last := Dst;
        end loop;
     end Adjust;
  
--- 110,149 ----
        Container.First := null;
        Container.Last := null;
        Container.Length := 0;
+       Container.Busy := 0;
+       Container.Lock := 0;
  
!       declare
!          Element : Element_Access := new Element_Type'(Src.Element.all);
!       begin
!          Dst := new Node_Type'(Element, null, null);
!       exception
!          when others =>
!             Free (Element);
!             raise;
!       end;
  
!       Container.First := Dst;
!       Container.Last := Dst;
!       Container.Length := 1;
! 
!       Src := Src.Next;
!       while Src /= null loop
!          declare
!             Element : Element_Access := new Element_Type'(Src.Element.all);
           begin
!             Dst := new Node_Type'(Element, null, Prev => Container.Last);
           exception
              when others =>
!                Free (Element);
                 raise;
           end;
  
           Container.Last.Next := Dst;
           Container.Last := Dst;
+          Container.Length := Container.Length + 1;
+ 
+          Src := Src.Next;
        end loop;
     end Adjust;
  
*************** package body Ada.Containers.Indefinite_D
*** 174,181 ****
     -----------
  
     procedure Clear (Container : in out List) is
     begin
!       Delete_Last (Container, Count => Container.Length);
     end Clear;
  
     --------------
--- 165,208 ----
     -----------
  
     procedure Clear (Container : in out List) is
+       X : Node_Access;
+ 
     begin
!       if Container.Length = 0 then
!          pragma Assert (Container.First = null);
!          pragma Assert (Container.Last = null);
!          pragma Assert (Container.Busy = 0);
!          pragma Assert (Container.Lock = 0);
!          return;
!       end if;
! 
!       pragma Assert (Container.First.Prev = null);
!       pragma Assert (Container.Last.Next = null);
! 
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       while Container.Length > 1 loop
!          X := Container.First;
!          pragma Assert (X.Next.Prev = Container.First);
! 
!          Container.First := X.Next;
!          Container.First.Prev := null;
! 
!          Container.Length := Container.Length - 1;
! 
!          Free (X);
!       end loop;
! 
!       X := Container.First;
!       pragma Assert (X = Container.Last);
! 
!       Container.First := null;
!       Container.Last := null;
!       Container.Length := 0;
! 
!       Free (X);
     end Clear;
  
     --------------
*************** package body Ada.Containers.Indefinite_D
*** 184,190 ****
  
     function Contains
       (Container : List;
!       Item      : Element_Type) return Boolean is
     begin
        return Find (Container, Item) /= No_Element;
     end Contains;
--- 211,218 ----
  
     function Contains
       (Container : List;
!       Item      : Element_Type) return Boolean
!    is
     begin
        return Find (Container, Item) /= No_Element;
     end Contains;
*************** package body Ada.Containers.Indefinite_D
*** 198,220 ****
        Position  : in out Cursor;
        Count     : Count_Type := 1)
     is
     begin
!       if Position = No_Element then
           return;
        end if;
  
!       if Position.Container /= List_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
        for Index in 1 .. Count loop
!          Delete_Node (Container, Position.Node);
  
!          if Position.Node = null then
!             Position.Container := null;
              return;
           end if;
        end loop;
     end Delete;
  
     ------------------
--- 226,286 ----
        Position  : in out Cursor;
        Count     : Count_Type := 1)
     is
+       X : Node_Access;
+ 
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Delete");
! 
!       if Position.Node = Container.First then
!          Delete_First (Container, Count);
!          Position := No_Element;  --  Post-York behavior
           return;
        end if;
  
!       if Count = 0 then
!          Position := No_Element;  --  Post-York behavior
!          return;
!       end if;
! 
!       if Container.Busy > 0 then
           raise Program_Error;
        end if;
  
        for Index in 1 .. Count loop
!          X := Position.Node;
!          Container.Length := Container.Length - 1;
  
!          if X = Container.Last then
!             Position := No_Element;
! 
!             Container.Last := X.Prev;
!             Container.Last.Next := null;
! 
!             Free (X);
              return;
           end if;
+ 
+          Position.Node := X.Next;
+ 
+          X.Next.Prev := X.Prev;
+          X.Prev.Next := X.Next;
+ 
+          Free (X);
        end loop;
+ 
+       Position := No_Element;  --  Post-York behavior
     end Delete;
  
     ------------------
*************** package body Ada.Containers.Indefinite_D
*** 225,234 ****
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       Node : Node_Access := Container.First;
     begin
!       for J in 1 .. Count_Type'Min (Count, Container.Length) loop
!          Delete_Node (Container, Node);
        end loop;
     end Delete_First;
  
--- 291,322 ----
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       X : Node_Access;
! 
     begin
!       if Count >= Container.Length then
!          Clear (Container);
!          return;
!       end if;
! 
!       if Count = 0 then
!          return;
!       end if;
! 
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       for I in 1 .. Count loop
!          X := Container.First;
!          pragma Assert (X.Next.Prev = Container.First);
! 
!          Container.First := X.Next;
!          Container.First.Prev := null;
! 
!          Container.Length := Container.Length - 1;
! 
!          Free (X);
        end loop;
     end Delete_First;
  
*************** package body Ada.Containers.Indefinite_D
*** 240,296 ****
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       Node : Node_Access;
!    begin
!       for J in 1 .. Count_Type'Min (Count, Container.Length) loop
!          Node := Container.Last;
!          Delete_Node (Container, Node);
!       end loop;
!    end Delete_Last;
! 
!    -----------------
!    -- Delete_Node --
!    -----------------
! 
!    procedure Delete_Node
!      (Container : in out List;
!       Node      : in out Node_Access)
!    is
!       X : Node_Access := Node;
  
     begin
!       Node := X.Next;
!       Container.Length := Container.Length - 1;
  
!       if X = Container.First then
!          Container.First := X.Next;
  
!          if X = Container.Last then
!             pragma Assert (Container.First = null);
!             pragma Assert (Container.Length = 0);
!             Container.Last := null;
!          else
!             pragma Assert (Container.Length > 0);
!             Container.First.Prev := null;
!          end if;
  
!       elsif X = Container.Last then
!          pragma Assert (Container.Length > 0);
  
           Container.Last := X.Prev;
           Container.Last.Next := null;
  
!       else
!          pragma Assert (Container.Length > 0);
! 
!          X.Next.Prev := X.Prev;
!          X.Prev.Next := X.Next;
! 
!       end if;
  
!       Free (X.Element);
!       Free (X);
!    end Delete_Node;
  
     -------------
     -- Element --
--- 328,361 ----
       (Container : in out List;
        Count     : Count_Type := 1)
     is
!       X : Node_Access;
  
     begin
!       if Count >= Container.Length then
!          Clear (Container);
!          return;
!       end if;
  
!       if Count = 0 then
!          return;
!       end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       for I in 1 .. Count loop
!          X := Container.Last;
!          pragma Assert (X.Prev.Next = Container.Last);
  
           Container.Last := X.Prev;
           Container.Last.Next := null;
  
!          Container.Length := Container.Length - 1;
  
!          Free (X);
!       end loop;
!    end Delete_Last;
  
     -------------
     -- Element --
*************** package body Ada.Containers.Indefinite_D
*** 298,303 ****
--- 363,378 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Position.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position), "bad cursor in Element");
+ 
        return Position.Node.Element.all;
     end Element;
  
*************** package body Ada.Containers.Indefinite_D
*** 315,328 ****
     begin
        if Node = null then
           Node := Container.First;
!       elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
        end if;
  
        while Node /= null loop
!          if Node.Element /= null
!            and then Node.Element.all = Item
!          then
              return Cursor'(Container'Unchecked_Access, Node);
           end if;
  
--- 390,410 ----
     begin
        if Node = null then
           Node := Container.First;
! 
!       else
!          if Node.Element = null then
!             raise Program_Error;
!          end if;
! 
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Position), "bad cursor in Find");
        end if;
  
        while Node /= null loop
!          if Node.Element.all = Item then
              return Cursor'(Container'Unchecked_Access, Node);
           end if;
  
*************** package body Ada.Containers.Indefinite_D
*** 351,488 ****
  
     function First_Element (Container : List) return Element_Type is
     begin
        return Container.First.Element.all;
     end First_Element;
  
!    -------------------
!    -- Generic_Merge --
!    -------------------
  
!    procedure Generic_Merge
!      (Target : in out List;
!       Source : in out List)
!    is
!       LI : Cursor;
!       RI : Cursor;
  
     begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
! 
!       LI := First (Target);
!       RI := First (Source);
!       while RI.Node /= null loop
!          if LI.Node = null then
!             Splice (Target, No_Element, Source);
!             return;
!          end if;
! 
!          if LI.Node.Element = null then
!             LI.Node := LI.Node.Next;
! 
!          elsif RI.Node.Element = null
!            or else RI.Node.Element.all < LI.Node.Element.all
!          then
!             declare
!                RJ : constant Cursor := RI;
!             begin
!                RI.Node := RI.Node.Next;
!                Splice (Target, LI, Source, RJ);
!             end;
  
!          else
!             LI.Node := LI.Node.Next;
!          end if;
!       end loop;
!    end Generic_Merge;
  
!    ------------------
!    -- Generic_Sort --
!    ------------------
  
!    procedure Generic_Sort (Container : in out List) is
!       procedure Partition (Pivot : Node_Access; Back  : Node_Access);
  
!       procedure Sort (Front, Back : Node_Access);
  
        ---------------
!       -- Partition --
        ---------------
  
!       procedure Partition (Pivot : Node_Access; Back  : Node_Access) is
!          Node : Node_Access := Pivot.Next;
  
        begin
!          while Node /= Back loop
!             if Pivot.Element = null then
!                Node := Node.Next;
  
!             elsif Node.Element = null
!               or else Node.Element.all < Pivot.Element.all
!             then
!                declare
!                   Prev : constant Node_Access := Node.Prev;
!                   Next : constant Node_Access := Node.Next;
!                begin
!                   Prev.Next := Next;
  
!                   if Next = null then
!                      Container.Last := Prev;
!                   else
!                      Next.Prev := Prev;
!                   end if;
  
!                   Node.Next := Pivot;
!                   Node.Prev := Pivot.Prev;
  
!                   Pivot.Prev := Node;
  
!                   if Node.Prev = null then
!                      Container.First := Node;
!                   else
!                      Node.Prev.Next := Node;
!                   end if;
  
!                   Node := Next;
                 end;
  
              else
!                Node := Node.Next;
              end if;
           end loop;
!       end Partition;
  
        ----------
        -- Sort --
        ----------
  
!       procedure Sort (Front, Back : Node_Access) is
!          Pivot : Node_Access;
  
        begin
!          if Front = null then
!             Pivot := Container.First;
!          else
!             Pivot := Front.Next;
           end if;
  
!          if Pivot /= Back then
!             Partition (Pivot, Back);
!             Sort (Front, Pivot);
!             Sort (Pivot, Back);
           end if;
-       end Sort;
  
!    --  Start of processing for Generic_Sort
  
!    begin
!       Sort (Front => null, Back => null);
  
!       pragma Assert (Container.Length = 0
!                        or else (Container.First.Prev = null
!                                   and Container.Last.Next = null));
!    end Generic_Sort;
  
     -----------------
     -- Has_Element --
--- 433,631 ----
  
     function First_Element (Container : List) return Element_Type is
     begin
+       if Container.First = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.First.Element.all;
     end First_Element;
  
!    ----------
!    -- Free --
!    ----------
  
!    procedure Free (X : in out Node_Access) is
!       procedure Deallocate is
!          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     begin
!       X.Next := X;
!       X.Prev := X;
  
!       begin
!          Free (X.Element);
!       exception
!          when others =>
!             X.Element := null;
!             Deallocate (X);
!             raise;
!       end;
  
!       Deallocate (X);
!    end Free;
  
!    ---------------------
!    -- Generic_Sorting --
!    ---------------------
  
!    package body Generic_Sorting is
  
        ---------------
!       -- Is_Sorted --
        ---------------
  
!       function Is_Sorted (Container : List) return Boolean is
!          Node : Node_Access := Container.First;
  
        begin
!          for I in 2 .. Container.Length loop
!             if Node.Next.Element.all < Node.Element.all then
!                return False;
!             end if;
  
!             Node := Node.Next;
!          end loop;
  
!          return True;
!       end Is_Sorted;
  
!       -----------
!       -- Merge --
!       -----------
  
!       procedure Merge
!         (Target : in out List;
!          Source : in out List)
!       is
!          LI : Cursor;
!          RI : Cursor;
  
!       begin
!          if Target'Address = Source'Address then
!             return;
!          end if;
  
!          if Target.Busy > 0
!            or else Source.Busy > 0
!          then
!             raise Program_Error;
!          end if;
! 
!          LI := First (Target);
!          RI := First (Source);
!          while RI.Node /= null loop
!             if LI.Node = null then
!                Splice (Target, No_Element, Source);
!                return;
!             end if;
! 
!             if RI.Node.Element.all < LI.Node.Element.all then
!                declare
!                   RJ : Cursor := RI;
!                begin
!                   RI.Node := RI.Node.Next;
!                   Splice (Target, LI, Source, RJ);
                 end;
  
              else
!                LI.Node := LI.Node.Next;
              end if;
           end loop;
!       end Merge;
  
        ----------
        -- Sort --
        ----------
  
!       procedure Sort (Container : in out List) is
!          procedure Partition (Pivot : Node_Access; Back  : Node_Access);
! 
!          procedure Sort (Front, Back : Node_Access);
! 
!          ---------------
!          -- Partition --
!          ---------------
! 
!          procedure Partition (Pivot : Node_Access; Back : Node_Access) is
!             Node : Node_Access := Pivot.Next;
! 
!          begin
!             while Node /= Back loop
!                if Node.Element.all < Pivot.Element.all then
!                   declare
!                      Prev : constant Node_Access := Node.Prev;
!                      Next : constant Node_Access := Node.Next;
!                   begin
!                      Prev.Next := Next;
! 
!                      if Next = null then
!                         Container.Last := Prev;
!                      else
!                         Next.Prev := Prev;
!                      end if;
! 
!                      Node.Next := Pivot;
!                      Node.Prev := Pivot.Prev;
! 
!                      Pivot.Prev := Node;
! 
!                      if Node.Prev = null then
!                         Container.First := Node;
!                      else
!                         Node.Prev.Next := Node;
!                      end if;
! 
!                      Node := Next;
!                   end;
! 
!                else
!                   Node := Node.Next;
!                end if;
!             end loop;
!          end Partition;
! 
!          ----------
!          -- Sort --
!          ----------
! 
!          procedure Sort (Front, Back : Node_Access) is
!             Pivot : Node_Access;
! 
!          begin
!             if Front = null then
!                Pivot := Container.First;
!             else
!                Pivot := Front.Next;
!             end if;
! 
!             if Pivot /= Back then
!                Partition (Pivot, Back);
!                Sort (Front, Pivot);
!                Sort (Pivot, Back);
!             end if;
!          end Sort;
! 
!       --  Start of processing for Sort
  
        begin
!          if Container.Length <= 1 then
!             return;
           end if;
  
!          pragma Assert (Container.First.Prev = null);
!          pragma Assert (Container.Last.Next = null);
! 
!          if Container.Busy > 0 then
!             raise Program_Error;
           end if;
  
!          Sort (Front => null, Back => null);
  
!          pragma Assert (Container.First.Prev = null);
!          pragma Assert (Container.Last.Next = null);
!       end Sort;
  
!    end Generic_Sorting;
  
     -----------------
     -- Has_Element --
*************** package body Ada.Containers.Indefinite_D
*** 490,496 ****
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       return Position.Container /= null and then Position.Node /= null;
     end Has_Element;
  
     ------------
--- 633,640 ----
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
     end Has_Element;
  
     ------------
*************** package body Ada.Containers.Indefinite_D
*** 507,516 ****
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
        if Count = 0 then
--- 651,668 ----
        New_Node : Node_Access;
  
     begin
!       if Before.Container /= null then
!          if Before.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          if Before.Node = null
!            or else Before.Node.Element = null
!          then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad cursor in Insert");
        end if;
  
        if Count = 0 then
*************** package body Ada.Containers.Indefinite_D
*** 518,523 ****
--- 670,683 ----
           return;
        end if;
  
+       if Container.Length > Count_Type'Last - Count then
+          raise Constraint_Error;
+       end if;
+ 
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        declare
           Element : Element_Access := new Element_Type'(New_Item);
        begin
*************** package body Ada.Containers.Indefinite_D
*** 529,535 ****
        end;
  
        Insert_Internal (Container, Before.Node, New_Node);
!       Position := Cursor'(Before.Container, New_Node);
  
        for J in Count_Type'(2) .. Count loop
  
--- 689,695 ----
        end;
  
        Insert_Internal (Container, Before.Node, New_Node);
!       Position := Cursor'(Container'Unchecked_Access, New_Node);
  
        for J in Count_Type'(2) .. Count loop
  
*************** package body Ada.Containers.Indefinite_D
*** 623,659 ****
       (Container : List;
        Process   : not null access procedure (Position : in Cursor))
     is
!       Node : Node_Access := Container.First;
!    begin
!       while Node /= null loop
!          Process (Cursor'(Container'Unchecked_Access, Node));
!          Node := Node.Next;
!       end loop;
!    end Iterate;
  
!    ----------
!    -- Move --
!    ----------
  
-    procedure Move (Target : in out List; Source : in out List) is
     begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
! 
!       if Target.Length > 0 then
!          raise Constraint_Error;
!       end if;
! 
!       Target.First := Source.First;
!       Source.First := null;
  
!       Target.Last := Source.Last;
!       Source.Last := null;
  
!       Target.Length := Source.Length;
!       Source.Length := 0;
!    end Move;
  
     ----------
     -- Last --
--- 783,809 ----
       (Container : List;
        Process   : not null access procedure (Position : in Cursor))
     is
!       C : List renames Container'Unrestricted_Access.all;
!       B : Natural renames C.Busy;
  
!       Node : Node_Access := Container.First;
  
     begin
!       B := B + 1;
  
!       begin
!          while Node /= null loop
!             Process (Cursor'(Container'Unchecked_Access, Node));
!             Node := Node.Next;
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
  
!       B := B - 1;
!    end Iterate;
  
     ----------
     -- Last --
*************** package body Ada.Containers.Indefinite_D
*** 674,679 ****
--- 824,833 ----
  
     function Last_Element (Container : List) return Element_Type is
     begin
+       if Container.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Last.Element.all;
     end Last_Element;
  
*************** package body Ada.Containers.Indefinite_D
*** 687,697 ****
--- 841,879 ----
     end Length;
  
     ----------
+    -- Move --
+    ----------
+ 
+    procedure Move (Target : in out List; Source : in out List) is
+    begin
+       if Target'Address = Source'Address then
+          return;
+       end if;
+ 
+       if Source.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
+       Clear (Target);
+ 
+       Target.First := Source.First;
+       Source.First := null;
+ 
+       Target.Last := Source.Last;
+       Source.Last := null;
+ 
+       Target.Length := Source.Length;
+       Source.Length := 0;
+    end Move;
+ 
+    ----------
     -- Next --
     ----------
  
     procedure Next (Position : in out Cursor) is
     begin
+       pragma Assert (Vet (Position), "bad cursor in procedure Next");
+ 
        if Position.Node = null then
           return;
        end if;
*************** package body Ada.Containers.Indefinite_D
*** 705,710 ****
--- 887,894 ----
  
     function Next (Position : Cursor) return Cursor is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Next");
+ 
        if Position.Node = null then
           return No_Element;
        end if;
*************** package body Ada.Containers.Indefinite_D
*** 739,744 ****
--- 923,930 ----
  
     procedure Previous (Position : in out Cursor) is
     begin
+       pragma Assert (Vet (Position), "bad cursor in procedure Previous");
+ 
        if Position.Node = null then
           return;
        end if;
*************** package body Ada.Containers.Indefinite_D
*** 752,757 ****
--- 938,945 ----
  
     function Previous (Position : Cursor) return Cursor is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Previous");
+ 
        if Position.Node = null then
           return No_Element;
        end if;
*************** package body Ada.Containers.Indefinite_D
*** 776,782 ****
        Process  : not null access procedure (Element : in Element_Type))
     is
     begin
!       Process (Position.Node.Element.all);
     end Query_Element;
  
     ----------
--- 964,1000 ----
        Process  : not null access procedure (Element : in Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       declare
!          C : List renames Position.Container.all'Unrestricted_Access.all;
!          B : Natural renames C.Busy;
!          L : Natural renames C.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element.all);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Indefinite_D
*** 787,797 ****
       (Stream : access Root_Stream_Type'Class;
        Item   : out List)
     is
!       N : Count_Type'Base;
!       X : Node_Access;
  
     begin
!       Clear (Item);  --  ???
  
        Count_Type'Base'Read (Stream, N);
  
--- 1005,1015 ----
       (Stream : access Root_Stream_Type'Class;
        Item   : out List)
     is
!       N   : Count_Type'Base;
!       Dst : Node_Access;
  
     begin
!       Clear (Item);
  
        Count_Type'Base'Read (Stream, N);
  
*************** package body Ada.Containers.Indefinite_D
*** 799,904 ****
           return;
        end if;
  
!       X := new Node_Type;
! 
        begin
!          X.Element := new Element_Type'(Element_Type'Input (Stream));
        exception
           when others =>
!             Free (X);
              raise;
        end;
  
!       Item.First := X;
! 
!       Item.Last := X;
!       loop
!          Item.Length := Item.Length + 1;
!          exit when Item.Length = N;
! 
!          X := new Node_Type;
  
           begin
!             X.Element := new Element_Type'(Element_Type'Input (Stream));
           exception
              when others =>
!                Free (X);
                 raise;
           end;
  
!          X.Prev := Item.Last;
!          Item.Last.Next := X;
!          Item.Last := X;
        end loop;
     end Read;
  
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Position : Cursor;
!       By       : Element_Type)
     is
-       X : Element_Access := Position.Node.Element;
     begin
!       Position.Node.Element := new Element_Type'(By);
!       Free (X);
!    end Replace_Element;
! 
!    ------------------
!    -- Reverse_Find --
!    ------------------
! 
!    function Reverse_Find
!      (Container : List;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
!       Node : Node_Access := Position.Node;
  
!    begin
!       if Node = null then
!          Node := Container.Last;
!       elsif Position.Container /= List_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       while Node /= null loop
!          if Node.Element /= null
!            and then Node.Element.all = Item
!          then
!             return Cursor'(Container'Unchecked_Access, Node);
!          end if;
! 
!          Node := Node.Prev;
!       end loop;
  
!       return No_Element;
!    end Reverse_Find;
  
!    ---------------------
!    -- Reverse_Iterate --
!    ---------------------
  
!    procedure Reverse_Iterate
!      (Container : List;
!       Process   : not null access procedure (Position : in Cursor))
!    is
!       Node : Node_Access := Container.Last;
  
!    begin
!       while Node /= null loop
!          Process (Cursor'(Container'Unchecked_Access, Node));
!          Node := Node.Prev;
!       end loop;
!    end Reverse_Iterate;
  
!    ------------------
!    -- Reverse_List --
!    ------------------
  
!    procedure Reverse_List (Container : in out List) is
        I : Node_Access := Container.First;
        J : Node_Access := Container.Last;
  
--- 1017,1105 ----
           return;
        end if;
  
!       declare
!          Element : Element_Access :=
!                      new Element_Type'(Element_Type'Input (Stream));
        begin
!          Dst := new Node_Type'(Element, null, null);
        exception
           when others =>
!             Free (Element);
              raise;
        end;
  
!       Item.First := Dst;
!       Item.Last := Dst;
!       Item.Length := 1;
  
+       while Item.Length < N loop
+          declare
+             Element : Element_Access :=
+                         new Element_Type'(Element_Type'Input (Stream));
           begin
!             Dst := new Node_Type'(Element, Next => null, Prev => Item.Last);
           exception
              when others =>
!                Free (Element);
                 raise;
           end;
  
!          Item.Last.Next := Dst;
!          Item.Last := Dst;
!          Item.Length := Item.Length + 1;
        end loop;
     end Read;
  
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor)
+    is
+    begin
+       raise Program_Error;
+    end Read;
+ 
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Container : in out List;
!       Position  : Cursor;
!       New_Item  : Element_Type)
     is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unchecked_Access then
           raise Program_Error;
        end if;
  
!       if Position.Container.Lock > 0 then
!          raise Program_Error;
!       end if;
  
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
  
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
  
!       declare
!          X : Element_Access := Position.Node.Element;
  
!       begin
!          Position.Node.Element := new Element_Type'(New_Item);
!          Free (X);
!       end;
!    end Replace_Element;
  
!    ----------------------
!    -- Reverse_Elements --
!    ----------------------
  
!    procedure Reverse_Elements (Container : in out List) is
        I : Node_Access := Container.First;
        J : Node_Access := Container.Last;
  
*************** package body Ada.Containers.Indefinite_D
*** 942,954 ****
           end if;
        end Swap;
  
!    --  Start of processing for Reverse_List
  
     begin
        if Container.Length <= 1 then
           return;
        end if;
  
        Container.First := J;
        Container.Last := I;
        loop
--- 1143,1162 ----
           end if;
        end Swap;
  
!    --  Start of processing for Reverse_Elements
  
     begin
        if Container.Length <= 1 then
           return;
        end if;
  
+       pragma Assert (Container.First.Prev = null);
+       pragma Assert (Container.Last.Next = null);
+ 
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        Container.First := J;
        Container.Last := I;
        loop
*************** package body Ada.Containers.Indefinite_D
*** 971,977 ****
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!    end Reverse_List;
  
     ------------
     -- Splice --
--- 1179,1253 ----
  
        pragma Assert (Container.First.Prev = null);
        pragma Assert (Container.Last.Next = null);
!    end Reverse_Elements;
! 
!    ------------------
!    -- Reverse_Find --
!    ------------------
! 
!    function Reverse_Find
!      (Container : List;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
!       Node : Node_Access := Position.Node;
! 
!    begin
!       if Node = null then
!          Node := Container.Last;
! 
!       else
!          if Node.Element = null then
!             raise Program_Error;
!          end if;
! 
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
!       end if;
! 
!       while Node /= null loop
!          if Node.Element.all = Item then
!             return Cursor'(Container'Unchecked_Access, Node);
!          end if;
! 
!          Node := Node.Prev;
!       end loop;
! 
!       return No_Element;
!    end Reverse_Find;
! 
!    ---------------------
!    -- Reverse_Iterate --
!    ---------------------
! 
!    procedure Reverse_Iterate
!      (Container : List;
!       Process   : not null access procedure (Position : in Cursor))
!    is
!       C : List renames Container'Unrestricted_Access.all;
!       B : Natural renames C.Busy;
! 
!       Node : Node_Access := Container.Last;
! 
!    begin
!       B := B + 1;
! 
!       begin
!          while Node /= null loop
!             Process (Cursor'(Container'Unchecked_Access, Node));
!             Node := Node.Prev;
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
!    end Reverse_Iterate;
  
     ------------
     -- Splice --
*************** package body Ada.Containers.Indefinite_D
*** 983,992 ****
        Source : in out List)
     is
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
        if Target'Address = Source'Address
--- 1259,1276 ----
        Source : in out List)
     is
     begin
!       if Before.Container /= null then
!          if Before.Container /= Target'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          if Before.Node = null
!            or else Before.Node.Element = null
!          then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad cursor in Splice");
        end if;
  
        if Target'Address = Source'Address
*************** package body Ada.Containers.Indefinite_D
*** 995,1002 ****
--- 1279,1301 ----
           return;
        end if;
  
+       pragma Assert (Source.First.Prev = null);
+       pragma Assert (Source.Last.Next = null);
+ 
+       if Target.Length > Count_Type'Last - Source.Length then
+          raise Constraint_Error;
+       end if;
+ 
+       if Target.Busy > 0
+         or else Source.Busy > 0
+       then
+          raise Program_Error;
+       end if;
+ 
        if Target.Length = 0 then
           pragma Assert (Before = No_Element);
+          pragma Assert (Target.First = null);
+          pragma Assert (Target.Last = null);
  
           Target.First := Source.First;
           Target.Last := Source.Last;
*************** package body Ada.Containers.Indefinite_D
*** 1018,1023 ****
--- 1317,1323 ----
           Target.First := Source.First;
  
        else
+          pragma Assert (Target.Length >= 2);
           Before.Node.Prev.Next := Source.First;
           Source.First.Prev := Before.Node.Prev;
  
*************** package body Ada.Containers.Indefinite_D
*** 1037,1177 ****
        Before   : Cursor;
        Position : Cursor)
     is
-       X : Node_Access := Position.Node;
- 
     begin
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if Position.Container /= null
!         and then Position.Container /= List_Access'(Target'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if X = null
!         or else X = Before.Node
!         or else X.Next = Before.Node
        then
           return;
        end if;
  
!       pragma Assert (Target.Length > 0);
  
        if Before.Node = null then
!          pragma Assert (X /= Target.Last);
  
!          if X = Target.First then
!             Target.First := X.Next;
              Target.First.Prev := null;
           else
!             X.Prev.Next := X.Next;
!             X.Next.Prev := X.Prev;
           end if;
  
!          Target.Last.Next := X;
!          X.Prev := Target.Last;
  
!          Target.Last := X;
           Target.Last.Next := null;
  
           return;
        end if;
  
        if Before.Node = Target.First then
!          pragma Assert (X /= Target.First);
  
!          if X = Target.Last then
!             Target.Last := X.Prev;
              Target.Last.Next := null;
           else
!             X.Prev.Next := X.Next;
!             X.Next.Prev := X.Prev;
           end if;
  
!          Target.First.Prev := X;
!          X.Next := Target.First;
  
!          Target.First := X;
           Target.First.Prev := null;
  
           return;
        end if;
  
!       if X = Target.First then
!          Target.First := X.Next;
           Target.First.Prev := null;
  
!       elsif X = Target.Last then
!          Target.Last := X.Prev;
           Target.Last.Next := null;
  
        else
!          X.Prev.Next := X.Next;
!          X.Next.Prev := X.Prev;
        end if;
  
!       Before.Node.Prev.Next := X;
!       X.Prev := Before.Node.Prev;
  
!       Before.Node.Prev := X;
!       X.Next := Before.Node;
     end Splice;
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Source   : in out List;
!       Position : Cursor)
     is
-       X : Node_Access := Position.Node;
- 
     begin
        if Target'Address = Source'Address then
           Splice (Target, Before, Position);
           return;
        end if;
  
!       if Before.Container /= null
!         and then Before.Container /= List_Access'(Target'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if Position.Container /= null
!         and then Position.Container /= List_Access'(Source'Unchecked_Access)
!       then
           raise Program_Error;
        end if;
  
!       if X = null then
!          return;
        end if;
  
!       pragma Assert (Source.Length > 0);
!       pragma Assert (Source.First.Prev = null);
!       pragma Assert (Source.Last.Next = null);
  
!       if X = Source.First then
!          Source.First := X.Next;
!          Source.First.Prev := null;
  
!          if X = Source.Last then
              pragma Assert (Source.First = null);
              pragma Assert (Source.Length = 1);
              Source.Last := null;
           end if;
  
!       elsif X = Source.Last then
!          Source.Last := X.Prev;
           Source.Last.Next := null;
  
        else
!          X.Prev.Next := X.Next;
!          X.Next.Prev := X.Prev;
        end if;
  
        if Target.Length = 0 then
--- 1337,1517 ----
        Before   : Cursor;
        Position : Cursor)
     is
     begin
!       if Before.Container /= null then
!          if Before.Container /= Target'Unchecked_Access then
!             raise Program_Error;
!          end if;
! 
!          if Before.Node = null
!            or else Before.Node.Element = null
!          then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad Before cursor in Splice");
!       end if;
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
           raise Program_Error;
        end if;
  
!       if Position.Container /= Target'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Position), "bad Position cursor in Splice");
! 
!       if Position.Node = Before.Node
!         or else Position.Node.Next = Before.Node
        then
           return;
        end if;
  
!       pragma Assert (Target.Length >= 2);
! 
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
  
        if Before.Node = null then
!          pragma Assert (Position.Node /= Target.Last);
  
!          if Position.Node = Target.First then
!             Target.First := Position.Node.Next;
              Target.First.Prev := null;
           else
!             Position.Node.Prev.Next := Position.Node.Next;
!             Position.Node.Next.Prev := Position.Node.Prev;
           end if;
  
!          Target.Last.Next := Position.Node;
!          Position.Node.Prev := Target.Last;
  
!          Target.Last := Position.Node;
           Target.Last.Next := null;
  
           return;
        end if;
  
        if Before.Node = Target.First then
!          pragma Assert (Position.Node /= Target.First);
  
!          if Position.Node = Target.Last then
!             Target.Last := Position.Node.Prev;
              Target.Last.Next := null;
           else
!             Position.Node.Prev.Next := Position.Node.Next;
!             Position.Node.Next.Prev := Position.Node.Prev;
           end if;
  
!          Target.First.Prev := Position.Node;
!          Position.Node.Next := Target.First;
  
!          Target.First := Position.Node;
           Target.First.Prev := null;
  
           return;
        end if;
  
!       if Position.Node = Target.First then
!          Target.First := Position.Node.Next;
           Target.First.Prev := null;
  
!       elsif Position.Node = Target.Last then
!          Target.Last := Position.Node.Prev;
           Target.Last.Next := null;
  
        else
!          Position.Node.Prev.Next := Position.Node.Next;
!          Position.Node.Next.Prev := Position.Node.Prev;
        end if;
  
!       Before.Node.Prev.Next := Position.Node;
!       Position.Node.Prev := Before.Node.Prev;
  
!       Before.Node.Prev := Position.Node;
!       Position.Node.Next := Before.Node;
! 
!       pragma Assert (Target.First.Prev = null);
!       pragma Assert (Target.Last.Next = null);
     end Splice;
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Source   : in out List;
!       Position : in out Cursor)
     is
     begin
        if Target'Address = Source'Address then
           Splice (Target, Before, Position);
           return;
        end if;
  
!       if Before.Container /= null then
!          if Before.Container /= Target'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          if Before.Node = null
!            or else Before.Node.Element = null
!          then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Before), "bad Before cursor in Splice");
!       end if;
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
           raise Program_Error;
        end if;
  
!       if Position.Container /= Source'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Position), "bad Position cursor in Splice");
! 
!       if Target.Length = Count_Type'Last then
!          raise Constraint_Error;
        end if;
  
!       if Target.Busy > 0
!         or else Source.Busy > 0
!       then
!          raise Program_Error;
!       end if;
  
!       if Position.Node = Source.First then
!          Source.First := Position.Node.Next;
  
!          if Position.Node = Source.Last then
              pragma Assert (Source.First = null);
              pragma Assert (Source.Length = 1);
              Source.Last := null;
+ 
+          else
+             Source.First.Prev := null;
           end if;
  
!       elsif Position.Node = Source.Last then
!          pragma Assert (Source.Length >= 2);
!          Source.Last := Position.Node.Prev;
           Source.Last.Next := null;
  
        else
!          pragma Assert (Source.Length >= 3);
!          Position.Node.Prev.Next := Position.Node.Next;
!          Position.Node.Next.Prev := Position.Node.Prev;
        end if;
  
        if Target.Length = 0 then
*************** package body Ada.Containers.Indefinite_D
*** 1179,1227 ****
           pragma Assert (Target.First = null);
           pragma Assert (Target.Last = null);
  
!          Target.First := X;
!          Target.Last := X;
  
        elsif Before.Node = null then
!          Target.Last.Next := X;
!          X.Next := Target.Last;
  
!          Target.Last := X;
           Target.Last.Next := null;
  
        elsif Before.Node = Target.First then
!          Target.First.Prev := X;
!          X.Next := Target.First;
  
!          Target.First := X;
           Target.First.Prev := null;
  
        else
!          Before.Node.Prev.Next := X;
!          X.Prev := Before.Node.Prev;
  
!          Before.Node.Prev := X;
!          X.Next := Before.Node;
        end if;
  
        Target.Length := Target.Length + 1;
        Source.Length := Source.Length - 1;
     end Splice;
  
     ----------
     -- Swap --
     ----------
  
!    procedure Swap (I, J : Cursor) is
  
!       --  Is this op legal when I and J designate elements in different
!       --  containers, or should it raise an exception (e.g. Program_Error).
  
!       EI : constant Element_Access := I.Node.Element;
  
!    begin
!       I.Node.Element := J.Node.Element;
!       J.Node.Element := EI;
     end Swap;
  
     ----------------
--- 1519,1600 ----
           pragma Assert (Target.First = null);
           pragma Assert (Target.Last = null);
  
!          Target.First := Position.Node;
!          Target.Last := Position.Node;
! 
!          Target.First.Prev := null;
!          Target.Last.Next := null;
  
        elsif Before.Node = null then
!          pragma Assert (Target.Last.Next = null);
!          Target.Last.Next := Position.Node;
!          Position.Node.Prev := Target.Last;
  
!          Target.Last := Position.Node;
           Target.Last.Next := null;
  
        elsif Before.Node = Target.First then
!          pragma Assert (Target.First.Prev = null);
!          Target.First.Prev := Position.Node;
!          Position.Node.Next := Target.First;
  
!          Target.First := Position.Node;
           Target.First.Prev := null;
  
        else
!          pragma Assert (Target.Length >= 2);
!          Before.Node.Prev.Next := Position.Node;
!          Position.Node.Prev := Before.Node.Prev;
  
!          Before.Node.Prev := Position.Node;
!          Position.Node.Next := Before.Node;
        end if;
  
        Target.Length := Target.Length + 1;
        Source.Length := Source.Length - 1;
+ 
+       Position.Container := Target'Unchecked_Access;
     end Splice;
  
     ----------
     -- Swap --
     ----------
  
!    procedure Swap
!      (Container : in out List;
!       I, J      : Cursor)
!    is
!    begin
!       if I.Node = null
!         or else J.Node = null
!       then
!          raise Constraint_Error;
!       end if;
  
!       if I.Container /= Container'Unchecked_Access
!         or else J.Container /= Container'Unchecked_Access
!       then
!          raise Program_Error;
!       end if;
  
!       if I.Node = J.Node then
!          return;
!       end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (I), "bad I cursor in Swap");
!       pragma Assert (Vet (J), "bad J cursor in Swap");
! 
!       declare
!          EI_Copy : constant Element_Access := I.Node.Element;
! 
!       begin
!          I.Node.Element := J.Node.Element;
!          J.Node.Element := EI_Copy;
!       end;
     end Swap;
  
     ----------------
*************** package body Ada.Containers.Indefinite_D
*** 1233,1259 ****
        I, J      : Cursor)
     is
     begin
!       if I = No_Element
!         or else J = No_Element
        then
           raise Constraint_Error;
        end if;
  
!       if I.Container /= List_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
!       end if;
! 
!       if J.Container /= I.Container then
           raise Program_Error;
        end if;
  
-       pragma Assert (Container.Length >= 1);
- 
        if I.Node = J.Node then
           return;
        end if;
  
!       pragma Assert (Container.Length >= 2);
  
        declare
           I_Next : constant Cursor := Next (I);
--- 1606,1633 ----
        I, J      : Cursor)
     is
     begin
!       if I.Node = null
!         or else J.Node = null
        then
           raise Constraint_Error;
        end if;
  
!       if I.Container /= Container'Unrestricted_Access
!         or else I.Container /= J.Container
!       then
           raise Program_Error;
        end if;
  
        if I.Node = J.Node then
           return;
        end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (I), "bad I cursor in Swap_Links");
!       pragma Assert (Vet (J), "bad J cursor in Swap_Links");
  
        declare
           I_Next : constant Cursor := Next (I);
*************** package body Ada.Containers.Indefinite_D
*** 1278,1283 ****
--- 1652,1660 ----
              end;
           end if;
        end;
+ 
+       pragma Assert (Container.First.Prev = null);
+       pragma Assert (Container.Last.Next = null);
     end Swap_Links;
  
     --------------------
*************** package body Ada.Containers.Indefinite_D
*** 1285,1297 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
     begin
!       Process (Position.Node.Element.all);
     end Update_Element;
  
     -----------
     -- Write --
     -----------
--- 1662,1851 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out List;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container /= Container'Unchecked_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position), "bad cursor in Update_Element");
! 
!       declare
!          B : Natural renames Container.Busy;
!          L : Natural renames Container.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element.all);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
+    ---------
+    -- Vet --
+    ---------
+ 
+    function Vet (Position : Cursor) return Boolean is
+    begin
+       if Position.Node = null then
+          return Position.Container = null;
+       end if;
+ 
+       if Position.Container = null then
+          return False;
+       end if;
+ 
+       if Position.Node.Next = Position.Node then
+          return False;
+       end if;
+ 
+       if Position.Node.Prev = Position.Node then
+          return False;
+       end if;
+ 
+       if Position.Node.Element = null then
+          return False;
+       end if;
+ 
+       declare
+          L : List renames Position.Container.all;
+       begin
+          if L.Length = 0 then
+             return False;
+          end if;
+ 
+          if L.First = null then
+             return False;
+          end if;
+ 
+          if L.Last = null then
+             return False;
+          end if;
+ 
+          if L.First.Prev /= null then
+             return False;
+          end if;
+ 
+          if L.Last.Next /= null then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev = null
+            and then Position.Node /= L.First
+          then
+             return False;
+          end if;
+ 
+          if Position.Node.Next = null
+            and then Position.Node /= L.Last
+          then
+             return False;
+          end if;
+ 
+          if L.Length = 1 then
+             return L.First = L.Last;
+          end if;
+ 
+          if L.First = L.Last then
+             return False;
+          end if;
+ 
+          if L.First.Next = null then
+             return False;
+          end if;
+ 
+          if L.Last.Prev = null then
+             return False;
+          end if;
+ 
+          if L.First.Next.Prev /= L.First then
+             return False;
+          end if;
+ 
+          if L.Last.Prev.Next /= L.Last then
+             return False;
+          end if;
+ 
+          if L.Length = 2 then
+             if L.First.Next /= L.Last then
+                return False;
+             end if;
+ 
+             if L.Last.Prev /= L.First then
+                return False;
+             end if;
+ 
+             return True;
+          end if;
+ 
+          if L.First.Next = L.Last then
+             return False;
+          end if;
+ 
+          if L.Last.Prev = L.First then
+             return False;
+          end if;
+ 
+          if Position.Node = L.First then
+             return True;
+          end if;
+ 
+          if Position.Node = L.Last then
+             return True;
+          end if;
+ 
+          if Position.Node.Next = null then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev = null then
+             return False;
+          end if;
+ 
+          if Position.Node.Next.Prev /= Position.Node then
+             return False;
+          end if;
+ 
+          if Position.Node.Prev.Next /= Position.Node then
+             return False;
+          end if;
+ 
+          if L.Length = 3 then
+             if L.First.Next /= Position.Node then
+                return False;
+             end if;
+ 
+             if L.Last.Prev /= Position.Node then
+                return False;
+             end if;
+          end if;
+ 
+          return True;
+       end;
+    end Vet;
+ 
     -----------
     -- Write --
     -----------
*************** package body Ada.Containers.Indefinite_D
*** 1301,1314 ****
        Item   : List)
     is
        Node : Node_Access := Item.First;
     begin
        Count_Type'Base'Write (Stream, Item.Length);
        while Node /= null loop
           Element_Type'Output (Stream, Node.Element.all);  --  X.all
           Node := Node.Next;
        end loop;
     end Write;
  
! end Ada.Containers.Indefinite_Doubly_Linked_Lists;
! 
  
--- 1855,1876 ----
        Item   : List)
     is
        Node : Node_Access := Item.First;
+ 
     begin
        Count_Type'Base'Write (Stream, Item.Length);
+ 
        while Node /= null loop
           Element_Type'Output (Stream, Node.Element.all);  --  X.all
           Node := Node.Next;
        end loop;
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Indefinite_Doubly_Linked_Lists;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cidlli.ads gcc-4.1.0/gcc/ada/a-cidlli.ads
*** gcc-4.0.2/gcc/ada/a-cidlli.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cidlli.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --              ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --        I N D E F I N I T E _ D O U B L Y _ L I N K E D _ L I S T S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Finalization;
*** 37,50 ****
  with Ada.Streams;
  
  generic
- 
     type Element_Type (<>) is private;
  
     with function "=" (Left, Right : Element_Type)
        return Boolean is <>;
  
  package Ada.Containers.Indefinite_Doubly_Linked_Lists is
!    pragma Preelaborate (Indefinite_Doubly_Linked_Lists);
  
     type List is tagged private;
  
--- 38,50 ----
  with Ada.Streams;
  
  generic
     type Element_Type (<>) is private;
  
     with function "=" (Left, Right : Element_Type)
        return Boolean is <>;
  
  package Ada.Containers.Indefinite_Doubly_Linked_Lists is
!    pragma Preelaborate;
  
     type List is tagged private;
  
*************** package Ada.Containers.Indefinite_Doubly
*** 62,107 ****
  
     procedure Clear (Container : in out List);
  
!    function Element (Position : Cursor)
!       return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type));
! 
!    procedure Replace_Element
!      (Position : Cursor;
!       By       : Element_Type);
  
     procedure Move
       (Target : in out List;
        Source : in out List);
  
!    procedure Prepend
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Append
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
-       Before    : Cursor;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
-       Before    : Cursor;
        New_Item  : Element_Type;
-       Position  : out Cursor;
        Count     : Count_Type := 1);
  
     procedure Delete
--- 62,108 ----
  
     procedure Clear (Container : in out List);
  
!    function Element (Position : Cursor) return Element_Type;
! 
!    procedure Replace_Element
!      (Container : in out List;
!       Position  : Cursor;
!       New_Item  : Element_Type);
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out List;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Move
       (Target : in out List;
        Source : in out List);
  
!    procedure Insert
       (Container : in out List;
+       Before    : Cursor;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Insert
       (Container : in out List;
+       Before    : Cursor;
        New_Item  : Element_Type;
+       Position  : out Cursor;
        Count     : Count_Type := 1);
  
!    procedure Prepend
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
!    procedure Append
       (Container : in out List;
        New_Item  : Element_Type;
        Count     : Count_Type := 1);
  
     procedure Delete
*************** package Ada.Containers.Indefinite_Doubly
*** 117,137 ****
       (Container : in out List;
        Count     : Count_Type := 1);
  
!    generic
!       with function "<" (Left, Right : Element_Type)
!          return Boolean is <>;
!    procedure Generic_Sort (Container : in out List);
! 
!    generic
!       with function "<" (Left, Right : Element_Type)
!          return Boolean is <>;
!    procedure Generic_Merge
!      (Target : in out List;
!       Source : in out List);
! 
!    procedure Reverse_List (Container : in out List);
  
!    procedure Swap (I, J : Cursor);
  
     procedure Swap_Links (Container : in out List; I, J : Cursor);
  
--- 118,126 ----
       (Container : in out List;
        Count     : Count_Type := 1);
  
!    procedure Reverse_Elements (Container : in out List);
  
!    procedure Swap (Container : in out List; I, J : Cursor);
  
     procedure Swap_Links (Container : in out List; I, J : Cursor);
  
*************** package Ada.Containers.Indefinite_Doubly
*** 143,154 ****
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
!       Position : Cursor);
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
-       Source   : in out List;
        Position : Cursor);
  
     function First (Container : List) return Cursor;
--- 132,143 ----
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
!       Source   : in out List;
!       Position : in out Cursor);
  
     procedure Splice
       (Target   : in out List;
        Before   : Cursor;
        Position : Cursor);
  
     function First (Container : List) return Cursor;
*************** package Ada.Containers.Indefinite_Doubly
*** 159,167 ****
  
     function Last_Element (Container : List) return Element_Type;
  
!    function Contains
!      (Container : List;
!       Item      : Element_Type) return Boolean;
  
     function Find
       (Container : List;
--- 148,160 ----
  
     function Last_Element (Container : List) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
! 
!    procedure Next (Position : in out Cursor);
! 
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Previous (Position : in out Cursor);
  
     function Find
       (Container : List;
*************** package Ada.Containers.Indefinite_Doubly
*** 173,185 ****
        Item      : Element_Type;
        Position  : Cursor := No_Element) return Cursor;
  
!    function Next (Position : Cursor) return Cursor;
! 
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Next (Position : in out Cursor);
! 
!    procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
--- 166,174 ----
        Item      : Element_Type;
        Position  : Cursor := No_Element) return Cursor;
  
!    function Contains
!      (Container : List;
!       Item      : Element_Type) return Boolean;
  
     function Has_Element (Position : Cursor) return Boolean;
  
*************** package Ada.Containers.Indefinite_Doubly
*** 191,196 ****
--- 180,197 ----
       (Container : List;
        Process   : not null access procedure (Position : Cursor));
  
+    generic
+       with function "<" (Left, Right : Element_Type) return Boolean is <>;
+    package Generic_Sorting is
+ 
+       function Is_Sorted (Container : List) return Boolean;
+ 
+       procedure Sort (Container : in out List);
+ 
+       procedure Merge (Target, Source : in out List);
+ 
+    end Generic_Sorting;
+ 
  private
     type Node_Type;
     type Node_Access is access Node_Type;
*************** private
*** 198,211 ****
     type Element_Access is access Element_Type;
  
     type Node_Type is
!       record
           Element : Element_Access;
           Next    : Node_Access;
           Prev    : Node_Access;
        end record;
  
-    function "=" (L, R : Node_Type) return Boolean is abstract;
- 
     use Ada.Finalization;
  
     type List is
--- 199,210 ----
     type Element_Access is access Element_Type;
  
     type Node_Type is
!       limited record
           Element : Element_Access;
           Next    : Node_Access;
           Prev    : Node_Access;
        end record;
  
     use Ada.Finalization;
  
     type List is
*************** private
*** 213,218 ****
--- 212,219 ----
          First  : Node_Access;
          Last   : Node_Access;
          Length : Count_Type := 0;
+         Busy   : Natural := 0;
+         Lock   : Natural := 0;
       end record;
  
     procedure Adjust (Container : in out List);
*************** private
*** 233,239 ****
  
     for List'Write use Write;
  
!    Empty_List : constant List := List'(Controlled with null, null, 0);
  
     type List_Access is access constant List;
     for List_Access'Storage_Size use 0;
--- 234,240 ----
  
     for List'Write use Write;
  
!    Empty_List : constant List := List'(Controlled with null, null, 0, 0, 0);
  
     type List_Access is access constant List;
     for List_Access'Storage_Size use 0;
*************** private
*** 244,251 ****
           Node      : Node_Access;
        end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
! end Ada.Containers.Indefinite_Doubly_Linked_Lists;
  
  
--- 245,262 ----
           Node      : Node_Access;
        end record;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
  
!    for Cursor'Read use Read;
! 
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
+    for Cursor'Write use Write;
  
+    No_Element : constant Cursor := Cursor'(null, null);
+ 
+ end Ada.Containers.Indefinite_Doubly_Linked_Lists;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cihama.adb gcc-4.1.0/gcc/ada/a-cihama.adb
*** gcc-4.0.2/gcc/ada/a-cihama.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cihama.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_HASHED_MAPS                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --               I N D E F I N I T E _ H A S H E D _ M A P S                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Unchecked_Deallocation;
*** 43,57 ****
  
  package body Ada.Containers.Indefinite_Hashed_Maps is
  
-    type Key_Access is access Key_Type;
-    type Element_Access is access Element_Type;
- 
-    type Node_Type is limited record
-       Key     : Key_Access;
-       Element : Element_Access;
-       Next    : Node_Access;
-    end record;
- 
     procedure Free_Key is
        new Ada.Unchecked_Deallocation (Key_Type, Key_Access);
  
--- 44,49 ----
*************** package body Ada.Containers.Indefinite_H
*** 65,81 ****
     function Copy_Node (Node : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Equivalent_Keys
       (Key  : Key_Type;
        Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
     function Find_Equal_Key
!      (R_Map  : Map;
        L_Node : Node_Access) return Boolean;
  
     procedure Free (X : in out Node_Access);
!    pragma Inline (Free);
  
     function Hash_Node (Node : Node_Access) return Hash_Type;
     pragma Inline (Hash_Node);
--- 57,73 ----
     function Copy_Node (Node : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Equivalent_Key_Node
       (Key  : Key_Type;
        Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Key_Node);
  
     function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
        L_Node : Node_Access) return Boolean;
  
     procedure Free (X : in out Node_Access);
!    --  pragma Inline (Free);
  
     function Hash_Node (Node : Node_Access) return Hash_Type;
     pragma Inline (Hash_Node);
*************** package body Ada.Containers.Indefinite_H
*** 89,94 ****
--- 81,88 ----
     procedure Set_Next (Node : Node_Access; Next : Node_Access);
     pragma Inline (Set_Next);
  
+    function Vet (Position : Cursor) return Boolean;
+ 
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
        Node   : Node_Access);
*************** package body Ada.Containers.Indefinite_H
*** 100,107 ****
     package HT_Ops is
        new Ada.Containers.Hash_Tables.Generic_Operations
          (HT_Types          => HT_Types,
-          Hash_Table_Type   => Map,
-          Null_Node         => null,
           Hash_Node         => Hash_Node,
           Next              => Next,
           Set_Next          => Set_Next,
--- 94,99 ----
*************** package body Ada.Containers.Indefinite_H
*** 111,123 ****
     package Key_Ops is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
-         HT_Type   => Map,
-         Null_Node => null,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Key_Type,
          Hash      => Hash,
!         Equivalent_Keys => Equivalent_Keys);
  
     ---------
     -- "=" --
--- 103,113 ----
     package Key_Ops is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Key_Type,
          Hash      => Hash,
!         Equivalent_Keys => Equivalent_Key_Node);
  
     ---------
     -- "=" --
*************** package body Ada.Containers.Indefinite_H
*** 125,150 ****
  
     function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
  
!    function "=" (Left, Right : Map) return Boolean renames Is_Equal;
  
     ------------
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) renames HT_Ops.Adjust;
  
     --------------
     -- Capacity --
     --------------
  
!    function Capacity (Container : Map)
!      return Count_Type renames HT_Ops.Capacity;
  
     -----------
     -- Clear --
     -----------
  
!    procedure Clear (Container : in out Map) renames HT_Ops.Clear;
  
     --------------
     -- Contains --
--- 115,151 ----
  
     function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
  
!    function "=" (Left, Right : Map) return Boolean is
!    begin
!       return Is_Equal (Left.HT, Right.HT);
!    end "=";
  
     ------------
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) is
!    begin
!       HT_Ops.Adjust (Container.HT);
!    end Adjust;
  
     --------------
     -- Capacity --
     --------------
  
!    function Capacity (Container : Map) return Count_Type is
!    begin
!       return HT_Ops.Capacity (Container.HT);
!    end Capacity;
  
     -----------
     -- Clear --
     -----------
  
!    procedure Clear (Container : in out Map) is
!    begin
!       HT_Ops.Clear (Container.HT);
!    end Clear;
  
     --------------
     -- Contains --
*************** package body Ada.Containers.Indefinite_H
*** 182,188 ****
        X : Node_Access;
  
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
  
        if X = null then
           raise Constraint_Error;
--- 183,189 ----
        X : Node_Access;
  
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
  
        if X = null then
           raise Constraint_Error;
*************** package body Ada.Containers.Indefinite_H
*** 193,209 ****
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Map_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
!       Free (Position.Node);
  
        Position.Container := null;
     end Delete;
  
--- 194,216 ----
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Delete");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       if Container.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
+       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
+ 
+       Free (Position.Node);
        Position.Container := null;
     end Delete;
  
*************** package body Ada.Containers.Indefinite_H
*** 212,241 ****
     -------------
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
!       C : constant Cursor := Find (Container, Key);
     begin
!       return C.Node.Element.all;
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
        return Position.Node.Element.all;
     end Element;
  
!    ---------------------
!    -- Equivalent_Keys --
!    ---------------------
  
!    function Equivalent_Keys
       (Key  : Key_Type;
        Node : Node_Access) return Boolean
     is
     begin
        return Equivalent_Keys (Key, Node.Key.all);
!    end Equivalent_Keys;
  
     function Equivalent_Keys (Left, Right : Cursor) return Boolean is
     begin
        return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
     end Equivalent_Keys;
  
--- 219,272 ----
     -------------
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
! 
     begin
!       if Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       return Node.Element.all;
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Element");
+ 
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Position.Node.Element.all;
     end Element;
  
!    -------------------------
!    -- Equivalent_Key_Node --
!    -------------------------
  
!    function Equivalent_Key_Node
       (Key  : Key_Type;
        Node : Node_Access) return Boolean
     is
     begin
        return Equivalent_Keys (Key, Node.Key.all);
!    end Equivalent_Key_Node;
! 
!    ---------------------
!    -- Equivalent_Keys --
!    ---------------------
  
     function Equivalent_Keys (Left, Right : Cursor) return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+ 
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
     end Equivalent_Keys;
  
*************** package body Ada.Containers.Indefinite_H
*** 244,249 ****
--- 275,286 ----
        Right : Key_Type) return Boolean
     is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+ 
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left.Node.Key.all, Right);
     end Equivalent_Keys;
  
*************** package body Ada.Containers.Indefinite_H
*** 252,257 ****
--- 289,300 ----
        Right : Cursor) return Boolean
     is
     begin
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+ 
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left, Right.Node.Key.all);
     end Equivalent_Keys;
  
*************** package body Ada.Containers.Indefinite_H
*** 262,268 ****
     procedure Exclude (Container : in out Map; Key : Key_Type) is
        X : Node_Access;
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
        Free (X);
     end Exclude;
  
--- 305,311 ----
     procedure Exclude (Container : in out Map; Key : Key_Type) is
        X : Node_Access;
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
        Free (X);
     end Exclude;
  
*************** package body Ada.Containers.Indefinite_H
*** 270,283 ****
     -- Finalize --
     --------------
  
!    procedure Finalize (Container : in out Map) renames HT_Ops.Finalize;
  
     ----------
     -- Find --
     ----------
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
!       Node : constant Node_Access := Key_Ops.Find (Container, Key);
  
     begin
        if Node = null then
--- 313,329 ----
     -- Finalize --
     --------------
  
!    procedure Finalize (Container : in out Map) is
!    begin
!       HT_Ops.Finalize (Container.HT);
!    end Finalize;
  
     ----------
     -- Find --
     ----------
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
  
     begin
        if Node = null then
*************** package body Ada.Containers.Indefinite_H
*** 292,302 ****
     --------------------
  
     function Find_Equal_Key
!      (R_Map  : Map;
        L_Node : Node_Access) return Boolean
     is
!       R_Index : constant Hash_Type := Key_Ops.Index (R_Map, L_Node.Key.all);
!       R_Node  : Node_Access := R_Map.Buckets (R_Index);
  
     begin
        while R_Node /= null loop
--- 338,348 ----
     --------------------
  
     function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
        L_Node : Node_Access) return Boolean
     is
!       R_Index : constant Hash_Type := Key_Ops.Index (R_HT, L_Node.Key.all);
!       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
     begin
        while R_Node /= null loop
*************** package body Ada.Containers.Indefinite_H
*** 315,321 ****
     -----------
  
     function First (Container : Map) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container);
     begin
        if Node = null then
           return No_Element;
--- 361,368 ----
     -----------
  
     function First (Container : Map) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container.HT);
! 
     begin
        if Node = null then
           return No_Element;
*************** package body Ada.Containers.Indefinite_H
*** 332,342 ****
        procedure Deallocate is
           new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
     begin
!       if X /= null then
           Free_Key (X.Key);
           Free_Element (X.Element);
!          Deallocate (X);
!       end if;
     end Free;
  
     -----------------
--- 379,418 ----
        procedure Deallocate is
           new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
     begin
!       if X = null then
!          return;
!       end if;
! 
!       X.Next := X;  --  detect mischief (in Vet)
! 
!       begin
           Free_Key (X.Key);
+       exception
+          when others =>
+             X.Key := null;
+ 
+             begin
+                Free_Element (X.Element);
+             exception
+                when others =>
+                   X.Element := null;
+             end;
+ 
+             Deallocate (X);
+             raise;
+       end;
+ 
+       begin
           Free_Element (X.Element);
!       exception
!          when others =>
!             X.Element := null;
! 
!             Deallocate (X);
!             raise;
!       end;
! 
!       Deallocate (X);
     end Free;
  
     -----------------
*************** package body Ada.Containers.Indefinite_H
*** 345,351 ****
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       return Position /= No_Element;
     end Has_Element;
  
     ---------------
--- 421,428 ----
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
     end Has_Element;
  
     ---------------
*************** package body Ada.Containers.Indefinite_H
*** 376,386 ****
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
           K := Position.Node.Key;
           E := Position.Node.Element;
  
           Position.Node.Key := new Key_Type'(Key);
!          Position.Node.Element := new Element_Type'(New_Item);
  
           Free_Key (K);
           Free_Element (E);
--- 453,474 ----
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.HT.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           K := Position.Node.Key;
           E := Position.Node.Element;
  
           Position.Node.Key := new Key_Type'(Key);
! 
!          begin
!             Position.Node.Element := new Element_Type'(New_Item);
!          exception
!             when others =>
!                Free_Key (K);
!                raise;
!          end;
  
           Free_Key (K);
           Free_Element (E);
*************** package body Ada.Containers.Indefinite_H
*** 400,406 ****
     is
        function New_Node (Next : Node_Access) return Node_Access;
  
!       procedure Insert is
          new Key_Ops.Generic_Conditional_Insert (New_Node);
  
        --------------
--- 488,494 ----
     is
        function New_Node (Next : Node_Access) return Node_Access;
  
!       procedure Local_Insert is
          new Key_Ops.Generic_Conditional_Insert (New_Node);
  
        --------------
*************** package body Ada.Containers.Indefinite_H
*** 410,415 ****
--- 498,504 ----
        function New_Node (Next : Node_Access) return Node_Access is
           K  : Key_Access := new Key_Type'(Key);
           E  : Element_Access;
+ 
        begin
           E := new Element_Type'(New_Item);
           return new Node_Type'(K, E, Next);
*************** package body Ada.Containers.Indefinite_H
*** 420,430 ****
              raise;
        end New_Node;
  
     --  Start of processing for Insert
  
     begin
!       HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
!       Insert (Container, Key, Position.Node, Inserted);
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
--- 509,531 ----
              raise;
        end New_Node;
  
+       HT : Hash_Table_Type renames Container.HT;
+ 
     --  Start of processing for Insert
  
     begin
!       if HT_Ops.Capacity (HT) = 0 then
!          HT_Ops.Reserve_Capacity (HT, 1);
!       end if;
! 
!       Local_Insert (HT, Key, Position.Node, Inserted);
! 
!       if Inserted
!         and then HT.Length > HT_Ops.Capacity (HT)
!       then
!          HT_Ops.Reserve_Capacity (HT, HT.Length);
!       end if;
! 
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
*************** package body Ada.Containers.Indefinite_H
*** 450,456 ****
  
     function Is_Empty (Container : Map) return Boolean is
     begin
!       return Container.Length = 0;
     end Is_Empty;
  
     -------------
--- 551,557 ----
  
     function Is_Empty (Container : Map) return Boolean is
     begin
!       return Container.HT.Length = 0;
     end Is_Empty;
  
     -------------
*************** package body Ada.Containers.Indefinite_H
*** 479,485 ****
     --  Start of processing Iterate
  
     begin
!       Iterate (Container);
     end Iterate;
  
     ---------
--- 580,586 ----
     --  Start of processing Iterate
  
     begin
!       Iterate (Container.HT);
     end Iterate;
  
     ---------
*************** package body Ada.Containers.Indefinite_H
*** 488,493 ****
--- 589,600 ----
  
     function Key (Position : Cursor) return Key_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Key");
+ 
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Position.Node.Key.all;
     end Key;
  
*************** package body Ada.Containers.Indefinite_H
*** 497,503 ****
  
     function Length (Container : Map) return Count_Type is
     begin
!       return Container.Length;
     end Length;
  
     ----------
--- 604,610 ----
  
     function Length (Container : Map) return Count_Type is
     begin
!       return Container.HT.Length;
     end Length;
  
     ----------
*************** package body Ada.Containers.Indefinite_H
*** 506,512 ****
  
     procedure Move
       (Target : in out Map;
!       Source : in out Map) renames HT_Ops.Move;
  
     ----------
     -- Next --
--- 613,623 ----
  
     procedure Move
       (Target : in out Map;
!       Source : in out Map)
!    is
!    begin
!       HT_Ops.Move (Target => Target.HT, Source => Source.HT);
!    end Move;
  
     ----------
     -- Next --
*************** package body Ada.Containers.Indefinite_H
*** 524,536 ****
  
     function Next (Position : Cursor) return Cursor is
     begin
!       if Position = No_Element then
           return No_Element;
        end if;
  
        declare
!          M    : Map renames Position.Container.all;
!          Node : constant Node_Access := HT_Ops.Next (M, Position.Node);
  
        begin
           if Node = null then
--- 635,649 ----
  
     function Next (Position : Cursor) return Cursor is
     begin
!       pragma Assert (Vet (Position), "bad cursor in function Next");
! 
!       if Position.Node = null then
           return No_Element;
        end if;
  
        declare
!          HT   : Hash_Table_Type renames Position.Container.HT;
!          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
  
        begin
           if Node = null then
*************** package body Ada.Containers.Indefinite_H
*** 547,556 ****
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Key.all, Position.Node.Element.all);
     end Query_Element;
  
     ----------
--- 660,702 ----
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Key     : Key_Type;
!                                             Element : Element_Type))
     is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       declare
!          M  : Map renames Position.Container.all;
!          HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
! 
!          B : Natural renames HT.Busy;
!          L : Natural renames HT.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key.all;
!             E : Element_Type renames Position.Node.Element.all;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Indefinite_H
*** 561,567 ****
  
     procedure Read
       (Stream    : access Root_Stream_Type'Class;
!       Container : out Map) renames Read_Nodes;
  
     ---------------
     -- Read_Node --
--- 707,725 ----
  
     procedure Read
       (Stream    : access Root_Stream_Type'Class;
!       Container : out Map)
!    is
!    begin
!       Read_Nodes (Stream, Container.HT);
!    end Read;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
  
     ---------------
     -- Read_Node --
*************** package body Ada.Containers.Indefinite_H
*** 602,608 ****
        Key       : Key_Type;
        New_Item  : Element_Type)
     is
!       Node : constant Node_Access := Key_Ops.Find (Container, Key);
  
        K : Key_Access;
        E : Element_Access;
--- 760,766 ----
        Key       : Key_Type;
        New_Item  : Element_Type)
     is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
  
        K : Key_Access;
        E : Element_Access;
*************** package body Ada.Containers.Indefinite_H
*** 612,622 ****
           raise Constraint_Error;
        end if;
  
        K := Node.Key;
        E := Node.Element;
  
        Node.Key := new Key_Type'(Key);
!       Node.Element := new Element_Type'(New_Item);
  
        Free_Key (K);
        Free_Element (E);
--- 770,791 ----
           raise Constraint_Error;
        end if;
  
+       if Container.HT.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        K := Node.Key;
        E := Node.Element;
  
        Node.Key := new Key_Type'(Key);
! 
!       begin
!          Node.Element := new Element_Type'(New_Item);
!       exception
!          when others =>
!             Free_Key (K);
!             raise;
!       end;
  
        Free_Key (K);
        Free_Element (E);
*************** package body Ada.Containers.Indefinite_H
*** 626,636 ****
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element (Position : Cursor; By : Element_Type) is
!       X : Element_Access := Position.Node.Element;
     begin
!       Position.Node.Element := new Element_Type'(By);
!       Free_Element (X);
     end Replace_Element;
  
     ----------------------
--- 795,827 ----
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container.HT.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       declare
!          X : Element_Access := Position.Node.Element;
! 
!       begin
!          Position.Node.Element := new Element_Type'(New_Item);
!          Free_Element (X);
!       end;
     end Replace_Element;
  
     ----------------------
*************** package body Ada.Containers.Indefinite_H
*** 639,645 ****
  
     procedure Reserve_Capacity
       (Container : in out Map;
!       Capacity  : Count_Type) renames HT_Ops.Ensure_Capacity;
  
     --------------
     -- Set_Next --
--- 830,840 ----
  
     procedure Reserve_Capacity
       (Container : in out Map;
!       Capacity  : Count_Type)
!    is
!    begin
!       HT_Ops.Reserve_Capacity (Container.HT, Capacity);
!    end Reserve_Capacity;
  
     --------------
     -- Set_Next --
*************** package body Ada.Containers.Indefinite_H
*** 655,667 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
     begin
!       Process (Position.Node.Key.all, Position.Node.Element.all);
     end Update_Element;
  
     -----------
     -- Write --
     -----------
--- 850,961 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
!                                              Element : in out Element_Type))
     is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Update_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       declare
!          HT : Hash_Table_Type renames Container.HT;
! 
!          B : Natural renames HT.Busy;
!          L : Natural renames HT.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key.all;
!             E : Element_Type renames Position.Node.Element.all;
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
+    ---------
+    -- Vet --
+    ---------
+ 
+    function Vet (Position : Cursor) return Boolean is
+    begin
+       if Position.Node = null then
+          return Position.Container = null;
+       end if;
+ 
+       if Position.Container = null then
+          return False;
+       end if;
+ 
+       if Position.Node.Next = Position.Node then
+          return False;
+       end if;
+ 
+       if Position.Node.Key = null then
+          return False;
+       end if;
+ 
+       if Position.Node.Element = null then
+          return False;
+       end if;
+ 
+       declare
+          HT : Hash_Table_Type renames Position.Container.HT;
+          X  : Node_Access;
+ 
+       begin
+          if HT.Length = 0 then
+             return False;
+          end if;
+ 
+          if HT.Buckets = null
+            or else HT.Buckets'Length = 0
+          then
+             return False;
+          end if;
+ 
+          X := HT.Buckets (Key_Ops.Index (HT, Position.Node.Key.all));
+ 
+          for J in 1 .. HT.Length loop
+             if X = Position.Node then
+                return True;
+             end if;
+ 
+             if X = null then
+                return False;
+             end if;
+ 
+             if X = X.Next then -- to prevent endless loop
+                return False;
+             end if;
+ 
+             X := X.Next;
+          end loop;
+ 
+          return False;
+       end;
+    end Vet;
+ 
     -----------
     -- Write --
     -----------
*************** package body Ada.Containers.Indefinite_H
*** 670,676 ****
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
!       Container : Map) renames Write_Nodes;
  
     ----------------
     -- Write_Node --
--- 964,982 ----
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
!       Container : Map)
!    is
!    begin
!       Write_Nodes (Stream, Container.HT);
!    end Write;
! 
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
     ----------------
     -- Write_Node --
*************** package body Ada.Containers.Indefinite_H
*** 686,689 ****
     end Write_Node;
  
  end Ada.Containers.Indefinite_Hashed_Maps;
- 
--- 992,994 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cihama.ads gcc-4.1.0/gcc/ada/a-cihama.ads
*** gcc-4.0.2/gcc/ada/a-cihama.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cihama.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_HASHED_MAPS                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --               I N D E F I N I T E _ H A S H E D _ M A P S                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,40 ****
--- 36,42 ----
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
+ with Ada.Finalization;
  
  generic
     type Key_Type (<>) is private;
*************** generic
*** 45,51 ****
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Hashed_Maps is
!    pragma Preelaborate (Indefinite_Hashed_Maps);
  
     type Map is tagged private;
     type Cursor is private;
--- 47,53 ----
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Hashed_Maps is
!    pragma Preelaborate;
  
     type Map is tagged private;
     type Cursor is private;
*************** package Ada.Containers.Indefinite_Hashed
*** 55,82 ****
  
     function "=" (Left, Right : Map) return Boolean;
  
     function Length (Container : Map) return Count_Type;
  
     function Is_Empty (Container : Map) return Boolean;
  
     procedure Clear (Container : in out Map);
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Key     : Key_Type;
                                              Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Key     : Key_Type;
                                              Element : in out Element_Type));
  
-    procedure Replace_Element
-      (Position : Cursor;
-       By       : Element_Type);
- 
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
--- 57,94 ----
  
     function "=" (Left, Right : Map) return Boolean;
  
+    function Capacity (Container : Map) return Count_Type;
+ 
+    procedure Reserve_Capacity
+      (Container : in out Map;
+       Capacity  : Count_Type);
+ 
     function Length (Container : Map) return Count_Type;
  
     function Is_Empty (Container : Map) return Boolean;
  
     procedure Clear (Container : in out Map);
  
+    function Key (Position : Cursor) return Key_Type;
+ 
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Map;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Key     : Key_Type;
                                              Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
                                              Element : in out Element_Type));
  
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
*************** package Ada.Containers.Indefinite_Hashed
*** 101,135 ****
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Delete
!      (Container : in out Map;
!       Key       : Key_Type);
! 
!    procedure Exclude
!      (Container : in out Map;
!       Key       : Key_Type);
! 
!    procedure Delete
!      (Container : in out Map;
!       Position  : in out Cursor);
! 
!    function Contains
!      (Container : Map;
!       Key       : Key_Type) return Boolean;
! 
!    function Find
!      (Container : Map;
!       Key       : Key_Type) return Cursor;
! 
!    function Element
!      (Container : Map;
!       Key       : Key_Type) return Element_Type;
  
!    function Capacity (Container : Map) return Count_Type;
  
!    procedure Reserve_Capacity
!      (Container : in out Map;
!       Capacity  : Count_Type);
  
     function First (Container : Map) return Cursor;
  
--- 113,123 ----
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Exclude (Container : in out Map; Key : Key_Type);
  
!    procedure Delete (Container : in out Map; Key : Key_Type);
  
!    procedure Delete (Container : in out Map; Position : in out Cursor);
  
     function First (Container : Map) return Cursor;
  
*************** package Ada.Containers.Indefinite_Hashed
*** 137,171 ****
  
     procedure Next (Position : in out Cursor);
  
!    function Has_Element (Position : Cursor) return Boolean;
  
!    function Key (Position : Cursor) return Key_Type;
  
!    function Equivalent_Keys (Left, Right : Cursor)
!      return Boolean;
  
!    function Equivalent_Keys
!      (Left  : Cursor;
!       Right : Key_Type) return Boolean;
  
!    function Equivalent_Keys
!      (Left  : Key_Type;
!       Right : Cursor) return Boolean;
  
     procedure Iterate
       (Container : Map;
        Process   : not null access procedure (Position : Cursor));
  
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package HT_Types is
!       new Hash_Tables.Generic_Hash_Table_Types (Node_Access);
  
!    use HT_Types;
  
!    type Map is new Hash_Table_Type with null record;
  
     procedure Adjust (Container : in out Map);
  
--- 125,185 ----
  
     procedure Next (Position : in out Cursor);
  
!    function Find (Container : Map; Key : Key_Type) return Cursor;
  
!    function Contains (Container : Map; Key : Key_Type) return Boolean;
  
!    function Element (Container : Map; Key : Key_Type) return Element_Type;
  
!    function Has_Element (Position : Cursor) return Boolean;
  
!    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
! 
!    function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
! 
!    function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
  
     procedure Iterate
       (Container : Map;
        Process   : not null access procedure (Position : Cursor));
  
  private
+    pragma Inline ("=");
+    pragma Inline (Length);
+    pragma Inline (Is_Empty);
+    pragma Inline (Clear);
+    pragma Inline (Key);
+    pragma Inline (Element);
+    pragma Inline (Move);
+    pragma Inline (Contains);
+    pragma Inline (Capacity);
+    pragma Inline (Reserve_Capacity);
+    pragma Inline (Has_Element);
+    pragma Inline (Equivalent_Keys);
+ 
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Key_Access is access Key_Type;
!    type Element_Access is access Element_Type;
  
!    type Node_Type is limited record
!       Key     : Key_Access;
!       Element : Element_Access;
!       Next    : Node_Access;
!    end record;
  
!    package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
!      (Node_Type,
!       Node_Access);
! 
!    type Map is new Ada.Finalization.Controlled with record
!       HT : HT_Types.Hash_Table_Type;
!    end record;
! 
!    use HT_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
  
     procedure Adjust (Container : in out Map);
  
*************** private
*** 180,191 ****
           Node      : Node_Access;
        end record;
  
     No_Element : constant Cursor :=
       (Container => null,
        Node      => null);
  
-    use Ada.Streams;
- 
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
        Container : Map);
--- 194,215 ----
           Node      : Node_Access;
        end record;
  
+    procedure Write
+      (Stream : access Root_Stream_Type'Class;
+       Item   : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
     No_Element : constant Cursor :=
       (Container => null,
        Node      => null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
        Container : Map);
*************** private
*** 198,206 ****
  
     for Map'Read use Read;
  
!    Empty_Map : constant Map := (Hash_Table_Type with null record);
  
  end Ada.Containers.Indefinite_Hashed_Maps;
- 
- 
- 
--- 222,227 ----
  
     for Map'Read use Read;
  
!    Empty_Map : constant Map := (Controlled with HT => (null, 0, 0, 0));
  
  end Ada.Containers.Indefinite_Hashed_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cihase.adb gcc-4.1.0/gcc/ada/a-cihase.adb
*** gcc-4.0.2/gcc/ada/a-cihase.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cihase.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_HASHED_SETS                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --               I N D E F I N I T E _ H A S H E D _ S E T S                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;  use type System.Address;
*** 45,655 ****
  
  with Ada.Containers.Prime_Numbers;
  
- with Ada.Finalization;  use Ada.Finalization;
- 
  package body Ada.Containers.Indefinite_Hashed_Sets is
  
!    type Element_Access is access Element_Type;
  
!    type Node_Type is
!       limited record
!          Element : Element_Access;
!          Next    : Node_Access;
!       end record;
  
!    function Hash_Node
!      (Node : Node_Access) return Hash_Type;
!    pragma Inline (Hash_Node);
  
!    function Hash_Node
!      (Node : Node_Access) return Hash_Type is
!    begin
!       return Hash (Node.Element.all);
!    end Hash_Node;
  
!    function Next
!      (Node : Node_Access) return Node_Access;
!    pragma Inline (Next);
  
!    function Next
!      (Node : Node_Access) return Node_Access is
!    begin
!       return Node.Next;
!    end Next;
  
!    procedure Set_Next
!      (Node : Node_Access;
!       Next : Node_Access);
!    pragma Inline (Set_Next);
  
!    procedure Set_Next
!      (Node : Node_Access;
!       Next : Node_Access) is
!    begin
!       Node.Next := Next;
!    end Set_Next;
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean is
!    begin
!       return Equivalent_Keys (Key, Node.Element.all);
!    end Equivalent_Keys;
  
!    function Copy_Node
!      (Source : Node_Access) return Node_Access;
!    pragma Inline (Copy_Node);
  
!    function Copy_Node
!      (Source : Node_Access) return Node_Access is
  
!       Target : constant Node_Access :=
!         new Node_Type'(Element => Source.Element,
!                        Next    => null);
!    begin
!       return Target;
!    end Copy_Node;
  
  
!    procedure Free_Element is
!       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
!    procedure Free (X : in out Node_Access);
  
!    procedure Free (X : in out Node_Access) is
!       procedure Deallocate is
!          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
!    begin
!       if X /= null then
!          Free_Element (X.Element);
!          Deallocate (X);
!       end if;
!    end Free;
  
     package HT_Ops is
        new Hash_Tables.Generic_Operations
!        (HT_Types          => HT_Types,
!         Hash_Table_Type   => Set,
!         Null_Node         => null,
!         Hash_Node         => Hash_Node,
!         Next              => Next,
!         Set_Next          => Set_Next,
!         Copy_Node         => Copy_Node,
!         Free              => Free);
  
     package Element_Keys is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
-         HT_Type   => Set,
-         Null_Node => null,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Element_Type,
          Hash      => Hash,
          Equivalent_Keys => Equivalent_Keys);
  
  
!    procedure Adjust (Container : in out Set) renames HT_Ops.Adjust;
! 
!    procedure Finalize (Container : in out Set) renames HT_Ops.Finalize;
! 
! 
!    function Find_Equal_Key
!      (R_Set  : Set;
!       L_Node : Node_Access) return Boolean;
  
!    function Find_Equal_Key
!      (R_Set  : Set;
!       L_Node : Node_Access) return Boolean is
  
!       R_Index : constant Hash_Type :=
!         Element_Keys.Index (R_Set, L_Node.Element.all);
  
!       R_Node  : Node_Access := R_Set.Buckets (R_Index);
  
     begin
  
!       loop
! 
!          if R_Node = null then
!             return False;
!          end if;
! 
!          if L_Node.Element.all = R_Node.Element.all then
!             return True;
!          end if;
! 
!          R_Node := Next (R_Node);
! 
!       end loop;
! 
!    end Find_Equal_Key;
! 
!    function Is_Equal is
!       new HT_Ops.Generic_Equal (Find_Equal_Key);
! 
!    function "=" (Left, Right : Set) return Boolean renames Is_Equal;
! 
  
!    function Length (Container : Set) return Count_Type is
     begin
!       return Container.Length;
!    end Length;
  
  
!    function Is_Empty (Container : Set) return Boolean is
     begin
!       return Container.Length = 0;
!    end Is_Empty;
  
  
!    procedure Clear (Container : in out Set) renames HT_Ops.Clear;
  
  
!    function Element (Position : Cursor) return Element_Type is
     begin
!       return Position.Node.Element.all;
!    end Element;
  
  
!    procedure Query_Element
!      (Position : in Cursor;
!       Process  : not null access procedure (Element : in Element_Type)) is
     begin
!       Process (Position.Node.Element.all);
!    end Query_Element;
  
  
! --  TODO:
! --     procedure Replace_Element (Container : in out Set;
! --                                Position  : in     Node_Access;
! --                                By        : in     Element_Type);
  
! --     procedure Replace_Element (Container : in out Set;
! --                                Position  : in     Node_Access;
! --                                By        : in     Element_Type) is
  
! --        Node : Node_Access := Position;
  
! --     begin
  
! --        if Equivalent_Keys (Node.Element.all, By) then
  
! --           declare
! --              X : Element_Access := Node.Element;
! --           begin
! --              Node.Element := new Element_Type'(By);
! --              --
! --              --  NOTE: If there's an exception here, then just
! --              --  let it propagate.  We haven't modified the
! --              --  state of the container, so there's nothing else
! --              --  we need to do.
  
! --              Free_Element (X);
! --           end;
  
! --           return;
  
! --        end if;
  
! --        HT_Ops.Delete_Node_Sans_Free (Container, Node);
  
! --        begin
! --           Free_Element (Node.Element);
! --        exception
! --           when others =>
! --              Node.Element := null;  --  don't attempt to dealloc X.E again
! --              Free (Node);
! --              raise;
! --        end;
  
! --        begin
! --           Node.Element := new Element_Type'(By);
! --        exception
! --           when others =>
! --              Free (Node);
! --              raise;
! --        end;
  
! --        declare
! --           function New_Node (Next : Node_Access) return Node_Access;
! --           pragma Inline (New_Node);
  
! --           function New_Node (Next : Node_Access) return Node_Access is
! --           begin
! --              Node.Next := Next;
! --              return Node;
! --           end New_Node;
  
! --           procedure Insert is
! --              new Element_Keys.Generic_Conditional_Insert (New_Node);
  
! --           Result  : Node_Access;
! --           Success : Boolean;
! --        begin
! --           Insert
! --             (HT      => Container,
! --              Key     => Node.Element.all,
! --              Node    => Result,
! --              Success => Success);
  
! --           if not Success then
! --              Free (Node);
! --              raise Program_Error;
! --           end if;
  
! --           pragma Assert (Result = Node);
! --        end;
  
! --     end Replace_Element;
  
  
! --     procedure Replace_Element (Container : in out Set;
! --                                Position  : in     Cursor;
! --                                By        : in     Element_Type) is
! --     begin
  
! --        if Position.Container = null then
! --           raise Constraint_Error;
! --        end if;
  
! --        if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --           raise Program_Error;
! --        end if;
  
! --        Replace_Element (Container, Position.Node, By);
  
! --     end Replace_Element;
  
  
!    procedure Move (Target : in out Set;
!                    Source : in out Set) renames HT_Ops.Move;
  
  
!    procedure Insert (Container : in out Set;
!                      New_Item  : in     Element_Type;
!                      Position  :    out Cursor;
!                      Inserted  :    out Boolean) is
  
!       function New_Node (Next : Node_Access) return Node_Access;
!       pragma Inline (New_Node);
  
-       function New_Node (Next : Node_Access) return Node_Access is
-          Element : Element_Access := new Element_Type'(New_Item);
        begin
!          return new Node_Type'(Element, Next);
        exception
           when others =>
!             Free_Element (Element);
              raise;
!       end New_Node;
! 
!       procedure Insert is
!         new Element_Keys.Generic_Conditional_Insert (New_Node);
! 
!    begin
! 
!       HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
!       Insert (Container, New_Item, Position.Node, Inserted);
!       Position.Container := Container'Unchecked_Access;
! 
!    end Insert;
! 
  
!    procedure Insert (Container : in out Set;
!                      New_Item  : in     Element_Type) is
  
!       Position : Cursor;
!       Inserted : Boolean;
  
     begin
  
!       Insert (Container, New_Item, Position, Inserted);
! 
!       if not Inserted then
           raise Constraint_Error;
        end if;
  
!    end Insert;
  
  
!    procedure Replace (Container : in out Set;
!                       New_Item  : in     Element_Type) is
  
!       Node : constant Node_Access :=
!         Element_Keys.Find (Container, New_Item);
  
!       X : Element_Access;
  
     begin
  
!       if Node = null then
           raise Constraint_Error;
        end if;
  
!       X := Node.Element;
! 
!       Node.Element := new Element_Type'(New_Item);
! 
!       Free_Element (X);
! 
!    end Replace;
! 
! 
!    procedure Include (Container : in out Set;
!                       New_Item  : in     Element_Type) is
! 
!       Position : Cursor;
!       Inserted : Boolean;
  
!       X : Element_Access;
  
     begin
  
!       Insert (Container, New_Item, Position, Inserted);
! 
!       if not Inserted then
! 
!          X := Position.Node.Element;
! 
!          Position.Node.Element := new Element_Type'(New_Item);
! 
!          Free_Element (X);
! 
        end if;
  
!    end Include;
! 
! 
!    procedure Delete (Container : in out Set;
!                      Item      : in     Element_Type) is
  
!       X : Node_Access;
  
     begin
  
!       Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
! 
!       if X = null then
           raise Constraint_Error;
        end if;
  
!       Free (X);
  
!    end Delete;
  
  
!    procedure Exclude (Container : in out Set;
!                       Item      : in     Element_Type) is
  
!       X : Node_Access;
  
     begin
! 
!       Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
        Free (X);
- 
     end Exclude;
  
  
!    procedure Delete (Container : in out Set;
!                      Position  : in out Cursor) is
     begin
  
!       if Position = No_Element then
!          return;
!       end if;
! 
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
!       end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
!       Free (Position.Node);
  
!       Position.Container := null;
  
!    end Delete;
  
  
  
!    procedure Union (Target : in out Set;
!                     Source : in     Set) is
  
!       procedure Process (Src_Node : in Node_Access);
  
!       procedure Process (Src_Node : in Node_Access) is
  
!          Src : Element_Type renames Src_Node.Element.all;
  
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
  
!          function New_Node (Next : Node_Access) return Node_Access is
!             Tgt : Element_Access := new Element_Type'(Src);
!          begin
!             return new Node_Type'(Tgt, Next);
!          exception
!             when others =>
!                Free_Element (Tgt);
!                raise;
!          end New_Node;
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!          Tgt_Node : Node_Access;
!          Success  : Boolean;
  
!       begin
  
!          Insert (Target, Src, Tgt_Node, Success);
  
!       end Process;
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process);
  
     begin
! 
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
! 
!       Iterate (Source);
  
!    end Union;
  
  
  
!    function Union (Left, Right : Set) return Set is
  
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
!    begin
  
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
  
!       if Right.Length = 0 then
!          return Left;
!       end if;
  
!       if Left.Length = 0 then
!          return Right;
!       end if;
  
!       declare
!          Size : constant Hash_Type :=
!            Prime_Numbers.To_Prime (Left.Length + Right.Length);
!       begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
!       end;
  
!       declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Process (L_Node : Node_Access) is
!             I : constant Hash_Type :=
!               Hash (L_Node.Element.all) mod Buckets'Length;
!          begin
!             Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
!          end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
!       begin
!          Iterate (Left);
!       exception
!          when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end;
  
!       Length := Left.Length;
  
!       declare
!          procedure Process (Src_Node : Node_Access);
  
!          procedure Process (Src_Node : Node_Access) is
  
!             Src : Element_Type renames Src_Node.Element.all;
  
!             I : constant Hash_Type :=
!               Hash (Src) mod Buckets'Length;
  
!             Tgt_Node : Node_Access := Buckets (I);
  
!          begin
  
!             while Tgt_Node /= null loop
  
!                if Equivalent_Keys (Src, Tgt_Node.Element.all) then
!                   return;
!                end if;
  
!                Tgt_Node := Next (Tgt_Node);
  
!             end loop;
  
!             declare
!                Tgt : Element_Access := new Element_Type'(Src);
!             begin
!                Buckets (I) := new Node_Type'(Tgt, Buckets (I));
!             exception
!                when others =>
!                   Free_Element (Tgt);
!                   raise;
!             end;
  
!             Length := Length + 1;
  
!          end Process;
  
-          procedure Iterate is
-             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Right);
        exception
           when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
! 
!    end Union;
! 
  
!    function Is_In
!      (HT  : Set;
!       Key : Node_Access) return Boolean;
!    pragma Inline (Is_In);
  
-    function Is_In
-      (HT  : Set;
-       Key : Node_Access) return Boolean is
     begin
!       return Element_Keys.Find (HT, Key.Element.all) /= null;
!    end Is_In;
  
  
!    procedure Intersection (Target : in out Set;
!                            Source : in     Set) is
  
        Tgt_Node : Node_Access;
  
     begin
- 
        if Target'Address = Source'Address then
           return;
        end if;
--- 46,732 ----
  
  with Ada.Containers.Prime_Numbers;
  
  package body Ada.Containers.Indefinite_Hashed_Sets is
  
!    -----------------------
!    -- Local Subprograms --
!    -----------------------
  
!    function Copy_Node (Source : Node_Access) return Node_Access;
!    pragma Inline (Copy_Node);
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
!    function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean;
  
!    function Find_Equivalent_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean;
  
!    procedure Free (X : in out Node_Access);
  
!    function Hash_Node (Node : Node_Access) return Hash_Type;
!    pragma Inline (Hash_Node);
  
!    procedure Insert
!      (HT       : in out Hash_Table_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean);
  
!    function Is_In (HT  : Hash_Table_Type; Key : Node_Access) return Boolean;
!    pragma Inline (Is_In);
  
!    function Next (Node : Node_Access) return Node_Access;
!    pragma Inline (Next);
  
!    function Read_Node (Stream : access Root_Stream_Type'Class)
!      return Node_Access;
!    pragma Inline (Read_Node);
  
!    procedure Replace_Element
!      (HT       : in out Hash_Table_Type;
!       Node     : Node_Access;
!       New_Item : Element_Type);
  
!    procedure Set_Next (Node : Node_Access; Next : Node_Access);
!    pragma Inline (Set_Next);
  
+    function Vet (Position : Cursor) return Boolean;
  
!    procedure Write_Node
!      (Stream : access Root_Stream_Type'Class;
!       Node   : Node_Access);
!    pragma Inline (Write_Node);
  
!    --------------------------
!    -- Local Instantiations --
!    --------------------------
  
!    procedure Free_Element is
!       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
     package HT_Ops is
        new Hash_Tables.Generic_Operations
!        (HT_Types  => HT_Types,
!         Hash_Node => Hash_Node,
!         Next      => Next,
!         Set_Next  => Set_Next,
!         Copy_Node => Copy_Node,
!         Free      => Free);
  
     package Element_Keys is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Element_Type,
          Hash      => Hash,
          Equivalent_Keys => Equivalent_Keys);
  
+    function Is_Equal is
+       new HT_Ops.Generic_Equal (Find_Equal_Key);
  
!    function Is_Equivalent is
!       new HT_Ops.Generic_Equal (Find_Equivalent_Key);
  
!    procedure Read_Nodes is
!       new HT_Ops.Generic_Read (Read_Node);
  
!    procedure Write_Nodes is
!      new HT_Ops.Generic_Write (Write_Node);
  
!    ---------
!    -- "=" --
!    ---------
  
+    function "=" (Left, Right : Set) return Boolean is
     begin
+       return Is_Equal (Left.HT, Right.HT);
+    end "=";
  
!    ------------
!    -- Adjust --
!    ------------
  
!    procedure Adjust (Container : in out Set) is
     begin
!       HT_Ops.Adjust (Container.HT);
!    end Adjust;
  
+    --------------
+    -- Capacity --
+    --------------
  
!    function Capacity (Container : Set) return Count_Type is
     begin
!       return HT_Ops.Capacity (Container.HT);
!    end Capacity;
  
+    -----------
+    -- Clear --
+    -----------
  
!    procedure Clear (Container : in out Set) is
!    begin
!       HT_Ops.Clear (Container.HT);
!    end Clear;
  
+    --------------
+    -- Contains --
+    --------------
  
!    function Contains (Container : Set; Item : Element_Type) return Boolean is
     begin
!       return Find (Container, Item) /= No_Element;
!    end Contains;
  
+    ---------------
+    -- Copy_Node --
+    ---------------
  
!    function Copy_Node (Source : Node_Access) return Node_Access is
!       E : Element_Access := new Element_Type'(Source.Element.all);
     begin
!       return new Node_Type'(Element => E, Next => null);
!    exception
!       when others =>
!          Free_Element (E);
!          raise;
!    end Copy_Node;
  
+    ------------
+    -- Delete --
+    ------------
  
!    procedure Delete
!      (Container : in out Set;
!       Item      : Element_Type)
!    is
!       X : Node_Access;
  
!    begin
!       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
  
!       if X = null then
!          raise Constraint_Error;
!       end if;
  
!       Free (X);
!    end Delete;
  
!    procedure Delete
!      (Container : in out Set;
!       Position  : in out Cursor)
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Delete");
  
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
  
!       if Container.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
  
!       Free (Position.Node);
!       Position.Container := null;
!    end Delete;
  
!    ----------------
!    -- Difference --
!    ----------------
  
!    procedure Difference
!      (Target : in out Set;
!       Source : Set)
!    is
!       Tgt_Node : Node_Access;
  
!    begin
!       if Target'Address = Source'Address then
!          Clear (Target);
!          return;
!       end if;
  
!       if Source.Length = 0 then
!          return;
!       end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       --  TODO: This can be written in terms of a loop instead as
!       --  active-iterator style, sort of like a passive iterator.
  
!       Tgt_Node := HT_Ops.First (Target.HT);
!       while Tgt_Node /= null loop
!          if Is_In (Source.HT, Tgt_Node) then
!             declare
!                X : Node_Access := Tgt_Node;
!             begin
!                Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
!                Free (X);
!             end;
  
!          else
!             Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
!          end if;
!       end loop;
!    end Difference;
  
+    function Difference (Left, Right : Set) return Set is
+       Buckets : HT_Types.Buckets_Access;
+       Length  : Count_Type;
  
!    begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
  
!       if Left.Length = 0 then
!          return Empty_Set;
!       end if;
  
!       if Right.Length = 0 then
!          return Left;
!       end if;
  
!       declare
!          Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
!       begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
!       end;
  
!       Length := 0;
  
+       Iterate_Left : declare
+          procedure Process (L_Node : Node_Access);
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
  
+          -------------
+          -- Process --
+          -------------
  
!          procedure Process (L_Node : Node_Access) is
!          begin
!             if not Is_In (Right.HT, L_Node) then
!                declare
!                   Src    : Element_Type renames L_Node.Element.all;
!                   Indx   : constant Hash_Type := Hash (Src) mod Buckets'Length;
!                   Bucket : Node_Access renames Buckets (Indx);
!                   Tgt    : Element_Access := new Element_Type'(Src);
!                begin
!                   Bucket := new Node_Type'(Tgt, Bucket);
!                exception
!                   when others =>
!                      Free_Element (Tgt);
!                      raise;
!                end;
  
!                Length := Length + 1;
!             end if;
!          end Process;
! 
!       --  Start of processing for Iterate_Left
  
        begin
!          Iterate (Left.HT);
        exception
           when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Left;
  
!       return (Controlled with HT => (Buckets, Length, 0, 0));
!    end Difference;
  
!    -------------
!    -- Element --
!    -------------
  
+    function Element (Position : Cursor) return Element_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Element");
  
!       if Position.Node = null then
           raise Constraint_Error;
        end if;
  
!       if Position.Node.Element = null then  --  handle dangling reference
!          raise Program_Error;
!       end if;
  
+       return Position.Node.Element.all;
+    end Element;
  
!    ---------------------
!    -- Equivalent_Sets --
!    ---------------------
  
!    function Equivalent_Sets (Left, Right : Set) return Boolean is
!    begin
!       return Is_Equivalent (Left.HT, Right.HT);
!    end Equivalent_Sets;
  
!    -------------------------
!    -- Equivalent_Elements --
!    -------------------------
  
+    function Equivalent_Elements (Left, Right : Cursor)
+      return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
  
!       if Left.Node = null
!         or else Right.Node = null
!       then
           raise Constraint_Error;
        end if;
  
!       if Left.Node.Element = null  --  handle dangling cursor reference
!         or else Right.Node.Element = null
!       then
!          raise Program_Error;
!       end if;
  
!       return Equivalent_Elements
!                (Left.Node.Element.all,
!                 Right.Node.Element.all);
!    end Equivalent_Elements;
  
+    function Equivalent_Elements (Left : Cursor; Right : Element_Type)
+      return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
  
!       if Left.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Left.Node.Element = null then  --  handling dangling reference
!          raise Program_Error;
!       end if;
  
!       return Equivalent_Elements (Left.Node.Element.all, Right);
!    end Equivalent_Elements;
  
+    function Equivalent_Elements (Left : Element_Type; Right : Cursor)
+      return Boolean is
     begin
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
  
!       if Right.Node = null then
           raise Constraint_Error;
        end if;
  
!       if Right.Node.Element = null then  --  handle dangling cursor reference
!          raise Program_Error;
!       end if;
  
!       return Equivalent_Elements (Left, Right.Node.Element.all);
!    end Equivalent_Elements;
  
+    ---------------------
+    -- Equivalent_Keys --
+    ---------------------
  
!    function Equivalent_Keys (Key : Element_Type; Node : Node_Access)
!      return Boolean is
!    begin
!       return Equivalent_Elements (Key, Node.Element.all);
!    end Equivalent_Keys;
  
!    -------------
!    -- Exclude --
!    -------------
  
+    procedure Exclude
+      (Container : in out Set;
+       Item      : Element_Type)
+    is
+       X : Node_Access;
     begin
!       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
        Free (X);
     end Exclude;
  
+    --------------
+    -- Finalize --
+    --------------
  
!    procedure Finalize (Container : in out Set) is
     begin
+       HT_Ops.Finalize (Container.HT);
+    end Finalize;
  
!    ----------
!    -- Find --
!    ----------
  
!    function Find
!      (Container : Set;
!       Item      : Element_Type) return Cursor
!    is
!       Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
  
!    begin
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
!    end Find;
  
+    --------------------
+    -- Find_Equal_Key --
+    --------------------
  
+    function Find_Equal_Key
+      (R_HT   : Hash_Table_Type;
+       L_Node : Node_Access) return Boolean
+    is
+       R_Index : constant Hash_Type :=
+                   Element_Keys.Index (R_HT, L_Node.Element.all);
  
!       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
!    begin
!       loop
!          if R_Node = null then
!             return False;
!          end if;
  
!          if L_Node.Element.all = R_Node.Element.all then
!             return True;
!          end if;
  
!          R_Node := Next (R_Node);
!       end loop;
!    end Find_Equal_Key;
  
!    -------------------------
!    -- Find_Equivalent_Key --
!    -------------------------
  
!    function Find_Equivalent_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean
!    is
!       R_Index : constant Hash_Type :=
!                   Element_Keys.Index (R_HT, L_Node.Element.all);
  
!       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
!    begin
!       loop
!          if R_Node = null then
!             return False;
!          end if;
  
!          if Equivalent_Elements (L_Node.Element.all, R_Node.Element.all) then
!             return True;
!          end if;
  
!          R_Node := Next (R_Node);
!       end loop;
!    end Find_Equivalent_Key;
  
!    -----------
!    -- First --
!    -----------
  
!    function First (Container : Set) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container.HT);
  
     begin
!       if Node = null then
!          return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
!    end First;
  
!    ----------
!    -- Free --
!    ----------
  
+    procedure Free (X : in out Node_Access) is
+       procedure Deallocate is
+          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
+    begin
+       if X = null then
+          return;
+       end if;
  
!       X.Next := X;  --  detect mischief (in Vet)
  
!       begin
!          Free_Element (X.Element);
!       exception
!          when others =>
!             X.Element := null;
!             Deallocate (X);
!             raise;
!       end;
  
!       Deallocate (X);
!    end Free;
  
!    -----------------
!    -- Has_Element --
!    -----------------
  
!    function Has_Element (Position : Cursor) return Boolean is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
!    end Has_Element;
  
!    ---------------
!    -- Hash_Node --
!    ---------------
  
!    function Hash_Node (Node : Node_Access) return Hash_Type is
!    begin
!       return Hash (Node.Element.all);
!    end Hash_Node;
  
!    -------------
!    -- Include --
!    -------------
  
!    procedure Include
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Position : Cursor;
!       Inserted : Boolean;
  
!       X : Element_Access;
  
!    begin
!       Insert (Container, New_Item, Position, Inserted);
  
!       if not Inserted then
!          if Container.HT.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          X := Position.Node.Element;
  
!          Position.Node.Element := new Element_Type'(New_Item);
  
!          Free_Element (X);
!       end if;
!    end Include;
  
!    ------------
!    -- Insert --
!    ------------
  
!    procedure Insert
!      (Container : in out Set;
!       New_Item  : Element_Type;
!       Position  : out Cursor;
!       Inserted  : out Boolean)
!    is
!    begin
!       Insert (Container.HT, New_Item, Position.Node, Inserted);
!       Position.Container := Container'Unchecked_Access;
!    end Insert;
  
!    procedure Insert
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Position : Cursor;
!       Inserted : Boolean;
  
!    begin
!       Insert (Container, New_Item, Position, Inserted);
  
!       if not Inserted then
!          raise Constraint_Error;
!       end if;
!    end Insert;
  
!    procedure Insert
!      (HT       : in out Hash_Table_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean)
!    is
!       function New_Node (Next : Node_Access) return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Insert is
!          new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node (Next : Node_Access) return Node_Access is
!          Element : Element_Access := new Element_Type'(New_Item);
  
        begin
!          return new Node_Type'(Element, Next);
        exception
           when others =>
!             Free_Element (Element);
              raise;
!       end New_Node;
  
!    --  Start of processing for Insert
  
     begin
!       if HT_Ops.Capacity (HT) = 0 then
!          HT_Ops.Reserve_Capacity (HT, 1);
!       end if;
  
+       Local_Insert (HT, New_Item, Node, Inserted);
  
!       if Inserted
!         and then HT.Length > HT_Ops.Capacity (HT)
!       then
!          HT_Ops.Reserve_Capacity (HT, HT.Length);
!       end if;
!    end Insert;
  
+    ------------------
+    -- Intersection --
+    ------------------
+ 
+    procedure Intersection
+      (Target : in out Set;
+       Source : Set)
+    is
        Tgt_Node : Node_Access;
  
     begin
        if Target'Address = Source'Address then
           return;
        end if;
*************** package body Ada.Containers.Indefinite_H
*** 659,664 ****
--- 736,745 ----
           return;
        end if;
  
+       if Target.HT.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        --  TODO: optimize this to use an explicit
        --  loop instead of an active iterator
        --  (similar to how a passive iterator is
*************** package body Ada.Containers.Indefinite_H
*** 668,705 ****
        --  set is smaller, and iterate over the
        --  smaller set.
  
!       Tgt_Node := HT_Ops.First (Target);
! 
        while Tgt_Node /= null loop
! 
!          if Is_In (Source, Tgt_Node) then
! 
!             Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
  
           else
- 
              declare
                 X : Node_Access := Tgt_Node;
              begin
!                Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target, X);
                 Free (X);
              end;
- 
           end if;
- 
        end loop;
- 
     end Intersection;
  
- 
     function Intersection (Left, Right : Set) return Set is
- 
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
- 
        if Left'Address = Right'Address then
           return Left;
        end if;
--- 749,776 ----
        --  set is smaller, and iterate over the
        --  smaller set.
  
!       Tgt_Node := HT_Ops.First (Target.HT);
        while Tgt_Node /= null loop
!          if Is_In (Source.HT, Tgt_Node) then
!             Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
  
           else
              declare
                 X : Node_Access := Tgt_Node;
              begin
!                Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
                 Free (X);
              end;
           end if;
        end loop;
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
        if Left'Address = Right'Address then
           return Left;
        end if;
*************** package body Ada.Containers.Indefinite_H
*** 718,893 ****
  
        Length := 0;
  
!       declare
           procedure Process (L_Node : Node_Access);
  
           procedure Process (L_Node : Node_Access) is
           begin
!             if Is_In (Right, L_Node) then
! 
                 declare
!                   I : constant Hash_Type :=
!                     Hash (L_Node.Element.all) mod Buckets'Length;
                 begin
!                   Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
                 end;
  
                 Length := Length + 1;
- 
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
  
     end Intersection;
  
  
!    procedure Difference (Target : in out Set;
!                          Source : in     Set) is
! 
  
!       Tgt_Node : Node_Access;
  
     begin
  
!       if Target'Address = Source'Address then
!          Clear (Target);
!          return;
        end if;
  
!       if Source.Length = 0 then
!          return;
        end if;
  
!       --  TODO: As I noted above, this can be
!       --  written in terms of a loop instead as
!       --  active-iterator style, sort of like a
!       --  passive iterator.
  
!       Tgt_Node := HT_Ops.First (Target);
  
!       while Tgt_Node /= null loop
  
!          if Is_In (Source, Tgt_Node) then
  
!             declare
!                X : Node_Access := Tgt_Node;
!             begin
!                Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target, X);
!                Free (X);
!             end;
  
!          else
  
!             Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
  
!          end if;
  
!       end loop;
  
!    end Difference;
  
  
  
!    function Difference (Left, Right : Set) return Set is
  
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
     begin
  
!       if Left'Address = Right'Address then
!          return Empty_Set;
        end if;
  
!       if Left.Length = 0 then
!          return Empty_Set;
        end if;
  
        if Right.Length = 0 then
!          return Left;
        end if;
  
        declare
!          Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
        begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
!       Length := 0;
  
!       declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right, L_Node) then
  
!                declare
!                   I : constant Hash_Type :=
!                     Hash (L_Node.Element.all) mod Buckets'Length;
!                begin
!                   Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
!                end;
  
!                Length := Length + 1;
  
!             end if;
!          end Process;
  
-          procedure Iterate is
-             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end;
  
!       return (Controlled with Buckets, Length);
  
!    end Difference;
  
  
  
!    procedure Symmetric_Difference (Target : in out Set;
!                                    Source : in     Set) is
     begin
  
        if Target'Address = Source'Address then
           Clear (Target);
           return;
        end if;
  
!       HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
  
!       if Target.Length = 0 then
  
!          declare
              procedure Process (Src_Node : Node_Access);
  
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element.all;
!                B : Buckets_Type renames Target.Buckets.all;
!                I : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.Length;
              begin
                 declare
                    X : Element_Access := new Element_Type'(E);
                 begin
!                   B (I) := new Node_Type'(X, B (I));
                 exception
                    when others =>
                       Free_Element (X);
--- 789,1327 ----
  
        Length := 0;
  
!       Iterate_Left : declare
           procedure Process (L_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (L_Node : Node_Access) is
           begin
!             if Is_In (Right.HT, L_Node) then
                 declare
!                   Src : Element_Type renames L_Node.Element.all;
! 
!                   Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
! 
!                   Bucket : Node_Access renames Buckets (Indx);
! 
!                   Tgt : Element_Access := new Element_Type'(Src);
! 
                 begin
!                   Bucket := new Node_Type'(Tgt, Bucket);
!                exception
!                   when others =>
!                      Free_Element (Tgt);
!                      raise;
                 end;
  
                 Length := Length + 1;
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Left
! 
        begin
!          Iterate (Left.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Left;
  
+       return (Controlled with HT => (Buckets, Length, 0, 0));
     end Intersection;
  
+    --------------
+    -- Is_Empty --
+    --------------
  
!    function Is_Empty (Container : Set) return Boolean is
!    begin
!       return Container.HT.Length = 0;
!    end Is_Empty;
  
!    -----------
!    -- Is_In --
!    -----------
  
+    function Is_In (HT  : Hash_Table_Type; Key : Node_Access) return Boolean is
     begin
+       return Element_Keys.Find (HT, Key.Element.all) /= null;
+    end Is_In;
  
!    ---------------
!    -- Is_Subset --
!    ---------------
! 
!    function Is_Subset
!      (Subset : Set;
!       Of_Set : Set) return Boolean
!    is
!       Subset_Node : Node_Access;
! 
!    begin
!       if Subset'Address = Of_Set'Address then
!          return True;
        end if;
  
!       if Subset.Length > Of_Set.Length then
!          return False;
        end if;
  
!       --  TODO: rewrite this to loop in the
!       --  style of a passive iterator.
  
!       Subset_Node := HT_Ops.First (Subset.HT);
!       while Subset_Node /= null loop
!          if not Is_In (Of_Set.HT, Subset_Node) then
!             return False;
!          end if;
  
!          Subset_Node := HT_Ops.Next (Subset.HT, Subset_Node);
!       end loop;
  
!       return True;
!    end Is_Subset;
  
!    -------------
!    -- Iterate --
!    -------------
  
!    procedure Iterate
!      (Container : Set;
!       Process   : not null access procedure (Position : Cursor))
!    is
!       procedure Process_Node (Node : Node_Access);
!       pragma Inline (Process_Node);
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process_Node);
  
!       ------------------
!       -- Process_Node --
!       ------------------
  
!       procedure Process_Node (Node : Node_Access) is
!       begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
!       end Process_Node;
  
!       HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
  
+    --  Start of processing for Iterate
  
+    begin
+       --  TODO: resolve whether HT_Ops.Generic_Iteration should
+       --  manipulate busy bit.
  
!       Iterate (HT);
!    end Iterate;
  
!    ------------
!    -- Length --
!    ------------
  
+    function Length (Container : Set) return Count_Type is
     begin
+       return Container.HT.Length;
+    end Length;
  
!    ----------
!    -- Move --
!    ----------
! 
!    procedure Move (Target : in out Set; Source : in out Set) is
!    begin
!       HT_Ops.Move (Target => Target.HT, Source => Source.HT);
!    end Move;
! 
!    ----------
!    -- Next --
!    ----------
! 
!    function Next (Node : Node_Access) return Node_Access is
!    begin
!       return Node.Next;
!    end Next;
! 
!    function Next (Position : Cursor) return Cursor is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in function Next");
! 
!       if Position.Node = null then
!          return No_Element;
        end if;
  
!       if Position.Node.Element = null then
!          raise Program_Error;
        end if;
  
+       declare
+          HT   : Hash_Table_Type renames Position.Container.HT;
+          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
+ 
+       begin
+          if Node = null then
+             return No_Element;
+          end if;
+ 
+          return Cursor'(Position.Container, Node);
+       end;
+    end Next;
+ 
+    procedure Next (Position : in out Cursor) is
+    begin
+       Position := Next (Position);
+    end Next;
+ 
+    -------------
+    -- Overlap --
+    -------------
+ 
+    function Overlap (Left, Right : Set) return Boolean is
+       Left_Node : Node_Access;
+ 
+    begin
        if Right.Length = 0 then
!          return False;
!       end if;
! 
!       if Left'Address = Right'Address then
!          return True;
!       end if;
! 
!       Left_Node := HT_Ops.First (Left.HT);
!       while Left_Node /= null loop
!          if Is_In (Right.HT, Left_Node) then
!             return True;
!          end if;
! 
!          Left_Node := HT_Ops.Next (Left.HT, Left_Node);
!       end loop;
! 
!       return False;
!    end Overlap;
! 
!    -------------------
!    -- Query_Element --
!    -------------------
! 
!    procedure Query_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
        end if;
  
        declare
!          HT : Hash_Table_Type renames
!                 Position.Container'Unrestricted_Access.all.HT;
! 
!          B : Natural renames HT.Busy;
!          L : Natural renames HT.Lock;
! 
        begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element.all);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
        end;
+    end Query_Element;
  
!    ----------
!    -- Read --
!    ----------
  
!    procedure Read
!      (Stream    : access Root_Stream_Type'Class;
!       Container : out Set)
!    is
!    begin
!       Read_Nodes (Stream, Container.HT);
!    end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
! 
!    ---------------
!    -- Read_Node --
!    ---------------
! 
!    function Read_Node
!      (Stream : access Root_Stream_Type'Class) return Node_Access
!    is
!       X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
! 
!    begin
!       return new Node_Type'(X, null);
!    exception
!       when others =>
!          Free_Element (X);
!          raise;
!    end Read_Node;
! 
!    -------------
!    -- Replace --
!    -------------
! 
!    procedure Replace
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Node : constant Node_Access :=
!                Element_Keys.Find (Container.HT, New_Item);
! 
!       X : Element_Access;
! 
!    begin
!       if Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Container.HT.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       X := Node.Element;
! 
!       Node.Element := new Element_Type'(New_Item);
! 
!       Free_Element (X);
!    end Replace;
! 
!    ---------------------
!    -- Replace_Element --
!    ---------------------
! 
!    procedure Replace_Element
!      (HT       : in out Hash_Table_Type;
!       Node     : Node_Access;
!       New_Item : Element_Type)
!    is
!    begin
!       if Equivalent_Elements (Node.Element.all, New_Item) then
!          pragma Assert (Hash (Node.Element.all) = Hash (New_Item));
! 
!          if HT.Lock > 0 then
!             raise Program_Error;
!          end if;
! 
!          declare
!             X : Element_Access := Node.Element;
           begin
!             Node.Element := new Element_Type'(New_Item);  --  OK if fails
!             Free_Element (X);
!          end;
  
!          return;
!       end if;
  
!       if HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       HT_Ops.Delete_Node_Sans_Free (HT, Node);
! 
!       Insert_New_Element : declare
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
! 
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
! 
!          ------------------------
!          -- Insert_New_Element --
!          ------------------------
! 
!          function New_Node (Next : Node_Access) return Node_Access is
!          begin
!             Node.Element := new Element_Type'(New_Item);  -- OK if fails
!             Node.Next := Next;
!             return Node;
!          end New_Node;
! 
!          Result   : Node_Access;
!          Inserted : Boolean;
! 
!          X : Element_Access := Node.Element;
! 
!       --  Start of processing for Insert_New_Element
  
        begin
!          Attempt_Insert : begin
!             Insert
!               (HT       => HT,
!                Key      => New_Item,
!                Node     => Result,
!                Inserted => Inserted);
!          exception
!             when others =>
!                Inserted := False;  -- Assignment failed
!          end Attempt_Insert;
! 
!          if Inserted then
!             Free_Element (X);  -- Just propagate if fails
!             return;
!          end if;
!       end Insert_New_Element;
! 
!       Reinsert_Old_Element :
!       declare
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
! 
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
! 
!          --------------
!          -- New_Node --
!          --------------
! 
!          function New_Node (Next : Node_Access) return Node_Access is
!          begin
!             Node.Next := Next;
!             return Node;
!          end New_Node;
! 
!          Result   : Node_Access;
!          Inserted : Boolean;
! 
!       --  Start of processing for Reinsert_Old_Element
! 
!       begin
!          Insert
!            (HT       => HT,
!             Key      => Node.Element.all,
!             Node     => Result,
!             Inserted => Inserted);
        exception
           when others =>
!             null;
!       end Reinsert_Old_Element;
  
!       raise Program_Error;
!    end Replace_Element;
  
!    procedure Replace_Element
!      (Container : in out Set;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
  
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
  
+       if Position.Node.Element = null then
+          raise Program_Error;
+       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       Replace_Element (Container.HT, Position.Node, New_Item);
!    end Replace_Element;
! 
!    ----------------------
!    -- Reserve_Capacity --
!    ----------------------
! 
!    procedure Reserve_Capacity
!      (Container : in out Set;
!       Capacity  : Count_Type)
!    is
     begin
+       HT_Ops.Reserve_Capacity (Container.HT, Capacity);
+    end Reserve_Capacity;
  
+    --------------
+    -- Set_Next --
+    --------------
+ 
+    procedure Set_Next (Node : Node_Access; Next : Node_Access) is
+    begin
+       Node.Next := Next;
+    end Set_Next;
+ 
+    --------------------------
+    -- Symmetric_Difference --
+    --------------------------
+ 
+    procedure Symmetric_Difference
+      (Target : in out Set;
+       Source : Set)
+    is
+    begin
        if Target'Address = Source'Address then
           Clear (Target);
           return;
        end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       declare
!          N : constant Count_Type := Target.Length + Source.Length;
!       begin
!          if N > HT_Ops.Capacity (Target.HT) then
!             HT_Ops.Reserve_Capacity (Target.HT, N);
!          end if;
!       end;
  
!       if Target.Length = 0 then
!          Iterate_Source_When_Empty_Target : declare
              procedure Process (Src_Node : Node_Access);
  
+             procedure Iterate is
+                new HT_Ops.Generic_Iteration (Process);
+ 
+             -------------
+             -- Process --
+             -------------
+ 
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element.all;
!                B : Buckets_Type renames Target.HT.Buckets.all;
!                J : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.HT.Length;
! 
              begin
                 declare
                    X : Element_Access := new Element_Type'(E);
                 begin
!                   B (J) := new Node_Type'(X, B (J));
                 exception
                    when others =>
                       Free_Element (X);
*************** package body Ada.Containers.Indefinite_H
*** 897,925 ****
                 N := N + 1;
              end Process;
  
!             procedure Iterate is
!                new HT_Ops.Generic_Iteration (Process);
           begin
!             Iterate (Source);
!          end;
  
        else
! 
!          declare
              procedure Process (Src_Node : Node_Access);
  
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element.all;
!                B : Buckets_Type renames Target.Buckets.all;
!                I : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.Length;
!             begin
!                if B (I) = null then
  
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      B (I) := new Node_Type'(X, null);
                    exception
                       when others =>
                          Free_Element (X);
--- 1331,1365 ----
                 N := N + 1;
              end Process;
  
!          --  Start of processing for Iterate_Source_When_Empty_Target
! 
           begin
!             Iterate (Source.HT);
!          end Iterate_Source_When_Empty_Target;
  
        else
!          Iterate_Source : declare
              procedure Process (Src_Node : Node_Access);
  
+             procedure Iterate is
+                new HT_Ops.Generic_Iteration (Process);
+ 
+             -------------
+             -- Process --
+             -------------
+ 
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element.all;
!                B : Buckets_Type renames Target.HT.Buckets.all;
!                J : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.HT.Length;
  
+             begin
+                if B (J) = null then
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      B (J) := new Node_Type'(X, null);
                    exception
                       when others =>
                          Free_Element (X);
*************** package body Ada.Containers.Indefinite_H
*** 928,951 ****
  
                    N := N + 1;
  
!                elsif Equivalent_Keys (E, B (I).Element.all) then
! 
                    declare
!                      X : Node_Access := B (I);
                    begin
!                      B (I) := B (I).Next;
                       N := N - 1;
                       Free (X);
                    end;
  
                 else
- 
                    declare
!                      Prev : Node_Access := B (I);
                       Curr : Node_Access := Prev.Next;
                    begin
                       while Curr /= null loop
!                         if Equivalent_Keys (E, Curr.Element.all) then
                             Prev.Next := Curr.Next;
                             N := N - 1;
                             Free (Curr);
--- 1368,1390 ----
  
                    N := N + 1;
  
!                elsif Equivalent_Elements (E, B (J).Element.all) then
                    declare
!                      X : Node_Access := B (J);
                    begin
!                      B (J) := B (J).Next;
                       N := N - 1;
                       Free (X);
                    end;
  
                 else
                    declare
!                      Prev : Node_Access := B (J);
                       Curr : Node_Access := Prev.Next;
+ 
                    begin
                       while Curr /= null loop
!                         if Equivalent_Elements (E, Curr.Element.all) then
                             Prev.Next := Curr.Next;
                             N := N - 1;
                             Free (Curr);
*************** package body Ada.Containers.Indefinite_H
*** 959,965 ****
                       declare
                          X : Element_Access := new Element_Type'(E);
                       begin
!                         B (I) := new Node_Type'(X, B (I));
                       exception
                          when others =>
                             Free_Element (X);
--- 1398,1404 ----
                       declare
                          X : Element_Access := new Element_Type'(E);
                       begin
!                         B (J) := new Node_Type'(X, B (J));
                       exception
                          when others =>
                             Free_Element (X);
*************** package body Ada.Containers.Indefinite_H
*** 968,995 ****
  
                       N := N + 1;
                    end;
- 
                 end if;
              end Process;
  
!             procedure Iterate is
!                new HT_Ops.Generic_Iteration (Process);
!          begin
!             Iterate (Source);
!          end;
  
        end if;
- 
     end Symmetric_Difference;
  
- 
     function Symmetric_Difference (Left, Right : Set) return Set is
- 
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
- 
        if Left'Address = Right'Address then
           return Empty_Set;
        end if;
--- 1407,1428 ----
  
                       N := N + 1;
                    end;
                 end if;
              end Process;
  
!          --  Start of processing for Iterate_Source
  
+          begin
+             Iterate (Source.HT);
+          end Iterate_Source;
        end if;
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
        if Left'Address = Right'Address then
           return Empty_Set;
        end if;
*************** package body Ada.Containers.Indefinite_H
*** 1004,1031 ****
  
        declare
           Size : constant Hash_Type :=
!            Prime_Numbers.To_Prime (Left.Length + Right.Length);
        begin
           Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
        Length := 0;
  
!       declare
           procedure Process (L_Node : Node_Access);
  
           procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right, L_Node) then
                 declare
                    E : Element_Type renames L_Node.Element.all;
!                   I : constant Hash_Type := Hash (E) mod Buckets'Length;
!                begin
  
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      Buckets (I) := new Node_Type'(X, Buckets (I));
                    exception
                       when others =>
                          Free_Element (X);
--- 1437,1471 ----
  
        declare
           Size : constant Hash_Type :=
!                   Prime_Numbers.To_Prime (Left.Length + Right.Length);
        begin
           Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
        Length := 0;
  
!       Iterate_Left : declare
           procedure Process (L_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right.HT, L_Node) then
                 declare
                    E : Element_Type renames L_Node.Element.all;
!                   J : constant Hash_Type := Hash (E) mod Buckets'Length;
  
+                begin
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      Buckets (J) := new Node_Type'(X, Buckets (J));
                    exception
                       when others =>
                          Free_Element (X);
*************** package body Ada.Containers.Indefinite_H
*** 1037,1067 ****
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
  
!       declare
           procedure Process (R_Node : Node_Access);
  
           procedure Process (R_Node : Node_Access) is
           begin
!             if not Is_In (Left, R_Node) then
                 declare
                    E : Element_Type renames R_Node.Element.all;
!                   I : constant Hash_Type := Hash (E) mod Buckets'Length;
!                begin
  
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      Buckets (I) := new Node_Type'(X, Buckets (I));
                    exception
                       when others =>
                          Free_Element (X);
--- 1477,1514 ----
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Left
! 
        begin
!          Iterate (Left.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Left;
  
!       Iterate_Right : declare
           procedure Process (R_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (R_Node : Node_Access) is
           begin
!             if not Is_In (Left.HT, R_Node) then
                 declare
                    E : Element_Type renames R_Node.Element.all;
!                   J : constant Hash_Type := Hash (E) mod Buckets'Length;
  
+                begin
                    declare
                       X : Element_Access := new Element_Type'(E);
                    begin
!                      Buckets (J) := new Node_Type'(X, Buckets (J));
                    exception
                       when others =>
                          Free_Element (X);
*************** package body Ada.Containers.Indefinite_H
*** 1069,1531 ****
                    end;
  
                    Length := Length + 1;
- 
                 end;
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Right);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
  
     end Symmetric_Difference;
  
  
!    function Is_Subset (Subset : Set;
!                        Of_Set : Set) return Boolean is
! 
!       Subset_Node : Node_Access;
  
     begin
  
!       if Subset'Address = Of_Set'Address then
!          return True;
!       end if;
  
!       if Subset.Length > Of_Set.Length then
!          return False;
!       end if;
  
!       --  TODO: rewrite this to loop in the
!       --  style of a passive iterator.
  
!       Subset_Node := HT_Ops.First (Subset);
  
!       while Subset_Node /= null loop
!          if not Is_In (Of_Set, Subset_Node) then
!             return False;
!          end if;
  
!          Subset_Node := HT_Ops.Next (Subset, Subset_Node);
!       end loop;
  
!       return True;
  
!    end Is_Subset;
  
  
!    function Overlap (Left, Right : Set) return Boolean is
  
!       Left_Node : Node_Access;
  
     begin
  
!       if Right.Length = 0 then
!          return False;
        end if;
  
        if Left'Address = Right'Address then
!          return True;
        end if;
  
!       Left_Node := HT_Ops.First (Left);
  
!       while Left_Node /= null loop
!          if Is_In (Right, Left_Node) then
!             return True;
!          end if;
  
!          Left_Node := HT_Ops.Next (Left, Left_Node);
!       end loop;
  
!       return False;
  
!    end Overlap;
  
  
!    function Find (Container : Set;
!                   Item      : Element_Type) return Cursor is
  
!       Node : constant Node_Access := Element_Keys.Find (Container, Item);
  
!    begin
  
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
  
!    end Find;
  
  
!    function Contains (Container : Set;
!                       Item      : Element_Type) return Boolean is
!    begin
!       return Find (Container, Item) /= No_Element;
!    end Contains;
  
  
  
!    function First (Container : Set) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container);
!    begin
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
!    end First;
  
  
! --     function First_Element (Container : Set) return Element_Type is
! --        Node : constant Node_Access := HT_Ops.First (Container);
! --     begin
! --        return Node.Element;
! --     end First_Element;
  
  
!    function Next (Position : Cursor) return Cursor is
!    begin
!       if Position.Container = null
!         or else Position.Node = null
!       then
!          return No_Element;
!       end if;
  
-       declare
-          S : Set renames Position.Container.all;
-          Node : constant Node_Access := HT_Ops.Next (S, Position.Node);
        begin
!          if Node = null then
!             return No_Element;
!          end if;
  
!          return Cursor'(Position.Container, Node);
!       end;
!    end Next;
  
  
!    procedure Next (Position : in out Cursor) is
     begin
!       Position := Next (Position);
!    end Next;
! 
  
-    function Has_Element (Position : Cursor) return Boolean is
-    begin
        if Position.Container = null then
           return False;
        end if;
  
!       if Position.Node = null then
           return False;
        end if;
  
!       return True;
!    end Has_Element;
  
  
!    function Equivalent_Keys (Left, Right : Cursor)
!      return Boolean is
!    begin
!       return Equivalent_Keys (Left.Node.Element.all, Right.Node.Element.all);
!    end Equivalent_Keys;
  
  
!    function Equivalent_Keys (Left  : Cursor;
!                              Right : Element_Type)
!     return Boolean is
!    begin
!       return Equivalent_Keys (Left.Node.Element.all, Right);
!    end Equivalent_Keys;
  
  
!    function Equivalent_Keys (Left  : Element_Type;
!                              Right : Cursor)
!     return Boolean is
!    begin
!       return Equivalent_Keys (Left, Right.Node.Element.all);
!    end Equivalent_Keys;
  
  
!    procedure Iterate
!      (Container : in Set;
!       Process   : not null access procedure (Position : in Cursor)) is
  
!       procedure Process_Node (Node : in Node_Access);
!       pragma Inline (Process_Node);
  
!       procedure Process_Node (Node : in Node_Access) is
!       begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
!       end Process_Node;
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process_Node);
     begin
!       Iterate (Container);
!    end Iterate;
! 
! 
!    function Capacity (Container : Set) return Count_Type
!      renames HT_Ops.Capacity;
! 
!    procedure Reserve_Capacity
!      (Container : in out Set;
!       Capacity  : in     Count_Type)
!      renames HT_Ops.Ensure_Capacity;
! 
  
!    procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : in     Node_Access);
!    pragma Inline (Write_Node);
  
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : in     Node_Access) is
     begin
        Element_Type'Output (Stream, Node.Element.all);
     end Write_Node;
  
-    procedure Write_Nodes is
-       new HT_Ops.Generic_Write (Write_Node);
- 
-    procedure Write
-      (Stream    : access Root_Stream_Type'Class;
-       Container : in     Set) renames Write_Nodes;
- 
- 
-    function Read_Node (Stream : access Root_Stream_Type'Class)
-      return Node_Access;
-    pragma Inline (Read_Node);
- 
-    function Read_Node (Stream : access Root_Stream_Type'Class)
-      return Node_Access is
- 
-       X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
-    begin
-       return new Node_Type'(X, null);
-    exception
-       when others =>
-          Free_Element (X);
-          raise;
-    end Read_Node;
- 
-    procedure Read_Nodes is
-       new HT_Ops.Generic_Read (Read_Node);
- 
-    procedure Read
-      (Stream    : access Root_Stream_Type'Class;
-       Container :    out Set) renames Read_Nodes;
- 
- 
     package body Generic_Keys is
  
!       function Equivalent_Keys (Left  : Cursor;
!                                 Right : Key_Type)
!         return Boolean is
!       begin
!          return Equivalent_Keys (Right, Left.Node.Element.all);
!       end Equivalent_Keys;
! 
!       function Equivalent_Keys (Left  : Key_Type;
!                                 Right : Cursor)
!         return Boolean is
!       begin
!          return Equivalent_Keys (Left, Right.Node.Element.all);
!       end Equivalent_Keys;
  
!       function Equivalent_Keys
          (Key  : Key_Type;
           Node : Node_Access) return Boolean;
!       pragma Inline (Equivalent_Keys);
  
!       function Equivalent_Keys
!         (Key  : Key_Type;
!          Node : Node_Access) return Boolean is
!       begin
!          return Equivalent_Keys (Key, Node.Element.all);
!       end Equivalent_Keys;
  
        package Key_Keys is
           new Hash_Tables.Generic_Keys
            (HT_Types  => HT_Types,
-            HT_Type   => Set,
-            Null_Node => null,
             Next      => Next,
             Set_Next  => Set_Next,
             Key_Type  => Key_Type,
             Hash      => Hash,
!            Equivalent_Keys => Equivalent_Keys);
! 
! 
!       function Find (Container : Set;
!                      Key       : Key_Type)
!          return Cursor is
  
!          Node : constant Node_Access :=
!            Key_Keys.Find (Container, Key);
  
        begin
  
!          if Node = null then
!             return No_Element;
!          end if;
! 
!          return Cursor'(Container'Unchecked_Access, Node);
! 
!       end Find;
  
  
-       function Contains (Container : Set;
-                          Key       : Key_Type) return Boolean is
        begin
!          return Find (Container, Key) /= No_Element;
!       end Contains;
  
  
!       function Element (Container : Set;
!                         Key       : Key_Type)
!         return Element_Type is
  
!          Node : constant Node_Access := Key_Keys.Find (Container, Key);
        begin
           return Node.Element.all;
        end Element;
  
  
!       function Key (Position : Cursor) return Key_Type is
        begin
!          return Key (Position.Node.Element.all);
!       end Key;
! 
! 
! --  TODO:
! --        procedure Replace (Container : in out Set;
! --                           Key       : in     Key_Type;
! --                           New_Item  : in     Element_Type) is
! 
! --           Node : constant Node_Access :=
! --             Key_Keys.Find (Container, Key);
  
! --        begin
  
! --           if Node = null then
! --              raise Constraint_Error;
! --           end if;
  
! --           Replace_Element (Container, Node, New_Item);
  
! --        end Replace;
  
  
!       procedure Delete (Container : in out Set;
!                         Key       : in     Key_Type) is
  
!          X : Node_Access;
  
        begin
  
!          Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
! 
!          if X = null then
              raise Constraint_Error;
           end if;
  
!          Free (X);
! 
!       end Delete;
  
  
!       procedure Exclude (Container : in out Set;
!                          Key       : in     Key_Type) is
  
!          X : Node_Access;
  
        begin
  
!          Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
!          Free (X);
! 
!       end Exclude;
! 
  
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : in     Cursor;
           Process   : not null access
!            procedure (Element : in out Element_Type)) is
  
        begin
  
!          if Position.Container = null then
              raise Constraint_Error;
           end if;
  
!          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
              raise Program_Error;
           end if;
  
           declare
!             Old_Key : Key_Type renames Key (Position.Node.Element.all);
           begin
!             Process (Position.Node.Element.all);
  
!             if Equivalent_Keys (Old_Key, Position.Node.Element.all) then
                 return;
              end if;
           end;
  
!          declare
!             function New_Node (Next : Node_Access) return Node_Access;
!             pragma Inline (New_Node);
  
!             function New_Node (Next : Node_Access) return Node_Access is
!             begin
!                Position.Node.Next := Next;
!                return Position.Node;
!             end New_Node;
  
!             procedure Insert is
!                new Key_Keys.Generic_Conditional_Insert (New_Node);
  
!             Result  : Node_Access;
!             Success : Boolean;
!          begin
!             HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
  
!             Insert
!               (HT      => Container,
!                Key     => Key (Position.Node.Element.all),
!                Node    => Result,
!                Success => Success);
  
!             if not Success then
!                declare
!                   X : Node_Access := Position.Node;
!                begin
!                   Free (X);
!                end;
  
!                raise Program_Error;
!             end if;
  
!             pragma Assert (Result = Position.Node);
           end;
  
!       end Checked_Update_Element;
  
     end Generic_Keys;
  
  end Ada.Containers.Indefinite_Hashed_Sets;
- 
--- 1516,2077 ----
                    end;
  
                    Length := Length + 1;
                 end;
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Right
! 
        begin
!          Iterate (Right.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Right;
  
+       return (Controlled with HT => (Buckets, Length, 0, 0));
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
  
!    function To_Set (New_Item : Element_Type) return Set is
!       HT       : Hash_Table_Type;
!       Node     : Node_Access;
!       Inserted : Boolean;
  
     begin
+       Insert (HT, New_Item, Node, Inserted);
+       return Set'(Controlled with HT);
+    end To_Set;
  
!    -----------
!    -- Union --
!    -----------
  
!    procedure Union
!      (Target : in out Set;
!       Source : Set)
!    is
!       procedure Process (Src_Node : Node_Access);
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Src_Node : Node_Access) is
!          Src : Element_Type renames Src_Node.Element.all;
  
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!          --------------
!          -- New_Node --
!          --------------
  
+          function New_Node (Next : Node_Access) return Node_Access is
+             Tgt : Element_Access := new Element_Type'(Src);
  
!          begin
!             return new Node_Type'(Tgt, Next);
!          exception
!             when others =>
!                Free_Element (Tgt);
!                raise;
!          end New_Node;
  
!          Tgt_Node : Node_Access;
!          Success  : Boolean;
! 
!       --  Start of processing for Process
! 
!       begin
!          Insert (Target.HT, Src, Tgt_Node, Success);
!       end Process;
! 
!    --  Start of processing for Union
  
     begin
+       if Target'Address = Source'Address then
+          return;
+       end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
        end if;
  
+       declare
+          N : constant Count_Type := Target.Length + Source.Length;
+       begin
+          if N > HT_Ops.Capacity (Target.HT) then
+             HT_Ops.Reserve_Capacity (Target.HT, N);
+          end if;
+       end;
+ 
+       Iterate (Source.HT);
+    end Union;
+ 
+    function Union (Left, Right : Set) return Set is
+       Buckets : HT_Types.Buckets_Access;
+       Length  : Count_Type;
+ 
+    begin
        if Left'Address = Right'Address then
!          return Left;
        end if;
  
!       if Right.Length = 0 then
!          return Left;
!       end if;
  
!       if Left.Length = 0 then
!          return Right;
!       end if;
  
!       declare
!          Size : constant Hash_Type :=
!                   Prime_Numbers.To_Prime (Left.Length + Right.Length);
!       begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
!       end;
  
!       Iterate_Left : declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
  
+          -------------
+          -- Process --
+          -------------
  
!          procedure Process (L_Node : Node_Access) is
!             Src : Element_Type renames L_Node.Element.all;
  
!             J : constant Hash_Type := Hash (Src) mod Buckets'Length;
  
!             Bucket : Node_Access renames Buckets (J);
  
!             Tgt : Element_Access := new Element_Type'(Src);
  
!          begin
!             Bucket := new Node_Type'(Tgt, Bucket);
!          exception
!             when others =>
!                Free_Element (Tgt);
!                raise;
!          end Process;
  
!       --  Start of processing for Process
  
+       begin
+          Iterate (Left.HT);
+       exception
+          when others =>
+             HT_Ops.Free_Hash_Table (Buckets);
+             raise;
+       end Iterate_Left;
  
!       Length := Left.Length;
  
+       Iterate_Right : declare
+          procedure Process (Src_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
  
!          -------------
!          -- Process --
!          -------------
  
!          procedure Process (Src_Node : Node_Access) is
!             Src : Element_Type renames Src_Node.Element.all;
!             Idx : constant Hash_Type := Hash (Src) mod Buckets'Length;
  
+             Tgt_Node : Node_Access := Buckets (Idx);
  
!          begin
!             while Tgt_Node /= null loop
!                if Equivalent_Elements (Src, Tgt_Node.Element.all) then
!                   return;
!                end if;
!                Tgt_Node := Next (Tgt_Node);
!             end loop;
  
+             declare
+                Tgt : Element_Access := new Element_Type'(Src);
+             begin
+                Buckets (Idx) := new Node_Type'(Tgt, Buckets (Idx));
+             exception
+                when others =>
+                   Free_Element (Tgt);
+                   raise;
+             end;
  
!             Length := Length + 1;
!          end Process;
! 
!       --  Start of processing for Iterate_Right
  
        begin
!          Iterate (Right.HT);
!       exception
!          when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end Iterate_Right;
  
!       return (Controlled with HT => (Buckets, Length, 0, 0));
!    end Union;
  
+    ---------
+    -- Vet --
+    ---------
  
!    function Vet (Position : Cursor) return Boolean is
     begin
!       if Position.Node = null then
!          return Position.Container = null;
!       end if;
  
        if Position.Container = null then
           return False;
        end if;
  
!       if Position.Node.Next = Position.Node then
           return False;
        end if;
  
!       if Position.Node.Element = null then
!          return False;
!       end if;
  
+       declare
+          HT : Hash_Table_Type renames Position.Container.HT;
+          X  : Node_Access;
  
!       begin
!          if HT.Length = 0 then
!             return False;
!          end if;
  
+          if HT.Buckets = null
+            or else HT.Buckets'Length = 0
+          then
+             return False;
+          end if;
  
!          X := HT.Buckets (Element_Keys.Index (HT, Position.Node.Element.all));
  
+          for J in 1 .. HT.Length loop
+             if X = Position.Node then
+                return True;
+             end if;
  
!             if X = null then
!                return False;
!             end if;
  
+             if X = X.Next then  --  to prevent unnecessary looping
+                return False;
+             end if;
  
!             X := X.Next;
!          end loop;
  
!          return False;
!       end;
!    end Vet;
  
!    -----------
!    -- Write --
!    -----------
  
!    procedure Write
!      (Stream    : access Root_Stream_Type'Class;
!       Container : Set)
!    is
     begin
!       Write_Nodes (Stream, Container.HT);
!    end Write;
  
!    procedure Write
       (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
! 
!    ----------------
!    -- Write_Node --
!    ----------------
  
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : Node_Access)
!    is
     begin
        Element_Type'Output (Stream, Node.Element.all);
     end Write_Node;
  
     package body Generic_Keys is
  
!       -----------------------
!       -- Local Subprograms --
!       -----------------------
  
!       function Equivalent_Key_Node
          (Key  : Key_Type;
           Node : Node_Access) return Boolean;
!       pragma Inline (Equivalent_Key_Node);
  
!       --------------------------
!       -- Local Instantiations --
!       --------------------------
  
        package Key_Keys is
           new Hash_Tables.Generic_Keys
            (HT_Types  => HT_Types,
             Next      => Next,
             Set_Next  => Set_Next,
             Key_Type  => Key_Type,
             Hash      => Hash,
!            Equivalent_Keys => Equivalent_Key_Node);
  
!       --------------
!       -- Contains --
!       --------------
  
+       function Contains
+         (Container : Set;
+          Key       : Key_Type) return Boolean
+       is
        begin
+          return Find (Container, Key) /= No_Element;
+       end Contains;
  
!       ------------
!       -- Delete --
!       ------------
  
+       procedure Delete
+         (Container : in out Set;
+          Key       : Key_Type)
+       is
+          X : Node_Access;
  
        begin
!          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
  
+          if X = null then
+             raise Constraint_Error;
+          end if;
  
!          Free (X);
!       end Delete;
  
!       -------------
!       -- Element --
!       -------------
! 
!       function Element
!         (Container : Set;
!          Key       : Key_Type) return Element_Type
!       is
!          Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
        begin
           return Node.Element.all;
        end Element;
  
+       -------------------------
+       -- Equivalent_Key_Node --
+       -------------------------
  
!       function Equivalent_Key_Node
!         (Key  : Key_Type;
!          Node : Node_Access) return Boolean is
        begin
!          return Equivalent_Keys (Key, Generic_Keys.Key (Node.Element.all));
!       end Equivalent_Key_Node;
  
!       -------------
!       -- Exclude --
!       -------------
  
!       procedure Exclude
!         (Container : in out Set;
!          Key       : Key_Type)
!       is
!          X : Node_Access;
!       begin
!          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
!          Free (X);
!       end Exclude;
  
!       ----------
!       -- Find --
!       ----------
  
!       function Find
!         (Container : Set;
!          Key       : Key_Type) return Cursor
!       is
!          Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
  
+       begin
+          if Node = null then
+             return No_Element;
+          end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
!       end Find;
  
!       ---------
!       -- Key --
!       ---------
  
+       function Key (Position : Cursor) return Key_Type is
        begin
+          pragma Assert (Vet (Position), "bad cursor in function Key");
  
!          if Position.Node = null then
              raise Constraint_Error;
           end if;
  
!          if Position.Node.Element = null then
!             raise Program_Error;
!          end if;
  
+          return Key (Position.Node.Element.all);
+       end Key;
  
!       -------------
!       -- Replace --
!       -------------
  
!       procedure Replace
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type)
!       is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.HT, Key);
  
        begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
  
!          Replace_Element (Container.HT, Node, New_Item);
!       end Replace;
  
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : in     Cursor;
           Process   : not null access
!            procedure (Element : in out Element_Type))
!       is
!          HT   : Hash_Table_Type renames Container.HT;
!          Indx : Hash_Type;
  
        begin
+          pragma Assert
+            (Vet (Position),
+             "bad cursor in Update_Element_Preserving_Key");
  
!          if Position.Node = null then
              raise Constraint_Error;
           end if;
  
!          if Position.Node.Element = null
!            or else Position.Node.Next = Position.Node
!          then
              raise Program_Error;
           end if;
  
+          if Position.Container /= Container'Unrestricted_Access then
+             raise Program_Error;
+          end if;
+ 
+          if HT.Buckets = null
+            or else HT.Buckets'Length = 0
+            or else HT.Length = 0
+          then
+             raise Program_Error;
+          end if;
+ 
+          Indx := HT_Ops.Index (HT, Position.Node);
+ 
           declare
!             E : Element_Type renames Position.Node.Element.all;
!             K : constant Key_Type := Key (E);
! 
!             B : Natural renames HT.Busy;
!             L : Natural renames HT.Lock;
! 
           begin
!             B := B + 1;
!             L := L + 1;
  
!             begin
!                Process (E);
!             exception
!                when others =>
!                   L := L - 1;
!                   B := B - 1;
!                   raise;
!             end;
! 
!             L := L - 1;
!             B := B - 1;
! 
!             if Equivalent_Keys (K, Key (E)) then
!                pragma Assert (Hash (K) = Hash (E));
                 return;
              end if;
           end;
  
!          if HT.Buckets (Indx) = Position.Node then
!             HT.Buckets (Indx) := Position.Node.Next;
  
!          else
!             declare
!                Prev : Node_Access := HT.Buckets (Indx);
  
!             begin
!                while Prev.Next /= Position.Node loop
!                   Prev := Prev.Next;
  
!                   if Prev = null then
!                      raise Program_Error;
!                   end if;
!                end loop;
  
!                Prev.Next := Position.Node.Next;
!             end;
!          end if;
  
!          HT.Length := HT.Length - 1;
  
!          declare
!             X : Node_Access := Position.Node;
  
!          begin
!             Free (X);
           end;
  
!          raise Program_Error;
!       end Update_Element_Preserving_Key;
  
     end Generic_Keys;
  
  end Ada.Containers.Indefinite_Hashed_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cihase.ads gcc-4.1.0/gcc/ada/a-cihase.ads
*** gcc-4.0.2/gcc/ada/a-cihase.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cihase.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_HASHED_SETS                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --               I N D E F I N I T E _ H A S H E D _ S E T S                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,56 ****
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
  
  generic
     type Element_Type (<>) is private;
  
     with function Hash (Element : Element_Type) return Hash_Type;
  
!    --  TODO: get a ruling from ARG in Atlanta re the name and
!    --  order of these declarations ???
! 
!    with function Equivalent_Keys (Left, Right : Element_Type) return Boolean;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Hashed_Sets is
! 
!    pragma Preelaborate (Indefinite_Hashed_Sets);
  
     type Set is tagged private;
  
--- 36,55 ----
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
+ with Ada.Finalization;
  
  generic
     type Element_Type (<>) is private;
  
     with function Hash (Element : Element_Type) return Hash_Type;
  
!    with function Equivalent_Elements (Left, Right : Element_Type)
!                                      return Boolean;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Hashed_Sets is
!    pragma Preelaborate;
  
     type Set is tagged private;
  
*************** package Ada.Containers.Indefinite_Hashed
*** 62,67 ****
--- 61,76 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
+    function Capacity (Container : Set) return Count_Type;
+ 
+    procedure Reserve_Capacity
+      (Container : in out Set;
+       Capacity  : Count_Type);
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** package Ada.Containers.Indefinite_Hashed
*** 70,84 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
- --  TODO: resolve in atlanta ???
- --   procedure Replace_Element (Container : in out Set;
- --                              Position  : Cursor;
- --                              By        : Element_Type);
- 
     procedure Move
       (Target : in out Set;
        Source : in out Set);
--- 79,93 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Move
       (Target : in out Set;
        Source : in out Set);
*************** package Ada.Containers.Indefinite_Hashed
*** 95,104 ****
  
     procedure Replace (Container : in out Set; New_Item : Element_Type);
  
-    procedure Delete  (Container : in out Set; Item : Element_Type);
- 
     procedure Exclude (Container : in out Set; Item : Element_Type);
  
     procedure Delete (Container : in out Set; Position  : in out Cursor);
  
     procedure Union (Target : in out Set; Source : Set);
--- 104,113 ----
  
     procedure Replace (Container : in out Set; New_Item : Element_Type);
  
     procedure Exclude (Container : in out Set; Item : Element_Type);
  
+    procedure Delete  (Container : in out Set; Item : Element_Type);
+ 
     procedure Delete (Container : in out Set; Position  : in out Cursor);
  
     procedure Union (Target : in out Set; Source : Set);
*************** package Ada.Containers.Indefinite_Hashed
*** 126,144 ****
     function "xor" (Left, Right : Set) return Set
       renames Symmetric_Difference;
  
-    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
- 
     function Overlap (Left, Right : Set) return Boolean;
  
!    function Contains (Container : Set; Item : Element_Type) return Boolean;
! 
!    function Find (Container : Set; Item : Element_Type) return Cursor;
! 
!    function Capacity (Container : Set) return Count_Type;
! 
!    procedure Reserve_Capacity
!      (Container : in out Set;
!       Capacity  : Count_Type);
  
     function First (Container : Set) return Cursor;
  
--- 135,143 ----
     function "xor" (Left, Right : Set) return Set
       renames Symmetric_Difference;
  
     function Overlap (Left, Right : Set) return Boolean;
  
!    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
     function First (Container : Set) return Cursor;
  
*************** package Ada.Containers.Indefinite_Hashed
*** 146,160 ****
  
     procedure Next (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
!    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
  
!    function Equivalent_Keys
       (Left  : Cursor;
        Right : Element_Type) return Boolean;
  
!    function Equivalent_Keys
       (Left  : Element_Type;
        Right : Cursor) return Boolean;
  
--- 145,163 ----
  
     procedure Next (Position : in out Cursor);
  
+    function Find (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
!    function Equivalent_Elements (Left, Right : Cursor) return Boolean;
  
!    function Equivalent_Elements
       (Left  : Cursor;
        Right : Element_Type) return Boolean;
  
!    function Equivalent_Elements
       (Left  : Element_Type;
        Right : Cursor) return Boolean;
  
*************** package Ada.Containers.Indefinite_Hashed
*** 163,228 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
        with function Hash (Key : Key_Type) return Hash_Type;
  
!       with function Equivalent_Keys
!         (Key     : Key_Type;
!          Element : Element_Type) return Boolean;
  
     package Generic_Keys is
  
-       function Contains (Container : Set; Key : Key_Type) return Boolean;
- 
-       function Find (Container : Set; Key : Key_Type) return Cursor;
- 
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
! --  TODO: resolve in atlanta???
! --      procedure Replace (Container : in out Set;
! --                         Key       : Key_Type;
! --                         New_Item  : Element_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
                         procedure (Element : in out Element_Type));
  
-       function Equivalent_Keys
-         (Left  : Cursor;
-          Right : Key_Type) return Boolean;
- 
-       function Equivalent_Keys
-         (Left  : Key_Type;
-          Right : Cursor) return Boolean;
     end Generic_Keys;
  
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package HT_Types is
!       new Hash_Tables.Generic_Hash_Table_Types (Node_Access);
  
!    use HT_Types;
  
!    type Set is new Hash_Table_Type with null record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set);
  
!    type Set_Access is access constant Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is
--- 166,235 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
        with function Hash (Key : Key_Type) return Hash_Type;
  
!       with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
     package Generic_Keys is
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       procedure Replace           -- TODO: ask Randy why this is still here
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type);
! 
!       procedure Exclude (Container : in out Set; Key : Key_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       function Find (Container : Set; Key : Key_Type) return Cursor;
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
                         procedure (Element : in out Element_Type));
  
     end Generic_Keys;
  
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Element_Access is access Element_Type;
  
!    type Node_Type is
!       limited record
!          Element : Element_Access;
!          Next    : Node_Access;
!       end record;
  
!    package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
!      (Node_Type,
!       Node_Access);
! 
!    type Set is new Ada.Finalization.Controlled with record
!       HT : HT_Types.Hash_Table_Type;
!    end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set);
  
!    use HT_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is
*************** private
*** 231,242 ****
           Node      : Node_Access;
        end record;
  
     No_Element : constant Cursor :=
                    (Container => null,
                     Node      => null);
  
-    use Ada.Streams;
- 
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
        Container : Set);
--- 238,259 ----
           Node      : Node_Access;
        end record;
  
+    procedure Write
+      (Stream : access Root_Stream_Type'Class;
+       Item   : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
     No_Element : constant Cursor :=
                    (Container => null,
                     Node      => null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
        Container : Set);
*************** private
*** 249,255 ****
  
     for Set'Read use Read;
  
!    Empty_Set : constant Set := (Hash_Table_Type with null record);
  
  end Ada.Containers.Indefinite_Hashed_Sets;
- 
--- 266,271 ----
  
     for Set'Read use Read;
  
!    Empty_Set : constant Set := (Controlled with HT => (null, 0, 0, 0));
  
  end Ada.Containers.Indefinite_Hashed_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciorma.adb gcc-4.1.0/gcc/ada/a-ciorma.adb
*** gcc-4.0.2/gcc/ada/a-ciorma.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciorma.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_ORDERED_MAPS                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --             I N D E F I N I T E _ O R D E R E D _ M A P S                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 41,64 ****
  with Ada.Containers.Red_Black_Trees.Generic_Keys;
  pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Indefinite_Ordered_Maps is
  
-    use Red_Black_Trees;
- 
-    type Key_Access is access Key_Type;
-    type Element_Access is access Element_Type;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Key     : Key_Access;
-       Element : Element_Access;
-    end record;
- 
     -----------------------------
     -- Node Access Subprograms --
     -----------------------------
--- 42,49 ----
*************** package body Ada.Containers.Indefinite_O
*** 97,106 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
- 
-    procedure Delete_Tree (X : in out Node_Access);
- 
     procedure Free (X : in out Node_Access);
  
     function Is_Equal_Node_Node
--- 82,87 ----
*************** package body Ada.Containers.Indefinite_O
*** 122,130 ****
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!        (Tree_Types => Tree_Types,
!         Null_Node  => Node_Access'(null));
  
     use Tree_Operations;
  
--- 103,115 ----
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations (Tree_Types);
! 
!    procedure Delete_Tree is
!       new Tree_Operations.Generic_Delete_Tree (Free);
! 
!    function Copy_Tree is
!       new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
  
     use Tree_Operations;
  
*************** package body Ada.Containers.Indefinite_O
*** 150,165 ****
--- 135,190 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Key = null
+         or else Right.Node.Key = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Key.all < Right.Node.Key.all;
     end "<";
  
     function "<" (Left : Cursor; Right : Key_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Key = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Key.all < Right;
     end "<";
  
     function "<" (Left : Key_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Key = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Key.all;
     end "<";
  
*************** package body Ada.Containers.Indefinite_O
*** 169,178 ****
  
     function "=" (Left, Right : Map) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return True;
-       end if;
- 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
--- 194,199 ----
*************** package body Ada.Containers.Indefinite_O
*** 182,197 ****
--- 203,258 ----
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Key = null
+         or else Right.Node.Key = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Key.all < Left.Node.Key.all;
     end ">";
  
     function ">" (Left : Cursor; Right : Key_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Key = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
        return Right < Left.Node.Key.all;
     end ">";
  
     function ">" (Left : Key_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Key = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Key.all < Left;
     end ">";
  
*************** package body Ada.Containers.Indefinite_O
*** 199,222 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) is
!       Tree : Tree_Type renames Container.Tree;
! 
!       N : constant Count_Type := Tree.Length;
!       X : constant Node_Access := Tree.Root;
  
     begin
!       if N = 0 then
!          pragma Assert (X = null);
!          return;
!       end if;
! 
!       Tree := (Length => 0, others => null);
! 
!       Tree.Root := Copy_Tree (X);
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
!       Tree.Length := N;
     end Adjust;
  
     -------------
--- 260,271 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Map) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 225,248 ****
  
     function Ceiling (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
     begin
        if Node = null then
           return No_Element;
-       else
-          return Cursor'(Container'Unchecked_Access, Node);
        end if;
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Map) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 274,298 ----
  
     function Ceiling (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
+ 
     begin
        if Node = null then
           return No_Element;
        end if;
+ 
+       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Map) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 268,326 ****
     ---------------
  
     function Copy_Node (Source : Node_Access) return Node_Access is
!       Target : constant Node_Access :=
!          new Node_Type'(Parent  => null,
!                         Left    => null,
!                         Right   => null,
!                         Color   => Source.Color,
!                         Key     => Source.Key,
!                         Element => Source.Element);
!    begin
!       return Target;
!    end Copy_Node;
! 
!    ---------------
!    -- Copy_Tree --
!    ---------------
! 
!    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
!       Target_Root : Node_Access := Copy_Node (Source_Root);
! 
!       P, X : Node_Access;
! 
     begin
!       if Source_Root.Right /= null then
!          Target_Root.Right := Copy_Tree (Source_Root.Right);
!          Target_Root.Right.Parent := Target_Root;
!       end if;
! 
!       P := Target_Root;
!       X := Source_Root.Left;
!       while X /= null loop
!          declare
!             Y : Node_Access := Copy_Node (X);
! 
!          begin
!             P.Left := Y;
!             Y.Parent := P;
! 
!             if X.Right /= null then
!                Y.Right := Copy_Tree (X.Right);
!                Y.Right.Parent := Y;
!             end if;
! 
!             P := Y;
!             X := X.Left;
!          end;
!       end loop;
! 
!       return Target_Root;
  
     exception
        when others =>
!          Delete_Tree (Target_Root);
           raise;
!    end Copy_Tree;
  
     ------------
     -- Delete --
--- 318,340 ----
     ---------------
  
     function Copy_Node (Source : Node_Access) return Node_Access is
!       K : Key_Access := new Key_Type'(Source.Key.all);
!       E : Element_Access;
     begin
!       E := new Element_Type'(Source.Element.all);
  
+       return new Node_Type'(Parent  => null,
+                             Left    => null,
+                             Right   => null,
+                             Color   => Source.Color,
+                             Key     => K,
+                             Element => E);
     exception
        when others =>
!          Free_Key (K);
!          Free_Element (E);
           raise;
!    end Copy_Node;
  
     ------------
     -- Delete --
*************** package body Ada.Containers.Indefinite_O
*** 331,345 ****
        Position  : in out Cursor)
     is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Map_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
--- 345,368 ----
        Position  : in out Cursor)
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Node.Key = null
!         or else Position.Node.Element = null
!       then
           raise Program_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Delete");
! 
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
*************** package body Ada.Containers.Indefinite_O
*** 347,359 ****
  
     procedure Delete (Container : in out Map; Key : Key_Type) is
        X : Node_Access := Key_Ops.Find (Container.Tree, Key);
     begin
        if X = null then
           raise Constraint_Error;
-       else
-          Delete_Node_Sans_Free (Container.Tree, X);
-          Free (X);
        end if;
     end Delete;
  
     ------------------
--- 370,383 ----
  
     procedure Delete (Container : in out Map; Key : Key_Type) is
        X : Node_Access := Key_Ops.Find (Container.Tree, Key);
+ 
     begin
        if X = null then
           raise Constraint_Error;
        end if;
+ 
+       Delete_Node_Sans_Free (Container.Tree, X);
+       Free (X);
     end Delete;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 361,369 ****
     ------------------
  
     procedure Delete_First (Container : in out Map) is
!       Position : Cursor := First (Container);
     begin
!       Delete (Container, Position);
     end Delete_First;
  
     -----------------
--- 385,397 ----
     ------------------
  
     procedure Delete_First (Container : in out Map) is
!       X : Node_Access := Container.Tree.First;
! 
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
!          Free (X);
!       end if;
     end Delete_First;
  
     -----------------
*************** package body Ada.Containers.Indefinite_O
*** 371,396 ****
     -----------------
  
     procedure Delete_Last (Container : in out Map) is
!       Position : Cursor := Last (Container);
!    begin
!       Delete (Container, Position);
!    end Delete_Last;
! 
!    -----------------
!    -- Delete_Tree --
!    -----------------
  
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
     begin
!       while X /= null loop
!          Y := X.Right;
!          Delete_Tree (Y);
!          Y := X.Left;
           Free (X);
!          X := Y;
!       end loop;
!    end Delete_Tree;
  
     -------------
     -- Element --
--- 399,412 ----
     -----------------
  
     procedure Delete_Last (Container : in out Map) is
!       X : Node_Access := Container.Tree.Last;
  
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
!       end if;
!    end Delete_Last;
  
     -------------
     -- Element --
*************** package body Ada.Containers.Indefinite_O
*** 398,412 ****
--- 414,459 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Position.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element.all;
     end Element;
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
        Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+ 
     begin
+       if Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Node.Element.all;
     end Element;
  
+    ---------------------
+    -- Equivalent_Keys --
+    ---------------------
+ 
+    function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Keys;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 416,422 ****
  
     begin
        if X /= null then
!          Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
--- 463,469 ----
  
     begin
        if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
*************** package body Ada.Containers.Indefinite_O
*** 427,438 ****
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
     begin
        if Node = null then
           return No_Element;
-       else
-          return Cursor'(Container'Unchecked_Access, Node);
        end if;
     end Find;
  
     -----------
--- 474,486 ----
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+ 
     begin
        if Node = null then
           return No_Element;
        end if;
+ 
+       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 440,451 ****
     -----------
  
     function First (Container : Map) return Cursor is
     begin
!       if Container.Tree.First = null then
           return No_Element;
-       else
-          return Cursor'(Container'Unchecked_Access, Container.Tree.First);
        end if;
     end First;
  
     -------------------
--- 488,501 ----
     -----------
  
     function First (Container : Map) return Cursor is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
           return No_Element;
        end if;
+ 
+       return Cursor'(Container'Unrestricted_Access, T.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Indefinite_O
*** 453,460 ****
     -------------------
  
     function First_Element (Container : Map) return Element_Type is
     begin
!       return Container.Tree.First.Element.all;
     end First_Element;
  
     ---------------
--- 503,516 ----
     -------------------
  
     function First_Element (Container : Map) return Element_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.First.Element.all;
     end First_Element;
  
     ---------------
*************** package body Ada.Containers.Indefinite_O
*** 462,469 ****
     ---------------
  
     function First_Key (Container : Map) return Key_Type is
     begin
!       return Container.Tree.First.Key.all;
     end First_Key;
  
     -----------
--- 518,531 ----
     ---------------
  
     function First_Key (Container : Map) return Key_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.First.Key.all;
     end First_Key;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 472,483 ****
  
     function Floor (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
     begin
        if Node = null then
           return No_Element;
-       else
-          return Cursor'(Container'Unchecked_Access, Node);
        end if;
     end Floor;
  
     ----------
--- 534,546 ----
  
     function Floor (Container : Map; Key : Key_Type) return Cursor is
        Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
+ 
     begin
        if Node = null then
           return No_Element;
        end if;
+ 
+       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 487,498 ****
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
     begin
!       if X /= null then
           Free_Key (X.Key);
           Free_Element (X.Element);
!          Deallocate (X);
!       end if;
     end Free;
  
     -----------------
--- 550,593 ----
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
     begin
!       if X = null then
!          return;
!       end if;
! 
!       X.Parent := X;
!       X.Left := X;
!       X.Right := X;
! 
!       begin
           Free_Key (X.Key);
+       exception
+          when others =>
+             X.Key := null;
+ 
+             begin
+                Free_Element (X.Element);
+             exception
+                when others =>
+                   X.Element := null;
+             end;
+ 
+             Deallocate (X);
+             raise;
+       end;
+ 
+       begin
           Free_Element (X.Element);
!       exception
!          when others =>
!             X.Element := null;
! 
!             Deallocate (X);
!             raise;
!       end;
! 
!       Deallocate (X);
     end Free;
  
     -----------------
*************** package body Ada.Containers.Indefinite_O
*** 523,533 ****
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
           K := Position.Node.Key;
           E := Position.Node.Element;
  
           Position.Node.Key := new Key_Type'(Key);
!          Position.Node.Element := new Element_Type'(New_Item);
  
           Free_Key (K);
           Free_Element (E);
--- 618,639 ----
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.Tree.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           K := Position.Node.Key;
           E := Position.Node.Element;
  
           Position.Node.Key := new Key_Type'(Key);
! 
!          begin
!             Position.Node.Element := new Element_Type'(New_Item);
!          exception
!             when others =>
!                Free_Key (K);
!                raise;
!          end;
  
           Free_Key (K);
           Free_Element (E);
*************** package body Ada.Containers.Indefinite_O
*** 571,577 ****
  
              --  On exception, deallocate key and elem
  
!             Free (Node);
              raise;
        end New_Node;
  
--- 677,683 ----
  
              --  On exception, deallocate key and elem
  
!             Free (Node);  --  Note that Free deallocates key and elem too
              raise;
        end New_Node;
  
*************** package body Ada.Containers.Indefinite_O
*** 584,590 ****
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unchecked_Access;
     end Insert;
  
     procedure Insert
--- 690,696 ----
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unrestricted_Access;
     end Insert;
  
     procedure Insert
*************** package body Ada.Containers.Indefinite_O
*** 620,626 ****
     function Is_Equal_Node_Node
       (L, R : Node_Access) return Boolean is
     begin
!       return L.Element.all = R.Element.all;
     end Is_Equal_Node_Node;
  
     -------------------------
--- 726,740 ----
     function Is_Equal_Node_Node
       (L, R : Node_Access) return Boolean is
     begin
!       if L.Key.all < R.Key.all then
!          return False;
! 
!       elsif R.Key.all < L.Key.all then
!          return False;
! 
!       else
!          return L.Element.all = R.Element.all;
!       end if;
     end Is_Equal_Node_Node;
  
     -------------------------
*************** package body Ada.Containers.Indefinite_O
*** 668,680 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     ---------
--- 782,806 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (Container.Tree);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ---------
*************** package body Ada.Containers.Indefinite_O
*** 683,688 ****
--- 809,825 ----
  
     function Key (Position : Cursor) return Key_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Position.Node.Key = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Key");
+ 
        return Position.Node.Key.all;
     end Key;
  
*************** package body Ada.Containers.Indefinite_O
*** 691,702 ****
     ----------
  
     function Last (Container : Map) return Cursor is
     begin
!       if Container.Tree.Last = null then
           return No_Element;
-       else
-          return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
        end if;
     end Last;
  
     ------------------
--- 828,841 ----
     ----------
  
     function Last (Container : Map) return Cursor is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
           return No_Element;
        end if;
+ 
+       return Cursor'(Container'Unrestricted_Access, T.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 704,711 ****
     ------------------
  
     function Last_Element (Container : Map) return Element_Type is
     begin
!       return Container.Tree.Last.Element.all;
     end Last_Element;
  
     --------------
--- 843,856 ----
     ------------------
  
     function Last_Element (Container : Map) return Element_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.Last.Element.all;
     end Last_Element;
  
     --------------
*************** package body Ada.Containers.Indefinite_O
*** 713,720 ****
     --------------
  
     function Last_Key (Container : Map) return Key_Type is
     begin
!       return Container.Tree.Last.Key.all;
     end Last_Key;
  
     ----------
--- 858,871 ----
     --------------
  
     function Last_Key (Container : Map) return Key_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.Last.Key.all;
     end Last_Key;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 739,750 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Map; Source : in out Map) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 890,900 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Map; Source : in out Map) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Indefinite_O
*** 758,765 ****
           return No_Element;
        end if;
  
        declare
!          Node : constant Node_Access := Tree_Operations.Next (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 908,923 ----
           return No_Element;
        end if;
  
+       pragma Assert (Position.Node /= null);
+       pragma Assert (Position.Node.Key /= null);
+       pragma Assert (Position.Node.Element /= null);
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
!          Node : constant Node_Access :=
!                   Tree_Operations.Next (Position.Node);
! 
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Indefinite_O
*** 793,801 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Previous (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 951,966 ----
           return No_Element;
        end if;
  
+       pragma Assert (Position.Node /= null);
+       pragma Assert (Position.Node.Key /= null);
+       pragma Assert (Position.Node.Element /= null);
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Previous (Position.Node);
! 
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Indefinite_O
*** 816,825 ****
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Key.all, Position.Node.Element.all);
     end Query_Element;
  
     ----------
--- 981,1029 ----
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Key     : Key_Type;
!                                             Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Key = null
!         or else Position.Node.Element = null
!       then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key.all;
!             E : Element_Type renames Position.Node.Element.all;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 830,872 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : out Map)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
- 
        begin
           Node.Key := new Key_Type'(Key_Type'Input (Stream));
           Node.Element := new Element_Type'(Element_Type'Input (Stream));
           return Node;
- 
        exception
           when others =>
! 
!             --  Deallocate key and elem too on exception
! 
!             Free (Node);
              raise;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
! 
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
  
!       Local_Read (Container.Tree, N);
     end Read;
  
     -------------
--- 1034,1076 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : out Map)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
!       procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
        begin
           Node.Key := new Key_Type'(Key_Type'Input (Stream));
           Node.Element := new Element_Type'(Element_Type'Input (Stream));
           return Node;
        exception
           when others =>
!             Free (Node);  --  Note that Free deallocates key and elem too
              raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
!    end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
     end Read;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 889,899 ****
           raise Constraint_Error;
        end if;
  
        K := Node.Key;
        E := Node.Element;
  
        Node.Key := new Key_Type'(Key);
!       Node.Element := new Element_Type'(New_Item);
  
        Free_Key (K);
        Free_Element (E);
--- 1093,1114 ----
           raise Constraint_Error;
        end if;
  
+       if Container.Tree.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        K := Node.Key;
        E := Node.Element;
  
        Node.Key := new Key_Type'(Key);
! 
!       begin
!          Node.Element := new Element_Type'(New_Item);
!       exception
!          when others =>
!             Free_Key (K);
!             raise;
!       end;
  
        Free_Key (K);
        Free_Element (E);
*************** package body Ada.Containers.Indefinite_O
*** 903,913 ****
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element (Position : Cursor; By : Element_Type) is
!       X : Element_Access := Position.Node.Element;
     begin
!       Position.Node.Element := new Element_Type'(By);
!       Free_Element (X);
     end Replace_Element;
  
     ---------------------
--- 1118,1157 ----
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Key = null
!         or else Position.Node.Element = null
!       then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       if Container.Tree.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
! 
!       declare
!          X : Element_Access := Position.Node.Element;
! 
!       begin
!          Position.Node.Element := new Element_Type'(New_Item);
!          Free_Element (X);
!       end;
     end Replace_Element;
  
     ---------------------
*************** package body Ada.Containers.Indefinite_O
*** 930,942 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     -----------
--- 1174,1198 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (Container.Tree);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 989,999 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
     begin
!       Process (Position.Node.Key.all, Position.Node.Element.all);
     end Update_Element;
  
     -----------
--- 1245,1299 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
!                                              Element : in out Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Key = null
!         or else Position.Node.Element = null
!       then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Update_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key.all;
!             E : Element_Type renames Position.Node.Element.all;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 1004,1031 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : Map)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is
!         new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Key_Type'Output (Stream, Node.Key.all);
           Element_Type'Output (Stream, Node.Element.all);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
! end Ada.Containers.Indefinite_Ordered_Maps;
  
--- 1304,1342 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : Map)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Key_Type'Output (Stream, Node.Key.all);
           Element_Type'Output (Stream, Node.Element.all);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Indefinite_Ordered_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciorma.ads gcc-4.1.0/gcc/ada/a-ciorma.ads
*** gcc-4.0.2/gcc/ada/a-ciorma.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciorma.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_ORDERED_MAPS                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --             I N D E F I N I T E _ O R D E R E D _ M A P S                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Finalization;
*** 38,54 ****
  with Ada.Streams;
  
  generic
- 
     type Key_Type (<>) is private;
- 
     type Element_Type (<>) is private;
  
     with function "<" (Left, Right : Key_Type) return Boolean is <>;
- 
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Maps is
! pragma Preelaborate (Indefinite_Ordered_Maps);
  
     type Map is tagged private;
  
--- 39,54 ----
  with Ada.Streams;
  
  generic
     type Key_Type (<>) is private;
     type Element_Type (<>) is private;
  
     with function "<" (Left, Right : Key_Type) return Boolean is <>;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Maps is
!    pragma Preelaborate;
! 
!    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
     type Map is tagged private;
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 70,86 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Key     : Key_Type;
                                              Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Key     : Key_Type;
!                                             Element : in out Element_Type));
! 
!    procedure Replace_Element (Position : Cursor; By : Element_Type);
  
     procedure Move (Target : in out Map; Source : in out Map);
  
--- 70,90 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Map;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Key     : Key_Type;
                                              Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
!                                              Element : in out Element_Type));
  
     procedure Move (Target : in out Map; Source : in out Map);
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 106,166 ****
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Delete
!      (Container : in out Map;
!       Key       : Key_Type);
  
!    procedure Exclude
!      (Container : in out Map;
!       Key       : Key_Type);
  
!    procedure Delete
!      (Container : in out Map;
!       Position  : in out Cursor);
  
     procedure Delete_First (Container : in out Map);
  
     procedure Delete_Last (Container : in out Map);
  
!    function Contains
!      (Container : Map;
!       Key       : Key_Type) return Boolean;
  
!    function Find
!      (Container : Map;
!       Key       : Key_Type) return Cursor;
  
!    function Element
!      (Container : Map;
!       Key       : Key_Type) return Element_Type;
  
!    function Floor
!      (Container : Map;
!       Key       : Key_Type) return Cursor;
  
!    function Ceiling
!      (Container : Map;
!       Key       : Key_Type) return Cursor;
  
!    function First (Container : Map) return Cursor;
  
!    function First_Key (Container : Map) return Key_Type;
  
!    function First_Element (Container : Map) return Element_Type;
  
!    function Last (Container : Map) return Cursor;
  
!    function Last_Key (Container : Map) return Key_Type;
  
!    function Last_Element (Container : Map) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    function Previous (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
--- 110,154 ----
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Exclude (Container : in out Map; Key : Key_Type);
  
!    procedure Delete (Container : in out Map; Key : Key_Type);
  
!    procedure Delete (Container : in out Map; Position : in out Cursor);
  
     procedure Delete_First (Container : in out Map);
  
     procedure Delete_Last (Container : in out Map);
  
!    function First (Container : Map) return Cursor;
  
!    function First_Element (Container : Map) return Element_Type;
  
!    function First_Key (Container : Map) return Key_Type;
  
!    function Last (Container : Map) return Cursor;
  
!    function Last_Element (Container : Map) return Element_Type;
  
!    function Last_Key (Container : Map) return Key_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    function Previous (Position : Cursor) return Cursor;
  
!    procedure Previous (Position : in out Cursor);
  
!    function Find (Container : Map; Key : Key_Type) return Cursor;
  
!    function Element (Container : Map; Key : Key_Type) return Element_Type;
  
!    function Floor (Container : Map; Key : Key_Type) return Cursor;
  
!    function Ceiling (Container : Map; Key : Key_Type) return Cursor;
  
!    function Contains (Container : Map; Key : Key_Type) return Boolean;
  
     function Has_Element (Position : Cursor) return Boolean;
  
*************** private
*** 189,209 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!      new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Map is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Map);
  
     procedure Finalize (Container : in out Map) renames Clear;
  
!    type Map_Access is access constant Map;
     for Map_Access'Storage_Size use 0;
  
     type Cursor is record
--- 177,212 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Key_Access is access Key_Type;
!    type Element_Access is access Element_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Key     : Key_Access;
!       Element : Element_Access;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
! 
!    type Map is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Map);
  
     procedure Finalize (Container : in out Map) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Map_Access is access all Map;
     for Map_Access'Storage_Size use 0;
  
     type Cursor is record
*************** private
*** 211,219 ****
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 214,232 ----
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 228,234 ****
     for Map'Read use Read;
  
     Empty_Map : constant Map :=
!      (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Indefinite_Ordered_Maps;
- 
--- 241,251 ----
     for Map'Read use Read;
  
     Empty_Map : constant Map :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Indefinite_Ordered_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciormu.adb gcc-4.1.0/gcc/ada/a-ciormu.adb
*** gcc-4.0.2/gcc/ada/a-ciormu.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciormu.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.INDEFINITE_ORDERED_MULTISETS                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --         I N D E F I N I T E _ O R D E R E D _ M U L T I S E T S          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 44,65 ****
  with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
  pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Indefinite_Ordered_Multisets is
  
-    use Red_Black_Trees;
- 
-    type Element_Access is access Element_Type;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Element : Element_Access;
-    end record;
- 
     -----------------------------
     -- Node Access Subprograms --
     -----------------------------
--- 45,52 ----
*************** package body Ada.Containers.Indefinite_O
*** 98,109 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
- 
-    procedure Delete_Tree (X : in out Node_Access);
- 
     procedure Free (X : in out Node_Access);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
        Dst_Hint : Node_Access;
--- 85,97 ----
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
     procedure Free (X : in out Node_Access);
  
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access);
+ 
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
        Dst_Hint : Node_Access;
*************** package body Ada.Containers.Indefinite_O
*** 126,139 ****
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!        (Tree_Types => Tree_Types,
!         Null_Node  => Node_Access'(null));
  
     use Tree_Operations;
  
--- 114,136 ----
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
+    procedure Replace_Element
+      (Tree : in out Tree_Type;
+       Node : Node_Access;
+       Item : Element_Type);
+ 
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations (Tree_Types);
! 
!    procedure Delete_Tree is
!      new Tree_Operations.Generic_Delete_Tree (Free);
! 
!    function Copy_Tree is
!      new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
  
     use Tree_Operations;
  
*************** package body Ada.Containers.Indefinite_O
*** 165,180 ****
--- 162,217 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null
+         or else Right.Node.Element = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Element.all < Right.Node.Element.all;
     end "<";
  
     function "<" (Left : Cursor; Right : Element_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Element.all < Right;
     end "<";
  
     function "<" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Element.all;
     end "<";
  
*************** package body Ada.Containers.Indefinite_O
*** 182,192 ****
     -- "=" --
     ---------
  
!    function "=" (Left, Right : Set) return Boolean is begin
!       if Left'Address = Right'Address then
!          return True;
!       end if;
! 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
--- 219,226 ----
     -- "=" --
     ---------
  
!    function "=" (Left, Right : Set) return Boolean is
!    begin
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
*************** package body Ada.Containers.Indefinite_O
*** 194,213 ****
     -- ">" --
     ---------
  
-    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
-    begin
-       return Right < Left.Node.Element.all;
-    end ">";
- 
     function ">" (Left, Right : Cursor) return Boolean is
     begin
        --  L > R same as R < L
  
        return Right.Node.Element.all < Left.Node.Element.all;
     end ">";
  
     function ">" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
        return Right.Node.Element.all < Left;
     end ">";
  
--- 228,287 ----
     -- ">" --
     ---------
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null
+         or else Right.Node.Element = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        --  L > R same as R < L
  
        return Right.Node.Element.all < Left.Node.Element.all;
     end ">";
  
+    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
+    begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       return Right < Left.Node.Element.all;
+    end ">";
+ 
     function ">" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Element.all < Left;
     end ">";
  
*************** package body Ada.Containers.Indefinite_O
*** 215,238 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
! 
!       N : constant Count_Type := Tree.Length;
!       X : constant Node_Access := Tree.Root;
  
     begin
!       if N = 0 then
!          pragma Assert (X = null);
!          return;
!       end if;
! 
!       Tree := (Length => 0, others => null);
! 
!       Tree.Root := Copy_Tree (X);
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
!       Tree.Length := N;
     end Adjust;
  
     -------------
--- 289,300 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Set) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 248,266 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Set) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 310,328 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Set) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 301,349 ****
           raise;
     end Copy_Node;
  
-    ---------------
-    -- Copy_Tree --
-    ---------------
- 
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
-       Target_Root : Node_Access := Copy_Node (Source_Root);
- 
-       P, X : Node_Access;
- 
-    begin
-       if Source_Root.Right /= null then
-          Target_Root.Right := Copy_Tree (Source_Root.Right);
-          Target_Root.Right.Parent := Target_Root;
-       end if;
- 
-       P := Target_Root;
-       X := Source_Root.Left;
-       while X /= null loop
-          declare
-             Y : Node_Access := Copy_Node (X);
- 
-          begin
-             P.Left := Y;
-             Y.Parent := P;
- 
-             if X.Right /= null then
-                Y.Right := Copy_Tree (X.Right);
-                Y.Right.Parent := Y;
-             end if;
- 
-             P := Y;
-             X := X.Left;
-          end;
-       end loop;
- 
-       return Target_Root;
- 
-    exception
-       when others =>
-          Delete_Tree (Target_Root);
-          raise;
-    end Copy_Tree;
- 
     ------------
     -- Delete --
     ------------
--- 363,368 ----
*************** package body Ada.Containers.Indefinite_O
*** 371,385 ****
  
     procedure Delete (Container : in out Set; Position : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
--- 390,407 ----
  
     procedure Delete (Container : in out Set; Position : in out Cursor) is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Delete");
! 
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
*************** package body Ada.Containers.Indefinite_O
*** 419,466 ****
        Free (X);
     end Delete_Last;
  
-    -----------------
-    -- Delete_Tree --
-    -----------------
- 
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
-    begin
-       while X /= null loop
-          Y := X.Right;
-          Delete_Tree (Y);
-          Y := X.Left;
-          Free (X);
-          X := Y;
-       end loop;
-    end Delete_Tree;
- 
     ----------------
     -- Difference --
     ----------------
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Difference;
  
     -------------
--- 441,460 ----
        Free (X);
     end Delete_Last;
  
     ----------------
     -- Difference --
     ----------------
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Difference;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 469,477 ****
--- 463,530 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Position.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element.all;
     end Element;
  
+    -------------------------
+    -- Equivalent_Elements --
+    -------------------------
+ 
+    function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Elements;
+ 
+    ---------------------
+    -- Equivalent_Sets --
+    ---------------------
+ 
+    function Equivalent_Sets (Left, Right : Set) return Boolean is
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean;
+       pragma Inline (Is_Equivalent_Node_Node);
+ 
+       function Is_Equivalent is
+          new Tree_Operations.Generic_Equal (Is_Equivalent_Node_Node);
+ 
+       -----------------------------
+       -- Is_Equivalent_Node_Node --
+       -----------------------------
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
+       begin
+          if L.Element.all < R.Element.all then
+             return False;
+          elsif R.Element.all < L.Element.all then
+             return False;
+          else
+             return True;
+          end if;
+       end Is_Equivalent_Node_Node;
+ 
+    --  Start of processing for Equivalent_Sets
+ 
+    begin
+       return Is_Equivalent (Left.Tree, Right.Tree);
+    end Equivalent_Sets;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 481,486 ****
--- 534,540 ----
        Node : Node_Access := Element_Keys.Ceiling (Tree, Item);
        Done : constant Node_Access := Element_Keys.Upper_Bound (Tree, Item);
        X    : Node_Access;
+ 
     begin
        while Node /= Done loop
           X := Node;
*************** package body Ada.Containers.Indefinite_O
*** 503,509 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Find;
  
     -----------
--- 557,563 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 516,522 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.First);
     end First;
  
     -------------------
--- 570,576 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Indefinite_O
*** 525,530 ****
--- 579,592 ----
  
     function First_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.First = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Container.Tree.First.Element = null then
+          raise Program_Error;
+       end if;
+ 
        return Container.Tree.First.Element.all;
     end First_Element;
  
*************** package body Ada.Containers.Indefinite_O
*** 541,547 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Floor;
  
     ----------
--- 603,609 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 551,561 ****
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
     begin
!       if X /= null then
!          Free_Element (X.Element);
!          Deallocate (X);
        end if;
     end Free;
  
     ------------------
--- 613,638 ----
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
     begin
!       if X = null then
!          return;
        end if;
+ 
+       X.Parent := X;
+       X.Left := X;
+       X.Right := X;
+ 
+       begin
+          Free_Element (X.Element);
+       exception
+          when others =>
+             X.Element := null;
+             Deallocate (X);
+             raise;
+       end;
+ 
+       Deallocate (X);
     end Free;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 589,622 ****
             Is_Less_Key_Node    => Is_Less_Key_Node,
             Is_Greater_Key_Node => Is_Greater_Key_Node);
  
-       ---------
-       -- "<" --
-       ---------
- 
-       function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left < Right.Node.Element.all;
-       end "<";
- 
-       function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right > Left.Node.Element.all;
-       end "<";
- 
-       ---------
-       -- ">" --
-       ---------
- 
-       function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left > Right.Node.Element.all;
-       end ">";
- 
-       function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right < Left.Node.Element.all;
-       end ">";
- 
        -------------
        -- Ceiling --
        -------------
--- 666,671 ----
*************** package body Ada.Containers.Indefinite_O
*** 630,706 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Ceiling;
  
-       ----------------------------
-       -- Checked_Update_Element --
-       ----------------------------
- 
-       procedure Checked_Update_Element
-         (Container : in out Set;
-          Position  : Cursor;
-          Process   : not null access procedure (Element : in out Element_Type))
-       is
-       begin
-          if Position.Container = null then
-             raise Constraint_Error;
-          end if;
- 
-          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
-             raise Program_Error;
-          end if;
- 
-          declare
-             Old_Key : Key_Type renames Key (Position.Node.Element.all);
- 
-          begin
-             Process (Position.Node.Element.all);
- 
-             if Old_Key < Position.Node.Element.all
-               or else Old_Key > Position.Node.Element.all
-             then
-                null;
-             else
-                return;
-             end if;
-          end;
- 
-          Delete_Node_Sans_Free (Container.Tree, Position.Node);
- 
-          Do_Insert : declare
-             Result : Node_Access;
- 
-             function New_Node return Node_Access;
-             pragma Inline (New_Node);
- 
-             procedure Insert_Post is
-               new Key_Keys.Generic_Insert_Post (New_Node);
- 
-             procedure Insert is
-               new Key_Keys.Generic_Unconditional_Insert (Insert_Post);
- 
-             --------------
-             -- New_Node --
-             --------------
- 
-             function New_Node return Node_Access is
-             begin
-                return Position.Node;
-             end New_Node;
- 
-          --  Start of processing for Do_Insert
- 
-          begin
-             Insert
-               (Tree    => Container.Tree,
-                Key     => Key (Position.Node.Element.all),
-                Node    => Result);
- 
-             pragma Assert (Result = Position.Node);
-          end Do_Insert;
-       end Checked_Update_Element;
- 
        --------------
        -- Contains --
        --------------
--- 679,687 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Ceiling;
  
        --------------
        -- Contains --
        --------------
*************** package body Ada.Containers.Indefinite_O
*** 740,750 ****
        -------------
  
        function Element (Container : Set; Key : Key_Type) return Element_Type is
!          Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
        begin
           return Node.Element.all;
        end Element;
  
        -------------
        -- Exclude --
        -------------
--- 721,752 ----
        -------------
  
        function Element (Container : Set; Key : Key_Type) return Element_Type is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.Tree, Key);
! 
        begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
+ 
           return Node.Element.all;
        end Element;
  
+       ---------------------
+       -- Equivalent_Keys --
+       ---------------------
+ 
+       function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+       begin
+          if Left < Right
+            or else Right < Left
+          then
+             return False;
+          else
+             return True;
+          end if;
+       end Equivalent_Keys;
+ 
        -------------
        -- Exclude --
        -------------
*************** package body Ada.Containers.Indefinite_O
*** 776,782 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Find;
  
        -----------
--- 778,784 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Find;
  
        -----------
*************** package body Ada.Containers.Indefinite_O
*** 791,797 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Floor;
  
        -------------------------
--- 793,799 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Floor;
  
        -------------------------
*************** package body Ada.Containers.Indefinite_O
*** 800,808 ****
  
        function Is_Greater_Key_Node
          (Left  : Key_Type;
!          Right : Node_Access) return Boolean is
        begin
!          return Left > Right.Element.all;
        end Is_Greater_Key_Node;
  
        ----------------------
--- 802,811 ----
  
        function Is_Greater_Key_Node
          (Left  : Key_Type;
!          Right : Node_Access) return Boolean
!       is
        begin
!          return Key (Right.Element.all) < Left;
        end Is_Greater_Key_Node;
  
        ----------------------
*************** package body Ada.Containers.Indefinite_O
*** 811,819 ****
  
        function Is_Less_Key_Node
          (Left  : Key_Type;
!          Right : Node_Access) return Boolean is
        begin
!          return Left < Right.Element.all;
        end Is_Less_Key_Node;
  
        -------------
--- 814,823 ----
  
        function Is_Less_Key_Node
          (Left  : Key_Type;
!          Right : Node_Access) return Boolean
!       is
        begin
!          return Left < Key (Right.Element.all);
        end Is_Less_Key_Node;
  
        -------------
*************** package body Ada.Containers.Indefinite_O
*** 837,849 ****
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unchecked_Access, Node));
           end Process_Node;
  
        --  Start of processing for Iterate
  
        begin
!          Local_Iterate (Container.Tree, Key);
        end Iterate;
  
        ---------
--- 841,866 ----
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unrestricted_Access, Node));
           end Process_Node;
  
+          T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+          B : Natural renames T.Busy;
+ 
        --  Start of processing for Iterate
  
        begin
!          B := B + 1;
! 
!          begin
!             Local_Iterate (T, Key);
!          exception
!             when others =>
!                B := B - 1;
!                raise;
!          end;
! 
!          B := B - 1;
        end Iterate;
  
        ---------
*************** package body Ada.Containers.Indefinite_O
*** 852,880 ****
  
        function Key (Position : Cursor) return Key_Type is
        begin
!          return Key (Position.Node.Element.all);
!       end Key;
! 
!       -------------
!       -- Replace --
!       -------------
! 
!       --  In post-madision api: ???
  
! --     procedure Replace
! --       (Container : in out Set;
! --        Key       : Key_Type;
! --        New_Item  : Element_Type)
! --     is
! --           Node : Node_Access := Key_Keys.Find (Container.Tree, Key);
  
! --        begin
! --           if Node = null then
! --              raise Constraint_Error;
! --           end if;
  
! --           Replace_Node (Container, Node, New_Item);
! --        end Replace;
  
        ---------------------
        -- Reverse_Iterate --
--- 869,887 ----
  
        function Key (Position : Cursor) return Key_Type is
        begin
!          if Position.Node = null then
!             raise Constraint_Error;
!          end if;
  
!          if Position.Node.Element = null then
!             raise Program_Error;
!          end if;
  
!          pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                         "bad cursor in Key");
  
!          return Key (Position.Node.Element.all);
!       end Key;
  
        ---------------------
        -- Reverse_Iterate --
*************** package body Ada.Containers.Indefinite_O
*** 901,915 ****
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unchecked_Access, Node));
           end Process_Node;
  
        --  Start of processing for Reverse_Iterate
  
        begin
!          Local_Reverse_Iterate (Container.Tree, Key);
        end Reverse_Iterate;
  
     end Generic_Keys;
  
     -----------------
--- 908,1000 ----
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unrestricted_Access, Node));
           end Process_Node;
  
+          T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+          B : Natural renames T.Busy;
+ 
        --  Start of processing for Reverse_Iterate
  
        begin
!          B := B + 1;
! 
!          begin
!             Local_Reverse_Iterate (T, Key);
!          exception
!             when others =>
!                B := B - 1;
!                raise;
!          end;
! 
!          B := B - 1;
        end Reverse_Iterate;
  
+       -----------------------------------
+       -- Update_Element_Preserving_Key --
+       -----------------------------------
+ 
+       procedure Update_Element_Preserving_Key
+         (Container : in out Set;
+          Position  : Cursor;
+          Process   : not null access procedure (Element : in out Element_Type))
+       is
+          Tree : Tree_Type renames Container.Tree;
+ 
+       begin
+          if Position.Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          if Position.Node.Element = null then
+             raise Program_Error;
+          end if;
+ 
+          if Position.Container /= Container'Unrestricted_Access then
+             raise Program_Error;
+          end if;
+ 
+          pragma Assert (Vet (Container.Tree, Position.Node),
+                         "bad cursor in Update_Element_Preserving_Key");
+ 
+          declare
+             E : Element_Type renames Position.Node.Element.all;
+             K : constant Key_Type := Key (E);
+ 
+             B : Natural renames Tree.Busy;
+             L : Natural renames Tree.Lock;
+ 
+          begin
+             B := B + 1;
+             L := L + 1;
+ 
+             begin
+                Process (E);
+             exception
+                when others =>
+                   L := L - 1;
+                   B := B - 1;
+                   raise;
+             end;
+ 
+             L := L - 1;
+             B := B - 1;
+ 
+             if Equivalent_Keys (Left => K, Right => Key (E)) then
+                return;
+             end if;
+          end;
+ 
+          declare
+             X : Node_Access := Position.Node;
+          begin
+             Tree_Operations.Delete_Node_Sans_Free (Tree, X);
+             Free (X);
+          end;
+ 
+          raise Program_Error;
+       end Update_Element_Preserving_Key;
+ 
     end Generic_Keys;
  
     -----------------
*************** package body Ada.Containers.Indefinite_O
*** 936,941 ****
--- 1021,1044 ----
        New_Item  : Element_Type;
        Position  : out Cursor)
     is
+    begin
+       Insert_Sans_Hint
+         (Container.Tree,
+          New_Item,
+          Position.Node);
+ 
+       Position.Container := Container'Unrestricted_Access;
+    end Insert;
+ 
+    ----------------------
+    -- Insert_Sans_Hint --
+    ----------------------
+ 
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access)
+    is
        function New_Node return Node_Access;
        pragma Inline (New_Node);
  
*************** package body Ada.Containers.Indefinite_O
*** 956,962 ****
           return new Node_Type'(Parent  => null,
                                 Left    => null,
                                 Right   => null,
!                                Color   => Red,
                                 Element => X);
  
        exception
--- 1059,1065 ----
           return new Node_Type'(Parent  => null,
                                 Left    => null,
                                 Right   => null,
!                                Color   => Red_Black_Trees.Red,
                                 Element => X);
  
        exception
*************** package body Ada.Containers.Indefinite_O
*** 965,980 ****
              raise;
        end New_Node;
  
!    --  Start of processing for Insert
  
     begin
        Unconditional_Insert_Sans_Hint
!         (Container.Tree,
           New_Item,
!          Position.Node);
! 
!       Position.Container := Container'Unchecked_Access;
!    end Insert;
  
     ----------------------
     -- Insert_With_Hint --
--- 1068,1081 ----
              raise;
        end New_Node;
  
!    --  Start of processing for Insert_Sans_Hint
  
     begin
        Unconditional_Insert_Sans_Hint
!         (Tree,
           New_Item,
!          Node);
!    end Insert_Sans_Hint;
  
     ----------------------
     -- Insert_With_Hint --
*************** package body Ada.Containers.Indefinite_O
*** 1036,1060 ****
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Intersection (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Intersection;
  
     --------------
--- 1137,1150 ----
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Intersection (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Intersection;
  
     --------------
*************** package body Ada.Containers.Indefinite_O
*** 1116,1125 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
     begin
-       if Subset'Address = Of_Set'Address then
-          return True;
-       end if;
- 
        return Set_Ops.Is_Subset (Subset => Subset.Tree, Of_Set => Of_Set.Tree);
     end Is_Subset;
  
--- 1206,1211 ----
*************** package body Ada.Containers.Indefinite_O
*** 1144,1156 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree, Item);
     end Iterate;
  
     procedure Iterate
--- 1230,1255 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T, Item);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     procedure Iterate
*************** package body Ada.Containers.Indefinite_O
*** 1169,1181 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     ----------
--- 1268,1293 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 1188,1194 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
     end Last;
  
     ------------------
--- 1300,1306 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 1197,1202 ****
--- 1309,1318 ----
  
     function Last_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.Last.Element.all;
     end Last_Element;
  
*************** package body Ada.Containers.Indefinite_O
*** 1222,1233 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 1338,1348 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Indefinite_O
*** 1241,1246 ****
--- 1356,1364 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
           Node : constant Node_Access :=
                    Tree_Operations.Next (Position.Node);
*************** package body Ada.Containers.Indefinite_O
*** 1265,1274 ****
  
     function Overlap (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return Left.Tree.Length /= 0;
-       end if;
- 
        return Set_Ops.Overlap (Left.Tree, Right.Tree);
     end Overlap;
  
--- 1383,1388 ----
*************** package body Ada.Containers.Indefinite_O
*** 1291,1296 ****
--- 1405,1413 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
                    Tree_Operations.Previous (Position.Node);
*************** package body Ada.Containers.Indefinite_O
*** 1318,1324 ****
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Element.all);
     end Query_Element;
  
     ----------
--- 1435,1473 ----
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element.all);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 1329,1478 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
- 
        begin
!          begin
!             Node.Element := new Element_Type'(Element_Type'Input (Stream));
!          exception
!             when others =>
!                Free (Node);
!                raise;
!          end;
! 
           return Node;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
! 
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
! 
!       Local_Read (Container.Tree, N);
     end Read;
  
!    -------------
!    -- Replace --
!    -------------
! 
!    --  NOTE: from post-madison api???
! 
! --   procedure Replace
! --     (Container : in out Set;
! --      Position  : Cursor;
! --      By        : Element_Type)
! --   is
! --   begin
! --      if Position.Container = null then
! --         raise Constraint_Error;
! --      end if;
  
! --      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --         raise Program_Error;
! --      end if;
  
! --      Replace_Node (Container, Position.Node, By);
! --   end Replace;
  
!    ------------------
!    -- Replace_Node --
!    ------------------
  
!    --  NOTE: from post-madison api???
  
! --   procedure Replace_Node
! --     (Container : in out Set;
! --      Position  : Node_Access;
! --      By        : Element_Type);
! --   is
! --      Tree : Tree_Type renames Container.Tree;
! --      Node : Node_Access := Position;
  
! --   begin
! --      if By < Node.Element
! --        or else Node.Element < By
! --      then
! --         null;
  
! --      else
! --         begin
! --            Node.Element := By;
  
! --         exception
! --            when others =>
! --               Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
! --               Free (Node);
! --               raise;
! --         end;
  
! --         return;
! --      end if;
  
! --      Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
  
! --      begin
! --         Node.Element := By;
  
! --      exception
! --         when others =>
! --            Free (Node);
! --            raise;
! --      end;
  
! --      declare
! --         Result  : Node_Access;
! --         Success : Boolean;
  
! --         function New_Node return Node_Access;
! --         pragma Inline (New_Node);
  
! --         procedure Insert_Post is
! --           new Element_Keys.Generic_Insert_Post (New_Node);
  
! --         procedure Insert is
! --           new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
! --         --------------
! --         -- New_Node --
! --         --------------
! --
! --         function New_Node return Node_Access is
! --         begin
! --            return Node;
! --         end New_Node;
  
! --      --  Start of processing for Replace_Node
  
! --      begin
! --         Insert
! --           (Tree    => Tree,
! --            Key     => Node.Element,
! --            Node    => Result,
! --            Success => Success);
  
! --         if not Success then
! --            Free (Node);
! --            raise Program_Error;
! --         end if;
  
! --         pragma Assert (Result = Node);
! --      end;
! --   end Replace_Node;
  
     ---------------------
     -- Reverse_Iterate --
--- 1478,1617 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
!       procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
        begin
!          Node.Element := new Element_Type'(Element_Type'Input (Stream));
           return Node;
!       exception
!          when others =>
!             Free (Node);  --  Note that Free deallocates elem too
!             raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
     end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
  
!    ---------------------
!    -- Replace_Element --
!    ---------------------
  
!    procedure Replace_Element
!      (Tree : in out Tree_Type;
!       Node : Node_Access;
!       Item : Element_Type)
!    is
!    begin
!       if Item < Node.Element.all
!         or else Node.Element.all < Item
!       then
!          null;
!       else
!          if Tree.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          declare
!             X : Element_Access := Node.Element;
!          begin
!             Node.Element := new Element_Type'(Item);
!             Free_Element (X);
!          end;
  
!          return;
!       end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
  
!       Insert_New_Item : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
!          procedure Unconditional_Insert is
!             new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node return Node_Access is
!          begin
!             Node.Element := new Element_Type'(Item);  -- OK if fails
!             Node.Color := Red_Black_Trees.Red;
!             Node.Parent := null;
!             Node.Left := null;
!             Node.Right := null;
  
!             return Node;
!          end New_Node;
  
!          Result : Node_Access;
  
!          X : Element_Access := Node.Element;
  
!       --  Start of processing for Insert_New_Item
  
!       begin
!          Unconditional_Insert
!            (Tree => Tree,
!             Key  => Item,
!             Node => Result);
!          pragma Assert (Result = Node);
  
!          Free_Element (X);  -- OK if fails
!       end Insert_New_Item;
!    end Replace_Element;
  
!    procedure Replace_Element
!     (Container : in out Set;
!      Position  : Cursor;
!      New_Item  : Element_Type)
!    is
!    begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
  
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
  
!       Replace_Element (Container.Tree, Position.Node, New_Item);
!    end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
*************** package body Ada.Containers.Indefinite_O
*** 1495,1507 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree, Item);
     end Reverse_Iterate;
  
     procedure Reverse_Iterate
--- 1634,1659 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T, Item);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     procedure Reverse_Iterate
*************** package body Ada.Containers.Indefinite_O
*** 1520,1532 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     -----------
--- 1672,1697 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 1580,1630 ****
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Symmetric_Difference;
  
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
!    function Union (Left, Right : Set) return Set is begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Union;
  
     -----------
--- 1745,1787 ----
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
+ 
+    function To_Set (New_Item : Element_Type) return Set is
+       Tree     : Tree_Type;
+       Node     : Node_Access;
+ 
+    begin
+       Insert_Sans_Hint (Tree, New_Item, Node);
+       return Set'(Controlled with Tree);
+    end To_Set;
+ 
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
!    function Union (Left, Right : Set) return Set is
!       Tree : constant Tree_Type :=
!                Set_Ops.Union (Left.Tree, Right.Tree);
!    begin
!       return Set'(Controlled with Tree);
     end Union;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 1635,1659 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Element_Type'Output (Stream, Node.Element.all);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
  end Ada.Containers.Indefinite_Ordered_Multisets;
--- 1792,1829 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Element_Type'Output (Stream, Node.Element.all);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
!    end Write;
! 
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
     end Write;
  
  end Ada.Containers.Indefinite_Ordered_Multisets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciormu.ads gcc-4.1.0/gcc/ada/a-ciormu.ads
*** gcc-4.0.2/gcc/ada/a-ciormu.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciormu.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.INDEFINITE_ORDERED_MULTISETS                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --         I N D E F I N I T E _ O R D E R E D _ M U L T I S E T S          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 44,50 ****
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Multisets is
! pragma Preelaborate (Indefinite_Ordered_Multisets);
  
     type Set is tagged private;
  
--- 45,53 ----
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Multisets is
!    pragma Preelaborate;
! 
!    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
  
     type Set is tagged private;
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 56,61 ****
--- 59,68 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** pragma Preelaborate (Indefinite_Ordered_
*** 64,69 ****
--- 71,81 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
*************** pragma Preelaborate (Indefinite_Ordered_
*** 77,103 ****
  
     procedure Insert (Container : in out Set; New_Item : Element_Type);
  
!    procedure Delete (Container : in out Set; Item : Element_Type);
  
     procedure Exclude (Container : in out Set; Item : Element_Type);
  
     procedure Delete (Container : in out Set; Position : in out Cursor);
  
     procedure Delete_First (Container : in out Set);
  
     procedure Delete_Last (Container : in out Set);
  
! 
!    --  NOTE: The following operation is named Replace in the Madison API.
!    --  However, it should be named Replace_Element ???
!    --
!    --   procedure Replace
!    --     (Container : in out Set;
!    --      Position  : Cursor;
!    --      By        : Element_Type);
! 
!    procedure Union (Target : in out Set;
!                     Source : Set);
  
     function Union (Left, Right : Set) return Set;
  
--- 89,111 ----
  
     procedure Insert (Container : in out Set; New_Item : Element_Type);
  
! --  TODO: include Replace too???
! --
! --     procedure Replace
! --       (Container : in out Set;
! --        New_Item  : Element_Type);
  
     procedure Exclude (Container : in out Set; Item : Element_Type);
  
+    procedure Delete (Container : in out Set; Item : Element_Type);
+ 
     procedure Delete (Container : in out Set; Position : in out Cursor);
  
     procedure Delete_First (Container : in out Set);
  
     procedure Delete_Last (Container : in out Set);
  
!    procedure Union (Target : in out Set; Source : Set);
  
     function Union (Left, Right : Set) return Set;
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 125,138 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
-    function Contains (Container : Set; Item : Element_Type) return Boolean;
- 
-    function Find (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Floor (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
- 
     function First (Container : Set) return Cursor;
  
     function First_Element (Container : Set) return Element_Type;
--- 133,138 ----
*************** pragma Preelaborate (Indefinite_Ordered_
*** 143,154 ****
  
     function Next (Position : Cursor) return Cursor;
  
-    function Previous (Position : Cursor) return Cursor;
- 
     procedure Next (Position : in out Cursor);
  
     procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
--- 143,162 ----
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
+    function Previous (Position : Cursor) return Cursor;
+ 
     procedure Previous (Position : in out Cursor);
  
+    function Find (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Floor (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
*************** pragma Preelaborate (Indefinite_Ordered_
*** 182,231 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
! 
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left : Key_Type; Right : Element_Type)
!           return Boolean is <>;
! 
!       with function ">" (Left : Key_Type; Right : Element_Type)
!           return Boolean is <>;
  
     package Generic_Keys is
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       function Find (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       --  NOTE: in post-madison api ???
!       --      procedure Replace
!       --        (Container : in out Set;
!       --         Key       : Key_Type;
!       --         New_Item  : Element_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       procedure Exclude (Container : in out Set; Key : Key_Type);
! 
!       function "<" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function ">" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function "<" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       function ">" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
--- 190,222 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left, Right : Key_Type) return Boolean is <>;
  
     package Generic_Keys is
  
!       function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       procedure Exclude (Container : in out Set; Key : Key_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       function Find (Container : Set; Key : Key_Type) return Cursor;
  
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
  
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
  
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
*************** private
*** 248,268 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!       new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Set is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    type Set_Access is access constant Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
--- 239,272 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Element_Access is access Element_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Element : Element_Access;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
! 
!    type Set is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
*************** private
*** 270,278 ****
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
  
--- 274,292 ----
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
  
*************** private
*** 285,290 ****
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Indefinite_Ordered_Multisets;
--- 299,309 ----
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Indefinite_Ordered_Multisets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciorse.adb gcc-4.1.0/gcc/ada/a-ciorse.adb
*** gcc-4.0.2/gcc/ada/a-ciorse.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciorse.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_ORDERED_SETS                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --              I N D E F I N I T E _ O R D E R E D _ S E T S               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 44,65 ****
  
  with Ada.Unchecked_Deallocation;
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Indefinite_Ordered_Sets is
  
-    type Element_Access is access Element_Type;
- 
-    use Red_Black_Trees;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Element : Element_Access;
-    end record;
- 
     -----------------------
     -- Local Subprograms --
     -----------------------
--- 45,52 ----
*************** package body Ada.Containers.Indefinite_O
*** 70,81 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
- 
-    procedure Delete_Tree (X : in out Node_Access);
- 
     procedure Free (X : in out Node_Access);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
        Dst_Hint : Node_Access;
--- 57,70 ----
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
     procedure Free (X : in out Node_Access);
  
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access;
+       Inserted : out Boolean);
+ 
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
        Dst_Hint : Node_Access;
*************** package body Ada.Containers.Indefinite_O
*** 101,106 ****
--- 90,100 ----
     function Parent (Node : Node_Access) return Node_Access;
     pragma Inline (Parent);
  
+    procedure Replace_Element
+      (Tree : in out Tree_Type;
+       Node : Node_Access;
+       Item : Element_Type);
+ 
     function Right (Node : Node_Access) return Node_Access;
     pragma Inline (Right);
  
*************** package body Ada.Containers.Indefinite_O
*** 124,132 ****
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!        (Tree_Types => Tree_Types,
!         Null_Node  => Node_Access'(null));
  
     use Tree_Operations;
  
--- 118,130 ----
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations (Tree_Types);
! 
!    procedure Delete_Tree is
!      new Tree_Operations.Generic_Delete_Tree (Free);
! 
!    function Copy_Tree is
!      new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
  
     use Tree_Operations;
  
*************** package body Ada.Containers.Indefinite_O
*** 152,167 ****
--- 150,205 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null
+         or else Right.Node.Element = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Element.all < Right.Node.Element.all;
     end "<";
  
     function "<" (Left : Cursor; Right : Element_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Element.all < Right;
     end "<";
  
     function "<" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Element.all;
     end "<";
  
*************** package body Ada.Containers.Indefinite_O
*** 189,208 ****
     --  Start of processing for "="
  
     begin
-       if Left'Address = Right'Address then
-          return True;
-       end if;
- 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
- 
     ---------
     -- ">" --
     ---------
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
        --  L > R same as R < L
  
        return Right.Node.Element.all < Left.Node.Element.all;
--- 227,259 ----
     --  Start of processing for "="
  
     begin
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
     ---------
     -- ">" --
     ---------
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null
+         or else Right.Node.Element = null
+       then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        --  L > R same as R < L
  
        return Right.Node.Element.all < Left.Node.Element.all;
*************** package body Ada.Containers.Indefinite_O
*** 210,220 ****
--- 261,293 ----
  
     function ">" (Left : Cursor; Right : Element_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Left.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
        return Right < Left.Node.Element.all;
     end ">";
  
     function ">" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Right.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Element.all < Left;
     end ">";
  
*************** package body Ada.Containers.Indefinite_O
*** 222,246 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
  
     begin
!       if Tree.Length = 0 then
!          pragma Assert (Tree.Root = null);
!          return;
!       end if;
! 
!       begin
!          Tree.Root := Copy_Tree (Tree.Root);
!       exception
!          when others =>
!             Tree := (Length => 0, others => null);
!             raise;
!       end;
! 
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
     end Adjust;
  
     -------------
--- 295,306 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Set) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 256,274 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Set) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 316,334 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Set) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 295,300 ****
--- 355,361 ----
  
     function Copy_Node (Source : Node_Access) return Node_Access is
        Element : Element_Access := new Element_Type'(Source.Element.all);
+ 
     begin
        return new Node_Type'(Parent  => null,
                              Left    => null,
*************** package body Ada.Containers.Indefinite_O
*** 307,372 ****
           raise;
     end Copy_Node;
  
-    ---------------
-    -- Copy_Tree --
-    ---------------
- 
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
-       Target_Root : Node_Access := Copy_Node (Source_Root);
-       P, X        : Node_Access;
- 
-    begin
-       if Source_Root.Right /= null then
-          Target_Root.Right := Copy_Tree (Source_Root.Right);
-          Target_Root.Right.Parent := Target_Root;
-       end if;
- 
-       P := Target_Root;
-       X := Source_Root.Left;
- 
-       while X /= null loop
-          declare
-             Y : Node_Access := Copy_Node (X);
- 
-          begin
-             P.Left := Y;
-             Y.Parent := P;
- 
-             if X.Right /= null then
-                Y.Right := Copy_Tree (X.Right);
-                Y.Right.Parent := Y;
-             end if;
- 
-             P := Y;
-             X := X.Left;
-          end;
-       end loop;
- 
-       return Target_Root;
- 
-    exception
-       when others =>
-          Delete_Tree (Target_Root);
-          raise;
-    end Copy_Tree;
- 
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Set; Position  : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, Position.Node);
!       Free (Position.Node);
  
        Position.Container := null;
     end Delete;
  
--- 368,392 ----
           raise;
     end Copy_Node;
  
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Set; Position  : in out Cursor) is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Delete");
  
+       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
+       Free (Position.Node);
        Position.Container := null;
     end Delete;
  
*************** package body Ada.Containers.Indefinite_O
*** 379,385 ****
           raise Constraint_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
--- 399,405 ----
           raise Constraint_Error;
        end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
*************** package body Ada.Containers.Indefinite_O
*** 388,396 ****
     ------------------
  
     procedure Delete_First (Container : in out Set) is
!       C : Cursor := First (Container);
     begin
!       Delete (Container, C);
     end Delete_First;
  
     -----------------
--- 408,421 ----
     ------------------
  
     procedure Delete_First (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
!       X    : Node_Access := Tree.First;
! 
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Tree, X);
!          Free (X);
!       end if;
     end Delete_First;
  
     -----------------
*************** package body Ada.Containers.Indefinite_O
*** 398,423 ****
     -----------------
  
     procedure Delete_Last (Container : in out Set) is
!       C : Cursor := Last (Container);
!    begin
!       Delete (Container, C);
!    end Delete_Last;
! 
!    -----------------
!    -- Delete_Tree --
!    -----------------
  
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
     begin
!       while X /= null loop
!          Y := X.Right;
!          Delete_Tree (Y);
!          Y := X.Left;
           Free (X);
!          X := Y;
!       end loop;
!    end Delete_Tree;
  
     ----------------
     -- Difference --
--- 423,437 ----
     -----------------
  
     procedure Delete_Last (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
!       X    : Node_Access := Tree.Last;
  
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Tree, X);
           Free (X);
!       end if;
!    end Delete_Last;
  
     ----------------
     -- Difference --
*************** package body Ada.Containers.Indefinite_O
*** 425,450 ****
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!            Set_Ops.Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Difference;
  
     -------------
--- 439,452 ----
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Difference;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 453,461 ****
--- 455,522 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       if Position.Node.Element = null then
+          raise Program_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element.all;
     end Element;
  
+    -------------------------
+    -- Equivalent_Elements --
+    -------------------------
+ 
+    function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Elements;
+ 
+    ---------------------
+    -- Equivalent_Sets --
+    ---------------------
+ 
+    function Equivalent_Sets (Left, Right : Set) return Boolean is
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean;
+       pragma Inline (Is_Equivalent_Node_Node);
+ 
+       function Is_Equivalent is
+          new Tree_Operations.Generic_Equal (Is_Equivalent_Node_Node);
+ 
+       -----------------------------
+       -- Is_Equivalent_Node_Node --
+       -----------------------------
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
+       begin
+          if L.Element.all < R.Element.all then
+             return False;
+          elsif R.Element.all < L.Element.all then
+             return False;
+          else
+             return True;
+          end if;
+       end Is_Equivalent_Node_Node;
+ 
+    --  Start of processing for Equivalent_Sets
+ 
+    begin
+       return Is_Equivalent (Left.Tree, Right.Tree);
+    end Equivalent_Sets;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 463,471 ****
     procedure Exclude (Container : in out Set; Item : Element_Type) is
        X : Node_Access :=
              Element_Keys.Find (Container.Tree, Item);
     begin
        if X /= null then
!          Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
--- 524,533 ----
     procedure Exclude (Container : in out Set; Item : Element_Type) is
        X : Node_Access :=
              Element_Keys.Find (Container.Tree, Item);
+ 
     begin
        if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
*************** package body Ada.Containers.Indefinite_O
*** 483,489 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Find;
  
     -----------
--- 545,551 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 496,502 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.First);
     end First;
  
     -------------------
--- 558,564 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Indefinite_O
*** 505,510 ****
--- 567,576 ----
  
     function First_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.First = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.First.Element.all;
     end First_Element;
  
*************** package body Ada.Containers.Indefinite_O
*** 521,527 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Floor;
  
     ----------
--- 587,593 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 531,541 ****
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
     begin
!       if X /= null then
!          Free_Element (X.Element);
!          Deallocate (X);
        end if;
     end Free;
  
     ------------------
--- 597,622 ----
     procedure Free (X : in out Node_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
     begin
!       if X = null then
!          return;
        end if;
+ 
+       X.Parent := X;
+       X.Left := X;
+       X.Right := X;
+ 
+       begin
+          Free_Element (X.Element);
+       exception
+          when others =>
+             X.Element := null;
+             Deallocate (X);
+             raise;
+       end;
+ 
+       Deallocate (X);
     end Free;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 569,602 ****
             Is_Less_Key_Node    => Is_Less_Key_Node,
             Is_Greater_Key_Node => Is_Greater_Key_Node);
  
-       ---------
-       -- "<" --
-       ---------
- 
-       function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left < Right.Node.Element.all;
-       end "<";
- 
-       function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right > Left.Node.Element.all;
-       end "<";
- 
-       ---------
-       -- ">" --
-       ---------
- 
-       function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left > Right.Node.Element.all;
-       end ">";
- 
-       function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right < Left.Node.Element.all;
-       end ">";
- 
        -------------
        -- Ceiling --
        -------------
--- 650,655 ----
*************** package body Ada.Containers.Indefinite_O
*** 610,699 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Ceiling;
  
-       ----------------------------
-       -- Checked_Update_Element --
-       ----------------------------
- 
-       procedure Checked_Update_Element
-         (Container : in out Set;
-          Position  : Cursor;
-          Process   : not null access
-                         procedure (Element : in out Element_Type))
-       is
-       begin
-          if Position.Container = null then
-             raise Constraint_Error;
-          end if;
- 
-          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
-             raise Program_Error;
-          end if;
- 
-          declare
-             Old_Key : Key_Type renames Key (Position.Node.Element.all);
- 
-          begin
-             Process (Position.Node.Element.all);
- 
-             if Old_Key < Position.Node.Element.all
-               or else Old_Key > Position.Node.Element.all
-             then
-                null;
-             else
-                return;
-             end if;
-          end;
- 
-          declare
-             Result  : Node_Access;
-             Success : Boolean;
- 
-             function New_Node return Node_Access;
-             pragma Inline (New_Node);
- 
-             procedure Insert_Post is
-               new Key_Keys.Generic_Insert_Post (New_Node);
- 
-             procedure Insert is
-               new Key_Keys.Generic_Conditional_Insert (Insert_Post);
- 
-             --------------
-             -- New_Node --
-             --------------
- 
-             function New_Node return Node_Access is
-             begin
-                return Position.Node;
-             end New_Node;
- 
-          --  Start of processing for Checked_Update_Element
- 
-          begin
-             Delete_Node_Sans_Free (Container.Tree, Position.Node);
- 
-             Insert
-               (Tree    => Container.Tree,
-                Key     => Key (Position.Node.Element.all),
-                Node    => Result,
-                Success => Success);
- 
-             if not Success then
-                declare
-                   X : Node_Access := Position.Node;
-                begin
-                   Free (X);
-                end;
- 
-                raise Program_Error;
-             end if;
- 
-             pragma Assert (Result = Position.Node);
-          end;
-       end Checked_Update_Element;
- 
        --------------
        -- Contains --
        --------------
--- 663,671 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Ceiling;
  
        --------------
        -- Contains --
        --------------
*************** package body Ada.Containers.Indefinite_O
*** 715,721 ****
              raise Constraint_Error;
           end if;
  
!          Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end Delete;
  
--- 687,693 ----
              raise Constraint_Error;
           end if;
  
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end Delete;
  
*************** package body Ada.Containers.Indefinite_O
*** 724,734 ****
        -------------
  
        function Element (Container : Set; Key : Key_Type) return Element_Type is
!          C : constant Cursor := Find (Container, Key);
        begin
!          return C.Node.Element.all;
        end Element;
  
        -------------
        -- Exclude --
        -------------
--- 696,727 ----
        -------------
  
        function Element (Container : Set; Key : Key_Type) return Element_Type is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.Tree, Key);
! 
        begin
!          if Node = null then
!             raise Constraint_Error;
!          end if;
! 
!          return Node.Element.all;
        end Element;
  
+       ---------------------
+       -- Equivalent_Keys --
+       ---------------------
+ 
+       function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+       begin
+          if Left < Right
+            or else Right < Left
+          then
+             return False;
+          else
+             return True;
+          end if;
+       end Equivalent_Keys;
+ 
        -------------
        -- Exclude --
        -------------
*************** package body Ada.Containers.Indefinite_O
*** 738,744 ****
  
        begin
           if X /= null then
!             Delete_Node_Sans_Free (Container.Tree, X);
              Free (X);
           end if;
        end Exclude;
--- 731,737 ----
  
        begin
           if X /= null then
!             Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
              Free (X);
           end if;
        end Exclude;
*************** package body Ada.Containers.Indefinite_O
*** 756,762 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Find;
  
        -----------
--- 749,755 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Find;
  
        -----------
*************** package body Ada.Containers.Indefinite_O
*** 772,778 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Floor;
  
        -------------------------
--- 765,771 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Floor;
  
        -------------------------
*************** package body Ada.Containers.Indefinite_O
*** 783,789 ****
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left > Right.Element.all;
        end Is_Greater_Key_Node;
  
        ----------------------
--- 776,782 ----
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Key (Right.Element.all) < Left;
        end Is_Greater_Key_Node;
  
        ----------------------
*************** package body Ada.Containers.Indefinite_O
*** 794,800 ****
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left < Right.Element.all;
        end Is_Less_Key_Node;
  
        ---------
--- 787,793 ----
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left < Key (Right.Element.all);
        end Is_Less_Key_Node;
  
        ---------
*************** package body Ada.Containers.Indefinite_O
*** 803,811 ****
--- 796,900 ----
  
        function Key (Position : Cursor) return Key_Type is
        begin
+          if Position.Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          if Position.Node.Element = null then
+             raise Program_Error;
+          end if;
+ 
+          pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                         "bad cursor in Key");
+ 
           return Key (Position.Node.Element.all);
        end Key;
  
+       -------------
+       -- Replace --
+       -------------
+ 
+       procedure Replace
+         (Container : in out Set;
+          Key       : Key_Type;
+          New_Item  : Element_Type)
+       is
+          Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
+ 
+       begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          Replace_Element (Container.Tree, Node, New_Item);
+       end Replace;
+ 
+       -----------------------------------
+       -- Update_Element_Preserving_Key --
+       -----------------------------------
+ 
+       procedure Update_Element_Preserving_Key
+         (Container : in out Set;
+          Position  : Cursor;
+          Process   : not null access
+                         procedure (Element : in out Element_Type))
+       is
+          Tree : Tree_Type renames Container.Tree;
+ 
+       begin
+          if Position.Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          if Position.Node.Element = null then
+             raise Program_Error;
+          end if;
+ 
+          if Position.Container /= Container'Unrestricted_Access then
+             raise Program_Error;
+          end if;
+ 
+          pragma Assert (Vet (Container.Tree, Position.Node),
+                         "bad cursor in Update_Element_Preserving_Key");
+ 
+          declare
+             E : Element_Type renames Position.Node.Element.all;
+             K : constant Key_Type := Key (E);
+ 
+             B : Natural renames Tree.Busy;
+             L : Natural renames Tree.Lock;
+ 
+          begin
+             B := B + 1;
+             L := L + 1;
+ 
+             begin
+                Process (E);
+             exception
+                when others =>
+                   L := L - 1;
+                   B := B - 1;
+                   raise;
+             end;
+ 
+             L := L - 1;
+             B := B - 1;
+ 
+             if Equivalent_Keys (K, Key (E)) then
+                return;
+             end if;
+          end;
+ 
+          declare
+             X : Node_Access := Position.Node;
+          begin
+             Tree_Operations.Delete_Node_Sans_Free (Tree, X);
+             Free (X);
+          end;
+ 
+          raise Program_Error;
+       end Update_Element_Preserving_Key;
+ 
     end Generic_Keys;
  
     -----------------
*************** package body Ada.Containers.Indefinite_O
*** 831,836 ****
--- 920,929 ----
        Insert (Container, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.Tree.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           X := Position.Node.Element;
           Position.Node.Element := new Element_Type'(New_Item);
           Free_Element (X);
*************** package body Ada.Containers.Indefinite_O
*** 847,859 ****
        Position  : out Cursor;
        Inserted  : out Boolean)
     is
        function New_Node return Node_Access;
        pragma Inline (New_Node);
  
        procedure Insert_Post is
          new Element_Keys.Generic_Insert_Post (New_Node);
  
!       procedure Insert_Sans_Hint is
          new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
        --------------
--- 940,983 ----
        Position  : out Cursor;
        Inserted  : out Boolean)
     is
+    begin
+       Insert_Sans_Hint
+         (Container.Tree,
+          New_Item,
+          Position.Node,
+          Inserted);
+ 
+       Position.Container := Container'Unrestricted_Access;
+    end Insert;
+ 
+    procedure Insert (Container : in out Set; New_Item  : Element_Type) is
+       Position : Cursor;
+       Inserted : Boolean;
+    begin
+       Insert (Container, New_Item, Position, Inserted);
+ 
+       if not Inserted then
+          raise Constraint_Error;
+       end if;
+    end Insert;
+ 
+    ----------------------
+    -- Insert_Sans_Hint --
+    ----------------------
+ 
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access;
+       Inserted : out Boolean)
+    is
        function New_Node return Node_Access;
        pragma Inline (New_Node);
  
        procedure Insert_Post is
          new Element_Keys.Generic_Insert_Post (New_Node);
  
!       procedure Conditional_Insert_Sans_Hint is
          new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
        --------------
*************** package body Ada.Containers.Indefinite_O
*** 862,872 ****
  
        function New_Node return Node_Access is
           Element : Element_Access := new Element_Type'(New_Item);
        begin
           return new Node_Type'(Parent  => null,
                                 Left    => null,
                                 Right   => null,
!                                Color   => Red,
                                 Element => Element);
        exception
           when others =>
--- 986,997 ----
  
        function New_Node return Node_Access is
           Element : Element_Access := new Element_Type'(New_Item);
+ 
        begin
           return new Node_Type'(Parent  => null,
                                 Left    => null,
                                 Right   => null,
!                                Color   => Red_Black_Trees.Red,
                                 Element => Element);
        exception
           when others =>
*************** package body Ada.Containers.Indefinite_O
*** 874,901 ****
              raise;
        end New_Node;
  
!    --  Start of processing for Insert
  
     begin
!       Insert_Sans_Hint
!         (Container.Tree,
           New_Item,
!          Position.Node,
           Inserted);
! 
!       Position.Container := Container'Unchecked_Access;
!    end Insert;
! 
!    procedure Insert (Container : in out Set; New_Item  : Element_Type) is
!       Position : Cursor;
!       Inserted : Boolean;
!    begin
!       Insert (Container, New_Item, Position, Inserted);
! 
!       if not Inserted then
!          raise Constraint_Error;
!       end if;
!    end Insert;
  
     ----------------------
     -- Insert_With_Hint --
--- 999,1013 ----
              raise;
        end New_Node;
  
!    --  Start of processing for Insert_Sans_Hint
  
     begin
!       Conditional_Insert_Sans_Hint
!         (Tree,
           New_Item,
!          Node,
           Inserted);
!    end Insert_Sans_Hint;
  
     ----------------------
     -- Insert_With_Hint --
*************** package body Ada.Containers.Indefinite_O
*** 961,985 ****
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Intersection (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Intersection;
  
     --------------
--- 1073,1086 ----
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Intersection (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Intersection;
  
     --------------
*************** package body Ada.Containers.Indefinite_O
*** 988,994 ****
  
     function Is_Empty (Container : Set) return Boolean is
     begin
!       return Length (Container) = 0;
     end Is_Empty;
  
     -----------------------------
--- 1089,1095 ----
  
     function Is_Empty (Container : Set) return Boolean is
     begin
!       return Container.Tree.Length = 0;
     end Is_Empty;
  
     -----------------------------
*************** package body Ada.Containers.Indefinite_O
*** 1004,1010 ****
        return Right.Element.all < Left;
     end Is_Greater_Element_Node;
  
- 
     --------------------------
     -- Is_Less_Element_Node --
     --------------------------
--- 1105,1110 ----
*************** package body Ada.Containers.Indefinite_O
*** 1031,1040 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
     begin
-       if Subset'Address = Of_Set'Address then
-          return True;
-       end if;
- 
        return Set_Ops.Is_Subset (Subset => Subset.Tree, Of_Set => Of_Set.Tree);
     end Is_Subset;
  
--- 1131,1136 ----
*************** package body Ada.Containers.Indefinite_O
*** 1058,1070 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
!    --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     ----------
--- 1154,1179 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
!       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
!       B : Natural renames T.Busy;
! 
!    --  Start of prccessing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 1077,1083 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
     end Last;
  
     ------------------
--- 1186,1192 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Indefinite_O
*** 1086,1091 ****
--- 1195,1204 ----
  
     function Last_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.Last.Element.all;
     end Last_Element;
  
*************** package body Ada.Containers.Indefinite_O
*** 1111,1122 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 1224,1234 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Indefinite_O
*** 1135,1143 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Next (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 1247,1259 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Next (Position.Node);
! 
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Indefinite_O
*** 1153,1162 ****
  
     function Overlap (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return Left.Tree.Length /= 0;
-       end if;
- 
        return Set_Ops.Overlap (Left.Tree, Right.Tree);
     end Overlap;
  
--- 1269,1274 ----
*************** package body Ada.Containers.Indefinite_O
*** 1184,1192 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Previous (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 1296,1308 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Previous (Position.Node);
! 
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Indefinite_O
*** 1205,1211 ****
        Process   : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Element.all);
     end Query_Element;
  
     ----------
--- 1321,1359 ----
        Process   : not null access procedure (Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element.all);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Indefinite_O
*** 1213,1233 ****
     ----------
  
     procedure Read
!      (Stream    : access Ada.Streams.Root_Stream_Type'Class;
        Container : out Set)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
  
        procedure Read is
!         new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
  
        begin
--- 1361,1383 ----
     ----------
  
     procedure Read
!      (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
        procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
  
        begin
*************** package body Ada.Containers.Indefinite_O
*** 1236,1252 ****
  
        exception
           when others =>
!             Free (Node);
              raise;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
!       Read (Container.Tree, N);
     end Read;
  
     -------------
--- 1386,1407 ----
  
        exception
           when others =>
!             Free (Node);  --  Note that Free deallocates elem too
              raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
!    end Read;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
     end Read;
  
     -------------
*************** package body Ada.Containers.Indefinite_O
*** 1264,1397 ****
           raise Constraint_Error;
        end if;
  
        X := Node.Element;
        Node.Element := new Element_Type'(New_Item);
        Free_Element (X);
     end Replace;
  
- --  TODO ???
- --        procedure Replace
- --          (Container : in out Set;
- --           Key       : Key_Type;
- --           New_Item  : Element_Type)
- --        is
- --           Node : Node_Access := Key_Keys.Find (Container.Tree, Key);
- 
- --        begin
- --           if Node = null then
- --              raise Constraint_Error;
- --           end if;
- 
- --           Replace_Element (Container, Node, New_Item);
- --        end Replace;
- 
     ---------------------
     -- Replace_Element --
     ---------------------
  
! --  TODO: ???
! --     procedure Replace_Element
! --       (Container : in out Set;
! --        Position  : Node_Access;
! --        By        : Element_Type)
! --   is
  
! --        Node : Node_Access := Position;
  
! --     begin
! --        if By < Node.Element.all
! --          or else Node.Element.all < By
! --        then
! --           null;
  
! --        else
! --           declare
! --              X : Element_Access := Node.Element;
  
! --           begin
! --              Node.Element := new Element_Type'(By);
  
! --              --  NOTE: If there's an exception here, then just
! --              --  let it propagate.  We haven't modified the
! --              --  state of the container, so there's nothing else
! --              --  we need to do.
  
! --              Free_Element (X);
! --           end;
  
! --           return;
! --        end if;
  
! --        Delete_Node_Sans_Free (Container.Tree, Node);
  
! --        begin
! --           Free_Element (Node.Element);
! --        exception
! --           when others =>
! --              Node.Element := null;  --  don't attempt to dealloc X.E again
! --              Free (Node);
! --              raise;
! --        end;
  
! --        begin
! --           Node.Element := new Element_Type'(By);
! --        exception
! --           when others =>
! --              Free (Node);
! --              raise;
! --        end;
  
! --        declare
! --           function New_Node return Node_Access;
! --           pragma Inline (New_Node);
  
! --           function New_Node return Node_Access is
! --           begin
! --              return Node;
! --           end New_Node;
  
! --           procedure Insert_Post is
! --             new Element_Keys.Generic_Insert_Post (New_Node);
  
! --           procedure Insert is
! --             new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
! --           Result  : Node_Access;
! --           Success : Boolean;
  
! --        begin
! --           Insert
! --             (Tree    => Container.Tree,
! --              Key     => Node.Element.all,
! --              Node    => Result,
! --              Success => Success);
  
! --           if not Success then
! --              Free (Node);
! --              raise Program_Error;
! --           end if;
  
! --           pragma Assert (Result = Node);
! --        end;
! --     end Replace_Element;
  
  
! --     procedure Replace_Element
! --      (Container : in out Set;
! --       Position  : Cursor;
! --       By        : Element_Type)
! --     is
! --     begin
! --        if Position.Container = null then
! --           raise Constraint_Error;
! --        end if;
  
! --        if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --           raise Program_Error;
! --        end if;
  
! --        Replace_Element (Container, Position.Node, By);
! --     end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
--- 1419,1581 ----
           raise Constraint_Error;
        end if;
  
+       if Container.Tree.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        X := Node.Element;
        Node.Element := new Element_Type'(New_Item);
        Free_Element (X);
     end Replace;
  
     ---------------------
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Tree : in out Tree_Type;
!       Node : Node_Access;
!       Item : Element_Type)
!    is
!    begin
!       if Item < Node.Element.all
!         or else Node.Element.all < Item
!       then
!          null;
!       else
!          if Tree.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          declare
!             X : Element_Access := Node.Element;
!          begin
!             Node.Element := new Element_Type'(Item);
!             Free_Element (X);
!          end;
  
!          return;
!       end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
  
!       Insert_New_Item : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node return Node_Access is
!          begin
!             Node.Element := new Element_Type'(Item);  -- OK if fails
!             Node.Color := Red;
!             Node.Parent := null;
!             Node.Right := null;
!             Node.Left := null;
  
!             return Node;
!          end New_Node;
  
!          Result   : Node_Access;
!          Inserted : Boolean;
  
!          X : Element_Access := Node.Element;
  
!       --  Start of processing for Insert_New_Item
  
!       begin
!          Attempt_Insert : begin
!             Insert
!               (Tree    => Tree,
!                Key     => Item,
!                Node    => Result,
!                Success => Inserted);  --  TODO: change name of formal param
!          exception
!             when others =>
!                Inserted := False;
!          end Attempt_Insert;
  
!          if Inserted then
!             pragma Assert (Result = Node);
!             Free_Element (X);  -- OK if fails
!             return;
!          end if;
!       end Insert_New_Item;
  
!       Reinsert_Old_Element : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
+          function New_Node return Node_Access is
+          begin
+             Node.Color := Red;
+             Node.Parent := null;
+             Node.Right := null;
+             Node.Left := null;
  
!             return Node;
!          end New_Node;
  
!          Result   : Node_Access;
!          Inserted : Boolean;
  
!       --  Start of processing for Reinsert_Old_Element
! 
!       begin
!          Insert
!            (Tree    => Tree,
!             Key     => Node.Element.all,
!             Node    => Result,
!             Success => Inserted);  --  TODO: change name of formal param
!       exception
!          when others =>
!             null;
!       end Reinsert_Old_Element;
! 
!       raise Program_Error;
!    end Replace_Element;
! 
!    procedure Replace_Element
!     (Container : in out Set;
!      Position  : Cursor;
!      New_Item  : Element_Type)
!    is
!    begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Node.Element = null then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
! 
!       Replace_Element (Container.Tree, Position.Node, New_Item);
!    end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
*************** package body Ada.Containers.Indefinite_O
*** 1413,1425 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     -----------
--- 1597,1622 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 1473,1525 ****
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Symmetric_Difference;
  
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Union (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Union;
  
     -----------
--- 1670,1713 ----
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
+ 
+    function To_Set (New_Item : Element_Type) return Set is
+       Tree     : Tree_Type;
+       Node     : Node_Access;
+       Inserted : Boolean;
+ 
+    begin
+       Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
+       return Set'(Controlled with Tree);
+    end To_Set;
+ 
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Union (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Union;
  
     -----------
*************** package body Ada.Containers.Indefinite_O
*** 1527,1557 ****
     -----------
  
     procedure Write
!      (Stream    : access Ada.Streams.Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is
!         new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Element_Type'Output (Stream, Node.Element.all);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
! end Ada.Containers.Indefinite_Ordered_Sets;
! 
  
--- 1715,1755 ----
     -----------
  
     procedure Write
!      (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Element_Type'Output (Stream, Node.Element.all);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Indefinite_Ordered_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ciorse.ads gcc-4.1.0/gcc/ada/a-ciorse.ads
*** gcc-4.0.2/gcc/ada/a-ciorse.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-ciorse.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                  ADA.CONTAINERS.INDEFINITE_ORDERED_SETS                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      A D A . C O N T A I N E R S .                       --
! --              I N D E F I N I T E _ O R D E R E D _ S E T S               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 44,50 ****
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Sets is
! pragma Preelaborate (Indefinite_Ordered_Sets);
  
     type Set is tagged private;
  
--- 45,53 ----
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Ordered_Sets is
!    pragma Preelaborate;
! 
!    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
  
     type Set is tagged private;
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 56,61 ****
--- 59,68 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** pragma Preelaborate (Indefinite_Ordered_
*** 64,79 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
-    --  TODO: resolve in Atlanta???
-    --   procedure Replace_Element
-    --     (Container : in out Set;
-    --      Position  : Cursor;
-    --      By        : Element_Type);
- 
     procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
--- 71,85 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
*************** pragma Preelaborate (Indefinite_Ordered_
*** 94,104 ****
       (Container : in out Set;
        New_Item  : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
--- 100,110 ----
       (Container : in out Set;
        New_Item  : Element_Type);
  
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 122,129 ****
  
     function "and" (Left, Right : Set) return Set renames Intersection;
  
!    procedure Difference (Target : in out Set;
!                          Source : Set);
  
     function Difference (Left, Right : Set) return Set;
  
--- 128,134 ----
  
     function "and" (Left, Right : Set) return Set renames Intersection;
  
!    procedure Difference (Target : in out Set; Source : Set);
  
     function Difference (Left, Right : Set) return Set;
  
*************** pragma Preelaborate (Indefinite_Ordered_
*** 139,152 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
-    function Contains (Container : Set; Item : Element_Type) return Boolean;
- 
-    function Find (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Floor (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
- 
     function First (Container : Set) return Cursor;
  
     function First_Element (Container : Set) return Element_Type;
--- 144,149 ----
*************** pragma Preelaborate (Indefinite_Ordered_
*** 157,168 ****
  
     function Next (Position : Cursor) return Cursor;
  
-    function Previous (Position : Cursor) return Cursor;
- 
     procedure Next (Position : in out Cursor);
  
     procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
--- 154,173 ----
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
+    function Previous (Position : Cursor) return Cursor;
+ 
     procedure Previous (Position : in out Cursor);
  
+    function Find (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Floor (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
*************** pragma Preelaborate (Indefinite_Ordered_
*** 186,206 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left : Key_Type; Right : Element_Type)
!           return Boolean is <>;
! 
!       with function ">" (Left : Key_Type; Right : Element_Type)
!           return Boolean is <>;
  
     package Generic_Keys is
  
!       function Contains
!         (Container : Set;
!          Key       : Key_Type) return Boolean;
  
        function Find
          (Container : Set;
--- 191,218 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left, Right : Key_Type) return Boolean is <>;
  
     package Generic_Keys is
  
!       function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
! 
!       function Key (Position : Cursor) return Key_Type;
! 
!       function Element (Container : Set; Key : Key_Type) return Element_Type;
! 
!       procedure Replace
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type);
! 
!       procedure Exclude (Container : in out Set; Key : Key_Type);
! 
!       procedure Delete (Container : in out Set; Key : Key_Type);
  
        function Find
          (Container : Set;
*************** pragma Preelaborate (Indefinite_Ordered_
*** 214,245 ****
          (Container : Set;
           Key       : Key_Type) return Cursor;
  
!       function Key (Position : Cursor) return Key_Type;
! 
!       function Element
          (Container : Set;
!          Key       : Key_Type) return Element_Type;
! 
!       --  TODO: resolve in Atlanta???
!       --      procedure Replace
!       --        (Container : in out Set;
!       --         Key       : Key_Type;
!       --         New_Item  : Element_Type);
! 
!       procedure Delete (Container : in out Set; Key : Key_Type);
! 
!       procedure Exclude (Container : in out Set; Key : Key_Type);
! 
!       function "<" (Left : Cursor; Right : Key_Type) return Boolean;
! 
!       function ">" (Left : Cursor; Right : Key_Type) return Boolean;
! 
!       function "<" (Left : Key_Type; Right : Cursor) return Boolean;
! 
!       function ">" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       --  TODO: resolve name in Atlanta???
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
--- 226,236 ----
          (Container : Set;
           Key       : Key_Type) return Cursor;
  
!       function Contains
          (Container : Set;
!          Key       : Key_Type) return Boolean;
  
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
*************** private
*** 252,272 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!      new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Set is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    type Set_Access is access constant Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
--- 243,276 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Element_Access is access Element_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Element : Element_Access;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
! 
!    type Set is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
*************** private
*** 274,282 ****
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 278,296 ----
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 291,296 ****
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Indefinite_Ordered_Sets;
--- 305,315 ----
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Indefinite_Ordered_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cohama.adb gcc-4.1.0/gcc/ada/a-cohama.adb
*** gcc-4.0.2/gcc/ada/a-cohama.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cohama.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.CONTAINERS.HASHED_MAPS                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --            A D A . C O N T A I N E R S . H A S H E D _ M A P S           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Has
*** 43,54 ****
  
  package body Ada.Containers.Hashed_Maps is
  
-    type Node_Type is limited record
-       Key     : Key_Type;
-       Element : Element_Type;
-       Next    : Node_Access;
-    end record;
- 
     -----------------------
     -- Local Subprograms --
     -----------------------
--- 43,48 ----
*************** package body Ada.Containers.Hashed_Maps 
*** 57,69 ****
       (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Equivalent_Keys
       (Key  : Key_Type;
        Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
     function Find_Equal_Key
!      (R_Map  : Map;
        L_Node : Node_Access) return Boolean;
  
     function Hash_Node (Node : Node_Access) return Hash_Type;
--- 51,65 ----
       (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Equivalent_Key_Node
       (Key  : Key_Type;
        Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Key_Node);
! 
!    procedure Free (X : in out Node_Access);
  
     function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
        L_Node : Node_Access) return Boolean;
  
     function Hash_Node (Node : Node_Access) return Hash_Type;
*************** package body Ada.Containers.Hashed_Maps 
*** 79,84 ****
--- 75,82 ----
     procedure Set_Next (Node : Node_Access; Next : Node_Access);
     pragma Inline (Set_Next);
  
+    function Vet (Position : Cursor) return Boolean;
+ 
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
        Node   : Node_Access);
*************** package body Ada.Containers.Hashed_Maps 
*** 88,101 ****
     -- Local Instantiations --
     --------------------------
  
-    procedure Free is
-      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
- 
     package HT_Ops is
        new Hash_Tables.Generic_Operations
         (HT_Types          => HT_Types,
-         Hash_Table_Type   => Map,
-         Null_Node         => null,
          Hash_Node         => Hash_Node,
          Next              => Next,
          Set_Next          => Set_Next,
--- 86,94 ----
*************** package body Ada.Containers.Hashed_Maps 
*** 105,117 ****
     package Key_Ops is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
-         HT_Type   => Map,
-         Null_Node => null,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Key_Type,
          Hash      => Hash,
!         Equivalent_Keys => Equivalent_Keys);
  
     function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
  
--- 98,108 ----
     package Key_Ops is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Key_Type,
          Hash      => Hash,
!         Equivalent_Keys => Equivalent_Key_Node);
  
     function Is_Equal is new HT_Ops.Generic_Equal (Find_Equal_Key);
  
*************** package body Ada.Containers.Hashed_Maps 
*** 122,147 ****
     -- "=" --
     ---------
  
!    function "=" (Left, Right : Map) return Boolean renames Is_Equal;
  
     ------------
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) renames HT_Ops.Adjust;
  
     --------------
     -- Capacity --
     --------------
  
!    function Capacity (Container : Map) return Count_Type
!      renames HT_Ops.Capacity;
  
     -----------
     -- Clear --
     -----------
  
!    procedure Clear (Container : in out Map) renames HT_Ops.Clear;
  
     --------------
     -- Contains --
--- 113,149 ----
     -- "=" --
     ---------
  
!    function "=" (Left, Right : Map) return Boolean is
!    begin
!       return Is_Equal (Left.HT, Right.HT);
!    end "=";
  
     ------------
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) is
!    begin
!       HT_Ops.Adjust (Container.HT);
!    end Adjust;
  
     --------------
     -- Capacity --
     --------------
  
!    function Capacity (Container : Map) return Count_Type is
!    begin
!       return HT_Ops.Capacity (Container.HT);
!    end Capacity;
  
     -----------
     -- Clear --
     -----------
  
!    procedure Clear (Container : in out Map) is
!    begin
!       HT_Ops.Clear (Container.HT);
!    end Clear;
  
     --------------
     -- Contains --
*************** package body Ada.Containers.Hashed_Maps 
*** 175,181 ****
        X : Node_Access;
  
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
  
        if X = null then
           raise Constraint_Error;
--- 177,183 ----
        X : Node_Access;
  
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
  
        if X = null then
           raise Constraint_Error;
*************** package body Ada.Containers.Hashed_Maps 
*** 186,202 ****
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Map_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
!       Free (Position.Node);
  
        Position.Container := null;
     end Delete;
  
--- 188,210 ----
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Delete");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       if Container.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
+       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
+ 
+       Free (Position.Node);
        Position.Container := null;
     end Delete;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 205,230 ****
     -------------
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
!       C : constant Cursor := Find (Container, Key);
     begin
!       return C.Node.Element;
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
        return Position.Node.Element;
     end Element;
  
!    ---------------------
!    -- Equivalent_Keys --
!    ---------------------
  
!    function Equivalent_Keys
       (Key  : Key_Type;
        Node : Node_Access) return Boolean is
     begin
        return Equivalent_Keys (Key, Node.Key);
!    end Equivalent_Keys;
  
     ---------------------
     -- Equivalent_Keys --
--- 213,249 ----
     -------------
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
! 
     begin
!       if Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       return Node.Element;
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Element");
+ 
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Position.Node.Element;
     end Element;
  
!    -------------------------
!    -- Equivalent_Key_Node --
!    -------------------------
  
!    function Equivalent_Key_Node
       (Key  : Key_Type;
        Node : Node_Access) return Boolean is
     begin
        return Equivalent_Keys (Key, Node.Key);
!    end Equivalent_Key_Node;
  
     ---------------------
     -- Equivalent_Keys --
*************** package body Ada.Containers.Hashed_Maps 
*** 233,248 ****
--- 252,288 ----
     function Equivalent_Keys (Left, Right : Cursor)
       return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+ 
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left.Node.Key, Right.Node.Key);
     end Equivalent_Keys;
  
     function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+ 
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left.Node.Key, Right);
     end Equivalent_Keys;
  
     function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean is
     begin
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+ 
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Equivalent_Keys (Left, Right.Node.Key);
     end Equivalent_Keys;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 253,259 ****
     procedure Exclude (Container : in out Map; Key : Key_Type) is
        X : Node_Access;
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
        Free (X);
     end Exclude;
  
--- 293,299 ----
     procedure Exclude (Container : in out Map; Key : Key_Type) is
        X : Node_Access;
     begin
!       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
        Free (X);
     end Exclude;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 261,274 ****
     -- Finalize --
     --------------
  
!    procedure Finalize (Container : in out Map) renames HT_Ops.Finalize;
  
     ----------
     -- Find --
     ----------
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
!       Node : constant Node_Access := Key_Ops.Find (Container, Key);
  
     begin
        if Node = null then
--- 301,317 ----
     -- Finalize --
     --------------
  
!    procedure Finalize (Container : in out Map) is
!    begin
!       HT_Ops.Finalize (Container.HT);
!    end Finalize;
  
     ----------
     -- Find --
     ----------
  
     function Find (Container : Map; Key : Key_Type) return Cursor is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
  
     begin
        if Node = null then
*************** package body Ada.Containers.Hashed_Maps 
*** 283,293 ****
     --------------------
  
     function Find_Equal_Key
!      (R_Map  : Map;
        L_Node : Node_Access) return Boolean
     is
!       R_Index : constant Hash_Type := Key_Ops.Index (R_Map, L_Node.Key);
!       R_Node  : Node_Access := R_Map.Buckets (R_Index);
  
     begin
        while R_Node /= null loop
--- 326,336 ----
     --------------------
  
     function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
        L_Node : Node_Access) return Boolean
     is
!       R_Index : constant Hash_Type := Key_Ops.Index (R_HT, L_Node.Key);
!       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
     begin
        while R_Node /= null loop
*************** package body Ada.Containers.Hashed_Maps 
*** 306,312 ****
     -----------
  
     function First (Container : Map) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container);
  
     begin
        if Node = null then
--- 349,355 ----
     -----------
  
     function First (Container : Map) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container.HT);
  
     begin
        if Node = null then
*************** package body Ada.Containers.Hashed_Maps 
*** 316,328 ****
        return Cursor'(Container'Unchecked_Access, Node);
     end First;
  
     -----------------
     -- Has_Element --
     -----------------
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       return Position /= No_Element;
     end Has_Element;
  
     ---------------
--- 359,386 ----
        return Cursor'(Container'Unchecked_Access, Node);
     end First;
  
+    ----------
+    -- Free --
+    ----------
+ 
+    procedure Free (X : in out Node_Access) is
+       procedure Deallocate is
+          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+    begin
+       if X /= null then
+          X.Next := X;     --  detect mischief (in Vet)
+          Deallocate (X);
+       end if;
+    end Free;
+ 
     -----------------
     -- Has_Element --
     -----------------
  
     function Has_Element (Position : Cursor) return Boolean is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
     end Has_Element;
  
     ---------------
*************** package body Ada.Containers.Hashed_Maps 
*** 350,355 ****
--- 408,417 ----
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.HT.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           Position.Node.Key := Key;
           Position.Node.Element := New_Item;
        end if;
*************** package body Ada.Containers.Hashed_Maps 
*** 390,400 ****
              raise;
        end New_Node;
  
     --  Start of processing for Insert
  
     begin
!       HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
!       Local_Insert (Container, Key, Position.Node, Inserted);
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
--- 452,474 ----
              raise;
        end New_Node;
  
+       HT : Hash_Table_Type renames Container.HT;
+ 
     --  Start of processing for Insert
  
     begin
!       if HT_Ops.Capacity (HT) = 0 then
!          HT_Ops.Reserve_Capacity (HT, 1);
!       end if;
! 
!       Local_Insert (HT, Key, Position.Node, Inserted);
! 
!       if Inserted
!         and then HT.Length > HT_Ops.Capacity (HT)
!       then
!          HT_Ops.Reserve_Capacity (HT, HT.Length);
!       end if;
! 
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 421,431 ****
           return Node;
        end New_Node;
  
     --  Start of processing for Insert
  
     begin
!       HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
!       Local_Insert (Container, Key, Position.Node, Inserted);
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
--- 495,517 ----
           return Node;
        end New_Node;
  
+       HT : Hash_Table_Type renames Container.HT;
+ 
     --  Start of processing for Insert
  
     begin
!       if HT_Ops.Capacity (HT) = 0 then
!          HT_Ops.Reserve_Capacity (HT, 1);
!       end if;
! 
!       Local_Insert (HT, Key, Position.Node, Inserted);
! 
!       if Inserted
!         and then HT.Length > HT_Ops.Capacity (HT)
!       then
!          HT_Ops.Reserve_Capacity (HT, HT.Length);
!       end if;
! 
        Position.Container := Container'Unchecked_Access;
     end Insert;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 451,457 ****
  
     function Is_Empty (Container : Map) return Boolean is
     begin
!       return Container.Length = 0;
     end Is_Empty;
  
     -------------
--- 537,543 ----
  
     function Is_Empty (Container : Map) return Boolean is
     begin
!       return Container.HT.Length = 0;
     end Is_Empty;
  
     -------------
*************** package body Ada.Containers.Hashed_Maps 
*** 479,485 ****
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container);
     end Iterate;
  
     ---------
--- 565,571 ----
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.HT);
     end Iterate;
  
     ---------
*************** package body Ada.Containers.Hashed_Maps 
*** 488,493 ****
--- 574,585 ----
  
     function Key (Position : Cursor) return Key_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Key");
+ 
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Position.Node.Key;
     end Key;
  
*************** package body Ada.Containers.Hashed_Maps 
*** 497,503 ****
  
     function Length (Container : Map) return Count_Type is
     begin
!       return Container.Length;
     end Length;
  
     ----------
--- 589,595 ----
  
     function Length (Container : Map) return Count_Type is
     begin
!       return Container.HT.Length;
     end Length;
  
     ----------
*************** package body Ada.Containers.Hashed_Maps 
*** 506,512 ****
  
     procedure Move
       (Target : in out Map;
!       Source : in out Map) renames HT_Ops.Move;
  
     ----------
     -- Next --
--- 598,608 ----
  
     procedure Move
       (Target : in out Map;
!       Source : in out Map)
!    is
!    begin
!       HT_Ops.Move (Target => Target.HT, Source => Source.HT);
!    end Move;
  
     ----------
     -- Next --
*************** package body Ada.Containers.Hashed_Maps 
*** 519,531 ****
  
     function Next (Position : Cursor) return Cursor is
     begin
!       if Position = No_Element then
           return No_Element;
        end if;
  
        declare
!          M    : Map renames Position.Container.all;
!          Node : constant Node_Access := HT_Ops.Next (M, Position.Node);
  
        begin
           if Node = null then
--- 615,629 ----
  
     function Next (Position : Cursor) return Cursor is
     begin
!       pragma Assert (Vet (Position), "bad cursor in function Next");
! 
!       if Position.Node = null then
           return No_Element;
        end if;
  
        declare
!          HT   : Hash_Table_Type renames Position.Container.HT;
!          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
  
        begin
           if Node = null then
*************** package body Ada.Containers.Hashed_Maps 
*** 547,556 ****
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Key, Position.Node.Element);
     end Query_Element;
  
     ----------
--- 645,687 ----
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access
!                    procedure (Key : Key_Type; Element : Element_Type))
     is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       declare
!          M  : Map renames Position.Container.all;
!          HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
! 
!          B : Natural renames HT.Busy;
!          L : Natural renames HT.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key;
!             E : Element_Type renames Position.Node.Element;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Hashed_Maps 
*** 559,565 ****
  
     procedure Read
       (Stream    : access Root_Stream_Type'Class;
!       Container : out Map) renames Read_Nodes;
  
     ---------------
     -- Read_Node --
--- 690,708 ----
  
     procedure Read
       (Stream    : access Root_Stream_Type'Class;
!       Container : out Map)
!    is
!    begin
!       Read_Nodes (Stream, Container.HT);
!    end Read;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
  
     ---------------
     -- Read_Node --
*************** package body Ada.Containers.Hashed_Maps 
*** 590,602 ****
        Key       : Key_Type;
        New_Item  : Element_Type)
     is
!       Node : constant Node_Access := Key_Ops.Find (Container, Key);
  
     begin
        if Node = null then
           raise Constraint_Error;
        end if;
  
        Node.Key := Key;
        Node.Element := New_Item;
     end Replace;
--- 733,749 ----
        Key       : Key_Type;
        New_Item  : Element_Type)
     is
!       Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
  
     begin
        if Node = null then
           raise Constraint_Error;
        end if;
  
+       if Container.HT.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        Node.Key := Key;
        Node.Element := New_Item;
     end Replace;
*************** package body Ada.Containers.Hashed_Maps 
*** 605,613 ****
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element (Position : Cursor; By : Element_Type) is
     begin
!       Position.Node.Element := By;
     end Replace_Element;
  
     ----------------------
--- 752,778 ----
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       if Position.Container.HT.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       Position.Node.Element := New_Item;
     end Replace_Element;
  
     ----------------------
*************** package body Ada.Containers.Hashed_Maps 
*** 616,622 ****
  
     procedure Reserve_Capacity
       (Container : in out Map;
!       Capacity  : Count_Type) renames HT_Ops.Ensure_Capacity;
  
     --------------
     -- Set_Next --
--- 781,791 ----
  
     procedure Reserve_Capacity
       (Container : in out Map;
!       Capacity  : Count_Type)
!    is
!    begin
!       HT_Ops.Reserve_Capacity (Container.HT, Capacity);
!    end Reserve_Capacity;
  
     --------------
     -- Set_Next --
*************** package body Ada.Containers.Hashed_Maps 
*** 632,651 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
     begin
!       Process (Position.Node.Key, Position.Node.Element);
     end Update_Element;
  
     -----------
     -- Write --
     -----------
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
!       Container : Map) renames Write_Nodes;
  
     ----------------
     -- Write_Node --
--- 801,922 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
!                                              Element : in out Element_Type))
     is
     begin
!       pragma Assert (Vet (Position), "bad cursor in Update_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       declare
!          HT : Hash_Table_Type renames Container.HT;
!          B  : Natural renames HT.Busy;
!          L  : Natural renames HT.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key;
!             E : Element_Type renames Position.Node.Element;
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
+    ---------
+    -- Vet --
+    ---------
+ 
+    function Vet (Position : Cursor) return Boolean is
+    begin
+       if Position.Node = null then
+          return Position.Container = null;
+       end if;
+ 
+       if Position.Container = null then
+          return False;
+       end if;
+ 
+       if Position.Node.Next = Position.Node then
+          return False;
+       end if;
+ 
+       declare
+          HT : Hash_Table_Type renames Position.Container.HT;
+          X  : Node_Access;
+ 
+       begin
+          if HT.Length = 0 then
+             return False;
+          end if;
+ 
+          if HT.Buckets = null
+            or else HT.Buckets'Length = 0
+          then
+             return False;
+          end if;
+ 
+          X := HT.Buckets (Key_Ops.Index (HT, Position.Node.Key));
+ 
+          for J in 1 .. HT.Length loop
+             if X = Position.Node then
+                return True;
+             end if;
+ 
+             if X = null then
+                return False;
+             end if;
+ 
+             if X = X.Next then  --  to prevent endless loop
+                return False;
+             end if;
+ 
+             X := X.Next;
+          end loop;
+ 
+          return False;
+       end;
+    end Vet;
+ 
     -----------
     -- Write --
     -----------
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
!       Container : Map)
!    is
!    begin
!       Write_Nodes (Stream, Container.HT);
!    end Write;
! 
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
     ----------------
     -- Write_Node --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cohama.ads gcc-4.1.0/gcc/ada/a-cohama.ads
*** gcc-4.0.2/gcc/ada/a-cohama.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cohama.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.CONTAINERS.HASHED_MAPS                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --            A D A . C O N T A I N E R S . H A S H E D _ M A P S           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,54 ****
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
  
  generic
     type Key_Type is private;
- 
     type Element_Type is private;
  
     with function Hash (Key : Key_Type) return Hash_Type;
- 
     with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
- 
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Hashed_Maps is
! pragma Preelaborate (Hashed_Maps);
  
     type Map is tagged private;
  
--- 35,52 ----
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
+ with Ada.Finalization;
  
  generic
     type Key_Type is private;
     type Element_Type is private;
  
     with function Hash (Key : Key_Type) return Hash_Type;
     with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Hashed_Maps is
!    pragma Preelaborate;
  
     type Map is tagged private;
  
*************** pragma Preelaborate (Hashed_Maps);
*** 60,73 ****
  
     function "=" (Left, Right : Map) return Boolean;
  
     function Length (Container : Map) return Count_Type;
  
     function Is_Empty (Container : Map) return Boolean;
  
     procedure Clear (Container : in out Map);
  
!    function Element (Position : Cursor)
!       return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
--- 58,82 ----
  
     function "=" (Left, Right : Map) return Boolean;
  
+    function Capacity (Container : Map) return Count_Type;
+ 
+    procedure Reserve_Capacity (Container : in out Map;
+                                Capacity  : Count_Type);
+ 
     function Length (Container : Map) return Count_Type;
  
     function Is_Empty (Container : Map) return Boolean;
  
     procedure Clear (Container : in out Map);
  
!    function Key (Position : Cursor) return Key_Type;
! 
!    function Element (Position : Cursor) return Element_Type;
! 
!    procedure Replace_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       New_Item  : Element_Type);
  
     procedure Query_Element
       (Position : Cursor;
*************** pragma Preelaborate (Hashed_Maps);
*** 75,86 ****
                     procedure (Key : Key_Type; Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access
                     procedure (Key : Key_Type; Element : in out Element_Type));
  
-    procedure Replace_Element (Position : Cursor; By : Element_Type);
- 
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
--- 84,94 ----
                     procedure (Key : Key_Type; Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access
                     procedure (Key : Key_Type; Element : in out Element_Type));
  
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
*************** pragma Preelaborate (Hashed_Maps);
*** 93,98 ****
--- 101,112 ----
     procedure Insert
       (Container : in out Map;
        Key       : Key_Type;
+       Position  : out Cursor;
+       Inserted  : out Boolean);
+ 
+    procedure Insert
+      (Container : in out Map;
+       Key       : Key_Type;
        New_Item  : Element_Type);
  
     procedure Include
*************** pragma Preelaborate (Hashed_Maps);
*** 105,142 ****
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Insert
!      (Container : in out Map;
!       Key       : Key_Type;
!       Position  : out Cursor;
!       Inserted  : out Boolean);
  
     procedure Delete (Container : in out Map; Key : Key_Type);
  
-    procedure Exclude (Container : in out Map; Key : Key_Type);
- 
     procedure Delete (Container : in out Map; Position : in out Cursor);
  
-    function Contains (Container : Map; Key : Key_Type) return Boolean;
- 
-    function Find (Container : Map; Key : Key_Type) return Cursor;
- 
-    function Element (Container : Map; Key : Key_Type) return Element_Type;
- 
-    function Capacity (Container : Map) return Count_Type;
- 
-    procedure Reserve_Capacity (Container : in out Map;
-                                Capacity  : Count_Type);
- 
     function First (Container : Map) return Cursor;
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
!    function Has_Element (Position : Cursor) return Boolean;
  
!    function Key (Position : Cursor) return Key_Type;
  
     function Equivalent_Keys (Left, Right : Cursor) return Boolean;
  
--- 119,143 ----
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Exclude (Container : in out Map; Key : Key_Type);
  
     procedure Delete (Container : in out Map; Key : Key_Type);
  
     procedure Delete (Container : in out Map; Position : in out Cursor);
  
     function First (Container : Map) return Cursor;
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
!    function Find (Container : Map; Key : Key_Type) return Cursor;
  
!    function Contains (Container : Map; Key : Key_Type) return Boolean;
! 
!    function Element (Container : Map; Key : Key_Type) return Element_Type;
! 
!    function Has_Element (Position : Cursor) return Boolean;
  
     function Equivalent_Keys (Left, Right : Cursor) return Boolean;
  
*************** pragma Preelaborate (Hashed_Maps);
*** 149,163 ****
        Process   : not null access procedure (Position : Cursor));
  
  private
  
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package HT_Types is new Hash_Tables.Generic_Hash_Table_Types (Node_Access);
  
!    use HT_Types;
  
!    type Map is new Hash_Table_Type with null record;
  
     procedure Adjust (Container : in out Map);
  
--- 150,187 ----
        Process   : not null access procedure (Position : Cursor));
  
  private
+    pragma Inline ("=");
+    pragma Inline (Length);
+    pragma Inline (Is_Empty);
+    pragma Inline (Clear);
+    pragma Inline (Key);
+    pragma Inline (Element);
+    pragma Inline (Move);
+    pragma Inline (Contains);
+    pragma Inline (Capacity);
+    pragma Inline (Reserve_Capacity);
+    pragma Inline (Has_Element);
+    pragma Inline (Equivalent_Keys);
  
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Node_Type is limited record
!       Key     : Key_Type;
!       Element : Element_Type;
!       Next    : Node_Access;
!    end record;
  
!    package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
!      (Node_Type,
!       Node_Access);
  
!    type Map is new Ada.Finalization.Controlled with record
!       HT : HT_Types.Hash_Table_Type;
!    end record;
! 
!    use HT_Types;
!    use Ada.Finalization;
  
     procedure Adjust (Container : in out Map);
  
*************** private
*** 177,183 ****
  
     for Map'Read use Read;
  
!    Empty_Map : constant Map := (Hash_Table_Type with null record);
  
     type Map_Access is access constant Map;
     for Map_Access'Storage_Size use 0;
--- 201,207 ----
  
     for Map'Read use Read;
  
!    Empty_Map : constant Map := (Controlled with HT => (null, 0, 0, 0));
  
     type Map_Access is access constant Map;
     for Map_Access'Storage_Size use 0;
*************** private
*** 188,193 ****
--- 212,229 ----
           Node      : Node_Access;
        end record;
  
+    procedure Write
+      (Stream : access Root_Stream_Type'Class;
+       Item   : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
+    procedure Read
+      (Stream : access Root_Stream_Type'Class;
+       Item   : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
     No_Element : constant Cursor := (Container => null, Node => null);
  
  end Ada.Containers.Hashed_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cohase.adb gcc-4.1.0/gcc/ada/a-cohase.adb
*** gcc-4.0.2/gcc/ada/a-cohase.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cohase.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.CONTAINERS.HASHED_SETS                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . H A S H E D _ S E T S            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Has
*** 41,590 ****
  with Ada.Containers.Hash_Tables.Generic_Keys;
  pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
  
- with System;  use type System.Address;
- 
  with Ada.Containers.Prime_Numbers;
  
! with Ada.Finalization;  use Ada.Finalization;
  
  package body Ada.Containers.Hashed_Sets is
  
!    type Node_Type is
!       limited record
!          Element : Element_Type;
!          Next    : Node_Access;
!       end record;
  
!    function Hash_Node
!      (Node : Node_Access) return Hash_Type;
!    pragma Inline (Hash_Node);
  
!    function Hash_Node
!      (Node : Node_Access) return Hash_Type is
!    begin
!       return Hash (Node.Element);
!    end Hash_Node;
  
!    function Next
!      (Node : Node_Access) return Node_Access;
!    pragma Inline (Next);
  
!    function Next
!      (Node : Node_Access) return Node_Access is
!    begin
!       return Node.Next;
!    end Next;
  
!    procedure Set_Next
!      (Node : Node_Access;
!       Next : Node_Access);
!    pragma Inline (Set_Next);
  
!    procedure Set_Next
!      (Node : Node_Access;
!       Next : Node_Access) is
!    begin
!       Node.Next := Next;
!    end Set_Next;
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean is
!    begin
!       return Equivalent_Keys (Key, Node.Element);
!    end Equivalent_Keys;
  
!    function Copy_Node
!      (Source : Node_Access) return Node_Access;
!    pragma Inline (Copy_Node);
  
!    function Copy_Node
!      (Source : Node_Access) return Node_Access is
  
!       Target : constant Node_Access :=
!         new Node_Type'(Element => Source.Element,
!                        Next    => null);
!    begin
!       return Target;
!    end Copy_Node;
  
  
!    procedure Free is
!       new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     package HT_Ops is
        new Hash_Tables.Generic_Operations
!        (HT_Types          => HT_Types,
!         Hash_Table_Type   => Set,
!         Null_Node         => null,
!         Hash_Node         => Hash_Node,
!         Next              => Next,
!         Set_Next          => Set_Next,
!         Copy_Node         => Copy_Node,
!         Free              => Free);
  
     package Element_Keys is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
-         HT_Type   => Set,
-         Null_Node => null,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Element_Type,
          Hash      => Hash,
          Equivalent_Keys => Equivalent_Keys);
  
  
!    procedure Adjust (Container : in out Set) renames HT_Ops.Adjust;
! 
!    procedure Finalize (Container : in out Set) renames HT_Ops.Finalize;
! 
! 
!    function Find_Equal_Key
!      (R_Set  : Set;
!       L_Node : Node_Access) return Boolean;
  
!    function Find_Equal_Key
!      (R_Set  : Set;
!       L_Node : Node_Access) return Boolean is
  
!       R_Index : constant Hash_Type :=
!         Element_Keys.Index (R_Set, L_Node.Element);
  
!       R_Node  : Node_Access := R_Set.Buckets (R_Index);
  
     begin
  
!       loop
! 
!          if R_Node = null then
!             return False;
!          end if;
! 
!          if L_Node.Element = R_Node.Element then
!             --  pragma Assert (Is_Equal_Key (L_Node.Element, R_Node.Element));
!             return True;
!          end if;
! 
!          R_Node := Next (R_Node);
! 
!       end loop;
! 
!    end Find_Equal_Key;
! 
!    function Is_Equal is
!       new HT_Ops.Generic_Equal (Find_Equal_Key);
! 
!    function "=" (Left, Right : Set) return Boolean renames Is_Equal;
! 
  
!    function Length (Container : Set) return Count_Type is
     begin
!       return Container.Length;
!    end Length;
  
  
!    function Is_Empty (Container : Set) return Boolean is
     begin
!       return Container.Length = 0;
!    end Is_Empty;
  
  
!    procedure Clear (Container : in out Set) renames HT_Ops.Clear;
  
  
!    function Element (Position : Cursor) return Element_Type is
     begin
!       return Position.Node.Element;
!    end Element;
  
  
!    procedure Query_Element
!      (Position : in Cursor;
!       Process  : not null access procedure (Element : in Element_Type)) is
     begin
!       Process (Position.Node.Element);
!    end Query_Element;
  
  
! --  TODO:
! --     procedure Replace_Element (Container : in out Set;
! --                                Position  : in     Node_Access;
! --                                By        : in     Element_Type) is
  
! --        Node : Node_Access := Position;
  
! --     begin
  
! --        if Equivalent_Keys (Node.Element, By) then
  
! --           begin
! --              Node.Element := By;
! --           exception
! --              when others =>
! --                 HT_Ops.Delete_Node_Sans_Free (Container, Node);
! --                 Free (Node);
! --                 raise;
! --           end;
  
! --           return;
  
! --        end if;
  
! --        HT_Ops.Delete_Node_Sans_Free (Container, Node);
  
! --        begin
! --           Node.Element := By;
! --        exception
! --           when others =>
! --              Free (Node);
! --              raise;
! --        end;
  
! --        declare
! --           function New_Node (Next : Node_Access) return Node_Access;
! --           pragma Inline (New_Node);
  
! --           function New_Node (Next : Node_Access) return Node_Access is
! --           begin
! --              Node.Next := Next;
! --              return Node;
! --           end New_Node;
  
! --           procedure Insert is
! --              new Element_Keys.Generic_Conditional_Insert (New_Node);
  
! --           Result  : Node_Access;
! --           Success : Boolean;
! --        begin
! --           Insert
! --             (HT      => Container,
! --              Key     => Node.Element,
! --              Node    => Result,
! --              Success => Success);
  
! --           if not Success then
! --              Free (Node);
! --              raise Program_Error;
! --           end if;
  
! --           pragma Assert (Result = Node);
! --        end;
  
! --     end Replace_Element;
  
  
! --     procedure Replace_Element (Container : in out Set;
! --                                Position  : in     Cursor;
! --                                By        : in     Element_Type) is
! --     begin
  
! --        if Position.Container = null then
! --           raise Constraint_Error;
! --        end if;
  
! --        if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --           raise Program_Error;
! --        end if;
  
! --        Replace_Element (Container, Position.Node, By);
  
! --     end Replace_Element;
  
  
!    procedure Move (Target : in out Set;
!                    Source : in out Set) renames HT_Ops.Move;
  
  
!    procedure Insert (Container : in out Set;
!                      New_Item  : in     Element_Type;
!                      Position  :    out Cursor;
!                      Inserted  :    out Boolean) is
  
!       function New_Node (Next : Node_Access) return Node_Access;
!       pragma Inline (New_Node);
  
!       function New_Node (Next : Node_Access) return Node_Access is
!          Node : constant Node_Access := new Node_Type'(New_Item, Next);
!       begin
!          return Node;
!       end New_Node;
  
!       procedure Insert is
!         new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!    begin
  
!       HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
!       Insert (Container, New_Item, Position.Node, Inserted);
!       Position.Container := Container'Unchecked_Access;
  
!    end Insert;
  
  
!    procedure Insert (Container : in out Set;
!                      New_Item  : in     Element_Type) is
  
!       Position : Cursor;
!       Inserted : Boolean;
  
     begin
  
!       Insert (Container, New_Item, Position, Inserted);
! 
!       if not Inserted then
           raise Constraint_Error;
        end if;
  
!    end Insert;
  
  
!    procedure Replace (Container : in out Set;
!                       New_Item  : in     Element_Type) is
  
!       X : Node_Access := Element_Keys.Find (Container, New_Item);
  
     begin
  
!       if X = null then
           raise Constraint_Error;
        end if;
  
!       X.Element := New_Item;
! 
!    end Replace;
! 
! 
!    procedure Include (Container : in out Set;
!                       New_Item  : in     Element_Type) is
! 
!       Position : Cursor;
!       Inserted : Boolean;
  
     begin
  
!       Insert (Container, New_Item, Position, Inserted);
! 
!       if not Inserted then
!          Position.Node.Element := New_Item;
        end if;
  
!    end Include;
! 
! 
!    procedure Delete (Container : in out Set;
!                      Item      : in     Element_Type) is
! 
!       X : Node_Access;
  
     begin
  
!       Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
! 
!       if X = null then
           raise Constraint_Error;
        end if;
  
!       Free (X);
  
!    end Delete;
  
  
!    procedure Exclude (Container : in out Set;
!                       Item      : in     Element_Type) is
  
        X : Node_Access;
- 
     begin
! 
!       Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
        Free (X);
- 
     end Exclude;
  
  
!    procedure Delete (Container : in out Set;
!                      Position  : in out Cursor) is
     begin
  
!       if Position = No_Element then
!          return;
!       end if;
  
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
!          raise Program_Error;
!       end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
!       Free (Position.Node);
  
!       Position.Container := null;
  
!    end Delete;
  
  
  
!    procedure Union (Target : in out Set;
!                     Source : in     Set) is
  
!       procedure Process (Src_Node : in Node_Access);
  
!       procedure Process (Src_Node : in Node_Access) is
  
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
  
!          function New_Node (Next : Node_Access) return Node_Access is
!             Node : constant Node_Access :=
!               new Node_Type'(Src_Node.Element, Next);
!          begin
!             return Node;
!          end New_Node;
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!          Tgt_Node : Node_Access;
!          Success  : Boolean;
  
!       begin
  
!          Insert (Target, Src_Node.Element, Tgt_Node, Success);
  
!       end Process;
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process);
  
     begin
! 
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
! 
!       Iterate (Source);
! 
!    end Union;
! 
! 
  
!    function Union (Left, Right : Set) return Set is
  
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
     begin
! 
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       if Right.Length = 0 then
!          return Left;
        end if;
  
!       if Left.Length = 0 then
!          return Right;
!       end if;
  
!       declare
!          Size : constant Hash_Type :=
!            Prime_Numbers.To_Prime (Left.Length + Right.Length);
!       begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
!       end;
  
!       declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Process (L_Node : Node_Access) is
!             I : constant Hash_Type :=
!               Hash (L_Node.Element) mod Buckets'Length;
!          begin
!             Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
!          end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
!       begin
!          Iterate (Left);
!       exception
!          when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end;
  
!       Length := Left.Length;
  
!       declare
!          procedure Process (Src_Node : Node_Access);
  
!          procedure Process (Src_Node : Node_Access) is
  
!             I : constant Hash_Type :=
!               Hash (Src_Node.Element) mod Buckets'Length;
  
!             Tgt_Node : Node_Access := Buckets (I);
  
!          begin
  
!             while Tgt_Node /= null loop
  
!                if Equivalent_Keys (Src_Node.Element, Tgt_Node.Element) then
!                   return;
!                end if;
  
!                Tgt_Node := Next (Tgt_Node);
  
!             end loop;
  
!             Buckets (I) := new Node_Type'(Src_Node.Element, Buckets (I));
!             Length := Length + 1;
  
!          end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Right);
!       exception
!          when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
! 
!    end Union;
! 
  
!    function Is_In
!      (HT  : Set;
!       Key : Node_Access) return Boolean;
!    pragma Inline (Is_In);
  
-    function Is_In
-      (HT  : Set;
-       Key : Node_Access) return Boolean is
     begin
!       return Element_Keys.Find (HT, Key.Element) /= null;
!    end Is_In;
  
  
!    procedure Intersection (Target : in out Set;
!                            Source : in     Set) is
  
        Tgt_Node : Node_Access;
  
     begin
- 
        if Target'Address = Source'Address then
           return;
        end if;
--- 41,674 ----
  with Ada.Containers.Hash_Tables.Generic_Keys;
  pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
  
  with Ada.Containers.Prime_Numbers;
  
! with System; use type System.Address;
  
  package body Ada.Containers.Hashed_Sets is
  
!    -----------------------
!    -- Local Subprograms --
!    -----------------------
  
!    function Copy_Node (Source : Node_Access) return Node_Access;
!    pragma Inline (Copy_Node);
  
!    function Equivalent_Keys
!      (Key  : Element_Type;
!       Node : Node_Access) return Boolean;
!    pragma Inline (Equivalent_Keys);
  
!    function Find_Equal_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean;
  
!    function Find_Equivalent_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean;
  
!    procedure Free (X : in out Node_Access);
  
!    function Hash_Node (Node : Node_Access) return Hash_Type;
!    pragma Inline (Hash_Node);
  
!    procedure Insert
!      (HT       : in out Hash_Table_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean);
  
!    function Is_In
!      (HT  : Hash_Table_Type;
!       Key : Node_Access) return Boolean;
!    pragma Inline (Is_In);
  
!    function Next (Node : Node_Access) return Node_Access;
!    pragma Inline (Next);
  
!    function Read_Node (Stream : access Root_Stream_Type'Class)
!      return Node_Access;
!    pragma Inline (Read_Node);
  
!    procedure Replace_Element
!      (HT       : in out Hash_Table_Type;
!       Node     : Node_Access;
!       New_Item : Element_Type);
  
+    procedure Set_Next (Node : Node_Access; Next : Node_Access);
+    pragma Inline (Set_Next);
  
!    function Vet (Position : Cursor) return Boolean;
! 
!    procedure Write_Node
!      (Stream : access Root_Stream_Type'Class;
!       Node   : Node_Access);
!    pragma Inline (Write_Node);
! 
!    --------------------------
!    -- Local Instantiations --
!    --------------------------
  
     package HT_Ops is
        new Hash_Tables.Generic_Operations
!        (HT_Types  => HT_Types,
!         Hash_Node => Hash_Node,
!         Next      => Next,
!         Set_Next  => Set_Next,
!         Copy_Node => Copy_Node,
!         Free      => Free);
  
     package Element_Keys is
        new Hash_Tables.Generic_Keys
         (HT_Types  => HT_Types,
          Next      => Next,
          Set_Next  => Set_Next,
          Key_Type  => Element_Type,
          Hash      => Hash,
          Equivalent_Keys => Equivalent_Keys);
  
+    function Is_Equal is
+       new HT_Ops.Generic_Equal (Find_Equal_Key);
  
!    function Is_Equivalent is
!       new HT_Ops.Generic_Equal (Find_Equivalent_Key);
  
!    procedure Read_Nodes is
!       new HT_Ops.Generic_Read (Read_Node);
  
!    procedure Write_Nodes is
!       new HT_Ops.Generic_Write (Write_Node);
  
!    ---------
!    -- "=" --
!    ---------
  
+    function "=" (Left, Right : Set) return Boolean is
     begin
+       return Is_Equal (Left.HT, Right.HT);
+    end "=";
  
!    ------------
!    -- Adjust --
!    ------------
  
!    procedure Adjust (Container : in out Set) is
     begin
!       HT_Ops.Adjust (Container.HT);
!    end Adjust;
  
+    --------------
+    -- Capacity --
+    --------------
  
!    function Capacity (Container : Set) return Count_Type is
     begin
!       return HT_Ops.Capacity (Container.HT);
!    end Capacity;
  
+    -----------
+    -- Clear --
+    -----------
  
!    procedure Clear (Container : in out Set) is
!    begin
!       HT_Ops.Clear (Container.HT);
!    end Clear;
  
+    --------------
+    -- Contains --
+    --------------
  
!    function Contains (Container : Set; Item : Element_Type) return Boolean is
     begin
!       return Find (Container, Item) /= No_Element;
!    end Contains;
  
+    ---------------
+    -- Copy_Node --
+    ---------------
  
!    function Copy_Node (Source : Node_Access) return Node_Access is
     begin
!       return new Node_Type'(Element => Source.Element, Next => null);
!    end Copy_Node;
  
+    ------------
+    -- Delete --
+    ------------
  
!    procedure Delete
!      (Container : in out Set;
!       Item      : Element_Type)
!    is
!       X : Node_Access;
  
!    begin
!       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
  
!       if X = null then
!          raise Constraint_Error;
!       end if;
  
!       Free (X);
!    end Delete;
  
!    procedure Delete
!      (Container : in out Set;
!       Position  : in out Cursor)
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Delete");
  
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
  
!       if Container.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
  
!       Free (Position.Node);
!       Position.Container := null;
!    end Delete;
  
!    ----------------
!    -- Difference --
!    ----------------
  
!    procedure Difference
!      (Target : in out Set;
!       Source : Set)
!    is
!       Tgt_Node : Node_Access;
  
!    begin
!       if Target'Address = Source'Address then
!          Clear (Target);
!          return;
!       end if;
  
!       if Source.Length = 0 then
!          return;
!       end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       --  TODO: This can be written in terms of a loop instead as
!       --  active-iterator style, sort of like a passive iterator.
  
+       Tgt_Node := HT_Ops.First (Target.HT);
+       while Tgt_Node /= null loop
+          if Is_In (Source.HT, Tgt_Node) then
+             declare
+                X : Node_Access := Tgt_Node;
+             begin
+                Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
+                HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
+                Free (X);
+             end;
  
!          else
!             Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
!          end if;
!       end loop;
!    end Difference;
  
!    function Difference (Left, Right : Set) return Set is
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
!    begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
  
!       if Left.Length = 0 then
!          return Empty_Set;
!       end if;
  
!       if Right.Length = 0 then
!          return Left;
!       end if;
  
+       declare
+          Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
+       begin
+          Buckets := new Buckets_Type (0 .. Size - 1);
+       end;
  
!       Length := 0;
  
+       Iterate_Left : declare
+          procedure Process (L_Node : Node_Access);
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
  
!          -------------
!          -- Process --
!          -------------
  
!          procedure Process (L_Node : Node_Access) is
!          begin
!             if not Is_In (Right.HT, L_Node) then
!                declare
!                   J : constant Hash_Type :=
!                         Hash (L_Node.Element) mod Buckets'Length;
  
!                   Bucket : Node_Access renames Buckets (J);
  
!                begin
!                   Bucket := new Node_Type'(L_Node.Element, Bucket);
!                end;
  
!                Length := Length + 1;
!             end if;
!          end Process;
  
!       --  Start of processing for Iterate_Left
  
+       begin
+          Iterate (Left.HT);
+       exception
+          when others =>
+             HT_Ops.Free_Hash_Table (Buckets);
+             raise;
+       end Iterate_Left;
  
!       return (Controlled with HT => (Buckets, Length, 0, 0));
!    end Difference;
  
!    -------------
!    -- Element --
!    -------------
  
+    function Element (Position : Cursor) return Element_Type is
     begin
+       pragma Assert (Vet (Position), "bad cursor in function Element");
  
!       if Position.Node = null then
           raise Constraint_Error;
        end if;
  
!       return Position.Node.Element;
!    end Element;
  
+    ---------------------
+    -- Equivalent_Sets --
+    ---------------------
  
!    function Equivalent_Sets (Left, Right : Set) return Boolean is
!    begin
!       return Is_Equivalent (Left.HT, Right.HT);
!    end Equivalent_Sets;
  
!    -------------------------
!    -- Equivalent_Elements --
!    -------------------------
  
+    function Equivalent_Elements (Left, Right : Cursor)
+      return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
  
!       if Left.Node = null
!         or else Right.Node = null
!       then
           raise Constraint_Error;
        end if;
  
!       return Equivalent_Elements (Left.Node.Element, Right.Node.Element);
!    end Equivalent_Elements;
  
+    function Equivalent_Elements (Left : Cursor; Right : Element_Type)
+      return Boolean is
     begin
+       pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
  
!       if Left.Node = null then
!          raise Constraint_Error;
        end if;
  
!       return Equivalent_Elements (Left.Node.Element, Right);
!    end Equivalent_Elements;
  
+    function Equivalent_Elements (Left : Element_Type; Right : Cursor)
+      return Boolean is
     begin
+       pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
  
!       if Right.Node = null then
           raise Constraint_Error;
        end if;
  
!       return Equivalent_Elements (Left, Right.Node.Element);
!    end Equivalent_Elements;
  
!    ---------------------
!    -- Equivalent_Keys --
!    ---------------------
  
+    function Equivalent_Keys (Key : Element_Type; Node : Node_Access)
+      return Boolean is
+    begin
+       return Equivalent_Elements (Key, Node.Element);
+    end Equivalent_Keys;
  
!    -------------
!    -- Exclude --
!    -------------
  
+    procedure Exclude
+      (Container : in out Set;
+       Item      : Element_Type)
+    is
        X : Node_Access;
     begin
!       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
        Free (X);
     end Exclude;
  
+    --------------
+    -- Finalize --
+    --------------
  
!    procedure Finalize (Container : in out Set) is
     begin
+       HT_Ops.Finalize (Container.HT);
+    end Finalize;
  
!    ----------
!    -- Find --
!    ----------
  
!    function Find
!      (Container : Set;
!       Item      : Element_Type) return Cursor
!    is
!       Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
  
!    begin
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
!    end Find;
  
!    --------------------
!    -- Find_Equal_Key --
!    --------------------
  
+    function Find_Equal_Key
+      (R_HT   : Hash_Table_Type;
+       L_Node : Node_Access) return Boolean
+    is
+       R_Index : constant Hash_Type :=
+                   Element_Keys.Index (R_HT, L_Node.Element);
  
+       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
!    begin
!       loop
!          if R_Node = null then
!             return False;
!          end if;
  
!          if L_Node.Element = R_Node.Element then
!             return True;
!          end if;
  
!          R_Node := Next (R_Node);
!       end loop;
!    end Find_Equal_Key;
  
!    -------------------------
!    -- Find_Equivalent_Key --
!    -------------------------
  
!    function Find_Equivalent_Key
!      (R_HT   : Hash_Table_Type;
!       L_Node : Node_Access) return Boolean
!    is
!       R_Index : constant Hash_Type :=
!                   Element_Keys.Index (R_HT, L_Node.Element);
  
!       R_Node  : Node_Access := R_HT.Buckets (R_Index);
  
!    begin
!       loop
!          if R_Node = null then
!             return False;
!          end if;
  
!          if Equivalent_Elements (L_Node.Element, R_Node.Element) then
!             return True;
!          end if;
  
!          R_Node := Next (R_Node);
!       end loop;
!    end Find_Equivalent_Key;
  
!    -----------
!    -- First --
!    -----------
  
!    function First (Container : Set) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container.HT);
  
     begin
!       if Node = null then
!          return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
!    end First;
  
!    ----------
!    -- Free --
!    ----------
  
!    procedure Free (X : in out Node_Access) is
!       procedure Deallocate is
!          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     begin
!       if X /= null then
!          X.Next := X;     --  detect mischief (in Vet)
!          Deallocate (X);
        end if;
+    end Free;
  
!    -----------------
!    -- Has_Element --
!    -----------------
  
!    function Has_Element (Position : Cursor) return Boolean is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Has_Element");
!       return Position.Node /= null;
!    end Has_Element;
  
!    ---------------
!    -- Hash_Node --
!    ---------------
  
!    function Hash_Node (Node : Node_Access) return Hash_Type is
!    begin
!       return Hash (Node.Element);
!    end Hash_Node;
  
!    -------------
!    -- Include --
!    -------------
  
!    procedure Include
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Position : Cursor;
!       Inserted : Boolean;
  
!    begin
!       Insert (Container, New_Item, Position, Inserted);
  
!       if not Inserted then
!          if Container.HT.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          Position.Node.Element := New_Item;
!       end if;
!    end Include;
  
!    ------------
!    -- Insert --
!    ------------
  
!    procedure Insert
!      (Container : in out Set;
!       New_Item  : Element_Type;
!       Position  : out Cursor;
!       Inserted  : out Boolean)
!    is
!    begin
!       Insert (Container.HT, New_Item, Position.Node, Inserted);
!       Position.Container := Container'Unchecked_Access;
!    end Insert;
  
!    procedure Insert
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Position : Cursor;
!       Inserted : Boolean;
  
!    begin
!       Insert (Container, New_Item, Position, Inserted);
  
!       if not Inserted then
!          raise Constraint_Error;
!       end if;
!    end Insert;
  
!    procedure Insert
!      (HT       : in out Hash_Table_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean)
!    is
!       function New_Node (Next : Node_Access) return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Insert is
!         new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node (Next : Node_Access) return Node_Access is
        begin
!          return new Node_Type'(New_Item, Next);
!       end New_Node;
  
!    --  Start of processing for Insert
  
     begin
!       if HT_Ops.Capacity (HT) = 0 then
!          HT_Ops.Reserve_Capacity (HT, 1);
!       end if;
  
+       Local_Insert (HT, New_Item, Node, Inserted);
  
!       if Inserted
!         and then HT.Length > HT_Ops.Capacity (HT)
!       then
!          HT_Ops.Reserve_Capacity (HT, HT.Length);
!       end if;
!    end Insert;
  
+    ------------------
+    -- Intersection --
+    ------------------
+ 
+    procedure Intersection
+      (Target : in out Set;
+       Source : Set)
+    is
        Tgt_Node : Node_Access;
  
     begin
        if Target'Address = Source'Address then
           return;
        end if;
*************** package body Ada.Containers.Hashed_Sets 
*** 594,599 ****
--- 678,687 ----
           return;
        end if;
  
+       if Target.HT.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        --  TODO: optimize this to use an explicit
        --  loop instead of an active iterator
        --  (similar to how a passive iterator is
*************** package body Ada.Containers.Hashed_Sets 
*** 603,640 ****
        --  set is smaller, and iterate over the
        --  smaller set.
  
!       Tgt_Node := HT_Ops.First (Target);
! 
        while Tgt_Node /= null loop
! 
!          if Is_In (Source, Tgt_Node) then
! 
!             Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
  
           else
- 
              declare
                 X : Node_Access := Tgt_Node;
              begin
!                Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target, X);
                 Free (X);
              end;
- 
           end if;
- 
        end loop;
- 
     end Intersection;
  
- 
     function Intersection (Left, Right : Set) return Set is
- 
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
- 
        if Left'Address = Right'Address then
           return Left;
        end if;
--- 691,718 ----
        --  set is smaller, and iterate over the
        --  smaller set.
  
!       Tgt_Node := HT_Ops.First (Target.HT);
        while Tgt_Node /= null loop
!          if Is_In (Source.HT, Tgt_Node) then
!             Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
  
           else
              declare
                 X : Node_Access := Tgt_Node;
              begin
!                Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
                 Free (X);
              end;
           end if;
        end loop;
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
        if Left'Address = Right'Address then
           return Left;
        end if;
*************** package body Ada.Containers.Hashed_Sets 
*** 653,868 ****
  
        Length := 0;
  
!       declare
           procedure Process (L_Node : Node_Access);
  
           procedure Process (L_Node : Node_Access) is
           begin
!             if Is_In (Right, L_Node) then
! 
                 declare
!                   I : constant Hash_Type :=
!                     Hash (L_Node.Element) mod Buckets'Length;
                 begin
!                   Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
                 end;
  
                 Length := Length + 1;
- 
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
  
     end Intersection;
  
  
!    procedure Difference (Target : in out Set;
!                          Source : in     Set) is
! 
  
!       Tgt_Node : Node_Access;
  
     begin
  
!       if Target'Address = Source'Address then
!          Clear (Target);
!          return;
        end if;
  
!       if Source.Length = 0 then
!          return;
        end if;
  
!       --  TODO: As I noted above, this can be
!       --  written in terms of a loop instead as
!       --  active-iterator style, sort of like a
!       --  passive iterator.
  
!       Tgt_Node := HT_Ops.First (Target);
  
!       while Tgt_Node /= null loop
  
!          if Is_In (Source, Tgt_Node) then
  
!             declare
!                X : Node_Access := Tgt_Node;
!             begin
!                Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
!                HT_Ops.Delete_Node_Sans_Free (Target, X);
!                Free (X);
!             end;
  
!          else
  
!             Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
  
!          end if;
  
!       end loop;
  
!    end Difference;
  
  
  
!    function Difference (Left, Right : Set) return Set is
  
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
     begin
  
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
  
!       if Left.Length = 0 then
!          return Empty_Set;
        end if;
  
        if Right.Length = 0 then
!          return Left;
        end if;
  
        declare
!          Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
        begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
!       Length := 0;
  
!       declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right, L_Node) then
  
!                declare
!                   I : constant Hash_Type :=
!                     Hash (L_Node.Element) mod Buckets'Length;
!                begin
!                   Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
!                end;
  
!                Length := Length + 1;
  
!             end if;
!          end Process;
  
-          procedure Iterate is
-             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end;
  
!       return (Controlled with Buckets, Length);
  
!    end Difference;
  
  
  
!    procedure Symmetric_Difference (Target : in out Set;
!                                    Source : in     Set) is
     begin
  
        if Target'Address = Source'Address then
           Clear (Target);
           return;
        end if;
  
!       HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
  
!       if Target.Length = 0 then
  
!          declare
              procedure Process (Src_Node : Node_Access);
  
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element;
!                B : Buckets_Type renames Target.Buckets.all;
!                I : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.Length;
              begin
!                B (I) := new Node_Type'(E, B (I));
                 N := N + 1;
              end Process;
  
!             procedure Iterate is
!                new HT_Ops.Generic_Iteration (Process);
           begin
!             Iterate (Source);
!          end;
  
        else
! 
!          declare
              procedure Process (Src_Node : Node_Access);
  
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element;
!                B : Buckets_Type renames Target.Buckets.all;
!                I : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.Length;
!             begin
!                if B (I) = null then
  
!                   B (I) := new Node_Type'(E, null);
                    N := N + 1;
  
!                elsif Equivalent_Keys (E, B (I).Element) then
! 
                    declare
!                      X : Node_Access := B (I);
                    begin
!                      B (I) := B (I).Next;
                       N := N - 1;
                       Free (X);
                    end;
  
                 else
- 
                    declare
!                      Prev : Node_Access := B (I);
                       Curr : Node_Access := Prev.Next;
                    begin
                       while Curr /= null loop
!                         if Equivalent_Keys (E, Curr.Element) then
                             Prev.Next := Curr.Next;
                             N := N - 1;
                             Free (Curr);
--- 731,1270 ----
  
        Length := 0;
  
!       Iterate_Left : declare
           procedure Process (L_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (L_Node : Node_Access) is
           begin
!             if Is_In (Right.HT, L_Node) then
                 declare
!                   J : constant Hash_Type :=
!                         Hash (L_Node.Element) mod Buckets'Length;
! 
!                   Bucket : Node_Access renames Buckets (J);
! 
                 begin
!                   Bucket := new Node_Type'(L_Node.Element, Bucket);
                 end;
  
                 Length := Length + 1;
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Left
! 
        begin
!          Iterate (Left.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Left;
  
+       return (Controlled with HT => (Buckets, Length, 0, 0));
     end Intersection;
  
+    --------------
+    -- Is_Empty --
+    --------------
  
!    function Is_Empty (Container : Set) return Boolean is
!    begin
!       return Container.HT.Length = 0;
!    end Is_Empty;
  
!    -----------
!    -- Is_In --
!    -----------
  
+    function Is_In (HT : Hash_Table_Type; Key : Node_Access) return Boolean is
     begin
+       return Element_Keys.Find (HT, Key.Element) /= null;
+    end Is_In;
  
!    ---------------
!    -- Is_Subset --
!    ---------------
! 
!    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
!       Subset_Node : Node_Access;
! 
!    begin
!       if Subset'Address = Of_Set'Address then
!          return True;
        end if;
  
!       if Subset.Length > Of_Set.Length then
!          return False;
        end if;
  
!       --  TODO: rewrite this to loop in the
!       --  style of a passive iterator.
  
!       Subset_Node := HT_Ops.First (Subset.HT);
!       while Subset_Node /= null loop
!          if not Is_In (Of_Set.HT, Subset_Node) then
!             return False;
!          end if;
!          Subset_Node := HT_Ops.Next (Subset.HT, Subset_Node);
!       end loop;
  
!       return True;
!    end Is_Subset;
  
!    -------------
!    -- Iterate --
!    -------------
  
!    procedure Iterate
!      (Container : Set;
!       Process   : not null access procedure (Position : Cursor))
!    is
!       procedure Process_Node (Node : Node_Access);
!       pragma Inline (Process_Node);
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process_Node);
  
!       ------------------
!       -- Process_Node --
!       ------------------
  
!       procedure Process_Node (Node : Node_Access) is
!       begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
!       end Process_Node;
  
!    --  Start of processing for Iterate
  
!    begin
!       --  TODO: resolve whether HT_Ops.Generic_Iteration should
!       --  manipulate busy bit.
  
+       Iterate (Container.HT);
+    end Iterate;
  
+    ------------
+    -- Length --
+    ------------
  
!    function Length (Container : Set) return Count_Type is
!    begin
!       return Container.HT.Length;
!    end Length;
  
!    ----------
!    -- Move --
!    ----------
  
+    procedure Move (Target : in out Set; Source : in out Set) is
     begin
+       HT_Ops.Move (Target => Target.HT, Source => Source.HT);
+    end Move;
  
!    ----------
!    -- Next --
!    ----------
  
!    function Next (Node : Node_Access) return Node_Access is
!    begin
!       return Node.Next;
!    end Next;
! 
!    function Next (Position : Cursor) return Cursor is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in function Next");
! 
!       if Position.Node = null then
!          return No_Element;
        end if;
  
+       declare
+          HT   : Hash_Table_Type renames Position.Container.HT;
+          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
+ 
+       begin
+          if Node = null then
+             return No_Element;
+          end if;
+ 
+          return Cursor'(Position.Container, Node);
+       end;
+    end Next;
+ 
+    procedure Next (Position : in out Cursor) is
+    begin
+       Position := Next (Position);
+    end Next;
+ 
+    -------------
+    -- Overlap --
+    -------------
+ 
+    function Overlap (Left, Right : Set) return Boolean is
+       Left_Node : Node_Access;
+ 
+    begin
        if Right.Length = 0 then
!          return False;
!       end if;
! 
!       if Left'Address = Right'Address then
!          return True;
!       end if;
! 
!       Left_Node := HT_Ops.First (Left.HT);
!       while Left_Node /= null loop
!          if Is_In (Right.HT, Left_Node) then
!             return True;
!          end if;
!          Left_Node := HT_Ops.Next (Left.HT, Left_Node);
!       end loop;
! 
!       return False;
!    end Overlap;
! 
!    -------------------
!    -- Query_Element --
!    -------------------
! 
!    procedure Query_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Query_Element");
! 
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
        declare
!          HT : Hash_Table_Type renames Position.Container.HT;
! 
!          B : Natural renames HT.Busy;
!          L : Natural renames HT.Lock;
! 
        begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
        end;
+    end Query_Element;
  
!    ----------
!    -- Read --
!    ----------
  
!    procedure Read
!      (Stream    : access Root_Stream_Type'Class;
!       Container :    out Set)
!    is
!    begin
!       Read_Nodes (Stream, Container.HT);
!    end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
! 
!    ---------------
!    -- Read_Node --
!    ---------------
! 
!    function Read_Node (Stream : access Root_Stream_Type'Class)
!      return Node_Access
!    is
!       Node : Node_Access := new Node_Type;
! 
!    begin
!       Element_Type'Read (Stream, Node.Element);
!       return Node;
!    exception
!       when others =>
!          Free (Node);
!          raise;
!    end Read_Node;
! 
!    -------------
!    -- Replace --
!    -------------
! 
!    procedure Replace
!      (Container : in out Set;
!       New_Item  : Element_Type)
!    is
!       Node : constant Node_Access :=
!                Element_Keys.Find (Container.HT, New_Item);
! 
!    begin
!       if Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Container.HT.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       Node.Element := New_Item;
!    end Replace;
! 
!    ---------------------
!    -- Replace_Element --
!    ---------------------
! 
!    procedure Replace_Element
!      (HT       : in out Hash_Table_Type;
!       Node     : Node_Access;
!       New_Item : Element_Type)
!    is
!    begin
!       if Equivalent_Elements (Node.Element, New_Item) then
!          pragma Assert (Hash (Node.Element) = Hash (New_Item));
! 
!          if HT.Lock > 0 then
!             raise Program_Error;
!          end if;
! 
!          Node.Element := New_Item;  --  Note that this assignment can fail
!          return;
!       end if;
! 
!       if HT.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       HT_Ops.Delete_Node_Sans_Free (HT, Node);
! 
!       Insert_New_Element : declare
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
! 
!          procedure Local_Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
! 
!          --------------
!          -- New_Node --
!          --------------
! 
!          function New_Node (Next : Node_Access) return Node_Access is
           begin
!             Node.Element := New_Item;  -- Note that this assignment can fail
!             Node.Next := Next;
!             return Node;
!          end New_Node;
  
!          Result   : Node_Access;
!          Inserted : Boolean;
  
!       --  Start of processing for Insert_New_Element
  
!       begin
!          Local_Insert
!            (HT       => HT,
!             Key      => New_Item,
!             Node     => Result,
!             Inserted => Inserted);
! 
!          if Inserted then
!             return;
!          end if;
!       exception
!          when others =>
!             null;   --  Assignment must have failed
!       end Insert_New_Element;
! 
!       Reinsert_Old_Element : declare
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
! 
!          procedure Local_Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
! 
!          --------------
!          -- New_Node --
!          --------------
! 
!          function New_Node (Next : Node_Access) return Node_Access is
!          begin
!             Node.Next := Next;
!             return Node;
!          end New_Node;
! 
!          Result   : Node_Access;
!          Inserted : Boolean;
! 
!       --  Start of processing for Reinsert_Old_Element
  
        begin
!          Local_Insert
!            (HT       => HT,
!             Key      => Node.Element,
!             Node     => Result,
!             Inserted => Inserted);
        exception
           when others =>
!             null;
!       end Reinsert_Old_Element;
  
!       raise Program_Error;
!    end Replace_Element;
  
!    procedure Replace_Element
!      (Container : in out Set;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
!    begin
!       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
  
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
  
+       if Position.Container /= Container'Unrestricted_Access then
+          raise Program_Error;
+       end if;
  
!       Replace_Element (Container.HT, Position.Node, New_Item);
!    end Replace_Element;
! 
!    ----------------------
!    -- Reserve_Capacity --
!    ----------------------
! 
!    procedure Reserve_Capacity
!      (Container : in out Set;
!       Capacity  : Count_Type)
!    is
!    begin
!       HT_Ops.Reserve_Capacity (Container.HT, Capacity);
!    end Reserve_Capacity;
! 
!    --------------
!    -- Set_Next --
!    --------------
! 
!    procedure Set_Next (Node : Node_Access; Next : Node_Access) is
     begin
+       Node.Next := Next;
+    end Set_Next;
+ 
+    --------------------------
+    -- Symmetric_Difference --
+    --------------------------
  
+    procedure Symmetric_Difference
+      (Target : in out Set;
+       Source : Set)
+    is
+    begin
        if Target'Address = Source'Address then
           Clear (Target);
           return;
        end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       declare
!          N : constant Count_Type := Target.Length + Source.Length;
!       begin
!          if N > HT_Ops.Capacity (Target.HT) then
!             HT_Ops.Reserve_Capacity (Target.HT, N);
!          end if;
!       end;
  
!       if Target.Length = 0 then
!          Iterate_Source_When_Empty_Target : declare
              procedure Process (Src_Node : Node_Access);
  
+             procedure Iterate is
+                new HT_Ops.Generic_Iteration (Process);
+ 
+             -------------
+             -- Process --
+             -------------
+ 
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element;
!                B : Buckets_Type renames Target.HT.Buckets.all;
!                J : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.HT.Length;
! 
              begin
!                B (J) := new Node_Type'(E, B (J));
                 N := N + 1;
              end Process;
  
!          --  Start of processing for Iterate_Source_When_Empty_Target
! 
           begin
!             Iterate (Source.HT);
!          end Iterate_Source_When_Empty_Target;
  
        else
!          Iterate_Source : declare
              procedure Process (Src_Node : Node_Access);
  
+             procedure Iterate is
+                new HT_Ops.Generic_Iteration (Process);
+ 
+             -------------
+             -- Process --
+             -------------
+ 
              procedure Process (Src_Node : Node_Access) is
                 E : Element_Type renames Src_Node.Element;
!                B : Buckets_Type renames Target.HT.Buckets.all;
!                J : constant Hash_Type := Hash (E) mod B'Length;
!                N : Count_Type renames Target.HT.Length;
  
!             begin
!                if B (J) = null then
!                   B (J) := new Node_Type'(E, null);
                    N := N + 1;
  
!                elsif Equivalent_Elements (E, B (J).Element) then
                    declare
!                      X : Node_Access := B (J);
                    begin
!                      B (J) := B (J).Next;
                       N := N - 1;
                       Free (X);
                    end;
  
                 else
                    declare
!                      Prev : Node_Access := B (J);
                       Curr : Node_Access := Prev.Next;
+ 
                    begin
                       while Curr /= null loop
!                         if Equivalent_Elements (E, Curr.Element) then
                             Prev.Next := Curr.Next;
                             N := N - 1;
                             Free (Curr);
*************** package body Ada.Containers.Hashed_Sets 
*** 873,903 ****
                          Curr := Prev.Next;
                       end loop;
  
!                      B (I) := new Node_Type'(E, B (I));
                       N := N + 1;
                    end;
- 
                 end if;
              end Process;
  
!             procedure Iterate is
!                new HT_Ops.Generic_Iteration (Process);
!          begin
!             Iterate (Source);
!          end;
  
        end if;
- 
     end Symmetric_Difference;
  
- 
     function Symmetric_Difference (Left, Right : Set) return Set is
- 
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
- 
        if Left'Address = Right'Address then
           return Empty_Set;
        end if;
--- 1275,1299 ----
                          Curr := Prev.Next;
                       end loop;
  
!                      B (J) := new Node_Type'(E, B (J));
                       N := N + 1;
                    end;
                 end if;
              end Process;
  
!          --  Start of processing for Iterate_Source
  
+          begin
+             Iterate (Source.HT);
+          end Iterate_Source;
        end if;
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
        Buckets : HT_Types.Buckets_Access;
        Length  : Count_Type;
  
     begin
        if Left'Address = Right'Address then
           return Empty_Set;
        end if;
*************** package body Ada.Containers.Hashed_Sets 
*** 912,1417 ****
  
        declare
           Size : constant Hash_Type :=
!            Prime_Numbers.To_Prime (Left.Length + Right.Length);
        begin
           Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
        Length := 0;
  
!       declare
           procedure Process (L_Node : Node_Access);
  
           procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right, L_Node) then
                 declare
                    E : Element_Type renames L_Node.Element;
!                   I : constant Hash_Type := Hash (E) mod Buckets'Length;
                 begin
!                   Buckets (I) := new Node_Type'(E, Buckets (I));
                    Length := Length + 1;
                 end;
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Left);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
  
!       declare
           procedure Process (R_Node : Node_Access);
  
           procedure Process (R_Node : Node_Access) is
           begin
!             if not Is_In (Left, R_Node) then
                 declare
                    E : Element_Type renames R_Node.Element;
!                   I : constant Hash_Type := Hash (E) mod Buckets'Length;
                 begin
!                   Buckets (I) := new Node_Type'(E, Buckets (I));
                    Length := Length + 1;
                 end;
              end if;
           end Process;
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
        begin
!          Iterate (Right);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end;
! 
!       return (Controlled with Buckets, Length);
  
     end Symmetric_Difference;
  
  
!    function Is_Subset (Subset : Set;
!                        Of_Set : Set) return Boolean is
! 
!       Subset_Node : Node_Access;
  
     begin
  
!       if Subset'Address = Of_Set'Address then
!          return True;
!       end if;
  
!       if Subset.Length > Of_Set.Length then
!          return False;
!       end if;
  
!       --  TODO: rewrite this to loop in the
!       --  style of a passive iterator.
  
!       Subset_Node := HT_Ops.First (Subset);
  
!       while Subset_Node /= null loop
!          if not Is_In (Of_Set, Subset_Node) then
!             return False;
!          end if;
  
!          Subset_Node := HT_Ops.Next (Subset, Subset_Node);
!       end loop;
  
!       return True;
  
!    end Is_Subset;
  
  
!    function Overlap (Left, Right : Set) return Boolean is
  
!       Left_Node : Node_Access;
  
!    begin
  
!       if Right.Length = 0 then
!          return False;
        end if;
  
!       if Left'Address = Right'Address then
!          return True;
        end if;
  
!       Left_Node := HT_Ops.First (Left);
! 
!       while Left_Node /= null loop
!          if Is_In (Right, Left_Node) then
!             return True;
           end if;
  
!          Left_Node := HT_Ops.Next (Left, Left_Node);
!       end loop;
  
!       return False;
  
!    end Overlap;
  
  
!    function Find (Container : Set;
!                   Item      : Element_Type) return Cursor is
  
!       Node : constant Node_Access := Element_Keys.Find (Container, Item);
  
!    begin
  
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
  
!    end Find;
  
  
!    function Contains (Container : Set;
!                       Item      : Element_Type) return Boolean is
!    begin
!       return Find (Container, Item) /= No_Element;
!    end Contains;
  
  
  
!    function First (Container : Set) return Cursor is
!       Node : constant Node_Access := HT_Ops.First (Container);
!    begin
!       if Node = null then
!          return No_Element;
!       end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
!    end First;
  
  
! --     function First_Element (Container : Set) return Element_Type is
! --        Node : constant Node_Access := HT_Ops.First (Container);
! --     begin
! --        return Node.Element;
! --     end First_Element;
  
  
!    function Next (Position : Cursor) return Cursor is
!    begin
!       if Position.Container = null
!         or else Position.Node = null
!       then
!          return No_Element;
!       end if;
  
!       declare
!          S : Set renames Position.Container.all;
!          Node : constant Node_Access := HT_Ops.Next (S, Position.Node);
!       begin
!          if Node = null then
!             return No_Element;
!          end if;
  
!          return Cursor'(Position.Container, Node);
!       end;
!    end Next;
  
  
!    procedure Next (Position : in out Cursor) is
!    begin
!       Position := Next (Position);
!    end Next;
  
  
!    function Has_Element (Position : Cursor) return Boolean is
     begin
        if Position.Container = null then
           return False;
        end if;
  
!       if Position.Node = null then
           return False;
        end if;
  
!       return True;
!    end Has_Element;
! 
  
!    function Equivalent_Keys (Left, Right : Cursor)
!      return Boolean is
!    begin
!       return Equivalent_Keys (Left.Node.Element, Right.Node.Element);
!    end Equivalent_Keys;
  
  
!    function Equivalent_Keys (Left  : Cursor;
!                              Right : Element_Type)
!     return Boolean is
!    begin
!       return Equivalent_Keys (Left.Node.Element, Right);
!    end Equivalent_Keys;
  
  
!    function Equivalent_Keys (Left  : Element_Type;
!                              Right : Cursor)
!     return Boolean is
!    begin
!       return Equivalent_Keys (Left, Right.Node.Element);
!    end Equivalent_Keys;
  
  
!    procedure Iterate
!      (Container : in Set;
!       Process   : not null access procedure (Position : in Cursor)) is
  
!       procedure Process_Node (Node : in Node_Access);
!       pragma Inline (Process_Node);
  
!       procedure Process_Node (Node : in Node_Access) is
!       begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
!       end Process_Node;
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process_Node);
     begin
!       Iterate (Container);
!    end Iterate;
! 
! 
!    function Capacity (Container : Set) return Count_Type
!      renames HT_Ops.Capacity;
! 
!    procedure Reserve_Capacity
!      (Container : in out Set;
!       Capacity  : in     Count_Type)
!      renames HT_Ops.Ensure_Capacity;
! 
  
!    procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : in     Node_Access);
!    pragma Inline (Write_Node);
  
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : in     Node_Access) is
     begin
        Element_Type'Write (Stream, Node.Element);
     end Write_Node;
  
-    procedure Write_Nodes is
-       new HT_Ops.Generic_Write (Write_Node);
- 
-    procedure Write
-      (Stream    : access Root_Stream_Type'Class;
-       Container : in     Set) renames Write_Nodes;
- 
- 
-    function Read_Node (Stream : access Root_Stream_Type'Class)
-      return Node_Access;
-    pragma Inline (Read_Node);
- 
-    function Read_Node (Stream : access Root_Stream_Type'Class)
-      return Node_Access is
- 
-       Node : Node_Access := new Node_Type;
-    begin
-       Element_Type'Read (Stream, Node.Element);
-       return Node;
-    exception
-       when others =>
-          Free (Node);
-          raise;
-    end Read_Node;
- 
-    procedure Read_Nodes is
-       new HT_Ops.Generic_Read (Read_Node);
- 
-    procedure Read
-      (Stream    : access Root_Stream_Type'Class;
-       Container :    out Set) renames Read_Nodes;
- 
- 
     package body Generic_Keys is
  
!       function Equivalent_Keys (Left  : Cursor;
!                                 Right : Key_Type)
!         return Boolean is
!       begin
!          return Equivalent_Keys (Right, Left.Node.Element);
!       end Equivalent_Keys;
! 
!       function Equivalent_Keys (Left  : Key_Type;
!                                 Right : Cursor)
!         return Boolean is
!       begin
!          return Equivalent_Keys (Left, Right.Node.Element);
!       end Equivalent_Keys;
  
!       function Equivalent_Keys
          (Key  : Key_Type;
           Node : Node_Access) return Boolean;
!       pragma Inline (Equivalent_Keys);
  
!       function Equivalent_Keys
!         (Key  : Key_Type;
!          Node : Node_Access) return Boolean is
!       begin
!          return Equivalent_Keys (Key, Node.Element);
!       end Equivalent_Keys;
  
        package Key_Keys is
           new Hash_Tables.Generic_Keys
            (HT_Types  => HT_Types,
-            HT_Type   => Set,
-            Null_Node => null,
             Next      => Next,
             Set_Next  => Set_Next,
             Key_Type  => Key_Type,
             Hash      => Hash,
!            Equivalent_Keys => Equivalent_Keys);
! 
! 
!       function Find (Container : Set;
!                      Key       : Key_Type)
!          return Cursor is
  
!          Node : constant Node_Access :=
!            Key_Keys.Find (Container, Key);
  
        begin
  
!          if Node = null then
!             return No_Element;
!          end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
  
!       end Find;
  
  
!       function Contains (Container : Set;
!                          Key       : Key_Type) return Boolean is
!       begin
!          return Find (Container, Key) /= No_Element;
!       end Contains;
  
  
!       function Element (Container : Set;
!                         Key       : Key_Type)
!         return Element_Type is
  
-          Node : constant Node_Access := Key_Keys.Find (Container, Key);
        begin
           return Node.Element;
        end Element;
  
  
!       function Key (Position : Cursor) return Key_Type is
        begin
!          return Key (Position.Node.Element);
!       end Key;
! 
! 
! --  TODO:
! --        procedure Replace (Container : in out Set;
! --                           Key       : in     Key_Type;
! --                           New_Item  : in     Element_Type) is
! 
! --           Node : constant Node_Access :=
! --             Key_Keys.Find (Container, Key);
  
! --        begin
  
! --           if Node = null then
! --              raise Constraint_Error;
! --           end if;
  
! --           Replace_Element (Container, Node, New_Item);
  
! --        end Replace;
  
  
!       procedure Delete (Container : in out Set;
!                         Key       : in     Key_Type) is
  
!          X : Node_Access;
  
        begin
  
!          Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
! 
!          if X = null then
              raise Constraint_Error;
           end if;
  
!          Free (X);
! 
!       end Delete;
! 
  
!       procedure Exclude (Container : in out Set;
!                          Key       : in     Key_Type) is
  
!          X : Node_Access;
  
        begin
  
!          Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
!          Free (X);
! 
!       end Exclude;
  
  
!       procedure Checked_Update_Element
          (Container : in out Set;
!          Position  : in     Cursor;
           Process   : not null access
!            procedure (Element : in out Element_Type)) is
  
        begin
  
!          if Position.Container = null then
              raise Constraint_Error;
           end if;
  
!          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
              raise Program_Error;
           end if;
  
           declare
!             Old_Key : Key_Type renames Key (Position.Node.Element);
           begin
!             Process (Position.Node.Element);
  
!             if Equivalent_Keys (Old_Key, Position.Node.Element) then
                 return;
              end if;
           end;
  
!          declare
!             function New_Node (Next : Node_Access) return Node_Access;
!             pragma Inline (New_Node);
  
!             function New_Node (Next : Node_Access) return Node_Access is
!             begin
!                Position.Node.Next := Next;
!                return Position.Node;
!             end New_Node;
  
!             procedure Insert is
!                new Key_Keys.Generic_Conditional_Insert (New_Node);
  
!             Result  : Node_Access;
!             Success : Boolean;
!          begin
!             HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
  
!             Insert
!               (HT      => Container,
!                Key     => Key (Position.Node.Element),
!                Node    => Result,
!                Success => Success);
  
!             if not Success then
!                declare
!                   X : Node_Access := Position.Node;
!                begin
!                   Free (X);
!                end;
  
!                raise Program_Error;
!             end if;
  
!             pragma Assert (Result = Position.Node);
           end;
  
!       end Checked_Update_Element;
  
     end Generic_Keys;
  
--- 1308,1900 ----
  
        declare
           Size : constant Hash_Type :=
!                   Prime_Numbers.To_Prime (Left.Length + Right.Length);
        begin
           Buckets := new Buckets_Type (0 .. Size - 1);
        end;
  
        Length := 0;
  
!       Iterate_Left : declare
           procedure Process (L_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (L_Node : Node_Access) is
           begin
!             if not Is_In (Right.HT, L_Node) then
                 declare
                    E : Element_Type renames L_Node.Element;
!                   J : constant Hash_Type := Hash (E) mod Buckets'Length;
! 
                 begin
!                   Buckets (J) := new Node_Type'(E, Buckets (J));
                    Length := Length + 1;
                 end;
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Left
! 
        begin
!          Iterate (Left.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Left;
  
!       Iterate_Right : declare
           procedure Process (R_Node : Node_Access);
  
+          procedure Iterate is
+             new HT_Ops.Generic_Iteration (Process);
+ 
+          -------------
+          -- Process --
+          -------------
+ 
           procedure Process (R_Node : Node_Access) is
           begin
!             if not Is_In (Left.HT, R_Node) then
                 declare
                    E : Element_Type renames R_Node.Element;
!                   J : constant Hash_Type := Hash (E) mod Buckets'Length;
! 
                 begin
!                   Buckets (J) := new Node_Type'(E, Buckets (J));
                    Length := Length + 1;
                 end;
              end if;
           end Process;
  
!       --  Start of processing for Iterate_Right
! 
        begin
!          Iterate (Right.HT);
        exception
           when others =>
              HT_Ops.Free_Hash_Table (Buckets);
              raise;
!       end Iterate_Right;
  
+       return (Controlled with HT => (Buckets, Length, 0, 0));
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
  
!    function To_Set (New_Item : Element_Type) return Set is
!       HT       : Hash_Table_Type;
!       Node     : Node_Access;
!       Inserted : Boolean;
  
     begin
+       Insert (HT, New_Item, Node, Inserted);
+       return Set'(Controlled with HT);
+    end To_Set;
  
!    -----------
!    -- Union --
!    -----------
  
!    procedure Union
!      (Target : in out Set;
!       Source : Set)
!    is
!       procedure Process (Src_Node : Node_Access);
  
!       procedure Iterate is
!          new HT_Ops.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Src_Node : Node_Access) is
!          function New_Node (Next : Node_Access) return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (New_Node);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node (Next : Node_Access) return Node_Access is
!             Node : constant Node_Access :=
!                      new Node_Type'(Src_Node.Element, Next);
!          begin
!             return Node;
!          end New_Node;
  
+          Tgt_Node : Node_Access;
+          Success  : Boolean;
  
!       --  Start of processing for Process
  
!       begin
!          Insert (Target.HT, Src_Node.Element, Tgt_Node, Success);
!       end Process;
  
!    --  Start of processing for Union
  
!    begin
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       if Target.HT.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       declare
!          N : constant Count_Type := Target.Length + Source.Length;
!       begin
!          if N > HT_Ops.Capacity (Target.HT) then
!             HT_Ops.Reserve_Capacity (Target.HT, N);
           end if;
+       end;
  
!       Iterate (Source.HT);
!    end Union;
  
!    function Union (Left, Right : Set) return Set is
!       Buckets : HT_Types.Buckets_Access;
!       Length  : Count_Type;
  
!    begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
  
+       if Right.Length = 0 then
+          return Left;
+       end if;
  
!       if Left.Length = 0 then
!          return Right;
!       end if;
  
!       declare
!          Size : constant Hash_Type :=
!                   Prime_Numbers.To_Prime (Left.Length + Right.Length);
!       begin
!          Buckets := new Buckets_Type (0 .. Size - 1);
!       end;
  
!       Iterate_Left : declare
!          procedure Process (L_Node : Node_Access);
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
  
!          -------------
!          -- Process --
!          -------------
  
!          procedure Process (L_Node : Node_Access) is
!             J : constant Hash_Type :=
!                   Hash (L_Node.Element) mod Buckets'Length;
  
+          begin
+             Buckets (J) := new Node_Type'(L_Node.Element, Buckets (J));
+          end Process;
  
!       --  Start of processing for Iterate_Left
  
+       begin
+          Iterate (Left.HT);
+       exception
+          when others =>
+             HT_Ops.Free_Hash_Table (Buckets);
+             raise;
+       end Iterate_Left;
  
+       Length := Left.Length;
  
!       Iterate_Right : declare
!          procedure Process (Src_Node : Node_Access);
  
!          procedure Iterate is
!             new HT_Ops.Generic_Iteration (Process);
  
+          -------------
+          -- Process --
+          -------------
  
!          procedure Process (Src_Node : Node_Access) is
!             J : constant Hash_Type :=
!                   Hash (Src_Node.Element) mod Buckets'Length;
  
+             Tgt_Node : Node_Access := Buckets (J);
  
!          begin
!             while Tgt_Node /= null loop
!                if Equivalent_Elements (Src_Node.Element, Tgt_Node.Element) then
!                   return;
!                end if;
  
!                Tgt_Node := Next (Tgt_Node);
!             end loop;
  
!             Buckets (J) := new Node_Type'(Src_Node.Element, Buckets (J));
!             Length := Length + 1;
!          end Process;
  
+       --  Start of processing for Iterate_Right
  
!       begin
!          Iterate (Right.HT);
!       exception
!          when others =>
!             HT_Ops.Free_Hash_Table (Buckets);
!             raise;
!       end Iterate_Right;
  
+       return (Controlled with HT => (Buckets, Length, 0, 0));
+    end Union;
  
!    ---------
!    -- Vet --
!    ---------
! 
!    function Vet (Position : Cursor) return Boolean is
     begin
+       if Position.Node = null then
+          return Position.Container = null;
+       end if;
+ 
        if Position.Container = null then
           return False;
        end if;
  
!       if Position.Node.Next = Position.Node then
           return False;
        end if;
  
!       declare
!          HT : Hash_Table_Type renames Position.Container.HT;
!          X  : Node_Access;
  
!       begin
!          if HT.Length = 0 then
!             return False;
!          end if;
  
+          if HT.Buckets = null
+            or else HT.Buckets'Length = 0
+          then
+             return False;
+          end if;
  
!          X := HT.Buckets (Element_Keys.Index (HT, Position.Node.Element));
  
+          for J in 1 .. HT.Length loop
+             if X = Position.Node then
+                return True;
+             end if;
  
!             if X = null then
!                return False;
!             end if;
  
+             if X = X.Next then  --  to prevent unnecessary looping
+                return False;
+             end if;
  
!             X := X.Next;
!          end loop;
  
!          return False;
!       end;
!    end Vet;
  
!    -----------
!    -- Write --
!    -----------
  
!    procedure Write
!      (Stream    : access Root_Stream_Type'Class;
!       Container : Set)
!    is
     begin
!       Write_Nodes (Stream, Container.HT);
!    end Write;
  
!    procedure Write
       (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
! 
!    ----------------
!    -- Write_Node --
!    ----------------
  
     procedure Write_Node
       (Stream : access Root_Stream_Type'Class;
!       Node   : Node_Access)
!    is
     begin
        Element_Type'Write (Stream, Node.Element);
     end Write_Node;
  
     package body Generic_Keys is
  
!       -----------------------
!       -- Local Subprograms --
!       -----------------------
  
!       function Equivalent_Key_Node
          (Key  : Key_Type;
           Node : Node_Access) return Boolean;
!       pragma Inline (Equivalent_Key_Node);
  
!       --------------------------
!       -- Local Instantiations --
!       --------------------------
  
        package Key_Keys is
           new Hash_Tables.Generic_Keys
            (HT_Types  => HT_Types,
             Next      => Next,
             Set_Next  => Set_Next,
             Key_Type  => Key_Type,
             Hash      => Hash,
!            Equivalent_Keys => Equivalent_Key_Node);
  
!       --------------
!       -- Contains --
!       --------------
  
+       function Contains
+         (Container : Set;
+          Key       : Key_Type) return Boolean
+       is
        begin
+          return Find (Container, Key) /= No_Element;
+       end Contains;
  
!       ------------
!       -- Delete --
!       ------------
  
!       procedure Delete
!         (Container : in out Set;
!          Key       : Key_Type)
!       is
!          X : Node_Access;
  
!       begin
!          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
  
+          if X = null then
+             raise Constraint_Error;
+          end if;
  
!          Free (X);
!       end Delete;
  
+       -------------
+       -- Element --
+       -------------
  
!       function Element
!         (Container : Set;
!          Key       : Key_Type) return Element_Type
!       is
!          Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
  
        begin
           return Node.Element;
        end Element;
  
+       -------------------------
+       -- Equivalent_Key_Node --
+       -------------------------
  
!       function Equivalent_Key_Node
!         (Key  : Key_Type;
!          Node : Node_Access) return Boolean
!       is
        begin
!          return Equivalent_Keys (Key, Generic_Keys.Key (Node.Element));
!       end Equivalent_Key_Node;
  
!       -------------
!       -- Exclude --
!       -------------
  
!       procedure Exclude
!         (Container : in out Set;
!          Key       : Key_Type)
!       is
!          X : Node_Access;
!       begin
!          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
!          Free (X);
!       end Exclude;
  
!       ----------
!       -- Find --
!       ----------
  
!       function Find
!         (Container : Set;
!          Key       : Key_Type) return Cursor
!       is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.HT, Key);
  
+       begin
+          if Node = null then
+             return No_Element;
+          end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
!       end Find;
  
!       ---------
!       -- Key --
!       ---------
  
+       function Key (Position : Cursor) return Key_Type is
        begin
+          pragma Assert (Vet (Position), "bad cursor in function Key");
  
!          if Position.Node = null then
              raise Constraint_Error;
           end if;
  
!          return Key (Position.Node.Element);
!       end Key;
  
!       -------------
!       -- Replace --
!       -------------
  
!       procedure Replace
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type)
!       is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.HT, Key);
  
        begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
  
!          Replace_Element (Container.HT, Node, New_Item);
!       end Replace;
  
+       -----------------------------------
+       -- Update_Element_Preserving_Key --
+       -----------------------------------
  
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
!          Position  : Cursor;
           Process   : not null access
!                        procedure (Element : in out Element_Type))
!       is
!          HT   : Hash_Table_Type renames Container.HT;
!          Indx : Hash_Type;
  
        begin
+          pragma Assert
+            (Vet (Position),
+             "bad cursor in Update_Element_Preserving_Key");
  
!          if Position.Node = null then
              raise Constraint_Error;
           end if;
  
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          if HT.Buckets = null
!            or else HT.Buckets'Length = 0
!            or else HT.Length = 0
!            or else Position.Node.Next = Position.Node
!          then
              raise Program_Error;
           end if;
  
+          Indx := HT_Ops.Index (HT, Position.Node);
+ 
           declare
!             E : Element_Type renames Position.Node.Element;
!             K : constant Key_Type := Key (E);
! 
!             B : Natural renames HT.Busy;
!             L : Natural renames HT.Lock;
! 
           begin
!             B := B + 1;
!             L := L + 1;
  
!             begin
!                Process (E);
!             exception
!                when others =>
!                   L := L - 1;
!                   B := B - 1;
!                   raise;
!             end;
! 
!             L := L - 1;
!             B := B - 1;
! 
!             if Equivalent_Keys (K, Key (E)) then
!                pragma Assert (Hash (K) = Hash (E));
                 return;
              end if;
           end;
  
!          if HT.Buckets (Indx) = Position.Node then
!             HT.Buckets (Indx) := Position.Node.Next;
  
!          else
!             declare
!                Prev : Node_Access := HT.Buckets (Indx);
  
!             begin
!                while Prev.Next /= Position.Node loop
!                   Prev := Prev.Next;
  
!                   if Prev = null then
!                      raise Program_Error;
!                   end if;
!                end loop;
  
!                Prev.Next := Position.Node.Next;
!             end;
!          end if;
  
!          HT.Length := HT.Length - 1;
  
!          declare
!             X : Node_Access := Position.Node;
  
!          begin
!             Free (X);
           end;
  
!          raise Program_Error;
!       end Update_Element_Preserving_Key;
  
     end Generic_Keys;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cohase.ads gcc-4.1.0/gcc/ada/a-cohase.ads
*** gcc-4.0.2/gcc/ada/a-cohase.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cohase.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.CONTAINERS.HASHED_SETS                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . H A S H E D _ S E T S            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,55 ****
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
  
  generic
     type Element_Type is private;
  
     with function Hash (Element : Element_Type) return Hash_Type;
  
!    --  TODO: get a ruling from ARG in Atlanta re the name and
!    --  order of these declarations. ???
!    --
!    with function Equivalent_Keys (Left, Right : Element_Type) return Boolean;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Hashed_Sets is
! pragma Preelaborate (Hashed_Sets);
  
     type Set is tagged private;
  
--- 35,54 ----
  
  with Ada.Containers.Hash_Tables;
  with Ada.Streams;
+ with Ada.Finalization;
  
  generic
     type Element_Type is private;
  
     with function Hash (Element : Element_Type) return Hash_Type;
  
!    with function Equivalent_Elements (Left, Right : Element_Type)
!                                      return Boolean;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Hashed_Sets is
!    pragma Preelaborate;
  
     type Set is tagged private;
  
*************** pragma Preelaborate (Hashed_Sets);
*** 61,66 ****
--- 60,75 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
+    function Capacity (Container : Set) return Count_Type;
+ 
+    procedure Reserve_Capacity
+      (Container : in out Set;
+       Capacity  : Count_Type);
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** pragma Preelaborate (Hashed_Sets);
*** 69,84 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
-    --  TODO: resolve in atlanta
-    --   procedure Replace_Element
-    --     (Container : in out Set;
-    --      Position  : Cursor;
-    --      By        : Element_Type);
- 
     procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
--- 78,92 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
*************** pragma Preelaborate (Hashed_Sets);
*** 93,102 ****
  
     procedure Replace (Container : in out Set; New_Item : Element_Type);
  
-    procedure Delete  (Container : in out Set; Item     : Element_Type);
- 
     procedure Exclude (Container : in out Set; Item     : Element_Type);
  
     procedure Delete (Container : in out Set; Position  : in out Cursor);
  
     procedure Union (Target : in out Set; Source : Set);
--- 101,110 ----
  
     procedure Replace (Container : in out Set; New_Item : Element_Type);
  
     procedure Exclude (Container : in out Set; Item     : Element_Type);
  
+    procedure Delete  (Container : in out Set; Item     : Element_Type);
+ 
     procedure Delete (Container : in out Set; Position  : in out Cursor);
  
     procedure Union (Target : in out Set; Source : Set);
*************** pragma Preelaborate (Hashed_Sets);
*** 128,160 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
-    function Contains (Container : Set; Item : Element_Type) return Boolean;
- 
-    function Find
-      (Container : Set;
-       Item      : Element_Type) return Cursor;
- 
-    function Capacity (Container : Set) return Count_Type;
- 
-    procedure Reserve_Capacity
-      (Container : in out Set;
-       Capacity  : Count_Type);
- 
     function First (Container : Set) return Cursor;
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
!    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
  
!    function Equivalent_Keys
       (Left  : Cursor;
        Right : Element_Type) return Boolean;
  
!    function Equivalent_Keys
       (Left  : Element_Type;
        Right : Cursor) return Boolean;
  
--- 136,162 ----
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
     function First (Container : Set) return Cursor;
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
+    function Find
+      (Container : Set;
+       Item      : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
!    function Equivalent_Elements (Left, Right : Cursor) return Boolean;
  
!    function Equivalent_Elements
       (Left  : Cursor;
        Right : Element_Type) return Boolean;
  
!    function Equivalent_Elements
       (Left  : Element_Type;
        Right : Cursor) return Boolean;
  
*************** pragma Preelaborate (Hashed_Sets);
*** 163,242 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
        with function Hash (Key : Key_Type) return Hash_Type;
  
!       with function Equivalent_Keys
!         (Key     : Key_Type;
!          Element : Element_Type) return Boolean;
  
     package Generic_Keys is
  
-       function Contains (Container : Set; Key : Key_Type) return Boolean;
- 
-       function Find (Container : Set; Key : Key_Type) return Cursor;
- 
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       --  TODO: resolve in atlanta
!       --      procedure Replace
!       --        (Container : in out Set;
!       --         Key       : Key_Type;
!       --         New_Item  : Element_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       --  TODO: resolve name in atlanta: ???
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
                         procedure (Element : in out Element_Type));
  
-       function Equivalent_Keys
-         (Left  : Cursor;
-          Right : Key_Type) return Boolean;
- 
-       function Equivalent_Keys
-         (Left  : Key_Type;
-          Right : Cursor) return Boolean;
- 
     end Generic_Keys;
  
  private
- 
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package HT_Types is
!      new Hash_Tables.Generic_Hash_Table_Types (Node_Access);
  
!    use HT_Types;
  
!    type Set is new Hash_Table_Type with null record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set);
  
!    type Set_Access is access constant Set;
     for Set_Access'Storage_Size use 0;
  
!    type Cursor is record
!       Container : Set_Access;
!       Node      : Node_Access;
!    end record;
  
!    No_Element : constant Cursor := (Container => null, Node => null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 165,253 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
        with function Hash (Key : Key_Type) return Hash_Type;
  
!       with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
     package Generic_Keys is
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       procedure Replace          --  TODO: ask Randy why this wasn't removed
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type);
! 
!       procedure Exclude (Container : in out Set; Key : Key_Type);
  
        procedure Delete (Container : in out Set; Key : Key_Type);
  
!       function Find (Container : Set; Key : Key_Type) return Cursor;
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
                         procedure (Element : in out Element_Type));
  
     end Generic_Keys;
  
  private
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Node_Type is
!       limited record
!          Element : Element_Type;
!          Next    : Node_Access;
!       end record;
  
!    package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
!      (Node_Type,
!       Node_Access);
  
!    type Set is new Ada.Finalization.Controlled with record
!       HT : HT_Types.Hash_Table_Type;
!    end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set);
  
!    use HT_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
     for Set_Access'Storage_Size use 0;
  
!    type Cursor is
!       record
!          Container : Set_Access;
!          Node      : Node_Access;
!       end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := (Container => null, Node => null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 250,255 ****
  
     for Set'Read use Read;
  
!    Empty_Set : constant Set := (Hash_Table_Type with null record);
  
  end Ada.Containers.Hashed_Sets;
--- 261,266 ----
  
     for Set'Read use Read;
  
!    Empty_Set : constant Set := (Controlled with HT => (null, 0, 0, 0));
  
  end Ada.Containers.Hashed_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cohata.ads gcc-4.1.0/gcc/ada/a-cohata.ads
*** gcc-4.0.2/gcc/ada/a-cohata.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-cohata.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,34 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.CONTAINERS.HASH_TABLES                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! -- This specification is adapted from the Ada Reference Manual for use with --
! -- GNAT.  In accordance with the copyright of that document, you can freely --
! -- copy and modify this specification,  provided that if you redistribute a --
! -- modified version,  any changes that you have made are clearly indicated. --
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Ada.Finalization;
- 
  package Ada.Containers.Hash_Tables is
! pragma Preelaborate;
  
     generic
!       type Node_Access is private;
  
     package Generic_Hash_Table_Types is
        type Buckets_Type is array (Hash_Type range <>) of Node_Access;
  
        type Buckets_Access is access Buckets_Type;
  
!       type Hash_Table_Type is new Ada.Finalization.Controlled with record
           Buckets : Buckets_Access;
           Length  : Count_Type := 0;
        end record;
     end Generic_Hash_Table_Types;
  
--- 2,56 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --            A D A . C O N T A I N E R S . H A S H _ T A B L E S           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- This specification is derived from the Ada Reference Manual for use with --
! -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the  contents of the part following the private keyword. --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
  package Ada.Containers.Hash_Tables is
!    pragma Preelaborate;
  
     generic
!       type Node_Type (<>) is limited private;
! 
!       type Node_Access is access Node_Type;
  
     package Generic_Hash_Table_Types is
        type Buckets_Type is array (Hash_Type range <>) of Node_Access;
  
        type Buckets_Access is access Buckets_Type;
  
!       type Hash_Table_Type is tagged record
           Buckets : Buckets_Access;
           Length  : Count_Type := 0;
+          Busy    : Natural := 0;
+          Lock    : Natural := 0;
        end record;
     end Generic_Hash_Table_Types;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coinve.adb gcc-4.1.0/gcc/ada/a-coinve.adb
*** gcc-4.0.2/gcc/ada/a-coinve.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coinve.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.INDEFINITE_VECTORS                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . C O N T A I N E R S . I N D E F I N I T E _ V E C T O R S     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;  use type System.Address;
*** 39,269 ****
  
  package body Ada.Containers.Indefinite_Vectors is
  
- 
     type Int is range System.Min_Int .. System.Max_Int;
  
     procedure Free is
!       new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
  
     procedure Free is
!       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
! 
! 
!    procedure Adjust (Container : in out Vector) is
!    begin
! 
!       if Container.Elements = null then
!          return;
!       end if;
  
!       if Container.Elements'Length = 0
!         or else Container.Last < Index_Type'First
!       then
!          Container.Elements := null;
!          return;
!       end if;
  
!       declare
!          E : Elements_Type renames Container.Elements.all;
!          L : constant Index_Type := Container.Last;
!       begin
  
!          Container.Elements := null;
!          Container.Last := Index_Type'Pred (Index_Type'First);
  
!          Container.Elements := new Elements_Type (Index_Type'First .. L);
  
!          for I in Container.Elements'Range loop
  
!             if E (I) /= null then
!                Container.Elements (I) := new Element_Type'(E (I).all);
!             end if;
  
!             Container.Last := I;
  
!          end loop;
  
!       end;
  
!    end Adjust;
  
  
!    procedure Finalize (Container : in out Vector) is
  
!       E : Elements_Access := Container.Elements;
!       L : constant Index_Type'Base := Container.Last;
  
!    begin
  
!       Container.Elements := null;
!       Container.Last := Index_Type'Pred (Index_Type'First);
  
!       for I in Index_Type'First .. L loop
!          Free (E (I));
!       end loop;
  
!       Free (E);
  
!    end Finalize;
  
  
!    procedure Write
!      (Stream    : access Root_Stream_Type'Class;
!       Container : in     Vector) is
  
!       N : constant Count_Type := Length (Container);
  
!    begin
  
!       Count_Type'Base'Write (Stream, N);
  
!       if N = 0 then
!          return;
!       end if;
  
!       declare
!          E : Elements_Type renames Container.Elements.all;
!       begin
!          for I in Index_Type'First .. Container.Last loop
  
!             --  There's another way to do this.  Instead a separate
!             --  Boolean for each element, you could write a Boolean
!             --  followed by a count of how many nulls or non-nulls
!             --  follow in the array.  Alternately you could use a
!             --  signed integer, and use the sign as the indicator
!             --  or null-ness.
  
!             if E (I) = null then
!                Boolean'Write (Stream, False);
!             else
!                Boolean'Write (Stream, True);
!                Element_Type'Output (Stream, E (I).all);
!             end if;
  
!          end loop;
        end;
  
!    end Write;
! 
! 
!    procedure Read
!      (Stream    : access Root_Stream_Type'Class;
!       Container :    out Vector) is
! 
!       Length : Count_Type'Base;
!       Last   : Index_Type'Base := Index_Type'Pred (Index_Type'First);
! 
!       B : Boolean;
  
     begin
  
!       Clear (Container);
  
!       Count_Type'Base'Read (Stream, Length);
  
!       if Length > Capacity (Container) then
!          Reserve_Capacity (Container, Capacity => Length);
        end if;
  
!       for I in Count_Type range 1 .. Length loop
! 
!          Last := Index_Type'Succ (Last);
! 
!          Boolean'Read (Stream, B);
  
!          if B then
!             Container.Elements (Last) :=
!               new Element_Type'(Element_Type'Input (Stream));
           end if;
  
!          Container.Last := Last;
! 
!       end loop;
! 
!    end Read;
! 
! 
!    function To_Vector (Length : Count_Type) return Vector is
!    begin
! 
!       if Length = 0 then
!          return Empty_Vector;
!       end if;
! 
!       declare
  
!          First : constant Int := Int (Index_Type'First);
  
!          Last_As_Int : constant Int'Base :=
!            First + Int (Length) - 1;
  
!          Last : constant Index_Type :=
!            Index_Type (Last_As_Int);
  
!          Elements : constant Elements_Access :=
!            new Elements_Type (Index_Type'First .. Last);
  
!       begin
  
!          return (Controlled with Elements, Last);
  
        end;
  
!    end To_Vector;
! 
  
  
!    function To_Vector
!      (New_Item : Element_Type;
!       Length   : Count_Type) return Vector is
  
!    begin
  
!       if Length = 0 then
!          return Empty_Vector;
        end if;
  
        declare
- 
-          First : constant Int := Int (Index_Type'First);
- 
           Last_As_Int : constant Int'Base :=
!            First + Int (Length) - 1;
  
!          Last : constant Index_Type :=
!            Index_Type (Last_As_Int);
  
!          Elements : Elements_Access :=
!            new Elements_Type (Index_Type'First .. Last);
  
!       begin
  
!          for I in Elements'Range loop
  
              begin
!                Elements (I) := new Element_Type'(New_Item);
              exception
                 when others =>
-                   for J in Index_Type'First .. Index_Type'Pred (I) loop
-                      Free (Elements (J));
-                   end loop;
- 
                    Free (Elements);
                    raise;
              end;
  
!          end loop;
  
!          return (Controlled with Elements, Last);
  
        end;
  
!    end To_Vector;
  
  
     function "=" (Left, Right : Vector) return Boolean is
     begin
- 
        if Left'Address = Right'Address then
           return True;
        end if;
--- 39,381 ----
  
  package body Ada.Containers.Indefinite_Vectors is
  
     type Int is range System.Min_Int .. System.Max_Int;
  
     procedure Free is
!      new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
  
     procedure Free is
!      new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
  
!    ---------
!    -- "&" --
!    ---------
  
!    function "&" (Left, Right : Vector) return Vector is
!       LN : constant Count_Type := Length (Left);
!       RN : constant Count_Type := Length (Right);
  
!    begin
!       if LN = 0 then
!          if RN = 0 then
!             return Empty_Vector;
!          end if;
  
!          declare
!             RE : Elements_Type renames
!                    Right.Elements (Index_Type'First .. Right.Last);
  
!             Elements : Elements_Access :=
!                          new Elements_Type (RE'Range);
  
!          begin
!             for I in Elements'Range loop
!                begin
!                   if RE (I) /= null then
!                      Elements (I) := new Element_Type'(RE (I).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             return (Controlled with Elements, Right.Last, 0, 0);
!          end;
  
!       end if;
  
!       if RN = 0 then
!          declare
!             LE : Elements_Type renames
!                    Left.Elements (Index_Type'First .. Left.Last);
  
+             Elements : Elements_Access :=
+                          new Elements_Type (LE'Range);
  
!          begin
!             for I in Elements'Range loop
!                begin
!                   if LE (I) /= null then
!                      Elements (I) := new Element_Type'(LE (I).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             return (Controlled with Elements, Left.Last, 0, 0);
!          end;
!       end if;
  
!       declare
!          Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
!                          Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             LE : Elements_Type renames
!                    Left.Elements (Index_Type'First .. Left.Last);
  
+             RE : Elements_Type renames
+                    Right.Elements (Index_Type'First .. Right.Last);
  
!             Elements : Elements_Access :=
!                          new Elements_Type (Index_Type'First .. Last);
  
!             I : Index_Type'Base := No_Index;
  
!          begin
!             for LI in LE'Range loop
!                I := I + 1;
  
!                begin
!                   if LE (LI) /= null then
!                      Elements (I) := new Element_Type'(LE (LI).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             for RI in RE'Range loop
!                I := I + 1;
  
!                begin
!                   if RE (RI) /= null then
!                      Elements (I) := new Element_Type'(RE (RI).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             return (Controlled with Elements, Last, 0, 0);
!          end;
        end;
+    end "&";
  
!    function "&" (Left : Vector; Right : Element_Type) return Vector is
!       LN : constant Count_Type := Length (Left);
  
     begin
+       if LN = 0 then
+          declare
+             subtype Elements_Subtype is
+               Elements_Type (Index_Type'First .. Index_Type'First);
  
!             Elements : Elements_Access := new Elements_Subtype;
  
!          begin
!             begin
!                Elements (Elements'First) := new Element_Type'(Right);
!             exception
!                when others =>
!                   Free (Elements);
!                   raise;
!             end;
  
!             return (Controlled with Elements, Index_Type'First, 0, 0);
!          end;
        end if;
  
!       declare
!          Last_As_Int : constant Int'Base :=
!                          Int (Index_Type'First) + Int (LN);
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
           end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             LE : Elements_Type renames
!                    Left.Elements (Index_Type'First .. Left.Last);
  
!             Elements : Elements_Access :=
!                         new Elements_Type (Index_Type'First .. Last);
  
!          begin
!             for I in LE'Range loop
!                begin
!                   if LE (I) /= null then
!                      Elements (I) := new Element_Type'(LE (I).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             begin
!                Elements (Elements'Last) := new Element_Type'(Right);
!             exception
!                when others =>
!                   for J in Index_Type'First .. Elements'Last - 1 loop
!                      Free (Elements (J));
!                   end loop;
  
!                   Free (Elements);
!                   raise;
!             end;
  
+             return (Controlled with Elements, Last, 0, 0);
+          end;
        end;
+    end "&";
  
!    function "&" (Left : Element_Type; Right : Vector) return Vector is
!       RN : constant Count_Type := Length (Right);
  
+    begin
+       if RN = 0 then
+          declare
+             subtype Elements_Subtype is
+               Elements_Type (Index_Type'First .. Index_Type'First);
  
!             Elements : Elements_Access := new Elements_Subtype;
  
!          begin
!             begin
!                Elements (Elements'First) := new Element_Type'(Left);
!             exception
!                when others =>
!                   Free (Elements);
!                   raise;
!             end;
  
!             return (Controlled with Elements, Index_Type'First, 0, 0);
!          end;
        end if;
  
        declare
           Last_As_Int : constant Int'Base :=
!                          Int (Index_Type'First) + Int (RN);
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             RE : Elements_Type renames
!                    Right.Elements (Index_Type'First .. Right.Last);
  
!             Elements : Elements_Access :=
!                          new Elements_Type (Index_Type'First .. Last);
  
+             I : Index_Type'Base := Index_Type'First;
+ 
+          begin
              begin
!                Elements (I) := new Element_Type'(Left);
              exception
                 when others =>
                    Free (Elements);
                    raise;
              end;
  
!             for RI in RE'Range loop
!                I := I + 1;
  
!                begin
!                   if RE (RI) /= null then
!                      Elements (I) := new Element_Type'(RE (RI).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. I - 1 loop
!                         Free (Elements (J));
!                      end loop;
  
+                      Free (Elements);
+                      raise;
+                end;
+             end loop;
+ 
+             return (Controlled with Elements, Last, 0, 0);
+          end;
        end;
+    end "&";
  
!    function "&" (Left, Right : Element_Type) return Vector is
!    begin
!       if Index_Type'First >= Index_Type'Last then
!          raise Constraint_Error;
!       end if;
! 
!       declare
!          Last : constant Index_Type := Index_Type'First + 1;
! 
!          subtype ET is Elements_Type (Index_Type'First .. Last);
! 
!          Elements : Elements_Access := new ET;
!       begin
!          begin
!             Elements (Elements'First) := new Element_Type'(Left);
!          exception
!             when others =>
!                Free (Elements);
!                raise;
!          end;
! 
!          begin
!             Elements (Elements'Last) := new Element_Type'(Right);
!          exception
!             when others =>
!                Free (Elements (Elements'First));
!                Free (Elements);
!                raise;
!          end;
! 
!          return (Controlled with Elements, Elements'Last, 0, 0);
!       end;
!    end "&";
  
+    ---------
+    -- "=" --
+    ---------
  
     function "=" (Left, Right : Vector) return Boolean is
     begin
        if Left'Address = Right'Address then
           return True;
        end if;
*************** package body Ada.Containers.Indefinite_V
*** 272,2171 ****
           return False;
        end if;
  
!       for I in Index_Type'First .. Left.Last loop
! 
!          --  NOTE:
!          --  I think it's a bounded error to read or otherwise manipulate
!          --  an "empty" element, which here means that it has the value
!          --  null.  If it's a bounded error then an exception might
!          --  propagate, or it might not.  We take advantage of that
!          --  permission here to allow empty elements to be compared.
!          --
!          --  Whether this is the right decision I'm not really sure.  If
!          --  you have a contrary argument then let me know.
!          --  END NOTE.
! 
!          if Left.Elements (I) = null then
! 
!             if Right.Elements (I) /= null then
                 return False;
              end if;
  
!          elsif Right.Elements (I) = null then
! 
              return False;
  
!          elsif Left.Elements (I).all /= Right.Elements (I).all then
! 
              return False;
- 
           end if;
- 
        end loop;
  
        return True;
- 
     end "=";
  
  
!    function Length (Container : Vector) return Count_Type is
! 
!       L : constant Int := Int (Container.Last);
!       F : constant Int := Int (Index_Type'First);
! 
!       N : constant Int'Base := L - F + 1;
!    begin
!       return Count_Type (N);
!    end Length;
! 
! 
!    function Is_Empty (Container : Vector) return Boolean is
!    begin
!       return Container.Last < Index_Type'First;
!    end Is_Empty;
! 
! 
!    procedure Set_Length
!      (Container : in out Vector;
!       Length    : in     Count_Type) is
! 
!       N : constant Count_Type := Indefinite_Vectors.Length (Container);
! 
     begin
! 
!       if Length = N then
!          return;
!       end if;
! 
!       if Length = 0 then
!          Clear (Container);
           return;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=
!            Int (Index_Type'First) + Int (Length) - 1;
  
-          Last : constant Index_Type :=
-            Index_Type (Last_As_Int);
        begin
  
!          if Length > N then
  
!             if Length > Capacity (Container) then
!                Reserve_Capacity (Container, Capacity => Length);
              end if;
  
!             Container.Last := Last;
! 
!             return;
! 
!          end if;
! 
!          for I in reverse Index_Type'Succ (Last) .. Container.Last loop
! 
!             declare
!                X : Element_Access := Container.Elements (I);
!             begin
!                Container.Elements (I) := null;
!                Container.Last := Index_Type'Pred (Container.Last);
!                Free (X);
!             end;
! 
           end loop;
- 
        end;
  
!    end Set_Length;
! 
  
!    procedure Clear (Container : in out Vector) is
     begin
  
!       for I in reverse Index_Type'First .. Container.Last loop
! 
!          declare
!             X : Element_Access := Container.Elements (I);
!          begin
!             Container.Elements (I) := null;
!             Container.Last := Index_Type'Pred (I);
!             Free (X);
!          end;
! 
!       end loop;
! 
!    end Clear;
  
  
!    procedure Append (Container : in out Vector;
!                      New_Item  : in     Element_Type;
!                      Count     : in     Count_Type := 1) is
     begin
        if Count = 0 then
           return;
        end if;
  
        Insert
          (Container,
!          Index_Type'Succ (Container.Last),
           New_Item,
           Count);
     end Append;
  
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : in     Extended_Index;
!       New_Item  : in     Element_Type;
!       Count     : in     Count_Type := 1) is
! 
!       Old_Last_As_Int : constant Int := Int (Container.Last);
! 
!       N : constant Int := Int (Count);
! 
!       New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
! 
!       New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
! 
!       Index : Index_Type;
! 
!       Dst_Last : Index_Type;
!       Dst      : Elements_Access;
! 
     begin
! 
!       if Count = 0 then
!          return;
        end if;
  
!       declare
!          subtype Before_Subtype is Index_Type'Base range
!            Index_Type'First .. Index_Type'Succ (Container.Last);
! 
!          Old_First : constant Before_Subtype := Before;
! 
!          Old_First_As_Int : constant Int := Int (Old_First);
  
!          New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
!       begin
!          Index := Index_Type (New_First_As_Int);
!       end;
  
!       if Container.Elements = null then
  
           declare
!             subtype Elements_Subtype is
!               Elements_Type (Index_Type'First .. New_Last);
           begin
!             Container.Elements := new Elements_Subtype;
!             Container.Last := Index_Type'Pred (Index_Type'First);
! 
!             for I in Container.Elements'Range loop
!                Container.Elements (I) := new Element_Type'(New_Item);
!                Container.Last := I;
!             end loop;
           end;
  
!          return;
! 
!       end if;
! 
!       if New_Last <= Container.Elements'Last then
! 
!          declare
!             E : Elements_Type renames Container.Elements.all;
!          begin
!             E (Index .. New_Last) := E (Before .. Container.Last);
!             Container.Last := New_Last;
  
!             --  NOTE:
!             --  Now we do the allocation.  If it fails, we can propagate the
!             --  exception and invariants are more or less satisfied.  The
!             --  issue is that we have some slots still null, and the client
!             --  has no way of detecting whether the slot is null (unless we
!             --  give him a way).
!             --
!             --  Another way is to allocate a subarray on the stack, do the
!             --  allocation into that array, and if that success then do
!             --  the insertion proper.  The issue there is that you have to
!             --  allocate the subarray on the stack, and that may fail if the
!             --  subarray is long.
!             --
!             --  Or we could try to roll-back the changes: deallocate the
!             --  elements we have successfully deallocated, and then copy
!             --  the elements ptrs back to their original posns.
!             --  END NOTE.
  
!             --  NOTE: I have written the loop manually here.  I could
!             --  have done it this way too:
!             --    E (Before .. Index_Type'Pred (Index)) :=
!             --      (others => new Element_Type'New_Item);
!             --  END NOTE.
  
!             for I in Before .. Index_Type'Pred (Index) loop
  
!                begin
!                   E (I) := new Element_Type'(New_Item);
!                exception
!                   when others =>
!                      E (I .. Index_Type'Pred (Index)) := (others => null);
!                      raise;
!                end;
  
!             end loop;
!          end;
  
           return;
  
        end if;
  
        declare
  
!          First : constant Int := Int (Index_Type'First);
! 
!          New_Size : constant Int'Base :=
!            New_Last_As_Int - First + 1;
! 
!          Max_Size : constant Int'Base :=
!            Int (Index_Type'Last) - First + 1;
  
!          Size, Dst_Last_As_Int : Int'Base;
  
        begin
  
!          if New_Size >= Max_Size / 2 then
! 
!             Dst_Last := Index_Type'Last;
  
           else
  
!             Size := Container.Elements'Length;
! 
!             if Size = 0 then
!                Size := 1;
!             end if;
! 
!             while Size < New_Size loop
!                Size := 2 * Size;
!             end loop;
  
!             Dst_Last_As_Int := First + Size - 1;
!             Dst_Last := Index_Type (Dst_Last_As_Int);
  
           end if;
- 
        end;
  
!       Dst := new Elements_Type (Index_Type'First .. Dst_Last);
! 
!       declare
!          Src : Elements_Type renames Container.Elements.all;
!       begin
!          Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
!            Src (Index_Type'First .. Index_Type'Pred (Before));
! 
!          Dst (Index .. New_Last) := Src (Before .. Container.Last);
!       end;
! 
!       declare
!          X : Elements_Access := Container.Elements;
!       begin
!          Container.Elements := Dst;
!          Container.Last := New_Last;
! 
!          Free (X);
!       end;
! 
!       --  NOTE:
!       --  Now do the allocation.  If the allocation fails,
!       --  then the worst thing is that we have a few null slots.
!       --  Our invariants are otherwise satisfied.
!       --  END NOTE.
! 
!       for I in Before .. Index_Type'Pred (Index) loop
!          Dst (I) := new Element_Type'(New_Item);
!       end loop;
! 
!    end Insert;
! 
! 
!    procedure Insert_Space
       (Container : in out Vector;
!       Before    : in     Extended_Index;
!       Count     : in     Count_Type := 1) is
! 
!       Old_Last_As_Int : constant Int := Int (Container.Last);
! 
!       N : constant Int := Int (Count);
  
!       New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
  
!       New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
  
!       Index : Index_Type;
  
!       Dst_Last : Index_Type;
!       Dst      : Elements_Access;
  
     begin
- 
        if Count = 0 then
           return;
        end if;
  
!       declare
!          subtype Before_Subtype is Index_Type'Base range
!            Index_Type'First .. Index_Type'Succ (Container.Last);
! 
!          Old_First : constant Before_Subtype := Before;
! 
!          Old_First_As_Int : constant Int := Int (Old_First);
! 
!          New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
!       begin
!          Index := Index_Type (New_First_As_Int);
!       end;
! 
!       if Container.Elements = null then
! 
!          declare
!             subtype Elements_Subtype is
!               Elements_Type (Index_Type'First .. New_Last);
!          begin
!             Container.Elements := new Elements_Subtype;
!             Container.Last := New_Last;
!          end;
! 
           return;
- 
        end if;
  
!       if New_Last <= Container.Elements'Last then
  
!          declare
!             E : Elements_Type renames Container.Elements.all;
!          begin
!             E (Index .. New_Last) := E (Before .. Container.Last);
!             E (Before .. Index_Type'Pred (Index)) := (others => null);
  
!             Container.Last := New_Last;
!          end;
  
           return;
  
        end if;
  
        declare
! 
!          First : constant Int := Int (Index_Type'First);
! 
!          New_Size : constant Int'Base :=
!            Int (New_Last_As_Int) - First + 1;
! 
!          Max_Size : constant Int'Base :=
!            Int (Index_Type'Last) - First + 1;
! 
!          Size, Dst_Last_As_Int : Int'Base;
  
        begin
  
!          if New_Size >= Max_Size / 2 then
! 
!             Dst_Last := Index_Type'Last;
! 
!          else
! 
!             Size := Container.Elements'Length;
  
!             if Size = 0 then
!                Size := 1;
!             end if;
  
!             while Size < New_Size loop
!                Size := 2 * Size;
!             end loop;
  
!             Dst_Last_As_Int := First + Size - 1;
!             Dst_Last := Index_Type (Dst_Last_As_Int);
  
           end if;
  
        end;
  
!       Dst := new Elements_Type (Index_Type'First .. Dst_Last);
  
!       declare
!          Src : Elements_Type renames Container.Elements.all;
!       begin
!          Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
!            Src (Index_Type'First .. Index_Type'Pred (Before));
  
!          Dst (Index .. New_Last) := Src (Before .. Container.Last);
!       end;
  
        declare
           X : Elements_Access := Container.Elements;
        begin
!          Container.Elements := Dst;
!          Container.Last := New_Last;
! 
           Free (X);
        end;
  
!    end Insert_Space;
  
  
!    procedure Delete_First (Container : in out Vector;
!                            Count     : in     Count_Type := 1) is
     begin
  
!       if Count = 0 then
!          return;
!       end if;
  
!       if Count >= Length (Container) then
!          Clear (Container);
!          return;
!       end if;
  
!       Delete (Container, Index_Type'First, Count);
  
!    end Delete_First;
  
  
!    procedure Delete_Last (Container : in out Vector;
!                           Count     : in     Count_Type := 1) is
  
!       Index : Int'Base;
  
     begin
  
!       if Count = 0 then
!          return;
!       end if;
  
!       if Count >= Length (Container) then
!          Clear (Container);
!          return;
!       end if;
  
!       Index := Int'Base (Container.Last) - Int'Base (Count) + 1;
  
!       Delete (Container, Index_Type'Base (Index), Count);
  
!    end Delete_Last;
  
  
!    procedure Delete
!      (Container : in out Vector;
!       Index     : in     Extended_Index;  --  TODO: verify in Atlanta
!       Count     : in     Count_Type := 1) is
  
!    begin
  
!       if Count = 0 then
!          return;
!       end if;
  
!       declare
  
!          subtype I_Subtype is Index_Type'Base range
!            Index_Type'First .. Container.Last;
  
!          I : constant I_Subtype := Index;
!          I_As_Int : constant Int := Int (I);
  
!          Old_Last_As_Int : constant Int := Int (Container.Last);
  
!          Count1 : constant Int'Base := Int (Count);
!          Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
  
!          N : constant Int'Base := Int'Min (Count1, Count2);
  
!          J_As_Int : constant Int'Base := I_As_Int + N;
!          J : constant Index_Type'Base := Index_Type'Base (J_As_Int);
  
!          E : Elements_Type renames Container.Elements.all;
  
!          New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
  
!          New_Last : constant Extended_Index :=
!            Extended_Index (New_Last_As_Int);
  
!       begin
  
!          for K in I .. Index_Type'Pred (J) loop
  
              begin
!                Free (E (K));
!             exception
!                when others =>
!                   E (K) := null;
!                   raise;
              end;
  
           end loop;
  
!          E (I .. New_Last) := E (J .. Container.Last);
!          Container.Last := New_Last;
! 
!       end;
  
!    end Delete;
  
  
!    function Capacity (Container : Vector) return Count_Type is
!    begin
!       if Container.Elements = null then
!          return 0;
!       end if;
  
!       return Container.Elements'Length;
!    end Capacity;
  
  
!    procedure Reserve_Capacity (Container : in out Vector;
!                                Capacity  : in     Count_Type) is
  
!       N : constant Count_Type := Length (Container);
  
     begin
  
!       if Capacity = 0 then
  
!          if N = 0 then
  
!             declare
!                X : Elements_Access := Container.Elements;
!             begin
!                Container.Elements := null;
!                Free (X);
!             end;
  
!          elsif N < Container.Elements'Length then
  
!             declare
!                subtype Array_Index_Subtype is Index_Type'Base range
!                  Index_Type'First .. Container.Last;
  
!                Src : Elements_Type renames
!                  Container.Elements (Array_Index_Subtype);
  
!                subtype Array_Subtype is
!                  Elements_Type (Array_Index_Subtype);
  
!                X : Elements_Access := Container.Elements;
!             begin
!                Container.Elements := new Array_Subtype'(Src);
!                Free (X);
!             end;
  
           end if;
  
!          return;
  
        end if;
  
        if Container.Elements = null then
  
!          declare
!             Last_As_Int : constant Int'Base :=
!               Int (Index_Type'First) + Int (Capacity) - 1;
! 
!             Last : constant Index_Type :=
!               Index_Type (Last_As_Int);
  
!             subtype Array_Subtype is
!               Elements_Type (Index_Type'First .. Last);
!          begin
!             Container.Elements := new Array_Subtype;
!          end;
  
           return;
- 
        end if;
  
!       if Capacity <= N then
! 
!          if N < Container.Elements'Length then
! 
!             declare
!                subtype Array_Index_Subtype is Index_Type'Base range
!                  Index_Type'First .. Container.Last;
! 
!                Src : Elements_Type renames
!                  Container.Elements (Array_Index_Subtype);
  
!                subtype Array_Subtype is
!                  Elements_Type (Array_Index_Subtype);
  
!                X : Elements_Access := Container.Elements;
!             begin
!                Container.Elements := new Array_Subtype'(Src);
!                Free (X);
!             end;
  
!          end if;
  
!          return;
  
!       end if;
  
-       if Capacity = Container.Elements'Length then
           return;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=
!            Int (Index_Type'First) + Int (Capacity) - 1;
  
!          Last : constant Index_Type :=
!            Index_Type (Last_As_Int);
  
!          subtype Array_Subtype is
!            Elements_Type (Index_Type'First .. Last);
  
!          X : Elements_Access := Container.Elements;
!       begin
!          Container.Elements := new Array_Subtype;
  
           declare
!             Src : Elements_Type renames
!               X (Index_Type'First .. Container.Last);
! 
!             Tgt : Elements_Type renames
!               Container.Elements (Index_Type'First .. Container.Last);
           begin
!             Tgt := Src;
           end;
  
!          Free (X);
        end;
  
!    end Reserve_Capacity;
  
  
!    function First_Index (Container : Vector) return Index_Type is
!       pragma Warnings (Off, Container);
!    begin
!       return Index_Type'First;
!    end First_Index;
  
  
!    function First_Element (Container : Vector) return Element_Type is
!    begin
!       return Element (Container, Index_Type'First);
!    end First_Element;
  
  
!    function Last_Index (Container : Vector) return Extended_Index is
!    begin
!       return Container.Last;
!    end Last_Index;
  
  
!    function Last_Element (Container : Vector) return Element_Type is
!    begin
!       return Element (Container, Container.Last);
!    end Last_Element;
  
  
!    function Element (Container : Vector;
!                      Index     : Index_Type)
!       return Element_Type is
  
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Container.Last;
     begin
!       return Container.Elements (T'(Index)).all;
!    end Element;
  
  
!    procedure Replace_Element (Container : in Vector;
!                               Index     : in Index_Type;
!                               By        : in Element_Type) is
  
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
  
!       X : Element_Access := Container.Elements (T'(Index));
!    begin
!       Container.Elements (T'(Index)) := new Element_Type'(By);
!       Free (X);
!    end Replace_Element;
  
  
!    procedure Generic_Sort (Container : in Vector) is
  
!       function Is_Less (L, R : Element_Access) return Boolean;
!       pragma Inline (Is_Less);
  
-       function Is_Less (L, R : Element_Access) return Boolean is
        begin
!          if L = null then
!             return R /= null;
!          elsif R = null then
!             return False;
!          else
!             return L.all < R.all;
!          end if;
!       end Is_Less;
! 
!       procedure Sort is
!          new Generic_Array_Sort
!           (Index_Type,
!            Element_Access,
!            Elements_Type,
!            "<" => Is_Less);
  
!    begin
  
!       if Container.Elements = null then
!          return;
!       end if;
  
!       Sort (Container.Elements (Index_Type'First .. Container.Last));
  
!    end Generic_Sort;
  
  
!    function Find_Index
!      (Container : Vector;
!       Item      : Element_Type;
!       Index     : Index_Type := Index_Type'First)
!      return Extended_Index is
  
!    begin
  
!       for I in Index .. Container.Last loop
!          if Container.Elements (I) /= null
!            and then Container.Elements (I).all = Item
!          then
!             return I;
           end if;
-       end loop;
  
!       return No_Index;
  
!    end Find_Index;
  
  
!    function Reverse_Find_Index
!      (Container : Vector;
!       Item      : Element_Type;
!       Index     : Index_Type := Index_Type'Last)
!      return Extended_Index is
  
!       Last : Index_Type'Base;
  
     begin
  
!       if Index > Container.Last then
!          Last := Container.Last;
!       else
!          Last := Index;
        end if;
  
!       for I in reverse Index_Type'First .. Last loop
!          if Container.Elements (I) /= null
!            and then Container.Elements (I).all = Item
!          then
!             return I;
           end if;
-       end loop;
- 
-       return No_Index;
- 
-    end Reverse_Find_Index;
- 
- 
-    function Contains (Container : Vector;
-                       Item      : Element_Type) return Boolean is
-    begin
-       return Find_Index (Container, Item) /= No_Index;
-    end Contains;
  
  
  
!    procedure Assign
!      (Target : in out Vector;
!       Source : in     Vector) is
  
!       N : constant Count_Type := Length (Source);
  
     begin
! 
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       Clear (Target);
  
-       if N = 0 then
           return;
        end if;
  
!       if N > Capacity (Target) then
!          Reserve_Capacity (Target, Capacity => N);
!       end if;
! 
!       for I in Index_Type'First .. Source.Last loop
! 
!          declare
!             EA : constant Element_Access := Source.Elements (I);
!          begin
!             if EA /= null then
!                Target.Elements (I) := new Element_Type'(EA.all);
!             end if;
!          end;
! 
!          Target.Last := I;
  
!       end loop;
  
!    end Assign;
  
  
!    procedure Move
!      (Target : in out Vector;
!       Source : in out Vector) is
  
!       X : Elements_Access := Target.Elements;
  
     begin
! 
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       if Target.Last >= Index_Type'First then
!          raise Constraint_Error;
        end if;
  
!       Target.Elements := null;
!       Free (X);  --  shouldn't fail
! 
!       Target.Elements := Source.Elements;
!       Target.Last := Source.Last;
  
!       Source.Elements := null;
!       Source.Last := Index_Type'Pred (Index_Type'First);
  
!    end Move;
  
  
!    procedure Query_Element
!      (Container : in Vector;
!       Index     : in Index_Type;
!       Process   : not null access procedure (Element : in Element_Type)) is
  
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Container.Last;
     begin
!       Process (Container.Elements (T'(Index)).all);
!    end Query_Element;
! 
  
!    procedure Update_Element
!      (Container : in Vector;
!       Index     : in Index_Type;
!       Process   : not null access procedure (Element : in out Element_Type)) is
  
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
!    begin
!       Process (Container.Elements (T'(Index)).all);
!    end Update_Element;
  
  
!    procedure Prepend (Container : in out Vector;
!                       New_Item  : in     Element_Type;
!                       Count     : in     Count_Type := 1) is
!    begin
!       Insert (Container,
!               Index_Type'First,
!               New_Item,
!               Count);
!    end Prepend;
  
  
!    procedure Swap
!      (Container : in Vector;
!       I, J      : in Index_Type) is
  
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
  
!       EI : constant Element_Access := Container.Elements (T'(I));
  
!    begin
  
!       Container.Elements (T'(I)) := Container.Elements (T'(J));
!       Container.Elements (T'(J)) := EI;
  
!    end Swap;
  
  
!    function "&" (Left, Right : Vector) return Vector is
  
!       LN : constant Count_Type := Length (Left);
!       RN : constant Count_Type := Length (Right);
  
!    begin
  
!       if LN = 0 then
  
!          if RN = 0 then
!             return Empty_Vector;
           end if;
  
!          declare
!             RE : Elements_Type renames
!               Right.Elements (Index_Type'First .. Right.Last);
! 
!             Elements : Elements_Access :=
!               new Elements_Type (RE'Range);
!          begin
!             for I in Elements'Range loop
!                begin
!                   if RE (I) /= null then
!                      Elements (I) := new Element_Type'(RE (I).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. Index_Type'Pred (I) loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             return (Controlled with Elements, Right.Last);
!          end;
  
        end if;
  
!       if RN = 0 then
! 
           declare
!             LE : Elements_Type renames
!               Left.Elements (Index_Type'First .. Left.Last);
  
-             Elements : Elements_Access :=
-               new Elements_Type (LE'Range);
           begin
!             for I in Elements'Range loop
!                begin
!                   if LE (I) /= null then
!                      Elements (I) := new Element_Type'(LE (I).all);
!                   end if;
!                exception
!                   when others =>
!                      for J in Index_Type'First .. Index_Type'Pred (I) loop
!                         Free (Elements (J));
!                      end loop;
  
!                      Free (Elements);
!                      raise;
!                end;
!             end loop;
  
!             return (Controlled with Elements, Left.Last);
           end;
  
        end if;
  
        declare
! 
!          Last_As_Int : constant Int'Base :=
!             Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
! 
!          Last : constant Index_Type := Index_Type (Last_As_Int);
! 
!          LE : Elements_Type renames
!            Left.Elements (Index_Type'First .. Left.Last);
! 
!          RE : Elements_Type renames
!            Right.Elements (Index_Type'First .. Right.Last);
! 
!          Elements : Elements_Access :=
!            new Elements_Type (Index_Type'First .. Last);
! 
!          I : Index_Type'Base := Index_Type'Pred (Index_Type'First);
  
        begin
  
!          for LI in LE'Range loop
! 
!             I := Index_Type'Succ (I);
! 
!             begin
!                if LE (LI) /= null then
!                   Elements (I) := new Element_Type'(LE (LI).all);
!                end if;
!             exception
!                when others =>
!                   for J in Index_Type'First .. Index_Type'Pred (I) loop
!                      Free (Elements (J));
!                   end loop;
! 
!                   Free (Elements);
!                   raise;
!             end;
! 
!          end loop;
! 
!          for RI in RE'Range loop
! 
!             I := Index_Type'Succ (I);
! 
!             begin
!                if RE (RI) /= null then
!                   Elements (I) := new Element_Type'(RE (RI).all);
!                end if;
!             exception
!                when others =>
!                   for J in Index_Type'First .. Index_Type'Pred (I) loop
!                      Free (Elements (J));
!                   end loop;
! 
!                   Free (Elements);
!                   raise;
!             end;
! 
           end loop;
  
!          return (Controlled with Elements, Last);
!       end;
! 
!    end "&";
! 
! 
!    function "&" (Left  : Vector;
!                  Right : Element_Type) return Vector is
! 
!       LN : constant Count_Type := Length (Left);
! 
!    begin
! 
!       if LN = 0 then
  
           declare
!             Elements : Elements_Access :=
!               new Elements_Type (Index_Type'First .. Index_Type'First);
           begin
! 
!             begin
!                Elements (Elements'First) := new Element_Type'(Right);
!             exception
!                when others =>
!                   Free (Elements);
!                   raise;
!             end;
! 
!             return (Controlled with Elements, Index_Type'First);
! 
           end;
  
!       end if;
  
        declare
! 
!          Last_As_Int : constant Int'Base :=
!             Int (Index_Type'First) + Int (LN);
! 
!          Last : constant Index_Type := Index_Type (Last_As_Int);
! 
!          LE : Elements_Type renames
!            Left.Elements (Index_Type'First .. Left.Last);
! 
!          Elements : Elements_Access :=
!            new Elements_Type (Index_Type'First .. Last);
  
        begin
  
!          for I in LE'Range loop
  
              begin
!                if LE (I) /= null then
!                   Elements (I) := new Element_Type'(LE (I).all);
!                end if;
!             exception
!                when others =>
!                   for J in Index_Type'First .. Index_Type'Pred (I) loop
!                      Free (Elements (J));
!                   end loop;
  
!                   Free (Elements);
!                   raise;
              end;
  
!          end loop;
! 
!          begin
!             Elements (Elements'Last) := new Element_Type'(Right);
!          exception
!             when others =>
! 
!                declare
!                   subtype J_Subtype is Index_Type'Base range
!                     Index_Type'First .. Index_Type'Pred (Elements'Last);
!                begin
!                   for J in J_Subtype loop
!                      Free (Elements (J));
!                   end loop;
!                end;
! 
!                Free (Elements);
!                raise;
!          end;
  
!          return (Controlled with Elements, Last);
        end;
  
!    end "&";
! 
! 
! 
!    function "&" (Left  : Element_Type;
!                  Right : Vector) return Vector is
! 
!       RN : constant Count_Type := Length (Right);
  
     begin
! 
!       if RN = 0 then
! 
!          declare
!             Elements : Elements_Access :=
!               new Elements_Type (Index_Type'First .. Index_Type'First);
!          begin
! 
!             begin
!                Elements (Elements'First) := new Element_Type'(Left);
!             exception
!                when others =>
!                   Free (Elements);
!                   raise;
!             end;
! 
!             return (Controlled with Elements, Index_Type'First);
! 
!          end;
! 
        end if;
  
!       declare
! 
!          Last_As_Int : constant Int'Base :=
!             Int (Index_Type'First) + Int (RN);
! 
!          Last : constant Index_Type := Index_Type (Last_As_Int);
! 
!          RE : Elements_Type renames
!            Right.Elements (Index_Type'First .. Right.Last);
! 
!          Elements : Elements_Access :=
!            new Elements_Type (Index_Type'First .. Last);
! 
!          I : Index_Type'Base := Index_Type'First;
! 
!       begin
! 
!          begin
!             Elements (I) := new Element_Type'(Left);
!          exception
!             when others =>
!                Free (Elements);
!                raise;
!          end;
! 
!          for RI in RE'Range loop
  
!             I := Index_Type'Succ (I);
  
!             begin
!                if RE (RI) /= null then
!                   Elements (I) := new Element_Type'(RE (RI).all);
!                end if;
!             exception
!                when others =>
!                   for J in Index_Type'First .. Index_Type'Pred (I) loop
!                      Free (Elements (J));
!                   end loop;
  
!                   Free (Elements);
!                   raise;
!             end;
  
!          end loop;
  
!          return (Controlled with Elements, Last);
!       end;
  
!    end "&";
  
  
!    function "&" (Left, Right  : Element_Type) return Vector is
  
!       subtype IT is Index_Type'Base range
!         Index_Type'First .. Index_Type'Succ (Index_Type'First);
  
!       Elements : Elements_Access := new Elements_Type (IT);
  
     begin
  
        begin
!          Elements (Elements'First) := new Element_Type'(Left);
!       exception
!          when others =>
!             Free (Elements);
!             raise;
!       end;
! 
!       begin
!          Elements (Elements'Last) := new Element_Type'(Right);
        exception
           when others =>
!             Free (Elements (Elements'First));
!             Free (Elements);
              raise;
        end;
  
!       return (Controlled with Elements, Elements'Last);
! 
!    end "&";
  
  
!    function To_Cursor (Container : Vector;
!                        Index     : Extended_Index)
!       return Cursor is
     begin
!       if Index not in Index_Type'First .. Container.Last then
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Index);
!    end To_Cursor;
  
  
!    function To_Index (Position : Cursor) return Extended_Index is
     begin
!       if Position.Container = null then
!          return No_Index;
!       end if;
  
!       if Position.Index <= Position.Container.Last then
!          return Position.Index;
!       end if;
  
!       return No_Index;
!    end To_Index;
  
  
-    function Element (Position : Cursor) return Element_Type is
     begin
!       return Element (Position.Container.all, Position.Index);
!    end Element;
  
  
!    function Next (Position : Cursor) return Cursor is
!    begin
  
!       if Position.Container = null then
!          return No_Element;
        end if;
  
!       if Position.Index < Position.Container.Last then
!          return (Position.Container, Index_Type'Succ (Position.Index));
        end if;
  
!       return No_Element;
  
!    end Next;
  
  
!    function Previous (Position : Cursor) return Cursor is
!    begin
  
        if Position.Container = null then
           return No_Element;
        end if;
  
!       if Position.Index > Index_Type'First then
!          return (Position.Container, Index_Type'Pred (Position.Index));
        end if;
  
        return No_Element;
  
!    end Previous;
! 
  
     procedure Next (Position : in out Cursor) is
     begin
- 
        if Position.Container = null then
           return;
        end if;
  
        if Position.Index < Position.Container.Last then
!          Position.Index := Index_Type'Succ (Position.Index);
        else
           Position := No_Element;
        end if;
- 
     end Next;
  
  
!    procedure Previous (Position : in out Cursor) is
     begin
  
        if Position.Container = null then
           return;
        end if;
  
        if Position.Index > Index_Type'First then
!          Position.Index := Index_Type'Pred (Position.Index);
        else
           Position := No_Element;
        end if;
- 
     end Previous;
  
! 
!    function Has_Element (Position : Cursor) return Boolean is
     begin
- 
        if Position.Container = null then
!          return False;
        end if;
  
!       return Position.Index <= Position.Container.Last;
! 
!    end Has_Element;
! 
! 
!    procedure Iterate
!      (Container : in Vector;
!       Process   : not null access procedure (Position : in Cursor)) is
!    begin
  
!       for I in Index_Type'First .. Container.Last loop
!          Process (Cursor'(Container'Unchecked_Access, I));
!       end loop;
  
!    end Iterate;
  
  
-    procedure Reverse_Iterate
-      (Container : in Vector;
-       Process   : not null access procedure (Position : in Cursor)) is
     begin
  
!       for I in reverse Index_Type'First .. Container.Last loop
!          Process (Cursor'(Container'Unchecked_Access, I));
!       end loop;
! 
!    end Reverse_Iterate;
  
  
!    procedure Query_Element
!      (Position : in Cursor;
!       Process  : not null access procedure (Element : in Element_Type)) is
  
!       C : Vector renames Position.Container.all;
!       E : Elements_Type renames C.Elements.all;
  
!       subtype T is Index_Type'Base range
!         Index_Type'First .. C.Last;
     begin
!       Process (E (T'(Position.Index)).all);
     end Query_Element;
  
  
!    procedure Update_Element
!      (Position : in Cursor;
!       Process  : not null access procedure (Element : in out Element_Type)) is
  
!       C : Vector renames Position.Container.all;
!       E : Elements_Type renames C.Elements.all;
  
-       subtype T is Index_Type'Base range
-         Index_Type'First .. C.Last;
     begin
!       Process (E (T'(Position.Index)).all);
!    end Update_Element;
  
  
!    procedure Replace_Element (Position : in Cursor;
!                               By       : in Element_Type) is
  
!       C : Vector renames Position.Container.all;
!       E : Elements_Type renames C.Elements.all;
  
!       subtype T is Index_Type'Base range
!         Index_Type'First .. C.Last;
  
!       X : Element_Access := E (T'(Position.Index));
!    begin
!       E (T'(Position.Index)) := new Element_Type'(By);
!       Free (X);
!    end Replace_Element;
  
  
!    procedure Insert (Container : in out Vector;
!                      Before    : in     Extended_Index;
!                      New_Item  : in     Vector) is
  
!       N : constant Count_Type := Length (New_Item);
  
     begin
  
!       if N = 0 then
!          return;
        end if;
  
!       Insert_Space (Container, Before, Count => N);
  
!       if Container'Address = New_Item'Address then
  
!          declare
!             Dst_Last_As_Int : constant Int'Base :=
!               Int'Base (Before) + Int'Base (N) - 1;
  
!             Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
  
!             Dst_Index : Index_Type'Base := Index_Type'Pred (Before);
  
!             Dst : Elements_Type renames
!               Container.Elements (Before .. Dst_Last);
!          begin
  
              declare
!                subtype Src_Index_Subtype is Index_Type'Base range
!                  Index_Type'First .. Index_Type'Pred (Before);
! 
!                Src : Elements_Type renames
!                  Container.Elements (Src_Index_Subtype);
              begin
!                for Src_Index in Src'Range loop
!                   Dst_Index := Index_Type'Succ (Dst_Index);
! 
!                   if Src (Src_Index) /= null then
!                      Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                   end if;
!                end loop;
              end;
  
              declare
!                subtype Src_Index_Subtype is Index_Type'Base range
!                  Index_Type'Succ (Dst_Last) .. Container.Last;
  
                 Src : Elements_Type renames
!                  Container.Elements (Src_Index_Subtype);
!             begin
!                for Src_Index in Src'Range loop
!                   Dst_Index := Index_Type'Succ (Dst_Index);
  
!                   if Src (Src_Index) /= null then
!                      Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                   end if;
!                end loop;
!             end;
  
!          end;
  
!       else
  
!          declare
!             Dst_Last_As_Int : constant Int'Base :=
!               Int'Base (Before) + Int'Base (N) - 1;
  
!             Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
  
!             Dst_Index : Index_Type'Base := Index_Type'Pred (Before);
  
!             Src : Elements_Type renames
!               New_Item.Elements (Index_Type'First .. New_Item.Last);
  
!             Dst : Elements_Type renames
!               Container.Elements (Before .. Dst_Last);
!          begin
!             for Src_Index in Src'Range loop
!                Dst_Index := Index_Type'Succ (Dst_Index);
  
!                if Src (Src_Index) /= null then
!                   Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                end if;
!             end loop;
           end;
  
        end if;
  
!    end Insert;
  
  
!    procedure Insert (Container : in out Vector;
!                      Before    : in     Cursor;
!                      New_Item  : in     Vector) is
  
!       Index : Index_Type'Base;
  
!    begin
  
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Is_Empty (New_Item) then
           return;
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          Index := Index_Type'Succ (Container.Last);
!       else
!          Index := Before.Index;
        end if;
  
!       Insert (Container, Index, New_Item);
  
!    end Insert;
  
  
  
!    procedure Insert (Container : in out Vector;
!                      Before    : in     Cursor;
!                      New_Item  : in     Vector;
!                      Position  :    out Cursor) is
  
!       Index : Index_Type'Base;
  
!    begin
  
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
!       end if;
  
!       if Is_Empty (New_Item) then
  
!          if Before.Container = null
!            or else Before.Index > Container.Last
!          then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
!          end if;
  
           return;
- 
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          Index := Index_Type'Succ (Container.Last);
!       else
!          Index := Before.Index;
        end if;
  
!       Insert (Container, Index, New_Item);
  
!       Position := (Container'Unchecked_Access, Index);
  
!    end Insert;
  
  
!    procedure Insert (Container : in out Vector;
!                      Before    : in     Cursor;
!                      New_Item  : in     Element_Type;
!                      Count     : in     Count_Type := 1) is
  
!       Index : Index_Type'Base;
  
     begin
! 
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
        then
           raise Program_Error;
        end if;
  
!       if Count = 0 then
!          return;
!       end if;
! 
!       if Before.Container = null
!         or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
!          Index := Before.Index;
        end if;
  
!       Insert (Container, Index, New_Item, Count);
! 
!    end Insert;
  
  
!    procedure Insert (Container : in out Vector;
!                      Before    : in     Cursor;
!                      New_Item  : in     Element_Type;
!                      Position  :    out Cursor;
!                      Count     : in     Count_Type := 1) is
  
!       Index : Index_Type'Base;
  
     begin
! 
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Count = 0 then
! 
!          if Before.Container = null
!            or else Before.Index > Container.Last
           then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
           end if;
  
!          return;
  
!       end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          Index := Index_Type'Succ (Container.Last);
!       else
!          Index := Before.Index;
!       end if;
  
!       Insert (Container, Index, New_Item, Count);
  
!       Position := (Container'Unchecked_Access, Index);
  
!    end Insert;
  
  
  
-    procedure Prepend (Container : in out Vector;
-                       New_Item  : in     Vector) is
     begin
!       Insert (Container, Index_Type'First, New_Item);
!    end Prepend;
  
  
-    procedure Append (Container : in out Vector;
-                      New_Item  : in     Vector) is
-    begin
-       if Is_Empty (New_Item) then
           return;
        end if;
  
!       Insert
!         (Container,
!          Index_Type'Succ (Container.Last),
!          New_Item);
!    end Append;
! 
  
  
!    procedure Insert_Space (Container : in out Vector;
!                            Before    : in     Cursor;
!                            Position  :    out Cursor;
!                            Count     : in     Count_Type := 1) is
  
!       Index : Index_Type'Base;
  
     begin
! 
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
        then
!          raise Program_Error;
        end if;
  
!       if Count = 0 then
! 
!          if Before.Container = null
!            or else Before.Index > Container.Last
!          then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
!          end if;
! 
           return;
- 
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          Index := Index_Type'Succ (Container.Last);
!       else
!          Index := Before.Index;
        end if;
  
!       Insert_Space (Container, Index, Count);
! 
!       Position := (Container'Unchecked_Access, Index);
  
!    end Insert_Space;
  
  
!    procedure Delete (Container : in out Vector;
!                      Position  : in out Cursor;
!                      Count     : in     Count_Type := 1) is
     begin
! 
!       if Position.Container /= null
!         and then Position.Container /=
!                    Vector_Access'(Container'Unchecked_Access)
        then
!          raise Program_Error;
        end if;
  
!       if Position.Container = null
!         or else Position.Index > Container.Last
        then
!          Position := No_Element;
!          return;
        end if;
  
!       Delete (Container, Position.Index, Count);
  
!       if Position.Index <= Container.Last then
!          Position := (Container'Unchecked_Access, Position.Index);
!       else
!          Position := No_Element;
        end if;
  
!    end Delete;
  
  
!    function First (Container : Vector) return Cursor is
     begin
!       if Is_Empty (Container) then
!          return No_Element;
        end if;
  
!       return (Container'Unchecked_Access, Index_Type'First);
!    end First;
  
  
!    function Last (Container : Vector) return Cursor is
     begin
!       if Is_Empty (Container) then
!          return No_Element;
        end if;
  
!       return (Container'Unchecked_Access, Container.Last);
!    end Last;
  
  
!    procedure Swap (I, J : in Cursor) is
  
!       --  NOTE: I've liberalized the behavior here, to
!       --  allow I and J to designate different containers.
!       --  TODO: I think this is suppose to raise P_E.
  
!       subtype TI is Index_Type'Base range
!         Index_Type'First .. I.Container.Last;
  
!       EI : Element_Access renames
!         I.Container.Elements (TI'(I.Index));
  
!       EI_Copy : constant Element_Access := EI;
  
!       subtype TJ is Index_Type'Base range
!         Index_Type'First .. J.Container.Last;
  
!       EJ : Element_Access renames
!         J.Container.Elements (TJ'(J.Index));
  
!    begin
  
!       EI := EJ;
!       EJ := EI_Copy;
  
!    end Swap;
  
  
!    function Find (Container : Vector;
!                   Item      : Element_Type;
!                   Position  : Cursor := No_Element) return Cursor is
  
     begin
  
!       if Position.Container /= null
!         and then Position.Container /=
!                    Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       for I in Position.Index .. Container.Last loop
!          if Container.Elements (I) /= null
!            and then Container.Elements (I).all = Item
!          then
!             return (Container'Unchecked_Access, I);
!          end if;
!       end loop;
  
!       return No_Element;
  
!    end Find;
  
  
!    function Reverse_Find (Container : Vector;
!                           Item      : Element_Type;
!                           Position  : Cursor := No_Element) return Cursor is
  
!       Last : Index_Type'Base;
  
     begin
  
!       if Position.Container /= null
!         and then Position.Container /=
!                    Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Position.Container = null
!         or else Position.Index > Container.Last
!       then
!          Last := Container.Last;
!       else
!          Last := Position.Index;
!       end if;
  
!       for I in reverse Index_Type'First .. Last loop
!          if Container.Elements (I) /= null
!            and then Container.Elements (I).all = Item
!          then
!             return (Container'Unchecked_Access, I);
!          end if;
!       end loop;
  
!       return No_Element;
  
!    end Reverse_Find;
  
  
  end Ada.Containers.Indefinite_Vectors;
- 
--- 384,2510 ----
           return False;
        end if;
  
!       for J in Index_Type'First .. Left.Last loop
!          if Left.Elements (J) = null then
!             if Right.Elements (J) /= null then
                 return False;
              end if;
  
!          elsif Right.Elements (J) = null then
              return False;
  
!          elsif Left.Elements (J).all /= Right.Elements (J).all then
              return False;
           end if;
        end loop;
  
        return True;
     end "=";
  
+    ------------
+    -- Adjust --
+    ------------
  
!    procedure Adjust (Container : in out Vector) is
     begin
!       if Container.Last = No_Index then
!          Container.Elements := null;
           return;
        end if;
  
        declare
!          E : Elements_Type renames Container.Elements.all;
!          L : constant Index_Type := Container.Last;
  
        begin
+          Container.Elements := null;
+          Container.Last := No_Index;
+          Container.Busy := 0;
+          Container.Lock := 0;
  
!          Container.Elements := new Elements_Type (Index_Type'First .. L);
  
!          for I in Container.Elements'Range loop
!             if E (I) /= null then
!                Container.Elements (I) := new Element_Type'(E (I).all);
              end if;
  
!             Container.Last := I;
           end loop;
        end;
+    end Adjust;
  
!    ------------
!    -- Append --
!    ------------
  
!    procedure Append (Container : in out Vector; New_Item : Vector) is
     begin
+       if Is_Empty (New_Item) then
+          return;
+       end if;
  
!       if Container.Last = Index_Type'Last then
!          raise Constraint_Error;
!       end if;
  
+       Insert
+         (Container,
+          Container.Last + 1,
+          New_Item);
+    end Append;
  
!    procedure Append
!      (Container : in out Vector;
!       New_Item  : Element_Type;
!       Count     : Count_Type := 1)
!    is
     begin
        if Count = 0 then
           return;
        end if;
  
+       if Container.Last = Index_Type'Last then
+          raise Constraint_Error;
+       end if;
+ 
        Insert
          (Container,
!          Container.Last + 1,
           New_Item,
           Count);
     end Append;
  
+    --------------
+    -- Capacity --
+    --------------
  
!    function Capacity (Container : Vector) return Count_Type is
     begin
!       if Container.Elements = null then
!          return 0;
        end if;
  
!       return Container.Elements'Length;
!    end Capacity;
  
!    -----------
!    -- Clear --
!    -----------
  
!    procedure Clear (Container : in out Vector) is
!    begin
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
  
+       while Container.Last >= Index_Type'First loop
           declare
!             X : Element_Access := Container.Elements (Container.Last);
           begin
!             Container.Elements (Container.Last) := null;
!             Container.Last := Container.Last - 1;
!             Free (X);
           end;
+       end loop;
+    end Clear;
  
!    --------------
!    -- Contains --
!    --------------
  
!    function Contains
!      (Container : Vector;
!       Item      : Element_Type) return Boolean
!    is
!    begin
!       return Find_Index (Container, Item) /= No_Index;
!    end Contains;
  
!    ------------
!    -- Delete --
!    ------------
  
!    procedure Delete
!      (Container : in out Vector;
!       Index     : Extended_Index;
!       Count     : Count_Type := 1)
!    is
!    begin
!       if Index < Index_Type'First then
!          raise Constraint_Error;
!       end if;
  
!       if Index > Container.Last then
!          if Index > Container.Last + 1 then
!             raise Constraint_Error;
!          end if;
  
!          return;
!       end if;
  
+       if Count = 0 then
           return;
+       end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
        end if;
  
        declare
+          Index_As_Int    : constant Int := Int (Index);
+          Old_Last_As_Int : constant Int := Int (Container.Last);
  
!          --  TODO: somewhat vestigial...fix ???
!          Count1 : constant Int'Base := Int (Count);
!          Count2 : constant Int'Base := Old_Last_As_Int - Index_As_Int + 1;
!          N      : constant Int'Base := Int'Min (Count1, Count2);
  
!          J_As_Int : constant Int'Base := Index_As_Int + N;
!          E        : Elements_Type renames Container.Elements.all;
  
        begin
+          if J_As_Int > Old_Last_As_Int then
+             while Container.Last >= Index loop
+                declare
+                   K : constant Index_Type := Container.Last;
+                   X : Element_Access := E (K);
  
!                begin
!                   E (K) := null;
!                   Container.Last := K - 1;
!                   Free (X);
!                end;
!             end loop;
  
           else
+             declare
+                J : constant Index_Type := Index_Type (J_As_Int);
  
!                New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
!                New_Last        : constant Index_Type :=
!                                    Index_Type (New_Last_As_Int);
  
!             begin
!                for K in Index .. J - 1 loop
!                   declare
!                      X : Element_Access := E (K);
!                   begin
!                      E (K) := null;
!                      Free (X);
!                   end;
!                end loop;
  
+                E (Index .. New_Last) := E (J .. Container.Last);
+                Container.Last := New_Last;
+             end;
           end if;
        end;
+    end Delete;
  
!    procedure Delete
       (Container : in out Vector;
!       Position  : in out Cursor;
!       Count     : Count_Type := 1)
!    is
!    begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unchecked_Access
!         or else Position.Index > Container.Last
!       then
!          raise Program_Error;
!       end if;
  
!       Delete (Container, Position.Index, Count);
  
!       Position := No_Element;  -- See comment in a-convec.adb
!    end Delete;
  
!    ------------------
!    -- Delete_First --
!    ------------------
  
+    procedure Delete_First
+      (Container : in out Vector;
+       Count     : Count_Type := 1)
+    is
     begin
        if Count = 0 then
           return;
        end if;
  
!       if Count >= Length (Container) then
!          Clear (Container);
           return;
        end if;
  
!       Delete (Container, Index_Type'First, Count);
!    end Delete_First;
  
!    -----------------
!    -- Delete_Last --
!    -----------------
  
!    procedure Delete_Last
!      (Container : in out Vector;
!       Count     : Count_Type := 1)
!    is
!       N : constant Count_Type := Length (Container);
  
+    begin
+       if Count = 0
+         or else N = 0
+       then
           return;
+       end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
        end if;
  
        declare
!          E : Elements_Type renames Container.Elements.all;
  
        begin
+          for Indx in 1 .. Count_Type'Min (Count, N) loop
+             declare
+                J : constant Index_Type := Container.Last;
+                X : Element_Access := E (J);
  
!             begin
!                E (J) := null;
!                Container.Last := J - 1;
!                Free (X);
!             end;
!          end loop;
!       end;
!    end Delete_Last;
  
!    -------------
!    -- Element --
!    -------------
  
!    function Element
!      (Container : Vector;
!       Index     : Index_Type) return Element_Type
!    is
!    begin
!       if Index > Container.Last then
!          raise Constraint_Error;
!       end if;
  
!       declare
!          EA : constant Element_Access := Container.Elements (Index);
  
+       begin
+          if EA = null then
+             raise Constraint_Error;
           end if;
  
+          return EA.all;
        end;
+    end Element;
  
!    function Element (Position : Cursor) return Element_Type is
!    begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
!       return Element (Position.Container.all, Position.Index);
!    end Element;
  
!    --------------
!    -- Finalize --
!    --------------
! 
!    procedure Finalize (Container : in out Vector) is
!    begin
!       Clear (Container);
  
        declare
           X : Elements_Access := Container.Elements;
        begin
!          Container.Elements := null;
           Free (X);
        end;
+    end Finalize;
  
!    ----------
!    -- Find --
!    ----------
  
+    function Find
+      (Container : Vector;
+       Item      : Element_Type;
+       Position  : Cursor := No_Element) return Cursor
+    is
+    begin
+       if Position.Container /= null
+         and then (Position.Container /= Container'Unchecked_Access
+                     or else Position.Index > Container.Last)
+       then
+          raise Program_Error;
+       end if;
  
!       for J in Position.Index .. Container.Last loop
!          if Container.Elements (J) /= null
!            and then Container.Elements (J).all = Item
!          then
!             return (Container'Unchecked_Access, J);
!          end if;
!       end loop;
! 
!       return No_Element;
!    end Find;
! 
!    ----------------
!    -- Find_Index --
!    ----------------
! 
!    function Find_Index
!      (Container : Vector;
!       Item      : Element_Type;
!       Index     : Index_Type := Index_Type'First) return Extended_Index
!    is
     begin
+       for Indx in Index .. Container.Last loop
+          if Container.Elements (Indx) /= null
+            and then Container.Elements (Indx).all = Item
+          then
+             return Indx;
+          end if;
+       end loop;
  
!       return No_Index;
!    end Find_Index;
  
!    -----------
!    -- First --
!    -----------
  
!    function First (Container : Vector) return Cursor is
!    begin
!       if Is_Empty (Container) then
!          return No_Element;
!       end if;
  
!       return (Container'Unchecked_Access, Index_Type'First);
!    end First;
  
+    -------------------
+    -- First_Element --
+    -------------------
  
!    function First_Element (Container : Vector) return Element_Type is
!    begin
!       return Element (Container, Index_Type'First);
!    end First_Element;
  
!    -----------------
!    -- First_Index --
!    -----------------
  
+    function First_Index (Container : Vector) return Index_Type is
+       pragma Unreferenced (Container);
     begin
+       return Index_Type'First;
+    end First_Index;
  
!    ---------------------
!    -- Generic_Sorting --
!    ---------------------
  
!    package body Generic_Sorting is
  
!       -----------------------
!       -- Local Subprograms --
!       -----------------------
  
!       function Is_Less (L, R : Element_Access) return Boolean;
!       pragma Inline (Is_Less);
  
!       -------------
!       -- Is_Less --
!       -------------
  
+       function Is_Less (L, R : Element_Access) return Boolean is
+       begin
+          if L = null then
+             return R /= null;
+          elsif R = null then
+             return False;
+          else
+             return L.all < R.all;
+          end if;
+       end Is_Less;
  
!       ---------------
!       -- Is_Sorted --
!       ---------------
  
!       function Is_Sorted (Container : Vector) return Boolean is
!       begin
!          if Container.Last <= Index_Type'First then
!             return True;
!          end if;
  
!          declare
!             E : Elements_Type renames Container.Elements.all;
!          begin
!             for I in Index_Type'First .. Container.Last - 1 loop
!                if Is_Less (E (I + 1), E (I)) then
!                   return False;
!                end if;
!             end loop;
!          end;
  
!          return True;
!       end Is_Sorted;
  
!       -----------
!       -- Merge --
!       -----------
  
!       procedure Merge (Target, Source : in out Vector) is
!          I : Index_Type'Base := Target.Last;
!          J : Index_Type'Base;
  
!       begin
!          if Target.Last < Index_Type'First then
!             Move (Target => Target, Source => Source);
!             return;
!          end if;
  
!          if Target'Address = Source'Address then
!             return;
!          end if;
  
!          if Source.Last < Index_Type'First then
!             return;
!          end if;
  
!          if Source.Busy > 0 then
!             raise Program_Error;
!          end if;
  
!          Target.Set_Length (Length (Target) + Length (Source));
  
!          J := Target.Last;
!          while Source.Last >= Index_Type'First loop
!             if I < Index_Type'First then
!                declare
!                   Src : Elements_Type renames
!                     Source.Elements (Index_Type'First .. Source.Last);
  
!                begin
!                   Target.Elements (Index_Type'First .. J) := Src;
!                   Src := (others => null);
!                end;
  
!                Source.Last := No_Index;
!                return;
!             end if;
  
!             declare
!                Src : Element_Access renames Source.Elements (Source.Last);
!                Tgt : Element_Access renames Target.Elements (I);
  
              begin
!                if Is_Less (Src, Tgt) then
!                   Target.Elements (J) := Tgt;
!                   Tgt := null;
!                   I := I - 1;
! 
!                else
!                   Target.Elements (J) := Src;
!                   Src := null;
!                   Source.Last := Source.Last - 1;
!                end if;
              end;
  
+             J := J - 1;
           end loop;
+       end Merge;
  
!       ----------
!       -- Sort --
!       ----------
  
!       procedure Sort (Container : in out Vector)
!       is
!          procedure Sort is
!             new Generic_Array_Sort
!              (Index_Type   => Index_Type,
!               Element_Type => Element_Access,
!               Array_Type   => Elements_Type,
!               "<"          => Is_Less);
  
+       --  Start of processing for Sort
  
!       begin
!          if Container.Last <= Index_Type'First then
!             return;
!          end if;
  
!          if Container.Lock > 0 then
!             raise Program_Error;
!          end if;
  
+          Sort (Container.Elements (Index_Type'First .. Container.Last));
+       end Sort;
  
!    end Generic_Sorting;
  
!    -----------------
!    -- Has_Element --
!    -----------------
  
+    function Has_Element (Position : Cursor) return Boolean is
     begin
+       if Position.Container = null then
+          return False;
+       end if;
  
!       return Position.Index <= Position.Container.Last;
!    end Has_Element;
  
!    ------------
!    -- Insert --
!    ------------
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Extended_Index;
!       New_Item  : Element_Type;
!       Count     : Count_Type := 1)
!    is
!       N : constant Int := Int (Count);
  
!       New_Last_As_Int : Int'Base;
!       New_Last        : Index_Type;
  
!       Dst : Elements_Access;
  
!    begin
!       if Before < Index_Type'First then
!          raise Constraint_Error;
!       end if;
  
!       if Before > Container.Last
!         and then Before > Container.Last + 1
!       then
!          raise Constraint_Error;
!       end if;
  
!       if Count = 0 then
!          return;
!       end if;
! 
!       declare
!          Old_Last_As_Int : constant Int := Int (Container.Last);
  
+       begin
+          New_Last_As_Int := Old_Last_As_Int + N;
+ 
+          if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+             raise Constraint_Error;
           end if;
  
!          New_Last := Index_Type (New_Last_As_Int);
!       end;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
        end if;
  
        if Container.Elements = null then
+          Container.Elements :=
+            new Elements_Type (Index_Type'First .. New_Last);
  
!          Container.Last := No_Index;
  
!          for J in Container.Elements'Range loop
!             Container.Elements (J) := new Element_Type'(New_Item);
!             Container.Last := J;
!          end loop;
  
           return;
        end if;
  
!       if New_Last <= Container.Elements'Last then
!          declare
!             E : Elements_Type renames Container.Elements.all;
!          begin
!             if Before <= Container.Last then
!                declare
!                   Index_As_Int : constant Int'Base :=
!                                    Index_Type'Pos (Before) + N;
  
!                   Index : constant Index_Type := Index_Type (Index_As_Int);
  
!                   J : Index_Type'Base := Before;
  
!                begin
!                   E (Index .. New_Last) := E (Before .. Container.Last);
!                   Container.Last := New_Last;
  
!                   while J < Index loop
!                      E (J) := new Element_Type'(New_Item);
!                      J := J + 1;
!                   end loop;
!                exception
!                   when others =>
!                      E (J .. Index - 1) := (others => null);
!                      raise;
!                end;
  
!             else
!                for J in Before .. New_Last loop
!                   E (J) := new Element_Type'(New_Item);
!                   Container.Last := J;
!                end loop;
!             end if;
!          end;
  
           return;
        end if;
  
        declare
!          First    : constant Int := Int (Index_Type'First);
!          New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Size     : Int'Base := Int'Max (1, Container.Elements'Length);
  
!       begin
!          while Size < New_Size loop
!             if Size > Int'Last / 2 then
!                Size := Int'Last;
!                exit;
!             end if;
  
!             Size := 2 * Size;
!          end loop;
  
!          --  TODO: The following calculations aren't quite right, since
!          --  there will be overflow if Index_Type'Range is very large
!          --  (e.g. this package is instantiated with a 64-bit integer).
!          --  END TODO.
  
           declare
!             Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
           begin
!             if Size > Max_Size then
!                Size := Max_Size;
!             end if;
           end;
  
!          declare
!             Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
!          begin
!             Dst := new Elements_Type (Index_Type'First .. Dst_Last);
!          end;
        end;
  
!       if Before <= Container.Last then
!          declare
!             Index_As_Int : constant Int'Base :=
!                              Index_Type'Pos (Before) + N;
  
+             Index : constant Index_Type := Index_Type (Index_As_Int);
  
!             Src : Elements_Access := Container.Elements;
  
+          begin
+             Dst (Index_Type'First .. Before - 1) :=
+               Src (Index_Type'First .. Before - 1);
  
!             Dst (Index .. New_Last) := Src (Before .. Container.Last);
  
+             Container.Elements := Dst;
+             Container.Last := New_Last;
+             Free (Src);
  
!             for J in Before .. Index - 1 loop
!                Dst (J) := new Element_Type'(New_Item);
!             end loop;
!          end;
  
+       else
+          declare
+             Src : Elements_Access := Container.Elements;
  
!          begin
!             Dst (Index_Type'First .. Container.Last) :=
!               Src (Index_Type'First .. Container.Last);
! 
!             Container.Elements := Dst;
!             Free (Src);
  
+             for J in Before .. New_Last loop
+                Dst (J) := new Element_Type'(New_Item);
+                Container.Last := J;
+             end loop;
+          end;
+       end if;
+    end Insert;
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Extended_Index;
!       New_Item  : Vector)
!    is
!       N : constant Count_Type := Length (New_Item);
  
     begin
!       if Before < Index_Type'First then
!          raise Constraint_Error;
!       end if;
  
+       if Before > Container.Last
+         and then Before > Container.Last + 1
+       then
+          raise Constraint_Error;
+       end if;
  
!       if N = 0 then
!          return;
!       end if;
  
!       Insert_Space (Container, Before, Count => N);
  
!       declare
!          Dst_Last_As_Int : constant Int'Base :=
!                              Int'Base (Before) + Int'Base (N) - 1;
  
+          Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
  
!          Dst : Elements_Type renames
!                  Container.Elements (Before .. Dst_Last);
  
!          Dst_Index : Index_Type'Base := Before - 1;
  
        begin
!          if Container'Address /= New_Item'Address then
!             declare
!                Src : Elements_Type renames
!                        New_Item.Elements (Index_Type'First .. New_Item.Last);
  
!             begin
!                for Src_Index in Src'Range loop
!                   Dst_Index := Dst_Index + 1;
  
!                   if Src (Src_Index) /= null then
!                      Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                   end if;
!                end loop;
!             end;
  
!             return;
!          end if;
  
!          declare
!             subtype Src_Index_Subtype is Index_Type'Base range
!               Index_Type'First .. Before - 1;
  
+             Src : Elements_Type renames
+                     Container.Elements (Src_Index_Subtype);
  
!          begin
!             for Src_Index in Src'Range loop
!                Dst_Index := Dst_Index + 1;
  
!                if Src (Src_Index) /= null then
!                   Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                end if;
!             end loop;
!          end;
  
!          if Dst_Last = Container.Last then
!             return;
           end if;
  
!          declare
!             subtype Src_Index_Subtype is Index_Type'Base range
!               Dst_Last + 1 .. Container.Last;
  
!             Src : Elements_Type renames
!                     Container.Elements (Src_Index_Subtype);
  
+          begin
+             for Src_Index in Src'Range loop
+                Dst_Index := Dst_Index + 1;
  
!                if Src (Src_Index) /= null then
!                   Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
!                end if;
!             end loop;
!          end;
!       end;
!    end Insert;
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Cursor;
!       New_Item  : Vector)
!    is
!       Index : Index_Type'Base;
  
     begin
+       if Before.Container /= null
+         and then Before.Container /= Container'Unchecked_Access
+       then
+          raise Program_Error;
+       end if;
  
!       if Is_Empty (New_Item) then
!          return;
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
           end if;
  
+          Index := Container.Last + 1;
  
+       else
+          Index := Before.Index;
+       end if;
  
!       Insert (Container, Index, New_Item);
!    end Insert;
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Cursor;
!       New_Item  : Vector;
!       Position  : out Cursor)
!    is
!       Index : Index_Type'Base;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Is_Empty (New_Item) then
!          if Before.Container = null
!            or else Before.Index > Container.Last
!          then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
!          end if;
  
           return;
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
  
!          Index := Container.Last + 1;
  
!       else
!          Index := Before.Index;
!       end if;
  
+       Insert (Container, Index, New_Item);
  
!       Position := Cursor'(Container'Unchecked_Access, Index);
!    end Insert;
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Cursor;
!       New_Item  : Element_Type;
!       Count     : Count_Type := 1)
!    is
!       Index : Index_Type'Base;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Count = 0 then
!          return;
        end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
  
!          Index := Container.Last + 1;
  
!       else
!          Index := Before.Index;
!       end if;
  
+       Insert (Container, Index, New_Item, Count);
+    end Insert;
  
!    procedure Insert
!      (Container : in out Vector;
!       Before    : Cursor;
!       New_Item  : Element_Type;
!       Position  : out Cursor;
!       Count     : Count_Type := 1)
!    is
!       Index : Index_Type'Base;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
!       end if;
  
!       if Count = 0 then
!          if Before.Container = null
!            or else Before.Index > Container.Last
!          then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
!          end if;
  
!          return;
!       end if;
  
+       if Before.Container = null
+         or else Before.Index > Container.Last
+       then
+          if Container.Last = Index_Type'Last then
+             raise Constraint_Error;
+          end if;
  
!          Index := Container.Last + 1;
  
+       else
+          Index := Before.Index;
+       end if;
  
!       Insert (Container, Index, New_Item, Count);
  
!       Position := (Container'Unchecked_Access, Index);
!    end Insert;
  
!    ------------------
!    -- Insert_Space --
!    ------------------
  
!    procedure Insert_Space
!      (Container : in out Vector;
!       Before    : Extended_Index;
!       Count     : Count_Type := 1)
!    is
!       N : constant Int := Int (Count);
  
!       New_Last_As_Int : Int'Base;
!       New_Last        : Index_Type;
  
!       Dst : Elements_Access;
  
+    begin
+       if Before < Index_Type'First then
+          raise Constraint_Error;
+       end if;
  
!       if Before > Container.Last
!         and then Before > Container.Last + 1
!       then
!          raise Constraint_Error;
!       end if;
  
!       if Count = 0 then
!          return;
!       end if;
  
!       declare
!          Old_Last_As_Int : constant Int := Int (Container.Last);
  
!       begin
!          New_Last_As_Int := Old_Last_As_Int + N;
  
!          if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
           end if;
  
!          New_Last := Index_Type (New_Last_As_Int);
!       end;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       if Container.Elements = null then
!          Container.Elements :=
!            new Elements_Type (Index_Type'First .. New_Last);
  
+          Container.Last := New_Last;
+          return;
        end if;
  
!       if New_Last <= Container.Elements'Last then
           declare
!             E : Elements_Type renames Container.Elements.all;
  
           begin
!             if Before <= Container.Last then
!                declare
!                   Index_As_Int : constant Int'Base :=
!                                    Index_Type'Pos (Before) + N;
  
!                   Index : constant Index_Type := Index_Type (Index_As_Int);
  
!                begin
!                   E (Index .. New_Last) := E (Before .. Container.Last);
!                   E (Before .. Index - 1) := (others => null);
!                end;
!             end if;
           end;
  
+          Container.Last := New_Last;
+          return;
        end if;
  
        declare
!          First    : constant Int := Int (Index_Type'First);
!          New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Size     : Int'Base := Int'Max (1, Container.Elements'Length);
  
        begin
+          while Size < New_Size loop
+             if Size > Int'Last / 2 then
+                Size := Int'Last;
+                exit;
+             end if;
  
!             Size := 2 * Size;
           end loop;
  
!          --  TODO: The following calculations aren't quite right, since
!          --  there will be overflow if Index_Type'Range is very large
!          --  (e.g. this package is instantiated with a 64-bit integer).
!          --  END TODO.
  
           declare
!             Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
           begin
!             if Size > Max_Size then
!                Size := Max_Size;
!             end if;
           end;
  
!          declare
!             Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
!          begin
!             Dst := new Elements_Type (Index_Type'First .. Dst_Last);
!          end;
!       end;
  
        declare
!          Src : Elements_Access := Container.Elements;
  
        begin
+          if Before <= Container.Last then
+             declare
+                Index_As_Int : constant Int'Base :=
+                                 Index_Type'Pos (Before) + N;
  
!                Index : constant Index_Type := Index_Type (Index_As_Int);
  
              begin
!                Dst (Index_Type'First .. Before - 1) :=
!                  Src (Index_Type'First .. Before - 1);
  
!                Dst (Index .. New_Last) := Src (Before .. Container.Last);
              end;
  
!          else
!             Dst (Index_Type'First .. Container.Last) :=
!               Src (Index_Type'First .. Container.Last);
!          end if;
  
!          Container.Elements := Dst;
!          Container.Last := New_Last;
!          Free (Src);
        end;
+    end Insert_Space;
  
!    procedure Insert_Space
!      (Container : in out Vector;
!       Before    : Cursor;
!       Position  : out Cursor;
!       Count     : Count_Type := 1)
!    is
!       Index : Index_Type'Base;
  
     begin
!       if Before.Container /= null
!         and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Count = 0 then
!          if Before.Container = null
!            or else Before.Index > Container.Last
!          then
!             Position := No_Element;
!          else
!             Position := (Container'Unchecked_Access, Before.Index);
!          end if;
  
!          return;
!       end if;
  
!       if Before.Container = null
!         or else Before.Index > Container.Last
!       then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
  
!          Index := Container.Last + 1;
  
!       else
!          Index := Before.Index;
!       end if;
  
!       Insert_Space (Container, Index, Count);
  
!       Position := Cursor'(Container'Unchecked_Access, Index);
!    end Insert_Space;
  
+    --------------
+    -- Is_Empty --
+    --------------
  
!    function Is_Empty (Container : Vector) return Boolean is
!    begin
!       return Container.Last < Index_Type'First;
!    end Is_Empty;
  
!    -------------
!    -- Iterate --
!    -------------
  
!    procedure Iterate
!      (Container : Vector;
!       Process   : not null access procedure (Position : in Cursor))
!    is
!       V : Vector renames Container'Unrestricted_Access.all;
!       B : Natural renames V.Busy;
  
     begin
+       B := B + 1;
  
        begin
!          for Indx in Index_Type'First .. Container.Last loop
!             Process (Cursor'(Container'Unchecked_Access, Indx));
!          end loop;
        exception
           when others =>
!             B := B - 1;
              raise;
        end;
  
!       B := B - 1;
!    end Iterate;
  
+    ----------
+    -- Last --
+    ----------
  
!    function Last (Container : Vector) return Cursor is
     begin
!       if Is_Empty (Container) then
           return No_Element;
        end if;
  
!       return (Container'Unchecked_Access, Container.Last);
!    end Last;
  
+    ------------------
+    -- Last_Element --
+    ------------------
  
!    function Last_Element (Container : Vector) return Element_Type is
     begin
!       return Element (Container, Container.Last);
!    end Last_Element;
  
!    ----------------
!    -- Last_Index --
!    ----------------
  
!    function Last_Index (Container : Vector) return Extended_Index is
!    begin
!       return Container.Last;
!    end Last_Index;
  
+    ------------
+    -- Length --
+    ------------
+ 
+    function Length (Container : Vector) return Count_Type is
+       L : constant Int := Int (Container.Last);
+       F : constant Int := Int (Index_Type'First);
+       N : constant Int'Base := L - F + 1;
  
     begin
!       if N > Count_Type'Pos (Count_Type'Last) then
!          raise Constraint_Error;
!       end if;
  
+       return Count_Type (N);
+    end Length;
  
!    ----------
!    -- Move --
!    ----------
  
!    procedure Move
!      (Target : in out Vector;
!       Source : in out Vector)
!    is
!    begin
!       if Target'Address = Source'Address then
!          return;
        end if;
  
!       if Source.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       Clear (Target);
  
!       declare
!          Target_Elements : constant Elements_Access := Target.Elements;
!       begin
!          Target.Elements := Source.Elements;
!          Source.Elements := Target_Elements;
!       end;
  
+       Target.Last := Source.Last;
+       Source.Last := No_Index;
+    end Move;
  
!    ----------
!    -- Next --
!    ----------
  
+    function Next (Position : Cursor) return Cursor is
+    begin
        if Position.Container = null then
           return No_Element;
        end if;
  
!       if Position.Index < Position.Container.Last then
!          return (Position.Container, Position.Index + 1);
        end if;
  
        return No_Element;
+    end Next;
  
!    ----------
!    -- Next --
!    ----------
  
     procedure Next (Position : in out Cursor) is
     begin
        if Position.Container = null then
           return;
        end if;
  
        if Position.Index < Position.Container.Last then
!          Position.Index := Position.Index + 1;
        else
           Position := No_Element;
        end if;
     end Next;
  
+    -------------
+    -- Prepend --
+    -------------
+ 
+    procedure Prepend (Container : in out Vector; New_Item : Vector) is
+    begin
+       Insert (Container, Index_Type'First, New_Item);
+    end Prepend;
  
!    procedure Prepend
!      (Container : in out Vector;
!       New_Item  : Element_Type;
!       Count     : Count_Type := 1)
!    is
     begin
+       Insert (Container,
+               Index_Type'First,
+               New_Item,
+               Count);
+    end Prepend;
+ 
+    --------------
+    -- Previous --
+    --------------
  
+    procedure Previous (Position : in out Cursor) is
+    begin
        if Position.Container = null then
           return;
        end if;
  
        if Position.Index > Index_Type'First then
!          Position.Index := Position.Index - 1;
        else
           Position := No_Element;
        end if;
     end Previous;
  
!    function Previous (Position : Cursor) return Cursor is
     begin
        if Position.Container = null then
!          return No_Element;
        end if;
  
!       if Position.Index > Index_Type'First then
!          return (Position.Container, Position.Index - 1);
!       end if;
  
!       return No_Element;
!    end Previous;
  
!    -------------------
!    -- Query_Element --
!    -------------------
  
+    procedure Query_Element
+      (Container : Vector;
+       Index     : Index_Type;
+       Process   : not null access procedure (Element : in Element_Type))
+    is
+       V : Vector renames Container'Unrestricted_Access.all;
+       B : Natural renames V.Busy;
+       L : Natural renames V.Lock;
  
     begin
+       if Index > Container.Last then
+          raise Constraint_Error;
+       end if;
  
!       if V.Elements (Index) = null then
!          raise Constraint_Error;
!       end if;
  
+       B := B + 1;
+       L := L + 1;
  
!       begin
!          Process (V.Elements (Index).all);
!       exception
!          when others =>
!             L := L - 1;
!             B := B - 1;
!             raise;
!       end;
  
!       L := L - 1;
!       B := B - 1;
!    end Query_Element;
  
!    procedure Query_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in Element_Type))
!    is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
! 
!       Query_Element (Position.Container.all, Position.Index, Process);
     end Query_Element;
  
+    ----------
+    -- Read --
+    ----------
  
!    procedure Read
!      (Stream    : access Root_Stream_Type'Class;
!       Container : out Vector)
!    is
!       Length : Count_Type'Base;
!       Last   : Index_Type'Base := Index_Type'Pred (Index_Type'First);
  
!       B : Boolean;
  
     begin
!       Clear (Container);
  
+       Count_Type'Base'Read (Stream, Length);
  
!       if Length > Capacity (Container) then
!          Reserve_Capacity (Container, Capacity => Length);
!       end if;
  
!       for J in Count_Type range 1 .. Length loop
!          Last := Last + 1;
  
!          Boolean'Read (Stream, B);
  
!          if B then
!             Container.Elements (Last) :=
!               new Element_Type'(Element_Type'Input (Stream));
!          end if;
  
+          Container.Last := Last;
+       end loop;
+    end Read;
  
!    procedure Read
!      (Stream   : access Root_Stream_Type'Class;
!       Position : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
  
!    ---------------------
!    -- Replace_Element --
!    ---------------------
  
+    procedure Replace_Element
+      (Container : in out Vector;
+       Index     : Index_Type;
+       New_Item  : Element_Type)
+    is
     begin
+       if Index > Container.Last then
+          raise Constraint_Error;
+       end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
        end if;
  
!       declare
!          X : Element_Access := Container.Elements (Index);
!       begin
!          Container.Elements (Index) := new Element_Type'(New_Item);
!          Free (X);
!       end;
!    end Replace_Element;
  
!    procedure Replace_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
!    begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
  
!       Replace_Element (Container, Position.Index, New_Item);
!    end Replace_Element;
  
!    ----------------------
!    -- Reserve_Capacity --
!    ----------------------
  
!    procedure Reserve_Capacity
!      (Container : in out Vector;
!       Capacity  : Count_Type)
!    is
!       N : constant Count_Type := Length (Container);
  
+    begin
+       if Capacity = 0 then
+          if N = 0 then
              declare
!                X : Elements_Access := Container.Elements;
              begin
!                Container.Elements := null;
!                Free (X);
              end;
  
+          elsif N < Container.Elements'Length then
+             if Container.Busy > 0 then
+                raise Program_Error;
+             end if;
+ 
              declare
!                subtype Array_Index_Subtype is Index_Type'Base range
!                  Index_Type'First .. Container.Last;
  
                 Src : Elements_Type renames
!                        Container.Elements (Array_Index_Subtype);
  
!                subtype Array_Subtype is
!                  Elements_Type (Array_Index_Subtype);
  
!                X : Elements_Access := Container.Elements;
  
!             begin
!                Container.Elements := new Array_Subtype'(Src);
!                Free (X);
!             end;
!          end if;
  
!          return;
!       end if;
  
!       if Container.Elements = null then
!          declare
!             Last_As_Int : constant Int'Base :=
!                             Int (Index_Type'First) + Int (Capacity) - 1;
  
!          begin
!             if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!                raise Constraint_Error;
!             end if;
  
!             declare
!                Last : constant Index_Type := Index_Type (Last_As_Int);
  
!                subtype Array_Subtype is
!                  Elements_Type (Index_Type'First .. Last);
  
!             begin
!                Container.Elements := new Array_Subtype;
!             end;
           end;
  
+          return;
        end if;
  
!       if Capacity <= N then
!          if N < Container.Elements'Length then
!             if Container.Busy > 0 then
!                raise Program_Error;
!             end if;
  
+             declare
+                subtype Array_Index_Subtype is Index_Type'Base range
+                  Index_Type'First .. Container.Last;
  
!                Src : Elements_Type renames
!                        Container.Elements (Array_Index_Subtype);
  
!                subtype Array_Subtype is
!                  Elements_Type (Array_Index_Subtype);
  
!                X : Elements_Access := Container.Elements;
  
!             begin
!                Container.Elements := new Array_Subtype'(Src);
!                Free (X);
!             end;
!          end if;
! 
!          return;
        end if;
  
!       if Capacity = Container.Elements'Length then
           return;
        end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       declare
!          Last_As_Int : constant Int'Base :=
!                          Int (Index_Type'First) + Int (Capacity) - 1;
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
! 
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
+             subtype Array_Subtype is
+               Elements_Type (Index_Type'First .. Last);
  
+             X : Elements_Access := Container.Elements;
  
!          begin
!             Container.Elements := new Array_Subtype;
  
!             declare
!                Src : Elements_Type renames
!                        X (Index_Type'First .. Container.Last);
  
!                Tgt : Elements_Type renames
!                        Container.Elements (Index_Type'First .. Container.Last);
  
!             begin
!                Tgt := Src;
!             end;
  
!             Free (X);
!          end;
!       end;
!    end Reserve_Capacity;
  
!    ----------------------
!    -- Reverse_Elements --
!    ----------------------
  
+    procedure Reverse_Elements (Container : in out Vector) is
+    begin
+       if Container.Length <= 1 then
           return;
        end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
        end if;
  
!       declare
!          I : Index_Type := Index_Type'First;
!          J : Index_Type := Container.Last;
!          E : Elements_Type renames Container.Elements.all;
  
!       begin
!          while I < J loop
!             declare
!                EI : constant Element_Access := E (I);
  
!             begin
!                E (I) := E (J);
!                E (J) := EI;
!             end;
  
+             I := I + 1;
+             J := J - 1;
+          end loop;
+       end;
+    end Reverse_Elements;
  
!    ------------------
!    -- Reverse_Find --
!    ------------------
  
!    function Reverse_Find
!      (Container : Vector;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
!       Last : Index_Type'Base;
  
     begin
!       if Position.Container /= null
!         and then Position.Container /= Container'Unchecked_Access
        then
           raise Program_Error;
        end if;
  
!       if Position.Container = null
!         or else Position.Index > Container.Last
        then
!          Last := Container.Last;
        else
!          Last := Position.Index;
        end if;
  
!       for Indx in reverse Index_Type'First .. Last loop
!          if Container.Elements (Indx) /= null
!            and then Container.Elements (Indx).all = Item
!          then
!             return (Container'Unchecked_Access, Indx);
!          end if;
!       end loop;
  
+       return No_Element;
+    end Reverse_Find;
  
!    ------------------------
!    -- Reverse_Find_Index --
!    ------------------------
  
!    function Reverse_Find_Index
!      (Container : Vector;
!       Item      : Element_Type;
!       Index     : Index_Type := Index_Type'Last) return Extended_Index
!    is
!       Last : Index_Type'Base;
  
     begin
!       if Index > Container.Last then
!          Last := Container.Last;
!       else
!          Last := Index;
        end if;
  
!       for Indx in reverse Index_Type'First .. Last loop
!          if Container.Elements (Indx) /= null
!            and then Container.Elements (Indx).all = Item
           then
!             return Indx;
           end if;
+       end loop;
  
!       return No_Index;
!    end Reverse_Find_Index;
  
!    ---------------------
!    -- Reverse_Iterate --
!    ---------------------
  
!    procedure Reverse_Iterate
!      (Container : Vector;
!       Process   : not null access procedure (Position : in Cursor))
!    is
!       V : Vector renames Container'Unrestricted_Access.all;
!       B : Natural renames V.Busy;
  
!    begin
!       B := B + 1;
  
!       begin
!          for Indx in reverse Index_Type'First .. Container.Last loop
!             Process (Cursor'(Container'Unchecked_Access, Indx));
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
  
!       B := B - 1;
!    end Reverse_Iterate;
  
+    ----------------
+    -- Set_Length --
+    ----------------
  
+    procedure Set_Length
+      (Container : in out Vector;
+       Length    : Count_Type)
+    is
+       N : constant Count_Type := Indefinite_Vectors.Length (Container);
  
     begin
!       if Length = N then
!          return;
!       end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
+       if Length < N then
+          for Index in 1 .. N - Length loop
+             declare
+                J : constant Index_Type := Container.Last;
+                X : Element_Access := Container.Elements (J);
+ 
+             begin
+                Container.Elements (J) := null;
+                Container.Last := J - 1;
+                Free (X);
+             end;
+          end loop;
  
           return;
        end if;
  
!       if Length > Capacity (Container) then
!          Reserve_Capacity (Container, Capacity => Length);
!       end if;
  
+       declare
+          Last_As_Int : constant Int'Base :=
+                          Int (Index_Type'First) + Int (Length) - 1;
  
!       begin
!          Container.Last := Index_Type (Last_As_Int);
!       end;
!    end Set_Length;
  
!    ----------
!    -- Swap --
!    ----------
  
+    procedure Swap
+      (Container : in out Vector;
+       I, J      : Index_Type)
+    is
     begin
!       if I > Container.Last
!         or else J > Container.Last
        then
!          raise Constraint_Error;
        end if;
  
!       if I = J then
           return;
        end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
        end if;
  
!       declare
!          EI : Element_Access renames Container.Elements (I);
!          EJ : Element_Access renames Container.Elements (J);
  
!          EI_Copy : constant Element_Access := EI;
  
+       begin
+          EI := EJ;
+          EJ := EI_Copy;
+       end;
+    end Swap;
  
!    procedure Swap
!      (Container : in out Vector;
!       I, J      : Cursor)
!    is
     begin
!       if I.Container = null
!         or else J.Container = null
        then
!          raise Constraint_Error;
        end if;
  
!       if I.Container /= Container'Unrestricted_Access
!         or else J.Container /= Container'Unrestricted_Access
        then
!          raise Program_Error;
        end if;
  
!       Swap (Container, I.Index, J.Index);
!    end Swap;
  
!    ---------------
!    -- To_Cursor --
!    ---------------
! 
!    function To_Cursor
!      (Container : Vector;
!       Index     : Extended_Index) return Cursor
!    is
!    begin
!       if Index not in Index_Type'First .. Container.Last then
!          return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Index);
!    end To_Cursor;
  
+    --------------
+    -- To_Index --
+    --------------
  
!    function To_Index (Position : Cursor) return Extended_Index is
     begin
!       if Position.Container = null then
!          return No_Index;
        end if;
  
!       if Position.Index <= Position.Container.Last then
!          return Position.Index;
!       end if;
  
+       return No_Index;
+    end To_Index;
  
!    ---------------
!    -- To_Vector --
!    ---------------
! 
!    function To_Vector (Length : Count_Type) return Vector is
     begin
!       if Length = 0 then
!          return Empty_Vector;
        end if;
  
!       declare
!          First       : constant Int := Int (Index_Type'First);
!          Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : Index_Type;
!          Elements    : Elements_Access;
  
+       begin
+          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+             raise Constraint_Error;
+          end if;
  
!          Last := Index_Type (Last_As_Int);
!          Elements := new Elements_Type (Index_Type'First .. Last);
  
!          return (Controlled with Elements, Last, 0, 0);
!       end;
!    end To_Vector;
  
!    function To_Vector
!      (New_Item : Element_Type;
!       Length   : Count_Type) return Vector
!    is
!    begin
!       if Length = 0 then
!          return Empty_Vector;
!       end if;
  
!       declare
!          First       : constant Int := Int (Index_Type'First);
!          Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : Index_Type'Base;
!          Elements    : Elements_Access;
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          Last := Index_Type (Last_As_Int);
!          Elements := new Elements_Type (Index_Type'First .. Last);
  
!          Last := Index_Type'First;
  
!          begin
!             loop
!                Elements (Last) := new Element_Type'(New_Item);
!                exit when Last = Elements'Last;
!                Last := Last + 1;
!             end loop;
!          exception
!             when others =>
!                for J in Index_Type'First .. Last - 1 loop
!                   Free (Elements (J));
!                end loop;
  
!                Free (Elements);
!                raise;
!          end;
  
!          return (Controlled with Elements, Last, 0, 0);
!       end;
!    end To_Vector;
  
+    --------------------
+    -- Update_Element --
+    --------------------
  
!    procedure Update_Element
!      (Container : in out Vector;
!       Index     : Index_Type;
!       Process   : not null access procedure (Element : in out Element_Type))
!    is
!       B : Natural renames Container.Busy;
!       L : Natural renames Container.Lock;
  
     begin
+       if Index > Container.Last then
+          raise Constraint_Error;
+       end if;
  
!       if Container.Elements (Index) = null then
!          raise Constraint_Error;
        end if;
  
!       B := B + 1;
!       L := L + 1;
  
!       begin
!          Process (Container.Elements (Index).all);
!       exception
!          when others =>
!             L := L - 1;
!             B := B - 1;
!             raise;
!       end;
  
!       L := L - 1;
!       B := B - 1;
!    end Update_Element;
! 
!    procedure Update_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type))
!    is
!    begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
  
+       if Position.Container /= Container'Unrestricted_Access then
+          raise Program_Error;
+       end if;
  
!       Update_Element (Container, Position.Index, Process);
!    end Update_Element;
  
!    -----------
!    -- Write --
!    -----------
! 
!    procedure Write
!      (Stream    : access Root_Stream_Type'Class;
!       Container : Vector)
!    is
!       N : constant Count_Type := Length (Container);
  
     begin
+       Count_Type'Base'Write (Stream, N);
  
!       if N = 0 then
!          return;
        end if;
  
!       declare
!          E : Elements_Type renames Container.Elements.all;
  
!       begin
!          for Indx in Index_Type'First .. Container.Last loop
  
!             --  There's another way to do this.  Instead a separate
!             --  Boolean for each element, you could write a Boolean
!             --  followed by a count of how many nulls or non-nulls
!             --  follow in the array.
  
!             if E (Indx) = null then
!                Boolean'Write (Stream, False);
!             else
!                Boolean'Write (Stream, True);
!                Element_Type'Output (Stream, E (Indx).all);
!             end if;
!          end loop;
!       end;
!    end Write;
  
+    procedure Write
+      (Stream   : access Root_Stream_Type'Class;
+       Position : Cursor)
+    is
+    begin
+       raise Program_Error;
+    end Write;
  
  end Ada.Containers.Indefinite_Vectors;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coinve.ads gcc-4.1.0/gcc/ada/a-coinve.ads
*** gcc-4.0.2/gcc/ada/a-coinve.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coinve.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.CONTAINERS.INDEFINITE_VECTORS                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . C O N T A I N E R S . I N D E F I N I T E _ V E C T O R S     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Streams;
*** 38,60 ****
  
  generic
     type Index_Type is range <>;
- 
     type Element_Type (<>) is private;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Vectors is
! pragma Preelaborate (Indefinite_Vectors);
  
     subtype Extended_Index is Index_Type'Base
       range Index_Type'First - 1 ..
!             Index_Type'Last +
!             Boolean'Pos (Index_Type'Base'Last > Index_Type'Last);
  
     No_Index : constant Extended_Index := Extended_Index'First;
  
-    subtype Index_Subtype is Index_Type;
- 
     type Vector is tagged private;
  
     type Cursor is private;
--- 38,56 ----
  
  generic
     type Index_Type is range <>;
     type Element_Type (<>) is private;
  
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Indefinite_Vectors is
!    pragma Preelaborate;
  
     subtype Extended_Index is Index_Type'Base
       range Index_Type'First - 1 ..
!            Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
  
     No_Index : constant Extended_Index := Extended_Index'First;
  
     type Vector is tagged private;
  
     type Cursor is private;
*************** pragma Preelaborate (Indefinite_Vectors)
*** 63,68 ****
--- 59,66 ----
  
     No_Element : constant Cursor;
  
+    function "=" (Left, Right : Vector) return Boolean;
+ 
     function To_Vector (Length : Count_Type) return Vector;
  
     function To_Vector
*************** pragma Preelaborate (Indefinite_Vectors)
*** 77,84 ****
  
     function "&" (Left, Right : Element_Type) return Vector;
  
-    function "=" (Left, Right : Vector) return Boolean;
- 
     function Capacity (Container : Vector) return Count_Type;
  
     procedure Reserve_Capacity
--- 75,80 ----
*************** pragma Preelaborate (Indefinite_Vectors)
*** 87,92 ****
--- 83,92 ----
  
     function Length (Container : Vector) return Count_Type;
  
+    procedure Set_Length
+      (Container : in out Vector;
+       Length    : Count_Type);
+ 
     function Is_Empty (Container : Vector) return Boolean;
  
     procedure Clear (Container : in out Vector);
*************** pragma Preelaborate (Indefinite_Vectors)
*** 103,108 ****
--- 103,118 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Vector;
+       Index     : Index_Type;
+       New_Item  : Element_Type);
+ 
+    procedure Replace_Element
+      (Container : in out Vector;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Container : Vector;
        Index     : Index_Type;
*************** pragma Preelaborate (Indefinite_Vectors)
*** 113,136 ****
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type));
! 
!    procedure Replace_Element
!      (Container : Vector;
!       Index     : Index_Type;
!       By        : Element_Type);
! 
!    procedure Replace_Element
!      (Position : Cursor;
!       By       : Element_Type);
! 
!    procedure Assign (Target : in out Vector; Source : Vector);
  
     procedure Move (Target : in out Vector; Source : in out Vector);
  
--- 123,136 ----
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Update_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Move (Target : in out Vector; Source : in out Vector);
  
*************** pragma Preelaborate (Indefinite_Vectors)
*** 198,210 ****
        Position  : out Cursor;
        Count     : Count_Type := 1);
  
-    procedure Set_Length
-      (Container : in out Vector;
-       Length    : Count_Type);
- 
     procedure Delete
       (Container : in out Vector;
!       Index     : Extended_Index;  --  TODO: verify
        Count     : Count_Type := 1);
  
     procedure Delete
--- 198,206 ----
        Position  : out Cursor;
        Count     : Count_Type := 1);
  
     procedure Delete
       (Container : in out Vector;
!       Index     : Extended_Index;
        Count     : Count_Type := 1);
  
     procedure Delete
*************** pragma Preelaborate (Indefinite_Vectors)
*** 220,225 ****
--- 216,227 ----
       (Container : in out Vector;
        Count     : Count_Type := 1);
  
+    procedure Reverse_Elements (Container : in out Vector);
+ 
+    procedure Swap (Container : in out Vector; I, J : Index_Type);
+ 
+    procedure Swap (Container : in out Vector; I, J : Cursor);
+ 
     function First_Index (Container : Vector) return Index_Type;
  
     function First (Container : Vector) return Cursor;
*************** pragma Preelaborate (Indefinite_Vectors)
*** 232,244 ****
  
     function Last_Element (Container : Vector) return Element_Type;
  
!    procedure Swap (Container : Vector; I, J : Index_Type);
  
!    procedure Swap (I, J : Cursor);
  
!    generic
!       with function "<" (Left, Right : Element_Type) return Boolean is <>;
!    procedure Generic_Sort (Container : Vector);
  
     function Find_Index
       (Container : Vector;
--- 234,246 ----
  
     function Last_Element (Container : Vector) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Previous (Position : in out Cursor);
  
     function Find_Index
       (Container : Vector;
*************** pragma Preelaborate (Indefinite_Vectors)
*** 248,277 ****
     function Find
       (Container : Vector;
        Item      : Element_Type;
!        Position  : Cursor := No_Element) return Cursor;
  
     function Reverse_Find_Index
       (Container : Vector;
        Item      : Element_Type;
        Index     : Index_Type := Index_Type'Last) return Extended_Index;
  
!    function Reverse_Find (Container : Vector;
!                           Item      : Element_Type;
!                           Position  : Cursor := No_Element)
!       return Cursor;
  
     function Contains
       (Container : Vector;
        Item      : Element_Type) return Boolean;
  
-    function Next (Position : Cursor) return Cursor;
- 
-    function Previous (Position : Cursor) return Cursor;
- 
-    procedure Next (Position : in out Cursor);
- 
-    procedure Previous (Position : in out Cursor);
- 
     function Has_Element (Position : Cursor) return Boolean;
  
     procedure Iterate
--- 250,271 ----
     function Find
       (Container : Vector;
        Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor;
  
     function Reverse_Find_Index
       (Container : Vector;
        Item      : Element_Type;
        Index     : Index_Type := Index_Type'Last) return Extended_Index;
  
!    function Reverse_Find
!      (Container : Vector;
!       Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor;
  
     function Contains
       (Container : Vector;
        Item      : Element_Type) return Boolean;
  
     function Has_Element (Position : Cursor) return Boolean;
  
     procedure Iterate
*************** pragma Preelaborate (Indefinite_Vectors)
*** 282,287 ****
--- 276,293 ----
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor));
  
+    generic
+       with function "<" (Left, Right : Element_Type) return Boolean is <>;
+    package Generic_Sorting is
+ 
+       function Is_Sorted (Container : Vector) return Boolean;
+ 
+       procedure Sort (Container : in out Vector);
+ 
+       procedure Merge (Target : in out Vector; Source : in out Vector);
+ 
+    end Generic_Sorting;
+ 
  private
  
     pragma Inline (First_Index);
*************** private
*** 307,312 ****
--- 313,320 ----
     type Vector is new Controlled with record
        Elements : Elements_Access;
        Last     : Extended_Index := No_Index;
+       Busy     : Natural := 0;
+       Lock     : Natural := 0;
     end record;
  
     procedure Adjust (Container : in out Vector);
*************** private
*** 327,333 ****
  
     for Vector'Read use Read;
  
!    Empty_Vector : constant Vector := Vector'(Controlled with null, No_Index);
  
     type Vector_Access is access constant Vector;
     for Vector_Access'Storage_Size use 0;
--- 335,341 ----
  
     for Vector'Read use Read;
  
!    Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
  
     type Vector_Access is access constant Vector;
     for Vector_Access'Storage_Size use 0;
*************** private
*** 337,343 ****
        Index     : Index_Type := Index_Type'First;
     end record;
  
     No_Element : constant Cursor := Cursor'(null, Index_Type'First);
  
  end Ada.Containers.Indefinite_Vectors;
- 
--- 345,362 ----
        Index     : Index_Type := Index_Type'First;
     end record;
  
+    procedure Write
+      (Stream   : access Root_Stream_Type'Class;
+       Position : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
+    procedure Read
+      (Stream   : access Root_Stream_Type'Class;
+       Position : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
     No_Element : constant Cursor := Cursor'(null, Index_Type'First);
  
  end Ada.Containers.Indefinite_Vectors;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-colien.adb gcc-4.1.0/gcc/ada/a-colien.adb
*** gcc-4.0.2/gcc/ada/a-colien.adb	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-colien.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . C O M M A N D _ L I N E . E N V I R O N M E N T          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . C O M M A N D _ L I N E . E N V I R O N M E N T          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with System;
+ 
  package body Ada.Command_Line.Environment is
  
     -----------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/a-colien.ads gcc-4.1.0/gcc/ada/a-colien.ads
*** gcc-4.0.2/gcc/ada/a-colien.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-colien.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . C O M M A N D _ L I N E . E N V I R O N M E N T          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --         Copyright (C) 1996-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . C O M M A N D _ L I N E . E N V I R O N M E N T          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-colire.adb gcc-4.1.0/gcc/ada/a-colire.adb
*** gcc-4.0.2/gcc/ada/a-colire.adb	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-colire.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . C O M M A N D _ L I N E . R E M O V E                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . C O M M A N D _ L I N E . R E M O V E                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Command_Line.Remove is
*** 38,44 ****
     -----------------------
  
     procedure Initialize;
!    --  Initialize the Remove_Count and Remove_Args variables.
  
     ----------------
     -- Initialize --
--- 38,44 ----
     -----------------------
  
     procedure Initialize;
!    --  Initialize the Remove_Count and Remove_Args variables
  
     ----------------
     -- Initialize --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-colire.ads gcc-4.1.0/gcc/ada/a-colire.ads
*** gcc-4.0.2/gcc/ada/a-colire.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-colire.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . C O M M A N D _ L I N E . R E M O V E                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . C O M M A N D _ L I N E . R E M O V E                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  --  argument, Argument_Count will be 2, and Argument (2) will return C.
  
  package Ada.Command_Line.Remove is
! pragma Preelaborate (Remove);
  
     procedure Remove_Argument (Number : in Positive);
     --  Removes the argument identified by Number, which must be in the
--- 41,47 ----
  --  argument, Argument_Count will be 2, and Argument (2) will return C.
  
  package Ada.Command_Line.Remove is
!    pragma Preelaborate;
  
     procedure Remove_Argument (Number : in Positive);
     --  Removes the argument identified by Number, which must be in the
diff -Nrcpad gcc-4.0.2/gcc/ada/a-comlin.adb gcc-4.1.0/gcc/ada/a-comlin.adb
*** gcc-4.0.2/gcc/ada/a-comlin.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-comlin.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . C O M M A N D _ L I N E                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . C O M M A N D _ L I N E                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-comlin.ads gcc-4.1.0/gcc/ada/a-comlin.ads
*** gcc-4.0.2/gcc/ada/a-comlin.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-comlin.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  ------------------------------------------------------------------------------
  
  package Ada.Command_Line is
! pragma Preelaborate (Command_Line);
  
     function Argument_Count return Natural;
     --  If the external execution environment supports passing arguments to a
--- 36,42 ----
  ------------------------------------------------------------------------------
  
  package Ada.Command_Line is
!    pragma Preelaborate;
  
     function Argument_Count return Natural;
     --  If the external execution environment supports passing arguments to a
diff -Nrcpad gcc-4.0.2/gcc/ada/a-contai.ads gcc-4.1.0/gcc/ada/a-contai.ads
*** gcc-4.0.2/gcc/ada/a-contai.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-contai.ads	Mon Sep  5 07:51:25 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                              ADA.CONTAINERS                              --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       A D A . C O N T A I N E R S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
***************
*** 14,20 ****
  ------------------------------------------------------------------------------
  
  package Ada.Containers is
! pragma Pure (Containers);
  
     type Hash_Type is mod 2**32;
     type Count_Type is range 0 .. 2**31 - 1;
--- 14,20 ----
  ------------------------------------------------------------------------------
  
  package Ada.Containers is
!    pragma Pure;
  
     type Hash_Type is mod 2**32;
     type Count_Type is range 0 .. 2**31 - 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-convec.adb gcc-4.1.0/gcc/ada/a-convec.adb
*** gcc-4.0.2/gcc/ada/a-convec.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-convec.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                          ADA.CONTAINERS.VECTORS                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                A D A . C O N T A I N E R S . V E C T O R S               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Containers.Vectors is
*** 67,73 ****
                           new Elements_Type'(RE);
  
           begin
!             return (Controlled with Elements, Right.Last);
           end;
        end if;
  
--- 67,73 ----
                           new Elements_Type'(RE);
  
           begin
!             return (Controlled with Elements, Right.Last, 0, 0);
           end;
        end if;
  
*************** package body Ada.Containers.Vectors is
*** 80,107 ****
                           new Elements_Type'(LE);
  
           begin
!             return (Controlled with Elements, Left.Last);
           end;
  
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
  
!          Last : constant Index_Type := Index_Type (Last_As_Int);
  
!          LE : Elements_Type renames
!                 Left.Elements (Index_Type'First .. Left.Last);
  
!          RE : Elements_Type renames
!                 Right.Elements (Index_Type'First .. Right.Last);
  
!          Elements : constant Elements_Access :=
                           new Elements_Type'(LE & RE);
  
!       begin
!          return (Controlled with Elements, Last);
        end;
     end "&";
  
--- 80,114 ----
                           new Elements_Type'(LE);
  
           begin
!             return (Controlled with Elements, Left.Last, 0, 0);
           end;
  
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                           Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             LE : Elements_Type renames
!                    Left.Elements (Index_Type'First .. Left.Last);
  
!             RE : Elements_Type renames
!                    Right.Elements (Index_Type'First .. Right.Last);
! 
!             Elements : constant Elements_Access :=
                           new Elements_Type'(LE & RE);
  
!          begin
!             return (Controlled with Elements, Last, 0, 0);
!          end;
        end;
     end "&";
  
*************** package body Ada.Containers.Vectors is
*** 118,142 ****
                           new Elements_Subtype'(others => Right);
  
           begin
!             return (Controlled with Elements, Index_Type'First);
           end;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (LN);
  
!          Last : constant Index_Type := Index_Type (Last_As_Int);
  
!          LE : Elements_Type renames
!                 Left.Elements (Index_Type'First .. Left.Last);
  
!          subtype ET is Elements_Type (Index_Type'First .. Last);
  
!          Elements : constant Elements_Access := new ET'(LE & Right);
  
!       begin
!          return (Controlled with Elements, Last);
        end;
     end "&";
  
--- 125,156 ----
                           new Elements_Subtype'(others => Right);
  
           begin
!             return (Controlled with Elements, Index_Type'First, 0, 0);
           end;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                           Int (Index_Type'First) + Int (LN);
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             LE : Elements_Type renames
!                    Left.Elements (Index_Type'First .. Left.Last);
  
!             subtype ET is Elements_Type (Index_Type'First .. Last);
  
!             Elements : constant Elements_Access := new ET'(LE & Right);
! 
!          begin
!             return (Controlled with Elements, Last, 0, 0);
!          end;
        end;
     end "&";
  
*************** package body Ada.Containers.Vectors is
*** 153,190 ****
                           new Elements_Subtype'(others => Left);
  
           begin
!             return (Controlled with Elements, Index_Type'First);
           end;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (RN);
  
!          Last : constant Index_Type := Index_Type (Last_As_Int);
  
!          RE : Elements_Type renames
!                 Right.Elements (Index_Type'First .. Right.Last);
  
!          subtype ET is Elements_Type (Index_Type'First .. Last);
  
!          Elements : constant Elements_Access := new ET'(Left & RE);
  
!       begin
!          return (Controlled with Elements, Last);
        end;
     end "&";
  
     function "&" (Left, Right  : Element_Type) return Vector is
!       subtype IT is Index_Type'Base range
!         Index_Type'First .. Index_Type'Succ (Index_Type'First);
  
!       subtype ET is Elements_Type (IT);
  
!       Elements : constant Elements_Access := new ET'(Left, Right);
  
!    begin
!       return Vector'(Controlled with Elements, Elements'Last);
     end "&";
  
     ---------
--- 167,217 ----
                           new Elements_Subtype'(others => Left);
  
           begin
!             return (Controlled with Elements, Index_Type'First, 0, 0);
           end;
        end if;
  
        declare
!          Last_As_Int : constant Int'Base :=  -- TODO: handle overflow
                           Int (Index_Type'First) + Int (RN);
  
!       begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             RE : Elements_Type renames
!                    Right.Elements (Index_Type'First .. Right.Last);
  
!             subtype ET is Elements_Type (Index_Type'First .. Last);
  
!             Elements : constant Elements_Access := new ET'(Left & RE);
! 
!          begin
!             return (Controlled with Elements, Last, 0, 0);
!          end;
        end;
     end "&";
  
     function "&" (Left, Right  : Element_Type) return Vector is
!    begin
!       if Index_Type'First >= Index_Type'Last then
!          raise Constraint_Error;
!       end if;
  
!       declare
!          Last : constant Index_Type := Index_Type'First + 1;
  
!          subtype ET is Elements_Type (Index_Type'First .. Last);
  
!          Elements : constant Elements_Access := new ET'(Left, Right);
! 
!       begin
!          return (Controlled with Elements, Last, 0, 0);
!       end;
     end "&";
  
     ---------
*************** package body Ada.Containers.Vectors is
*** 216,240 ****
  
     procedure Adjust (Container : in out Vector) is
     begin
!       if Container.Elements = null then
!          return;
!       end if;
! 
!       if Container.Elements'Length = 0
!         or else Container.Last < Index_Type'First
!       then
           Container.Elements := null;
           return;
        end if;
  
        declare
!          X : constant Elements_Access := Container.Elements;
!          L : constant Index_Type'Base := Container.Last;
!          E : Elements_Type renames X (Index_Type'First .. L);
        begin
           Container.Elements := null;
!          Container.Last := Index_Type'Pred (Index_Type'First);
!          Container.Elements := new Elements_Type'(E);
           Container.Last := L;
        end;
     end Adjust;
--- 243,263 ----
  
     procedure Adjust (Container : in out Vector) is
     begin
!       if Container.Last = No_Index then
           Container.Elements := null;
           return;
        end if;
  
        declare
!          E : constant Elements_Access := Container.Elements;
!          L : constant Index_Type := Container.Last;
! 
        begin
           Container.Elements := null;
!          Container.Last := No_Index;
!          Container.Busy := 0;
!          Container.Lock := 0;
!          Container.Elements := new Elements_Type'(E (Index_Type'First .. L));
           Container.Last := L;
        end;
     end Adjust;
*************** package body Ada.Containers.Vectors is
*** 249,257 ****
           return;
        end if;
  
        Insert
          (Container,
!          Index_Type'Succ (Container.Last),
           New_Item);
     end Append;
  
--- 272,284 ----
           return;
        end if;
  
+       if Container.Last = Index_Type'Last then
+          raise Constraint_Error;
+       end if;
+ 
        Insert
          (Container,
!          Container.Last + 1,
           New_Item);
     end Append;
  
*************** package body Ada.Containers.Vectors is
*** 265,308 ****
           return;
        end if;
  
        Insert
          (Container,
!          Index_Type'Succ (Container.Last),
           New_Item,
           Count);
     end Append;
  
-    ------------
-    -- Assign --
-    ------------
- 
-    procedure Assign
-      (Target : in out Vector;
-       Source : Vector)
-    is
-       N : constant Count_Type := Length (Source);
- 
-    begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
-       Clear (Target);
- 
-       if N = 0 then
-          return;
-       end if;
- 
-       if N > Capacity (Target) then
-          Reserve_Capacity (Target, Capacity => N);
-       end if;
- 
-       Target.Elements (Index_Type'First .. Source.Last) :=
-         Source.Elements (Index_Type'First .. Source.Last);
- 
-       Target.Last := Source.Last;
-    end Assign;
- 
     --------------
     -- Capacity --
     --------------
--- 292,308 ----
           return;
        end if;
  
+       if Container.Last = Index_Type'Last then
+          raise Constraint_Error;
+       end if;
+ 
        Insert
          (Container,
!          Container.Last + 1,
           New_Item,
           Count);
     end Append;
  
     --------------
     -- Capacity --
     --------------
*************** package body Ada.Containers.Vectors is
*** 322,328 ****
  
     procedure Clear (Container : in out Vector) is
     begin
!       Container.Last := Index_Type'Pred (Index_Type'First);
     end Clear;
  
     --------------
--- 322,332 ----
  
     procedure Clear (Container : in out Vector) is
     begin
!       if Container.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       Container.Last := No_Index;
     end Clear;
  
     --------------
*************** package body Ada.Containers.Vectors is
*** 347,385 ****
        Count     : Count_Type := 1)
     is
     begin
!       if Count = 0 then
!          return;
        end if;
  
!       declare
!          subtype I_Subtype is Index_Type'Base range
!            Index_Type'First .. Container.Last;
  
!          I : constant I_Subtype := Index;
!          --  TODO: not sure whether to relax this check ???
  
!          I_As_Int : constant Int := Int (I);
  
           Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
  
           Count1 : constant Int'Base := Count_Type'Pos (Count);
           Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
! 
!          N : constant Int'Base := Int'Min (Count1, Count2);
  
           J_As_Int : constant Int'Base := I_As_Int + N;
-          J        : constant Index_Type'Base := Index_Type'Base (J_As_Int);
  
!          E : Elements_Type renames Container.Elements.all;
  
!          New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
  
!          New_Last : constant Extended_Index :=
!                       Extended_Index (New_Last_As_Int);
  
!       begin
!          E (I .. New_Last) := E (J .. Container.Last);
!          Container.Last := New_Last;
        end;
     end Delete;
  
--- 351,404 ----
        Count     : Count_Type := 1)
     is
     begin
!       if Index < Index_Type'First then
!          raise Constraint_Error;
        end if;
  
!       if Index > Container.Last then
!          if Index > Container.Last + 1 then
!             raise Constraint_Error;
!          end if;
  
!          return;
!       end if;
  
!       if Count = 0 then
!          return;
!       end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
+       declare
+          I_As_Int        : constant Int := Int (Index);
           Old_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);
  
           Count1 : constant Int'Base := Count_Type'Pos (Count);
           Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1;
!          N      : constant Int'Base := Int'Min (Count1, Count2);
  
           J_As_Int : constant Int'Base := I_As_Int + N;
  
!       begin
!          if J_As_Int > Old_Last_As_Int then
!             Container.Last := Index - 1;
  
!          else
!             declare
!                J : constant Index_Type := Index_Type (J_As_Int);
!                E : Elements_Type renames Container.Elements.all;
  
!                New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
!                New_Last        : constant Index_Type :=
!                                    Index_Type (New_Last_As_Int);
  
!             begin
!                E (Index .. New_Last) := E (J .. Container.Last);
!                Container.Last := New_Last;
!             end;
!          end if;
        end;
     end Delete;
  
*************** package body Ada.Containers.Vectors is
*** 389,416 ****
        Count     : Count_Type := 1)
     is
     begin
! 
!       if Position.Container /= null
!         and then Position.Container /=
!                    Vector_Access'(Container'Unchecked_Access)
!       then
!          raise Program_Error;
        end if;
  
!       if Position.Container = null
          or else Position.Index > Container.Last
        then
!          Position := No_Element;
!          return;
        end if;
  
        Delete (Container, Position.Index, Count);
  
!       if Position.Index <= Container.Last then
!          Position := (Container'Unchecked_Access, Position.Index);
!       else
!          Position := No_Element;
!       end if;
     end Delete;
  
     ------------------
--- 408,436 ----
        Count     : Count_Type := 1)
     is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access
          or else Position.Index > Container.Last
        then
!          raise Program_Error;
        end if;
  
        Delete (Container, Position.Index, Count);
  
!       --  This is the old behavior, prior to the York API (2005/06):
! 
!       --  if Position.Index <= Container.Last then
!       --    Position := (Container'Unchecked_Access, Position.Index);
!       --  else
!       --    Position := No_Element;
!       --  end if;
! 
!       --  This is the behavior specified by the York API:
! 
!       Position := No_Element;
     end Delete;
  
     ------------------
*************** package body Ada.Containers.Vectors is
*** 449,462 ****
           return;
        end if;
  
!       if Count >= Length (Container) then
!          Clear (Container);
!          return;
        end if;
  
!       Index := Int'Base (Container.Last) - Int'Base (Count) + 1;
  
!       Delete (Container, Index_Type'Base (Index), Count);
     end Delete_Last;
  
     -------------
--- 469,485 ----
           return;
        end if;
  
!       if Container.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       Index := Int'Base (Container.Last) - Int'Base (Count);
  
!       if Index < Index_Type'Pos (Index_Type'First) then
!          Container.Last := No_Index;
!       else
!          Container.Last := Index_Type (Index);
!       end if;
     end Delete_Last;
  
     -------------
*************** package body Ada.Containers.Vectors is
*** 467,480 ****
       (Container : Vector;
        Index     : Index_Type) return Element_Type
     is
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Container.Last;
     begin
!       return Container.Elements (T'(Index));
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
        return Element (Position.Container.all, Position.Index);
     end Element;
  
--- 490,509 ----
       (Container : Vector;
        Index     : Index_Type) return Element_Type
     is
     begin
!       if Index > Container.Last then
!          raise Constraint_Error;
!       end if;
! 
!       return Container.Elements (Index);
     end Element;
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Container = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Element (Position.Container.all, Position.Index);
     end Element;
  
*************** package body Ada.Containers.Vectors is
*** 484,492 ****
  
     procedure Finalize (Container : in out Vector) is
        X : Elements_Access := Container.Elements;
     begin
        Container.Elements := null;
!       Container.Last := Index_Type'Pred (Index_Type'First);
        Free (X);
     end Finalize;
  
--- 513,526 ----
  
     procedure Finalize (Container : in out Vector) is
        X : Elements_Access := Container.Elements;
+ 
     begin
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        Container.Elements := null;
!       Container.Last := No_Index;
        Free (X);
     end Finalize;
  
*************** package body Ada.Containers.Vectors is
*** 497,508 ****
     function Find
       (Container : Vector;
        Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor is
! 
     begin
        if Position.Container /= null
!         and then Position.Container /=
!                    Vector_Access'(Container'Unchecked_Access)
        then
           raise Program_Error;
        end if;
--- 531,542 ----
     function Find
       (Container : Vector;
        Item      : Element_Type;
!       Position  : Cursor := No_Element) return Cursor
!    is
     begin
        if Position.Container /= null
!         and then (Position.Container /= Container'Unrestricted_Access
!                     or else Position.Index > Container.Last)
        then
           raise Program_Error;
        end if;
*************** package body Ada.Containers.Vectors is
*** 523,529 ****
     function Find_Index
       (Container : Vector;
        Item      : Element_Type;
!       Index     : Index_Type := Index_Type'First) return Extended_Index is
     begin
        for Indx in Index .. Container.Last loop
           if Container.Elements (Indx) = Item then
--- 557,564 ----
     function Find_Index
       (Container : Vector;
        Item      : Element_Type;
!       Index     : Index_Type := Index_Type'First) return Extended_Index
!    is
     begin
        for Indx in Index .. Container.Last loop
           if Container.Elements (Indx) = Item then
*************** package body Ada.Containers.Vectors is
*** 566,591 ****
        return Index_Type'First;
     end First_Index;
  
!    ------------------
!    -- Generic_Sort --
!    ------------------
  
!    procedure Generic_Sort (Container : Vector)
!    is
!       procedure Sort is
!          new Generic_Array_Sort
!           (Index_Type   => Index_Type,
!            Element_Type => Element_Type,
!            Array_Type   => Elements_Type,
!            "<"          => "<");
  
!    begin
!       if Container.Elements = null then
!          return;
!       end if;
  
!       Sort (Container.Elements (Index_Type'First .. Container.Last));
!    end Generic_Sort;
  
     -----------------
     -- Has_Element --
--- 601,712 ----
        return Index_Type'First;
     end First_Index;
  
!    ---------------------
!    -- Generic_Sorting --
!    ---------------------
  
!    package body Generic_Sorting is
  
!       ---------------
!       -- Is_Sorted --
!       ---------------
  
!       function Is_Sorted (Container : Vector) return Boolean is
!       begin
!          if Container.Last <= Index_Type'First then
!             return True;
!          end if;
! 
!          declare
!             E : Elements_Type renames Container.Elements.all;
!          begin
!             for I in Index_Type'First .. Container.Last - 1 loop
!                if E (I + 1) < E (I) then
!                   return False;
!                end if;
!             end loop;
!          end;
! 
!          return True;
!       end Is_Sorted;
! 
!       -----------
!       -- Merge --
!       -----------
! 
!       procedure Merge (Target, Source : in out Vector) is
!          I : Index_Type'Base := Target.Last;
!          J : Index_Type'Base;
! 
!       begin
!          if Target.Last < Index_Type'First then
!             Move (Target => Target, Source => Source);
!             return;
!          end if;
! 
!          if Target'Address = Source'Address then
!             return;
!          end if;
! 
!          if Source.Last < Index_Type'First then
!             return;
!          end if;
! 
!          if Source.Busy > 0 then
!             raise Program_Error;
!          end if;
! 
!          Target.Set_Length (Length (Target) + Length (Source));
! 
!          J := Target.Last;
!          while Source.Last >= Index_Type'First loop
!             if I < Index_Type'First then
!                Target.Elements (Index_Type'First .. J) :=
!                  Source.Elements (Index_Type'First .. Source.Last);
! 
!                Source.Last := No_Index;
!                return;
!             end if;
! 
!             if Source.Elements (Source.Last) < Target.Elements (I) then
!                Target.Elements (J) := Target.Elements (I);
!                I := I - 1;
! 
!             else
!                Target.Elements (J) := Source.Elements (Source.Last);
!                Source.Last := Source.Last - 1;
!             end if;
! 
!             J := J - 1;
!          end loop;
!       end Merge;
! 
!       ----------
!       -- Sort --
!       ----------
! 
!       procedure Sort (Container : in out Vector)
!       is
!          procedure Sort is
!             new Generic_Array_Sort
!              (Index_Type   => Index_Type,
!               Element_Type => Element_Type,
!               Array_Type   => Elements_Type,
!               "<"          => "<");
! 
!       begin
!          if Container.Last <= Index_Type'First then
!             return;
!          end if;
! 
!          if Container.Lock > 0 then
!             raise Program_Error;
!          end if;
! 
!          Sort (Container.Elements (Index_Type'First .. Container.Last));
!       end Sort;
! 
!    end Generic_Sorting;
  
     -----------------
     -- Has_Element --
*************** package body Ada.Containers.Vectors is
*** 610,649 ****
        New_Item  : Element_Type;
        Count     : Count_Type := 1)
     is
-       Old_Last : constant Extended_Index := Container.Last;
- 
-       Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
- 
        N : constant Int := Count_Type'Pos (Count);
  
!       New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
  
!       New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
  
!       Index : Index_Type;
  
!       Dst_Last : Index_Type;
!       Dst      : Elements_Access;
  
-    begin
        if Count = 0 then
           return;
        end if;
  
        declare
!          subtype Before_Subtype is Index_Type'Base range
!            Index_Type'First .. Index_Type'Succ (Container.Last);
  
!          Old_First : constant Before_Subtype := Before;
  
!          Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
  
!          New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
  
!       begin
!          Index := Index_Type (New_First_As_Int);
        end;
  
        if Container.Elements = null then
           declare
              subtype Elements_Subtype is
--- 731,777 ----
        New_Item  : Element_Type;
        Count     : Count_Type := 1)
     is
        N : constant Int := Count_Type'Pos (Count);
  
!       New_Last_As_Int : Int'Base;
!       New_Last        : Index_Type;
  
!       Dst : Elements_Access;
  
!    begin
!       if Before < Index_Type'First then
!          raise Constraint_Error;
!       end if;
  
!       if Before > Container.Last
!         and then Before > Container.Last + 1
!       then
!          raise Constraint_Error;
!       end if;
  
        if Count = 0 then
           return;
        end if;
  
        declare
!          Old_Last : constant Extended_Index := Container.Last;
  
!          Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
  
!       begin
!          New_Last_As_Int := Old_Last_As_Int + N;
  
!          if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          New_Last := Index_Type (New_Last_As_Int);
        end;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        if Container.Elements = null then
           declare
              subtype Elements_Subtype is
*************** package body Ada.Containers.Vectors is
*** 660,667 ****
           declare
              E : Elements_Type renames Container.Elements.all;
           begin
!             E (Index .. New_Last) := E (Before .. Container.Last);
!             E (Before .. Index_Type'Pred (Index)) := (others => New_Item);
           end;
  
           Container.Last := New_Last;
--- 788,810 ----
           declare
              E : Elements_Type renames Container.Elements.all;
           begin
!             if Before <= Container.Last then
!                declare
!                   Index_As_Int : constant Int'Base :=
!                                    Index_Type'Pos (Before) + N;
! 
!                   Index : constant Index_Type := Index_Type (Index_As_Int);
! 
!                begin
!                   E (Index .. New_Last) := E (Before .. Container.Last);
! 
!                   E (Before .. Index_Type'Pred (Index)) :=
!                       (others => New_Item);
!                end;
! 
!             else
!                E (Before .. New_Last) := (others => New_Item);
!             end if;
           end;
  
           Container.Last := New_Last;
*************** package body Ada.Containers.Vectors is
*** 669,703 ****
        end if;
  
        declare
!          First : constant Int := Int (Index_Type'First);
! 
           New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
! 
!          Size, Dst_Last_As_Int : Int'Base;
  
        begin
!          if New_Size >= Max_Size / 2 then
!             Dst_Last := Index_Type'Last;
  
!          else
!             Size := Container.Elements'Length;
  
!             if Size = 0 then
!                Size := 1;
!             end if;
  
!             while Size < New_Size loop
!                Size := 2 * Size;
!             end loop;
  
!             Dst_Last_As_Int := First + Size - 1;
!             Dst_Last := Index_Type (Dst_Last_As_Int);
!          end if;
        end;
  
-       Dst := new Elements_Type (Index_Type'First .. Dst_Last);
- 
        declare
           Src : Elements_Type renames Container.Elements.all;
  
--- 812,851 ----
        end if;
  
        declare
!          First    : constant Int := Int (Index_Type'First);
           New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Size     : Int'Base := Int'Max (1, Container.Elements'Length);
  
        begin
!          while Size < New_Size loop
!             if Size > Int'Last / 2 then
!                Size := Int'Last;
!                exit;
!             end if;
  
!             Size := 2 * Size;
!          end loop;
  
!          --  TODO: The following calculations aren't quite right, since
!          --  there will be overflow if Index_Type'Range is very large
!          --  (e.g. this package is instantiated with a 64-bit integer).
!          --  END TODO.
  
!          declare
!             Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
!          begin
!             if Size > Max_Size then
!                Size := Max_Size;
!             end if;
!          end;
  
!          declare
!             Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
!          begin
!             Dst := new Elements_Type (Index_Type'First .. Dst_Last);
!          end;
        end;
  
        declare
           Src : Elements_Type renames Container.Elements.all;
  
*************** package body Ada.Containers.Vectors is
*** 705,716 ****
           Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
             Src (Index_Type'First .. Index_Type'Pred (Before));
  
!          Dst (Before .. Index_Type'Pred (Index)) :=
!            (others => New_Item);
  
!          Dst (Index .. New_Last) :=
!            Src (Before .. Container.Last);
  
        exception
           when others =>
              Free (Dst);
--- 853,873 ----
           Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
             Src (Index_Type'First .. Index_Type'Pred (Before));
  
!          if Before <= Container.Last then
!             declare
!                Index_As_Int : constant Int'Base :=
!                                 Index_Type'Pos (Before) + N;
  
!                Index : constant Index_Type := Index_Type (Index_As_Int);
  
+             begin
+                Dst (Before .. Index_Type'Pred (Index)) := (others => New_Item);
+                Dst (Index .. New_Last) := Src (Before .. Container.Last);
+             end;
+ 
+          else
+             Dst (Before .. New_Last) := (others => New_Item);
+          end if;
        exception
           when others =>
              Free (Dst);
*************** package body Ada.Containers.Vectors is
*** 734,739 ****
--- 891,906 ----
        N : constant Count_Type := Length (New_Item);
  
     begin
+       if Before < Index_Type'First then
+          raise Constraint_Error;
+       end if;
+ 
+       if Before > Container.Last
+         and then Before > Container.Last + 1
+       then
+          raise Constraint_Error;
+       end if;
+ 
        if N = 0 then
           return;
        end if;
*************** package body Ada.Containers.Vectors is
*** 747,797 ****
           Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
  
        begin
!          if Container'Address = New_Item'Address then
!             declare
!                subtype Src_Index_Subtype is Index_Type'Base range
!                  Index_Type'First .. Index_Type'Pred (Before);
  
!                Src : Elements_Type renames
!                        Container.Elements (Src_Index_Subtype);
  
!                Index_As_Int : constant Int'Base :=
!                                 Int (Before) + Src'Length - 1;
  
!                Index : constant Index_Type'Base :=
!                          Index_Type'Base (Index_As_Int);
  
!                Dst : Elements_Type renames
!                        Container.Elements (Before .. Index);
  
!             begin
!                Dst := Src;
!             end;
  
!             declare
!                subtype Src_Index_Subtype is Index_Type'Base range
!                  Index_Type'Succ (Dst_Last) .. Container.Last;
  
!                Src : Elements_Type renames
!                        Container.Elements (Src_Index_Subtype);
  
!                Index_As_Int : constant Int'Base :=
!                                 Dst_Last_As_Int - Src'Length + 1;
  
!                Index : constant Index_Type'Base :=
!                          Index_Type'Base (Index_As_Int);
  
!                Dst : Elements_Type renames
!                        Container.Elements (Index .. Dst_Last);
  
!             begin
!                Dst := Src;
!             end;
  
!          else
!             Container.Elements (Before .. Dst_Last) :=
!               New_Item.Elements (Index_Type'First .. New_Item.Last);
!          end if;
        end;
     end Insert;
  
--- 914,969 ----
           Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
  
        begin
!          if Container'Address /= New_Item'Address then
!             Container.Elements (Before .. Dst_Last) :=
!               New_Item.Elements (Index_Type'First .. New_Item.Last);
  
!             return;
!          end if;
  
!          declare
!             subtype Src_Index_Subtype is Index_Type'Base range
!               Index_Type'First .. Before - 1;
  
!             Src : Elements_Type renames
!                     Container.Elements (Src_Index_Subtype);
  
!             Index_As_Int : constant Int'Base :=
!                              Int (Before) + Src'Length - 1;
  
!             Index : constant Index_Type'Base :=
!                       Index_Type'Base (Index_As_Int);
  
!             Dst : Elements_Type renames
!                     Container.Elements (Before .. Index);
  
!          begin
!             Dst := Src;
!          end;
  
!          if Dst_Last = Container.Last then
!             return;
!          end if;
  
!          declare
!             subtype Src_Index_Subtype is Index_Type'Base range
!               Dst_Last + 1 .. Container.Last;
  
!             Src : Elements_Type renames
!                     Container.Elements (Src_Index_Subtype);
  
!             Index_As_Int : constant Int'Base :=
!                              Dst_Last_As_Int - Src'Length + 1;
  
!             Index : constant Index_Type :=
!                       Index_Type (Index_As_Int);
! 
!             Dst : Elements_Type renames
!                     Container.Elements (Index .. Dst_Last);
! 
!          begin
!             Dst := Src;
!          end;
        end;
     end Insert;
  
*************** package body Ada.Containers.Vectors is
*** 816,822 ****
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
           Index := Before.Index;
        end if;
--- 988,999 ----
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
! 
!          Index := Container.Last + 1;
! 
        else
           Index := Before.Index;
        end if;
*************** package body Ada.Containers.Vectors is
*** 854,860 ****
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
           Index := Before.Index;
        end if;
--- 1031,1042 ----
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
! 
!          Index := Container.Last + 1;
! 
        else
           Index := Before.Index;
        end if;
*************** package body Ada.Containers.Vectors is
*** 886,892 ****
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
           Index := Before.Index;
        end if;
--- 1068,1079 ----
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
! 
!          Index := Container.Last + 1;
! 
        else
           Index := Before.Index;
        end if;
*************** package body Ada.Containers.Vectors is
*** 925,931 ****
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
           Index := Before.Index;
        end if;
--- 1112,1123 ----
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
! 
!          Index := Container.Last + 1;
! 
        else
           Index := Before.Index;
        end if;
*************** package body Ada.Containers.Vectors is
*** 935,940 ****
--- 1127,1157 ----
        Position := Cursor'(Container'Unchecked_Access, Index);
     end Insert;
  
+    procedure Insert
+      (Container : in out Vector;
+       Before    : Extended_Index;
+       Count     : Count_Type := 1)
+    is
+       New_Item : Element_Type;  -- Default-initialized value
+       pragma Warnings (Off, New_Item);
+ 
+    begin
+       Insert (Container, Before, New_Item, Count);
+    end Insert;
+ 
+    procedure Insert
+      (Container : in out Vector;
+       Before    : Cursor;
+       Position  : out Cursor;
+       Count     : Count_Type := 1)
+    is
+       New_Item : Element_Type;  -- Default-initialized value
+       pragma Warnings (Off, New_Item);
+ 
+    begin
+       Insert (Container, Before, New_Item, Position, Count);
+    end Insert;
+ 
     ------------------
     -- Insert_Space --
     ------------------
*************** package body Ada.Containers.Vectors is
*** 944,983 ****
        Before    : Extended_Index;
        Count     : Count_Type := 1)
     is
-       Old_Last : constant Extended_Index := Container.Last;
- 
-       Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
- 
        N : constant Int := Count_Type'Pos (Count);
  
!       New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;
  
!       New_Last : constant Extended_Index := Extended_Index (New_Last_As_Int);
  
!       Index : Index_Type;
  
!       Dst_Last : Index_Type;
!       Dst      : Elements_Access;
  
-    begin
        if Count = 0 then
           return;
        end if;
  
        declare
!          subtype Before_Subtype is Index_Type'Base range
!            Index_Type'First .. Index_Type'Succ (Container.Last);
  
!          Old_First : constant Before_Subtype := Before;
  
!          Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);
  
!          New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
  
!       begin
!          Index := Index_Type (New_First_As_Int);
        end;
  
        if Container.Elements = null then
           Container.Elements :=
             new Elements_Type (Index_Type'First .. New_Last);
--- 1161,1207 ----
        Before    : Extended_Index;
        Count     : Count_Type := 1)
     is
        N : constant Int := Count_Type'Pos (Count);
  
!       New_Last_As_Int : Int'Base;
!       New_Last        : Index_Type;
  
!       Dst : Elements_Access;
  
!    begin
!       if Before < Index_Type'First then
!          raise Constraint_Error;
!       end if;
  
!       if Before > Container.Last
!         and then Before > Container.Last + 1
!       then
!          raise Constraint_Error;
!       end if;
  
        if Count = 0 then
           return;
        end if;
  
        declare
!          Old_Last : constant Extended_Index := Container.Last;
  
!          Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);
  
!       begin
!          New_Last_As_Int := Old_Last_As_Int + N;
  
!          if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
  
!          New_Last := Index_Type (New_Last_As_Int);
        end;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        if Container.Elements = null then
           Container.Elements :=
             new Elements_Type (Index_Type'First .. New_Last);
*************** package body Ada.Containers.Vectors is
*** 990,996 ****
           declare
              E : Elements_Type renames Container.Elements.all;
           begin
!             E (Index .. New_Last) := E (Before .. Container.Last);
           end;
  
           Container.Last := New_Last;
--- 1214,1230 ----
           declare
              E : Elements_Type renames Container.Elements.all;
           begin
!             if Before <= Container.Last then
!                declare
!                   Index_As_Int : constant Int'Base :=
!                                    Index_Type'Pos (Before) + N;
! 
!                   Index : constant Index_Type := Index_Type (Index_As_Int);
! 
!                begin
!                   E (Index .. New_Last) := E (Before .. Container.Last);
!                end;
!             end if;
           end;
  
           Container.Last := New_Last;
*************** package body Ada.Containers.Vectors is
*** 998,1032 ****
        end if;
  
        declare
!          First : constant Int := Int (Index_Type'First);
! 
           New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
! 
!          Size, Dst_Last_As_Int : Int'Base;
  
        begin
!          if New_Size >= Max_Size / 2 then
!             Dst_Last := Index_Type'Last;
  
!          else
!             Size := Container.Elements'Length;
  
!             if Size = 0 then
!                Size := 1;
!             end if;
  
!             while Size < New_Size loop
!                Size := 2 * Size;
!             end loop;
  
!             Dst_Last_As_Int := First + Size - 1;
!             Dst_Last := Index_Type (Dst_Last_As_Int);
!          end if;
        end;
  
-       Dst := new Elements_Type (Index_Type'First .. Dst_Last);
- 
        declare
           Src : Elements_Type renames Container.Elements.all;
  
--- 1232,1271 ----
        end if;
  
        declare
!          First    : constant Int := Int (Index_Type'First);
           New_Size : constant Int'Base := New_Last_As_Int - First + 1;
!          Size     : Int'Base := Int'Max (1, Container.Elements'Length);
  
        begin
!          while Size < New_Size loop
!             if Size > Int'Last / 2 then
!                Size := Int'Last;
!                exit;
!             end if;
  
!             Size := 2 * Size;
!          end loop;
  
!          --  TODO: The following calculations aren't quite right, since
!          --  there will be overflow if Index_Type'Range is very large
!          --  (e.g. this package is instantiated with a 64-bit integer).
!          --  END TODO.
  
!          declare
!             Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
!          begin
!             if Size > Max_Size then
!                Size := Max_Size;
!             end if;
!          end;
  
!          declare
!             Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
!          begin
!             Dst := new Elements_Type (Index_Type'First .. Dst_Last);
!          end;
        end;
  
        declare
           Src : Elements_Type renames Container.Elements.all;
  
*************** package body Ada.Containers.Vectors is
*** 1034,1042 ****
           Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
             Src (Index_Type'First .. Index_Type'Pred (Before));
  
!          Dst (Index .. New_Last) :=
!            Src (Before .. Container.Last);
  
        exception
           when others =>
              Free (Dst);
--- 1273,1289 ----
           Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
             Src (Index_Type'First .. Index_Type'Pred (Before));
  
!          if Before <= Container.Last then
!             declare
!                Index_As_Int : constant Int'Base :=
!                                 Index_Type'Pos (Before) + N;
  
+                Index : constant Index_Type := Index_Type (Index_As_Int);
+ 
+             begin
+                Dst (Index .. New_Last) := Src (Before .. Container.Last);
+             end;
+          end if;
        exception
           when others =>
              Free (Dst);
*************** package body Ada.Containers.Vectors is
*** 1048,1054 ****
        begin
           Container.Elements := Dst;
           Container.Last := New_Last;
- 
           Free (X);
        end;
     end Insert_Space;
--- 1295,1300 ----
*************** package body Ada.Containers.Vectors is
*** 1083,1094 ****
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          Index := Index_Type'Succ (Container.Last);
        else
           Index := Before.Index;
        end if;
  
!       Insert_Space (Container, Index, Count);
  
        Position := Cursor'(Container'Unchecked_Access, Index);
     end Insert_Space;
--- 1329,1345 ----
        if Before.Container = null
          or else Before.Index > Container.Last
        then
!          if Container.Last = Index_Type'Last then
!             raise Constraint_Error;
!          end if;
! 
!          Index := Container.Last + 1;
! 
        else
           Index := Before.Index;
        end if;
  
!       Insert_Space (Container, Index, Count => Count);
  
        Position := Cursor'(Container'Unchecked_Access, Index);
     end Insert_Space;
*************** package body Ada.Containers.Vectors is
*** 1110,1119 ****
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor))
     is
     begin
!       for Indx in Index_Type'First .. Container.Last loop
!          Process (Cursor'(Container'Unchecked_Access, Indx));
!       end loop;
     end Iterate;
  
     ----------
--- 1361,1383 ----
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor))
     is
+       V : Vector renames Container'Unrestricted_Access.all;
+       B : Natural renames V.Busy;
+ 
     begin
!       B := B + 1;
! 
!       begin
!          for Indx in Index_Type'First .. Container.Last loop
!             Process (Cursor'(Container'Unchecked_Access, Indx));
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Vectors is
*** 1155,1161 ****
--- 1419,1430 ----
        L : constant Int := Int (Container.Last);
        F : constant Int := Int (Index_Type'First);
        N : constant Int'Base := L - F + 1;
+ 
     begin
+       if N > Count_Type'Pos (Count_Type'Last) then
+          raise Constraint_Error;
+       end if;
+ 
        return Count_Type (N);
     end Length;
  
*************** package body Ada.Containers.Vectors is
*** 1167,1191 ****
       (Target : in out Vector;
        Source : in out Vector)
     is
-       X : Elements_Access := Target.Elements;
- 
     begin
        if Target'Address = Source'Address then
           return;
        end if;
  
!       if Target.Last >= Index_Type'First then
!          raise Constraint_Error;
        end if;
  
!       Target.Elements := null;
!       Free (X);
  
!       Target.Elements := Source.Elements;
!       Target.Last := Source.Last;
  
!       Source.Elements := null;
!       Source.Last := Index_Type'Pred (Index_Type'First);
     end Move;
  
     ----------
--- 1436,1463 ----
       (Target : in out Vector;
        Source : in out Vector)
     is
     begin
        if Target'Address = Source'Address then
           return;
        end if;
  
!       if Target.Busy > 0 then
!          raise Program_Error;
        end if;
  
!       if Source.Busy > 0 then
!          raise Program_Error;
!       end if;
  
!       declare
!          Target_Elements : constant Elements_Access := Target.Elements;
!       begin
!          Target.Elements := Source.Elements;
!          Source.Elements := Target_Elements;
!       end;
  
!       Target.Last := Source.Last;
!       Source.Last := No_Index;
     end Move;
  
     ----------
*************** package body Ada.Containers.Vectors is
*** 1199,1205 ****
        end if;
  
        if Position.Index < Position.Container.Last then
!          return (Position.Container, Index_Type'Succ (Position.Index));
        end if;
  
        return No_Element;
--- 1471,1477 ----
        end if;
  
        if Position.Index < Position.Container.Last then
!          return (Position.Container, Position.Index + 1);
        end if;
  
        return No_Element;
*************** package body Ada.Containers.Vectors is
*** 1216,1222 ****
        end if;
  
        if Position.Index < Position.Container.Last then
!          Position.Index := Index_Type'Succ (Position.Index);
        else
           Position := No_Element;
        end if;
--- 1488,1494 ----
        end if;
  
        if Position.Index < Position.Container.Last then
!          Position.Index := Position.Index + 1;
        else
           Position := No_Element;
        end if;
*************** package body Ada.Containers.Vectors is
*** 1254,1260 ****
        end if;
  
        if Position.Index > Index_Type'First then
!          Position.Index := Index_Type'Pred (Position.Index);
        else
           Position := No_Element;
        end if;
--- 1526,1532 ----
        end if;
  
        if Position.Index > Index_Type'First then
!          Position.Index := Position.Index - 1;
        else
           Position := No_Element;
        end if;
*************** package body Ada.Containers.Vectors is
*** 1267,1273 ****
        end if;
  
        if Position.Index > Index_Type'First then
!          return (Position.Container, Index_Type'Pred (Position.Index));
        end if;
  
        return No_Element;
--- 1539,1545 ----
        end if;
  
        if Position.Index > Index_Type'First then
!          return (Position.Container, Position.Index - 1);
        end if;
  
        return No_Element;
*************** package body Ada.Containers.Vectors is
*** 1282,1304 ****
        Index     : Index_Type;
        Process   : not null access procedure (Element : Element_Type))
     is
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
     begin
!       Process (Container.Elements (T'(Index)));
     end Query_Element;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type))
     is
-       Container : Vector renames Position.Container.all;
- 
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Container.Last;
- 
     begin
!       Process (Container.Elements (T'(Position.Index)));
     end Query_Element;
  
     ----------
--- 1554,1594 ----
        Index     : Index_Type;
        Process   : not null access procedure (Element : Element_Type))
     is
!       V : Vector renames Container'Unrestricted_Access.all;
!       B : Natural renames V.Busy;
!       L : Natural renames V.Lock;
! 
     begin
!       if Index > Container.Last then
!          raise Constraint_Error;
!       end if;
! 
!       B := B + 1;
!       L := L + 1;
! 
!       begin
!          Process (V.Elements (Index));
!       exception
!          when others =>
!             L := L - 1;
!             B := B - 1;
!             raise;
!       end;
! 
!       L := L - 1;
!       B := B - 1;
     end Query_Element;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
! 
!       Query_Element (Position.Container.all, Position.Index, Process);
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Vectors is
*** 1310,1316 ****
        Container : out Vector)
     is
        Length : Count_Type'Base;
!       Last   : Index_Type'Base := Index_Type'Pred (Index_Type'First);
  
     begin
        Clear (Container);
--- 1600,1606 ----
        Container : out Vector)
     is
        Length : Count_Type'Base;
!       Last   : Index_Type'Base := No_Index;
  
     begin
        Clear (Container);
*************** package body Ada.Containers.Vectors is
*** 1322,1353 ****
        end if;
  
        for J in Count_Type range 1 .. Length loop
!          Last := Index_Type'Succ (Last);
           Element_Type'Read (Stream, Container.Elements (Last));
           Container.Last := Last;
        end loop;
     end Read;
  
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Container : Vector;
        Index     : Index_Type;
!       By        : Element_Type)
     is
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Container.Last;
     begin
!       Container.Elements (T'(Index)) := By;
     end Replace_Element;
  
!    procedure Replace_Element (Position : Cursor; By : Element_Type) is
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Position.Container.Last;
     begin
!       Position.Container.Elements (T'(Position.Index)) := By;
     end Replace_Element;
  
     ----------------------
--- 1612,1667 ----
        end if;
  
        for J in Count_Type range 1 .. Length loop
!          Last := Last + 1;
           Element_Type'Read (Stream, Container.Elements (Last));
           Container.Last := Last;
        end loop;
     end Read;
  
+    procedure Read
+      (Stream   : access Root_Stream_Type'Class;
+       Position : out Cursor)
+    is
+    begin
+       raise Program_Error;
+    end Read;
+ 
     ---------------------
     -- Replace_Element --
     ---------------------
  
     procedure Replace_Element
!      (Container : in out Vector;
        Index     : Index_Type;
!       New_Item  : Element_Type)
     is
     begin
!       if Index > Container.Last then
!          raise Constraint_Error;
!       end if;
! 
!       if Container.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       Container.Elements (Index) := New_Item;
     end Replace_Element;
  
!    procedure Replace_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       Replace_Element (Container, Position.Index, New_Item);
     end Replace_Element;
  
     ----------------------
*************** package body Ada.Containers.Vectors is
*** 1371,1376 ****
--- 1685,1694 ----
              end;
  
           elsif N < Container.Elements'Length then
+             if Container.Busy > 0 then
+                raise Program_Error;
+             end if;
+ 
              declare
                 subtype Array_Index_Subtype is Index_Type'Base range
                   Index_Type'First .. Container.Last;
*************** package body Ada.Containers.Vectors is
*** 1397,1409 ****
              Last_As_Int : constant Int'Base :=
                              Int (Index_Type'First) + Int (Capacity) - 1;
  
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             subtype Array_Subtype is
!               Elements_Type (Index_Type'First .. Last);
  
!          begin
!             Container.Elements := new Array_Subtype;
           end;
  
           return;
--- 1715,1733 ----
              Last_As_Int : constant Int'Base :=
                              Int (Index_Type'First) + Int (Capacity) - 1;
  
!          begin
!             if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!                raise Constraint_Error;
!             end if;
  
!             declare
!                Last : constant Index_Type := Index_Type (Last_As_Int);
  
!                subtype Array_Subtype is
!                  Elements_Type (Index_Type'First .. Last);
!             begin
!                Container.Elements := new Array_Subtype;
!             end;
           end;
  
           return;
*************** package body Ada.Containers.Vectors is
*** 1411,1416 ****
--- 1735,1744 ----
  
        if Capacity <= N then
           if N < Container.Elements'Length then
+             if Container.Busy > 0 then
+                raise Program_Error;
+             end if;
+ 
              declare
                 subtype Array_Index_Subtype is Index_Type'Base range
                   Index_Type'First .. Container.Last;
*************** package body Ada.Containers.Vectors is
*** 1437,1479 ****
           return;
        end if;
  
        declare
           Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (Capacity) - 1;
  
-          Last : constant Index_Type := Index_Type (Last_As_Int);
- 
-          subtype Array_Subtype is
-            Elements_Type (Index_Type'First .. Last);
- 
-          E : Elements_Access := new Array_Subtype;
- 
        begin
           declare
!             Src : Elements_Type renames
!                     Container.Elements (Index_Type'First .. Container.Last);
  
!             Tgt : Elements_Type renames
!                     E (Index_Type'First .. Container.Last);
  
           begin
!             Tgt := Src;
  
!          exception
!             when others =>
!                Free (E);
!                raise;
!          end;
  
!          declare
!             X : Elements_Access := Container.Elements;
!          begin
!             Container.Elements := E;
!             Free (X);
           end;
        end;
     end Reserve_Capacity;
  
     ------------------
     -- Reverse_Find --
     ------------------
--- 1765,1853 ----
           return;
        end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
        declare
           Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (Capacity) - 1;
  
        begin
+          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
+             raise Constraint_Error;
+          end if;
+ 
           declare
!             Last : constant Index_Type := Index_Type (Last_As_Int);
  
!             subtype Array_Subtype is
!               Elements_Type (Index_Type'First .. Last);
! 
!             E : Elements_Access := new Array_Subtype;
  
           begin
!             declare
!                Src : Elements_Type renames
!                        Container.Elements (Index_Type'First .. Container.Last);
  
!                Tgt : Elements_Type renames
!                        E (Index_Type'First .. Container.Last);
  
!             begin
!                Tgt := Src;
! 
!             exception
!                when others =>
!                   Free (E);
!                   raise;
!             end;
! 
!             declare
!                X : Elements_Access := Container.Elements;
!             begin
!                Container.Elements := E;
!                Free (X);
!             end;
           end;
        end;
     end Reserve_Capacity;
  
+    ----------------------
+    -- Reverse_Elements --
+    ----------------------
+ 
+    procedure Reverse_Elements (Container : in out Vector) is
+    begin
+       if Container.Length <= 1 then
+          return;
+       end if;
+ 
+       if Container.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
+       declare
+          I : Index_Type := Index_Type'First;
+          J : Index_Type := Container.Last;
+          E : Elements_Type renames Container.Elements.all;
+ 
+       begin
+          while I < J loop
+             declare
+                EI : constant Element_Type := E (I);
+ 
+             begin
+                E (I) := E (J);
+                E (J) := EI;
+             end;
+ 
+             I := I + 1;
+             J := J - 1;
+          end loop;
+       end;
+    end Reverse_Elements;
+ 
     ------------------
     -- Reverse_Find --
     ------------------
*************** package body Ada.Containers.Vectors is
*** 1545,1554 ****
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor))
     is
     begin
!       for Indx in reverse Index_Type'First .. Container.Last loop
!          Process (Cursor'(Container'Unchecked_Access, Indx));
!       end loop;
     end Reverse_Iterate;
  
     ----------------
--- 1919,1943 ----
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor))
     is
+       V : Vector renames Container'Unrestricted_Access.all;
+       B : Natural renames V.Busy;
+ 
     begin
! 
!       B := B + 1;
! 
!       begin
!          for Indx in reverse Index_Type'First .. Container.Last loop
!             Process (Cursor'(Container'Unchecked_Access, Indx));
!          end loop;
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
! 
     end Reverse_Iterate;
  
     ----------------
*************** package body Ada.Containers.Vectors is
*** 1557,1579 ****
  
     procedure Set_Length (Container : in out Vector; Length : Count_Type) is
     begin
!       if Length = 0 then
!          Clear (Container);
           return;
        end if;
  
        declare
           Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (Length) - 1;
- 
-          Last        : constant Index_Type := Index_Type (Last_As_Int);
- 
        begin
!          if Length > Capacity (Container) then
!             Reserve_Capacity (Container, Capacity => Length);
!          end if;
! 
!          Container.Last := Last;
        end;
     end Set_Length;
  
--- 1946,1968 ----
  
     procedure Set_Length (Container : in out Vector; Length : Count_Type) is
     begin
!       if Length = Vectors.Length (Container) then
           return;
        end if;
  
+       if Container.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
+       if Length > Capacity (Container) then
+          Reserve_Capacity (Container, Capacity => Length);
+       end if;
+ 
        declare
           Last_As_Int : constant Int'Base :=
                           Int (Index_Type'First) + Int (Length) - 1;
        begin
!          Container.Last := Index_Type'Base (Last_As_Int);
        end;
     end Set_Length;
  
*************** package body Ada.Containers.Vectors is
*** 1581,1624 ****
     -- Swap --
     ----------
  
!    procedure Swap
!      (Container : Vector;
!       I, J      : Index_Type)
!    is
! 
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
! 
!       EI : constant Element_Type := Container.Elements (T'(I));
! 
     begin
  
!       Container.Elements (T'(I)) := Container.Elements (T'(J));
!       Container.Elements (T'(J)) := EI;
! 
!    end Swap;
! 
!    procedure Swap (I, J : Cursor) is
  
!       --  NOTE: The behavior has been liberalized here to
!       --  allow I and J to designate different containers.
!       --  TODO: Probably this is supposed to raise P_E ???
  
!       subtype TI is Index_Type'Base range
!         Index_Type'First .. I.Container.Last;
  
!       EI : Element_Type renames I.Container.Elements (TI'(I.Index));
  
!       EI_Copy : constant Element_Type := EI;
  
!       subtype TJ is Index_Type'Base range
!         Index_Type'First .. J.Container.Last;
  
!       EJ : Element_Type renames J.Container.Elements (TJ'(J.Index));
  
!    begin
!       EI := EJ;
!       EJ := EI_Copy;
     end Swap;
  
     ---------------
--- 1970,2018 ----
     -- Swap --
     ----------
  
!    procedure Swap (Container : in out Vector; I, J : Index_Type) is
     begin
+       if I > Container.Last
+         or else J > Container.Last
+       then
+          raise Constraint_Error;
+       end if;
  
!       if I = J then
!          return;
!       end if;
  
!       if Container.Lock > 0 then
!          raise Program_Error;
!       end if;
  
!       declare
!          EI : Element_Type renames Container.Elements (I);
!          EJ : Element_Type renames Container.Elements (J);
  
!          EI_Copy : constant Element_Type := EI;
  
!       begin
!          EI := EJ;
!          EJ := EI_Copy;
!       end;
!    end Swap;
  
!    procedure Swap (Container : in out Vector; I, J : Cursor) is
!    begin
!       if I.Container = null
!         or else J.Container = null
!       then
!          raise Constraint_Error;
!       end if;
  
!       if I.Container /= Container'Unrestricted_Access
!         or else J.Container /= Container'Unrestricted_Access
!       then
!          raise Program_Error;
!       end if;
  
!       Swap (Container, I.Index, J.Index);
     end Swap;
  
     ---------------
*************** package body Ada.Containers.Vectors is
*** 1667,1677 ****
        declare
           First       : constant Int := Int (Index_Type'First);
           Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : constant Index_Type := Index_Type (Last_As_Int);
!          Elements    : constant Elements_Access :=
!                          new Elements_Type (Index_Type'First .. Last);
        begin
!          return (Controlled with Elements, Last);
        end;
     end To_Vector;
  
--- 2061,2078 ----
        declare
           First       : constant Int := Int (Index_Type'First);
           Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : Index_Type;
!          Elements    : Elements_Access;
! 
        begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
! 
!          Last := Index_Type (Last_As_Int);
!          Elements := new Elements_Type (Index_Type'First .. Last);
! 
!          return (Controlled with Elements, Last, 0, 0);
        end;
     end To_Vector;
  
*************** package body Ada.Containers.Vectors is
*** 1687,1698 ****
        declare
           First       : constant Int := Int (Index_Type'First);
           Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : constant Index_Type := Index_Type (Last_As_Int);
!          Elements    : constant Elements_Access :=
!                          new Elements_Type'
!                                    (Index_Type'First .. Last => New_Item);
        begin
!          return (Controlled with Elements, Last);
        end;
     end To_Vector;
  
--- 2088,2105 ----
        declare
           First       : constant Int := Int (Index_Type'First);
           Last_As_Int : constant Int'Base := First + Int (Length) - 1;
!          Last        : Index_Type;
!          Elements    : Elements_Access;
! 
        begin
!          if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
!             raise Constraint_Error;
!          end if;
! 
!          Last := Index_Type (Last_As_Int);
!          Elements := new Elements_Type'(Index_Type'First .. Last => New_Item);
! 
!          return (Controlled with Elements, Last, 0, 0);
        end;
     end To_Vector;
  
*************** package body Ada.Containers.Vectors is
*** 1701,1724 ****
     --------------------
  
     procedure Update_Element
!      (Container : Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type))
     is
!       subtype T is Index_Type'Base range
!         Index_Type'First .. Container.Last;
     begin
!       Process (Container.Elements (T'(Index)));
     end Update_Element;
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
-       subtype T is Index_Type'Base range
-         Index_Type'First .. Position.Container.Last;
     begin
!       Process (Position.Container.Elements (T'(Position.Index)));
     end Update_Element;
  
     -----------
--- 2108,2156 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type))
     is
!       B : Natural renames Container.Busy;
!       L : Natural renames Container.Lock;
! 
     begin
!       if Index > Container.Last then
!          raise Constraint_Error;
!       end if;
! 
!       B := B + 1;
!       L := L + 1;
! 
!       begin
!          Process (Container.Elements (Index));
!       exception
!          when others =>
!             L := L - 1;
!             B := B - 1;
!             raise;
!       end;
! 
!       L := L - 1;
!       B := B - 1;
     end Update_Element;
  
     procedure Update_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type))
     is
     begin
!       if Position.Container = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       Update_Element (Container, Position.Index, Process);
     end Update_Element;
  
     -----------
*************** package body Ada.Containers.Vectors is
*** 1737,1741 ****
        end loop;
     end Write;
  
! end Ada.Containers.Vectors;
  
--- 2169,2180 ----
        end loop;
     end Write;
  
!    procedure Write
!      (Stream   : access Root_Stream_Type'Class;
!       Position : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Vectors;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-convec.ads gcc-4.1.0/gcc/ada/a-convec.ads
*** gcc-4.0.2/gcc/ada/a-convec.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-convec.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                          ADA.CONTAINERS.VECTORS                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                A D A . C O N T A I N E R S . V E C T O R S               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 42,58 ****
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Vectors is
! pragma Preelaborate (Vectors);
  
     subtype Extended_Index is Index_Type'Base
       range Index_Type'First - 1 ..
!            Index_Type'Last +
!               Boolean'Pos (Index_Type'Base'Last > Index_Type'Last);
  
     No_Index : constant Extended_Index := Extended_Index'First;
  
-    subtype Index_Subtype is Index_Type;
- 
     type Vector is tagged private;
  
     type Cursor is private;
--- 42,55 ----
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Vectors is
!    pragma Preelaborate;
  
     subtype Extended_Index is Index_Type'Base
       range Index_Type'First - 1 ..
!            Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
  
     No_Index : constant Extended_Index := Extended_Index'First;
  
     type Vector is tagged private;
  
     type Cursor is private;
*************** pragma Preelaborate (Vectors);
*** 61,66 ****
--- 58,65 ----
  
     No_Element : constant Cursor;
  
+    function "=" (Left, Right : Vector) return Boolean;
+ 
     function To_Vector (Length : Count_Type) return Vector;
  
     function To_Vector
*************** pragma Preelaborate (Vectors);
*** 75,82 ****
  
     function "&" (Left, Right : Element_Type) return Vector;
  
-    function "=" (Left, Right : Vector) return Boolean;
- 
     function Capacity (Container : Vector) return Count_Type;
  
     procedure Reserve_Capacity
--- 74,79 ----
*************** pragma Preelaborate (Vectors);
*** 85,90 ****
--- 82,91 ----
  
     function Length (Container : Vector) return Count_Type;
  
+    procedure Set_Length
+      (Container : in out Vector;
+       Length    : Count_Type);
+ 
     function Is_Empty (Container : Vector) return Boolean;
  
     procedure Clear (Container : in out Vector);
*************** pragma Preelaborate (Vectors);
*** 101,106 ****
--- 102,117 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Vector;
+       Index     : Index_Type;
+       New_Item  : Element_Type);
+ 
+    procedure Replace_Element
+      (Container : in out Vector;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Container : Vector;
        Index     : Index_Type;
*************** pragma Preelaborate (Vectors);
*** 111,132 ****
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type));
! 
!    procedure Replace_Element
!      (Container : Vector;
!       Index     : Index_Type;
!       By        : Element_Type);
! 
!    procedure Replace_Element (Position : Cursor; By : Element_Type);
! 
!    procedure Assign (Target : in out Vector; Source : Vector);
  
     procedure Move (Target : in out Vector; Source : in out Vector);
  
--- 122,135 ----
        Process  : not null access procedure (Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Vector;
        Index     : Index_Type;
        Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Update_Element
!      (Container : in out Vector;
!       Position  : Cursor;
!       Process   : not null access procedure (Element : in out Element_Type));
  
     procedure Move (Target : in out Vector; Source : in out Vector);
  
*************** pragma Preelaborate (Vectors);
*** 165,170 ****
--- 168,184 ----
        Position  : out Cursor;
        Count     : Count_Type := 1);
  
+    procedure Insert
+      (Container : in out Vector;
+       Before    : Extended_Index;
+       Count     : Count_Type := 1);
+ 
+    procedure Insert
+      (Container : in out Vector;
+       Before    : Cursor;
+       Position  : out Cursor;
+       Count     : Count_Type := 1);
+ 
     procedure Prepend
       (Container : in out Vector;
        New_Item  : Vector);
*************** pragma Preelaborate (Vectors);
*** 194,206 ****
        Position  : out Cursor;
        Count     : Count_Type := 1);
  
-    procedure Set_Length
-      (Container : in out Vector;
-       Length    : Count_Type);
- 
     procedure Delete
       (Container : in out Vector;
!       Index     : Extended_Index;  --  TODO: verify
        Count     : Count_Type := 1);
  
     procedure Delete
--- 208,216 ----
        Position  : out Cursor;
        Count     : Count_Type := 1);
  
     procedure Delete
       (Container : in out Vector;
!       Index     : Extended_Index;
        Count     : Count_Type := 1);
  
     procedure Delete
*************** pragma Preelaborate (Vectors);
*** 216,221 ****
--- 226,237 ----
       (Container : in out Vector;
        Count     : Count_Type := 1);
  
+    procedure Reverse_Elements (Container : in out Vector);
+ 
+    procedure Swap (Container : in out Vector; I, J : Index_Type);
+ 
+    procedure Swap (Container : in out Vector; I, J : Cursor);
+ 
     function First_Index (Container : Vector) return Index_Type;
  
     function First (Container : Vector) return Cursor;
*************** pragma Preelaborate (Vectors);
*** 228,240 ****
  
     function Last_Element (Container : Vector) return Element_Type;
  
!    procedure Swap (Container : Vector; I, J : Index_Type);
  
!    procedure Swap (I, J : Cursor);
  
!    generic
!       with function "<" (Left, Right : Element_Type) return Boolean is <>;
!    procedure Generic_Sort (Container : Vector);
  
     function Find_Index
       (Container : Vector;
--- 244,256 ----
  
     function Last_Element (Container : Vector) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    function Previous (Position : Cursor) return Cursor;
! 
!    procedure Previous (Position : in out Cursor);
  
     function Find_Index
       (Container : Vector;
*************** pragma Preelaborate (Vectors);
*** 260,273 ****
       (Container : Vector;
        Item      : Element_Type) return Boolean;
  
-    function Next (Position : Cursor) return Cursor;
- 
-    function Previous (Position : Cursor) return Cursor;
- 
-    procedure Next (Position : in out Cursor);
- 
-    procedure Previous (Position : in out Cursor);
- 
     function Has_Element (Position : Cursor) return Boolean;
  
     procedure Iterate
--- 276,281 ----
*************** pragma Preelaborate (Vectors);
*** 278,283 ****
--- 286,303 ----
       (Container : Vector;
        Process   : not null access procedure (Position : Cursor));
  
+    generic
+       with function "<" (Left, Right : Element_Type) return Boolean is <>;
+    package Generic_Sorting is
+ 
+       function Is_Sorted (Container : Vector) return Boolean;
+ 
+       procedure Sort (Container : in out Vector);
+ 
+       procedure Merge (Target : in out Vector; Source : in out Vector);
+ 
+    end Generic_Sorting;
+ 
  private
  
     pragma Inline (First_Index);
*************** private
*** 301,306 ****
--- 321,328 ----
     type Vector is new Controlled with record
        Elements : Elements_Access;
        Last     : Extended_Index := No_Index;
+       Busy     : Natural := 0;
+       Lock     : Natural := 0;
     end record;
  
     procedure Adjust (Container : in out Vector);
*************** private
*** 321,327 ****
  
     for Vector'Read use Read;
  
!    Empty_Vector : constant Vector := (Controlled with null, No_Index);
  
     type Vector_Access is access constant Vector;
     for Vector_Access'Storage_Size use 0;
--- 343,349 ----
  
     for Vector'Read use Read;
  
!    Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
  
     type Vector_Access is access constant Vector;
     for Vector_Access'Storage_Size use 0;
*************** private
*** 331,336 ****
--- 353,370 ----
        Index     : Index_Type := Index_Type'First;
     end record;
  
+    procedure Write
+      (Stream   : access Root_Stream_Type'Class;
+       Position : Cursor);
+ 
+    for Cursor'Write use Write;
+ 
+    procedure Read
+      (Stream   : access Root_Stream_Type'Class;
+       Position : out Cursor);
+ 
+    for Cursor'Read use Read;
+ 
     No_Element : constant Cursor := Cursor'(null, Index_Type'First);
  
  end Ada.Containers.Vectors;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coorma.adb gcc-4.1.0/gcc/ada/a-coorma.adb
*** gcc-4.0.2/gcc/ada/a-coorma.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-coorma.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.ORDERED_MAPS                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . O R D E R E D _ M A P S          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 41,61 ****
  with Ada.Containers.Red_Black_Trees.Generic_Keys;
  pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Ordered_Maps is
  
-    use Red_Black_Trees;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Key     : Key_Type;
-       Element : Element_Type;
-    end record;
- 
     -----------------------------
     -- Node Access Subprograms --
     -----------------------------
--- 41,48 ----
*************** package body Ada.Containers.Ordered_Maps
*** 94,102 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
! 
!    procedure Delete_Tree (X : in out Node_Access);
  
     function Is_Equal_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Equal_Node_Node);
--- 81,87 ----
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    procedure Free (X : in out Node_Access);
  
     function Is_Equal_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Equal_Node_Node);
*************** package body Ada.Containers.Ordered_Maps
*** 115,126 ****
     -- Local Instantiations --
     --------------------------
  
-    procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
- 
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!        (Tree_Types => Tree_Types,
!         Null_Node  => Node_Access'(null));
  
     use Tree_Operations;
  
--- 100,113 ----
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!       new Red_Black_Trees.Generic_Operations (Tree_Types);
! 
!    procedure Delete_Tree is
!       new Tree_Operations.Generic_Delete_Tree (Free);
! 
!    function Copy_Tree is
!       new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
  
     use Tree_Operations;
  
*************** package body Ada.Containers.Ordered_Maps
*** 140,155 ****
--- 127,168 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Key < Right.Node.Key;
     end "<";
  
     function "<" (Left : Cursor; Right : Key_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Key < Right;
     end "<";
  
     function "<" (Left : Key_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Key;
     end "<";
  
*************** package body Ada.Containers.Ordered_Maps
*** 159,168 ****
  
     function "=" (Left, Right : Map) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return True;
-       end if;
- 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
--- 172,177 ----
*************** package body Ada.Containers.Ordered_Maps
*** 172,187 ****
--- 181,222 ----
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Key < Left.Node.Key;
     end ">";
  
     function ">" (Left : Cursor; Right : Key_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
        return Right < Left.Node.Key;
     end ">";
  
     function ">" (Left : Key_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Key < Left;
     end ">";
  
*************** package body Ada.Containers.Ordered_Maps
*** 189,212 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Map) is
!       Tree : Tree_Type renames Container.Tree;
! 
!       N : constant Count_Type := Tree.Length;
!       X : constant Node_Access := Tree.Root;
  
     begin
!       if N = 0 then
!          pragma Assert (X = null);
!          return;
!       end if;
! 
!       Tree := (Length => 0, others => null);
! 
!       Tree.Root := Copy_Tree (X);
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
!       Tree.Length := N;
     end Adjust;
  
     -------------
--- 224,235 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Map) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Ordered_Maps
*** 221,239 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Map) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 244,262 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Map) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Ordered_Maps
*** 260,333 ****
  
     function Copy_Node (Source : Node_Access) return Node_Access is
        Target : constant Node_Access :=
!                  new Node_Type'(Parent  => null,
!                                 Left    => null,
!                                 Right   => null,
!                                 Color   => Source.Color,
                                  Key     => Source.Key,
!                                 Element => Source.Element);
     begin
        return Target;
     end Copy_Node;
  
-    ---------------
-    -- Copy_Tree --
-    ---------------
- 
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
-       Target_Root : Node_Access := Copy_Node (Source_Root);
-       P, X : Node_Access;
- 
-    begin
-       if Source_Root.Right /= null then
-          Target_Root.Right := Copy_Tree (Source_Root.Right);
-          Target_Root.Right.Parent := Target_Root;
-       end if;
- 
-       P := Target_Root;
-       X := Source_Root.Left;
- 
-       while X /= null loop
-          declare
-             Y : Node_Access := Copy_Node (X);
- 
-          begin
-             P.Left := Y;
-             Y.Parent := P;
- 
-             if X.Right /= null then
-                Y.Right := Copy_Tree (X.Right);
-                Y.Right.Parent := Y;
-             end if;
- 
-             P := Y;
-             X := X.Left;
-          end;
-       end loop;
- 
-       return Target_Root;
- 
-    exception
-       when others =>
-          Delete_Tree (Target_Root);
-          raise;
-    end Copy_Tree;
- 
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Map_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
--- 283,317 ----
  
     function Copy_Node (Source : Node_Access) return Node_Access is
        Target : constant Node_Access :=
!                  new Node_Type'(Color   => Source.Color,
                                  Key     => Source.Key,
!                                 Element => Source.Element,
!                                 Parent  => null,
!                                 Left    => null,
!                                 Right   => null);
     begin
        return Target;
     end Copy_Node;
  
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Map; Position : in out Cursor) is
+       Tree : Tree_Type renames Container.Tree;
+ 
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Tree, Position.Node), "bad cursor in Delete");
! 
!       Tree_Operations.Delete_Node_Sans_Free (Tree, Position.Node);
        Free (Position.Node);
  
        Position.Container := null;
*************** package body Ada.Containers.Ordered_Maps
*** 341,347 ****
           raise Constraint_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
--- 325,331 ----
           raise Constraint_Error;
        end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
*************** package body Ada.Containers.Ordered_Maps
*** 350,358 ****
     ------------------
  
     procedure Delete_First (Container : in out Map) is
!       Position : Cursor := First (Container);
     begin
!       Delete (Container, Position);
     end Delete_First;
  
     -----------------
--- 334,346 ----
     ------------------
  
     procedure Delete_First (Container : in out Map) is
!       X : Node_Access := Container.Tree.First;
! 
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
!          Free (X);
!       end if;
     end Delete_First;
  
     -----------------
*************** package body Ada.Containers.Ordered_Maps
*** 360,386 ****
     -----------------
  
     procedure Delete_Last (Container : in out Map) is
!       Position : Cursor := Last (Container);
!    begin
!       Delete (Container, Position);
!    end Delete_Last;
! 
! 
!    -----------------
!    -- Delete_Tree --
!    -----------------
  
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
     begin
!       while X /= null loop
!          Y := X.Right;
!          Delete_Tree (Y);
!          Y := X.Left;
           Free (X);
!          X := Y;
!       end loop;
!    end Delete_Tree;
  
     -------------
     -- Element --
--- 348,361 ----
     -----------------
  
     procedure Delete_Last (Container : in out Map) is
!       X : Node_Access := Container.Tree.Last;
  
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
!       end if;
!    end Delete_Last;
  
     -------------
     -- Element --
*************** package body Ada.Containers.Ordered_Maps
*** 388,402 ****
--- 363,404 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element;
     end Element;
  
     function Element (Container : Map; Key : Key_Type) return Element_Type is
        Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+ 
     begin
+       if Node = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Node.Element;
     end Element;
  
+    ---------------------
+    -- Equivalent_Keys --
+    ---------------------
+ 
+    function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Keys;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Ordered_Maps
*** 406,412 ****
  
     begin
        if X /= null then
!          Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
--- 408,414 ----
  
     begin
        if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
*************** package body Ada.Containers.Ordered_Maps
*** 423,429 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Find;
  
     -----------
--- 425,431 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Ordered_Maps
*** 431,442 ****
     -----------
  
     function First (Container : Map) return Cursor is
     begin
!       if Container.Tree.First = null then
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.First);
     end First;
  
     -------------------
--- 433,446 ----
     -----------
  
     function First (Container : Map) return Cursor is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, T.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Ordered_Maps
*** 444,451 ****
     -------------------
  
     function First_Element (Container : Map) return Element_Type is
     begin
!       return Container.Tree.First.Element;
     end First_Element;
  
     ---------------
--- 448,461 ----
     -------------------
  
     function First_Element (Container : Map) return Element_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.First.Element;
     end First_Element;
  
     ---------------
*************** package body Ada.Containers.Ordered_Maps
*** 453,460 ****
     ---------------
  
     function First_Key (Container : Map) return Key_Type is
     begin
!       return Container.Tree.First.Key;
     end First_Key;
  
     -----------
--- 463,476 ----
     ---------------
  
     function First_Key (Container : Map) return Key_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.First = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.First.Key;
     end First_Key;
  
     -----------
*************** package body Ada.Containers.Ordered_Maps
*** 469,477 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Floor;
  
     -----------------
     -- Has_Element --
     -----------------
--- 485,513 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
+    ----------
+    -- Free --
+    ----------
+ 
+    procedure Free (X : in out Node_Access) is
+       procedure Deallocate is
+          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
+    begin
+       if X = null then
+          return;
+       end if;
+ 
+       X.Parent := X;
+       X.Left := X;
+       X.Right := X;
+ 
+       Deallocate (X);
+    end Free;
+ 
     -----------------
     -- Has_Element --
     -----------------
*************** package body Ada.Containers.Ordered_Maps
*** 497,502 ****
--- 533,542 ----
        Insert (Container, Key, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.Tree.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           Position.Node.Key := Key;
           Position.Node.Element := New_Item;
        end if;
*************** package body Ada.Containers.Ordered_Maps
*** 523,537 ****
        --------------
  
        function New_Node return Node_Access is
-          Node : constant Node_Access :=
-                   new Node_Type'(Parent  => null,
-                                  Left    => null,
-                                  Right   => null,
-                                  Color   => Red,
-                                  Key     => Key,
-                                  Element => New_Item);
        begin
!          return Node;
        end New_Node;
  
     --  Start of processing for Insert
--- 563,575 ----
        --------------
  
        function New_Node return Node_Access is
        begin
!          return new Node_Type'(Key     => Key,
!                                Element => New_Item,
!                                Color   => Red_Black_Trees.Red,
!                                Parent  => null,
!                                Left    => null,
!                                Right   => null);
        end New_Node;
  
     --  Start of processing for Insert
*************** package body Ada.Containers.Ordered_Maps
*** 543,549 ****
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unchecked_Access;
     end Insert;
  
     procedure Insert
--- 581,587 ----
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unrestricted_Access;
     end Insert;
  
     procedure Insert
*************** package body Ada.Containers.Ordered_Maps
*** 586,603 ****
        --------------
  
        function New_Node return Node_Access is
-          Node : Node_Access := new Node_Type;
- 
        begin
!          begin
!             Node.Key := Key;
!          exception
!             when others =>
!                Free (Node);
!                raise;
!          end;
! 
!          return Node;
        end New_Node;
  
     --  Start of processing for Insert
--- 624,636 ----
        --------------
  
        function New_Node return Node_Access is
        begin
!          return new Node_Type'(Key     => Key,
!                                Element => <>,
!                                Color   => Red_Black_Trees.Red,
!                                Parent  => null,
!                                Left    => null,
!                                Right   => null);
        end New_Node;
  
     --  Start of processing for Insert
*************** package body Ada.Containers.Ordered_Maps
*** 609,615 ****
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unchecked_Access;
     end Insert;
  
     --------------
--- 642,648 ----
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unrestricted_Access;
     end Insert;
  
     --------------
*************** package body Ada.Containers.Ordered_Maps
*** 628,634 ****
     function Is_Equal_Node_Node
       (L, R : Node_Access) return Boolean is
     begin
!       return L.Element = R.Element;
     end Is_Equal_Node_Node;
  
     -------------------------
--- 661,675 ----
     function Is_Equal_Node_Node
       (L, R : Node_Access) return Boolean is
     begin
!       if L.Key < R.Key then
!          return False;
! 
!       elsif R.Key < L.Key then
!          return False;
! 
!       else
!          return L.Element = R.Element;
!       end if;
     end Is_Equal_Node_Node;
  
     -------------------------
*************** package body Ada.Containers.Ordered_Maps
*** 677,689 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     ---------
--- 718,742 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (Container.Tree);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ---------
*************** package body Ada.Containers.Ordered_Maps
*** 692,697 ****
--- 745,757 ----
  
     function Key (Position : Cursor) return Key_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Key");
+ 
        return Position.Node.Key;
     end Key;
  
*************** package body Ada.Containers.Ordered_Maps
*** 700,711 ****
     ----------
  
     function Last (Container : Map) return Cursor is
     begin
!       if Container.Tree.Last = null then
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
     end Last;
  
     ------------------
--- 760,773 ----
     ----------
  
     function Last (Container : Map) return Cursor is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, T.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Ordered_Maps
*** 713,720 ****
     ------------------
  
     function Last_Element (Container : Map) return Element_Type is
     begin
!       return Container.Tree.Last.Element;
     end Last_Element;
  
     --------------
--- 775,788 ----
     ------------------
  
     function Last_Element (Container : Map) return Element_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.Last.Element;
     end Last_Element;
  
     --------------
*************** package body Ada.Containers.Ordered_Maps
*** 722,729 ****
     --------------
  
     function Last_Key (Container : Map) return Key_Type is
     begin
!       return Container.Tree.Last.Key;
     end Last_Key;
  
     ----------
--- 790,803 ----
     --------------
  
     function Last_Key (Container : Map) return Key_Type is
+       T : Tree_Type renames Container.Tree;
+ 
     begin
!       if T.Last = null then
!          raise Constraint_Error;
!       end if;
! 
!       return T.Last.Key;
     end Last_Key;
  
     ----------
*************** package body Ada.Containers.Ordered_Maps
*** 748,759 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Map; Source : in out Map) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 822,832 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Map; Source : in out Map) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Ordered_Maps
*** 772,777 ****
--- 845,853 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
           Node : constant Node_Access :=
                    Tree_Operations.Next (Position.Node);
*************** package body Ada.Containers.Ordered_Maps
*** 809,814 ****
--- 885,893 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
                    Tree_Operations.Previous (Position.Node);
*************** package body Ada.Containers.Ordered_Maps
*** 828,837 ****
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Key, Position.Node.Element);
     end Query_Element;
  
     ----------
--- 907,949 ----
  
     procedure Query_Element
       (Position : Cursor;
!       Process  : not null access procedure (Key     : Key_Type;
!                                             Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key;
!             E : Element_Type renames Position.Node.Element;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Ordered_Maps
*** 842,882 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : out Map)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
- 
        begin
!          begin
!             Key_Type'Read (Stream, Node.Key);
!             Element_Type'Read (Stream, Node.Element);
!          exception
!             when others =>
!                Free (Node);
!                raise;
!          end;
! 
           return Node;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
  
!       Local_Read (Container.Tree, N);
     end Read;
  
     -------------
--- 954,996 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : out Map)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
!       procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
        begin
!          Key_Type'Read (Stream, Node.Key);
!          Element_Type'Read (Stream, Node.Element);
           return Node;
!       exception
!          when others =>
!             Free (Node);
!             raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
!    end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
     end Read;
  
     -------------
*************** package body Ada.Containers.Ordered_Maps
*** 895,900 ****
--- 1009,1018 ----
           raise Constraint_Error;
        end if;
  
+       if Container.Tree.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        Node.Key := Key;
        Node.Element := New_Item;
     end Replace;
*************** package body Ada.Containers.Ordered_Maps
*** 903,911 ****
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element (Position : Cursor; By : Element_Type) is
     begin
!       Position.Node.Element := By;
     end Replace_Element;
  
     ---------------------
--- 1021,1048 ----
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       if Container.Tree.Lock > 0 then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
! 
!       Position.Node.Element := New_Item;
     end Replace_Element;
  
     ---------------------
*************** package body Ada.Containers.Ordered_Maps
*** 928,940 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
        --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     -----------
--- 1065,1089 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       B : Natural renames Container.Tree'Unrestricted_Access.all.Busy;
+ 
        --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (Container.Tree);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Ordered_Maps
*** 976,982 ****
        Node.Parent := Parent;
     end Set_Parent;
  
- 
     ---------------
     -- Set_Right --
     ---------------
--- 1125,1130 ----
*************** package body Ada.Containers.Ordered_Maps
*** 991,1001 ****
     --------------------
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access procedure (Element : in out Element_Type))
     is
     begin
!       Process (Position.Node.Key, Position.Node.Element);
     end Update_Element;
  
     -----------
--- 1139,1187 ----
     --------------------
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access procedure (Key     : Key_Type;
!                                              Element : in out Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Update_Element");
! 
!       declare
!          T : Tree_Type renames Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          declare
!             K : Key_Type renames Position.Node.Key;
!             E : Element_Type renames Position.Node.Element;
! 
!          begin
!             Process (K, E);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Update_Element;
  
     -----------
*************** package body Ada.Containers.Ordered_Maps
*** 1006,1031 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : Map)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Key_Type'Write (Stream, Node.Key);
           Element_Type'Write (Stream, Node.Element);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
  end Ada.Containers.Ordered_Maps;
--- 1192,1230 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : Map)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Key_Type'Write (Stream, Node.Key);
           Element_Type'Write (Stream, Node.Element);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
!    end Write;
! 
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
     end Write;
  
  end Ada.Containers.Ordered_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coorma.ads gcc-4.1.0/gcc/ada/a-coorma.ads
*** gcc-4.0.2/gcc/ada/a-coorma.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-coorma.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.ORDERED_MAPS                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . O R D E R E D _ M A P S          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Finalization;
*** 38,53 ****
  with Ada.Streams;
  
  generic
- 
     type Key_Type is private;
- 
     type Element_Type is private;
  
     with function "<" (Left, Right : Key_Type) return Boolean is <>;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Maps is
! pragma Preelaborate (Ordered_Maps);
  
     type Map is tagged private;
  
--- 38,53 ----
  with Ada.Streams;
  
  generic
     type Key_Type is private;
     type Element_Type is private;
  
     with function "<" (Left, Right : Key_Type) return Boolean is <>;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Maps is
!    pragma Preelaborate;
! 
!    function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
     type Map is tagged private;
  
*************** pragma Preelaborate (Ordered_Maps);
*** 69,86 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access
                     procedure (Key : Key_Type; Element : Element_Type));
  
     procedure Update_Element
!      (Position : Cursor;
!       Process  : not null access
                     procedure (Key : Key_Type; Element : in out Element_Type));
  
-    procedure Replace_Element (Position : Cursor; By : in Element_Type);
- 
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
--- 69,90 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Map;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access
                     procedure (Key : Key_Type; Element : Element_Type));
  
     procedure Update_Element
!      (Container : in out Map;
!       Position  : Cursor;
!       Process   : not null access
                     procedure (Key : Key_Type; Element : in out Element_Type));
  
     procedure Move (Target : in out Map; Source : in out Map);
  
     procedure Insert
*************** pragma Preelaborate (Ordered_Maps);
*** 93,98 ****
--- 97,108 ----
     procedure Insert
       (Container : in out Map;
        Key       : Key_Type;
+       Position  : out Cursor;
+       Inserted  : out Boolean);
+ 
+    procedure Insert
+      (Container : in out Map;
+       Key       : Key_Type;
        New_Item  : Element_Type);
  
     procedure Include
*************** pragma Preelaborate (Ordered_Maps);
*** 105,155 ****
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Insert
!      (Container : in out Map;
!       Key       : Key_Type;
!       Position  : out Cursor;
!       Inserted  : out Boolean);
  
     procedure Delete (Container : in out Map; Key : Key_Type);
  
-    procedure Exclude (Container : in out Map; Key : Key_Type);
- 
     procedure Delete (Container : in out Map; Position : in out Cursor);
  
     procedure Delete_First (Container : in out Map);
  
     procedure Delete_Last (Container : in out Map);
  
!    function Contains (Container : Map; Key : Key_Type) return Boolean;
  
!    function Find (Container : Map; Key : Key_Type) return Cursor;
  
!    function Element (Container : Map; Key : Key_Type) return Element_Type;
  
!    function Floor (Container : Map; Key : Key_Type) return Cursor;
  
!    function Ceiling (Container : Map; Key : Key_Type) return Cursor;
  
!    function First (Container : Map) return Cursor;
  
!    function First_Key (Container : Map) return Key_Type;
  
!    function First_Element (Container : Map) return Element_Type;
  
!    function Last (Container : Map) return Cursor;
  
!    function Last_Key (Container : Map) return Key_Type;
  
!    function Last_Element (Container : Map) return Element_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    function Previous (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
--- 115,159 ----
        Key       : Key_Type;
        New_Item  : Element_Type);
  
!    procedure Exclude (Container : in out Map; Key : Key_Type);
  
     procedure Delete (Container : in out Map; Key : Key_Type);
  
     procedure Delete (Container : in out Map; Position : in out Cursor);
  
     procedure Delete_First (Container : in out Map);
  
     procedure Delete_Last (Container : in out Map);
  
!    function First (Container : Map) return Cursor;
  
!    function First_Element (Container : Map) return Element_Type;
  
!    function First_Key (Container : Map) return Key_Type;
  
!    function Last (Container : Map) return Cursor;
  
!    function Last_Element (Container : Map) return Element_Type;
  
!    function Last_Key (Container : Map) return Key_Type;
  
!    function Next (Position : Cursor) return Cursor;
  
!    procedure Next (Position : in out Cursor);
  
!    function Previous (Position : Cursor) return Cursor;
  
!    procedure Previous (Position : in out Cursor);
  
!    function Find (Container : Map; Key : Key_Type) return Cursor;
  
!    function Element (Container : Map; Key : Key_Type) return Element_Type;
  
!    function Floor (Container : Map; Key : Key_Type) return Cursor;
  
!    function Ceiling (Container : Map; Key : Key_Type) return Cursor;
  
!    function Contains (Container : Map; Key : Key_Type) return Boolean;
  
     function Has_Element (Position : Cursor) return Boolean;
  
*************** private
*** 178,198 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!      new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Map is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Map);
  
     procedure Finalize (Container : in out Map) renames Clear;
  
!    type Map_Access is access constant Map;
     for Map_Access'Storage_Size use 0;
  
     type Cursor is record
--- 182,214 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Key     : Key_Type;
!       Element : Element_Type;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
  
!    type Map is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Map);
  
     procedure Finalize (Container : in out Map) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Map_Access is access all Map;
     for Map_Access'Storage_Size use 0;
  
     type Cursor is record
*************** private
*** 200,208 ****
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 216,234 ----
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 210,216 ****
  
     for Map'Write use Write;
  
- 
     procedure Read
       (Stream    : access Root_Stream_Type'Class;
        Container : out Map);
--- 236,241 ----
*************** private
*** 218,223 ****
     for Map'Read use Read;
  
     Empty_Map : constant Map :=
!                  (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Ordered_Maps;
--- 243,253 ----
     for Map'Read use Read;
  
     Empty_Map : constant Map :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Ordered_Maps;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coormu.adb gcc-4.1.0/gcc/ada/a-coormu.adb
*** gcc-4.0.2/gcc/ada/a-coormu.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-coormu.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                     ADA.CONTAINERS.ORDERED_MULTISETS                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --     A D A . C O N T A I N E R S . O R D E R E D _ M U L T I S E T S      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 44,63 ****
  with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
  pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Ordered_Multisets is
  
-    use Red_Black_Trees;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Element : Element_Type;
-    end record;
- 
     -----------------------------
     -- Node Access Subprograms --
     -----------------------------
--- 44,51 ----
*************** package body Ada.Containers.Ordered_Mult
*** 96,104 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
  
!    procedure Delete_Tree (X : in out Node_Access);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
--- 84,95 ----
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    procedure Free (X : in out Node_Access);
  
!    procedure Insert_Sans_Hint
!      (Tree     : in out Tree_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
*************** package body Ada.Containers.Ordered_Mult
*** 122,140 ****
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!        (Tree_Types => Tree_Types,
!         Null_Node  => Node_Access'(null));
  
!    use Tree_Operations;
  
!    procedure Free is
!      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     function Is_Equal is
       new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
--- 113,137 ----
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
+    procedure Replace_Element
+      (Tree : in out Tree_Type;
+       Node : Node_Access;
+       Item : Element_Type);
+ 
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations (Tree_Types);
  
!    procedure Delete_Tree is
!      new Tree_Operations.Generic_Delete_Tree (Free);
  
!    function Copy_Tree is
!      new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
! 
!    use Tree_Operations;
  
     function Is_Equal is
       new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
*************** package body Ada.Containers.Ordered_Mult
*** 161,178 ****
--- 158,201 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Element < Right.Node.Element;
     end "<";
  
     function "<" (Left : Cursor; Right : Element_Type)
        return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Element < Right;
     end "<";
  
     function "<" (Left : Element_Type; Right : Cursor)
        return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Element;
     end "<";
  
*************** package body Ada.Containers.Ordered_Mult
*** 182,191 ****
  
     function "=" (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return True;
-       end if;
- 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
--- 205,210 ----
*************** package body Ada.Containers.Ordered_Mult
*** 195,200 ****
--- 214,231 ----
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        --  L > R same as R < L
  
        return Right.Node.Element < Left.Node.Element;
*************** package body Ada.Containers.Ordered_Mult
*** 203,214 ****
--- 234,259 ----
     function ">" (Left : Cursor; Right : Element_Type)
        return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
        return Right < Left.Node.Element;
     end ">";
  
     function ">" (Left : Element_Type; Right : Cursor)
        return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Element < Left;
     end ">";
  
*************** package body Ada.Containers.Ordered_Mult
*** 216,239 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
! 
!       N : constant Count_Type := Tree.Length;
!       X : constant Node_Access := Tree.Root;
  
     begin
!       if N = 0 then
!          pragma Assert (X = null);
!          return;
!       end if;
! 
!       Tree := (Length => 0, others => null);
! 
!       Tree.Root := Copy_Tree (X);
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
!       Tree.Length := N;
     end Adjust;
  
     -------------
--- 261,272 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Set) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Ordered_Mult
*** 249,267 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Set) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 282,300 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Set) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Ordered_Mult
*** 297,345 ****
        return Target;
     end Copy_Node;
  
-    ---------------
-    -- Copy_Tree --
-    ---------------
- 
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
-       Target_Root : Node_Access := Copy_Node (Source_Root);
- 
-       P, X : Node_Access;
- 
-    begin
-       if Source_Root.Right /= null then
-          Target_Root.Right := Copy_Tree (Source_Root.Right);
-          Target_Root.Right.Parent := Target_Root;
-       end if;
- 
-       P := Target_Root;
-       X := Source_Root.Left;
-       while X /= null loop
-          declare
-             Y : Node_Access := Copy_Node (X);
- 
-          begin
-             P.Left := Y;
-             Y.Parent := P;
- 
-             if X.Right /= null then
-                Y.Right := Copy_Tree (X.Right);
-                Y.Right.Parent := Y;
-             end if;
- 
-             P := Y;
-             X := X.Left;
-          end;
-       end loop;
- 
-       return Target_Root;
- 
-    exception
-       when others =>
-          Delete_Tree (Target_Root);
-          raise;
-    end Copy_Tree;
- 
     ------------
     -- Delete --
     ------------
--- 330,335 ----
*************** package body Ada.Containers.Ordered_Mult
*** 365,380 ****
        end loop;
     end Delete;
  
!    procedure Delete (Container : in out Set; Position  : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
        Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
--- 355,373 ----
        end loop;
     end Delete;
  
!    procedure Delete (Container : in out Set; Position : in out Cursor) is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
+       pragma Assert (Vet (Container.Tree, Position.Node),
+                      "bad cursor in Delete");
+ 
        Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
  
*************** package body Ada.Containers.Ordered_Mult
*** 415,462 ****
        Free (X);
     end Delete_Last;
  
-    -----------------
-    -- Delete_Tree --
-    -----------------
- 
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
-    begin
-       while X /= null loop
-          Y := X.Right;
-          Delete_Tree (Y);
-          Y := X.Left;
-          Free (X);
-          X := Y;
-       end loop;
-    end Delete_Tree;
- 
     ----------------
     -- Difference --
     ----------------
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Difference;
  
     -------------
--- 408,427 ----
        Free (X);
     end Delete_Last;
  
     ----------------
     -- Difference --
     ----------------
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Difference;
  
     -------------
*************** package body Ada.Containers.Ordered_Mult
*** 465,473 ****
--- 430,493 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element;
     end Element;
  
+    -------------------------
+    -- Equivalent_Elements --
+    -------------------------
+ 
+    function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Elements;
+ 
+    ---------------------
+    -- Equivalent_Sets --
+    ---------------------
+ 
+    function Equivalent_Sets (Left, Right : Set) return Boolean is
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean;
+       pragma Inline (Is_Equivalent_Node_Node);
+ 
+       function Is_Equivalent is
+         new Tree_Operations.Generic_Equal (Is_Equivalent_Node_Node);
+ 
+       -----------------------------
+       -- Is_Equivalent_Node_Node --
+       -----------------------------
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
+       begin
+          if L.Element < R.Element then
+             return False;
+          elsif R.Element < L.Element then
+             return False;
+          else
+             return True;
+          end if;
+       end Is_Equivalent_Node_Node;
+ 
+    --  Start of processing for Equivalent_Sets
+ 
+    begin
+       return Is_Equivalent (Left.Tree, Right.Tree);
+    end Equivalent_Sets;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Ordered_Mult
*** 499,505 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Find;
  
     -----------
--- 519,525 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Ordered_Mult
*** 512,518 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.First);
     end First;
  
     -------------------
--- 532,538 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Ordered_Mult
*** 521,526 ****
--- 541,550 ----
  
     function First_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.First = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.First.Element;
     end First_Element;
  
*************** package body Ada.Containers.Ordered_Mult
*** 537,545 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Floor;
  
     ------------------
     -- Generic_Keys --
     ------------------
--- 561,587 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
+    ----------
+    -- Free --
+    ----------
+ 
+    procedure Free (X : in out Node_Access) is
+       procedure Deallocate is
+          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
+    begin
+       if X /= null then
+          X.Parent := X;
+          X.Left := X;
+          X.Right := X;
+ 
+          Deallocate (X);
+       end if;
+    end Free;
+ 
     ------------------
     -- Generic_Keys --
     ------------------
*************** package body Ada.Containers.Ordered_Mult
*** 571,604 ****
             Is_Less_Key_Node    => Is_Less_Key_Node,
             Is_Greater_Key_Node => Is_Greater_Key_Node);
  
-       ---------
-       -- "<" --
-       ---------
- 
-       function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left < Right.Node.Element;
-       end "<";
- 
-       function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right > Left.Node.Element;
-       end "<";
- 
-       ---------
-       -- ">" --
-       ---------
- 
-       function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right < Left.Node.Element;
-       end ">";
- 
-       function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left > Right.Node.Element;
-       end ">";
- 
        -------------
        -- Ceiling --
        -------------
--- 613,618 ----
*************** package body Ada.Containers.Ordered_Mult
*** 612,688 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Ceiling;
  
-       ----------------------------
-       -- Checked_Update_Element --
-       ----------------------------
- 
-       procedure Checked_Update_Element
-         (Container : in out Set;
-          Position  : Cursor;
-          Process   : not null access procedure (Element : in out Element_Type))
-       is
-       begin
-          if Position.Container = null then
-             raise Constraint_Error;
-          end if;
- 
-          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
-             raise Program_Error;
-          end if;
- 
-          declare
-             Old_Key : Key_Type renames Key (Position.Node.Element);
- 
-          begin
-             Process (Position.Node.Element);
- 
-             if Old_Key < Position.Node.Element
-               or else Old_Key > Position.Node.Element
-             then
-                null;
-             else
-                return;
-             end if;
-          end;
- 
-          Delete_Node_Sans_Free (Container.Tree, Position.Node);
- 
-          Do_Insert : declare
-             Result  : Node_Access;
- 
-             function New_Node return Node_Access;
-             pragma Inline (New_Node);
- 
-             procedure Insert_Post is
-               new Key_Keys.Generic_Insert_Post (New_Node);
- 
-             procedure Insert is
-               new Key_Keys.Generic_Unconditional_Insert (Insert_Post);
- 
-             --------------
-             -- New_Node --
-             --------------
- 
-             function New_Node return Node_Access is
-             begin
-                return Position.Node;
-             end New_Node;
- 
-          --  Start of processing for Do_Insert
- 
-          begin
-             Insert
-               (Tree    => Container.Tree,
-                Key     => Key (Position.Node.Element),
-                Node    => Result);
- 
-             pragma Assert (Result = Position.Node);
-          end Do_Insert;
-       end Checked_Update_Element;
- 
        --------------
        -- Contains --
        --------------
--- 626,634 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Ceiling;
  
        --------------
        -- Contains --
        --------------
*************** package body Ada.Containers.Ordered_Mult
*** 725,733 ****
--- 671,698 ----
           Node : constant Node_Access :=
                    Key_Keys.Find (Container.Tree, Key);
        begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
+ 
           return Node.Element;
        end Element;
  
+       ---------------------
+       -- Equivalent_Keys --
+       ---------------------
+ 
+       function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+       begin
+          if Left < Right
+            or else Right < Left
+          then
+             return False;
+          else
+             return True;
+          end if;
+       end Equivalent_Keys;
+ 
        -------------
        -- Exclude --
        -------------
*************** package body Ada.Containers.Ordered_Mult
*** 737,742 ****
--- 702,708 ----
           Node : Node_Access := Key_Keys.Ceiling (Tree, Key);
           Done : constant Node_Access := Key_Keys.Upper_Bound (Tree, Key);
           X    : Node_Access;
+ 
        begin
           while Node /= Done loop
              X := Node;
*************** package body Ada.Containers.Ordered_Mult
*** 759,765 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Find;
  
        -----------
--- 725,731 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Find;
  
        -----------
*************** package body Ada.Containers.Ordered_Mult
*** 775,781 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Floor;
  
        -------------------------
--- 741,747 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Floor;
  
        -------------------------
*************** package body Ada.Containers.Ordered_Mult
*** 786,792 ****
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left > Right.Element;
        end Is_Greater_Key_Node;
  
        ----------------------
--- 752,758 ----
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Key (Right.Element) < Left;
        end Is_Greater_Key_Node;
  
        ----------------------
*************** package body Ada.Containers.Ordered_Mult
*** 797,803 ****
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left < Right.Element;
        end Is_Less_Key_Node;
  
        -------------
--- 763,769 ----
          (Left  : Key_Type;
           Right : Node_Access) return Boolean is
        begin
!          return Left < Key (Right.Element);
        end Is_Less_Key_Node;
  
        -------------
*************** package body Ada.Containers.Ordered_Mult
*** 821,833 ****
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unchecked_Access, Node));
           end Process_Node;
  
        --  Start of processing for Iterate
  
        begin
!          Local_Iterate (Container.Tree, Key);
        end Iterate;
  
        ---------
--- 787,812 ----
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unrestricted_Access, Node));
           end Process_Node;
  
+          T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+          B : Natural renames T.Busy;
+ 
        --  Start of processing for Iterate
  
        begin
!          B := B + 1;
! 
!          begin
!             Local_Iterate (T, Key);
!          exception
!             when others =>
!                B := B - 1;
!                raise;
!          end;
! 
!          B := B - 1;
        end Iterate;
  
        ---------
*************** package body Ada.Containers.Ordered_Mult
*** 836,864 ****
  
        function Key (Position : Cursor) return Key_Type is
        begin
!          return Key (Position.Node.Element);
!       end Key;
! 
!       -------------
!       -- Replace --
!       -------------
! 
!       --  In post-madision api:???
! 
! --    procedure Replace
! --      (Container : in out Set;
! --       Key       : Key_Type;
! --       New_Item  : Element_Type)
! --    is
! --       Node : Node_Access := Key_Keys.Find (Container.Tree, Key);
  
! --    begin
! --       if Node = null then
! --          raise Constraint_Error;
! --       end if;
  
! --       Replace_Node (Container, Node, New_Item);
! --    end Replace;
  
        ---------------------
        -- Reverse_Iterate --
--- 815,829 ----
  
        function Key (Position : Cursor) return Key_Type is
        begin
!          if Position.Node = null then
!             raise Constraint_Error;
!          end if;
  
!          pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                         "bad cursor in Key");
  
!          return Key (Position.Node.Element);
!       end Key;
  
        ---------------------
        -- Reverse_Iterate --
*************** package body Ada.Containers.Ordered_Mult
*** 881,895 ****
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unchecked_Access, Node));
           end Process_Node;
  
        --  Start of processing for Reverse_Iterate
  
        begin
!          Local_Reverse_Iterate (Container.Tree, Key);
        end Reverse_Iterate;
  
     end Generic_Keys;
  
     -----------------
--- 846,934 ----
  
           procedure Process_Node (Node : Node_Access) is
           begin
!             Process (Cursor'(Container'Unrestricted_Access, Node));
           end Process_Node;
  
+          T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+          B : Natural renames T.Busy;
+ 
        --  Start of processing for Reverse_Iterate
  
        begin
!          B := B + 1;
! 
!          begin
!             Local_Reverse_Iterate (T, Key);
!          exception
!             when others =>
!                B := B - 1;
!                raise;
!          end;
! 
!          B := B - 1;
        end Reverse_Iterate;
  
+       -----------------------------------
+       -- Update_Element_Preserving_Key --
+       -----------------------------------
+ 
+       procedure Update_Element_Preserving_Key
+         (Container : in out Set;
+          Position  : Cursor;
+          Process   : not null access procedure (Element : in out Element_Type))
+       is
+          Tree : Tree_Type renames Container.Tree;
+ 
+       begin
+          if Position.Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          if Position.Container /= Container'Unrestricted_Access then
+             raise Program_Error;
+          end if;
+ 
+          pragma Assert (Vet (Container.Tree, Position.Node),
+                         "bad cursor in Update_Element_Preserving_Key");
+ 
+          declare
+             E : Element_Type renames Position.Node.Element;
+             K : constant Key_Type := Key (E);
+ 
+             B : Natural renames Tree.Busy;
+             L : Natural renames Tree.Lock;
+ 
+          begin
+             B := B + 1;
+             L := L + 1;
+ 
+             begin
+                Process (E);
+             exception
+                when others =>
+                   L := L - 1;
+                   B := B - 1;
+                   raise;
+             end;
+ 
+             L := L - 1;
+             B := B - 1;
+ 
+             if Equivalent_Keys (Left => K, Right => Key (E)) then
+                return;
+             end if;
+          end;
+ 
+          declare
+             X : Node_Access := Position.Node;
+          begin
+             Tree_Operations.Delete_Node_Sans_Free (Tree, X);
+             Free (X);
+          end;
+ 
+          raise Program_Error;
+       end Update_Element_Preserving_Key;
+ 
     end Generic_Keys;
  
     -----------------
*************** package body Ada.Containers.Ordered_Mult
*** 916,921 ****
--- 955,978 ----
        New_Item  : Element_Type;
        Position  : out Cursor)
     is
+    begin
+       Insert_Sans_Hint
+         (Container.Tree,
+          New_Item,
+          Position.Node);
+ 
+       Position.Container := Container'Unrestricted_Access;
+    end Insert;
+ 
+    ----------------------
+    -- Insert_Sans_Hint --
+    ----------------------
+ 
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access)
+    is
        function New_Node return Node_Access;
        pragma Inline (New_Node);
  
*************** package body Ada.Containers.Ordered_Mult
*** 931,955 ****
  
        function New_Node return Node_Access is
           Node : constant Node_Access :=
!                   new Node_Type'(Parent => null,
!                                  Left   => null,
!                                  Right  => null,
!                                  Color  => Red,
                                   Element => New_Item);
        begin
           return Node;
        end New_Node;
  
!    --  Start of processing for Insert
  
     begin
        Unconditional_Insert_Sans_Hint
!         (Container.Tree,
           New_Item,
!          Position.Node);
! 
!       Position.Container := Container'Unchecked_Access;
!    end Insert;
  
     ----------------------
     -- Insert_With_Hint --
--- 988,1010 ----
  
        function New_Node return Node_Access is
           Node : constant Node_Access :=
!                   new Node_Type'(Parent  => null,
!                                  Left    => null,
!                                  Right   => null,
!                                  Color   => Red_Black_Trees.Red,
                                   Element => New_Item);
        begin
           return Node;
        end New_Node;
  
!    --  Start of processing for Insert_Sans_Hint
  
     begin
        Unconditional_Insert_Sans_Hint
!         (Tree,
           New_Item,
!          Node);
!    end Insert_Sans_Hint;
  
     ----------------------
     -- Insert_With_Hint --
*************** package body Ada.Containers.Ordered_Mult
*** 1006,1030 ****
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Intersection (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Intersection;
  
     --------------
--- 1061,1074 ----
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Intersection (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Intersection;
  
     --------------
*************** package body Ada.Containers.Ordered_Mult
*** 1086,1095 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
     begin
-       if Subset'Address = Of_Set'Address then
-          return True;
-       end if;
- 
        return Set_Ops.Is_Subset (Subset => Subset.Tree, Of_Set => Of_Set.Tree);
     end Is_Subset;
  
--- 1130,1135 ----
*************** package body Ada.Containers.Ordered_Mult
*** 1113,1125 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     procedure Iterate
--- 1153,1178 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     procedure Iterate
*************** package body Ada.Containers.Ordered_Mult
*** 1139,1151 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Iterate
  
     begin
!       Local_Iterate (Container.Tree, Item);
     end Iterate;
  
     ----------
--- 1192,1217 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T, Item);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Ordered_Mult
*** 1158,1164 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
     end Last;
  
     ------------------
--- 1224,1230 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Ordered_Mult
*** 1167,1172 ****
--- 1233,1242 ----
  
     function Last_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.Last.Element;
     end Last_Element;
  
*************** package body Ada.Containers.Ordered_Mult
*** 1192,1203 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 1262,1272 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Ordered_Mult
*** 1217,1225 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Next (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 1286,1297 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Next (Position.Node);
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Ordered_Mult
*** 1235,1244 ****
  
     function Overlap (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return Left.Tree.Length /= 0;
-       end if;
- 
        return Set_Ops.Overlap (Left.Tree, Right.Tree);
     end Overlap;
  
--- 1307,1312 ----
*************** package body Ada.Containers.Ordered_Mult
*** 1267,1275 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Previous (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 1335,1346 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Previous (Position.Node);
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Ordered_Mult
*** 1288,1294 ****
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Element);
     end Query_Element;
  
     ----------
--- 1359,1393 ----
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Ordered_Mult
*** 1299,1449 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
- 
        begin
!          begin
!             Element_Type'Read (Stream, Node.Element);
! 
!          exception
!             when others =>
!                Free (Node);
!                raise;
!          end;
! 
           return Node;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
! 
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
! 
!       Local_Read (Container.Tree, N);
     end Read;
  
!    -------------
!    -- Replace --
!    -------------
! 
!    --  NOTE: from post-madison api ???
! 
! --   procedure Replace
! --     (Container : in out Set;
! --      Position  : Cursor;
! --      By        : Element_Type)
! --   is
! --   begin
! --      if Position.Container = null then
! --         raise Constraint_Error;
! --      end if;
  
! --      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --         raise Program_Error;
! --      end if;
  
! --      Replace_Node (Container, Position.Node, By);
! --   end Replace;
  
!    ------------------
!    -- Replace_Node --
!    ------------------
  
!    --  NOTE: from post-madison api ???
  
! --   procedure Replace_Node
! --     (Container : in out Set;
! --      Position  : Node_Access;
! --      By        : Element_Type)
! --   is
! --      Tree : Tree_Type renames Container.Tree;
! --      Node : Node_Access := Position;
  
! --   begin
! --      if By < Node.Element
! --        or else Node.Element < By
! --      then
! --         null;
  
! --      else
! --         begin
! --            Node.Element := By;
  
! --         exception
! --            when others =>
! --               Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
! --               Free (Node);
! --               raise;
! --         end;
  
! --         return;
! --      end if;
  
! --      Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
  
! --      begin
! --         Node.Element := By;
  
! --      exception
! --         when others =>
! --            Free (Node);
! --            raise;
! --      end;
! --
! --      Do_Insert : declare
! --         Result  : Node_Access;
! --         Success : Boolean;
  
! --         function New_Node return Node_Access;
! --         pragma Inline (New_Node);
  
! --         procedure Insert_Post is
! --           new Element_Keys.Generic_Insert_Post (New_Node);
! --
! --         procedure Insert is
! --           new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
! --         --------------
! --         -- New_Node --
! --         --------------
  
! --         function New_Node return Node_Access is
! --         begin
! --            return Node;
! --         end New_Node;
  
! --      --  Start of processing for Do_Insert
  
! --      begin
! --         Insert
! --           (Tree    => Tree,
! --            Key     => Node.Element,
! --            Node    => Result,
! --            Success => Success);
! --
! --         if not Success then
! --            Free (Node);
! --            raise Program_Error;
! --         end if;
! --
! --         pragma Assert (Result = Node);
! --      end Do_Insert;
! --   end Replace_Node;
  
     ---------------------
     -- Reverse_Iterate --
--- 1398,1524 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
!       procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
        begin
!          Element_Type'Read (Stream, Node.Element);
           return Node;
!       exception
!          when others =>
!             Free (Node);  --  Note that Free deallocates elem too
!             raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
     end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Read;
  
!    ---------------------
!    -- Replace_Element --
!    ---------------------
  
!    procedure Replace_Element
!      (Tree : in out Tree_Type;
!       Node : Node_Access;
!       Item : Element_Type)
!    is
!    begin
!       if Item < Node.Element
!         or else Node.Element < Item
!       then
!          null;
!       else
!          if Tree.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          Node.Element := Item;
!          return;
!       end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
  
!       Insert_New_Item : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
!          procedure Unconditional_Insert is
!             new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node return Node_Access is
!          begin
!             Node.Element := Item;
!             Node.Color := Red_Black_Trees.Red;
!             Node.Parent := null;
!             Node.Left := null;
!             Node.Right := null;
  
!             return Node;
!          end New_Node;
  
!          Result : Node_Access;
  
!       --  Start of processing for Insert_New_Item
  
!       begin
!          Unconditional_Insert
!            (Tree => Tree,
!             Key  => Item,
!             Node => Result);
  
!          pragma Assert (Result = Node);
!       end Insert_New_Item;
!    end Replace_Element;
  
!    procedure Replace_Element
!      (Container : in out Set;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
!    begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
  
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
  
!       Replace_Element (Container.Tree, Position.Node, New_Item);
!    end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
*************** package body Ada.Containers.Ordered_Mult
*** 1465,1477 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     procedure Reverse_Iterate
--- 1540,1565 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     procedure Reverse_Iterate
*************** package body Ada.Containers.Ordered_Mult
*** 1491,1503 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree, Item);
     end Reverse_Iterate;
  
     -----------
--- 1579,1604 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T, Item);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Ordered_Mult
*** 1551,1603 ****
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Symmetric_Difference;
  
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Union (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Union;
  
     -----------
--- 1652,1694 ----
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
+ 
+    function To_Set (New_Item : Element_Type) return Set is
+       Tree     : Tree_Type;
+       Node     : Node_Access;
+ 
+    begin
+       Insert_Sans_Hint (Tree, New_Item, Node);
+       return Set'(Controlled with Tree);
+    end To_Set;
+ 
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Union (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Union;
  
     -----------
*************** package body Ada.Containers.Ordered_Mult
*** 1608,1635 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is
!         new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Element_Type'Write (Stream, Node.Element);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
! end Ada.Containers.Ordered_Multisets;
! 
  
--- 1699,1736 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Element_Type'Write (Stream, Node.Element);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
+ end Ada.Containers.Ordered_Multisets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coormu.ads gcc-4.1.0/gcc/ada/a-coormu.ads
*** gcc-4.0.2/gcc/ada/a-coormu.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-coormu.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                     ADA.CONTAINERS.ORDERED_MULTISETS                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --     A D A . C O N T A I N E R S . O R D E R E D _ M U L T I S E T S      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 44,50 ****
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Multisets is
! pragma Preelaborate (Ordered_Multisets);
  
     type Set is tagged private;
  
--- 44,52 ----
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Multisets is
!    pragma Preelaborate;
! 
!    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
  
     type Set is tagged private;
  
*************** pragma Preelaborate (Ordered_Multisets);
*** 56,61 ****
--- 58,67 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** pragma Preelaborate (Ordered_Multisets);
*** 64,76 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
!    procedure Move
!      (Target : in out Set;
!       Source : in out Set);
  
     procedure Insert
       (Container : in out Set;
--- 70,85 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
!    procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
       (Container : in out Set;
*************** pragma Preelaborate (Ordered_Multisets);
*** 81,91 ****
       (Container : in out Set;
        New_Item  : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
--- 90,106 ----
       (Container : in out Set;
        New_Item  : Element_Type);
  
! --  TODO: include Replace too???
! --
! --     procedure Replace
! --       (Container : in out Set;
! --        New_Item  : Element_Type);
! 
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
*************** pragma Preelaborate (Ordered_Multisets);
*** 97,110 ****
  
     procedure Delete_Last (Container : in out Set);
  
-    --  NOTE: The following operation is named Replace in the Madison API.
-    --  However, it should be named Replace_Element. ???
-    --
-    --   procedure Replace
-    --     (Container : in out Set;
-    --      Position  : Cursor;
-    --      By        : Element_Type);
- 
     procedure Union (Target : in out Set; Source : Set);
  
     function Union (Left, Right : Set) return Set;
--- 112,117 ----
*************** pragma Preelaborate (Ordered_Multisets);
*** 133,146 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
-    function Contains (Container : Set; Item : Element_Type) return Boolean;
- 
-    function Find (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Floor (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
- 
     function First (Container : Set) return Cursor;
  
     function First_Element (Container : Set) return Element_Type;
--- 140,145 ----
*************** pragma Preelaborate (Ordered_Multisets);
*** 151,162 ****
  
     function Next (Position : Cursor) return Cursor;
  
-    function Previous (Position : Cursor) return Cursor;
- 
     procedure Next (Position : in out Cursor);
  
     procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
--- 150,169 ----
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
+    function Previous (Position : Cursor) return Cursor;
+ 
     procedure Previous (Position : in out Cursor);
  
+    function Find (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Floor (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
*************** pragma Preelaborate (Ordered_Multisets);
*** 190,244 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left : Key_Type; Right : Element_Type)
!         return Boolean is <>;
! 
!       with function ">" (Left : Key_Type; Right : Element_Type)
!         return Boolean is <>;
  
     package Generic_Keys is
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       function Find (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
-       --  NOTE: in post-madison api ???
-       --      procedure Replace
-       --        (Container : in out Set;
-       --         Key       : Key_Type;
-       --         New_Item  : Element_Type);
- 
-       procedure Delete (Container : in out Set; Key : Key_Type);
- 
        procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       function "<" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function ">" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function "<" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       function ">" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       --  Should name of following be "Update_Element" ???
  
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
!            procedure (Element : in out Element_Type));
  
        procedure Iterate
          (Container : Set;
--- 197,233 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left, Right : Key_Type) return Boolean is <>;
  
     package Generic_Keys is
  
!       function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
        procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       procedure Delete (Container : in out Set; Key : Key_Type);
  
!       function Find (Container : Set; Key : Key_Type) return Cursor;
  
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
  
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
  
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
!                        procedure (Element : in out Element_Type));
  
        procedure Iterate
          (Container : Set;
*************** private
*** 257,277 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!      new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Set is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    type Set_Access is access constant Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
--- 246,277 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Element : Element_Type;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
  
!    type Set is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
     for Set_Access'Storage_Size use 0;
  
     type Cursor is record
*************** private
*** 279,287 ****
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 279,297 ----
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 296,301 ****
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Ordered_Multisets;
--- 306,316 ----
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Ordered_Multisets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coorse.adb gcc-4.1.0/gcc/ada/a-coorse.adb
*** gcc-4.0.2/gcc/ada/a-coorse.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coorse.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.ORDERED_SETS                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . O R D E R E D _ S E T S          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Elaborate_All (Ada.Containers.Red
*** 44,63 ****
  with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
  pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
  
- with System;  use type System.Address;
- 
  package body Ada.Containers.Ordered_Sets is
  
-    use Red_Black_Trees;
- 
-    type Node_Type is limited record
-       Parent  : Node_Access;
-       Left    : Node_Access;
-       Right   : Node_Access;
-       Color   : Red_Black_Trees.Color_Type := Red;
-       Element : Element_Type;
-    end record;
- 
     ------------------------------
     -- Access to Fields of Node --
     ------------------------------
--- 44,51 ----
*************** package body Ada.Containers.Ordered_Sets
*** 96,104 ****
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    function Copy_Tree (Source_Root : Node_Access) return Node_Access;
  
!    procedure Delete_Tree (X : in out Node_Access);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
--- 84,96 ----
     function Copy_Node (Source : Node_Access) return Node_Access;
     pragma Inline (Copy_Node);
  
!    procedure Free (X : in out Node_Access);
  
!    procedure Insert_Sans_Hint
!      (Tree     : in out Tree_Type;
!       New_Item : Element_Type;
!       Node     : out Node_Access;
!       Inserted : out Boolean);
  
     procedure Insert_With_Hint
       (Dst_Tree : in out Tree_Type;
*************** package body Ada.Containers.Ordered_Sets
*** 122,140 ****
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations
!       (Tree_Types => Tree_Types,
!        Null_Node  => Node_Access'(null));
  
!    use Tree_Operations;
  
!    procedure Free is
!      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  
     function Is_Equal is
       new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
--- 114,138 ----
     function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
     pragma Inline (Is_Less_Node_Node);
  
+    procedure Replace_Element
+      (Tree : in out Tree_Type;
+       Node : Node_Access;
+       Item : Element_Type);
+ 
     --------------------------
     -- Local Instantiations --
     --------------------------
  
     package Tree_Operations is
!      new Red_Black_Trees.Generic_Operations (Tree_Types);
  
!    procedure Delete_Tree is
!       new Tree_Operations.Generic_Delete_Tree (Free);
  
!    function Copy_Tree is
!       new Tree_Operations.Generic_Copy_Tree (Copy_Node, Delete_Tree);
! 
!    use Tree_Operations;
  
     function Is_Equal is
       new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
*************** package body Ada.Containers.Ordered_Sets
*** 161,176 ****
--- 159,200 ----
  
     function "<" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left.Node.Element < Right.Node.Element;
     end "<";
  
     function "<" (Left : Cursor; Right : Element_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in ""<""");
+ 
        return Left.Node.Element < Right;
     end "<";
  
     function "<" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in ""<""");
+ 
        return Left < Right.Node.Element;
     end "<";
  
*************** package body Ada.Containers.Ordered_Sets
*** 180,189 ****
  
     function "=" (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return True;
-       end if;
- 
        return Is_Equal (Left.Tree, Right.Tree);
     end "=";
  
--- 204,209 ----
*************** package body Ada.Containers.Ordered_Sets
*** 193,198 ****
--- 213,230 ----
  
     function ">" (Left, Right : Cursor) return Boolean is
     begin
+       if Left.Node = null
+         or else Right.Node = null
+       then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        --  L > R same as R < L
  
        return Right.Node.Element < Left.Node.Element;
*************** package body Ada.Containers.Ordered_Sets
*** 200,210 ****
--- 232,256 ----
  
     function ">" (Left : Element_Type; Right : Cursor) return Boolean is
     begin
+       if Right.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                      "bad Right cursor in "">""");
+ 
        return Right.Node.Element < Left;
     end ">";
  
     function ">" (Left : Cursor; Right : Element_Type) return Boolean is
     begin
+       if Left.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                      "bad Left cursor in "">""");
+ 
        return Right < Left.Node.Element;
     end ">";
  
*************** package body Ada.Containers.Ordered_Sets
*** 212,235 ****
     -- Adjust --
     ------------
  
!    procedure Adjust (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
! 
!       N : constant Count_Type := Tree.Length;
!       X : constant Node_Access := Tree.Root;
  
     begin
!       if N = 0 then
!          pragma Assert (X = null);
!          return;
!       end if;
! 
!       Tree := (Length => 0, others => null);
! 
!       Tree.Root := Copy_Tree (X);
!       Tree.First := Min (Tree.Root);
!       Tree.Last := Max (Tree.Root);
!       Tree.Length := N;
     end Adjust;
  
     -------------
--- 258,269 ----
     -- Adjust --
     ------------
  
!    procedure Adjust is
!       new Tree_Operations.Generic_Adjust (Copy_Tree);
  
+    procedure Adjust (Container : in out Set) is
     begin
!       Adjust (Container.Tree);
     end Adjust;
  
     -------------
*************** package body Ada.Containers.Ordered_Sets
*** 245,263 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
     procedure Clear (Container : in out Set) is
-       Tree : Tree_Type renames Container.Tree;
-       Root : Node_Access := Tree.Root;
     begin
!       Tree := (Length => 0, others => null);
!       Delete_Tree (Root);
     end Clear;
  
     -----------
--- 279,297 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Ceiling;
  
     -----------
     -- Clear --
     -----------
  
+    procedure Clear is
+       new Tree_Operations.Generic_Clear (Delete_Tree);
+ 
     procedure Clear (Container : in out Set) is
     begin
!       Clear (Container.Tree);
     end Clear;
  
     -----------
*************** package body Ada.Containers.Ordered_Sets
*** 296,360 ****
        return Target;
     end Copy_Node;
  
-    ---------------
-    -- Copy_Tree --
-    ---------------
- 
-    function Copy_Tree (Source_Root : Node_Access) return Node_Access is
-       Target_Root : Node_Access := Copy_Node (Source_Root);
- 
-       P, X : Node_Access;
- 
-    begin
-       if Source_Root.Right /= null then
-          Target_Root.Right := Copy_Tree (Source_Root.Right);
-          Target_Root.Right.Parent := Target_Root;
-       end if;
- 
-       P := Target_Root;
-       X := Source_Root.Left;
-       while X /= null loop
-          declare
-             Y : Node_Access := Copy_Node (X);
- 
-          begin
-             P.Left := Y;
-             Y.Parent := P;
- 
-             if X.Right /= null then
-                Y.Right := Copy_Tree (X.Right);
-                Y.Right.Parent := Y;
-             end if;
- 
-             P := Y;
-             X := X.Left;
-          end;
-       end loop;
- 
-       return Target_Root;
- 
-    exception
-       when others =>
- 
-          Delete_Tree (Target_Root);
-          raise;
-    end Copy_Tree;
- 
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Set; Position : in out Cursor) is
     begin
!       if Position = No_Element then
!          return;
        end if;
  
!       if Position.Container /= Set_Access'(Container'Unchecked_Access) then
           raise Program_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
        Position.Container := null;
     end Delete;
--- 330,353 ----
        return Target;
     end Copy_Node;
  
     ------------
     -- Delete --
     ------------
  
     procedure Delete (Container : in out Set; Position : in out Cursor) is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
        end if;
  
!       if Position.Container /= Container'Unrestricted_Access then
           raise Program_Error;
        end if;
  
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Delete");
! 
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
        Free (Position.Node);
        Position.Container := null;
     end Delete;
*************** package body Ada.Containers.Ordered_Sets
*** 367,373 ****
           raise Constraint_Error;
        end if;
  
!       Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
--- 360,366 ----
           raise Constraint_Error;
        end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
        Free (X);
     end Delete;
  
*************** package body Ada.Containers.Ordered_Sets
*** 376,384 ****
     ------------------
  
     procedure Delete_First (Container : in out Set) is
!       C : Cursor := First (Container);
     begin
!       Delete (Container, C);
     end Delete_First;
  
     -----------------
--- 369,382 ----
     ------------------
  
     procedure Delete_First (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
!       X    : Node_Access := Tree.First;
! 
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Tree, X);
!          Free (X);
!       end if;
     end Delete_First;
  
     -----------------
*************** package body Ada.Containers.Ordered_Sets
*** 386,411 ****
     -----------------
  
     procedure Delete_Last (Container : in out Set) is
!       C : Cursor := Last (Container);
!    begin
!       Delete (Container, C);
!    end Delete_Last;
! 
!    -----------------
!    -- Delete_Tree --
!    -----------------
  
-    procedure Delete_Tree (X : in out Node_Access) is
-       Y : Node_Access;
     begin
!       while X /= null loop
!          Y := X.Right;
!          Delete_Tree (Y);
!          Y := X.Left;
           Free (X);
!          X := Y;
!       end loop;
!    end Delete_Tree;
  
     ----------------
     -- Difference --
--- 384,398 ----
     -----------------
  
     procedure Delete_Last (Container : in out Set) is
!       Tree : Tree_Type renames Container.Tree;
!       X    : Node_Access := Tree.Last;
  
     begin
!       if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Tree, X);
           Free (X);
!       end if;
!    end Delete_Last;
  
     ----------------
     -- Difference --
*************** package body Ada.Containers.Ordered_Sets
*** 413,438 ****
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Difference;
  
     -------------
--- 400,413 ----
  
     procedure Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Difference (Target.Tree, Source.Tree);
     end Difference;
  
     function Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Difference;
  
     -------------
*************** package body Ada.Containers.Ordered_Sets
*** 441,449 ****
--- 416,478 ----
  
     function Element (Position : Cursor) return Element_Type is
     begin
+       if Position.Node = null then
+          raise Constraint_Error;
+       end if;
+ 
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Element");
+ 
        return Position.Node.Element;
     end Element;
  
+    -------------------------
+    -- Equivalent_Elements --
+    -------------------------
+ 
+    function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+    begin
+       if Left < Right
+         or else Right < Left
+       then
+          return False;
+       else
+          return True;
+       end if;
+    end Equivalent_Elements;
+ 
+    ---------------------
+    -- Equivalent_Sets --
+    ---------------------
+ 
+    function Equivalent_Sets (Left, Right : Set) return Boolean is
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean;
+       pragma Inline (Is_Equivalent_Node_Node);
+ 
+       function Is_Equivalent is
+          new Tree_Operations.Generic_Equal (Is_Equivalent_Node_Node);
+ 
+       -----------------------------
+       -- Is_Equivalent_Node_Node --
+       -----------------------------
+ 
+       function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
+       begin
+          if L.Element < R.Element then
+             return False;
+          elsif R.Element < L.Element then
+             return False;
+          else
+             return True;
+          end if;
+       end Is_Equivalent_Node_Node;
+ 
+    --  Start of processing for Equivalent_Sets
+ 
+    begin
+       return Is_Equivalent (Left.Tree, Right.Tree);
+    end Equivalent_Sets;
+ 
     -------------
     -- Exclude --
     -------------
*************** package body Ada.Containers.Ordered_Sets
*** 453,459 ****
  
     begin
        if X /= null then
!          Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
--- 482,488 ----
  
     begin
        if X /= null then
!          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
           Free (X);
        end if;
     end Exclude;
*************** package body Ada.Containers.Ordered_Sets
*** 471,477 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Find;
  
     -----------
--- 500,506 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Find;
  
     -----------
*************** package body Ada.Containers.Ordered_Sets
*** 484,490 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.First);
     end First;
  
     -------------------
--- 513,519 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
     end First;
  
     -------------------
*************** package body Ada.Containers.Ordered_Sets
*** 493,498 ****
--- 522,531 ----
  
     function First_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.First = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.First.Element;
     end First_Element;
  
*************** package body Ada.Containers.Ordered_Sets
*** 509,517 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Node);
     end Floor;
  
     ------------------
     -- Generic_Keys --
     ------------------
--- 542,568 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Node);
     end Floor;
  
+    ----------
+    -- Free --
+    ----------
+ 
+    procedure Free (X : in out Node_Access) is
+       procedure Deallocate is
+          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ 
+    begin
+       if X /= null then
+          X.Parent := X;
+          X.Left := X;
+          X.Right := X;
+ 
+          Deallocate (X);
+       end if;
+    end Free;
+ 
     ------------------
     -- Generic_Keys --
     ------------------
*************** package body Ada.Containers.Ordered_Sets
*** 543,576 ****
             Is_Less_Key_Node    => Is_Less_Key_Node,
             Is_Greater_Key_Node => Is_Greater_Key_Node);
  
-       ---------
-       -- "<" --
-       ---------
- 
-       function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left < Right.Node.Element;
-       end "<";
- 
-       function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right > Left.Node.Element;
-       end "<";
- 
-       ---------
-       -- ">" --
-       ---------
- 
-       function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-       begin
-          return Left > Right.Node.Element;
-       end ">";
- 
-       function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-       begin
-          return Right < Left.Node.Element;
-       end ">";
- 
        -------------
        -- Ceiling --
        -------------
--- 594,599 ----
*************** package body Ada.Containers.Ordered_Sets
*** 584,671 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Ceiling;
  
-       ----------------------------
-       -- Checked_Update_Element --
-       ----------------------------
- 
-       procedure Checked_Update_Element
-         (Container : in out Set;
-          Position  : Cursor;
-          Process   : not null access procedure (Element : in out Element_Type))
-       is
-       begin
-          if Position.Container = null then
-             raise Constraint_Error;
-          end if;
- 
-          if Position.Container /= Set_Access'(Container'Unchecked_Access) then
-             raise Program_Error;
-          end if;
- 
-          declare
-             Old_Key : Key_Type renames Key (Position.Node.Element);
- 
-          begin
-             Process (Position.Node.Element);
- 
-             if Old_Key < Position.Node.Element
-               or else Old_Key > Position.Node.Element
-             then
-                null;
-             else
-                return;
-             end if;
-          end;
- 
-          Delete_Node_Sans_Free (Container.Tree, Position.Node);
- 
-          declare
-             Result  : Node_Access;
-             Success : Boolean;
- 
-             function New_Node return Node_Access;
-             pragma Inline (New_Node);
- 
-             procedure Local_Insert_Post is
-               new Key_Keys.Generic_Insert_Post (New_Node);
- 
-             procedure Local_Conditional_Insert is
-                new Key_Keys.Generic_Conditional_Insert (Local_Insert_Post);
- 
-             --------------
-             -- New_Node --
-             --------------
- 
-             function New_Node return Node_Access is
-             begin
-                return Position.Node;
-             end New_Node;
- 
- 
-          begin
-             Local_Conditional_Insert
-               (Tree    => Container.Tree,
-                Key     => Key (Position.Node.Element),
-                Node    => Result,
-                Success => Success);
- 
-             if not Success then
-                declare
-                   X : Node_Access := Position.Node;
-                begin
-                   Free (X);
-                end;
- 
-                raise Program_Error;
-             end if;
- 
-             pragma Assert (Result = Position.Node);
-          end;
-       end Checked_Update_Element;
- 
        --------------
        -- Contains --
        --------------
--- 607,615 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Ceiling;
  
        --------------
        -- Contains --
        --------------
*************** package body Ada.Containers.Ordered_Sets
*** 695,715 ****
        -- Element --
        -------------
  
!       function Element
!         (Container : Set;
!          Key       : Key_Type) return Element_Type
!       is
!          Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
        begin
           return Node.Element;
        end Element;
  
        -------------
        -- Exclude --
        -------------
  
        procedure Exclude (Container : in out Set; Key : Key_Type) is
           X : Node_Access := Key_Keys.Find (Container.Tree, Key);
        begin
           if X /= null then
              Delete_Node_Sans_Free (Container.Tree, X);
--- 639,678 ----
        -- Element --
        -------------
  
!       function Element (Container : Set; Key : Key_Type) return Element_Type is
!          Node : constant Node_Access :=
!                   Key_Keys.Find (Container.Tree, Key);
! 
        begin
+          if Node = null then
+             raise Constraint_Error;
+          end if;
+ 
           return Node.Element;
        end Element;
  
+       ---------------------
+       -- Equivalent_Keys --
+       ---------------------
+ 
+       function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+       begin
+          if Left < Right
+            or else Right < Left
+          then
+             return False;
+          else
+             return True;
+          end if;
+       end Equivalent_Keys;
+ 
        -------------
        -- Exclude --
        -------------
  
        procedure Exclude (Container : in out Set; Key : Key_Type) is
           X : Node_Access := Key_Keys.Find (Container.Tree, Key);
+ 
        begin
           if X /= null then
              Delete_Node_Sans_Free (Container.Tree, X);
*************** package body Ada.Containers.Ordered_Sets
*** 729,735 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Find;
  
        -----------
--- 692,698 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Find;
  
        -----------
*************** package body Ada.Containers.Ordered_Sets
*** 744,750 ****
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unchecked_Access, Node);
        end Floor;
  
        -------------------------
--- 707,713 ----
              return No_Element;
           end if;
  
!          return Cursor'(Container'Unrestricted_Access, Node);
        end Floor;
  
        -------------------------
*************** package body Ada.Containers.Ordered_Sets
*** 756,762 ****
           Right : Node_Access) return Boolean
        is
        begin
!          return Left > Right.Element;
        end Is_Greater_Key_Node;
  
        ----------------------
--- 719,725 ----
           Right : Node_Access) return Boolean
        is
        begin
!          return Key (Right.Element) < Left;
        end Is_Greater_Key_Node;
  
        ----------------------
*************** package body Ada.Containers.Ordered_Sets
*** 768,774 ****
           Right : Node_Access) return Boolean
        is
        begin
!          return Left < Right.Element;
        end Is_Less_Key_Node;
  
        ---------
--- 731,737 ----
           Right : Node_Access) return Boolean
        is
        begin
!          return Left < Key (Right.Element);
        end Is_Less_Key_Node;
  
        ---------
*************** package body Ada.Containers.Ordered_Sets
*** 777,782 ****
--- 740,752 ----
  
        function Key (Position : Cursor) return Key_Type is
        begin
+          if Position.Node = null then
+             raise Constraint_Error;
+          end if;
+ 
+          pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                         "bad cursor in Key");
+ 
           return Key (Position.Node.Element);
        end Key;
  
*************** package body Ada.Containers.Ordered_Sets
*** 784,805 ****
        -- Replace --
        -------------
  
! --    TODO???
  
! --    procedure Replace
! --      (Container : in out Set;
! --        Key       : Key_Type;
! --        New_Item  : Element_Type)
! --    is
! --       Node : Node_Access := Key_Keys.Find (Container.Tree, Key);
  
! --    begin
! --       if Node = null then
! --          raise Constraint_Error;
! --       end if;
  
! --        Replace_Element (Container, Node, New_Item);
! --     end Replace;
  
     end Generic_Keys;
  
--- 754,834 ----
        -- Replace --
        -------------
  
!       procedure Replace
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type)
!       is
!          Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
  
!       begin
!          if Node = null then
!             raise Constraint_Error;
!          end if;
  
!          Replace_Element (Container.Tree, Node, New_Item);
!       end Replace;
  
!       -----------------------------------
!       -- Update_Element_Preserving_Key --
!       -----------------------------------
! 
!       procedure Update_Element_Preserving_Key
!         (Container : in out Set;
!          Position  : Cursor;
!          Process   : not null access procedure (Element : in out Element_Type))
!       is
!          Tree : Tree_Type renames Container.Tree;
! 
!       begin
!          if Position.Node = null then
!             raise Constraint_Error;
!          end if;
! 
!          if Position.Container /= Container'Unrestricted_Access then
!             raise Program_Error;
!          end if;
! 
!          pragma Assert (Vet (Container.Tree, Position.Node),
!                         "bad cursor in Update_Element_Preserving_Key");
! 
!          declare
!             E : Element_Type renames Position.Node.Element;
!             K : constant Key_Type := Key (E);
! 
!             B : Natural renames Tree.Busy;
!             L : Natural renames Tree.Lock;
! 
!          begin
!             B := B + 1;
!             L := L + 1;
! 
!             begin
!                Process (E);
!             exception
!                when others =>
!                   L := L - 1;
!                   B := B - 1;
!                   raise;
!             end;
! 
!             L := L - 1;
!             B := B - 1;
! 
!             if Equivalent_Keys (K, Key (E)) then
!                return;
!             end if;
!          end;
! 
!          declare
!             X : Node_Access := Position.Node;
!          begin
!             Tree_Operations.Delete_Node_Sans_Free (Tree, X);
!             Free (X);
!          end;
! 
!          raise Program_Error;
!       end Update_Element_Preserving_Key;
  
     end Generic_Keys;
  
*************** package body Ada.Containers.Ordered_Sets
*** 824,829 ****
--- 853,862 ----
        Insert (Container, New_Item, Position, Inserted);
  
        if not Inserted then
+          if Container.Tree.Lock > 0 then
+             raise Program_Error;
+          end if;
+ 
           Position.Node.Element := New_Item;
        end if;
     end Include;
*************** package body Ada.Containers.Ordered_Sets
*** 838,869 ****
        Position  : out Cursor;
        Inserted  : out Boolean)
     is
-       function New_Node return Node_Access;
-       pragma Inline (New_Node);
- 
-       procedure Insert_Post is
-         new Element_Keys.Generic_Insert_Post (New_Node);
- 
-       procedure Insert_Sans_Hint is
-         new Element_Keys.Generic_Conditional_Insert (Insert_Post);
- 
-       --------------
-       -- New_Node --
-       --------------
- 
-       function New_Node return Node_Access is
-          Node : constant Node_Access :=
-                   new Node_Type'(Parent => null,
-                                  Left   => null,
-                                  Right  => null,
-                                  Color  => Red,
-                                  Element => New_Item);
-       begin
-          return Node;
-       end New_Node;
- 
-    --  Start of processing for Insert
- 
     begin
        Insert_Sans_Hint
          (Container.Tree,
--- 871,876 ----
*************** package body Ada.Containers.Ordered_Sets
*** 871,884 ****
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unchecked_Access;
     end Insert;
  
     procedure Insert
       (Container : in out Set;
        New_Item  : Element_Type)
     is
- 
        Position : Cursor;
        Inserted : Boolean;
  
--- 878,890 ----
           Position.Node,
           Inserted);
  
!       Position.Container := Container'Unrestricted_Access;
     end Insert;
  
     procedure Insert
       (Container : in out Set;
        New_Item  : Element_Type)
     is
        Position : Cursor;
        Inserted : Boolean;
  
*************** package body Ada.Containers.Ordered_Sets
*** 891,896 ****
--- 897,944 ----
     end Insert;
  
     ----------------------
+    -- Insert_Sans_Hint --
+    ----------------------
+ 
+    procedure Insert_Sans_Hint
+      (Tree     : in out Tree_Type;
+       New_Item : Element_Type;
+       Node     : out Node_Access;
+       Inserted : out Boolean)
+    is
+       function New_Node return Node_Access;
+       pragma Inline (New_Node);
+ 
+       procedure Insert_Post is
+         new Element_Keys.Generic_Insert_Post (New_Node);
+ 
+       procedure Conditional_Insert_Sans_Hint is
+         new Element_Keys.Generic_Conditional_Insert (Insert_Post);
+ 
+       --------------
+       -- New_Node --
+       --------------
+ 
+       function New_Node return Node_Access is
+       begin
+          return new Node_Type'(Parent  => null,
+                                Left    => null,
+                                Right   => null,
+                                Color   => Red_Black_Trees.Red,
+                                Element => New_Item);
+       end New_Node;
+ 
+    --  Start of processing for Insert_Sans_Hint
+ 
+    begin
+       Conditional_Insert_Sans_Hint
+         (Tree,
+          New_Item,
+          Node,
+          Inserted);
+    end Insert_Sans_Hint;
+ 
+    ----------------------
     -- Insert_With_Hint --
     ----------------------
  
*************** package body Ada.Containers.Ordered_Sets
*** 948,972 ****
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Intersection (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Intersection;
  
     --------------
--- 996,1009 ----
  
     procedure Intersection (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Intersection (Target.Tree, Source.Tree);
     end Intersection;
  
     function Intersection (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Intersection (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Intersection;
  
     --------------
*************** package body Ada.Containers.Ordered_Sets
*** 975,981 ****
  
     function Is_Empty (Container : Set) return Boolean is
     begin
!       return Length (Container) = 0;
     end Is_Empty;
  
     ------------------------
--- 1012,1018 ----
  
     function Is_Empty (Container : Set) return Boolean is
     begin
!       return Container.Tree.Length = 0;
     end Is_Empty;
  
     ------------------------
*************** package body Ada.Containers.Ordered_Sets
*** 1028,1037 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
     begin
-       if Subset'Address = Of_Set'Address then
-          return True;
-       end if;
- 
        return Set_Ops.Is_Subset (Subset => Subset.Tree, Of_Set => Of_Set.Tree);
     end Is_Subset;
  
--- 1065,1070 ----
*************** package body Ada.Containers.Ordered_Sets
*** 1055,1067 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of prccessing for Iterate
  
     begin
!       Local_Iterate (Container.Tree);
     end Iterate;
  
     ----------
--- 1088,1113 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of prccessing for Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Iterate;
  
     ----------
*************** package body Ada.Containers.Ordered_Sets
*** 1074,1080 ****
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
     end Last;
  
     ------------------
--- 1120,1126 ----
           return No_Element;
        end if;
  
!       return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
     end Last;
  
     ------------------
*************** package body Ada.Containers.Ordered_Sets
*** 1083,1088 ****
--- 1129,1138 ----
  
     function Last_Element (Container : Set) return Element_Type is
     begin
+       if Container.Tree.Last = null then
+          raise Constraint_Error;
+       end if;
+ 
        return Container.Tree.Last.Element;
     end Last_Element;
  
*************** package body Ada.Containers.Ordered_Sets
*** 1108,1119 ****
     -- Move --
     ----------
  
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
--- 1158,1168 ----
     -- Move --
     ----------
  
+    procedure Move is
+       new Tree_Operations.Generic_Move (Clear);
+ 
     procedure Move (Target : in out Set; Source : in out Set) is
     begin
        Move (Target => Target.Tree, Source => Source.Tree);
     end Move;
  
*************** package body Ada.Containers.Ordered_Sets
*** 1127,1135 ****
           return No_Element;
        end if;
  
        declare
           Node : constant Node_Access :=
!            Tree_Operations.Next (Position.Node);
        begin
           if Node = null then
              return No_Element;
--- 1176,1188 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Next");
+ 
        declare
           Node : constant Node_Access :=
!                   Tree_Operations.Next (Position.Node);
! 
        begin
           if Node = null then
              return No_Element;
*************** package body Ada.Containers.Ordered_Sets
*** 1150,1159 ****
  
     function Overlap (Left, Right : Set) return Boolean is
     begin
-       if Left'Address = Right'Address then
-          return Left.Tree.Length /= 0;
-       end if;
- 
        return Set_Ops.Overlap (Left.Tree, Right.Tree);
     end Overlap;
  
--- 1203,1208 ----
*************** package body Ada.Containers.Ordered_Sets
*** 1176,1181 ****
--- 1225,1233 ----
           return No_Element;
        end if;
  
+       pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                      "bad cursor in Previous");
+ 
        declare
           Node : constant Node_Access :=
                    Tree_Operations.Previous (Position.Node);
*************** package body Ada.Containers.Ordered_Sets
*** 1203,1209 ****
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       Process (Position.Node.Element);
     end Query_Element;
  
     ----------
--- 1255,1289 ----
        Process  : not null access procedure (Element : Element_Type))
     is
     begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       pragma Assert (Vet (Position.Container.Tree, Position.Node),
!                      "bad cursor in Query_Element");
! 
!       declare
!          T : Tree_Type renames Position.Container.Tree;
! 
!          B : Natural renames T.Busy;
!          L : Natural renames T.Lock;
! 
!       begin
!          B := B + 1;
!          L := L + 1;
! 
!          begin
!             Process (Position.Node.Element);
!          exception
!             when others =>
!                L := L - 1;
!                B := B - 1;
!                raise;
!          end;
! 
!          L := L - 1;
!          B := B - 1;
!       end;
     end Query_Element;
  
     ----------
*************** package body Ada.Containers.Ordered_Sets
*** 1214,1255 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       N : Count_Type'Base;
! 
!       function New_Node return Node_Access;
!       pragma Inline (New_Node);
  
!       procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
  
!       --------------
!       -- New_Node --
!       --------------
  
!       function New_Node return Node_Access is
           Node : Node_Access := new Node_Type;
  
        begin
!          begin
!             Element_Type'Read (Stream, Node.Element);
! 
!          exception
!             when others =>
!                Free (Node);
!                raise;
!          end;
! 
           return Node;
!       end New_Node;
  
     --  Start of processing for Read
  
     begin
!       Clear (Container);
! 
!       Count_Type'Base'Read (Stream, N);
!       pragma Assert (N >= 0);
  
!       Local_Read (Container.Tree, N);
     end Read;
  
     -------------
--- 1294,1337 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : out Set)
     is
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!       pragma Inline (Read_Node);
  
!       procedure Read is
!          new Tree_Operations.Generic_Read (Clear, Read_Node);
  
!       ---------------
!       -- Read_Node --
!       ---------------
  
!       function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access
!       is
           Node : Node_Access := new Node_Type;
  
        begin
!          Element_Type'Read (Stream, Node.Element);
           return Node;
! 
!       exception
!          when others =>
!             Free (Node);
!             raise;
!       end Read_Node;
  
     --  Start of processing for Read
  
     begin
!       Read (Stream, Container.Tree);
!    end Read;
  
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor)
!    is
!    begin
!       raise Program_Error;
     end Read;
  
     -------------
*************** package body Ada.Containers.Ordered_Sets
*** 1265,1270 ****
--- 1347,1356 ----
           raise Constraint_Error;
        end if;
  
+       if Container.Tree.Lock > 0 then
+          raise Program_Error;
+       end if;
+ 
        Node.Element := New_Item;
     end Replace;
  
*************** package body Ada.Containers.Ordered_Sets
*** 1272,1366 ****
     -- Replace_Element --
     ---------------------
  
! --  TODO: ???
! --     procedure Replace_Element
! --       (Container : in out Set;
! --        Position  : Node_Access;
! --        By        : Element_Type)
! --     is
! --        Node : Node_Access := Position;
  
! --     begin
! --        if By < Node.Element
! --          or else Node.Element < By
! --        then
! --           null;
  
! --        else
! --           begin
! --              Node.Element := By;
  
! --           exception
! --              when others =>
! --                 Delete_Node_Sans_Free (Container.Tree, Node);
! --                 Free (Node);
! --                 raise;
! --           end;
  
! --           return;
! --        end if;
  
! --        Delete_Node_Sans_Free (Container.Tree, Node);
  
! --        begin
! --           Node.Element := By;
! --        exception
! --           when others =>
! --              Free (Node);
! --              raise;
! --        end;
  
! --        declare
! --           function New_Node return Node_Access;
! --           pragma Inline (New_Node);
  
! --           function New_Node return Node_Access is
! --           begin
! --              return Node;
! --           end New_Node;
  
! --           procedure Insert_Post is
! --              new Element_Keys.Generic_Insert_Post (New_Node);
  
! --           procedure Insert is
! --              new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
! --           Result  : Node_Access;
! --           Success : Boolean;
  
! --        begin
! --           Insert
! --             (Tree    => Container.Tree,
! --              Key     => Node.Element,
! --              Node    => Result,
! --              Success => Success);
  
! --           if not Success then
! --              Free (Node);
! --              raise Program_Error;
! --           end if;
  
! --           pragma Assert (Result = Node);
! --        end;
! --     end Replace_Element;
  
  
! --     procedure Replace_Element
! --       (Container : in out Set;
! --        Position  : Cursor;
! --        By        : Element_Type)
! --     is
! --     begin
! --        if Position.Container = null then
! --           raise Constraint_Error;
! --        end if;
  
! --        if Position.Container /= Set_Access'(Container'Unchecked_Access) then
! --           raise Program_Error;
! --        end if;
  
! --        Replace_Element (Container, Position.Node, By);
! --     end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
--- 1358,1492 ----
     -- Replace_Element --
     ---------------------
  
!    procedure Replace_Element
!      (Tree : in out Tree_Type;
!       Node : Node_Access;
!       Item : Element_Type)
!    is
!    begin
!       if Item < Node.Element
!         or else Node.Element < Item
!       then
!          null;
!       else
!          if Tree.Lock > 0 then
!             raise Program_Error;
!          end if;
  
!          Node.Element := Item;
!          return;
!       end if;
  
!       Tree_Operations.Delete_Node_Sans_Free (Tree, Node);  -- Checks busy-bit
  
!       Insert_New_Item : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
!          procedure Insert is
!             new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node return Node_Access is
!          begin
!             Node.Element := Item;
!             Node.Color := Red;
!             Node.Parent := null;
!             Node.Right := null;
!             Node.Left := null;
  
!             return Node;
!          end New_Node;
  
!          Result   : Node_Access;
!          Inserted : Boolean;
  
!       --  Start of processing for Insert_New_Item
  
!       begin
!          Insert
!            (Tree    => Tree,
!             Key     => Item,
!             Node    => Result,
!             Success => Inserted);  --  TODO: change param name
  
!          if Inserted then
!             pragma Assert (Result = Node);
!             return;
!          end if;
!       exception
!          when others =>
!             null;  -- Assignment must have failed
!       end Insert_New_Item;
  
!       Reinsert_Old_Element : declare
!          function New_Node return Node_Access;
!          pragma Inline (New_Node);
  
!          procedure Insert_Post is
!             new Element_Keys.Generic_Insert_Post (New_Node);
  
+          procedure Insert is
+             new Element_Keys.Generic_Conditional_Insert (Insert_Post);
  
!          --------------
!          -- New_Node --
!          --------------
  
!          function New_Node return Node_Access is
!          begin
!             Node.Color := Red;
!             Node.Parent := null;
!             Node.Right := null;
!             Node.Left := null;
  
!             return Node;
!          end New_Node;
! 
!          Result   : Node_Access;
!          Inserted : Boolean;
! 
!       --  Start of processing for Reinsert_Old_Element
! 
!       begin
!          Insert
!            (Tree    => Tree,
!             Key     => Node.Element,
!             Node    => Result,
!             Success => Inserted);  --  TODO: change param name
!       exception
!          when others =>
!             null;  -- Assignment must have failed
!       end Reinsert_Old_Element;
! 
!       raise Program_Error;
!    end Replace_Element;
! 
!    procedure Replace_Element
!      (Container : in out Set;
!       Position  : Cursor;
!       New_Item  : Element_Type)
!    is
!    begin
!       if Position.Node = null then
!          raise Constraint_Error;
!       end if;
! 
!       if Position.Container /= Container'Unrestricted_Access then
!          raise Program_Error;
!       end if;
! 
!       pragma Assert (Vet (Container.Tree, Position.Node),
!                      "bad cursor in Replace_Element");
! 
!       Replace_Element (Container.Tree, Position.Node, New_Item);
!    end Replace_Element;
  
     ---------------------
     -- Reverse_Iterate --
*************** package body Ada.Containers.Ordered_Sets
*** 1382,1394 ****
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unchecked_Access, Node));
        end Process_Node;
  
     --  Start of processing for Reverse_Iterate
  
     begin
!       Local_Reverse_Iterate (Container.Tree);
     end Reverse_Iterate;
  
     -----------
--- 1508,1533 ----
  
        procedure Process_Node (Node : Node_Access) is
        begin
!          Process (Cursor'(Container'Unrestricted_Access, Node));
        end Process_Node;
  
+       T : Tree_Type renames Container.Tree'Unrestricted_Access.all;
+       B : Natural renames T.Busy;
+ 
     --  Start of processing for Reverse_Iterate
  
     begin
!       B := B + 1;
! 
!       begin
!          Local_Reverse_Iterate (T);
!       exception
!          when others =>
!             B := B - 1;
!             raise;
!       end;
! 
!       B := B - 1;
     end Reverse_Iterate;
  
     -----------
*************** package body Ada.Containers.Ordered_Sets
*** 1442,1494 ****
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
-       if Target'Address = Source'Address then
-          Clear (Target);
-          return;
-       end if;
- 
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Empty_Set;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type :=
!                   Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Symmetric_Difference;
  
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
- 
-       if Target'Address = Source'Address then
-          return;
-       end if;
- 
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
     begin
!       if Left'Address = Right'Address then
!          return Left;
!       end if;
! 
!       declare
!          Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree);
!       begin
!          return (Controlled with Tree);
!       end;
     end Union;
  
     -----------
--- 1581,1624 ----
  
     procedure Symmetric_Difference (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Symmetric_Difference;
  
+    ------------
+    -- To_Set --
+    ------------
+ 
+    function To_Set (New_Item : Element_Type) return Set is
+       Tree     : Tree_Type;
+       Node     : Node_Access;
+       Inserted : Boolean;
+ 
+    begin
+       Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
+       return Set'(Controlled with Tree);
+    end To_Set;
+ 
     -----------
     -- Union --
     -----------
  
     procedure Union (Target : in out Set; Source : Set) is
     begin
        Set_Ops.Union (Target.Tree, Source.Tree);
     end Union;
  
     function Union (Left, Right : Set) return Set is
+       Tree : constant Tree_Type :=
+                Set_Ops.Union (Left.Tree, Right.Tree);
     begin
!       return Set'(Controlled with Tree);
     end Union;
  
     -----------
*************** package body Ada.Containers.Ordered_Sets
*** 1499,1529 ****
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Process (Node : Node_Access);
!       pragma Inline (Process);
  
!       procedure Iterate is
!         new Tree_Operations.Generic_Iteration (Process);
  
!       -------------
!       -- Process --
!       -------------
  
!       procedure Process (Node : Node_Access) is
        begin
           Element_Type'Write (Stream, Node.Element);
!       end Process;
  
     --  Start of processing for Write
  
     begin
!       Count_Type'Base'Write (Stream, Container.Tree.Length);
!       Iterate (Container.Tree);
     end Write;
  
! 
! 
  
  end Ada.Containers.Ordered_Sets;
- 
- 
--- 1629,1666 ----
       (Stream    : access Root_Stream_Type'Class;
        Container : Set)
     is
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!       pragma Inline (Write_Node);
  
!       procedure Write is
!          new Tree_Operations.Generic_Write (Write_Node);
  
!       ----------------
!       -- Write_Node --
!       ----------------
  
!       procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access)
!       is
        begin
           Element_Type'Write (Stream, Node.Element);
!       end Write_Node;
  
     --  Start of processing for Write
  
     begin
!       Write (Stream, Container.Tree);
     end Write;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor)
!    is
!    begin
!       raise Program_Error;
!    end Write;
  
  end Ada.Containers.Ordered_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coorse.ads gcc-4.1.0/gcc/ada/a-coorse.ads
*** gcc-4.0.2/gcc/ada/a-coorse.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coorse.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.ORDERED_SETS                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . C O N T A I N E R S . O R D E R E D _ S E T S          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Finalization;
*** 38,51 ****
  with Ada.Streams;
  
  generic
- 
     type Element_Type is private;
  
     with function "<" (Left, Right : Element_Type) return Boolean is <>;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Sets is
! pragma Preelaborate (Ordered_Sets);
  
     type Set is tagged private;
  
--- 38,52 ----
  with Ada.Streams;
  
  generic
     type Element_Type is private;
  
     with function "<" (Left, Right : Element_Type) return Boolean is <>;
     with function "=" (Left, Right : Element_Type) return Boolean is <>;
  
  package Ada.Containers.Ordered_Sets is
!    pragma Preelaborate;
! 
!    function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
  
     type Set is tagged private;
  
*************** pragma Preelaborate (Ordered_Sets);
*** 57,62 ****
--- 58,67 ----
  
     function "=" (Left, Right : Set) return Boolean;
  
+    function Equivalent_Sets (Left, Right : Set) return Boolean;
+ 
+    function To_Set (New_Item : Element_Type) return Set;
+ 
     function Length (Container : Set) return Count_Type;
  
     function Is_Empty (Container : Set) return Boolean;
*************** pragma Preelaborate (Ordered_Sets);
*** 65,83 ****
  
     function Element (Position : Cursor) return Element_Type;
  
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
! --  TODO: resolve in Atlanta. ???
! --   procedure Replace_Element
! --     (Container : in out Set;
! --      Position  : Cursor;
! --      By        : Element_Type);
! 
!    procedure Move
!      (Target : in out Set;
!       Source : in out Set);
  
     procedure Insert
       (Container : in out Set;
--- 70,85 ----
  
     function Element (Position : Cursor) return Element_Type;
  
+    procedure Replace_Element
+      (Container : in out Set;
+       Position  : Cursor;
+       New_Item  : Element_Type);
+ 
     procedure Query_Element
       (Position : Cursor;
        Process  : not null access procedure (Element : Element_Type));
  
!    procedure Move (Target : in out Set; Source : in out Set);
  
     procedure Insert
       (Container : in out Set;
*************** pragma Preelaborate (Ordered_Sets);
*** 97,107 ****
       (Container : in out Set;
        New_Item  : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
--- 99,109 ----
       (Container : in out Set;
        New_Item  : Element_Type);
  
!    procedure Exclude
       (Container : in out Set;
        Item      : Element_Type);
  
!    procedure Delete
       (Container : in out Set;
        Item      : Element_Type);
  
*************** pragma Preelaborate (Ordered_Sets);
*** 125,132 ****
  
     function "and" (Left, Right : Set) return Set renames Intersection;
  
!    procedure Difference (Target : in out Set;
!                          Source : Set);
  
     function Difference (Left, Right : Set) return Set;
  
--- 127,133 ----
  
     function "and" (Left, Right : Set) return Set renames Intersection;
  
!    procedure Difference (Target : in out Set; Source : Set);
  
     function Difference (Left, Right : Set) return Set;
  
*************** pragma Preelaborate (Ordered_Sets);
*** 142,155 ****
  
     function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
  
-    function Contains (Container : Set; Item : Element_Type) return Boolean;
- 
-    function Find (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Floor (Container : Set; Item : Element_Type) return Cursor;
- 
-    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
- 
     function First (Container : Set) return Cursor;
  
     function First_Element (Container : Set) return Element_Type;
--- 143,148 ----
*************** pragma Preelaborate (Ordered_Sets);
*** 160,171 ****
  
     function Next (Position : Cursor) return Cursor;
  
-    function Previous (Position : Cursor) return Cursor;
- 
     procedure Next (Position : in out Cursor);
  
     procedure Previous (Position : in out Cursor);
  
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
--- 153,172 ----
  
     function Next (Position : Cursor) return Cursor;
  
     procedure Next (Position : in out Cursor);
  
+    function Previous (Position : Cursor) return Cursor;
+ 
     procedure Previous (Position : in out Cursor);
  
+    function Find (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Floor (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+ 
+    function Contains (Container : Set; Item : Element_Type) return Boolean;
+ 
     function Has_Element (Position : Cursor) return Boolean;
  
     function "<" (Left, Right : Cursor) return Boolean;
*************** pragma Preelaborate (Ordered_Sets);
*** 189,240 ****
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is limited private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<"
!         (Left  : Key_Type;
!          Right : Element_Type) return Boolean is <>;
! 
!       with function ">"
!         (Left  : Key_Type;
!          Right : Element_Type) return Boolean is <>;
  
     package Generic_Keys is
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       function Find (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
! 
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
! --  TODO: resolve in Atlanta ???
! --      procedure Replace
! --        (Container : in out Set;
! --         Key       : Key_Type;
! --         New_Item  : Element_Type);
! 
!       procedure Delete (Container : in out Set; Key : Key_Type);
  
        procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       function "<" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function ">" (Left : Cursor; Right : Key_Type) return Boolean;
  
!       function "<" (Left : Key_Type; Right : Cursor) return Boolean;
  
!       function ">" (Left : Key_Type; Right : Cursor) return Boolean;
  
! --  TODO: resolve name in Atlanta. Should name be just "Update_Element" ???
!       procedure Checked_Update_Element
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
--- 190,227 ----
        Process   : not null access procedure (Position : Cursor));
  
     generic
!       type Key_Type (<>) is private;
  
        with function Key (Element : Element_Type) return Key_Type;
  
!       with function "<" (Left, Right : Key_Type) return Boolean is <>;
  
     package Generic_Keys is
  
!       function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
  
        function Key (Position : Cursor) return Key_Type;
  
        function Element (Container : Set; Key : Key_Type) return Element_Type;
  
!       procedure Replace
!         (Container : in out Set;
!          Key       : Key_Type;
!          New_Item  : Element_Type);
  
        procedure Exclude (Container : in out Set; Key : Key_Type);
  
!       procedure Delete (Container : in out Set; Key : Key_Type);
  
!       function Find (Container : Set; Key : Key_Type) return Cursor;
  
!       function Floor (Container : Set; Key : Key_Type) return Cursor;
  
!       function Ceiling (Container : Set; Key : Key_Type) return Cursor;
  
!       function Contains (Container : Set; Key : Key_Type) return Boolean;
! 
!       procedure Update_Element_Preserving_Key
          (Container : in out Set;
           Position  : Cursor;
           Process   : not null access
*************** private
*** 247,276 ****
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    package Tree_Types is
!      new Red_Black_Trees.Generic_Tree_Types (Node_Access);
  
!    use Tree_Types;
!    use Ada.Finalization;
  
!    type Set is new Controlled with record
!       Tree : Tree_Type := (Length => 0, others => null);
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    type Set_Access is access constant Set;
  
     type Cursor is record
        Container : Set_Access;
        Node      : Node_Access;
     end record;
  
!    No_Element : constant Cursor := Cursor'(null, null);
  
!    use Ada.Streams;
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
--- 234,285 ----
     type Node_Type;
     type Node_Access is access Node_Type;
  
!    type Node_Type is limited record
!       Parent  : Node_Access;
!       Left    : Node_Access;
!       Right   : Node_Access;
!       Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
!       Element : Element_Type;
!    end record;
  
!    package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
!      (Node_Type,
!       Node_Access);
  
!    type Set is new Ada.Finalization.Controlled with record
!       Tree : Tree_Types.Tree_Type;
     end record;
  
     procedure Adjust (Container : in out Set);
  
     procedure Finalize (Container : in out Set) renames Clear;
  
!    use Red_Black_Trees;
!    use Tree_Types;
!    use Ada.Finalization;
!    use Ada.Streams;
! 
!    type Set_Access is access all Set;
!    for Set_Access'Storage_Size use 0;
  
     type Cursor is record
        Container : Set_Access;
        Node      : Node_Access;
     end record;
  
!    procedure Write
!      (Stream : access Root_Stream_Type'Class;
!       Item   : Cursor);
  
!    for Cursor'Write use Write;
! 
!    procedure Read
!      (Stream : access Root_Stream_Type'Class;
!       Item   : out Cursor);
! 
!    for Cursor'Read use Read;
! 
!    No_Element : constant Cursor := Cursor'(null, null);
  
     procedure Write
       (Stream    : access Root_Stream_Type'Class;
*************** private
*** 285,290 ****
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (Length => 0, others => null));
  
  end Ada.Containers.Ordered_Sets;
--- 294,304 ----
     for Set'Read use Read;
  
     Empty_Set : constant Set :=
!                  (Controlled with Tree => (First  => null,
!                                            Last   => null,
!                                            Root   => null,
!                                            Length => 0,
!                                            Busy   => 0,
!                                            Lock   => 0));
  
  end Ada.Containers.Ordered_Sets;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coprnu.adb gcc-4.1.0/gcc/ada/a-coprnu.adb
*** gcc-4.0.2/gcc/ada/a-coprnu.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coprnu.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.PRIME_NUMBERS                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --         A D A . C O N T A I N E R S . P R I M E _ N U M B E R S          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-coprnu.ads gcc-4.1.0/gcc/ada/a-coprnu.ads
*** gcc-4.0.2/gcc/ada/a-coprnu.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-coprnu.ads	Mon Sep  5 07:51:25 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                       ADA.CONTAINERS.PRIME_NUMBERS                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --         A D A . C O N T A I N E R S . P R I M E _ N U M B E R S          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
***************
*** 14,20 ****
  ------------------------------------------------------------------------------
  
  package Ada.Containers.Prime_Numbers is
! pragma Pure (Prime_Numbers);
  
     type Primes_Type is array (Positive range <>) of Hash_Type;
  
--- 14,20 ----
  ------------------------------------------------------------------------------
  
  package Ada.Containers.Prime_Numbers is
!    pragma Pure;
  
     type Primes_Type is array (Positive range <>) of Hash_Type;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-crbltr.ads gcc-4.1.0/gcc/ada/a-crbltr.ads
*** gcc-4.0.2/gcc/ada/a-crbltr.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-crbltr.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,31 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                      ADA.CONTAINERS.RED_BLACK_TREES                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! -- This specification is adapted from the Ada Reference Manual for use with --
! -- GNAT.  In accordance with the copyright of that document, you can freely --
! -- copy and modify this specification,  provided that if you redistribute a --
! -- modified version,  any changes that you have made are clearly indicated. --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package Ada.Containers.Red_Black_Trees is
! pragma Pure (Red_Black_Trees);
  
     type Color_Type is (Red, Black);
  
     generic
!       type Node_Access is private;
     package Generic_Tree_Types is
!       type Tree_Type is record
           First  : Node_Access;
           Last   : Node_Access;
           Root   : Node_Access;
!          Length : Count_Type;
        end record;
     end Generic_Tree_Types;
  end Ada.Containers.Red_Black_Trees;
--- 2,55 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --       A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- This specification is derived from the Ada Reference Manual for use with --
! -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the  contents of the part following the private keyword. --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
  package Ada.Containers.Red_Black_Trees is
!    pragma Pure;
  
     type Color_Type is (Red, Black);
  
     generic
!       type Node_Type (<>) is limited private;
!       type Node_Access is access Node_Type;
     package Generic_Tree_Types is
!       type Tree_Type is tagged record
           First  : Node_Access;
           Last   : Node_Access;
           Root   : Node_Access;
!          Length : Count_Type := 0;
!          Busy   : Natural := 0;
!          Lock   : Natural := 0;
        end record;
     end Generic_Tree_Types;
+ 
  end Ada.Containers.Red_Black_Trees;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-crbtgk.adb gcc-4.1.0/gcc/ada/a-crbtgk.adb
*** gcc-4.0.2/gcc/ada/a-crbtgk.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-crbtgk.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_KEYS                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --        A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .     --
! --                          G E N E R I C _ K E Y S                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Containers.Red_Black_Tr
*** 48,54 ****
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= Ops.Null_Node loop
           if Is_Greater_Key_Node (Key, X) then
              X := Ops.Right (X);
           else
--- 49,55 ----
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= null loop
           if Is_Greater_Key_Node (Key, X) then
              X := Ops.Right (X);
           else
*************** package body Ada.Containers.Red_Black_Tr
*** 69,75 ****
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= Ops.Null_Node loop
           if Is_Greater_Key_Node (Key, X) then
              X := Ops.Right (X);
           else
--- 70,76 ----
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= null loop
           if Is_Greater_Key_Node (Key, X) then
              X := Ops.Right (X);
           else
*************** package body Ada.Containers.Red_Black_Tr
*** 78,89 ****
           end if;
        end loop;
  
!       if Y = Ops.Null_Node then
!          return Ops.Null_Node;
        end if;
  
        if Is_Less_Key_Node (Key, Y) then
!          return Ops.Null_Node;
        end if;
  
        return Y;
--- 79,90 ----
           end if;
        end loop;
  
!       if Y = null then
!          return null;
        end if;
  
        if Is_Less_Key_Node (Key, Y) then
!          return null;
        end if;
  
        return Y;
*************** package body Ada.Containers.Red_Black_Tr
*** 98,104 ****
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= Ops.Null_Node loop
           if Is_Less_Key_Node (Key, X) then
              X := Ops.Left (X);
           else
--- 99,105 ----
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= null loop
           if Is_Less_Key_Node (Key, X) then
              X := Ops.Left (X);
           else
*************** package body Ada.Containers.Red_Black_Tr
*** 120,131 ****
        Node    : out Node_Access;
        Success : out Boolean)
     is
!       Y : Node_Access := Ops.Null_Node;
        X : Node_Access := Tree.Root;
  
     begin
        Success := True;
!       while X /= Ops.Null_Node loop
           Y := X;
           Success := Is_Less_Key_Node (Key, X);
  
--- 121,132 ----
        Node    : out Node_Access;
        Success : out Boolean)
     is
!       Y : Node_Access := null;
        X : Node_Access := Tree.Root;
  
     begin
        Success := True;
!       while X /= null loop
           Y := X;
           Success := Is_Less_Key_Node (Key, X);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 168,178 ****
        Success  : out Boolean)
     is
     begin
!       if Position = Ops.Null_Node then  -- largest
           if Tree.Length > 0
             and then Is_Greater_Key_Node (Key, Tree.Last)
           then
!             Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
              Success := True;
           else
              Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
--- 169,179 ----
        Success  : out Boolean)
     is
     begin
!       if Position = null then  -- largest
           if Tree.Length > 0
             and then Is_Greater_Key_Node (Key, Tree.Last)
           then
!             Insert_Post (Tree, null, Tree.Last, Key, Node);
              Success := True;
           else
              Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
*************** package body Ada.Containers.Red_Black_Tr
*** 195,202 ****
  
           begin
              if Is_Greater_Key_Node (Key, Before) then
!                if Ops.Right (Before) = Ops.Null_Node then
!                   Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
                 else
                    Insert_Post (Tree, Position, Position, Key, Node);
                 end if;
--- 196,203 ----
  
           begin
              if Is_Greater_Key_Node (Key, Before) then
!                if Ops.Right (Before) = null then
!                   Insert_Post (Tree, null, Before, Key, Node);
                 else
                    Insert_Post (Tree, Position, Position, Key, Node);
                 end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 213,219 ****
  
        if Is_Greater_Key_Node (Key, Position) then
           if Position = Tree.Last then
!             Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
              Success := True;
              return;
           end if;
--- 214,220 ----
  
        if Is_Greater_Key_Node (Key, Position) then
           if Position = Tree.Last then
!             Insert_Post (Tree, null, Tree.Last, Key, Node);
              Success := True;
              return;
           end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 223,230 ****
  
           begin
              if Is_Less_Key_Node (Key, After) then
!                if Ops.Right (Position) = Ops.Null_Node then
!                   Insert_Post (Tree, Ops.Null_Node, Position, Key, Node);
                 else
                    Insert_Post (Tree, After, After, Key, Node);
                 end if;
--- 224,231 ----
  
           begin
              if Is_Less_Key_Node (Key, After) then
!                if Ops.Right (Position) = null then
!                   Insert_Post (Tree, null, Position, Key, Node);
                 else
                    Insert_Post (Tree, After, After, Key, Node);
                 end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 258,283 ****
        New_Length : constant Count_Type := Length_Subtype'(Tree.Length) + 1;
  
     begin
!       if Y = Ops.Null_Node
!         or else X /= Ops.Null_Node
          or else Is_Less_Key_Node (Key, Y)
        then
!          pragma Assert (Y = Ops.Null_Node
!                           or else Ops.Left (Y) = Ops.Null_Node);
  
           --  Delay allocation as long as we can, in order to defend
           --  against exceptions propagated by relational operators.
  
           Z := New_Node;
  
!          pragma Assert (Z /= Ops.Null_Node);
           pragma Assert (Ops.Color (Z) = Red);
  
!          if Y = Ops.Null_Node then
              pragma Assert (Tree.Length = 0);
!             pragma Assert (Tree.Root = Ops.Null_Node);
!             pragma Assert (Tree.First = Ops.Null_Node);
!             pragma Assert (Tree.Last = Ops.Null_Node);
  
              Tree.Root := Z;
              Tree.First := Z;
--- 259,288 ----
        New_Length : constant Count_Type := Length_Subtype'(Tree.Length) + 1;
  
     begin
!       if Tree.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       if Y = null
!         or else X /= null
          or else Is_Less_Key_Node (Key, Y)
        then
!          pragma Assert (Y = null
!                           or else Ops.Left (Y) = null);
  
           --  Delay allocation as long as we can, in order to defend
           --  against exceptions propagated by relational operators.
  
           Z := New_Node;
  
!          pragma Assert (Z /= null);
           pragma Assert (Ops.Color (Z) = Red);
  
!          if Y = null then
              pragma Assert (Tree.Length = 0);
!             pragma Assert (Tree.Root = null);
!             pragma Assert (Tree.First = null);
!             pragma Assert (Tree.Last = null);
  
              Tree.Root := Z;
              Tree.First := Z;
*************** package body Ada.Containers.Red_Black_Tr
*** 292,305 ****
           end if;
  
        else
!          pragma Assert (Ops.Right (Y) = Ops.Null_Node);
  
           --  Delay allocation as long as we can, in order to defend
           --  against exceptions propagated by relational operators.
  
           Z := New_Node;
  
!          pragma Assert (Z /= Ops.Null_Node);
           pragma Assert (Ops.Color (Z) = Red);
  
           Ops.Set_Right (Y, Z);
--- 297,310 ----
           end if;
  
        else
!          pragma Assert (Ops.Right (Y) = null);
  
           --  Delay allocation as long as we can, in order to defend
           --  against exceptions propagated by relational operators.
  
           Z := New_Node;
  
!          pragma Assert (Z /= null);
           pragma Assert (Ops.Color (Z) = Red);
  
           Ops.Set_Right (Y, Z);
*************** package body Ada.Containers.Red_Black_Tr
*** 331,337 ****
        procedure Iterate (Node : Node_Access) is
           N : Node_Access := Node;
        begin
!          while N /= Ops.Null_Node loop
              if Is_Less_Key_Node (Key, N) then
                 N := Ops.Left (N);
              elsif Is_Greater_Key_Node (Key, N) then
--- 336,342 ----
        procedure Iterate (Node : Node_Access) is
           N : Node_Access := Node;
        begin
!          while N /= null loop
              if Is_Less_Key_Node (Key, N) then
                 N := Ops.Left (N);
              elsif Is_Greater_Key_Node (Key, N) then
*************** package body Ada.Containers.Red_Black_Tr
*** 367,373 ****
        procedure Iterate (Node : Node_Access) is
           N : Node_Access := Node;
        begin
!          while N /= Ops.Null_Node loop
              if Is_Less_Key_Node (Key, N) then
                 N := Ops.Left (N);
              elsif Is_Greater_Key_Node (Key, N) then
--- 372,378 ----
        procedure Iterate (Node : Node_Access) is
           N : Node_Access := Node;
        begin
!          while N /= null loop
              if Is_Less_Key_Node (Key, N) then
                 N := Ops.Left (N);
              elsif Is_Greater_Key_Node (Key, N) then
*************** package body Ada.Containers.Red_Black_Tr
*** 395,405 ****
        Key  : Key_Type;
        Node : out Node_Access)
     is
!       Y : Node_Access := Ops.Null_Node;
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= Ops.Null_Node loop
           Y := X;
  
           if Is_Less_Key_Node (Key, X) then
--- 400,410 ----
        Key  : Key_Type;
        Node : out Node_Access)
     is
!       Y : Node_Access := null;
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= null loop
           Y := X;
  
           if Is_Less_Key_Node (Key, X) then
*************** package body Ada.Containers.Red_Black_Tr
*** 431,441 ****
        --  inserted last in the sequence of equivalent items.) ???
  
     begin
!       if Hint = Ops.Null_Node then  -- largest
           if Tree.Length > 0
             and then Is_Greater_Key_Node (Key, Tree.Last)
           then
!             Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
           else
              Unconditional_Insert_Sans_Hint (Tree, Key, Node);
           end if;
--- 436,446 ----
        --  inserted last in the sequence of equivalent items.) ???
  
     begin
!       if Hint = null then  -- largest
           if Tree.Length > 0
             and then Is_Greater_Key_Node (Key, Tree.Last)
           then
!             Insert_Post (Tree, null, Tree.Last, Key, Node);
           else
              Unconditional_Insert_Sans_Hint (Tree, Key, Node);
           end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 455,462 ****
              Before : constant Node_Access := Ops.Previous (Hint);
           begin
              if Is_Greater_Key_Node (Key, Before) then
!                if Ops.Right (Before) = Ops.Null_Node then
!                   Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
                 else
                    Insert_Post (Tree, Hint, Hint, Key, Node);
                 end if;
--- 460,467 ----
              Before : constant Node_Access := Ops.Previous (Hint);
           begin
              if Is_Greater_Key_Node (Key, Before) then
!                if Ops.Right (Before) = null then
!                   Insert_Post (Tree, null, Before, Key, Node);
                 else
                    Insert_Post (Tree, Hint, Hint, Key, Node);
                 end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 470,476 ****
  
        if Is_Greater_Key_Node (Key, Hint) then
           if Hint = Tree.Last then
!             Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
              return;
           end if;
  
--- 475,481 ----
  
        if Is_Greater_Key_Node (Key, Hint) then
           if Hint = Tree.Last then
!             Insert_Post (Tree, null, Tree.Last, Key, Node);
              return;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 478,485 ****
              After : constant Node_Access := Ops.Next (Hint);
           begin
              if Is_Less_Key_Node (Key, After) then
!                if Ops.Right (Hint) = Ops.Null_Node then
!                   Insert_Post (Tree, Ops.Null_Node, Hint, Key, Node);
                 else
                    Insert_Post (Tree, After, After, Key, Node);
                 end if;
--- 483,490 ----
              After : constant Node_Access := Ops.Next (Hint);
           begin
              if Is_Less_Key_Node (Key, After) then
!                if Ops.Right (Hint) = null then
!                   Insert_Post (Tree, null, Hint, Key, Node);
                 else
                    Insert_Post (Tree, After, After, Key, Node);
                 end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 506,512 ****
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= Ops.Null_Node loop
           if Is_Less_Key_Node (Key, X) then
              Y := X;
              X := Ops.Left (X);
--- 511,517 ----
        X : Node_Access := Tree.Root;
  
     begin
!       while X /= null loop
           if Is_Less_Key_Node (Key, X) then
              Y := X;
              X := Ops.Left (X);
*************** package body Ada.Containers.Red_Black_Tr
*** 519,523 ****
     end Upper_Bound;
  
  end Ada.Containers.Red_Black_Trees.Generic_Keys;
- 
- 
--- 524,526 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-crbtgk.ads gcc-4.1.0/gcc/ada/a-crbtgk.ads
*** gcc-4.0.2/gcc/ada/a-crbtgk.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-crbtgk.ads	Mon Sep  5 07:51:25 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --               ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_KEYS                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,9 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --        A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .     --
! --                          G E N E R I C _ K E Y S                         --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
*************** generic
*** 31,37 ****
        R : Node_Access) return Boolean;
  
  package Ada.Containers.Red_Black_Trees.Generic_Keys is
! pragma Pure (Generic_Keys);
  
     generic
        with function New_Node return Node_Access;
--- 32,38 ----
        R : Node_Access) return Boolean;
  
  package Ada.Containers.Red_Black_Trees.Generic_Keys is
!    pragma Pure;
  
     generic
        with function New_Node return Node_Access;
*************** pragma Pure (Generic_Keys);
*** 133,138 ****
        Key  : Key_Type);
  
  end Ada.Containers.Red_Black_Trees.Generic_Keys;
- 
- 
- 
--- 134,136 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-crbtgo.adb gcc-4.1.0/gcc/ada/a-crbtgo.adb
*** gcc-4.0.2/gcc/ada/a-crbtgo.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-crbtgo.adb	Tue Nov 15 13:54:02 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --            ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_OPERATIONS             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --        A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .     --
! --                    G E N E R I C _ O P E R A T I O N S                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,38 ****
--- 34,41 ----
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
+ with System;  use type System.Address;
+ 
  package body Ada.Containers.Red_Black_Trees.Generic_Operations is
  
     -----------------------
*************** package body Ada.Containers.Red_Black_Tr
*** 46,136 ****
     procedure Left_Rotate  (Tree : in out Tree_Type; X : Node_Access);
     procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access);
  
!    ---------------------
!    -- Check_Invariant --
!    ---------------------
! 
!    procedure Check_Invariant (Tree : Tree_Type) is
!       Root : constant Node_Access := Tree.Root;
! 
!       function Check (Node : Node_Access) return Natural;
! 
!       -----------
!       -- Check --
!       -----------
! 
!       function Check (Node : Node_Access) return Natural is
!       begin
!          if Node = Null_Node then
!             return 0;
!          end if;
! 
!          if Color (Node) = Red then
!             declare
!                L : constant Node_Access := Left (Node);
!             begin
!                pragma Assert (L = Null_Node or else Color (L) = Black);
!                null;
!             end;
! 
!             declare
!                R : constant Node_Access := Right (Node);
!             begin
!                pragma Assert (R = Null_Node or else Color (R) = Black);
!                null;
!             end;
! 
!             declare
!                NL : constant Natural := Check (Left (Node));
!                NR : constant Natural := Check (Right (Node));
!             begin
!                pragma Assert (NL = NR);
!                return NL;
!             end;
!          end if;
! 
!          declare
!             NL : constant Natural := Check (Left (Node));
!             NR : constant Natural := Check (Right (Node));
!          begin
!             pragma Assert (NL = NR);
!             return NL + 1;
!          end;
!       end Check;
! 
!    --  Start of processing for Check_Invariant
! 
!    begin
!       if Root = Null_Node then
!          pragma Assert (Tree.First = Null_Node);
!          pragma Assert (Tree.Last = Null_Node);
!          pragma Assert (Tree.Length = 0);
!          null;
! 
!       else
!          pragma Assert (Color (Root) = Black);
!          pragma Assert (Tree.Length > 0);
!          pragma Assert (Tree.Root /= Null_Node);
!          pragma Assert (Tree.First /= Null_Node);
!          pragma Assert (Tree.Last /= Null_Node);
!          pragma Assert (Parent (Tree.Root) = Null_Node);
!          pragma Assert ((Tree.Length > 1)
!                            or else (Tree.First = Tree.Last
!                                       and Tree.First = Tree.Root));
!          pragma Assert (Left (Tree.First) = Null_Node);
!          pragma Assert (Right (Tree.Last) = Null_Node);
  
!          declare
!             L  : constant Node_Access := Left (Root);
!             R  : constant Node_Access := Right (Root);
!             NL : constant Natural := Check (L);
!             NR : constant Natural := Check (R);
!          begin
!             pragma Assert (NL = NR);
!             null;
!          end;
!       end if;
!    end Check_Invariant;
  
     ------------------
     -- Delete_Fixup --
--- 49,139 ----
     procedure Left_Rotate  (Tree : in out Tree_Type; X : Node_Access);
     procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access);
  
! --     ---------------------
! --     -- Check_Invariant --
! --     ---------------------
  
! --     procedure Check_Invariant (Tree : Tree_Type) is
! --        Root : constant Node_Access := Tree.Root;
! --
! --        function Check (Node : Node_Access) return Natural;
! --
! --        -----------
! --        -- Check --
! --        -----------
! --
! --        function Check (Node : Node_Access) return Natural is
! --        begin
! --           if Node = null then
! --              return 0;
! --           end if;
! --
! --           if Color (Node) = Red then
! --              declare
! --                 L : constant Node_Access := Left (Node);
! --              begin
! --                 pragma Assert (L = null or else Color (L) = Black);
! --                 null;
! --              end;
! --
! --              declare
! --                 R : constant Node_Access := Right (Node);
! --              begin
! --                 pragma Assert (R = null or else Color (R) = Black);
! --                 null;
! --              end;
! --
! --              declare
! --                 NL : constant Natural := Check (Left (Node));
! --                 NR : constant Natural := Check (Right (Node));
! --              begin
! --                 pragma Assert (NL = NR);
! --                 return NL;
! --              end;
! --           end if;
! --
! --           declare
! --              NL : constant Natural := Check (Left (Node));
! --              NR : constant Natural := Check (Right (Node));
! --           begin
! --              pragma Assert (NL = NR);
! --              return NL + 1;
! --           end;
! --        end Check;
! --
! --     --  Start of processing for Check_Invariant
! --
! --     begin
! --        if Root = null then
! --           pragma Assert (Tree.First = null);
! --           pragma Assert (Tree.Last = null);
! --           pragma Assert (Tree.Length = 0);
! --           null;
! --
! --        else
! --           pragma Assert (Color (Root) = Black);
! --           pragma Assert (Tree.Length > 0);
! --           pragma Assert (Tree.Root /= null);
! --           pragma Assert (Tree.First /= null);
! --           pragma Assert (Tree.Last /= null);
! --           pragma Assert (Parent (Tree.Root) = null);
! --           pragma Assert ((Tree.Length > 1)
! --                             or else (Tree.First = Tree.Last
! --                                        and Tree.First = Tree.Root));
! --           pragma Assert (Left (Tree.First) = null);
! --           pragma Assert (Right (Tree.Last) = null);
! --
! --           declare
! --              L  : constant Node_Access := Left (Root);
! --              R  : constant Node_Access := Right (Root);
! --              NL : constant Natural := Check (L);
! --              NR : constant Natural := Check (R);
! --           begin
! --              pragma Assert (NL = NR);
! --              null;
! --           end;
! --        end if;
! --     end Check_Invariant;
  
     ------------------
     -- Delete_Fixup --
*************** package body Ada.Containers.Red_Black_Tr
*** 157,174 ****
                 W := Right (Parent (X));
              end if;
  
!             if (Left (W)  = Null_Node or else Color (Left (W)) = Black)
                and then
!                (Right (W) = Null_Node or else Color (Right (W)) = Black)
              then
                 Set_Color (W, Red);
                 X := Parent (X);
  
              else
!                if Right (W) = Null_Node
                   or else Color (Right (W)) = Black
                 then
!                   if Left (W) /= Null_Node then
                       Set_Color (Left (W), Black);
                    end if;
  
--- 160,177 ----
                 W := Right (Parent (X));
              end if;
  
!             if (Left (W)  = null or else Color (Left (W)) = Black)
                and then
!                (Right (W) = null or else Color (Right (W)) = Black)
              then
                 Set_Color (W, Red);
                 X := Parent (X);
  
              else
!                if Right (W) = null
                   or else Color (Right (W)) = Black
                 then
!                   if Left (W) /= null then
                       Set_Color (Left (W), Black);
                    end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 196,211 ****
                 W := Left (Parent (X));
              end if;
  
!             if (Left (W)  = Null_Node or else Color (Left (W)) = Black)
                    and then
!                (Right (W) = Null_Node or else Color (Right (W)) = Black)
              then
                 Set_Color (W, Red);
                 X := Parent (X);
  
              else
!                if Left (W) = Null_Node or else Color (Left (W)) = Black then
!                   if Right (W) /= Null_Node then
                       Set_Color (Right (W), Black);
                    end if;
  
--- 199,214 ----
                 W := Left (Parent (X));
              end if;
  
!             if (Left (W)  = null or else Color (Left (W)) = Black)
                    and then
!                (Right (W) = null or else Color (Right (W)) = Black)
              then
                 Set_Color (W, Red);
                 X := Parent (X);
  
              else
!                if Left (W) = null or else Color (Left (W)) = Black then
!                   if Right (W) /= null then
                       Set_Color (Right (W), Black);
                    end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 239,266 ****
        X, Y : Node_Access;
  
        Z : constant Node_Access := Node;
!       pragma Assert (Z /= Null_Node);
  
     begin
!       pragma Assert (Tree.Length > 0);
!       pragma Assert (Tree.Root /= Null_Node);
!       pragma Assert (Tree.First /= Null_Node);
!       pragma Assert (Tree.Last /= Null_Node);
!       pragma Assert (Parent (Tree.Root) = Null_Node);
!       pragma Assert ((Tree.Length > 1)
!                         or else (Tree.First = Tree.Last
!                                    and then Tree.First = Tree.Root));
!       pragma Assert ((Left (Node) = Null_Node)
!                         or else (Parent (Left (Node)) = Node));
!       pragma Assert ((Right (Node) = Null_Node)
!                         or else (Parent (Right (Node)) = Node));
!       pragma Assert (((Parent (Node) = Null_Node) and then (Tree.Root = Node))
!                         or else ((Parent (Node) /= Null_Node) and then
!                                   ((Left (Parent (Node)) = Node)
!                                      or else (Right (Parent (Node)) = Node))));
  
!       if Left (Z) = Null_Node then
!          if Right (Z) = Null_Node then
              if Z = Tree.First then
                 Tree.First := Parent (Z);
              end if;
--- 242,273 ----
        X, Y : Node_Access;
  
        Z : constant Node_Access := Node;
!       pragma Assert (Z /= null);
  
     begin
!       if Tree.Busy > 0 then
!          raise Program_Error;
!       end if;
  
! --    pragma Assert (Tree.Length > 0);
! --    pragma Assert (Tree.Root /= null);
! --    pragma Assert (Tree.First /= null);
! --    pragma Assert (Tree.Last /= null);
! --    pragma Assert (Parent (Tree.Root) = null);
! --    pragma Assert ((Tree.Length > 1)
! --                      or else (Tree.First = Tree.Last
! --                                 and then Tree.First = Tree.Root));
! --    pragma Assert ((Left (Node) = null)
! --                      or else (Parent (Left (Node)) = Node));
! --    pragma Assert ((Right (Node) = null)
! --                      or else (Parent (Right (Node)) = Node));
! --    pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
! --                      or else ((Parent (Node) /= null) and then
! --                                ((Left (Parent (Node)) = Node)
! --                                   or else (Right (Parent (Node)) = Node))));
! 
!       if Left (Z) = null then
!          if Right (Z) = null then
              if Z = Tree.First then
                 Tree.First := Parent (Z);
              end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 273,290 ****
                 Delete_Fixup (Tree, Z);
              end if;
  
!             pragma Assert (Left (Z) = Null_Node);
!             pragma Assert (Right (Z) = Null_Node);
  
              if Z = Tree.Root then
                 pragma Assert (Tree.Length = 1);
!                pragma Assert (Parent (Z) = Null_Node);
!                Tree.Root := Null_Node;
              elsif Z = Left (Parent (Z)) then
!                Set_Left (Parent (Z), Null_Node);
              else
                 pragma Assert (Z = Right (Parent (Z)));
!                Set_Right (Parent (Z), Null_Node);
              end if;
  
           else
--- 280,297 ----
                 Delete_Fixup (Tree, Z);
              end if;
  
!             pragma Assert (Left (Z) = null);
!             pragma Assert (Right (Z) = null);
  
              if Z = Tree.Root then
                 pragma Assert (Tree.Length = 1);
!                pragma Assert (Parent (Z) = null);
!                Tree.Root := null;
              elsif Z = Left (Parent (Z)) then
!                Set_Left (Parent (Z), null);
              else
                 pragma Assert (Z = Right (Parent (Z)));
!                Set_Right (Parent (Z), null);
              end if;
  
           else
*************** package body Ada.Containers.Red_Black_Tr
*** 312,318 ****
              end if;
           end if;
  
!       elsif Right (Z) = Null_Node then
           pragma Assert (Z /= Tree.First);
  
           X := Left (Z);
--- 319,325 ----
              end if;
           end if;
  
!       elsif Right (Z) = null then
           pragma Assert (Z /= Tree.First);
  
           X := Left (Z);
*************** package body Ada.Containers.Red_Black_Tr
*** 341,351 ****
           pragma Assert (Z /= Tree.Last);
  
           Y := Next (Z);
!          pragma Assert (Left (Y) = Null_Node);
  
           X := Right (Y);
  
!          if X = Null_Node then
              if Y = Left (Parent (Y)) then
                 pragma Assert (Parent (Y) /= Z);
                 Delete_Swap (Tree, Z, Y);
--- 348,358 ----
           pragma Assert (Z /= Tree.Last);
  
           Y := Next (Z);
!          pragma Assert (Left (Y) = null);
  
           X := Right (Y);
  
!          if X = null then
              if Y = Left (Parent (Y)) then
                 pragma Assert (Parent (Y) /= Z);
                 Delete_Swap (Tree, Z, Y);
*************** package body Ada.Containers.Red_Black_Tr
*** 369,376 ****
                 Set_Parent (Left (Y), Y);
                 Set_Right (Y, Z);
                 Set_Parent (Z, Y);
!                Set_Left (Z, Null_Node);
!                Set_Right (Z, Null_Node);
  
                 declare
                    Y_Color : constant Color_Type := Color (Y);
--- 376,383 ----
                 Set_Parent (Left (Y), Y);
                 Set_Right (Y, Z);
                 Set_Parent (Z, Y);
!                Set_Left (Z, null);
!                Set_Right (Z, null);
  
                 declare
                    Y_Color : constant Color_Type := Color (Y);
*************** package body Ada.Containers.Red_Black_Tr
*** 384,397 ****
                 Delete_Fixup (Tree, Z);
              end if;
  
!             pragma Assert (Left (Z) = Null_Node);
!             pragma Assert (Right (Z) = Null_Node);
  
              if Z = Right (Parent (Z)) then
!                Set_Right (Parent (Z), Null_Node);
              else
                 pragma Assert (Z = Left (Parent (Z)));
!                Set_Left (Parent (Z), Null_Node);
              end if;
  
           else
--- 391,404 ----
                 Delete_Fixup (Tree, Z);
              end if;
  
!             pragma Assert (Left (Z) = null);
!             pragma Assert (Right (Z) = null);
  
              if Z = Right (Parent (Z)) then
!                Set_Right (Parent (Z), null);
              else
                 pragma Assert (Z = Left (Parent (Z)));
!                Set_Left (Parent (Z), null);
              end if;
  
           else
*************** package body Ada.Containers.Red_Black_Tr
*** 467,486 ****
           Set_Left (Parent (Y), Y);
        end if;
  
!       if Right (Y) /= Null_Node then
           Set_Parent (Right (Y), Y);
        end if;
  
!       if Left (Y) /= Null_Node then
           Set_Parent (Left (Y), Y);
        end if;
  
        Set_Parent (Z, Y_Parent);
        Set_Color (Z, Y_Color);
!       Set_Left (Z, Null_Node);
!       Set_Right (Z, Null_Node);
     end Delete_Swap;
  
     -------------------
     -- Generic_Equal --
     -------------------
--- 474,608 ----
           Set_Left (Parent (Y), Y);
        end if;
  
!       if Right (Y) /= null then
           Set_Parent (Right (Y), Y);
        end if;
  
!       if Left (Y) /= null then
           Set_Parent (Left (Y), Y);
        end if;
  
        Set_Parent (Z, Y_Parent);
        Set_Color (Z, Y_Color);
!       Set_Left (Z, null);
!       Set_Right (Z, null);
     end Delete_Swap;
  
+    --------------------
+    -- Generic_Adjust --
+    --------------------
+ 
+    procedure Generic_Adjust (Tree : in out Tree_Type) is
+       N    : constant Count_Type := Tree.Length;
+       Root : constant Node_Access := Tree.Root;
+ 
+    begin
+       if N = 0 then
+          pragma Assert (Root = null);
+          pragma Assert (Tree.Busy = 0);
+          pragma Assert (Tree.Lock = 0);
+          return;
+       end if;
+ 
+       Tree.Root := null;
+       Tree.First := null;
+       Tree.Last := null;
+       Tree.Length := 0;
+ 
+       Tree.Root := Copy_Tree (Root);
+       Tree.First := Min (Tree.Root);
+       Tree.Last := Max (Tree.Root);
+       Tree.Length := N;
+    end Generic_Adjust;
+ 
+    -------------------
+    -- Generic_Clear --
+    -------------------
+ 
+    procedure Generic_Clear (Tree : in out Tree_Type) is
+       Root : Node_Access := Tree.Root;
+    begin
+       if Tree.Busy > 0 then
+          raise Program_Error;
+       end if;
+ 
+       Tree := (First  => null,
+                Last   => null,
+                Root   => null,
+                Length => 0,
+                Busy   => 0,
+                Lock   => 0);
+ 
+       Delete_Tree (Root);
+    end Generic_Clear;
+ 
+    -----------------------
+    -- Generic_Copy_Tree --
+    -----------------------
+ 
+    function Generic_Copy_Tree (Source_Root : Node_Access) return Node_Access is
+       Target_Root : Node_Access := Copy_Node (Source_Root);
+       P, X        : Node_Access;
+ 
+    begin
+       if Right (Source_Root) /= null then
+          Set_Right
+            (Node  => Target_Root,
+             Right => Generic_Copy_Tree (Right (Source_Root)));
+ 
+          Set_Parent
+            (Node   => Right (Target_Root),
+             Parent => Target_Root);
+       end if;
+ 
+       P := Target_Root;
+ 
+       X := Left (Source_Root);
+       while X /= null loop
+          declare
+             Y : constant Node_Access := Copy_Node (X);
+          begin
+             Set_Left (Node => P, Left => Y);
+             Set_Parent (Node => Y, Parent => P);
+ 
+             if Right (X) /= null then
+                Set_Right
+                  (Node  => Y,
+                   Right => Generic_Copy_Tree (Right (X)));
+ 
+                Set_Parent
+                  (Node   => Right (Y),
+                   Parent => Y);
+             end if;
+ 
+             P := Y;
+             X := Left (X);
+          end;
+       end loop;
+ 
+       return Target_Root;
+    exception
+       when others =>
+          Delete_Tree (Target_Root);
+          raise;
+    end Generic_Copy_Tree;
+ 
+    -------------------------
+    -- Generic_Delete_Tree --
+    -------------------------
+ 
+    procedure Generic_Delete_Tree (X : in out Node_Access) is
+       Y : Node_Access;
+    begin
+       while X /= null loop
+          Y := Right (X);
+          Generic_Delete_Tree (Y);
+          Y := Left (X);
+          Free (X);
+          X := Y;
+       end loop;
+    end Generic_Delete_Tree;
+ 
     -------------------
     -- Generic_Equal --
     -------------------
*************** package body Ada.Containers.Red_Black_Tr
*** 490,502 ****
        R_Node : Node_Access;
  
     begin
        if Left.Length /= Right.Length then
           return False;
        end if;
  
        L_Node := Left.First;
        R_Node := Right.First;
!       while L_Node /= Null_Node loop
           if not Is_Equal (L_Node, R_Node) then
              return False;
           end if;
--- 612,628 ----
        R_Node : Node_Access;
  
     begin
+       if Left'Address = Right'Address then
+          return True;
+       end if;
+ 
        if Left.Length /= Right.Length then
           return False;
        end if;
  
        L_Node := Left.First;
        R_Node := Right.First;
!       while L_Node /= null loop
           if not Is_Equal (L_Node, R_Node) then
              return False;
           end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 522,528 ****
        procedure Iterate (P : Node_Access) is
           X : Node_Access := P;
        begin
!          while X /= Null_Node loop
              Iterate (Left (X));
              Process (X);
              X := Right (X);
--- 648,654 ----
        procedure Iterate (P : Node_Access) is
           X : Node_Access := P;
        begin
!          while X /= null loop
              Iterate (Left (X));
              Process (X);
              X := Right (X);
*************** package body Ada.Containers.Red_Black_Tr
*** 536,558 ****
     end Generic_Iteration;
  
     ------------------
!    -- Generic_Read --
     ------------------
  
!    procedure Generic_Read (Tree : in out Tree_Type; N : Count_Type) is
  
!       pragma Assert (Tree.Length = 0);
!       --  Clear and back node reinit was done by caller
  
        Node, Last_Node : Node_Access;
  
     begin
        if N = 0 then
           return;
        end if;
  
!       Node := New_Node;
!       pragma Assert (Node /= Null_Node);
        pragma Assert (Color (Node) = Red);
  
        Set_Color (Node, Black);
--- 662,716 ----
     end Generic_Iteration;
  
     ------------------
!    -- Generic_Move --
     ------------------
  
!    procedure Generic_Move (Target, Source : in out Tree_Type) is
!    begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
  
!       if Source.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       Clear (Target);
! 
!       Target := Source;
! 
!       Source := (First  => null,
!                  Last   => null,
!                  Root   => null,
!                  Length => 0,
!                  Busy   => 0,
!                  Lock   => 0);
!    end Generic_Move;
! 
!    ------------------
!    -- Generic_Read --
!    ------------------
! 
!    procedure Generic_Read
!      (Stream : access Root_Stream_Type'Class;
!       Tree   : in out Tree_Type)
!    is
!       N : Count_Type'Base;
  
        Node, Last_Node : Node_Access;
  
     begin
+       Clear (Tree);
+ 
+       Count_Type'Base'Read (Stream, N);
+       pragma Assert (N >= 0);
+ 
        if N = 0 then
           return;
        end if;
  
!       Node := Read_Node (Stream);
!       pragma Assert (Node /= null);
        pragma Assert (Color (Node) = Red);
  
        Set_Color (Node, Black);
*************** package body Ada.Containers.Red_Black_Tr
*** 567,574 ****
           Last_Node := Node;
           pragma Assert (Last_Node = Tree.Last);
  
!          Node := New_Node;
!          pragma Assert (Node /= Null_Node);
           pragma Assert (Color (Node) = Red);
  
           Set_Right (Node => Last_Node, Right => Node);
--- 725,732 ----
           Last_Node := Node;
           pragma Assert (Last_Node = Tree.Last);
  
!          Node := Read_Node (Stream);
!          pragma Assert (Node /= null);
           pragma Assert (Color (Node) = Red);
  
           Set_Right (Node => Last_Node, Right => Node);
*************** package body Ada.Containers.Red_Black_Tr
*** 594,600 ****
        procedure Iterate (P : Node_Access) is
           X : Node_Access := P;
        begin
!          while X /= Null_Node loop
              Iterate (Right (X));
              Process (X);
              X := Left (X);
--- 752,758 ----
        procedure Iterate (P : Node_Access) is
           X : Node_Access := P;
        begin
!          while X /= null loop
              Iterate (Right (X));
              Process (X);
              X := Left (X);
*************** package body Ada.Containers.Red_Black_Tr
*** 607,612 ****
--- 765,800 ----
        Iterate (Tree.Root);
     end Generic_Reverse_Iteration;
  
+    -------------------
+    -- Generic_Write --
+    -------------------
+ 
+    procedure Generic_Write
+      (Stream : access Root_Stream_Type'Class;
+       Tree   : in     Tree_Type)
+    is
+       procedure Process (Node : Node_Access);
+       pragma Inline (Process);
+ 
+       procedure Iterate is
+          new Generic_Iteration (Process);
+ 
+       -------------
+       -- Process --
+       -------------
+ 
+       procedure Process (Node : Node_Access) is
+       begin
+          Write_Node (Stream, Node);
+       end Process;
+ 
+    --  Start of processing for Generic_Write
+ 
+    begin
+       Count_Type'Base'Write (Stream, Tree.Length);
+       Iterate (Tree);
+    end Generic_Write;
+ 
     -----------------
     -- Left_Rotate --
     -----------------
*************** package body Ada.Containers.Red_Black_Tr
*** 616,627 ****
        --  CLR p266 ???
  
        Y : constant Node_Access := Right (X);
!       pragma Assert (Y /= Null_Node);
  
     begin
        Set_Right (X, Left (Y));
  
!       if Left (Y) /= Null_Node then
           Set_Parent (Left (Y), X);
        end if;
  
--- 804,815 ----
        --  CLR p266 ???
  
        Y : constant Node_Access := Right (X);
!       pragma Assert (Y /= null);
  
     begin
        Set_Right (X, Left (Y));
  
!       if Left (Y) /= null then
           Set_Parent (Left (Y), X);
        end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 655,661 ****
        loop
           Y := Right (X);
  
!          if Y = Null_Node then
              return X;
           end if;
  
--- 843,849 ----
        loop
           Y := Right (X);
  
!          if Y = null then
              return X;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 678,684 ****
        loop
           Y := Left (X);
  
!          if Y = Null_Node then
              return X;
           end if;
  
--- 866,872 ----
        loop
           Y := Left (X);
  
!          if Y = null then
              return X;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 687,709 ****
     end Min;
  
     ----------
-    -- Move --
-    ----------
- 
-    procedure Move (Target, Source : in out Tree_Type) is
-    begin
-       if Target.Length > 0 then
-          raise Constraint_Error;
-       end if;
- 
-       Target := Source;
-       Source := (First => Null_Node,
-                  Last  => Null_Node,
-                  Root  => Null_Node,
-                  Length => 0);
-    end Move;
- 
-    ----------
     -- Next --
     ----------
  
--- 875,880 ----
*************** package body Ada.Containers.Red_Black_Tr
*** 711,721 ****
     begin
        --  CLR p249 ???
  
!       if Node = Null_Node then
!          return Null_Node;
        end if;
  
!       if Right (Node) /= Null_Node then
           return Min (Right (Node));
        end if;
  
--- 882,892 ----
     begin
        --  CLR p249 ???
  
!       if Node = null then
!          return null;
        end if;
  
!       if Right (Node) /= null then
           return Min (Right (Node));
        end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 724,730 ****
           Y : Node_Access := Parent (Node);
  
        begin
!          while Y /= Null_Node
             and then X = Right (Y)
           loop
              X := Y;
--- 895,901 ----
           Y : Node_Access := Parent (Node);
  
        begin
!          while Y /= null
             and then X = Right (Y)
           loop
              X := Y;
*************** package body Ada.Containers.Red_Black_Tr
*** 749,759 ****
  
     function Previous (Node : Node_Access) return Node_Access is
     begin
!       if Node = Null_Node then
!          return Null_Node;
        end if;
  
!       if Left (Node) /= Null_Node then
           return Max (Left (Node));
        end if;
  
--- 920,930 ----
  
     function Previous (Node : Node_Access) return Node_Access is
     begin
!       if Node = null then
!          return null;
        end if;
  
!       if Left (Node) /= null then
           return Max (Left (Node));
        end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 762,768 ****
           Y : Node_Access := Parent (Node);
  
        begin
!          while Y /= Null_Node
             and then X = Left (Y)
           loop
              X := Y;
--- 933,939 ----
           Y : Node_Access := Parent (Node);
  
        begin
!          while Y /= null
             and then X = Left (Y)
           loop
              X := Y;
*************** package body Ada.Containers.Red_Black_Tr
*** 792,798 ****
        --  CLR p.268 ???
  
        X : Node_Access := Node;
!       pragma Assert (X /= Null_Node);
        pragma Assert (Color (X) = Red);
  
        Y : Node_Access;
--- 963,969 ----
        --  CLR p.268 ???
  
        X : Node_Access := Node;
!       pragma Assert (X /= null);
        pragma Assert (Color (X) = Red);
  
        Y : Node_Access;
*************** package body Ada.Containers.Red_Black_Tr
*** 802,808 ****
           if Parent (X) = Left (Parent (Parent (X))) then
              Y := Right (Parent (Parent (X)));
  
!             if Y /= Null_Node and then Color (Y) = Red then
                 Set_Color (Parent (X), Black);
                 Set_Color (Y, Black);
                 Set_Color (Parent (Parent (X)), Red);
--- 973,979 ----
           if Parent (X) = Left (Parent (Parent (X))) then
              Y := Right (Parent (Parent (X)));
  
!             if Y /= null and then Color (Y) = Red then
                 Set_Color (Parent (X), Black);
                 Set_Color (Y, Black);
                 Set_Color (Parent (Parent (X)), Red);
*************** package body Ada.Containers.Red_Black_Tr
*** 824,830 ****
  
              Y := Left (Parent (Parent (X)));
  
!             if Y /= Null_Node and then Color (Y) = Red then
                 Set_Color (Parent (X), Black);
                 Set_Color (Y, Black);
                 Set_Color (Parent (Parent (X)), Red);
--- 995,1001 ----
  
              Y := Left (Parent (Parent (X)));
  
!             if Y /= null and then Color (Y) = Red then
                 Set_Color (Parent (X), Black);
                 Set_Color (Y, Black);
                 Set_Color (Parent (Parent (X)), Red);
*************** package body Ada.Containers.Red_Black_Tr
*** 852,863 ****
  
     procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access) is
        X : constant Node_Access := Left (Y);
!       pragma Assert (X /= Null_Node);
  
     begin
        Set_Left (Y, Right (X));
  
!       if Right (X) /= Null_Node then
           Set_Parent (Right (X), Y);
        end if;
  
--- 1023,1034 ----
  
     procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access) is
        X : constant Node_Access := Left (Y);
!       pragma Assert (X /= null);
  
     begin
        Set_Left (Y, Right (X));
  
!       if Right (X) /= null then
           Set_Parent (Right (X), Y);
        end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 876,879 ****
--- 1047,1152 ----
        Set_Parent (Y, X);
     end Right_Rotate;
  
+    ---------
+    -- Vet --
+    ---------
+ 
+    function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is
+    begin
+       if Node = null then
+          return True;
+       end if;
+ 
+       if Parent (Node) = Node
+         or else Left (Node) = Node
+         or else Right (Node) = Node
+       then
+          return False;
+       end if;
+ 
+       if Tree.Length = 0
+         or else Tree.Root = null
+         or else Tree.First = null
+         or else Tree.Last = null
+       then
+          return False;
+       end if;
+ 
+       if Parent (Tree.Root) /= null then
+          return False;
+       end if;
+ 
+       if Left (Tree.First) /= null then
+          return False;
+       end if;
+ 
+       if Right (Tree.Last) /= null then
+          return False;
+       end if;
+ 
+       if Tree.Length = 1 then
+          if Tree.First /= Tree.Last
+            or else Tree.First /= Tree.Root
+          then
+             return False;
+          end if;
+ 
+          if Node /= Tree.First then
+             return False;
+          end if;
+ 
+          if Parent (Node) /= null
+            or else Left (Node) /= null
+            or else Right (Node) /= null
+          then
+             return False;
+          end if;
+ 
+          return True;
+       end if;
+ 
+       if Tree.First = Tree.Last then
+          return False;
+       end if;
+ 
+       if Tree.Length = 2 then
+          if Tree.First /= Tree.Root
+            and then Tree.Last /= Tree.Root
+          then
+             return False;
+          end if;
+ 
+          if Tree.First /= Node
+            and then Tree.Last /= Node
+          then
+             return False;
+          end if;
+       end if;
+ 
+       if Left (Node) /= null
+         and then Parent (Left (Node)) /= Node
+       then
+          return False;
+       end if;
+ 
+       if Right (Node) /= null
+         and then Parent (Right (Node)) /= Node
+       then
+          return False;
+       end if;
+ 
+       if Parent (Node) = null then
+          if Tree.Root /= Node then
+             return False;
+          end if;
+ 
+       elsif Left (Parent (Node)) /= Node
+         and then Right (Parent (Node)) /= Node
+       then
+          return False;
+       end if;
+ 
+       return True;
+    end Vet;
+ 
  end Ada.Containers.Red_Black_Trees.Generic_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-crbtgo.ads gcc-4.1.0/gcc/ada/a-crbtgo.ads
*** gcc-4.0.2/gcc/ada/a-crbtgo.ads	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-crbtgo.ads	Tue Nov 15 13:54:02 2005
***************
*** 2,24 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --            ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_OPERATIONS             --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! -- This specification is adapted from the Ada Reference Manual for use with --
! -- GNAT.  In accordance with the copyright of that document, you can freely --
! -- copy and modify this specification,  provided that if you redistribute a --
! -- modified version,  any changes that you have made are clearly indicated. --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  generic
     with package Tree_Types is new Generic_Tree_Types (<>);
     use Tree_Types;
  
-    Null_Node : Node_Access;
- 
     with function  Parent (Node : Node_Access) return Node_Access is <>;
     with procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is <>;
     with function  Left (Node : Node_Access) return Node_Access is <>;
--- 2,45 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --        A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .     --
! --                    G E N E R I C _ O P E R A T I O N S                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- This specification is derived from the Ada Reference Manual for use with --
! -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the  contents of the part following the private keyword. --
  --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
+ with Ada.Streams; use Ada.Streams;
+ 
  generic
     with package Tree_Types is new Generic_Tree_Types (<>);
     use Tree_Types;
  
     with function  Parent (Node : Node_Access) return Node_Access is <>;
     with procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is <>;
     with function  Left (Node : Node_Access) return Node_Access is <>;
*************** generic
*** 29,48 ****
     with procedure Set_Color (Node : Node_Access; Color : Color_Type) is <>;
  
  package Ada.Containers.Red_Black_Trees.Generic_Operations is
! pragma Pure;
  
     function Min (Node : Node_Access) return Node_Access;
  
     function Max (Node : Node_Access) return Node_Access;
  
!    procedure Check_Invariant (Tree : Tree_Type);
  
     function Next (Node : Node_Access) return Node_Access;
  
     function Previous (Node : Node_Access) return Node_Access;
  
-    procedure Move (Target, Source : in out Tree_Type);
- 
     generic
        with function Is_Equal (L, R : Node_Access) return Boolean;
     function Generic_Equal (Left, Right : Tree_Type) return Boolean;
--- 50,74 ----
     with procedure Set_Color (Node : Node_Access; Color : Color_Type) is <>;
  
  package Ada.Containers.Red_Black_Trees.Generic_Operations is
!    pragma Pure;
  
     function Min (Node : Node_Access) return Node_Access;
  
     function Max (Node : Node_Access) return Node_Access;
  
!    --  NOTE: The Check_Invariant operation was used during early
!    --  development of the red-black tree. Now that the tree type
!    --  implementation has matured, we don't really need Check_Invariant
!    --  anymore.
! 
!    --  procedure Check_Invariant (Tree : Tree_Type);
! 
!    function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean;
  
     function Next (Node : Node_Access) return Node_Access;
  
     function Previous (Node : Node_Access) return Node_Access;
  
     generic
        with function Is_Equal (L, R : Node_Access) return Boolean;
     function Generic_Equal (Left, Right : Tree_Type) return Boolean;
*************** pragma Pure;
*** 52,57 ****
--- 78,104 ----
        Node : Node_Access);
  
     generic
+       with procedure Free (X : in out Node_Access);
+    procedure Generic_Delete_Tree (X : in out Node_Access);
+ 
+    generic
+       with function Copy_Node (Source : Node_Access) return Node_Access;
+       with procedure Delete_Tree (X : in out Node_Access);
+    function Generic_Copy_Tree (Source_Root : Node_Access) return Node_Access;
+ 
+    generic
+       with function Copy_Tree (Root : Node_Access) return Node_Access;
+    procedure Generic_Adjust (Tree : in out Tree_Type);
+ 
+    generic
+       with procedure Delete_Tree (X : in out Node_Access);
+    procedure Generic_Clear (Tree : in out Tree_Type);
+ 
+    generic
+       with procedure Clear (Tree : in out Tree_Type);
+    procedure Generic_Move (Target, Source : in out Tree_Type);
+ 
+    generic
        with procedure Process (Node : Node_Access) is <>;
     procedure Generic_Iteration (Tree : Tree_Type);
  
*************** pragma Pure;
*** 60,67 ****
     procedure Generic_Reverse_Iteration (Tree : Tree_Type);
  
     generic
!       with function New_Node return Node_Access is <>;
!    procedure Generic_Read (Tree : in out Tree_Type; N : Count_Type);
  
     procedure Rebalance_For_Insert
       (Tree : in out Tree_Type;
--- 107,126 ----
     procedure Generic_Reverse_Iteration (Tree : Tree_Type);
  
     generic
!       with procedure Write_Node
!         (Stream : access Root_Stream_Type'Class;
!          Node   : Node_Access);
!    procedure Generic_Write
!      (Stream : access Root_Stream_Type'Class;
!       Tree   : Tree_Type);
! 
!    generic
!       with procedure Clear (Tree : in out Tree_Type);
!       with function Read_Node
!         (Stream : access Root_Stream_Type'Class) return Node_Access;
!    procedure Generic_Read
!      (Stream : access Root_Stream_Type'Class;
!       Tree   : in out Tree_Type);
  
     procedure Rebalance_For_Insert
       (Tree : in out Tree_Type;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cwila1.ads gcc-4.1.0/gcc/ada/a-cwila1.ads
*** gcc-4.0.2/gcc/ada/a-cwila1.ads	Thu Apr 24 17:53:52 2003
--- gcc-4.1.0/gcc/ada/a-cwila1.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . C H A R A C T E R S . W I D E _ L A T I N _ 1           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . C H A R A C T E R S . W I D E _ L A T I N _ 1           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Latin_1 is
! pragma Pure (Wide_Latin_1);
  
     ------------------------
     -- Control Characters --
--- 37,43 ----
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Latin_1 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-cwila9.ads gcc-4.1.0/gcc/ada/a-cwila9.ads
*** gcc-4.0.2/gcc/ada/a-cwila9.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-cwila9.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . C H A R A C T E R S . W I D E _ L A T I N _ 9           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . C H A R A C T E R S . W I D E _ L A T I N _ 9           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Latin_9 is
! pragma Pure (Wide_Latin_9);
  
     ------------------------
     -- Control Characters --
--- 37,43 ----
  --  is in accordance with the implementation permission in RM (A.3.3(27)).
  
  package Ada.Characters.Wide_Latin_9 is
!    pragma Pure;
  
     ------------------------
     -- Control Characters --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-decima.adb gcc-4.1.0/gcc/ada/a-decima.adb
*** gcc-4.0.2/gcc/ada/a-decima.adb	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-decima.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          A D A . D E C I M A L                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          A D A . D E C I M A L                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-decima.ads gcc-4.1.0/gcc/ada/a-decima.ads
*** gcc-4.0.2/gcc/ada/a-decima.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-decima.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  ------------------------------------------------------------------------------
  
  package Ada.Decimal is
! pragma Pure (Decimal);
  
     --  The compiler makes a number of assumptions based on the following five
     --  constants (e.g. there is an assumption that decimal values can always
--- 36,42 ----
  ------------------------------------------------------------------------------
  
  package Ada.Decimal is
!    pragma Pure;
  
     --  The compiler makes a number of assumptions based on the following five
     --  constants (e.g. there is an assumption that decimal values can always
diff -Nrcpad gcc-4.0.2/gcc/ada/a-diocst.adb gcc-4.1.0/gcc/ada/a-diocst.adb
*** gcc-4.0.2/gcc/ada/a-diocst.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-diocst.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-diocst.ads gcc-4.1.0/gcc/ada/a-diocst.ads
*** gcc-4.0.2/gcc/ada/a-diocst.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-diocst.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . D I R E C T _ I O . C _ S T R E A M S               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . D I R E C T _ I O . C _ S T R E A M S               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-direct.adb gcc-4.1.0/gcc/ada/a-direct.adb
*** gcc-4.0.2/gcc/ada/a-direct.adb	Wed Oct 27 13:56:03 2004
--- gcc-4.1.0/gcc/ada/a-direct.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,45 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Directories.Validity; use Ada.Directories.Validity;
! with Ada.Strings.Unbounded;    use Ada.Strings.Unbounded;
  with Ada.Unchecked_Deallocation;
! with Ada.Characters.Handling;  use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations; use GNAT.Directory_Operations;
! with GNAT.OS_Lib;               use GNAT.OS_Lib;
! with GNAT.Regexp;               use GNAT.Regexp;
! --  ??? Ada units cannot depend on GNAT units
  
  with System;
  
--- 31,45 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Directories.Validity;   use Ada.Directories.Validity;
! with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
  with Ada.Unchecked_Deallocation;
! with Ada.Characters.Handling;    use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
! with GNAT.OS_Lib;                use GNAT.OS_Lib;
! with GNAT.Regexp;                use GNAT.Regexp;
! --  ??? Ada units should not depend on GNAT units
  
  with System;
  
*************** package body Ada.Directories is
*** 62,68 ****
     procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
  
     function File_Exists (Name : String) return Boolean;
!    --  Returns True if the named file exists.
  
     procedure Fetch_Next_Entry (Search : Search_Type);
     --  Get the next entry in a directory, setting Entry_Fetched if successful
--- 62,68 ----
     procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
  
     function File_Exists (Name : String) return Boolean;
!    --  Returns True if the named file exists
  
     procedure Fetch_Next_Entry (Search : Search_Type);
     --  Get the next entry in a directory, setting Entry_Fetched if successful
*************** package body Ada.Directories is
*** 126,132 ****
        then
           raise Name_Error;
  
!          --  This is not an invalid case. Build the path name.
  
        else
           Last := Containing_Directory'Length;
--- 126,132 ----
        then
           raise Name_Error;
  
!          --  This is not an invalid case so build the path name
  
        else
           Last := Containing_Directory'Length;
*************** package body Ada.Directories is
*** 938,943 ****
--- 938,944 ----
  
        exception
           when Error_In_Regexp =>
+             Free (Search.Value);
              raise Name_Error;
        end;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-direct.ads gcc-4.1.0/gcc/ada/a-direct.ads
*** gcc-4.0.2/gcc/ada/a-direct.ads	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/a-direct.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004 Free Software Foundation, Inc.               --
  --                                                                          --
  -- This specification is derived for use with GNAT from AI-00248,  which is --
  -- expected to be a part of a future expected revised Ada Reference Manual. --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived for use with GNAT from AI-00248,  which is --
  -- expected to be a part of a future expected revised Ada Reference Manual. --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Ada.Directories is
*** 178,185 ****
     --  and form given by Form, or copying of the file with the name given by
     --  Source_Name (in the absence of Name_Error).
  
! 
!    --  File and directory name operations:
  
     function Full_Name (Name : String) return String;
     --  Returns the full name corresponding to the file name specified by Name.
--- 178,186 ----
     --  and form given by Form, or copying of the file with the name given by
     --  Source_Name (in the absence of Name_Error).
  
!    ----------------------------------------
!    -- File and directory name operations --
!    ----------------------------------------
  
     function Full_Name (Name : String) return String;
     --  Returns the full name corresponding to the file name specified by Name.
*************** package Ada.Directories is
*** 231,245 ****
     --  Name is not a possible simple name (if Extension is null) or base name
     --  (if Extension is non-null).
  
! 
!    --  File and directory queries:
  
     type File_Kind is (Directory, Ordinary_File, Special_File);
     --  The type File_Kind represents the kind of file represented by an
     --  external file or directory.
  
     type File_Size is range 0 .. Long_Long_Integer'Last;
!    --  The type File_Size represents the size of an external file.
  
     function Exists (Name : String) return Boolean;
     --  Returns True if external file represented by Name exists, and False
--- 232,247 ----
     --  Name is not a possible simple name (if Extension is null) or base name
     --  (if Extension is non-null).
  
!    --------------------------------
!    -- File and directory queries --
!    --------------------------------
  
     type File_Kind is (Directory, Ordinary_File, Special_File);
     --  The type File_Kind represents the kind of file represented by an
     --  external file or directory.
  
     type File_Size is range 0 .. Long_Long_Integer'Last;
!    --  The type File_Size represents the size of an external file
  
     function Exists (Name : String) return Boolean;
     --  Returns True if external file represented by Name exists, and False
*************** package Ada.Directories is
*** 304,313 ****
     --  Starts a search in the directory entry in the directory named by
     --  Directory for entries matching Pattern. Pattern represents a file name
     --  matching pattern. If Pattern is null, all items in the directory are
!    --  matched; otherwise, the interpretation of Pattern is
!    --  implementation-defined. Only items which match Filter will be returned.
!    --  After a successful call on Start_Search, the object Search may have
!    --  entries available, but it may have no entries available if no files or
     --  directories match Pattern and Filter. The exception Name_Error is
     --  propagated if the string given by Directory does not identify an
     --  existing directory, or if Pattern does not allow the identification of
--- 306,315 ----
     --  Starts a search in the directory entry in the directory named by
     --  Directory for entries matching Pattern. Pattern represents a file name
     --  matching pattern. If Pattern is null, all items in the directory are
!    --  matched; otherwise, the interpretation of Pattern is implementation-
!    --  defined. Only items which match Filter will be returned. After a
!    --  successful call on Start_Search, the object Search may have entries
!    --  available, but it may have no entries available if no files or
     --  directories match Pattern and Filter. The exception Name_Error is
     --  propagated if the string given by Directory does not identify an
     --  existing directory, or if Pattern does not allow the identification of
*************** package Ada.Directories is
*** 317,323 ****
  
     procedure End_Search (Search : in out Search_Type);
     --  Ends the search represented by Search. After a successful call on
!    --  End_Search, the object Search will have no entries available.
  
     function More_Entries (Search : Search_Type) return Boolean;
     --  Returns True if more entries are available to be returned by a call
--- 319,328 ----
  
     procedure End_Search (Search : in out Search_Type);
     --  Ends the search represented by Search. After a successful call on
!    --  End_Search, the object Search will have no entries available. Note
!    --  that is is not necessary to call End_Search if the call to Start_Search
!    --  was unsuccessful and raised an exception (but it is harmless to make
!    --  the call in this case)>
  
     function More_Entries (Search : Search_Type) return Boolean;
     --  Returns True if more entries are available to be returned by a call
*************** private
*** 400,418 ****
  
     --  Search_Type need to be a controlled type, because it includes component
     --  of type Dir_Type (in GNAT.Directory_Operations) that need to be closed
!    --  (if opened) during finalization.
!    --  The component need to be an access value, because Search_Data is not
!    --  fully defined in the spec.
  
     type Search_Type is new Ada.Finalization.Controlled with record
        Value : Search_Ptr;
     end record;
  
     procedure Finalize (Search : in out Search_Type);
!    --  Close the directory, if opened, and deallocate Value.
  
     procedure End_Search (Search : in out Search_Type) renames Finalize;
  
  end Ada.Directories;
- 
- 
--- 405,420 ----
  
     --  Search_Type need to be a controlled type, because it includes component
     --  of type Dir_Type (in GNAT.Directory_Operations) that need to be closed
!    --  (if opened) during finalization. The component need to be an access
!    --  value, because Search_Data is not fully defined in the spec.
  
     type Search_Type is new Ada.Finalization.Controlled with record
        Value : Search_Ptr;
     end record;
  
     procedure Finalize (Search : in out Search_Type);
!    --  Close the directory, if opened, and deallocate Value
  
     procedure End_Search (Search : in out Search_Type) renames Finalize;
  
  end Ada.Directories;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-direio.adb gcc-4.1.0/gcc/ada/a-direio.adb
*** gcc-4.0.2/gcc/ada/a-direio.adb	Mon Jan  3 15:32:14 2005
--- gcc-4.1.0/gcc/ada/a-direio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        A D A . D I R E C T _ I O                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        A D A . D I R E C T _ I O                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Direct_IO is
*** 51,57 ****
  
     Zeroes : constant System.Storage_Elements.Storage_Array :=
                (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
!    --  Buffer used to fill out partial records.
  
     package FCB renames System.File_Control_Block;
     package FIO renames System.File_IO;
--- 51,57 ----
  
     Zeroes : constant System.Storage_Elements.Storage_Array :=
                (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
!    --  Buffer used to fill out partial records
  
     package FCB renames System.File_Control_Block;
     package FIO renames System.File_IO;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-direio.ads gcc-4.1.0/gcc/ada/a-direio.ads
*** gcc-4.0.2/gcc/ada/a-direio.ads	Thu Jul 15 20:34:34 2004
--- gcc-4.1.0/gcc/ada/a-direio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  with Ada.IO_Exceptions;
  with System.Direct_IO;
  with Interfaces.C_Streams;
--- 35,40 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dirval-mingw.adb gcc-4.1.0/gcc/ada/a-dirval-mingw.adb
*** gcc-4.0.2/gcc/ada/a-dirval-mingw.adb	Wed Oct 27 13:56:03 2004
--- gcc-4.1.0/gcc/ada/a-dirval-mingw.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                            (Windows Version)                             --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                            (Windows Version)                             --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Directories.Validity is
*** 147,153 ****
              end if;
           end loop;
  
!          --  If no invalid chars, and not all spaces, file name is valid.
  
           return not Only_Spaces;
        end if;
--- 147,153 ----
              end if;
           end loop;
  
!          --  If no invalid chars, and not all spaces, file name is valid
  
           return not Only_Spaces;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dirval-vms.adb gcc-4.1.0/gcc/ada/a-dirval-vms.adb
*** gcc-4.0.2/gcc/ada/a-dirval-vms.adb	Wed Oct 27 13:56:03 2004
--- gcc-4.1.0/gcc/ada/a-dirval-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dirval.adb gcc-4.1.0/gcc/ada/a-dirval.adb
*** gcc-4.0.2/gcc/ada/a-dirval.adb	Wed Oct 27 13:56:03 2004
--- gcc-4.1.0/gcc/ada/a-dirval.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                             (POSIX Version)                              --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                             (POSIX Version)                              --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dirval.ads gcc-4.1.0/gcc/ada/a-dirval.ads
*** gcc-4.0.2/gcc/ada/a-dirval.ads	Wed Oct 27 13:56:03 2004
--- gcc-4.1.0/gcc/ada/a-dirval.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dynpri.adb gcc-4.1.0/gcc/ada/a-dynpri.adb
*** gcc-4.0.2/gcc/ada/a-dynpri.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/a-dynpri.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                 A D A . D Y N A M I C _ P R I O R I T I E S              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 A D A . D Y N A M I C _ P R I O R I T I E S              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Task_Primitives.Operations;
*** 47,70 ****
  with System.Tasking;
  --  used for Task_Id
  
- with Ada.Exceptions;
- --  used for Raise_Exception
- 
- with System.Tasking.Initialization;
- --  used for Defer/Undefer_Abort
- 
  with System.Parameters;
  --  used for Single_Lock
  
  with Unchecked_Conversion;
  
  package body Ada.Dynamic_Priorities is
  
     package STPO renames System.Task_Primitives.Operations;
  
     use System.Parameters;
     use System.Tasking;
-    use Ada.Exceptions;
  
     function Convert_Ids is new
       Unchecked_Conversion
--- 47,68 ----
  with System.Tasking;
  --  used for Task_Id
  
  with System.Parameters;
  --  used for Single_Lock
  
+ with System.Soft_Links;
+ --  use for Abort_Defer
+ --          Abort_Undefer
+ 
  with Unchecked_Conversion;
  
  package body Ada.Dynamic_Priorities is
  
     package STPO renames System.Task_Primitives.Operations;
+    package SSL renames System.Soft_Links;
  
     use System.Parameters;
     use System.Tasking;
  
     function Convert_Ids is new
       Unchecked_Conversion
*************** package body Ada.Dynamic_Priorities is
*** 85,97 ****
  
     begin
        if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
!          Raise_Exception (Program_Error'Identity,
!            Error_Message & "null task");
        end if;
  
        if Task_Identification.Is_Terminated (T) then
!          Raise_Exception (Tasking_Error'Identity,
!            Error_Message & "null task");
        end if;
  
        return Target.Common.Base_Priority;
--- 83,93 ----
  
     begin
        if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
!          raise Program_Error with Error_Message & "null task";
        end if;
  
        if Task_Identification.Is_Terminated (T) then
!          raise Tasking_Error with Error_Message & "null task";
        end if;
  
        return Target.Common.Base_Priority;
*************** package body Ada.Dynamic_Priorities is
*** 114,129 ****
  
     begin
        if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
!          Raise_Exception (Program_Error'Identity,
!            Error_Message & "null task");
        end if;
  
        if Task_Identification.Is_Terminated (T) then
!          Raise_Exception (Tasking_Error'Identity,
!            Error_Message & "terminated task");
        end if;
  
!       Initialization.Defer_Abort (Self_ID);
  
        if Single_Lock then
           STPO.Lock_RTS;
--- 110,123 ----
  
     begin
        if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then
!          raise Program_Error with Error_Message & "null task";
        end if;
  
        if Task_Identification.Is_Terminated (T) then
!          raise Tasking_Error with Error_Message & "terminated task";
        end if;
  
!       SSL.Abort_Defer.all;
  
        if Single_Lock then
           STPO.Lock_RTS;
*************** package body Ada.Dynamic_Priorities is
*** 141,147 ****
              STPO.Unlock_RTS;
           end if;
  
!          --  Yield is needed to enforce FIFO task dispatching.
  
           --  LL Set_Priority is made while holding the RTS lock so that it
           --  is inheriting high priority until it release all the RTS locks.
--- 135,141 ----
              STPO.Unlock_RTS;
           end if;
  
!          --  Yield is needed to enforce FIFO task dispatching
  
           --  LL Set_Priority is made while holding the RTS lock so that it
           --  is inheriting high priority until it release all the RTS locks.
*************** package body Ada.Dynamic_Priorities is
*** 168,174 ****
           end if;
        end if;
  
!       Initialization.Undefer_Abort (Self_ID);
     end Set_Priority;
  
  end Ada.Dynamic_Priorities;
--- 162,168 ----
           end if;
        end if;
  
!       SSL.Abort_Undefer.all;
     end Set_Priority;
  
  end Ada.Dynamic_Priorities;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-dynpri.ads gcc-4.1.0/gcc/ada/a-dynpri.ads
*** gcc-4.0.2/gcc/ada/a-dynpri.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-dynpri.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . D Y N A M I C _ P R I O R I T I E S                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . D Y N A M I C _ P R I O R I T I E S                --
  --                                                                          --
*************** with System;
*** 17,22 ****
--- 17,24 ----
  with Ada.Task_Identification;
  
  package Ada.Dynamic_Priorities is
+    pragma Preelaborate_05;
+    --  In accordance with Ada 2005 AI-362
  
     procedure Set_Priority
       (Priority : System.Any_Priority;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-einuoc.adb gcc-4.1.0/gcc/ada/a-einuoc.adb
*** gcc-4.0.2/gcc/ada/a-einuoc.adb	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-einuoc.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-einuoc.ads gcc-4.1.0/gcc/ada/a-einuoc.ads
*** gcc-4.0.2/gcc/ada/a-einuoc.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-einuoc.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-elchha.adb gcc-4.1.0/gcc/ada/a-elchha.adb
*** gcc-4.0.2/gcc/ada/a-elchha.adb	Tue Jul 20 10:26:51 2004
--- gcc-4.1.0/gcc/ada/a-elchha.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,42 ****
--- 37,44 ----
  
  --  Default version for most targets
  
+ with System.Standard_Library; use System.Standard_Library;
+ 
  procedure Ada.Exceptions.Last_Chance_Handler
    (Except : Exception_Occurrence)
  is
*************** begin
*** 88,94 ****
     --  really an exception at all. We recognize this by the fact that
     --  it is the only exception whose name starts with underscore.
  
!    if Except.Id.Full_Name.all (1) = '_' then
        To_Stderr (Nline);
        To_Stderr ("Execution terminated by abort of environment task");
        To_Stderr (Nline);
--- 90,96 ----
     --  really an exception at all. We recognize this by the fact that
     --  it is the only exception whose name starts with underscore.
  
!    if To_Ptr (Except.Id.Full_Name) (1) = '_' then
        To_Stderr (Nline);
        To_Stderr ("Execution terminated by abort of environment task");
        To_Stderr (Nline);
*************** begin
*** 100,106 ****
     elsif Except.Num_Tracebacks = 0 then
        To_Stderr (Nline);
        To_Stderr ("raised ");
!       To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
  
        if Exception_Message_Length (Except) /= 0 then
           To_Stderr (" : ");
--- 102,109 ----
     elsif Except.Num_Tracebacks = 0 then
        To_Stderr (Nline);
        To_Stderr ("raised ");
!       To_Stderr
!         (To_Ptr (Except.Id.Full_Name) (1 .. Except.Id.Name_Length - 1));
  
        if Exception_Message_Length (Except) /= 0 then
           To_Stderr (" : ");
diff -Nrcpad gcc-4.0.2/gcc/ada/a-elchha.ads gcc-4.1.0/gcc/ada/a-elchha.ads
*** gcc-4.0.2/gcc/ada/a-elchha.ads	Fri Dec  5 10:24:04 2003
--- gcc-4.1.0/gcc/ada/a-elchha.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-excach.adb gcc-4.1.0/gcc/ada/a-excach.adb
*** gcc-4.0.2/gcc/ada/a-excach.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-excach.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --                         ADA.EXCEPTIONS.CALL_CHAIN                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 2,12 ----
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --             A D A . E X C E P T I O N S . C A L L _ C H A I N            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
--- 31,45 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ pragma Warnings (Off);
+ --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
+ --  package will be categorized as Preelaborate. See AI-362 for details.
+ --  It is safe in the context of the run-time to violate the rules!
+ 
  with System.Traceback;
  
+ pragma Warnings (On);
+ 
  separate (Ada.Exceptions)
  procedure Call_Chain (Excep : EOA) is
  
*************** procedure Call_Chain (Excep : EOA) is
*** 42,48 ****
     --  occurrences.
  
  begin
- 
     if Exception_Tracebacks /= 0 and Excep.Num_Tracebacks = 0 then
  
        --  If Exception_Tracebacks = 0 then the program was not
--- 49,54 ----
*************** begin
*** 65,71 ****
           Exclude_Min => Code_Address_For_AAA,
           Exclude_Max => Code_Address_For_ZZZ,
           Skip_Frames => 3);
- 
     end if;
  
  end Call_Chain;
--- 71,76 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-except.adb gcc-4.1.0/gcc/ada/a-except.adb
*** gcc-4.0.2/gcc/ada/a-except.adb	Thu Feb 10 13:50:40 2005
--- gcc-4.1.0/gcc/ada/a-except.adb	Tue Nov 15 13:52:55 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 35,68 ****
  --  We must turn polling off for this unit, because otherwise we get
  --  elaboration circularities with System.Exception_Tables.
  
- pragma Warnings (Off);
- --  Since several constructs give warnings in 3.14a1, including unreferenced
- --  variables and pragma Unreferenced itself.
- 
  with System;                  use System;
  with System.Standard_Library; use System.Standard_Library;
  with System.Soft_Links;       use System.Soft_Links;
- with System.Machine_State_Operations; use System.Machine_State_Operations;
  
  package body Ada.Exceptions is
  
-    procedure builtin_longjmp (buffer : Address; Flag : Integer);
-    pragma No_Return (builtin_longjmp);
-    pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
- 
     pragma Suppress (All_Checks);
     --  We definitely do not want exceptions occurring within this unit, or
     --  we are in big trouble. If an exceptional situation does occur, better
     --  that it not be raised, since raising it can cause confusing chaos.
  
-    Zero_Cost_Exceptions : Integer;
-    pragma Import (C, Zero_Cost_Exceptions, "__gl_zero_cost_exceptions");
-    --  Boolean indicating if we are handling exceptions using a zero cost
-    --  mechanism.
-    --
-    --  Note that although we currently do not support it, the GCC3 back-end
-    --  tables are also potentially useable for setjmp/longjmp processing.
- 
     -----------------------
     -- Local Subprograms --
     -----------------------
--- 35,51 ----
*************** package body Ada.Exceptions is
*** 71,81 ****
     --  from C clients using the given external name, even though they are not
     --  technically visible in the Ada sense.
  
!    procedure AAA;
!    procedure ZZZ;
!    --  Mark start and end of procedures in this package
     --
!    --  The AAA and ZZZ procedures are used to provide exclusion bounds in
     --  calls to Call_Chain at exception raise points from this unit. The
     --  purpose is to arrange for the exception tracebacks not to include
     --  frames from routines involved in the raise process, as these are
--- 54,64 ----
     --  from C clients using the given external name, even though they are not
     --  technically visible in the Ada sense.
  
!    function Code_Address_For_AAA return System.Address;
!    function Code_Address_For_ZZZ return System.Address;
!    --  Return start and end of procedures in this package
     --
!    --  These procedures are used to provide exclusion bounds in
     --  calls to Call_Chain at exception raise points from this unit. The
     --  purpose is to arrange for the exception tracebacks not to include
     --  frames from routines involved in the raise process, as these are
*************** package body Ada.Exceptions is
*** 83,109 ****
     --
     --  For these bounds to be meaningful, we need to ensure that the object
     --  code for the routines involved in processing a raise is located after
!    --  the object code for AAA and before the object code for ZZZ. This will
!    --  indeed be the case as long as the following rules are respected:
     --
     --  1) The bodies of the subprograms involved in processing a raise
!    --     are located after the body of AAA and before the body of ZZZ.
     --
     --  2) No pragma Inline applies to any of these subprograms, as this
     --     could delay the corresponding assembly output until the end of
     --     the unit.
  
-    Code_Address_For_AAA, Code_Address_For_ZZZ : System.Address;
-    --  Used to represent addresses really inside the code range for AAA and
-    --  ZZZ, initialized to the address of a label inside the corresponding
-    --  procedure. This is initialization takes place inside the procedures
-    --  themselves, which are called as part of the elaboration code.
-    --
-    --  We are doing this instead of merely using Proc'Address because on some
-    --  platforms the latter does not yield the address we want, but the
-    --  address of a stub or of a descriptor instead. This is the case at least
-    --  on Alpha-VMS and PA-HPUX.
- 
     procedure Call_Chain (Excep : EOA);
     --  Store up to Max_Tracebacks in Excep, corresponding to the current
     --  call chain.
--- 66,83 ----
     --
     --  For these bounds to be meaningful, we need to ensure that the object
     --  code for the routines involved in processing a raise is located after
!    --  the object code Code_Address_For_AAA and before the object code
!    --  Code_Address_For_ZZZ. This will indeed be the case as long as the
!    --  following rules are respected:
     --
     --  1) The bodies of the subprograms involved in processing a raise
!    --     are located after the body of Code_Address_For_AAA and before the
!    --     body of Code_Address_For_ZZZ.
     --
     --  2) No pragma Inline applies to any of these subprograms, as this
     --     could delay the corresponding assembly output until the end of
     --     the unit.
  
     procedure Call_Chain (Excep : EOA);
     --  Store up to Max_Tracebacks in Excep, corresponding to the current
     --  call chain.
*************** package body Ada.Exceptions is
*** 139,147 ****
  
        procedure Set_Exception_C_Msg
          (Id   : Exception_Id;
!          Msg1 : Big_String_Ptr;
           Line : Integer        := 0;
!          Msg2 : Big_String_Ptr := null);
        --  This routine is called to setup the exception referenced by the
        --  Current_Excep field in the TSD to contain the indicated Id value
        --  and message. Msg1 is a null terminated string which is generated
--- 113,121 ----
  
        procedure Set_Exception_C_Msg
          (Id   : Exception_Id;
!          Msg1 : System.Address;
           Line : Integer        := 0;
!          Msg2 : System.Address := System.Null_Address);
        --  This routine is called to setup the exception referenced by the
        --  Current_Excep field in the TSD to contain the indicated Id value
        --  and message. Msg1 is a null terminated string which is generated
*************** package body Ada.Exceptions is
*** 210,216 ****
        pragma Export
          (Ada, Tailored_Exception_Information,
             "__gnat_tailored_exception_information");
!       --  This is currently used by System.Tasking.Stages.
  
     end Exception_Data;
  
--- 184,190 ----
        pragma Export
          (Ada, Tailored_Exception_Information,
             "__gnat_tailored_exception_information");
!       --  This is currently used by System.Tasking.Stages
  
     end Exception_Data;
  
*************** package body Ada.Exceptions is
*** 329,337 ****
  
     procedure Raise_With_Location_And_Msg
       (E : Exception_Id;
!       F : Big_String_Ptr;
        L : Integer;
!       M : Big_String_Ptr := null);
     pragma No_Return (Raise_With_Location_And_Msg);
     --  Raise an exception with given exception id value. A filename and line
     --  number is associated with the raise and is stored in the exception
--- 303,311 ----
  
     procedure Raise_With_Location_And_Msg
       (E : Exception_Id;
!       F : System.Address;
        L : Integer;
!       M : System.Address := System.Null_Address);
     pragma No_Return (Raise_With_Location_And_Msg);
     --  Raise an exception with given exception id value. A filename and line
     --  number is associated with the raise and is stored in the exception
*************** package body Ada.Exceptions is
*** 339,345 ****
     --  this (if M is not null).
  
     procedure Raise_Constraint_Error
!      (File : Big_String_Ptr;
        Line : Integer);
     pragma No_Return (Raise_Constraint_Error);
     pragma Export
--- 313,319 ----
     --  this (if M is not null).
  
     procedure Raise_Constraint_Error
!      (File : System.Address;
        Line : Integer);
     pragma No_Return (Raise_Constraint_Error);
     pragma Export
*************** package body Ada.Exceptions is
*** 347,362 ****
     --  Raise constraint error with file:line information
  
     procedure Raise_Constraint_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr);
     pragma No_Return (Raise_Constraint_Error_Msg);
     pragma Export
       (C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
     --  Raise constraint error with file:line + msg information
  
     procedure Raise_Program_Error
!      (File : Big_String_Ptr;
        Line : Integer);
     pragma No_Return (Raise_Program_Error);
     pragma Export
--- 321,336 ----
     --  Raise constraint error with file:line information
  
     procedure Raise_Constraint_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address);
     pragma No_Return (Raise_Constraint_Error_Msg);
     pragma Export
       (C, Raise_Constraint_Error_Msg, "__gnat_raise_constraint_error_msg");
     --  Raise constraint error with file:line + msg information
  
     procedure Raise_Program_Error
!      (File : System.Address;
        Line : Integer);
     pragma No_Return (Raise_Program_Error);
     pragma Export
*************** package body Ada.Exceptions is
*** 364,379 ****
     --  Raise program error with file:line information
  
     procedure Raise_Program_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr);
     pragma No_Return (Raise_Program_Error_Msg);
     pragma Export
       (C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
     --  Raise program error with file:line + msg information
  
     procedure Raise_Storage_Error
!      (File : Big_String_Ptr;
        Line : Integer);
     pragma No_Return (Raise_Storage_Error);
     pragma Export
--- 338,353 ----
     --  Raise program error with file:line information
  
     procedure Raise_Program_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address);
     pragma No_Return (Raise_Program_Error_Msg);
     pragma Export
       (C, Raise_Program_Error_Msg, "__gnat_raise_program_error_msg");
     --  Raise program error with file:line + msg information
  
     procedure Raise_Storage_Error
!      (File : System.Address;
        Line : Integer);
     pragma No_Return (Raise_Storage_Error);
     pragma Export
*************** package body Ada.Exceptions is
*** 381,389 ****
     --  Raise storage error with file:line information
  
     procedure Raise_Storage_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr);
     pragma No_Return (Raise_Storage_Error_Msg);
     pragma Export
       (C, Raise_Storage_Error_Msg, "__gnat_raise_storage_error_msg");
--- 355,363 ----
     --  Raise storage error with file:line information
  
     procedure Raise_Storage_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address);
     pragma No_Return (Raise_Storage_Error_Msg);
     pragma Export
       (C, Raise_Storage_Error_Msg, "__gnat_raise_storage_error_msg");
*************** package body Ada.Exceptions is
*** 423,434 ****
     --  The following procedures provide an internal interface to help making
     --  this explicit.
  
-    procedure Save_Occurrence_And_Private
-      (Target : out Exception_Occurrence;
-       Source : Exception_Occurrence);
-    --  Copy all the components of Source to Target as well as the
-    --  Private_Data pointer.
- 
     procedure Save_Occurrence_No_Private
       (Target : out Exception_Occurrence;
        Source : Exception_Occurrence);
--- 397,402 ----
*************** package body Ada.Exceptions is
*** 454,490 ****
     --  to the codes defined in Types.ads and a-types.h (for example,
     --  the name Rcheck_05 refers to the Reason whose Pos code is 5).
  
!    procedure Rcheck_00 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_01 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_02 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_03 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_04 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_05 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_06 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_07 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_08 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_09 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_10 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_11 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_12 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_13 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_14 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_15 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_16 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_17 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_18 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_19 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_20 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_21 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_22 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_23 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_24 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_25 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_26 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_27 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_28 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_29 (File : Big_String_Ptr; Line : Integer);
!    procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer);
  
     pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
     pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
--- 422,458 ----
     --  to the codes defined in Types.ads and a-types.h (for example,
     --  the name Rcheck_05 refers to the Reason whose Pos code is 5).
  
!    procedure Rcheck_00 (File : System.Address; Line : Integer);
!    procedure Rcheck_01 (File : System.Address; Line : Integer);
!    procedure Rcheck_02 (File : System.Address; Line : Integer);
!    procedure Rcheck_03 (File : System.Address; Line : Integer);
!    procedure Rcheck_04 (File : System.Address; Line : Integer);
!    procedure Rcheck_05 (File : System.Address; Line : Integer);
!    procedure Rcheck_06 (File : System.Address; Line : Integer);
!    procedure Rcheck_07 (File : System.Address; Line : Integer);
!    procedure Rcheck_08 (File : System.Address; Line : Integer);
!    procedure Rcheck_09 (File : System.Address; Line : Integer);
!    procedure Rcheck_10 (File : System.Address; Line : Integer);
!    procedure Rcheck_11 (File : System.Address; Line : Integer);
!    procedure Rcheck_12 (File : System.Address; Line : Integer);
!    procedure Rcheck_13 (File : System.Address; Line : Integer);
!    procedure Rcheck_14 (File : System.Address; Line : Integer);
!    procedure Rcheck_15 (File : System.Address; Line : Integer);
!    procedure Rcheck_16 (File : System.Address; Line : Integer);
!    procedure Rcheck_17 (File : System.Address; Line : Integer);
!    procedure Rcheck_18 (File : System.Address; Line : Integer);
!    procedure Rcheck_19 (File : System.Address; Line : Integer);
!    procedure Rcheck_20 (File : System.Address; Line : Integer);
!    procedure Rcheck_21 (File : System.Address; Line : Integer);
!    procedure Rcheck_22 (File : System.Address; Line : Integer);
!    procedure Rcheck_23 (File : System.Address; Line : Integer);
!    procedure Rcheck_24 (File : System.Address; Line : Integer);
!    procedure Rcheck_25 (File : System.Address; Line : Integer);
!    procedure Rcheck_26 (File : System.Address; Line : Integer);
!    procedure Rcheck_27 (File : System.Address; Line : Integer);
!    procedure Rcheck_28 (File : System.Address; Line : Integer);
!    procedure Rcheck_29 (File : System.Address; Line : Integer);
!    procedure Rcheck_30 (File : System.Address; Line : Integer);
  
     pragma Export (C, Rcheck_00, "__gnat_rcheck_00");
     pragma Export (C, Rcheck_01, "__gnat_rcheck_01");
*************** package body Ada.Exceptions is
*** 611,629 ****
     --  The actual polling routine is separate, so that it can easily
     --  be replaced with a target dependent version.
  
!    ---------
!    -- AAA --
!    ---------
  
!    --  This dummy procedure gives us the start of the PC range for addresses
     --  within the exception unit itself. We hope that gigi/gcc keep all the
     --  procedures in their original order!
  
!    procedure AAA is
     begin
        <<Start_Of_AAA>>
!       Code_Address_For_AAA := Start_Of_AAA'Address;
!    end AAA;
  
     ----------------
     -- Call_Chain --
--- 579,603 ----
     --  The actual polling routine is separate, so that it can easily
     --  be replaced with a target dependent version.
  
!    --------------------------
!    -- Code_Address_For_AAA --
!    --------------------------
  
!    --  This function gives us the start of the PC range for addresses
     --  within the exception unit itself. We hope that gigi/gcc keep all the
     --  procedures in their original order!
  
!    function Code_Address_For_AAA return System.Address is
     begin
+       --  We are using a label instead of merely using
+       --  Code_Address_For_AAA'Address because on some platforms the latter
+       --  does not yield the address we want, but the address of a stub or of
+       --  a descriptor instead. This is the case at least on Alpha-VMS and
+       --  PA-HPUX.
+ 
        <<Start_Of_AAA>>
!       return Start_Of_AAA'Address;
!    end Code_Address_For_AAA;
  
     ----------------
     -- Call_Chain --
*************** package body Ada.Exceptions is
*** 664,678 ****
     ------------------------
  
     function Exception_Identity
!      (X    : Exception_Occurrence)
!       return Exception_Id
     is
     begin
!       if X.Id = Null_Id then
!          raise Constraint_Error;
!       else
!          return X.Id;
!       end if;
     end Exception_Identity;
  
     ---------------------------
--- 638,655 ----
     ------------------------
  
     function Exception_Identity
!      (X : Exception_Occurrence) return Exception_Id
     is
     begin
!       --  Note that the following test used to be here for the original
!       --  Ada 95 semantics, but these were modified by AI-241 to require
!       --  returning Null_Id instead of raising Constraint_Error.
! 
!       --  if X.Id = Null_Id then
!       --     raise Constraint_Error;
!       --  end if;
! 
!       return X.Id;
     end Exception_Identity;
  
     ---------------------------
*************** package body Ada.Exceptions is
*** 711,717 ****
           raise Constraint_Error;
        end if;
  
!       return Id.Full_Name.all (1 .. Id.Name_Length - 1);
     end Exception_Name;
  
     function Exception_Name (X : Exception_Occurrence) return String is
--- 688,694 ----
           raise Constraint_Error;
        end if;
  
!       return To_Ptr (Id.Full_Name) (1 .. Id.Name_Length - 1);
     end Exception_Name;
  
     function Exception_Name (X : Exception_Occurrence) return String is
*************** package body Ada.Exceptions is
*** 788,867 ****
     is
        pragma Inspection_Point (E);
        --  This is so the debugger can reliably inspect the parameter
- 
-       Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
-       Excep       : EOA := Get_Current_Excep.all;
- 
     begin
!       --  WARNING : There should be no exception handler for this body
        --  because this would cause gigi to prepend a setup for a new
!       --  jmpbuf to the sequence of statements. We would then always get
!       --  this new buf in Jumpbuf_Ptr instead of the one for the exception
!       --  we are handling, which would completely break the whole design
!       --  of this procedure.
! 
!       --  Processing varies between zero cost and setjmp/lonjmp processing.
! 
!       if Zero_Cost_Exceptions /= 0 then
! 
!          --  Use the front-end tables to propagate if we have them, otherwise
!          --  resort to the GCC back-end alternative. Backtrace computation is
!          --  performed, if required, by the underlying routine. Notifications
!          --  for the debugger are also not performed here, because we do not
!          --  yet know if the exception is handled.
! 
!          Exception_Propagation.Propagate_Exception (From_Signal_Handler);
! 
!       else
!          --  Compute the backtrace for this occurrence if the corresponding
!          --  binder option has been set. Call_Chain takes care of the reraise
!          --  case.
! 
!          Call_Chain (Excep);
!          --  We used to only do this if From_Signal_Handler was not set,
!          --  based on the assumption that backtracing from a signal handler
!          --  would not work due to stack layout oddities. However, since
!          --
!          --   1. The flag is never set in tasking programs (Notify_Exception
!          --      performs regular raise statements), and
!          --
!          --   2. No problem has shown up in tasking programs around here so
!          --      far, this turned out to be too strong an assumption.
!          --
!          --  As, in addition, the test was
!          --
!          --   1. preventing the production of backtraces in non-tasking
!          --      programs, and
!          --
!          --   2. introducing a behavior inconsistency between
!          --      the tasking and non-tasking cases,
!          --
!          --  we have simply removed it.
! 
!          --  If the jump buffer pointer is non-null, transfer control using
!          --  it. Otherwise announce an unhandled exception (note that this
!          --  means that we have no finalizations to do other than at the outer
!          --  level). Perform the necessary notification tasks in both cases.
! 
!          if Jumpbuf_Ptr /= Null_Address then
! 
!             if not Excep.Exception_Raised then
!                Excep.Exception_Raised := True;
!                Exception_Traces.Notify_Handled_Exception;
!             end if;
! 
!             builtin_longjmp (Jumpbuf_Ptr, 1);
! 
!          else
!             --  The pragma Inspection point here ensures that the debugger
!             --  can inspect the parameter.
! 
!             pragma Inspection_Point (E);
  
!             Exception_Traces.Notify_Unhandled_Exception;
!             Exception_Traces.Unhandled_Exception_Terminate;
!          end if;
!       end if;
     end Process_Raise_Exception;
  
     ----------------------------
--- 765,779 ----
     is
        pragma Inspection_Point (E);
        --  This is so the debugger can reliably inspect the parameter
     begin
!       --  WARNING: There should be no exception handler for this body
        --  because this would cause gigi to prepend a setup for a new
!       --  jmpbuf to the sequence of statements in case of built-in sjljl.
!       --  We would then always get this new buf in Jumpbuf_Ptr instead of the
!       --  one for the exception we are handling, which would completely break
!       --  the whole design of this procedure.
  
!       Exception_Propagation.Propagate_Exception (From_Signal_Handler);
     end Process_Raise_Exception;
  
     ----------------------------
*************** package body Ada.Exceptions is
*** 869,875 ****
     ----------------------------
  
     procedure Raise_Constraint_Error
!      (File : Big_String_Ptr;
        Line : Integer)
     is
     begin
--- 781,787 ----
     ----------------------------
  
     procedure Raise_Constraint_Error
!      (File : System.Address;
        Line : Integer)
     is
     begin
*************** package body Ada.Exceptions is
*** 882,890 ****
     --------------------------------
  
     procedure Raise_Constraint_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr)
     is
     begin
        Raise_With_Location_And_Msg
--- 794,802 ----
     --------------------------------
  
     procedure Raise_Constraint_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address)
     is
     begin
        Raise_With_Location_And_Msg
*************** package body Ada.Exceptions is
*** 896,903 ****
     -------------------------
  
     procedure Raise_Current_Excep (E : Exception_Id) is
        pragma Inspection_Point (E);
!       --  This is so the debugger can reliably inspect the parameter
     begin
        Process_Raise_Exception (E => E, From_Signal_Handler => False);
     end Raise_Current_Excep;
--- 808,830 ----
     -------------------------
  
     procedure Raise_Current_Excep (E : Exception_Id) is
+ 
        pragma Inspection_Point (E);
!       --  This is so the debugger can reliably inspect the parameter when
!       --  inserting a breakpoint at the start of this procedure.
! 
!       Id : Exception_Id := E;
!       pragma Volatile (Id);
!       pragma Warnings (Off, Id);
!       --  In order to provide support for breakpoints on unhandled exceptions,
!       --  the debugger will also need to be able to inspect the value of E from
!       --  another (inner) frame. So we need to make sure that if E is passed in
!       --  a register, its value is also spilled on stack. For this, we store
!       --  the parameter value in a local variable, and add a pragma Volatile to
!       --  make sure it is spilled. The pragma Warnings (Off) is needed because
!       --  the compiler knows that Id is not referenced and that this use of
!       --  pragma Volatile is peculiar!
! 
     begin
        Process_Raise_Exception (E => E, From_Signal_Handler => False);
     end Raise_Current_Excep;
*************** package body Ada.Exceptions is
*** 938,944 ****
  
     procedure Raise_From_Signal_Handler
       (E : Exception_Id;
!       M : Big_String_Ptr)
     is
     begin
        Exception_Data.Set_Exception_C_Msg (E, M);
--- 865,871 ----
  
     procedure Raise_From_Signal_Handler
       (E : Exception_Id;
!       M : System.Address)
     is
     begin
        Exception_Data.Set_Exception_C_Msg (E, M);
*************** package body Ada.Exceptions is
*** 951,957 ****
     -------------------------
  
     procedure Raise_Program_Error
!      (File : Big_String_Ptr;
        Line : Integer)
     is
     begin
--- 878,884 ----
     -------------------------
  
     procedure Raise_Program_Error
!      (File : System.Address;
        Line : Integer)
     is
     begin
*************** package body Ada.Exceptions is
*** 964,972 ****
     -----------------------------
  
     procedure Raise_Program_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr)
     is
     begin
        Raise_With_Location_And_Msg
--- 891,899 ----
     -----------------------------
  
     procedure Raise_Program_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address)
     is
     begin
        Raise_With_Location_And_Msg
*************** package body Ada.Exceptions is
*** 978,984 ****
     -------------------------
  
     procedure Raise_Storage_Error
!      (File : Big_String_Ptr;
        Line : Integer)
     is
     begin
--- 905,911 ----
     -------------------------
  
     procedure Raise_Storage_Error
!      (File : System.Address;
        Line : Integer)
     is
     begin
*************** package body Ada.Exceptions is
*** 991,999 ****
     -----------------------------
  
     procedure Raise_Storage_Error_Msg
!      (File : Big_String_Ptr;
        Line : Integer;
!       Msg  : Big_String_Ptr)
     is
     begin
        Raise_With_Location_And_Msg
--- 918,926 ----
     -----------------------------
  
     procedure Raise_Storage_Error_Msg
!      (File : System.Address;
        Line : Integer;
!       Msg  : System.Address)
     is
     begin
        Raise_With_Location_And_Msg
*************** package body Ada.Exceptions is
*** 1006,1014 ****
  
     procedure Raise_With_Location_And_Msg
       (E : Exception_Id;
!       F : Big_String_Ptr;
        L : Integer;
!       M : Big_String_Ptr := null)
     is
     begin
        Exception_Data.Set_Exception_C_Msg (E, F, L, M);
--- 933,941 ----
  
     procedure Raise_With_Location_And_Msg
       (E : Exception_Id;
!       F : System.Address;
        L : Integer;
!       M : System.Address := System.Null_Address)
     is
     begin
        Exception_Data.Set_Exception_C_Msg (E, F, L, M);
*************** package body Ada.Exceptions is
*** 1039,1197 ****
     -- Calls to Run-Time Check Routines --
     --------------------------------------
  
!    procedure Rcheck_00 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_00'Address));
     end Rcheck_00;
  
!    procedure Rcheck_01 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_01'Address));
     end Rcheck_01;
  
!    procedure Rcheck_02 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_02'Address));
     end Rcheck_02;
  
!    procedure Rcheck_03 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_03'Address));
     end Rcheck_03;
  
!    procedure Rcheck_04 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_04'Address));
     end Rcheck_04;
  
!    procedure Rcheck_05 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_05'Address));
     end Rcheck_05;
  
!    procedure Rcheck_06 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_06'Address));
     end Rcheck_06;
  
!    procedure Rcheck_07 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_07'Address));
     end Rcheck_07;
  
!    procedure Rcheck_08 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_08'Address));
     end Rcheck_08;
  
!    procedure Rcheck_09 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_09'Address));
     end Rcheck_09;
  
!    procedure Rcheck_10 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_10'Address));
     end Rcheck_10;
  
!    procedure Rcheck_11 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_11'Address));
     end Rcheck_11;
  
!    procedure Rcheck_12 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, To_Ptr (Rmsg_12'Address));
     end Rcheck_12;
  
!    procedure Rcheck_13 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_13'Address));
     end Rcheck_13;
  
!    procedure Rcheck_14 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_14'Address));
     end Rcheck_14;
  
!    procedure Rcheck_15 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_15'Address));
     end Rcheck_15;
  
!    procedure Rcheck_16 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_16'Address));
     end Rcheck_16;
  
!    procedure Rcheck_17 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_17'Address));
     end Rcheck_17;
  
!    procedure Rcheck_18 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_18'Address));
     end Rcheck_18;
  
!    procedure Rcheck_19 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_19'Address));
     end Rcheck_19;
  
!    procedure Rcheck_20 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_20'Address));
     end Rcheck_20;
  
!    procedure Rcheck_21 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_21'Address));
     end Rcheck_21;
  
!    procedure Rcheck_22 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_22'Address));
     end Rcheck_22;
  
!    procedure Rcheck_23 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_23'Address));
     end Rcheck_23;
  
!    procedure Rcheck_24 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_24'Address));
     end Rcheck_24;
  
!    procedure Rcheck_25 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, To_Ptr (Rmsg_25'Address));
     end Rcheck_25;
  
!    procedure Rcheck_26 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_26'Address));
     end Rcheck_26;
  
!    procedure Rcheck_27 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_27'Address));
     end Rcheck_27;
  
!    procedure Rcheck_28 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_28'Address));
     end Rcheck_28;
  
!    procedure Rcheck_29 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_29'Address));
     end Rcheck_29;
  
!    procedure Rcheck_30 (File : Big_String_Ptr; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, To_Ptr (Rmsg_30'Address));
     end Rcheck_30;
  
     -------------
--- 966,1124 ----
     -- Calls to Run-Time Check Routines --
     --------------------------------------
  
!    procedure Rcheck_00 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_00'Address);
     end Rcheck_00;
  
!    procedure Rcheck_01 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_01'Address);
     end Rcheck_01;
  
!    procedure Rcheck_02 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_02'Address);
     end Rcheck_02;
  
!    procedure Rcheck_03 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_03'Address);
     end Rcheck_03;
  
!    procedure Rcheck_04 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_04'Address);
     end Rcheck_04;
  
!    procedure Rcheck_05 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_05'Address);
     end Rcheck_05;
  
!    procedure Rcheck_06 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_06'Address);
     end Rcheck_06;
  
!    procedure Rcheck_07 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_07'Address);
     end Rcheck_07;
  
!    procedure Rcheck_08 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_08'Address);
     end Rcheck_08;
  
!    procedure Rcheck_09 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_09'Address);
     end Rcheck_09;
  
!    procedure Rcheck_10 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_10'Address);
     end Rcheck_10;
  
!    procedure Rcheck_11 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_11'Address);
     end Rcheck_11;
  
!    procedure Rcheck_12 (File : System.Address; Line : Integer) is
     begin
!       Raise_Constraint_Error_Msg (File, Line, Rmsg_12'Address);
     end Rcheck_12;
  
!    procedure Rcheck_13 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_13'Address);
     end Rcheck_13;
  
!    procedure Rcheck_14 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_14'Address);
     end Rcheck_14;
  
!    procedure Rcheck_15 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_15'Address);
     end Rcheck_15;
  
!    procedure Rcheck_16 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_16'Address);
     end Rcheck_16;
  
!    procedure Rcheck_17 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_17'Address);
     end Rcheck_17;
  
!    procedure Rcheck_18 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_18'Address);
     end Rcheck_18;
  
!    procedure Rcheck_19 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_19'Address);
     end Rcheck_19;
  
!    procedure Rcheck_20 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_20'Address);
     end Rcheck_20;
  
!    procedure Rcheck_21 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_21'Address);
     end Rcheck_21;
  
!    procedure Rcheck_22 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_22'Address);
     end Rcheck_22;
  
!    procedure Rcheck_23 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_23'Address);
     end Rcheck_23;
  
!    procedure Rcheck_24 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_24'Address);
     end Rcheck_24;
  
!    procedure Rcheck_25 (File : System.Address; Line : Integer) is
     begin
!       Raise_Program_Error_Msg (File, Line, Rmsg_25'Address);
     end Rcheck_25;
  
!    procedure Rcheck_26 (File : System.Address; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, Rmsg_26'Address);
     end Rcheck_26;
  
!    procedure Rcheck_27 (File : System.Address; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, Rmsg_27'Address);
     end Rcheck_27;
  
!    procedure Rcheck_28 (File : System.Address; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, Rmsg_28'Address);
     end Rcheck_28;
  
!    procedure Rcheck_29 (File : System.Address; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, Rmsg_29'Address);
     end Rcheck_29;
  
!    procedure Rcheck_30 (File : System.Address; Line : Integer) is
     begin
!       Raise_Storage_Error_Msg (File, Line, Rmsg_30'Address);
     end Rcheck_30;
  
     -------------
*************** package body Ada.Exceptions is
*** 1259,1289 ****
        Save_Occurrence_No_Private (Target, Source);
     end Save_Occurrence;
  
!    function Save_Occurrence
!      (Source : Exception_Occurrence)
!       return   EOA
!    is
!       Target : EOA := new Exception_Occurrence;
! 
     begin
        Save_Occurrence (Target.all, Source);
        return Target;
     end Save_Occurrence;
  
     --------------------------------
-    -- Save_Occurrence_And_Private --
-    --------------------------------
- 
-    procedure Save_Occurrence_And_Private
-      (Target : out Exception_Occurrence;
-       Source : Exception_Occurrence)
-    is
-    begin
-       Save_Occurrence_No_Private (Target, Source);
-       Target.Private_Data := Source.Private_Data;
-    end Save_Occurrence_And_Private;
- 
-    --------------------------------
     -- Save_Occurrence_No_Private --
     --------------------------------
  
--- 1186,1199 ----
        Save_Occurrence_No_Private (Target, Source);
     end Save_Occurrence;
  
!    function Save_Occurrence (Source : Exception_Occurrence) return EOA is
!       Target : constant EOA := new Exception_Occurrence;
     begin
        Save_Occurrence (Target.all, Source);
        return Target;
     end Save_Occurrence;
  
     --------------------------------
     -- Save_Occurrence_No_Private --
     --------------------------------
  
*************** package body Ada.Exceptions is
*** 1349,1356 ****
     begin
        Exception_Data.Set_Exception_Msg (E, Message);
  
!       --  DO NOT CALL Abort_Defer.all; !!!!
!       --  why not??? would be nice to have more comments here
  
        Raise_Current_Excep (E);
     end Raise_Exception_No_Defer;
--- 1259,1265 ----
     begin
        Exception_Data.Set_Exception_Msg (E, Message);
  
!       --  Do not call Abort_Defer.all, as specified by the spec
  
        Raise_Current_Excep (E);
     end Raise_Exception_No_Defer;
*************** package body Ada.Exceptions is
*** 1379,1406 ****
        end loop;
     end To_Stderr;
  
!    ---------
!    -- ZZZ --
!    ---------
  
!    --  This dummy procedure gives us the end of the PC range for addresses
     --  within the exception unit itself. We hope that gigi/gcc keeps all the
     --  procedures in their original order!
  
!    procedure ZZZ is
     begin
        <<Start_Of_ZZZ>>
!       Code_Address_For_ZZZ := Start_Of_ZZZ'Address;
!    end ZZZ;
! 
! begin
!    --  Allocate the Non-Tasking Machine_State
! 
!    Set_Machine_State_Addr_NT (System.Address (Allocate_Machine_State));
! 
!    --  Call the AAA/ZZZ routines to setup the code addresses for the
!    --  bounds of this unit.
  
-    AAA;
-    ZZZ;
  end Ada.Exceptions;
--- 1288,1305 ----
        end loop;
     end To_Stderr;
  
!    --------------------------
!    -- Code_Address_For_ZZZ --
!    --------------------------
  
!    --  This function gives us the end of the PC range for addresses
     --  within the exception unit itself. We hope that gigi/gcc keeps all the
     --  procedures in their original order!
  
!    function Code_Address_For_ZZZ return System.Address is
     begin
        <<Start_Of_ZZZ>>
!       return Start_Of_ZZZ'Address;
!    end Code_Address_For_ZZZ;
  
  end Ada.Exceptions;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-except.ads gcc-4.1.0/gcc/ada/a-except.ads
*** gcc-4.0.2/gcc/ada/a-except.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-except.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 40,49 ****
--- 40,56 ----
  --  elaboration circularities with ourself.
  
  with System;
+ with System.Parameters;
  with System.Standard_Library;
  with System.Traceback_Entries;
  
  package Ada.Exceptions is
+    pragma Warnings (Off);
+    pragma Preelaborate_05;
+    pragma Warnings (On);
+    --  In accordance with Ada 2005 AI-362. The warnings pragmas are so that we
+    --  can compile this using older compiler versions, which will ignore the
+    --  pragma, which is fine for the bootstrap.
  
     type Exception_Id is private;
     Null_Id : constant Exception_Id;
*************** package Ada.Exceptions is
*** 103,122 ****
  
  private
     package SSL renames System.Standard_Library;
  
     subtype EOA is Exception_Occurrence_Access;
  
!    Exception_Msg_Max_Length : constant := 200;
  
     ------------------
     -- Exception_Id --
     ------------------
  
     subtype Code_Loc is System.Address;
!    --  Code location used in building exception tables and for call
!    --  addresses when propagating an exception.
!    --  Values of this type are created by using Label'Address or
!    --  extracted from machine states using Get_Code_Loc.
  
     Null_Loc : constant Code_Loc := System.Null_Address;
     --  Null code location, used to flag outer level frame
--- 110,129 ----
  
  private
     package SSL renames System.Standard_Library;
+    package SP renames System.Parameters;
  
     subtype EOA is Exception_Occurrence_Access;
  
!    Exception_Msg_Max_Length : constant := SP.Default_Exception_Msg_Max_Length;
  
     ------------------
     -- Exception_Id --
     ------------------
  
     subtype Code_Loc is System.Address;
!    --  Code location used in building exception tables and for call addresses
!    --  when propagating an exception. Values of this type are created by using
!    --  Label'Address or extracted from machine states using Get_Code_Loc.
  
     Null_Loc : constant Code_Loc := System.Null_Address;
     --  Null code location, used to flag outer level frame
*************** private
*** 147,158 ****
     --  to be in the visible part, since this is set by the reference manual).
  
     function Exception_Name_Simple (X : Exception_Occurrence) return String;
!    --  Like Exception_Name, but returns the simple non-qualified name of
!    --  the exception. This is used to implement the Exception_Name function
!    --  in Current_Exceptions (the DEC compatible unit). It is called from
!    --  the compiler generated code (using Rtsfind, which does not respect
!    --  the private barrier, so we can place this function in the private
!    --  part where the compiler can find it, but the spec is unchanged.)
  
     procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
     pragma No_Return (Raise_Exception_Always);
--- 154,165 ----
     --  to be in the visible part, since this is set by the reference manual).
  
     function Exception_Name_Simple (X : Exception_Occurrence) return String;
!    --  Like Exception_Name, but returns the simple non-qualified name of the
!    --  exception. This is used to implement the Exception_Name function in
!    --  Current_Exceptions (the DEC compatible unit). It is called from the
!    --  compiler generated code (using Rtsfind, which does not respect the
!    --  private barrier, so we can place this function in the private part
!    --  where the compiler can find it, but the spec is unchanged.)
  
     procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
     pragma No_Return (Raise_Exception_Always);
*************** private
*** 165,186 ****
  
     procedure Raise_From_Signal_Handler
       (E : Exception_Id;
!       M : SSL.Big_String_Ptr);
     pragma Export
       (Ada, Raise_From_Signal_Handler,
             "ada__exceptions__raise_from_signal_handler");
     pragma No_Return (Raise_From_Signal_Handler);
!    --  This routine is used to raise an exception from a signal handler.
!    --  The signal handler has already stored the machine state (i.e. the
!    --  state that corresponds to the location at which the signal was
!    --  raised). E is the Exception_Id specifying what exception is being
!    --  raised, and M is a pointer to a null-terminated string which is the
!    --  message to be raised. Note that this routine never returns, so it is
!    --  permissible to simply jump to this routine, rather than call it. This
!    --  may be appropriate for systems where the right way to get out of a
!    --  signal handler is to alter the PC value in the machine state or in
!    --  some other way ask the operating system to return here rather than
!    --  to the original location.
  
     procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
     pragma No_Return (Reraise_Occurrence_Always);
--- 172,192 ----
  
     procedure Raise_From_Signal_Handler
       (E : Exception_Id;
!       M : System.Address);
     pragma Export
       (Ada, Raise_From_Signal_Handler,
             "ada__exceptions__raise_from_signal_handler");
     pragma No_Return (Raise_From_Signal_Handler);
!    --  This routine is used to raise an exception from a signal handler. The
!    --  signal handler has already stored the machine state (i.e. the state that
!    --  corresponds to the location at which the signal was raised). E is the
!    --  Exception_Id specifying what exception is being raised, and M is a
!    --  pointer to a null-terminated string which is the message to be raised.
!    --  Note that this routine never returns, so it is permissible to simply
!    --  jump to this routine, rather than call it. This may be appropriate for
!    --  systems where the right way to get out of signal handler is to alter the
!    --  PC value in the machine state or in some other way ask the operating
!    --  system to return here rather than to the original location.
  
     procedure Reraise_Occurrence_Always (X : Exception_Occurrence);
     pragma No_Return (Reraise_Occurrence_Always);
*************** private
*** 193,200 ****
     pragma No_Return (Reraise_Occurrence_No_Defer);
     --  Exactly like Reraise_Occurrence, except that abort is not deferred
     --  before the call and the parameter X is known not to be the null
!    --  occurrence. This is used in generated code when it is known
!    --  that abort is already deferred.
  
     -----------------------
     -- Polling Interface --
--- 199,206 ----
     pragma No_Return (Reraise_Occurrence_No_Defer);
     --  Exactly like Reraise_Occurrence, except that abort is not deferred
     --  before the call and the parameter X is known not to be the null
!    --  occurrence. This is used in generated code when it is known that
!    --  abort is already deferred.
  
     -----------------------
     -- Polling Interface --
*************** private
*** 246,252 ****
        Msg : String (1 .. Exception_Msg_Max_Length);
        --  Characters of message
  
!       Cleanup_Flag : Boolean;
        --  The cleanup flag is normally False, it is set True for an exception
        --  occurrence passed to a cleanup routine, and will still be set True
        --  when the cleanup routine does a Reraise_Occurrence call using this
--- 252,258 ----
        Msg : String (1 .. Exception_Msg_Max_Length);
        --  Characters of message
  
!       Cleanup_Flag : Boolean := False;
        --  The cleanup flag is normally False, it is set True for an exception
        --  occurrence passed to a cleanup routine, and will still be set True
        --  when the cleanup routine does a Reraise_Occurrence call using this
*************** private
*** 262,268 ****
        --  it is dealing with the reraise case (which is useful to distinguish
        --  for exception tracing purposes).
  
!       Pid : Natural;
        --  Partition_Id for partition raising exception
  
        Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
--- 268,274 ----
        --  it is dealing with the reraise case (which is useful to distinguish
        --  for exception tracing purposes).
  
!       Pid : Natural := 0;
        --  Partition_Id for partition raising exception
  
        Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0;
*************** private
*** 289,295 ****
     --  Functions for implementing Exception_Occurrence stream attributes
  
     Null_Occurrence : constant Exception_Occurrence := (
!      Id               => Null_Id,
       Msg_Length       => 0,
       Msg              => (others => ' '),
       Cleanup_Flag     => False,
--- 295,301 ----
     --  Functions for implementing Exception_Occurrence stream attributes
  
     Null_Occurrence : constant Exception_Occurrence := (
!      Id               => null,
       Msg_Length       => 0,
       Msg              => (others => ' '),
       Cleanup_Flag     => False,
diff -Nrcpad gcc-4.0.2/gcc/ada/a-excpol-abort.adb gcc-4.1.0/gcc/ada/a-excpol-abort.adb
*** gcc-4.0.2/gcc/ada/a-excpol-abort.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-excpol-abort.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --                (version supporting asynchronous abort test)              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --                (version supporting asynchronous abort test)              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,47 ****
--- 39,54 ----
  
  --  NT, OS/2, HPUX/DCE and SCO currently use this file
  
+ pragma Warnings (Off);
+ --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
+ --  package will be categorized as Preelaborate. See AI-362 for details.
+ --  It is safe in the context of the run-time to violate the rules!
+ 
  with System.Soft_Links;
  --  used for Check_Abort_Status
  
+ pragma Warnings (On);
+ 
  separate (Ada.Exceptions)
  
  ----------
diff -Nrcpad gcc-4.0.2/gcc/ada/a-excpol-interix.adb gcc-4.1.0/gcc/ada/a-excpol-interix.adb
*** gcc-4.0.2/gcc/ada/a-excpol-interix.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-excpol-interix.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --       (version supporting asynchronous abort test and time slicing)      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --       (version supporting asynchronous abort test and time slicing)      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,48 ****
  --  Then in the body of the polling routine we test for asynchronous abort and
  --  yield periodically.
  
! --  HP-UX and SCO currently use this file
  
  with System.Soft_Links;
  --  used for Check_Abort_Status
  
  separate (Ada.Exceptions)
  
  ----------
--- 38,55 ----
  --  Then in the body of the polling routine we test for asynchronous abort and
  --  yield periodically.
  
! --  This is currently used only by Interix
! 
! pragma Warnings (Off);
! --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
! --  package will be categorized as Preelaborate. See AI-362 for details.
! --  It is safe in the context of the run-time to violate the rules!
  
  with System.Soft_Links;
  --  used for Check_Abort_Status
  
+ pragma Warnings (On);
+ 
  separate (Ada.Exceptions)
  
  ----------
diff -Nrcpad gcc-4.0.2/gcc/ada/a-excpol.adb gcc-4.1.0/gcc/ada/a-excpol.adb
*** gcc-4.0.2/gcc/ada/a-excpol.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-excpol.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                 (dummy version where polling is not used)                --
  --                                                                          --
! --          Copyright (C) 1992-1998, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . E X C E P T I O N S . P O L L                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                 (dummy version where polling is not used)                --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exctra.adb gcc-4.1.0/gcc/ada/a-exctra.adb
*** gcc-4.0.2/gcc/ada/a-exctra.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-exctra.adb	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exctra.ads gcc-4.1.0/gcc/ada/a-exctra.ads
*** gcc-4.0.2/gcc/ada/a-exctra.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-exctra.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is part of the support for tracebacks on exceptions.
  
  with System.Traceback_Entries;
  
--- 35,41 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is part of the support for tracebacks on exceptions
  
  with System.Traceback_Entries;
  
*************** package Ada.Exceptions.Traceback is
*** 47,53 ****
     --  Code location in executing program
  
     type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry;
!    --  A traceback array is an array of traceback entries.
  
     function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array;
     --  This function extracts the traceback information from an exception
--- 47,53 ----
     --  Code location in executing program
  
     type Tracebacks_Array is array (Positive range <>) of TBE.Traceback_Entry;
!    --  A traceback array is an array of traceback entries
  
     function Tracebacks (E : Exception_Occurrence) return Tracebacks_Array;
     --  This function extracts the traceback information from an exception
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exexda.adb gcc-4.1.0/gcc/ada/a-exexda.adb
*** gcc-4.0.2/gcc/ada/a-exexda.adb	Tue Jul 20 10:26:51 2004
--- gcc-4.1.0/gcc/ada/a-exexda.adb	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Exception_Data is
*** 152,158 ****
        Info : in out String;
        Ptr  : in out Natural);
  
- 
     --  The "functional" interface to the exception information not involving
     --  a traceback decorator uses preallocated intermediate buffers to avoid
     --  the use of secondary stack. Preallocation requires preliminary length
--- 152,157 ----
*************** package body Exception_Data is
*** 387,393 ****
        Ptr  : in out Natural)
     is
     begin
!       if X.Num_Tracebacks <= 0 then
           return;
        end if;
  
--- 386,392 ----
        Ptr  : in out Natural)
     is
     begin
!       if X.Num_Tracebacks = 0 then
           return;
        end if;
  
*************** package body Exception_Data is
*** 477,483 ****
  
        declare
           Len  : constant Natural := Exception_Name_Length (Id);
!          Name : constant String (1 .. Len) := Id.Full_Name (1 .. Len);
        begin
           Append_Info_String (Name, Info, Ptr);
        end;
--- 476,482 ----
  
        declare
           Len  : constant Natural := Exception_Name_Length (Id);
!          Name : constant String (1 .. Len) := To_Ptr (Id.Full_Name) (1 .. Len);
        begin
           Append_Info_String (Name, Info, Ptr);
        end;
*************** package body Exception_Data is
*** 557,565 ****
  
     procedure Set_Exception_C_Msg
       (Id   : Exception_Id;
!       Msg1 : Big_String_Ptr;
        Line : Integer        := 0;
!       Msg2 : Big_String_Ptr := null)
     is
        Excep  : constant EOA := Get_Current_Excep.all;
        Val    : Integer := Line;
--- 556,564 ----
  
     procedure Set_Exception_C_Msg
       (Id   : Exception_Id;
!       Msg1 : System.Address;
        Line : Integer        := 0;
!       Msg2 : System.Address := System.Null_Address)
     is
        Excep  : constant EOA := Get_Current_Excep.all;
        Val    : Integer := Line;
*************** package body Exception_Data is
*** 576,586 ****
        Excep.Msg_Length       := 0;
        Excep.Cleanup_Flag     := False;
  
!       while Msg1 (Excep.Msg_Length + 1) /= ASCII.NUL
          and then Excep.Msg_Length < Exception_Msg_Max_Length
        loop
           Excep.Msg_Length := Excep.Msg_Length + 1;
!          Excep.Msg (Excep.Msg_Length) := Msg1 (Excep.Msg_Length);
        end loop;
  
        --  Append line number if present
--- 575,585 ----
        Excep.Msg_Length       := 0;
        Excep.Cleanup_Flag     := False;
  
!       while To_Ptr (Msg1) (Excep.Msg_Length + 1) /= ASCII.NUL
          and then Excep.Msg_Length < Exception_Msg_Max_Length
        loop
           Excep.Msg_Length := Excep.Msg_Length + 1;
!          Excep.Msg (Excep.Msg_Length) := To_Ptr (Msg1) (Excep.Msg_Length);
        end loop;
  
        --  Append line number if present
*************** package body Exception_Data is
*** 614,631 ****
  
        --  Append second message if present
  
!       if Msg2 /= null
          and then Excep.Msg_Length + 1 < Exception_Msg_Max_Length
        then
           Excep.Msg_Length := Excep.Msg_Length + 1;
           Excep.Msg (Excep.Msg_Length) := ' ';
  
           Ptr := 1;
!          while Msg2 (Ptr) /= ASCII.NUL
             and then Excep.Msg_Length < Exception_Msg_Max_Length
           loop
              Excep.Msg_Length := Excep.Msg_Length + 1;
!             Excep.Msg (Excep.Msg_Length) := Msg2 (Ptr);
              Ptr := Ptr + 1;
           end loop;
        end if;
--- 613,630 ----
  
        --  Append second message if present
  
!       if Msg2 /= System.Null_Address
          and then Excep.Msg_Length + 1 < Exception_Msg_Max_Length
        then
           Excep.Msg_Length := Excep.Msg_Length + 1;
           Excep.Msg (Excep.Msg_Length) := ' ';
  
           Ptr := 1;
!          while To_Ptr (Msg2) (Ptr) /= ASCII.NUL
             and then Excep.Msg_Length < Exception_Msg_Max_Length
           loop
              Excep.Msg_Length := Excep.Msg_Length + 1;
!             Excep.Msg (Excep.Msg_Length) := To_Ptr (Msg2) (Ptr);
              Ptr := Ptr + 1;
           end loop;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exexpr-gcc.adb gcc-4.1.0/gcc/ada/a-exexpr-gcc.adb
*** gcc-4.0.2/gcc/ada/a-exexpr-gcc.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-exexpr-gcc.adb	Tue Nov 15 13:52:55 2005
***************
*** 0 ****
--- 1,726 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --  A D A . E X C E P T I O N S . E X C E P T I O N _ P R O P A G A T I O N --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This is the version using the GCC EH mechanism
+ 
+ with Ada.Unchecked_Conversion;
+ with Ada.Unchecked_Deallocation;
+ 
+ with System.Storage_Elements;  use System.Storage_Elements;
+ 
+ separate (Ada.Exceptions)
+ package body Exception_Propagation is
+ 
+    ------------------------------------------------
+    -- Entities to interface with the GCC runtime --
+    ------------------------------------------------
+ 
+    --  These come from "C++ ABI for Itanium: Exception handling", which is
+    --  the reference for GCC. They are used only when we are relying on
+    --  back-end tables for exception propagation, which in turn is currenly
+    --  only the case for Zero_Cost_Exceptions in GNAT5.
+ 
+    --  Return codes from the GCC runtime functions used to propagate
+    --  an exception.
+ 
+    type Unwind_Reason_Code is
+      (URC_NO_REASON,
+       URC_FOREIGN_EXCEPTION_CAUGHT,
+       URC_PHASE2_ERROR,
+       URC_PHASE1_ERROR,
+       URC_NORMAL_STOP,
+       URC_END_OF_STACK,
+       URC_HANDLER_FOUND,
+       URC_INSTALL_CONTEXT,
+       URC_CONTINUE_UNWIND);
+ 
+    pragma Unreferenced
+      (URC_FOREIGN_EXCEPTION_CAUGHT,
+       URC_PHASE2_ERROR,
+       URC_PHASE1_ERROR,
+       URC_NORMAL_STOP,
+       URC_END_OF_STACK,
+       URC_HANDLER_FOUND,
+       URC_INSTALL_CONTEXT,
+       URC_CONTINUE_UNWIND);
+ 
+    pragma Convention (C, Unwind_Reason_Code);
+ 
+    --  Phase identifiers
+ 
+    type Unwind_Action is
+      (UA_SEARCH_PHASE,
+       UA_CLEANUP_PHASE,
+       UA_HANDLER_FRAME,
+       UA_FORCE_UNWIND);
+ 
+    for Unwind_Action use
+       (UA_SEARCH_PHASE  => 1,
+        UA_CLEANUP_PHASE => 2,
+        UA_HANDLER_FRAME => 4,
+        UA_FORCE_UNWIND  => 8);
+ 
+    pragma Convention (C, Unwind_Action);
+ 
+    --  Mandatory common header for any exception object handled by the
+    --  GCC unwinding runtime.
+ 
+    type Exception_Class is mod 2 ** 64;
+ 
+    GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
+    --  "GNU-Ada\0"
+ 
+    type Unwind_Word is mod 2 ** System.Word_Size;
+    for Unwind_Word'Size use System.Word_Size;
+    --  Map the corresponding C type used in Unwind_Exception below
+ 
+    type Unwind_Exception is record
+       Class    : Exception_Class := GNAT_Exception_Class;
+       Cleanup  : System.Address  := System.Null_Address;
+       Private1 : Unwind_Word;
+       Private2 : Unwind_Word;
+    end record;
+    --  Map the GCC struct used for exception handling
+ 
+    for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
+    --  The C++ ABI mandates the common exception header to be at least
+    --  doubleword aligned, and the libGCC implementation actually makes it
+    --  maximally aligned (see unwind.h). See additional comments on the
+    --  alignment below.
+ 
+    --------------------------------------------------------------
+    -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
+    --------------------------------------------------------------
+ 
+    --  A GNAT exception object to be dealt with by the personality routine
+    --  called by the GCC unwinding runtime.
+ 
+    type GNAT_GCC_Exception is record
+       Header : Unwind_Exception;
+       --  ABI Exception header first
+ 
+       Id : Exception_Id;
+       --  GNAT Exception identifier.  This is filled by Propagate_Exception
+       --  and then used by the personality routine to determine if the context
+       --  it examines contains a handler for the exception beeing propagated.
+ 
+       N_Cleanups_To_Trigger : Integer;
+       --  Number of cleanup only frames encountered in SEARCH phase.  This is
+       --  initialized to 0 by Propagate_Exception and maintained by the
+       --  personality routine to control a forced unwinding phase triggering
+       --  all the cleanups before calling Unhandled_Exception_Terminate when
+       --  an exception is not handled.
+ 
+       Next_Exception : EOA;
+       --  Used to create a linked list of exception occurrences
+    end record;
+ 
+    pragma Convention (C, GNAT_GCC_Exception);
+ 
+    --  There is a subtle issue with the common header alignment, since the C
+    --  version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
+    --  Standard'Maximum_Alignment, and those two values don't quite represent
+    --  the same concepts and so may be decoupled someday. One typical reason
+    --  is that BIGGEST_ALIGNMENT may be larger than what the underlying system
+    --  allocator guarantees, and there are extra costs involved in allocating
+    --  objects aligned to such factors.
+ 
+    --  To deal with the potential alignment differences between the C and Ada
+    --  representations, the Ada part of the whole structure is only accessed
+    --  by the personality routine through the accessors declared below.  Ada
+    --  specific fields are thus always accessed through consistent layout, and
+    --  we expect the actual alignment to always be large enough to avoid traps
+    --  from the C accesses to the common header. Besides, accessors aleviate
+    --  the need for a C struct whole conterpart, both painful and errorprone
+    --  to maintain anyway.
+ 
+    type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
+ 
+    function To_GNAT_GCC_Exception is new
+      Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
+ 
+    procedure Free is new Unchecked_Deallocation
+      (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
+ 
+    procedure Free is new Unchecked_Deallocation
+      (Exception_Occurrence, EOA);
+ 
+    function CleanupUnwind_Handler
+      (UW_Version   : Integer;
+       UW_Phases    : Unwind_Action;
+       UW_Eclass    : Exception_Class;
+       UW_Exception : access GNAT_GCC_Exception;
+       UW_Context   : System.Address;
+       UW_Argument  : System.Address) return Unwind_Reason_Code;
+    --  Hook called at each step of the forced unwinding we perform to
+    --  trigger cleanups found during the propagation of an unhandled
+    --  exception.
+ 
+    --  GCC runtime functions used. These are C non-void functions, actually,
+    --  but we ignore the return values. See raise.c as to why we are using
+    --  __gnat stubs for these.
+ 
+    procedure Unwind_RaiseException
+      (UW_Exception : access GNAT_GCC_Exception);
+    pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
+ 
+    procedure Unwind_ForcedUnwind
+      (UW_Exception : access GNAT_GCC_Exception;
+       UW_Handler   : System.Address;
+       UW_Argument  : System.Address);
+    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
+ 
+    ------------------------------------------------------------------
+    -- Occurrence Stack Management Facilities for the GCC-EH Scheme --
+    ------------------------------------------------------------------
+ 
+    function Remove
+      (Top   : EOA;
+       Excep : GNAT_GCC_Exception_Access) return Boolean;
+    --  Remove Excep from the stack starting at Top.
+    --  Return True if Excep was found and removed, false otherwise.
+ 
+    --  Hooks called when entering/leaving an exception handler for a given
+    --  occurrence, aimed at handling the stack of active occurrences. The
+    --  calls are generated by gigi in tree_transform/N_Exception_Handler.
+ 
+    procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+    pragma Export (C, Begin_Handler, "__gnat_begin_handler");
+ 
+    procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
+    pragma Export (C, End_Handler, "__gnat_end_handler");
+ 
+    Setup_Key : constant := 16#DEAD#;
+    --  To handle the case of a task "transferring" an exception occurrence to
+    --  another task, for instance via Exceptional_Complete_Rendezvous, we need
+    --  to be able to identify occurrences which have been Setup and not yet
+    --  Propagated. We hijack one of the common header fields for that purpose,
+    --  setting it to a special key value during the setup process, clearing it
+    --  at the very beginning of the propagation phase, and expecting it never
+    --  to be reset to the special value later on. A 16-bit value is used rather
+    --  than a 32-bit value for static compatibility with 16-bit targets such as
+    --  AAMP (where type Unwind_Word will be 16 bits).
+ 
+    function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
+ 
+    procedure Set_Setup_And_Not_Propagated (E : EOA);
+    procedure Clear_Setup_And_Not_Propagated (E : EOA);
+ 
+    procedure Save_Occurrence_And_Private
+      (Target : out Exception_Occurrence;
+       Source : Exception_Occurrence);
+    --  Copy all the components of Source to Target as well as the
+    --  Private_Data pointer.
+ 
+    ------------------------------------------------------------
+    -- Accessors to basic components of a GNAT exception data --
+    ------------------------------------------------------------
+ 
+    --  As of today, these are only used by the C implementation of the
+    --  GCC propagation personality routine to avoid having to rely on a C
+    --  counterpart of the whole exception_data structure, which is both
+    --  painful and error prone. These subprograms could be moved to a
+    --  more widely visible location if need be.
+ 
+    function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
+    pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
+ 
+    function Language_For (E : Exception_Data_Ptr) return Character;
+    pragma Export (C, Language_For, "__gnat_language_for");
+ 
+    function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
+    pragma Export (C, Import_Code_For, "__gnat_import_code_for");
+ 
+    function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
+      return Exception_Id;
+    pragma Export (C, EID_For, "__gnat_eid_for");
+ 
+    procedure Adjust_N_Cleanups_For
+      (GNAT_Exception : GNAT_GCC_Exception_Access;
+       Adjustment     : Integer);
+    pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
+ 
+    ---------------------------------------------------------------------------
+    -- Objects to materialize "others" and "all others" in the GCC EH tables --
+    ---------------------------------------------------------------------------
+ 
+    --  Currently, these only have their address taken and compared so there is
+    --  no real point having whole exception data blocks allocated. In any case
+    --  the types should match what gigi and the personality routine expect.
+    --  The initial value is an arbitrary value that will not exceed the range
+    --  of Integer on 16-bit targets (such as AAMP).
+ 
+    Others_Value : constant Integer := 16#7FFF#;
+    pragma Export (C, Others_Value, "__gnat_others_value");
+ 
+    All_Others_Value : constant Integer := 16#7FFF#;
+    pragma Export (C, All_Others_Value, "__gnat_all_others_value");
+ 
+    ------------
+    -- Remove --
+    ------------
+ 
+    function Remove
+      (Top   : EOA;
+       Excep : GNAT_GCC_Exception_Access) return Boolean
+    is
+       Prev          : GNAT_GCC_Exception_Access := null;
+       Iter          : EOA := Top;
+       GCC_Exception : GNAT_GCC_Exception_Access;
+ 
+    begin
+       --  Pop stack
+ 
+       loop
+          pragma Assert (Iter.Private_Data /= System.Null_Address);
+ 
+          GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
+ 
+          if GCC_Exception = Excep then
+             if Prev = null then
+ 
+                --  Special case for the top of the stack: shift the contents
+                --  of the next item to the top, since top is at a fixed
+                --  location and can't be changed.
+ 
+                Iter := GCC_Exception.Next_Exception;
+ 
+                if Iter = null then
+ 
+                   --  Stack is now empty
+ 
+                   Top.Private_Data := System.Null_Address;
+ 
+                else
+                   Save_Occurrence_And_Private (Top.all, Iter.all);
+                   Free (Iter);
+                end if;
+ 
+             else
+                Prev.Next_Exception := GCC_Exception.Next_Exception;
+                Free (Iter);
+             end if;
+ 
+             Free (GCC_Exception);
+ 
+             return True;
+          end if;
+ 
+          exit when GCC_Exception.Next_Exception = null;
+ 
+          Prev := GCC_Exception;
+          Iter := GCC_Exception.Next_Exception;
+       end loop;
+ 
+       return False;
+    end Remove;
+ 
+    ---------------------------
+    -- CleanupUnwind_Handler --
+    ---------------------------
+ 
+    function CleanupUnwind_Handler
+      (UW_Version   : Integer;
+       UW_Phases    : Unwind_Action;
+       UW_Eclass    : Exception_Class;
+       UW_Exception : access GNAT_GCC_Exception;
+       UW_Context   : System.Address;
+       UW_Argument  : System.Address) return Unwind_Reason_Code
+    is
+       pragma Unreferenced
+         (UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument);
+ 
+    begin
+       --  Terminate as soon as we know there is nothing more to run. The
+       --  count is maintained by the personality routine.
+ 
+       if UW_Exception.N_Cleanups_To_Trigger = 0 then
+          Unhandled_Exception_Terminate;
+       end if;
+ 
+       --  We know there is at least one cleanup further up. Return so that it
+       --  is searched and entered, after which Unwind_Resume will be called
+       --  and this hook will gain control (with an updated count) again.
+ 
+       return URC_NO_REASON;
+    end CleanupUnwind_Handler;
+ 
+    ---------------------------------
+    -- Is_Setup_And_Not_Propagated --
+    ---------------------------------
+ 
+    function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
+       GCC_E : constant GNAT_GCC_Exception_Access :=
+                 To_GNAT_GCC_Exception (E.Private_Data);
+    begin
+       return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
+    end Is_Setup_And_Not_Propagated;
+ 
+    ------------------------------------
+    -- Clear_Setup_And_Not_Propagated --
+    ------------------------------------
+ 
+    procedure Clear_Setup_And_Not_Propagated (E : EOA) is
+       GCC_E : constant GNAT_GCC_Exception_Access :=
+                 To_GNAT_GCC_Exception (E.Private_Data);
+    begin
+       pragma Assert (GCC_E /= null);
+       GCC_E.Header.Private1 := 0;
+    end Clear_Setup_And_Not_Propagated;
+ 
+    ----------------------------------
+    -- Set_Setup_And_Not_Propagated --
+    ----------------------------------
+ 
+    procedure Set_Setup_And_Not_Propagated (E : EOA) is
+       GCC_E : constant GNAT_GCC_Exception_Access :=
+                 To_GNAT_GCC_Exception (E.Private_Data);
+    begin
+       pragma Assert (GCC_E /= null);
+       GCC_E.Header.Private1 := Setup_Key;
+    end Set_Setup_And_Not_Propagated;
+ 
+    --------------------------------
+    -- Save_Occurrence_And_Private --
+    --------------------------------
+ 
+    procedure Save_Occurrence_And_Private
+      (Target : out Exception_Occurrence;
+       Source : Exception_Occurrence)
+    is
+    begin
+       Save_Occurrence_No_Private (Target, Source);
+       Target.Private_Data := Source.Private_Data;
+    end Save_Occurrence_And_Private;
+ 
+    ---------------------
+    -- Setup_Exception --
+    ---------------------
+ 
+    --  In the GCC-EH implementation of the propagation scheme, this
+    --  subprogram should be understood as: Setup the exception occurrence
+    --  stack headed at Current for a forthcoming raise of Excep.
+ 
+    procedure Setup_Exception
+      (Excep    : EOA;
+       Current  : EOA;
+       Reraised : Boolean := False)
+    is
+       Top           : constant EOA := Current;
+       Next          : EOA;
+       GCC_Exception : GNAT_GCC_Exception_Access;
+ 
+    begin
+       --  The exception Excep is soon to be propagated, and the
+       --  storage used for that will be the occurrence statically allocated
+       --  for the current thread. This storage might currently be used for a
+       --  still active occurrence, so we need to push it on the thread's
+       --  occurrence stack (headed at that static occurrence) before it gets
+       --  clobbered.
+ 
+       --  What we do here is to trigger this push when need be, and allocate a
+       --  Private_Data block for the forthcoming Propagation.
+ 
+       --  Some tasking rendez-vous attempts lead to an occurrence transfer
+       --  from the server to the client (see Exceptional_Complete_Rendezvous).
+       --  In those cases Setup is called twice for the very same occurrence
+       --  before it gets propagated: once from the server, because this is
+       --  where the occurrence contents is elaborated and known, and then
+       --  once from the client when it detects the case and actually raises
+       --  the exception in its own context.
+ 
+       --  The Is_Setup_And_Not_Propagated predicate tells us when we are in
+       --  the second call to Setup for a Transferred occurrence, and there is
+       --  nothing to be done here in this situation. This predicate cannot be
+       --  True if we are dealing with a Reraise, and we may even be called
+       --  with a raw uninitialized Excep occurrence in this case so we should
+       --  not check anyway. Observe the front-end expansion for a "raise;" to
+       --  see that happening. We get a local occurrence and a direct call to
+       --  Save_Occurrence without the intermediate init-proc call.
+ 
+       if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
+          return;
+       end if;
+ 
+       --  Allocate what will be the Private_Data block for the exception
+       --  to be propagated.
+ 
+       GCC_Exception := new GNAT_GCC_Exception;
+ 
+       --  If the Top of the occurrence stack is not currently used for an
+       --  active exception (the stack is empty) we just need to setup the
+       --  Private_Data pointer.
+ 
+       --  Otherwise, we also need to shift the contents of the Top of the
+       --  stack in a freshly allocated entry and link everything together.
+ 
+       if Top.Private_Data /= System.Null_Address then
+          Next := new Exception_Occurrence;
+          Save_Occurrence_And_Private (Next.all, Top.all);
+ 
+          GCC_Exception.Next_Exception := Next;
+          Top.Private_Data := GCC_Exception.all'Address;
+       end if;
+ 
+       Top.Private_Data := GCC_Exception.all'Address;
+ 
+       Set_Setup_And_Not_Propagated (Top);
+    end Setup_Exception;
+ 
+    -------------------
+    -- Begin_Handler --
+    -------------------
+ 
+    procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
+       pragma Unreferenced (GCC_Exception);
+ 
+    begin
+       --  Every necessary operation related to the occurrence stack has
+       --  already been performed by Propagate_Exception. This hook remains for
+       --  potential future necessity in optimizing the overall scheme, as well
+       --  a useful debugging tool.
+ 
+       null;
+    end Begin_Handler;
+ 
+    -----------------
+    -- End_Handler --
+    -----------------
+ 
+    procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
+       Removed : Boolean;
+    begin
+       Removed := Remove (Get_Current_Excep.all, GCC_Exception);
+       pragma Assert (Removed);
+    end End_Handler;
+ 
+    -------------------------
+    -- Propagate_Exception --
+    -------------------------
+ 
+    --  Build an object suitable for the libgcc processing and call
+    --  Unwind_RaiseException to actually throw, taking care of handling
+    --  the two phase scheme it implements.
+ 
+    procedure Propagate_Exception (From_Signal_Handler : Boolean) is
+       pragma Unreferenced (From_Signal_Handler);
+ 
+       Excep         : constant EOA := Get_Current_Excep.all;
+       GCC_Exception : GNAT_GCC_Exception_Access;
+ 
+    begin
+       pragma Assert (Excep.Private_Data /= System.Null_Address);
+ 
+       --  Retrieve the Private_Data for this occurrence and set the useful
+       --  flags for the personality routine, which will be called for each
+       --  frame via Unwind_RaiseException below.
+ 
+       GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
+ 
+       Clear_Setup_And_Not_Propagated (Excep);
+ 
+       GCC_Exception.Id := Excep.Id;
+       GCC_Exception.N_Cleanups_To_Trigger := 0;
+ 
+       --  Compute the backtrace for this occurrence if the corresponding
+       --  binder option has been set. Call_Chain takes care of the reraise
+       --  case.
+ 
+       --  ??? Using Call_Chain here means we are going to walk up the stack
+       --  once only for backtracing purposes before doing it again for the
+       --  propagation per se.
+ 
+       --  The first inspection is much lighter, though, as it only requires
+       --  partial unwinding of each frame. Additionally, although we could use
+       --  the personality routine to record the addresses while propagating,
+       --  this method has two drawbacks:
+ 
+       --  1) the trace is incomplete if the exception is handled since we
+       --  don't walk past the frame with the handler,
+ 
+       --    and
+ 
+       --  2) we would miss the frames for which our personality routine is not
+       --  called, e.g. if C or C++ calls are on the way.
+ 
+       Call_Chain (Excep);
+ 
+       --  Perform a standard raise first. If a regular handler is found, it
+       --  will be entered after all the intermediate cleanups have run. If
+       --  there is no regular handler, control will get back to after the
+       --  call, with N_Cleanups_To_Trigger set to the number of frames with
+       --  cleanups found on the way up, and none of these already run.
+ 
+       Unwind_RaiseException (GCC_Exception);
+ 
+       --  If we get here we know the exception is not handled, as otherwise
+       --  Unwind_RaiseException arranges for the handler to be entered. Take
+       --  the necessary steps to enable the debugger to gain control while the
+       --  stack is still intact.
+ 
+       Notify_Unhandled_Exception;
+ 
+       --  Now, if cleanups have been found, run a forced unwind to trigger
+       --  them. Control should not resume there, as the unwinding hook calls
+       --  Unhandled_Exception_Terminate as soon as the last cleanup has been
+       --  triggered.
+ 
+       if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
+          Unwind_ForcedUnwind (GCC_Exception,
+                               CleanupUnwind_Handler'Address,
+                               System.Null_Address);
+       end if;
+ 
+       --  We get here when there is no handler or cleanup to be run at all.
+       --  The debugger has been notified before the second step above.
+ 
+       Unhandled_Exception_Terminate;
+    end Propagate_Exception;
+ 
+    ---------------------------
+    -- Adjust_N_Cleanups_For --
+    ---------------------------
+ 
+    procedure Adjust_N_Cleanups_For
+      (GNAT_Exception : GNAT_GCC_Exception_Access;
+       Adjustment     : Integer)
+    is
+    begin
+       GNAT_Exception.N_Cleanups_To_Trigger :=
+         GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
+    end Adjust_N_Cleanups_For;
+ 
+    -------------
+    -- EID_For --
+    -------------
+ 
+    function EID_For
+      (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
+    is
+    begin
+       return GNAT_Exception.Id;
+    end EID_For;
+ 
+    ---------------------
+    -- Import_Code_For --
+    ---------------------
+ 
+    function Import_Code_For
+      (E : SSL.Exception_Data_Ptr) return Exception_Code
+    is
+    begin
+       return E.all.Import_Code;
+    end Import_Code_For;
+ 
+    --------------------------
+    -- Is_Handled_By_Others --
+    --------------------------
+ 
+    function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
+    begin
+       return not E.all.Not_Handled_By_Others;
+    end Is_Handled_By_Others;
+ 
+    ------------------
+    -- Language_For --
+    ------------------
+ 
+    function Language_For (E : SSL.Exception_Data_Ptr) return Character is
+    begin
+       return E.all.Lang;
+    end Language_For;
+ 
+    -----------
+    -- Notes --
+    -----------
+ 
+    --  The current model implemented for the stack of occurrences is a
+    --  simplification of previous attempts, which all prooved to be flawed or
+    --  would have needed significant additional circuitry to be made to work
+    --  correctly.
+ 
+    --  We now represent every propagation by a new entry on the stack, which
+    --  means that an exception occurrence may appear more than once (e.g. when
+    --  it is reraised during the course of its own handler).
+ 
+    --  This may seem overcostly compared to the C++ model as implemented in
+    --  the g++ v3 libstd. This is actually understandable when one considers
+    --  the extra variations of possible run-time configurations induced by the
+    --  freedom offered by the Save_Occurrence/Reraise_Occurrence public
+    --  interface.
+ 
+    --  The basic point is that arranging for an occurrence to always appear at
+    --  most once on the stack requires a way to determine if a given occurence
+    --  is already there, which is not as easy as it might seem.
+ 
+    --  An attempt was made to use the Private_Data pointer for this purpose.
+    --  It did not work because:
+ 
+    --  1) The Private_Data has to be saved by Save_Occurrence to be usable
+    --     as a key in case of a later reraise,
+ 
+    --  2) There is no easy way to synchronize End_Handler for an occurrence
+    --     and the data attached to potential copies, so these copies may end
+    --     up pointing to stale data. Moreover ...
+ 
+    --  3) The same address may be reused for different occurrences, which
+    --     defeats the idea of using it as a key.
+ 
+    --  The example below illustrates:
+ 
+    --  Saved_CE : Exception_Occurrence;
+ 
+    --  begin
+    --    raise Constraint_Error;
+    --  exception
+    --    when CE: others =>
+    --      Save_Occurrence (Saved_CE, CE);      <= Saved_CE.PDA = CE.PDA
+    --  end;
+ 
+    --                                           <= Saved_CE.PDA is stale (!)
+ 
+    --  begin
+    --    raise Program_Error;                   <= Saved_CE.PDA = PE.PDA (!!)
+    --  exception
+    --    when others =>
+    --      Reraise_Occurrence (Saved_CE);
+    --  end;
+ 
+    --  Not releasing the Private_Data via End_Handler could be an option,
+    --  but making this to work while still avoiding memory leaks is far
+    --  from trivial.
+ 
+    --  The current scheme has the advantage of beeing simple, and induces
+    --  extra costs only in reraise cases which is acceptable.
+ 
+ end Exception_Propagation;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exexpr.adb gcc-4.1.0/gcc/ada/a-exexpr.adb
*** gcc-4.0.2/gcc/ada/a-exexpr.adb	Wed Dec  8 11:24:50 2004
--- gcc-4.1.0/gcc/ada/a-exexpr.adb	Tue Nov 15 13:52:55 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,40 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Interfaces;
! 
! with Ada.Unchecked_Conversion;
! with Ada.Unchecked_Deallocation;
  
  with System.Storage_Elements;  use System.Storage_Elements;
  
--- 31,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default version, using the __builtin_setjmp/longjmp EH
! --  mechanism.
  
  with System.Storage_Elements;  use System.Storage_Elements;
  
*************** pragma Warnings (Off);
*** 45,725 ****
  separate (Ada.Exceptions)
  package body Exception_Propagation is
  
!    ------------------------------------------------
!    -- Entities to interface with the GCC runtime --
!    ------------------------------------------------
! 
!    --  These come from "C++ ABI for Itanium: Exception handling", which is
!    --  the reference for GCC. They are used only when we are relying on
!    --  back-end tables for exception propagation, which in turn is currenly
!    --  only the case for Zero_Cost_Exceptions in GNAT5.
! 
!    --  Return codes from the GCC runtime functions used to propagate
!    --  an exception.
! 
!    type Unwind_Reason_Code is
!      (URC_NO_REASON,
!       URC_FOREIGN_EXCEPTION_CAUGHT,
!       URC_PHASE2_ERROR,
!       URC_PHASE1_ERROR,
!       URC_NORMAL_STOP,
!       URC_END_OF_STACK,
!       URC_HANDLER_FOUND,
!       URC_INSTALL_CONTEXT,
!       URC_CONTINUE_UNWIND);
! 
!    pragma Unreferenced
!      (URC_FOREIGN_EXCEPTION_CAUGHT,
!       URC_PHASE2_ERROR,
!       URC_PHASE1_ERROR,
!       URC_NORMAL_STOP,
!       URC_END_OF_STACK,
!       URC_HANDLER_FOUND,
!       URC_INSTALL_CONTEXT,
!       URC_CONTINUE_UNWIND);
! 
!    pragma Convention (C, Unwind_Reason_Code);
! 
!    --  Phase identifiers
! 
!    type Unwind_Action is
!      (UA_SEARCH_PHASE,
!       UA_CLEANUP_PHASE,
!       UA_HANDLER_FRAME,
!       UA_FORCE_UNWIND);
! 
!    for Unwind_Action use
!       (UA_SEARCH_PHASE  => 1,
!        UA_CLEANUP_PHASE => 2,
!        UA_HANDLER_FRAME => 4,
!        UA_FORCE_UNWIND  => 8);
! 
!    pragma Convention (C, Unwind_Action);
! 
!    --  Mandatory common header for any exception object handled by the
!    --  GCC unwinding runtime.
! 
!    subtype Exception_Class is Interfaces.Unsigned_64;
! 
!    GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
!    --  "GNU-Ada\0"
! 
!    type Unwind_Word is mod 2 ** System.Word_Size;
!    for Unwind_Word'Size use System.Word_Size;
!    --  Map the corresponding C type used in Unwind_Exception below
! 
!    type Unwind_Exception is record
!       Class    : Exception_Class := GNAT_Exception_Class;
!       Cleanup  : System.Address  := System.Null_Address;
!       Private1 : Unwind_Word;
!       Private2 : Unwind_Word;
!    end record;
!    --  Map the GCC struct used for exception handling
! 
!    for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
!    --  The C++ ABI mandates the common exception header to be at least
!    --  doubleword aligned, and the libGCC implementation actually makes it
!    --  maximally aligned (see unwind.h). See additional comments on the
!    --  alignment below.
! 
!    --------------------------------------------------------------
!    -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
!    --------------------------------------------------------------
! 
!    --  A GNAT exception object to be dealt with by the personality routine
!    --  called by the GCC unwinding runtime.
! 
!    type GNAT_GCC_Exception is record
!       Header : Unwind_Exception;
!       --  ABI Exception header first
! 
!       Id : Exception_Id;
!       --  GNAT Exception identifier.  This is filled by Propagate_Exception
!       --  and then used by the personality routine to determine if the context
!       --  it examines contains a handler for the exception beeing propagated.
! 
!       N_Cleanups_To_Trigger : Integer;
!       --  Number of cleanup only frames encountered in SEARCH phase.  This is
!       --  initialized to 0 by Propagate_Exception and maintained by the
!       --  personality routine to control a forced unwinding phase triggering
!       --  all the cleanups before calling Unhandled_Exception_Terminate when
!       --  an exception is not handled.
! 
!       Next_Exception : EOA;
!       --  Used to create a linked list of exception occurrences
!    end record;
! 
!    pragma Convention (C, GNAT_GCC_Exception);
! 
!    --  There is a subtle issue with the common header alignment, since the C
!    --  version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
!    --  Standard'Maximum_Alignment, and those two values don't quite represent
!    --  the same concepts and so may be decoupled someday. One typical reason
!    --  is that BIGGEST_ALIGNMENT may be larger than what the underlying system
!    --  allocator guarantees, and there are extra costs involved in allocating
!    --  objects aligned to such factors.
! 
!    --  To deal with the potential alignment differences between the C and Ada
!    --  representations, the Ada part of the whole structure is only accessed
!    --  by the personality routine through the accessors declared below.  Ada
!    --  specific fields are thus always accessed through consistent layout, and
!    --  we expect the actual alignment to always be large enough to avoid traps
!    --  from the C accesses to the common header. Besides, accessors aleviate
!    --  the need for a C struct whole conterpart, both painful and errorprone
!    --  to maintain anyway.
! 
!    type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
! 
!    function To_GNAT_GCC_Exception is new
!      Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
! 
!    procedure Free is new Unchecked_Deallocation
!      (GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
! 
!    procedure Free is new Unchecked_Deallocation
!      (Exception_Occurrence, EOA);
! 
!    function CleanupUnwind_Handler
!      (UW_Version   : Integer;
!       UW_Phases    : Unwind_Action;
!       UW_Eclass    : Exception_Class;
!       UW_Exception : access GNAT_GCC_Exception;
!       UW_Context   : System.Address;
!       UW_Argument  : System.Address) return Unwind_Reason_Code;
!    --  Hook called at each step of the forced unwinding we perform to
!    --  trigger cleanups found during the propagation of an unhandled
!    --  exception.
! 
!    --  GCC runtime functions used. These are C non-void functions, actually,
!    --  but we ignore the return values. See raise.c as to why we are using
!    --  __gnat stubs for these.
! 
!    procedure Unwind_RaiseException
!      (UW_Exception : access GNAT_GCC_Exception);
!    pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
! 
!    procedure Unwind_ForcedUnwind
!      (UW_Exception : access GNAT_GCC_Exception;
!       UW_Handler   : System.Address;
!       UW_Argument  : System.Address);
!    pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
! 
!    ------------------------------------------------------------------
!    -- Occurrence Stack Management Facilities for the GCC-EH Scheme --
!    ------------------------------------------------------------------
! 
!    function Remove
!      (Top   : EOA;
!       Excep : GNAT_GCC_Exception_Access) return Boolean;
!    --  Remove Excep from the stack starting at Top.
!    --  Return True if Excep was found and removed, false otherwise.
! 
!    --  Hooks called when entering/leaving an exception handler for a given
!    --  occurrence, aimed at handling the stack of active occurrences. The
!    --  calls are generated by gigi in tree_transform/N_Exception_Handler.
! 
!    procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
!    pragma Export (C, Begin_Handler, "__gnat_begin_handler");
! 
!    procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
!    pragma Export (C, End_Handler, "__gnat_end_handler");
! 
!    Setup_Key : constant := 16#DEAD#;
!    --  To handle the case of a task "transferring" an exception occurrence to
!    --  another task, for instance via Exceptional_Complete_Rendezvous, we need
!    --  to be able to identify occurrences which have been Setup and not yet
!    --  Propagated. We hijack one of the common header fields for that purpose,
!    --  setting it to a special key value during the setup process, clearing it
!    --  at the very beginning of the propagation phase, and expecting it never
!    --  to be reset to the special value later on. A 16-bit value is used rather
!    --  than a 32-bit value for static compatibility with 16-bit targets such as
!    --  AAMP (where type Unwind_Word will be 16 bits).
! 
!    function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
! 
!    procedure Set_Setup_And_Not_Propagated (E : EOA);
!    procedure Clear_Setup_And_Not_Propagated (E : EOA);
! 
!    ------------------------------------------------------------
!    -- Accessors to basic components of a GNAT exception data --
!    ------------------------------------------------------------
! 
!    --  As of today, these are only used by the C implementation of the
!    --  GCC propagation personality routine to avoid having to rely on a C
!    --  counterpart of the whole exception_data structure, which is both
!    --  painful and error prone. These subprograms could be moved to a
!    --  more widely visible location if need be.
! 
!    function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
!    pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
! 
!    function Language_For (E : Exception_Data_Ptr) return Character;
!    pragma Export (C, Language_For, "__gnat_language_for");
! 
!    function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
!    pragma Export (C, Import_Code_For, "__gnat_import_code_for");
! 
!    function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
!      return Exception_Id;
!    pragma Export (C, EID_For, "__gnat_eid_for");
! 
!    procedure Adjust_N_Cleanups_For
!      (GNAT_Exception : GNAT_GCC_Exception_Access;
!       Adjustment     : Integer);
!    pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
! 
!    ---------------------------------------------------------------------------
!    -- Objects to materialize "others" and "all others" in the GCC EH tables --
!    ---------------------------------------------------------------------------
! 
!    --  Currently, these only have their address taken and compared so there is
!    --  no real point having whole exception data blocks allocated. In any case
!    --  the types should match what gigi and the personality routine expect.
!    --  The initial value is an arbitrary value that will not exceed the range
!    --  of Integer on 16-bit targets (such as AAMP).
! 
!    Others_Value : constant Integer := 16#7FFF#;
!    pragma Export (C, Others_Value, "__gnat_others_value");
! 
!    All_Others_Value : constant Integer := 16#7FFF#;
!    pragma Export (C, All_Others_Value, "__gnat_all_others_value");
! 
!    ------------
!    -- Remove --
!    ------------
! 
!    function Remove
!      (Top   : EOA;
!       Excep : GNAT_GCC_Exception_Access) return Boolean
!    is
!       Prev          : GNAT_GCC_Exception_Access := null;
!       Iter          : EOA := Top;
!       GCC_Exception : GNAT_GCC_Exception_Access;
! 
!    begin
!       --  Pop stack
! 
!       loop
!          pragma Assert (Iter.Private_Data /= System.Null_Address);
! 
!          GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
! 
!          if GCC_Exception = Excep then
!             if Prev = null then
! 
!                --  Special case for the top of the stack: shift the contents
!                --  of the next item to the top, since top is at a fixed
!                --  location and can't be changed.
! 
!                Iter := GCC_Exception.Next_Exception;
! 
!                if Iter = null then
! 
!                   --  Stack is now empty
! 
!                   Top.Private_Data := System.Null_Address;
! 
!                else
!                   Save_Occurrence_And_Private (Top.all, Iter.all);
!                   Free (Iter);
!                end if;
! 
!             else
!                Prev.Next_Exception := GCC_Exception.Next_Exception;
!                Free (Iter);
!             end if;
! 
!             Free (GCC_Exception);
! 
!             return True;
!          end if;
! 
!          exit when GCC_Exception.Next_Exception = null;
! 
!          Prev := GCC_Exception;
!          Iter := GCC_Exception.Next_Exception;
!       end loop;
! 
!       return False;
!    end Remove;
! 
!    ---------------------------
!    -- CleanupUnwind_Handler --
!    ---------------------------
! 
!    function CleanupUnwind_Handler
!      (UW_Version   : Integer;
!       UW_Phases    : Unwind_Action;
!       UW_Eclass    : Exception_Class;
!       UW_Exception : access GNAT_GCC_Exception;
!       UW_Context   : System.Address;
!       UW_Argument  : System.Address) return Unwind_Reason_Code
!    is
!    begin
!       --  Terminate as soon as we know there is nothing more to run. The
!       --  count is maintained by the personality routine.
! 
!       if UW_Exception.N_Cleanups_To_Trigger = 0 then
!          Unhandled_Exception_Terminate;
!       end if;
! 
!       --  We know there is at least one cleanup further up. Return so that it
!       --  is searched and entered, after which Unwind_Resume will be called
!       --  and this hook will gain control (with an updated count) again.
! 
!       return URC_NO_REASON;
!    end CleanupUnwind_Handler;
! 
!    ---------------------------------
!    -- Is_Setup_And_Not_Propagated --
!    ---------------------------------
! 
!    function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
!       GCC_E : GNAT_GCC_Exception_Access :=
!                 To_GNAT_GCC_Exception (E.Private_Data);
!    begin
!       return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
!    end Is_Setup_And_Not_Propagated;
! 
!    ------------------------------------
!    -- Clear_Setup_And_Not_Propagated --
!    ------------------------------------
! 
!    procedure Clear_Setup_And_Not_Propagated (E : EOA) is
!       GCC_E : GNAT_GCC_Exception_Access :=
!                 To_GNAT_GCC_Exception (E.Private_Data);
!    begin
!       pragma Assert (GCC_E /= null);
!       GCC_E.Header.Private1 := 0;
!    end Clear_Setup_And_Not_Propagated;
! 
!    ----------------------------------
!    -- Set_Setup_And_Not_Propagated --
!    ----------------------------------
! 
!    procedure Set_Setup_And_Not_Propagated (E : EOA) is
!       GCC_E : GNAT_GCC_Exception_Access :=
!                 To_GNAT_GCC_Exception (E.Private_Data);
!    begin
!       pragma Assert (GCC_E /= null);
!       GCC_E.Header.Private1 := Setup_Key;
!    end Set_Setup_And_Not_Propagated;
  
     ---------------------
     -- Setup_Exception --
     ---------------------
  
-    --  In the GCC-EH implementation of the propagation scheme, this
-    --  subprogram should be understood as : Setup the exception occurrence
-    --  stack headed at Current for a forthcoming raise of Excep.
- 
-    --  In the GNAT-SJLJ case this "stack" only exists implicitely, by way of
-    --  local occurrence declarations together with save/restore operations
-    --  generated by the front-end, and this routine has nothing to do.
- 
-    --  The differenciation is done here and not in the callers to avoid having
-    --  to spread out the test in numerous places.
- 
     procedure Setup_Exception
       (Excep    : EOA;
        Current  : EOA;
        Reraised : Boolean := False)
     is
!       Top           : constant EOA := Current;
!       Next          : EOA;
!       GCC_Exception : GNAT_GCC_Exception_Access;
! 
!    begin
!       --  Just return if we're not in the GCC-EH case. What is otherwise
!       --  performed is useless and even harmful since it potentially involves
!       --  dynamic allocations that would never be released, and participates
!       --  in the Setup_And_Not_Propagated predicate management, only properly
!       --  handled by the rest of the GCC-EH scheme.
! 
!       if Zero_Cost_Exceptions = 0 then
!          return;
!       end if;
! 
!       --  Otherwise, the exception Excep is soon to be propagated, and the
!       --  storage used for that will be the occurrence statically allocated
!       --  for the current thread. This storage might currently be used for a
!       --  still active occurrence, so we need to push it on the thread's
!       --  occurrence stack (headed at that static occurrence) before it gets
!       --  clobbered.
! 
!       --  What we do here is to trigger this push when need be, and allocate a
!       --  Private_Data block for the forthcoming Propagation.
! 
!       --  Some tasking rendez-vous attempts lead to an occurrence transfer
!       --  from the server to the client (see Exceptional_Complete_Rendezvous).
!       --  In those cases Setup is called twice for the very same occurrence
!       --  before it gets propagated: once from the server, because this is
!       --  where the occurrence contents is elaborated and known, and then
!       --  once from the client when it detects the case and actually raises
!       --  the exception in its own context.
! 
!       --  The Is_Setup_And_Not_Propagated predicate tells us when we are in
!       --  the second call to Setup for a Transferred occurrence, and there is
!       --  nothing to be done here in this situation. This predicate cannot be
!       --  True if we are dealing with a Reraise, and we may even be called
!       --  with a raw uninitialized Excep occurrence in this case so we should
!       --  not check anyway. Observe the front-end expansion for a "raise;" to
!       --  see that happening. We get a local occurrence and a direct call to
!       --  Save_Occurrence without the intermediate init-proc call.
! 
!       if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
!          return;
!       end if;
! 
!       --  Allocate what will be the Private_Data block for the exception
!       --  to be propagated.
! 
!       GCC_Exception := new GNAT_GCC_Exception;
! 
!       --  If the Top of the occurrence stack is not currently used for an
!       --  active exception (the stack is empty) we just need to setup the
!       --  Private_Data pointer.
! 
!       --  Otherwise, we also need to shift the contents of the Top of the
!       --  stack in a freshly allocated entry and link everything together.
! 
!       if Top.Private_Data /= System.Null_Address then
!          Next := new Exception_Occurrence;
!          Save_Occurrence_And_Private (Next.all, Top.all);
! 
!          GCC_Exception.Next_Exception := Next;
!          Top.Private_Data := GCC_Exception.all'Address;
!       end if;
! 
!       Top.Private_Data := GCC_Exception.all'Address;
! 
!       Set_Setup_And_Not_Propagated (Top);
!    end Setup_Exception;
! 
!    -------------------
!    -- Begin_Handler --
!    -------------------
! 
!    procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
     begin
!       --  Every necessary operation related to the occurrence stack has
!       --  already been performed by Propagate_Exception. This hook remains for
!       --  potential future necessity in optimizing the overall scheme, as well
!       --  a useful debugging tool.
  
        null;
!    end Begin_Handler;
! 
!    -----------------
!    -- End_Handler --
!    -----------------
! 
!    procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
!       Removed : Boolean;
!    begin
!       Removed := Remove (Get_Current_Excep.all, GCC_Exception);
!       pragma Assert (Removed);
!    end End_Handler;
  
     -------------------------
     -- Propagate_Exception --
     -------------------------
  
-    --  Build an object suitable for the libgcc processing and call
-    --  Unwind_RaiseException to actually throw, taking care of handling
-    --  the two phase scheme it implements.
- 
     procedure Propagate_Exception (From_Signal_Handler : Boolean) is
!       Excep         : EOA := Get_Current_Excep.all;
!       GCC_Exception : GNAT_GCC_Exception_Access;
! 
     begin
!       pragma Assert (Excep.Private_Data /= System.Null_Address);
! 
!       --  Retrieve the Private_Data for this occurrence and set the useful
!       --  flags for the personality routine, which will be called for each
!       --  frame via Unwind_RaiseException below.
! 
!       GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
! 
!       Clear_Setup_And_Not_Propagated (Excep);
! 
!       GCC_Exception.Id := Excep.Id;
!       GCC_Exception.N_Cleanups_To_Trigger := 0;
  
!       --  Compute the backtrace for this occurrence if the corresponding
!       --  binder option has been set. Call_Chain takes care of the reraise
!       --  case.
  
!       --  ??? Using Call_Chain here means we are going to walk up the stack
!       --  once only for backtracing purposes before doing it again for the
!       --  propagation per se.
  
!       --  The first inspection is much lighter, though, as it only requires
!       --  partial unwinding of each frame. Additionally, although we could use
!       --  the personality routine to record the addresses while propagating,
!       --  this method has two drawbacks:
  
!       --  1) the trace is incomplete if the exception is handled since we
!       --  don't walk past the frame with the handler,
  
!       --    and
  
!       --  2) we would miss the frames for which our personality routine is not
!       --  called, e.g. if C or C++ calls are on the way.
  
!       Call_Chain (Excep);
  
!       --  Perform a standard raise first. If a regular handler is found, it
!       --  will be entered after all the intermediate cleanups have run. If
!       --  there is no regular handler, control will get back to after the
!       --  call, with N_Cleanups_To_Trigger set to the number of frames with
!       --  cleanups found on the way up, and none of these already run.
  
!       Unwind_RaiseException (GCC_Exception);
  
!       --  If we get here we know the exception is not handled, as otherwise
!       --  Unwind_RaiseException arranges for the handler to be entered. Take
!       --  the necessary steps to enable the debugger to gain control while the
!       --  stack is still intact.
  
!       Notify_Unhandled_Exception;
  
!       --  Now, if cleanups have been found, run a forced unwind to trigger
!       --  them. Control should not resume there, as the unwinding hook calls
!       --  Unhandled_Exception_Terminate as soon as the last cleanup has been
!       --  triggered.
  
!       if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
!          Unwind_ForcedUnwind (GCC_Exception,
!                               CleanupUnwind_Handler'Address,
!                               System.Null_Address);
        end if;
- 
-       --  We get here when there is no handler or cleanup to be run at
-       --  all. The debugger has been notified before the second step above.
- 
-       Unhandled_Exception_Terminate;
     end Propagate_Exception;
  
-    ---------------------------
-    -- Adjust_N_Cleanups_For --
-    ---------------------------
- 
-    procedure Adjust_N_Cleanups_For
-      (GNAT_Exception : GNAT_GCC_Exception_Access;
-       Adjustment     : Integer)
-    is
-    begin
-       GNAT_Exception.N_Cleanups_To_Trigger :=
-         GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
-    end Adjust_N_Cleanups_For;
- 
-    -------------
-    -- EID_For --
-    -------------
- 
-    function EID_For
-      (GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
-    is
-    begin
-       return GNAT_Exception.Id;
-    end EID_For;
- 
-    ---------------------
-    -- Import_Code_For --
-    ---------------------
- 
-    function Import_Code_For
-      (E : SSL.Exception_Data_Ptr) return Exception_Code
-    is
-    begin
-       return E.all.Import_Code;
-    end Import_Code_For;
- 
-    --------------------------
-    -- Is_Handled_By_Others --
-    --------------------------
- 
-    function Is_Handled_By_Others
-      (E : SSL.Exception_Data_Ptr) return Boolean
-    is
-    begin
-       return not E.all.Not_Handled_By_Others;
-    end Is_Handled_By_Others;
- 
-    ------------------
-    -- Language_For --
-    ------------------
- 
-    function Language_For
-      (E : SSL.Exception_Data_Ptr) return Character
-    is
-    begin
-       return E.all.Lang;
-    end Language_For;
- 
-    -----------
-    -- Notes --
-    -----------
- 
-    --  The current model implemented for the stack of occurrences is a
-    --  simplification of previous attempts, which all prooved to be flawed or
-    --  would have needed significant additional circuitry to be made to work
-    --  correctly.
- 
-    --  We now represent every propagation by a new entry on the stack, which
-    --  means that an exception occurrence may appear more than once (e.g. when
-    --  it is reraised during the course of its own handler).
- 
-    --  This may seem overcostly compared to the C++ model as implemented in
-    --  the g++ v3 libstd. This is actually understandable when one considers
-    --  the extra variations of possible run-time configurations induced by the
-    --  freedom offered by the Save_Occurrence/Reraise_Occurrence public
-    --  interface.
- 
-    --  The basic point is that arranging for an occurrence to always appear at
-    --  most once on the stack requires a way to determine if a given occurence
-    --  is already there, which is not as easy as it might seem.
- 
-    --  An attempt was made to use the Private_Data pointer for this purpose.
-    --  It did not work because:
- 
-    --  1) The Private_Data has to be saved by Save_Occurrence to be usable
-    --     as a key in case of a later reraise,
- 
-    --  2) There is no easy way to synchronize End_Handler for an occurrence
-    --     and the data attached to potential copies, so these copies may end
-    --     up pointing to stale data. Moreover ...
- 
-    --  3) The same address may be reused for different occurrences, which
-    --     defeats the idea of using it as a key.
- 
-    --  The example below illustrates:
- 
-    --  Saved_CE : Exception_Occurrence;
- 
-    --  begin
-    --    raise Constraint_Error;
-    --  exception
-    --    when CE: others =>
-    --      Save_Occurrence (Saved_CE, CE);      <= Saved_CE.PDA = CE.PDA
-    --  end;
- 
-    --                                           <= Saved_CE.PDA is stale (!)
- 
-    --  begin
-    --    raise Program_Error;                   <= Saved_CE.PDA = PE.PDA (!!)
-    --  exception
-    --    when others =>
-    --      Reraise_Occurrence (Saved_CE);
-    --  end;
- 
-    --  Not releasing the Private_Data via End_Handler could be an option,
-    --  but making this to work while still avoiding memory leaks is far
-    --  from trivial.
- 
-    --  The current scheme has the advantage of beeing simple, and induces
-    --  extra costs only in reraise cases which is acceptable.
- 
  end Exception_Propagation;
--- 43,122 ----
  separate (Ada.Exceptions)
  package body Exception_Propagation is
  
!    procedure builtin_longjmp (buffer : Address; Flag : Integer);
!    pragma No_Return (builtin_longjmp);
!    pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
  
     ---------------------
     -- Setup_Exception --
     ---------------------
  
     procedure Setup_Exception
       (Excep    : EOA;
        Current  : EOA;
        Reraised : Boolean := False)
     is
!       pragma Unreferenced (Excep, Current, Reraised);
     begin
!       --  In the GNAT-SJLJ case this "stack" only exists implicitely, by way of
!       --  local occurrence declarations together with save/restore operations
!       --  generated by the front-end, and this routine has nothing to do.
  
        null;
!    end Setup_Exception;
  
     -------------------------
     -- Propagate_Exception --
     -------------------------
  
     procedure Propagate_Exception (From_Signal_Handler : Boolean) is
!       Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
!       Excep       : constant EOA := Get_Current_Excep.all;
     begin
!       --  Compute the backtrace for this occurrence if corresponding binder
!       --  option has been set. Call_Chain takes care of the reraise case.
  
!       Call_Chain (Excep);
  
!       --  Note on above call to Call_Chain:
  
!       --  We used to only do this if From_Signal_Handler was not set,
!       --  based on the assumption that backtracing from a signal handler
!       --  would not work due to stack layout oddities. However, since
  
!       --   1. The flag is never set in tasking programs (Notify_Exception
!       --      performs regular raise statements), and
  
!       --   2. No problem has shown up in tasking programs around here so
!       --      far, this turned out to be too strong an assumption.
  
!       --  As, in addition, the test was
  
!       --   1. preventing the production of backtraces in non-tasking
!       --      programs, and
  
!       --   2. introducing a behavior inconsistency between
!       --      the tasking and non-tasking cases,
  
!       --  we have simply removed it
  
!       --  If the jump buffer pointer is non-null, transfer control using
!       --  it. Otherwise announce an unhandled exception (note that this
!       --  means that we have no finalizations to do other than at the outer
!       --  level). Perform the necessary notification tasks in both cases.
  
!       if Jumpbuf_Ptr /= Null_Address then
!          if not Excep.Exception_Raised then
!             Excep.Exception_Raised := True;
!             Exception_Traces.Notify_Handled_Exception;
!          end if;
  
!          builtin_longjmp (Jumpbuf_Ptr, 1);
  
!       else
!          Exception_Traces.Notify_Unhandled_Exception;
!          Exception_Traces.Unhandled_Exception_Terminate;
        end if;
     end Propagate_Exception;
  
  end Exception_Propagation;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exextr.adb gcc-4.1.0/gcc/ada/a-exextr.adb
*** gcc-4.0.2/gcc/ada/a-exextr.adb	Tue Jul 20 10:26:51 2004
--- gcc-4.1.0/gcc/ada/a-exextr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Exception_Traces is
*** 85,91 ****
  
     procedure Unhandled_Exception;
     pragma Export (C, Unhandled_Exception, "__gnat_unhandled_exception");
!    --  Hook for GDB to support "break exception unhandled".
  
     --  For "break exception", GDB uses __gnat_raise_nodefer_with_msg, which
     --  is not in this section because it fullfills other purposes than a mere
--- 85,91 ----
  
     procedure Unhandled_Exception;
     pragma Export (C, Unhandled_Exception, "__gnat_unhandled_exception");
!    --  Hook for GDB to support "break exception unhandled"
  
     --  For "break exception", GDB uses __gnat_raise_nodefer_with_msg, which
     --  is not in this section because it fullfills other purposes than a mere
*************** package body Exception_Traces is
*** 190,196 ****
        Last_Chance_Handler (Excep.all);
     end Unhandled_Exception_Terminate;
  
- 
     ------------------------------------
     -- Handling GNAT.Exception_Traces --
     ------------------------------------
--- 190,195 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-exstat.adb gcc-4.1.0/gcc/ada/a-exstat.adb
*** gcc-4.0.2/gcc/ada/a-exstat.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-exstat.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
--- 31,46 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ pragma Warnings (Off);
+ --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
+ --  package will be categorized as Preelaborate. See AI-362 for details.
+ --  It is safe in the context of the run-time to violate the rules!
+ 
  with System.Exception_Table;  use System.Exception_Table;
  with System.Storage_Elements; use System.Storage_Elements;
  
+ pragma Warnings (On);
+ 
  separate (Ada.Exceptions)
  package body Stream_Attributes is
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-filico.adb gcc-4.1.0/gcc/ada/a-filico.adb
*** gcc-4.0.2/gcc/ada/a-filico.adb	Wed Oct 27 12:29:19 2004
--- gcc-4.1.0/gcc/ada/a-filico.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-filico.ads gcc-4.1.0/gcc/ada/a-filico.ads
*** gcc-4.0.2/gcc/ada/a-filico.ads	Wed Oct 27 12:29:19 2004
--- gcc-4.1.0/gcc/ada/a-filico.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                S p e c                                   --
  --                                                                          --
! --          Copyright (C) 1992-1997, 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                S p e c                                   --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,39 ****
  ------------------------------------------------------------------------------
  
  with System.Finalization_Root;
  package Ada.Finalization.List_Controller is
! pragma Elaborate_Body (List_Controller);
  
     package SFR renames System.Finalization_Root;
  
--- 32,40 ----
  ------------------------------------------------------------------------------
  
  with System.Finalization_Root;
+ 
  package Ada.Finalization.List_Controller is
!    pragma Elaborate_Body;
  
     package SFR renames System.Finalization_Root;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-finali.adb gcc-4.1.0/gcc/ada/a-finali.adb
*** gcc-4.0.2/gcc/ada/a-finali.adb	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-finali.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-finali.ads gcc-4.1.0/gcc/ada/a-finali.ads
*** gcc-4.0.2/gcc/ada/a-finali.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-finali.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Finalization_Root;
  
  package Ada.Finalization is
! pragma Preelaborate (Finalization);
  
     type Controlled is abstract tagged private;
  
--- 38,44 ----
  with System.Finalization_Root;
  
  package Ada.Finalization is
!    pragma Preelaborate;
  
     type Controlled is abstract tagged private;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-flteio.ads gcc-4.1.0/gcc/ada/a-flteio.ads
*** gcc-4.0.2/gcc/ada/a-flteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-flteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                    A D A . F L O A T _ T E X T _ I O                     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                    A D A . F L O A T _ T E X T _ I O                     --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-fwteio.ads gcc-4.1.0/gcc/ada/a-fwteio.ads
*** gcc-4.0.2/gcc/ada/a-fwteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-fwteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . F L O A T _ W I D E _ T E X T _ I O                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . F L O A T _ W I D E _ T E X T _ I O                --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-inteio.ads gcc-4.1.0/gcc/ada/a-inteio.ads
*** gcc-4.0.2/gcc/ada/a-inteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-inteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  A D A . I N T E G E R _ T E X T _ I O                   --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  A D A . I N T E G E R _ T E X T _ I O                   --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-interr.adb gcc-4.1.0/gcc/ada/a-interr.adb
*** gcc-4.0.2/gcc/ada/a-interr.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-interr.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                         A D A . I N T E R R U P T S                      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                         A D A . I N T E R R U P T S                      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Interrupts is
*** 73,80 ****
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID)
!       return      Parameterless_Handler
     is
     begin
        return To_Ada (SI.Current_Handler (SI.Interrupt_ID (Interrupt)));
--- 73,79 ----
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler
     is
     begin
        return To_Ada (SI.Current_Handler (SI.Interrupt_ID (Interrupt)));
*************** package body Ada.Interrupts is
*** 84,90 ****
     -- Detach_Handler --
     --------------------
  
!    procedure Detach_Handler (Interrupt : in Interrupt_ID) is
     begin
        SI.Detach_Handler (SI.Interrupt_ID (Interrupt), False);
     end Detach_Handler;
--- 83,89 ----
     -- Detach_Handler --
     --------------------
  
!    procedure Detach_Handler (Interrupt : Interrupt_ID) is
     begin
        SI.Detach_Handler (SI.Interrupt_ID (Interrupt), False);
     end Detach_Handler;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-interr.ads gcc-4.1.0/gcc/ada/a-interr.ads
*** gcc-4.0.2/gcc/ada/a-interr.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-interr.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  ------------------------------------------------------------------------------
  
  with System.Interrupts;
! --  used for Ada_Interrupt_ID.
  
  package Ada.Interrupts is
  
--- 36,42 ----
  ------------------------------------------------------------------------------
  
  with System.Interrupts;
! --  used for Ada_Interrupt_ID
  
  package Ada.Interrupts is
  
*************** package Ada.Interrupts is
*** 49,56 ****
     function Is_Attached (Interrupt : Interrupt_ID) return Boolean;
  
     function Current_Handler
!      (Interrupt : Interrupt_ID)
!       return      Parameterless_Handler;
  
     procedure Attach_Handler
       (New_Handler : Parameterless_Handler;
--- 49,55 ----
     function Is_Attached (Interrupt : Interrupt_ID) return Boolean;
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler;
  
     procedure Attach_Handler
       (New_Handler : Parameterless_Handler;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-aix.ads gcc-4.1.0/gcc/ada/a-intnam-aix.ads
*** gcc-4.0.2/gcc/ada/a-intnam-aix.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-aix.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1991-2002 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,50 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a AIX version of this package.
! --
  --  The following signals are reserved by the run time (native threads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGTERM,
  --  SIGSTOP, SIGKILL
! --
  --  The following signals are reserved by the run time (FSU threads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM,
  --  SIGWAITING, SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
--- 31,50 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a AIX version of this package
! 
  --  The following signals are reserved by the run time (native threads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGTERM,
  --  SIGSTOP, SIGKILL
! 
  --  The following signals are reserved by the run time (FSU threads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM,
  --  SIGWAITING, SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
*************** with System.OS_Interface;
*** 55,64 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 55,63 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-darwin.ads gcc-4.1.0/gcc/ada/a-intnam-darwin.ads
*** gcc-4.0.2/gcc/ada/a-intnam-darwin.ads	Wed Apr 28 09:38:51 2004
--- gcc-4.1.0/gcc/ada/a-intnam-darwin.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,44 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Darwin version of this package.
! --
  --  The following signals are reserved by the run time:
! --
  --  SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
--- 31,44 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Darwin version of this package
! 
  --  The following signals are reserved by the run time:
! 
  --  SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
*************** with System.OS_Interface;
*** 49,58 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 49,57 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-dummy.ads gcc-4.1.0/gcc/ada/a-intnam-dummy.ads
*** gcc-4.0.2/gcc/ada/a-intnam-dummy.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-dummy.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                           (No Tasking Version)                           --
  --                                                                          --
! --          Copyright (C) 1991-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                           (No Tasking Version)                           --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-freebsd.ads gcc-4.1.0/gcc/ada/a-intnam-freebsd.ads
*** gcc-4.0.2/gcc/ada/a-intnam-freebsd.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-freebsd.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-hpux.ads gcc-4.1.0/gcc/ada/a-intnam-hpux.ads
*** gcc-4.0.2/gcc/ada/a-intnam-hpux.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-hpux.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a HP-UX version of this package.
  
  --  The following signals are reserved by the run time:
  
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a HP-UX version of this package
  
  --  The following signals are reserved by the run time:
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-interix.ads gcc-4.1.0/gcc/ada/a-intnam-interix.ads
*** gcc-4.0.2/gcc/ada/a-intnam-interix.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-interix.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1991-2002 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-irix.ads gcc-4.1.0/gcc/ada/a-intnam-irix.ads
*** gcc-4.0.2/gcc/ada/a-intnam-irix.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-irix.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL is free software; you can redistribute it  and/or modify it  under --
  -- terms  of  the  GNU  Library General Public License  as published by the --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL is free software; you can redistribute it  and/or modify it  under --
  -- terms  of  the  GNU  Library General Public License  as published by the --
***************
*** 17,24 ****
  -- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  -- eral Library Public License  for more details.  You should have received --
  -- a  copy of the GNU Library General Public License along with GNARL;  see --
! -- file COPYING.LIB.  If not,  write to the  Free Software Foundation,   59 --
! -- Temple Place - Suite 330, Boston, MA 02111-1307, USA.                    --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  -- eral Library Public License  for more details.  You should have received --
  -- a  copy of the GNU Library General Public License along with GNARL;  see --
! -- file COPYING.LIB.  If not,  write to the  Free Software Foundation,   51 --
! -- Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.                --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Ada.Interrupts.Names is
*** 177,183 ****
     SIGUME : constant Interrupt_ID :=
       System.OS_Interface.SIGUME;      --  Uncorrectable memory error
  
!    --  Signals defined for Posix 1003.1c.
  
     SIGPTINTR : constant Interrupt_ID :=
       System.OS_Interface.SIGPTINTR;    --  Pthread Interrupt Signal
--- 177,183 ----
     SIGUME : constant Interrupt_ID :=
       System.OS_Interface.SIGUME;      --  Uncorrectable memory error
  
!    --  Signals defined for Posix 1003.1c
  
     SIGPTINTR : constant Interrupt_ID :=
       System.OS_Interface.SIGPTINTR;    --  Pthread Interrupt Signal
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-linux.ads gcc-4.1.0/gcc/ada/a-intnam-linux.ads
*** gcc-4.0.2/gcc/ada/a-intnam-linux.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-linux.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1991-2002 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,50 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a GNU/Linux version of this package.
! --
  --  The following signals are reserved by the run time (FSU threads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGALRM, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
! --
  --  The following signals are reserved by the run time (LinuxThreads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGUSR1, SIGUSR2, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
--- 31,50 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a GNU/Linux version of this package
! 
  --  The following signals are reserved by the run time (FSU threads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGALRM, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
! 
  --  The following signals are reserved by the run time (LinuxThreads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGUSR1, SIGUSR2, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  --  This target-dependent package spec contains names of interrupts
*************** with System.OS_Interface;
*** 55,64 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 55,63 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-lynxos.ads gcc-4.1.0/gcc/ada/a-intnam-lynxos.ads
*** gcc-4.0.2/gcc/ada/a-intnam-lynxos.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-lynxos.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,45 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a LynxOS version of this package.
! --
  --  The following signals are reserved by the run time:
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
--- 31,45 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a LynxOS version of this package
! 
  --  The following signals are reserved by the run time:
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
*************** with System.OS_Interface;
*** 47,54 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one. There may be aliases.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 47,54 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-mingw.ads gcc-4.1.0/gcc/ada/a-intnam-mingw.ads
*** gcc-4.0.2/gcc/ada/a-intnam-mingw.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-mingw.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1997-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1997-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,50 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NT (native) version of this package.
  
! --  This target-dependent package spec contains names of interrupts
! --  supported by the local system.
  
  with System.OS_Interface;
  --  used for names of interrupts
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGINT : constant Interrupt_ID :=
       System.OS_Interface.SIGINT;      --  interrupt (rubout)
--- 31,49 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NT (native) version of this package
  
! --  This target-dependent package spec contains names of interrupts supported
! --  by the local system.
  
  with System.OS_Interface;
  --  used for names of interrupts
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGINT : constant Interrupt_ID :=
       System.OS_Interface.SIGINT;      --  interrupt (rubout)
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-os2.ads gcc-4.1.0/gcc/ada/a-intnam-os2.ads
*** gcc-4.0.2/gcc/ada/a-intnam-os2.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-os2.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OS/2 version of this package.
  
  --  This target-dependent package spec contains names of interrupts
  --  supported by the local system.
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OS/2 version of this package
  
  --  This target-dependent package spec contains names of interrupts
  --  supported by the local system.
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-rtems.ads gcc-4.1.0/gcc/ada/a-intnam-rtems.ads
*** gcc-4.0.2/gcc/ada/a-intnam-rtems.ads	Thu Jan 27 20:18:26 2005
--- gcc-4.1.0/gcc/ada/a-intnam-rtems.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-solaris.ads gcc-4.1.0/gcc/ada/a-intnam-solaris.ads
*** gcc-4.0.2/gcc/ada/a-intnam-solaris.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-solaris.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --             Copyright (C) 1991-2002 Free Software Foundation, Inc.       --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,50 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a Solaris version of this package.
! --
  --  The following signals are reserved by the run time (native threads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGLWP, SIGWAITING, SIGCANCEL, SIGSTOP, SIGKILL
! --
  --  The following signals are reserved by the run time (FSU threads):
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGTERM, SIGABRT, SIGINT,
  --  SIGLWP, SIGALRM, SIGVTALRM, SIGAITING, SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handlers
  
  with System.OS_Interface;
--- 31,50 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a Solaris version of this package
! 
  --  The following signals are reserved by the run time (native threads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGLWP, SIGWAITING, SIGCANCEL, SIGSTOP, SIGKILL
! 
  --  The following signals are reserved by the run time (FSU threads):
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGTERM, SIGABRT, SIGINT,
  --  SIGLWP, SIGALRM, SIGVTALRM, SIGAITING, SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handlers
  
  with System.OS_Interface;
*************** with System.OS_Interface;
*** 52,61 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 52,60 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-tru64.ads gcc-4.1.0/gcc/ada/a-intnam-tru64.ads
*** gcc-4.0.2/gcc/ada/a-intnam-tru64.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-tru64.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,45 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix 4.0 version of this package.
! --
  --  The following signals are reserved by the run time:
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM,
  --  SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
--- 31,45 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix 4.0 version of this package
! 
  --  The following signals are reserved by the run time:
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM,
  --  SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
*************** with System.OS_Interface;
*** 47,56 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one.  There may be aliases.  Also, for all
!    --  signal names that are not supported on the current system
!    --  the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 47,55 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases. Also, for all signal names that are not supported on the
!    --  current system the value of the corresponding constant will be zero.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-unixware.ads gcc-4.1.0/gcc/ada/a-intnam-unixware.ads
*** gcc-4.0.2/gcc/ada/a-intnam-unixware.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-unixware.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,45 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a SCO UnixWare version of this package.
! --
  --  The following signals are reserved by the run time:
! --
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL
! --
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! --
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
--- 31,45 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a SCO UnixWare version of this package
! 
  --  The following signals are reserved by the run time:
! 
  --  SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT,
  --  SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL
! 
  --  The pragma Unreserve_All_Interrupts affects the following signal(s):
! 
  --  SIGINT: made available for Ada handler
  
  with System.OS_Interface;
*************** with System.OS_Interface;
*** 47,54 ****
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be
!    --  many-to-one. There may be aliases.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
--- 47,54 ----
  
  package Ada.Interrupts.Names is
  
!    --  Beware that the mapping of names to signals may be many-to-one. There
!    --  may be aliases.
  
     SIGHUP : constant Interrupt_ID :=
       System.OS_Interface.SIGHUP;      --  hangup
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-vms.ads gcc-4.1.0/gcc/ada/a-intnam-vms.ads
*** gcc-4.0.2/gcc/ada/a-intnam-vms.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-vms.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a OpenVMS/Alpha version of this package.
! --
  --  This target-dependent package spec contains names of interrupts
  --  supported by the local system.
  
--- 31,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a OpenVMS/Alpha version of this package
! 
  --  This target-dependent package spec contains names of interrupts
  --  supported by the local system.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam-vxworks.ads gcc-4.1.0/gcc/ada/a-intnam-vxworks.ads
*** gcc-4.0.2/gcc/ada/a-intnam-vxworks.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-intnam-vxworks.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1998-2001 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . I N T E R R U P T S . N A M E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VxWorks version of this package.
  
  with System.OS_Interface;
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VxWorks version of this package
  
  with System.OS_Interface;
  
*************** package Ada.Interrupts.Names is
*** 39,44 ****
  
     subtype Hardware_Interrupts is Interrupt_ID
       range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
!    --  Range of values that can be used for hardware interrupts.
  
  end Ada.Interrupts.Names;
--- 39,44 ----
  
     subtype Hardware_Interrupts is Interrupt_ID
       range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt;
!    --  Range of values that can be used for hardware interrupts
  
  end Ada.Interrupts.Names;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intnam.ads gcc-4.1.0/gcc/ada/a-intnam.ads
*** gcc-4.0.2/gcc/ada/a-intnam.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-intnam.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . N A M E S                  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . N A M E S                  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intsig.adb gcc-4.1.0/gcc/ada/a-intsig.adb
*** gcc-4.0.2/gcc/ada/a-intsig.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/a-intsig.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . S I G N A L                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2000-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . S I G N A L                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with System.Interrupt_Management.Operations;
+ 
  package body Ada.Interrupts.Signal is
  
     ------------------------
*************** package body Ada.Interrupts.Signal is
*** 43,46 ****
--- 44,48 ----
        System.Interrupt_Management.Operations.Interrupt_Self_Process
          (System.Interrupt_Management.Interrupt_ID (Interrupt));
     end Generate_Interrupt;
+ 
  end Ada.Interrupts.Signal;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-intsig.ads gcc-4.1.0/gcc/ada/a-intsig.ads
*** gcc-4.0.2/gcc/ada/a-intsig.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-intsig.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . S I G N A L                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 2000-2003 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 A D A . I N T E R R U P T S . S I G N A L                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,44 ****
  --  by user programs and avoids importing low level children of System
  --  (e.g. System.Interrupt_Management.Operations), or defining an interface
  --  to complex system calls.
! --
  package Ada.Interrupts.Signal is
  
     procedure Generate_Interrupt (Interrupt : Interrupt_ID);
!    --  Generate Interrupt at the process level
  
  end Ada.Interrupts.Signal;
--- 35,44 ----
  --  by user programs and avoids importing low level children of System
  --  (e.g. System.Interrupt_Management.Operations), or defining an interface
  --  to complex system calls.
! 
  package Ada.Interrupts.Signal is
  
     procedure Generate_Interrupt (Interrupt : Interrupt_ID);
!    --  Generate interrupt at the process level
  
  end Ada.Interrupts.Signal;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ioexce.ads gcc-4.1.0/gcc/ada/a-ioexce.ads
*** gcc-4.0.2/gcc/ada/a-ioexce.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-ioexce.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . I O _ E X C E P T I O N S                    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . I O _ E X C E P T I O N S                    --
  --                                                                          --
***************
*** 14,20 ****
  ------------------------------------------------------------------------------
  
  package Ada.IO_Exceptions is
! pragma Pure (IO_Exceptions);
  
     Status_Error : exception;
     Mode_Error   : exception;
--- 14,20 ----
  ------------------------------------------------------------------------------
  
  package Ada.IO_Exceptions is
!    pragma Pure;
  
     Status_Error : exception;
     Mode_Error   : exception;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-iwteio.ads gcc-4.1.0/gcc/ada/a-iwteio.ads
*** gcc-4.0.2/gcc/ada/a-iwteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-iwteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . I N T E G E R _ W I D E _ T E X T _ I O              --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . I N T E G E R _ W I D E _ T E X T _ I O              --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-lfteio.ads gcc-4.1.0/gcc/ada/a-lfteio.ads
*** gcc-4.0.2/gcc/ada/a-lfteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-lfteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . L O N G _ F L O A T _ T E X T _ I O                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . L O N G _ F L O A T _ T E X T _ I O                --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-lfwtio.ads gcc-4.1.0/gcc/ada/a-lfwtio.ads
*** gcc-4.0.2/gcc/ada/a-lfwtio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-lfwtio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . L O N G _ F L O A T _ W I D E _ T E X T _ I O           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . L O N G _ F L O A T _ W I D E _ T E X T _ I O           --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-lfztio.ads gcc-4.1.0/gcc/ada/a-lfztio.ads
*** gcc-4.0.2/gcc/ada/a-lfztio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-lfztio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . L O N G _ F L O A T _ W I D E _ W I D E _ T E X T _ I O      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . L O N G _ F L O A T _ W I D E _ W I D E _ T E X T _ I O      --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-liteio.ads gcc-4.1.0/gcc/ada/a-liteio.ads
*** gcc-4.0.2/gcc/ada/a-liteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-liteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . L O N G _ I N T E G E R _ T E X T _ I O              --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . L O N G _ I N T E G E R _ T E X T _ I O              --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-liwtio.ads gcc-4.1.0/gcc/ada/a-liwtio.ads
*** gcc-4.0.2/gcc/ada/a-liwtio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-liwtio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . L O N G _ I N T E G E R _ W I D E _ T E X T _ I O         --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . L O N G _ I N T E G E R _ W I D E _ T E X T _ I O         --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-liztio.ads gcc-4.1.0/gcc/ada/a-liztio.ads
*** gcc-4.0.2/gcc/ada/a-liztio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-liztio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . L O N G _ I N T E G E R _ W I D E _ W I D E _ T E X T _ I O    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . L O N G _ I N T E G E R _ W I D E _ W I D E _ T E X T _ I O    --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-llftio.ads gcc-4.1.0/gcc/ada/a-llftio.ads
*** gcc-4.0.2/gcc/ada/a-llftio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-llftio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . L O N G _ L O N G _ F L O A T _ T E X T _ I O           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . L O N G _ L O N G _ F L O A T _ T E X T _ I O           --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-llfwti.ads gcc-4.1.0/gcc/ada/a-llfwti.ads
*** gcc-4.0.2/gcc/ada/a-llfwti.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-llfwti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . L O N G _ L O N G _ F L O A T _ W I D E _ T E X T _ I O      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . L O N G _ L O N G _ F L O A T _ W I D E _ T E X T _ I O      --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-llfzti.ads gcc-4.1.0/gcc/ada/a-llfzti.ads
*** gcc-4.0.2/gcc/ada/a-llfzti.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-llfzti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --A D A . L O N G _ L O N G _ F L O A T _ W I D E _ W I D E _ T E X T _ I O --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --A D A . L O N G _ L O N G _ F L O A T _ W I D E _ W I D E _ T E X T _ I O --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-llitio.ads gcc-4.1.0/gcc/ada/a-llitio.ads
*** gcc-4.0.2/gcc/ada/a-llitio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-llitio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . L O N G _ L O N G _ I N T E G E R _ T E X T _ I O         --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . L O N G _ L O N G _ I N T E G E R _ T E X T _ I O         --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-lliwti.ads gcc-4.1.0/gcc/ada/a-lliwti.ads
*** gcc-4.0.2/gcc/ada/a-lliwti.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-lliwti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O    --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-llizti.ads gcc-4.1.0/gcc/ada/a-llizti.ads
*** gcc-4.0.2/gcc/ada/a-llizti.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-llizti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . L O N G _ L O N G _ I N T E G E R _ W I D E _ T E X T _ I O    --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ncelfu.ads gcc-4.1.0/gcc/ada/a-ncelfu.ads
*** gcc-4.0.2/gcc/ada/a-ncelfu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-ncelfu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX.ELEMENTARY_FUNCTIONS             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX.ELEMENTARY_FUNCTIONS             --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngcefu.adb gcc-4.1.0/gcc/ada/a-ngcefu.adb
*** gcc-4.0.2/gcc/ada/a-ngcefu.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-ngcefu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX_ELEMENTARY_FUNCTIONS             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX_ELEMENTARY_FUNCTIONS             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Numerics.Generic_Comple
*** 305,311 ****
        Result : Complex;
  
     begin
!       --  For very small argument, sin (x) = x.
  
        if abs Re (X) < Square_Root_Epsilon and then
           abs Im (X) < Square_Root_Epsilon
--- 305,311 ----
        Result : Complex;
  
     begin
!       --  For very small argument, sin (x) = x
  
        if abs Re (X) < Square_Root_Epsilon and then
           abs Im (X) < Square_Root_Epsilon
*************** package body Ada.Numerics.Generic_Comple
*** 642,648 ****
           end if;
        end if;
  
!       if Im (X) < 0.0 then                 -- halve angle, Sqrt of magnitude
           R_Y := -R_Y;
        end if;
        return Compose_From_Cartesian (R_X, R_Y);
--- 642,648 ----
           end if;
        end if;
  
!       if Im (X) < 0.0 then -- halve angle, Sqrt of magnitude
           R_Y := -R_Y;
        end if;
        return Compose_From_Cartesian (R_X, R_Y);
*************** package body Ada.Numerics.Generic_Comple
*** 650,656 ****
     exception
        when Constraint_Error =>
  
!          --  Rescale and try again.
  
           R := Modulus (Compose_From_Cartesian (Re (X / 4.0), Im (X / 4.0)));
           R_X := 2.0 * Sqrt (0.5 * R + 0.5 * Re (X / 4.0));
--- 650,656 ----
     exception
        when Constraint_Error =>
  
!          --  Rescale and try again
  
           R := Modulus (Compose_From_Cartesian (Re (X / 4.0), Im (X / 4.0)));
           R_X := 2.0 * Sqrt (0.5 * R + 0.5 * Re (X / 4.0));
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngcefu.ads gcc-4.1.0/gcc/ada/a-ngcefu.ads
*** gcc-4.0.2/gcc/ada/a-ngcefu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-ngcefu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX_ELEMENTARY_FUNCTIONS             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            ADA.NUMERICS.GENERIC_COMPLEX_ELEMENTARY_FUNCTIONS             --
  --                                                                          --
*************** generic
*** 19,25 ****
     use Complex_Types;
  
  package Ada.Numerics.Generic_Complex_Elementary_Functions is
!    pragma Pure (Ada.Numerics.Generic_Complex_Elementary_Functions);
  
     function Sqrt (X : Complex)   return Complex;
  
--- 19,25 ----
     use Complex_Types;
  
  package Ada.Numerics.Generic_Complex_Elementary_Functions is
!    pragma Pure;
  
     function Sqrt (X : Complex)   return Complex;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngcoty.adb gcc-4.1.0/gcc/ada/a-ngcoty.adb
*** gcc-4.0.2/gcc/ada/a-ngcoty.adb	Mon Mar 15 14:50:55 2004
--- gcc-4.1.0/gcc/ada/a-ngcoty.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . N U M E R I C S . G E N E R I C _ C O M P L E X _ T Y P E S    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . N U M E R I C S . G E N E R I C _ C O M P L E X _ T Y P E S    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with Ada.Numerics.Aux; use Ada.Numerics.Aux;
+ 
  package body Ada.Numerics.Generic_Complex_Types is
  
     subtype R is Real'Base;
*************** package body Ada.Numerics.Generic_Comple
*** 51,57 ****
        X := Left.Re * Right.Re - Left.Im * Right.Im;
        Y := Left.Re * Right.Im + Left.Im * Right.Re;
  
!       --  If either component overflows, try to scale.
  
        if abs (X) > R'Last then
           X := R'(4.0) * (R'(Left.Re / 2.0)  * R'(Right.Re / 2.0)
--- 52,58 ----
        X := Left.Re * Right.Re - Left.Im * Right.Im;
        Y := Left.Re * Right.Im + Left.Im * Right.Re;
  
!       --  If either component overflows, try to scale
  
        if abs (X) > R'Last then
           X := R'(4.0) * (R'(Left.Re / 2.0)  * R'(Right.Re / 2.0)
*************** package body Ada.Numerics.Generic_Comple
*** 626,632 ****
        elsif Im2 = 0.0 then
           return abs (X.Re);
  
!          --  in all other cases, the naive computation will do.
  
        else
           return R (Sqrt (Double (Re2 + Im2)));
--- 627,633 ----
        elsif Im2 = 0.0 then
           return abs (X.Re);
  
!       --  In all other cases, the naive computation will do
  
        else
           return R (Sqrt (Double (Re2 + Im2)));
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngcoty.ads gcc-4.1.0/gcc/ada/a-ngcoty.ads
*** gcc-4.0.2/gcc/ada/a-ngcoty.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-ngcoty.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 39,46 ****
     type Real is digits <>;
  
  package Ada.Numerics.Generic_Complex_Types is
! 
! pragma Pure (Generic_Complex_Types);
  
     type Complex is record
        Re, Im : Real'Base;
--- 39,45 ----
     type Real is digits <>;
  
  package Ada.Numerics.Generic_Complex_Types is
!    pragma Pure;
  
     type Complex is record
        Re, Im : Real'Base;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngelfu.adb gcc-4.1.0/gcc/ada/a-ngelfu.adb
*** gcc-4.0.2/gcc/ada/a-ngelfu.adb	Fri Jun 25 16:39:24 2004
--- gcc-4.1.0/gcc/ada/a-ngelfu.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ngelfu.ads gcc-4.1.0/gcc/ada/a-ngelfu.ads
*** gcc-4.0.2/gcc/ada/a-ngelfu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-ngelfu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS                 --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS                 --
  --                                                                          --
*************** generic
*** 17,23 ****
     type Float_Type is digits <>;
  
  package Ada.Numerics.Generic_Elementary_Functions is
! pragma Pure (Generic_Elementary_Functions);
  
     function Sqrt    (X           : Float_Type'Base) return Float_Type'Base;
     function Log     (X           : Float_Type'Base) return Float_Type'Base;
--- 17,23 ----
     type Float_Type is digits <>;
  
  package Ada.Numerics.Generic_Elementary_Functions is
!    pragma Pure;
  
     function Sqrt    (X           : Float_Type'Base) return Float_Type'Base;
     function Log     (X           : Float_Type'Base) return Float_Type'Base;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nlcefu.ads gcc-4.1.0/gcc/ada/a-nlcefu.ads
*** gcc-4.0.2/gcc/ada/a-nlcefu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nlcefu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              ADA.NUMERICS.LONG_COMPLEX.ELEMENTARY_FUNCTIONS              --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              ADA.NUMERICS.LONG_COMPLEX.ELEMENTARY_FUNCTIONS              --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nlcoty.ads gcc-4.1.0/gcc/ada/a-nlcoty.ads
*** gcc-4.0.2/gcc/ada/a-nlcoty.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nlcoty.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --       A D A . N U M E R I C S . L O N G _ C O M P L E X _ T Y P E S      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --       A D A . N U M E R I C S . L O N G _ C O M P L E X _ T Y P E S      --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nlelfu.ads gcc-4.1.0/gcc/ada/a-nlelfu.ads
*** gcc-4.0.2/gcc/ada/a-nlelfu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nlelfu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  ADA.NUMERICS.LONG_ELEMENTARY_FUNCTIONS                  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  ADA.NUMERICS.LONG_ELEMENTARY_FUNCTIONS                  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nllcef.ads gcc-4.1.0/gcc/ada/a-nllcef.ads
*** gcc-4.0.2/gcc/ada/a-nllcef.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nllcef.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           ADA.NUMERICS.LONG_LONG_COMPLEX.ELEMENTARY_FUNCTIONS            --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           ADA.NUMERICS.LONG_LONG_COMPLEX.ELEMENTARY_FUNCTIONS            --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nllcty.ads gcc-4.1.0/gcc/ada/a-nllcty.ads
*** gcc-4.0.2/gcc/ada/a-nllcty.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nllcty.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  -- A D A . N U M E R I C S . L O N G _ L O N G _ C O M P L E X _ T Y P E S  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  -- A D A . N U M E R I C S . L O N G _ L O N G _ C O M P L E X _ T Y P E S  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nllefu.ads gcc-4.1.0/gcc/ada/a-nllefu.ads
*** gcc-4.0.2/gcc/ada/a-nllefu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nllefu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               ADA.NUMERICS.LONG_LONG_ELEMENTARY_FUNCTIONS                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               ADA.NUMERICS.LONG_LONG_ELEMENTARY_FUNCTIONS                --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nscefu.ads gcc-4.1.0/gcc/ada/a-nscefu.ads
*** gcc-4.0.2/gcc/ada/a-nscefu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nscefu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              ADA.NUMERICS.SHORT.COMPLEX.ELEMENTARY_FUNCTIONS             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              ADA.NUMERICS.SHORT.COMPLEX.ELEMENTARY_FUNCTIONS             --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nscoty.ads gcc-4.1.0/gcc/ada/a-nscoty.ads
*** gcc-4.0.2/gcc/ada/a-nscoty.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nscoty.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . N U M E R I C S . S H O R T _ C O M P L E X _ T Y P E S     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . N U M E R I C S . S H O R T _ C O M P L E X _ T Y P E S     --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nselfu.ads gcc-4.1.0/gcc/ada/a-nselfu.ads
*** gcc-4.0.2/gcc/ada/a-nselfu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nselfu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 ADA.NUMERICS.SHORT_ELEMENTARY_FUNCTIONS                  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 ADA.NUMERICS.SHORT_ELEMENTARY_FUNCTIONS                  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nucoty.ads gcc-4.1.0/gcc/ada/a-nucoty.ads
*** gcc-4.0.2/gcc/ada/a-nucoty.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nucoty.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            A D A . N U M E R I C S . C O M P L E X _ T Y P E S           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            A D A . N U M E R I C S . C O M P L E X _ T Y P E S           --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nudira.adb gcc-4.1.0/gcc/ada/a-nudira.adb
*** gcc-4.0.2/gcc/ada/a-nudira.adb	Sun Apr 24 19:21:56 2005
--- gcc-4.1.0/gcc/ada/a-nudira.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . N U M E R I C S . D I S C R E T E _ R A N D O M          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . N U M E R I C S . D I S C R E T E _ R A N D O M          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with Ada.Calendar;
+ 
  with Interfaces; use Interfaces;
  
  package body Ada.Numerics.Discrete_Random is
*************** package body Ada.Numerics.Discrete_Rando
*** 201,207 ****
  
     procedure Reset (Gen : Generator; From_State : State) is
        Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
- 
     begin
        Genp.all := From_State;
     end Reset;
--- 202,207 ----
*************** package body Ada.Numerics.Discrete_Rando
*** 261,267 ****
        Outs.FP  := Flt (Outs.P);
        Outs.Scl := (RstL - RstF + 1.0) / (Flt (Outs.P) * Flt (Outs.Q));
  
!       --  Now do *some* sanity checks.
  
        if Outs.Q < 31
          or else Outs.X1 not in 2 .. Outs.P - 1
--- 261,267 ----
        Outs.FP  := Flt (Outs.P);
        Outs.Scl := (RstL - RstF + 1.0) / (Flt (Outs.P) * Flt (Outs.Q));
  
!       --  Now do *some* sanity checks
  
        if Outs.Q < 31
          or else Outs.X1 not in 2 .. Outs.P - 1
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nudira.ads gcc-4.1.0/gcc/ada/a-nudira.ads
*** gcc-4.0.2/gcc/ada/a-nudira.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-nudira.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,48 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Note: the implementation used in this package was contributed by
! --  Robert Eachus. It is based on the work of L. Blum, M. Blum, and
! --  M. Shub, SIAM Journal of Computing, Vol 15. No 2, May 1986. The
! --  particular choices for P and Q chosen here guarantee a period of
! --  562,085,314,430,582 (about 2**49), and the generated sequence has
! --  excellent randomness properties. For further details, see the
! --  paper "Fast Generation of Trustworthy Random Numbers", by Robert
! --  Eachus, which describes both the algorithm and the efficient
  --  implementation approach used here.
  
  with Interfaces;
--- 35,47 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Note: the implementation used in this package was contributed by Robert
! --  Eachus. It is based on the work of L. Blum, M. Blum, and M. Shub, SIAM
! --  Journal of Computing, Vol 15. No 2, May 1986. The particular choices for P
! --  and Q chosen here guarantee a period of 562,085,314,430,582 (about 2**49),
! --  and the generated sequence has excellent randomness properties. For further
! --  details, see the paper "Fast Generation of Trustworthy Random Numbers", by
! --  Robert Eachus, which describes both the algorithm and the efficient
  --  implementation approach used here.
  
  with Interfaces;
*************** generic
*** 52,67 ****
  
  package Ada.Numerics.Discrete_Random is
  
!    --  The algorithm used here is reliable from a required statistical point
!    --  of view only up to 48 bits. We try to behave reasonably in the case
!    --  of larger types, but we can't guarantee the required properties.
!    --  So generate a warning for these (slightly) dubious cases.
  
     pragma Compile_Time_Warning
       (Result_Subtype'Size > 48,
        "statistical properties not guaranteed for size '> 48");
  
!    --  Basic facilities.
  
     type Generator is limited private;
  
--- 51,66 ----
  
  package Ada.Numerics.Discrete_Random is
  
!    --  The algorithm used here is reliable from a required statistical point of
!    --  view only up to 48 bits. We try to behave reasonably in the case of
!    --  larger types, but we can't guarantee the required properties. So
!    --  generate a warning for these (slightly) dubious cases.
  
     pragma Compile_Time_Warning
       (Result_Subtype'Size > 48,
        "statistical properties not guaranteed for size '> 48");
  
!    --  Basic facilities
  
     type Generator is limited private;
  
*************** package Ada.Numerics.Discrete_Random is
*** 70,76 ****
     procedure Reset (Gen : Generator);
     procedure Reset (Gen : Generator; Initiator : Integer);
  
!    --  Advanced facilities.
  
     type State is private;
  
--- 69,75 ----
     procedure Reset (Gen : Generator);
     procedure Reset (Gen : Generator; Initiator : Integer);
  
!    --  Advanced facilities
  
     type State is private;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nuelfu.ads gcc-4.1.0/gcc/ada/a-nuelfu.ads
*** gcc-4.0.2/gcc/ada/a-nuelfu.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-nuelfu.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . N U M E R I C S . E L E M E N T A R Y _ F U N C T I O N S    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . N U M E R I C S . E L E M E N T A R Y _ F U N C T I O N S    --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nuflra.adb gcc-4.1.0/gcc/ada/a-nuflra.adb
*** gcc-4.0.2/gcc/ada/a-nuflra.adb	Sun Apr 24 19:21:56 2005
--- gcc-4.1.0/gcc/ada/a-nuflra.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            A D A . N U M E R I C S . F L O A T _ R A N D O M             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            A D A . N U M E R I C S . F L O A T _ R A N D O M             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Numerics.Float_Random i
*** 164,170 ****
        X1 := 2 + Int (Initiator) mod (K1 - 3);
        X2 := 2 + Int (Initiator) mod (K2 - 3);
  
!       --  Eliminate effects of small Initiators.
  
        for J in 1 .. 5 loop
           X1 := Square_Mod_N (X1, K1);
--- 164,170 ----
        X1 := 2 + Int (Initiator) mod (K1 - 3);
        X2 := 2 + Int (Initiator) mod (K2 - 3);
  
!       --  Eliminate effects of small initiators
  
        for J in 1 .. 5 loop
           X1 := Square_Mod_N (X1, K1);
*************** package body Ada.Numerics.Float_Random i
*** 299,305 ****
        Outs.X   := Euclid (Outs.P, Outs.Q);
        Outs.Scl := 1.0 / (Flt (Outs.P) * Flt (Outs.Q));
  
!       --  Now do *some* sanity checks.
  
        if Outs.Q < 31 or else Outs.P < 31
          or else Outs.X1 not in 2 .. Outs.P - 1
--- 299,305 ----
        Outs.X   := Euclid (Outs.P, Outs.Q);
        Outs.Scl := 1.0 / (Flt (Outs.P) * Flt (Outs.Q));
  
!       --  Now do *some* sanity checks
  
        if Outs.Q < 31 or else Outs.P < 31
          or else Outs.X1 not in 2 .. Outs.P - 1
diff -Nrcpad gcc-4.0.2/gcc/ada/a-nuflra.ads gcc-4.1.0/gcc/ada/a-nuflra.ads
*** gcc-4.0.2/gcc/ada/a-nuflra.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-nuflra.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-darwin.adb gcc-4.1.0/gcc/ada/a-numaux-darwin.adb
*** gcc-4.0.2/gcc/ada/a-numaux-darwin.adb	Mon Jan  3 15:34:18 2005
--- gcc-4.1.0/gcc/ada/a-numaux-darwin.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                          (Apple OS X Version)                            --
  --                                                                          --
! --          Copyright (C) 1998-2004 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                          (Apple OS X Version)                            --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  File a-numaux.adb <- a-numaux-darwin.adb
  
  package body Ada.Numerics.Aux is
  
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  File a-numaux.adb <- a-numaux-d arwin.adb
  
  package body Ada.Numerics.Aux is
  
*************** package body Ada.Numerics.Aux is
*** 95,101 ****
        P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3
                                                                   - P4, HM);
        P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
!       K  : Double := X * Two_Over_Pi;
     begin
        --  For X < 2.0**HM, all products below are computed exactly.
        --  Due to cancellation effects all subtractions are exact as well.
--- 95,102 ----
        P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3
                                                                   - P4, HM);
        P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
!       K  : Double;
! 
     begin
        --  For X < 2.0**HM, all products below are computed exactly.
        --  Due to cancellation effects all subtractions are exact as well.
*************** package body Ada.Numerics.Aux is
*** 103,119 ****
        --  zeros after the binary point, the result will be the correctly
        --  rounded result of X - K * (Pi / 2.0).
  
!       while abs K >= 2.0**HM loop
           K := K * M - (K * M - K);
!          X := (((((X - K * P1) - K * P2) - K * P3)
!                      - K * P4) - K * P5) - K * P6;
           K := X * Two_Over_Pi;
        end loop;
  
!       if K /= K then
! 
!          --  K is not a number, because X was not finite
  
           raise Constraint_Error;
        end if;
  
--- 104,120 ----
        --  zeros after the binary point, the result will be the correctly
        --  rounded result of X - K * (Pi / 2.0).
  
!       K := X * Two_Over_Pi;
!       while abs K >= 2.0 ** HM loop
           K := K * M - (K * M - K);
!          X :=
!            (((((X - K * P1) - K * P2) - K * P3) - K * P4) - K * P5) - K * P6;
           K := X * Two_Over_Pi;
        end loop;
  
!       --  If K is not a number (because X was not finite) raise exception
  
+       if K /= K then
           raise Constraint_Error;
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-darwin.ads gcc-4.1.0/gcc/ada/a-numaux-darwin.ads
*** gcc-4.0.2/gcc/ada/a-numaux-darwin.ads	Mon Jan  3 15:34:18 2005
--- gcc-4.1.0/gcc/ada/a-numaux-darwin.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                          (Apple OS X Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                          (Apple OS X Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  --  routines that take 80-bit arguments).
  
  package Ada.Numerics.Aux is
! pragma Pure (Aux);
  
     pragma Linker_Options ("-lm");
  
--- 41,47 ----
  --  routines that take 80-bit arguments).
  
  package Ada.Numerics.Aux is
!    pragma Pure;
  
     pragma Linker_Options ("-lm");
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-libc-x86.ads gcc-4.1.0/gcc/ada/a-numaux-libc-x86.ads
*** gcc-4.0.2/gcc/ada/a-numaux-libc-x86.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-numaux-libc-x86.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version for x86)                        --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version for x86)                        --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,50 ****
  --  double (see file a-numaux.ads).
  
  package Ada.Numerics.Aux is
! pragma Pure (Aux);
  
     pragma Linker_Options ("-lm");
  
--- 44,50 ----
  --  double (see file a-numaux.ads).
  
  package Ada.Numerics.Aux is
!    pragma Pure;
  
     pragma Linker_Options ("-lm");
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-vxworks.ads gcc-4.1.0/gcc/ada/a-numaux-vxworks.ads
*** gcc-4.0.2/gcc/ada/a-numaux-vxworks.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-numaux-vxworks.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version, VxWorks)                       --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version, VxWorks)                       --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,50 ****
  --  long double (see file 4onumaux.ads).
  
  package Ada.Numerics.Aux is
! pragma Pure (Aux);
  
     --  This version omits the pragma linker_options ("-lm") since there is
     --  no libm.a library for VxWorks.
--- 44,50 ----
  --  long double (see file 4onumaux.ads).
  
  package Ada.Numerics.Aux is
!    pragma Pure;
  
     --  This version omits the pragma linker_options ("-lm") since there is
     --  no libm.a library for VxWorks.
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-x86.adb gcc-4.1.0/gcc/ada/a-numaux-x86.adb
*** gcc-4.0.2/gcc/ada/a-numaux-x86.adb	Mon Nov  8 14:03:44 2004
--- gcc-4.1.0/gcc/ada/a-numaux-x86.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                        (Machine Version for x86)                         --
  --                                                                          --
! --          Copyright (C) 1998-2004 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                        (Machine Version for x86)                         --
  --                                                                          --
! --          Copyright (C) 1998-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux-x86.ads gcc-4.1.0/gcc/ada/a-numaux-x86.ads
*** gcc-4.0.2/gcc/ada/a-numaux-x86.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-numaux-x86.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                        (Machine Version for x86)                         --
  --                                                                          --
! --          Copyright (C) 1992-1998 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                        (Machine Version for x86)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  --  routines directly.
  
  package Ada.Numerics.Aux is
! pragma Pure (Aux);
  
     type Double is new Long_Long_Float;
  
--- 42,48 ----
  --  routines directly.
  
  package Ada.Numerics.Aux is
!    pragma Pure;
  
     type Double is new Long_Long_Float;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numaux.ads gcc-4.1.0/gcc/ada/a-numaux.ads
*** gcc-4.0.2/gcc/ada/a-numaux.ads	Mon Jan  5 15:20:43 2004
--- gcc-4.1.0/gcc/ada/a-numaux.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version, non-x86)                       --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . N U M E R I C S . A U X                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                       (C Library Version, non-x86)                       --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 46,52 ****
  --  routines that take 80-bit arguments).
  
  package Ada.Numerics.Aux is
! pragma Pure (Aux);
  
     pragma Linker_Options ("-lm");
  
--- 46,52 ----
  --  routines that take 80-bit arguments).
  
  package Ada.Numerics.Aux is
!    pragma Pure;
  
     pragma Linker_Options ("-lm");
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-numeri.ads gcc-4.1.0/gcc/ada/a-numeri.ads
*** gcc-4.0.2/gcc/ada/a-numeri.ads	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/a-numeri.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         A D A . N U M E R I C S                          --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         A D A . N U M E R I C S                          --
  --                                                                          --
***************
*** 13,21 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  package Ada.Numerics is
! pragma Pure (Numerics);
  
     Argument_Error : exception;
  
--- 13,20 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package Ada.Numerics is
!    pragma Pure;
  
     Argument_Error : exception;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-rbtgso.adb gcc-4.1.0/gcc/ada/a-rbtgso.adb
*** gcc-4.0.2/gcc/ada/a-rbtgso.adb	Wed Feb  9 11:14:39 2005
--- gcc-4.1.0/gcc/ada/a-rbtgso.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --          ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_SET_OPERATIONS           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,13 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --       A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .      --
! --               G E N E R I C _ S E T _ O P E R A T I O N S                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,40 ****
--- 34,90 ----
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
+ with System; use type System.Address;
+ 
  package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
  
+    -----------------------
+    -- Local Subprograms --
+    -----------------------
+ 
+    procedure Clear (Tree : in out Tree_Type);
+ 
+    function Copy (Source : Tree_Type) return Tree_Type;
+ 
+    -----------
+    -- Clear --
+    -----------
+ 
+    procedure Clear (Tree : in out Tree_Type) is
+       pragma Assert (Tree.Busy = 0);
+       pragma Assert (Tree.Lock = 0);
+ 
+       Root : Node_Access := Tree.Root;
+ 
+    begin
+       Tree.Root := null;
+       Tree.First := null;
+       Tree.Last := null;
+       Tree.Length := 0;
+ 
+       Delete_Tree (Root);
+    end Clear;
+ 
+    ----------
+    -- Copy --
+    ----------
+ 
+    function Copy (Source : Tree_Type) return Tree_Type is
+       Target : Tree_Type;
+ 
+    begin
+       if Source.Length = 0 then
+          return Target;
+       end if;
+ 
+       Target.Root := Copy_Tree (Source.Root);
+       Target.First := Tree_Operations.Min (Target.Root);
+       Target.Last := Tree_Operations.Max (Target.Root);
+       Target.Length := Source.Length;
+ 
+       return Target;
+    end Copy;
+ 
     ----------------
     -- Difference --
     ----------------
*************** package body Ada.Containers.Red_Black_Tr
*** 44,62 ****
        Src : Node_Access := Source.First;
  
     begin
  
!       --  NOTE: must be done by client:
!       --      if Target'Address = Source'Address then
!       --         Clear (Target);
!       --         return;
!       --      end if;
  
        loop
!          if Tgt = Tree_Operations.Null_Node then
              return;
           end if;
  
!          if Src = Tree_Operations.Null_Node then
              return;
           end if;
  
--- 94,122 ----
        Src : Node_Access := Source.First;
  
     begin
+       if Target'Address = Source'Address then
+          if Target.Busy > 0 then
+             raise Program_Error;
+          end if;
  
!          Clear (Target);
!          return;
!       end if;
! 
!       if Source.Length = 0 then
!          return;
!       end if;
! 
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
  
        loop
!          if Tgt = null then
              return;
           end if;
  
!          if Src = null then
              return;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 81,87 ****
     end Difference;
  
     function Difference (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
--- 141,147 ----
     end Difference;
  
     function Difference (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type;
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
*************** package body Ada.Containers.Red_Black_Tr
*** 89,109 ****
        Dst_Node : Node_Access;
  
     begin
!       --  NOTE: must by done by client:
!       --      if Left'Address = Right'Address then
!       --         return Empty_Set;
!       --      end if;
  
        loop
!          if L_Node = Tree_Operations.Null_Node then
              return Tree;
           end if;
  
!          if R_Node = Tree_Operations.Null_Node then
!             while L_Node /= Tree_Operations.Null_Node loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => Tree_Operations.Null_Node,
                    Src_Node => L_Node,
                    Dst_Node => Dst_Node);
  
--- 149,176 ----
        Dst_Node : Node_Access;
  
     begin
!       if Left'Address = Right'Address then
!          return Tree;  -- Empty set
!       end if;
! 
!       if Left.Length = 0 then
!          return Tree;  -- Empty set
!       end if;
! 
!       if Right.Length = 0 then
!          return Copy (Left);
!       end if;
  
        loop
!          if L_Node = null then
              return Tree;
           end if;
  
!          if R_Node = null then
!             while L_Node /= null loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => null,
                    Src_Node => L_Node,
                    Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 117,123 ****
           if Is_Less (L_Node, R_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => Tree_Operations.Null_Node,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
--- 184,190 ----
           if Is_Less (L_Node, R_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => null,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 150,162 ****
        Src : Node_Access := Source.First;
  
     begin
!       --  NOTE: must be done by caller: ???
!       --      if Target'Address = Source'Address then
!       --         return;
!       --      end if;
  
!       while Tgt /= Tree_Operations.Null_Node
!         and then Src /= Tree_Operations.Null_Node
        loop
           if Is_Less (Tgt, Src) then
              declare
--- 217,237 ----
        Src : Node_Access := Source.First;
  
     begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
  
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       if Source.Length = 0 then
!          Clear (Target);
!          return;
!       end if;
! 
!       while Tgt /= null
!         and then Src /= null
        loop
           if Is_Less (Tgt, Src) then
              declare
*************** package body Ada.Containers.Red_Black_Tr
*** 175,184 ****
              Src := Tree_Operations.Next (Src);
           end if;
        end loop;
     end Intersection;
  
     function Intersection (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
--- 250,269 ----
              Src := Tree_Operations.Next (Src);
           end if;
        end loop;
+ 
+       while Tgt /= null loop
+          declare
+             X : Node_Access := Tgt;
+          begin
+             Tgt := Tree_Operations.Next (Tgt);
+             Tree_Operations.Delete_Node_Sans_Free (Target, X);
+             Free (X);
+          end;
+       end loop;
     end Intersection;
  
     function Intersection (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type;
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
*************** package body Ada.Containers.Red_Black_Tr
*** 186,202 ****
        Dst_Node : Node_Access;
  
     begin
!       --  NOTE: must be done by caller: ???
!       --      if Left'Address = Right'Address then
!       --         return Left;
!       --      end if;
  
        loop
!          if L_Node = Tree_Operations.Null_Node then
              return Tree;
           end if;
  
!          if R_Node = Tree_Operations.Null_Node then
              return Tree;
           end if;
  
--- 271,286 ----
        Dst_Node : Node_Access;
  
     begin
!       if Left'Address = Right'Address then
!          return Copy (Left);
!       end if;
  
        loop
!          if L_Node = null then
              return Tree;
           end if;
  
!          if R_Node = null then
              return Tree;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 209,215 ****
           else
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => Tree_Operations.Null_Node,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
--- 293,299 ----
           else
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => null,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 233,242 ****
        Of_Set : Tree_Type) return Boolean
     is
     begin
!       --  NOTE: must by done by caller:
!       --      if Subset'Address = Of_Set'Address then
!       --         return True;
!       --      end if;
  
        if Subset.Length > Of_Set.Length then
           return False;
--- 317,325 ----
        Of_Set : Tree_Type) return Boolean
     is
     begin
!       if Subset'Address = Of_Set'Address then
!          return True;
!       end if;
  
        if Subset.Length > Of_Set.Length then
           return False;
*************** package body Ada.Containers.Red_Black_Tr
*** 244,258 ****
  
        declare
           Subset_Node : Node_Access := Subset.First;
!          Set_Node : Node_Access := Of_Set.First;
  
        begin
           loop
!             if Set_Node = Tree_Operations.Null_Node then
!                return Subset_Node = Tree_Operations.Null_Node;
              end if;
  
!             if Subset_Node = Tree_Operations.Null_Node then
                 return True;
              end if;
  
--- 327,341 ----
  
        declare
           Subset_Node : Node_Access := Subset.First;
!          Set_Node    : Node_Access := Of_Set.First;
  
        begin
           loop
!             if Set_Node = null then
!                return Subset_Node = null;
              end if;
  
!             if Subset_Node = null then
                 return True;
              end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 279,292 ****
        R_Node : Node_Access := Right.First;
  
     begin
!       --  NOTE: must be done by caller: ???
!       --      if Left'Address = Right'Address then
!       --         return Left.Tree.Length /= 0;
!       --      end if;
  
        loop
!          if L_Node = Tree_Operations.Null_Node
!            or else R_Node = Tree_Operations.Null_Node
           then
              return False;
           end if;
--- 362,374 ----
        R_Node : Node_Access := Right.First;
  
     begin
!       if Left'Address = Right'Address then
!          return Left.Length /= 0;
!       end if;
  
        loop
!          if L_Node = null
!            or else R_Node = null
           then
              return False;
           end if;
*************** package body Ada.Containers.Red_Black_Tr
*** 317,334 ****
        New_Tgt_Node : Node_Access;
  
     begin
!       --  NOTE: must by done by client: ???
!       --      if Target'Address = Source'Address then
!       --         Clear (Target);
!       --         return;
!       --      end if;
  
        loop
!          if Tgt = Tree_Operations.Null_Node then
!             while Src /= Tree_Operations.Null_Node loop
                 Insert_With_Hint
                   (Dst_Tree => Target,
!                   Dst_Hint => Tree_Operations.Null_Node,
                    Src_Node => Src,
                    Dst_Node => New_Tgt_Node);
  
--- 399,419 ----
        New_Tgt_Node : Node_Access;
  
     begin
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
! 
!       if Target'Address = Source'Address then
!          Clear (Target);
!          return;
!       end if;
  
        loop
!          if Tgt = null then
!             while Src /= null loop
                 Insert_With_Hint
                   (Dst_Tree => Target,
!                   Dst_Hint => null,
                    Src_Node => Src,
                    Dst_Node => New_Tgt_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 338,344 ****
              return;
           end if;
  
!          if Src = Tree_Operations.Null_Node then
              return;
           end if;
  
--- 423,429 ----
              return;
           end if;
  
!          if Src = null then
              return;
           end if;
  
*************** package body Ada.Containers.Red_Black_Tr
*** 369,375 ****
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
--- 454,460 ----
     end Symmetric_Difference;
  
     function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
!       Tree : Tree_Type;
  
        L_Node : Node_Access := Left.First;
        R_Node : Node_Access := Right.First;
*************** package body Ada.Containers.Red_Black_Tr
*** 377,393 ****
        Dst_Node : Node_Access;
  
     begin
!       --  NOTE: must by done by caller ???
!       --      if Left'Address = Right'Address then
!       --         return Empty_Set;
!       --      end if;
  
        loop
!          if L_Node = Tree_Operations.Null_Node then
!             while R_Node /= Tree_Operations.Null_Node loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => Tree_Operations.Null_Node,
                    Src_Node => R_Node,
                    Dst_Node => Dst_Node);
                 R_Node := Tree_Operations.Next (R_Node);
--- 462,485 ----
        Dst_Node : Node_Access;
  
     begin
!       if Left'Address = Right'Address then
!          return Tree;  -- Empty set
!       end if;
! 
!       if Right.Length = 0 then
!          return Copy (Left);
!       end if;
! 
!       if Left.Length = 0 then
!          return Copy (Right);
!       end if;
  
        loop
!          if L_Node = null then
!             while R_Node /= null loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => null,
                    Src_Node => R_Node,
                    Dst_Node => Dst_Node);
                 R_Node := Tree_Operations.Next (R_Node);
*************** package body Ada.Containers.Red_Black_Tr
*** 396,406 ****
              return Tree;
           end if;
  
!          if R_Node = Tree_Operations.Null_Node then
!             while L_Node /= Tree_Operations.Null_Node loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => Tree_Operations.Null_Node,
                    Src_Node => L_Node,
                    Dst_Node => Dst_Node);
  
--- 488,498 ----
              return Tree;
           end if;
  
!          if R_Node = null then
!             while L_Node /= null loop
                 Insert_With_Hint
                   (Dst_Tree => Tree,
!                   Dst_Hint => null,
                    Src_Node => L_Node,
                    Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 413,419 ****
           if Is_Less (L_Node, R_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => Tree_Operations.Null_Node,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
--- 505,511 ----
           if Is_Less (L_Node, R_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => null,
                 Src_Node => L_Node,
                 Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 422,428 ****
           elsif Is_Less (R_Node, L_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => Tree_Operations.Null_Node,
                 Src_Node => R_Node,
                 Dst_Node => Dst_Node);
  
--- 514,520 ----
           elsif Is_Less (R_Node, L_Node) then
              Insert_With_Hint
                (Dst_Tree => Tree,
!                Dst_Hint => null,
                 Src_Node => R_Node,
                 Dst_Node => Dst_Node);
  
*************** package body Ada.Containers.Red_Black_Tr
*** 469,501 ****
     --  Start of processing for Union
  
     begin
!       --  NOTE: must be done by caller: ???
!       --      if Target'Address = Source'Address then
!       --         return;
!       --      end if;
  
        Iterate (Source);
     end Union;
  
     function Union (Left, Right : Tree_Type) return Tree_Type is
-       Tree : Tree_Type;
- 
     begin
!       --  NOTE: must be done by caller:
!       --      if Left'Address = Right'Address then
!       --         return Left;
!       --      end if;
  
!       declare
!          Root : constant Node_Access := Copy_Tree (Left.Root);
!       begin
!          Tree := (Root   => Root,
!                   First  => Tree_Operations.Min (Root),
!                   Last   => Tree_Operations.Max (Root),
!                   Length => Left.Length);
!       end;
  
        declare
           Hint : Node_Access;
  
           procedure Process (Node : Node_Access);
--- 561,594 ----
     --  Start of processing for Union
  
     begin
!       if Target'Address = Source'Address then
!          return;
!       end if;
! 
!       if Target.Busy > 0 then
!          raise Program_Error;
!       end if;
  
        Iterate (Source);
     end Union;
  
     function Union (Left, Right : Tree_Type) return Tree_Type is
     begin
!       if Left'Address = Right'Address then
!          return Copy (Left);
!       end if;
  
!       if Left.Length = 0 then
!          return Copy (Right);
!       end if;
! 
!       if Right.Length = 0 then
!          return Copy (Left);
!       end if;
  
        declare
+          Tree : Tree_Type := Copy (Left);
+ 
           Hint : Node_Access;
  
           procedure Process (Node : Node_Access);
*************** package body Ada.Containers.Red_Black_Tr
*** 521,526 ****
--- 614,620 ----
  
        begin
           Iterate (Right);
+          return Tree;
  
        exception
           when others =>
*************** package body Ada.Containers.Red_Black_Tr
*** 528,534 ****
              raise;
        end;
  
-       return Tree;
     end Union;
  
  end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
--- 622,627 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-rbtgso.ads gcc-4.1.0/gcc/ada/a-rbtgso.ads
*** gcc-4.0.2/gcc/ada/a-rbtgso.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-rbtgso.ads	Mon Sep  5 07:51:25 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --          ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_SET_OPERATIONS           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,9 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --       A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S .      --
! --               G E N E R I C _ S E T _ O P E R A T I O N S                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
*************** generic
*** 36,42 ****
     with procedure Free (X : in out Node_Access);
  
  package Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
! pragma Pure (Generic_Set_Operations);
  
     procedure Union (Target : in out Tree_Type; Source : Tree_Type);
  
--- 37,43 ----
     with procedure Free (X : in out Node_Access);
  
  package Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
!    pragma Pure;
  
     procedure Union (Target : in out Tree_Type; Source : Tree_Type);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-reatim.adb gcc-4.1.0/gcc/ada/a-reatim.adb
*** gcc-4.0.2/gcc/ada/a-reatim.adb	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-reatim.adb	Mon Sep  5 07:51:25 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                         A D A . R E A L _ T I M E                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                         A D A . R E A L _ T I M E                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Real_Time is
*** 154,159 ****
--- 154,168 ----
        return Time_Span_Unit * MS * 1_000_000;
     end Milliseconds;
  
+    -------------
+    -- Minutes --
+    -------------
+ 
+    function Minutes (M : Integer) return Time_Span is
+    begin
+       return Milliseconds (M) * Integer'(60_000);
+    end Minutes;
+ 
     -----------------
     -- Nanoseconds --
     -----------------
*************** package body Ada.Real_Time is
*** 163,168 ****
--- 172,186 ----
        return Time_Span_Unit * NS;
     end Nanoseconds;
  
+    -------------
+    -- Seconds --
+    -------------
+ 
+    function Seconds (S : Integer) return Time_Span is
+    begin
+       return Milliseconds (S) * Integer'(1000);
+    end Seconds;
+ 
     -----------
     -- Split --
     -----------
*************** package body Ada.Real_Time is
*** 180,186 ****
           T_Val := abs (T);
        end if;
  
!       --  Extract the integer part of T, truncating towards zero.
  
        if T_Val < 0.5 then
           SC := 0;
--- 198,204 ----
           T_Val := abs (T);
        end if;
  
!       --  Extract the integer part of T, truncating towards zero
  
        if T_Val < 0.5 then
           SC := 0;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-reatim.ads gcc-4.1.0/gcc/ada/a-reatim.ads
*** gcc-4.0.2/gcc/ada/a-reatim.ads	Tue Oct 21 13:41:53 2003
--- gcc-4.1.0/gcc/ada/a-reatim.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Ada.Real_Time is
*** 86,91 ****
--- 86,97 ----
     function Microseconds (US : Integer) return Time_Span;
     function Milliseconds (MS : Integer) return Time_Span;
  
+    function Seconds (S : Integer) return Time_Span;
+    pragma Ada_05 (Seconds);
+ 
+    function Minutes (M : Integer) return Time_Span;
+    pragma Ada_05 (Minutes);
+ 
     --  Seconds_Count needs 64 bits, since Time has the full range of
     --  Duration. The delta of Duration is 10 ** (-9), so the maximum
     --  number of seconds is 2**63/10**9 = 8*10**9 which does not quite
*************** private
*** 126,129 ****
--- 132,141 ----
     pragma Import (Intrinsic, ">=");
     pragma Import (Intrinsic, "abs");
  
+    pragma Inline (Microseconds);
+    pragma Inline (Milliseconds);
+    pragma Inline (Nanoseconds);
+    pragma Inline (Seconds);
+    pragma Inline (Minutes);
+ 
  end Ada.Real_Time;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-retide.adb gcc-4.1.0/gcc/ada/a-retide.adb
*** gcc-4.0.2/gcc/ada/a-retide.adb	Mon Sep 13 10:18:38 2004
--- gcc-4.1.0/gcc/ada/a-retide.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   A D A . R E A L _ T I M E . D E L A Y S                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . R E A L _ T I M E . D E L A Y S                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-retide.ads gcc-4.1.0/gcc/ada/a-retide.ads
*** gcc-4.0.2/gcc/ada/a-retide.ads	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-retide.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   A D A . R E A L _ T I M E . D E L A Y S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   A D A . R E A L _ T I M E . D E L A Y S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,49 ****
  package Ada.Real_Time.Delays is
  
     function To_Duration (T : Real_Time.Time) return Duration;
  
     procedure Delay_Until (T : Time);
     --  Delay until Clock has reached (at least) time T,
     --  or the task is aborted to at least the current ATC nesting level.
     --  The body of this procedure must perform all the processing
!    --  required for an abortion point.
  
  end Ada.Real_Time.Delays;
--- 39,50 ----
  package Ada.Real_Time.Delays is
  
     function To_Duration (T : Real_Time.Time) return Duration;
+    --  Convert Time to Duration
  
     procedure Delay_Until (T : Time);
     --  Delay until Clock has reached (at least) time T,
     --  or the task is aborted to at least the current ATC nesting level.
     --  The body of this procedure must perform all the processing
!    --  required for an abort point.
  
  end Ada.Real_Time.Delays;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-secain.adb gcc-4.1.0/gcc/ada/a-secain.adb
*** gcc-4.0.2/gcc/ada/a-secain.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-secain.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.STRINGS.EQUAL_CASE_INSENSITIVE                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --   A D A . S T R I N G S . E Q U A L _ C A S E _ I N S E N S I T I V E    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** begin
*** 63,70 ****
        RI := RI + 1;
     end loop;
  end Ada.Strings.Equal_Case_Insensitive;
- 
- 
- 
- 
- 
--- 63,65 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-secain.ads gcc-4.1.0/gcc/ada/a-secain.ads
*** gcc-4.0.2/gcc/ada/a-secain.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-secain.ads	Thu Jun 16 08:26:28 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.STRINGS.EQUAL_CASE_INSENSITIVE                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --   A D A . S T R I N G S . E Q U A L _ C A S E _ I N S E N S I T I V E    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
*************** function Ada.Strings.Equal_Case_Insensit
*** 17,20 ****
    (Left, Right : String) return Boolean;
  
  pragma Pure (Ada.Strings.Equal_Case_Insensitive);
- 
--- 17,19 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sequio.adb gcc-4.1.0/gcc/ada/a-sequio.adb
*** gcc-4.0.2/gcc/ada/a-sequio.adb	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/a-sequio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                    A D A . S E Q U E N T I A L _ I O                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                    A D A . S E Q U E N T I A L _ I O                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sequio.ads gcc-4.1.0/gcc/ada/a-sequio.ads
*** gcc-4.0.2/gcc/ada/a-sequio.ads	Thu Jul 15 20:34:34 2004
--- gcc-4.1.0/gcc/ada/a-sequio.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                    A D A . S E Q U E N T I A L _ I O                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                    A D A . S E Q U E N T I A L _ I O                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  with Ada.IO_Exceptions;
  with System.Sequential_IO;
  
  generic
--- 35,42 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with Ada.IO_Exceptions;
+ 
  with System.Sequential_IO;
  
  generic
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sfteio.ads gcc-4.1.0/gcc/ada/a-sfteio.ads
*** gcc-4.0.2/gcc/ada/a-sfteio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-sfteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . S H O R T _ F L O A T _ T E X T _ I O               --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . S H O R T _ F L O A T _ T E X T _ I O               --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sfwtio.ads gcc-4.1.0/gcc/ada/a-sfwtio.ads
*** gcc-4.0.2/gcc/ada/a-sfwtio.ads	Thu Apr 24 17:53:53 2003
--- gcc-4.1.0/gcc/ada/a-sfwtio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . S H O R T _ F L O A T _ W I D E _ T E X T _ I O          --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . S H O R T _ F L O A T _ W I D E _ T E X T _ I O          --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sfztio.ads gcc-4.1.0/gcc/ada/a-sfztio.ads
*** gcc-4.0.2/gcc/ada/a-sfztio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-sfztio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . S H O R T _ F L O A T _ W I D E _ W I D E _ T E X T _ I O     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . S H O R T _ F L O A T _ W I D E _ W I D E _ T E X T _ I O     --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-shcain.adb gcc-4.1.0/gcc/ada/a-shcain.adb
*** gcc-4.0.2/gcc/ada/a-shcain.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-shcain.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.STRINGS.HASH_CASE_INSENSITIVE                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . S T R I N G S . H A S H _ C A S E _ I N S E N S I T I V E     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Handling;  use Ada.Characters.Handling;
  
  --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
  
--- 33,39 ----
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Handling; use Ada.Characters.Handling;
  
  --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
  
*************** is
*** 52,68 ****
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 1) + Character'Pos (To_Lower (Key (J)));
     end loop;
  
     return Tmp;
  end Ada.Strings.Hash_Case_Insensitive;
- 
- 
- 
- 
- 
- 
- 
- 
- 
--- 52,59 ----
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 3) + Character'Pos (To_Lower (Key (J)));
     end loop;
  
     return Tmp;
  end Ada.Strings.Hash_Case_Insensitive;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-shcain.ads gcc-4.1.0/gcc/ada/a-shcain.ads
*** gcc-4.0.2/gcc/ada/a-shcain.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-shcain.ads	Thu Jun 16 08:56:24 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                    ADA.STRINGS.HASH_CASE_INSENSITIVE                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --    A D A . S T R I N G S . H A S H _ C A S E _ I N S E N S I T I V E     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-siocst.adb gcc-4.1.0/gcc/ada/a-siocst.adb
*** gcc-4.0.2/gcc/ada/a-siocst.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-siocst.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-siocst.ads gcc-4.1.0/gcc/ada/a-siocst.ads
*** gcc-4.0.2/gcc/ada/a-siocst.ads	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-siocst.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . S E Q U E N T I A L _ I O . C _ S T R E A M S           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . S E Q U E N T I A L _ I O . C _ S T R E A M S           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-siteio.ads gcc-4.1.0/gcc/ada/a-siteio.ads
*** gcc-4.0.2/gcc/ada/a-siteio.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-siteio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            A D A . S H O R T _ I N T E G E R _ T E X T _ I O             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            A D A . S H O R T _ I N T E G E R _ T E X T _ I O             --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-siwtio.ads gcc-4.1.0/gcc/ada/a-siwtio.ads
*** gcc-4.0.2/gcc/ada/a-siwtio.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-siwtio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --       A D A . S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O        --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --       A D A . S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O        --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-siztio.ads gcc-4.1.0/gcc/ada/a-siztio.ads
*** gcc-4.0.2/gcc/ada/a-siztio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-siztio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --  A D A . S H O R T _ I N T E G E R _ W I D E _ W I D E _ T E X T _ I O   --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --  A D A . S H O R T _ I N T E G E R _ W I D E _ W I D E _ T E X T _ I O   --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-slcain.adb gcc-4.1.0/gcc/ada/a-slcain.adb
*** gcc-4.0.2/gcc/ada/a-slcain.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-slcain.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Handling;  use Ada.Characters.Handling;
  
  function Ada.Strings.Less_Case_Insensitive
    (Left, Right : String) return Boolean
--- 33,39 ----
  -- This unit was originally developed by Matthew J Heaney.                  --
  ------------------------------------------------------------------------------
  
! with Ada.Characters.Handling; use Ada.Characters.Handling;
  
  function Ada.Strings.Less_Case_Insensitive
    (Left, Right : String) return Boolean
*************** begin
*** 76,80 ****
        RI := RI + 1;
     end loop;
  end Ada.Strings.Less_Case_Insensitive;
- 
- 
--- 76,78 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ssicst.adb gcc-4.1.0/gcc/ada/a-ssicst.adb
*** gcc-4.0.2/gcc/ada/a-ssicst.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-ssicst.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ssicst.ads gcc-4.1.0/gcc/ada/a-ssicst.ads
*** gcc-4.0.2/gcc/ada/a-ssicst.ads	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-ssicst.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . S T R E A M S . S T R E A M _ I O . C _ S T R E A M S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . S T R E A M S . S T R E A M _ I O . C _ S T R E A M S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ssitio.ads gcc-4.1.0/gcc/ada/a-ssitio.ads
*** gcc-4.0.2/gcc/ada/a-ssitio.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-ssitio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . S H O R T _ S H O R T _ I N T E G E R _ T E X T _ I O       --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . S H O R T _ S H O R T _ I N T E G E R _ T E X T _ I O       --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ssiwti.ads gcc-4.1.0/gcc/ada/a-ssiwti.ads
*** gcc-4.0.2/gcc/ada/a-ssiwti.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-ssiwti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  -- A D A . S H O R T _ S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  -- A D A . S H O R T _ S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ssizti.ads gcc-4.1.0/gcc/ada/a-ssizti.ads
*** gcc-4.0.2/gcc/ada/a-ssizti.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ssizti.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  -- A D A . S H O R T _ S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  -- A D A . S H O R T _ S H O R T _ I N T E G E R _ W I D E _ T E X T _ I O  --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stmaco.ads gcc-4.1.0/gcc/ada/a-stmaco.ads
*** gcc-4.0.2/gcc/ada/a-stmaco.ads	Fri Nov 19 10:55:09 2004
--- gcc-4.1.0/gcc/ada/a-stmaco.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . S T R I N G S . M A P S . C O N S T A N T S            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . S T R I N G S . M A P S . C O N S T A N T S            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Characters.Latin_1;
  
  package Ada.Strings.Maps.Constants is
! pragma Preelaborate (Constants);
  
     Control_Set           : constant Character_Set;
     Graphic_Set           : constant Character_Set;
--- 38,46 ----
  with Ada.Characters.Latin_1;
  
  package Ada.Strings.Maps.Constants is
!    pragma Preelaborate;
!    pragma Pure_05;
!    --  In accordance with Ada 2005 AI-362
  
     Control_Set           : constant Character_Set;
     Graphic_Set           : constant Character_Set;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-storio.adb gcc-4.1.0/gcc/ada/a-storio.adb
*** gcc-4.0.2/gcc/ada/a-storio.adb	Fri Jun 25 16:39:24 2004
--- gcc-4.1.0/gcc/ada/a-storio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       A D A . S T O R A G E _ I O                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       A D A . S T O R A G E _ I O                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-storio.ads gcc-4.1.0/gcc/ada/a-storio.ads
*** gcc-4.0.2/gcc/ada/a-storio.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-storio.ads	Mon Sep  5 07:51:25 2005
*************** generic
*** 20,26 ****
     type Element_Type is private;
  
  package Ada.Storage_IO is
! pragma Preelaborate (Storage_IO);
  
     Buffer_Size : constant System.Storage_Elements.Storage_Count :=
                     System.Storage_Elements.Storage_Count
--- 20,26 ----
     type Element_Type is private;
  
  package Ada.Storage_IO is
!    pragma Preelaborate;
  
     Buffer_Size : constant System.Storage_Elements.Storage_Count :=
                     System.Storage_Elements.Storage_Count
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strbou.adb gcc-4.1.0/gcc/ada/a-strbou.adb
*** gcc-4.0.2/gcc/ada/a-strbou.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-strbou.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  A D A . S T R I N G S . B O U N D E D                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  A D A . S T R I N G S . B O U N D E D                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strbou.ads gcc-4.1.0/gcc/ada/a-strbou.ads
*** gcc-4.0.2/gcc/ada/a-strbou.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-strbou.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Maps;
*** 39,45 ****
  with Ada.Strings.Superbounded;
  
  package Ada.Strings.Bounded is
! pragma Preelaborate (Bounded);
  
     generic
        Max : Positive;
--- 39,45 ----
  with Ada.Strings.Superbounded;
  
  package Ada.Strings.Bounded is
!    pragma Preelaborate;
  
     generic
        Max : Positive;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stream.ads gcc-4.1.0/gcc/ada/a-stream.ads
*** gcc-4.0.2/gcc/ada/a-stream.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-stream.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,43 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  package Ada.Streams is
! pragma Pure (Streams);
  
     type Root_Stream_Type is abstract tagged limited private;
  
--- 35,42 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package Ada.Streams is
!    pragma Pure;
  
     type Root_Stream_Type is abstract tagged limited private;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strfix.adb gcc-4.1.0/gcc/ada/a-strfix.adb
*** gcc-4.0.2/gcc/ada/a-strfix.adb	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-strfix.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                    A D A . S T R I N G S . F I X E D                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                    A D A . S T R I N G S . F I X E D                     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,44 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Note: This code is derived from the ADAR.CSH public domain Ada 83
! --  versions of the Appendix C string handling packages. One change is
! --  to avoid the use of Is_In, so that we are not dependent on inlining.
! --  Note that the search function implementations are to be found in the
! --  auxiliary package Ada.Strings.Search. Also the Move procedure is
! --  directly incorporated (ADAR used a subunit for this procedure). A
! --  number of errors having to do with bounds of function return results
! --  were also fixed, and use of & removed for efficiency reasons.
  
  with Ada.Strings.Maps; use Ada.Strings.Maps;
  with Ada.Strings.Search;
--- 31,44 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Note: This code is derived from the ADAR.CSH public domain Ada 83 versions
! --  of the Appendix C string handling packages. One change is to avoid the use
! --  of Is_In, so that we are not dependent on inlining. Note that the search
! --  function implementations are to be found in the auxiliary package
! --  Ada.Strings.Search. Also the Move procedure is directly incorporated (ADAR
! --  used a subunit for this procedure). number of errors having to do with
! --  bounds of function return results were also fixed, and use of & removed for
! --  efficiency reasons.
  
  with Ada.Strings.Maps; use Ada.Strings.Maps;
  with Ada.Strings.Search;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strfix.ads gcc-4.1.0/gcc/ada/a-strfix.ads
*** gcc-4.0.2/gcc/ada/a-strfix.ads	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-strfix.ads	Mon Sep  5 07:51:25 2005
***************
*** 13,23 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  with Ada.Strings.Maps;
  
  package Ada.Strings.Fixed is
! pragma Preelaborate (Fixed);
  
     --------------------------------------------------------------
     -- Copy Procedure for Strings of Possibly Different Lengths --
--- 13,22 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with Ada.Strings.Maps;
  
  package Ada.Strings.Fixed is
!    pragma Preelaborate;
  
     --------------------------------------------------------------
     -- Copy Procedure for Strings of Possibly Different Lengths --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strhas.adb gcc-4.1.0/gcc/ada/a-strhas.adb
*** gcc-4.0.2/gcc/ada/a-strhas.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-strhas.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                             ADA.STRINGS.HASH                             --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                     A D A . S T R I N G S . H A S H                      --
  --                                                                          --
! --                                B o d y                                   --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** function Ada.Strings.Hash (Key : String)
*** 48,63 ****
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Hash;
- 
- 
- 
- 
- 
- 
- 
- 
--- 48,55 ----
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Hash;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strhas.ads gcc-4.1.0/gcc/ada/a-strhas.ads
*** gcc-4.0.2/gcc/ada/a-strhas.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-strhas.ads	Thu Jun 16 08:26:28 2005
***************
*** 2,10 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                             ADA.STRINGS.HASH                             --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
--- 2,10 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                     A D A . S T R I N G S . H A S H                      --
  --                                                                          --
! --                                S p e c                                   --
  --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
*************** with Ada.Containers;
*** 18,22 ****
  function Ada.Strings.Hash (Key : String) return Containers.Hash_Type;
  
  pragma Pure (Ada.Strings.Hash);
- 
- 
--- 18,20 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-string.ads gcc-4.1.0/gcc/ada/a-string.ads
*** gcc-4.0.2/gcc/ada/a-string.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-string.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          A D A . S T R I N G S                           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          A D A . S T R I N G S                           --
  --                                                                          --
***************
*** 14,20 ****
  ------------------------------------------------------------------------------
  
  package Ada.Strings is
! pragma Pure (Strings);
  
     Space           : constant Character           := ' ';
     Wide_Space      : constant Wide_Character      := ' ';
--- 14,20 ----
  ------------------------------------------------------------------------------
  
  package Ada.Strings is
!    pragma Pure;
  
     Space           : constant Character           := ' ';
     Wide_Space      : constant Wide_Character      := ' ';
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strmap.adb gcc-4.1.0/gcc/ada/a-strmap.adb
*** gcc-4.0.2/gcc/ada/a-strmap.adb	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-strmap.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . S T R I N G S . M A P S                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . S T R I N G S . M A P S                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strmap.ads gcc-4.1.0/gcc/ada/a-strmap.ads
*** gcc-4.0.2/gcc/ada/a-strmap.ads	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-strmap.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Characters.Latin_1;
  
  package Ada.Strings.Maps is
! pragma Preelaborate (Maps);
  
     --------------------------------
     -- Character Set Declarations --
--- 38,46 ----
  with Ada.Characters.Latin_1;
  
  package Ada.Strings.Maps is
!    pragma Preelaborate;
!    pragma Pure_05;
!    --  In accordance with Ada 2005 AI-362
  
     --------------------------------
     -- Character Set Declarations --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strsea.adb gcc-4.1.0/gcc/ada/a-strsea.adb
*** gcc-4.0.2/gcc/ada/a-strsea.adb	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-strsea.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   A D A . S T R I N G S . S E A R C H                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   A D A . S T R I N G S . S E A R C H                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  case of identity mappings for Count and Index, and also Index_Non_Blank
  --  is specialized (rather than using the general Index routine).
  
- 
  with Ada.Strings.Maps; use Ada.Strings.Maps;
  
  package body Ada.Strings.Search is
--- 37,42 ----
*************** package body Ada.Strings.Search is
*** 217,223 ****
        Cur_Index     : Natural;
        Mapped_Source : String (Source'Range);
  
- 
     begin
        if Pattern = "" then
           raise Pattern_Error;
--- 216,221 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strsea.ads gcc-4.1.0/gcc/ada/a-strsea.ads
*** gcc-4.0.2/gcc/ada/a-strsea.ads	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-strsea.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  with Ada.Strings.Maps;
  
  private package Ada.Strings.Search is
! pragma Preelaborate (Search);
  
     function Index
       (Source  : String;
--- 41,47 ----
  with Ada.Strings.Maps;
  
  private package Ada.Strings.Search is
!    pragma Preelaborate;
  
     function Index
       (Source  : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strsup.adb gcc-4.1.0/gcc/ada/a-strsup.adb
*** gcc-4.0.2/gcc/ada/a-strsup.adb	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-strsup.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . S T R I N G S . S U P E R B O U N D E D              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . S T R I N G S . S U P E R B O U N D E D              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strsup.ads gcc-4.1.0/gcc/ada/a-strsup.ads
*** gcc-4.0.2/gcc/ada/a-strsup.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-strsup.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  with Ada.Strings.Maps;
  
  package Ada.Strings.Superbounded is
! pragma Preelaborate (Superbounded);
  
     type Super_String (Max_Length : Positive) is record
        Current_Length : Natural := 0;
--- 41,47 ----
  with Ada.Strings.Maps;
  
  package Ada.Strings.Superbounded is
!    pragma Preelaborate;
  
     type Super_String (Max_Length : Positive) is record
        Current_Length : Natural := 0;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strunb.adb gcc-4.1.0/gcc/ada/a-strunb.adb
*** gcc-4.0.2/gcc/ada/a-strunb.adb	Thu Feb 10 13:51:37 2005
--- gcc-4.1.0/gcc/ada/a-strunb.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
! --                A D A . S T R I N G S . U N B O U N D E D                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
! --                 A D A . S T R I N G S . U N B O U N D E D                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Strings.Unbounded is
*** 39,54 ****
  
     use Ada.Finalization;
  
-    procedure Realloc_For_Chunk
-      (Source     : in out Unbounded_String;
-       Chunk_Size : Natural);
-    pragma Inline (Realloc_For_Chunk);
-    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
-    --  is safe to add a string of this size at the end of the current content.
-    --  The real size allocated for the string is Chunk_Size + x of the current
-    --  string size. This buffered handling makes the Append unbounded string
-    --  routines very fast.
- 
     ---------
     -- "&" --
     ---------
--- 39,44 ----
*************** package body Ada.Strings.Unbounded is
*** 202,208 ****
        Result.Reference := new String (1 .. Result.Last);
  
        K := 1;
!       for I in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
--- 192,198 ----
        Result.Reference := new String (1 .. Result.Last);
  
        K := 1;
!       for J in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
*************** package body Ada.Strings.Unbounded is
*** 363,369 ****
     procedure Adjust (Object : in out Unbounded_String) is
     begin
        --  Copy string, except we do not copy the statically allocated null
!       --  string, since it can never be deallocated. Note that we do not copy
        --  extra string room here to avoid dragging unused allocated memory.
  
        if Object.Reference /= Null_String'Access then
--- 353,359 ----
     procedure Adjust (Object : in out Unbounded_String) is
     begin
        --  Copy string, except we do not copy the statically allocated null
!       --  string since it can never be deallocated. Note that we do not copy
        --  extra string room here to avoid dragging unused allocated memory.
  
        if Object.Reference /= Null_String'Access then
*************** package body Ada.Strings.Unbounded is
*** 633,639 ****
          (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
     end Index;
  
- 
     function Index
       (Source  : Unbounded_String;
        Set     : Maps.Character_Set;
--- 623,628 ----
*************** package body Ada.Strings.Unbounded is
*** 765,781 ****
       (Source     : in out Unbounded_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 50;
!       S_Length      : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             Alloc_Chunk_Size : constant Positive :=
!                                  Chunk_Size + (S_Length / Growth_Factor);
!             Tmp : String_Access;
           begin
-             Tmp := new String (1 .. S_Length + Alloc_Chunk_Size);
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
--- 754,789 ----
       (Source     : in out Unbounded_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 32;
!       --  The growth factor controls how much extra space is allocated when
!       --  we have to increase the size of an allocated unbounded string. By
!       --  allocating extra space, we avoid the need to reallocate on every
!       --  append, particularly important when a string is built up by repeated
!       --  append operations of small pieces. This is expressed as a factor so
!       --  32 means add 1/32 of the length of the string as growth space.
! 
!       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
!       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
!       --  no memory loss as most (all?) malloc implementations are obliged to
!       --  align the returned memory on the maximum alignment as malloc does not
!       --  know the target alignment.
! 
!       S_Length : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             New_Size : constant Positive :=
!                          S_Length + Chunk_Size + (S_Length / Growth_Factor);
! 
!             New_Rounded_Up_Size : constant Positive :=
!                                     ((New_Size - 1) / Min_Mul_Alloc + 1) *
!                                        Min_Mul_Alloc;
! 
!             Tmp : constant String_Access :=
!                     new String (1 .. New_Rounded_Up_Size);
! 
           begin
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-strunb.ads gcc-4.1.0/gcc/ada/a-strunb.ads
*** gcc-4.0.2/gcc/ada/a-strunb.ads	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-strunb.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
! --                A D A . S T R I N G S . U N B O U N D E D                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
! --                 A D A . S T R I N G S . U N B O U N D E D                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Maps;
*** 39,45 ****
  with Ada.Finalization;
  
  package Ada.Strings.Unbounded is
! pragma Preelaborate (Unbounded);
  
     type Unbounded_String is private;
  
--- 39,45 ----
  with Ada.Finalization;
  
  package Ada.Strings.Unbounded is
!    pragma Preelaborate;
  
     type Unbounded_String is private;
  
*************** private
*** 405,422 ****
     pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
  
     pragma Finalize_Storage_Only (Unbounded_String);
  
     procedure Initialize (Object : in out Unbounded_String);
     procedure Adjust     (Object : in out Unbounded_String);
     procedure Finalize   (Object : in out Unbounded_String);
  
!    --  Note: the following declaration is illegal since library level
!    --  controlled objects are not allowed in preelaborated units. See
!    --  AI-161 for a discussion of this issue and an attempt to address it.
!    --  Meanwhile, what happens in GNAT is that this check is omitted for
!    --  internal implementation units (see check in sem_cat.adb).
  
     Null_Unbounded_String : constant Unbounded_String :=
!      (AF.Controlled with Reference => Null_String'Access, Last => 0);
  
  end Ada.Strings.Unbounded;
--- 405,435 ----
     pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);
  
     pragma Finalize_Storage_Only (Unbounded_String);
+    --  Finalization is required only for freeing storage
  
     procedure Initialize (Object : in out Unbounded_String);
     procedure Adjust     (Object : in out Unbounded_String);
     procedure Finalize   (Object : in out Unbounded_String);
  
!    procedure Realloc_For_Chunk
!      (Source     : in out Unbounded_String;
!       Chunk_Size : Natural);
!    pragma Inline (Realloc_For_Chunk);
!    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
!    --  is safe to add a string of this size at the end of the current content.
!    --  The real size allocated for the string is Chunk_Size + x of the current
!    --  string size. This buffered handling makes the Append unbounded string
!    --  routines very fast. This spec is in the private part so that it can be
!    --  accessed from children (e.g. from Unbounded.Text_IO).
  
     Null_Unbounded_String : constant Unbounded_String :=
!                              (AF.Controlled with
!                                 Reference => Null_String'Access,
!                                 Last => 0);
!    --  Note: this declaration is illegal since library level controlled
!    --  objects are not allowed in preelaborated units. See AI-161 for a
!    --  discussion of this issue and an attempt to address it. Meanwhile,
!    --  what happens in GNAT is that this check is omitted for internal
!    --  implementation units (see check in sem_cat.adb).
  
  end Ada.Strings.Unbounded;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ststio.adb gcc-4.1.0/gcc/ada/a-ststio.adb
*** gcc-4.0.2/gcc/ada/a-ststio.adb	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/a-ststio.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                A D A . S T R E A M S . S T R E A M _ I O                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                A D A . S T R E A M S . S T R E A M _ I O                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ststio.ads gcc-4.1.0/gcc/ada/a-ststio.ads
*** gcc-4.0.2/gcc/ada/a-ststio.ads	Wed Oct 27 12:29:19 2004
--- gcc-4.1.0/gcc/ada/a-ststio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stunau.adb gcc-4.1.0/gcc/ada/a-stunau.adb
*** gcc-4.0.2/gcc/ada/a-stunau.adb	Tue Jan 18 22:00:12 2005
--- gcc-4.1.0/gcc/ada/a-stunau.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --            A D A . S T R I N G S . U N B O U N D E D . A U X             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --            A D A . S T R I N G S . U N B O U N D E D . A U X             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Strings.Unbounded.Aux i
*** 37,67 ****
     -- Get_String --
     ----------------
  
!    function Get_String (U : Unbounded_String) return String_Access is
     begin
!       if U.Last = U.Reference'Length then
!          return U.Reference;
! 
!       else
!          declare
!             type Unbounded_String_Access is access all Unbounded_String;
! 
!             U_Ptr : constant Unbounded_String_Access := U'Unrestricted_Access;
!             --  Unbounded_String is a controlled type which is always passed
!             --  by reference.  It is always safe to take the pointer to such
!             --  object here.  This pointer is used to set the U.Reference
!             --  value which would not be possible otherwise as U is read-only.
! 
!             Old : String_Access := U.Reference;
!             Ret : String_Access;
! 
!          begin
!             Ret := new String'(U.Reference (1 .. U.Last));
!             U_Ptr.Reference := Ret;
!             Free (Old);
!             return Ret;
!          end;
!       end if;
     end Get_String;
  
     ----------------
--- 37,50 ----
     -- Get_String --
     ----------------
  
!    procedure Get_String
!      (U : Unbounded_String;
!       S : out String_Access;
!       L : out Natural)
!    is
     begin
!       S := U.Reference;
!       L := U.Last;
     end Get_String;
  
     ----------------
*************** package body Ada.Strings.Unbounded.Aux i
*** 70,90 ****
  
     procedure Set_String (UP : in out Unbounded_String; S : String) is
     begin
!       if UP.Last = S'Length then
!          UP.Reference.all := S;
! 
!       else
!          declare
!             subtype String_1 is String (1 .. S'Length);
!             Tmp : String_Access;
! 
!          begin
!             Tmp := new String'(String_1 (S));
!             Finalize (UP);
!             UP.Reference := Tmp;
!             UP.Last := UP.Reference'Length;
!          end;
        end if;
     end Set_String;
  
     procedure Set_String (UP : in out Unbounded_String; S : String_Access) is
--- 53,65 ----
  
     procedure Set_String (UP : in out Unbounded_String; S : String) is
     begin
!       if S'Length > UP.Last then
!          Finalize (UP);
!          UP.Reference := new String (1 .. S'Length);
        end if;
+ 
+       UP.Reference (1 .. S'Length) := S;
+       UP.Last := S'Length;
     end Set_String;
  
     procedure Set_String (UP : in out Unbounded_String; S : String_Access) is
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stunau.ads gcc-4.1.0/gcc/ada/a-stunau.ads
*** gcc-4.0.2/gcc/ada/a-stunau.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stunau.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --            A D A . S T R I N G S . U N B O U N D E D . A U X             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --            A D A . S T R I N G S . U N B O U N D E D . A U X             --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,57 ****
  --  utilities (such as GNAT.SPITBOL.Patterns).
  
  package Ada.Strings.Unbounded.Aux is
! pragma Preelaborate (Aux);
  
!    function Get_String (U : Unbounded_String) return String_Access;
     pragma Inline (Get_String);
!    --  This function returns the internal string pointer used in the
!    --  representation of an unbounded string. There is no copy involved,
!    --  so the value obtained references the same string as the original
!    --  unbounded string. The characters of this string may not be modified
!    --  via the returned pointer, and are valid only as long as the original
!    --  unbounded string is not modified. Violating either of these two
!    --  rules results in erroneous execution.
     --
!    --  This function is much more efficient than the use of To_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one.
  
     procedure Set_String (UP : in out Unbounded_String; S : String);
     pragma Inline (Set_String);
--- 37,60 ----
  --  utilities (such as GNAT.SPITBOL.Patterns).
  
  package Ada.Strings.Unbounded.Aux is
!    pragma Preelaborate;
  
!    procedure Get_String
!      (U : Unbounded_String;
!       S : out String_Access;
!       L : out Natural);
     pragma Inline (Get_String);
!    --  This procedure returns the internal string pointer used in the
!    --  representation of an unbounded string as well as the actual current
!    --  length (which may be less than S.all'Length because in general there
!    --  can be extra space assigned). The characters of this string may be
!    --  not be modified via the returned pointer,  and are valid only as
!    --  long as the original unbounded string is not accessed or modified.
     --
!    --  This procedure is much more efficient than the use of To_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one, so the actual
!    --  string data is always accessible as S (1 .. L).
  
     procedure Set_String (UP : in out Unbounded_String; S : String);
     pragma Inline (Set_String);
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stunha.adb gcc-4.1.0/gcc/ada/a-stunha.adb
*** gcc-4.0.2/gcc/ada/a-stunha.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-stunha.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.STRINGS.UNBOUNDED.HASH                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . S T R I N G S . U N B O U N D E D . H A S H            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** is
*** 50,56 ****
  begin
     Tmp := 0;
     for J in 1 .. Key.Last loop
!       Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key.Reference (J));
     end loop;
  
     return Tmp;
--- 50,56 ----
  begin
     Tmp := 0;
     for J in 1 .. Key.Last loop
!       Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key.Reference (J));
     end loop;
  
     return Tmp;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stunha.ads gcc-4.1.0/gcc/ada/a-stunha.ads
*** gcc-4.0.2/gcc/ada/a-stunha.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-stunha.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,13 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                        ADA.STRINGS.UNBOUNDED.HASH                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
- --             Copyright (C) 2004 Free Software Foundation, Inc.            --
- --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
  -- copy and modify this specification,  provided that if you redistribute a --
--- 2,11 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --           A D A . S T R I N G S . U N B O U N D E D . H A S H            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
  -- This specification is adapted from the Ada Reference Manual for use with --
  -- GNAT.  In accordance with the copyright of that document, you can freely --
  -- copy and modify this specification,  provided that if you redistribute a --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwibo.adb gcc-4.1.0/gcc/ada/a-stwibo.adb
*** gcc-4.0.2/gcc/ada/a-stwibo.adb	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwibo.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . S T R I N G S . W I D E _ B O U N D E D              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . S T R I N G S . W I D E _ B O U N D E D              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwibo.ads gcc-4.1.0/gcc/ada/a-stwibo.ads
*** gcc-4.0.2/gcc/ada/a-stwibo.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwibo.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Wide_Maps;
*** 39,45 ****
  with Ada.Strings.Wide_Superbounded;
  
  package Ada.Strings.Wide_Bounded is
! pragma Preelaborate (Wide_Bounded);
  
     generic
        Max : Positive;
--- 39,45 ----
  with Ada.Strings.Wide_Superbounded;
  
  package Ada.Strings.Wide_Bounded is
!    pragma Preelaborate;
  
     generic
        Max : Positive;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwifi.adb gcc-4.1.0/gcc/ada/a-stwifi.adb
*** gcc-4.0.2/gcc/ada/a-stwifi.adb	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-stwifi.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  with Ada.Strings.Wide_Search;
  
  package body Ada.Strings.Wide_Fixed is
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Strings.Wide_Maps;   use Ada.Strings.Wide_Maps;
  with Ada.Strings.Wide_Search;
  
  package body Ada.Strings.Wide_Fixed is
*************** package body Ada.Strings.Wide_Fixed is
*** 296,302 ****
        Tlength : constant Integer := Target'Length;
  
        function Is_Padding (Item : Wide_String) return Boolean;
!       --  Determinbe if all characters in Item are pad characters
  
        function Is_Padding (Item : Wide_String) return Boolean is
        begin
--- 296,306 ----
        Tlength : constant Integer := Target'Length;
  
        function Is_Padding (Item : Wide_String) return Boolean;
!       --  Determine if all characters in Item are pad characters
! 
!       ----------------
!       -- Is_Padding --
!       ----------------
  
        function Is_Padding (Item : Wide_String) return Boolean is
        begin
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwifi.ads gcc-4.1.0/gcc/ada/a-stwifi.ads
*** gcc-4.0.2/gcc/ada/a-stwifi.ads	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-stwifi.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
***************
*** 13,23 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  with Ada.Strings.Wide_Maps;
  
  package Ada.Strings.Wide_Fixed is
! pragma Preelaborate (Wide_Fixed);
  
     -------------------------------------------------------------------
     -- Copy Procedure for Wide_Strings of Possibly Different Lengths --
--- 13,22 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with Ada.Strings.Wide_Maps;
  
  package Ada.Strings.Wide_Fixed is
!    pragma Preelaborate;
  
     -------------------------------------------------------------------
     -- Copy Procedure for Wide_Strings of Possibly Different Lengths --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwiha.adb gcc-4.1.0/gcc/ada/a-stwiha.adb
*** gcc-4.0.2/gcc/ada/a-stwiha.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-stwiha.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                          ADA.STRINGS.WIDE_HASH                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 2,12 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                A D A . S T R I N G S . W I D E _ H A S H                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** is
*** 50,59 ****
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 1) + Wide_Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Wide_Hash;
- 
- 
--- 50,57 ----
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Wide_Hash;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwiha.ads gcc-4.1.0/gcc/ada/a-stwiha.ads
*** gcc-4.0.2/gcc/ada/a-stwiha.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-stwiha.ads	Thu Jun 16 08:56:24 2005
***************
*** 2,8 ****
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                          ADA.STRINGS.WIDE_HASH                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
--- 2,8 ----
  --                                                                          --
  --                         GNAT LIBRARY COMPONENTS                          --
  --                                                                          --
! --                A D A . S T R I N G S . W I D E _ H A S H                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
*************** function Ada.Strings.Wide_Hash
*** 19,24 ****
    (Key : Wide_String) return Containers.Hash_Type;
  
  pragma Pure (Ada.Strings.Wide_Hash);
- 
- 
- 
--- 19,21 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwima.adb gcc-4.1.0/gcc/ada/a-stwima.adb
*** gcc-4.0.2/gcc/ada/a-stwima.adb	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-stwima.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                A D A . S T R I N G S . W I D E _ M A P S                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                A D A . S T R I N G S . W I D E _ M A P S                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwima.ads gcc-4.1.0/gcc/ada/a-stwima.ads
*** gcc-4.0.2/gcc/ada/a-stwima.ads	Thu Feb 10 13:51:38 2005
--- gcc-4.1.0/gcc/ada/a-stwima.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Maps is
!    pragma Preelaborate (Wide_Maps);
  
     -------------------------------------
     -- Wide Character Set Declarations --
--- 38,44 ----
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Maps is
!    pragma Preelaborate;
  
     -------------------------------------
     -- Wide Character Set Declarations --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwise.adb gcc-4.1.0/gcc/ada/a-stwise.adb
*** gcc-4.0.2/gcc/ada/a-stwise.adb	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-stwise.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . S T R I N G S . W I D E _ S E A R C H               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . S T R I N G S . W I D E _ S E A R C H               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwise.ads gcc-4.1.0/gcc/ada/a-stwise.ads
*** gcc-4.0.2/gcc/ada/a-stwise.ads	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-stwise.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  with Ada.Strings.Wide_Maps;
  
  private package Ada.Strings.Wide_Search is
! pragma Preelaborate (Wide_Search);
  
     function Index
       (Source  : Wide_String;
--- 41,47 ----
  with Ada.Strings.Wide_Maps;
  
  private package Ada.Strings.Wide_Search is
!    pragma Preelaborate;
  
     function Index
       (Source  : Wide_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwisu.adb gcc-4.1.0/gcc/ada/a-stwisu.adb
*** gcc-4.0.2/gcc/ada/a-stwisu.adb	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwisu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ S U P E R B O U N D E D         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ S U P E R B O U N D E D         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwisu.ads gcc-4.1.0/gcc/ada/a-stwisu.ads
*** gcc-4.0.2/gcc/ada/a-stwisu.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwisu.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  with Ada.Strings.Wide_Maps;
  
  package Ada.Strings.Wide_Superbounded is
! pragma Preelaborate (Wide_Superbounded);
  
     Wide_NUL : constant Wide_Character := Wide_Character'Val (0);
  
--- 42,48 ----
  with Ada.Strings.Wide_Maps;
  
  package Ada.Strings.Wide_Superbounded is
!    pragma Preelaborate;
  
     Wide_NUL : constant Wide_Character := Wide_Character'Val (0);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwiun.adb gcc-4.1.0/gcc/ada/a-stwiun.adb
*** gcc-4.0.2/gcc/ada/a-stwiun.adb	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwiun.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . S T R I N G S . W I D E _ U N B O U N D E D            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . S T R I N G S . W I D E _ U N B O U N D E D            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Strings.Wide_Unbounded 
*** 39,54 ****
  
     use Ada.Finalization;
  
-    procedure Realloc_For_Chunk
-      (Source     : in out Unbounded_Wide_String;
-       Chunk_Size : Natural);
-    pragma Inline (Realloc_For_Chunk);
-    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
-    --  is safe to add a string of this size at the end of the current
-    --  content. The real size allocated for the string is Chunk_Size + x %
-    --  of the current string size. This buffered handling makes the Append
-    --  unbounded wide string routines very fast.
- 
     ---------
     -- "&" --
     ---------
--- 39,44 ----
*************** package body Ada.Strings.Wide_Unbounded 
*** 142,148 ****
        Result.Reference (1) := Left;
        Result.Reference (2 .. Result.Last) :=
          Right.Reference (1 .. Right.Last);
- 
        return Result;
     end "&";
  
--- 132,137 ----
*************** package body Ada.Strings.Wide_Unbounded 
*** 157,163 ****
        Result : Unbounded_Wide_String;
  
     begin
!       Result.Last := Left;
  
        Result.Reference := new Wide_String (1 .. Left);
        for J in Result.Reference'Range loop
--- 146,152 ----
        Result : Unbounded_Wide_String;
  
     begin
!       Result.Last   := Left;
  
        Result.Reference := new Wide_String (1 .. Left);
        for J in Result.Reference'Range loop
*************** package body Ada.Strings.Wide_Unbounded 
*** 195,201 ****
     is
        Len    : constant Natural := Right.Last;
        K      : Positive;
!       Result   : Unbounded_Wide_String;
  
     begin
        Result.Last := Left * Len;
--- 184,190 ----
     is
        Len    : constant Natural := Right.Last;
        K      : Positive;
!       Result : Unbounded_Wide_String;
  
     begin
        Result.Last := Left * Len;
*************** package body Ada.Strings.Wide_Unbounded 
*** 203,209 ****
        Result.Reference := new Wide_String (1 .. Result.Last);
  
        K := 1;
!       for I in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
--- 192,198 ----
        Result.Reference := new Wide_String (1 .. Result.Last);
  
        K := 1;
!       for J in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
*************** package body Ada.Strings.Wide_Unbounded 
*** 363,372 ****
  
     procedure Adjust (Object : in out Unbounded_Wide_String) is
     begin
!       --  Copy string, except we do not copy the statically allocated
!       --  null string, since it can never be deallocated.
!       --  Note that we do not copy extra string room here to avoid dragging
!       --  unused allocated memory.
  
        if Object.Reference /= Null_Wide_String'Access then
           Object.Reference :=
--- 352,360 ----
  
     procedure Adjust (Object : in out Unbounded_Wide_String) is
     begin
!       --  Copy string, except we do not copy the statically allocated null
!       --  string, since it can never be deallocated. Note that we do not copy
!       --  extra string room here to avoid dragging unused allocated memory.
  
        if Object.Reference /= Null_Wide_String'Access then
           Object.Reference :=
*************** package body Ada.Strings.Wide_Unbounded 
*** 417,429 ****
     function Count
       (Source  : Unbounded_Wide_String;
        Pattern : Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping :=
!                   Wide_Maps.Identity)
        return Natural
     is
     begin
!       return Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
--- 405,417 ----
     function Count
       (Source  : Unbounded_Wide_String;
        Pattern : Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
        return Natural
     is
     begin
!       return
!         Wide_Search.Count
!           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
*************** package body Ada.Strings.Wide_Unbounded 
*** 432,439 ****
        Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
     is
     begin
!       return Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
--- 420,428 ----
        Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
     is
     begin
!       return
!         Wide_Search.Count
!           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
*************** package body Ada.Strings.Wide_Unbounded 
*** 441,447 ****
        Set    : Wide_Maps.Wide_Character_Set) return Natural
     is
     begin
!       return Wide_Search.Count (Source.Reference (1 .. Source.Last), Set);
     end Count;
  
     ------------
--- 430,438 ----
        Set    : Wide_Maps.Wide_Character_Set) return Natural
     is
     begin
!       return
!         Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Set);
     end Count;
  
     ------------
*************** package body Ada.Strings.Wide_Unbounded 
*** 454,462 ****
        Through : Natural) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Delete
!            (Source.Reference (1 .. Source.Last), From, Through));
     end Delete;
  
     procedure Delete
--- 445,454 ----
        Through : Natural) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Delete
!              (Source.Reference (1 .. Source.Last), From, Through));
     end Delete;
  
     procedure Delete
*************** package body Ada.Strings.Wide_Unbounded 
*** 505,511 ****
  
     procedure Finalize (Object : in out Unbounded_Wide_String) is
        procedure Deallocate is
!         new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
  
     begin
        --  Note: Don't try to free statically allocated null string
--- 497,503 ----
  
     procedure Finalize (Object : in out Unbounded_Wide_String) is
        procedure Deallocate is
!          new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
  
     begin
        --  Note: Don't try to free statically allocated null string
*************** package body Ada.Strings.Wide_Unbounded 
*** 513,518 ****
--- 505,511 ----
        if Object.Reference /= Null_Wide_String'Access then
           Deallocate (Object.Reference);
           Object.Reference := Null_Unbounded_Wide_String.Reference;
+          Object.Last := 0;
        end if;
     end Finalize;
  
*************** package body Ada.Strings.Wide_Unbounded 
*** 539,544 ****
--- 532,538 ----
     procedure Free (X : in out Wide_String_Access) is
        procedure Deallocate is
           new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
+ 
     begin
        --  Note: Do not try to free statically allocated null string
  
*************** package body Ada.Strings.Wide_Unbounded 
*** 557,565 ****
        Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
     end Head;
  
     procedure Head
--- 551,558 ----
        Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
     end Head;
  
     procedure Head
*************** package body Ada.Strings.Wide_Unbounded 
*** 568,577 ****
        Pad    : Wide_Character := Wide_Space)
     is
        Old : Wide_String_Access := Source.Reference;
- 
     begin
!       Source.Reference := new Wide_String'
!         (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
        Source.Last := Source.Reference'Length;
        Free (Old);
     end Head;
--- 561,570 ----
        Pad    : Wide_Character := Wide_Space)
     is
        Old : Wide_String_Access := Source.Reference;
     begin
!       Source.Reference :=
!         new Wide_String'
!           (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
        Source.Last := Source.Reference'Length;
        Free (Old);
     end Head;
*************** package body Ada.Strings.Wide_Unbounded 
*** 584,595 ****
       (Source  : Unbounded_Wide_String;
        Pattern : Wide_String;
        Going   : Strings.Direction := Strings.Forward;
!       Mapping : Wide_Maps.Wide_Character_Mapping :=
!                         Wide_Maps.Identity) return Natural
     is
     begin
!       return Wide_Search.Index
!         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
--- 577,589 ----
       (Source  : Unbounded_Wide_String;
        Pattern : Wide_String;
        Going   : Strings.Direction := Strings.Forward;
!       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
!       return Natural
     is
     begin
!       return
!         Wide_Search.Index
!           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
*************** package body Ada.Strings.Wide_Unbounded 
*** 599,606 ****
        Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
     is
     begin
!       return Wide_Search.Index
!         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
--- 593,601 ----
        Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
     is
     begin
!       return
!         Wide_Search.Index
!           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
*************** package body Ada.Strings.Wide_Unbounded 
*** 614,626 ****
          (Source.Reference (1 .. Source.Last), Set, Test, Going);
     end Index;
  
     function Index_Non_Blank
       (Source : Unbounded_Wide_String;
        Going  : Strings.Direction := Strings.Forward) return Natural
     is
     begin
!       return Wide_Search.Index_Non_Blank
!         (Source.Reference (1 .. Source.Last), Going);
     end Index_Non_Blank;
  
     ----------------
--- 609,673 ----
          (Source.Reference (1 .. Source.Last), Set, Test, Going);
     end Index;
  
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Pattern : Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
+       return Natural
+    is
+    begin
+       return
+         Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+    end Index;
+ 
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Pattern : Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
+    is
+    begin
+       return
+         Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+    end Index;
+ 
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Set     : Wide_Maps.Wide_Character_Set;
+       From    : Positive;
+       Test    : Membership := Inside;
+       Going   : Direction := Forward) return Natural
+    is
+    begin
+       return
+         Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
+    end Index;
+ 
     function Index_Non_Blank
       (Source : Unbounded_Wide_String;
        Going  : Strings.Direction := Strings.Forward) return Natural
     is
     begin
!       return
!         Wide_Search.Index_Non_Blank
!           (Source.Reference (1 .. Source.Last), Going);
!    end Index_Non_Blank;
! 
!    function Index_Non_Blank
!      (Source : Unbounded_Wide_String;
!       From   : Positive;
!       Going  : Direction := Forward) return Natural
!    is
!    begin
!       return
!         Wide_Search.Index_Non_Blank
!           (Source.Reference (1 .. Source.Last), From, Going);
     end Index_Non_Blank;
  
     ----------------
*************** package body Ada.Strings.Wide_Unbounded 
*** 643,651 ****
        New_Item : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Insert
!            (Source.Reference (1 .. Source.Last), Before, New_Item));
     end Insert;
  
     procedure Insert
--- 690,699 ----
        New_Item : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Insert
!              (Source.Reference (1 .. Source.Last), Before, New_Item));
     end Insert;
  
     procedure Insert
*************** package body Ada.Strings.Wide_Unbounded 
*** 687,695 ****
        New_Item : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Overwrite
!            (Source.Reference (1 .. Source.Last), Position, New_Item));
     end Overwrite;
  
     procedure Overwrite
--- 735,744 ----
        New_Item : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Overwrite
!             (Source.Reference (1 .. Source.Last), Position, New_Item));
     end Overwrite;
  
     procedure Overwrite
*************** package body Ada.Strings.Wide_Unbounded 
*** 698,712 ****
        New_Item  : Wide_String)
     is
        NL : constant Natural := New_Item'Length;
- 
     begin
        if Position <= Source.Last - NL + 1 then
           Source.Reference (Position .. Position + NL - 1) := New_Item;
- 
        else
           declare
              Old : Wide_String_Access := Source.Reference;
- 
           begin
              Source.Reference := new Wide_String'
                (Wide_Fixed.Overwrite
--- 747,758 ----
*************** package body Ada.Strings.Wide_Unbounded 
*** 725,742 ****
       (Source     : in out Unbounded_Wide_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 50;
!       S_Length      : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             Alloc_Chunk_Size : constant Positive :=
!                                  Chunk_Size + (S_Length / Growth_Factor);
!             Tmp : Wide_String_Access;
  
           begin
-             Tmp := new Wide_String (1 .. S_Length + Alloc_Chunk_Size);
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
--- 771,806 ----
       (Source     : in out Unbounded_Wide_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 32;
!       --  The growth factor controls how much extra space is allocated when
!       --  we have to increase the size of an allocated unbounded string. By
!       --  allocating extra space, we avoid the need to reallocate on every
!       --  append, particularly important when a string is built up by repeated
!       --  append operations of small pieces. This is expressed as a factor so
!       --  32 means add 1/32 of the length of the string as growth space.
! 
!       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
!       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
!       --  no memory loss as most (all?) malloc implementations are obliged to
!       --  align the returned memory on the maximum alignment as malloc does not
!       --  know the target alignment.
! 
!       S_Length : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             New_Size : constant Positive :=
!                          S_Length + Chunk_Size + (S_Length / Growth_Factor);
! 
!             New_Rounded_Up_Size : constant Positive :=
!                                     ((New_Size - 1) / Min_Mul_Alloc + 1) *
!                                        Min_Mul_Alloc;
! 
!             Tmp : constant Wide_String_Access :=
!                     new Wide_String (1 .. New_Rounded_Up_Size);
  
           begin
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
*************** package body Ada.Strings.Wide_Unbounded 
*** 772,791 ****
        By     : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
          (Wide_Fixed.Replace_Slice
             (Source.Reference (1 .. Source.Last), Low, High, By));
     end Replace_Slice;
  
     procedure Replace_Slice
!      (Source   : in out Unbounded_Wide_String;
!       Low      : Positive;
!       High     : Natural;
!       By       : Wide_String)
     is
        Old : Wide_String_Access := Source.Reference;
- 
     begin
        Source.Reference := new Wide_String'
          (Wide_Fixed.Replace_Slice
--- 836,853 ----
        By     : Wide_String) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
          (Wide_Fixed.Replace_Slice
             (Source.Reference (1 .. Source.Last), Low, High, By));
     end Replace_Slice;
  
     procedure Replace_Slice
!      (Source : in out Unbounded_Wide_String;
!       Low    : Positive;
!       High   : Natural;
!       By     : Wide_String)
     is
        Old : Wide_String_Access := Source.Reference;
     begin
        Source.Reference := new Wide_String'
          (Wide_Fixed.Replace_Slice
*************** package body Ada.Strings.Wide_Unbounded 
*** 794,799 ****
--- 856,875 ----
        Free (Old);
     end Replace_Slice;
  
+    -------------------------------
+    -- Set_Unbounded_Wide_String --
+    -------------------------------
+ 
+    procedure Set_Unbounded_Wide_String
+      (Target : out Unbounded_Wide_String;
+       Source : Wide_String)
+    is
+    begin
+       Target.Last          := Source'Length;
+       Target.Reference     := new Wide_String (1 .. Source'Length);
+       Target.Reference.all := Source;
+    end Set_Unbounded_Wide_String;
+ 
     -----------
     -- Slice --
     -----------
*************** package body Ada.Strings.Wide_Unbounded 
*** 808,814 ****
  
        if Low > Source.Last + 1 or else High > Source.Last then
           raise Index_Error;
- 
        else
           return Source.Reference (Low .. High);
        end if;
--- 884,889 ----
*************** package body Ada.Strings.Wide_Unbounded 
*** 821,828 ****
     function Tail
       (Source : Unbounded_Wide_String;
        Count  : Natural;
!       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String
!    is
     begin
        return To_Unbounded_Wide_String
          (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
--- 896,902 ----
     function Tail
       (Source : Unbounded_Wide_String;
        Count  : Natural;
!       Pad    : Wide_Character := Wide_Space) return Unbounded_Wide_String is
     begin
        return To_Unbounded_Wide_String
          (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
*************** package body Ada.Strings.Wide_Unbounded 
*** 834,840 ****
        Pad    : Wide_Character := Wide_Space)
     is
        Old : Wide_String_Access := Source.Reference;
- 
     begin
        Source.Reference := new Wide_String'
          (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
--- 908,913 ----
*************** package body Ada.Strings.Wide_Unbounded 
*** 847,853 ****
     ------------------------------
  
     function To_Unbounded_Wide_String
!      (Source : Wide_String) return Unbounded_Wide_String
     is
        Result : Unbounded_Wide_String;
     begin
--- 920,927 ----
     ------------------------------
  
     function To_Unbounded_Wide_String
!      (Source : Wide_String)
!       return Unbounded_Wide_String
     is
        Result : Unbounded_Wide_String;
     begin
*************** package body Ada.Strings.Wide_Unbounded 
*** 867,878 ****
        return Result;
     end To_Unbounded_Wide_String;
  
!    --------------------
     -- To_Wide_String --
     --------------------
  
     function To_Wide_String
!      (Source : Unbounded_Wide_String) return Wide_String
     is
     begin
        return Source.Reference (1 .. Source.Last);
--- 941,953 ----
        return Result;
     end To_Unbounded_Wide_String;
  
!    -------------------
     -- To_Wide_String --
     --------------------
  
     function To_Wide_String
!      (Source : Unbounded_Wide_String)
!       return Wide_String
     is
     begin
        return Source.Reference (1 .. Source.Last);
*************** package body Ada.Strings.Wide_Unbounded 
*** 884,894 ****
  
     function Translate
       (Source  : Unbounded_Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
--- 959,972 ----
  
     function Translate
       (Source  : Unbounded_Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping)
!       return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Translate
!              (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
*************** package body Ada.Strings.Wide_Unbounded 
*** 905,912 ****
        return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
--- 983,992 ----
        return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Translate
!             (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
*************** package body Ada.Strings.Wide_Unbounded 
*** 926,933 ****
        Side   : Trim_End) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
     end Trim;
  
     procedure Trim
--- 1006,1014 ----
        Side   : Trim_End) return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
     end Trim;
  
     procedure Trim
*************** package body Ada.Strings.Wide_Unbounded 
*** 936,943 ****
     is
        Old : Wide_String_Access := Source.Reference;
     begin
!       Source.Reference := new Wide_String'
!         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
--- 1017,1025 ----
     is
        Old : Wide_String_Access := Source.Reference;
     begin
!       Source.Reference :=
!         new Wide_String'
!           (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
*************** package body Ada.Strings.Wide_Unbounded 
*** 945,955 ****
     function Trim
       (Source : Unbounded_Wide_String;
        Left   : Wide_Maps.Wide_Character_Set;
!       Right  : Wide_Maps.Wide_Character_Set) return Unbounded_Wide_String
     is
     begin
!       return To_Unbounded_Wide_String
!         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
     end Trim;
  
     procedure Trim
--- 1027,1040 ----
     function Trim
       (Source : Unbounded_Wide_String;
        Left   : Wide_Maps.Wide_Character_Set;
!       Right  : Wide_Maps.Wide_Character_Set)
!       return Unbounded_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_String
!           (Wide_Fixed.Trim
!              (Source.Reference (1 .. Source.Last), Left, Right));
     end Trim;
  
     procedure Trim
*************** package body Ada.Strings.Wide_Unbounded 
*** 958,969 ****
        Right  : Wide_Maps.Wide_Character_Set)
     is
        Old : Wide_String_Access := Source.Reference;
- 
     begin
!       Source.Reference := new Wide_String'
!         (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Left, Right));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
  
  end Ada.Strings.Wide_Unbounded;
--- 1043,1087 ----
        Right  : Wide_Maps.Wide_Character_Set)
     is
        Old : Wide_String_Access := Source.Reference;
     begin
!       Source.Reference :=
!         new Wide_String'
!           (Wide_Fixed.Trim
!              (Source.Reference (1 .. Source.Last), Left, Right));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
  
+    ---------------------
+    -- Unbounded_Slice --
+    ---------------------
+ 
+    function Unbounded_Slice
+      (Source : Unbounded_Wide_String;
+       Low    : Positive;
+       High   : Natural) return Unbounded_Wide_String
+    is
+    begin
+       if Low > Source.Last + 1 or else High > Source.Last then
+          raise Index_Error;
+       else
+          return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
+       end if;
+    end Unbounded_Slice;
+ 
+    procedure Unbounded_Slice
+      (Source : Unbounded_Wide_String;
+       Target : out Unbounded_Wide_String;
+       Low    : Positive;
+       High   : Natural)
+    is
+    begin
+       if Low > Source.Last + 1 or else High > Source.Last then
+          raise Index_Error;
+       else
+          Target :=
+            To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
+       end if;
+    end Unbounded_Slice;
+ 
  end Ada.Strings.Wide_Unbounded;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stwiun.ads gcc-4.1.0/gcc/ada/a-stwiun.ads
*** gcc-4.0.2/gcc/ada/a-stwiun.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/a-stwiun.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Wide_Maps;
*** 39,45 ****
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Unbounded is
! pragma Preelaborate (Wide_Unbounded);
  
     type Unbounded_Wide_String is private;
  
--- 39,45 ----
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Unbounded is
!    pragma Preelaborate;
  
     type Unbounded_Wide_String is private;
  
*************** pragma Preelaborate (Wide_Unbounded);
*** 62,68 ****
       (Length : Natural) return Unbounded_Wide_String;
  
     function To_Wide_String
!      (Source : Unbounded_Wide_String) return Wide_String;
  
     procedure Append
       (Source   : in out Unbounded_Wide_String;
--- 62,74 ----
       (Length : Natural) return Unbounded_Wide_String;
  
     function To_Wide_String
!      (Source : Unbounded_Wide_String)
!       return Wide_String;
! 
!    procedure Set_Unbounded_Wide_String
!      (Target : out Unbounded_Wide_String;
!       Source : Wide_String);
!    pragma Ada_05 (Set_Unbounded_Wide_String);
  
     procedure Append
       (Source   : in out Unbounded_Wide_String;
*************** pragma Preelaborate (Wide_Unbounded);
*** 77,83 ****
        New_Item : Wide_Character);
  
     function "&"
!      (Left, Right : Unbounded_Wide_String) return Unbounded_Wide_String;
  
     function "&"
       (Left  : Unbounded_Wide_String;
--- 83,90 ----
        New_Item : Wide_Character);
  
     function "&"
!      (Left  : Unbounded_Wide_String;
!       Right : Unbounded_Wide_String) return Unbounded_Wide_String;
  
     function "&"
       (Left  : Unbounded_Wide_String;
*************** pragma Preelaborate (Wide_Unbounded);
*** 109,114 ****
--- 116,134 ----
        Low    : Positive;
        High   : Natural) return Wide_String;
  
+    function Unbounded_Slice
+      (Source : Unbounded_Wide_String;
+       Low    : Positive;
+       High   : Natural) return Unbounded_Wide_String;
+    pragma Ada_05 (Unbounded_Slice);
+ 
+    procedure Unbounded_Slice
+      (Source : Unbounded_Wide_String;
+       Target : out Unbounded_Wide_String;
+       Low    : Positive;
+       High   : Natural);
+    pragma Ada_05 (Unbounded_Slice);
+ 
     function "="
       (Left  : Unbounded_Wide_String;
        Right : Unbounded_Wide_String) return Boolean;
*************** pragma Preelaborate (Wide_Unbounded);
*** 192,201 ****
--- 212,252 ----
        Test   : Membership := Inside;
        Going  : Direction  := Forward) return Natural;
  
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Pattern : Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
+       return Natural;
+    pragma Ada_05 (Index);
+ 
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Pattern : Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural;
+    pragma Ada_05 (Index);
+ 
+    function Index
+      (Source  : Unbounded_Wide_String;
+       Set     : Wide_Maps.Wide_Character_Set;
+       From    : Positive;
+       Test    : Membership := Inside;
+       Going   : Direction := Forward) return Natural;
+    pragma Ada_05 (Index);
+ 
     function Index_Non_Blank
       (Source : Unbounded_Wide_String;
        Going  : Direction := Forward) return Natural;
  
+    function Index_Non_Blank
+      (Source : Unbounded_Wide_String;
+       From   : Positive;
+       Going  : Direction := Forward) return Natural;
+    pragma Ada_05 (Index_Non_Blank);
+ 
     function Count
       (Source  : Unbounded_Wide_String;
        Pattern : Wide_String;
*************** pragma Preelaborate (Wide_Unbounded);
*** 219,230 ****
        Last   : out Natural);
  
     ------------------------------------
!    -- Wide_String Translation Subprograms --
     ------------------------------------
  
     function Translate
       (Source  : Unbounded_Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping) return Unbounded_Wide_String;
  
     procedure Translate
       (Source  : in out Unbounded_Wide_String;
--- 270,282 ----
        Last   : out Natural);
  
     ------------------------------------
!    -- String Translation Subprograms --
     ------------------------------------
  
     function Translate
       (Source  : Unbounded_Wide_String;
!       Mapping : Wide_Maps.Wide_Character_Mapping)
!       return Unbounded_Wide_String;
  
     procedure Translate
       (Source  : in out Unbounded_Wide_String;
*************** pragma Preelaborate (Wide_Unbounded);
*** 240,246 ****
        Mapping : Wide_Maps.Wide_Character_Mapping_Function);
  
     ---------------------------------------
!    -- Wide_String Transformation Subprograms --
     ---------------------------------------
  
     function Replace_Slice
--- 292,298 ----
        Mapping : Wide_Maps.Wide_Character_Mapping_Function);
  
     ---------------------------------------
!    -- String Transformation Subprograms --
     ---------------------------------------
  
     function Replace_Slice
*************** pragma Preelaborate (Wide_Unbounded);
*** 250,259 ****
        By     : Wide_String) return Unbounded_Wide_String;
  
     procedure Replace_Slice
!      (Source   : in out Unbounded_Wide_String;
!       Low      : Positive;
!       High     : Natural;
!       By       : Wide_String);
  
     function Insert
       (Source   : Unbounded_Wide_String;
--- 302,311 ----
        By     : Wide_String) return Unbounded_Wide_String;
  
     procedure Replace_Slice
!      (Source : in out Unbounded_Wide_String;
!       Low    : Positive;
!       High   : Natural;
!       By     : Wide_String);
  
     function Insert
       (Source   : Unbounded_Wide_String;
*************** pragma Preelaborate (Wide_Unbounded);
*** 271,279 ****
        New_Item : Wide_String) return Unbounded_Wide_String;
  
     procedure Overwrite
!      (Source    : in out Unbounded_Wide_String;
!       Position  : Positive;
!       New_Item  : Wide_String);
  
     function Delete
       (Source  : Unbounded_Wide_String;
--- 323,331 ----
        New_Item : Wide_String) return Unbounded_Wide_String;
  
     procedure Overwrite
!      (Source   : in out Unbounded_Wide_String;
!       Position : Positive;
!       New_Item : Wide_String);
  
     function Delete
       (Source  : Unbounded_Wide_String;
*************** private
*** 361,372 ****
       (Unbounded_Wide_String, To_Unbounded_Wide, To_Wide_String);
  
     pragma Finalize_Storage_Only (Unbounded_Wide_String);
  
     procedure Initialize (Object : in out Unbounded_Wide_String);
     procedure Adjust     (Object : in out Unbounded_Wide_String);
     procedure Finalize   (Object : in out Unbounded_Wide_String);
  
     Null_Unbounded_Wide_String : constant Unbounded_Wide_String :=
!      (AF.Controlled with Reference => Null_Wide_String'Access, Last => 0);
  
  end Ada.Strings.Wide_Unbounded;
--- 413,441 ----
       (Unbounded_Wide_String, To_Unbounded_Wide, To_Wide_String);
  
     pragma Finalize_Storage_Only (Unbounded_Wide_String);
+    --  Finalization is required only for freeing storage
  
     procedure Initialize (Object : in out Unbounded_Wide_String);
     procedure Adjust     (Object : in out Unbounded_Wide_String);
     procedure Finalize   (Object : in out Unbounded_Wide_String);
  
+    procedure Realloc_For_Chunk
+      (Source     : in out Unbounded_Wide_String;
+       Chunk_Size : Natural);
+    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
+    --  is safe to add a string of this size at the end of the current content.
+    --  The real size allocated for the string is Chunk_Size + x of the current
+    --  string size. This buffered handling makes the Append unbounded string
+    --  routines very fast.
+ 
     Null_Unbounded_Wide_String : constant Unbounded_Wide_String :=
!                                   (AF.Controlled with
!                                      Reference => Null_Wide_String'Access,
!                                      Last => 0);
!    --  Note: this declaration is illegal since library level controlled
!    --  objects are not allowed in preelaborated units. See AI-161 for a
!    --  discussion of this issue and an attempt to address it. Meanwhile,
!    --  what happens in GNAT is that this check is omitted for internal
!    --  implementation units (see check in sem_cat.adb).
  
  end Ada.Strings.Wide_Unbounded;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzbou.adb gcc-4.1.0/gcc/ada/a-stzbou.adb
*** gcc-4.0.2/gcc/ada/a-stzbou.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzbou.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ W I D E _ B O U N D E D         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ W I D E _ B O U N D E D         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzbou.ads gcc-4.1.0/gcc/ada/a-stzbou.ads
*** gcc-4.0.2/gcc/ada/a-stzbou.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzbou.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Wide_Wide_Maps;
*** 39,45 ****
  with Ada.Strings.Wide_Wide_Superbounded;
  
  package Ada.Strings.Wide_Wide_Bounded is
! pragma Preelaborate (Wide_Wide_Bounded);
  
     generic
        Max : Positive;
--- 39,45 ----
  with Ada.Strings.Wide_Wide_Superbounded;
  
  package Ada.Strings.Wide_Wide_Bounded is
!    pragma Preelaborate;
  
     generic
        Max : Positive;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzfix.adb gcc-4.1.0/gcc/ada/a-stzfix.adb
*** gcc-4.0.2/gcc/ada/a-stzfix.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzfix.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . S T R I N G S . W I D E _ F I X E D                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzfix.ads gcc-4.1.0/gcc/ada/a-stzfix.ads
*** gcc-4.0.2/gcc/ada/a-stzfix.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzfix.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . S T R I N G S . W I D E _ W I D E _ F I X E D           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . S T R I N G S . W I D E _ W I D E _ F I X E D           --
  --                                                                          --
***************
*** 13,23 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  with Ada.Strings.Wide_Wide_Maps;
  
  package Ada.Strings.Wide_Wide_Fixed is
! pragma Preelaborate (Wide_Wide_Fixed);
  
     ------------------------------------------------------------------------
     -- Copy Procedure for Wide_Wide_Strings of Possibly Different Lengths --
--- 13,22 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with Ada.Strings.Wide_Wide_Maps;
  
  package Ada.Strings.Wide_Wide_Fixed is
!    pragma Preelaborate;
  
     ------------------------------------------------------------------------
     -- Copy Procedure for Wide_Wide_Strings of Possibly Different Lengths --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzhas.adb gcc-4.1.0/gcc/ada/a-stzhas.adb
*** gcc-4.0.2/gcc/ada/a-stzhas.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzhas.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** is
*** 50,59 ****
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 1) + Wide_Wide_Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Wide_Wide_Hash;
- 
- 
--- 50,57 ----
  begin
     Tmp := 0;
     for J in Key'Range loop
!       Tmp := Rotate_Left (Tmp, 3) + Wide_Wide_Character'Pos (Key (J));
     end loop;
  
     return Tmp;
  end Ada.Strings.Wide_Wide_Hash;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzhas.ads gcc-4.1.0/gcc/ada/a-stzhas.ads
*** gcc-4.0.2/gcc/ada/a-stzhas.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzhas.ads	Thu Jun 16 09:00:13 2005
*************** function Ada.Strings.Wide_Wide_Hash
*** 19,24 ****
    (Key : Wide_Wide_String) return Containers.Hash_Type;
  
  pragma Pure (Ada.Strings.Wide_Wide_Hash);
- 
- 
- 
--- 19,21 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzmap.adb gcc-4.1.0/gcc/ada/a-stzmap.adb
*** gcc-4.0.2/gcc/ada/a-stzmap.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzmap.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . S T R I N G S . W I D E _ W I D E _ M A P S            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . S T R I N G S . W I D E _ W I D E _ M A P S            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzmap.ads gcc-4.1.0/gcc/ada/a-stzmap.ads
*** gcc-4.0.2/gcc/ada/a-stzmap.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzmap.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Wide_Maps is
!    pragma Preelaborate (Wide_Wide_Maps);
  
     ------------------------------------------
     -- Wide_Wide_Character Set Declarations --
--- 38,44 ----
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Wide_Maps is
!    pragma Preelaborate;
  
     ------------------------------------------
     -- Wide_Wide_Character Set Declarations --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzsea.adb gcc-4.1.0/gcc/ada/a-stzsea.adb
*** gcc-4.0.2/gcc/ada/a-stzsea.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzsea.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . S T R I N G S . W I D E _ W I D E _ S E A R C H          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . S T R I N G S . W I D E _ W I D E _ S E A R C H          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzsea.ads gcc-4.1.0/gcc/ada/a-stzsea.ads
*** gcc-4.0.2/gcc/ada/a-stzsea.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzsea.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  with Ada.Strings.Wide_Wide_Maps;
  
  private package Ada.Strings.Wide_Wide_Search is
! pragma Preelaborate (Wide_Wide_Search);
  
     function Index
       (Source  : Wide_Wide_String;
--- 42,48 ----
  with Ada.Strings.Wide_Wide_Maps;
  
  private package Ada.Strings.Wide_Wide_Search is
!    pragma Preelaborate;
  
     function Index
       (Source  : Wide_Wide_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzsup.adb gcc-4.1.0/gcc/ada/a-stzsup.adb
*** gcc-4.0.2/gcc/ada/a-stzsup.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzsup.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ S U P E R B O U N D E D    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ S U P E R B O U N D E D    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzsup.ads gcc-4.1.0/gcc/ada/a-stzsup.ads
*** gcc-4.0.2/gcc/ada/a-stzsup.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzsup.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  with Ada.Strings.Wide_Wide_Maps;
  
  package Ada.Strings.Wide_Wide_Superbounded is
! pragma Preelaborate (Wide_Wide_Superbounded);
  
     Wide_Wide_NUL : constant Wide_Wide_Character :=
                       Wide_Wide_Character'Val (0);
--- 42,48 ----
  with Ada.Strings.Wide_Wide_Maps;
  
  package Ada.Strings.Wide_Wide_Superbounded is
!    pragma Preelaborate;
  
     Wide_Wide_NUL : constant Wide_Wide_Character :=
                       Wide_Wide_Character'Val (0);
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzunb.adb gcc-4.1.0/gcc/ada/a-stzunb.adb
*** gcc-4.0.2/gcc/ada/a-stzunb.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzunb.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 39,54 ****
  
     use Ada.Finalization;
  
-    procedure Realloc_For_Chunk
-      (Source     : in out Unbounded_Wide_Wide_String;
-       Chunk_Size : Natural);
-    pragma Inline (Realloc_For_Chunk);
-    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
-    --  is safe to add a string of this size at the end of the current content.
-    --  The real size allocated for the string is Chunk_Size + x of the current
-    --  string size. This buffered handling makes the Append unbounded wide
-    --  string routines very fast.
- 
     ---------
     -- "&" --
     ---------
--- 39,44 ----
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 142,148 ****
        Result.Reference (1) := Left;
        Result.Reference (2 .. Result.Last) :=
          Right.Reference (1 .. Right.Last);
- 
        return Result;
     end "&";
  
--- 132,137 ----
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 157,163 ****
        Result : Unbounded_Wide_Wide_String;
  
     begin
!       Result.Last := Left;
  
        Result.Reference := new Wide_Wide_String (1 .. Left);
        for J in Result.Reference'Range loop
--- 146,152 ----
        Result : Unbounded_Wide_Wide_String;
  
     begin
!       Result.Last   := Left;
  
        Result.Reference := new Wide_Wide_String (1 .. Left);
        for J in Result.Reference'Range loop
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 195,201 ****
     is
        Len    : constant Natural := Right.Last;
        K      : Positive;
!       Result   : Unbounded_Wide_Wide_String;
  
     begin
        Result.Last := Left * Len;
--- 184,190 ----
     is
        Len    : constant Natural := Right.Last;
        K      : Positive;
!       Result : Unbounded_Wide_Wide_String;
  
     begin
        Result.Last := Left * Len;
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 203,209 ****
        Result.Reference := new Wide_Wide_String (1 .. Result.Last);
  
        K := 1;
!       for I in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
--- 192,198 ----
        Result.Reference := new Wide_Wide_String (1 .. Result.Last);
  
        K := 1;
!       for J in 1 .. Left loop
           Result.Reference (K .. K + Len - 1) :=
             Right.Reference (1 .. Right.Last);
           K := K + Len;
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 417,427 ****
       (Source  : Unbounded_Wide_Wide_String;
        Pattern : Wide_Wide_String;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                         Wide_Wide_Maps.Identity) return Natural
     is
     begin
!       return Wide_Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
--- 406,418 ----
       (Source  : Unbounded_Wide_Wide_String;
        Pattern : Wide_Wide_String;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                   Wide_Wide_Maps.Identity)
!       return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Count
!           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 431,438 ****
        return Natural
     is
     begin
!       return Wide_Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
--- 422,430 ----
        return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Count
!           (Source.Reference (1 .. Source.Last), Pattern, Mapping);
     end Count;
  
     function Count
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 440,447 ****
        Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
     is
     begin
!       return Wide_Wide_Search.Count
!                (Source.Reference (1 .. Source.Last), Set);
     end Count;
  
     ------------
--- 432,440 ----
        Set    : Wide_Wide_Maps.Wide_Wide_Character_Set) return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Count
!         (Source.Reference (1 .. Source.Last), Set);
     end Count;
  
     ------------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 454,462 ****
        Through : Natural) return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Delete
!            (Source.Reference (1 .. Source.Last), From, Through));
     end Delete;
  
     procedure Delete
--- 447,456 ----
        Through : Natural) return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Delete
!              (Source.Reference (1 .. Source.Last), From, Through));
     end Delete;
  
     procedure Delete
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 506,512 ****
     procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation
!               (Wide_Wide_String, Wide_Wide_String_Access);
  
     begin
        --  Note: Don't try to free statically allocated null string
--- 500,506 ----
     procedure Finalize (Object : in out Unbounded_Wide_Wide_String) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation
!           (Wide_Wide_String, Wide_Wide_String_Access);
  
     begin
        --  Note: Don't try to free statically allocated null string
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 514,519 ****
--- 508,514 ----
        if Object.Reference /= Null_Wide_Wide_String'Access then
           Deallocate (Object.Reference);
           Object.Reference := Null_Unbounded_Wide_Wide_String.Reference;
+          Object.Last := 0;
        end if;
     end Finalize;
  
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 540,546 ****
     procedure Free (X : in out Wide_Wide_String_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation
!               (Wide_Wide_String, Wide_Wide_String_Access);
     begin
        --  Note: Do not try to free statically allocated null string
  
--- 535,542 ----
     procedure Free (X : in out Wide_Wide_String_Access) is
        procedure Deallocate is
          new Ada.Unchecked_Deallocation
!           (Wide_Wide_String, Wide_Wide_String_Access);
! 
     begin
        --  Note: Do not try to free statically allocated null string
  
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 560,569 ****
        return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Head
!              (Source.Reference (1 .. Source.Last), Count, Pad));
     end Head;
  
     procedure Head
--- 556,564 ----
        return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Head
!            (Source.Reference (1 .. Source.Last), Count, Pad));
     end Head;
  
     procedure Head
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 572,582 ****
        Pad    : Wide_Wide_Character := Wide_Wide_Space)
     is
        Old : Wide_Wide_String_Access := Source.Reference;
- 
     begin
!       Source.Reference := new Wide_Wide_String'
!         (Wide_Wide_Fixed.Head
!            (Source.Reference (1 .. Source.Last), Count, Pad));
        Source.Last := Source.Reference'Length;
        Free (Old);
     end Head;
--- 567,577 ----
        Pad    : Wide_Wide_Character := Wide_Wide_Space)
     is
        Old : Wide_Wide_String_Access := Source.Reference;
     begin
!       Source.Reference :=
!         new Wide_Wide_String'
!           (Wide_Wide_Fixed.Head
!              (Source.Reference (1 .. Source.Last), Count, Pad));
        Source.Last := Source.Reference'Length;
        Free (Old);
     end Head;
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 590,600 ****
        Pattern : Wide_Wide_String;
        Going   : Strings.Direction := Strings.Forward;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                         Wide_Wide_Maps.Identity) return Natural
     is
     begin
!       return Wide_Wide_Search.Index
!         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
--- 585,597 ----
        Pattern : Wide_Wide_String;
        Going   : Strings.Direction := Strings.Forward;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                   Wide_Wide_Maps.Identity)
!       return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Index
!           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 605,612 ****
        return Natural
     is
     begin
!       return Wide_Wide_Search.Index
!         (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
--- 602,610 ----
        return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Index
!           (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
     end Index;
  
     function Index
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 620,632 ****
          (Source.Reference (1 .. Source.Last), Set, Test, Going);
     end Index;
  
     function Index_Non_Blank
       (Source : Unbounded_Wide_Wide_String;
        Going  : Strings.Direction := Strings.Forward) return Natural
     is
     begin
!       return Wide_Wide_Search.Index_Non_Blank
!         (Source.Reference (1 .. Source.Last), Going);
     end Index_Non_Blank;
  
     ----------------
--- 618,684 ----
          (Source.Reference (1 .. Source.Last), Set, Test, Going);
     end Index;
  
+    function Index
+      (Source  : Unbounded_Wide_Wide_String;
+       Pattern : Wide_Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
+                   Wide_Wide_Maps.Identity)
+       return Natural
+    is
+    begin
+       return
+         Wide_Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+    end Index;
+ 
+    function Index
+      (Source  : Unbounded_Wide_Wide_String;
+       Pattern : Wide_Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
+       return Natural
+    is
+    begin
+       return
+         Wide_Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
+    end Index;
+ 
+    function Index
+      (Source : Unbounded_Wide_Wide_String;
+       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
+       From   : Positive;
+       Test   : Membership := Inside;
+       Going  : Direction := Forward) return Natural
+    is
+    begin
+       return
+         Wide_Wide_Search.Index
+           (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
+    end Index;
+ 
     function Index_Non_Blank
       (Source : Unbounded_Wide_Wide_String;
        Going  : Strings.Direction := Strings.Forward) return Natural
     is
     begin
!       return
!         Wide_Wide_Search.Index_Non_Blank
!           (Source.Reference (1 .. Source.Last), Going);
!    end Index_Non_Blank;
! 
!    function Index_Non_Blank
!      (Source : Unbounded_Wide_Wide_String;
!       From   : Positive;
!       Going  : Direction := Forward) return Natural
!    is
!    begin
!       return
!         Wide_Wide_Search.Index_Non_Blank
!           (Source.Reference (1 .. Source.Last), From, Going);
     end Index_Non_Blank;
  
     ----------------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 649,657 ****
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Insert
!            (Source.Reference (1 .. Source.Last), Before, New_Item));
     end Insert;
  
     procedure Insert
--- 701,710 ----
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Insert
!              (Source.Reference (1 .. Source.Last), Before, New_Item));
     end Insert;
  
     procedure Insert
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 693,701 ****
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Overwrite
!            (Source.Reference (1 .. Source.Last), Position, New_Item));
     end Overwrite;
  
     procedure Overwrite
--- 746,755 ----
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Overwrite
!             (Source.Reference (1 .. Source.Last), Position, New_Item));
     end Overwrite;
  
     procedure Overwrite
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 704,718 ****
        New_Item  : Wide_Wide_String)
     is
        NL : constant Natural := New_Item'Length;
- 
     begin
        if Position <= Source.Last - NL + 1 then
           Source.Reference (Position .. Position + NL - 1) := New_Item;
- 
        else
           declare
              Old : Wide_Wide_String_Access := Source.Reference;
- 
           begin
              Source.Reference := new Wide_Wide_String'
                (Wide_Wide_Fixed.Overwrite
--- 758,769 ----
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 731,748 ****
       (Source     : in out Unbounded_Wide_Wide_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 50;
!       S_Length      : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             Alloc_Chunk_Size : constant Positive :=
!                                  Chunk_Size + (S_Length / Growth_Factor);
!             Tmp : Wide_Wide_String_Access;
  
           begin
-             Tmp := new Wide_Wide_String (1 .. S_Length + Alloc_Chunk_Size);
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
--- 782,817 ----
       (Source     : in out Unbounded_Wide_Wide_String;
        Chunk_Size : Natural)
     is
!       Growth_Factor : constant := 32;
!       --  The growth factor controls how much extra space is allocated when
!       --  we have to increase the size of an allocated unbounded string. By
!       --  allocating extra space, we avoid the need to reallocate on every
!       --  append, particularly important when a string is built up by repeated
!       --  append operations of small pieces. This is expressed as a factor so
!       --  32 means add 1/32 of the length of the string as growth space.
! 
!       Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
!       --  Allocation will be done by a multiple of Min_Mul_Alloc This causes
!       --  no memory loss as most (all?) malloc implementations are obliged to
!       --  align the returned memory on the maximum alignment as malloc does not
!       --  know the target alignment.
! 
!       S_Length : constant Natural := Source.Reference'Length;
  
     begin
        if Chunk_Size > S_Length - Source.Last then
           declare
!             New_Size : constant Positive :=
!                          S_Length + Chunk_Size + (S_Length / Growth_Factor);
! 
!             New_Rounded_Up_Size : constant Positive :=
!                                     ((New_Size - 1) / Min_Mul_Alloc + 1) *
!                                        Min_Mul_Alloc;
! 
!             Tmp : constant Wide_Wide_String_Access :=
!                     new Wide_Wide_String (1 .. New_Rounded_Up_Size);
  
           begin
              Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
              Free (Source.Reference);
              Source.Reference := Tmp;
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 778,797 ****
        By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
          (Wide_Wide_Fixed.Replace_Slice
             (Source.Reference (1 .. Source.Last), Low, High, By));
     end Replace_Slice;
  
     procedure Replace_Slice
!      (Source   : in out Unbounded_Wide_Wide_String;
!       Low      : Positive;
!       High     : Natural;
!       By       : Wide_Wide_String)
     is
        Old : Wide_Wide_String_Access := Source.Reference;
- 
     begin
        Source.Reference := new Wide_Wide_String'
          (Wide_Wide_Fixed.Replace_Slice
--- 847,864 ----
        By     : Wide_Wide_String) return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
          (Wide_Wide_Fixed.Replace_Slice
             (Source.Reference (1 .. Source.Last), Low, High, By));
     end Replace_Slice;
  
     procedure Replace_Slice
!      (Source : in out Unbounded_Wide_Wide_String;
!       Low    : Positive;
!       High   : Natural;
!       By     : Wide_Wide_String)
     is
        Old : Wide_Wide_String_Access := Source.Reference;
     begin
        Source.Reference := new Wide_Wide_String'
          (Wide_Wide_Fixed.Replace_Slice
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 800,805 ****
--- 867,886 ----
        Free (Old);
     end Replace_Slice;
  
+    ------------------------------------
+    -- Set_Unbounded_Wide_Wide_String --
+    ------------------------------------
+ 
+    procedure Set_Unbounded_Wide_Wide_String
+      (Target : out Unbounded_Wide_Wide_String;
+       Source : Wide_Wide_String)
+    is
+    begin
+       Target.Last          := Source'Length;
+       Target.Reference     := new Wide_Wide_String (1 .. Source'Length);
+       Target.Reference.all := Source;
+    end Set_Unbounded_Wide_Wide_String;
+ 
     -----------
     -- Slice --
     -----------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 814,820 ****
  
        if Low > Source.Last + 1 or else High > Source.Last then
           raise Index_Error;
- 
        else
           return Source.Reference (Low .. High);
        end if;
--- 895,900 ----
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 828,835 ****
       (Source : Unbounded_Wide_Wide_String;
        Count  : Natural;
        Pad    : Wide_Wide_Character := Wide_Wide_Space)
!       return Unbounded_Wide_Wide_String
!    is
     begin
        return To_Unbounded_Wide_Wide_String
          (Wide_Wide_Fixed.Tail
--- 908,914 ----
       (Source : Unbounded_Wide_Wide_String;
        Count  : Natural;
        Pad    : Wide_Wide_Character := Wide_Wide_Space)
!       return Unbounded_Wide_Wide_String is
     begin
        return To_Unbounded_Wide_Wide_String
          (Wide_Wide_Fixed.Tail
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 842,848 ****
        Pad    : Wide_Wide_Character := Wide_Wide_Space)
     is
        Old : Wide_Wide_String_Access := Source.Reference;
- 
     begin
        Source.Reference := new Wide_Wide_String'
          (Wide_Wide_Fixed.Tail
--- 921,926 ----
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 851,859 ****
        Free (Old);
     end Tail;
  
!    ------------------------------
     -- To_Unbounded_Wide_Wide_String --
!    ------------------------------
  
     function To_Unbounded_Wide_Wide_String
       (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
--- 929,937 ----
        Free (Old);
     end Tail;
  
!    -----------------------------------
     -- To_Unbounded_Wide_Wide_String --
!    -----------------------------------
  
     function To_Unbounded_Wide_Wide_String
       (Source : Wide_Wide_String) return Unbounded_Wide_Wide_String
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 876,884 ****
        return Result;
     end To_Unbounded_Wide_Wide_String;
  
!    --------------------
     -- To_Wide_Wide_String --
!    --------------------
  
     function To_Wide_Wide_String
       (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String
--- 954,962 ----
        return Result;
     end To_Unbounded_Wide_Wide_String;
  
!    -------------------------
     -- To_Wide_Wide_String --
!    -------------------------
  
     function To_Wide_Wide_String
       (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 897,905 ****
        return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Translate
!            (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
--- 975,984 ----
        return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Translate
!              (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 907,914 ****
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
     is
     begin
!       Wide_Wide_Fixed.Translate
!         (Source.Reference (1 .. Source.Last), Mapping);
     end Translate;
  
     function Translate
--- 986,992 ----
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping)
     is
     begin
!       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
     end Translate;
  
     function Translate
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 917,925 ****
        return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Translate
!            (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
--- 995,1004 ----
        return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Translate
!             (Source.Reference (1 .. Source.Last), Mapping));
     end Translate;
  
     procedure Translate
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 927,934 ****
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
     is
     begin
!       Wide_Wide_Fixed.Translate
!         (Source.Reference (1 .. Source.Last), Mapping);
     end Translate;
  
     ----------
--- 1006,1012 ----
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
     is
     begin
!       Wide_Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
     end Translate;
  
     ----------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 940,947 ****
        Side   : Trim_End) return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
     end Trim;
  
     procedure Trim
--- 1018,1026 ----
        Side   : Trim_End) return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
     end Trim;
  
     procedure Trim
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 964,972 ****
        return Unbounded_Wide_Wide_String
     is
     begin
!       return To_Unbounded_Wide_Wide_String
!         (Wide_Wide_Fixed.Trim
!            (Source.Reference (1 .. Source.Last), Left, Right));
     end Trim;
  
     procedure Trim
--- 1043,1052 ----
        return Unbounded_Wide_Wide_String
     is
     begin
!       return
!         To_Unbounded_Wide_Wide_String
!           (Wide_Wide_Fixed.Trim
!              (Source.Reference (1 .. Source.Last), Left, Right));
     end Trim;
  
     procedure Trim
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 976,986 ****
     is
        Old : Wide_Wide_String_Access := Source.Reference;
     begin
!       Source.Reference := new Wide_Wide_String'
!         (Wide_Wide_Fixed.Trim
!            (Source.Reference (1 .. Source.Last), Left, Right));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
  
  end Ada.Strings.Wide_Wide_Unbounded;
--- 1056,1100 ----
     is
        Old : Wide_Wide_String_Access := Source.Reference;
     begin
!       Source.Reference :=
!         new Wide_Wide_String'
!           (Wide_Wide_Fixed.Trim
!              (Source.Reference (1 .. Source.Last), Left, Right));
        Source.Last      := Source.Reference'Length;
        Free (Old);
     end Trim;
  
+    ---------------------
+    -- Unbounded_Slice --
+    ---------------------
+ 
+    function Unbounded_Slice
+      (Source : Unbounded_Wide_Wide_String;
+       Low    : Positive;
+       High   : Natural) return Unbounded_Wide_Wide_String
+    is
+    begin
+       if Low > Source.Last + 1 or else High > Source.Last then
+          raise Index_Error;
+       else
+          return
+            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
+       end if;
+    end Unbounded_Slice;
+ 
+    procedure Unbounded_Slice
+      (Source : Unbounded_Wide_Wide_String;
+       Target : out Unbounded_Wide_Wide_String;
+       Low    : Positive;
+       High   : Natural)
+    is
+    begin
+       if Low > Source.Last + 1 or else High > Source.Last then
+          raise Index_Error;
+       else
+          Target :=
+            To_Unbounded_Wide_Wide_String (Source.Reference.all (Low .. High));
+       end if;
+    end Unbounded_Slice;
+ 
  end Ada.Strings.Wide_Wide_Unbounded;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-stzunb.ads gcc-4.1.0/gcc/ada/a-stzunb.ads
*** gcc-4.0.2/gcc/ada/a-stzunb.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-stzunb.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Wide_Wide_Maps;
*** 39,45 ****
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Wide_Unbounded is
! pragma Preelaborate (Wide_Wide_Unbounded);
  
     type Unbounded_Wide_Wide_String is private;
  
--- 39,45 ----
  with Ada.Finalization;
  
  package Ada.Strings.Wide_Wide_Unbounded is
!    pragma Preelaborate;
  
     type Unbounded_Wide_Wide_String is private;
  
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 64,69 ****
--- 64,74 ----
     function To_Wide_Wide_String
       (Source : Unbounded_Wide_Wide_String) return Wide_Wide_String;
  
+    procedure Set_Unbounded_Wide_Wide_String
+      (Target : out Unbounded_Wide_Wide_String;
+       Source : Wide_Wide_String);
+    pragma Ada_05 (Set_Unbounded_Wide_Wide_String);
+ 
     procedure Append
       (Source   : in out Unbounded_Wide_Wide_String;
        New_Item : Unbounded_Wide_Wide_String);
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 77,84 ****
        New_Item : Wide_Wide_Character);
  
     function "&"
!      (Left, Right : Unbounded_Wide_Wide_String)
!      return Unbounded_Wide_Wide_String;
  
     function "&"
       (Left  : Unbounded_Wide_Wide_String;
--- 82,89 ----
        New_Item : Wide_Wide_Character);
  
     function "&"
!      (Left  : Unbounded_Wide_Wide_String;
!       Right : Unbounded_Wide_Wide_String) return Unbounded_Wide_Wide_String;
  
     function "&"
       (Left  : Unbounded_Wide_Wide_String;
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 110,115 ****
--- 115,133 ----
        Low    : Positive;
        High   : Natural) return Wide_Wide_String;
  
+    function Unbounded_Slice
+      (Source : Unbounded_Wide_Wide_String;
+       Low    : Positive;
+       High   : Natural) return Unbounded_Wide_Wide_String;
+       pragma Ada_05 (Unbounded_Slice);
+ 
+    procedure Unbounded_Slice
+      (Source : Unbounded_Wide_Wide_String;
+       Target : out Unbounded_Wide_Wide_String;
+       Low    : Positive;
+       High   : Natural);
+       pragma Ada_05 (Unbounded_Slice);
+ 
     function "="
       (Left  : Unbounded_Wide_Wide_String;
        Right : Unbounded_Wide_Wide_String) return Boolean;
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 179,185 ****
        Pattern : Wide_Wide_String;
        Going   : Direction := Forward;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                    Wide_Wide_Maps.Identity) return Natural;
  
     function Index
       (Source  : Unbounded_Wide_Wide_String;
--- 197,204 ----
        Pattern : Wide_Wide_String;
        Going   : Direction := Forward;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                   Wide_Wide_Maps.Identity)
!       return Natural;
  
     function Index
       (Source  : Unbounded_Wide_Wide_String;
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 194,208 ****
        Test   : Membership := Inside;
        Going  : Direction  := Forward) return Natural;
  
     function Index_Non_Blank
       (Source : Unbounded_Wide_Wide_String;
        Going  : Direction := Forward) return Natural;
  
     function Count
       (Source  : Unbounded_Wide_Wide_String;
        Pattern : Wide_Wide_String;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                   Wide_Wide_Maps.Identity) return Natural;
  
     function Count
       (Source  : Unbounded_Wide_Wide_String;
--- 213,261 ----
        Test   : Membership := Inside;
        Going  : Direction  := Forward) return Natural;
  
+    function Index
+      (Source  : Unbounded_Wide_Wide_String;
+       Pattern : Wide_Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
+                   Wide_Wide_Maps.Identity)
+       return Natural;
+    pragma Ada_05 (Index);
+ 
+    function Index
+      (Source  : Unbounded_Wide_Wide_String;
+       Pattern : Wide_Wide_String;
+       From    : Positive;
+       Going   : Direction := Forward;
+       Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function)
+       return Natural;
+    pragma Ada_05 (Index);
+ 
+    function Index
+      (Source : Unbounded_Wide_Wide_String;
+       Set    : Wide_Wide_Maps.Wide_Wide_Character_Set;
+       From   : Positive;
+       Test   : Membership := Inside;
+       Going  : Direction := Forward) return Natural;
+    pragma Ada_05 (Index);
+ 
+    function Index_Non_Blank
+      (Source : Unbounded_Wide_Wide_String;
+       Going  : Direction := Forward) return Natural;
+ 
     function Index_Non_Blank
       (Source : Unbounded_Wide_Wide_String;
+       From   : Positive;
        Going  : Direction := Forward) return Natural;
+    pragma Ada_05 (Index_Non_Blank);
  
     function Count
       (Source  : Unbounded_Wide_Wide_String;
        Pattern : Wide_Wide_String;
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
!                   Wide_Wide_Maps.Identity)
!       return Natural;
  
     function Count
       (Source  : Unbounded_Wide_Wide_String;
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 222,228 ****
        Last   : out Natural);
  
     ------------------------------------
!    -- Wide_Wide_String Translation Subprograms --
     ------------------------------------
  
     function Translate
--- 275,281 ----
        Last   : out Natural);
  
     ------------------------------------
!    -- String Translation Subprograms --
     ------------------------------------
  
     function Translate
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 244,250 ****
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function);
  
     ---------------------------------------
!    -- Wide_Wide_String Transformation Subprograms --
     ---------------------------------------
  
     function Replace_Slice
--- 297,303 ----
        Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping_Function);
  
     ---------------------------------------
!    -- String Transformation Subprograms --
     ---------------------------------------
  
     function Replace_Slice
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 254,263 ****
        By     : Wide_Wide_String) return Unbounded_Wide_Wide_String;
  
     procedure Replace_Slice
!      (Source   : in out Unbounded_Wide_Wide_String;
!       Low      : Positive;
!       High     : Natural;
!       By       : Wide_Wide_String);
  
     function Insert
       (Source   : Unbounded_Wide_Wide_String;
--- 307,316 ----
        By     : Wide_Wide_String) return Unbounded_Wide_Wide_String;
  
     procedure Replace_Slice
!      (Source : in out Unbounded_Wide_Wide_String;
!       Low    : Positive;
!       High   : Natural;
!       By     : Wide_Wide_String);
  
     function Insert
       (Source   : Unbounded_Wide_Wide_String;
*************** pragma Preelaborate (Wide_Wide_Unbounded
*** 275,283 ****
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String;
  
     procedure Overwrite
!      (Source    : in out Unbounded_Wide_Wide_String;
!       Position  : Positive;
!       New_Item  : Wide_Wide_String);
  
     function Delete
       (Source  : Unbounded_Wide_Wide_String;
--- 328,336 ----
        New_Item : Wide_Wide_String) return Unbounded_Wide_Wide_String;
  
     procedure Overwrite
!      (Source   : in out Unbounded_Wide_Wide_String;
!       Position : Positive;
!       New_Item : Wide_Wide_String);
  
     function Delete
       (Source  : Unbounded_Wide_Wide_String;
*************** private
*** 351,361 ****
  
     function To_Unbounded_Wide
       (S : Wide_Wide_String) return Unbounded_Wide_Wide_String
!       renames To_Unbounded_Wide_Wide_String;
  
     type Unbounded_Wide_Wide_String is new AF.Controlled with record
        Reference : Wide_Wide_String_Access := Null_Wide_Wide_String'Access;
!       Last      : Natural := 0;
     end record;
  
     --  The Unbounded_Wide_Wide_String is using a buffered implementation to
--- 404,414 ----
  
     function To_Unbounded_Wide
       (S : Wide_Wide_String) return Unbounded_Wide_Wide_String
!      renames To_Unbounded_Wide_Wide_String;
  
     type Unbounded_Wide_Wide_String is new AF.Controlled with record
        Reference : Wide_Wide_String_Access := Null_Wide_Wide_String'Access;
!       Last      : Natural            := 0;
     end record;
  
     --  The Unbounded_Wide_Wide_String is using a buffered implementation to
*************** private
*** 369,380 ****
       (Unbounded_Wide_Wide_String, To_Unbounded_Wide, To_Wide_Wide_String);
  
     pragma Finalize_Storage_Only (Unbounded_Wide_Wide_String);
  
     procedure Initialize (Object : in out Unbounded_Wide_Wide_String);
     procedure Adjust     (Object : in out Unbounded_Wide_Wide_String);
     procedure Finalize   (Object : in out Unbounded_Wide_Wide_String);
  
     Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
!      (AF.Controlled with Reference => Null_Wide_Wide_String'Access, Last => 0);
  
  end Ada.Strings.Wide_Wide_Unbounded;
--- 422,450 ----
       (Unbounded_Wide_Wide_String, To_Unbounded_Wide, To_Wide_Wide_String);
  
     pragma Finalize_Storage_Only (Unbounded_Wide_Wide_String);
+    --  Finalization is required only for freeing storage
  
     procedure Initialize (Object : in out Unbounded_Wide_Wide_String);
     procedure Adjust     (Object : in out Unbounded_Wide_Wide_String);
     procedure Finalize   (Object : in out Unbounded_Wide_Wide_String);
+    procedure Realloc_For_Chunk
+      (Source     : in out Unbounded_Wide_Wide_String;
+       Chunk_Size : Natural);
+    --  Adjust the size allocated for the string. Add at least Chunk_Size so it
+    --  is safe to add a string of this size at the end of the current content.
+    --  The real size allocated for the string is Chunk_Size + x of the current
+    --  string size. This buffered handling makes the Append unbounded string
+    --  routines very fast.
  
     Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
!                                        (AF.Controlled with
!                                           Reference =>
!                                             Null_Wide_Wide_String'Access,
!                                           Last => 0);
!    --  Note: this declaration is illegal since library level controlled
!    --  objects are not allowed in preelaborated units. See AI-161 for a
!    --  discussion of this issue and an attempt to address it. Meanwhile,
!    --  what happens in GNAT is that this check is omitted for internal
!    --  implementation units (see check in sem_cat.adb).
  
  end Ada.Strings.Wide_Wide_Unbounded;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-suteio.adb gcc-4.1.0/gcc/ada/a-suteio.adb
*** gcc-4.0.2/gcc/ada/a-suteio.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-suteio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . S T R I N G S . U N B O U N D E D . T E X T _ I O        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . S T R I N G S . U N B O U N D E D . T E X T _ I O        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
! with Ada.Text_IO;               use Ada.Text_IO;
  
  package body Ada.Strings.Unbounded.Text_IO is
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Text_IO; use Ada.Text_IO;
  
  package body Ada.Strings.Unbounded.Text_IO is
  
*************** package body Ada.Strings.Unbounded.Text_
*** 57,63 ****
           Str1 := Str2;
        end loop;
  
!       Set_String (Result, Str1);
        return Result;
     end Get_Line;
  
--- 56,63 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
*************** package body Ada.Strings.Unbounded.Text_
*** 78,126 ****
           Str1 := Str2;
        end loop;
  
!       Set_String (Result, Str1);
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_String) is
-       Buffer : String (1 .. 1000);
-       Last   : Natural;
-       Str1   : String_Access;
-       Str2   : String_Access;
- 
     begin
!       Get_Line (Buffer, Last);
!       Str1 := new String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
! 
!       Set_String (Item, Str1);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Text_IO.File_Type;
        Item : out Unbounded_String)
     is
-       Buffer : String (1 .. 1000);
-       Last   : Natural;
-       Str1   : String_Access;
-       Str2   : String_Access;
- 
     begin
!       Get_Line (File, Buffer, Last);
!       Str1 := new String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
  
!       Set_String (Item, Str1);
     end Get_Line;
  
     ---------
--- 78,129 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_String) is
     begin
!       Get_Line (Current_Input, Item);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Text_IO.File_Type;
        Item : out Unbounded_String)
     is
     begin
!       --  We are going to read into the string that is already there and
!       --  allocated. Hopefully it is big enough now, if not, we will extend
!       --  it in the usual manner using Realloc_For_Chunk.
  
!       --  Make sure we start with at least 80 characters
! 
!       if Item.Reference'Last < 80 then
!          Realloc_For_Chunk (Item, 80);
!       end if;
! 
!       --  Loop to read data, filling current string as far as possible.
!       --  Item.Last holds the number of characters read so far.
! 
!       Item.Last := 0;
!       loop
!          Get_Line
!            (File,
!             Item.Reference (Item.Last + 1 .. Item.Reference'Last),
!             Item.Last);
! 
!          --  If we hit the end of the line before the end of the buffer, then
!          --  we are all done, and the result length is properly set.
! 
!          if Item.Last < Item.Reference'Last then
!             return;
!          end if;
! 
!          --  If not enough room, double it and keep reading
! 
!          Realloc_For_Chunk (Item, Item.Last);
!       end loop;
     end Get_Line;
  
     ---------
*************** package body Ada.Strings.Unbounded.Text_
*** 129,140 ****
  
     procedure Put (U : Unbounded_String) is
     begin
!       Put (Get_String (U).all);
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_String) is
     begin
!       Put (File, Get_String (U).all);
     end Put;
  
     --------------
--- 132,143 ----
  
     procedure Put (U : Unbounded_String) is
     begin
!       Put (U.Reference (1 .. U.Last));
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_String) is
     begin
!       Put (File, U.Reference (1 .. U.Last));
     end Put;
  
     --------------
*************** package body Ada.Strings.Unbounded.Text_
*** 143,154 ****
  
     procedure Put_Line (U : Unbounded_String) is
     begin
!       Put_Line (Get_String (U).all);
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_String) is
     begin
!       Put_Line (File, Get_String (U).all);
     end Put_Line;
  
  end Ada.Strings.Unbounded.Text_IO;
--- 146,157 ----
  
     procedure Put_Line (U : Unbounded_String) is
     begin
!       Put_Line (U.Reference (1 .. U.Last));
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_String) is
     begin
!       Put_Line (File, U.Reference (1 .. U.Last));
     end Put_Line;
  
  end Ada.Strings.Unbounded.Text_IO;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-suteio.ads gcc-4.1.0/gcc/ada/a-suteio.ads
*** gcc-4.0.2/gcc/ada/a-suteio.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-suteio.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . S T R I N G S . U N B O U N D E D . T E X T _ I O        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . S T R I N G S . U N B O U N D E D . T E X T _ I O        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swmwco.ads gcc-4.1.0/gcc/ada/a-swmwco.ads
*** gcc-4.0.2/gcc/ada/a-swmwco.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-swmwco.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Characters.Wide_Latin_1;
  
  package Ada.Strings.Wide_Maps.Wide_Constants is
! pragma Preelaborate (Wide_Constants);
  
     Control_Set           : constant Wide_Maps.Wide_Character_Set;
     Graphic_Set           : constant Wide_Maps.Wide_Character_Set;
--- 38,44 ----
  with Ada.Characters.Wide_Latin_1;
  
  package Ada.Strings.Wide_Maps.Wide_Constants is
!    pragma Preelaborate;
  
     Control_Set           : constant Wide_Maps.Wide_Character_Set;
     Graphic_Set           : constant Wide_Maps.Wide_Character_Set;
*************** private
*** 182,188 ****
       (AF.Controlled with
        Character_Ranges'Unrestricted_Access);
  
- 
     Lower_Case_Mapping : aliased constant Wide_Character_Mapping_Values :=
       (Length => 56,
  
--- 182,187 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swunau.adb gcc-4.1.0/gcc/ada/a-swunau.adb
*** gcc-4.0.2/gcc/ada/a-swunau.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-swunau.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ U N B O U N D E D . A U X       --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ U N B O U N D E D . A U X       --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Strings.Wide_Unbounded.
*** 37,69 ****
     -- Get_Wide_String --
     ---------------------
  
!    function Get_Wide_String
!      (U : Unbounded_Wide_String) return Wide_String_Access
     is
     begin
!       if U.Last = U.Reference'Length then
!          return U.Reference;
! 
!       else
!          declare
!             type Unbounded_Wide_String_Access is
!               access all Unbounded_Wide_String;
! 
!             U_Ptr : constant Unbounded_Wide_String_Access :=
!                       U'Unrestricted_Access;
!             --  Unbounded_Wide_String is a controlled type which is always
!             --  passed by copy it is always safe to take the pointer to such
!             --  object here. This pointer is used to set the U.Reference value
!             --  which would not be possible otherwise as U is read-only.
! 
!             Old : Wide_String_Access := U.Reference;
! 
!          begin
!             U_Ptr.Reference := new Wide_String'(U.Reference (1 .. U.Last));
!             Free (Old);
!             return U.Reference;
!          end;
!       end if;
     end Get_Wide_String;
  
     ---------------------
--- 37,50 ----
     -- Get_Wide_String --
     ---------------------
  
!    procedure Get_Wide_String
!      (U : Unbounded_Wide_String;
!       S : out Wide_String_Access;
!       L : out Natural)
     is
     begin
!       S := U.Reference;
!       L := U.Last;
     end Get_Wide_String;
  
     ---------------------
*************** package body Ada.Strings.Wide_Unbounded.
*** 75,94 ****
        S  : Wide_String)
     is
     begin
!       if UP.Last = S'Length then
!          UP.Reference.all := S;
! 
!       else
!          declare
!             subtype String_1 is Wide_String (1 .. S'Length);
!             Tmp : Wide_String_Access;
!          begin
!             Tmp := new Wide_String'(String_1 (S));
!             Finalize (UP);
!             UP.Reference := Tmp;
!             UP.Last := UP.Reference'Length;
!          end;
        end if;
     end Set_Wide_String;
  
     procedure Set_Wide_String
--- 56,68 ----
        S  : Wide_String)
     is
     begin
!       if S'Length > UP.Last then
!          Finalize (UP);
!          UP.Reference := new Wide_String (1 .. S'Length);
        end if;
+ 
+       UP.Reference (1 .. S'Length) := S;
+       UP.Last := S'Length;
     end Set_Wide_String;
  
     procedure Set_Wide_String
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swunau.ads gcc-4.1.0/gcc/ada/a-swunau.ads
*** gcc-4.0.2/gcc/ada/a-swunau.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-swunau.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ U N B O U N D E D . A U X       --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --        A D A . S T R I N G S . W I D E _ U N B O U N D E D . A U X       --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,58 ****
  --  utilities.
  
  package Ada.Strings.Wide_Unbounded.Aux is
! pragma Preelaborate (Aux);
  
!    function Get_Wide_String
!      (U : Unbounded_Wide_String) return Wide_String_Access;
     pragma Inline (Get_Wide_String);
!    --  This function returns the internal string pointer used in the
!    --  representation of an unbounded string. There is no copy involved,
!    --  so the value obtained references the same string as the original
!    --  unbounded string. The characters of this string may not be modified
!    --  via the returned pointer, and are valid only as long as the original
!    --  unbounded string is not modified. Violating either of these two
!    --  rules results in erroneous execution.
     --
!    --  This function is much more efficient than the use of To_Wide_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one.
  
     procedure Set_Wide_String
       (UP : in out Unbounded_Wide_String;
--- 37,60 ----
  --  utilities.
  
  package Ada.Strings.Wide_Unbounded.Aux is
!    pragma Preelaborate;
  
!    procedure Get_Wide_String
!      (U : Unbounded_Wide_String;
!       S : out Wide_String_Access;
!       L : out Natural);
     pragma Inline (Get_Wide_String);
!    --  This procedure returns the internal string pointer used in the
!    --  representation of an unbounded string as well as the actual current
!    --  length (which may be less than S.all'Length because in general there
!    --  can be extra space assigned). The characters of this string may be
!    --  not be modified via the returned pointer,  and are valid only as
!    --  long as the original unbounded string is not accessed or modified.
     --
!    --  This procedure is much more efficient than the use of To_Wide_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one, so the actual
!    --  string data is always accessible as S (1 .. L).
  
     procedure Set_Wide_String
       (UP : in out Unbounded_Wide_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swunha.adb gcc-4.1.0/gcc/ada/a-swunha.adb
*** gcc-4.0.2/gcc/ada/a-swunha.adb	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-swunha.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,57 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT LIBRARY COMPONENTS                          --
- --                                                                          --
- --                     ADA.STRINGS.WIDE_UNBOUNDED.HASH                      --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --             Copyright (C) 2004 Free Software Foundation, Inc.            --
- --                                                                          --
- -- This specification is derived from the Ada Reference Manual for use with --
- -- GNAT. The copyright notice above, and the license provisions that follow --
- -- apply solely to the  contents of the part following the private keyword. --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- This unit was originally developed by Matthew J Heaney.                  --
- ------------------------------------------------------------------------------
- 
- --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
- 
- function Ada.Strings.Wide_Unbounded.Hash
-   (Key : Unbounded_Wide_String) return Containers.Hash_Type
- is
-    use Ada.Containers;
- 
-    function Rotate_Left
-      (Value  : Hash_Type;
-       Amount : Natural) return Hash_Type;
-    pragma Import (Intrinsic, Rotate_Left);
- 
-    Tmp : Hash_Type;
- 
- begin
-    Tmp := 0;
-    for J in 1 .. Key.Last loop
-       Tmp := Rotate_Left (Tmp, 1) + Wide_Character'Pos (Key.Reference (J));
-    end loop;
- 
-    return Tmp;
- end Ada.Strings.Wide_Unbounded.Hash;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swunha.ads gcc-4.1.0/gcc/ada/a-swunha.ads
*** gcc-4.0.2/gcc/ada/a-swunha.ads	Wed Feb  9 11:14:40 2005
--- gcc-4.1.0/gcc/ada/a-swunha.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,21 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT LIBRARY COMPONENTS                          --
- --                                                                          --
- --                     ADA.STRINGS.WIDE_UNBOUNDED.HASH                      --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- -- This specification is adapted from the Ada Reference Manual for use with --
- -- GNAT.  In accordance with the copyright of that document, you can freely --
- -- copy and modify this specification,  provided that if you redistribute a --
- -- modified version,  any changes that you have made are clearly indicated. --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- with Ada.Containers;
- 
- function Ada.Strings.Wide_Unbounded.Hash
-   (Key : Unbounded_Wide_String) return Containers.Hash_Type;
- 
- pragma Preelaborate (Ada.Strings.Wide_Unbounded.Hash);
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swuwha.adb gcc-4.1.0/gcc/ada/a-swuwha.adb
*** gcc-4.0.2/gcc/ada/a-swuwha.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-swuwha.adb	Fri Jul  1 01:29:17 2005
***************
*** 0 ****
--- 1,57 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT LIBRARY COMPONENTS                          --
+ --                                                                          --
+ --  A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- This specification is derived from the Ada Reference Manual for use with --
+ -- GNAT. The copyright notice above, and the license provisions that follow --
+ -- apply solely to the  contents of the part following the private keyword. --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
+ ------------------------------------------------------------------------------
+ 
+ --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
+ 
+ function Ada.Strings.Wide_Unbounded.Wide_Hash
+   (Key : Unbounded_Wide_String) return Containers.Hash_Type
+ is
+    use Ada.Containers;
+ 
+    function Rotate_Left
+      (Value  : Hash_Type;
+       Amount : Natural) return Hash_Type;
+    pragma Import (Intrinsic, Rotate_Left);
+ 
+    Tmp : Hash_Type;
+ 
+ begin
+    Tmp := 0;
+    for J in 1 .. Key.Last loop
+       Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key.Reference (J));
+    end loop;
+ 
+    return Tmp;
+ end Ada.Strings.Wide_Unbounded.Wide_Hash;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swuwha.ads gcc-4.1.0/gcc/ada/a-swuwha.ads
*** gcc-4.0.2/gcc/ada/a-swuwha.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-swuwha.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,21 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT LIBRARY COMPONENTS                          --
+ --                                                                          --
+ --  A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ -- This specification is adapted from the Ada Reference Manual for use with --
+ -- GNAT.  In accordance with the copyright of that document, you can freely --
+ -- copy and modify this specification,  provided that if you redistribute a --
+ -- modified version,  any changes that you have made are clearly indicated. --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ with Ada.Containers;
+ 
+ function Ada.Strings.Wide_Unbounded.Wide_Hash
+   (Key : Unbounded_Wide_String) return Containers.Hash_Type;
+ 
+ pragma Preelaborate (Ada.Strings.Wide_Unbounded.Wide_Hash);
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swuwti.adb gcc-4.1.0/gcc/ada/a-swuwti.adb
*** gcc-4.0.2/gcc/ada/a-swuwti.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-swuwti.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  ADA.STRINGS.WIDE_UNBOUNDED.WIDE_TEXT_IO                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  ADA.STRINGS.WIDE_UNBOUNDED.WIDE_TEXT_IO                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Strings.Wide_Unbounded.Aux; use Ada.Strings.Wide_Unbounded.Aux;
! with Ada.Wide_Text_IO;               use Ada.Wide_Text_IO;
  
  package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Wide_Text_IO; use Ada.Wide_Text_IO;
  
  package body Ada.Strings.Wide_Unbounded.Wide_Text_IO is
  
*************** package body Ada.Strings.Wide_Unbounded.
*** 57,63 ****
           Str1 := Str2;
        end loop;
  
!       Set_Wide_String (Result, Str1);
        return Result;
     end Get_Line;
  
--- 56,63 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
*************** package body Ada.Strings.Wide_Unbounded.
*** 73,79 ****
     begin
        Get_Line (File, Buffer, Last);
        Str1 := new Wide_String'(Buffer (1 .. Last));
- 
        while Last = Buffer'Last loop
           Get_Line (File, Buffer, Last);
           Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last));
--- 73,78 ----
*************** package body Ada.Strings.Wide_Unbounded.
*** 81,129 ****
           Str1 := Str2;
        end loop;
  
!       Set_Wide_String (Result, Str1);
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_Wide_String) is
-       Buffer : Wide_String (1 .. 1000);
-       Last   : Natural;
-       Str1   : Wide_String_Access;
-       Str2   : Wide_String_Access;
- 
     begin
!       Get_Line (Buffer, Last);
!       Str1 := new Wide_String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
! 
!       Set_Wide_String (Item, Str1);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Wide_Text_IO.File_Type;
        Item : out Unbounded_Wide_String)
     is
-       Buffer : Wide_String (1 .. 1000);
-       Last   : Natural;
-       Str1   : Wide_String_Access;
-       Str2   : Wide_String_Access;
- 
     begin
!       Get_Line (File, Buffer, Last);
!       Str1 := new Wide_String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new Wide_String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
  
!       Set_Wide_String (Item, Str1);
     end Get_Line;
  
     ---------
--- 80,131 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_Wide_String) is
     begin
!       Get_Line (Current_Input, Item);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Wide_Text_IO.File_Type;
        Item : out Unbounded_Wide_String)
     is
     begin
!       --  We are going to read into the string that is already there and
!       --  allocated. Hopefully it is big enough now, if not, we will extend
!       --  it in the usual manner using Realloc_For_Chunk.
  
!       --  Make sure we start with at least 80 characters
! 
!       if Item.Reference'Last < 80 then
!          Realloc_For_Chunk (Item, 80);
!       end if;
! 
!       --  Loop to read data, filling current string as far as possible.
!       --  Item.Last holds the number of characters read so far.
! 
!       Item.Last := 0;
!       loop
!          Get_Line
!            (File,
!             Item.Reference (Item.Last + 1 .. Item.Reference'Last),
!             Item.Last);
! 
!          --  If we hit the end of the line before the end of the buffer, then
!          --  we are all done, and the result length is properly set.
! 
!          if Item.Last < Item.Reference'Last then
!             return;
!          end if;
! 
!          --  If not enough room, double it and keep reading
! 
!          Realloc_For_Chunk (Item, Item.Last);
!       end loop;
     end Get_Line;
  
     ---------
*************** package body Ada.Strings.Wide_Unbounded.
*** 132,143 ****
  
     procedure Put (U : Unbounded_Wide_String) is
     begin
!       Put (Get_Wide_String (U).all);
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_Wide_String) is
     begin
!       Put (File, Get_Wide_String (U).all);
     end Put;
  
     --------------
--- 134,145 ----
  
     procedure Put (U : Unbounded_Wide_String) is
     begin
!       Put (U.Reference (1 .. U.Last));
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_Wide_String) is
     begin
!       Put (File, U.Reference (1 .. U.Last));
     end Put;
  
     --------------
*************** package body Ada.Strings.Wide_Unbounded.
*** 146,157 ****
  
     procedure Put_Line (U : Unbounded_Wide_String) is
     begin
!       Put_Line (Get_Wide_String (U).all);
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_Wide_String) is
     begin
!       Put_Line (File, Get_Wide_String (U).all);
     end Put_Line;
  
  end Ada.Strings.Wide_Unbounded.Wide_Text_IO;
--- 148,159 ----
  
     procedure Put_Line (U : Unbounded_Wide_String) is
     begin
!       Put_Line (U.Reference (1 .. U.Last));
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_Wide_String) is
     begin
!       Put_Line (File, U.Reference (1 .. U.Last));
     end Put_Line;
  
  end Ada.Strings.Wide_Unbounded.Wide_Text_IO;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-swuwti.ads gcc-4.1.0/gcc/ada/a-swuwti.ads
*** gcc-4.0.2/gcc/ada/a-swuwti.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/a-swuwti.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  ADA.STRINGS.WIDE_UNBOUNDED.WIDE_TEXT_IO                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  ADA.STRINGS.WIDE_UNBOUNDED.WIDE_TEXT_IO                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sytaco-vxworks.adb gcc-4.1.0/gcc/ada/a-sytaco-vxworks.adb
*** gcc-4.0.2/gcc/ada/a-sytaco-vxworks.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-sytaco-vxworks.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,147 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUNTIME COMPONENTS                          --
- --                                                                          --
- --         A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L          --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --            Copyright (C) 1992-2004 Free Software Foundation, Inc.        --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- with Interfaces.C;
- 
- package body Ada.Synchronous_Task_Control is
-    use System.OS_Interface;
-    use type Interfaces.C.int;
- 
-    -------------------
-    -- Current_State --
-    -------------------
- 
-    function Current_State (S : Suspension_Object) return Boolean is
-       St     : STATUS;
-       Result : Boolean := False;
- 
-    begin
-       --  Determine state by attempting to take the semaphore with
-       --  a 0 timeout value.  Status = OK indicates the semaphore was
-       --  full, so reset it to the full state.
- 
-       St := semTake (S.Sema, NO_WAIT);
- 
-       --  If we took the semaphore, reset semaphore state to FULL
- 
-       if St = OK then
-          Result := True;
-          St := semGive (S.Sema);
-       end if;
- 
-       return Result;
-    end Current_State;
- 
-    ---------------
-    -- Set_False --
-    ---------------
- 
-    procedure Set_False (S : in out Suspension_Object) is
-       St : STATUS;
- 
-    begin
-       --  Need to get the semaphore into the "empty" state.
-       --  On return, this task will have made the semaphore
-       --  empty (St = OK) or have left it empty.
- 
-       St := semTake (S.Sema, NO_WAIT);
-       pragma Assert (St = OK);
-    end Set_False;
- 
-    --------------
-    -- Set_True --
-    --------------
- 
-    procedure Set_True (S : in out Suspension_Object) is
-       St : STATUS;
-       pragma Unreferenced (St);
-    begin
-       St := semGive (S.Sema);
-    end Set_True;
- 
-    ------------------------
-    -- Suspend_Until_True --
-    ------------------------
- 
-    procedure Suspend_Until_True (S : in out Suspension_Object) is
-       St : STATUS;
- 
-    begin
-       --  Determine whether another task is pending on the suspension
-       --  object. Should never be called from an ISR. Therefore semTake can
-       --  be called on the mutex
- 
-       St := semTake (S.Mutex, NO_WAIT);
- 
-       if St = OK then
- 
-          --  Wait for suspension object
- 
-          St := semTake (S.Sema, WAIT_FOREVER);
-          St := semGive (S.Mutex);
- 
-       else
-          --  Another task is pending on the suspension object
- 
-          raise Program_Error;
-       end if;
-    end Suspend_Until_True;
- 
-    ----------------
-    -- Initialize --
-    ----------------
- 
-    procedure Initialize (S : in out Suspension_Object) is
-    begin
-       S.Sema := semBCreate (SEM_Q_FIFO, SEM_EMPTY);
- 
-       --  Use simpler binary semaphore instead of VxWorks
-       --  mutual exclusion semaphore, because we don't need
-       --  the fancier semantics and their overhead.
- 
-       S.Mutex := semBCreate (SEM_Q_FIFO, SEM_FULL);
-    end Initialize;
- 
-    --------------
-    -- Finalize --
-    --------------
- 
-    procedure Finalize (S : in out Suspension_Object) is
-       St : STATUS;
-       pragma Unreferenced (St);
-    begin
-       St := semDelete (S.Sema);
-       St := semDelete (S.Mutex);
-    end Finalize;
- 
- end Ada.Synchronous_Task_Control;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sytaco-vxworks.ads gcc-4.1.0/gcc/ada/a-sytaco-vxworks.ads
*** gcc-4.0.2/gcc/ada/a-sytaco-vxworks.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/a-sytaco-vxworks.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,68 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUN-TIME COMPONENTS                         --
- --                                                                          --
- --         A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L          --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
- --                                                                          --
- -- This specification is derived from the Ada Reference Manual for use with --
- -- GNAT. The copyright notice above, and the license provisions that follow --
- -- apply solely to the  contents of the part following the private keyword. --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- with System.OS_Interface;
- with Ada.Finalization;
- package Ada.Synchronous_Task_Control is
- 
-    type Suspension_Object is limited private;
- 
-    procedure Set_True (S : in out Suspension_Object);
- 
-    procedure Set_False (S : in out Suspension_Object);
- 
-    function Current_State (S : Suspension_Object) return Boolean;
- 
-    procedure Suspend_Until_True (S : in out Suspension_Object);
- 
- private
- 
-    procedure Initialize (S : in out Suspension_Object);
- 
-    procedure Finalize (S : in out Suspension_Object);
- 
-    --  Implement with a VxWorks binary semaphore. A second semaphore
-    --  is used to avoid a race condition related to the implementation of
-    --  the STC requirement to raise Program_Error when Suspend_Until_True is
-    --  called with a task already pending on the suspension object
- 
-    type Suspension_Object is new Ada.Finalization.Controlled with record
-       Sema  : System.OS_Interface.SEM_ID;
-       Mutex : System.OS_Interface.SEM_ID;
-    end record;
- 
- end Ada.Synchronous_Task_Control;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sytaco.adb gcc-4.1.0/gcc/ada/a-sytaco.adb
*** gcc-4.0.2/gcc/ada/a-sytaco.adb	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-sytaco.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1992-2001 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,95 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
  
! package body Ada.Synchronous_Task_Control is
! 
!    -------------------
!    -- Suspension_PO --
!    -------------------
! 
!    protected body Suspension_Object is
! 
!       --------------
!       -- Get_Open --
!       --------------
! 
!       function Get_Open return Boolean is
!       begin
!          return Open;
!       end Get_Open;
! 
!       ---------------
!       -- Set_False --
!       ---------------
! 
!       procedure Set_False is
!       begin
!          Open := False;
!       end Set_False;
! 
!       --------------
!       -- Set_True --
!       --------------
! 
!       procedure Set_True is
!       begin
!          Open := True;
!       end Set_True;
  
!       ----------
!       -- Wait --
!       ----------
  
!       entry Wait when Open is
!       begin
!          Open := False;
!       end Wait;
  
!       --------------------
!       -- Wait_Exception --
!       --------------------
  
!       entry Wait_Exception when True is
!       begin
!          if Wait'Count /= 0 then
!             raise Program_Error;
!          end if;
  
!          requeue Wait;
!       end Wait_Exception;
  
!    end Suspension_Object;
  
     -------------------
     -- Current_State --
--- 31,70 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ with System.Tasking;
+ --  Used for Detect_Blocking
+ --           Self
  
! with Ada.Exceptions;
! --  Used for Raise_Exception
  
! with System.Task_Primitives.Operations;
! --  Used for Initialize
! --           Finalize
! --           Current_State
! --           Set_False
! --           Set_True
! --           Suspend_Until_True
  
! package body Ada.Synchronous_Task_Control is
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    procedure Initialize (S : in out Suspension_Object) is
!    begin
!       System.Task_Primitives.Operations.Initialize (S.SO);
!    end Initialize;
  
!    --------------
!    -- Finalize --
!    --------------
  
!    procedure Finalize (S : in out Suspension_Object) is
!    begin
!       System.Task_Primitives.Operations.Finalize (S.SO);
!    end Finalize;
  
     -------------------
     -- Current_State --
*************** package body Ada.Synchronous_Task_Contro
*** 97,103 ****
  
     function Current_State (S : Suspension_Object) return Boolean is
     begin
!       return S.Get_Open;
     end Current_State;
  
     ---------------
--- 72,78 ----
  
     function Current_State (S : Suspension_Object) return Boolean is
     begin
!       return System.Task_Primitives.Operations.Current_State (S.SO);
     end Current_State;
  
     ---------------
*************** package body Ada.Synchronous_Task_Contro
*** 106,112 ****
  
     procedure Set_False (S : in out Suspension_Object) is
     begin
!       S.Set_False;
     end Set_False;
  
     --------------
--- 81,87 ----
  
     procedure Set_False (S : in out Suspension_Object) is
     begin
!       System.Task_Primitives.Operations.Set_False (S.SO);
     end Set_False;
  
     --------------
*************** package body Ada.Synchronous_Task_Contro
*** 115,121 ****
  
     procedure Set_True (S : in out Suspension_Object) is
     begin
!       S.Set_True;
     end Set_True;
  
     ------------------------
--- 90,96 ----
  
     procedure Set_True (S : in out Suspension_Object) is
     begin
!       System.Task_Primitives.Operations.Set_True (S.SO);
     end Set_True;
  
     ------------------------
*************** package body Ada.Synchronous_Task_Contro
*** 124,130 ****
  
     procedure Suspend_Until_True (S : in out Suspension_Object) is
     begin
!       S.Wait_Exception;
     end Suspend_Until_True;
  
  end Ada.Synchronous_Task_Control;
--- 99,116 ----
  
     procedure Suspend_Until_True (S : in out Suspension_Object) is
     begin
!       --  This is a potentially blocking (see ARM D.10, par. 10), so that
!       --  if pragma Detect_Blocking is active then Program_Error must be
!       --  raised if this operation is called from a protected action.
! 
!       if System.Tasking.Detect_Blocking
!         and then System.Tasking.Self.Common.Protected_Action_Nesting > 0
!       then
!          Ada.Exceptions.Raise_Exception
!            (Program_Error'Identity, "potentially blocking operation");
!       end if;
! 
!       System.Task_Primitives.Operations.Suspend_Until_True (S.SO);
     end Suspend_Until_True;
  
  end Ada.Synchronous_Task_Control;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-sytaco.ads gcc-4.1.0/gcc/ada/a-sytaco.ads
*** gcc-4.0.2/gcc/ada/a-sytaco.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-sytaco.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1998 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,43 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with System;
  
  package Ada.Synchronous_Task_Control is
  
     type Suspension_Object is limited private;
  
--- 35,49 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with System.Task_Primitives;
! --  Used for Suspension_Object
! 
! with Ada.Finalization;
! --  Used for Limited_Controlled
  
  package Ada.Synchronous_Task_Control is
+    pragma Preelaborate_05;
+    --  In accordance with Ada 2005 AI-362
  
     type Suspension_Object is limited private;
  
*************** package Ada.Synchronous_Task_Control is
*** 51,69 ****
  
  private
  
!    --  ??? Using a protected object is overkill; suspension could be
!    --      implemented more efficiently.
  
!    protected type Suspension_Object is
!       entry Wait;
!       procedure Set_False;
!       procedure Set_True;
!       function Get_Open return Boolean;
!       entry Wait_Exception;
  
!       pragma Priority (System.Any_Priority'Last);
!    private
!       Open : Boolean := False;
!    end Suspension_Object;
  
  end Ada.Synchronous_Task_Control;
--- 57,82 ----
  
  private
  
!    procedure Initialize (S : in out Suspension_Object);
!    --  Initialization for Suspension_Object
  
!    procedure Finalize (S : in out Suspension_Object);
!    --  Finalization for Suspension_Object
  
!    type Suspension_Object is
!      new Ada.Finalization.Limited_Controlled with
!    record
!       SO : System.Task_Primitives.Suspension_Object;
!       --  Use low-level suspension objects so that the synchronization
!       --  functionality provided by this object can be achieved using
!       --  efficient operating system primitives.
!    end record;
! 
!    pragma Inline (Set_True);
!    pragma Inline (Set_False);
!    pragma Inline (Current_State);
!    pragma Inline (Suspend_Until_True);
!    pragma Inline (Initialize);
!    pragma Inline (Finalize);
  
  end Ada.Synchronous_Task_Control;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szmzco.ads gcc-4.1.0/gcc/ada/a-szmzco.ads
*** gcc-4.0.2/gcc/ada/a-szmzco.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szmzco.ads	Mon Sep  5 08:11:07 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Ada.Characters.Wide_Wide_Latin_1;
  
  package Ada.Strings.Wide_Wide_Maps.Wide_Wide_Constants is
! pragma Preelaborate (Wide_Wide_Constants);
  
     Control_Set           : constant Wide_Wide_Maps.Wide_Wide_Character_Set;
     Graphic_Set           : constant Wide_Wide_Maps.Wide_Wide_Character_Set;
--- 38,44 ----
  with Ada.Characters.Wide_Wide_Latin_1;
  
  package Ada.Strings.Wide_Wide_Maps.Wide_Wide_Constants is
!    pragma Preelaborate;
  
     Control_Set           : constant Wide_Wide_Maps.Wide_Wide_Character_Set;
     Graphic_Set           : constant Wide_Wide_Maps.Wide_Wide_Character_Set;
*************** private
*** 182,188 ****
       (AF.Controlled with
        Character_Ranges'Unrestricted_Access);
  
- 
     Lower_Case_Mapping : aliased constant Wide_Wide_Character_Mapping_Values :=
       (Length => 56,
  
--- 182,187 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szunau.adb gcc-4.1.0/gcc/ada/a-szunau.adb
*** gcc-4.0.2/gcc/ada/a-szunau.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szunau.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D . A U X  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D . A U X  --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,95 ****
  
  package body Ada.Strings.Wide_Wide_Unbounded.Aux is
  
!    --------------------------
     -- Get_Wide_Wide_String --
!    --------------------------
  
!    function Get_Wide_Wide_String
!      (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access
     is
     begin
!       if U.Last = U.Reference'Length then
!          return U.Reference;
! 
!       else
!          declare
!             type Unbounded_Wide_Wide_String_Access is
!               access all Unbounded_Wide_Wide_String;
! 
!             U_Ptr : constant Unbounded_Wide_Wide_String_Access :=
!                       U'Unrestricted_Access;
!             --  Unbounded_Wide_Wide_String is a controlled type which is always
!             --  passed by copy it is always safe to take the pointer to such
!             --  object here. This pointer is used to set the U.Reference value
!             --  which would not be possible otherwise as U is read-only.
! 
!             Old : Wide_Wide_String_Access := U.Reference;
! 
!          begin
!             U_Ptr.Reference :=
!               new Wide_Wide_String'(U.Reference (1 .. U.Last));
!             Free (Old);
!             return U.Reference;
!          end;
!       end if;
     end Get_Wide_Wide_String;
  
!    --------------------------
     -- Set_Wide_Wide_String --
!    --------------------------
  
     procedure Set_Wide_Wide_String
       (UP : in out Unbounded_Wide_Wide_String;
        S  : Wide_Wide_String)
     is
     begin
!       if UP.Last = S'Length then
!          UP.Reference.all := S;
! 
!       else
!          declare
!             subtype String_1 is Wide_Wide_String (1 .. S'Length);
!             Tmp : Wide_Wide_String_Access;
!          begin
!             Tmp := new Wide_Wide_String'(String_1 (S));
!             Finalize (UP);
!             UP.Reference := Tmp;
!             UP.Last := UP.Reference'Length;
!          end;
        end if;
     end Set_Wide_Wide_String;
  
     procedure Set_Wide_Wide_String
--- 33,68 ----
  
  package body Ada.Strings.Wide_Wide_Unbounded.Aux is
  
!    --------------------
     -- Get_Wide_Wide_String --
!    ---------------------
  
!    procedure Get_Wide_Wide_String
!      (U : Unbounded_Wide_Wide_String;
!       S : out Wide_Wide_String_Access;
!       L : out Natural)
     is
     begin
!       S := U.Reference;
!       L := U.Last;
     end Get_Wide_Wide_String;
  
!    ---------------------
     -- Set_Wide_Wide_String --
!    ---------------------
  
     procedure Set_Wide_Wide_String
       (UP : in out Unbounded_Wide_Wide_String;
        S  : Wide_Wide_String)
     is
     begin
!       if S'Length > UP.Last then
!          Finalize (UP);
!          UP.Reference := new Wide_Wide_String (1 .. S'Length);
        end if;
+ 
+       UP.Reference (1 .. S'Length) := S;
+       UP.Last := S'Length;
     end Set_Wide_Wide_String;
  
     procedure Set_Wide_Wide_String
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szunau.ads gcc-4.1.0/gcc/ada/a-szunau.ads
*** gcc-4.0.2/gcc/ada/a-szunau.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szunau.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D . A U X  --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --   A D A . S T R I N G S . W I D E _ W I D E _ U N B O U N D E D . A U X  --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,58 ****
  --  other layered utilities.
  
  package Ada.Strings.Wide_Wide_Unbounded.Aux is
! pragma Preelaborate (Aux);
  
!    function Get_Wide_Wide_String
!      (U : Unbounded_Wide_Wide_String) return Wide_Wide_String_Access;
     pragma Inline (Get_Wide_Wide_String);
!    --  This function returns the internal string pointer used in the
!    --  representation of an unbounded string. There is no copy involved,
!    --  so the value obtained references the same string as the original
!    --  unbounded string. The characters of this string may not be modified
!    --  via the returned pointer, and are valid only as long as the original
!    --  unbounded string is not modified. Violating either of these two
!    --  rules results in erroneous execution.
     --
!    --  This function is much more efficient than the use of To_Wide_Wide_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one.
  
     procedure Set_Wide_Wide_String
       (UP : in out Unbounded_Wide_Wide_String;
--- 37,60 ----
  --  other layered utilities.
  
  package Ada.Strings.Wide_Wide_Unbounded.Aux is
!    pragma Preelaborate;
  
!    procedure Get_Wide_Wide_String
!      (U : Unbounded_Wide_Wide_String;
!       S : out Wide_Wide_String_Access;
!       L : out Natural);
     pragma Inline (Get_Wide_Wide_String);
!    --  This procedure returns the internal string pointer used in the
!    --  representation of an unbounded string as well as the actual current
!    --  length (which may be less than S.all'Length because in general there
!    --  can be extra space assigned). The characters of this string may be
!    --  not be modified via the returned pointer,  and are valid only as
!    --  long as the original unbounded string is not accessed or modified.
     --
!    --  This procedure is more efficient than the use of To_Wide_Wide_String
     --  since it avoids the need to copy the string. The lower bound of the
!    --  referenced string returned by this call is always one, so the actual
!    --  string data is always accessible as S (1 .. L).
  
     procedure Set_Wide_Wide_String
       (UP : in out Unbounded_Wide_Wide_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szunha.adb gcc-4.1.0/gcc/ada/a-szunha.adb
*** gcc-4.0.2/gcc/ada/a-szunha.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szunha.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,58 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT LIBRARY COMPONENTS                          --
- --                                                                          --
- --       A D A . S T R I N G S . W I D E _ U N B O U N D E D . H A S H      --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
- --                                                                          --
- -- This specification is derived from the Ada Reference Manual for use with --
- -- GNAT. The copyright notice above, and the license provisions that follow --
- -- apply solely to the  contents of the part following the private keyword. --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- This unit was originally developed by Matthew J Heaney.                  --
- ------------------------------------------------------------------------------
- 
- --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
- 
- function Ada.Strings.Wide_Wide_Unbounded.Hash
-   (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type
- is
-    use Ada.Containers;
- 
-    function Rotate_Left
-      (Value  : Hash_Type;
-       Amount : Natural) return Hash_Type;
-    pragma Import (Intrinsic, Rotate_Left);
- 
-    Tmp : Hash_Type;
- 
- begin
-    Tmp := 0;
-    for J in 1 .. Key.Last loop
-       Tmp := Rotate_Left (Tmp, 1) +
-         Wide_Wide_Character'Pos (Key.Reference (J));
-    end loop;
- 
-    return Tmp;
- end Ada.Strings.Wide_Wide_Unbounded.Hash;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szunha.ads gcc-4.1.0/gcc/ada/a-szunha.ads
*** gcc-4.0.2/gcc/ada/a-szunha.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szunha.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,21 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT LIBRARY COMPONENTS                          --
- --                                                                          --
- --       A D A . S T R I N G S . W I D E _ U N B O U N D E D . H A S H      --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- -- This specification is adapted from the Ada Reference Manual for use with --
- -- GNAT.  In accordance with the copyright of that document, you can freely --
- -- copy and modify this specification,  provided that if you redistribute a --
- -- modified version,  any changes that you have made are clearly indicated. --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- with Ada.Containers;
- 
- function Ada.Strings.Wide_Wide_Unbounded.Hash
-   (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type;
- 
- pragma Preelaborate (Ada.Strings.Wide_Wide_Unbounded.Hash);
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szuzha.adb gcc-4.1.0/gcc/ada/a-szuzha.adb
*** gcc-4.0.2/gcc/ada/a-szuzha.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-szuzha.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,58 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT LIBRARY COMPONENTS                          --
+ --                                                                          --
+ --  A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- This specification is derived from the Ada Reference Manual for use with --
+ -- GNAT. The copyright notice above, and the license provisions that follow --
+ -- apply solely to the  contents of the part following the private keyword. --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- This unit was originally developed by Matthew J Heaney.                  --
+ ------------------------------------------------------------------------------
+ 
+ --  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
+ 
+ function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
+   (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type
+ is
+    use Ada.Containers;
+ 
+    function Rotate_Left
+      (Value  : Hash_Type;
+       Amount : Natural) return Hash_Type;
+    pragma Import (Intrinsic, Rotate_Left);
+ 
+    Tmp : Hash_Type;
+ 
+ begin
+    Tmp := 0;
+    for J in 1 .. Key.Last loop
+       Tmp := Rotate_Left (Tmp, 3) +
+         Wide_Wide_Character'Pos (Key.Reference (J));
+    end loop;
+ 
+    return Tmp;
+ end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szuzha.ads gcc-4.1.0/gcc/ada/a-szuzha.ads
*** gcc-4.0.2/gcc/ada/a-szuzha.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-szuzha.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,21 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT LIBRARY COMPONENTS                          --
+ --                                                                          --
+ --  A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ -- This specification is adapted from the Ada Reference Manual for use with --
+ -- GNAT.  In accordance with the copyright of that document, you can freely --
+ -- copy and modify this specification,  provided that if you redistribute a --
+ -- modified version,  any changes that you have made are clearly indicated. --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ with Ada.Containers;
+ 
+ function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
+   (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type;
+ 
+ pragma Preelaborate (Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash);
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szuzti.adb gcc-4.1.0/gcc/ada/a-szuzti.adb
*** gcc-4.0.2/gcc/ada/a-szuzti.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szuzti.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             ADA.STRINGS.WIDE_WIDE_UNBOUNDED.WIDE_WIDE_TEXT_IO            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             ADA.STRINGS.WIDE_WIDE_UNBOUNDED.WIDE_WIDE_TEXT_IO            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,40 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Strings.Wide_Wide_Unbounded.Aux;
! use Ada.Strings.Wide_Wide_Unbounded.Aux;
! with Ada.Wide_Wide_Text_IO;
! use Ada.Wide_Wide_Text_IO;
  
  package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
  
  package body Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO is
  
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 59,71 ****
           Str1 := Str2;
        end loop;
  
!       Set_Wide_Wide_String (Result, Str1);
        return Result;
     end Get_Line;
  
     function Get_Line
!      (File : Ada.Wide_Wide_Text_IO.File_Type)
!       return Unbounded_Wide_Wide_String
     is
        Buffer : Wide_Wide_String (1 .. 1000);
        Last   : Natural;
--- 56,68 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
     function Get_Line
!      (File : Ada.Wide_Wide_Text_IO.File_Type) return Unbounded_Wide_Wide_String
     is
        Buffer : Wide_Wide_String (1 .. 1000);
        Last   : Natural;
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 84,132 ****
           Str1 := Str2;
        end loop;
  
!       Set_Wide_Wide_String (Result, Str1);
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_Wide_Wide_String) is
-       Buffer : Wide_Wide_String (1 .. 1000);
-       Last   : Natural;
-       Str1   : Wide_Wide_String_Access;
-       Str2   : Wide_Wide_String_Access;
- 
     begin
!       Get_Line (Buffer, Last);
!       Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
! 
!       Set_Wide_Wide_String (Item, Str1);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Wide_Wide_Text_IO.File_Type;
        Item : out Unbounded_Wide_Wide_String)
     is
-       Buffer : Wide_Wide_String (1 .. 1000);
-       Last   : Natural;
-       Str1   : Wide_Wide_String_Access;
-       Str2   : Wide_Wide_String_Access;
- 
     begin
!       Get_Line (File, Buffer, Last);
!       Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
!       while Last = Buffer'Last loop
!          Get_Line (Buffer, Last);
!          Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
!          Free (Str1);
!          Str1 := Str2;
!       end loop;
  
!       Set_Wide_Wide_String (Item, Str1);
     end Get_Line;
  
     ---------
--- 81,132 ----
           Str1 := Str2;
        end loop;
  
!       Result.Reference := Str1;
!       Result.Last      := Str1'Length;
        return Result;
     end Get_Line;
  
     procedure Get_Line (Item : out Unbounded_Wide_Wide_String) is
     begin
!       Get_Line (Current_Input, Item);
     end Get_Line;
  
     procedure Get_Line
       (File : Ada.Wide_Wide_Text_IO.File_Type;
        Item : out Unbounded_Wide_Wide_String)
     is
     begin
!       --  We are going to read into the string that is already there and
!       --  allocated. Hopefully it is big enough now, if not, we will extend
!       --  it in the usual manner using Realloc_For_Chunk.
  
!       --  Make sure we start with at least 80 characters
! 
!       if Item.Reference'Last < 80 then
!          Realloc_For_Chunk (Item, 80);
!       end if;
! 
!       --  Loop to read data, filling current string as far as possible.
!       --  Item.Last holds the number of characters read so far.
! 
!       Item.Last := 0;
!       loop
!          Get_Line
!            (File,
!             Item.Reference (Item.Last + 1 .. Item.Reference'Last),
!             Item.Last);
! 
!          --  If we hit the end of the line before the end of the buffer, then
!          --  we are all done, and the result length is properly set.
! 
!          if Item.Last < Item.Reference'Last then
!             return;
!          end if;
! 
!          --  If not enough room, double it and keep reading
! 
!          Realloc_For_Chunk (Item, Item.Last);
!       end loop;
     end Get_Line;
  
     ---------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 135,146 ****
  
     procedure Put (U : Unbounded_Wide_Wide_String) is
     begin
!       Put (Get_Wide_Wide_String (U).all);
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_Wide_Wide_String) is
     begin
!       Put (File, Get_Wide_Wide_String (U).all);
     end Put;
  
     --------------
--- 135,146 ----
  
     procedure Put (U : Unbounded_Wide_Wide_String) is
     begin
!       Put (U.Reference (1 .. U.Last));
     end Put;
  
     procedure Put (File : File_Type; U : Unbounded_Wide_Wide_String) is
     begin
!       Put (File, U.Reference (1 .. U.Last));
     end Put;
  
     --------------
*************** package body Ada.Strings.Wide_Wide_Unbou
*** 149,160 ****
  
     procedure Put_Line (U : Unbounded_Wide_Wide_String) is
     begin
!       Put_Line (Get_Wide_Wide_String (U).all);
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_Wide_Wide_String) is
     begin
!       Put_Line (File, Get_Wide_Wide_String (U).all);
     end Put_Line;
  
  end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
--- 149,160 ----
  
     procedure Put_Line (U : Unbounded_Wide_Wide_String) is
     begin
!       Put_Line (U.Reference (1 .. U.Last));
     end Put_Line;
  
     procedure Put_Line (File : File_Type; U : Unbounded_Wide_Wide_String) is
     begin
!       Put_Line (File, U.Reference (1 .. U.Last));
     end Put_Line;
  
  end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-szuzti.ads gcc-4.1.0/gcc/ada/a-szuzti.ads
*** gcc-4.0.2/gcc/ada/a-szuzti.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-szuzti.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             ADA.STRINGS.WIDE_WIDE_UNBOUNDED.WIDE_WIDE_TEXT_IO            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             ADA.STRINGS.WIDE_WIDE_UNBOUNDED.WIDE_WIDE_TEXT_IO            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tags.adb gcc-4.1.0/gcc/ada/a-tags.adb
*** gcc-4.0.2/gcc/ada/a-tags.adb	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/a-tags.adb	Tue Nov 15 13:54:36 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                             A D A . T A G S                              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                             A D A . T A G S                              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,160 ****
  
  with Ada.Exceptions;
  with System.HTable;
  
  pragma Elaborate_All (System.HTable);
  
  package body Ada.Tags is
  
! --  Structure of the GNAT Dispatch Table
  
  --           +-----------------------+
  --           |     Offset_To_Top     |
  --           +-----------------------+
! --           | Typeinfo_Ptr/TSD_Ptr  |----> Type Specific Data
  --  Tag ---> +-----------------------+      +-------------------+
  --           |        table of       |      | inheritance depth |
  --           :     primitive ops     :      +-------------------+
! --           |        pointers       |      |   expanded name   |
  --           +-----------------------+      +-------------------+
  --                                          |   external tag    |
  --                                          +-------------------+
! --                                          |   Hash table link |
  --                                          +-------------------+
! --                                          | Remotely Callable |
  --                                          +-------------------+
! --                                          | Rec Ctrler offset |
  --                                          +-------------------+
! --                                          | table of          |
! --                                          :   ancestor        :
! --                                          |      tags         |
  --                                          +-------------------+
  
     subtype Cstring is String (Positive);
     type Cstring_Ptr is access all Cstring;
  
     type Tag_Table is array (Natural range <>) of Tag;
     pragma Suppress_Initialization (Tag_Table);
     pragma Suppress (Index_Check, On => Tag_Table);
-    --  We suppress index checks because the declared size in the record below
-    --  is a dummy size of one (see below).
  
!    type Wide_Boolean is new Boolean;
!    --  This name should probably be changed sometime ??? and indeed probably
!    --  this field could simply be of type Standard.Boolean.
  
     type Type_Specific_Data is record
!       Idepth             : Natural;
!       Expanded_Name      : Cstring_Ptr;
!       External_Tag       : Cstring_Ptr;
!       HT_Link            : Tag;
!       Remotely_Callable  : Wide_Boolean;
!       RC_Offset          : SSE.Storage_Offset;
!       Ancestor_Tags      : Tag_Table (0 .. 1);
     end record;
-    --  The size of the Ancestor_Tags array actually depends on the tagged type
-    --  to which it applies. We are using the same mechanism as for the
-    --  Prims_Ptr array in the Dispatch_Table record. See comments below for
-    --  more details.
  
     type Dispatch_Table is record
!       --  Offset_To_Top : Integer := 0;
!       --  Typeinfo_Ptr  : System.Address; -- Currently TSD is also here???
!       Prims_Ptr    : Address_Array (Positive);
     end record;
  
!    --  Note on the commented out fields of the Dispatch_Table
!    --  ------------------------------------------------------
!    --  According to the C++ ABI the components Offset_To_Top and Typeinfo_Ptr
!    --  are stored just "before" the dispatch table (that is, the Prims_Ptr
!    --  table), and they are referenced with negative offsets referring to the
!    --  base of the dispatch table. The _Tag (or the VTable_Ptr in C++ termi-
!    --  nology) must point to the base of the virtual table, just after these
!    --  components, to point to the Prims_Ptr table. For this purpose the
!    --  expander generates a Prims_Ptr table that has enough space for these
!    --  additional components, and generates code that displaces the _Tag to
!    --  point after these components.
!    --  -----------------------------------------------------------------------
  
!    --  The size of the Prims_Ptr array actually depends on the tagged type to
!    --  which it applies. For each tagged type, the expander computes the
!    --  actual array size, allocates the Dispatch_Table record accordingly, and
!    --  generates code that displaces the base of the record after the
!    --  Typeinfo_Ptr component. For this reason the first two components have
!    --  been commented in the previous declaration. The access to these
!    --  components is done by means of local functions.
!    --
!    --  To avoid the use of discriminants to define the actual size of the
!    --  dispatch table, we used to declare the tag as a pointer to a record
!    --  that contains an arbitrary array of addresses, using Positive as its
!    --  index. This ensures that there are never range checks when accessing
!    --  the dispatch table, but it prevents GDB from displaying tagged types
!    --  properly. A better approach is to declare this record type as holding a
!    --  small number of addresses, and to explicitly suppress checks on it.
!    --
!    --  Note that in both cases, this type is never allocated, and serves only
!    --  to declare the corresponding access type.
  
     ---------------------------------------------
     -- Unchecked Conversions for String Fields --
     ---------------------------------------------
  
     function To_Cstring_Ptr is
       new Unchecked_Conversion (System.Address, Cstring_Ptr);
  
!    function To_Address is
!      new Unchecked_Conversion (Cstring_Ptr, System.Address);
  
!    -----------------------------------------------------------
!    -- Unchecked Conversions for the component offset_to_top --
!    -----------------------------------------------------------
  
!    type Int_Ptr is access Integer;
  
!    function To_Int_Ptr is
!       new Unchecked_Conversion (System.Address, Int_Ptr);
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
     function Length (Str : Cstring_Ptr) return Natural;
     --  Length of string represented by the given pointer (treating the string
     --  as a C-style string, which is Nul terminated).
  
!    function Offset_To_Top (T : Tag) return Integer;
     --  Returns the current value of the offset_to_top component available in
     --  the prologue of the dispatch table.
  
--- 33,312 ----
  
  with Ada.Exceptions;
  with System.HTable;
+ with System.Storage_Elements; use System.Storage_Elements;
  
  pragma Elaborate_All (System.HTable);
  
  package body Ada.Tags is
  
! --  Structure of the GNAT Primary Dispatch Table
  
  --           +-----------------------+
+ --           |       Signature       |
+ --           +-----------------------+
  --           |     Offset_To_Top     |
  --           +-----------------------+
! --           | Typeinfo_Ptr/TSD_Ptr  | ---> Type Specific Data
  --  Tag ---> +-----------------------+      +-------------------+
  --           |        table of       |      | inheritance depth |
  --           :     primitive ops     :      +-------------------+
! --           |        pointers       |      |   access level    |
  --           +-----------------------+      +-------------------+
+ --                                          |   expanded name   |
+ --                                          +-------------------+
  --                                          |   external tag    |
  --                                          +-------------------+
! --                                          |   hash table link |
  --                                          +-------------------+
! --                                          | remotely callable |
  --                                          +-------------------+
! --                                          | rec ctrler offset |
  --                                          +-------------------+
! --                                          |   num prim ops    |
  --                                          +-------------------+
+ --                                          |  num interfaces   |
+ --                                          +-------------------+
+ --           Select Specific Data      <--- |     SSD_Ptr       |
+ --           +-----------------------+      +-------------------+
+ --           | table of primitive    |      | table of          |
+ --           :    operation          :      :    ancestor       :
+ --           |       kinds           |      |       tags        |
+ --           +-----------------------+      +-------------------+
+ --           | table of              |      | table of          |
+ --           :    entry              :      :    interface      :
+ --           |       indices         |      |       tags        |
+ --           +-----------------------+      +-------------------+
+ 
+ --  Structure of the GNAT Secondary Dispatch Table
+ 
+ --           +-----------------------+
+ --           |       Signature       |
+ --           +-----------------------+
+ --           |     Offset_To_Top     |
+ --           +-----------------------+
+ --           |        OSD_Ptr        |---> Object Specific Data
+ --  Tag ---> +-----------------------+      +---------------+
+ --           |        table of       |      | num prim ops  |
+ --           :      primitive op     :      +---------------+
+ --           |     thunk pointers    |      | table of      |
+ --           +-----------------------+      +   primitive   |
+ --                                          |    op offsets |
+ --                                          +---------------+
+ 
+    Offset_To_Signature : constant SSE.Storage_Count :=
+                            DT_Typeinfo_Ptr_Size
+                              + DT_Offset_To_Top_Size
+                              + DT_Signature_Size;
  
     subtype Cstring is String (Positive);
     type Cstring_Ptr is access all Cstring;
  
+    --  We suppress index checks because the declared size in the record below
+    --  is a dummy size of one (see below).
+ 
     type Tag_Table is array (Natural range <>) of Tag;
     pragma Suppress_Initialization (Tag_Table);
     pragma Suppress (Index_Check, On => Tag_Table);
  
!    --  Object specific data types
! 
!    type Object_Specific_Data_Array is array (Positive range <>) of Positive;
! 
!    type Object_Specific_Data (Nb_Prim : Positive) is record
!       Num_Prim_Ops : Natural;
!       --  Number of primitive operations of the dispatch table. This field is
!       --  used by the run-time check routines that are activated when the
!       --  run-time is compiled with assertions enabled.
! 
!       OSD_Table : Object_Specific_Data_Array (1 .. Nb_Prim);
!       --  Table used in secondary DT to reference their counterpart in the
!       --  select specific data (in the TSD of the primary DT). This construct
!       --  is used in the handling of dispatching triggers in select statements.
!       --  Nb_Prim is the number of non-predefined primitive operations.
!    end record;
! 
!    --  Select specific data types
! 
!    type Select_Specific_Data_Element is record
!       Index : Positive;
!       Kind  : Prim_Op_Kind;
!    end record;
! 
!    type Select_Specific_Data_Array is
!      array (Positive range <>) of Select_Specific_Data_Element;
! 
!    type Select_Specific_Data (Nb_Prim : Positive) is record
!       SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
!       --  NOTE: Nb_Prim is the number of non-predefined primitive operations
!    end record;
! 
!    --  Type specific data types
  
     type Type_Specific_Data is record
!       Idepth : Natural;
!       --  Inheritance Depth Level: Used to implement the membership test
!       --  associated with single inheritance of tagged types in constant-time.
!       --  In addition it also indicates the size of the first table stored in
!       --  the Tags_Table component (see comment below).
! 
!       Access_Level : Natural;
!       --  Accessibility level required to give support to Ada 2005 nested type
!       --  extensions. This feature allows safe nested type extensions by
!       --  shifting the accessibility checks to certain operations, rather than
!       --  being enforced at the type declaration. In particular, by performing
!       --  run-time accessibility checks on class-wide allocators, class-wide
!       --  function return, and class-wide stream I/O, the danger of objects
!       --  outliving their type declaration can be eliminated (Ada 2005: AI-344)
! 
!       Expanded_Name : Cstring_Ptr;
!       External_Tag  : Cstring_Ptr;
!       HT_Link       : Tag;
!       --  Components used to give support to the Ada.Tags subprograms described
!       --  in ARM 3.9
! 
!       Remotely_Callable : Boolean;
!       --  Used to check ARM E.4 (18)
! 
!       RC_Offset : SSE.Storage_Offset;
!       --  Controller Offset: Used to give support to tagged controlled objects
!       --  (see Get_Deep_Controller at s-finimp)
! 
!       Num_Prim_Ops : Natural;
!       --  Number of primitive operations of the dispatch table. This field is
!       --  used for additional run-time checks when the run-time is compiled
!       --  with assertions enabled.
! 
!       Num_Interfaces : Natural;
!       --  Number of abstract interface types implemented by the tagged type.
!       --  The value Idepth+Num_Interfaces indicates the end of the second table
!       --  stored in the Tags_Table component. It is used to implement the
!       --  membership test associated with interfaces (Ada 2005:AI-251).
! 
!       SSD_Ptr : System.Address;
!       --  Pointer to a table of records used in dispatching selects. This
!       --  field has a meaningful value for all tagged types that implement
!       --  a limited, protected, synchronized or task interfaces and have
!       --  non-predefined primitive operations.
! 
!       Tags_Table : Tag_Table (0 .. 1);
!       --  The size of the Tags_Table array actually depends on the tagged type
!       --  to which it applies. The compiler ensures that has enough space to
!       --  store all the entries of the two tables phisically stored there: the
!       --  "table of ancestor tags" and the "table of interface tags". For this
!       --  purpose we are using the same mechanism as for the Prims_Ptr array in
!       --  the Dispatch_Table record. See comments below on Prims_Ptr for
!       --  further details.
     end record;
  
     type Dispatch_Table is record
! 
!       --  According to the C++ ABI the components Offset_To_Top and
!       --  Typeinfo_Ptr are stored just "before" the dispatch table (that is,
!       --  the Prims_Ptr table), and they are referenced with negative offsets
!       --  referring to the base of the dispatch table. The _Tag (or the
!       --  VTable_Ptr in C++ terminology) must point to the base of the virtual
!       --  table, just after these components, to point to the Prims_Ptr table.
!       --  For this purpose the expander generates a Prims_Ptr table that has
!       --  enough space for these additional components, and generates code that
!       --  displaces the _Tag to point after these components.
! 
!       --  Offset_To_Top : Natural;
!       --  Typeinfo_Ptr  : System.Address;
! 
!       Prims_Ptr : Address_Array (1 .. 1);
!       --  The size of the Prims_Ptr array actually depends on the tagged type
!       --  to which it applies. For each tagged type, the expander computes the
!       --  actual array size, allocates the Dispatch_Table record accordingly,
!       --  and generates code that displaces the base of the record after the
!       --  Typeinfo_Ptr component. For this reason the first two components have
!       --  been commented in the previous declaration. The access to these
!       --  components is done by means of local functions.
!       --
!       --  To avoid the use of discriminants to define the actual size of the
!       --  dispatch table, we used to declare the tag as a pointer to a record
!       --  that contains an arbitrary array of addresses, using Positive as its
!       --  index. This ensures that there are never range checks when accessing
!       --  the dispatch table, but it prevents GDB from displaying tagged types
!       --  properly. A better approach is to declare this record type as holding
!       --  small number of addresses, and to explicitly suppress checks on it.
!       --
!       --  Note that in both cases, this type is never allocated, and serves
!       --  only to declare the corresponding access type.
     end record;
  
!    --  Run-time check types and subprograms: These subprograms are used only
!    --  when the run-time is compiled with assertions enabled.
  
!    type Signature_Type is
!       (Must_Be_Primary_DT,
!        Must_Be_Secondary_DT,
!        Must_Be_Primary_Or_Secondary_DT,
!        Must_Be_Interface,
!        Must_Be_Primary_Or_Interface);
!    --  Type of signature accepted by primitives in this package that are called
!    --  during the elaboration of tagged types. This type is used by the routine
!    --  Check_Signature that is called only when the run-time is compiled with
!    --  assertions enabled.
  
     ---------------------------------------------
     -- Unchecked Conversions for String Fields --
     ---------------------------------------------
  
+    function To_Address is
+      new Unchecked_Conversion (Cstring_Ptr, System.Address);
+ 
     function To_Cstring_Ptr is
       new Unchecked_Conversion (System.Address, Cstring_Ptr);
  
!    ------------------------------------------------
!    -- Unchecked Conversions for other components --
!    ------------------------------------------------
  
!    type Acc_Size
!      is access function (A : System.Address) return Long_Long_Integer;
  
!    function To_Acc_Size is new Unchecked_Conversion (System.Address, Acc_Size);
!    --  The profile of the implicitly defined _size primitive
  
!    type Storage_Offset_Ptr is access System.Storage_Elements.Storage_Offset;
! 
!    function To_Storage_Offset_Ptr is
!      new Unchecked_Conversion (System.Address, Storage_Offset_Ptr);
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
+    function Check_Index
+      (T     : Tag;
+       Index : Natural) return Boolean;
+    --  Check that Index references a valid entry of the dispatch table of T
+ 
+    function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean;
+    --  Check that the signature of T is valid and corresponds with the subset
+    --  specified by the signature Kind.
+ 
+    function Check_Size
+      (Old_T       : Tag;
+       New_T       : Tag;
+       Entry_Count : Natural) return Boolean;
+    --  Verify that Old_T and New_T have at least Entry_Count entries
+ 
+    function Get_Num_Prim_Ops (T : Tag) return Natural;
+    --  Retrieve the number of primitive operations in the dispatch table of T
+ 
+    function Is_Primary_DT (T : Tag) return Boolean;
+    pragma Inline_Always (Is_Primary_DT);
+    --  Given a tag returns True if it has the signature of a primary dispatch
+    --  table.  This is Inline_Always since it is called from other Inline_
+    --  Always subprograms where we want no out of line code to be generated.
+ 
     function Length (Str : Cstring_Ptr) return Natural;
     --  Length of string represented by the given pointer (treating the string
     --  as a C-style string, which is Nul terminated).
  
!    function Offset_To_Top
!      (T : Tag) return System.Storage_Elements.Storage_Offset;
     --  Returns the current value of the offset_to_top component available in
     --  the prologue of the dispatch table.
  
*************** package body Ada.Tags is
*** 162,168 ****
     --  Returns the current value of the typeinfo_ptr component available in
     --  the prologue of the dispatch table.
  
-    pragma Unreferenced (Offset_To_Top);
     pragma Unreferenced (Typeinfo_Ptr);
     --  These functions will be used for full compatibility with the C++ ABI
  
--- 314,319 ----
*************** package body Ada.Tags is
*** 203,225 ****
  
     package body HTable_Subprograms is
  
!    -----------
!    -- Equal --
!    -----------
  
        function Equal (A, B : System.Address) return Boolean is
           Str1 : constant Cstring_Ptr := To_Cstring_Ptr (A);
           Str2 : constant Cstring_Ptr := To_Cstring_Ptr (B);
           J    : Integer := 1;
- 
        begin
           loop
              if Str1 (J) /= Str2 (J) then
                 return False;
- 
              elsif Str1 (J) = ASCII.NUL then
                 return True;
- 
              else
                 J := J + 1;
              end if;
--- 354,373 ----
  
     package body HTable_Subprograms is
  
!       -----------
!       -- Equal --
!       -----------
  
        function Equal (A, B : System.Address) return Boolean is
           Str1 : constant Cstring_Ptr := To_Cstring_Ptr (A);
           Str2 : constant Cstring_Ptr := To_Cstring_Ptr (B);
           J    : Integer := 1;
        begin
           loop
              if Str1 (J) /= Str2 (J) then
                 return False;
              elsif Str1 (J) = ASCII.NUL then
                 return True;
              else
                 J := J + 1;
              end if;
*************** package body Ada.Tags is
*** 258,263 ****
--- 406,498 ----
  
     end HTable_Subprograms;
  
+    -----------------
+    -- Check_Index --
+    -----------------
+ 
+    function Check_Index
+      (T     : Tag;
+       Index : Natural) return Boolean
+    is
+       Max_Entries : constant Natural := Get_Num_Prim_Ops (T);
+ 
+    begin
+       return Index /= 0 and then Index <= Max_Entries;
+    end Check_Index;
+ 
+    ---------------------
+    -- Check_Signature --
+    ---------------------
+ 
+    function Check_Signature (T : Tag; Kind : Signature_Type) return Boolean is
+       Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                             To_Storage_Offset_Ptr (To_Address (T)
+                               - Offset_To_Signature);
+ 
+       Signature : constant Signature_Values :=
+                     To_Signature_Values (Offset_To_Top_Ptr.all);
+ 
+       Signature_Id : Signature_Kind;
+ 
+    begin
+       if Signature (1) /= Valid_Signature then
+          Signature_Id := Unknown;
+ 
+       elsif Signature (2) in Primary_DT .. Abstract_Interface then
+          Signature_Id := Signature (2);
+ 
+       else
+          Signature_Id := Unknown;
+       end if;
+ 
+       case Signature_Id is
+          when Primary_DT         =>
+             if Kind = Must_Be_Secondary_DT
+               or else Kind = Must_Be_Interface
+             then
+                return False;
+             end if;
+ 
+          when Secondary_DT       =>
+             if Kind = Must_Be_Primary_DT
+               or else Kind = Must_Be_Interface
+             then
+                return False;
+             end if;
+ 
+          when Abstract_Interface =>
+             if Kind = Must_Be_Primary_DT
+               or else Kind = Must_Be_Secondary_DT
+               or else Kind = Must_Be_Primary_Or_Secondary_DT
+             then
+                return False;
+             end if;
+ 
+          when others =>
+             return False;
+ 
+       end case;
+ 
+       return True;
+    end Check_Signature;
+ 
+    ----------------
+    -- Check_Size --
+    ----------------
+ 
+    function Check_Size
+      (Old_T       : Tag;
+       New_T       : Tag;
+       Entry_Count : Natural) return Boolean
+    is
+       Max_Entries_Old : constant Natural := Get_Num_Prim_Ops (Old_T);
+       Max_Entries_New : constant Natural := Get_Num_Prim_Ops (New_T);
+ 
+    begin
+       return Entry_Count <= Max_Entries_Old
+         and then Entry_Count <= Max_Entries_New;
+    end Check_Size;
+ 
     -------------------
     -- CW_Membership --
     -------------------
*************** package body Ada.Tags is
*** 266,273 ****
  
     --     Obj in Typ'Class
  
!    --  Each dispatch table contains a reference to a table of ancestors
!    --  (Ancestor_Tags) and a count of the level of inheritance "Idepth" .
  
     --  Obj is in Typ'Class if Typ'Tag is in the table of ancestors that are
     --  contained in the dispatch table referenced by Obj'Tag . Knowing the
--- 501,509 ----
  
     --     Obj in Typ'Class
  
!    --  Each dispatch table contains a reference to a table of ancestors (stored
!    --  in the first part of the Tags_Table) and a count of the level of
!    --  inheritance "Idepth".
  
     --  Obj is in Typ'Class if Typ'Tag is in the table of ancestors that are
     --  contained in the dispatch table referenced by Obj'Tag . Knowing the
*************** package body Ada.Tags is
*** 278,295 ****
     --     = Typ'tag
  
     function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
!       Pos : constant Integer := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
     begin
!       return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag;
     end CW_Membership;
  
     -------------------
     -- Expanded_Name --
     -------------------
  
     function Expanded_Name (T : Tag) return String is
!       Result : constant Cstring_Ptr := TSD (T).Expanded_Name;
     begin
        return Result (1 .. Length (Result));
     end Expanded_Name;
  
--- 514,618 ----
     --     = Typ'tag
  
     function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
!       Pos : Integer;
     begin
!       pragma Assert (Check_Signature (Obj_Tag, Must_Be_Primary_DT));
!       pragma Assert (Check_Signature (Typ_Tag, Must_Be_Primary_DT));
!       Pos := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
!       return Pos >= 0 and then TSD (Obj_Tag).Tags_Table (Pos) = Typ_Tag;
     end CW_Membership;
  
     -------------------
+    -- IW_Membership --
+    -------------------
+ 
+    --  Canonical implementation of Classwide Membership corresponding to:
+ 
+    --     Obj in Iface'Class
+ 
+    --  Each dispatch table contains a table with the tags of all the
+    --  implemented interfaces.
+ 
+    --  Obj is in Iface'Class if Iface'Tag is found in the table of interfaces
+    --  that are contained in the dispatch table referenced by Obj'Tag.
+ 
+    function IW_Membership (This : System.Address; T : Tag) return Boolean is
+       Curr_DT  : constant Tag := To_Tag_Ptr (This).all;
+       Id       : Natural;
+       Last_Id  : Natural;
+       Obj_Base : System.Address;
+       Obj_DT   : Tag;
+       Obj_TSD  : Type_Specific_Data_Ptr;
+ 
+    begin
+       pragma Assert
+         (Check_Signature (Curr_DT, Must_Be_Primary_Or_Secondary_DT));
+       pragma Assert
+         (Check_Signature (T, Must_Be_Primary_Or_Interface));
+ 
+       Obj_Base := This - Offset_To_Top (Curr_DT);
+       Obj_DT   := To_Tag_Ptr (Obj_Base).all;
+ 
+       pragma Assert
+         (Check_Signature (Curr_DT, Must_Be_Primary_DT));
+ 
+       Obj_TSD := TSD (Obj_DT);
+       Last_Id := Obj_TSD.Idepth + Obj_TSD.Num_Interfaces;
+ 
+       if Obj_TSD.Num_Interfaces > 0 then
+ 
+          --  Traverse the ancestor tags table plus the interface tags table.
+          --  The former part is required for:
+ 
+          --     Iface_CW in Typ'Class
+ 
+          Id := 0;
+          loop
+             if Obj_TSD.Tags_Table (Id) = T then
+                return True;
+             end if;
+ 
+             Id := Id + 1;
+             exit when Id > Last_Id;
+          end loop;
+       end if;
+ 
+       return False;
+    end IW_Membership;
+ 
+    --------------------
+    -- Descendant_Tag --
+    --------------------
+ 
+    function Descendant_Tag (External : String; Ancestor : Tag) return Tag is
+       Int_Tag : Tag;
+ 
+    begin
+       pragma Assert (Check_Signature (Ancestor, Must_Be_Primary_DT));
+       Int_Tag := Internal_Tag (External);
+       pragma Assert (Check_Signature (Int_Tag, Must_Be_Primary_DT));
+ 
+       if not Is_Descendant_At_Same_Level (Int_Tag, Ancestor) then
+          raise Tag_Error;
+       end if;
+ 
+       return Int_Tag;
+    end Descendant_Tag;
+ 
+    -------------------
     -- Expanded_Name --
     -------------------
  
     function Expanded_Name (T : Tag) return String is
!       Result : Cstring_Ptr;
! 
     begin
+       if T = No_Tag then
+          raise Tag_Error;
+       end if;
+ 
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
+       Result := TSD (T).Expanded_Name;
        return Result (1 .. Length (Result));
     end Expanded_Name;
  
*************** package body Ada.Tags is
*** 298,316 ****
     ------------------
  
     function External_Tag (T : Tag) return String is
!       Result : constant Cstring_Ptr := TSD (T).External_Tag;
     begin
        return Result (1 .. Length (Result));
     end External_Tag;
  
!    -----------------------
!    -- Get_Expanded_Name --
!    -----------------------
  
!    function Get_Expanded_Name (T : Tag) return System.Address is
     begin
!       return To_Address (TSD (T).Expanded_Name);
!    end Get_Expanded_Name;
  
     ----------------------
     -- Get_External_Tag --
--- 621,660 ----
     ------------------
  
     function External_Tag (T : Tag) return String is
!       Result : Cstring_Ptr;
! 
     begin
+       if T = No_Tag then
+          raise Tag_Error;
+       end if;
+ 
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
+       Result := TSD (T).External_Tag;
+ 
        return Result (1 .. Length (Result));
     end External_Tag;
  
!    ----------------------
!    -- Get_Access_Level --
!    ----------------------
  
!    function Get_Access_Level (T : Tag) return Natural is
     begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
!       return TSD (T).Access_Level;
!    end Get_Access_Level;
! 
!    ---------------------
!    -- Get_Entry_Index --
!    ---------------------
! 
!    function Get_Entry_Index (T : Tag; Position : Positive) return Positive is
!       Index : constant Integer := Position - Default_Prim_Op_Count;
!    begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
!       pragma Assert (Index > 0);
!       return SSD (T).SSD_Table (Index).Index;
!    end Get_Entry_Index;
  
     ----------------------
     -- Get_External_Tag --
*************** package body Ada.Tags is
*** 318,334 ****
  
     function Get_External_Tag (T : Tag) return System.Address is
     begin
        return To_Address (TSD (T).External_Tag);
     end Get_External_Tag;
  
!    ---------------------------
!    -- Get_Inheritance_Depth --
!    ---------------------------
  
!    function Get_Inheritance_Depth (T : Tag) return Natural is
     begin
!       return TSD (T).Idepth;
!    end Get_Inheritance_Depth;
  
     -------------------------
     -- Get_Prim_Op_Address --
--- 662,685 ----
  
     function Get_External_Tag (T : Tag) return System.Address is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
        return To_Address (TSD (T).External_Tag);
     end Get_External_Tag;
  
!    ----------------------
!    -- Get_Num_Prim_Ops --
!    ----------------------
  
!    function Get_Num_Prim_Ops (T : Tag) return Natural is
     begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
! 
!       if Is_Primary_DT (T) then
!          return TSD (T).Num_Prim_Ops;
!       else
!          return OSD (Interface_Tag (T)).Num_Prim_Ops;
!       end if;
!    end Get_Num_Prim_Ops;
  
     -------------------------
     -- Get_Prim_Op_Address --
*************** package body Ada.Tags is
*** 339,353 ****
--- 690,737 ----
        Position : Positive) return System.Address
     is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+       pragma Assert (Check_Index (T, Position));
        return T.Prims_Ptr (Position);
     end Get_Prim_Op_Address;
  
+    ----------------------
+    -- Get_Prim_Op_Kind --
+    ----------------------
+ 
+    function Get_Prim_Op_Kind
+      (T        : Tag;
+       Position : Positive) return Prim_Op_Kind
+    is
+       Index : constant Integer := Position - Default_Prim_Op_Count;
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       pragma Assert (Index > 0);
+       return SSD (T).SSD_Table (Index).Kind;
+    end Get_Prim_Op_Kind;
+ 
+    ----------------------
+    -- Get_Offset_Index --
+    ----------------------
+ 
+    function Get_Offset_Index
+      (T        : Interface_Tag;
+       Position : Positive) return Positive
+    is
+       Index : constant Integer := Position - Default_Prim_Op_Count;
+    begin
+       pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
+       pragma Assert (Index > 0);
+       return OSD (T).OSD_Table (Index);
+    end Get_Offset_Index;
+ 
     -------------------
     -- Get_RC_Offset --
     -------------------
  
     function Get_RC_Offset (T : Tag) return SSE.Storage_Offset is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
        return TSD (T).RC_Offset;
     end Get_RC_Offset;
  
*************** package body Ada.Tags is
*** 357,387 ****
  
     function Get_Remotely_Callable (T : Tag) return Boolean is
     begin
!       return TSD (T).Remotely_Callable = True;
     end Get_Remotely_Callable;
  
-    -------------
-    -- Get_TSD --
-    -------------
- 
-    function Get_TSD  (T : Tag) return System.Address is
-       use type System.Storage_Elements.Storage_Offset;
-       TSD_Ptr : constant Addr_Ptr :=
-                   To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
-    begin
-       return TSD_Ptr.all;
-    end Get_TSD;
- 
     ----------------
     -- Inherit_DT --
     ----------------
  
!    procedure Inherit_DT
!     (Old_T       : Tag;
!      New_T       : Tag;
!      Entry_Count : Natural)
!    is
     begin
        if Old_T /= null then
           New_T.Prims_Ptr (1 .. Entry_Count) :=
             Old_T.Prims_Ptr (1 .. Entry_Count);
--- 741,760 ----
  
     function Get_Remotely_Callable (T : Tag) return Boolean is
     begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
!       return TSD (T).Remotely_Callable;
     end Get_Remotely_Callable;
  
     ----------------
     -- Inherit_DT --
     ----------------
  
!    procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural) is
     begin
+       pragma Assert (Check_Signature (Old_T, Must_Be_Primary_Or_Secondary_DT));
+       pragma Assert (Check_Signature (New_T, Must_Be_Primary_Or_Secondary_DT));
+       pragma Assert (Check_Size (Old_T, New_T, Entry_Count));
+ 
        if Old_T /= null then
           New_T.Prims_Ptr (1 .. Entry_Count) :=
             Old_T.Prims_Ptr (1 .. Entry_Count);
*************** package body Ada.Tags is
*** 392,413 ****
     -- Inherit_TSD --
     -----------------
  
!    procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag) is
!       Old_TSD_Ptr  : constant Type_Specific_Data_Ptr :=
!                        To_Type_Specific_Data_Ptr (Old_TSD);
!       New_TSD_Ptr  : constant Type_Specific_Data_Ptr :=
!                        TSD (New_Tag);
  
     begin
!       if Old_TSD_Ptr /= null then
           New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
!          New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
!            Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
        else
!          New_TSD_Ptr.Idepth := 0;
        end if;
  
!       New_TSD_Ptr.Ancestor_Tags (0) := New_Tag;
     end Inherit_TSD;
  
     ------------------
--- 765,798 ----
     -- Inherit_TSD --
     -----------------
  
!    procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag) is
!       New_TSD_Ptr : Type_Specific_Data_Ptr;
!       Old_TSD_Ptr : Type_Specific_Data_Ptr;
  
     begin
!       pragma Assert (Check_Signature (New_Tag, Must_Be_Primary_Or_Interface));
!       New_TSD_Ptr := TSD (New_Tag);
! 
!       if Old_Tag /= null then
!          pragma Assert
!            (Check_Signature (Old_Tag, Must_Be_Primary_Or_Interface));
!          Old_TSD_Ptr := TSD (Old_Tag);
           New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
!          New_TSD_Ptr.Num_Interfaces := Old_TSD_Ptr.Num_Interfaces;
! 
!          --  Copy the "table of ancestor tags" plus the "table of interfaces"
!          --  of the parent.
! 
!          New_TSD_Ptr.Tags_Table
!            (1 .. New_TSD_Ptr.Idepth + New_TSD_Ptr.Num_Interfaces) :=
!              Old_TSD_Ptr.Tags_Table
!                (0 .. Old_TSD_Ptr.Idepth + Old_TSD_Ptr.Num_Interfaces);
        else
!          New_TSD_Ptr.Idepth         := 0;
!          New_TSD_Ptr.Num_Interfaces := 0;
        end if;
  
!       New_TSD_Ptr.Tags_Table (0) := New_Tag;
     end Inherit_TSD;
  
     ------------------
*************** package body Ada.Tags is
*** 420,426 ****
  
     begin
        --  Make a copy of the string representing the external tag with
!       --  a null at the end
  
        Ext_Copy (External'Range) := External;
        Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
--- 805,811 ----
  
     begin
        --  Make a copy of the string representing the external tag with
!       --  a null at the end.
  
        Ext_Copy (External'Range) := External;
        Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
*************** package body Ada.Tags is
*** 430,435 ****
--- 815,821 ----
           declare
              Msg1 : constant String := "unknown tagged type: ";
              Msg2 : String (1 .. Msg1'Length + External'Length);
+ 
           begin
              Msg2 (1 .. Msg1'Length) := Msg1;
              Msg2 (Msg1'Length + 1 .. Msg1'Length + External'Length) :=
*************** package body Ada.Tags is
*** 441,446 ****
--- 827,859 ----
        return Res;
     end Internal_Tag;
  
+    ---------------------------------
+    -- Is_Descendant_At_Same_Level --
+    ---------------------------------
+ 
+    function Is_Descendant_At_Same_Level
+      (Descendant : Tag;
+       Ancestor   : Tag) return Boolean
+    is
+    begin
+       return CW_Membership (Descendant, Ancestor)
+         and then TSD (Descendant).Access_Level = TSD (Ancestor).Access_Level;
+    end Is_Descendant_At_Same_Level;
+ 
+    -------------------
+    -- Is_Primary_DT --
+    -------------------
+ 
+    function Is_Primary_DT (T : Tag) return Boolean is
+       Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                             To_Storage_Offset_Ptr (To_Address (T)
+                               - Offset_To_Signature);
+       Signature         : constant Signature_Values :=
+                             To_Signature_Values (Offset_To_Top_Ptr.all);
+    begin
+       return Signature (2) = Primary_DT;
+    end Is_Primary_DT;
+ 
     ------------
     -- Length --
     ------------
*************** package body Ada.Tags is
*** 456,483 ****
        return Len - 1;
     end Length;
  
     -----------------
     -- Parent_Size --
     -----------------
  
-    type Acc_Size
-      is access function (A : System.Address) return Long_Long_Integer;
- 
-    function To_Acc_Size is new Unchecked_Conversion (System.Address, Acc_Size);
-    --  The profile of the implicitly defined _size primitive
- 
     function Parent_Size
       (Obj : System.Address;
        T   : Tag) return SSE.Storage_Count
     is
!       Parent_Tag : constant Tag := TSD (T).Ancestor_Tags (1);
        --  The tag of the parent type through the dispatch table
  
!       F : constant Acc_Size := To_Acc_Size (Parent_Tag.Prims_Ptr (1));
!       --  Access to the _size primitive of the parent. We assume that
!       --  it is always in the first slot of the distatch table
  
     begin
        --  Here we compute the size of the _parent field of the object
  
        return SSE.Storage_Count (F.all (Obj));
--- 869,924 ----
        return Len - 1;
     end Length;
  
+    -------------------
+    -- Offset_To_Top --
+    -------------------
+ 
+    function Offset_To_Top
+      (T : Tag) return System.Storage_Elements.Storage_Offset
+    is
+       Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                             To_Storage_Offset_Ptr (To_Address (T)
+                               - DT_Typeinfo_Ptr_Size
+                               - DT_Offset_To_Top_Size);
+ 
+    begin
+       return Offset_To_Top_Ptr.all;
+    end Offset_To_Top;
+ 
+    ---------
+    -- OSD --
+    ---------
+ 
+    function OSD
+      (T : Interface_Tag) return Object_Specific_Data_Ptr
+    is
+       OSD_Ptr : Addr_Ptr;
+ 
+    begin
+       OSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+       return To_Object_Specific_Data_Ptr (OSD_Ptr.all);
+    end OSD;
+ 
     -----------------
     -- Parent_Size --
     -----------------
  
     function Parent_Size
       (Obj : System.Address;
        T   : Tag) return SSE.Storage_Count
     is
!       Parent_Tag : Tag;
        --  The tag of the parent type through the dispatch table
  
!       F : Acc_Size;
!       --  Access to the _size primitive of the parent. We assume that it is
!       --  always in the first slot of the dispatch table.
  
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       Parent_Tag := TSD (T).Tags_Table (1);
+       F := To_Acc_Size (Parent_Tag.Prims_Ptr (1));
+ 
        --  Here we compute the size of the _parent field of the object
  
        return SSE.Storage_Count (F.all (Obj));
*************** package body Ada.Tags is
*** 489,497 ****
  
     function Parent_Tag (T : Tag) return Tag is
     begin
!       return TSD (T).Ancestor_Tags (1);
     end Parent_Tag;
  
     ------------------
     -- Register_Tag --
     ------------------
--- 930,992 ----
  
     function Parent_Tag (T : Tag) return Tag is
     begin
!       if T = No_Tag then
!          raise Tag_Error;
!       end if;
! 
!       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
! 
!       --  The Parent_Tag of a root-level tagged type is defined to be No_Tag.
!       --  The first entry in the Ancestors_Tags array will be null for such
!       --  a type, but it's better to be explicit about returning No_Tag in
!       --  this case.
! 
!       if TSD (T).Idepth = 0 then
!          return No_Tag;
!       else
!          return TSD (T).Tags_Table (1);
!       end if;
     end Parent_Tag;
  
+    ----------------------------
+    -- Register_Interface_Tag --
+    ----------------------------
+ 
+    procedure Register_Interface_Tag (T : Tag; Interface_T : Tag) is
+       New_T_TSD : Type_Specific_Data_Ptr;
+       Index     : Natural;
+ 
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       pragma Assert (Check_Signature (Interface_T, Must_Be_Interface));
+ 
+       New_T_TSD := TSD (T);
+ 
+       --  Check if the interface is already registered
+ 
+       if New_T_TSD.Num_Interfaces > 0 then
+          declare
+             Id      : Natural          := New_T_TSD.Idepth + 1;
+             Last_Id : constant Natural := New_T_TSD.Idepth
+                                             + New_T_TSD.Num_Interfaces;
+ 
+          begin
+             loop
+                if New_T_TSD.Tags_Table (Id) = Interface_T then
+                   return;
+                end if;
+ 
+                Id := Id + 1;
+                exit when Id > Last_Id;
+             end loop;
+          end;
+       end if;
+ 
+       New_T_TSD.Num_Interfaces := New_T_TSD.Num_Interfaces + 1;
+       Index := New_T_TSD.Idepth + New_T_TSD.Num_Interfaces;
+       New_T_TSD.Tags_Table (Index) := Interface_T;
+    end Register_Interface_Tag;
+ 
     ------------------
     -- Register_Tag --
     ------------------
*************** package body Ada.Tags is
*** 501,512 ****
--- 996,1036 ----
        External_Tag_HTable.Set (T);
     end Register_Tag;
  
+    ----------------------
+    -- Set_Access_Level --
+    ----------------------
+ 
+    procedure Set_Access_Level (T : Tag; Value : Natural) is
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       TSD (T).Access_Level := Value;
+    end Set_Access_Level;
+ 
+    ---------------------
+    -- Set_Entry_Index --
+    ---------------------
+ 
+    procedure Set_Entry_Index
+      (T        : Tag;
+       Position : Positive;
+       Value    : Positive)
+    is
+       Index : constant Integer := Position - Default_Prim_Op_Count;
+ 
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       pragma Assert (Index > 0);
+       SSD (T).SSD_Table (Index).Index := Value;
+    end Set_Entry_Index;
+ 
     -----------------------
     -- Set_Expanded_Name --
     -----------------------
  
     procedure Set_Expanded_Name (T : Tag; Value : System.Address) is
     begin
+       pragma Assert
+         (Check_Signature (T, Must_Be_Primary_Or_Interface));
        TSD (T).Expanded_Name := To_Cstring_Ptr (Value);
     end Set_Expanded_Name;
  
*************** package body Ada.Tags is
*** 516,535 ****
  
     procedure Set_External_Tag (T : Tag; Value : System.Address) is
     begin
        TSD (T).External_Tag := To_Cstring_Ptr (Value);
     end Set_External_Tag;
  
!    ---------------------------
!    -- Set_Inheritance_Depth --
!    ---------------------------
  
!    procedure Set_Inheritance_Depth
       (T     : Tag;
!       Value : Natural)
     is
     begin
!       TSD (T).Idepth := Value;
!    end Set_Inheritance_Depth;
  
     -------------------------
     -- Set_Prim_Op_Address --
--- 1040,1108 ----
  
     procedure Set_External_Tag (T : Tag; Value : System.Address) is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
        TSD (T).External_Tag := To_Cstring_Ptr (Value);
     end Set_External_Tag;
  
!    ----------------------
!    -- Set_Num_Prim_Ops --
!    ----------------------
  
!    procedure Set_Num_Prim_Ops (T : Tag; Value : Natural) is
!    begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
! 
!       if Is_Primary_DT (T) then
!          TSD (T).Num_Prim_Ops := Value;
!       else
!          OSD (Interface_Tag (T)).Num_Prim_Ops := Value;
!       end if;
!    end Set_Num_Prim_Ops;
! 
!    ----------------------
!    -- Set_Offset_Index --
!    ----------------------
! 
!    procedure Set_Offset_Index
!      (T        : Interface_Tag;
!       Position : Positive;
!       Value    : Positive)
!    is
!       Index : constant Integer := Position - Default_Prim_Op_Count;
!    begin
!       pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
!       pragma Assert (Index > 0);
!       OSD (T).OSD_Table (Index) := Value;
!    end Set_Offset_Index;
! 
!    -----------------------
!    -- Set_Offset_To_Top --
!    -----------------------
! 
!    procedure Set_Offset_To_Top
       (T     : Tag;
!       Value : System.Storage_Elements.Storage_Offset)
     is
+       Offset_To_Top_Ptr : constant Storage_Offset_Ptr :=
+                             To_Storage_Offset_Ptr (To_Address (T)
+                               - DT_Typeinfo_Ptr_Size
+                               - DT_Offset_To_Top_Size);
     begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
!       Offset_To_Top_Ptr.all := Value;
!    end Set_Offset_To_Top;
! 
!    -------------
!    -- Set_OSD --
!    -------------
! 
!    procedure Set_OSD (T : Interface_Tag; Value : System.Address) is
!       OSD_Ptr : Addr_Ptr;
!    begin
!       pragma Assert (Check_Signature (Tag (T), Must_Be_Secondary_DT));
!       OSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
!       OSD_Ptr.all := Value;
!    end Set_OSD;
  
     -------------------------
     -- Set_Prim_Op_Address --
*************** package body Ada.Tags is
*** 541,555 ****
--- 1114,1147 ----
        Value    : System.Address)
     is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Secondary_DT));
+       pragma Assert (Check_Index (T, Position));
        T.Prims_Ptr (Position) := Value;
     end Set_Prim_Op_Address;
  
+    ----------------------
+    -- Set_Prim_Op_Kind --
+    ----------------------
+ 
+    procedure Set_Prim_Op_Kind
+      (T        : Tag;
+       Position : Positive;
+       Value    : Prim_Op_Kind)
+    is
+       Index : constant Integer := Position - Default_Prim_Op_Count;
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       pragma Assert (Index > 0);
+       SSD (T).SSD_Table (Index).Kind := Value;
+    end Set_Prim_Op_Kind;
+ 
     -------------------
     -- Set_RC_Offset --
     -------------------
  
     procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset) is
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
        TSD (T).RC_Offset := Value;
     end Set_RC_Offset;
  
*************** package body Ada.Tags is
*** 559,601 ****
  
     procedure Set_Remotely_Callable (T : Tag; Value : Boolean) is
     begin
!       if Value then
!          TSD (T).Remotely_Callable := True;
!       else
!          TSD (T).Remotely_Callable := False;
!       end if;
     end Set_Remotely_Callable;
  
     -------------
     -- Set_TSD --
     -------------
  
     procedure Set_TSD (T : Tag; Value : System.Address) is
!       use type System.Storage_Elements.Storage_Offset;
!       TSD_Ptr : constant Addr_Ptr :=
!                   To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
     begin
        TSD_Ptr.all := Value;
     end Set_TSD;
  
!    -------------------
!    -- Offset_To_Top --
!    -------------------
  
!    function Offset_To_Top (T : Tag) return Integer is
!       use type System.Storage_Elements.Storage_Offset;
!       TSD_Ptr : constant Int_Ptr :=
!                   To_Int_Ptr (To_Address (T) - DT_Prologue_Size);
     begin
!       return TSD_Ptr.all;
!    end Offset_To_Top;
  
     ------------------
     -- Typeinfo_Ptr --
     ------------------
  
     function Typeinfo_Ptr (T : Tag) return System.Address is
-       use type System.Storage_Elements.Storage_Offset;
        TSD_Ptr : constant Addr_Ptr :=
                    To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
     begin
--- 1151,1196 ----
  
     procedure Set_Remotely_Callable (T : Tag; Value : Boolean) is
     begin
!       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
!       TSD (T).Remotely_Callable := Value;
     end Set_Remotely_Callable;
  
     -------------
+    -- Set_SSD --
+    -------------
+ 
+    procedure Set_SSD (T : Tag; Value : System.Address) is
+    begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_DT));
+       TSD (T).SSD_Ptr := Value;
+    end Set_SSD;
+ 
+    -------------
     -- Set_TSD --
     -------------
  
     procedure Set_TSD (T : Tag; Value : System.Address) is
!       TSD_Ptr : Addr_Ptr;
     begin
+       pragma Assert (Check_Signature (T, Must_Be_Primary_Or_Interface));
+       TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
        TSD_Ptr.all := Value;
     end Set_TSD;
  
!    ---------
!    -- SSD --
!    ---------
  
!    function SSD (T : Tag) return Select_Specific_Data_Ptr is
     begin
!       return To_Select_Specific_Data_Ptr (TSD (T).SSD_Ptr);
!    end SSD;
  
     ------------------
     -- Typeinfo_Ptr --
     ------------------
  
     function Typeinfo_Ptr (T : Tag) return System.Address is
        TSD_Ptr : constant Addr_Ptr :=
                    To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
     begin
*************** package body Ada.Tags is
*** 607,614 ****
     ---------
  
     function TSD (T : Tag) return Type_Specific_Data_Ptr is
     begin
!       return To_Type_Specific_Data_Ptr (Get_TSD (T));
     end TSD;
  
  end Ada.Tags;
--- 1202,1211 ----
     ---------
  
     function TSD (T : Tag) return Type_Specific_Data_Ptr is
+       TSD_Ptr : constant Addr_Ptr :=
+                   To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
     begin
!       return To_Type_Specific_Data_Ptr (TSD_Ptr.all);
     end TSD;
  
  end Ada.Tags;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tags.ads gcc-4.1.0/gcc/ada/a-tags.ads
*** gcc-4.0.2/gcc/ada/a-tags.ads	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/a-tags.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Storage_Elements;
*** 40,73 ****
  with Unchecked_Conversion;
  
  package Ada.Tags is
! 
!    pragma Elaborate_Body;
  
     type Tag is private;
  
     function Expanded_Name (T : Tag) return String;
  
     function External_Tag (T : Tag) return String;
  
     function Internal_Tag (External : String) return Tag;
  
     Tag_Error : exception;
  
  private
  
     ---------------------------------------------------------------
     -- Abstract Procedural Interface For The GNAT Dispatch Table --
     ---------------------------------------------------------------
  
     --  GNAT's Dispatch Table format is customizable in order to match the
!    --  format used in another language. GNAT supports programs that use
!    --  two different dispatch table formats at the same time: the native
!    --  format that supports Ada 95 tagged types and which is described in
!    --  Ada.Tags, and a foreign format for types that are imported from some
!    --  other language (typically C++) which is described in Interfaces.CPP.
!    --  The runtime information kept for each tagged type is separated into
!    --  two objects: the Dispatch Table and the Type Specific Data record.
!    --  These two objects are allocated statically using the constants:
  
     --      DT Size  = DT_Prologue_Size  + Nb_Prim * DT_Entry_Size
     --      TSD Size = TSD_Prologue_Size + (1 + Idepth)  * TSD_Entry_Size
--- 40,90 ----
  with Unchecked_Conversion;
  
  package Ada.Tags is
!    pragma Preelaborate_05;
!    --  In accordance with Ada 2005 AI-362
  
     type Tag is private;
  
+    No_Tag : constant Tag;
+ 
     function Expanded_Name (T : Tag) return String;
  
     function External_Tag (T : Tag) return String;
  
     function Internal_Tag (External : String) return Tag;
  
+    function Descendant_Tag
+      (External : String;
+       Ancestor : Tag) return Tag;
+    pragma Ada_05 (Descendant_Tag);
+ 
+    function Is_Descendant_At_Same_Level
+      (Descendant : Tag;
+       Ancestor   : Tag) return Boolean;
+    pragma Ada_05 (Is_Descendant_At_Same_Level);
+ 
+    function Parent_Tag (T : Tag) return Tag;
+    pragma Ada_05 (Parent_Tag);
+ 
     Tag_Error : exception;
  
  private
+    --  The following subprogram specifications are placed here instead of
+    --  the package body to see them from the frontend through rtsfind.
  
     ---------------------------------------------------------------
     -- Abstract Procedural Interface For The GNAT Dispatch Table --
     ---------------------------------------------------------------
  
     --  GNAT's Dispatch Table format is customizable in order to match the
!    --  format used in another language. GNAT supports programs that use two
!    --  different dispatch table formats at the same time: the native format
!    --  that supports Ada 95 tagged types and which is described in Ada.Tags,
!    --  and a foreign format for types that are imported from some other
!    --  language (typically C++) which is described in Interfaces.CPP. The
!    --  runtime information kept for each tagged type is separated into two
!    --  objects: the Dispatch Table and the Type Specific Data record. These
!    --  two objects are allocated statically using the constants:
  
     --      DT Size  = DT_Prologue_Size  + Nb_Prim * DT_Entry_Size
     --      TSD Size = TSD_Prologue_Size + (1 + Idepth)  * TSD_Entry_Size
*************** private
*** 75,114 ****
     --  where Nb_prim is the number of primitive operations of the given
     --  type and Idepth its inheritance depth.
  
!    --  The compiler generates calls to the following SET routines to
!    --  initialize those structures and uses the GET functions to
!    --  retreive the information when needed
  
     type Dispatch_Table;
     type Tag is access all Dispatch_Table;
  
     type Type_Specific_Data;
     type Type_Specific_Data_Ptr is access all Type_Specific_Data;
  
     package SSE renames System.Storage_Elements;
  
     function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean;
     --  Given the tag of an object and the tag associated to a type, return
     --  true if Obj is in Typ'Class.
  
!    function Get_Expanded_Name (T : Tag) return System.Address;
!    --  Retrieve the address of a null terminated string containing
!    --  the expanded name
  
     function Get_External_Tag (T : Tag) return System.Address;
     --  Retrieve the address of a null terminated string containing
!    --  the external name
  
     function Get_Prim_Op_Address
       (T        : Tag;
        Position : Positive) return System.Address;
!    --  Given a pointer to a dispatch Table (T) and a position in the DT
     --  this function returns the address of the virtual function stored
!    --  in it (used for dispatching calls)
  
!    function Get_Inheritance_Depth (T : Tag) return Natural;
!    --  Given a pointer to a dispatch Table, retrieves the value representing
!    --  the depth in the inheritance tree (used for membership).
  
     function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
     --  Return the Offset of the implicit record controller when the object
--- 92,196 ----
     --  where Nb_prim is the number of primitive operations of the given
     --  type and Idepth its inheritance depth.
  
!    --  In order to set or retrieve information from the Dispatch Table or
!    --  the Type Specific Data record, GNAT generates calls to Set_XXX or
!    --  Get_XXX routines, where XXX is the name of the field of interest.
  
     type Dispatch_Table;
     type Tag is access all Dispatch_Table;
+    type Interface_Tag is access all Dispatch_Table;
+ 
+    No_Tag : constant Tag := null;
+ 
+    type Object_Specific_Data (Nb_Prim : Positive);
+    type Object_Specific_Data_Ptr is access all Object_Specific_Data;
+    --  Information associated with the secondary dispatch table of tagged-type
+    --  objects implementing abstract interfaces.
+ 
+    type Select_Specific_Data (Nb_Prim : Positive);
+    type Select_Specific_Data_Ptr is access all Select_Specific_Data;
+    --  A table used to store the primitive operation kind and entry index of
+    --  primitive subprograms of a type that implements a limited interface.
+    --  The Select Specific Data table resides in the Type Specific Data of a
+    --  type. This construct is used in the handling of dispatching triggers
+    --  in select statements.
  
     type Type_Specific_Data;
     type Type_Specific_Data_Ptr is access all Type_Specific_Data;
  
+    --  Primitive operation kinds. These values differentiate the kinds of
+    --  callable entities stored in the dispatch table. Certain kinds may
+    --  not be used, but are added for completeness.
+ 
+    type Prim_Op_Kind is
+      (POK_Function,
+       POK_Procedure,
+       POK_Protected_Entry,
+       POK_Protected_Function,
+       POK_Protected_Procedure,
+       POK_Task_Entry,
+       POK_Task_Function,
+       POK_Task_Procedure);
+ 
+    Default_Prim_Op_Count : constant Positive := 15;
+    --  Number of predefined primitive operations added by the Expander for a
+    --  tagged type. It is utilized for indexing in the two auxiliary tables
+    --  used for dispatching asynchronous, conditional and timed selects. In
+    --  order to be space efficient, indexing is performed by subtracting this
+    --  constant value from the provided position in the auxiliary tables (must
+    --  match Exp_Disp.Default_Prim_Op_Count).
+ 
     package SSE renames System.Storage_Elements;
  
     function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean;
     --  Given the tag of an object and the tag associated to a type, return
     --  true if Obj is in Typ'Class.
  
!    function IW_Membership (This : System.Address; T : Tag) return Boolean;
!    --  Ada 2005 (AI-251): General routine that checks if a given object
!    --  implements a tagged type. Its common usage is to check if Obj is in
!    --  Iface'Class, but it is also used to check if a class-wide interface
!    --  implements a given type (Iface_CW_Typ in T'Class). For example:
!    --
!    --      type I is interface;
!    --      type T is tagged ...
!    --
!    --      function Test (O : in I'Class) is
!    --      begin
!    --         return O in T'Class.
!    --      end Test;
! 
!    function Get_Access_Level (T : Tag) return Natural;
!    --  Given the tag associated with a type, returns the accessibility level
!    --  of the type.
! 
!    function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
!    --  Return a primitive operation's entry index (if entry) given a dispatch
!    --  table T and a position of a primitive operation in T.
  
     function Get_External_Tag (T : Tag) return System.Address;
     --  Retrieve the address of a null terminated string containing
!    --  the external name.
! 
!    function Get_Offset_Index
!      (T        : Interface_Tag;
!       Position : Positive) return Positive;
!    --  Given a pointer to a secondary dispatch table (T) and a position of an
!    --  operation in the DT, retrieve the corresponding operation's position in
!    --  the primary dispatch table from the Offset Specific Data table of T.
  
     function Get_Prim_Op_Address
       (T        : Tag;
        Position : Positive) return System.Address;
!    --  Given a pointer to a dispatch table (T) and a position in the DT
     --  this function returns the address of the virtual function stored
!    --  in it (used for dispatching calls).
  
!    function Get_Prim_Op_Kind
!      (T        : Tag;
!       Position : Positive) return Prim_Op_Kind;
!    --  Return a primitive operation's kind given a dispatch table T and a
!    --  position of a primitive operation in T.
  
     function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
     --  Return the Offset of the implicit record controller when the object
*************** private
*** 122,192 ****
     function Get_Remotely_Callable (T : Tag) return Boolean;
     --  Return the value previously set by Set_Remotely_Callable
  
!    function  Get_TSD (T : Tag) return System.Address;
!    --  Given a pointer T to a dispatch Table, retreives the address of the
!    --  record containing the Type Specific Data generated by GNAT
! 
!    procedure Inherit_DT
!     (Old_T   : Tag;
!      New_T   : Tag;
!      Entry_Count : Natural);
     --  Entry point used to initialize the DT of a type knowing the tag
     --  of the direct ancestor and the number of primitive ops that are
     --  inherited (Entry_Count).
  
!    procedure Inherit_TSD (Old_TSD : System.Address; New_Tag : Tag);
!    --  Entry point used to initialize the TSD of a type knowing the
!    --  TSD of the direct ancestor.
  
     function Parent_Size
       (Obj : System.Address;
        T   : Tag) return SSE.Storage_Count;
!    --  Computes the size the ancestor part of a tagged extension object
!    --  whose address is 'obj' by calling the indirectly _size function of
!    --  the ancestor. The ancestor is the parent of the type represented by
!    --  tag T. This function assumes that _size is always in slot 1 of
!    --  the dispatch table.
  
     pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
     --  This procedure is used in s-finimp and is thus exported manually
  
!    function Parent_Tag (T : Tag) return Tag;
!    --  Obj is the address of a tagged object. Parent_Tag fetch the tag of the
!    --  immediate ancestor (parent) of the type associated with Obj.
! 
!    pragma Export (Ada, Parent_Tag, "ada__tags__parent_tag");
!    --  This procedure is used in s-finimp and is thus exported manually
  
     procedure Register_Tag (T : Tag);
     --  Insert the Tag and its associated external_tag in a table for the
     --  sake of Internal_Tag
  
!    procedure Set_Inheritance_Depth
       (T     : Tag;
!       Value : Natural);
!    --  Given a pointer to a dispatch Table, stores the value representing
!    --  the depth in the inheritance tree (the second parameter). Used during
!    --  elaboration of the tagged type.
  
     procedure Set_Prim_Op_Address
       (T        : Tag;
        Position : Positive;
        Value    : System.Address);
!    --  Given a pointer to a dispatch Table (T) and a position in the
!    --  dispatch Table put the address of the virtual function in it
!    --  (used for overriding)
  
     procedure Set_TSD (T : Tag; Value : System.Address);
     --  Given a pointer T to a dispatch Table, stores the address of the record
!    --  containing the Type Specific Data generated by GNAT
  
     procedure Set_Expanded_Name (T : Tag; Value : System.Address);
     --  Set the address of the string containing the expanded name
!    --  in the Dispatch table
  
     procedure Set_External_Tag (T : Tag; Value : System.Address);
     --  Set the address of the string containing the external tag
!    --  in the Dispatch table
  
     procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset);
     --  Sets the Offset of the implicit record controller when the object
--- 204,302 ----
     function Get_Remotely_Callable (T : Tag) return Boolean;
     --  Return the value previously set by Set_Remotely_Callable
  
!    procedure Inherit_DT (Old_T : Tag; New_T : Tag; Entry_Count : Natural);
     --  Entry point used to initialize the DT of a type knowing the tag
     --  of the direct ancestor and the number of primitive ops that are
     --  inherited (Entry_Count).
  
!    procedure Inherit_TSD (Old_Tag : Tag; New_Tag : Tag);
!    --  Initialize the TSD of a type knowing the tag of the direct ancestor
! 
!    function OSD (T : Interface_Tag) return Object_Specific_Data_Ptr;
!    --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
!    --  retrieve the address of the record containing the Objet Specific
!    --  Data table.
  
     function Parent_Size
       (Obj : System.Address;
        T   : Tag) return SSE.Storage_Count;
!    --  Computes the size the ancestor part of a tagged extension object whose
!    --  address is 'obj' by calling indirectly the ancestor _size function. The
!    --  ancestor is the parent of the type represented by tag T. This function
!    --  assumes that _size is always in slot one of the dispatch table.
  
     pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
     --  This procedure is used in s-finimp and is thus exported manually
  
!    procedure Register_Interface_Tag (T : Tag; Interface_T : Tag);
!    --  Ada 2005 (AI-251): Used to initialize the table of interfaces
!    --  implemented by a type. Required to give support to IW_Membership.
  
     procedure Register_Tag (T : Tag);
     --  Insert the Tag and its associated external_tag in a table for the
     --  sake of Internal_Tag
  
!    procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
!    --  Set the entry index of a primitive operation in T's TSD table indexed
!    --  by Position.
! 
!    procedure Set_Num_Prim_Ops (T : Tag; Value : Natural);
!    --  Set the number of primitive operations in the dispatch table of T. This
!    --  is used for debugging purposes.
! 
!    procedure Set_Offset_Index
!      (T        : Interface_Tag;
!       Position : Positive;
!       Value    : Positive);
!    --  Set the offset value of a primitive operation in a secondary dispatch
!    --  table denoted by T, indexed by Position.
! 
!    procedure Set_Offset_To_Top
       (T     : Tag;
!       Value : System.Storage_Elements.Storage_Offset);
!    --  Ada 2005 (AI-251): Initialize the Offset_To_Top field in the prologue of
!    --  the dispatch table. In primary dispatch tables the value of this field
!    --  is always 0; in secondary dispatch tables this is the offset to the base
!    --  of the enclosing type.
! 
!    procedure Set_OSD (T : Interface_Tag; Value : System.Address);
!    --  Given a pointer T to a secondary dispatch table, store the pointer to
!    --  the record containing the Object Specific Data generated by GNAT.
  
     procedure Set_Prim_Op_Address
       (T        : Tag;
        Position : Positive;
        Value    : System.Address);
!    --  Given a pointer to a dispatch Table (T) and a position in the dispatch
!    --  Table put the address of the virtual function in it (used for
!    --  overriding).
! 
!    procedure Set_Prim_Op_Kind
!      (T        : Tag;
!       Position : Positive;
!       Value    : Prim_Op_Kind);
!    --  Set the kind of a primitive operation in T's TSD table indexed by
!    --  Position.
! 
!    procedure Set_SSD (T : Tag; Value : System.Address);
!    --  Given a pointer T to a dispatch Table, stores the pointer to the record
!    --  containing the Select Specific Data generated by GNAT.
  
     procedure Set_TSD (T : Tag; Value : System.Address);
     --  Given a pointer T to a dispatch Table, stores the address of the record
!    --  containing the Type Specific Data generated by GNAT.
! 
!    procedure Set_Access_Level (T : Tag; Value : Natural);
!    --  Sets the accessibility level of the tagged type associated with T
!    --  in its TSD.
  
     procedure Set_Expanded_Name (T : Tag; Value : System.Address);
     --  Set the address of the string containing the expanded name
!    --  in the Dispatch table.
  
     procedure Set_External_Tag (T : Tag; Value : System.Address);
     --  Set the address of the string containing the external tag
!    --  in the Dispatch table.
  
     procedure Set_RC_Offset (T : Tag; Value : SSE.Storage_Offset);
     --  Sets the Offset of the implicit record controller when the object
*************** private
*** 196,224 ****
     --  Set to true if the type has been declared in a context described
     --  in E.4 (18).
  
     function TSD (T : Tag) return Type_Specific_Data_Ptr;
!    --  This function is conceptually equivalent to Get_TSD, but
!    --  returning a Type_Specific_Data_Ptr type (rather than an Address)
!    --  simplifies the implementation of the other subprograms.
  
     DT_Prologue_Size : constant SSE.Storage_Count :=
                          SSE.Storage_Count
!                           (2 * (Standard'Address_Size / System.Storage_Unit));
     --  Size of the first part of the dispatch table
  
     DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
                              SSE.Storage_Count
                                (Standard'Address_Size / System.Storage_Unit);
!    --  Size of the Typeinfo_Ptr field of the Dispatch Table.
  
     DT_Entry_Size : constant SSE.Storage_Count :=
                       SSE.Storage_Count
                         (1 * (Standard'Address_Size / System.Storage_Unit));
!    --  Size of each primitive operation entry in the Dispatch Table.
  
     TSD_Prologue_Size : constant SSE.Storage_Count :=
                           SSE.Storage_Count
!                            (6 * Standard'Address_Size / System.Storage_Unit);
     --  Size of the first part of the type specific data
  
     TSD_Entry_Size : constant SSE.Storage_Count :=
--- 306,347 ----
     --  Set to true if the type has been declared in a context described
     --  in E.4 (18).
  
+    function SSD (T : Tag) return Select_Specific_Data_Ptr;
+    --  Given a pointer T to a dispatch Table, retrieves the address of the
+    --  record containing the Select Specific Data in T's TSD.
+ 
     function TSD (T : Tag) return Type_Specific_Data_Ptr;
!    --  Given a pointer T to a dispatch Table, retrieves the address of the
!    --  record containing the Type Specific Data generated by GNAT.
  
     DT_Prologue_Size : constant SSE.Storage_Count :=
                          SSE.Storage_Count
!                           (3 * (Standard'Address_Size / System.Storage_Unit));
     --  Size of the first part of the dispatch table
  
+    DT_Signature_Size : constant SSE.Storage_Count :=
+                          SSE.Storage_Count
+                            (Standard'Address_Size / System.Storage_Unit);
+    --  Size of the Signature field of the dispatch table
+ 
+    DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
+                             SSE.Storage_Count
+                               (Standard'Address_Size / System.Storage_Unit);
+    --  Size of the Offset_To_Top field of the Dispatch Table
+ 
     DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
                              SSE.Storage_Count
                                (Standard'Address_Size / System.Storage_Unit);
!    --  Size of the Typeinfo_Ptr field of the Dispatch Table
  
     DT_Entry_Size : constant SSE.Storage_Count :=
                       SSE.Storage_Count
                         (1 * (Standard'Address_Size / System.Storage_Unit));
!    --  Size of each primitive operation entry in the Dispatch Table
  
     TSD_Prologue_Size : constant SSE.Storage_Count :=
                           SSE.Storage_Count
!                           (10 * (Standard'Address_Size / System.Storage_Unit));
     --  Size of the first part of the type specific data
  
     TSD_Entry_Size : constant SSE.Storage_Count :=
*************** private
*** 231,270 ****
     --  of this type are declared with a dummy size of 1, the actual size
     --  depending on the number of primitive operations.
  
     function To_Type_Specific_Data_Ptr is
       new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
  
     function To_Address is
!      new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address);
  
     function To_Address is
       new Unchecked_Conversion (Tag, System.Address);
  
!    type Addr_Ptr is access System.Address;
  
!    function To_Addr_Ptr is
!       new Unchecked_Conversion (System.Address, Addr_Ptr);
  
     --  Primitive dispatching operations are always inlined, to facilitate
     --  use in a minimal/no run-time environment for high integrity use.
  
     pragma Inline_Always (CW_Membership);
!    pragma Inline_Always (Get_Expanded_Name);
!    pragma Inline_Always (Get_Inheritance_Depth);
     pragma Inline_Always (Get_Prim_Op_Address);
     pragma Inline_Always (Get_RC_Offset);
     pragma Inline_Always (Get_Remotely_Callable);
-    pragma Inline_Always (Get_TSD);
     pragma Inline_Always (Inherit_DT);
     pragma Inline_Always (Inherit_TSD);
     pragma Inline_Always (Register_Tag);
     pragma Inline_Always (Set_Expanded_Name);
     pragma Inline_Always (Set_External_Tag);
!    pragma Inline_Always (Set_Inheritance_Depth);
     pragma Inline_Always (Set_Prim_Op_Address);
     pragma Inline_Always (Set_RC_Offset);
     pragma Inline_Always (Set_Remotely_Callable);
     pragma Inline_Always (Set_TSD);
     pragma Inline_Always (TSD);
  
  end Ada.Tags;
--- 354,446 ----
     --  of this type are declared with a dummy size of 1, the actual size
     --  depending on the number of primitive operations.
  
+    type Signature_Kind is
+       (Unknown,
+        Valid_Signature,
+        Primary_DT,
+        Secondary_DT,
+        Abstract_Interface);
+    for Signature_Kind'Size use 8;
+    --  Kind of signature found in the header of the dispatch table. These
+    --  signatures are generated by the frontend and are used by the Check_XXX
+    --  routines to ensure that the kind of dispatch table managed by each of
+    --  the routines in this package is correct. This additional check is only
+    --  performed with this run-time package is compiled with assertions enabled
+ 
+    --  The signature is a sequence of two bytes. The first byte must have the
+    --  value Valid_Signature, and the second byte must have a value in the
+    --  range Primary_DT .. Abstract_Interface. The Unknown value is used by
+    --  the Check_XXX routines to indicate that the signature is wrong.
+ 
+    --  Unchecked Conversions
+ 
+    type Addr_Ptr is access System.Address;
+    type Tag_Ptr  is access Tag;
+ 
+    type Signature_Values is
+       array (1 .. DT_Signature_Size) of Signature_Kind;
+    --  Type used to see the signature as a sequence of Signature_Kind values
+ 
+    function To_Addr_Ptr is
+       new Unchecked_Conversion (System.Address, Addr_Ptr);
+ 
     function To_Type_Specific_Data_Ptr is
       new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
  
     function To_Address is
!      new Unchecked_Conversion (Interface_Tag, System.Address);
  
     function To_Address is
       new Unchecked_Conversion (Tag, System.Address);
  
!    function To_Address is
!      new Unchecked_Conversion (Type_Specific_Data_Ptr, System.Address);
  
!    function To_Object_Specific_Data_Ptr is
!      new Unchecked_Conversion (System.Address, Object_Specific_Data_Ptr);
! 
!    function To_Select_Specific_Data_Ptr is
!      new Unchecked_Conversion (System.Address, Select_Specific_Data_Ptr);
! 
!    function To_Signature_Values is
!      new Unchecked_Conversion (System.Storage_Elements.Storage_Offset,
!                                Signature_Values);
! 
!    function To_Tag_Ptr is
!      new Unchecked_Conversion (System.Address, Tag_Ptr);
  
     --  Primitive dispatching operations are always inlined, to facilitate
     --  use in a minimal/no run-time environment for high integrity use.
  
     pragma Inline_Always (CW_Membership);
!    pragma Inline_Always (IW_Membership);
!    pragma Inline_Always (Get_Access_Level);
!    pragma Inline_Always (Get_Entry_Index);
!    pragma Inline_Always (Get_Offset_Index);
     pragma Inline_Always (Get_Prim_Op_Address);
+    pragma Inline_Always (Get_Prim_Op_Kind);
     pragma Inline_Always (Get_RC_Offset);
     pragma Inline_Always (Get_Remotely_Callable);
     pragma Inline_Always (Inherit_DT);
     pragma Inline_Always (Inherit_TSD);
+    pragma Inline_Always (OSD);
+    pragma Inline_Always (Register_Interface_Tag);
     pragma Inline_Always (Register_Tag);
+    pragma Inline_Always (Set_Access_Level);
+    pragma Inline_Always (Set_Entry_Index);
     pragma Inline_Always (Set_Expanded_Name);
     pragma Inline_Always (Set_External_Tag);
!    pragma Inline_Always (Set_Num_Prim_Ops);
!    pragma Inline_Always (Set_Offset_Index);
!    pragma Inline_Always (Set_Offset_To_Top);
     pragma Inline_Always (Set_Prim_Op_Address);
+    pragma Inline_Always (Set_Prim_Op_Kind);
     pragma Inline_Always (Set_RC_Offset);
     pragma Inline_Always (Set_Remotely_Callable);
+    pragma Inline_Always (Set_OSD);
+    pragma Inline_Always (Set_SSD);
     pragma Inline_Always (Set_TSD);
+    pragma Inline_Always (SSD);
     pragma Inline_Always (TSD);
  
  end Ada.Tags;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tasatt.adb gcc-4.1.0/gcc/ada/a-tasatt.adb
*** gcc-4.0.2/gcc/ada/a-tasatt.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/a-tasatt.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,205 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The following notes are provided in case someone decides the
! --  implementation of this package is too complicated, or too slow.
! --  Please read this before making any "simplifications".
  
! --  Correct implementation of this package is more difficult than one
! --  might expect. After considering (and coding) several alternatives,
! --  we settled on the present compromise. Things we do not like about
! --  this implementation include:
  
! --  -  It is vulnerable to bad Task_Id values, to the extent of
! --     possibly trashing memory and crashing the runtime system.
  
! --  -  It requires dynamic storage allocation for each new attribute value,
! --     except for types that happen to be the same size as System.Address,
! --     or shorter.
  
  --  -  Instantiations at other than the library level rely on being able to
  --     do down-level calls to a procedure declared in the generic package body.
  --     This makes it potentially vulnerable to compiler changes.
  
! --  The main implementation issue here is that the connection from
! --  task to attribute is a potential source of dangling references.
  
  --  When a task goes away, we want to be able to recover all the storage
! --  associated with its attributes. The Ada mechanism for this is
! --  finalization, via controlled attribute types. For this reason,
! --  the ARM requires finalization of attribute values when the
! --  associated task terminates.
  
! --  This finalization must be triggered by the tasking runtime system,
! --  during termination of the task. Given the active set of instantiations
! --  of Ada.Task_Attributes is dynamic, the number and types of attributes
  --  belonging to a task will not be known until the task actually terminates.
  --  Some of these types may be controlled and some may not. The RTS must find
  --  some way to determine which of these attributes need finalization, and
  --  invoke the appropriate finalization on them.
  
! --  One way this might be done is to create a special finalization chain
! --  for each task, similar to the finalization chain that is used for
! --  controlled objects within the task. This would differ from the usual
! --  finalization chain in that it would not have a LIFO structure, since
! --  attributes may be added to a task at any time during its lifetime.
! --  This might be the right way to go for the longer term, but at present
! --  this approach is not open, since GNAT does not provide such special
! --  finalization support.
  
! --  Lacking special compiler support, the RTS is limited to the
! --  normal ways an application invokes finalization, i.e.
  
! --  a) Explicit call to the procedure Finalize, if we know the type
! --     has this operation defined on it. This is not sufficient, since
! --     we have no way of determining whether a given generic formal
! --     Attribute type is controlled, and no visibility of the associated
! --     Finalize procedure, in the generic body.
  
! --  b) Leaving the scope of a local object of a controlled type.
! --     This does not help, since the lifetime of an instantiation of
! --     Ada.Task_Attributes does not correspond to the lifetimes of the
! --     various tasks which may have that attribute.
  
! --  c) Assignment of another value to the object. This would not help,
! --     since we then have to finalize the new value of the object.
  
! --  d) Unchecked deallocation of an object of a controlled type.
! --     This seems to be the only mechanism available to the runtime
! --     system for finalization of task attributes.
  
! --  We considered two ways of using unchecked deallocation, both based
! --  on a linked list of that would hang from the task control block.
  
  --  In the first approach the objects on the attribute list are all derived
  --  from one controlled type, say T, and are linked using an access type to
! --  T'Class. The runtime system has an Unchecked_Deallocation for T'Class
! --  with access type T'Class, and uses this to deallocate and finalize all
! --  the items in the list. The limitation of this approach is that each
  --  instantiation of the package Ada.Task_Attributes derives a new record
! --  extension of T, and since T is controlled (RM 3.9.1 (3)), instantiation
! --  is only allowed at the library level.
  
! --  In the second approach the objects on the attribute list are of
! --  unrelated but structurally similar types. Unchecked conversion is
! --  used to circument Ada type checking. Each attribute-storage node
! --  contains not only the attribute value and a link for chaining, but
! --  also a pointer to a descriptor for the corresponding instantiation
! --  of Task_Attributes. The instantiation-descriptor contains a
! --  pointer to a procedure that can do the correct deallocation and
! --  finalization for that type of attribute. On task termination, the
! --  runtime system uses the pointer to call the appropriate deallocator.
  
! --  While this gets around the limitation that instantations be at
! --  the library level, it relies on an implementation feature that
! --  may not always be safe, i.e. that it is safe to call the
! --  Deallocate procedure for an instantiation of Ada.Task_Attributes
! --  that no longer exists. In general, it seems this might result in
! --  dangling references.
  
! --  Another problem with instantiations deeper than the library level
! --  is that there is risk of storage leakage, or dangling references
! --  to reused storage. That is, if an instantiation of Ada.Task_Attributes
! --  is made within a procedure, what happens to the storage allocated for
! --  attributes, when the procedure call returns?  Apparently (RM 7.6.1 (4))
! --  any such objects must be finalized, since they will no longer be
! --  accessible, and in general one would expect that the storage they occupy
! --  would be recovered for later reuse. (If not, we would have a case of
! --  storage leakage.)  Assuming the storage is recovered and later reused,
! --  we have potentially dangerous dangling references. When the procedure
! --  containing the instantiation of Ada.Task_Attributes returns, there
! --  may still be unterminated tasks with associated attribute values for
! --  that instantiation. When such tasks eventually terminate, the RTS
! --  will attempt to call the Deallocate procedure on them. If the
! --  corresponding storage has already been deallocated, when the master
! --  of the access type was left, we have a potential disaster. This
! --  disaster is compounded since the pointer to Deallocate is probably
! --  through a "trampoline" which will also have been destroyed.
  
! --  For this reason, we arrange to remove all dangling references
! --  before leaving the scope of an instantiation. This is ugly, since
! --  it requires traversing the list of all tasks, but it is no more ugly
! --  than a similar traversal that we must do at the point of instantiation
! --  in order to initialize the attributes of all tasks. At least we only
! --  need to do these traversals if the type is controlled.
  
! --  We chose to defer allocation of storage for attributes until the
! --  Reference function is called or the attribute is first set to a value
! --  different from the default initial one. This allows a potential
! --  savings in allocation, for attributes that are not used by all tasks.
  
  --  For efficiency, we reserve space in the TCB for a fixed number of
! --  direct-access attributes. These are required to be of a size that
! --  fits in the space of an object of type System.Address. Because
! --  we must use unchecked bitwise copy operations on these values, they
! --  cannot be of a controlled type, but that is covered automatically
! --  since controlled objects are too large to fit in the spaces.
  
  --  We originally deferred the initialization of these direct-access
! --  attributes, just as we do for the indirect-access attributes, and
! --  used a per-task bit vector to keep track of which attributes were
! --  currently defined for that task. We found that the overhead of
! --  maintaining this bit-vector seriously slowed down access to the
! --  attributes, and made the fetch operation non-atomic, so that even
! --  to read an attribute value required locking the TCB. Therefore,
! --  we now initialize such attributes for all existing tasks at the time
! --  of the attribute instantiation, and initialize existing attributes
! --  for each new task at the time it is created.
  
  --  The latter initialization requires a list of all the instantiation
! --  descriptors. Updates to this list, as well as the bit-vector that
! --  is used to reserve slots for attributes in the TCB, require mutual
! --  exclusion. That is provided by the Lock/Unlock_RTS.
  
! --  One special problem that added complexity to the design is that
! --  the per-task list of indirect attributes contains objects of
! --  different types. We use unchecked pointer conversion to link
! --  these nodes together and access them, but the records may not have
! --  identical internal structure. Initially, we thought it would be
! --  enough to allocate all the common components of the records at the
! --  front of each record, so that their positions would correspond.
! --  Unfortunately, GNAT adds "dope" information at the front of a record,
! --  if the record contains any controlled-type components.
  --
! --  This means that the offset of the fields we use to link the nodes is
! --  at different positions on nodes of different types. To get around this,
! --  each attribute storage record consists of a core node and wrapper.
! --  The core nodes are all of the same type, and it is these that are
! --  linked together and generally "seen" by the RTS. Each core node
! --  contains a pointer to its own wrapper, which is a record that contains
! --  the core node along with an attribute value, approximately
! --  as follows:
  
  --    type Node;
  --    type Node_Access is access all Node;
--- 32,201 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The following notes are provided in case someone decides the implementation
! --  of this package is too complicated, or too slow. Please read this before
! --  making any "simplifications".
  
! --  Correct implementation of this package is more difficult than one might
! --  expect. After considering (and coding) several alternatives, we settled on
! --  the present compromise. Things we do not like about this implementation
! --  include:
  
! --  - It is vulnerable to bad Task_Id values, to the extent of possibly
! --     trashing memory and crashing the runtime system.
  
! --  - It requires dynamic storage allocation for each new attribute value,
! --     except for types that happen to be the same size as System.Address, or
! --     shorter.
  
  --  -  Instantiations at other than the library level rely on being able to
  --     do down-level calls to a procedure declared in the generic package body.
  --     This makes it potentially vulnerable to compiler changes.
  
! --  The main implementation issue here is that the connection from task to
! --  attribute is a potential source of dangling references.
  
  --  When a task goes away, we want to be able to recover all the storage
! --  associated with its attributes. The Ada mechanism for this is finalization,
! --  via controlled attribute types. For this reason, the ARM requires
! --  finalization of attribute values when the associated task terminates.
  
! --  This finalization must be triggered by the tasking runtime system, during
! --  termination of the task. Given the active set of instantiations of
! --  Ada.Task_Attributes is dynamic, the number and types of attributes
  --  belonging to a task will not be known until the task actually terminates.
  --  Some of these types may be controlled and some may not. The RTS must find
  --  some way to determine which of these attributes need finalization, and
  --  invoke the appropriate finalization on them.
  
! --  One way this might be done is to create a special finalization chain for
! --  each task, similar to the finalization chain that is used for controlled
! --  objects within the task. This would differ from the usual finalization
! --  chain in that it would not have a LIFO structure, since attributes may be
! --  added to a task at any time during its lifetime. This might be the right
! --  way to go for the longer term, but at present this approach is not open,
! --  since GNAT does not provide such special finalization support.
  
! --  Lacking special compiler support, the RTS is limited to the normal ways an
! --  application invokes finalization, i.e.
  
! --  a) Explicit call to the procedure Finalize, if we know the type has this
! --     operation defined on it. This is not sufficient, since we have no way
! --     of determining whether a given generic formal Attribute type is
! --     controlled, and no visibility of the associated Finalize procedure, in
! --     the generic body.
  
! --  b) Leaving the scope of a local object of a controlled type. This does not
! --     help, since the lifetime of an instantiation of Ada.Task_Attributes
! --     does not correspond to the lifetimes of the various tasks which may
! --     have that attribute.
  
! --  c) Assignment of another value to the object. This would not help, since
! --     we then have to finalize the new value of the object.
  
! --  d) Unchecked deallocation of an object of a controlled type. This seems to
! --     be the only mechanism available to the runtime system for finalization
! --     of task attributes.
  
! --  We considered two ways of using unchecked deallocation, both based on a
! --  linked list of that would hang from the task control block.
  
  --  In the first approach the objects on the attribute list are all derived
  --  from one controlled type, say T, and are linked using an access type to
! --  T'Class. The runtime system has an Unchecked_Deallocation for T'Class with
! --  access type T'Class, and uses this to deallocate and finalize all the
! --  items in the list. The limitation of this approach is that each
  --  instantiation of the package Ada.Task_Attributes derives a new record
! --  extension of T, and since T is controlled (RM 3.9.1 (3)), instantiation is
! --  only allowed at the library level.
  
! --  In the second approach the objects on the attribute list are of unrelated
! --  but structurally similar types. Unchecked conversion is used to circument
! --  Ada type checking. Each attribute-storage node contains not only the
! --  attribute value and a link for chaining, but also a pointer to descriptor
! --  for the corresponding instantiation of Task_Attributes. The instantiation
! --  descriptor contains pointer to a procedure that can do the correct
! --  deallocation and finalization for that type of attribute. On task
! --  termination, the runtime system uses the pointer to call the appropriate
! --  deallocator.
  
! --  While this gets around the limitation that instantations be at the library
! --  level, it relies on an implementation feature that may not always be safe,
! --  i.e. that it is safe to call the Deallocate procedure for an instantiation
! --  of Ada.Task_Attributes that no longer exists. In general, it seems this
! --  might result in dangling references.
  
! --  Another problem with instantiations deeper than the library level is that
! --  there is risk of storage leakage, or dangling references to reused
! --  storage. That is, if an instantiation of Ada.Task_Attributes is made
! --  within a procedure, what happens to the storage allocated for attributes,
! --  when the procedure call returns? Apparently (RM 7.6.1 (4)) any such
! --  objects must be finalized, since they will no longer be accessible, and in
! --  general one would expect that the storage they occupy would be recovered
! --  for later reuse. (If not, we would have a case of storage leakage.)
! --  Assuming the storage is recovered and later reused, we have potentially
! --  dangerous dangling references. When the procedure containing the
! --  instantiation of Ada.Task_Attributes returns, there may still be
! --  unterminated tasks with associated attribute values for that instantiation.
! --  When such tasks eventually terminate, the RTS will attempt to call the
! --  Deallocate procedure on them. If the corresponding storage has already
! --  been deallocated, when the master of the access type was left, we have a
! --  potential disaster. This disaster is compounded since the pointer to
! --  Deallocate is probably through a "trampoline" which will also have been
! --  destroyed.
  
! --  For this reason, we arrange to remove all dangling references before
! --  leaving the scope of an instantiation. This is ugly, since it requires
! --  traversing the list of all tasks, but it is no more ugly than a similar
! --  traversal that we must do at the point of instantiation in order to
! --  initialize the attributes of all tasks. At least we only need to do these
! --  traversals if the type is controlled.
  
! --  We chose to defer allocation of storage for attributes until the Reference
! --  function is called or the attribute is first set to a value different from
! --  the default initial one. This allows a potential savings in allocation,
! --  for attributes that are not used by all tasks.
  
  --  For efficiency, we reserve space in the TCB for a fixed number of
! --  direct-access attributes. These are required to be of a size that fits in
! --  the space of an object of type System.Address. Because we must use
! --  unchecked bitwise copy operations on these values, they cannot be of a
! --  controlled type, but that is covered automatically since controlled
! --  objects are too large to fit in the spaces.
  
  --  We originally deferred the initialization of these direct-access
! --  attributes, just as we do for the indirect-access attributes, and used a
! --  per-task bit vector to keep track of which attributes were currently
! --  defined for that task. We found that the overhead of maintaining this
! --  bit-vector seriously slowed down access to the attributes, and made the
! --  fetch operation non-atomic, so that even to read an attribute value
! --  required locking the TCB. Therefore, we now initialize such attributes for
! --  all existing tasks at the time of the attribute instantiation, and
! --  initialize existing attributes for each new task at the time it is
! --  created.
  
  --  The latter initialization requires a list of all the instantiation
! --  descriptors. Updates to this list, as well as the bit-vector that is used
! --  to reserve slots for attributes in the TCB, require mutual exclusion. That
! --  is provided by the Lock/Unlock_RTS.
  
! --  One special problem that added complexity to the design is that the
! --  per-task list of indirect attributes contains objects of different types.
! --  We use unchecked pointer conversion to link these nodes together and
! --  access them, but the records may not have identical internal structure.
! --  Initially, we thought it would be enough to allocate all the common
! --  components of the records at the front of each record, so that their
! --  positions would correspond. Unfortunately, GNAT adds "dope" information at
! --  the front of a record, if the record contains any controlled-type
! --  components.
  --
! --  This means that the offset of the fields we use to link the nodes is at
! --  different positions on nodes of different types. To get around this, each
! --  attribute storage record consists of a core node and wrapper. The core
! --  nodes are all of the same type, and it is these that are linked together
! --  and generally "seen" by the RTS. Each core node contains a pointer to its
! --  own wrapper, which is a record that contains the core node along with an
! --  attribute value, approximately as follows:
  
  --    type Node;
  --    type Node_Access is access all Node;
***************
*** 211,261 ****
  --       Wrapper : Access_Wrapper;
  --    end record;
  --    type Wrapper is record
! --       Noed    : aliased Node;
! --       Value   : aliased Attribute;  --  the generic formal type
  --    end record;
  
! --  Another interesting problem is with the initialization of
! --  the instantiation descriptors. Originally, we did this all via
! --  the Initialize procedure of the descriptor type and code in the
! --  package body. It turned out that the Initialize procedure needed
! --  quite a bit of information, including the size of the attribute
! --  type, the initial value of the attribute (if it fits in the TCB),
! --  and a pointer to the deallocator procedure. These needed to be
! --  "passed" in via access discriminants. GNAT was having trouble
! --  with access discriminants, so all this work was moved to the
! --  package body.
  
  with Ada.Task_Identification;
! --  used for Task_Id
  --           Null_Task_Id
  --           Current_Task
  
  with System.Error_Reporting;
! --  used for Shutdown;
  
  with System.Storage_Elements;
! --  used for Integer_Address
  
  with System.Task_Primitives.Operations;
! --  used for Write_Lock
  --           Unlock
  --           Lock/Unlock_RTS
  
  with System.Tasking;
! --  used for Access_Address
  --           Task_Id
  --           Direct_Index_Vector
  --           Direct_Index
  
  with System.Tasking.Initialization;
! --  used for Defer_Abortion
  --           Undefer_Abortion
  --           Initialize_Attributes_Link
  --           Finalize_Attributes_Link
  
  with System.Tasking.Task_Attributes;
! --  used for Access_Node
  --           Access_Dummy_Wrapper
  --           Deallocator
  --           Instance
--- 207,256 ----
  --       Wrapper : Access_Wrapper;
  --    end record;
  --    type Wrapper is record
! --       Dummy_Node : aliased Node;
! --       Value      : aliased Attribute;  --  the generic formal type
  --    end record;
  
! --  Another interesting problem is with the initialization of the
! --  instantiation descriptors. Originally, we did this all via the Initialize
! --  procedure of the descriptor type and code in the package body. It turned
! --  out that the Initialize procedure needed quite a bit of information,
! --  including the size of the attribute type, the initial value of the
! --  attribute (if it fits in the TCB), and a pointer to the deallocator
! --  procedure. These needed to be "passed" in via access discriminants. GNAT
! --  was having trouble with access discriminants, so all this work was moved
! --  to the package body.
  
  with Ada.Task_Identification;
! --  Used for Task_Id
  --           Null_Task_Id
  --           Current_Task
  
  with System.Error_Reporting;
! --  Used for Shutdown;
  
  with System.Storage_Elements;
! --  Used for Integer_Address
  
  with System.Task_Primitives.Operations;
! --  Used for Write_Lock
  --           Unlock
  --           Lock/Unlock_RTS
  
  with System.Tasking;
! --  Used for Access_Address
  --           Task_Id
  --           Direct_Index_Vector
  --           Direct_Index
  
  with System.Tasking.Initialization;
! --  Used for Defer_Abortion
  --           Undefer_Abortion
  --           Initialize_Attributes_Link
  --           Finalize_Attributes_Link
  
  with System.Tasking.Task_Attributes;
! --  Used for Access_Node
  --           Access_Dummy_Wrapper
  --           Deallocator
  --           Instance
*************** with System.Tasking.Task_Attributes;
*** 263,275 ****
  --           Access_Instance
  
  with Ada.Exceptions;
! --  used for Raise_Exception
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
  pragma Elaborate_All (System.Tasking.Task_Attributes);
! --  to ensure the initialization of object Local (below) will work
  
  package body Ada.Task_Attributes is
  
--- 258,270 ----
  --           Access_Instance
  
  with Ada.Exceptions;
! --  Used for Raise_Exception
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
  pragma Elaborate_All (System.Tasking.Task_Attributes);
! --  To ensure the initialization of object Local (below) will work
  
  package body Ada.Task_Attributes is
  
*************** package body Ada.Task_Attributes is
*** 295,305 ****
  
     pragma Warnings (Off);
     --  We turn warnings off for the following declarations of the
!    --  To_Attribute_Handle conversions, since these are used only
!    --  for small attributes where we know that there are no problems
!    --  with alignment, but the compiler will generate warnings for
!    --  the occurrences in the large attribute case, even though
!    --  they will not actually be used.
  
     function To_Attribute_Handle is new Unchecked_Conversion
       (System.Address, Attribute_Handle);
--- 290,299 ----
  
     pragma Warnings (Off);
     --  We turn warnings off for the following declarations of the
!    --  To_Attribute_Handle conversions, since these are used only for small
!    --  attributes where we know that there are no problems with alignment, but
!    --  the compiler will generate warnings for the occurrences in the large
!    --  attribute case, even though they will not actually be used.
  
     function To_Attribute_Handle is new Unchecked_Conversion
       (System.Address, Attribute_Handle);
*************** package body Ada.Task_Attributes is
*** 327,336 ****
       (Access_Dummy_Wrapper, Access_Wrapper);
     pragma Warnings (On);
     --  To fetch pointer to actual wrapper of attribute node. We turn off
!    --  warnings since this may generate an alignment warning. The warning
!    --  can be ignored since Dummy_Wrapper is only a non-generic standin
!    --  for the real wrapper type (we never actually allocate objects of
!    --  type Dummy_Wrapper).
  
     function To_Access_Dummy_Wrapper is new Unchecked_Conversion
       (Access_Wrapper, Access_Dummy_Wrapper);
--- 321,330 ----
       (Access_Dummy_Wrapper, Access_Wrapper);
     pragma Warnings (On);
     --  To fetch pointer to actual wrapper of attribute node. We turn off
!    --  warnings since this may generate an alignment warning. The warning can
!    --  be ignored since Dummy_Wrapper is only a non-generic standin for the
!    --  real wrapper type (we never actually allocate objects of type
!    --  Dummy_Wrapper).
  
     function To_Access_Dummy_Wrapper is new Unchecked_Conversion
       (Access_Wrapper, Access_Dummy_Wrapper);
*************** package body Ada.Task_Attributes is
*** 364,370 ****
     --  Initialized in package body
  
     type Wrapper is record
!       Noed : aliased Node;
  
        Value : aliased Attribute := Initial_Value;
        --  The generic formal type, may be controlled
--- 358,364 ----
     --  Initialized in package body
  
     type Wrapper is record
!       Dummy_Node : aliased Node;
  
        Value : aliased Attribute := Initial_Value;
        --  The generic formal type, may be controlled
*************** package body Ada.Task_Attributes is
*** 381,387 ****
  
     procedure Deallocate (P : in out Access_Node) is
        T : Access_Wrapper := To_Access_Wrapper (P.Wrapper);
- 
     begin
        Free (T);
     end Deallocate;
--- 375,380 ----
*************** package body Ada.Task_Attributes is
*** 424,440 ****
  
        else
           declare
!             P : Access_Node := To_Access_Node (TT.Indirect_Attributes);
!             W : Access_Wrapper;
  
           begin
!             Defer_Abortion;
              POP.Lock_RTS;
  
              while P /= null loop
                 if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                    POP.Unlock_RTS;
!                   Undefer_Abortion;
                    return To_Access_Wrapper (P.Wrapper).Value'Access;
                 end if;
  
--- 417,434 ----
  
        else
           declare
!             P       : Access_Node := To_Access_Node (TT.Indirect_Attributes);
!             W       : Access_Wrapper;
!             Self_Id : constant Task_Id := POP.Self;
  
           begin
!             Defer_Abort (Self_Id);
              POP.Lock_RTS;
  
              while P /= null loop
                 if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                    POP.Unlock_RTS;
!                   Undefer_Abort (Self_Id);
                    return To_Access_Wrapper (P.Wrapper).Value'Access;
                 end if;
  
*************** package body Ada.Task_Attributes is
*** 450,467 ****
                    ((null, Local'Unchecked_Access, null), Initial_Value);
              POP.Lock_RTS;
  
!             P := W.Noed'Unchecked_Access;
              P.Wrapper := To_Access_Dummy_Wrapper (W);
              P.Next := To_Access_Node (TT.Indirect_Attributes);
              TT.Indirect_Attributes := To_Access_Address (P);
              POP.Unlock_RTS;
!             Undefer_Abortion;
              return W.Value'Access;
  
           exception
              when others =>
                 POP.Unlock_RTS;
!                Undefer_Abortion;
                 raise;
           end;
        end if;
--- 444,461 ----
                    ((null, Local'Unchecked_Access, null), Initial_Value);
              POP.Lock_RTS;
  
!             P := W.Dummy_Node'Unchecked_Access;
              P.Wrapper := To_Access_Dummy_Wrapper (W);
              P.Next := To_Access_Node (TT.Indirect_Attributes);
              TT.Indirect_Attributes := To_Access_Address (P);
              POP.Unlock_RTS;
!             Undefer_Abort (Self_Id);
              return W.Value'Access;
  
           exception
              when others =>
                 POP.Unlock_RTS;
!                Undefer_Abort (Self_Id);
                 raise;
           end;
        end if;
*************** package body Ada.Task_Attributes is
*** 501,510 ****
           Set_Value (Initial_Value, T);
        else
           declare
!             P, Q : Access_Node;
!             W    : Access_Wrapper;
           begin
!             Defer_Abortion;
              POP.Lock_RTS;
              Q := To_Access_Node (TT.Indirect_Attributes);
  
--- 495,506 ----
           Set_Value (Initial_Value, T);
        else
           declare
!             P, Q    : Access_Node;
!             W       : Access_Wrapper;
!             Self_Id : constant Task_Id := POP.Self;
! 
           begin
!             Defer_Abort (Self_Id);
              POP.Lock_RTS;
              Q := To_Access_Node (TT.Indirect_Attributes);
  
*************** package body Ada.Task_Attributes is
*** 519,525 ****
                    W := To_Access_Wrapper (Q.Wrapper);
                    Free (W);
                    POP.Unlock_RTS;
!                   Undefer_Abortion;
                    return;
                 end if;
  
--- 515,521 ----
                    W := To_Access_Wrapper (Q.Wrapper);
                    Free (W);
                    POP.Unlock_RTS;
!                   Undefer_Abort (Self_Id);
                    return;
                 end if;
  
*************** package body Ada.Task_Attributes is
*** 528,539 ****
              end loop;
  
              POP.Unlock_RTS;
!             Undefer_Abortion;
  
           exception
              when others =>
                 POP.Unlock_RTS;
!                Undefer_Abortion;
                 raise;
           end;
        end if;
--- 524,535 ----
              end loop;
  
              POP.Unlock_RTS;
!             Undefer_Abort (Self_Id);
  
           exception
              when others =>
                 POP.Unlock_RTS;
!                Undefer_Abort (Self_Id);
                 raise;
           end;
        end if;
*************** package body Ada.Task_Attributes is
*** 586,596 ****
        --  Not directly addressed
  
        declare
!          P : Access_Node := To_Access_Node (TT.Indirect_Attributes);
!          W : Access_Wrapper;
  
        begin
!          Defer_Abortion;
           POP.Lock_RTS;
  
           while P /= null loop
--- 582,593 ----
        --  Not directly addressed
  
        declare
!          P       : Access_Node := To_Access_Node (TT.Indirect_Attributes);
!          W       : Access_Wrapper;
!          Self_Id : constant Task_Id := POP.Self;
  
        begin
!          Defer_Abort (Self_Id);
           POP.Lock_RTS;
  
           while P /= null loop
*************** package body Ada.Task_Attributes is
*** 598,629 ****
              if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                 To_Access_Wrapper (P.Wrapper).Value := Val;
                 POP.Unlock_RTS;
!                Undefer_Abortion;
                 return;
              end if;
  
              P := P.Next;
           end loop;
  
!          --  Unlock RTS here to follow the lock ordering rule that
!          --  prevent us from using new (i.e the Global_Lock) while
!          --  holding any other lock.
  
           POP.Unlock_RTS;
           W := new Wrapper'((null, Local'Unchecked_Access, null), Val);
           POP.Lock_RTS;
!          P := W.Noed'Unchecked_Access;
           P.Wrapper := To_Access_Dummy_Wrapper (W);
           P.Next := To_Access_Node (TT.Indirect_Attributes);
           TT.Indirect_Attributes := To_Access_Address (P);
  
           POP.Unlock_RTS;
!          Undefer_Abortion;
  
        exception
           when others =>
              POP.Unlock_RTS;
!             Undefer_Abortion;
              raise;
        end;
  
--- 595,626 ----
              if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                 To_Access_Wrapper (P.Wrapper).Value := Val;
                 POP.Unlock_RTS;
!                Undefer_Abort (Self_Id);
                 return;
              end if;
  
              P := P.Next;
           end loop;
  
!          --  Unlock RTS here to follow the lock ordering rule that prevent us
!          --  from using new (i.e the Global_Lock) while holding any other
!          --  lock.
  
           POP.Unlock_RTS;
           W := new Wrapper'((null, Local'Unchecked_Access, null), Val);
           POP.Lock_RTS;
!          P := W.Dummy_Node'Unchecked_Access;
           P.Wrapper := To_Access_Dummy_Wrapper (W);
           P.Next := To_Access_Node (TT.Indirect_Attributes);
           TT.Indirect_Attributes := To_Access_Address (P);
  
           POP.Unlock_RTS;
!          Undefer_Abort (Self_Id);
  
        exception
           when others =>
              POP.Unlock_RTS;
!             Undefer_Abort (Self_Id);
              raise;
        end;
  
*************** package body Ada.Task_Attributes is
*** 661,669 ****
        if Local.Index /= 0 then
  
           --  Get value of attribute. Warnings off, because for large
!          --  attributes, this code can generate alignment warnings.
!          --  But of course large attributes are never directly addressed
!          --  so in fact we will never execute the code in this case.
  
           pragma Warnings (Off);
           return To_Attribute_Handle
--- 658,666 ----
        if Local.Index /= 0 then
  
           --  Get value of attribute. Warnings off, because for large
!          --  attributes, this code can generate alignment warnings. But of
!          --  course large attributes are never directly addressed so in fact
!          --  we will never execute the code in this case.
  
           pragma Warnings (Off);
           return To_Attribute_Handle
*************** package body Ada.Task_Attributes is
*** 674,684 ****
        --  Not directly addressed
  
        declare
!          P      : Access_Node;
!          Result : Attribute;
  
        begin
!          Defer_Abortion;
           POP.Lock_RTS;
           P := To_Access_Node (TT.Indirect_Attributes);
  
--- 671,682 ----
        --  Not directly addressed
  
        declare
!          P       : Access_Node;
!          Result  : Attribute;
!          Self_Id : constant Task_Id := POP.Self;
  
        begin
!          Defer_Abort (Self_Id);
           POP.Lock_RTS;
           P := To_Access_Node (TT.Indirect_Attributes);
  
*************** package body Ada.Task_Attributes is
*** 686,692 ****
              if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                 Result := To_Access_Wrapper (P.Wrapper).Value;
                 POP.Unlock_RTS;
!                Undefer_Abortion;
                 return Result;
              end if;
  
--- 684,690 ----
              if P.Instance = Access_Instance'(Local'Unchecked_Access) then
                 Result := To_Access_Wrapper (P.Wrapper).Value;
                 POP.Unlock_RTS;
!                Undefer_Abort (Self_Id);
                 return Result;
              end if;
  
*************** package body Ada.Task_Attributes is
*** 694,706 ****
           end loop;
  
           POP.Unlock_RTS;
!          Undefer_Abortion;
           return Initial_Value;
  
        exception
           when others =>
              POP.Unlock_RTS;
!             Undefer_Abortion;
              raise;
        end;
  
--- 692,704 ----
           end loop;
  
           POP.Unlock_RTS;
!          Undefer_Abort (Self_Id);
           return Initial_Value;
  
        exception
           when others =>
              POP.Unlock_RTS;
!             Undefer_Abort (Self_Id);
              raise;
        end;
  
*************** begin
*** 725,732 ****
  
     declare
        Two_To_J : Direct_Index_Vector;
     begin
!       Defer_Abortion;
  
        --  Need protection for updating links to per-task initialization and
        --  finalization routines, in case some task is being created or
--- 723,731 ----
  
     declare
        Two_To_J : Direct_Index_Vector;
+       Self_Id  : constant Task_Id := POP.Self;
     begin
!       Defer_Abort (Self_Id);
  
        --  Need protection for updating links to per-task initialization and
        --  finalization routines, in case some task is being created or
*************** begin
*** 734,746 ****
  
        POP.Lock_RTS;
  
!       --  Add this instantiation to the list of all instantiations.
  
        Local.Next := System.Tasking.Task_Attributes.All_Attributes;
        System.Tasking.Task_Attributes.All_Attributes :=
          Local'Unchecked_Access;
  
!       --  Try to find space for the attribute in the TCB.
  
        Local.Index := 0;
        Two_To_J := 1;
--- 733,745 ----
  
        POP.Lock_RTS;
  
!       --  Add this instantiation to the list of all instantiations
  
        Local.Next := System.Tasking.Task_Attributes.All_Attributes;
        System.Tasking.Task_Attributes.All_Attributes :=
          Local'Unchecked_Access;
  
!       --  Try to find space for the attribute in the TCB
  
        Local.Index := 0;
        Two_To_J := 1;
*************** begin
*** 754,762 ****
                 In_Use := In_Use or Two_To_J;
                 Local.Index := J;
  
!                --  This unchecked conversions can give a warning when the
!                --  the alignment is incorrect, but it will not be used in
!                --  such a case anyway, so the warning can be safely ignored.
  
                 pragma Warnings (Off);
                 To_Attribute_Handle (Local.Initial_Value'Access).all :=
--- 753,761 ----
                 In_Use := In_Use or Two_To_J;
                 Local.Index := J;
  
!                --  This unchecked conversions can give a warning when the the
!                --  alignment is incorrect, but it will not be used in such a
!                --  case anyway, so the warning can be safely ignored.
  
                 pragma Warnings (Off);
                 To_Attribute_Handle (Local.Initial_Value'Access).all :=
*************** begin
*** 773,785 ****
        --  Attribute goes directly in the TCB
  
        if Local.Index /= 0 then
!          --  Replace stub for initialization routine
!          --  that is called at task creation.
  
           Initialization.Initialize_Attributes_Link :=
             System.Tasking.Task_Attributes.Initialize_Attributes'Access;
  
!          --  Initialize the attribute, for all tasks.
  
           declare
              C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
--- 772,784 ----
        --  Attribute goes directly in the TCB
  
        if Local.Index /= 0 then
!          --  Replace stub for initialization routine that is called at task
!          --  creation.
  
           Initialization.Initialize_Attributes_Link :=
             System.Tasking.Task_Attributes.Initialize_Attributes'Access;
  
!          --  Initialize the attribute, for all tasks
  
           declare
              C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
*************** begin
*** 795,808 ****
        --  Attribute goes into a node onto a linked list
  
        else
!          --  Replace stub for finalization routine
!          --  that is called at task termination.
  
           Initialization.Finalize_Attributes_Link :=
             System.Tasking.Task_Attributes.Finalize_Attributes'Access;
        end if;
  
        POP.Unlock_RTS;
!       Undefer_Abortion;
     end;
  end Ada.Task_Attributes;
--- 794,807 ----
        --  Attribute goes into a node onto a linked list
  
        else
!          --  Replace stub for finalization routine that is called at task
!          --  termination.
  
           Initialization.Finalize_Attributes_Link :=
             System.Tasking.Task_Attributes.Finalize_Attributes'Access;
        end if;
  
        POP.Unlock_RTS;
!       Undefer_Abort (Self_Id);
     end;
  end Ada.Task_Attributes;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tasatt.ads gcc-4.1.0/gcc/ada/a-tasatt.ads
*** gcc-4.0.2/gcc/ada/a-tasatt.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-tasatt.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-taside.adb gcc-4.1.0/gcc/ada/a-taside.adb
*** gcc-4.0.2/gcc/ada/a-taside.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/a-taside.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,56 ****
  ------------------------------------------------------------------------------
  
  with System.Address_Image;
! --  used for the function itself
! 
  with System.Tasking;
- --  used for Task_List
  
! with System.Tasking.Stages;
! --  used for Terminated
! --           Abort_Tasks
  
! with System.Tasking.Rendezvous;
! --  used for Callable
  
! with System.Task_Primitives.Operations;
! --  used for Self
  
! with Unchecked_Conversion;
  
  package body Ada.Task_Identification is
  
     -----------------------
     -- Local Subprograms --
     -----------------------
--- 32,59 ----
  ------------------------------------------------------------------------------
  
  with System.Address_Image;
! with System.Parameters;
! with System.Soft_Links;
! with System.Task_Primitives.Operations;
  with System.Tasking;
  
! with Unchecked_Conversion;
  
! pragma Warnings (Off);
! --  Allow withing of non-Preelaborated units in Ada 2005 mode where this
! --  package will be categorized as Preelaborate. See AI-362 for details.
! --  It is safe in the context of the run-time to violate the rules!
  
! with System.Tasking.Stages;
  
! pragma Warnings (On);
  
  package body Ada.Task_Identification is
  
+    use System.Parameters;
+ 
+    package STPO renames System.Task_Primitives.Operations;
+ 
     -----------------------
     -- Local Subprograms --
     -----------------------
*************** package body Ada.Task_Identification is
*** 64,70 ****
     -- "=" --
     ---------
  
!    function  "=" (Left, Right : Task_Id) return Boolean is
     begin
        return System.Tasking."=" (Convert_Ids (Left), Convert_Ids (Right));
     end "=";
--- 67,73 ----
     -- "=" --
     ---------
  
!    function "=" (Left, Right : Task_Id) return Boolean is
     begin
        return System.Tasking."=" (Convert_Ids (Left), Convert_Ids (Right));
     end "=";
*************** package body Ada.Task_Identification is
*** 132,142 ****
     -----------------
  
     function Is_Callable (T : Task_Id) return Boolean is
     begin
        if T = Null_Task_Id then
           raise Program_Error;
        else
!          return System.Tasking.Rendezvous.Callable (Convert_Ids (T));
        end if;
     end Is_Callable;
  
--- 135,162 ----
     -----------------
  
     function Is_Callable (T : Task_Id) return Boolean is
+       Result : Boolean;
+       Id     : constant System.Tasking.Task_Id := Convert_Ids (T);
     begin
        if T = Null_Task_Id then
           raise Program_Error;
        else
!          System.Soft_Links.Abort_Defer.all;
! 
!          if Single_Lock then
!             STPO.Lock_RTS;
!          end if;
! 
!          STPO.Write_Lock (Id);
!          Result := Id.Callable;
!          STPO.Unlock (Id);
! 
!          if Single_Lock then
!             STPO.Unlock_RTS;
!          end if;
! 
!          System.Soft_Links.Abort_Undefer.all;
!          return Result;
        end if;
     end Is_Callable;
  
*************** package body Ada.Task_Identification is
*** 145,155 ****
     -------------------
  
     function Is_Terminated (T : Task_Id) return Boolean is
     begin
        if T = Null_Task_Id then
           raise Program_Error;
        else
!          return System.Tasking.Stages.Terminated (Convert_Ids (T));
        end if;
     end Is_Terminated;
  
--- 165,195 ----
     -------------------
  
     function Is_Terminated (T : Task_Id) return Boolean is
+       Result : Boolean;
+       Id     : constant System.Tasking.Task_Id := Convert_Ids (T);
+ 
+       use System.Tasking;
+ 
     begin
        if T = Null_Task_Id then
           raise Program_Error;
        else
!          System.Soft_Links.Abort_Defer.all;
! 
!          if Single_Lock then
!             STPO.Lock_RTS;
!          end if;
! 
!          STPO.Write_Lock (Id);
!          Result := Id.Common.State = Terminated;
!          STPO.Unlock (Id);
! 
!          if Single_Lock then
!             STPO.Unlock_RTS;
!          end if;
! 
!          System.Soft_Links.Abort_Undefer.all;
!          return Result;
        end if;
     end Is_Terminated;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-taside.ads gcc-4.1.0/gcc/ada/a-taside.ads
*** gcc-4.0.2/gcc/ada/a-taside.ads	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/a-taside.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;
*** 39,50 ****
  with System.Tasking;
  
  package Ada.Task_Identification is
  
     type Task_Id is private;
  
     Null_Task_Id : constant Task_Id;
  
!    function  "=" (Left, Right : Task_Id) return Boolean;
     pragma Inline ("=");
  
     function Image (T : Task_Id) return String;
--- 39,52 ----
  with System.Tasking;
  
  package Ada.Task_Identification is
+    pragma Preelaborate_05;
+    --  In accordance with Ada 2005 AI-362
  
     type Task_Id is private;
  
     Null_Task_Id : constant Task_Id;
  
!    function "=" (Left, Right : Task_Id) return Boolean;
     pragma Inline ("=");
  
     function Image (T : Task_Id) return String;
*************** package Ada.Task_Identification is
*** 54,60 ****
  
     procedure Abort_Task (T : Task_Id);
     pragma Inline (Abort_Task);
!    --  Note: parameter is mode IN, not IN OUT, per AI-00101.
  
     function Is_Terminated (T : Task_Id) return Boolean;
     pragma Inline (Is_Terminated);
--- 56,62 ----
  
     procedure Abort_Task (T : Task_Id);
     pragma Inline (Abort_Task);
!    --  Note: parameter is mode IN, not IN OUT, per AI-00101
  
     function Is_Terminated (T : Task_Id) return Boolean;
     pragma Inline (Is_Terminated);
*************** private
*** 66,71 ****
  
     type Task_Id is new System.Tasking.Task_Id;
  
!    Null_Task_Id : constant Task_Id := Task_Id (System.Tasking.Null_Task);
  
  end Ada.Task_Identification;
--- 68,73 ----
  
     type Task_Id is new System.Tasking.Task_Id;
  
!    Null_Task_Id : constant Task_Id := null;
  
  end Ada.Task_Identification;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-teioed.adb gcc-4.1.0/gcc/ada/a-teioed.adb
*** gcc-4.0.2/gcc/ada/a-teioed.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-teioed.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  A D A . T E X T _ I O . E D I T I N G                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  A D A . T E X T _ I O . E D I T I N G                   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Text_IO.Editing is
*** 90,96 ****
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last + 1 was a ')' throw it away too.
  
                 Picture_Index := Last + 2;
  
--- 90,96 ----
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last + 1 was a ')' throw it away too
  
                 Picture_Index := Last + 2;
  
*************** package body Ada.Text_IO.Editing is
*** 139,148 ****
        In_Currency   : Boolean := False;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary.
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output.
  
     begin
  
--- 139,148 ----
        In_Currency   : Boolean := False;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output
  
     begin
  
*************** package body Ada.Text_IO.Editing is
*** 236,242 ****
        for J in reverse Last .. Answer'Last loop
           exit when J = Pic.Radix_Position;
  
!          --  Do this test First, Separator_Character can equal Pic.Floater.
  
           if Answer (J) = Pic.Floater then
              exit;
--- 236,242 ----
        for J in reverse Last .. Answer'Last loop
           exit when J = Pic.Radix_Position;
  
!          --  Do this test First, Separator_Character can equal Pic.Floater
  
           if Answer (J) = Pic.Floater then
              exit;
*************** package body Ada.Text_IO.Editing is
*** 692,702 ****
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill.
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it.
  
           Last := Answer'Last;
  
--- 692,702 ----
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it
  
           Last := Answer'Last;
  
*************** package body Ada.Text_IO.Editing is
*** 897,903 ****
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no.
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
--- 897,903 ----
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
*************** package body Ada.Text_IO.Editing is
*** 917,923 ****
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (intger) digits needs a null range.
  
        return Answer;
     end Parse_Number_String;
--- 917,923 ----
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (integer) digits needs a null range
  
        return Answer;
     end Parse_Number_String;
*************** package body Ada.Text_IO.Editing is
*** 953,959 ****
        type Legality is  (Okay, Reject);
  
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings.
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
--- 953,959 ----
        type Legality is  (Okay, Reject);
  
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
*************** package body Ada.Text_IO.Editing is
*** 1067,1073 ****
        begin
           Debug_Start ("Floating_Bracket");
  
!          --  Two different floats not allowed.
  
           if Pic.Floater /= '!' and then Pic.Floater /= '<' then
              raise Picture_Error;
--- 1067,1073 ----
        begin
           Debug_Start ("Floating_Bracket");
  
!          --  Two different floats not allowed
  
           if Pic.Floater /= '!' and then Pic.Floater /= '<' then
              raise Picture_Error;
*************** package body Ada.Text_IO.Editing is
*** 1393,1398 ****
--- 1393,1399 ----
                       raise Picture_Error;
                    else
                       --  Overwrite Floater and Start_Float
+ 
                       Pic.Floater := '*';
                       Pic.Start_Float := Index;
                       Star_Suppression;
*************** package body Ada.Text_IO.Editing is
*** 1411,1417 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make.
  
                    Number_Completion;
                    return;
--- 1412,1418 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make
  
                    Number_Completion;
                    return;
*************** package body Ada.Text_IO.Editing is
*** 1423,1430 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1424,1431 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Text_IO.Editing is
*** 1459,1465 ****
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert.
  
        begin
           Debug_Start ("Leading_Pound");
--- 1460,1466 ----
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert
  
        begin
           Debug_Start ("Leading_Pound");
*************** package body Ada.Text_IO.Editing is
*** 1548,1554 ****
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float.
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
--- 1549,1555 ----
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
*************** package body Ada.Text_IO.Editing is
*** 1565,1572 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1566,1573 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Text_IO.Editing is
*** 1631,1637 ****
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen.
  
           end loop;
        end Number;
--- 1632,1638 ----
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen
  
           end loop;
        end Number;
*************** package body Ada.Text_IO.Editing is
*** 2075,2081 ****
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State.
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
--- 2076,2082 ----
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
*************** package body Ada.Text_IO.Editing is
*** 2136,2142 ****
           Debug_Start ("Picture_Bracket");
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
--- 2137,2143 ----
           Debug_Start ("Picture_Bracket");
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
*************** package body Ada.Text_IO.Editing is
*** 2208,2214 ****
  
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
--- 2209,2215 ----
  
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
*************** package body Ada.Text_IO.Editing is
*** 2253,2259 ****
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign.
  
                    if State = Okay then
                       Set_State (Reject);
--- 2254,2260 ----
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign
  
                    if State = Okay then
                       Set_State (Reject);
*************** package body Ada.Text_IO.Editing is
*** 2272,2278 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2273,2279 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Text_IO.Editing is
*** 2293,2299 ****
           Debug_Start ("Picture_Plus");
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
--- 2294,2300 ----
           Debug_Start ("Picture_Plus");
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
*************** package body Ada.Text_IO.Editing is
*** 2320,2326 ****
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough.
                    Floating_Plus;
                    Trailing_Currency;
                    return;
--- 2321,2327 ----
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough
                    Floating_Plus;
                    Trailing_Currency;
                    return;
*************** package body Ada.Text_IO.Editing is
*** 2341,2347 ****
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign.
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
--- 2342,2348 ----
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
*************** package body Ada.Text_IO.Editing is
*** 2366,2372 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2367,2373 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Text_IO.Editing is
*** 2427,2438 ****
           end case;
  
           --  Blank when zero either if the PIC does not contain a '9' or if
!          --  requested by the user and no '*'
  
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'.
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
--- 2428,2439 ----
           end case;
  
           --  Blank when zero either if the PIC does not contain a '9' or if
!          --  requested by the user and no '*'.
  
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
*************** package body Ada.Text_IO.Editing is
*** 2706,2712 ****
  
        when Constraint_Error =>
  
!          --  To deal with special cases like null strings.
  
        raise Picture_Error;
     end Precalculate;
--- 2707,2713 ----
  
        when Constraint_Error =>
  
!       --  To deal with special cases like null strings
  
        raise Picture_Error;
     end Precalculate;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-teioed.ads gcc-4.1.0/gcc/ada/a-teioed.ads
*** gcc-4.0.2/gcc/ada/a-teioed.ads	Thu Apr 24 17:53:54 2003
--- gcc-4.1.0/gcc/ada/a-teioed.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-textio.adb gcc-4.1.0/gcc/ada/a-textio.adb
*** gcc-4.0.2/gcc/ada/a-textio.adb	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-textio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          A D A . T E X T _ I O                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          A D A . T E X T _ I O                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Text_IO is
*** 896,902 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 896,902 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Text_IO is
*** 1334,1382 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
        FIO.Check_File_Open (AP (File));
  
!       if To = File.Col then
!          return;
!       end if;
  
        if Mode (File) >= Out_File then
           if File.Line_Length /= 0 and then To > File.Line_Length then
              raise Layout_Error;
           end if;
  
           if To < File.Col then
              New_Line (File);
           end if;
  
           while File.Col < To loop
              Put (File, ' ');
           end loop;
  
        else
           loop
              ch := Getc (File);
  
              if ch = EOF then
                 raise End_Error;
  
              elsif ch = LM then
                 File.Line := File.Line + 1;
                 File.Col := 1;
  
              elsif ch = PM and then File.Is_Regular_File then
                 File.Page := File.Page + 1;
                 File.Line := 1;
                 File.Col := 1;
  
              elsif To = File.Col then
                 Ungetc (ch, File);
                 return;
  
              else
                 File.Col := File.Col + 1;
              end if;
--- 1334,1421 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
        FIO.Check_File_Open (AP (File));
  
!       --  Output case
  
        if Mode (File) >= Out_File then
+ 
+          --  Error if we attempt to set Col to a value greater than the
+          --  maximum permissible line length.
+ 
           if File.Line_Length /= 0 and then To > File.Line_Length then
              raise Layout_Error;
           end if;
  
+          --  If we are behind current position, then go to start of new line
+ 
           if To < File.Col then
              New_Line (File);
           end if;
  
+          --  Loop to output blanks till we are at the required column
+ 
           while File.Col < To loop
              Put (File, ' ');
           end loop;
  
+       --  Input case
+ 
        else
+          --  If we are logically before a LM, but physically after it, the
+          --  file position still reflects the position before the LM, so eat
+          --  it now and adjust the file position appropriately.
+ 
+          if File.Before_LM then
+             File.Before_LM := False;
+             File.Before_LM_PM := False;
+             File.Line := File.Line + 1;
+             File.Col := 1;
+          end if;
+ 
+          --  Loop reading characters till we get one at the required Col value
+ 
           loop
+             --  Read next character. The reason we have to read ahead is to
+             --  skip formatting characters, the effect of Set_Col is to set
+             --  us to a real character with the right Col value, and format
+             --  characters don't count.
+ 
              ch := Getc (File);
  
+             --  Error if we hit an end of file
+ 
              if ch = EOF then
                 raise End_Error;
  
+             --  If line mark, eat it and adjust file position
+ 
              elsif ch = LM then
                 File.Line := File.Line + 1;
                 File.Col := 1;
  
+             --  If recognized page mark, eat it, and adjust file position
+ 
              elsif ch = PM and then File.Is_Regular_File then
                 File.Page := File.Page + 1;
                 File.Line := 1;
                 File.Col := 1;
  
+             --  Otherwise this is the character we are looking for, so put it
+             --  back in the input stream (we have not adjusted the file
+             --  position yet, so everything is set right after this ungetc).
+ 
              elsif To = File.Col then
                 Ungetc (ch, File);
                 return;
  
+             --  Keep skipping characters if we are not there yet, updating the
+             --  file position past the skipped character.
+ 
              else
                 File.Col := File.Col + 1;
              end if;
*************** package body Ada.Text_IO is
*** 1422,1428 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1461,1467 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Text_IO is
*** 1467,1473 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1506,1512 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Text_IO is
*** 1500,1506 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1539,1545 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Text_IO is
*** 1528,1534 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1567,1573 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-textio.ads gcc-4.1.0/gcc/ada/a-textio.ads
*** gcc-4.0.2/gcc/ada/a-textio.ads	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-textio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;
*** 47,53 ****
  with System.File_Control_Block;
  
  package Ada.Text_IO is
! pragma Elaborate_Body (Text_IO);
  
     type File_Type is limited private;
     type File_Mode is (In_File, Out_File, Append_File);
--- 47,53 ----
  with System.File_Control_Block;
  
  package Ada.Text_IO is
!    pragma Elaborate_Body;
  
     type File_Type is limited private;
     type File_Mode is (In_File, Out_File, Append_File);
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tgdico.ads gcc-4.1.0/gcc/ada/a-tgdico.ads
*** gcc-4.0.2/gcc/ada/a-tgdico.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-tgdico.ads	Thu Jun 16 08:28:59 2005
***************
*** 0 ****
--- 1,31 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                 ADA.TAGS.GENERIC_DISPATCHING_CONSTRUCTOR                 --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ -- This specification is adapted from the Ada Reference Manual for use with --
+ -- GNAT.  In accordance with the copyright of that document, you can freely --
+ -- copy and modify this specification,  provided that if you redistribute a --
+ -- modified version,  any changes that you have made are clearly indicated. --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ pragma Warnings (Off);
+ --  Turn of categorization warnings
+ 
+ generic
+    type T (<>) is abstract tagged limited private;
+    type Parameters (<>) is limited private;
+    with function Constructor (Params : access Parameters) return T is abstract;
+ 
+ function Ada.Tags.Generic_Dispatching_Constructor
+   (The_Tag : Tag; Params : access Parameters) return T'Class;
+ pragma Preelaborate_05 (Generic_Dispatching_Constructor);
+ pragma Import (Intrinsic, Generic_Dispatching_Constructor);
+ --  Note: the reason that we use Preelaborate_05 here is so that this will
+ --  compile fine during the normal build procedures. In Ada 2005 mode (which
+ --  is required for this package anyway), this will be treated as Preelaborate
+ --  so everything will be fine.
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ticoau.adb gcc-4.1.0/gcc/ada/a-ticoau.adb
*** gcc-4.0.2/gcc/ada/a-ticoau.adb	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-ticoau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . C O M P L E X _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . C O M P L E X _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ticoau.ads gcc-4.1.0/gcc/ada/a-ticoau.ads
*** gcc-4.0.2/gcc/ada/a-ticoau.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-ticoau.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . C O M P L E X _ A U X               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . C O M P L E X _ A U X               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ticoio.adb gcc-4.1.0/gcc/ada/a-ticoio.adb
*** gcc-4.0.2/gcc/ada/a-ticoio.adb	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-ticoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . T E X T _ I O . C O M P L E X _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . T E X T _ I O . C O M P L E X _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ticoio.ads gcc-4.1.0/gcc/ada/a-ticoio.ads
*** gcc-4.0.2/gcc/ada/a-ticoio.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-ticoio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tideau.adb gcc-4.1.0/gcc/ada/a-tideau.adb
*** gcc-4.0.2/gcc/ada/a-tideau.adb	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tideau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . D E C I M A L _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . D E C I M A L _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tideau.ads gcc-4.1.0/gcc/ada/a-tideau.ads
*** gcc-4.0.2/gcc/ada/a-tideau.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tideau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tideio.adb gcc-4.1.0/gcc/ada/a-tideio.adb
*** gcc-4.0.2/gcc/ada/a-tideio.adb	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tideio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . T E X T _ I O . D E C I M A L _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . T E X T _ I O . D E C I M A L _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tideio.ads gcc-4.1.0/gcc/ada/a-tideio.ads
*** gcc-4.0.2/gcc/ada/a-tideio.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tideio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tienau.adb gcc-4.1.0/gcc/ada/a-tienau.adb
*** gcc-4.0.2/gcc/ada/a-tienau.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tienau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --          A D A . T E X T _ I O . E N U M E R A T I O N _ A U X           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --          A D A . T E X T _ I O . E N U M E R A T I O N _ A U X           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tienau.ads gcc-4.1.0/gcc/ada/a-tienau.ads
*** gcc-4.0.2/gcc/ada/a-tienau.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tienau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tienio.adb gcc-4.1.0/gcc/ada/a-tienio.adb
*** gcc-4.0.2/gcc/ada/a-tienio.adb	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tienio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . T E X T _ I O . E N U M E R A T I O N _ I O            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . T E X T _ I O . E N U M E R A T I O N _ I O            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tienio.ads gcc-4.1.0/gcc/ada/a-tienio.ads
*** gcc-4.0.2/gcc/ada/a-tienio.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tienio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tifiio.adb gcc-4.1.0/gcc/ada/a-tifiio.adb
*** gcc-4.0.2/gcc/ada/a-tifiio.adb	Mon Mar 15 14:50:55 2004
--- gcc-4.1.0/gcc/ada/a-tifiio.adb	Fri Feb 17 11:21:20 2006
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 A D A . T E X T _ I O . F I X E D _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 A D A . T E X T _ I O . F I X E D _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2006, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Text_IO.Fixed_IO is
*** 183,189 ****
  
     --    Fore + Aft + Exp + Extra_Layout_Space
  
!    --  is always long enough for formatting any fixed point number.
  
     --  Implementation of Put routines
  
--- 183,189 ----
  
     --    Fore + Aft + Exp + Extra_Layout_Space
  
!    --  is always long enough for formatting any fixed point number
  
     --  Implementation of Put routines
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 247,253 ****
     --  least 20 in order to print T'First, which is at most -2.0**63.
     --  This means D < 0, so use
  
!    --    (1)   Y = -S and Z = -10**(-D).
  
     --  If 1.0 / S is an integer greater than one, use
  
--- 247,253 ----
     --  least 20 in order to print T'First, which is at most -2.0**63.
     --  This means D < 0, so use
  
!    --    (1)   Y = -S and Z = -10**(-D)
  
     --  If 1.0 / S is an integer greater than one, use
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 314,322 ****
     ---------
  
     procedure Get
!      (File  : in File_Type;
        Item  : out Num;
!       Width : in Field := 0)
     is
        pragma Unsuppress (Range_Check);
  
--- 314,322 ----
     ---------
  
     procedure Get
!      (File  : File_Type;
        Item  : out Num;
!       Width : Field := 0)
     is
        pragma Unsuppress (Range_Check);
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 329,335 ****
  
     procedure Get
       (Item  : out Num;
!       Width : in Field := 0)
     is
        pragma Unsuppress (Range_Check);
  
--- 329,335 ----
  
     procedure Get
       (Item  : out Num;
!       Width : Field := 0)
     is
        pragma Unsuppress (Range_Check);
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 341,347 ****
     end Get;
  
     procedure Get
!      (From : in String;
        Item : out Num;
        Last : out Positive)
     is
--- 341,347 ----
     end Get;
  
     procedure Get
!      (From : String;
        Item : out Num;
        Last : out Positive)
     is
*************** package body Ada.Text_IO.Fixed_IO is
*** 359,369 ****
     ---------
  
     procedure Put
!      (File : in File_Type;
!       Item : in Num;
!       Fore : in Field := Default_Fore;
!       Aft  : in Field := Default_Aft;
!       Exp  : in Field := Default_Exp)
     is
        S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
        Last : Natural;
--- 359,369 ----
     ---------
  
     procedure Put
!      (File : File_Type;
!       Item : Num;
!       Fore : Field := Default_Fore;
!       Aft  : Field := Default_Aft;
!       Exp  : Field := Default_Exp)
     is
        S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
        Last : Natural;
*************** package body Ada.Text_IO.Fixed_IO is
*** 373,382 ****
     end Put;
  
     procedure Put
!      (Item : in Num;
!       Fore : in Field := Default_Fore;
!       Aft  : in Field := Default_Aft;
!       Exp  : in Field := Default_Exp)
     is
        S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
        Last : Natural;
--- 373,382 ----
     end Put;
  
     procedure Put
!      (Item : Num;
!       Fore : Field := Default_Fore;
!       Aft  : Field := Default_Aft;
!       Exp  : Field := Default_Exp)
     is
        S    : String (1 .. Fore + Aft + Exp + Extra_Layout_Space);
        Last : Natural;
*************** package body Ada.Text_IO.Fixed_IO is
*** 387,395 ****
  
     procedure Put
       (To   : out String;
!       Item : in Num;
!       Aft  : in Field := Default_Aft;
!       Exp  : in Field := Default_Exp)
     is
        Fore : constant Integer := To'Length
                                  - 1                      -- Decimal point
--- 387,395 ----
  
     procedure Put
       (To   : out String;
!       Item : Num;
!       Aft  : Field := Default_Aft;
!       Exp  : Field := Default_Exp)
     is
        Fore : constant Integer := To'Length
                                  - 1                      -- Decimal point
*************** package body Ada.Text_IO.Fixed_IO is
*** 399,405 ****
        Last : Natural;
  
     begin
!       if Fore not in Field'Range then
           raise Layout_Error;
        end if;
  
--- 399,405 ----
        Last : Natural;
  
     begin
!       if Fore < 1 or else Fore > Field'Last then
           raise Layout_Error;
        end if;
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 419,428 ****
        Exp  : Field)
     is
        subtype Digit is Int64 range 0 .. 9;
!       X     : constant Int64   := Int64'Integer_Value (Item);
!       A     : constant Field   := Field'Max (Aft, 1);
!       Neg   : constant Boolean := (Item < 0.0);
!       Pos   : Integer;  -- Next digit X has value X * 10.0**Pos;
  
        Y, Z : Int64;
        E : constant Integer := Boolean'Pos (not Exact)
--- 419,429 ----
        Exp  : Field)
     is
        subtype Digit is Int64 range 0 .. 9;
! 
!       X   : constant Int64   := Int64'Integer_Value (Item);
!       A   : constant Field   := Field'Max (Aft, 1);
!       Neg : constant Boolean := (Item < 0.0);
!       Pos : Integer;  -- Next digit X has value X * 10.0**Pos;
  
        Y, Z : Int64;
        E : constant Integer := Boolean'Pos (not Exact)
*************** package body Ada.Text_IO.Fixed_IO is
*** 438,444 ****
  
        procedure Put_Digit (X : Digit);
        --  Add digit X to the output string (going from left to right),
!       --  updating Last and Pos, and inserting the sign, leading zeroes
        --  or a decimal point when necessary. After outputting the first
        --  digit, Pos must not be changed outside Put_Digit anymore
  
--- 439,445 ----
  
        procedure Put_Digit (X : Digit);
        --  Add digit X to the output string (going from left to right),
!       --  updating Last and Pos, and inserting the sign, leading zeros
        --  or a decimal point when necessary. After outputting the first
        --  digit, Pos must not be changed outside Put_Digit anymore
  
*************** package body Ada.Text_IO.Fixed_IO is
*** 470,480 ****
  
        procedure Put_Digit (X : Digit) is
           Digs : constant array (Digit) of Character := "0123456789";
        begin
!          if Last = 0 then
              if X /= 0 or Pos <= 0 then
                 --  Before outputting first digit, include leading space,
!                --  posible minus sign and, if the first digit is fractional,
                 --  decimal seperator and leading zeros.
  
                 --  The Fore part has Pos + 1 + Boolean'Pos (Neg) characters,
--- 471,482 ----
  
        procedure Put_Digit (X : Digit) is
           Digs : constant array (Digit) of Character := "0123456789";
+ 
        begin
!          if Last = To'First - 1 then
              if X /= 0 or Pos <= 0 then
                 --  Before outputting first digit, include leading space,
!                --  possible minus sign and, if the first digit is fractional,
                 --  decimal seperator and leading zeros.
  
                 --  The Fore part has Pos + 1 + Boolean'Pos (Neg) characters,
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tifiio.ads gcc-4.1.0/gcc/ada/a-tifiio.ads
*** gcc-4.0.2/gcc/ada/a-tifiio.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tifiio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiflau.adb gcc-4.1.0/gcc/ada/a-tiflau.adb
*** gcc-4.0.2/gcc/ada/a-tiflau.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tiflau.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiflau.ads gcc-4.1.0/gcc/ada/a-tiflau.ads
*** gcc-4.0.2/gcc/ada/a-tiflau.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tiflau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiflio.adb gcc-4.1.0/gcc/ada/a-tiflio.adb
*** gcc-4.0.2/gcc/ada/a-tiflio.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tiflio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 A D A . T E X T _ I O . F L O A T _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 A D A . T E X T _ I O . F L O A T _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiflio.ads gcc-4.1.0/gcc/ada/a-tiflio.ads
*** gcc-4.0.2/gcc/ada/a-tiflio.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tiflio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tigeau.adb gcc-4.1.0/gcc/ada/a-tigeau.adb
*** gcc-4.0.2/gcc/ada/a-tigeau.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tigeau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . G E N E R I C _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . G E N E R I C _ A U X               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tigeau.ads gcc-4.1.0/gcc/ada/a-tigeau.ads
*** gcc-4.0.2/gcc/ada/a-tigeau.ads	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tigeau.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . G E N E R I C _ A U X               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . G E N E R I C _ A U X               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiinau.adb gcc-4.1.0/gcc/ada/a-tiinau.adb
*** gcc-4.0.2/gcc/ada/a-tiinau.adb	Thu Dec 11 16:21:39 2003
--- gcc-4.1.0/gcc/ada/a-tiinau.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Text_IO.Integer_Aux is
*** 52,58 ****
       (File : in File_Type;
        Buf  : out String;
        Ptr  : in out Natural);
!    --  This is an auxiliary routine that is used to load an possibly signed
     --  integer literal value from the input file into Buf, starting at Ptr + 1.
     --  On return, Ptr is set to the last character stored.
  
--- 52,58 ----
       (File : in File_Type;
        Buf  : out String;
        Ptr  : in out Natural);
!    --  This is an auxiliary routine that is used to load a possibly signed
     --  integer literal value from the input file into Buf, starting at Ptr + 1.
     --  On return, Ptr is set to the last character stored.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiinau.ads gcc-4.1.0/gcc/ada/a-tiinau.ads
*** gcc-4.0.2/gcc/ada/a-tiinau.ads	Thu Apr 24 17:53:55 2003
--- gcc-4.1.0/gcc/ada/a-tiinau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiinio.adb gcc-4.1.0/gcc/ada/a-tiinio.adb
*** gcc-4.0.2/gcc/ada/a-tiinio.adb	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-tiinio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . T E X T _ I O . I N T E G E R _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . T E X T _ I O . I N T E G E R _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiinio.ads gcc-4.1.0/gcc/ada/a-tiinio.ads
*** gcc-4.0.2/gcc/ada/a-tiinio.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-tiinio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-timoau.adb gcc-4.1.0/gcc/ada/a-timoau.adb
*** gcc-4.0.2/gcc/ada/a-timoau.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-timoau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . M O D U L A R  _ A U X              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . M O D U L A R  _ A U X              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-timoau.ads gcc-4.1.0/gcc/ada/a-timoau.ads
*** gcc-4.0.2/gcc/ada/a-timoau.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-timoau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-timoio.adb gcc-4.1.0/gcc/ada/a-timoio.adb
*** gcc-4.0.2/gcc/ada/a-timoio.adb	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-timoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . T E X T _ I O . M O D U L A R _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . T E X T _ I O . M O D U L A R _ I O                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-timoio.ads gcc-4.1.0/gcc/ada/a-timoio.ads
*** gcc-4.0.2/gcc/ada/a-timoio.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-timoio.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               A D A . T E X T _ I O . M O D U L A R _ I O                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               A D A . T E X T _ I O . M O D U L A R _ I O                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiocst.adb gcc-4.1.0/gcc/ada/a-tiocst.adb
*** gcc-4.0.2/gcc/ada/a-tiocst.adb	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tiocst.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiocst.ads gcc-4.1.0/gcc/ada/a-tiocst.ads
*** gcc-4.0.2/gcc/ada/a-tiocst.ads	Tue Oct 21 13:41:54 2003
--- gcc-4.1.0/gcc/ada/a-tiocst.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                A D A . T E X T _ I O . C _ S T R E A M S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                A D A . T E X T _ I O . C _ S T R E A M S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-titest.adb gcc-4.1.0/gcc/ada/a-titest.adb
*** gcc-4.0.2/gcc/ada/a-titest.adb	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-titest.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . T E X T _ I O . T E X T _ S T R E A M S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . T E X T _ I O . T E X T _ S T R E A M S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-titest.ads gcc-4.1.0/gcc/ada/a-titest.ads
*** gcc-4.0.2/gcc/ada/a-titest.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-titest.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . T E X T _ I O . T E X T _ S T R E A M S              --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . T E X T _ I O . T E X T _ S T R E A M S              --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-tiunio.ads gcc-4.1.0/gcc/ada/a-tiunio.ads
*** gcc-4.0.2/gcc/ada/a-tiunio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-tiunio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --              A D A . T E X T _ I O . U N B O U N D E D _ I O             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --              A D A . T E X T _ I O . U N B O U N D E D _ I O             --
  --                                                                          --
***************
*** 19,25 ****
  --  implementation anyway, since we need access to the internal representation
  --  of Ada.Strings.Unbounded.Unbounded_String.
  
- 
  with Ada.Strings.Unbounded;
  with Ada.Strings.Unbounded.Text_IO;
  
--- 19,24 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wichun.adb gcc-4.1.0/gcc/ada/a-wichun.adb
*** gcc-4.0.2/gcc/ada/a-wichun.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-wichun.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,167 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --         A D A . W I D E _ C H A R A C T E R T S . U N I C O D E          --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package body Ada.Wide_Characters.Unicode is
+ 
+    package G renames GNAT.UTF_32;
+ 
+    ------------------
+    -- Get_Category --
+    ------------------
+ 
+    function Get_Category (U : Wide_Character) return Category is
+    begin
+       return Category (G.Get_Category (Wide_Character'Pos (U)));
+    end Get_Category;
+ 
+    --------------
+    -- Is_Digit --
+    --------------
+ 
+    function Is_Digit (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Digit (Wide_Character'Pos (U));
+    end Is_Digit;
+ 
+    function Is_Digit (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Digit (G.Category (C));
+    end Is_Digit;
+ 
+    ---------------
+    -- Is_Letter --
+    ---------------
+ 
+    function Is_Letter (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Letter (Wide_Character'Pos (U));
+    end Is_Letter;
+ 
+    function Is_Letter (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Letter (G.Category (C));
+    end Is_Letter;
+ 
+    ------------------------
+    -- Is_Line_Terminator --
+    ------------------------
+ 
+    function Is_Line_Terminator (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Line_Terminator (Wide_Character'Pos (U));
+    end Is_Line_Terminator;
+ 
+    -------------
+    -- Is_Mark --
+    -------------
+ 
+    function Is_Mark (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Mark (Wide_Character'Pos (U));
+    end Is_Mark;
+ 
+    function Is_Mark (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Mark (G.Category (C));
+    end Is_Mark;
+ 
+    --------------------
+    -- Is_Non_Graphic --
+    --------------------
+ 
+    function Is_Non_Graphic (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Non_Graphic (Wide_Character'Pos (U));
+    end Is_Non_Graphic;
+ 
+    function Is_Non_Graphic (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Non_Graphic (G.Category (C));
+    end Is_Non_Graphic;
+ 
+    --------------
+    -- Is_Other --
+    --------------
+ 
+    function Is_Other (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Other (Wide_Character'Pos (U));
+    end Is_Other;
+ 
+    function Is_Other (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Other (G.Category (C));
+    end Is_Other;
+ 
+    --------------------
+    -- Is_Punctuation --
+    --------------------
+ 
+    function Is_Punctuation (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Punctuation (Wide_Character'Pos (U));
+    end Is_Punctuation;
+ 
+    function Is_Punctuation (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Punctuation (G.Category (C));
+    end Is_Punctuation;
+ 
+    --------------
+    -- Is_Space --
+    --------------
+ 
+    function Is_Space (U : Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Space (Wide_Character'Pos (U));
+    end Is_Space;
+ 
+    function Is_Space (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Space (G.Category (C));
+    end Is_Space;
+ 
+    -------------------
+    -- To_Upper_Case --
+    -------------------
+ 
+    function To_Upper_Case
+      (U : Wide_Character) return Wide_Character
+    is
+    begin
+       return
+         Wide_Character'Val
+           (G.UTF_32_To_Upper_Case (Wide_Character'Pos (U)));
+    end To_Upper_Case;
+ 
+ end Ada.Wide_Characters.Unicode;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wichun.ads gcc-4.1.0/gcc/ada/a-wichun.ads
*** gcc-4.0.2/gcc/ada/a-wichun.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-wichun.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,190 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --          A D A . W I D E _ C H A R A C T E R S . U N I C O D E           --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  Unicode categorization routines for Wide_Character. Note that this
+ --  package is strictly speaking Ada 2005 (since it is a child of an
+ --  Ada 2005 unit), but we make it available in Ada 95 mode, since it
+ --  only deals with wide characters.
+ 
+ with GNAT.UTF_32;
+ 
+ package Ada.Wide_Characters.Unicode is
+ 
+    --  The following type defines the categories from the unicode definitions.
+    --  The one addition we make is Fe, which represents the characters FFFE
+    --  and FFFF in any of the planes.
+ 
+    type Category is new GNAT.UTF_32.Category;
+    --  Cc   Other, Control
+    --  Cf   Other, Format
+    --  Cn   Other, Not Assigned
+    --  Co   Other, Private Use
+    --  Cs   Other, Surrogate
+    --  Ll   Letter, Lowercase
+    --  Lm   Letter, Modifier
+    --  Lo   Letter, Other
+    --  Lt   Letter, Titlecase
+    --  Lu   Letter, Uppercase
+    --  Mc   Mark, Spacing Combining
+    --  Me   Mark, Enclosing
+    --  Mn   Mark, Nonspacing
+    --  Nd   Number, Decimal Digit
+    --  Nl   Number, Letter
+    --  No   Number, Other
+    --  Pc   Punctuation, Connector
+    --  Pd   Punctuation, Dash
+    --  Pe   Punctuation, Close
+    --  Pf   Punctuation, Final quote
+    --  Pi   Punctuation, Initial quote
+    --  Po   Punctuation, Other
+    --  Ps   Punctuation, Open
+    --  Sc   Symbol, Currency
+    --  Sk   Symbol, Modifier
+    --  Sm   Symbol, Math
+    --  So   Symbol, Other
+    --  Zl   Separator, Line
+    --  Zp   Separator, Paragraph
+    --  Zs   Separator, Space
+    --  Fe   relative position FFFE/FFFF in plane
+ 
+    function Get_Category (U : Wide_Character) return Category;
+    pragma Inline (Get_Category);
+    --  Given a Wide_Character, returns corresponding Category, or Cn if the
+    --  code does not have an assigned unicode category.
+ 
+    --  The following functions perform category tests corresponding to lexical
+    --  classes defined in the Ada standard. There are two interfaces for each
+    --  function. The second takes a Category (e.g. returned by Get_Category).
+    --  The first takes a Wide_Character. The form taking the Wide_Character is
+    --  typically more efficient than calling Get_Category, but if several
+    --  different tests are to be performed on the same code, it is more
+    --  efficient to use Get_Category to get the category, then test the
+    --  resulting category.
+ 
+    function Is_Letter (U : Wide_Character) return Boolean;
+    function Is_Letter (C : Category)       return Boolean;
+    pragma Inline (Is_Letter);
+    --  Returns true iff U is a letter that can be used to start an identifier,
+    --  or if C is one of the corresponding categories, which are the following:
+    --    Letter, Uppercase (Lu)
+    --    Letter, Lowercase (Ll)
+    --    Letter, Titlecase (Lt)
+    --    Letter, Modifier  (Lm)
+    --    Letter, Other     (Lo)
+    --    Number, Letter    (Nl)
+ 
+    function Is_Digit (U : Wide_Character) return Boolean;
+    function Is_Digit (C : Category)       return Boolean;
+    pragma Inline (Is_Digit);
+    --  Returns true iff U is a digit that can be used to extend an identifer,
+    --  or if C is one of the corresponding categories, which are the following:
+    --    Number, Decimal_Digit (Nd)
+ 
+    function Is_Line_Terminator (U : Wide_Character) return Boolean;
+    pragma Inline (Is_Line_Terminator);
+    --  Returns true iff U is an allowed line terminator for source programs,
+    --  if U is in the category Zp (Separator, Paragaph), or Zs (Separator,
+    --  Line), or if U is a conventional line terminator (CR, LF, VT, FF).
+    --  There is no category version for this function, since the set of
+    --  characters does not correspond to a set of Unicode categories.
+ 
+    function Is_Mark (U : Wide_Character) return Boolean;
+    function Is_Mark (C : Category)       return Boolean;
+    pragma Inline (Is_Mark);
+    --  Returns true iff U is a mark character which can be used to extend an
+    --  identifier, or if C is one of the corresponding categories, which are
+    --  the following:
+    --    Mark, Non-Spacing (Mn)
+    --    Mark, Spacing Combining (Mc)
+ 
+    function Is_Other (U : Wide_Character) return Boolean;
+    function Is_Other (C : Category)       return Boolean;
+    pragma Inline (Is_Other);
+    --  Returns true iff U is an other format character, which means that it
+    --  can be used to extend an identifier, but is ignored for the purposes of
+    --  matching of identiers, or if C is one of the corresponding categories,
+    --  which are the following:
+    --    Other, Format (Cf)
+ 
+    function Is_Punctuation (U : Wide_Character) return Boolean;
+    function Is_Punctuation (C : Category)       return Boolean;
+    pragma Inline (Is_Punctuation);
+    --  Returns true iff U is a punctuation character that can be used to
+    --  separate pices of an identifier, or if C is one of the corresponding
+    --  categories, which are the following:
+    --    Punctuation, Connector (Pc)
+ 
+    function Is_Space (U : Wide_Character) return Boolean;
+    function Is_Space (C : Category)       return Boolean;
+    pragma Inline (Is_Space);
+    --  Returns true iff U is considered a space to be ignored, or if C is one
+    --  of the corresponding categories, which are the following:
+    --    Separator, Space (Zs)
+ 
+    function Is_Non_Graphic (U : Wide_Character) return Boolean;
+    function Is_Non_Graphic (C : Category)       return Boolean;
+    pragma Inline (Is_Non_Graphic);
+    --  Returns true iff U is considered to be a non-graphic character, or if C
+    --  is one of the corresponding categories, which are the following:
+    --    Other, Control (Cc)
+    --    Other, Private Use (Co)
+    --    Other, Surrogate (Cs)
+    --    Separator, Line (Zl)
+    --    Separator, Paragraph (Zp)
+    --    FFFE or FFFF positions in any plane (Fe)
+    --
+    --  Note that the Ada category format effector is subsumed by the above
+    --  list of Unicode categories.
+    --
+    --  Note that Other, Unassiged (Cn) is quite deliberately not included
+    --  in the list of categories above. This means that should any of these
+    --  code positions be defined in future with graphic characters they will
+    --  be allowed without a need to change implementations or the standard.
+    --
+    --  Note that Other, Format (Cf) is also quite deliberately not included
+    --  in the list of categories above. This means that these characters can
+    --  be included in character and string literals.
+ 
+    --  The following function is used to fold to upper case, as required by
+    --  the Ada 2005 standard rules for identifier case folding. Two
+    --  identifiers are equivalent if they are identical after folding all
+    --  letters to upper case using this routine.
+ 
+    function To_Upper_Case (U : Wide_Character) return Wide_Character;
+    pragma Inline (To_Upper_Case);
+    --  If U represents a lower case letter, returns the corresponding upper
+    --  case letter, otherwise U is returned unchanged. The folding is locale
+    --  independent as defined by documents referenced in the note in section
+    --  1 of ISO/IEC 10646:2003
+ 
+ end Ada.Wide_Characters.Unicode;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-widcha.ads gcc-4.1.0/gcc/ada/a-widcha.ads
*** gcc-4.0.2/gcc/ada/a-widcha.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-widcha.ads	Mon Sep  5 07:51:25 2005
***************
*** 0 ****
--- 1,21 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --                  A D A . W I D E _ C H A R A C T E R S                   --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ -- This specification is adapted from the Ada Reference Manual for use with --
+ -- GNAT.  In accordance with the copyright of that document, you can freely --
+ -- copy and modify this specification,  provided that if you redistribute a --
+ -- modified version,  any changes that you have made are clearly indicated. --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  Note: strictly this is an Ada 2005 package, but we make it freely
+ --  available in Ada 95 mode, since it deals only with wide characters.
+ 
+ package Ada.Wide_Characters is
+    pragma Pure;
+ end Ada.Wide_Characters;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-witeio.adb gcc-4.1.0/gcc/ada/a-witeio.adb
*** gcc-4.0.2/gcc/ada/a-witeio.adb	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-witeio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     A D A . W I D E _ T E X T _ I O                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     A D A . W I D E _ T E X T _ I O                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Text_IO is
*** 987,993 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 987,993 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Text_IO is
*** 1346,1352 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1346,1352 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Text_IO is
*** 1434,1440 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1434,1440 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Text_IO is
*** 1479,1485 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1479,1485 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Text_IO is
*** 1512,1518 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1512,1518 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Text_IO is
*** 1570,1576 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1570,1576 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-witeio.ads gcc-4.1.0/gcc/ada/a-witeio.ads
*** gcc-4.0.2/gcc/ada/a-witeio.ads	Thu Feb 10 13:51:39 2005
--- gcc-4.1.0/gcc/ada/a-witeio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcoau.adb gcc-4.1.0/gcc/ada/a-wtcoau.adb
*** gcc-4.0.2/gcc/ada/a-wtcoau.adb	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtcoau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . C O M P L E X _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . C O M P L E X _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Text_IO.Complex_Au
*** 194,200 ****
  
        To (To'Last) := ')';
  
- 
        To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
  
        for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
--- 194,199 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcoau.ads gcc-4.1.0/gcc/ada/a-wtcoau.ads
*** gcc-4.0.2/gcc/ada/a-wtcoau.ads	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtcoau.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . C O M P L E X _ A U X          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . C O M P L E X _ A U X          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcoio.adb gcc-4.1.0/gcc/ada/a-wtcoio.adb
*** gcc-4.0.2/gcc/ada/a-wtcoio.adb	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtcoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ IO . C O M P L E X _ I O           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ IO . C O M P L E X _ I O           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcoio.ads gcc-4.1.0/gcc/ada/a-wtcoio.ads
*** gcc-4.0.2/gcc/ada/a-wtcoio.ads	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtcoio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ IO . C O M P L E X _ I O           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ IO . C O M P L E X _ I O           --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcstr.adb gcc-4.1.0/gcc/ada/a-wtcstr.adb
*** gcc-4.0.2/gcc/ada/a-wtcstr.adb	Tue Oct 21 13:41:55 2003
--- gcc-4.1.0/gcc/ada/a-wtcstr.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtcstr.ads gcc-4.1.0/gcc/ada/a-wtcstr.ads
*** gcc-4.0.2/gcc/ada/a-wtcstr.ads	Tue Oct 21 13:41:55 2003
--- gcc-4.1.0/gcc/ada/a-wtcstr.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . C _ S T R E A M S            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . C _ S T R E A M S            --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtdeau.adb gcc-4.1.0/gcc/ada/a-wtdeau.adb
*** gcc-4.0.2/gcc/ada/a-wtdeau.adb	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtdeau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . D E C I M A L _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . D E C I M A L _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtdeau.ads gcc-4.1.0/gcc/ada/a-wtdeau.ads
*** gcc-4.0.2/gcc/ada/a-wtdeau.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtdeau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtdeio.adb gcc-4.1.0/gcc/ada/a-wtdeio.adb
*** gcc-4.0.2/gcc/ada/a-wtdeio.adb	Tue Oct 21 13:41:55 2003
--- gcc-4.1.0/gcc/ada/a-wtdeio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . D E C I M A L _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . D E C I M A L _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtdeio.ads gcc-4.1.0/gcc/ada/a-wtdeio.ads
*** gcc-4.0.2/gcc/ada/a-wtdeio.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtdeio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtedit.adb gcc-4.1.0/gcc/ada/a-wtedit.adb
*** gcc-4.0.2/gcc/ada/a-wtedit.adb	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtedit.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Text_IO.Editing is
*** 266,272 ****
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last was a ')' throw it away too.
  
                 Picture_Index := Last + 1;
  
--- 266,272 ----
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last was a ')' throw it away too
  
                 Picture_Index := Last + 1;
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 313,322 ****
        Currency_Pos  : Integer := Pic.Start_Currency;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary.
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output.
  
     begin
  
--- 313,322 ----
        Currency_Pos  : Integer := Pic.Start_Currency;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output
  
     begin
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 856,866 ****
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill.
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it.
  
           Last := Answer'Last;
  
--- 856,866 ----
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it
  
           Last := Answer'Last;
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 1063,1069 ****
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no.
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
--- 1063,1069 ----
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1083,1089 ****
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (intger) digits needs a null range.
  
        return Answer;
     end Parse_Number_String;
--- 1083,1089 ----
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (intger) digits needs a null range
  
        return Answer;
     end Parse_Number_String;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1116,1122 ****
  
        type Legality is  (Okay, Reject);
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings.
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
--- 1116,1122 ----
  
        type Legality is  (Okay, Reject);
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 1426,1432 ****
  
        procedure Leading_Dollar is
        begin
!          --  Treat as a floating dollar, and unwind otherwise.
  
           Pic.Floater := '$';
           Pic.Start_Currency := Index;
--- 1426,1432 ----
  
        procedure Leading_Dollar is
        begin
!          --  Treat as a floating dollar, and unwind otherwise
  
           Pic.Floater := '$';
           Pic.Start_Currency := Index;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1495,1501 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make.
  
                    Number_Completion;
                    return;
--- 1495,1501 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make
  
                    Number_Completion;
                    return;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1507,1514 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1507,1514 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1543,1549 ****
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert.
  
        begin
           --  Treat as a floating currency. If it isn't, this will be
--- 1543,1549 ----
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert
  
        begin
           --  Treat as a floating currency. If it isn't, this will be
*************** package body Ada.Wide_Text_IO.Editing is
*** 1619,1625 ****
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float.
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
--- 1619,1625 ----
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1636,1643 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1636,1643 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Wide_Text_IO.Editing is
*** 1700,1706 ****
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen.
  
           end loop;
        end Number;
--- 1700,1706 ----
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen
  
           end loop;
        end Number;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2130,2136 ****
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State.
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
--- 2130,2136 ----
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
*************** package body Ada.Wide_Text_IO.Editing is
*** 2188,2194 ****
           Pic.Sign_Position := Index;
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
--- 2188,2194 ----
           Pic.Sign_Position := Index;
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2258,2264 ****
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
--- 2258,2264 ----
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2285,2291 ****
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "-- " is enough.
                    Floating_Minus;
                    Trailing_Currency;
                    return;
--- 2285,2291 ----
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "-- " is enough
                    Floating_Minus;
                    Trailing_Currency;
                    return;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2303,2309 ****
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign.
  
                    if State = Okay then
                       Set_State (Reject);
--- 2303,2309 ----
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign
  
                    if State = Okay then
                       Set_State (Reject);
*************** package body Ada.Wide_Text_IO.Editing is
*** 2322,2328 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2322,2328 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2342,2348 ****
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
--- 2342,2348 ----
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2369,2375 ****
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough.
                    Floating_Plus;
                    Trailing_Currency;
                    return;
--- 2369,2375 ----
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough
                    Floating_Plus;
                    Trailing_Currency;
                    return;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2390,2396 ****
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign.
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
--- 2390,2396 ----
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 2410,2416 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2410,2416 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Wide_Text_IO.Editing is
*** 2474,2480 ****
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'.
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
--- 2474,2480 ----
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
*************** package body Ada.Wide_Text_IO.Editing is
*** 2693,2699 ****
  
        when Constraint_Error =>
  
!          --  To deal with special cases like null strings.
  
        raise Picture_Error;
  
--- 2693,2699 ----
  
        when Constraint_Error =>
  
!       --  To deal with special cases like null strings
  
        raise Picture_Error;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtedit.ads gcc-4.1.0/gcc/ada/a-wtedit.ads
*** gcc-4.0.2/gcc/ada/a-wtedit.ads	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wtedit.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtenau.adb gcc-4.1.0/gcc/ada/a-wtenau.adb
*** gcc-4.0.2/gcc/ada/a-wtenau.adb	Tue Oct 21 13:41:56 2003
--- gcc-4.1.0/gcc/ada/a-wtenau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ T E X T _ I O . E N U M E R A T I O N _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ T E X T _ I O . E N U M E R A T I O N _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Text_IO.Enumeratio
*** 46,55 ****
     -----------------------
  
     procedure Store_Char
!      (WC   : Wide_Character;
!       Buf  : out Wide_String;
!       Ptr  : in out Integer);
!    --  Store a single character in buffer, checking for overflow.
  
     --  These definitions replace the ones in Ada.Characters.Handling, which
     --  do not seem to work for some strange not understood reason ??? at
--- 46,55 ----
     -----------------------
  
     procedure Store_Char
!      (WC  : Wide_Character;
!       Buf : out Wide_String;
!       Ptr : in out Integer);
!    --  Store a single character in buffer, checking for overflow
  
     --  These definitions replace the ones in Ada.Characters.Handling, which
     --  do not seem to work for some strange not understood reason ??? at
*************** package body Ada.Wide_Text_IO.Enumeratio
*** 324,332 ****
     ----------------
  
     procedure Store_Char
!      (WC   : Wide_Character;
!       Buf  : out Wide_String;
!       Ptr  : in out Integer)
     is
     begin
        if Ptr = Buf'Last then
--- 324,332 ----
     ----------------
  
     procedure Store_Char
!      (WC  : Wide_Character;
!       Buf : out Wide_String;
!       Ptr : in out Integer)
     is
     begin
        if Ptr = Buf'Last then
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtenau.ads gcc-4.1.0/gcc/ada/a-wtenau.ads
*** gcc-4.0.2/gcc/ada/a-wtenau.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtenau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtenio.adb gcc-4.1.0/gcc/ada/a-wtenio.adb
*** gcc-4.0.2/gcc/ada/a-wtenio.adb	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtenio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --       A D A . W I D E _ T E X T _ I O . E N U M E R A T I O N _ I O      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --       A D A . W I D E _ T E X T _ I O . E N U M E R A T I O N _ I O      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtenio.ads gcc-4.1.0/gcc/ada/a-wtenio.ads
*** gcc-4.0.2/gcc/ada/a-wtenio.ads	Thu Apr 24 17:53:56 2003
--- gcc-4.1.0/gcc/ada/a-wtenio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtfiio.adb gcc-4.1.0/gcc/ada/a-wtfiio.adb
*** gcc-4.0.2/gcc/ada/a-wtfiio.adb	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtfiio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . T E X T _ I O . W I D E _ T E X T _ I O . F I X E D _ I O    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . T E X T _ I O . W I D E _ T E X T _ I O . F I X E D _ I O    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtfiio.ads gcc-4.1.0/gcc/ada/a-wtfiio.ads
*** gcc-4.0.2/gcc/ada/a-wtfiio.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtfiio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtflau.adb gcc-4.1.0/gcc/ada/a-wtflau.adb
*** gcc-4.0.2/gcc/ada/a-wtflau.adb	Tue Oct 21 13:41:56 2003
--- gcc-4.1.0/gcc/ada/a-wtflau.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtflau.ads gcc-4.1.0/gcc/ada/a-wtflau.ads
*** gcc-4.0.2/gcc/ada/a-wtflau.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtflau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtflio.adb gcc-4.1.0/gcc/ada/a-wtflio.adb
*** gcc-4.0.2/gcc/ada/a-wtflio.adb	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtflio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             A D A . W I D E _ T E X T _ I O . F L O A T _ I O            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             A D A . W I D E _ T E X T _ I O . F L O A T _ I O            --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtflio.ads gcc-4.1.0/gcc/ada/a-wtflio.ads
*** gcc-4.0.2/gcc/ada/a-wtflio.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtflio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtgeau.adb gcc-4.1.0/gcc/ada/a-wtgeau.adb
*** gcc-4.0.2/gcc/ada/a-wtgeau.adb	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtgeau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . G E N E R I C _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . G E N E R I C _ A U X          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtgeau.ads gcc-4.1.0/gcc/ada/a-wtgeau.ads
*** gcc-4.0.2/gcc/ada/a-wtgeau.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtgeau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtinau.adb gcc-4.1.0/gcc/ada/a-wtinau.adb
*** gcc-4.0.2/gcc/ada/a-wtinau.adb	Tue Oct 21 13:41:57 2003
--- gcc-4.1.0/gcc/ada/a-wtinau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . I N T E G E R  _ A U X         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . I N T E G E R  _ A U X         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtinau.ads gcc-4.1.0/gcc/ada/a-wtinau.ads
*** gcc-4.0.2/gcc/ada/a-wtinau.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtinau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtinio.adb gcc-4.1.0/gcc/ada/a-wtinio.adb
*** gcc-4.0.2/gcc/ada/a-wtinio.adb	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtinio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . I N T E G E R _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . I N T E G E R _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtinio.ads gcc-4.1.0/gcc/ada/a-wtinio.ads
*** gcc-4.0.2/gcc/ada/a-wtinio.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtinio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . I N T E G E R _ I O          --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . I N T E G E R _ I O          --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtmoau.adb gcc-4.1.0/gcc/ada/a-wtmoau.adb
*** gcc-4.0.2/gcc/ada/a-wtmoau.adb	Tue Oct 21 13:41:57 2003
--- gcc-4.1.0/gcc/ada/a-wtmoau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . M O D U L A R  _ A U X         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . M O D U L A R  _ A U X         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtmoau.ads gcc-4.1.0/gcc/ada/a-wtmoau.ads
*** gcc-4.0.2/gcc/ada/a-wtmoau.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtmoau.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtmoio.adb gcc-4.1.0/gcc/ada/a-wtmoio.adb
*** gcc-4.0.2/gcc/ada/a-wtmoio.adb	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/a-wtmoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . M O D U L A R _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --           A D A . W I D E _ T E X T _ I O . M O D U L A R _ I O          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wtmoio.ads gcc-4.1.0/gcc/ada/a-wtmoio.ads
*** gcc-4.0.2/gcc/ada/a-wtmoio.ads	Tue Apr 27 10:49:36 2004
--- gcc-4.1.0/gcc/ada/a-wtmoio.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wttest.adb gcc-4.1.0/gcc/ada/a-wttest.adb
*** gcc-4.0.2/gcc/ada/a-wttest.adb	Thu Feb 10 13:51:40 2005
--- gcc-4.1.0/gcc/ada/a-wttest.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . T E X T _ S T R E A M S        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --         A D A . W I D E _ T E X T _ I O . T E X T _ S T R E A M S        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-wwunio.ads gcc-4.1.0/gcc/ada/a-wwunio.ads
*** gcc-4.0.2/gcc/ada/a-wwunio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-wwunio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --   A D A . W I D E _ T E X T _ I O . W I D E _ U N B O U N D E D _ I O    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --   A D A . W I D E _ T E X T _ I O . W I D E _ U N B O U N D E D _ I O    --
  --                                                                          --
***************
*** 19,25 ****
  --  straightforward implementation anyway, since we need access to the
  --  internal representation of Unbounded_Wide_String.
  
- 
  with Ada.Strings.Wide_Unbounded;
  with Ada.Strings.Wide_Unbounded.Wide_Text_IO;
  
--- 19,24 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-zchara.ads gcc-4.1.0/gcc/ada/a-zchara.ads
*** gcc-4.0.2/gcc/ada/a-zchara.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-zchara.ads	Mon Sep  5 07:51:25 2005
***************
*** 0 ****
--- 1,18 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --             A D A . W I D E _ W I D E _ C H A R A C T E R S              --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ -- This specification is adapted from the Ada Reference Manual for use with --
+ -- GNAT.  In accordance with the copyright of that document, you can freely --
+ -- copy and modify this specification,  provided that if you redistribute a --
+ -- modified version,  any changes that you have made are clearly indicated. --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package Ada.Wide_Wide_Characters is
+    pragma Pure;
+ end Ada.Wide_Wide_Characters;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-zchuni.adb gcc-4.1.0/gcc/ada/a-zchuni.adb
*** gcc-4.0.2/gcc/ada/a-zchuni.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-zchuni.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,167 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --    A D A . W I D E _ W I D E _ C H A R A C T E R T S . U N I C O D E     --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package body Ada.Wide_Wide_Characters.Unicode is
+ 
+    package G renames GNAT.UTF_32;
+ 
+    ------------------
+    -- Get_Category --
+    ------------------
+ 
+    function Get_Category (U : Wide_Wide_Character) return Category is
+    begin
+       return Category (G.Get_Category (Wide_Wide_Character'Pos (U)));
+    end Get_Category;
+ 
+    --------------
+    -- Is_Digit --
+    --------------
+ 
+    function Is_Digit (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Digit (Wide_Wide_Character'Pos (U));
+    end Is_Digit;
+ 
+    function Is_Digit (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Digit (G.Category (C));
+    end Is_Digit;
+ 
+    ---------------
+    -- Is_Letter --
+    ---------------
+ 
+    function Is_Letter (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Letter (Wide_Wide_Character'Pos (U));
+    end Is_Letter;
+ 
+    function Is_Letter (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Letter (G.Category (C));
+    end Is_Letter;
+ 
+    ------------------------
+    -- Is_Line_Terminator --
+    ------------------------
+ 
+    function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Line_Terminator (Wide_Wide_Character'Pos (U));
+    end Is_Line_Terminator;
+ 
+    -------------
+    -- Is_Mark --
+    -------------
+ 
+    function Is_Mark (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Mark (Wide_Wide_Character'Pos (U));
+    end Is_Mark;
+ 
+    function Is_Mark (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Mark (G.Category (C));
+    end Is_Mark;
+ 
+    --------------------
+    -- Is_Non_Graphic --
+    --------------------
+ 
+    function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Non_Graphic (Wide_Wide_Character'Pos (U));
+    end Is_Non_Graphic;
+ 
+    function Is_Non_Graphic (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Non_Graphic (G.Category (C));
+    end Is_Non_Graphic;
+ 
+    --------------
+    -- Is_Other --
+    --------------
+ 
+    function Is_Other (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Other (Wide_Wide_Character'Pos (U));
+    end Is_Other;
+ 
+    function Is_Other (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Other (G.Category (C));
+    end Is_Other;
+ 
+    --------------------
+    -- Is_Punctuation --
+    --------------------
+ 
+    function Is_Punctuation (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Punctuation (Wide_Wide_Character'Pos (U));
+    end Is_Punctuation;
+ 
+    function Is_Punctuation (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Punctuation (G.Category (C));
+    end Is_Punctuation;
+ 
+    --------------
+    -- Is_Space --
+    --------------
+ 
+    function Is_Space (U : Wide_Wide_Character) return Boolean is
+    begin
+       return G.Is_UTF_32_Space (Wide_Wide_Character'Pos (U));
+    end Is_Space;
+ 
+    function Is_Space (C : Category) return Boolean is
+    begin
+       return G.Is_UTF_32_Space (G.Category (C));
+    end Is_Space;
+ 
+    -------------------
+    -- To_Upper_Case --
+    -------------------
+ 
+    function To_Upper_Case
+      (U : Wide_Wide_Character) return Wide_Wide_Character
+    is
+    begin
+       return
+         Wide_Wide_Character'Val
+           (G.UTF_32_To_Upper_Case (Wide_Wide_Character'Pos (U)));
+    end To_Upper_Case;
+ 
+ end Ada.Wide_Wide_Characters.Unicode;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-zchuni.ads gcc-4.1.0/gcc/ada/a-zchuni.ads
*** gcc-4.0.2/gcc/ada/a-zchuni.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/a-zchuni.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,188 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --    A D A . W I D E _ W I D E _ C H A R A C T E R T S . U N I C O D E    --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  Unicode categorization routines for Wide_Wide_Character
+ 
+ with GNAT.UTF_32;
+ 
+ package Ada.Wide_Wide_Characters.Unicode is
+ 
+    --  The following type defines the categories from the unicode definitions.
+    --  The one addition we make is Fe, which represents the characters FFFE
+    --  and FFFF in any of the planes.
+ 
+    type Category is new GNAT.UTF_32.Category;
+    --  Cc   Other, Control
+    --  Cf   Other, Format
+    --  Cn   Other, Not Assigned
+    --  Co   Other, Private Use
+    --  Cs   Other, Surrogate
+    --  Ll   Letter, Lowercase
+    --  Lm   Letter, Modifier
+    --  Lo   Letter, Other
+    --  Lt   Letter, Titlecase
+    --  Lu   Letter, Uppercase
+    --  Mc   Mark, Spacing Combining
+    --  Me   Mark, Enclosing
+    --  Mn   Mark, Nonspacing
+    --  Nd   Number, Decimal Digit
+    --  Nl   Number, Letter
+    --  No   Number, Other
+    --  Pc   Punctuation, Connector
+    --  Pd   Punctuation, Dash
+    --  Pe   Punctuation, Close
+    --  Pf   Punctuation, Final quote
+    --  Pi   Punctuation, Initial quote
+    --  Po   Punctuation, Other
+    --  Ps   Punctuation, Open
+    --  Sc   Symbol, Currency
+    --  Sk   Symbol, Modifier
+    --  Sm   Symbol, Math
+    --  So   Symbol, Other
+    --  Zl   Separator, Line
+    --  Zp   Separator, Paragraph
+    --  Zs   Separator, Space
+    --  Fe   relative position FFFE/FFFF in plane
+ 
+    function Get_Category (U : Wide_Wide_Character) return Category;
+    pragma Inline (Get_Category);
+    --  Given a Wide_Wide_Character, returns corresponding Category, or Cn if
+    --  the code does not have an assigned unicode category.
+ 
+    --  The following functions perform category tests corresponding to lexical
+    --  classes defined in the Ada standard. There are two interfaces for each
+    --  function. The second takes a Category (e.g. returned by Get_Category).
+    --  The first takes a Wide_Wide_Character. The form taking the
+    --  Wide_Wide_Character is typically more efficient than calling
+    --  Get_Category, but if several different tests are to be performed on the
+    --  same code, it is more efficient to use Get_Category to get the category,
+    --  then test the resulting category.
+ 
+    function Is_Letter (U : Wide_Wide_Character) return Boolean;
+    function Is_Letter (C : Category)            return Boolean;
+    pragma Inline (Is_Letter);
+    --  Returns true iff U is a letter that can be used to start an identifier,
+    --  or if C is one of the corresponding categories, which are the following:
+    --    Letter, Uppercase (Lu)
+    --    Letter, Lowercase (Ll)
+    --    Letter, Titlecase (Lt)
+    --    Letter, Modifier  (Lm)
+    --    Letter, Other     (Lo)
+    --    Number, Letter    (Nl)
+ 
+    function Is_Digit (U : Wide_Wide_Character) return Boolean;
+    function Is_Digit (C : Category)            return Boolean;
+    pragma Inline (Is_Digit);
+    --  Returns true iff U is a digit that can be used to extend an identifer,
+    --  or if C is one of the corresponding categories, which are the following:
+    --    Number, Decimal_Digit (Nd)
+ 
+    function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean;
+    pragma Inline (Is_Line_Terminator);
+    --  Returns true iff U is an allowed line terminator for source programs,
+    --  if U is in the category Zp (Separator, Paragaph), or Zs (Separator,
+    --  Line), or if U is a conventional line terminator (CR, LF, VT, FF).
+    --  There is no category version for this function, since the set of
+    --  characters does not correspond to a set of Unicode categories.
+ 
+    function Is_Mark (U : Wide_Wide_Character) return Boolean;
+    function Is_Mark (C : Category)            return Boolean;
+    pragma Inline (Is_Mark);
+    --  Returns true iff U is a mark character which can be used to extend an
+    --  identifier, or if C is one of the corresponding categories, which are
+    --  the following:
+    --    Mark, Non-Spacing (Mn)
+    --    Mark, Spacing Combining (Mc)
+ 
+    function Is_Other (U : Wide_Wide_Character) return Boolean;
+    function Is_Other (C : Category)            return Boolean;
+    pragma Inline (Is_Other);
+    --  Returns true iff U is an other format character, which means that it
+    --  can be used to extend an identifier, but is ignored for the purposes of
+    --  matching of identiers, or if C is one of the corresponding categories,
+    --  which are the following:
+    --    Other, Format (Cf)
+ 
+    function Is_Punctuation (U : Wide_Wide_Character) return Boolean;
+    function Is_Punctuation (C : Category)            return Boolean;
+    pragma Inline (Is_Punctuation);
+    --  Returns true iff U is a punctuation character that can be used to
+    --  separate pices of an identifier, or if C is one of the corresponding
+    --  categories, which are the following:
+    --    Punctuation, Connector (Pc)
+ 
+    function Is_Space (U : Wide_Wide_Character) return Boolean;
+    function Is_Space (C : Category)            return Boolean;
+    pragma Inline (Is_Space);
+    --  Returns true iff U is considered a space to be ignored, or if C is one
+    --  of the corresponding categories, which are the following:
+    --    Separator, Space (Zs)
+ 
+    function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean;
+    function Is_Non_Graphic (C : Category)            return Boolean;
+    pragma Inline (Is_Non_Graphic);
+    --  Returns true iff U is considered to be a non-graphic character, or if C
+    --  is one of the corresponding categories, which are the following:
+    --    Other, Control (Cc)
+    --    Other, Private Use (Co)
+    --    Other, Surrogate (Cs)
+    --    Separator, Line (Zl)
+    --    Separator, Paragraph (Zp)
+    --    FFFE or FFFF positions in any plane (Fe)
+    --
+    --  Note that the Ada category format effector is subsumed by the above
+    --  list of Unicode categories.
+    --
+    --  Note that Other, Unassiged (Cn) is quite deliberately not included
+    --  in the list of categories above. This means that should any of these
+    --  code positions be defined in future with graphic characters they will
+    --  be allowed without a need to change implementations or the standard.
+    --
+    --  Note that Other, Format (Cf) is also quite deliberately not included
+    --  in the list of categories above. This means that these characters can
+    --  be included in character and string literals.
+ 
+    --  The following function is used to fold to upper case, as required by
+    --  the Ada 2005 standard rules for identifier case folding. Two
+    --  identifiers are equivalent if they are identical after folding all
+    --  letters to upper case using this routine.
+ 
+    function To_Upper_Case
+      (U : Wide_Wide_Character) return Wide_Wide_Character;
+    pragma Inline (To_Upper_Case);
+    --  If U represents a lower case letter, returns the corresponding upper
+    --  case letter, otherwise U is returned unchanged. The folding is locale
+    --  independent as defined by documents referenced in the note in section
+    --  1 of ISO/IEC 10646:2003
+ 
+ end Ada.Wide_Wide_Characters.Unicode;
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcoau.adb gcc-4.1.0/gcc/ada/a-ztcoau.adb
*** gcc-4.0.2/gcc/ada/a-ztcoau.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcoau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Wide_Text_IO.Compl
*** 194,200 ****
  
        To (To'Last) := ')';
  
- 
        To (To'Last - Iptr .. To'Last - 1) := I_String (1 .. Iptr);
  
        for J in To'First + Rptr + 2 .. To'Last - Iptr - 1 loop
--- 194,199 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcoau.ads gcc-4.1.0/gcc/ada/a-ztcoau.ads
*** gcc-4.0.2/gcc/ada/a-ztcoau.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcoau.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . C O M P L E X _ A U X     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcoio.adb gcc-4.1.0/gcc/ada/a-ztcoio.adb
*** gcc-4.0.2/gcc/ada/a-ztcoio.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ IO . C O M P L E X _ I O      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ IO . C O M P L E X _ I O      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcoio.ads gcc-4.1.0/gcc/ada/a-ztcoio.ads
*** gcc-4.0.2/gcc/ada/a-ztcoio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcoio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ IO . C O M P L E X _ I O      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ IO . C O M P L E X _ I O      --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcstr.adb gcc-4.1.0/gcc/ada/a-ztcstr.adb
*** gcc-4.0.2/gcc/ada/a-ztcstr.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcstr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztcstr.ads gcc-4.1.0/gcc/ada/a-ztcstr.ads
*** gcc-4.0.2/gcc/ada/a-ztcstr.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztcstr.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . C _ S T R E A M S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . C _ S T R E A M S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztdeau.adb gcc-4.1.0/gcc/ada/a-ztdeau.adb
*** gcc-4.0.2/gcc/ada/a-ztdeau.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztdeau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . D E C I M A L _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . D E C I M A L _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztdeau.ads gcc-4.1.0/gcc/ada/a-ztdeau.ads
*** gcc-4.0.2/gcc/ada/a-ztdeau.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztdeau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztdeio.adb gcc-4.1.0/gcc/ada/a-ztdeio.adb
*** gcc-4.0.2/gcc/ada/a-ztdeio.adb	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztdeio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . D E C I M A L _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . D E C I M A L _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with Ada.Wide_Wide_Text_IO.Decimal_Aux;
+ 
  with System.WCh_Con; use System.WCh_Con;
  with System.WCh_WtS; use System.WCh_WtS;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztdeio.ads gcc-4.1.0/gcc/ada/a-ztdeio.ads
*** gcc-4.0.2/gcc/ada/a-ztdeio.ads	Wed Feb  9 11:14:41 2005
--- gcc-4.1.0/gcc/ada/a-ztdeio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztedit.adb gcc-4.1.0/gcc/ada/a-ztedit.adb
*** gcc-4.0.2/gcc/ada/a-ztedit.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztedit.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 267,273 ****
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last was a ')' throw it away too.
  
                 Picture_Index := Last + 1;
  
--- 267,273 ----
  
                 Result_Index := Result_Index + Count - 1;
  
!                --  Last was a ')' throw it away too
  
                 Picture_Index := Last + 1;
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 314,323 ****
        Currency_Pos  : Integer := Pic.Start_Currency;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary.
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output.
  
     begin
  
--- 314,323 ----
        Currency_Pos  : Integer := Pic.Start_Currency;
  
        Dollar : Boolean := False;
!       --  Overridden immediately if necessary
  
        Zero : Boolean := True;
!       --  Set to False when a non-zero digit is output
  
     begin
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 857,867 ****
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill.
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it.
  
           Last := Answer'Last;
  
--- 857,867 ----
           end case;
        end loop;
  
!       --  Now get rid of Blank_when_Zero and complete Star fill
  
        if Zero and Pic.Blank_When_Zero then
  
!          --  Value is zero, and blank it
  
           Last := Answer'Last;
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1065,1071 ****
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no.
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
--- 1065,1071 ----
                    raise Picture_Error;
                 end if;
  
!                --  Two decimal points is a no-no
  
                 Answer.Has_Fraction    := True;
                 Answer.End_Of_Fraction := J;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1085,1091 ****
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (intger) digits needs a null range.
  
        return Answer;
     end Parse_Number_String;
--- 1085,1091 ----
           Answer.Start_Of_Int := Answer.End_Of_Int + 1;
        end if;
  
!       --  No significant (intger) digits needs a null range
  
        return Answer;
     end Parse_Number_String;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1118,1124 ****
  
        type Legality is  (Okay, Reject);
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings.
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
--- 1118,1124 ----
  
        type Legality is  (Okay, Reject);
        State : Legality := Reject;
!       --  Start in reject, which will reject null strings
  
        Index : Pic_Index := Pic.Picture.Expanded'First;
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1418,1426 ****
        -- Leading_Dollar --
        --------------------
  
!       --  Note that Leading_Dollar can be called in either State.
!       --  It will set state to Okay only if a 9 or (second) $
!       --  is encountered.
  
        --  Also notice the tricky bit with State and Zero_Suppression.
        --  Zero_Suppression is Picture_Error if a '$' or a '9' has been
--- 1418,1425 ----
        -- Leading_Dollar --
        --------------------
  
!       --  Note that Leading_Dollar can be called in either State. It will set
!       --  state to Okay only if a 9 or (second) is encountered.
  
        --  Also notice the tricky bit with State and Zero_Suppression.
        --  Zero_Suppression is Picture_Error if a '$' or a '9' has been
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1428,1434 ****
  
        procedure Leading_Dollar is
        begin
!          --  Treat as a floating dollar, and unwind otherwise.
  
           Pic.Floater := '$';
           Pic.Start_Currency := Index;
--- 1427,1433 ----
  
        procedure Leading_Dollar is
        begin
!          --  Treat as a floating dollar, and unwind otherwise
  
           Pic.Floater := '$';
           Pic.Start_Currency := Index;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1497,1503 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make.
  
                    Number_Completion;
                    return;
--- 1496,1502 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  A single dollar does not a floating make
  
                    Number_Completion;
                    return;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1509,1516 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1508,1515 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one dollar before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1533,1540 ****
        --  this procedure.  Also note that Leading_Pound can be called in
        --  either State.
  
!       --  It will set state to Okay only if a 9 or  (second) # is
!       --  encountered.
  
        --  One Last note:  In ambiguous cases, the currency is treated as
        --  floating unless there is only one '#'.
--- 1532,1538 ----
        --  this procedure.  Also note that Leading_Pound can be called in
        --  either State.
  
!       --  It will set state to Okay only if a 9 or (second) # is encountered
  
        --  One Last note:  In ambiguous cases, the currency is treated as
        --  floating unless there is only one '#'.
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1545,1551 ****
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert.
  
        begin
           --  Treat as a floating currency. If it isn't, this will be
--- 1543,1549 ----
           --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
  
           Must_Float : Boolean := False;
!          --  Set to true if a '#' occurs after an insert
  
        begin
           --  Treat as a floating currency. If it isn't, this will be
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1621,1627 ****
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float.
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
--- 1619,1625 ----
                 when '9' =>
                    if State /= Okay then
  
!                      --  A single '#' doesn't float
  
                       Pic.Floater := '!';
                       Pic.Start_Float := Invalid_Position;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1638,1645 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay,
!                   --  but doesn't float.
  
                    Pic.Radix_Position := Index;
                    Skip;
--- 1636,1643 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Only one pound before the sign is okay, but doesn't
!                   --  float.
  
                    Pic.Radix_Position := Index;
                    Skip;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 1702,1708 ****
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen.
  
           end loop;
        end Number;
--- 1700,1706 ----
                 return;
              end if;
  
!             --  Will return in Okay state if a '9' was seen
  
           end loop;
        end Number;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2132,2138 ****
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State.
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
--- 2130,2136 ----
        -- Picture --
        -------------
  
!       --  Note that Picture can be called in either State
  
        --  It will set state to Valid only if a 9 is encountered or floating
        --  currency is called.
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2190,2196 ****
           Pic.Sign_Position := Index;
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
--- 2188,2194 ----
           Pic.Sign_Position := Index;
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '<';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2260,2266 ****
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
--- 2258,2264 ----
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '-';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2305,2311 ****
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign.
  
                    if State = Okay then
                       Set_State (Reject);
--- 2303,2309 ----
  
                 when 'Z' | 'z' =>
  
!                   --  Can't have Z and a floating sign
  
                    if State = Okay then
                       Set_State (Reject);
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2324,2330 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2322,2328 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2344,2350 ****
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise.
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
--- 2342,2348 ----
        begin
           Pic.Sign_Position := Index;
  
!          --  Treat as a floating sign, and unwind otherwise
  
           Pic.Floater := '+';
           Pic.Start_Float := Index;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2371,2377 ****
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough.
                    Floating_Plus;
                    Trailing_Currency;
                    return;
--- 2369,2375 ----
                    Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
                    Pic.End_Float := Index;
                    Skip;
!                   Set_State (Okay);  --  "++" is enough
                    Floating_Plus;
                    Trailing_Currency;
                    return;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2392,2398 ****
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign.
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
--- 2390,2396 ----
                       Set_State (Reject);
                    end if;
  
!                   --  Can't have Z and a floating sign
  
                    Pic.Picture.Expanded (Index) := 'Z'; -- consistency
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2412,2418 ****
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit.
  
                    Picture;
                    return;
--- 2410,2416 ----
                       Pic.End_Float := Invalid_Position;
                    end if;
  
!                   --  Don't assume that state is okay, haven't seen a digit
  
                    Picture;
                    return;
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2476,2482 ****
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'.
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
--- 2474,2480 ----
           Pic.Blank_When_Zero :=
             (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
  
!          --  Star fill if '*' and no '9'
  
           Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
  
*************** package body Ada.Wide_Wide_Text_IO.Editi
*** 2695,2701 ****
  
        when Constraint_Error =>
  
!          --  To deal with special cases like null strings.
  
        raise Picture_Error;
  
--- 2693,2699 ----
  
        when Constraint_Error =>
  
!          --  To deal with special cases like null strings
  
        raise Picture_Error;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztedit.ads gcc-4.1.0/gcc/ada/a-ztedit.ads
*** gcc-4.0.2/gcc/ada/a-ztedit.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztedit.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztenau.adb gcc-4.1.0/gcc/ada/a-ztenau.adb
*** gcc-4.0.2/gcc/ada/a-ztenau.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztenau.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  -- A D A . W I D E _ W I D E _ T E X T _ I O . E N U M E R A T I O N _ A U X--
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  -- A D A . W I D E _ W I D E _ T E X T _ I O . E N U M E R A T I O N _ A U X--
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with Ada.Wide_Wide_Text_IO.Generic_Aux; use Ada.Wide_Wide_Text_IO.Generic_Aux;
+ with Ada.Characters.Conversions;        use Ada.Characters.Conversions;
  with Ada.Characters.Handling;           use Ada.Characters.Handling;
  with Interfaces.C_Streams;              use Interfaces.C_Streams;
  with System.WCh_Con;                    use System.WCh_Con;
*************** package body Ada.Wide_Wide_Text_IO.Enume
*** 46,55 ****
     -----------------------
  
     procedure Store_Char
!      (WC   : Wide_Wide_Character;
!       Buf  : out Wide_Wide_String;
!       Ptr  : in out Integer);
!    --  Store a single character in buffer, checking for overflow.
  
     --  These definitions replace the ones in Ada.Characters.Handling, which
     --  do not seem to work for some strange not understood reason ??? at
--- 47,56 ----
     -----------------------
  
     procedure Store_Char
!      (WC  : Wide_Wide_Character;
!       Buf : out Wide_Wide_String;
!       Ptr : in out Integer);
!    --  Store a single character in buffer, checking for overflow
  
     --  These definitions replace the ones in Ada.Characters.Handling, which
     --  do not seem to work for some strange not understood reason ??? at
*************** package body Ada.Wide_Wide_Text_IO.Enume
*** 325,333 ****
     ----------------
  
     procedure Store_Char
!      (WC   : Wide_Wide_Character;
!       Buf  : out Wide_Wide_String;
!       Ptr  : in out Integer)
     is
     begin
        if Ptr = Buf'Last then
--- 326,334 ----
     ----------------
  
     procedure Store_Char
!      (WC  : Wide_Wide_Character;
!       Buf : out Wide_Wide_String;
!       Ptr : in out Integer)
     is
     begin
        if Ptr = Buf'Last then
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztenau.ads gcc-4.1.0/gcc/ada/a-ztenau.ads
*** gcc-4.0.2/gcc/ada/a-ztenau.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztenau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztenio.adb gcc-4.1.0/gcc/ada/a-ztenio.adb
*** gcc-4.0.2/gcc/ada/a-ztenio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztenio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --  A D A . W I D E _ W I D E _ T E X T _ I O . E N U M E R A T I O N _ I O --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --  A D A . W I D E _ W I D E _ T E X T _ I O . E N U M E R A T I O N _ I O --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztenio.ads gcc-4.1.0/gcc/ada/a-ztenio.ads
*** gcc-4.0.2/gcc/ada/a-ztenio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztenio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztexio.adb gcc-4.1.0/gcc/ada/a-ztexio.adb
*** gcc-4.0.2/gcc/ada/a-ztexio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztexio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                A D A . W I D E _ W I D E _ T E X T _ I O                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                A D A . W I D E _ W I D E _ T E X T _ I O                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Ada.Wide_Wide_Text_IO is
*** 988,994 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 988,994 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Wide_Text_IO is
*** 1348,1354 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1348,1354 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Wide_Text_IO is
*** 1436,1442 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1436,1442 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Wide_Text_IO is
*** 1481,1487 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1481,1487 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Wide_Text_IO is
*** 1514,1520 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if To not in Count then
           raise Constraint_Error;
        end if;
  
--- 1514,1520 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not To'Valid then
           raise Constraint_Error;
        end if;
  
*************** package body Ada.Wide_Wide_Text_IO is
*** 1572,1578 ****
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if Spacing not in Positive_Count then
           raise Constraint_Error;
        end if;
  
--- 1572,1578 ----
        --  explicit test is that we don't want junk values around, even if
        --  checks are off in the caller.
  
!       if not Spacing'Valid then
           raise Constraint_Error;
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztexio.ads gcc-4.1.0/gcc/ada/a-ztexio.ads
*** gcc-4.0.2/gcc/ada/a-ztexio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztexio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztfiio.adb gcc-4.1.0/gcc/ada/a-ztfiio.adb
*** gcc-4.0.2/gcc/ada/a-ztfiio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztfiio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --     A D A . T E X T _ I O . W I D E _ T E X T _ I O . F I X E D _ I O    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --     A D A . T E X T _ I O . W I D E _ T E X T _ I O . F I X E D _ I O    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztfiio.ads gcc-4.1.0/gcc/ada/a-ztfiio.ads
*** gcc-4.0.2/gcc/ada/a-ztfiio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztfiio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztflau.adb gcc-4.1.0/gcc/ada/a-ztflau.adb
*** gcc-4.0.2/gcc/ada/a-ztflau.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztflau.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztflau.ads gcc-4.1.0/gcc/ada/a-ztflau.ads
*** gcc-4.0.2/gcc/ada/a-ztflau.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztflau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztflio.adb gcc-4.1.0/gcc/ada/a-ztflio.adb
*** gcc-4.0.2/gcc/ada/a-ztflio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztflio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --        A D A . W I D E _ W I D E _ T E X T _ I O . F L O A T _ I O       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --        A D A . W I D E _ W I D E _ T E X T _ I O . F L O A T _ I O       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztflio.ads gcc-4.1.0/gcc/ada/a-ztflio.ads
*** gcc-4.0.2/gcc/ada/a-ztflio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztflio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztgeau.adb gcc-4.1.0/gcc/ada/a-ztgeau.adb
*** gcc-4.0.2/gcc/ada/a-ztgeau.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztgeau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . G E N E R I C _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . G E N E R I C _ A U X     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztgeau.ads gcc-4.1.0/gcc/ada/a-ztgeau.ads
*** gcc-4.0.2/gcc/ada/a-ztgeau.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztgeau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztinau.adb gcc-4.1.0/gcc/ada/a-ztinau.adb
*** gcc-4.0.2/gcc/ada/a-ztinau.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztinau.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R  _ A U X    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R  _ A U X    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztinau.ads gcc-4.1.0/gcc/ada/a-ztinau.ads
*** gcc-4.0.2/gcc/ada/a-ztinau.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztinau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztinio.adb gcc-4.1.0/gcc/ada/a-ztinio.adb
*** gcc-4.0.2/gcc/ada/a-ztinio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztinio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztinio.ads gcc-4.1.0/gcc/ada/a-ztinio.ads
*** gcc-4.0.2/gcc/ada/a-ztinio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztinio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . I N T E G E R _ I O     --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztmoau.adb gcc-4.1.0/gcc/ada/a-ztmoau.adb
*** gcc-4.0.2/gcc/ada/a-ztmoau.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztmoau.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R  _ A U X    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R  _ A U X    --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztmoau.ads gcc-4.1.0/gcc/ada/a-ztmoau.ads
*** gcc-4.0.2/gcc/ada/a-ztmoau.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztmoau.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztmoio.adb gcc-4.1.0/gcc/ada/a-ztmoio.adb
*** gcc-4.0.2/gcc/ada/a-ztmoio.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztmoio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --      A D A . W I D E _ W I D E _ T E X T _ I O . M O D U L A R _ I O     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-ztmoio.ads gcc-4.1.0/gcc/ada/a-ztmoio.ads
*** gcc-4.0.2/gcc/ada/a-ztmoio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-ztmoio.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-zttest.adb gcc-4.1.0/gcc/ada/a-zttest.adb
*** gcc-4.0.2/gcc/ada/a-zttest.adb	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-zttest.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . T E X T _ S T R E A M S   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --    A D A . W I D E _ W I D E _ T E X T _ I O . T E X T _ S T R E A M S   --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/a-zzunio.ads gcc-4.1.0/gcc/ada/a-zzunio.ads
*** gcc-4.0.2/gcc/ada/a-zzunio.ads	Wed Feb  9 11:14:42 2005
--- gcc-4.1.0/gcc/ada/a-zzunio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --               ADA.WIDE_WIDE_TEXT_IO.WIDE_WIDE_UNBOUNDED_IO               --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --               ADA.WIDE_WIDE_TEXT_IO.WIDE_WIDE_UNBOUNDED_IO               --
  --                                                                          --
***************
*** 19,25 ****
  --  straightforward implementation anyway, since we need access to the
  --  internal representation of Unbounded_Wide_Wide_String.
  
- 
  with Ada.Strings.Wide_Wide_Unbounded;
  with Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO;
  
--- 19,24 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/ada-tree.def gcc-4.1.0/gcc/ada/ada-tree.def
*** gcc-4.0.2/gcc/ada/ada-tree.def	Fri Sep 17 21:54:47 2004
--- gcc-4.1.0/gcc/ada/ada-tree.def	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/ada-tree.h gcc-4.1.0/gcc/ada/ada-tree.h
*** gcc-4.0.2/gcc/ada/ada-tree.h	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/ada-tree.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
*************** struct lang_type GTY(()) {tree t; };
*** 260,265 ****
--- 260,268 ----
  /* Nonzero in a PARM_DECL if we are to pass by descriptor.  */
  #define DECL_BY_DESCRIPTOR_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
  
+ /* Nonzero in a VAR_DECL if it is a pointer renaming a global object.  */
+ #define DECL_RENAMING_GLOBAL_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE))
+ 
  /* In a CONST_DECL, points to a VAR_DECL that is allocatable to
     memory.  Used when a scalar constant is aliased or has its
     address taken.  */
*************** struct lang_type GTY(()) {tree t; };
*** 275,280 ****
--- 278,291 ----
  #define SET_DECL_ORIGINAL_FIELD(NODE, X) \
    SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
  
+ /* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a
+    renaming pointer, otherwise 0.  Note that this object is guaranteed to
+    be protected against multiple evaluations.  */
+ #define DECL_RENAMED_OBJECT(NODE) \
+   GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
+ #define SET_DECL_RENAMED_OBJECT(NODE, X) \
+   SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
+ 
  /* In a FIELD_DECL corresponding to a discriminant, contains the
     discriminant number.  */
  #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
diff -Nrcpad gcc-4.0.2/gcc/ada/ada.ads gcc-4.1.0/gcc/ada/ada.ads
*** gcc-4.0.2/gcc/ada/ada.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/ada.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                                  A D A                                   --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                                  A D A                                   --
  --                                                                          --
***************
*** 14,19 ****
  ------------------------------------------------------------------------------
  
  package Ada is
! pragma Pure (Ada);
  
  end Ada;
--- 14,19 ----
  ------------------------------------------------------------------------------
  
  package Ada is
!    pragma Pure;
  
  end Ada;
diff -Nrcpad gcc-4.0.2/gcc/ada/ada.h gcc-4.1.0/gcc/ada/ada.h
*** gcc-4.0.2/gcc/ada/ada.h	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/ada.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/adadecode.c gcc-4.1.0/gcc/ada/adadecode.c
*** gcc-4.0.2/gcc/ada/adadecode.c	Mon Nov 24 16:38:39 2003
--- gcc-4.1.0/gcc/ada/adadecode.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/adadecode.h gcc-4.1.0/gcc/ada/adadecode.h
*** gcc-4.0.2/gcc/ada/adadecode.h	Fri Oct 24 13:02:42 2003
--- gcc-4.1.0/gcc/ada/adadecode.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/adaint.c gcc-4.1.0/gcc/ada/adaint.c
*** gcc-4.0.2/gcc/ada/adaint.c	Thu Feb 10 13:51:58 2005
--- gcc-4.1.0/gcc/ada/adaint.c	Tue Nov 15 13:52:31 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 52,57 ****
--- 52,59 ----
  
  #ifdef VMS
  #define _POSIX_EXIT 1
+ #define HOST_EXECUTABLE_SUFFIX ".exe"
+ #define HOST_OBJECT_SUFFIX ".obj"
  #endif
  
  #ifdef IN_RTS
***************
*** 87,92 ****
--- 89,96 ----
  #if OLD_MINGW
  #include <sys/wait.h>
  #endif
+ #elif defined (__vxworks) && defined (__RTP__)
+ #include <wait.h>
  #else
  #include <sys/wait.h>
  #endif
***************
*** 96,108 ****
  
  /* Header files and definitions for __gnat_set_file_time_name.  */
  
! #include <rms.h>
! #include <atrdef.h>
! #include <fibdef.h>
! #include <stsdef.h>
! #include <iodef.h>
  #include <errno.h>
! #include <descrip.h>
  #include <string.h>
  #include <unixlib.h>
  
--- 100,112 ----
  
  /* Header files and definitions for __gnat_set_file_time_name.  */
  
! #include <vms/rms.h>
! #include <vms/atrdef.h>
! #include <vms/fibdef.h>
! #include <vms/stsdef.h>
! #include <vms/iodef.h>
  #include <errno.h>
! #include <vms/descrip.h>
  #include <string.h>
  #include <unixlib.h>
  
*************** struct vstring
*** 191,196 ****
--- 195,207 ----
  #define DIR_SEPARATOR '/'
  #endif
  
+ /* Check for cross-compilation */
+ #ifdef CROSS_COMPILE
+ int __gnat_is_cross_compiler = 1;
+ #else
+ int __gnat_is_cross_compiler = 0;
+ #endif
+ 
  char __gnat_dir_separator = DIR_SEPARATOR;
  
  char __gnat_path_separator = PATH_SEPARATOR;
*************** const int __gnat_vmsp = 0;
*** 261,267 ****
--- 272,282 ----
  #include <sys/param.h>
  #endif
  
+ #ifdef MAXPATHLEN
  #define GNAT_MAX_PATH_LEN MAXPATHLEN
+ #else
+ #define GNAT_MAX_PATH_LEN 256
+ #endif
  
  #endif
  
*************** __gnat_set_env_value (char *name, char *
*** 1306,1312 ****
  	*next = 0;
  	ile_array[i].len = strlen (curr);
  
! 	/* Code 2 from lnmdef.h means its a string.  */
  	ile_array[i].code = 2;
  	ile_array[i].adr = curr;
  
--- 1321,1327 ----
  	*next = 0;
  	ile_array[i].len = strlen (curr);
  
! 	/* Code 2 from lnmdef.h means it's a string.  */
  	ile_array[i].code = 2;
  	ile_array[i].adr = curr;
  
*************** __gnat_set_env_value (char *name, char *
*** 1326,1331 ****
--- 1341,1349 ----
        LIB$SIGNAL (status);
    }
  
+ #elif defined (__vxworks) && defined (__RTP__)
+   setenv (name, value, 1);
+ 
  #else
    int size = strlen (name) + strlen (value) + 2;
    char *expression;
*************** __gnat_portable_spawn (char *args[])
*** 1577,1583 ****
    strcat (args[0], args_0);
    strcat (args[0], "\"");
  
!   status = spawnvp (P_WAIT, args_0, (char* const*)args);
  
    /* restore previous value */
    free (args[0]);
--- 1595,1601 ----
    strcat (args[0], args_0);
    strcat (args[0], "\"");
  
!   status = spawnvp (P_WAIT, args_0, (const char* const*)args);
  
    /* restore previous value */
    free (args[0]);
*************** __gnat_portable_spawn (char *args[])
*** 1632,1653 ****
  int
  __gnat_dup (int oldfd)
  {
! #if defined (__vxworks)
!    /* Not supported on VxWorks.  */
!    return -1;
  #else
!    return dup (oldfd);
  #endif
  }
  
  /* Make newfd be the copy of oldfd, closing newfd first if necessary.
!    Return -1 if an error occured.  */
  
  int
  __gnat_dup2 (int oldfd, int newfd)
  {
! #if defined (__vxworks)
!   /* Not supported on VxWorks.  */
    return -1;
  #else
    return dup2 (oldfd, newfd);
--- 1650,1673 ----
  int
  __gnat_dup (int oldfd)
  {
! #if defined (__vxworks) && !defined (__RTP__)
!   /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
!      RTPs. */
!   return -1;
  #else
!   return dup (oldfd);
  #endif
  }
  
  /* Make newfd be the copy of oldfd, closing newfd first if necessary.
!    Return -1 if an error occurred.  */
  
  int
  __gnat_dup2 (int oldfd, int newfd)
  {
! #if defined (__vxworks) && !defined (__RTP__)
!   /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
!      RTPs.  */
    return -1;
  #else
    return dup2 (oldfd, newfd);
*************** __gnat_portable_wait (int *process_statu
*** 1925,1947 ****
    return pid;
  }
  
- int
- __gnat_waitpid (int pid)
- {
-   int status = 0;
- 
- #if defined (_WIN32)
-   cwait (&status, pid, _WAIT_CHILD);
- #elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
-   /* Status is already zero, so nothing to do.  */
- #else
-   waitpid (pid, &status, 0);
-   status =  WEXITSTATUS (status);
- #endif
- 
-   return status;
- }
- 
  void
  __gnat_os_exit (int status)
  {
--- 1945,1950 ----
*************** char *
*** 1954,1966 ****
  __gnat_locate_regular_file (char *file_name, char *path_val)
  {
    char *ptr;
!   int absolute = __gnat_is_absolute_path (file_name, strlen (file_name));
  
    /* Handle absolute pathnames.  */
    if (absolute)
      {
!      if (__gnat_is_regular_file (file_name))
!        return xstrdup (file_name);
  
        return 0;
      }
--- 1957,1986 ----
  __gnat_locate_regular_file (char *file_name, char *path_val)
  {
    char *ptr;
!   char *file_path = alloca (strlen (file_name) + 1);
!   int absolute;
! 
!   /* Remove quotes around file_name if present */
! 
!   ptr = file_name;
!   if (*ptr == '"')
!     ptr++;
! 
!   strcpy (file_path, ptr);
! 
!   ptr = file_path + strlen (file_path) - 1;
! 
!   if (*ptr == '"')
!     *ptr = '\0';
  
    /* Handle absolute pathnames.  */
+ 
+   absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
+ 
    if (absolute)
      {
!      if (__gnat_is_regular_file (file_path))
!        return xstrdup (file_path);
  
        return 0;
      }
*************** __gnat_locate_regular_file (char *file_n
*** 1991,2000 ****
        if (*path_val == 0)
          return 0;
  
        for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
!         *ptr++ = *path_val++;
  
        ptr--;
        if (*ptr != '/' && *ptr != DIR_SEPARATOR)
          *++ptr = DIR_SEPARATOR;
  
--- 2011,2031 ----
        if (*path_val == 0)
          return 0;
  
+       /* Skip the starting quote */
+ 
+       if (*path_val == '"')
+ 	path_val++;
+ 
        for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
! 	*ptr++ = *path_val++;
  
        ptr--;
+ 
+       /* Skip the ending quote */
+ 
+       if (*ptr == '"')
+ 	ptr--;
+ 
        if (*ptr != '/' && *ptr != DIR_SEPARATOR)
          *++ptr = DIR_SEPARATOR;
  
*************** __gnat_locate_regular_file (char *file_n
*** 2015,2020 ****
--- 2046,2052 ----
  char *
  __gnat_locate_exec (char *exec_name, char *path_val)
  {
+   char *ptr;
    if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
      {
        char *full_exec_name
*************** __gnat_locate_exec (char *exec_name, cha
*** 2022,2028 ****
  
        strcpy (full_exec_name, exec_name);
        strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
!       return __gnat_locate_regular_file (full_exec_name, path_val);
      }
    else
      return __gnat_locate_regular_file (exec_name, path_val);
--- 2054,2064 ----
  
        strcpy (full_exec_name, exec_name);
        strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
!       ptr = __gnat_locate_regular_file (full_exec_name, path_val);
! 
!       if (ptr == 0)
!          return __gnat_locate_regular_file (exec_name, path_val);
!       return ptr;
      }
    else
      return __gnat_locate_regular_file (exec_name, path_val);
*************** __gnat_locate_exec_on_path (char *exec_n
*** 2041,2060 ****
  #endif
  #ifdef _WIN32
    /* In Win32 systems we expand the PATH as for XP environment
!      variables are not automatically expanded.  */
!   int len = strlen (path_val) * 3;
!   char *expanded_path_val = alloca (len + 1);
  
!   DWORD res = ExpandEnvironmentStrings (path_val, expanded_path_val, len);
  
!   if (res != 0)
!     {
!       path_val = expanded_path_val;
!     }
! #endif
  
    apath_val = alloca (strlen (path_val) + 1);
    strcpy (apath_val, path_val);
  
    return __gnat_locate_exec (exec_name, apath_val);
  }
--- 2077,2100 ----
  #endif
  #ifdef _WIN32
    /* In Win32 systems we expand the PATH as for XP environment
!      variables are not automatically expanded. We also prepend the
!      ".;" to the path to match normal NT path search semantics */
  
!   #define EXPAND_BUFFER_SIZE 32767
  
!   apath_val = alloca (EXPAND_BUFFER_SIZE);
! 
!   apath_val [0] = '.';
!   apath_val [1] = ';';
! 
!   DWORD res = ExpandEnvironmentStrings
!     (path_val, apath_val + 2, EXPAND_BUFFER_SIZE - 2);
  
+   if (!res) apath_val [0] = '\0';
+ #else
    apath_val = alloca (strlen (path_val) + 1);
    strcpy (apath_val, path_val);
+ #endif
  
    return __gnat_locate_exec (exec_name, apath_val);
  }
*************** __gnat_to_canonical_dir_spec (char *dirs
*** 2219,2236 ****
  }
  
  /* Translate a VMS syntax file specification into Unix syntax.
!    If no indicators of VMS syntax found, return input string.  */
  
  char *
  __gnat_to_canonical_file_spec (char *filespec)
  {
    strncpy (new_canonical_filespec, "", MAXPATH);
  
    if (strchr (filespec, ']') || strchr (filespec, ':'))
      {
!       strncpy (new_canonical_filespec,
! 	       (char *) decc$translate_vms (filespec),
! 	       MAXPATH);
      }
    else
      {
--- 2259,2291 ----
  }
  
  /* Translate a VMS syntax file specification into Unix syntax.
!    If no indicators of VMS syntax found, check if it's an uppercase
!    alphanumeric_ name and if so try it out as an environment
!    variable (logical name). If all else fails return the
!    input string.  */
  
  char *
  __gnat_to_canonical_file_spec (char *filespec)
  {
+   char *filespec1;
+ 
    strncpy (new_canonical_filespec, "", MAXPATH);
  
    if (strchr (filespec, ']') || strchr (filespec, ':'))
      {
!       char *tspec = (char *) decc$translate_vms (filespec);
! 
!       if (tspec != (char *) -1)
! 	strncpy (new_canonical_filespec, tspec, MAXPATH);
!     }
!   else if ((strlen (filespec) == strspn (filespec,
! 	    "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
! 	&& (filespec1 = getenv (filespec)))
!     {
!       char *tspec = (char *) decc$translate_vms (filespec1);
! 
!       if (tspec != (char *) -1)
! 	strncpy (new_canonical_filespec, tspec, MAXPATH);
      }
    else
      {
*************** _flush_cache()
*** 2487,2504 ****
  #endif
  
  #if defined (CROSS_COMPILE)  \
!   || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
!       && ! (defined (linux) && defined (i386)) \
        && ! defined (__FreeBSD__) \
        && ! defined (__hpux__) \
        && ! defined (_AIX) \
        && ! (defined (__alpha__)  && defined (__osf__)) \
        && ! defined (__MINGW32__) \
        && ! (defined (__mips) && defined (__sgi)))
  
! /* Dummy function to satisfy g-trasym.o.  Currently Solaris sparc, HP/UX,
!    GNU/Linux x86, Tru64 & Windows provide a non-dummy version of this
!    procedure in libaddr2line.a.  */
  
  void
  convert_addresses (void *addrs ATTRIBUTE_UNUSED,
--- 2542,2562 ----
  #endif
  
  #if defined (CROSS_COMPILE)  \
!   || (! ((defined (sparc) || defined (i386)) && defined (sun) \
!       && defined (__SVR4)) \
!       && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
!       && ! (defined (linux) && defined (__ia64__)) \
        && ! defined (__FreeBSD__) \
        && ! defined (__hpux__) \
+       && ! defined (__APPLE__) \
        && ! defined (_AIX) \
        && ! (defined (__alpha__)  && defined (__osf__)) \
        && ! defined (__MINGW32__) \
        && ! (defined (__mips) && defined (__sgi)))
  
! /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
!    just above for a list of native platforms that provide a non-dummy
!    version of this procedure in libaddr2line.a.  */
  
  void
  convert_addresses (void *addrs ATTRIBUTE_UNUSED,
*************** __gnat_copy_attribs (char *from, char *t
*** 2580,2606 ****
  #endif
  }
  
- /* This function is installed in libgcc.a.  */
- extern void __gnat_install_locks (void (*) (void), void (*) (void));
- 
- /* This function offers a hook for libgnarl to set the
-    locking subprograms for libgcc_eh.
-    This is only needed on OpenVMS, since other platforms use standard
-    --enable-threads=posix option, or similar.  */
- 
- void
- __gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
-                          void (*unlock) (void) ATTRIBUTE_UNUSED)
- {
- #if defined (IN_RTS) && defined (VMS)
-   __gnat_install_locks (lock, unlock);
-   /* There is a bootstrap path issue if adaint is build with this
-      symbol unresolved for the stage1 compiler. Since the compiler
-      does not use tasking, we simply make __gnatlib_install_locks
-      a no-op in this case. */
- #endif
- }
- 
  int
  __gnat_lseek (int fd, long offset, int whence)
  {
--- 2638,2643 ----
*************** get_gcc_version (void)
*** 2615,2621 ****
  }
  
  int
! __gnat_set_close_on_exec (int fd, int close_on_exec_p)
  {
  #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
    int flags = fcntl (fd, F_GETFD, 0);
--- 2652,2659 ----
  }
  
  int
! __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
!                         int close_on_exec_p ATTRIBUTE_UNUSED)
  {
  #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
    int flags = fcntl (fd, F_GETFD, 0);
*************** __gnat_set_close_on_exec (int fd, int cl
*** 2634,2636 ****
--- 2672,2698 ----
       as by default handles are *not* inherited. */
  #endif
  }
+ 
+ /* Indicates if platforms supports automatic initialization through the
+    constructor mechanism */
+ int
+ __gnat_binder_supports_auto_init ()
+ {
+ #ifdef VMS
+    return 0;
+ #else
+    return 1;
+ #endif
+ }
+ 
+ /* Indicates that Stand-Alone Libraries are automatically initialized through
+    the constructor mechanism */
+ int
+ __gnat_sals_init_using_constructors ()
+ {
+ #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
+    return 0;
+ #else
+    return 1;
+ #endif
+ }
diff -Nrcpad gcc-4.0.2/gcc/ada/adaint.h gcc-4.1.0/gcc/ada/adaint.h
*** gcc-4.0.2/gcc/ada/adaint.h	Thu Feb 10 13:51:58 2005
--- gcc-4.1.0/gcc/ada/adaint.h	Tue Nov 15 13:52:31 2005
***************
*** 6,12 ****
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-2005 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- *
--- 6,12 ----
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** extern int    __gnat_is_symbolic_link		 
*** 93,99 ****
  extern int    __gnat_portable_spawn                (char *[]);
  extern int    __gnat_portable_no_block_spawn       (char *[]);
  extern int    __gnat_portable_wait                 (int *);
- extern int    __gnat_waitpid			   (int);
  extern char  *__gnat_locate_exec                   (char *, char *);
  extern char  *__gnat_locate_exec_on_path	   (char *);
  extern char  *__gnat_locate_regular_file           (char *, char *);
--- 93,98 ----
*************** extern void   __gnat_plist_init         
*** 165,171 ****
  /* This function returns the version of GCC being used.  Here it's GCC 3.  */
  extern int get_gcc_version		     (void);
  
! /* This function offers a hook for libgnarl to set the
!    locking subprograms for libgcc_eh. */
! extern void __gnatlib_install_locks	     (void (*) (void),
! 					      void (*) (void));
--- 164,168 ----
  /* This function returns the version of GCC being used.  Here it's GCC 3.  */
  extern int get_gcc_version		     (void);
  
! extern int __gnat_binder_supports_auto_init (void);
! extern int __gnat_sals_init_using_constructors (void);
diff -Nrcpad gcc-4.0.2/gcc/ada/ali-util.adb gcc-4.1.0/gcc/ada/ali-util.adb
*** gcc-4.0.2/gcc/ada/ali-util.adb	Thu Feb 10 13:50:31 2005
--- gcc-4.1.0/gcc/ada/ali-util.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body ALI.Util is
*** 271,277 ****
                   Scan_ALI
                     (F         => Afile,
                      T         => Text,
!                     Ignore_ED => Force_RM_Elaboration_Order,
                      Err       => False);
  
                 Free (Text);
--- 271,277 ----
                   Scan_ALI
                     (F         => Afile,
                      T         => Text,
!                     Ignore_ED => False,
                      Err       => False);
  
                 Free (Text);
diff -Nrcpad gcc-4.0.2/gcc/ada/ali-util.ads gcc-4.1.0/gcc/ada/ali-util.ads
*** gcc-4.0.2/gcc/ada/ali-util.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/ali-util.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/ali.adb gcc-4.1.0/gcc/ada/ali.adb
*** gcc-4.0.2/gcc/ada/ali.adb	Thu Feb 10 13:50:28 2005
--- gcc-4.1.0/gcc/ada/ali.adb	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body ALI is
*** 208,213 ****
--- 208,223 ----
        function Nextc return Character;
        --  Return current character without modifying pointer P
  
+       procedure Get_Typeref
+         (Current_File_Num : Sdep_Id;
+          Ref             : out Tref_Kind;
+          File_Num        : out Sdep_Id;
+          Line            : out Nat;
+          Ref_Type        : out Character;
+          Col             : out Nat;
+          Standard_Entity : out Name_Id);
+       --  Parse the definition of a typeref (<...>, {...} or (...))
+ 
        procedure Skip_Eol;
        --  Skip past spaces, then skip past end of line (fatal error if not
        --  at end of line). Also skips past any following blank lines.
*************** package body ALI is
*** 439,444 ****
--- 449,455 ----
                   or else Nextc = '(' or else Nextc = ')'
                   or else Nextc = '{' or else Nextc = '}'
                   or else Nextc = '<' or else Nextc = '>'
+                  or else Nextc = '[' or else Nextc = ']'
                   or else Nextc = '=';
              end if;
           end loop;
*************** package body ALI is
*** 536,541 ****
--- 547,640 ----
           return T (P);
        end Nextc;
  
+       -----------------
+       -- Get_Typeref --
+       -----------------
+ 
+       procedure Get_Typeref
+         (Current_File_Num : Sdep_Id;
+          Ref              : out Tref_Kind;
+          File_Num         : out Sdep_Id;
+          Line             : out Nat;
+          Ref_Type         : out Character;
+          Col              : out Nat;
+          Standard_Entity  : out Name_Id)
+       is
+          N : Nat;
+       begin
+          case Nextc is
+             when '<'    => Ref := Tref_Derived;
+             when '('    => Ref := Tref_Access;
+             when '{'    => Ref := Tref_Type;
+             when others => Ref := Tref_None;
+          end case;
+ 
+          --  Case of typeref field present
+ 
+          if Ref /= Tref_None then
+             P := P + 1; -- skip opening bracket
+ 
+             if Nextc in 'a' .. 'z' then
+                File_Num        := No_Sdep_Id;
+                Line            := 0;
+                Ref_Type        := ' ';
+                Col             := 0;
+                Standard_Entity := Get_Name (Ignore_Spaces => True);
+             else
+                N := Get_Nat;
+ 
+                if Nextc = '|' then
+                   File_Num := Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
+                   P := P + 1;
+                   N := Get_Nat;
+                else
+                   File_Num := Current_File_Num;
+                end if;
+ 
+                Line            := N;
+                Ref_Type        := Getc;
+                Col             := Get_Nat;
+                Standard_Entity := No_Name;
+             end if;
+ 
+             --  ??? Temporary workaround for nested generics case:
+             --     4i4 Directories{1|4I9[4|6[3|3]]}
+             --  See C918-002
+ 
+             declare
+                Nested_Brackets : Natural := 0;
+ 
+             begin
+                loop
+                   case Nextc is
+                      when '['   =>
+                         Nested_Brackets := Nested_Brackets + 1;
+                      when ']' =>
+                         Nested_Brackets := Nested_Brackets - 1;
+                      when others =>
+                         if Nested_Brackets = 0 then
+                            exit;
+                         end if;
+                   end case;
+ 
+                   Skipc;
+                end loop;
+             end;
+ 
+             P := P + 1; -- skip closing bracket
+             Skip_Space;
+ 
+          --  No typeref entry present
+ 
+          else
+             File_Num        := No_Sdep_Id;
+             Line            := 0;
+             Ref_Type        := ' ';
+             Col             := 0;
+             Standard_Entity := No_Name;
+          end if;
+       end Get_Typeref;
+ 
        --------------
        -- Skip_Eol --
        --------------
*************** package body ALI is
*** 1457,1462 ****
--- 1556,1562 ----
                 Withs.Table (Withs.Last).Uname              := Get_Name;
                 Withs.Table (Withs.Last).Elaborate          := False;
                 Withs.Table (Withs.Last).Elaborate_All      := False;
+                Withs.Table (Withs.Last).Elab_Desirable     := False;
                 Withs.Table (Withs.Last).Elab_All_Desirable := False;
                 Withs.Table (Withs.Last).SAL_Interface      := False;
  
*************** package body ALI is
*** 1472,1483 ****
                    Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
                    Withs.Table (Withs.Last).Afile := Get_Name;
  
!                   --  Scan out possible E, EA, and NE parameters
  
                    while not At_Eol loop
                       Skip_Space;
  
!                      if Nextc = 'E' then
                          P := P + 1;
  
                          if At_End_Of_Field then
--- 1572,1595 ----
                    Withs.Table (Withs.Last).Sfile := Get_Name (Lower => True);
                    Withs.Table (Withs.Last).Afile := Get_Name;
  
!                   --  Scan out possible E, EA, ED, and AD parameters
  
                    while not At_Eol loop
                       Skip_Space;
  
!                      if Nextc = 'A' then
!                         P := P + 1;
!                         Checkc ('D');
!                         Check_At_End_Of_Field;
! 
!                         --  Store AD indication unless ignore required
! 
!                         if not Ignore_ED then
!                            Withs.Table (Withs.Last).Elab_All_Desirable :=
!                              True;
!                         end if;
! 
!                      elsif Nextc = 'E' then
                          P := P + 1;
  
                          if At_End_Of_Field then
*************** package body ALI is
*** 1495,1501 ****
                             --  Store ED indication unless ignore required
  
                             if not Ignore_ED then
!                               Withs.Table (Withs.Last).Elab_All_Desirable :=
                                  True;
                             end if;
                          end if;
--- 1607,1613 ----
                             --  Store ED indication unless ignore required
  
                             if not Ignore_ED then
!                               Withs.Table (Withs.Last).Elab_Desirable :=
                                  True;
                             end if;
                          end if;
*************** package body ALI is
*** 1886,1891 ****
--- 1998,2028 ----
                    XE.Lib    := (Getc = '*');
                    XE.Entity := Get_Name;
  
+                   --  Handle the information about generic instantiations
+ 
+                   if Nextc = '[' then
+                      Skipc; --  Opening '['
+                      N := Get_Nat;
+ 
+                      if Nextc /= '|' then
+                         XE.Iref_File_Num := Current_File_Num;
+                         XE.Iref_Line     := N;
+                      else
+                         XE.Iref_File_Num :=
+                           Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
+                         Skipc;
+                         XE.Iref_Line := Get_Nat;
+                      end if;
+ 
+                      if Getc /= ']' then
+                         Fatal_Error;
+                      end if;
+ 
+                   else
+                      XE.Iref_File_Num := No_Sdep_Id;
+                      XE.Iref_Line     := 0;
+                   end if;
+ 
                    Current_File_Num := XS.File_Num;
  
                    --  Renaming reference is present
*************** package body ALI is
*** 1911,1990 ****
  
                    --  See if type reference present
  
!                   case Nextc is
!                      when '<'    => XE.Tref := Tref_Derived;
!                      when '('    => XE.Tref := Tref_Access;
!                      when '{'    => XE.Tref := Tref_Type;
!                      when others => XE.Tref := Tref_None;
!                   end case;
! 
!                   --  Case of typeref field present
! 
!                   if XE.Tref /= Tref_None then
!                      P := P + 1; -- skip opening bracket
! 
!                      if Nextc in 'a' .. 'z' then
!                         XE.Tref_File_Num        := No_Sdep_Id;
!                         XE.Tref_Line            := 0;
!                         XE.Tref_Type            := ' ';
!                         XE.Tref_Col             := 0;
!                         XE.Tref_Standard_Entity :=
!                           Get_Name (Ignore_Spaces => True);
! 
!                      else
!                         N := Get_Nat;
! 
!                         if Nextc = '|' then
!                            XE.Tref_File_Num :=
!                              Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
!                            P := P + 1;
!                            N := Get_Nat;
! 
!                         else
!                            XE.Tref_File_Num := Current_File_Num;
!                         end if;
! 
!                         XE.Tref_Line            := N;
!                         XE.Tref_Type            := Getc;
!                         XE.Tref_Col             := Get_Nat;
!                         XE.Tref_Standard_Entity := No_Name;
!                      end if;
! 
!                      --  ??? Temporary workaround for nested generics case:
!                      --     4i4 Directories{1|4I9[4|6[3|3]]}
!                      --  See C918-002
  
                       declare
!                         Nested_Brackets : Natural := 0;
! 
                       begin
!                         loop
!                            case Nextc is
!                               when '['   =>
!                                  Nested_Brackets := Nested_Brackets + 1;
!                               when ']' =>
!                                  Nested_Brackets := Nested_Brackets - 1;
!                               when others =>
!                                  if Nested_Brackets = 0 then
!                                     exit;
!                                  end if;
!                            end case;
! 
!                            Skipc;
!                         end loop;
                       end;
- 
-                      P := P + 1; -- skip closing bracket
-                      Skip_Space;
- 
-                   --  No typeref entry present
- 
-                   else
-                      XE.Tref_File_Num        := No_Sdep_Id;
-                      XE.Tref_Line            := 0;
-                      XE.Tref_Type            := ' ';
-                      XE.Tref_Col             := 0;
-                      XE.Tref_Standard_Entity := No_Name;
                    end if;
  
                    XE.First_Xref := Xref.Last + 1;
--- 2048,2077 ----
  
                    --  See if type reference present
  
!                   Get_Typeref
!                     (Current_File_Num, XE.Tref, XE.Tref_File_Num, XE.Tref_Line,
!                      XE.Tref_Type, XE.Tref_Col, XE.Tref_Standard_Entity);
  
+                   --  Do we have an overriding procedure, instead ?
+                   if XE.Tref_Type = 'p' then
+                      XE.Oref_File_Num := XE.Tref_File_Num;
+                      XE.Oref_Line     := XE.Tref_Line;
+                      XE.Oref_Col      := XE.Tref_Col;
+                      XE.Tref_File_Num := No_Sdep_Id;
+                      XE.Tref          := Tref_None;
+                   else
+                      --  We might have additional information about the
+                      --  overloaded subprograms
                       declare
!                         Ref : Tref_Kind;
!                         Typ : Character;
!                         Standard_Entity : Name_Id;
                       begin
!                         Get_Typeref
!                           (Current_File_Num,
!                            Ref, XE.Oref_File_Num,
!                            XE.Oref_Line, Typ, XE.Oref_Col, Standard_Entity);
                       end;
                    end if;
  
                    XE.First_Xref := Xref.Last + 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/ali.ads gcc-4.1.0/gcc/ada/ali.ads
*** gcc-4.0.2/gcc/ada/ali.ads	Thu Feb 10 13:50:31 2005
--- gcc-4.1.0/gcc/ada/ali.ads	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package ALI is
*** 473,478 ****
--- 473,481 ----
        --  Indicates presence of EA parameter
  
        Elab_All_Desirable : Boolean;
+       --  Indicates presence of AD parameter
+ 
+       Elab_Desirable     : Boolean;
        --  Indicates presence of ED parameter
  
        SAL_Interface : Boolean := False;
*************** package ALI is
*** 590,599 ****
  
     type No_Dep_Record is record
        ALI_File : ALI_Id;
!       --  ALI File containing tne entry
  
        No_Dep_Unit : Name_Id;
!       --  Id for names table entry including entire name, including periods.
     end record;
  
     package No_Deps is new Table.Table (
--- 593,602 ----
  
     type No_Dep_Record is record
        ALI_File : ALI_Id;
!       --  ALI File containing the entry
  
        No_Dep_Unit : Name_Id;
!       --  Id for names table entry including entire name, including periods
     end record;
  
     package No_Deps is new Table.Table (
*************** package ALI is
*** 731,736 ****
--- 734,749 ----
        Entity : Name_Id;
        --  Name of entity
  
+       Iref_File_Num : Sdep_Id;
+       --  This field is set to the dependency reference for the file containing
+       --  the generic entity that this one instantiates, or to No_Sdep_Id if
+       --  the current entity is not an instantiation
+ 
+       Iref_Line : Nat;
+       --  This field is set to the line number in Iref_File_Num of the generic
+       --  entity that this one instantiates, or to zero if the current entity
+       --  is not an instantiation.
+ 
        Rref_Line : Nat;
        --  This field is set to the line number of a renaming reference if
        --  one is present, or to zero if no renaming reference is present
*************** package ALI is
*** 772,777 ****
--- 785,800 ----
        --  entity in package Standard, then this field is a Name_Id
        --  reference for the entity name.
  
+       Oref_File_Num : Sdep_Id;
+       --  This field is set to No_Sdep_Id is the entity doesn't override any
+       --  other entity, or to the dependency reference for the overriden
+       --  entity.
+ 
+       Oref_Line : Nat;
+       Oref_Col  : Nat;
+       --  These two fields are set to the line and column of the overriden
+       --  entity.
+ 
        First_Xref : Nat;
        --  Index into Xref table of first cross-reference
  
*************** package ALI is
*** 815,820 ****
--- 838,848 ----
  
        --  Note: for instantiation references, Rtype is set to ' ', and Col is
        --  set to zero. One or more such entries can follow any other reference.
+       --  When there is more than one such entry, this is to be read as:
+       --     e.g. ref1  ref2  ref3
+       --     ref1 is a reference to an entity that was instantied at ref2.
+       --     ref2 itself is also the result of an instantiation, that took
+       --     place at ref3
     end record;
  
     package Xref is new Table.Table (
*************** package ALI is
*** 847,854 ****
     --  switch description settings.
     --
     --    Ignore_ED is normally False. If set to True, it indicates that
!    --    all ED (elaboration desirable) indications in the ALI file are
!    --    to be ignored.
     --
     --    Err determines the action taken on an incorrectly formatted file.
     --    If Err is False, then an error message is output, and the program
--- 875,883 ----
     --  switch description settings.
     --
     --    Ignore_ED is normally False. If set to True, it indicates that
!    --    all AD/ED (elaboration desirable) indications in the ALI file are
!    --    to be ignored. This parameter is obsolete now that the -f switch
!    --    is removed from gnatbind, and should be removed ???
     --
     --    Err determines the action taken on an incorrectly formatted file.
     --    If Err is False, then an error message is output, and the program
diff -Nrcpad gcc-4.0.2/gcc/ada/alloc.ads gcc-4.1.0/gcc/ada/alloc.ads
*** gcc-4.0.2/gcc/ada/alloc.ads	Thu Apr 24 17:53:57 2003
--- gcc-4.1.0/gcc/ada/alloc.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/argv.c gcc-4.1.0/gcc/ada/argv.c
*** gcc-4.0.2/gcc/ada/argv.c	Tue Nov  4 12:51:45 2003
--- gcc-4.1.0/gcc/ada/argv.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/atree.adb gcc-4.1.0/gcc/ada/atree.adb
*** gcc-4.0.2/gcc/ada/atree.adb	Thu Feb 10 13:50:41 2005
--- gcc-4.1.0/gcc/ada/atree.adb	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Atree is
*** 1169,1175 ****
  
        function Copy_Elist_With_Replacement
          (Old_Elist : Elist_Id) return Elist_Id;
!       --  Called during second phase to copy element list doing replacements.
  
        procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
        --  Called during the second phase to process a copied Itype. The actual
--- 1169,1175 ----
  
        function Copy_Elist_With_Replacement
          (Old_Elist : Elist_Id) return Elist_Id;
!       --  Called during second phase to copy element list doing replacements
  
        procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
        --  Called during the second phase to process a copied Itype. The actual
*************** package body Atree is
*** 1178,1184 ****
        --  the copied Itype and copy them where necessary.
  
        function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
!       --  Called during second phase to copy list doing replacements.
  
        function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
        --  Called during second phase to copy node doing replacements
--- 1178,1184 ----
        --  the copied Itype and copy them where necessary.
  
        function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
!       --  Called during second phase to copy list doing replacements
  
        function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
        --  Called during second phase to copy node doing replacements
*************** package body Atree is
*** 1775,1781 ****
              Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
  
           elsif Has_Discriminants (Base_Type (Old_Itype)) then
!             --  ??? This should involve call to Visit_Field.
              Visit_Elist (Discriminant_Constraint (Old_Itype));
  
           elsif Is_Array_Type (Old_Itype) then
--- 1775,1781 ----
              Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
  
           elsif Has_Discriminants (Base_Type (Old_Itype)) then
!             --  ??? This should involve call to Visit_Field
              Visit_Elist (Discriminant_Constraint (Old_Itype));
  
           elsif Is_Array_Type (Old_Itype) then
*************** package body Atree is
*** 2886,2947 ****
        end List14;
  
        function Elist2 (N : Node_Id) return Elist_Id is
        begin
!          return Elist_Id (Nodes.Table (N).Field2);
        end Elist2;
  
        function Elist3 (N : Node_Id) return Elist_Id is
        begin
!          return Elist_Id (Nodes.Table (N).Field3);
        end Elist3;
  
        function Elist4 (N : Node_Id) return Elist_Id is
        begin
!          return Elist_Id (Nodes.Table (N).Field4);
        end Elist4;
  
        function Elist8 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 1).Field8);
        end Elist8;
  
        function Elist13 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 2).Field6);
        end Elist13;
  
        function Elist15 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 2).Field8);
        end Elist15;
  
        function Elist16 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 2).Field9);
        end Elist16;
  
        function Elist18 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 2).Field11);
        end Elist18;
  
        function Elist21 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 3).Field8);
        end Elist21;
  
        function Elist23 (N : Node_Id) return Elist_Id is
-       begin
           pragma Assert (Nkind (N) in N_Entity);
!          return Elist_Id (Nodes.Table (N + 3).Field10);
        end Elist23;
  
        function Name1 (N : Node_Id) return Name_Id is
        begin
           pragma Assert (N in Nodes.First .. Nodes.Last);
--- 2886,3011 ----
        end List14;
  
        function Elist2 (N : Node_Id) return Elist_Id is
+          pragma Assert (N in Nodes.First .. Nodes.Last);
+          Value : constant Union_Id := Nodes.Table (N).Field2;
        begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist2;
  
        function Elist3 (N : Node_Id) return Elist_Id is
+          pragma Assert (N in Nodes.First .. Nodes.Last);
+          Value : constant Union_Id := Nodes.Table (N).Field3;
        begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist3;
  
        function Elist4 (N : Node_Id) return Elist_Id is
+          pragma Assert (N in Nodes.First .. Nodes.Last);
+          Value : constant Union_Id := Nodes.Table (N).Field4;
        begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist4;
  
        function Elist8 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 1).Field8;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist8;
  
        function Elist13 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 2).Field6;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist13;
  
        function Elist15 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 2).Field8;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist15;
  
        function Elist16 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 2).Field9;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist16;
  
        function Elist18 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 2).Field11;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist18;
  
        function Elist21 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 3).Field8;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist21;
  
        function Elist23 (N : Node_Id) return Elist_Id is
           pragma Assert (Nkind (N) in N_Entity);
!          Value : constant Union_Id := Nodes.Table (N + 3).Field10;
!       begin
!          if Value = 0 then
!             return No_Elist;
!          else
!             return Elist_Id (Value);
!          end if;
        end Elist23;
  
+       function Elist24 (N : Node_Id) return Elist_Id is
+          pragma Assert (Nkind (N) in N_Entity);
+          Value : constant Union_Id := Nodes.Table (N + 4).Field6;
+       begin
+          if Value = 0 then
+             return No_Elist;
+          else
+             return Elist_Id (Value);
+          end if;
+       end Elist24;
+ 
        function Name1 (N : Node_Id) return Name_Id is
        begin
           pragma Assert (N in Nodes.First .. Nodes.Last);
*************** package body Atree is
*** 3007,3013 ****
        function Uint8 (N : Node_Id) return Uint is
           pragma Assert (Nkind (N) in N_Entity);
           U : constant Union_Id := Nodes.Table (N + 1).Field8;
- 
        begin
           if U = 0 then
              return Uint_0;
--- 3071,3076 ----
*************** package body Atree is
*** 4845,4850 ****
--- 4908,4919 ----
           Nodes.Table (N + 3).Field10 := Union_Id (Val);
        end Set_Elist23;
  
+       procedure Set_Elist24 (N : Node_Id; Val : Elist_Id) is
+       begin
+          pragma Assert (Nkind (N) in N_Entity);
+          Nodes.Table (N + 4).Field6 := Union_Id (Val);
+       end Set_Elist24;
+ 
        procedure Set_Name1 (N : Node_Id; Val : Name_Id) is
        begin
           pragma Assert (N in Nodes.First .. Nodes.Last);
diff -Nrcpad gcc-4.0.2/gcc/ada/atree.ads gcc-4.1.0/gcc/ada/atree.ads
*** gcc-4.0.2/gcc/ada/atree.ads	Thu Feb 10 13:50:42 2005
--- gcc-4.1.0/gcc/ada/atree.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Atree is
*** 75,136 ****
     --  a node contains a number of fields, much as though the nodes were
     --  defined as a record type. The fields in a node are as follows:
  
!    --   Nkind            Indicates the kind of the node. This field is present
!    --                    in all nodes. The type is Node_Kind, which is declared
!    --                    in the package Sinfo.
  
!    --   Sloc             Location (Source_Ptr) of the corresponding token
!    --                    in the Source buffer. The individual node definitions
!    --                    show which token is referenced by this pointer.
  
!    --   In_List          A flag used to indicate if the node is a member
     --                    of a node list.
  
!    --   Rewrite_Sub      A flag set if the node has been rewritten using
!    --                    the Rewrite procedure. The original value of the
!    --                    node is retrievable with Original_Node.
  
!    --   Rewrite_Ins      A flag set if a node is marked as a rewrite inserted
!    --                    node as a result of a call to Mark_Rewrite_Insertion.
  
!    --   Paren_Count      A 2-bit count used on expression nodes to indicate
!    --                    the level of parentheses. Up to 3 levels can be
!    --                    accomodated. Anything more than 3 levels is treated
!    --                    as 3 levels (conformance tests that complain about
!    --                    this are hereby deemed pathological!) Set to zero
!    --                    for non-subexpression nodes.
  
     --   Comes_From_Source
!    --                    This flag is present in all nodes. It is set if the
!    --                    node is built by the scanner or parser, and clear if
!    --                    the node is built by the analyzer or expander. It
!    --                    indicates that the node corresponds to a construct
!    --                    that appears in the original source program.
  
!    --   Analyzed         This flag is present in all nodes. It is set when
!    --                    a node is analyzed, and is used to avoid analyzing
!    --                    the same node twice. Analysis includes expansion if
!    --                    expansion is active, so in this case if the flag is
!    --                    set it means the node has been analyzed and expanded.
  
!    --   Error_Posted     This flag is present in all nodes. It is set when
!    --                    an error message is posted which is associated with
!    --                    the flagged node. This is used to avoid posting more
!    --                    than one message on the same node.
  
     --   Field1
     --   Field2
     --   Field3
     --   Field4
!    --   Field5           Five fields holding Union_Id values
  
!    --   ElistN           Synonym for FieldN typed as Elist_Id
!    --   ListN            Synonym for FieldN typed as List_Id
!    --   NameN            Synonym for FieldN typed as Name_Id
!    --   NodeN            Synonym for FieldN typed as Node_Id
!    --   StrN             Synonym for FieldN typed as String_Id
!    --   UintN            Synonym for FieldN typed as Uint (Empty = Uint_0)
!    --   UrealN           Synonym for FieldN typed as Ureal
  
     --   Note: the actual usage of FieldN (i.e. whether it contains a Elist_Id,
     --   List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal), depends on the
--- 75,147 ----
     --  a node contains a number of fields, much as though the nodes were
     --  defined as a record type. The fields in a node are as follows:
  
!    --   Nkind         Indicates the kind of the node. This field is present
!    --                 in all nodes. The type is Node_Kind, which is declared
!    --                 in the package Sinfo.
  
!    --   Sloc          Location (Source_Ptr) of the corresponding token
!    --                 in the Source buffer. The individual node definitions
!    --                 show which token is referenced by this pointer.
  
!    --   In_List       A flag used to indicate if the node is a member
     --                    of a node list.
  
!    --   Rewrite_Sub   A flag set if the node has been rewritten using
!    --                 the Rewrite procedure. The original value of the
!    --                 node is retrievable with Original_Node.
  
!    --   Rewrite_Ins   A flag set if a node is marked as a rewrite inserted
!    --                 node as a result of a call to Mark_Rewrite_Insertion.
  
!    --   Paren_Count   A 2-bit count used on expression nodes to indicate
!    --                 the level of parentheses. Up to 3 levels can be
!    --                 accomodated. Anything more than 3 levels is treated
!    --                 as 3 levels (conformance tests that complain about
!    --                 this are hereby deemed pathological!) Set to zero
!    --                 for non-subexpression nodes.
  
     --   Comes_From_Source
!    --                 This flag is present in all nodes. It is set if the
!    --                 node is built by the scanner or parser, and clear if
!    --                 the node is built by the analyzer or expander. It
!    --                 indicates that the node corresponds to a construct
!    --                 that appears in the original source program.
  
!    --   Analyzed      This flag is present in all nodes. It is set when
!    --                 a node is analyzed, and is used to avoid analyzing
!    --                 the same node twice. Analysis includes expansion if
!    --                 expansion is active, so in this case if the flag is
!    --                 set it means the node has been analyzed and expanded.
  
!    --   Error_Posted  This flag is present in all nodes. It is set when
!    --                 an error message is posted which is associated with
!    --                 the flagged node. This is used to avoid posting more
!    --                 than one message on the same node.
  
     --   Field1
     --   Field2
     --   Field3
     --   Field4
!    --   Field5        Five fields holding Union_Id values
  
!    --   ElistN        Synonym for FieldN typed as Elist_Id (Empty = No_Elist)
!    --   ListN         Synonym for FieldN typed as List_Id
!    --   NameN         Synonym for FieldN typed as Name_Id
!    --   NodeN         Synonym for FieldN typed as Node_Id
!    --   StrN          Synonym for FieldN typed as String_Id
!    --   UintN         Synonym for FieldN typed as Uint (Empty = Uint_0)
!    --   UrealN        Synonym for FieldN typed as Ureal
! 
!    --   Note: in the case of ElistN and UintN fields, it is common that we
!    --   end up with a value of Union_Id'(0) as the default value. This value
!    --   is meaningless as a Uint or Elist_Id value. We have two choices here.
!    --   We could require that all Uint and Elist fields be initialized to an
!    --   appropriate value, but that's error prone, since it would be easy to
!    --   miss an initialization. So instead we have the retrieval functions
!    --   generate an appropriate default value (Uint_0 or No_Elist). Probably
!    --   it would be cleaner to generate No_Uint in the Uint case but we got
!    --   stuck with representing an "unset" size value as zero early on, and
!    --   it will take a bit of fiddling to change that ???
  
     --   Note: the actual usage of FieldN (i.e. whether it contains a Elist_Id,
     --   List_Id, Name_Id, Node_Id, String_Id, Uint or Ureal), depends on the
*************** package Atree is
*** 146,191 ****
     --   it is useful to be able to do untyped traversals, and an internal
     --   package in Atree allows for direct untyped accesses in such cases.
  
!    --   Flag4            Fifteen Boolean flags (use depends on Nkind and
!    --   Flag5            Ekind, as described for FieldN). Again the access
!    --   Flag6            is usually via subprograms in Sinfo and Einfo which
!    --   Flag7            provide high-level synonyms for these flags, and
!    --   Flag8            contain debugging code that checks that the values
!    --   Flag9            in Nkind and Ekind are appropriate for the access.
     --   Flag10
!    --   Flag11           Note that Flag1-3 are missing from this list. The
!    --   Flag12           first three flag positions are reserved for the
!    --   Flag13           standard flags (Comes_From_Source, Error_Posted,
!    --   Flag14           and Analyzed)
     --   Flag15
     --   Flag16
     --   Flag17
     --   Flag18
  
!    --   Link             For a node, points to the Parent. For a list, points
!    --                    to the list header. Note that in the latter case, a
!    --                    client cannot modify the link field. This field is
!    --                    private to the Atree package (but is also modified
!    --                    by the Nlists package).
  
     --  The following additional fields are present in extended nodes used
     --  for entities (Nkind in N_Entity).
  
!    --   Ekind            Entity type. This field indicates the type of the
!    --                    entity, it is of type Entity_Kind which is defined
!    --                    in package Einfo.
  
!    --   Flag19           197 additional flags
     --   ...
     --   Flag215
  
!    --   Convention       Entity convention (Convention_Id value)
  
!    --   Field6           Additional Union_Id value stored in tree
  
!    --   Node6            Synonym for Field6 typed as Node_Id
!    --   Elist6           Synonym for Field6 typed as Elist_Id
!    --   Uint6            Synonym for Field6 typed as Uint (Empty = Uint_0)
  
     --   Similar definitions for Field7 to Field27 (and Node7-Node27,
     --   Elist7-Elist27, Uint7-Uint27, Ureal7-Ureal27). Note that not all
--- 157,202 ----
     --   it is useful to be able to do untyped traversals, and an internal
     --   package in Atree allows for direct untyped accesses in such cases.
  
!    --   Flag4         Fifteen Boolean flags (use depends on Nkind and
!    --   Flag5         Ekind, as described for FieldN). Again the access
!    --   Flag6         is usually via subprograms in Sinfo and Einfo which
!    --   Flag7         provide high-level synonyms for these flags, and
!    --   Flag8         contain debugging code that checks that the values
!    --   Flag9         in Nkind and Ekind are appropriate for the access.
     --   Flag10
!    --   Flag11        Note that Flag1-3 are missing from this list. The
!    --   Flag12        first three flag positions are reserved for the
!    --   Flag13        standard flags (Comes_From_Source, Error_Posted,
!    --   Flag14        and Analyzed)
     --   Flag15
     --   Flag16
     --   Flag17
     --   Flag18
  
!    --   Link          For a node, points to the Parent. For a list, points
!    --                 to the list header. Note that in the latter case, a
!    --                 client cannot modify the link field. This field is
!    --                 private to the Atree package (but is also modified
!    --                 by the Nlists package).
  
     --  The following additional fields are present in extended nodes used
     --  for entities (Nkind in N_Entity).
  
!    --   Ekind         Entity type. This field indicates the type of the
!    --                 entity, it is of type Entity_Kind which is defined
!    --                 in package Einfo.
  
!    --   Flag19        197 additional flags
     --   ...
     --   Flag215
  
!    --   Convention    Entity convention (Convention_Id value)
  
!    --   Field6        Additional Union_Id value stored in tree
  
!    --   Node6         Synonym for Field6 typed as Node_Id
!    --   Elist6        Synonym for Field6 typed as Elist_Id (Empty = No_Elist)
!    --   Uint6         Synonym for Field6 typed as Uint (Empty = Uint_0)
  
     --   Similar definitions for Field7 to Field27 (and Node7-Node27,
     --   Elist7-Elist27, Uint7-Uint27, Ureal7-Ureal27). Note that not all
*************** package Atree is
*** 981,986 ****
--- 992,1000 ----
        function Elist23 (N : Node_Id) return Elist_Id;
        pragma Inline (Elist23);
  
+       function Elist24 (N : Node_Id) return Elist_Id;
+       pragma Inline (Elist24);
+ 
        function Name1 (N : Node_Id) return Name_Id;
        pragma Inline (Name1);
  
*************** package Atree is
*** 1903,1908 ****
--- 1917,1925 ----
        procedure Set_Elist23 (N : Node_Id; Val : Elist_Id);
        pragma Inline (Set_Elist23);
  
+       procedure Set_Elist24 (N : Node_Id; Val : Elist_Id);
+       pragma Inline (Set_Elist24);
+ 
        procedure Set_Name1 (N : Node_Id; Val : Name_Id);
        pragma Inline (Set_Name1);
  
*************** package Atree is
*** 2602,2608 ****
        procedure Set_Flag215 (N : Node_Id; Val : Boolean);
        pragma Inline (Set_Flag215);
  
- 
        --  The following versions of Set_Noden also set the parent
        --  pointer of the referenced node if it is non_Empty
  
--- 2619,2624 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/atree.h gcc-4.1.0/gcc/ada/atree.h
*** gcc-4.0.2/gcc/ada/atree.h	Thu Feb 10 13:50:42 2005
--- gcc-4.1.0/gcc/ada/atree.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
*************** extern Node_Id Current_Error_Node;
*** 381,387 ****
  #define Field24(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6)
  #define Field25(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7)
  #define Field26(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8)
! #define Field27(N)    (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.field9)
  
  #define Node1(N)      Field1  (N)
  #define Node2(N)      Field2  (N)
--- 381,387 ----
  #define Field24(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field6)
  #define Field25(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field7)
  #define Field26(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field8)
! #define Field27(N)    (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.field9)
  
  #define Node1(N)      Field1  (N)
  #define Node2(N)      Field2  (N)
*************** extern Node_Id Current_Error_Node;
*** 425,433 ****
--- 425,435 ----
  #define Elist8(N)     Field8  (N)
  #define Elist13(N)    Field13 (N)
  #define Elist15(N)    Field15 (N)
+ #define Elist16(N)    Field16 (N)
  #define Elist18(N)    Field18 (N)
  #define Elist21(N)    Field21 (N)
  #define Elist23(N)    Field23 (N)
+ #define Elist24(N)    Field24 (N)
  
  #define Name1(N)      Field1  (N)
  #define Name2(N)      Field2  (N)
diff -Nrcpad gcc-4.0.2/gcc/ada/aux-io.c gcc-4.1.0/gcc/ada/aux-io.c
*** gcc-4.0.2/gcc/ada/aux-io.c	Tue Nov  4 12:51:45 2003
--- gcc-4.1.0/gcc/ada/aux-io.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/back_end.adb gcc-4.1.0/gcc/ada/back_end.adb
*** gcc-4.0.2/gcc/ada/back_end.adb	Wed Dec  8 11:25:14 2004
--- gcc-4.1.0/gcc/ada/back_end.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Elists;    use Elists;
*** 30,36 ****
  with Lib;       use Lib;
  with Osint;     use Osint;
  with Opt;       use Opt;
- with Osint;     use Osint;
  with Osint.C;   use Osint.C;
  with Namet;     use Namet;
  with Nlists;    use Nlists;
--- 30,35 ----
*************** package body Back_End is
*** 142,148 ****
        type Arg_Array is array (Nat) of BSP;
        type Arg_Array_Ptr is access Arg_Array;
  
!       --  Import flag_stack_check from toplev.c.
  
        flag_stack_check : Int;
        pragma Import (C, flag_stack_check); -- Import from toplev.c
--- 141,147 ----
        type Arg_Array is array (Nat) of BSP;
        type Arg_Array_Ptr is access Arg_Array;
  
!       --  Import flag_stack_check from toplev.c
  
        flag_stack_check : Int;
        pragma Import (C, flag_stack_check); -- Import from toplev.c
diff -Nrcpad gcc-4.0.2/gcc/ada/back_end.ads gcc-4.1.0/gcc/ada/back_end.ads
*** gcc-4.0.2/gcc/ada/back_end.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/back_end.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/bcheck.adb gcc-4.1.0/gcc/ada/bcheck.adb
*** gcc-4.0.2/gcc/ada/bcheck.adb	Mon Jan  3 15:32:16 2005
--- gcc-4.1.0/gcc/ada/bcheck.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/bcheck.ads gcc-4.1.0/gcc/ada/bcheck.ads
*** gcc-4.0.2/gcc/ada/bcheck.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/bcheck.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/binde.adb gcc-4.1.0/gcc/ada/binde.adb
*** gcc-4.0.2/gcc/ada/binde.adb	Thu Feb 10 13:50:31 2005
--- gcc-4.1.0/gcc/ada/binde.adb	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,37 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Binderr; use Binderr;
! with Butil;   use Butil;
! with Debug;   use Debug;
! with Fname;   use Fname;
! with Lib;     use Lib;
! with Namet;   use Namet;
! with Opt;     use Opt;
! with Output;  use Output;
  
  package body Binde is
  
--- 16,38 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Binderr;  use Binderr;
! with Butil;    use Butil;
! with Debug;    use Debug;
! with Fname;    use Fname;
! with Lib;      use Lib;
! with Namet;    use Namet;
! with Opt;      use Opt;
! with Output;   use Output;
! with Targparm; use Targparm;
  
  package body Binde is
  
*************** package body Binde is
*** 71,81 ****
        --  elaborated before unit X is elaborated. The Elab_All_Link list
        --  traces the dependencies in the latter case.
  
!       Elab_Desirable,
        --  This is just like Elab_All, except that the elaborate all was not
        --  explicitly present in the source, but rather was created by the
        --  front end, which decided that it was "desirable".
  
        Spec_First);
        --  After is a body, and Before is the corresponding spec
  
--- 72,87 ----
        --  elaborated before unit X is elaborated. The Elab_All_Link list
        --  traces the dependencies in the latter case.
  
!       Elab_All_Desirable,
        --  This is just like Elab_All, except that the elaborate all was not
        --  explicitly present in the source, but rather was created by the
        --  front end, which decided that it was "desirable".
  
+       Elab_Desirable,
+       --  This is just like Elab, except that the elaborate was not
+       --  explicitly present in the source, but rather was created by the
+       --  front end, which decided that it was "desirable".
+ 
        Spec_First);
        --  After is a body, and Before is the corresponding spec
  
*************** package body Binde is
*** 248,254 ****
        Link   : Elab_All_Id);
     --  Used to compute the transitive closure of elaboration links for an
     --  Elaborate_All pragma (Reason = Elab_All) or for an indication of
!    --  Elaborate_All_Desirable (Reason = Elab_Desirable). Unit After has
     --  a pragma Elaborate_All or the front end has determined that a reference
     --  probably requires Elaborate_All is required, and unit Before must be
     --  previously elaborated. First a link is built making sure that unit
--- 254,260 ----
        Link   : Elab_All_Id);
     --  Used to compute the transitive closure of elaboration links for an
     --  Elaborate_All pragma (Reason = Elab_All) or for an indication of
!    --  Elaborate_All_Desirable (Reason = Elab_All_Desirable). Unit After has
     --  a pragma Elaborate_All or the front end has determined that a reference
     --  probably requires Elaborate_All is required, and unit Before must be
     --  previously elaborated. First a link is built making sure that unit
*************** package body Binde is
*** 267,275 ****
  
     function Make_Elab_Entry
       (Unam : Unit_Name_Type;
!       Link : Elab_All_Id)
!       return Elab_All_Id;
!    --  Make an Elab_All_Entries table entry with the given Unam and Link.
  
     function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id;
     --  This function uses the Info field set in the names table to obtain
--- 273,280 ----
  
     function Make_Elab_Entry
       (Unam : Unit_Name_Type;
!       Link : Elab_All_Id) return Elab_All_Id;
!    --  Make an Elab_All_Entries table entry with the given Unam and Link
  
     function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id;
     --  This function uses the Info field set in the names table to obtain
*************** package body Binde is
*** 480,486 ****
        --  if it becomes zero, then add to no predecessor list.
  
        S := UNR.Table (Chosen).Successors;
- 
        while S /= No_Successor loop
           U := Succ.Table (S).After;
           UNR.Table (U).Num_Pred := UNR.Table (U).Num_Pred - 1;
--- 485,490 ----
*************** package body Binde is
*** 738,744 ****
        --  and we should have found and eliminated at least one bad path.
  
        raise Program_Error;
- 
     end Diagnose_Elaboration_Problem;
  
     --------------------
--- 742,747 ----
*************** package body Binde is
*** 801,809 ****
        SL : Successor_Link renames Succ.Table (S);
  
     begin
!       --  Nothing to do if internal unit involved and no -de flag
  
!       if not Debug_Flag_E
          and then
            (Is_Internal_File_Name (Units.Table (SL.Before).Sfile)
              or else
--- 804,812 ----
        SL : Successor_Link renames Succ.Table (S);
  
     begin
!       --  Nothing to do if internal unit involved and no -da flag
  
!       if not Debug_Flag_A
          and then
            (Is_Internal_File_Name (Units.Table (SL.Before).Sfile)
              or else
*************** package body Binde is
*** 842,848 ****
                ("     reason: pragma Elaborate_All in unit &",
                 Info => True);
  
!          when Elab_Desirable =>
              Error_Msg_Output
                ("     reason: implicit Elaborate_All in unit &",
                 Info => True);
--- 845,851 ----
                ("     reason: pragma Elaborate_All in unit &",
                 Info => True);
  
!          when Elab_All_Desirable =>
              Error_Msg_Output
                ("     reason: implicit Elaborate_All in unit &",
                 Info => True);
*************** package body Binde is
*** 851,856 ****
--- 854,868 ----
                ("     recompile & with -gnatwl for full details",
                 Info => True);
  
+          when Elab_Desirable =>
+             Error_Msg_Output
+               ("     reason: implicit Elaborate in unit &",
+                Info => True);
+ 
+             Error_Msg_Output
+               ("     recompile & with -gnatwl for full details",
+                Info => True);
+ 
           when Spec_First =>
              Error_Msg_Output
                ("     reason: spec always elaborated before body",
*************** package body Binde is
*** 898,903 ****
--- 910,929 ----
           UNR.Table (UNR.Last).Elab_Position := 0;
        end loop;
  
+       --  Output warning if -p used with no -gnatE units
+ 
+       if Pessimistic_Elab_Order
+         and not Dynamic_Elaboration_Checks_Specified
+       then
+          if OpenVMS_On_Target then
+             Error_Msg ("?use of /PESSIMISTIC_ELABORATION questionable");
+          else
+             Error_Msg ("?use of -p switch questionable");
+          end if;
+ 
+          Error_Msg ("?since all units compiled with static elaboration model");
+       end if;
+ 
        --  Gather dependencies and output them if option set
  
        Gather_Dependencies;
*************** package body Binde is
*** 924,929 ****
--- 950,956 ----
        --  nodes have been chosen.
  
        Outer : loop
+ 
           --  If there are no nodes with predecessors, then either we are
           --  done, as indicated by Num_Left being set to zero, or we have
           --  a circularity. In the latter case, diagnose the circularity,
*************** package body Binde is
*** 1078,1084 ****
                       --  Now establish all the links we need
  
                       Elab_All_Links
!                        (Withed_Unit, U, Elab_Desirable,
                          Make_Elab_Entry
                            (Withs.Table (W).Uname, No_Elab_All_Link));
  
--- 1105,1111 ----
                       --  Now establish all the links we need
  
                       Elab_All_Links
!                        (Withed_Unit, U, Elab_All_Desirable,
                          Make_Elab_Entry
                            (Withs.Table (W).Uname, No_Elab_All_Link));
  
*************** package body Binde is
*** 1102,1107 ****
--- 1129,1146 ----
                            (Corresponding_Body (Withed_Unit), U, Elab);
                       end if;
  
+                      --  Elaborate_Desirable case, for this we establish
+                      --  the same links as above, but with a different reason.
+ 
+                   elsif Withs.Table (W).Elab_Desirable then
+                      Build_Link (Withed_Unit, U, Withed);
+ 
+                      if Units.Table (Withed_Unit).Utype = Is_Spec then
+                         Build_Link
+                           (Corresponding_Body (Withed_Unit),
+                            U, Elab_Desirable);
+                      end if;
+ 
                       --  Case of normal WITH with no elaboration pragmas, just
                       --  build the single link to the directly referenced unit
  
*************** package body Binde is
*** 1123,1130 ****
  
     function Make_Elab_Entry
       (Unam : Unit_Name_Type;
!       Link : Elab_All_Id)
!       return Elab_All_Id
     is
     begin
        Elab_All_Entries.Increment_Last;
--- 1162,1168 ----
  
     function Make_Elab_Entry
       (Unam : Unit_Name_Type;
!       Link : Elab_All_Id) return Elab_All_Id
     is
     begin
        Elab_All_Entries.Increment_Last;
*************** package body Binde is
*** 1139,1145 ****
  
     function Unit_Id_Of (Uname : Unit_Name_Type) return Unit_Id is
        Info : constant Int := Get_Name_Table_Info (Uname);
- 
     begin
        pragma Assert (Info /= 0 and then Unit_Id (Info) /= No_Unit_Id);
        return Unit_Id (Info);
--- 1177,1182 ----
*************** package body Binde is
*** 1158,1169 ****
--- 1195,1214 ----
        --  Determines if U is a waiting body, defined as a body which has
        --  not been elaborated, but whose spec has been elaborated.
  
+       ---------------
+       -- Body_Unit --
+       ---------------
+ 
        function Body_Unit (U : Unit_Id) return Boolean is
        begin
           return Units.Table (U).Utype = Is_Body
             or else Units.Table (U).Utype = Is_Body_Only;
        end Body_Unit;
  
+       ------------------
+       -- Waiting_Body --
+       ------------------
+ 
        function Waiting_Body (U : Unit_Id) return Boolean is
        begin
           return Units.Table (U).Utype = Is_Body and then
*************** package body Binde is
*** 1172,1181 ****
  
     --  Start of processing for Worse_Choice
  
-    --  Note: the checks here are applied in sequence, and the ordering is
-    --  significant (i.e. the more important criteria are applied first).
- 
     begin
        --  If either unit is internal, then use Better_Choice, since the
        --  language requires that predefined units not mess up in the choice
        --  of elaboration order, and for internal units, any problems are
--- 1217,1226 ----
  
     --  Start of processing for Worse_Choice
  
     begin
+       --  Note: the checks here are applied in sequence, and the ordering is
+       --  significant (i.e. the more important criteria are applied first).
+ 
        --  If either unit is internal, then use Better_Choice, since the
        --  language requires that predefined units not mess up in the choice
        --  of elaboration order, and for internal units, any problems are
*************** package body Binde is
*** 1263,1269 ****
        First_Name : Boolean := True;
  
     begin
!       if ST.Reason in Elab_All .. Elab_Desirable then
           L := ST.Elab_All_Link;
           while L /= No_Elab_All_Link loop
              Nam := Elab_All_Entries.Table (L).Needed_By;
--- 1308,1314 ----
        First_Name : Boolean := True;
  
     begin
!       if ST.Reason in Elab_All .. Elab_All_Desirable then
           L := ST.Elab_All_Link;
           while L /= No_Elab_All_Link loop
              Nam := Elab_All_Entries.Table (L).Needed_By;
diff -Nrcpad gcc-4.0.2/gcc/ada/binde.ads gcc-4.1.0/gcc/ada/binde.ads
*** gcc-4.0.2/gcc/ada/binde.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/binde.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/binderr.adb gcc-4.1.0/gcc/ada/binderr.adb
*** gcc-4.0.2/gcc/ada/binderr.adb	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/binderr.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/binderr.ads gcc-4.1.0/gcc/ada/binderr.ads
*** gcc-4.0.2/gcc/ada/binderr.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/binderr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/bindgen.adb gcc-4.1.0/gcc/ada/bindgen.adb
*** gcc-4.0.2/gcc/ada/bindgen.adb	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/bindgen.adb	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Bindgen is
*** 201,216 ****
     procedure Gen_Elab_Defs_C;
     --  Generate sequence of definitions for elaboration routines (C code case)
  
-    procedure Gen_Exception_Table_Ada;
-    --  Generate binder exception table (Ada code case). This consists of
-    --  declarations followed by a begin followed by a call. If zero cost
-    --  exceptions are not active, then only the begin is generated.
- 
-    procedure Gen_Exception_Table_C;
-    --  Generate binder exception table (C code case). This has no effect
-    --  if zero cost exceptions are not active, otherwise it generates a
-    --  set of declarations followed by a call.
- 
     procedure Gen_Main_Ada;
     --  Generate procedure main (Ada code case)
  
--- 201,206 ----
*************** package body Bindgen is
*** 279,287 ****
     --  Set given character in Statement_Buffer at the Last + 1 position
     --  and increment Last by one to reflect the stored character.
  
-    procedure Set_EA_Last;
-    --  Output the number of elements in array EA
- 
     procedure Set_Int (N : Int);
     --  Set given value in decimal in Statement_Buffer with no spaces
     --  starting at the Last + 1 position, and updating Last past the value.
--- 269,274 ----
*************** package body Bindgen is
*** 296,302 ****
     --  is generated starting at Last + 1, and Last is updated past it.
  
     procedure Set_Name_Buffer;
!    --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer.
  
     procedure Set_String (S : String);
     --  Sets characters of given string in Statement_Buffer, starting at the
--- 283,289 ----
     --  is generated starting at Last + 1, and Last is updated past it.
  
     procedure Set_Name_Buffer;
!    --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer
  
     procedure Set_String (S : String);
     --  Sets characters of given string in Statement_Buffer, starting at the
*************** package body Bindgen is
*** 550,559 ****
           WBI ("      Handler_Installed : Integer;");
           WBI ("      pragma Import (C, Handler_Installed, " &
                """__gnat_handler_installed"");");
! 
!          --  Generate exception table
! 
!          Gen_Exception_Table_Ada;
  
           --  Generate the call to Set_Globals
  
--- 537,543 ----
           WBI ("      Handler_Installed : Integer;");
           WBI ("      pragma Import (C, Handler_Installed, " &
                """__gnat_handler_installed"");");
!          WBI ("   begin");
  
           --  Generate the call to Set_Globals
  
*************** package body Bindgen is
*** 782,791 ****
  
           --  Code for normal case (standard library not suppressed)
  
-          Gen_Exception_Table_C;
- 
           --  Generate call to set the runtime global variables defined in
!          --  a-init.c. We define the varables in a-init.c, rather than in
           --  the binder generated file itself to avoid undefined externals
           --  when the runtime is linked as a shareable image library.
  
--- 766,773 ----
  
           --  Code for normal case (standard library not suppressed)
  
           --  Generate call to set the runtime global variables defined in
!          --  init.c. We define the varables in init.c, rather than in
           --  the binder generated file itself to avoid undefined externals
           --  when the runtime is linked as a shareable image library.
  
*************** package body Bindgen is
*** 1228,1551 ****
        WBI ("   END ELABORATION ORDER */");
     end Gen_Elab_Order_C;
  
-    -----------------------------
-    -- Gen_Exception_Table_Ada --
-    -----------------------------
- 
-    procedure Gen_Exception_Table_Ada is
-       Num  : Nat;
-       Last : ALI_Id := No_ALI_Id;
- 
-    begin
-       if not Zero_Cost_Exceptions_Specified then
-          WBI ("   begin");
-          return;
-       end if;
- 
-       --  The code we generate looks like
- 
-       --        procedure SDP_Table_Build
-       --          (SDP_Addresses   : System.Address;
-       --           SDP_Count       : Natural;
-       --           Elab_Addresses  : System.Address;
-       --           Elab_Addr_Count : Natural);
-       --        pragma Import (C, SDP_Table_Build, "__gnat_SDP_Table_Build");
-       --
-       --        ST : aliased constant array (1 .. nnn) of System.Address := (
-       --               unit_name_1'UET_Address,
-       --               unit_name_2'UET_Address,
-       --               ...
-       --               unit_name_3'UET_Address,
-       --
-       --        EA : aliased constant array (1 .. eee) of System.Address := (
-       --               adainit'Code_Address,
-       --               adafinal'Code_Address,
-       --               unit_name'elab[spec|body]'Code_Address,
-       --               unit_name'elab[spec|body]'Code_Address,
-       --               unit_name'elab[spec|body]'Code_Address,
-       --               unit_name'elab[spec|body]'Code_Address);
-       --
-       --     begin
-       --        SDP_Table_Build (ST'Address, nnn, EA'Address, eee);
- 
-       Num := 0;
-       for A in ALIs.First .. ALIs.Last loop
-          if not ALIs.Table (A).SAL_Interface
-            and then ALIs.Table (A).Unit_Exception_Table
-          then
-             Num := Num + 1;
-             Last := A;
-          end if;
-       end loop;
- 
-       if Num = 0 then
- 
-          --  Happens with "gnatmake -a -f -gnatL ..."
- 
-          WBI (" ");
-          WBI ("   begin");
-          return;
-       end if;
- 
-       WBI ("      procedure SDP_Table_Build");
-       WBI ("        (SDP_Addresses   : System.Address;");
-       WBI ("         SDP_Count       : Natural;");
-       WBI ("         Elab_Addresses  : System.Address;");
-       WBI ("         Elab_Addr_Count : Natural);");
-       WBI ("      " &
-            "pragma Import (C, SDP_Table_Build, ""__gnat_SDP_Table_Build"");");
- 
-       WBI (" ");
-       Set_String ("      ST : aliased constant array (1 .. ");
-       Set_Int (Num);
-       Set_String (") of System.Address := (");
- 
-       if Num = 1 then
-          Set_String ("1 => ");
- 
-       else
-          Write_Statement_Buffer;
-       end if;
- 
-       for A in ALIs.First .. ALIs.Last loop
-          if not ALIs.Table (A).SAL_Interface
-            and then ALIs.Table (A).Unit_Exception_Table
-          then
-             Get_Decoded_Name_String_With_Brackets
-               (Units.Table (ALIs.Table (A).First_Unit).Uname);
-             Set_Casing (Mixed_Case);
- 
-             if Num /= 1 then
-                Set_String ("        ");
-             end if;
- 
-             Set_String (Name_Buffer (1 .. Name_Len - 2));
-             Set_String ("'UET_Address");
- 
-             if A = Last then
-                Set_String (");");
-             else
-                Set_Char (',');
-             end if;
- 
-             Write_Statement_Buffer;
-          end if;
-       end loop;
- 
-       WBI (" ");
-       Set_String ("      EA : aliased constant array (1 .. ");
-       Set_EA_Last;
-       Set_String (") of System.Address := (");
-       Write_Statement_Buffer;
-       Set_String ("        " & Ada_Init_Name.all & "'Code_Address");
- 
-       --  If compiling for the JVM, we directly reference Adafinal because
-       --  we don't import it via Do_Finalize (see Gen_Output_File_Ada).
- 
-       if not Cumulative_Restrictions.Set (No_Finalization) then
-          Set_Char (',');
-          Write_Statement_Buffer;
- 
-          if Hostparm.Java_VM then
-             Set_String
-               ("        System.Standard_Library.Adafinal'Code_Address");
-          else
-             Set_String
-               ("        Do_Finalize'Code_Address");
-          end if;
-       end if;
- 
-       for E in Elab_Order.First .. Elab_Order.Last loop
-          Get_Decoded_Name_String_With_Brackets
-            (Units.Table (Elab_Order.Table (E)).Uname);
- 
-          if Units.Table (Elab_Order.Table (E)).No_Elab then
-             null;
- 
-          else
-             Set_Char (',');
-             Write_Statement_Buffer;
-             Set_String ("        ");
- 
-             if Name_Buffer (Name_Len) = 's' then
-                Name_Buffer (Name_Len - 1 .. Name_Len + 21) :=
-                                         "'elab_spec'code_address";
-             else
-                Name_Buffer (Name_Len - 1 .. Name_Len + 21) :=
-                                         "'elab_body'code_address";
-             end if;
- 
-             Name_Len := Name_Len + 21;
-             Set_Casing (Units.Table (Elab_Order.Table (E)).Icasing);
-             Set_Name_Buffer;
-          end if;
-       end loop;
- 
-       Set_String (");");
-       Write_Statement_Buffer;
- 
-       WBI (" ");
-       WBI ("   begin");
- 
-       Set_String ("      SDP_Table_Build (ST'Address, ");
-       Set_Int (Num);
-       Set_String (", EA'Address, ");
-       Set_EA_Last;
-       Set_String (");");
-       Write_Statement_Buffer;
-    end Gen_Exception_Table_Ada;
- 
-    ---------------------------
-    -- Gen_Exception_Table_C --
-    ---------------------------
- 
-    procedure Gen_Exception_Table_C is
-       Num  : Nat;
-       Num2 : Nat;
- 
-    begin
-       if not Zero_Cost_Exceptions_Specified then
-          return;
-       end if;
- 
-       --  The code we generate looks like
- 
-       --     extern void *__gnat_unitname1__SDP;
-       --     extern void *__gnat_unitname2__SDP;
-       --     ...
-       --
-       --     void **st[nnn] = {
-       --       &__gnat_unitname1__SDP,
-       --       &__gnat_unitname2__SDP,
-       --       ...
-       --       &__gnat_unitnamen__SDP};
-       --
-       --     extern void unitname1__elabb ();
-       --     extern void unitname2__elabb ();
-       --     ...
-       --
-       --     void (*ea[eee]) () = {
-       --       adainit,
-       --       adafinal,
-       --       unitname1___elab[b,s],
-       --       unitname2___elab[b,s],
-       --       ...
-       --       unitnamen___elab[b,s]};
-       --
-       --     __gnat_SDP_Table_Build (&st, nnn, &ea, eee);
- 
-       Num := 0;
-       for A in ALIs.First .. ALIs.Last loop
-          if not ALIs.Table (A).SAL_Interface
-            and then ALIs.Table (A).Unit_Exception_Table
-          then
-             Num := Num + 1;
- 
-             Set_String ("   extern void *__gnat_");
-             Get_Name_String (Units.Table (ALIs.Table (A).First_Unit).Uname);
-             Set_Unit_Name;
-             Set_String ("__SDP");
-             Set_Char (';');
-             Write_Statement_Buffer;
-          end if;
-       end loop;
- 
-       if Num = 0 then
- 
-          --  Happens with "gnatmake -a -f -gnatL ..."
- 
-          return;
-       end if;
- 
-       WBI (" ");
- 
-       Set_String ("   void **st[");
-       Set_Int (Num);
-       Set_String ("] = {");
-       Write_Statement_Buffer;
- 
-       Num2 := 0;
-       for A in ALIs.First .. ALIs.Last loop
-          if not ALIs.Table (A).SAL_Interface
-            and then ALIs.Table (A).Unit_Exception_Table
-          then
-             Num2 := Num2 + 1;
- 
-             Set_String ("     &__gnat_");
-             Get_Name_String (Units.Table (ALIs.Table (A).First_Unit).Uname);
-             Set_Unit_Name;
-             Set_String ("__SDP");
- 
-             if Num = Num2 then
-                Set_String ("};");
-             else
-                Set_Char (',');
-             end if;
- 
-             Write_Statement_Buffer;
-          end if;
-       end loop;
- 
-       WBI ("");
-       for E in Elab_Order.First .. Elab_Order.Last loop
-          Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
- 
-          if Units.Table (Elab_Order.Table (E)).No_Elab then
-             null;
- 
-          else
-             Set_String ("   extern void ");
-             Set_Unit_Name;
-             Set_String ("___elab");
-             Set_Char (Name_Buffer (Name_Len)); -- 's' or 'b' for spec/body
-             Set_String (" ();");
-             Write_Statement_Buffer;
-          end if;
-       end loop;
- 
-       WBI ("");
-       Set_String ("   void (*ea[");
-       Set_EA_Last;
-       Set_String ("]) () = {");
-       Write_Statement_Buffer;
- 
-       Set_String ("     " & Ada_Init_Name.all);
- 
-       if not Cumulative_Restrictions.Set (No_Finalization) then
-          Set_Char (',');
-          Write_Statement_Buffer;
-          Set_String ("     system__standard_library__adafinal");
-       end if;
- 
-       for E in Elab_Order.First .. Elab_Order.Last loop
-          Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
- 
-          if Units.Table (Elab_Order.Table (E)).No_Elab then
-             null;
- 
-          else
-             Set_Char (',');
-             Write_Statement_Buffer;
-             Set_String ("     ");
-             Set_Unit_Name;
-             Set_String ("___elab");
-             Set_Char (Name_Buffer (Name_Len)); -- 's' or 'b' for spec/body
-          end if;
-       end loop;
- 
-       Set_String ("};");
-       Write_Statement_Buffer;
- 
-       WBI (" ");
- 
-       Set_String ("   __gnat_SDP_Table_Build (&st, ");
-       Set_Int (Num);
-       Set_String (", ea, ");
-       Set_EA_Last;
-       Set_String (");");
-       Write_Statement_Buffer;
-    end Gen_Exception_Table_C;
- 
     ------------------
     -- Gen_Main_Ada --
     ------------------
--- 1210,1215 ----
*************** package body Bindgen is
*** 1762,1767 ****
--- 1426,1432 ----
     procedure Gen_Main_C is
     begin
        if Exit_Status_Supported_On_Target then
+          WBI ("#include <stdlib.h>");
           Set_String ("int ");
        else
           Set_String ("void ");
*************** package body Bindgen is
*** 1904,1910 ****
              --  For all other systems, we use the standard exit routine.
  
              if OpenVMS_On_Target then
!                WBI ("   __posix_exit (result);");
              else
                 WBI ("   exit (result);");
              end if;
--- 1569,1575 ----
              --  For all other systems, we use the standard exit routine.
  
              if OpenVMS_On_Target then
!                WBI ("   decc$__posix_exit (result);");
              else
                 WBI ("   exit (result);");
              end if;
*************** package body Bindgen is
*** 1921,1927 ****
              --  For all other systems, we use the standard exit routine.
  
              if OpenVMS_On_Target then
!                WBI ("   __posix_exit (gnat_exit_status);");
              else
                 WBI ("   exit (gnat_exit_status);");
              end if;
--- 1586,1592 ----
              --  For all other systems, we use the standard exit routine.
  
              if OpenVMS_On_Target then
!                WBI ("   decc$__posix_exit (gnat_exit_status);");
              else
                 WBI ("   exit (gnat_exit_status);");
              end if;
*************** package body Bindgen is
*** 1942,1948 ****
        --  internal file appears.
  
        procedure Write_Linker_Option;
!       --  Write binder info linker option.
  
        -------------------------
        -- Write_Linker_Option --
--- 1607,1613 ----
        --  internal file appears.
  
        procedure Write_Linker_Option;
!       --  Write binder info linker option
  
        -------------------------
        -- Write_Linker_Option --
*************** package body Bindgen is
*** 2350,2360 ****
--- 2015,2033 ----
        WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
             Ada_Final_Name.all & """);");
  
+       if Use_Pragma_Linker_Constructor then
+          WBI ("   pragma Linker_Destructor (" & Ada_Final_Name.all & ");");
+       end if;
+ 
        WBI ("");
        WBI ("   procedure " & Ada_Init_Name.all & ";");
        WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
             Ada_Init_Name.all & """);");
  
+       if Use_Pragma_Linker_Constructor then
+          WBI ("   pragma Linker_Constructor (" & Ada_Init_Name.all & ");");
+       end if;
+ 
        if Bind_Main_Program then
  
           --  If we have the standard library, then Break_Start is defined
*************** package body Bindgen is
*** 2513,2520 ****
        WBI ("  (int, int, char, char, char, char,");
        WBI ("   const char *, const char *,");
        WBI ("   int, int, int, int, int);");
!       WBI ("extern void " & Ada_Final_Name.all & " (void);");
!       WBI ("extern void " & Ada_Init_Name.all & " (void);");
        WBI ("extern void system__standard_library__adafinal (void);");
  
        if not No_Main_Subprogram then
--- 2186,2203 ----
        WBI ("  (int, int, char, char, char, char,");
        WBI ("   const char *, const char *,");
        WBI ("   int, int, int, int, int);");
! 
!       if Use_Pragma_Linker_Constructor then
!          WBI ("extern void " & Ada_Final_Name.all &
!               " (void) __attribute__((destructor));");
!          WBI ("extern void " & Ada_Init_Name.all &
!               " (void) __attribute__((constructor));");
! 
!       else
!          WBI ("extern void " & Ada_Final_Name.all & " (void);");
!          WBI ("extern void " & Ada_Init_Name.all & " (void);");
!       end if;
! 
        WBI ("extern void system__standard_library__adafinal (void);");
  
        if not No_Main_Subprogram then
*************** package body Bindgen is
*** 2535,2541 ****
           end if;
  
           if OpenVMS_On_Target then
!             WBI ("extern void __posix_exit (int);");
           else
              WBI ("extern void exit (int);");
           end if;
--- 2218,2224 ----
           end if;
  
           if OpenVMS_On_Target then
!             WBI ("extern void decc$__posix_exit (int);");
           else
              WBI ("extern void exit (int);");
           end if;
*************** package body Bindgen is
*** 2759,2765 ****
           --  When building libraries, the version number of each unit can
           --  not be computed, since the binder does not know the full list
           --  of units. Therefore, the 'Version and 'Body_Version
!          --  attributes can not supported in this case.
  
           return;
        end if;
--- 2442,2448 ----
           --  When building libraries, the version number of each unit can
           --  not be computed, since the binder does not know the full list
           --  of units. Therefore, the 'Version and 'Body_Version
!          --  attributes cannot supported in this case.
  
           return;
        end if;
*************** package body Bindgen is
*** 2827,2833 ****
           --  When building libraries, the version number of each unit can
           --  not be computed, since the binder does not know the full list
           --  of units. Therefore, the 'Version and 'Body_Version
!          --  attributes can not supported.
  
           return;
        end if;
--- 2510,2516 ----
           --  When building libraries, the version number of each unit can
           --  not be computed, since the binder does not know the full list
           --  of units. Therefore, the 'Version and 'Body_Version
!          --  attributes cannot supported.
  
           return;
        end if;
*************** package body Bindgen is
*** 3113,3136 ****
        Statement_Buffer (Last) := C;
     end Set_Char;
  
-    -----------------
-    -- Set_EA_Last --
-    -----------------
- 
-    procedure Set_EA_Last is
-    begin
-       --  When there is no finalization, only adainit is added
- 
-       if Cumulative_Restrictions.Set (No_Finalization) then
-          Set_Int (Num_Elab_Calls + 1);
- 
-       --  When there is finalization, both adainit and adafinal are added
- 
-       else
-          Set_Int (Num_Elab_Calls + 2);
-       end if;
-    end Set_EA_Last;
- 
     -------------
     -- Set_Int --
     -------------
--- 2796,2801 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/bindgen.ads gcc-4.1.0/gcc/ada/bindgen.ads
*** gcc-4.0.2/gcc/ada/bindgen.ads	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/bindgen.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/bindusg.adb gcc-4.1.0/gcc/ada/bindusg.adb
*** gcc-4.0.2/gcc/ada/bindusg.adb	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/bindusg.adb	Tue Nov 15 14:05:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** begin
*** 51,56 ****
--- 51,61 ----
     Write_Str ("  -aIdir    Specify source files search path");
     Write_Eol;
  
+    --  Line for a switch
+ 
+    Write_Str ("  -a        Automatically initialize elaboration procedure");
+    Write_Eol;
+ 
     --  Line for A switch
  
     Write_Str ("  -A        Generate binder program in Ada (default)");
*************** begin
*** 127,143 ****
     Write_Str ("renamed to xyzinit/final, implies -n");
     Write_Eol;
  
-    --  Line for -M switch
- 
-    Write_Str ("  -Mxyz     Rename generated main program from main to xyz");
-    Write_Eol;
- 
     --  Line for -m switch
  
     Write_Str ("  -mnnn     Limit number of detected error");
     Write_Str ("s to nnn (1-999999)");
     Write_Eol;
  
     --  Line for -n switch
  
     Write_Str ("  -n        No Ada main program (foreign main routine)");
--- 132,148 ----
     Write_Str ("renamed to xyzinit/final, implies -n");
     Write_Eol;
  
     --  Line for -m switch
  
     Write_Str ("  -mnnn     Limit number of detected error");
     Write_Str ("s to nnn (1-999999)");
     Write_Eol;
  
+    --  Line for -M switch
+ 
+    Write_Str ("  -Mxyz     Rename generated main program from main to xyz");
+    Write_Eol;
+ 
     --  Line for -n switch
  
     Write_Str ("  -n        No Ada main program (foreign main routine)");
diff -Nrcpad gcc-4.0.2/gcc/ada/bindusg.ads gcc-4.1.0/gcc/ada/bindusg.ads
*** gcc-4.0.2/gcc/ada/bindusg.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/bindusg.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/butil.adb gcc-4.1.0/gcc/ada/butil.adb
*** gcc-4.0.2/gcc/ada/butil.adb	Fri Nov 19 10:55:59 2004
--- gcc-4.1.0/gcc/ada/butil.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/butil.ads gcc-4.1.0/gcc/ada/butil.ads
*** gcc-4.0.2/gcc/ada/butil.ads	Fri Nov 19 10:55:59 2004
--- gcc-4.1.0/gcc/ada/butil.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/cal.c gcc-4.1.0/gcc/ada/cal.c
*** gcc-4.0.2/gcc/ada/cal.c	Tue Nov  4 12:51:45 2003
--- gcc-4.1.0/gcc/ada/cal.c	Mon Sep  5 07:49:24 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 31,39 ****
   ****************************************************************************/
  
  /*  This file contains those routines named by Import pragmas in package    */
! /*  GNAT.Calendar. It is used to to Duration to timeval convertion.         */
! /*  These are simple wrappers function to abstarct the fact that the C      */
! /*  struct timeval fields type are not normalized (they are generaly        */
  /*  defined as int or long values).                                         */
  
  #if defined(VMS)
--- 31,39 ----
   ****************************************************************************/
  
  /*  This file contains those routines named by Import pragmas in package    */
! /*  GNAT.Calendar. It is used to do Duration to timeval conversion.         */
! /*  These are simple wrappers function to abstract the fact that the C      */
! /*  struct timeval fields type are not normalized (they are generally       */
  /*  defined as int or long values).                                         */
  
  #if defined(VMS)
*************** __gnat_duration_to_timeval (long sec, lo
*** 53,59 ****
--- 53,63 ----
  #else
  
  #if defined (__vxworks)
+ #ifdef __RTP__
+ #include <time.h>
+ #else
  #include <sys/times.h>
+ #endif
  #else
  #include <sys/time.h>
  #endif
*************** __gnat_timeval_to_duration (struct timev
*** 75,81 ****
  void
  __gnat_duration_to_timeval (long sec, long usec, struct timeval *t)
  {
!   /* here we are doing implicit convertion from a long to the struct timeval
       fields types. */
  
    t->tv_sec = sec;
--- 79,85 ----
  void
  __gnat_duration_to_timeval (long sec, long usec, struct timeval *t)
  {
!   /* here we are doing implicit conversion from a long to the struct timeval
       fields types. */
  
    t->tv_sec = sec;
diff -Nrcpad gcc-4.0.2/gcc/ada/calendar.ads gcc-4.1.0/gcc/ada/calendar.ads
*** gcc-4.0.2/gcc/ada/calendar.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/calendar.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                             C A L E N D A R                              --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                             C A L E N D A R                              --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/casing.adb gcc-4.1.0/gcc/ada/casing.adb
*** gcc-4.0.2/gcc/ada/casing.adb	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/casing.adb	Mon Sep  5 07:50:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  with Csets;    use Csets;
  with Namet;    use Namet;
  with Opt;      use Opt;
- with Types;    use Types;
  with Widechar; use Widechar;
  
  package body Casing is
--- 34,39 ----
*************** package body Casing is
*** 140,145 ****
--- 139,155 ----
        Ptr := 1;
  
        while Ptr <= Name_Len loop
+ 
+          --  Wide character. Note that we do nothing with casing in this case.
+          --  In Ada 2005 mode, required folding of lower case letters happened
+          --  as the identifier was scanned, and we do not attempt any further
+          --  messing with case (note that in any case we do not know how to
+          --  fold upper case to lower case in wide character mode). We also
+          --  do not bother with recognizing punctuation as equivalent to an
+          --  underscore. There is nothing functional at this stage in doing
+          --  the requested casing operation, beyond folding to upper case
+          --  when it is mandatory, which does not involve underscores.
+ 
           if Name_Buffer (Ptr) = ASCII.ESC
             or else Name_Buffer (Ptr) = '['
             or else (Upper_Half_Encoding
*************** package body Casing is
*** 148,159 ****
--- 158,173 ----
              Skip_Wide (Name_Buffer, Ptr);
              After_Und := False;
  
+          --  Underscore, or non-identifer character (error case)
+ 
           elsif Name_Buffer (Ptr) = '_'
              or else not Identifier_Char (Name_Buffer (Ptr))
           then
              After_Und := True;
              Ptr := Ptr + 1;
  
+          --  Lower case letter
+ 
           elsif Is_Lower_Case_Letter (Name_Buffer (Ptr)) then
              if Actual_Casing = All_Upper_Case
                or else (After_Und and then Actual_Casing = Mixed_Case)
*************** package body Casing is
*** 164,169 ****
--- 178,185 ----
              After_Und := False;
              Ptr := Ptr + 1;
  
+          --  Upper case letter
+ 
           elsif Is_Upper_Case_Letter (Name_Buffer (Ptr)) then
              if Actual_Casing = All_Lower_Case
                or else (not After_Und and then Actual_Casing = Mixed_Case)
*************** package body Casing is
*** 174,180 ****
              After_Und := False;
              Ptr := Ptr + 1;
  
!          else  --  all other characters
              After_Und := False;
              Ptr := Ptr + 1;
           end if;
--- 190,198 ----
              After_Und := False;
              Ptr := Ptr + 1;
  
!          --  Other identifier character (must be digit)
! 
!          else
              After_Und := False;
              Ptr := Ptr + 1;
           end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/casing.ads gcc-4.1.0/gcc/ada/casing.ads
*** gcc-4.0.2/gcc/ada/casing.ads	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/casing.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/ceinfo.adb gcc-4.1.0/gcc/ada/ceinfo.adb
*** gcc-4.0.2/gcc/ada/ceinfo.adb	Thu Apr 24 17:53:58 2003
--- gcc-4.1.0/gcc/ada/ceinfo.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/checks.adb gcc-4.1.0/gcc/ada/checks.adb
*** gcc-4.0.2/gcc/ada/checks.adb	Thu Feb 10 13:50:40 2005
--- gcc-4.1.0/gcc/ada/checks.adb	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Debug;    use Debug;
*** 29,34 ****
--- 29,35 ----
  with Einfo;    use Einfo;
  with Errout;   use Errout;
  with Exp_Ch2;  use Exp_Ch2;
+ with Exp_Pakd; use Exp_Pakd;
  with Exp_Util; use Exp_Util;
  with Elists;   use Elists;
  with Eval_Fat; use Eval_Fat;
*************** package body Checks is
*** 217,222 ****
--- 218,247 ----
     --  routine. The Do_Static flag indicates that only a static check is
     --  to be done.
  
+    type Check_Type is (Access_Check, Division_Check);
+    function Check_Needed (Nod : Node_Id; Check : Check_Type) return Boolean;
+    --  This function is used to see if an access or division by zero check is
+    --  needed. The check is to be applied to a single variable appearing in the
+    --  source, and N is the node for the reference. If N is not of this form,
+    --  True is returned with no further processing. If N is of the right form,
+    --  then further processing determines if the given Check is needed.
+    --
+    --  The particular circuit is to see if we have the case of a check that is
+    --  not needed because it appears in the right operand of a short circuited
+    --  conditional where the left operand guards the check. For example:
+    --
+    --    if Var = 0 or else Q / Var > 12 then
+    --       ...
+    --    end if;
+    --
+    --  In this example, the division check is not required. At the same time
+    --  we can issue warnings for suspicious use of non-short-circuited forms,
+    --  such as:
+    --
+    --    if Var = 0 or Q / Var > 12 then
+    --       ...
+    --    end if;
+ 
     procedure Find_Check
       (Expr        : Node_Id;
        Check_Type  : Character;
*************** package body Checks is
*** 253,262 ****
     --  that the access value is non-null, since the checks do not
     --  not apply to null access values.
  
-    procedure Install_Null_Excluding_Check (N : Node_Id);
-    --  Determines whether an access node requires a runtime access check and
-    --  if so inserts the appropriate run-time check
- 
     procedure Install_Static_Check (R_Cno : Node_Id; Loc : Source_Ptr);
     --  Called by Apply_{Length,Range}_Checks to rewrite the tree with the
     --  Constraint_Error node.
--- 278,283 ----
*************** package body Checks is
*** 379,391 ****
        elsif Access_Checks_Suppressed (Etype (P)) then
           return;
  
!          --  We do not need checks if we are not generating code (i.e. the
!          --  expander is not active). This is not just an optimization, there
!          --  are cases (e.g. with pragma Debug) where generating the checks
!          --  can cause real trouble).
  
        elsif not Expander_Active then
           return;
        end if;
  
        --  Case where P is an entity name
--- 400,417 ----
        elsif Access_Checks_Suppressed (Etype (P)) then
           return;
  
!       --  We do not need checks if we are not generating code (i.e. the
!       --  expander is not active). This is not just an optimization, there
!       --  are cases (e.g. with pragma Debug) where generating the checks
!       --  can cause real trouble).
  
        elsif not Expander_Active then
           return;
+ 
+       --  We do not need checks if not needed because of short circuiting
+ 
+       elsif not Check_Needed (P, Access_Check) then
+          return;
        end if;
  
        --  Case where P is an entity name
*************** package body Checks is
*** 714,723 ****
     -- Apply_Array_Size_Check --
     ----------------------------
  
-    --  Note: Really of course this entre check should be in the backend,
-    --  and perhaps this is not quite the right value, but it is good
-    --  enough to catch the normal cases (and the relevant ACVC tests!)
- 
     --  The situation is as follows. In GNAT 3 (GCC 2.x), the size in bits
     --  is computed in 32 bits without an overflow check. That's a real
     --  problem for Ada. So what we do in GNAT 3 is to approximate the
--- 740,745 ----
*************** package body Checks is
*** 726,733 ****
  
     --  In GNAT 5, the size in byte is still computed in 32 bits without
     --  an overflow check in the dynamic case, but the size in bits is
!    --  computed in 64 bits. We assume that's good enough, so we use the
!    --  size in bits for the test.
  
     procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id) is
        Loc  : constant Source_Ptr := Sloc (N);
--- 748,755 ----
  
     --  In GNAT 5, the size in byte is still computed in 32 bits without
     --  an overflow check in the dynamic case, but the size in bits is
!    --  computed in 64 bits. We assume that's good enough, and we do not
!    --  bother to generate any front end test.
  
     procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id) is
        Loc  : constant Source_Ptr := Sloc (N);
*************** package body Checks is
*** 808,813 ****
--- 830,843 ----
     --  Start of processing for Apply_Array_Size_Check
  
     begin
+       --  Do size check on local arrays. We only need this in the GCC 2
+       --  case, since in GCC 3, we expect the back end to properly handle
+       --  things. This routine can be removed when we baseline GNAT 3.
+ 
+       if Opt.GCC_Version >= 3 then
+          return;
+       end if;
+ 
        --  No need for a check if not expanding
  
        if not Expander_Active then
*************** package body Checks is
*** 843,986 ****
           end if;
        end loop;
  
!       --  GCC 3 case
  
!       if Opt.GCC_Version = 3 then
  
!          --  No problem if size is known at compile time (even if the front
!          --  end does not know it) because the back end does do overflow
!          --  checking on the size in bytes if it is compile time known.
  
!          if Size_Known_At_Compile_Time (Typ) then
              return;
           end if;
-       end if;
  
!       --  Following code is temporarily deleted, since GCC 3 is returning
!       --  zero for size in bits of large dynamic arrays. ???
! 
! --           --  Otherwise we check for the size in bits exceeding 2**31-1 * 8.
! --           --  This is the case in which we could end up with problems from
! --           --  an unnoticed overflow in computing the size in bytes
! --
! --           Check_Siz := (Uint_2 ** 31 - Uint_1) * Uint_8;
! --
! --           Sizx :=
! --             Make_Attribute_Reference (Loc,
! --               Prefix => New_Occurrence_Of (Typ, Loc),
! --               Attribute_Name => Name_Size);
! 
!       --  GCC 2 case (for now this is for GCC 3 dynamic case as well)
  
!       begin
!          --  First step is to calculate the maximum number of elements. For
!          --  this calculation, we use the actual size of the subtype if it is
!          --  static, and if a bound of a subtype is non-static, we go to the
!          --  bound of the base type.
  
!          Siz := Uint_1;
!          Indx := First_Index (Typ);
!          while Present (Indx) loop
!             Xtyp := Etype (Indx);
!             Lo := Type_Low_Bound (Xtyp);
!             Hi := Type_High_Bound (Xtyp);
  
!             --  If any bound raises constraint error, we will never get this
!             --  far, so there is no need to generate any kind of check.
  
!             if Raises_Constraint_Error (Lo)
!               or else
!                 Raises_Constraint_Error (Hi)
!             then
!                Uintp.Release (Umark);
!                return;
!             end if;
  
!             --  Otherwise get bounds values
  
!             if Is_Static_Expression (Lo) then
!                Lob := Expr_Value (Lo);
!             else
!                Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
!                Static := False;
!             end if;
  
!             if Is_Static_Expression (Hi) then
!                Hib := Expr_Value (Hi);
!             else
!                Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
!                Static := False;
!             end if;
  
!             Siz := Siz *  UI_Max (Hib - Lob + 1, Uint_0);
!             Next_Index (Indx);
!          end loop;
  
!          --  Compute the limit against which we want to check. For subprograms,
!          --  where the array will go on the stack, we use 8*2**24, which (in
!          --  bits) is the size of a 16 megabyte array.
  
!          if Is_Subprogram (Scope (Ent)) then
!             Check_Siz := Uint_2 ** 27;
!          else
!             Check_Siz := Uint_2 ** 31;
!          end if;
  
!          --  If we have all static bounds and Siz is too large, then we know
!          --  we know we have a storage error right now, so generate message
  
!          if Static and then Siz >= Check_Siz then
!             Insert_Action (N,
!               Make_Raise_Storage_Error (Loc,
!                 Reason => SE_Object_Too_Large));
!             Error_Msg_N ("?Storage_Error will be raised at run-time", N);
!             Uintp.Release (Umark);
!             return;
!          end if;
  
!          --  Case of component size known at compile time. If the array
!          --  size is definitely in range, then we do not need a check.
  
!          if Known_Esize (Ctyp)
!            and then Siz * Esize (Ctyp) < Check_Siz
!          then
!             Uintp.Release (Umark);
!             return;
           end if;
  
-          --  Here if a dynamic check is required
- 
-          --  What we do is to build an expression for the size of the array,
-          --  which is computed as the 'Size of the array component, times
-          --  the size of each dimension.
- 
-          Uintp.Release (Umark);
- 
           Sizx :=
!            Make_Attribute_Reference (Loc,
!              Prefix =>         New_Occurrence_Of (Ctyp, Loc),
!              Attribute_Name => Name_Size);
! 
!          Indx := First_Index (Typ);
!          for J in 1 .. Number_Dimensions (Typ) loop
!             if Sloc (Etype (Indx)) = Sloc (N) then
!                Ensure_Defined (Etype (Indx), N);
!             end if;
! 
!             Sizx :=
!               Make_Op_Multiply (Loc,
!                 Left_Opnd  => Sizx,
!                 Right_Opnd =>
!                   Make_Attribute_Reference (Loc,
!                     Prefix         => New_Occurrence_Of (Typ, Loc),
!                     Attribute_Name => Name_Length,
!                     Expressions    => New_List (
!                                         Make_Integer_Literal (Loc, J))));
!             Next_Index (Indx);
!          end loop;
!       end;
  
!       --  Common code to actually emit the check
  
        Code :=
          Make_Raise_Storage_Error (Loc,
--- 873,985 ----
           end if;
        end loop;
  
!       --  First step is to calculate the maximum number of elements. For
!       --  this calculation, we use the actual size of the subtype if it is
!       --  static, and if a bound of a subtype is non-static, we go to the
!       --  bound of the base type.
  
!       Siz := Uint_1;
!       Indx := First_Index (Typ);
!       while Present (Indx) loop
!          Xtyp := Etype (Indx);
!          Lo := Type_Low_Bound (Xtyp);
!          Hi := Type_High_Bound (Xtyp);
  
!          --  If any bound raises constraint error, we will never get this
!          --  far, so there is no need to generate any kind of check.
  
!          if Raises_Constraint_Error (Lo)
!            or else
!              Raises_Constraint_Error (Hi)
!          then
!             Uintp.Release (Umark);
              return;
           end if;
  
!          --  Otherwise get bounds values
  
!          if Is_Static_Expression (Lo) then
!             Lob := Expr_Value (Lo);
!          else
!             Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
!             Static := False;
!          end if;
  
!          if Is_Static_Expression (Hi) then
!             Hib := Expr_Value (Hi);
!          else
!             Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
!             Static := False;
!          end if;
  
!          Siz := Siz *  UI_Max (Hib - Lob + 1, Uint_0);
!          Next_Index (Indx);
!       end loop;
  
!       --  Compute the limit against which we want to check. For subprograms,
!       --  where the array will go on the stack, we use 8*2**24, which (in
!       --  bits) is the size of a 16 megabyte array.
  
!       if Is_Subprogram (Scope (Ent)) then
!          Check_Siz := Uint_2 ** 27;
!       else
!          Check_Siz := Uint_2 ** 31;
!       end if;
  
!       --  If we have all static bounds and Siz is too large, then we know
!       --  we know we have a storage error right now, so generate message
  
!       if Static and then Siz >= Check_Siz then
!          Insert_Action (N,
!            Make_Raise_Storage_Error (Loc,
!              Reason => SE_Object_Too_Large));
!          Error_Msg_N ("?Storage_Error will be raised at run-time", N);
!          Uintp.Release (Umark);
!          return;
!       end if;
  
!       --  Case of component size known at compile time. If the array
!       --  size is definitely in range, then we do not need a check.
  
!       if Known_Esize (Ctyp)
!         and then Siz * Esize (Ctyp) < Check_Siz
!       then
!          Uintp.Release (Umark);
!          return;
!       end if;
  
!       --  Here if a dynamic check is required
  
!       --  What we do is to build an expression for the size of the array,
!       --  which is computed as the 'Size of the array component, times
!       --  the size of each dimension.
  
!       Uintp.Release (Umark);
  
!       Sizx :=
!         Make_Attribute_Reference (Loc,
!           Prefix =>         New_Occurrence_Of (Ctyp, Loc),
!           Attribute_Name => Name_Size);
  
!       Indx := First_Index (Typ);
!       for J in 1 .. Number_Dimensions (Typ) loop
!          if Sloc (Etype (Indx)) = Sloc (N) then
!             Ensure_Defined (Etype (Indx), N);
           end if;
  
           Sizx :=
!            Make_Op_Multiply (Loc,
!              Left_Opnd  => Sizx,
!              Right_Opnd =>
!                Make_Attribute_Reference (Loc,
!                  Prefix         => New_Occurrence_Of (Typ, Loc),
!                  Attribute_Name => Name_Length,
!                  Expressions    => New_List (
!                    Make_Integer_Literal (Loc, J))));
!          Next_Index (Indx);
!       end loop;
  
!       --  Emit the check
  
        Code :=
          Make_Raise_Storage_Error (Loc,
*************** package body Checks is
*** 990,996 ****
                Right_Opnd =>
                  Make_Integer_Literal (Loc,
                    Intval    => Check_Siz)),
!                   Reason    => SE_Object_Too_Large);
  
        Set_Size_Check_Code (Defining_Identifier (N), Code);
        Insert_Action (N, Code, Suppress => All_Checks);
--- 989,995 ----
                Right_Opnd =>
                  Make_Integer_Literal (Loc,
                    Intval    => Check_Siz)),
!           Reason => SE_Object_Too_Large);
  
        Set_Size_Check_Code (Defining_Identifier (N), Code);
        Insert_Action (N, Code, Suppress => All_Checks);
*************** package body Checks is
*** 1016,1022 ****
  
        elsif Is_Array_Type (Typ) then
  
!          --  A useful optimization: an aggregate with only an Others clause
           --  always has the right bounds.
  
           if Nkind (N) = N_Aggregate
--- 1015,1021 ----
  
        elsif Is_Array_Type (Typ) then
  
!          --  A useful optimization: an aggregate with only an others clause
           --  always has the right bounds.
  
           if Nkind (N) = N_Aggregate
*************** package body Checks is
*** 1144,1153 ****
           return;
        end if;
  
!       --  No discriminant checks necessary for access when expression
        --  is statically Null. This is not only an optimization, this is
        --  fundamental because otherwise discriminant checks may be generated
!       --  in init procs for types containing an access to a non-frozen yet
        --  record, causing a deadly forward reference.
  
        --  Also, if the expression is of an access type whose designated
--- 1143,1152 ----
           return;
        end if;
  
!       --  No discriminant checks necessary for an access when expression
        --  is statically Null. This is not only an optimization, this is
        --  fundamental because otherwise discriminant checks may be generated
!       --  in init procs for types containing an access to a not-yet-frozen
        --  record, causing a deadly forward reference.
  
        --  Also, if the expression is of an access type whose designated
*************** package body Checks is
*** 1184,1189 ****
--- 1183,1196 ----
  
        if not Is_Constrained (T_Typ) then
           return;
+ 
+       --  Ada 2005: nothing to do if the type is one for which there is a
+       --  partial view that is constrained.
+ 
+       elsif Ada_Version >= Ada_05
+         and then Has_Constrained_Partial_View (Base_Type (T_Typ))
+       then
+          return;
        end if;
  
        --  Nothing to do if the type is an Unchecked_Union
*************** package body Checks is
*** 1378,1384 ****
  
     begin
        if Expander_Active
!         and not Backend_Divide_Checks_On_Target
        then
           Determine_Range (Right, ROK, Rlo, Rhi);
  
--- 1385,1392 ----
  
     begin
        if Expander_Active
!         and then not Backend_Divide_Checks_On_Target
!         and then Check_Needed (Right, Division_Check)
        then
           Determine_Range (Right, ROK, Rlo, Rhi);
  
*************** package body Checks is
*** 1400,1406 ****
           --  Test for extremely annoying case of xxx'First divided by -1
  
           if Do_Overflow_Check (N) then
- 
              if Nkind (N) = N_Op_Divide
                and then Is_Signed_Integer_Type (Typ)
              then
--- 1408,1413 ----
*************** package body Checks is
*** 1609,1615 ****
  
        Insert_Action (Ck_Node,
          Make_Raise_Constraint_Error (Loc,
!           Condition => Make_Op_Not (Loc, Make_Op_And (Loc, Lo_Chk, Hi_Chk)),
            Reason    => Reason));
     end Apply_Float_Conversion_Check;
  
--- 1616,1622 ----
  
        Insert_Action (Ck_Node,
          Make_Raise_Constraint_Error (Loc,
!           Condition => Make_Op_Not (Loc, Make_And_Then (Loc, Lo_Chk, Hi_Chk)),
            Reason    => Reason));
     end Apply_Float_Conversion_Check;
  
*************** package body Checks is
*** 2438,2443 ****
--- 2445,2563 ----
        return Cond;
     end Build_Discriminant_Checks;
  
+    ------------------
+    -- Check_Needed --
+    ------------------
+ 
+    function Check_Needed (Nod : Node_Id; Check : Check_Type) return Boolean is
+       N : Node_Id;
+       P : Node_Id;
+       K : Node_Kind;
+       L : Node_Id;
+       R : Node_Id;
+ 
+    begin
+       --  Always check if not simple entity
+ 
+       if Nkind (Nod) not in N_Has_Entity
+         or else not Comes_From_Source (Nod)
+       then
+          return True;
+       end if;
+ 
+       --  Look up tree for short circuit
+ 
+       N := Nod;
+       loop
+          P := Parent (N);
+          K := Nkind (P);
+ 
+          if K not in N_Subexpr then
+             return True;
+ 
+          --  Or/Or Else case, left operand must be equality test
+ 
+          elsif K = N_Op_Or or else K = N_Or_Else then
+             exit when N = Right_Opnd (P)
+               and then Nkind (Left_Opnd (P)) = N_Op_Eq;
+ 
+          --  And/And then case, left operand must be inequality test
+ 
+          elsif K = N_Op_And or else K = N_And_Then then
+             exit when N = Right_Opnd (P)
+               and then Nkind (Left_Opnd (P)) = N_Op_Ne;
+          end if;
+ 
+          N := P;
+       end loop;
+ 
+       --  If we fall through the loop, then we have a conditional with an
+       --  appropriate test as its left operand. So test further.
+ 
+       L := Left_Opnd (P);
+ 
+       if Nkind (L) = N_Op_Not then
+          L := Right_Opnd (L);
+       end if;
+ 
+       R := Right_Opnd (L);
+       L := Left_Opnd (L);
+ 
+       --  Left operand of test must match original variable
+ 
+       if Nkind (L) not in N_Has_Entity
+         or else Entity (L) /= Entity (Nod)
+       then
+          return True;
+       end if;
+ 
+       --  Right operand of test mus be key value (zero or null)
+ 
+       case Check is
+          when Access_Check =>
+             if Nkind (R) /= N_Null then
+                return True;
+             end if;
+ 
+          when Division_Check =>
+             if not Compile_Time_Known_Value (R)
+               or else Expr_Value (R) /= Uint_0
+             then
+                return True;
+             end if;
+       end case;
+ 
+       --  Here we have the optimizable case, warn if not short-circuited
+ 
+       if K = N_Op_And or else K = N_Op_Or then
+          case Check is
+             when Access_Check =>
+                Error_Msg_N
+                  ("Constraint_Error may be raised (access check)?",
+                   Parent (Nod));
+             when Division_Check =>
+                Error_Msg_N
+                  ("Constraint_Error may be raised (zero divide)?",
+                   Parent (Nod));
+          end case;
+ 
+          if K = N_Op_And then
+             Error_Msg_N ("use `AND THEN` instead of AND?", P);
+          else
+             Error_Msg_N ("use `OR ELSE` instead of OR?", P);
+          end if;
+ 
+          --  If not short-circuited, we need the ckeck
+ 
+          return True;
+ 
+       --  If short-circuited, we can omit the check
+ 
+       else
+          return False;
+       end if;
+    end Check_Needed;
+ 
     -----------------------------------
     -- Check_Valid_Lvalue_Subscripts --
     -----------------------------------
*************** package body Checks is
*** 2485,2702 ****
        Related_Nod        : Node_Id;
        Has_Null_Exclusion : Boolean := False;
  
!       type Msg_Kind is (Components, Formals, Objects);
!       Msg_K : Msg_Kind := Objects;
!       --  Used by local subprograms to generate precise error messages
  
!       procedure Check_Must_Be_Access
!         (Typ                : Entity_Id;
!          Has_Null_Exclusion : Boolean);
!       --  ??? local subprograms must have comment on spec
  
!       procedure Check_Already_Null_Excluding_Type
!         (Typ                : Entity_Id;
!          Has_Null_Exclusion : Boolean;
!          Related_Nod        : Node_Id);
!       --  ??? local subprograms must have comment on spec
  
!       procedure Check_Must_Be_Initialized
!         (N           : Node_Id;
!          Related_Nod : Node_Id);
!       --  ??? local subprograms must have comment on spec
  
!       procedure Check_Null_Not_Allowed (N : Node_Id);
!       --  ??? local subprograms must have comment on spec
  
!       --  ??? following bodies lack comments
  
!       --------------------------
!       -- Check_Must_Be_Access --
!       --------------------------
  
!       procedure Check_Must_Be_Access
!         (Typ                : Entity_Id;
!          Has_Null_Exclusion : Boolean)
!       is
!       begin
!          if Has_Null_Exclusion
!            and then not Is_Access_Type (Typ)
!          then
!             Error_Msg_N ("(Ada 2005) must be an access type", Related_Nod);
!          end if;
!       end Check_Must_Be_Access;
  
!       ---------------------------------------
!       -- Check_Already_Null_Excluding_Type --
!       ---------------------------------------
  
!       procedure Check_Already_Null_Excluding_Type
!         (Typ                : Entity_Id;
!          Has_Null_Exclusion : Boolean;
!          Related_Nod        : Node_Id)
!       is
!       begin
!          if Has_Null_Exclusion
!            and then Can_Never_Be_Null (Typ)
!          then
!             Error_Msg_N
!               ("(Ada 2005) already a null-excluding type", Related_Nod);
!          end if;
!       end Check_Already_Null_Excluding_Type;
  
!       -------------------------------
!       -- Check_Must_Be_Initialized --
!       -------------------------------
  
!       procedure Check_Must_Be_Initialized
!         (N           : Node_Id;
!          Related_Nod : Node_Id)
!       is
!          Expr        : constant Node_Id := Expression (N);
  
!       begin
!          pragma Assert (Nkind (N) = N_Component_Declaration
!                           or else Nkind (N) = N_Object_Declaration);
  
!          if not Present (Expr) then
!             case Msg_K is
!                when Components =>
!                   Error_Msg_N
!                     ("(Ada 2005) null-excluding components must be " &
!                      "initialized", Related_Nod);
  
!                when Formals =>
!                   Error_Msg_N
!                     ("(Ada 2005) null-excluding formals must be initialized",
!                      Related_Nod);
  
!                when Objects =>
!                   Error_Msg_N
!                     ("(Ada 2005) null-excluding objects must be initialized",
!                      Related_Nod);
!             end case;
!          end if;
!       end Check_Must_Be_Initialized;
  
!       ----------------------------
!       -- Check_Null_Not_Allowed --
!       ----------------------------
  
!       procedure Check_Null_Not_Allowed (N : Node_Id) is
           Expr : constant Node_Id := Expression (N);
  
        begin
           if Present (Expr)
             and then Nkind (Expr) = N_Null
           then
!             case Msg_K is
!                when Components =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding components?",
!                       Reason => CE_Null_Not_Allowed,
!                       Rep    => False);
  
!                when Formals =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding formals?",
!                       Reason => CE_Null_Not_Allowed,
!                       Rep    => False);
  
!                when Objects =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding objects?",
!                       Reason => CE_Null_Not_Allowed,
!                       Rep    => False);
              end case;
           end if;
!       end Check_Null_Not_Allowed;
! 
!    --  Start of processing for Null_Exclusion_Static_Checks
! 
!    begin
!       pragma Assert (K = N_Component_Declaration
!                        or else K = N_Parameter_Specification
!                        or else K = N_Object_Declaration
!                        or else K = N_Discriminant_Specification
!                        or else K = N_Allocator);
! 
!       case K is
!          when N_Component_Declaration =>
!             Msg_K := Components;
! 
!             if not Present (Access_Definition (Component_Definition (N))) then
!                Has_Null_Exclusion  := Null_Exclusion_Present
!                                         (Component_Definition (N));
!                Typ := Etype (Subtype_Indication (Component_Definition (N)));
!                Related_Nod := Subtype_Indication (Component_Definition (N));
!                Check_Must_Be_Access (Typ, Has_Null_Exclusion);
!                Check_Already_Null_Excluding_Type
!                  (Typ, Has_Null_Exclusion, Related_Nod);
!                Check_Must_Be_Initialized (N, Related_Nod);
!             end if;
! 
!             Check_Null_Not_Allowed (N);
! 
!          when N_Parameter_Specification =>
!             Msg_K := Formals;
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
!             Typ := Entity (Parameter_Type (N));
!             Related_Nod := Parameter_Type (N);
!             Check_Must_Be_Access (Typ, Has_Null_Exclusion);
!             Check_Already_Null_Excluding_Type
!               (Typ, Has_Null_Exclusion, Related_Nod);
!             Check_Null_Not_Allowed (N);
! 
!          when N_Object_Declaration =>
!             Msg_K := Objects;
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
!             Typ := Entity (Object_Definition (N));
!             Related_Nod := Object_Definition (N);
!             Check_Must_Be_Access (Typ, Has_Null_Exclusion);
!             Check_Already_Null_Excluding_Type
!               (Typ, Has_Null_Exclusion, Related_Nod);
!             Check_Must_Be_Initialized (N, Related_Nod);
!             Check_Null_Not_Allowed (N);
! 
!          when N_Discriminant_Specification =>
!             Msg_K := Components;
! 
!             if Nkind (Discriminant_Type (N)) /= N_Access_Definition then
!                Has_Null_Exclusion := Null_Exclusion_Present (N);
!                Typ := Etype (Defining_Identifier (N));
!                Related_Nod := Discriminant_Type (N);
!                Check_Must_Be_Access (Typ, Has_Null_Exclusion);
!                Check_Already_Null_Excluding_Type
!                  (Typ, Has_Null_Exclusion, Related_Nod);
!             end if;
! 
!             Check_Null_Not_Allowed (N);
! 
!          when N_Allocator =>
!             Msg_K := Objects;
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
!             Typ := Etype (Expression (N));
! 
!             if Nkind (Expression (N)) = N_Qualified_Expression then
!                Related_Nod := Subtype_Mark (Expression (N));
!             else
!                Related_Nod := Expression (N);
!             end if;
! 
!             Check_Must_Be_Access (Typ, Has_Null_Exclusion);
!             Check_Already_Null_Excluding_Type
!               (Typ, Has_Null_Exclusion, Related_Nod);
!             Check_Null_Not_Allowed (N);
! 
!          when others =>
!             raise Program_Error;
!       end case;
     end Null_Exclusion_Static_Checks;
  
     ----------------------------------
--- 2605,2724 ----
        Related_Nod        : Node_Id;
        Has_Null_Exclusion : Boolean := False;
  
!    begin
!       pragma Assert (K = N_Parameter_Specification
!                        or else K = N_Object_Declaration
!                        or else K = N_Discriminant_Specification
!                        or else K = N_Component_Declaration);
  
!       Typ := Etype (Defining_Identifier (N));
  
!       pragma Assert (Is_Access_Type (Typ)
!         or else (K = N_Object_Declaration and then Is_Array_Type (Typ)));
  
!       case K is
!          when N_Parameter_Specification =>
!             Related_Nod        := Parameter_Type (N);
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
  
!          when N_Object_Declaration =>
!             Related_Nod        := Object_Definition (N);
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
  
!          when N_Discriminant_Specification =>
!             Related_Nod        := Discriminant_Type (N);
!             Has_Null_Exclusion := Null_Exclusion_Present (N);
  
!          when N_Component_Declaration =>
!             if Present (Access_Definition (Component_Definition (N))) then
!                Related_Nod := Component_Definition (N);
!                Has_Null_Exclusion :=
!                  Null_Exclusion_Present
!                    (Access_Definition (Component_Definition (N)));
!             else
!                Related_Nod :=
!                  Subtype_Indication (Component_Definition (N));
!                Has_Null_Exclusion :=
!                  Null_Exclusion_Present (Component_Definition (N));
!             end if;
  
!          when others =>
!             raise Program_Error;
!       end case;
  
!       --  Enforce legality rule 3.10 (14/1): A null_exclusion is only allowed
!       --  of the access subtype does not exclude null.
  
!       if Has_Null_Exclusion
!         and then Can_Never_Be_Null (Typ)
  
!          --  No need to check itypes that have the null-excluding attribute
!          --  because they were checked at their point of creation
  
!         and then not Is_Itype (Typ)
!       then
!          Error_Msg_N
!            ("(Ada 2005) already a null-excluding type", Related_Nod);
!       end if;
  
!       --  Check that null-excluding objects are always initialized
  
!       if K = N_Object_Declaration
!         and then not Present (Expression (N))
!       then
!          --  Add a an expression that assignates null. This node is needed
!          --  by Apply_Compile_Time_Constraint_Error, that will replace this
!          --  node by a Constraint_Error node.
  
!          Set_Expression (N, Make_Null (Sloc (N)));
!          Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
  
!          Apply_Compile_Time_Constraint_Error
!            (N      => Expression (N),
!             Msg    => "(Ada 2005) null-excluding objects must be initialized?",
!             Reason => CE_Null_Not_Allowed);
!       end if;
  
!       --  Check that the null value is not used as a single expression to
!       --  assignate a value to a null-excluding component, formal or object;
!       --  otherwise generate a warning message at the sloc of Related_Nod and
!       --  replace Expression (N) by an N_Contraint_Error node.
  
!       declare
           Expr : constant Node_Id := Expression (N);
  
        begin
           if Present (Expr)
             and then Nkind (Expr) = N_Null
           then
!             case K is
!                when N_Discriminant_Specification  |
!                     N_Component_Declaration      =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding components?",
!                       Reason => CE_Null_Not_Allowed);
  
!                when N_Parameter_Specification =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding formals?",
!                       Reason => CE_Null_Not_Allowed);
  
!                when N_Object_Declaration =>
                    Apply_Compile_Time_Constraint_Error
                       (N      => Expr,
                        Msg    => "(Ada 2005) NULL not allowed in"
                                    & " null-excluding objects?",
!                       Reason => CE_Null_Not_Allowed);
! 
!                when others =>
!                   null;
              end case;
           end if;
!       end;
     end Null_Exclusion_Static_Checks;
  
     ----------------------------------
*************** package body Checks is
*** 3235,3249 ****
  
     function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean is
     begin
        if Present (E) then
           if Kill_Elaboration_Checks (E) then
              return True;
           elsif Checks_May_Be_Suppressed (E) then
!             return Is_Check_Suppressed (E, Elaboration_Check);
           end if;
        end if;
  
!       return Scope_Suppress (Elaboration_Check);
     end Elaboration_Checks_Suppressed;
  
     ---------------------------
--- 3257,3288 ----
  
     function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean is
     begin
+       --  The complication in this routine is that if we are in the dynamic
+       --  model of elaboration, we also check All_Checks, since All_Checks
+       --  does not set Elaboration_Check explicitly.
+ 
        if Present (E) then
           if Kill_Elaboration_Checks (E) then
              return True;
+ 
           elsif Checks_May_Be_Suppressed (E) then
!             if Is_Check_Suppressed (E, Elaboration_Check) then
!                return True;
!             elsif Dynamic_Elaboration_Checks then
!                return Is_Check_Suppressed (E, All_Checks);
!             else
!                return False;
!             end if;
           end if;
        end if;
  
!       if Scope_Suppress (Elaboration_Check) then
!          return True;
!       elsif Dynamic_Elaboration_Checks then
!          return Scope_Suppress (All_Checks);
!       else
!          return False;
!       end if;
     end Elaboration_Checks_Suppressed;
  
     ---------------------------
*************** package body Checks is
*** 3666,3671 ****
--- 3705,3719 ----
        then
           return;
  
+       --  No check on a univeral real constant. The context will eventually
+       --  convert it to a machine number for some target type, or report an
+       --  illegality.
+ 
+       elsif Nkind (Expr) = N_Real_Literal
+         and then Etype (Expr) = Universal_Real
+       then
+          return;
+ 
        --  An annoying special case. If this is an out parameter of a scalar
        --  type, then the value is not going to be accessed, therefore it is
        --  inappropriate to do any validity check at the call site.
*************** package body Checks is
*** 3821,3831 ****
        then
           return Expr_Known_Valid (Expression (Expr));
  
!       --  The result of any function call or operator is always considered
!       --  valid, since we assume the necessary checks are done by the call.
!       --  For operators on floating-point operations, we must also check
!       --  when the operation is the right-hand side of an assignment, or
!       --  is an actual in a call.
  
        elsif
          Nkind (Expr) in N_Binary_Op or else Nkind (Expr) in N_Unary_Op
--- 3869,3878 ----
        then
           return Expr_Known_Valid (Expression (Expr));
  
!       --  The result of any operator is always considered valid, since we
!       --  assume the necessary checks are done by the operator. For operators
!       --  on floating-point operations, we must also check when the operation
!       --  is the right-hand side of an assignment, or is an actual in a call.
  
        elsif
          Nkind (Expr) in N_Binary_Op or else Nkind (Expr) in N_Unary_Op
*************** package body Checks is
*** 3842,3850 ****
              return True;
           end if;
  
-       elsif Nkind (Expr) = N_Function_Call then
-          return True;
- 
        --  For all other cases, we do not know the expression is valid
  
        else
--- 3889,3894 ----
*************** package body Checks is
*** 4728,4733 ****
--- 4772,4799 ----
                     Attribute_Name => Name_Valid)),
             Reason => CE_Invalid_Data),
           Suppress => All_Checks);
+ 
+       --  If the expression is a a reference to an element of a bit-packed
+       --  array, it is rewritten as a renaming declaration. If the expression
+       --  is an actual in a call, it has not been expanded, waiting for the
+       --  proper point at which to do it. The same happens with renamings, so
+       --  that we have to force the expansion now. This non-local complication
+       --  is due to code in exp_ch2,adb, exp_ch4.adb and exp_ch6.adb.
+ 
+       if Is_Entity_Name (Exp)
+         and then Nkind (Parent (Entity (Exp))) = N_Object_Renaming_Declaration
+       then
+          declare
+             Old_Exp : constant Node_Id := Name (Parent (Entity (Exp)));
+          begin
+             if Nkind (Old_Exp) = N_Indexed_Component
+               and then Is_Bit_Packed_Array (Etype (Prefix (Old_Exp)))
+             then
+                Expand_Packed_Element_Reference (Old_Exp);
+             end if;
+          end;
+       end if;
+ 
        Validity_Checks_On := True;
     end Insert_Valid_Check;
  
*************** package body Checks is
*** 4742,4755 ****
     begin
        pragma Assert (Is_Access_Type (Etyp));
  
!       --  Don't need access check if: 1) we are analyzing a generic, 2) it is
!       --  known to be non-null, or 3) the check was suppressed on the type
  
        if Inside_A_Generic
          or else Access_Checks_Suppressed (Etyp)
        then
           return;
! 
           --  Otherwise install access check
  
        else
--- 4808,4832 ----
     begin
        pragma Assert (Is_Access_Type (Etyp));
  
!       --  Don't need access check if:
!       --   1) we are analyzing a generic
!       --   2) it is known to be non-null
!       --   3) the check was suppressed on the type
!       --   4) This is an attribute reference that returns an access type.
  
        if Inside_A_Generic
          or else Access_Checks_Suppressed (Etyp)
        then
           return;
!       elsif Nkind (N) = N_Attribute_Reference
!         and then
!          (Attribute_Name (N) = Name_Access
!             or else
!           Attribute_Name (N) = Name_Unchecked_Access
!             or else
!           Attribute_Name (N) = Name_Unrestricted_Access)
!       then
!          return;
           --  Otherwise install access check
  
        else
*************** package body Checks is
*** 5775,5781 ****
              return Get_Discriminal (E, Bound);
  
           elsif Nkind (Bound) = N_Integer_Literal then
!             return  Make_Integer_Literal (Loc, Intval (Bound));
  
           else
              return Duplicate_Subexpr_No_Checks (Bound);
--- 5852,5868 ----
              return Get_Discriminal (E, Bound);
  
           elsif Nkind (Bound) = N_Integer_Literal then
!             return Make_Integer_Literal (Loc, Intval (Bound));
! 
!          --  Case of a bound that has been rewritten to an
!          --  N_Raise_Constraint_Error node because it is an out-of-range
!          --  value. We may not call Duplicate_Subexpr on this node because
!          --  an N_Raise_Constraint_Error is not side effect free, and we may
!          --  not assume that we are in the proper context to remove side
!          --  effects on it at the point of reference.
! 
!          elsif Nkind (Bound) = N_Raise_Constraint_Error then
!             return New_Copy_Tree (Bound);
  
           else
              return Duplicate_Subexpr_No_Checks (Bound);
diff -Nrcpad gcc-4.0.2/gcc/ada/checks.ads gcc-4.1.0/gcc/ada/checks.ads
*** gcc-4.0.2/gcc/ada/checks.ads	Mon Jun  7 14:16:16 2004
--- gcc-4.1.0/gcc/ada/checks.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Checks is
*** 159,174 ****
        OK : out Boolean;
        Lo : out Uint;
        Hi : out Uint);
!    --  N is a node for a subexpression. If N is of a discrete type with
!    --  no error indications, and no other peculiarities (e.g. missing
!    --  type fields), then OK is True on return, and Lo and Hi are set
!    --  to a conservative estimate of the possible range of values of N.
!    --  Thus if OK is True on return, the value of the subexpression N is
!    --  known to like in the range Lo .. Hi (inclusive). If the expression
!    --  is not of a discrete type, or some kind of error condition is
!    --  detected, then OK is False on exit, and Lo/Hi are set to No_Uint.
!    --  Thus the significance of OK being False on return is that no
!    --  useful information is available on the range of the expression.
  
     -------------------------------------------------------
     -- Control and Optimization of Range/Overflow Checks --
--- 159,178 ----
        OK : out Boolean;
        Lo : out Uint;
        Hi : out Uint);
!    --  N is a node for a subexpression. If N is of a discrete type with no
!    --  error indications, and no other peculiarities (e.g. missing type
!    --  fields), then OK is True on return, and Lo and Hi are set to a
!    --  conservative estimate of the possible range of values of N. Thus if OK
!    --  is True on return, the value of the subexpression N is known to like in
!    --  the range Lo .. Hi (inclusive). If the expression is not of a discrete
!    --  type, or some kind of error condition is detected, then OK is False on
!    --  exit, and Lo/Hi are set to No_Uint. Thus the significance of OK being
!    --  False on return is that no useful information is available on the range
!    --  of the expression.
! 
!    procedure Install_Null_Excluding_Check (N : Node_Id);
!    --  Determines whether an access node requires a runtime access check and
!    --  if so inserts the appropriate run-time check.
  
     -------------------------------------------------------
     -- Control and Optimization of Range/Overflow Checks --
*************** package Checks is
*** 181,192 ****
     --  in the transitional phase where some of these checks are still done
     --  by the back end, but many are done by the front end.
  
!    --  Overflow checks are similarly controlled by the Do_Overflow_Check
!    --  flag. The difference here is that if Backend_Overflow_Checks is
!    --  is (Backend_Overflow_Checks_On_Target set False), then the actual
!    --  overflow checks are generated by the front end, but if back end
!    --  overflow checks are active (Backend_Overflow_Checks_On_Target
!    --  set True), then the back end does generate the checks.
  
     --  The following two routines are used to set these flags, they allow
     --  for the possibility of eliminating checks. Checks can be eliminated
--- 185,196 ----
     --  in the transitional phase where some of these checks are still done
     --  by the back end, but many are done by the front end.
  
!    --  Overflow checks are similarly controlled by the Do_Overflow_Check flag.
!    --  The difference here is that if Backend_Overflow_Checks is is
!    --  (Backend_Overflow_Checks_On_Target set False), then the actual overflow
!    --  checks are generated by the front end, but if back end overflow checks
!    --  are active (Backend_Overflow_Checks_On_Target set True), then the back
!    --  end does generate the checks.
  
     --  The following two routines are used to set these flags, they allow
     --  for the possibility of eliminating checks. Checks can be eliminated
*************** package Checks is
*** 243,249 ****
     --  be discarded, even if they are not in the current statement range.
  
     procedure Kill_All_Checks;
!    --  This procedure kills all remembered checks.
  
     -----------------------------
     -- Length and Range Checks --
--- 247,253 ----
     --  be discarded, even if they are not in the current statement range.
  
     procedure Kill_All_Checks;
!    --  This procedure kills all remembered checks
  
     -----------------------------
     -- Length and Range Checks --
*************** package Checks is
*** 266,282 ****
  
     --  The checks operate in one of two modes:
  
!    --    If Source_Typ is Empty, then the node Expr is examined, at the
!    --    very least to get the source subtype. In addition for some of
!    --    the checks, the actual form of the node may be examined. For
!    --    example, a node of type Integer whose actual form is an Integer
!    --    conversion from a type with range 0 .. 3 can be determined to
!    --    have a value in the range 0 .. 3.
  
!    --    If Source_Typ is given, then nothing can be assumed about the
!    --    Expr, and indeed its contents are not examined. In this case the
!    --    check is based on the assumption that Expr can be an arbitrary
!    --    value of the given Source_Typ.
  
     --  Currently, the only case in which a Source_Typ is explicitly supplied
     --  is for the case of Out and In_Out parameters, where, for the conversion
--- 270,285 ----
  
     --  The checks operate in one of two modes:
  
!    --    If Source_Typ is Empty, then the node Expr is examined, at the very
!    --    least to get the source subtype. In addition for some of the checks,
!    --    the actual form of the node may be examined. For example, a node of
!    --    type Integer whose actual form is an Integer conversion from a type
!    --    with range 0 .. 3 can be determined to have a value in range 0 .. 3.
  
!    --    If Source_Typ is given, then nothing can be assumed about the Expr,
!    --    and indeed its contents are not examined. In this case the check is
!    --    based on the assumption that Expr can be an arbitrary value of the
!    --    given Source_Typ.
  
     --  Currently, the only case in which a Source_Typ is explicitly supplied
     --  is for the case of Out and In_Out parameters, where, for the conversion
*************** package Checks is
*** 293,300 ****
     --  to Insert_Actions.
     --
     --  For access types, the Directly_Designated_Type is retrieved and
!    --  processing continues as enumerated above, with a guard against
!    --  null values.
     --
     --  Note: calls to Apply_Length_Check currently never supply an explicit
     --  Source_Typ parameter, but Apply_Length_Check takes this parameter and
--- 296,303 ----
     --  to Insert_Actions.
     --
     --  For access types, the Directly_Designated_Type is retrieved and
!    --  processing continues as enumerated above, with a guard against null
!    --  values.
     --
     --  Note: calls to Apply_Length_Check currently never supply an explicit
     --  Source_Typ parameter, but Apply_Length_Check takes this parameter and
*************** package Checks is
*** 305,313 ****
       (Ck_Node    : Node_Id;
        Target_Typ : Entity_Id;
        Source_Typ : Entity_Id := Empty);
!    --  For an Node of kind N_Range, constructs a range check action that
!    --  tests first that the range is not null and then that the range
!    --  is contained in the Target_Typ range.
     --
     --  For scalar types, constructs a range check action that first tests that
     --  the expression is contained in the Target_Typ range. The difference
--- 308,316 ----
       (Ck_Node    : Node_Id;
        Target_Typ : Entity_Id;
        Source_Typ : Entity_Id := Empty);
!    --  For an Node of kind N_Range, constructs a range check action that tests
!    --  first that the range is not null and then that the range is contained in
!    --  the Target_Typ range.
     --
     --  For scalar types, constructs a range check action that first tests that
     --  the expression is contained in the Target_Typ range. The difference
*************** package Checks is
*** 318,330 ****
     --  to check that each Expr range is properly contained in the range of
     --  Target_Typ.
     --
!    --  For a type conversion to an unconstrained array type, constructs
!    --  a range check action to check that the bounds of the source type
!    --  are within the constraints imposed by the Target_Typ.
     --
     --  For access types, the Directly_Designated_Type is retrieved and
!    --  processing continues as enumerated above, with a guard against
!    --  null values.
     --
     --  The source type is used by type conversions to unconstrained array
     --  types to retrieve the corresponding bounds.
--- 321,333 ----
     --  to check that each Expr range is properly contained in the range of
     --  Target_Typ.
     --
!    --  For a type conversion to an unconstrained array type, constructs a range
!    --  check action to check that the bounds of the source type are within the
!    --  constraints imposed by the Target_Typ.
     --
     --  For access types, the Directly_Designated_Type is retrieved and
!    --  processing continues as enumerated above, with a guard against null
!    --  values.
     --
     --  The source type is used by type conversions to unconstrained array
     --  types to retrieve the corresponding bounds.
*************** package Checks is
*** 344,353 ****
        Source_Typ : Entity_Id := Empty;
        Fixed_Int  : Boolean   := False);
     --  For scalar types, determines whether an expression node should be
!    --  flagged as needing a runtime range check. If the node requires such
!    --  a check, the Do_Range_Check flag is turned on. The Fixed_Int flag
!    --  if set causes any fixed-point values to be treated as though they
!    --  were discrete values (i.e. the underlying integer value is used).
  
     type Check_Result is private;
     --  Type used to return result of Range_Check call, for later use in
--- 347,356 ----
        Source_Typ : Entity_Id := Empty;
        Fixed_Int  : Boolean   := False);
     --  For scalar types, determines whether an expression node should be
!    --  flagged as needing a runtime range check. If the node requires such a
!    --  check, the Do_Range_Check flag is turned on. The Fixed_Int flag if set
!    --  causes any fixed-point values to be treated as though they were discrete
!    --  values (i.e. the underlying integer value is used).
  
     type Check_Result is private;
     --  Type used to return result of Range_Check call, for later use in
*************** package Checks is
*** 360,371 ****
        Static_Sloc  : Source_Ptr;
        Flag_Node    : Node_Id);
     --  Called to append range checks as returned by a call to Range_Check.
!    --  Stmts is a list to which either the dynamic check is appended or
!    --  the raise Constraint_Error statement is appended (for static checks).
!    --  Static_Sloc is the Sloc at which the raise CE node points,
!    --  Flag_Node is used as the node at which to set the Has_Dynamic_Check
!    --  flag. Checks_On is a boolean value that says if range and index checking
!    --  is on or not.
  
     procedure Insert_Range_Checks
       (Checks       : Check_Result;
--- 363,373 ----
        Static_Sloc  : Source_Ptr;
        Flag_Node    : Node_Id);
     --  Called to append range checks as returned by a call to Range_Check.
!    --  Stmts is a list to which either the dynamic check is appended or the
!    --  raise Constraint_Error statement is appended (for static checks).
!    --  Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
!    --  used as the node at which to set the Has_Dynamic_Check flag. Checks_On
!    --  is a boolean value that says if range and index checking is on or not.
  
     procedure Insert_Range_Checks
       (Checks       : Check_Result;
*************** package Checks is
*** 402,413 ****
     -- Expander Routines --
     -----------------------
  
!    --  Some of the earlier processing for checks results in temporarily
!    --  setting the Do_Range_Check flag rather than actually generating
!    --  checks. Now we are moving the generation of such checks into the
!    --  front end for reasons of efficiency and simplicity (there were
!    --  difficutlies in handling this in the back end when side effects
!    --  were present in the expressions being checked).
  
     --  Probably we could eliminate the Do_Range_Check flag entirely and
     --  generate the checks earlier, but this is a delicate area and it
--- 404,415 ----
     -- Expander Routines --
     -----------------------
  
!    --  Some of the earlier processing for checks results in temporarily setting
!    --  the Do_Range_Check flag rather than actually generating checks. Now we
!    --  are moving the generation of such checks into the front end for reasons
!    --  of efficiency and simplicity (there were difficutlies in handling this
!    --  in the back end when side effects were present in the expressions being
!    --  checked).
  
     --  Probably we could eliminate the Do_Range_Check flag entirely and
     --  generate the checks earlier, but this is a delicate area and it
*************** package Checks is
*** 419,455 ****
       (N           : Node_Id;
        Target_Type : Entity_Id;
        Reason      : RT_Exception_Code);
!    --  This procedure is called to actually generate and insert a range
!    --  check. A check is generated to ensure that the value of N lies
!    --  within the range of the target type. Note that the base type of
!    --  N may be different from the base type of the target type. This
!    --  happens in the conversion case. The Reason parameter is the
!    --  exception code to be used for the exception if raised.
     --
!    --  Note on the relation of this routine to the Do_Range_Check flag.
!    --  Mostly for historical reasons, we often set the Do_Range_Check
!    --  flag and then later we call Generate_Range_Check if this flag is
!    --  set. Most probably we could eliminate this intermediate setting
!    --  of the flag (historically the back end dealt with range checks,
!    --  using this flag to indicate if a check was required, then we
!    --  moved checks into the front end).
  
     procedure Generate_Index_Checks (N : Node_Id);
!    --  This procedure is called to generate index checks on the subscripts
!    --  for the indexed component node N. Each subscript expression is
!    --  examined, and if the Do_Range_Check flag is set, an appropriate
!    --  index check is generated and the flag is reset.
  
     --  Similarly, we set the flag Do_Discriminant_Check in the semantic
!    --  analysis to indicate that a discriminant check is required for a
!    --  selected component of a discriminated type. The following routine
!    --  is called from the expander to actually generate the call.
  
     procedure Generate_Discriminant_Check (N : Node_Id);
!    --  N is a selected component for which a discriminant check is required
!    --  to make sure that the discriminants have appropriate values for the
!    --  selection. This is done by calling the appropriate discriminant
!    --  checking routine for the selector.
  
     -----------------------
     -- Validity Checking --
--- 421,456 ----
       (N           : Node_Id;
        Target_Type : Entity_Id;
        Reason      : RT_Exception_Code);
!    --  This procedure is called to actually generate and insert a range check.
!    --  A check is generated to ensure that the value of N lies within the range
!    --  of the target type. Note that the base type of N may be different from
!    --  the base type of the target type. This happens in the conversion case.
!    --  The Reason parameter is the exception code to be used for the exception
!    --  if raised.
     --
!    --  Note on the relation of this routine to the Do_Range_Check flag. Mostly
!    --  for historical reasons, we often set the Do_Range_Check flag and then
!    --  later we call Generate_Range_Check if this flag is set. Most probably we
!    --  could eliminate this intermediate setting of the flag (historically the
!    --  back end dealt with range checks, using this flag to indicate if a check
!    --  was required, then we moved checks into the front end).
  
     procedure Generate_Index_Checks (N : Node_Id);
!    --  This procedure is called to generate index checks on the subscripts for
!    --  the indexed component node N. Each subscript expression is examined, and
!    --  if the Do_Range_Check flag is set, an appropriate index check is
!    --  generated and the flag is reset.
  
     --  Similarly, we set the flag Do_Discriminant_Check in the semantic
!    --  analysis to indicate that a discriminant check is required for selected
!    --  component of a discriminated type. The following routine is called from
!    --  the expander to actually generate the call.
  
     procedure Generate_Discriminant_Check (N : Node_Id);
!    --  N is a selected component for which a discriminant check is required to
!    --  make sure that the discriminants have appropriate values for the
!    --  selection. This is done by calling the appropriate discriminant checking
!    --  routine for the selector.
  
     -----------------------
     -- Validity Checking --
*************** package Checks is
*** 457,471 ****
  
     --  In (RM 13.9.1(9-11)) we have the following rules on invalid values
  
!    --    If the representation of a scalar object does not represent a
!    --    value of the object's subtype (perhaps because the object was not
!    --    initialized), the object is said to have an invalid representation.
!    --    It is a bounded error to evaluate the value of such an object.  If
!    --    the error is detected, either Constraint_Error or Program_Error is
!    --    raised.  Otherwise, execution continues using the invalid
!    --    representation.  The rules of the language outside this subclause
!    --    assume that all objects have valid representations.  The semantics
!    --    of operations on invalid representations are as follows:
     --
     --       10  If the representation of the object represents a value of the
     --           object's type, the value of the type is used.
--- 458,472 ----
  
     --  In (RM 13.9.1(9-11)) we have the following rules on invalid values
  
!    --    If the representation of a scalar object does not represent value of
!    --    the object's subtype (perhaps because the object was not initialized),
!    --    the object is said to have an invalid representation. It is a bounded
!    --    error to evaluate the value of such an object. If the error is
!    --    detected, either Constraint_Error or Program_Error is raised.
!    --    Otherwise, execution continues using the invalid representation. The
!    --    rules of the language outside this subclause assume that all objects
!    --    have valid representations. The semantics of operations on invalid
!    --    representations are as follows:
     --
     --       10  If the representation of the object represents a value of the
     --           object's type, the value of the type is used.
*************** package Checks is
*** 483,491 ****
     --  array assignments, where we don't want to do wild stores, and case
     --  statements where we don't want to do wild jumps.
  
!    --  In GNAT, we control validity checking with a switch -gnatV that
!    --  can take three parameters, n/d/f for None/Default/Full. These
!    --  modes have the following meanings:
  
     --    None (no validity checking)
  
--- 484,492 ----
     --  array assignments, where we don't want to do wild stores, and case
     --  statements where we don't want to do wild jumps.
  
!    --  In GNAT, we control validity checking with a switch -gnatV that can take
!    --  three parameters, n/d/f for None/Default/Full. These modes have the
!    --  following meanings:
  
     --    None (no validity checking)
  
*************** package Checks is
*** 547,553 ****
     --    If all possible stored values are valid, then any uninitialized
     --    value must be valid.
  
!    --    Literals, including enumeration literals, are clearly always valid.
  
     --    Constants are always assumed valid, with a validity check being
     --    performed on the initializing value where necessary to ensure that
--- 548,554 ----
     --    If all possible stored values are valid, then any uninitialized
     --    value must be valid.
  
!    --    Literals, including enumeration literals, are clearly always valid
  
     --    Constants are always assumed valid, with a validity check being
     --    performed on the initializing value where necessary to ensure that
*************** package Checks is
*** 577,588 ****
     --  are checked for validity.
  
     procedure Check_Valid_Lvalue_Subscripts (Expr : Node_Id);
!    --  Expr is a lvalue, i.e. an expression representing the target of
!    --  an assignment. This procedure checks for this expression involving
!    --  an assignment to an array value. We have to be sure that all the
!    --  subscripts in such a case are valid, since according to the rules
!    --  in (RM 13.9.1(9-11)) such assignments are not permitted to result
!    --  in erroneous behavior in the case of invalid subscript values.
  
     procedure Ensure_Valid (Expr : Node_Id; Holes_OK : Boolean := False);
     --  Ensure that Expr represents a valid value of its type. If this type
--- 578,589 ----
     --  are checked for validity.
  
     procedure Check_Valid_Lvalue_Subscripts (Expr : Node_Id);
!    --  Expr is a lvalue, i.e. an expression representing the target of an
!    --  assignment. This procedure checks for this expression involving an
!    --  assignment to an array value. We have to be sure that all the subscripts
!    --  in such a case are valid, since according to the rules in (RM
!    --  13.9.1(9-11)) such assignments are not permitted to result in erroneous
!    --  behavior in the case of invalid subscript values.
  
     procedure Ensure_Valid (Expr : Node_Id; Holes_OK : Boolean := False);
     --  Ensure that Expr represents a valid value of its type. If this type
*************** package Checks is
*** 602,615 ****
     --  valid, raising Constraint_Error if the value is not valid.
  
     function Expr_Known_Valid (Expr : Node_Id) return Boolean;
!    --  This function tests it the value of Expr is known to be valid in
!    --  the sense of RM 13.9.1(9-11). In the case of GNAT, it is only
!    --  discrete types which are a concern, since for non-discrete types
!    --  we simply continue computation with invalid values, which does
!    --  not lead to erroneous behavior. Thus Expr_Known_Valid always
!    --  returns True if the type of Expr is non-discrete. For discrete
!    --  types the value returned is True only if it can be determined
!    --  that the value is Valid. Otherwise False is returned.
  
     procedure Insert_Valid_Check (Expr : Node_Id);
     --  Inserts code that will check for the value of Expr being valid, in
--- 603,616 ----
     --  valid, raising Constraint_Error if the value is not valid.
  
     function Expr_Known_Valid (Expr : Node_Id) return Boolean;
!    --  This function tests it the value of Expr is known to be valid in the
!    --  sense of RM 13.9.1(9-11). In the case of GNAT, it is only discrete types
!    --  which are a concern, since for non-discrete types we simply continue
!    --  computation with invalid values, which does not lead to erroneous
!    --  behavior. Thus Expr_Known_Valid always returns True if the type of Expr
!    --  is non-discrete. For discrete types the value returned is True only if
!    --  it can be determined that the value is Valid. Otherwise False is
!    --  returned.
  
     procedure Insert_Valid_Check (Expr : Node_Id);
     --  Inserts code that will check for the value of Expr being valid, in
*************** private
*** 635,646 ****
     --    responsibility of the caller to rewrite and substitute the nodes with
     --    N_Raise_Constraint_Error nodes.
     --
!    --    For the non-static case a single N_Raise_Constraint_Error node
!    --    with a non-empty Condition field is returned.
     --
!    --  Unused entries in Check_Result, if any, are simply set to Empty
!    --  For external clients, the required processing on this result is
!    --  achieved using the Insert_Range_Checks routine.
  
     pragma Inline (Apply_Length_Check);
     pragma Inline (Apply_Range_Check);
--- 636,647 ----
     --    responsibility of the caller to rewrite and substitute the nodes with
     --    N_Raise_Constraint_Error nodes.
     --
!    --    For the non-static case a single N_Raise_Constraint_Error node with a
!    --    non-empty Condition field is returned.
     --
!    --  Unused entries in Check_Result, if any, are simply set to Empty For
!    --  external clients, the required processing on this result is achieved
!    --  using the Insert_Range_Checks routine.
  
     pragma Inline (Apply_Length_Check);
     pragma Inline (Apply_Range_Check);
diff -Nrcpad gcc-4.0.2/gcc/ada/cio.c gcc-4.1.0/gcc/ada/cio.c
*** gcc-4.0.2/gcc/ada/cio.c	Fri Oct 31 01:08:40 2003
--- gcc-4.1.0/gcc/ada/cio.c	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 51,56 ****
--- 51,61 ----
  #undef stdout
  #endif
  
+ #ifdef VTHREADS
+ #undef putchar
+ #undef getchar
+ #endif
+ 
  int
  get_char (void)
  {
diff -Nrcpad gcc-4.0.2/gcc/ada/clean.adb gcc-4.1.0/gcc/ada/clean.adb
*** gcc-4.0.2/gcc/ada/clean.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/clean.adb	Tue Nov 15 13:56:14 2005
***************
*** 16,31 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Ada.Command_Line; use Ada.Command_Line;
- 
  with ALI;      use ALI;
  with Csets;
  with Gnatvsn;
--- 16,29 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with ALI;      use ALI;
  with Csets;
  with Gnatvsn;
*************** with Opt;      use Opt;
*** 37,43 ****
  with Osint;    use Osint;
  with Osint.M;  use Osint.M;
  with Prj;      use Prj;
- with Prj.Com;
  with Prj.Env;
  with Prj.Ext;
  with Prj.Pars;
--- 35,40 ----
*************** with Snames;
*** 46,51 ****
--- 43,50 ----
  with Table;
  with Types;    use Types;
  
+ with Ada.Command_Line;          use Ada.Command_Line;
+ 
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  with GNAT.IO;                   use GNAT.IO;
  with GNAT.OS_Lib;               use GNAT.OS_Lib;
*************** package body Clean is
*** 92,97 ****
--- 91,98 ----
  
     Project_File_Name : String_Access := null;
  
+    Project_Tree : constant Prj.Project_Tree_Ref := new Prj.Project_Tree_Data;
+ 
     Main_Project : Prj.Project_Id := Prj.No_Project;
  
     All_Projects : Boolean := False;
*************** package body Clean is
*** 190,202 ****
     --  Delete a global archive or a fake library project archive and the
     --  dependency file, if they exist.
  
-    procedure Clean_Directory (Dir : Name_Id);
-    --  Delete all regular files in a library directory or in a library
-    --  interface dir.
- 
     procedure Clean_Executables;
     --  Do the cleaning work when no project file is specified
  
     procedure Clean_Project (Project : Project_Id);
     --  Do the cleaning work when a project file is specified.
     --  This procedure calls itself recursively when there are several
--- 191,207 ----
     --  Delete a global archive or a fake library project archive and the
     --  dependency file, if they exist.
  
     procedure Clean_Executables;
     --  Do the cleaning work when no project file is specified
  
+    procedure Clean_Interface_Copy_Directory (Project : Project_Id);
+    --  Delete files in an interface coy directory directory: any file that is
+    --  a copy of a source of the project.
+ 
+    procedure Clean_Library_Directory (Project : Project_Id);
+    --  Delete the library file in a library directory and any ALI file
+    --  of a source of the project in a library ALI directory.
+ 
     procedure Clean_Project (Project : Project_Id);
     --  Do the cleaning work when a project file is specified.
     --  This procedure calls itself recursively when there are several
*************** package body Clean is
*** 240,245 ****
--- 245,255 ----
     --  Returns True iff Prj is an extension of Of_Project or if Of_Project is
     --  an extension of Prj.
  
+    function Ultimate_Extension_Of (Project : Project_Id) return Project_Id;
+    --  Returns either Project, if it is not extended by another project, or
+    --  the project that extends Project, directly or indirectly, and that is
+    --  not itself extended. Returns No_Project if Project is No_Project.
+ 
     procedure Usage;
     --  Display the usage.
     --  If called several times, the usage is displayed only the first time.
*************** package body Clean is
*** 328,334 ****
  
     procedure Clean_Archive (Project : Project_Id) is
        Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
!       Data        : constant Project_Data := Projects.Table (Project);
  
        Archive_Name : constant String :=
                         "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
--- 338,345 ----
  
     procedure Clean_Archive (Project : Project_Id) is
        Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
!       Data        : constant Project_Data :=
!                       Project_Tree.Projects.Table (Project);
  
        Archive_Name : constant String :=
                         "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
*************** package body Clean is
*** 354,399 ****
        Change_Dir (Current_Dir);
     end Clean_Archive;
  
-    ---------------------
-    -- Clean_Directory --
-    ---------------------
- 
-    procedure Clean_Directory (Dir : Name_Id) is
-       Directory : constant String := Get_Name_String (Dir);
-       Current   : constant Dir_Name_Str := Get_Current_Dir;
- 
-       Direc : Dir_Type;
- 
-       Name : String (1 .. 200);
-       Last : Natural;
- 
-    begin
-       Change_Dir (Directory);
-       Open (Direc, ".");
- 
-       --  For each regular file in the directory, if switch -n has not been
-       --  specified, make it writable and delete the file.
- 
-       loop
-          Read (Direc, Name, Last);
-          exit when Last = 0;
- 
-          if Is_Regular_File (Name (1 .. Last)) then
-             if not Do_Nothing then
-                Set_Writable (Name (1 .. Last));
-             end if;
- 
-             Delete (Directory, Name (1 .. Last));
-          end if;
-       end loop;
- 
-       Close (Direc);
- 
-       --  Restore the initial working directory
- 
-       Change_Dir (Current);
-    end Clean_Directory;
- 
     -----------------------
     -- Clean_Executables --
     -----------------------
--- 365,370 ----
*************** package body Clean is
*** 548,553 ****
--- 519,760 ----
        end loop;
     end Clean_Executables;
  
+    ------------------------------------
+    -- Clean_Interface_Copy_Directory --
+    ------------------------------------
+ 
+    procedure Clean_Interface_Copy_Directory (Project : Project_Id) is
+       Current : constant String := Get_Current_Dir;
+       Data    : constant Project_Data := Project_Tree.Projects.Table (Project);
+ 
+       Direc : Dir_Type;
+ 
+       Name : String (1 .. 200);
+       Last : Natural;
+ 
+       Delete_File : Boolean;
+       Unit        : Unit_Data;
+ 
+    begin
+       if Data.Library and then Data.Library_Src_Dir /= No_Name then
+          declare
+             Directory : constant String :=
+                           Get_Name_String (Data.Library_Src_Dir);
+ 
+          begin
+             Change_Dir (Get_Name_String (Data.Library_Src_Dir));
+             Open (Direc, ".");
+ 
+             --  For each regular file in the directory, if switch -n has not
+             --  been specified, make it writable and delete the file if it is
+             --  a copy of a source of the project.
+ 
+             loop
+                Read (Direc, Name, Last);
+                exit when Last = 0;
+ 
+                if Is_Regular_File (Name (1 .. Last)) then
+                   Canonical_Case_File_Name (Name (1 .. Last));
+                   Delete_File := False;
+ 
+                   --  Compare with source file names of the project
+ 
+                   for Index in 1 .. Unit_Table.Last (Project_Tree.Units) loop
+                      Unit := Project_Tree.Units.Table (Index);
+ 
+                      if Ultimate_Extension_Of
+                        (Unit.File_Names (Body_Part).Project) = Project
+                        and then
+                          Get_Name_String
+                            (Unit.File_Names (Body_Part).Name) =
+                        Name (1 .. Last)
+                      then
+                         Delete_File := True;
+                         exit;
+                      end if;
+ 
+                      if Ultimate_Extension_Of
+                        (Unit.File_Names (Specification).Project) = Project
+                        and then
+                          Get_Name_String
+                            (Unit.File_Names (Specification).Name) =
+                        Name (1 .. Last)
+                      then
+                         Delete_File := True;
+                         exit;
+                      end if;
+                   end loop;
+ 
+                   if Delete_File then
+                      if not Do_Nothing then
+                         Set_Writable (Name (1 .. Last));
+                      end if;
+ 
+                      Delete (Directory, Name (1 .. Last));
+                   end if;
+                end if;
+             end loop;
+ 
+             Close (Direc);
+ 
+             --  Restore the initial working directory
+ 
+             Change_Dir (Current);
+          end;
+       end if;
+    end Clean_Interface_Copy_Directory;
+ 
+    -----------------------------
+    -- Clean_Library_Directory --
+    -----------------------------
+ 
+    procedure Clean_Library_Directory (Project : Project_Id) is
+       Current : constant String := Get_Current_Dir;
+       Data    : constant Project_Data := Project_Tree.Projects.Table (Project);
+ 
+       Lib_Filename : constant String := Get_Name_String (Data.Library_Name);
+       DLL_Name     : constant String :=
+                        DLL_Prefix & Lib_Filename & "." & DLL_Ext;
+       Archive_Name : constant String :=
+                        "lib" & Lib_Filename & "." & Archive_Ext;
+       Direc        : Dir_Type;
+ 
+       Name : String (1 .. 200);
+       Last : Natural;
+ 
+       Delete_File : Boolean;
+ 
+    begin
+       if Data.Library then
+          declare
+             Lib_Directory     : constant String :=
+                                   Get_Name_String (Data.Library_Dir);
+             Lib_ALI_Directory : constant String :=
+                                   Get_Name_String (Data.Library_ALI_Dir);
+ 
+          begin
+             Change_Dir (Lib_Directory);
+             Open (Direc, ".");
+ 
+             --  For each regular file in the directory, if switch -n has not
+             --  been specified, make it writable and delete the file if it is
+             --  the library file.
+ 
+             loop
+                Read (Direc, Name, Last);
+                exit when Last = 0;
+ 
+                if Is_Regular_File (Name (1 .. Last)) then
+                   Canonical_Case_File_Name (Name (1 .. Last));
+                   Delete_File := False;
+ 
+                   if (Data.Library_Kind = Static and then
+                         Name (1 .. Last) =  Archive_Name)
+                     or else
+                       ((Data.Library_Kind = Dynamic or else
+                           Data.Library_Kind = Relocatable)
+                        and then
+                          Name (1 .. Last) = DLL_Name)
+                   then
+                      if not Do_Nothing then
+                         Set_Writable (Name (1 .. Last));
+                      end if;
+ 
+                      Delete (Lib_Directory, Name (1 .. Last));
+                      exit;
+                   end if;
+                end if;
+             end loop;
+ 
+             Close (Direc);
+ 
+             Change_Dir (Lib_ALI_Directory);
+             Open (Direc, ".");
+ 
+             --  For each regular file in the directory, if switch -n has not
+             --  been specified, make it writable and delete the file if it is
+             --  any ALI file of a source of the project.
+ 
+             loop
+                Read (Direc, Name, Last);
+                exit when Last = 0;
+ 
+                if Is_Regular_File (Name (1 .. Last)) then
+                   Canonical_Case_File_Name (Name (1 .. Last));
+                   Delete_File := False;
+ 
+                   if Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
+                      declare
+                         Unit : Unit_Data;
+                      begin
+                         --  Compare with ALI file names of the project
+ 
+                         for
+                           Index in 1 .. Unit_Table.Last (Project_Tree.Units)
+                         loop
+                            Unit := Project_Tree.Units.Table (Index);
+ 
+                            if Unit.File_Names (Body_Part).Project /=
+                              No_Project
+                            then
+                               if  Ultimate_Extension_Of
+                                 (Unit.File_Names (Body_Part).Project) =
+                                  Project
+                               then
+                                  Get_Name_String
+                                    (Unit.File_Names (Body_Part).Name);
+                                  Name_Len := Name_Len -
+                                    File_Extension
+                                      (Name (1 .. Name_Len))'Length;
+                                  if Name_Buffer (1 .. Name_Len) =
+                                      Name (1 .. Last - 4)
+                                  then
+                                     Delete_File := True;
+                                     exit;
+                                  end if;
+                               end if;
+ 
+                            elsif Ultimate_Extension_Of
+                                    (Unit.File_Names (Specification).Project) =
+                                                                         Project
+                            then
+                               Get_Name_String
+                                 (Unit.File_Names (Specification).Name);
+                               Name_Len := Name_Len -
+                                             File_Extension
+                                               (Name (1 .. Name_Len))'Length;
+ 
+                               if Name_Buffer (1 .. Name_Len) =
+                                    Name (1 .. Last - 4)
+                               then
+                                  Delete_File := True;
+                                  exit;
+                               end if;
+                            end if;
+                         end loop;
+                      end;
+                   end if;
+ 
+                   if Delete_File then
+                      if not Do_Nothing then
+                         Set_Writable (Name (1 .. Last));
+                      end if;
+ 
+                      Delete (Lib_ALI_Directory, Name (1 .. Last));
+                   end if;
+ 
+                end if;
+             end loop;
+ 
+             Close (Direc);
+ 
+             --  Restore the initial working directory
+ 
+             Change_Dir (Current);
+          end;
+       end if;
+    end Clean_Library_Directory;
+ 
     -------------------
     -- Clean_Project --
     -------------------
*************** package body Clean is
*** 560,567 ****
        --  Name of the executable file
  
        Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
!       Data        : constant Project_Data := Projects.Table (Project);
!       U_Data      : Prj.Com.Unit_Data;
        File_Name1  : Name_Id;
        Index1      : Int;
        File_Name2  : Name_Id;
--- 767,775 ----
        --  Name of the executable file
  
        Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
!       Data        : constant Project_Data :=
!                       Project_Tree.Projects.Table (Project);
!       U_Data      : Unit_Data;
        File_Name1  : Name_Id;
        Index1      : Int;
        File_Name2  : Name_Id;
*************** package body Clean is
*** 573,580 ****
  
        Global_Archive : Boolean := False;
  
-       use Prj.Com;
- 
     begin
        --  Check that we don't specify executable on the command line for
        --  a main library project.
--- 781,786 ----
*************** package body Clean is
*** 587,830 ****
             ("Cannot specify executable(s) for a Library Project File");
        end if;
  
!       if Verbose_Mode then
!          Put ("Cleaning project """);
!          Put (Get_Name_String (Data.Name));
!          Put_Line ("""");
!       end if;
  
!       --  Add project to the list of processed projects
  
!       Processed_Projects.Increment_Last;
!       Processed_Projects.Table (Processed_Projects.Last) := Project;
  
!       if Data.Object_Directory /= No_Name then
!          declare
!             Obj_Dir : constant String :=
!                         Get_Name_String (Data.Object_Directory);
  
!          begin
!             Change_Dir (Obj_Dir);
  
!             --  First, deal with Ada
  
!             --  Look through the units to find those that are either immediate
!             --  sources or inherited sources of the project.
  
!             if Data.Languages (Ada_Language_Index) then
!                for Unit in 1 .. Prj.Com.Units.Last loop
!                   U_Data := Prj.Com.Units.Table (Unit);
!                   File_Name1 := No_Name;
!                   File_Name2 := No_Name;
  
!                   --  If either the spec or the body is a source of the
!                   --  project, check for the corresponding ALI file in the
!                   --  object directory.
  
!                   if In_Extension_Chain
!                     (U_Data.File_Names (Body_Part).Project, Project)
!                     or else
!                       In_Extension_Chain
!                         (U_Data.File_Names (Specification).Project, Project)
!                   then
!                      File_Name1 := U_Data.File_Names (Body_Part).Name;
!                      Index1     := U_Data.File_Names (Body_Part).Index;
!                      File_Name2 := U_Data.File_Names (Specification).Name;
!                      Index2     := U_Data.File_Names (Specification).Index;
  
!                      --  If there is no body file name, then there may be only
!                      --  a spec.
  
!                      if File_Name1 = No_Name then
!                         File_Name1 := File_Name2;
!                         Index1     := Index2;
!                         File_Name2 := No_Name;
!                         Index2     := 0;
                       end if;
-                   end if;
  
!                   --  If there is either a spec or a body, look for files
!                   --  in the object directory.
  
!                   if File_Name1 /= No_Name then
!                      Lib_File := Osint.Lib_File_Name (File_Name1, Index1);
  
!                      declare
!                         Asm : constant String := Assembly_File_Name (Lib_File);
!                         ALI : constant String := ALI_File_Name      (Lib_File);
!                         Obj : constant String := Object_File_Name   (Lib_File);
!                         Adt : constant String := Tree_File_Name     (Lib_File);
!                         Deb : constant String :=
!                                 Debug_File_Name (File_Name1);
!                         Rep : constant String :=
!                                 Repinfo_File_Name (File_Name1);
!                         Del : Boolean := True;
  
!                      begin
!                         --  If the ALI file exists and is read-only, no file
!                         --  is deleted.
  
!                         if Is_Regular_File (ALI) then
!                            if Is_Writable_File (ALI) then
!                               Delete (Obj_Dir, ALI);
  
!                            else
!                               Del := False;
  
!                               if Verbose_Mode then
!                                  Put ('"');
!                                  Put (Obj_Dir);
  
!                                  if Obj_Dir (Obj_Dir'Last) /=
                                        Dir_Separator
!                                  then
!                                     Put (Dir_Separator);
!                                  end if;
  
!                                  Put (ALI);
!                                  Put_Line (""" is read-only");
                                end if;
                             end if;
-                         end if;
  
!                         if Del then
  
!                            --  Object file
  
!                            if Is_Regular_File (Obj) then
!                               Delete (Obj_Dir, Obj);
!                            end if;
  
!                            --  Assembly file
  
!                            if Is_Regular_File (Asm) then
!                               Delete (Obj_Dir, Asm);
!                            end if;
  
!                            --  Tree file
  
!                            if Is_Regular_File (Adt) then
!                               Delete (Obj_Dir, Adt);
!                            end if;
  
!                            --  First expanded source file
  
!                            if Is_Regular_File (Deb) then
!                               Delete (Obj_Dir, Deb);
!                            end if;
  
!                            --  Repinfo file
  
!                            if Is_Regular_File (Rep) then
!                               Delete (Obj_Dir, Rep);
!                            end if;
  
!                            --  Second expanded source file
  
!                            if File_Name2 /= No_Name then
!                               declare
!                                  Deb : constant String :=
!                                          Debug_File_Name   (File_Name2);
!                                  Rep : constant String :=
!                                          Repinfo_File_Name (File_Name2);
!                               begin
!                                  if Is_Regular_File (Deb) then
!                                     Delete (Obj_Dir, Deb);
!                                  end if;
  
!                                  if Is_Regular_File (Rep) then
!                                     Delete (Obj_Dir, Rep);
!                                  end if;
!                               end;
                             end if;
!                         end if;
!                      end;
!                   end if;
!                end loop;
!             end if;
  
!             --  Check if a global archive and it dependency file could have
!             --  been created and, if they exist, delete them.
  
!             if Project = Main_Project and then not Data.Library then
!                Global_Archive := False;
  
!                for Proj in 1 .. Projects.Last loop
!                   if Projects.Table (Proj).Other_Sources_Present then
!                      Global_Archive := True;
!                      exit;
!                   end if;
!                end loop;
  
!                if Global_Archive then
!                   Clean_Archive (Project);
                 end if;
-             end if;
- 
-             if Data.Other_Sources_Present then
  
!                --  There is non-Ada code: delete the object files and
!                --  the dependency files if they exist.
  
!                Source_Id := Data.First_Other_Source;
  
!                while Source_Id /= No_Other_Source loop
!                   Source := Other_Sources.Table (Source_Id);
  
!                   if Is_Regular_File
                         (Get_Name_String (Source.Object_Name))
!                   then
!                      Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
!                   end if;
  
!                   if Is_Regular_File (Get_Name_String (Source.Dep_Name)) then
!                      Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
!                   end if;
  
!                   Source_Id := Source.Next;
!                end loop;
  
!                --  If it is a library with only non Ada sources, delete
!                --  the fake archive and the dependency file, if they exist.
  
!                if Data.Library
!                  and then not Data.Languages (Ada_Language_Index)
!                then
!                   Clean_Archive (Project);
                 end if;
!             end if;
!          end;
!       end if;
  
!       --  If this is a library project, clean the library directory, the
!       --  interface copy dir and, for a Stand-Alone Library, the binder
!       --  generated files of the library.
  
!       --  The directories are cleaned only if switch -c is not specified
  
!       if Data.Library then
!          if not Compile_Only then
!             Clean_Directory (Data.Library_Dir);
  
!             if Data.Library_Src_Dir /= No_Name
!               and then Data.Library_Src_Dir /= Data.Library_Dir
              then
!                Clean_Directory (Data.Library_Src_Dir);
              end if;
           end if;
  
!          if Data.Standalone_Library and then
!             Data.Object_Directory /= No_Name
!          then
!             Delete_Binder_Generated_Files
!               (Get_Name_String (Data.Object_Directory), Data.Library_Name);
           end if;
        end if;
  
-       if Verbose_Mode then
-          New_Line;
-       end if;
- 
        --  If switch -r is specified, call Clean_Project recursively for the
        --  imported projects and the project being extended.
  
--- 793,1063 ----
             ("Cannot specify executable(s) for a Library Project File");
        end if;
  
!       --  Nothing to clean in an externally built project
  
!       if Data.Externally_Built then
!          if Verbose_Mode then
!             Put ("Nothing to do to clean externally built project """);
!             Put (Get_Name_String (Data.Name));
!             Put_Line ("""");
!          end if;
  
!       else
!          if Verbose_Mode then
!             Put ("Cleaning project """);
!             Put (Get_Name_String (Data.Name));
!             Put_Line ("""");
!          end if;
  
!          --  Add project to the list of processed projects
  
!          Processed_Projects.Increment_Last;
!          Processed_Projects.Table (Processed_Projects.Last) := Project;
  
!          if Data.Object_Directory /= No_Name then
!             declare
!                Obj_Dir : constant String :=
!                            Get_Name_String (Data.Object_Directory);
  
!             begin
!                Change_Dir (Obj_Dir);
  
!                --  First, deal with Ada
  
!                --  Look through the units to find those that are either
!                --  immediate sources or inherited sources of the project.
!                --  Extending projects may have no language specified, if
!                --  Source_Dirs or Source_Files is specified as an empty list,
!                --  so always look for Ada units in extending projects.
  
!                if Data.Languages (Ada_Language_Index)
!                  or else Data.Extends /= No_Project
!                then
!                   for Unit in Unit_Table.First ..
!                     Unit_Table.Last (Project_Tree.Units)
!                   loop
!                      U_Data := Project_Tree.Units.Table (Unit);
!                      File_Name1 := No_Name;
!                      File_Name2 := No_Name;
  
!                      --  If either the spec or the body is a source of the
!                      --  project, check for the corresponding ALI file in the
!                      --  object directory.
  
!                      if In_Extension_Chain
!                        (U_Data.File_Names (Body_Part).Project, Project)
!                        or else
!                          In_Extension_Chain
!                            (U_Data.File_Names (Specification).Project, Project)
!                      then
!                         File_Name1 := U_Data.File_Names (Body_Part).Name;
!                         Index1     := U_Data.File_Names (Body_Part).Index;
!                         File_Name2 := U_Data.File_Names (Specification).Name;
!                         Index2     := U_Data.File_Names (Specification).Index;
! 
!                         --  If there is no body file name, then there may be
!                         --  only a spec.
! 
!                         if File_Name1 = No_Name then
!                            File_Name1 := File_Name2;
!                            Index1     := Index2;
!                            File_Name2 := No_Name;
!                            Index2     := 0;
!                         end if;
                       end if;
  
!                      --  If there is either a spec or a body, look for files
!                      --  in the object directory.
  
!                      if File_Name1 /= No_Name then
!                         Lib_File := Osint.Lib_File_Name (File_Name1, Index1);
  
!                         declare
!                            Asm : constant String :=
!                                    Assembly_File_Name (Lib_File);
!                            ALI : constant String :=
!                                    ALI_File_Name      (Lib_File);
!                            Obj : constant String :=
!                                    Object_File_Name   (Lib_File);
!                            Adt : constant String :=
!                                    Tree_File_Name     (Lib_File);
!                            Deb : constant String :=
!                                    Debug_File_Name (File_Name1);
!                            Rep : constant String :=
!                                    Repinfo_File_Name (File_Name1);
!                            Del : Boolean := True;
  
!                         begin
!                            --  If the ALI file exists and is read-only, no file
!                            --  is deleted.
  
!                            if Is_Regular_File (ALI) then
!                               if Is_Writable_File (ALI) then
!                                  Delete (Obj_Dir, ALI);
  
!                               else
!                                  Del := False;
  
!                                  if Verbose_Mode then
!                                     Put ('"');
!                                     Put (Obj_Dir);
  
!                                     if Obj_Dir (Obj_Dir'Last) /=
                                        Dir_Separator
!                                     then
!                                        Put (Dir_Separator);
!                                     end if;
  
!                                     Put (ALI);
!                                     Put_Line (""" is read-only");
!                                  end if;
                                end if;
                             end if;
  
!                            if Del then
  
!                               --  Object file
  
!                               if Is_Regular_File (Obj) then
!                                  Delete (Obj_Dir, Obj);
!                               end if;
  
!                               --  Assembly file
  
!                               if Is_Regular_File (Asm) then
!                                  Delete (Obj_Dir, Asm);
!                               end if;
  
!                               --  Tree file
  
!                               if Is_Regular_File (Adt) then
!                                  Delete (Obj_Dir, Adt);
!                               end if;
  
!                               --  First expanded source file
  
!                               if Is_Regular_File (Deb) then
!                                  Delete (Obj_Dir, Deb);
!                               end if;
  
!                               --  Repinfo file
  
!                               if Is_Regular_File (Rep) then
!                                  Delete (Obj_Dir, Rep);
!                               end if;
  
!                               --  Second expanded source file
  
!                               if File_Name2 /= No_Name then
!                                  declare
!                                     Deb : constant String :=
!                                             Debug_File_Name (File_Name2);
!                                     Rep : constant String :=
!                                             Repinfo_File_Name (File_Name2);
  
!                                  begin
!                                     if Is_Regular_File (Deb) then
!                                        Delete (Obj_Dir, Deb);
!                                     end if;
! 
!                                     if Is_Regular_File (Rep) then
!                                        Delete (Obj_Dir, Rep);
!                                     end if;
!                                  end;
!                               end if;
                             end if;
!                         end;
!                      end if;
!                   end loop;
!                end if;
  
!                --  Check if a global archive and it dependency file could have
!                --  been created and, if they exist, delete them.
  
!                if Project = Main_Project and then not Data.Library then
!                   Global_Archive := False;
  
!                   for Proj in Project_Table.First ..
!                     Project_Table.Last (Project_Tree.Projects)
!                   loop
!                      if Project_Tree.Projects.Table
!                        (Proj).Other_Sources_Present
!                      then
!                         Global_Archive := True;
!                         exit;
!                      end if;
!                   end loop;
  
!                   if Global_Archive then
!                      Clean_Archive (Project);
!                   end if;
                 end if;
  
!                if Data.Other_Sources_Present then
  
!                   --  There is non-Ada code: delete the object files and
!                   --  the dependency files if they exist.
  
!                   Source_Id := Data.First_Other_Source;
!                   while Source_Id /= No_Other_Source loop
!                      Source :=
!                        Project_Tree.Other_Sources.Table (Source_Id);
  
!                      if Is_Regular_File
                         (Get_Name_String (Source.Object_Name))
!                      then
!                         Delete (Obj_Dir, Get_Name_String (Source.Object_Name));
!                      end if;
  
!                      if
!                        Is_Regular_File (Get_Name_String (Source.Dep_Name))
!                      then
!                         Delete (Obj_Dir, Get_Name_String (Source.Dep_Name));
!                      end if;
  
!                      Source_Id := Source.Next;
!                   end loop;
  
!                   --  If it is a library with only non Ada sources, delete
!                   --  the fake archive and the dependency file, if they exist.
  
!                   if Data.Library
!                     and then not Data.Languages (Ada_Language_Index)
!                   then
!                      Clean_Archive (Project);
!                   end if;
                 end if;
!             end;
!          end if;
  
!          --  If this is a library project, clean the library directory, the
!          --  interface copy dir and, for a Stand-Alone Library, the binder
!          --  generated files of the library.
  
!          --  The directories are cleaned only if switch -c is not specified
  
!          if Data.Library then
!             if not Compile_Only then
!                Clean_Library_Directory (Project);
  
!                if Data.Library_Src_Dir /= No_Name then
!                   Clean_Interface_Copy_Directory (Project);
!                end if;
!             end if;
! 
!             if Data.Standalone_Library and then
!               Data.Object_Directory /= No_Name
              then
!                Delete_Binder_Generated_Files
!                  (Get_Name_String (Data.Object_Directory), Data.Library_Name);
              end if;
           end if;
  
!          if Verbose_Mode then
!             New_Line;
           end if;
        end if;
  
        --  If switch -r is specified, call Clean_Project recursively for the
        --  imported projects and the project being extended.
  
*************** package body Clean is
*** 839,845 ****
              --  has not been processed already.
  
              while Imported /= Empty_Project_List loop
!                Element := Project_Lists.Table (Imported);
                 Imported := Element.Next;
                 Process := True;
  
--- 1072,1078 ----
              --  has not been processed already.
  
              while Imported /= Empty_Project_List loop
!                Element := Project_Tree.Project_Lists.Table (Imported);
                 Imported := Element.Next;
                 Process := True;
  
*************** package body Clean is
*** 876,882 ****
        if Project = Main_Project and then Data.Exec_Directory /= No_Name then
           declare
              Exec_Dir : constant String :=
!               Get_Name_String (Data.Exec_Directory);
           begin
              Change_Dir (Exec_Dir);
  
--- 1109,1116 ----
        if Project = Main_Project and then Data.Exec_Directory /= No_Name then
           declare
              Exec_Dir : constant String :=
!                          Get_Name_String (Data.Exec_Directory);
! 
           begin
              Change_Dir (Exec_Dir);
  
*************** package body Clean is
*** 887,898 ****
                    Executable :=
                      Executable_Of
                        (Main_Project,
                         Main_Source_File,
                         Current_File_Index);
  
!                   if Is_Regular_File (Get_Name_String (Executable)) then
!                      Delete (Exec_Dir, Get_Name_String (Executable));
!                   end if;
                 end if;
  
                 if Data.Object_Directory /= No_Name then
--- 1121,1146 ----
                    Executable :=
                      Executable_Of
                        (Main_Project,
+                        Project_Tree,
                         Main_Source_File,
                         Current_File_Index);
  
!                   declare
!                      Exec_File_Name : constant String :=
!                                         Get_Name_String (Executable);
! 
!                   begin
!                      if Is_Absolute_Path (Name => Exec_File_Name) then
!                         if Is_Regular_File (Exec_File_Name) then
!                            Delete ("", Exec_File_Name);
!                         end if;
! 
!                      else
!                         if Is_Regular_File (Exec_File_Name) then
!                            Delete (Exec_Dir, Exec_File_Name);
!                         end if;
!                      end if;
!                   end;
                 end if;
  
                 if Data.Object_Directory /= No_Name then
*************** package body Clean is
*** 1099,1111 ****
           --  Set the project parsing verbosity to whatever was specified
           --  by a possible -vP switch.
  
!          Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
  
           --  Parse the project file. If there is an error, Main_Project
           --  will still be No_Project.
  
           Prj.Pars.Parse
             (Project           => Main_Project,
              Project_File_Name => Project_File_Name.all,
              Packages_To_Check => Packages_To_Check_By_Gnatmake);
  
--- 1347,1360 ----
           --  Set the project parsing verbosity to whatever was specified
           --  by a possible -vP switch.
  
!          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
  
           --  Parse the project file. If there is an error, Main_Project
           --  will still be No_Project.
  
           Prj.Pars.Parse
             (Project           => Main_Project,
+             In_Tree           => Project_Tree,
              Project_File_Name => Project_File_Name.all,
              Packages_To_Check => Packages_To_Check_By_Gnatmake);
  
*************** package body Clean is
*** 1121,1132 ****
              New_Line;
           end if;
  
!          --  We add the source directories and the object directories
!          --  to the search paths.
! 
!          Add_Source_Directories (Main_Project);
!          Add_Object_Directories (Main_Project);
  
        end if;
  
        Osint.Add_Default_Search_Dirs;
--- 1370,1379 ----
              New_Line;
           end if;
  
!          --  Add source directories and object directories to the search paths
  
+          Add_Source_Directories (Main_Project, Project_Tree);
+          Add_Object_Directories (Main_Project, Project_Tree);
        end if;
  
        Osint.Add_Default_Search_Dirs;
*************** package body Clean is
*** 1137,1147 ****
  
        if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
           declare
!             Value : String_List_Id := Projects.Table (Main_Project).Mains;
              Main  : String_Element;
           begin
              while Value /= Prj.Nil_String loop
!                Main := String_Elements.Table (Value);
                 Osint.Add_File
                   (File_Name => Get_Name_String (Main.Value),
                    Index     => Main.Index);
--- 1384,1395 ----
  
        if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
           declare
!             Value : String_List_Id :=
!                       Project_Tree.Projects.Table (Main_Project).Mains;
              Main  : String_Element;
           begin
              while Value /= Prj.Nil_String loop
!                Main := Project_Tree.String_Elements.Table (Value);
                 Osint.Add_File
                   (File_Name => Get_Name_String (Main.Value),
                    Index     => Main.Index);
*************** package body Clean is
*** 1211,1234 ****
           return True;
        end if;
  
!       Data := Projects.Table (Of_Project);
  
        while Data.Extends /= No_Project loop
           if Data.Extends = Prj then
              return True;
           end if;
  
!          Data := Projects.Table (Data.Extends);
        end loop;
  
!       Data := Projects.Table (Prj);
  
        while Data.Extends /= No_Project loop
           if Data.Extends = Of_Project then
              return True;
           end if;
  
!          Data := Projects.Table (Data.Extends);
        end loop;
  
        return False;
--- 1459,1482 ----
           return True;
        end if;
  
!       Data := Project_Tree.Projects.Table (Of_Project);
  
        while Data.Extends /= No_Project loop
           if Data.Extends = Prj then
              return True;
           end if;
  
!          Data := Project_Tree.Projects.Table (Data.Extends);
        end loop;
  
!       Data := Project_Tree.Projects.Table (Prj);
  
        while Data.Extends /= No_Project loop
           if Data.Extends = Of_Project then
              return True;
           end if;
  
!          Data := Project_Tree.Projects.Table (Data.Extends);
        end loop;
  
        return False;
*************** package body Clean is
*** 1258,1264 ****
           Csets.Initialize;
           Namet.Initialize;
           Snames.Initialize;
!          Prj.Initialize;
        end if;
  
        --  Reset global variables
--- 1506,1512 ----
           Csets.Initialize;
           Namet.Initialize;
           Snames.Initialize;
!          Prj.Initialize (Project_Tree);
        end if;
  
        --  Reset global variables
*************** package body Clean is
*** 1480,1492 ****
                             Verbose_Mode := True;
  
                          elsif Arg = "-vP0" then
!                            Prj.Com.Current_Verbosity := Prj.Default;
  
                          elsif Arg = "-vP1" then
!                            Prj.Com.Current_Verbosity := Prj.Medium;
  
                          elsif Arg = "-vP2" then
!                            Prj.Com.Current_Verbosity := Prj.High;
  
                          else
                             Bad_Argument;
--- 1728,1740 ----
                             Verbose_Mode := True;
  
                          elsif Arg = "-vP0" then
!                            Current_Verbosity := Prj.Default;
  
                          elsif Arg = "-vP1" then
!                            Current_Verbosity := Prj.Medium;
  
                          elsif Arg = "-vP2" then
!                            Current_Verbosity := Prj.High;
  
                          else
                             Bad_Argument;
*************** package body Clean is
*** 1587,1592 ****
--- 1835,1860 ----
        return Src & Tree_Suffix;
     end Tree_File_Name;
  
+    ---------------------------
+    -- Ultimate_Extension_Of --
+    ---------------------------
+ 
+    function Ultimate_Extension_Of (Project : Project_Id) return Project_Id is
+       Result : Project_Id := Project;
+       Data   : Project_Data;
+ 
+    begin
+       if Project /= No_Project then
+          loop
+             Data := Project_Tree.Projects.Table (Result);
+             exit when Data.Extended_By = No_Project;
+             Result := Data.Extended_By;
+          end loop;
+       end if;
+ 
+       return Result;
+    end Ultimate_Extension_Of;
+ 
     -----------
     -- Usage --
     -----------
diff -Nrcpad gcc-4.0.2/gcc/ada/clean.ads gcc-4.1.0/gcc/ada/clean.ads
*** gcc-4.0.2/gcc/ada/clean.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/clean.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/comperr.adb gcc-4.1.0/gcc/ada/comperr.adb
*** gcc-4.0.2/gcc/ada/comperr.adb	Mon Jan  3 15:43:24 2005
--- gcc-4.1.0/gcc/ada/comperr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,26 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
--- 16,26 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by AdaCore.                         --
  --                                                                          --
  ------------------------------------------------------------------------------
  
*************** package body Comperr is
*** 78,84 ****
        --  the cause of the compiler abort and about the preferred method
        --  of reporting bugs. The default is a bug box appropriate for
        --  the FSF version of GNAT, but there are specializations for
!       --  the GNATPRO and Public releases by Ada Core Technologies.
  
        procedure End_Line;
        --  Add blanks up to column 76, and then a final vertical bar
--- 78,84 ----
        --  the cause of the compiler abort and about the preferred method
        --  of reporting bugs. The default is a bug box appropriate for
        --  the FSF version of GNAT, but there are specializations for
!       --  the GNATPRO and Public releases by AdaCore.
  
        procedure End_Line;
        --  Add blanks up to column 76, and then a final vertical bar
*************** package body Comperr is
*** 95,106 ****
  
        Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
        Is_FSF_Version    : constant Boolean := Get_Gnat_Build_Type = FSF;
-       Is_GAP_Version    : constant Boolean := Get_Gnat_Build_Type = GAP;
  
     --  Start of processing for Compiler_Abort
  
     begin
!       --  Prevent recursion through Compiler_Abort, e.g. via SIGSEGV.
  
        if Abort_In_Progress then
           Exit_Program (E_Abort);
--- 95,105 ----
  
        Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
        Is_FSF_Version    : constant Boolean := Get_Gnat_Build_Type = FSF;
  
     --  Start of processing for Compiler_Abort
  
     begin
!       --  Prevent recursion through Compiler_Abort, e.g. via SIGSEGV
  
        if Abort_In_Progress then
           Exit_Program (E_Abort);
*************** package body Comperr is
*** 268,289 ****
                       " http://gcc.gnu.org/bugs.html.");
                    End_Line;
  
                 else
                    Write_Str
!                     ("| Please submit bug report by email " &
!                      "to report@gnat.com.");
                    End_Line;
  
                    Write_Str
!                     ("| Use a subject line meaningful to you" &
!                      " and us to track the bug.");
                    End_Line;
                 end if;
  
                 if not (Is_Public_Version or Is_FSF_Version) then
                    Write_Str
!                     ("| (include your customer number #nnn " &
!                      "in the subject line).");
                    End_Line;
                 end if;
  
--- 267,308 ----
                       " http://gcc.gnu.org/bugs.html.");
                    End_Line;
  
+                elsif Is_Public_Version then
+                   Write_Str
+                     ("| submit bug report by email " &
+                      "to report@adacore.com.");
+                   End_Line;
+ 
+                   Write_Str
+                     ("| See gnatinfo.txt for full info on procedure " &
+                      "for submitting bugs.");
+                   End_Line;
+ 
                 else
                    Write_Str
!                     ("| Please submit a bug report using GNAT Tracker:");
                    End_Line;
  
                    Write_Str
!                     ("| http://www.adacore.com/gnattracker/ " &
!                      "section 'send a report'.");
!                   End_Line;
! 
!                   Write_Str
!                     ("| alternatively submit a bug report by email " &
!                      "to report@adacore.com.");
                    End_Line;
                 end if;
  
+                Write_Str
+                  ("| Use a subject line meaningful to you" &
+                   " and us to track the bug.");
+                End_Line;
+ 
                 if not (Is_Public_Version or Is_FSF_Version) then
                    Write_Str
!                     ("| Include your customer number #nnn " &
!                      "in the subject line.");
                    End_Line;
                 end if;
  
*************** package body Comperr is
*** 305,339 ****
                   ("| (concatenated together with no headers between files).");
                 End_Line;
  
!                if Is_Public_Version then
!                   Write_Str
!                     ("| (use plain ASCII or MIME attachment).");
!                   End_Line;
! 
!                   Write_Str
!                     ("| See gnatinfo.txt for full info on procedure " &
!                      "for submitting bugs.");
!                   End_Line;
! 
!                elsif Is_GAP_Version then
!                   Write_Str
!                     ("| (use plain ASCII or MIME attachment, or FTP "
!                      & "to your GAP account.).");
!                   End_Line;
! 
!                   Write_Str
!                     ("| Please use your GAP account to report this.");
!                   End_Line;
! 
!                elsif not Is_FSF_Version then
!                   Write_Str
!                     ("| (use plain ASCII or MIME attachment, or FTP "
!                      & "to your customer directory).");
!                   End_Line;
! 
                    Write_Str
!                     ("| See README.GNATPRO for full info on procedure " &
!                      "for submitting bugs.");
                    End_Line;
                 end if;
              end if;
--- 324,332 ----
                   ("| (concatenated together with no headers between files).");
                 End_Line;
  
!                if not Is_FSF_Version then
                    Write_Str
!                     ("| Use plain ASCII or MIME attachment.");
                    End_Line;
                 end if;
              end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/comperr.ads gcc-4.1.0/gcc/ada/comperr.ads
*** gcc-4.0.2/gcc/ada/comperr.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/comperr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/config-lang.in gcc-4.1.0/gcc/ada/config-lang.in
*** gcc-4.0.2/gcc/ada/config-lang.in	Wed Aug 11 04:10:11 2004
--- gcc-4.1.0/gcc/ada/config-lang.in	Fri Jul  1 01:29:17 2005
***************
*** 15,22 ****
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 59 Temple Place - Suite 330,
! #Boston, MA 02111-1307, USA.
  
  # Configure looks for the existence of this file to auto-config each language.
  # We define several parameters used by configure:
--- 15,22 ----
  
  #You should have received a copy of the GNU General Public License
  #along with GCC; see the file COPYING.  If not, write to
! #the Free Software Foundation, 51 Franklin Street, Fifth Floor,
! #Boston, MA 02110-1301, USA.
  
  # Configure looks for the existence of this file to auto-config each language.
  # We define several parameters used by configure:
*************** gtfiles="\$(srcdir)/ada/ada-tree.h \$(sr
*** 39,44 ****
--- 39,45 ----
  outputs=ada/Makefile
  
  target_libs="target-libada"
+ lang_dirs="gnattools"
  
  # Ada will not work until the front end starts emitting GIMPLE trees.
  build_by_default=no
diff -Nrcpad gcc-4.0.2/gcc/ada/csets.adb gcc-4.1.0/gcc/ada/csets.adb
*** gcc-4.0.2/gcc/ada/csets.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/csets.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/csets.ads gcc-4.1.0/gcc/ada/csets.ads
*** gcc-4.0.2/gcc/ada/csets.ads	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/csets.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  ------------------------------------------------------------------------------
  
  package Csets is
! pragma Elaborate_Body (Csets);
  
     --  This package contains character tables for the various character
     --  sets that are supported for source representation. Character and
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  package Csets is
!    pragma Elaborate_Body;
  
     --  This package contains character tables for the various character
     --  sets that are supported for source representation. Character and
diff -Nrcpad gcc-4.0.2/gcc/ada/csinfo.adb gcc-4.1.0/gcc/ada/csinfo.adb
*** gcc-4.0.2/gcc/ada/csinfo.adb	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/csinfo.adb	Mon Sep  5 08:12:54 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure CSinfo is
*** 149,155 ****
  
     procedure Sort (A : in out VStringA) is
        Temp : VString;
- 
     begin
        <<Sort>>
           for J in 1 .. A'Length - 1 loop
--- 149,154 ----
*************** begin
*** 189,222 ****
     Set (Flags, "18", V ("R"));
  
     --  Special fields table. The following fields are not recorded or checked
!    --  by Csinfo, since they are specially handled. This means that he both
!    --  the field definitions, and the corresponding subprograms are ignored.
  
!    Set (Special, "Analyzed",                 True);
!    Set (Special, "Assignment_OK",            True);
!    Set (Special, "Associated_Node",          True);
!    Set (Special, "Cannot_Be_Constant",       True);
!    Set (Special, "Chars",                    True);
!    Set (Special, "Comes_From_Source",        True);
!    Set (Special, "Do_Overflow_Check",        True);
!    Set (Special, "Do_Range_Check",           True);
!    Set (Special, "Entity",                   True);
!    Set (Special, "Error_Posted",             True);
!    Set (Special, "Etype",                    True);
!    Set (Special, "Evaluate_Once",            True);
!    Set (Special, "First_Itype",              True);
!    Set (Special, "Has_Dynamic_Itype",        True);
!    Set (Special, "Has_Dynamic_Range_Check",  True);
!    Set (Special, "Has_Dynamic_Length_Check", True);
!    Set (Special, "Has_Private_View",         True);
!    Set (Special, "Is_Controlling_Actual",    True);
!    Set (Special, "Is_Overloaded",            True);
!    Set (Special, "Is_Static_Expression",     True);
!    Set (Special, "Left_Opnd",                True);
!    Set (Special, "Must_Not_Freeze",          True);
!    Set (Special, "Parens",                   True);
!    Set (Special, "Raises_Constraint_Error",  True);
!    Set (Special, "Right_Opnd",               True);
  
     --  Loop to acquire information from node definitions in sinfo.ads,
     --  checking for consistency in Op/Flag assignments to each synonym
--- 188,222 ----
     Set (Flags, "18", V ("R"));
  
     --  Special fields table. The following fields are not recorded or checked
!    --  by Csinfo, since they are specially handled. This means that both the
!    --  field definitions, and the corresponding subprograms are ignored.
  
!    Set (Special, "Analyzed",                  True);
!    Set (Special, "Assignment_OK",             True);
!    Set (Special, "Associated_Node",           True);
!    Set (Special, "Cannot_Be_Constant",        True);
!    Set (Special, "Chars",                     True);
!    Set (Special, "Comes_From_Source",         True);
!    Set (Special, "Do_Overflow_Check",         True);
!    Set (Special, "Do_Range_Check",            True);
!    Set (Special, "Entity",                    True);
!    Set (Special, "Entity_Or_Associated_Node", True);
!    Set (Special, "Error_Posted",              True);
!    Set (Special, "Etype",                     True);
!    Set (Special, "Evaluate_Once",             True);
!    Set (Special, "First_Itype",               True);
!    Set (Special, "Has_Dynamic_Itype",         True);
!    Set (Special, "Has_Dynamic_Range_Check",   True);
!    Set (Special, "Has_Dynamic_Length_Check",  True);
!    Set (Special, "Has_Private_View",          True);
!    Set (Special, "Is_Controlling_Actual",     True);
!    Set (Special, "Is_Overloaded",             True);
!    Set (Special, "Is_Static_Expression",      True);
!    Set (Special, "Left_Opnd",                 True);
!    Set (Special, "Must_Not_Freeze",           True);
!    Set (Special, "Parens",                    True);
!    Set (Special, "Raises_Constraint_Error",   True);
!    Set (Special, "Right_Opnd",                True);
  
     --  Loop to acquire information from node definitions in sinfo.ads,
     --  checking for consistency in Op/Flag assignments to each synonym
*************** begin
*** 256,262 ****
           Match (Field, Break_Field);
  
           if not Present (Special, Synonym) then
- 
              if Present (Fields, Synonym) then
                 if Field /= Get (Fields, Synonym) then
                    Put_Line
--- 256,261 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/cstand.adb gcc-4.1.0/gcc/ada/cstand.adb
*** gcc-4.0.2/gcc/ada/cstand.adb	Thu Feb 10 13:50:24 2005
--- gcc-4.1.0/gcc/ada/cstand.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body CStand is
*** 114,120 ****
     --  Make an entry in the names table for Nam, and set as Chars field of Id
  
     function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id;
!    --  Build entity for standard operator with given name and type.
  
     function New_Standard_Entity
       (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
--- 114,120 ----
     --  Make an entry in the names table for Nam, and set as Chars field of Id
  
     function New_Operator (Op : Name_Id; Typ : Entity_Id) return Entity_Id;
!    --  Build entity for standard operator with given name and type
  
     function New_Standard_Entity
       (New_Node_Kind : Node_Kind := N_Defining_Identifier) return Entity_Id;
*************** package body CStand is
*** 537,543 ****
        Set_Is_Known_Valid             (Standard_Character);
        Set_Size_Known_At_Compile_Time (Standard_Character);
  
!       --  Create the bounds for type Character.
  
        R_Node := New_Node (N_Range, Stloc);
  
--- 537,543 ----
        Set_Is_Known_Valid             (Standard_Character);
        Set_Size_Known_At_Compile_Time (Standard_Character);
  
!       --  Create the bounds for type Character
  
        R_Node := New_Node (N_Range, Stloc);
  
*************** package body CStand is
*** 582,588 ****
        Set_Is_Known_Valid             (Standard_Wide_Character);
        Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
  
!       --  Create the bounds for type Wide_Character.
  
        R_Node := New_Node (N_Range, Stloc);
  
--- 582,588 ----
        Set_Is_Known_Valid             (Standard_Wide_Character);
        Set_Size_Known_At_Compile_Time (Standard_Wide_Character);
  
!       --  Create the bounds for type Wide_Character
  
        R_Node := New_Node (N_Range, Stloc);
  
*************** package body CStand is
*** 1259,1278 ****
                        (Standard_Exception_Type, True);
        Make_Name       (Standard_Exception_Type, "exception");
  
!       Make_Component  (Standard_Exception_Type, Standard_Boolean,
!                                                  "Not_Handled_By_Others");
!       Make_Component  (Standard_Exception_Type, Standard_Character, "Lang");
!       Make_Component  (Standard_Exception_Type, Standard_Natural,
!                                                            "Name_Length");
!       Make_Component  (Standard_Exception_Type, Standard_A_Char,
!                                                              "Full_Name");
!       Make_Component  (Standard_Exception_Type, Standard_A_Char,
!                                                             "HTable_Ptr");
!       Make_Component  (Standard_Exception_Type, Standard_Unsigned,
!                                                           "Import_Code");
!       Make_Component  (Standard_Exception_Type, Standard_A_Char,
!                                                             "Raise_Hook");
!       --  Build tree for record declaration, for use by the back-end.
  
        declare
           Comp_List : List_Id;
--- 1259,1280 ----
                        (Standard_Exception_Type, True);
        Make_Name       (Standard_Exception_Type, "exception");
  
!       Make_Component
!         (Standard_Exception_Type, Standard_Boolean,   "Not_Handled_By_Others");
!       Make_Component
!         (Standard_Exception_Type, Standard_Character, "Lang");
!       Make_Component
!         (Standard_Exception_Type, Standard_Natural,   "Name_Length");
!       Make_Component
!         (Standard_Exception_Type, Standard_A_Char,    "Full_Name");
!       Make_Component
!         (Standard_Exception_Type, Standard_A_Char,    "HTable_Ptr");
!       Make_Component
!         (Standard_Exception_Type, Standard_Unsigned,  "Import_Code");
!       Make_Component
!         (Standard_Exception_Type, Standard_A_Char,    "Raise_Hook");
! 
!       --  Build tree for record declaration, for use by the back-end
  
        declare
           Comp_List : List_Id;
diff -Nrcpad gcc-4.0.2/gcc/ada/cstand.ads gcc-4.1.0/gcc/ada/cstand.ads
*** gcc-4.0.2/gcc/ada/cstand.ads	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/cstand.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/cstreams.c gcc-4.1.0/gcc/ada/cstreams.c
*** gcc-4.0.2/gcc/ada/cstreams.c	Tue Nov 18 10:00:42 2003
--- gcc-4.1.0/gcc/ada/cstreams.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/ctrl_c.c gcc-4.1.0/gcc/ada/ctrl_c.c
*** gcc-4.0.2/gcc/ada/ctrl_c.c	Fri Oct 31 01:08:40 2003
--- gcc-4.1.0/gcc/ada/ctrl_c.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/cuintp.c gcc-4.1.0/gcc/ada/cuintp.c
*** gcc-4.0.2/gcc/ada/cuintp.c	Mon Oct  4 14:56:02 2004
--- gcc-4.1.0/gcc/ada/cuintp.c	Tue Nov 15 13:54:14 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-2005 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
***************
*** 41,46 ****
--- 41,47 ----
  #include "stringt.h"
  #include "fe.h"
  #include "gigi.h"
+ #include "ada-tree.h"
  
  /* Universal integers are represented by the Uint type which is an index into
     the Uints_Ptr table containing Uint_Entry values.  A Uint_Entry contains an
*************** UI_To_gnu (Uint Input, tree type)
*** 74,95 ****
  {
    tree gnu_ret;
  
    if (Input <= Uint_Direct_Last)
!     gnu_ret = build_cst_from_int (type, Input - Uint_Direct_Bias);
    else
      {
        Int Idx = Uints_Ptr[Input].Loc;
        Pos Length = Uints_Ptr[Input].Length;
        Int First = Udigits_Ptr[Idx];
!       /* Do computations in integer type or TYPE whichever is wider, then
! 	 convert later.  This avoid overflow if type is short integer.  */
!       tree comp_type
! 	= ((TREE_CODE (type) == REAL_TYPE
! 	    || TYPE_PRECISION (type) >= TYPE_PRECISION (integer_type_node))
! 	   ? type : integer_type_node);
!       tree gnu_base = build_cst_from_int (comp_type, Base);
  
        gcc_assert (Length > 0);
        gnu_ret = build_cst_from_int (comp_type, First);
        if (First < 0)
  	for (Idx++, Length--; Length; Idx++, Length--)
--- 75,115 ----
  {
    tree gnu_ret;
  
+   /* We might have a TYPE with biased representation and be passed an
+      unbiased value that doesn't fit.  We always use an unbiased type able
+      to hold any such possible value for intermediate computations, and
+      then rely on a conversion back to TYPE to perform the bias adjustment
+      when need be.  */
+ 
+   int biased_type_p
+     = (TREE_CODE (type) == INTEGER_TYPE
+        && TYPE_BIASED_REPRESENTATION_P (type));
+ 
+   tree comp_type = biased_type_p ? get_base_type (type) : type;
+ 
    if (Input <= Uint_Direct_Last)
!     gnu_ret = build_cst_from_int (comp_type, Input - Uint_Direct_Bias);
    else
      {
        Int Idx = Uints_Ptr[Input].Loc;
        Pos Length = Uints_Ptr[Input].Length;
        Int First = Udigits_Ptr[Idx];
!       tree gnu_base;
  
        gcc_assert (Length > 0);
+ 
+       /* The computations we perform below always require a type at least as
+ 	 large as an integer not to overflow.  REAL types are always fine, but
+ 	 INTEGER or ENUMERAL types we are handed may be too short.  We use a
+ 	 base integer type node for the computations in this case and will
+ 	 convert the final result back to the incoming type later on.  */
+ 
+       if (TREE_CODE (comp_type) != REAL_TYPE
+ 	  && TYPE_PRECISION (comp_type) < TYPE_PRECISION (integer_type_node))
+ 	comp_type = integer_type_node;
+ 
+       gnu_base = build_cst_from_int (comp_type, Base);
+ 
        gnu_ret = build_cst_from_int (comp_type, First);
        if (First < 0)
  	for (Idx++, Length--; Length; Idx++, Length--)
diff -Nrcpad gcc-4.0.2/gcc/ada/debug.adb gcc-4.1.0/gcc/ada/debug.adb
*** gcc-4.0.2/gcc/ada/debug.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/debug.adb	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Debug is
*** 89,104 ****
     --  dU   Enable garbage collection of unreachable entities
     --  dV   Enable viewing of all symbols in debugger
     --  dW   Disable warnings on calls for IN OUT parameters
!    --  dX   Enable Frontend ZCX even when it is not supported
     --  dY   Enable configurable run-time mode
!    --  dZ
  
     --  d.a
     --  d.b
     --  d.c
     --  d.d
     --  d.e
!    --  d.f
     --  d.g
     --  d.h
     --  d.i
--- 89,104 ----
     --  dU   Enable garbage collection of unreachable entities
     --  dV   Enable viewing of all symbols in debugger
     --  dW   Disable warnings on calls for IN OUT parameters
!    --  dX
     --  dY   Enable configurable run-time mode
!    --  dZ   Generate listing showing the contents of the dispatch tables
  
     --  d.a
     --  d.b
     --  d.c
     --  d.d
     --  d.e
!    --  d.f  Inhibit folding of static expressions
     --  d.g
     --  d.h
     --  d.i
*************** package body Debug is
*** 132,138 ****
  
     --  Debug flags for binder (GNATBIND)
  
!    --  da
     --  db
     --  dc  List units as they are chosen
     --  dd
--- 132,138 ----
  
     --  Debug flags for binder (GNATBIND)
  
!    --  da  All links (including internal units) listed if there is a cycle
     --  db
     --  dc  List units as they are chosen
     --  dd
*************** package body Debug is
*** 410,416 ****
     --       indications. This debug flag disconnects the tracking of constant
     --       values (see Exp_Ch2.Expand_Current_Value).
  
!    --  dN   Do not generate file name information in exception messages.
  
     --  dO   Output immediate error messages. This causes error messages to
     --       be output as soon as they are generated (disconnecting several
--- 410,416 ----
     --       indications. This debug flag disconnects the tracking of constant
     --       values (see Exp_Ch2.Expand_Current_Value).
  
!    --  dN   Do not generate file name information in exception messages
  
     --  dO   Output immediate error messages. This causes error messages to
     --       be output as soon as they are generated (disconnecting several
*************** package body Debug is
*** 457,473 ****
     --       task of transitioning incorrect legacy code, we provide this
     --       undocumented feature for suppressing these warnings.
  
-    --  dX   Enable frontend ZCX even when it is not supported. Equivalent to
-    --       -gnatZ but without verifying that System.Front_End_ZCX_Support
-    --       is set. This causes the front end to generate suitable tables
-    --       for ZCX handling even when the runtime cannot handle ZCX. This
-    --       is used for testing the front end for correct ZCX operation, and
-    --       in particular is useful for multi-target testing.
- 
     --  dY   Enable configurable run-time mode, just as though the System file
     --       had Configurable_Run_Time_Mode set to True. This is useful in
     --       testing high integrity mode.
  
     --  d.x  No exception handlers in generated code. This causes exception
     --       handlers to be eliminated from the generated code. They are still
     --       fully compiled and analyzed, they just get eliminated from the
--- 457,470 ----
     --       task of transitioning incorrect legacy code, we provide this
     --       undocumented feature for suppressing these warnings.
  
     --  dY   Enable configurable run-time mode, just as though the System file
     --       had Configurable_Run_Time_Mode set to True. This is useful in
     --       testing high integrity mode.
  
+    --  d.f  Suppress folding of static expressions. This of course results
+    --       in seriously non-conforming behavior, but is useful sometimes
+    --       when tracking down handling of complex expressions.
+ 
     --  d.x  No exception handlers in generated code. This causes exception
     --       handlers to be eliminated from the generated code. They are still
     --       fully compiled and analyzed, they just get eliminated from the
*************** package body Debug is
*** 518,523 ****
--- 515,526 ----
     -- Documentation for Binder Debug Flags --
     ------------------------------------------
  
+    --  da  Normally if there is an elaboration circularity, then in describing
+    --      the cycle, links involving internal units are omitted, since they
+    --      are irrelevant and confusing. This debug flag causes all links to
+    --      be listed, and is useful when diagnosing circularities introduced
+    --      by incorrect changes to the run-time library itself.
+ 
     --  dc  List units as they are chosen. As units are selected for addition to
     --      the elaboration order, a line of output is generated showing which
     --      unit has been selected.
diff -Nrcpad gcc-4.0.2/gcc/ada/debug.ads gcc-4.1.0/gcc/ada/debug.ads
*** gcc-4.0.2/gcc/ada/debug.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/debug.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,43 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- package Debug is
- pragma Preelaborate (Debug);
- 
  --  This package contains global flags used to control the inclusion
  --  of debugging code in various phases of the compiler. Some of these
  --  flags are also used by the binder and gnatmake.
  
     -------------------------
     -- Dynamic Debug Flags --
     -------------------------
--- 31,43 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  --  This package contains global flags used to control the inclusion
  --  of debugging code in various phases of the compiler. Some of these
  --  flags are also used by the binder and gnatmake.
  
+ package Debug is
+    pragma Preelaborate;
+ 
     -------------------------
     -- Dynamic Debug Flags --
     -------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/debug_a.adb gcc-4.1.0/gcc/ada/debug_a.adb
*** gcc-4.0.2/gcc/ada/debug_a.adb	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/debug_a.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/debug_a.ads gcc-4.1.0/gcc/ada/debug_a.ads
*** gcc-4.0.2/gcc/ada/debug_a.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/debug_a.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/dec-io.adb gcc-4.1.0/gcc/ada/dec-io.adb
*** gcc-4.0.2/gcc/ada/dec-io.adb	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/dec-io.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,209 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUNTIME COMPONENTS                          --
- --                                                                          --
- --                               D E C . I O                                --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --            Copyright (C) 2001 Free Software Foundation, Inc.             --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is an AlphaVMS package that provides the interface between
- --  GNAT, DECLib IO packages and the DECLib Bliss library.
- 
- pragma Extend_System (Aux_DEC);
- 
- with System;                            use  System;
- with System.Task_Primitives;            use  System.Task_Primitives;
- with System.Task_Primitives.Operations; use  System.Task_Primitives.Operations;
- with IO_Exceptions;                     use  IO_Exceptions;
- with Aux_IO_Exceptions;                 use  Aux_IO_Exceptions;
- 
- package body DEC.IO is
- 
-    type File_Type is record
-       FCB : Integer   := 0;   -- Temporary
-       SEQ : Integer   := 0;
-    end record;
- 
-    for File_Type'Size use 64;
-    for File_Type'Alignment use 8;
- 
-    for File_Type use record
-       FCB at 0 range 0 .. 31;
-       SEQ at 4 range 0 .. 31;
-    end record;
- 
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    function GNAT_Name_64 (File : File_Type) return String;
-    pragma Export_Function (GNAT_Name_64, "GNAT$NAME_64");
-    --  ??? comment
- 
-    function GNAT_Form_64 (File : File_Type) return String;
-    pragma Export_Function (GNAT_Form_64, "GNAT$FORM_64");
-    --  ??? comment
- 
-    procedure Init_IO;
-    pragma Interface (C, Init_IO);
-    pragma Import_Procedure (Init_IO, "GNAT$$INIT_IO");
-    --  ??? comment
- 
-    ----------------
-    -- IO_Locking --
-    ----------------
- 
-    package body IO_Locking is
- 
-       ------------------
-       -- Create_Mutex --
-       ------------------
- 
-       function Create_Mutex return Access_Mutex is
-          M : constant Access_Mutex := new RTS_Lock;
- 
-       begin
-          Initialize_Lock (M, Global_Task_Level);
-          return M;
-       end Create_Mutex;
- 
-       -------------
-       -- Acquire --
-       -------------
- 
-       procedure Acquire (M : Access_Mutex) is
-       begin
-          Write_Lock (M);
-       end Acquire;
- 
-       -------------
-       -- Release --
-       -------------
- 
-       procedure Release (M : Access_Mutex) is
-       begin
-          Unlock (M);
-       end Release;
- 
-    end IO_Locking;
- 
-    ------------------
-    -- GNAT_Name_64 --
-    ------------------
- 
-    function GNAT_Name_64 (File : File_Type) return String is
-       subtype Buffer_Subtype is String (1 .. 8192);
- 
-       Buffer : Buffer_Subtype;
-       Length : System.Integer_32;
- 
-       procedure Get_Name
-         (File    : System.Address;
-          MaxLen  : System.Integer_32;
-          Buffer  : out Buffer_Subtype;
-          Length  : out System.Integer_32);
-       pragma Interface (C, Get_Name);
-       pragma Import_Procedure
-         (Get_Name, "GNAT$FILE_NAME",
-          Mechanism => (Value, Value, Reference, Reference));
- 
-    begin
-       Get_Name (File'Address, Buffer'Length, Buffer, Length);
-       return Buffer (1 .. Integer (Length));
-    end GNAT_Name_64;
- 
-    ------------------
-    -- GNAT_Form_64 --
-    ------------------
- 
-    function GNAT_Form_64 (File : File_Type) return String is
-       subtype Buffer_Subtype is String (1 .. 8192);
- 
-       Buffer : Buffer_Subtype;
-       Length : System.Integer_32;
- 
-       procedure Get_Form
-         (File    : System.Address;
-          MaxLen  : System.Integer_32;
-          Buffer  : out Buffer_Subtype;
-          Length  : out System.Integer_32);
-       pragma Interface (C, Get_Form);
-       pragma Import_Procedure
-         (Get_Form, "GNAT$FILE_FORM",
-          Mechanism => (Value, Value, Reference, Reference));
- 
-    begin
-       Get_Form (File'Address, Buffer'Length, Buffer, Length);
-       return Buffer (1 .. Integer (Length));
-    end GNAT_Form_64;
- 
-    ------------------------
-    -- Raise_IO_Exception --
-    ------------------------
- 
-    procedure Raise_IO_Exception (EN : Exception_Number) is
-    begin
-       case EN is
-          when GNAT_EN_LOCK_ERROR =>      raise LOCK_ERROR;
-          when GNAT_EN_EXISTENCE_ERROR => raise EXISTENCE_ERROR;
-          when GNAT_EN_KEY_ERROR =>       raise KEY_ERROR;
-          when GNAT_EN_KEYSIZERR =>       raise PROGRAM_ERROR; -- KEYSIZERR;
-          when GNAT_EN_STAOVF =>          raise STORAGE_ERROR; -- STAOVF;
-          when GNAT_EN_CONSTRAINT_ERRO => raise CONSTRAINT_ERROR;
-          when GNAT_EN_IOSYSFAILED =>     raise DEVICE_ERROR;  -- IOSYSFAILED;
-          when GNAT_EN_LAYOUT_ERROR =>    raise LAYOUT_ERROR;
-          when GNAT_EN_STORAGE_ERROR =>   raise STORAGE_ERROR;
-          when GNAT_EN_DATA_ERROR =>      raise DATA_ERROR;
-          when GNAT_EN_DEVICE_ERROR =>    raise DEVICE_ERROR;
-          when GNAT_EN_END_ERROR =>       raise END_ERROR;
-          when GNAT_EN_MODE_ERROR =>      raise MODE_ERROR;
-          when GNAT_EN_NAME_ERROR =>      raise NAME_ERROR;
-          when GNAT_EN_STATUS_ERROR =>    raise STATUS_ERROR;
-          when GNAT_EN_NOT_OPEN =>        raise USE_ERROR;   -- NOT_OPEN;
-          when GNAT_EN_ALREADY_OPEN =>    raise USE_ERROR;   -- ALREADY_OPEN;
-          when GNAT_EN_USE_ERROR =>       raise USE_ERROR;
-          when GNAT_EN_UNSUPPORTED =>     raise USE_ERROR;   -- UNSUPPORTED;
-          when GNAT_EN_FAC_MODE_MISMAT => raise USE_ERROR;   -- FAC_MODE_MISMAT;
-          when GNAT_EN_ORG_MISMATCH =>    raise USE_ERROR;   -- ORG_MISMATCH;
-          when GNAT_EN_RFM_MISMATCH =>    raise USE_ERROR;   -- RFM_MISMATCH;
-          when GNAT_EN_RAT_MISMATCH =>    raise USE_ERROR;   -- RAT_MISMATCH;
-          when GNAT_EN_MRS_MISMATCH =>    raise USE_ERROR;   -- MRS_MISMATCH;
-          when GNAT_EN_MRN_MISMATCH =>    raise USE_ERROR;   -- MRN_MISMATCH;
-          when GNAT_EN_KEY_MISMATCH =>    raise USE_ERROR;   -- KEY_MISMATCH;
-          when GNAT_EN_MAXLINEXC =>       raise CONSTRAINT_ERROR; -- MAXLINEXC;
-          when GNAT_EN_LINEXCMRS =>       raise CONSTRAINT_ERROR; -- LINEXCMRS;
-       end case;
-    end Raise_IO_Exception;
- 
- -------------------------
- -- Package Elaboration --
- -------------------------
- 
- begin
-    Init_IO;
- end DEC.IO;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/dec-io.ads gcc-4.1.0/gcc/ada/dec-io.ads
*** gcc-4.0.2/gcc/ada/dec-io.ads	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/dec-io.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,123 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUNTIME COMPONENTS                          --
- --                                                                          --
- --                               D E C . I O                                --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is an AlphaVMS package that contains the declarations and
- --  function specifications needed by the DECLib IO packages.
- 
- with System.Task_Primitives;
- package DEC.IO is
- private
- 
-    type Exception_Number is (
-      GNAT_EN_LOCK_ERROR,
-      GNAT_EN_EXISTENCE_ERROR,
-      GNAT_EN_KEY_ERROR,
-      GNAT_EN_KEYSIZERR,
-      GNAT_EN_STAOVF,
-      GNAT_EN_CONSTRAINT_ERRO,
-      GNAT_EN_IOSYSFAILED,
-      GNAT_EN_LAYOUT_ERROR,
-      GNAT_EN_STORAGE_ERROR,
-      GNAT_EN_DATA_ERROR,
-      GNAT_EN_DEVICE_ERROR,
-      GNAT_EN_END_ERROR,
-      GNAT_EN_MODE_ERROR,
-      GNAT_EN_NAME_ERROR,
-      GNAT_EN_STATUS_ERROR,
-      GNAT_EN_NOT_OPEN,
-      GNAT_EN_ALREADY_OPEN,
-      GNAT_EN_USE_ERROR,
-      GNAT_EN_UNSUPPORTED,
-      GNAT_EN_FAC_MODE_MISMAT,
-      GNAT_EN_ORG_MISMATCH,
-      GNAT_EN_RFM_MISMATCH,
-      GNAT_EN_RAT_MISMATCH,
-      GNAT_EN_MRS_MISMATCH,
-      GNAT_EN_MRN_MISMATCH,
-      GNAT_EN_KEY_MISMATCH,
-      GNAT_EN_MAXLINEXC,
-      GNAT_EN_LINEXCMRS);
- 
-    for Exception_Number'Size use 32;
- 
-    for Exception_Number use (
-      GNAT_EN_LOCK_ERROR => 1,
-      GNAT_EN_EXISTENCE_ERROR => 2,
-      GNAT_EN_KEY_ERROR => 3,
-      GNAT_EN_KEYSIZERR => 4,
-      GNAT_EN_STAOVF => 5,
-      GNAT_EN_CONSTRAINT_ERRO => 6,
-      GNAT_EN_IOSYSFAILED => 7,
-      GNAT_EN_LAYOUT_ERROR => 8,
-      GNAT_EN_STORAGE_ERROR => 9,
-      GNAT_EN_DATA_ERROR => 10,
-      GNAT_EN_DEVICE_ERROR => 11,
-      GNAT_EN_END_ERROR => 12,
-      GNAT_EN_MODE_ERROR => 13,
-      GNAT_EN_NAME_ERROR => 14,
-      GNAT_EN_STATUS_ERROR => 15,
-      GNAT_EN_NOT_OPEN => 16,
-      GNAT_EN_ALREADY_OPEN => 17,
-      GNAT_EN_USE_ERROR => 18,
-      GNAT_EN_UNSUPPORTED => 19,
-      GNAT_EN_FAC_MODE_MISMAT => 20,
-      GNAT_EN_ORG_MISMATCH => 21,
-      GNAT_EN_RFM_MISMATCH => 22,
-      GNAT_EN_RAT_MISMATCH => 23,
-      GNAT_EN_MRS_MISMATCH => 24,
-      GNAT_EN_MRN_MISMATCH => 25,
-      GNAT_EN_KEY_MISMATCH => 26,
-      GNAT_EN_MAXLINEXC => 27,
-      GNAT_EN_LINEXCMRS => 28);
- 
-    procedure Raise_IO_Exception (EN : Exception_Number);
-    pragma Export_Procedure (Raise_IO_Exception, "GNAT$RAISE_IO_EXCEPTION",
-       Mechanism => Value);
- 
-    package IO_Locking is
-       type Access_Mutex is private;
-       function Create_Mutex return Access_Mutex;
-       procedure Acquire (M : Access_Mutex);
-       procedure Release (M : Access_Mutex);
- 
-    private
-       type Access_Mutex is access System.Task_Primitives.RTS_Lock;
-       pragma Export_Function (Create_Mutex, "GNAT$CREATE_MUTEX",
-           Mechanism => Value);
-       pragma Export_Procedure (Acquire, "GNAT$ACQUIRE_MUTEX",
-           Mechanism => Value);
-       pragma Export_Procedure (Release, "GNAT$RELEASE_MUTEX",
-           Mechanism => Value);
-    end IO_Locking;
- 
- end DEC.IO;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/dec.ads gcc-4.1.0/gcc/ada/dec.ads
*** gcc-4.0.2/gcc/ada/dec.ads	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/dec.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                                  D E C                                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2001  Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                                  D E C                                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005  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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,40 ****
  --  the bind. It is also a convenient parent for all DEC IO child packages.
  
  package DEC is
! pragma Pure (DEC);
  end DEC;
--- 36,40 ----
  --  the bind. It is also a convenient parent for all DEC IO child packages.
  
  package DEC is
!    pragma Pure;
  end DEC;
diff -Nrcpad gcc-4.0.2/gcc/ada/decl.c gcc-4.1.0/gcc/ada/decl.c
*** gcc-4.0.2/gcc/ada/decl.c	Thu Mar 17 19:53:06 2005
--- gcc-4.1.0/gcc/ada/decl.c	Tue Nov 15 13:53:22 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
***************
*** 35,40 ****
--- 35,41 ----
  #include "ggc.h"
  #include "obstack.h"
  #include "target.h"
+ #include "expr.h"
  
  #include "ada.h"
  #include "types.h"
***************
*** 52,72 ****
  #include "ada-tree.h"
  #include "gigi.h"
  
! /* Provide default values for the macros controlling stack checking.
!    This is copied from GCC's expr.h.  */
  
! #ifndef STACK_CHECK_BUILTIN
! #define STACK_CHECK_BUILTIN 0
! #endif
! #ifndef STACK_CHECK_PROBE_INTERVAL
! #define STACK_CHECK_PROBE_INTERVAL 4096
! #endif
! #ifndef STACK_CHECK_MAX_FRAME_SIZE
! #define STACK_CHECK_MAX_FRAME_SIZE \
!   (STACK_CHECK_PROBE_INTERVAL - UNITS_PER_WORD)
! #endif
! #ifndef STACK_CHECK_MAX_VAR_SIZE
! #define STACK_CHECK_MAX_VAR_SIZE (STACK_CHECK_MAX_FRAME_SIZE / 100)
  #endif
  
  /* These two variables are used to defer recursively expanding incomplete
--- 53,66 ----
  #include "ada-tree.h"
  #include "gigi.h"
  
! /* Convention_Stdcall should be processed in a specific way on Windows targets
!    only.  The macro below is a helper to avoid having to check for a Windows
!    specific attribute throughout this unit.  */
  
! #if TARGET_DLLIMPORT_DECL_ATTRIBUTES
! #define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
! #else
! #define Has_Stdcall_Convention(E) (0)
  #endif
  
  /* These two variables are used to defer recursively expanding incomplete
*************** static struct incomplete
*** 80,85 ****
--- 74,85 ----
    Entity_Id full_type;
  } *defer_incomplete_list = 0;
  
+ /* These two variables are used to defer emission of debug information for
+    nested incomplete record types  */
+ 
+ static int defer_debug_level = 0;
+ static tree defer_debug_incomplete_list;
+ 
  static void copy_alias_set (tree, tree);
  static tree substitution_list (Entity_Id, Entity_Id, tree, bool);
  static bool allocatable_size_p (tree, bool);
*************** static tree elaborate_expression_1 (Node
*** 91,97 ****
  static tree make_packable_type (tree);
  static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
  static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
!                                   bool, bool);
  static int compare_field_bitpos (const PTR, const PTR);
  static Uint annotate_value (tree);
  static void annotate_rep (Entity_Id, tree);
--- 91,97 ----
  static tree make_packable_type (tree);
  static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
  static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
!                                   bool, bool, bool);
  static int compare_field_bitpos (const PTR, const PTR);
  static Uint annotate_value (tree);
  static void annotate_rep (Entity_Id, tree);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 151,156 ****
--- 151,158 ----
    bool saved = false;
    /* Nonzero if we incremented defer_incomplete_level.  */
    bool this_deferred = false;
+   /* Nonzero if we incremented defer_debug_level.  */
+   bool debug_deferred = false;
    /* Nonzero if we incremented force_global.  */
    bool this_global = false;
    /* Nonzero if we should check to see if elaborated during processing.  */
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 489,495 ****
--- 491,499 ----
  		 || Present (Renamed_Object (gnat_entity))));
  	bool inner_const_flag = const_flag;
  	bool static_p = Is_Statically_Allocated (gnat_entity);
+ 	bool mutable_p = false;
  	tree gnu_ext_name = NULL_TREE;
+ 	tree renamed_obj = NULL_TREE;
  
  	if (Present (Renamed_Object (gnat_entity)) && !definition)
  	  {
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 521,526 ****
--- 525,532 ----
  	    || TREE_CODE (gnu_type) == VOID_TYPE)
  	  {
  	    gcc_assert (type_annotate_only);
+ 	    if (this_global)
+ 	      force_global--;
  	    return error_mark_node;
  	  }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 585,591 ****
  			     (Etype
  			      (Expression (Declaration_Node (gnat_entity)))));
  	    else
! 	      gnu_size = max_size (TYPE_SIZE (gnu_type), true);
  	  }
  
  	/* If the size is zero bytes, make it one byte since some linkers have
--- 591,600 ----
  			     (Etype
  			      (Expression (Declaration_Node (gnat_entity)))));
  	    else
! 	      {
! 		gnu_size = max_size (TYPE_SIZE (gnu_type), true);
! 		mutable_p = true;
! 	      }
  	  }
  
  	/* If the size is zero bytes, make it one byte since some linkers have
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 657,667 ****
  	{
  	  tree gnu_fat
  	    = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
- 	  tree gnu_temp_type
- 	    = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat))));
  
  	  gnu_type
! 	    = build_unc_object_type (gnu_temp_type, gnu_type,
  				     concat_id_with_name (gnu_entity_id,
  							  "UNC"));
  	}
--- 666,674 ----
  	{
  	  tree gnu_fat
  	    = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity))));
  
  	  gnu_type
! 	    = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
  				     concat_id_with_name (gnu_entity_id,
  							  "UNC"));
  	}
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 716,733 ****
  		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
  	  gnu_expr = convert (gnu_type, gnu_expr);
  
! 	/* See if this is a renaming.  If this is a constant renaming, treat
! 	   it as a normal variable whose initial value is what is being
! 	   renamed.  We cannot do this if the type is unconstrained or
! 	   class-wide.
  
! 	   Otherwise, if what we are renaming is a reference, we can simply
! 	   return a stabilized version of that reference, after forcing any
! 	   SAVE_EXPRs to be evaluated.  But, if this is at global level, we
! 	   can only do this if we know no SAVE_EXPRs will be made.
  
! 	   Otherwise, make this into a constant pointer to the object we are
! 	   to rename.  */
  
  	if (Present (Renamed_Object (gnat_entity)))
  	  {
--- 723,740 ----
  		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
  	  gnu_expr = convert (gnu_type, gnu_expr);
  
! 	/* See if this is a renaming, and handle appropriately depending on
! 	   what is renamed and in which context.  There are three major
! 	   cases:
  
! 	   1/ This is a constant renaming and we can just make an object
! 	      with what is renamed as its initial value,
  
! 	   2/ We can reuse a stabilized version of what is renamed in place
!               of the renaming,
! 
! 	   3/ If neither 1 or 2 applies, we make the renaming entity a constant
!               pointer to what is being renamed.  */
  
  	if (Present (Renamed_Object (gnat_entity)))
  	  {
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 743,748 ****
--- 750,758 ----
  		gnu_type = TREE_TYPE (gnu_expr);
  	      }
  
+ 	    /* Case 1: If this is a constant renaming, treat it as a normal
+ 	       object whose initial value is what is being renamed.  We cannot
+ 	       do this if the type is unconstrained or class-wide.  */
  	    if (const_flag
  		&& !TREE_SIDE_EFFECTS (gnu_expr)
  		&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 751,808 ****
                  && !Is_Array_Type (Etype (gnat_entity)))
  	      ;
  
! 	    /* If this is a declaration or reference that we can stabilize,
! 	       just use that declaration or reference as this entity unless
! 	       the latter has to be materialized.  */
! 	    else if ((DECL_P (gnu_expr) || REFERENCE_CLASS_P (gnu_expr))
! 		     && !Materialize_Entity (gnat_entity)
! 		     && (!global_bindings_p ()
! 			 || (staticp (gnu_expr)
! 			     && !TREE_SIDE_EFFECTS (gnu_expr))))
  	      {
! 		gnu_decl = gnat_stabilize_reference (gnu_expr, true);
! 		save_gnu_tree (gnat_entity, gnu_decl, true);
! 		saved = true;
! 		break;
! 	      }
  
! 	    /* Otherwise, make this into a constant pointer to the object we
! 	       are to rename.
  
! 	       Stabilize it if we are not at the global level since in this
! 	       case the renaming evaluation may directly dereference the
! 	       initial value we make here instead of the pointer we will
! 	       assign it to.  We don't want variables in the expression to be
! 	       evaluated every time the renaming is used, since the value of
! 	       these variables may change in between.
  
! 	       If we are at the global level and the value is not constant,
! 	       create_var_decl generates a mere elaboration assignment and
! 	       does not attach the initial expression to the declaration.
! 	       There is no possible direct initial-value dereference then.  */
! 	    else
! 	      {
! 		inner_const_flag = TREE_READONLY (gnu_expr);
! 		const_flag = true;
! 		gnu_type = build_reference_type (gnu_type);
! 		gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr);
  
! 		if (!global_bindings_p ())
! 		  {
! 		    bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
  
! 		    gnu_expr = gnat_stabilize_reference (gnu_expr, true);
  
! 		    /* If the original expression had side effects, put a
! 		       SAVE_EXPR around this whole thing.  */
! 		    if (has_side_effects)
! 		      gnu_expr = save_expr (gnu_expr);
  
! 		    add_stmt (gnu_expr);
! 		  }
  
! 		gnu_size = NULL_TREE;
! 		used_by_ref = true;
  	      }
  	  }
  
--- 761,860 ----
                  && !Is_Array_Type (Etype (gnat_entity)))
  	      ;
  
! 	    /* Otherwise, see if we can proceed with a stabilized version of
! 	       the renamed entity or if we need to make a pointer.  */
! 	    else
  	      {
! 		bool stabilized;
! 		tree maybe_stable_expr = NULL_TREE;
  
! 		/* Case 2: If the renaming entity need not be materialized and
! 		   the renamed expression is something we can stabilize, use
! 		   that for the renaming after forcing the evaluation of any
! 		   SAVE_EXPR.  At the global level, we can only do this if we
! 		   know no SAVE_EXPRs will be made.  */
! 		if (!Materialize_Entity (gnat_entity)
! 		    && (!global_bindings_p ()
! 			|| (staticp (gnu_expr)
! 			    && !TREE_SIDE_EFFECTS (gnu_expr))))
! 		  {
! 		    maybe_stable_expr
! 		      = maybe_stabilize_reference (gnu_expr, true, false,
! 						   &stabilized);
  
! 		    if (stabilized)
! 		      {
! 			gnu_decl = maybe_stable_expr;
! 			save_gnu_tree (gnat_entity, gnu_decl, true);
! 			saved = true;
! 			break;
! 		      }
  
! 		    /* The stabilization failed.  Keep maybe_stable_expr
! 		       untouched here to let the pointer case below know
! 		       about that failure.  */
! 		  }
  
! 		/* Case 3: Make this into a constant pointer to the object we
! 		   are to rename and attach the object to the pointer if it is
! 		   an lvalue that can be stabilized.
  
! 		   From the proper scope, attached objects will be referenced
! 		   directly instead of indirectly via the pointer to avoid
! 		   subtle aliasing problems with non addressable entities.
! 		   They have to be stable because we must not evaluate the
! 		   variables in the expression every time the renaming is used.
! 		   They also have to be lvalues because the context in which
! 		   they are reused sometimes requires so.  We call pointers
! 		   with an attached object "renaming" pointers.
  
! 		   In the rare cases where we cannot stabilize the renamed
! 		   object, we just make a "bare" pointer, and the renamed
! 		   entity is always accessed indirectly through it.  */
! 		{
! 		  bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
! 		  inner_const_flag = TREE_READONLY (gnu_expr);
! 		  const_flag = true;
! 		  gnu_type = build_reference_type (gnu_type);
  
! 		  /* If a previous attempt at unrestricted
! 		     stabilization failed, there is no point trying
! 		     again and we can reuse the result without
! 		     attaching it to the pointer.  */
! 		  if (maybe_stable_expr)
! 		    ;
  
! 		  /* Otherwise, try to stabilize now, restricting to
! 		     lvalues only, and attach the expression to the pointer
! 		     if the stabilization succeeds.  */
! 		  else
! 		    {
! 		      maybe_stable_expr
! 			= maybe_stabilize_reference (gnu_expr, true, true,
! 						     &stabilized);
! 
! 		      if (stabilized)
! 			renamed_obj = maybe_stable_expr;
! 		      /* Attaching is actually performed downstream, as soon
! 			 as we have a DECL for the pointer we make.  */
! 		    }
! 
! 		  gnu_expr
! 		    = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
! 
! 		  if (!global_bindings_p ())
! 		    {
! 		      /* If the original expression had side effects, put a
! 			 SAVE_EXPR around this whole thing.  */
! 		      if (has_side_effects)
! 			gnu_expr = save_expr (gnu_expr);
! 
! 		      add_stmt (gnu_expr);
! 		    }
! 
! 		  gnu_size = NULL_TREE;
! 		  used_by_ref = true;
! 		}
  	      }
  	  }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 839,845 ****
  	  }
  
  	/* If this is a pointer and it does not have an initializing
! 	   expression, initialize it to NULL, unless the obect is
             imported.  */
  	if (definition
  	    && (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type))
--- 891,897 ----
  	  }
  
  	/* If this is a pointer and it does not have an initializing
! 	   expression, initialize it to NULL, unless the object is
             imported.  */
  	if (definition
  	    && (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type))
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 890,899 ****
  	   imported.  */
  	if ((!definition && Present (Address_Clause (gnat_entity)))
  	    || (Is_Imported (gnat_entity)
! 		&& Convention (gnat_entity) == Convention_Stdcall))
  	  {
  	    gnu_type = build_reference_type (gnu_type);
  	    gnu_size = NULL_TREE;
  	    used_by_ref = true;
  	  }
  
--- 942,956 ----
  	   imported.  */
  	if ((!definition && Present (Address_Clause (gnat_entity)))
  	    || (Is_Imported (gnat_entity)
! 		&& Has_Stdcall_Convention (gnat_entity)))
  	  {
  	    gnu_type = build_reference_type (gnu_type);
  	    gnu_size = NULL_TREE;
+ 
+ 	    gnu_expr = NULL_TREE;
+ 	    /* No point in taking the address of an initializing expression
+ 	       that isn't going to be used.  */
+ 
  	    used_by_ref = true;
  	  }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 928,934 ****
  	       If we have a template initializer only (that we made above),
  	       pretend there is none and rely on what build_allocator creates
  	       again anyway.  Otherwise (if we have a full initializer), get
! 	       the data part and feed that to build_allocator.  */
  
  	    if (definition)
  	      {
--- 985,995 ----
  	       If we have a template initializer only (that we made above),
  	       pretend there is none and rely on what build_allocator creates
  	       again anyway.  Otherwise (if we have a full initializer), get
! 	       the data part and feed that to build_allocator.
! 
! 	       If we are elaborating a mutable object, tell build_allocator to
! 	       ignore a possibly simpler size from the initializer, if any, as
! 	       we must allocate the maximum possible size in this case.  */
  
  	    if (definition)
  	      {
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 940,955 ****
  		    gnu_alloc_type
  		      = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
  
!                    if (TREE_CODE (gnu_expr) == CONSTRUCTOR
!                        &&
!                        TREE_CHAIN (CONSTRUCTOR_ELTS (gnu_expr)) == NULL_TREE)
!                      gnu_expr = 0;
!                    else
!                      gnu_expr
!                        = build_component_ref
!                          (gnu_expr, NULL_TREE,
!                           TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
! 			  false);
  		  }
  
  		if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
--- 1001,1016 ----
  		    gnu_alloc_type
  		      = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
  
! 		    if (TREE_CODE (gnu_expr) == CONSTRUCTOR
! 			&& VEC_length (constructor_elt,
! 				       CONSTRUCTOR_ELTS (gnu_expr)) == 1)
! 		      gnu_expr = 0;
! 		    else
! 		      gnu_expr
! 			= build_component_ref
! 			  (gnu_expr, NULL_TREE,
! 			  TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
! 			      false);
  		  }
  
  		if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 958,965 ****
  		  post_error ("Storage_Error will be raised at run-time?",
  			      gnat_entity);
  
! 		gnu_expr = build_allocator (gnu_alloc_type, gnu_expr,
! 					    gnu_type, 0, 0, gnat_entity);
  	      }
  	    else
  	      {
--- 1019,1026 ----
  		  post_error ("Storage_Error will be raised at run-time?",
  			      gnat_entity);
  
! 		gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
! 					    0, 0, gnat_entity, mutable_p);
  	      }
  	    else
  	      {
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1039,1045 ****
  	  gnu_ext_name = create_concat_name (gnat_entity, 0);
  
  	/* If this is constant initialized to a static constant and the
! 	   object has an aggregrate type, force it to be statically
  	   allocated. */
  	if (const_flag && gnu_expr && TREE_CONSTANT (gnu_expr)
  	    && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
--- 1100,1106 ----
  	  gnu_ext_name = create_concat_name (gnat_entity, 0);
  
  	/* If this is constant initialized to a static constant and the
! 	   object has an aggregate type, force it to be statically
  	   allocated. */
  	if (const_flag && gnu_expr && TREE_CONSTANT (gnu_expr)
  	    && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1055,1060 ****
--- 1116,1126 ----
  				    static_p, attr_list, gnat_entity);
  	DECL_BY_REF_P (gnu_decl) = used_by_ref;
  	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
+ 	if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+ 	  {
+ 	    SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
+ 	    DECL_RENAMING_GLOBAL_P (gnu_decl) = global_bindings_p ();
+ 	  }
  
  	/* If we have an address clause and we've made this indirect, it's
  	   not enough to merely mark the type as volatile since volatile
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1095,1105 ****
  	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
  	  }
  
! 	/* If this is declared in a block that contains an block with an
  	   exception handler, we must force this variable in memory to
  	   suppress an invalid optimization.  */
  	if (Has_Nested_Block_With_Handler (Scope (gnat_entity))
! 	    && Exception_Mechanism != GCC_ZCX)
  	  TREE_ADDRESSABLE (gnu_decl) = 1;
  
  	/* Back-annotate the Alignment of the object if not already in the
--- 1161,1171 ----
  	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
  	  }
  
! 	/* If this is declared in a block that contains a block with an
  	   exception handler, we must force this variable in memory to
  	   suppress an invalid optimization.  */
  	if (Has_Nested_Block_With_Handler (Scope (gnat_entity))
! 	    && Exception_Mechanism != Back_End_Exceptions)
  	  TREE_ADDRESSABLE (gnu_decl) = 1;
  
  	/* Back-annotate the Alignment of the object if not already in the
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1482,1500 ****
  	TYPE_READONLY (gnu_template_type) = 1;
  
  	/* Make a node for the array.  If we are not defining the array
! 	   suppress expanding incomplete types and save the node as the type
! 	   for GNAT_ENTITY.  */
  	gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
  	if (!definition)
! 	  {
! 	    defer_incomplete_level++;
! 	    this_deferred = this_made_decl = true;
! 	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! 					 !Comes_From_Source (gnat_entity),
! 					 debug_info_p, gnat_entity);
! 	    save_gnu_tree (gnat_entity, gnu_decl, false);
! 	    saved = true;
! 	  }
  
  	/* Build the fat pointer type.  Use a "void *" object instead of
  	   a pointer to the array type since we don't have the array type
--- 1548,1558 ----
  	TYPE_READONLY (gnu_template_type) = 1;
  
  	/* Make a node for the array.  If we are not defining the array
! 	   suppress expanding incomplete types.  */
  	gnu_type = make_node (UNCONSTRAINED_ARRAY_TYPE);
+ 
  	if (!definition)
! 	  defer_incomplete_level++, this_deferred = true;
  
  	/* Build the fat pointer type.  Use a "void *" object instead of
  	   a pointer to the array type since we don't have the array type
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2297,2305 ****
  	  }
  
  	/* Make a node for the record.  If we are not defining the record,
! 	   suppress expanding incomplete types and save the node as the type
! 	   for GNAT_ENTITY.  We use the same RECORD_TYPE as for a dummy type
! 	   and reset TYPE_DUMMY_P to show it's no longer a dummy.
  
  	   It is very tempting to delay resetting this bit until we are done
  	   with completing the type, e.g. to let possible intermediate
--- 2355,2363 ----
  	  }
  
  	/* Make a node for the record.  If we are not defining the record,
! 	   suppress expanding incomplete types.  We use the same RECORD_TYPE
! 	   as for a dummy type and reset TYPE_DUMMY_P to show it's no longer
! 	   a dummy.
  
  	   It is very tempting to delay resetting this bit until we are done
  	   with completing the type, e.g. to let possible intermediate
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2322,2336 ****
  	TYPE_PACKED (gnu_type) = packed || has_rep;
  
  	if (!definition)
! 	  {
! 	    defer_incomplete_level++;
! 	    this_deferred = true;
! 	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! 					 !Comes_From_Source (gnat_entity),
! 					 debug_info_p, gnat_entity);
! 	    save_gnu_tree (gnat_entity, gnu_decl, false);
! 	    this_made_decl = saved = true;
! 	  }
  
  	/* If both a size and rep clause was specified, put the size in
  	   the record type now so that it can get the proper mode.  */
--- 2380,2386 ----
  	TYPE_PACKED (gnu_type) = packed || has_rep;
  
  	if (!definition)
! 	  defer_incomplete_level++, this_deferred = true;
  
  	/* If both a size and rep clause was specified, put the size in
  	   the record type now so that it can get the proper mode.  */
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2348,2354 ****
  	else if (Is_Atomic (gnat_entity))
  	  TYPE_ALIGN (gnu_type)
  	    = (esize >= BITS_PER_WORD ? BITS_PER_WORD
! 	       : 1 << ((floor_log2 (esize) - 1) + 1));
  
  	/* If we have a Parent_Subtype, make a field for the parent.  If
  	   this record has rep clauses, force the position to zero.  */
--- 2398,2404 ----
  	else if (Is_Atomic (gnat_entity))
  	  TYPE_ALIGN (gnu_type)
  	    = (esize >= BITS_PER_WORD ? BITS_PER_WORD
! 	       : 1 << (floor_log2 (esize - 1) + 1));
  
  	/* If we have a Parent_Subtype, make a field for the parent.  If
  	   this record has rep clauses, force the position to zero.  */
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2439,2445 ****
  	/* Add the listed fields into the record and finish up.  */
  	components_to_record (gnu_type, Component_List (record_definition),
  			      gnu_field_list, packed, definition, NULL,
! 			      false, all_rep);
  
  	/* We used to remove the associations of the discriminants and
  	   _Parent for validity checking, but we may need them if there's
--- 2489,2505 ----
  	/* Add the listed fields into the record and finish up.  */
  	components_to_record (gnu_type, Component_List (record_definition),
  			      gnu_field_list, packed, definition, NULL,
! 			      false, all_rep, this_deferred);
! 
!         if (this_deferred)
! 	  {
! 	    debug_deferred = true;
! 	    defer_debug_level++;
! 
! 	    defer_debug_incomplete_list
! 	      = tree_cons (NULL_TREE, gnu_type,
! 			   defer_debug_incomplete_list);
! 	  }
  
  	/* We used to remove the associations of the discriminants and
  	   _Parent for validity checking, but we may need them if there's
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2869,2875 ****
  	/* If we are pointing to an incomplete type whose completion is an
  	   unconstrained array, make a fat pointer type instead of a pointer
  	   to VOID.  The two types in our fields will be pointers to VOID and
! 	   will be replaced in update_pointer_to.  Similiarly, if the type
  	   itself is a dummy type or an unconstrained array.  Also make
  	   a dummy TYPE_OBJECT_RECORD_TYPE in case we have any thin
  	   pointers to it.  */
--- 2929,2935 ----
  	/* If we are pointing to an incomplete type whose completion is an
  	   unconstrained array, make a fat pointer type instead of a pointer
  	   to VOID.  The two types in our fields will be pointers to VOID and
! 	   will be replaced in update_pointer_to.  Similarly, if the type
  	   itself is a dummy type or an unconstrained array.  Also make
  	   a dummy TYPE_OBJECT_RECORD_TYPE in case we have any thin
  	   pointers to it.  */
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3406,3418 ****
  	      post_error ("unsupported mechanism for&", gnat_param);
  
  	    /* If this is either a foreign function or if the
! 	       underlying type won't be passed by refererence, strip off
  	       possible padding type.  */
  	    if (TREE_CODE (gnu_param_type) == RECORD_TYPE
  		&& TYPE_IS_PADDING_P (gnu_param_type)
  		&& (req_by_ref || Has_Foreign_Convention (gnat_entity)
! 		    || !must_pass_by_ref (TREE_TYPE (TYPE_FIELDS
! 						     (gnu_param_type)))))
  	      gnu_param_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type));
  
  	    /* If this is an IN parameter it is read-only, so make a variant
--- 3466,3482 ----
  	      post_error ("unsupported mechanism for&", gnat_param);
  
  	    /* If this is either a foreign function or if the
! 	       underlying type won't be passed by reference, strip off
  	       possible padding type.  */
  	    if (TREE_CODE (gnu_param_type) == RECORD_TYPE
  		&& TYPE_IS_PADDING_P (gnu_param_type)
  		&& (req_by_ref || Has_Foreign_Convention (gnat_entity)
! 		    || (!must_pass_by_ref (TREE_TYPE (TYPE_FIELDS
! 					              (gnu_param_type)))
! 			&& (req_by_copy
! 			    || !default_pass_by_ref (TREE_TYPE
! 			    			      (TYPE_FIELDS
! 						       (gnu_param_type)))))))
  	      gnu_param_type = TREE_TYPE (TYPE_FIELDS (gnu_param_type));
  
  	    /* If this is an IN parameter it is read-only, so make a variant
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3590,3597 ****
  	   stubbed since structures are incomplete for the back-end.  */
  	if (gnu_field_list
  	    && Convention (gnat_entity) != Convention_Stubbed)
! 	  finish_record_type (gnu_return_type, nreverse (gnu_field_list),
! 			      false, false);
  
  	/* If we have a CICO list but it has only one entry, we convert
  	   this function into a function that simply returns that one
--- 3654,3677 ----
  	   stubbed since structures are incomplete for the back-end.  */
  	if (gnu_field_list
  	    && Convention (gnat_entity) != Convention_Stubbed)
!            {
!  	    /* If all types are not complete, defer emission of debug
!  	       information for this record types. Otherwise, we risk emitting
!  	       debug information for a dummy type contained in the fields
! 	       for that record.  */
!  	    finish_record_type (gnu_return_type, nreverse (gnu_field_list),
!  			        false, defer_incomplete_level);
! 
!  	    if (defer_incomplete_level)
!  	      {
!  	        debug_deferred = true;
!  	        defer_debug_level++;
! 
! 	        defer_debug_incomplete_list
! 		  = tree_cons (NULL_TREE, gnu_return_type,
! 			       defer_debug_incomplete_list);
!  	      }
!  	  }
  
  	/* If we have a CICO list but it has only one entry, we convert
  	   this function into a function that simply returns that one
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3599,3606 ****
  	if (list_length (gnu_return_list) == 1)
  	  gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
  
! #ifdef _WIN32
! 	if (Convention (gnat_entity) == Convention_Stdcall)
  	  {
  	    struct attrib *attr
  	      = (struct attrib *) xmalloc (sizeof (struct attrib));
--- 3679,3685 ----
  	if (list_length (gnu_return_list) == 1)
  	  gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list));
  
! 	if (Has_Stdcall_Convention (gnat_entity))
  	  {
  	    struct attrib *attr
  	      = (struct attrib *) xmalloc (sizeof (struct attrib));
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3612,3618 ****
  	    attr->error_point = gnat_entity;
  	    attr_list = attr;
  	  }
- #endif
  
  	/* Both lists ware built in reverse.  */
  	gnu_param_list = nreverse (gnu_param_list);
--- 3691,3696 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3696,3702 ****
  	else if (kind == E_Subprogram_Type)
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       !Comes_From_Source (gnat_entity),
! 				       debug_info_p, gnat_entity);
  	else
  	  {
  	    gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name,
--- 3774,3781 ----
  	else if (kind == E_Subprogram_Type)
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       !Comes_From_Source (gnat_entity),
! 				       debug_info_p && !defer_incomplete_level,
! 				       gnat_entity);
  	else
  	  {
  	    gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name,
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3722,3735 ****
  	 compiling, then just get the type from its Etype.  */
        if (No (Full_View (gnat_entity)))
  	{
! 	  /* If this is an incomplete type with no full view, it must
! 	     be a Taft Amendement type, so just return a dummy type.  */
  	  if (kind == E_Incomplete_Type)
! 	    gnu_type = make_dummy_type (gnat_entity);
  
!           else if (Present (Underlying_Full_View (gnat_entity)))
!              gnu_decl = gnat_to_gnu_entity (Underlying_Full_View (gnat_entity),
! 					    NULL_TREE, 0);
  	  else
  	    {
  	      gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity),
--- 3801,3823 ----
  	 compiling, then just get the type from its Etype.  */
        if (No (Full_View (gnat_entity)))
  	{
! 	  /* If this is an incomplete type with no full view, it must be
! 	     either a limited view brought in by a limited_with clause, in
! 	     which case we use the non-limited view, or a Taft Amendement
! 	     type, in which case we just return a dummy type.  */
  	  if (kind == E_Incomplete_Type)
! 	    {
! 	      if (From_With_Type (gnat_entity)
! 		  && Present (Non_Limited_View (gnat_entity)))
! 		gnu_decl = gnat_to_gnu_entity (Non_Limited_View (gnat_entity),
! 					       NULL_TREE, 0);
! 	      else
! 		gnu_type = make_dummy_type (gnat_entity);
! 	    }
  
! 	  else if (Present (Underlying_Full_View (gnat_entity)))
! 	    gnu_decl = gnat_to_gnu_entity (Underlying_Full_View (gnat_entity),
! 					   NULL_TREE, 0);
  	  else
  	    {
  	      gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity),
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 4043,4049 ****
      DECL_ARTIFICIAL (gnu_decl) = 1;
  
    if (!debug_info_p && DECL_P (gnu_decl)
!       && TREE_CODE (gnu_decl) != FUNCTION_DECL)
      DECL_IGNORED_P (gnu_decl) = 1;
  
    /* If we haven't already, associate the ..._DECL node that we just made with
--- 4131,4138 ----
      DECL_ARTIFICIAL (gnu_decl) = 1;
  
    if (!debug_info_p && DECL_P (gnu_decl)
!       && TREE_CODE (gnu_decl) != FUNCTION_DECL
!       && No (Renamed_Object (gnat_entity)))
      DECL_IGNORED_P (gnu_decl) = 1;
  
    /* If we haven't already, associate the ..._DECL node that we just made with
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 4122,4127 ****
--- 4211,4241 ----
  	  }
      }
  
+    /* If there are no incomplete types and we have deferred emission
+       of debug information, check whether we have finished defining
+       all nested records.
+       If so, handle the list now.  */
+ 
+    if (debug_deferred)
+      defer_debug_level--;
+ 
+    if (defer_debug_incomplete_list
+        && !defer_incomplete_level
+        && !defer_debug_level)
+     {
+       tree c, n;
+ 
+       defer_debug_incomplete_list = nreverse (defer_debug_incomplete_list);
+ 
+       for (c = defer_debug_incomplete_list; c; c = n)
+ 	{
+ 	  n = TREE_CHAIN (c);
+ 	  write_record_type_debug_info (TREE_VALUE (c));
+ 	}
+ 
+       defer_debug_incomplete_list = 0;
+     }
+ 
    if (this_global)
      force_global--;
  
*************** elaborate_entity (Entity_Id gnat_entity)
*** 4166,4172 ****
  	Node_Id gnat_lb = Type_Low_Bound (gnat_entity);
  	Node_Id gnat_hb = Type_High_Bound (gnat_entity);
  
! 	/* ??? Tests for avoiding static constaint error expression
  	   is needed until the front stops generating bogus conversions
  	   on bounds of real types. */
  
--- 4280,4286 ----
  	Node_Id gnat_lb = Type_Low_Bound (gnat_entity);
  	Node_Id gnat_hb = Type_High_Bound (gnat_entity);
  
! 	/* ??? Tests for avoiding static constraint error expression
  	   is needed until the front stops generating bogus conversions
  	   on bounds of real types. */
  
*************** copy_alias_set (tree gnu_new_type, tree 
*** 4291,4297 ****
  /* Return a TREE_LIST describing the substitutions needed to reflect
     discriminant substitutions from GNAT_SUBTYPE to GNAT_TYPE and add
     them to GNU_LIST.  If GNAT_TYPE is not specified, use the base type
!    of GNAT_SUBTYPE. The substitions can be in any order.  TREE_PURPOSE
     gives the tree for the discriminant and TREE_VALUES is the replacement
     value.  They are in the form of operands to substitute_in_expr.
     DEFINITION is as in gnat_to_gnu_entity.  */
--- 4405,4411 ----
  /* Return a TREE_LIST describing the substitutions needed to reflect
     discriminant substitutions from GNAT_SUBTYPE to GNAT_TYPE and add
     them to GNU_LIST.  If GNAT_TYPE is not specified, use the base type
!    of GNAT_SUBTYPE. The substitutions can be in any order.  TREE_PURPOSE
     gives the tree for the discriminant and TREE_VALUES is the replacement
     value.  They are in the form of operands to substitute_in_expr.
     DEFINITION is as in gnat_to_gnu_entity.  */
*************** prepend_attributes (Entity_Id gnat_entit
*** 4466,4471 ****
--- 4580,4593 ----
  	    etype = ATTR_LINK_SECTION;
  	    break;
  
+ 	  case Pragma_Linker_Constructor:
+ 	    etype = ATTR_LINK_CONSTRUCTOR;
+ 	    break;
+ 
+ 	  case Pragma_Linker_Destructor:
+ 	    etype = ATTR_LINK_DESTRUCTOR;
+ 	    break;
+ 
  	  case Pragma_Weak_External:
  	    etype = ATTR_WEAK_EXTERNAL;
  	    break;
*************** elaborate_expression (Node_Id gnat_expr,
*** 4560,4566 ****
  		   && Ekind (Entity (gnat_expr)) == E_Discriminant)))
      return 0;
  
!   /* Otherwise, convert this tree to its GCC equivalant.  */
    gnu_expr
      = elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
  			      gnu_name, definition, need_debug);
--- 4682,4688 ----
  		   && Ekind (Entity (gnat_expr)) == E_Discriminant)))
      return 0;
  
!   /* Otherwise, convert this tree to its GCC equivalent.  */
    gnu_expr
      = elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
  			      gnu_name, definition, need_debug);
*************** elaborate_expression_1 (Node_Id gnat_exp
*** 4626,4634 ****
      gnu_decl
        = create_var_decl (create_concat_name (gnat_entity,
  					     IDENTIFIER_POINTER (gnu_name)),
! 			 NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true,
! 			 Is_Public (gnat_entity), !definition, false, NULL,
! 			 gnat_entity);
  
    /* We only need to use this variable if we are in global context since GCC
       can do the right thing in the local case.  */
--- 4748,4756 ----
      gnu_decl
        = create_var_decl (create_concat_name (gnat_entity,
  					     IDENTIFIER_POINTER (gnu_name)),
! 			 NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
! 			 !need_debug, Is_Public (gnat_entity),
! 			 !definition, false, NULL, gnat_entity);
  
    /* We only need to use this variable if we are in global context since GCC
       can do the right thing in the local case.  */
*************** maybe_pad_type (tree type, tree size, un
*** 4908,4914 ****
  
        if (size && TREE_CODE (size) != INTEGER_CST && definition)
  	create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
! 			 sizetype, TYPE_SIZE (record), false, false, false,
  			 false, NULL, gnat_entity);
      }
  
--- 5030,5036 ----
  
        if (size && TREE_CODE (size) != INTEGER_CST && definition)
  	create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
! 			 bitsizetype, TYPE_SIZE (record), false, false, false,
  			 false, NULL, gnat_entity);
      }
  
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5054,5060 ****
  {
    tree gnu_field_id = get_entity_name (gnat_field);
    tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field));
-   tree gnu_orig_field_type = gnu_field_type;
    tree gnu_pos = 0;
    tree gnu_size = 0;
    tree gnu_field;
--- 5176,5181 ----
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5080,5115 ****
      gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
  			      gnat_field, FIELD_DECL, false, true);
  
-   /* If the field's type is justified modular and the size of the packed
-      array it wraps is the same as that of the field, we can make the field
-      the type of the inner object.  Note that we may need to do so if the
-      record is packed or the field has a component clause, but these cases
-      are handled later.  */
-   if (TREE_CODE (gnu_field_type) == RECORD_TYPE
-       && TYPE_JUSTIFIED_MODULAR_P (gnu_field_type)
-       && tree_int_cst_equal (TYPE_SIZE (gnu_field_type),
- 			     TYPE_ADA_SIZE (gnu_field_type)))
-     gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
- 
    /* If we are packing this record, have a specified size that's smaller than
!      that of the field type, or a position is specified, and the field type
!      is also a record that's BLKmode and with a small constant size, see if
!      we can get a better form of the type that allows more packing.  If we
!      can, show a size was specified for it if there wasn't one so we know to
!      make this a bitfield and avoid making things wider.  */
    if (TREE_CODE (gnu_field_type) == RECORD_TYPE
        && TYPE_MODE (gnu_field_type) == BLKmode
        && host_integerp (TYPE_SIZE (gnu_field_type), 1)
        && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
        && (packed == 1
! 	  || (gnu_size && tree_int_cst_lt (gnu_size,
! 					   TYPE_SIZE (gnu_field_type)))
  	  || Present (Component_Clause (gnat_field))))
      {
!       gnu_field_type = make_packable_type (gnu_field_type);
  
!       if (gnu_field_type != gnu_orig_field_type && !gnu_size)
! 	gnu_size = rm_size (gnu_field_type);
      }
  
    /* If we are packing the record and the field is BLKmode, round the
--- 5201,5248 ----
      gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
  			      gnat_field, FIELD_DECL, false, true);
  
    /* If we are packing this record, have a specified size that's smaller than
!      that of the field type, or a position is specified, and the field type is
!      also a record that's BLKmode and with a small constant size, see if we
!      can get a better form of the type that allows more packing.  If we can,
!      show a size was specified for it if there wasn't one so we know to make
!      this a bitfield and avoid making things wider.  */
    if (TREE_CODE (gnu_field_type) == RECORD_TYPE
        && TYPE_MODE (gnu_field_type) == BLKmode
        && host_integerp (TYPE_SIZE (gnu_field_type), 1)
        && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
        && (packed == 1
! 	  || (gnu_size
! 	      && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)))
  	  || Present (Component_Clause (gnat_field))))
      {
!       /* See what the alternate type and size would be.  */
!       tree gnu_packable_type = make_packable_type (gnu_field_type);
  
!       /* Compute whether we should avoid the substitution.  */
!       int reject =
!         /* There is no point substituting if there is no change.  */
!         (gnu_packable_type == gnu_field_type
!          ||
!          /* The size of an aliased field must be an exact multiple of the
!             type's alignment, which the substitution might increase.  Reject
!             substitutions that would so invalidate a component clause when the
!             specified position is byte aligned, as the change would have no
!             real benefit from the packing standpoint anyway.  */
!          (Is_Aliased (gnat_field)
!           && Present (Component_Clause (gnat_field))
!           && UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0
!           && tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0)
!          );
! 
!       /* Substitute unless told otherwise.  */
!       if (!reject)
!         {
!           gnu_field_type = gnu_packable_type;
! 
!           if (gnu_size == 0)
!             gnu_size = rm_size (gnu_field_type);
!         }
      }
  
    /* If we are packing the record and the field is BLKmode, round the
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5146,5159 ****
  	 consistent with the alignment.  */
        if (needs_strict_alignment)
  	{
! 	  tree gnu_min_size = round_up (rm_size (gnu_field_type),
! 					TYPE_ALIGN (gnu_field_type));
  
  	  TYPE_ALIGN (gnu_record_type)
  	    = MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_field_type));
  
! 	  /* If Atomic, the size must match exactly and if aliased, the size
! 	     must not be less than the rounded size.  */
  	  if ((Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field)))
  	      && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
  	    {
--- 5279,5291 ----
  	 consistent with the alignment.  */
        if (needs_strict_alignment)
  	{
! 	  tree gnu_rounded_size = round_up (rm_size (gnu_field_type),
! 					    TYPE_ALIGN (gnu_field_type));
  
  	  TYPE_ALIGN (gnu_record_type)
  	    = MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_field_type));
  
! 	  /* If Atomic, the size must match exactly that of the field.  */
  	  if ((Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field)))
  	      && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
  	    {
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5165,5177 ****
  	      gnu_size = NULL_TREE;
  	    }
  
  	  else if (Is_Aliased (gnat_field)
! 		   && gnu_size && tree_int_cst_lt (gnu_size, gnu_min_size))
  	    {
  	      post_error_ne_tree
! 		("size of aliased field& too small{, minimum required is ^}",
  		 Last_Bit (Component_Clause (gnat_field)), gnat_field,
! 		 gnu_min_size);
  	      gnu_size = NULL_TREE;
    	    }
  
--- 5297,5314 ----
  	      gnu_size = NULL_TREE;
  	    }
  
+ 	  /* If Aliased, the size must match exactly the rounded size.  We
+ 	     used to be more accommodating here and accept greater sizes, but
+ 	     fully supporting this case on big-endian platforms would require
+ 	     switching to a more involved layout for the field.  */
  	  else if (Is_Aliased (gnat_field)
! 		   && gnu_size
! 		   && ! operand_equal_p (gnu_size, gnu_rounded_size, 0))
  	    {
  	      post_error_ne_tree
! 		("size of aliased field& must be ^ bits",
  		 Last_Bit (Component_Clause (gnat_field)), gnat_field,
! 		 gnu_rounded_size);
  	      gnu_size = NULL_TREE;
    	    }
  
*************** is_variable_size (tree type)
*** 5323,5328 ****
--- 5460,5468 ----
     ALL_REP, if true, means a rep clause was found for all the fields.  This
     simplifies the logic since we know we're not in the mixed case.
  
+    DEFER_DEBUG, if true, means that the debugging routines should not be
+    called when finishing constructing the record type.
+ 
     The processing of the component list fills in the chain with all of the
     fields of the record and then the record type is finished.  */
  
*************** static void
*** 5330,5336 ****
  components_to_record (tree gnu_record_type, Node_Id component_list,
                        tree gnu_field_list, int packed, bool definition,
                        tree *p_gnu_rep_list, bool cancel_alignment,
! 		      bool all_rep)
  {
    Node_Id component_decl;
    Entity_Id gnat_field;
--- 5470,5476 ----
  components_to_record (tree gnu_record_type, Node_Id component_list,
                        tree gnu_field_list, int packed, bool definition,
                        tree *p_gnu_rep_list, bool cancel_alignment,
! 		      bool all_rep, bool defer_debug)
  {
    Node_Id component_decl;
    Entity_Id gnat_field;
*************** components_to_record (tree gnu_record_ty
*** 5452,5458 ****
  
  	  components_to_record (gnu_variant_type, Component_List (variant),
  				NULL_TREE, packed, definition,
! 				&gnu_our_rep_list, !all_rep_and_size, all_rep);
  
  	  gnu_qual = choices_to_gnu (gnu_discriminant,
  				     Discrete_Choices (variant));
--- 5592,5599 ----
  
  	  components_to_record (gnu_variant_type, Component_List (variant),
  				NULL_TREE, packed, definition,
! 				&gnu_our_rep_list, !all_rep_and_size, all_rep,
! 				false);
  
  	  gnu_qual = choices_to_gnu (gnu_discriminant,
  				     Discrete_Choices (variant));
*************** components_to_record (tree gnu_record_ty
*** 5548,5560 ****
        tree *gnu_arr = (tree *) alloca (sizeof (tree) * len);
        int i;
  
!       /* Set DECL_SECTION_NAME to increasing integers so we have a
  	 stable sort.  */
        for (i = 0, gnu_field = gnu_our_rep_list; gnu_field;
  	   gnu_field = TREE_CHAIN (gnu_field), i++)
  	{
  	  gnu_arr[i] = gnu_field;
! 	  DECL_SECTION_NAME (gnu_field) = size_int (i);
  	}
  
        qsort (gnu_arr, len, sizeof (tree), compare_field_bitpos);
--- 5689,5701 ----
        tree *gnu_arr = (tree *) alloca (sizeof (tree) * len);
        int i;
  
!       /* Set/abuse DECL_FCONTEXT to increasing integers so we have a
  	 stable sort.  */
        for (i = 0, gnu_field = gnu_our_rep_list; gnu_field;
  	   gnu_field = TREE_CHAIN (gnu_field), i++)
  	{
  	  gnu_arr[i] = gnu_field;
! 	  DECL_FCONTEXT (gnu_field) = size_int (i);
  	}
  
        qsort (gnu_arr, len, sizeof (tree), compare_field_bitpos);
*************** components_to_record (tree gnu_record_ty
*** 5567,5573 ****
  	  TREE_CHAIN (gnu_arr[i]) = gnu_our_rep_list;
  	  gnu_our_rep_list = gnu_arr[i];
  	  DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type;
! 	  DECL_SECTION_NAME (gnu_arr[i]) = NULL_TREE;
  	}
  
        if (gnu_field_list)
--- 5708,5714 ----
  	  TREE_CHAIN (gnu_arr[i]) = gnu_our_rep_list;
  	  gnu_our_rep_list = gnu_arr[i];
  	  DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type;
! 	  DECL_FCONTEXT (gnu_arr[i]) = NULL_TREE;
  	}
  
        if (gnu_field_list)
*************** components_to_record (tree gnu_record_ty
*** 5589,5595 ****
      TYPE_ALIGN (gnu_record_type) = 0;
  
    finish_record_type (gnu_record_type, nreverse (gnu_field_list),
! 		      layout_with_rep, false);
  }
  
  /* Called via qsort from the above.  Returns -1, 1, depending on the
--- 5730,5736 ----
      TYPE_ALIGN (gnu_record_type) = 0;
  
    finish_record_type (gnu_record_type, nreverse (gnu_field_list),
! 		      layout_with_rep, defer_debug);
  }
  
  /* Called via qsort from the above.  Returns -1, 1, depending on the
*************** compare_field_bitpos (const PTR rt1, con
*** 5603,5609 ****
  
    if (tree_int_cst_equal (bit_position (*t1), bit_position (*t2)))
      return
!       (tree_int_cst_lt (DECL_SECTION_NAME (*t1), DECL_SECTION_NAME (*t2))
         ? -1 : 1);
    else if (tree_int_cst_lt (bit_position (*t1), bit_position (*t2)))
      return -1;
--- 5744,5750 ----
  
    if (tree_int_cst_equal (bit_position (*t1), bit_position (*t2)))
      return
!       (tree_int_cst_lt (DECL_FCONTEXT (*t1), DECL_FCONTEXT (*t2))
         ? -1 : 1);
    else if (tree_int_cst_lt (bit_position (*t1), bit_position (*t2)))
      return -1;
*************** annotate_value (tree gnu_size)
*** 5624,5633 ****
    int i;
    int size;
  
-   /* If back annotation is suppressed by the front end, return No_Uint */
-   if (!Back_Annotate_Rep_Info)
-     return No_Uint;
- 
    /* See if we've already saved the value for this node.  */
    if (EXPR_P (gnu_size) && TREE_COMPLEXITY (gnu_size))
      return (Node_Ref_Or_Val) TREE_COMPLEXITY (gnu_size);
--- 5765,5770 ----
*************** annotate_value (tree gnu_size)
*** 5649,5655 ****
        /* For negative values, use NEGATE_EXPR of the supplied value.  */
        if (tree_int_cst_sgn (gnu_size) < 0)
  	{
! 	  /* The rediculous code below is to handle the case of the largest
  	     negative integer.  */
  	  tree negative_size = size_diffop (bitsize_zero_node, gnu_size);
  	  bool adjust = false;
--- 5786,5792 ----
        /* For negative values, use NEGATE_EXPR of the supplied value.  */
        if (tree_int_cst_sgn (gnu_size) < 0)
  	{
! 	  /* The ridiculous code below is to handle the case of the largest
  	     negative integer.  */
  	  tree negative_size = size_diffop (bitsize_zero_node, gnu_size);
  	  bool adjust = false;
*************** annotate_value (tree gnu_size)
*** 5720,5725 ****
--- 5857,5863 ----
      case TRUTH_OR_EXPR:		tcode = Truth_Or_Expr; break;
      case TRUTH_XOR_EXPR:	tcode = Truth_Xor_Expr; break;
      case TRUTH_NOT_EXPR:	tcode = Truth_Not_Expr; break;
+     case BIT_AND_EXPR:		tcode = Bit_And_Expr; break;
      case LT_EXPR:		tcode = Lt_Expr; break;
      case LE_EXPR:		tcode = Le_Expr; break;
      case GT_EXPR:		tcode = Gt_Expr; break;
*************** annotate_rep (Entity_Id gnat_entity, tre
*** 5806,5813 ****
  	    Set_Esize (gnat_field,
  		       annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry))));
  	  }
! 	else if (type_annotate_only
! 		 && Is_Tagged_Type (gnat_entity)
  		 && Is_Derived_Type (gnat_entity))
  	  {
  	    /* If there is no gnu_entry, this is an inherited component whose
--- 5944,5950 ----
  	    Set_Esize (gnat_field,
  		       annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry))));
  	  }
! 	else if (Is_Tagged_Type (gnat_entity)
  		 && Is_Derived_Type (gnat_entity))
  	  {
  	    /* If there is no gnu_entry, this is an inherited component whose
*************** static int
*** 6268,6274 ****
  compatible_signatures_p (tree ftype1, tree ftype2)
  {
    /* As of now, we only perform very trivial tests and consider it's the
!      programmer's responsability to ensure the type correctness in the Ada
       declaration, as in the regular Import cases.
  
       Mismatches typically result in either error messages from the builtin
--- 6405,6411 ----
  compatible_signatures_p (tree ftype1, tree ftype2)
  {
    /* As of now, we only perform very trivial tests and consider it's the
!      programmer's responsibility to ensure the type correctness in the Ada
       declaration, as in the regular Import cases.
  
       Mismatches typically result in either error messages from the builtin
*************** gnat_substitute_in_type (tree t, tree f,
*** 6348,6354 ****
  
      case OFFSET_TYPE:
      case METHOD_TYPE:
-     case FILE_TYPE:
      case FUNCTION_TYPE:
      case LANG_TYPE:
        /* Don't know how to do these yet.  */
--- 6485,6490 ----
*************** rm_size (tree gnu_type)
*** 6547,6578 ****
  tree
  create_concat_name (Entity_Id gnat_entity, const char *suffix)
  {
    const char *str = (!suffix ? "" : suffix);
    String_Template temp = {1, strlen (str)};
    Fat_Pointer fp = {str, &temp};
  
    Get_External_Name_With_Suffix (gnat_entity, fp);
  
- #ifdef _WIN32
    /* A variable using the Stdcall convention (meaning we are running
       on a Windows box) live in a DLL. Here we adjust its name to use
       the jump-table, the _imp__NAME contains the address for the NAME
       variable. */
!   {
!     Entity_Kind kind = Ekind (gnat_entity);
!     const char *prefix = "_imp__";
!     int plen = strlen (prefix);
  
!     if ((kind == E_Variable || kind == E_Constant)
! 	&& Convention (gnat_entity) == Convention_Stdcall)
!       {
! 	int k;
! 	for (k = 0; k <= Name_Len; k++)
! 	  Name_Buffer [Name_Len - k + plen] = Name_Buffer [Name_Len - k];
! 	strncpy (Name_Buffer, prefix, plen);
!       }
!   }
! #endif
  
    return get_identifier (Name_Buffer);
  }
--- 6683,6710 ----
  tree
  create_concat_name (Entity_Id gnat_entity, const char *suffix)
  {
+   Entity_Kind kind = Ekind (gnat_entity);
+ 
    const char *str = (!suffix ? "" : suffix);
    String_Template temp = {1, strlen (str)};
    Fat_Pointer fp = {str, &temp};
  
    Get_External_Name_With_Suffix (gnat_entity, fp);
  
    /* A variable using the Stdcall convention (meaning we are running
       on a Windows box) live in a DLL. Here we adjust its name to use
       the jump-table, the _imp__NAME contains the address for the NAME
       variable. */
!   if ((kind == E_Variable || kind == E_Constant)
!       && Has_Stdcall_Convention (gnat_entity))
!     {
!       const char *prefix = "_imp__";
!       int k, plen = strlen (prefix);
  
!       for (k = 0; k <= Name_Len; k++)
! 	Name_Buffer [Name_Len - k + plen] = Name_Buffer [Name_Len - k];
!       strncpy (Name_Buffer, prefix, plen);
!     }
  
    return get_identifier (Name_Buffer);
  }
diff -Nrcpad gcc-4.0.2/gcc/ada/deftarg.c gcc-4.1.0/gcc/ada/deftarg.c
*** gcc-4.0.2/gcc/ada/deftarg.c	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/deftarg.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/directio.ads gcc-4.1.0/gcc/ada/directio.ads
*** gcc-4.0.2/gcc/ada/directio.ads	Thu Apr 24 17:53:59 2003
--- gcc-4.1.0/gcc/ada/directio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                            D I R E C T _ I O                             --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                            D I R E C T _ I O                             --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/einfo.adb gcc-4.1.0/gcc/ada/einfo.adb
*** gcc-4.0.2/gcc/ada/einfo.adb	Thu Feb 10 13:50:25 2005
--- gcc-4.1.0/gcc/ada/einfo.adb	Tue Nov 15 13:54:36 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Einfo is
*** 129,135 ****
     --    String_Literal_Low_Bound        Node15
     --    Shared_Var_Read_Proc            Node15
  
!    --    Access_Disp_Table               Node16
     --    Cloned_Subtype                  Node16
     --    DTC_Entity                      Node16
     --    Entry_Formal                    Node16
--- 129,135 ----
     --    String_Literal_Low_Bound        Node15
     --    Shared_Var_Read_Proc            Node15
  
!    --    Access_Disp_Table               Elist16
     --    Cloned_Subtype                  Node16
     --    DTC_Entity                      Node16
     --    Entry_Formal                    Node16
*************** package body Einfo is
*** 210,219 ****
     --    Protected_Operation             Node23
  
     --    Obsolescent_Warning             Node24
  
!    --    (unused)                        Node25
!    --    (unused)                        Node26
!    --    (unused)                        Node27
  
     ---------------------------------------------
     -- Usage of Flags in Defining Entity Nodes --
--- 210,225 ----
     --    Protected_Operation             Node23
  
     --    Obsolescent_Warning             Node24
+    --    Task_Body_Procedure             Node24
+    --    Abstract_Interfaces             Elist24
  
!    --    Abstract_Interface_Alias        Node25
!    --    Current_Use_Clause              Node25
! 
!    --    Overridden_Operation            Node26
!    --    Package_Instantiation           Node26
! 
!    --    Wrapped_Entity                  Node27
  
     ---------------------------------------------
     -- Usage of Flags in Defining Entity Nodes --
*************** package body Einfo is
*** 384,390 ****
     --    Has_Recursive_Call             Flag143
     --    Is_Unsigned_Type               Flag144
     --    Strict_Alignment               Flag145
!    --    Elaborate_All_Desirable        Flag146
     --    Needs_Debug_Info               Flag147
     --    Suppress_Elaboration_Warnings  Flag148
     --    Is_Compilation_Unit            Flag149
--- 390,396 ----
     --    Has_Recursive_Call             Flag143
     --    Is_Unsigned_Type               Flag144
     --    Strict_Alignment               Flag145
!    --    (unused)                       Flag146
     --    Needs_Debug_Info               Flag147
     --    Suppress_Elaboration_Warnings  Flag148
     --    Is_Compilation_Unit            Flag149
*************** package body Einfo is
*** 428,450 ****
     --    Must_Be_On_Byte_Boundary       Flag183
     --    Has_Stream_Size_Clause         Flag184
     --    Is_Ada_2005                    Flag185
  
-    --    (unused)                       Flag186
-    --    (unused)                       Flag187
-    --    (unused)                       Flag188
-    --    (unused)                       Flag189
-    --    (unused)                       Flag190
-    --    (unused)                       Flag191
-    --    (unused)                       Flag192
-    --    (unused)                       Flag193
-    --    (unused)                       Flag194
-    --    (unused)                       Flag195
-    --    (unused)                       Flag196
-    --    (unused)                       Flag197
-    --    (unused)                       Flag198
-    --    (unused)                       Flag199
-    --    (unused)                       Flag200
-    --    (unused)                       Flag201
     --    (unused)                       Flag202
     --    (unused)                       Flag203
     --    (unused)                       Flag204
--- 434,458 ----
     --    Must_Be_On_Byte_Boundary       Flag183
     --    Has_Stream_Size_Clause         Flag184
     --    Is_Ada_2005                    Flag185
+    --    Is_Interface                   Flag186
+    --    Has_Constrained_Partial_View   Flag187
+    --    Has_Persistent_BSS             Flag188
+    --    Is_Pure_Unit_Access_Type       Flag189
+    --    Has_Specified_Stream_Input     Flag190
+ 
+    --    Has_Specified_Stream_Output    Flag191
+    --    Has_Specified_Stream_Read      Flag192
+    --    Has_Specified_Stream_Write     Flag193
+    --    Is_Local_Anonymous_Access      Flag194
+    --    Is_Primitive_Wrapper           Flag195
+    --    Was_Hidden                     Flag196
+    --    Is_Limited_Interface           Flag197
+    --    Is_Protected_Interface         Flag198
+    --    Is_Synchronized_Interface      Flag199
+    --    Is_Task_Interface              Flag200
+ 
+    --    Has_Anon_Block_Suffix          Flag201
  
     --    (unused)                       Flag202
     --    (unused)                       Flag203
     --    (unused)                       Flag204
*************** package body Einfo is
*** 494,508 ****
     -- Attribute Access Functions --
     --------------------------------
  
     function Accept_Address (Id : E) return L is
     begin
        return Elist21 (Id);
     end Accept_Address;
  
!    function Access_Disp_Table (Id : E) return E is
     begin
        pragma Assert (Is_Tagged_Type (Id));
!       return Node16 (Implementation_Base_Type (Id));
     end Access_Disp_Table;
  
     function Actual_Subtype (Id : E) return E is
--- 502,533 ----
     -- Attribute Access Functions --
     --------------------------------
  
+    function Abstract_Interfaces (Id : E) return L is
+    begin
+       pragma Assert
+         (Ekind (Id) = E_Record_Type
+           or else Ekind (Id) = E_Record_Subtype
+           or else Ekind (Id) = E_Record_Type_With_Private
+           or else Ekind (Id) = E_Record_Subtype_With_Private
+           or else Ekind (Id) = E_Class_Wide_Type);
+       return Elist24 (Id);
+    end Abstract_Interfaces;
+ 
+    function Abstract_Interface_Alias (Id : E) return E is
+    begin
+       pragma Assert (Is_Subprogram (Id));
+       return Node25 (Id);
+    end Abstract_Interface_Alias;
+ 
     function Accept_Address (Id : E) return L is
     begin
        return Elist21 (Id);
     end Accept_Address;
  
!    function Access_Disp_Table (Id : E) return L is
     begin
        pragma Assert (Is_Tagged_Type (Id));
!       return Elist16 (Implementation_Base_Type (Id));
     end Access_Disp_Table;
  
     function Actual_Subtype (Id : E) return E is
*************** package body Einfo is
*** 676,681 ****
--- 701,712 ----
        return Node22 (Id);
     end Corresponding_Remote_Type;
  
+    function Current_Use_Clause (Id : E) return E is
+    begin
+       pragma Assert (Ekind (Id) = E_Package);
+       return Node25 (Id);
+    end Current_Use_Clause;
+ 
     function Current_Value (Id : E) return N is
     begin
        pragma Assert (Ekind (Id) in Object_Kind);
*************** package body Einfo is
*** 797,803 ****
  
     function DT_Entry_Count (Id : E) return U is
     begin
!       pragma Assert (Ekind (Id) = E_Component  and then Is_Tag (Id));
        return Uint15 (Id);
     end DT_Entry_Count;
  
--- 828,834 ----
  
     function DT_Entry_Count (Id : E) return U is
     begin
!       pragma Assert (Ekind (Id) = E_Component and then Is_Tag (Id));
        return Uint15 (Id);
     end DT_Entry_Count;
  
*************** package body Einfo is
*** 817,827 ****
        return Node16 (Id);
     end DTC_Entity;
  
-    function Elaborate_All_Desirable (Id : E) return B is
-    begin
-       return Flag146 (Id);
-    end Elaborate_All_Desirable;
- 
     function Elaboration_Entity (Id : E) return E is
     begin
        pragma Assert
--- 848,853 ----
*************** package body Einfo is
*** 983,988 ****
--- 1009,1020 ----
  
     function First_Private_Entity (Id : E) return E is
     begin
+       pragma Assert (Ekind (Id) = E_Package
+                        or else Ekind (Id) = E_Generic_Package
+                        or else Ekind (Id) = E_Protected_Type
+                        or else Ekind (Id) = E_Protected_Subtype
+                        or else Ekind (Id) = E_Task_Type
+                        or else Ekind (Id) = E_Task_Subtype);
        return Node16 (Id);
     end First_Private_Entity;
  
*************** package body Einfo is
*** 1045,1050 ****
--- 1077,1087 ----
        return Flag79 (Id);
     end Has_All_Calls_Remote;
  
+    function Has_Anon_Block_Suffix (Id : E) return B is
+    begin
+       return Flag201 (Id);
+    end Has_Anon_Block_Suffix;
+ 
     function Has_Atomic_Components (Id : E) return B is
     begin
        return Flag86 (Implementation_Base_Type (Id));
*************** package body Einfo is
*** 1078,1083 ****
--- 1115,1126 ----
        return Flag68 (Implementation_Base_Type (Id));
     end Has_Component_Size_Clause;
  
+    function Has_Constrained_Partial_View (Id : E) return B is
+    begin
+       pragma Assert (Is_Type (Id));
+       return Flag187 (Id);
+    end Has_Constrained_Partial_View;
+ 
     function Has_Controlled_Component (Id : E) return B is
     begin
        return Flag43 (Base_Type (Id));
*************** package body Einfo is
*** 1186,1191 ****
--- 1229,1239 ----
        return Flag154 (Id);
     end Has_Per_Object_Constraint;
  
+    function Has_Persistent_BSS (Id : E) return B is
+    begin
+       return Flag188 (Id);
+    end Has_Persistent_BSS;
+ 
     function Has_Pragma_Controlled (Id : E) return B is
     begin
        pragma Assert (Is_Access_Type (Id));
*************** package body Einfo is
*** 1263,1268 ****
--- 1311,1340 ----
        return Flag100 (Implementation_Base_Type (Id));
     end Has_Specified_Layout;
  
+    function Has_Specified_Stream_Input (Id : E) return B is
+    begin
+       pragma Assert (Is_Type (Id));
+       return Flag190 (Id);
+    end Has_Specified_Stream_Input;
+ 
+    function Has_Specified_Stream_Output (Id : E) return B is
+    begin
+       pragma Assert (Is_Type (Id));
+       return Flag191 (Id);
+    end Has_Specified_Stream_Output;
+ 
+    function Has_Specified_Stream_Read (Id : E) return B is
+    begin
+       pragma Assert (Is_Type (Id));
+       return Flag192 (Id);
+    end Has_Specified_Stream_Read;
+ 
+    function Has_Specified_Stream_Write (Id : E) return B is
+    begin
+       pragma Assert (Is_Type (Id));
+       return Flag193 (Id);
+    end Has_Specified_Stream_Write;
+ 
     function Has_Storage_Size_Clause (Id : E) return B is
     begin
        pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
*************** package body Einfo is
*** 1348,1353 ****
--- 1420,1431 ----
        return Flag19 (Id);
     end Is_Abstract;
  
+    function Is_Local_Anonymous_Access (Id : E) return B is
+    begin
+       pragma Assert (Is_Access_Type (Id));
+       return Flag194 (Id);
+    end Is_Local_Anonymous_Access;
+ 
     function Is_Access_Constant (Id : E) return B is
     begin
        pragma Assert (Is_Access_Type (Id));
*************** package body Einfo is
*** 1551,1556 ****
--- 1629,1639 ----
        return Flag11 (Id);
     end Is_Inlined;
  
+    function Is_Interface (Id : E) return B is
+    begin
+       return Flag186 (Id);
+    end Is_Interface;
+ 
     function Is_Instantiated (Id : E) return B is
     begin
        return Flag126 (Id);
*************** package body Einfo is
*** 1593,1598 ****
--- 1676,1687 ----
        return Flag106 (Id);
     end Is_Limited_Composite;
  
+    function Is_Limited_Interface (Id : E) return B is
+    begin
+       pragma Assert (Is_Interface (Id));
+       return Flag197 (Id);
+    end Is_Limited_Interface;
+ 
     function Is_Limited_Record (Id : E) return B is
     begin
        return Flag25 (Id);
*************** package body Einfo is
*** 1618,1624 ****
  
     function Is_Obsolescent (Id : E) return B is
     begin
-       pragma Assert (Is_Subprogram (Id));
        return Flag153 (Id);
     end Is_Obsolescent;
  
--- 1707,1712 ----
*************** package body Einfo is
*** 1660,1665 ****
--- 1748,1759 ----
        return Flag59 (Id);
     end Is_Preelaborated;
  
+    function Is_Primitive_Wrapper (Id : E) return B is
+    begin
+       pragma Assert (Ekind (Id) = E_Procedure);
+       return Flag195 (Id);
+    end Is_Primitive_Wrapper;
+ 
     function Is_Private_Composite (Id : E) return B is
     begin
        pragma Assert (Is_Type (Id));
*************** package body Einfo is
*** 1671,1676 ****
--- 1765,1776 ----
        return Flag53 (Id);
     end Is_Private_Descendant;
  
+    function Is_Protected_Interface (Id : E) return B is
+    begin
+       pragma Assert (Is_Interface (Id));
+       return Flag198 (Id);
+    end Is_Protected_Interface;
+ 
     function Is_Public (Id : E) return B is
     begin
        pragma Assert (Nkind (Id) in N_Entity);
*************** package body Einfo is
*** 1682,1687 ****
--- 1782,1793 ----
        return Flag44 (Id);
     end Is_Pure;
  
+    function Is_Pure_Unit_Access_Type (Id : E) return B is
+    begin
+       pragma Assert (Is_Access_Type (Id));
+       return Flag189 (Id);
+    end Is_Pure_Unit_Access_Type;
+ 
     function Is_Remote_Call_Interface (Id : E) return B is
     begin
        return Flag62 (Id);
*************** package body Einfo is
*** 1707,1712 ****
--- 1813,1824 ----
        return Flag28 (Id);
     end Is_Statically_Allocated;
  
+    function Is_Synchronized_Interface (Id : E) return B is
+    begin
+       pragma Assert (Is_Interface (Id));
+       return Flag199 (Id);
+    end Is_Synchronized_Interface;
+ 
     function Is_Tag (Id : E) return B is
     begin
        pragma Assert (Nkind (Id) in N_Entity);
*************** package body Einfo is
*** 1718,1723 ****
--- 1830,1841 ----
        return Flag55 (Id);
     end Is_Tagged_Type;
  
+    function Is_Task_Interface (Id : E) return B is
+    begin
+       pragma Assert (Is_Interface (Id));
+       return Flag200 (Id);
+    end Is_Task_Interface;
+ 
     function Is_Thread_Body (Id : E) return B is
     begin
        return Flag77 (Id);
*************** package body Einfo is
*** 1931,1937 ****
  
     function Obsolescent_Warning (Id : E) return N is
     begin
!       pragma Assert (Is_Subprogram (Id));
        return Node24 (Id);
     end Obsolescent_Warning;
  
--- 2049,2056 ----
  
     function Obsolescent_Warning (Id : E) return N is
     begin
!       pragma Assert
!         (Is_Subprogram (Id) or else Is_Package_Or_Generic_Package (Id));
        return Node24 (Id);
     end Obsolescent_Warning;
  
*************** package body Einfo is
*** 1958,1963 ****
--- 2077,2096 ----
        return Node22 (Id);
     end Original_Record_Component;
  
+    function Overridden_Operation (Id : E) return E is
+    begin
+       return Node26 (Id);
+    end Overridden_Operation;
+ 
+    function Package_Instantiation (Id : E) return N is
+    begin
+       pragma Assert
+         (False
+            or else Ekind (Id) = E_Generic_Package
+            or else Ekind (Id) = E_Package);
+       return Node26 (Id);
+    end Package_Instantiation;
+ 
     function Packed_Array_Type (Id : E) return E is
     begin
        pragma Assert (Is_Array_Type (Id));
*************** package body Einfo is
*** 2207,2212 ****
--- 2340,2352 ----
        return Flag165 (Id);
     end Suppress_Style_Checks;
  
+    function Task_Body_Procedure (Id : E) return N is
+    begin
+       pragma Assert (Ekind (Id) = E_Task_Type
+                       or else Ekind (Id) = E_Task_Subtype);
+       return Node24 (Id);
+    end Task_Body_Procedure;
+ 
     function Treat_As_Volatile (Id : E) return B is
     begin
        return Flag41 (Id);
*************** package body Einfo is
*** 2238,2243 ****
--- 2378,2395 ----
        return Flag96 (Id);
     end Warnings_Off;
  
+    function Wrapped_Entity (Id : E) return E is
+    begin
+       pragma Assert (Ekind (Id) = E_Procedure
+                        and then Is_Primitive_Wrapper (Id));
+       return Node27 (Id);
+    end Wrapped_Entity;
+ 
+    function Was_Hidden (Id : E) return B is
+    begin
+       return Flag196 (Id);
+    end Was_Hidden;
+ 
     ------------------------------
     -- Classification Functions --
     ------------------------------
*************** package body Einfo is
*** 2434,2448 ****
     -- Attribute Set Procedures --
     ------------------------------
  
     procedure Set_Accept_Address (Id : E; V : L) is
     begin
        Set_Elist21 (Id, V);
     end Set_Accept_Address;
  
!    procedure Set_Access_Disp_Table (Id : E; V : E) is
     begin
        pragma Assert (Is_Tagged_Type (Id) and then Id = Base_Type (Id));
!       Set_Node16 (Id, V);
     end Set_Access_Disp_Table;
  
     procedure Set_Associated_Final_Chain (Id : E; V : E) is
--- 2586,2618 ----
     -- Attribute Set Procedures --
     ------------------------------
  
+    procedure Set_Abstract_Interfaces (Id : E; V : L) is
+    begin
+       pragma Assert
+         (Ekind (Id) = E_Record_Type
+           or else Ekind (Id) = E_Record_Subtype
+           or else Ekind (Id) = E_Record_Type_With_Private
+           or else Ekind (Id) = E_Record_Subtype_With_Private
+           or else Ekind (Id) = E_Class_Wide_Type);
+       Set_Elist24 (Id, V);
+    end Set_Abstract_Interfaces;
+ 
+    procedure Set_Abstract_Interface_Alias (Id : E; V : E) is
+    begin
+       pragma Assert
+         (Ekind (Id) = E_Procedure or Ekind (Id) = E_Function);
+       Set_Node25 (Id, V);
+    end Set_Abstract_Interface_Alias;
+ 
     procedure Set_Accept_Address (Id : E; V : L) is
     begin
        Set_Elist21 (Id, V);
     end Set_Accept_Address;
  
!    procedure Set_Access_Disp_Table (Id : E; V : L) is
     begin
        pragma Assert (Is_Tagged_Type (Id) and then Id = Base_Type (Id));
!       Set_Elist16 (Id, V);
     end Set_Access_Disp_Table;
  
     procedure Set_Associated_Final_Chain (Id : E; V : E) is
*************** package body Einfo is
*** 2617,2623 ****
        Set_Node22 (Id, V);
     end Set_Corresponding_Remote_Type;
  
!    procedure Set_Current_Value (Id : E; V : E) is
     begin
        pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
        Set_Node9 (Id, V);
--- 2787,2799 ----
        Set_Node22 (Id, V);
     end Set_Corresponding_Remote_Type;
  
!    procedure Set_Current_Use_Clause (Id : E; V : E) is
!    begin
!       pragma Assert (Ekind (Id) = E_Package);
!       Set_Node25 (Id, V);
!    end Set_Current_Use_Clause;
! 
!    procedure Set_Current_Value (Id : E; V : N) is
     begin
        pragma Assert (Ekind (Id) in Object_Kind or else Ekind (Id) = E_Void);
        Set_Node9 (Id, V);
*************** package body Einfo is
*** 2761,2771 ****
        Set_Node16 (Id, V);
     end Set_DTC_Entity;
  
-    procedure Set_Elaborate_All_Desirable (Id : E; V : B := True) is
-    begin
-       Set_Flag146 (Id, V);
-    end Set_Elaborate_All_Desirable;
- 
     procedure Set_Elaboration_Entity (Id : E; V : E) is
     begin
        pragma Assert
--- 2937,2942 ----
*************** package body Einfo is
*** 2928,2934 ****
  
     procedure Set_First_Private_Entity (Id : E; V : E) is
     begin
!       pragma Assert (Nkind (Id) in N_Entity);
        Set_Node16 (Id, V);
     end Set_First_Private_Entity;
  
--- 3099,3110 ----
  
     procedure Set_First_Private_Entity (Id : E; V : E) is
     begin
!       pragma Assert (Ekind (Id) = E_Package
!                        or else Ekind (Id) = E_Generic_Package
!                        or else Ekind (Id) = E_Protected_Type
!                        or else Ekind (Id) = E_Protected_Subtype
!                        or else Ekind (Id) = E_Task_Type
!                        or else Ekind (Id) = E_Task_Subtype);
        Set_Node16 (Id, V);
     end Set_First_Private_Entity;
  
*************** package body Einfo is
*** 2994,2999 ****
--- 3170,3180 ----
        Set_Flag79 (Id, V);
     end Set_Has_All_Calls_Remote;
  
+    procedure Set_Has_Anon_Block_Suffix (Id : E; V : B := True) is
+    begin
+       Set_Flag201 (Id, V);
+    end Set_Has_Anon_Block_Suffix;
+ 
     procedure Set_Has_Atomic_Components (Id : E; V : B := True) is
     begin
        pragma Assert (not Is_Type (Id) or else Base_Type (Id) = Id);
*************** package body Einfo is
*** 3030,3035 ****
--- 3211,3222 ----
        Set_Flag68 (Id, V);
     end Set_Has_Component_Size_Clause;
  
+    procedure Set_Has_Constrained_Partial_View (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Type (Id));
+       Set_Flag187 (Id, V);
+    end Set_Has_Constrained_Partial_View;
+ 
     procedure Set_Has_Contiguous_Rep (Id : E; V : B := True) is
     begin
        Set_Flag181 (Id, V);
*************** package body Einfo is
*** 3140,3145 ****
--- 3327,3337 ----
        Set_Flag154 (Id, V);
     end Set_Has_Per_Object_Constraint;
  
+    procedure Set_Has_Persistent_BSS (Id : E; V : B := True) is
+    begin
+       Set_Flag188 (Id, V);
+    end Set_Has_Persistent_BSS;
+ 
     procedure Set_Has_Pragma_Controlled (Id : E; V : B := True) is
     begin
        pragma Assert (Is_Access_Type (Id));
*************** package body Einfo is
*** 3218,3223 ****
--- 3410,3439 ----
        Set_Flag100 (Id, V);
     end Set_Has_Specified_Layout;
  
+    procedure Set_Has_Specified_Stream_Input (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Type (Id));
+       Set_Flag190 (Id, V);
+    end Set_Has_Specified_Stream_Input;
+ 
+    procedure Set_Has_Specified_Stream_Output (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Type (Id));
+       Set_Flag191 (Id, V);
+    end Set_Has_Specified_Stream_Output;
+ 
+    procedure Set_Has_Specified_Stream_Read (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Type (Id));
+       Set_Flag192 (Id, V);
+    end Set_Has_Specified_Stream_Read;
+ 
+    procedure Set_Has_Specified_Stream_Write (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Type (Id));
+       Set_Flag193 (Id, V);
+    end Set_Has_Specified_Stream_Write;
+ 
     procedure Set_Has_Storage_Size_Clause (Id : E; V : B := True) is
     begin
        pragma Assert (Is_Access_Type (Id) or else Is_Task_Type (Id));
*************** package body Einfo is
*** 3308,3313 ****
--- 3524,3535 ----
        Set_Flag19 (Id, V);
     end Set_Is_Abstract;
  
+    procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Access_Type (Id));
+       Set_Flag194 (Id, V);
+    end Set_Is_Local_Anonymous_Access;
+ 
     procedure Set_Is_Access_Constant (Id : E; V : B := True) is
     begin
        pragma Assert (Is_Access_Type (Id));
*************** package body Einfo is
*** 3527,3532 ****
--- 3749,3765 ----
        Set_Flag11 (Id, V);
     end Set_Is_Inlined;
  
+    procedure Set_Is_Interface (Id : E; V : B := True) is
+    begin
+       pragma Assert
+         (Ekind (Id) = E_Record_Type
+           or else Ekind (Id) = E_Record_Subtype
+           or else Ekind (Id) = E_Record_Type_With_Private
+           or else Ekind (Id) = E_Record_Subtype_With_Private
+           or else Ekind (Id) = E_Class_Wide_Type);
+       Set_Flag186 (Id, V);
+    end Set_Is_Interface;
+ 
     procedure Set_Is_Instantiated (Id : E; V : B := True) is
     begin
        Set_Flag126 (Id, V);
*************** package body Einfo is
*** 3570,3575 ****
--- 3803,3814 ----
        Set_Flag106 (Id, V);
     end Set_Is_Limited_Composite;
  
+    procedure Set_Is_Limited_Interface (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Interface (Id));
+       Set_Flag197 (Id, V);
+    end Set_Is_Limited_Interface;
+ 
     procedure Set_Is_Limited_Record (Id : E; V : B := True) is
     begin
        Set_Flag25 (Id, V);
*************** package body Einfo is
*** 3595,3601 ****
  
     procedure Set_Is_Obsolescent (Id : E; V : B := True) is
     begin
-       pragma Assert (Is_Subprogram (Id));
        Set_Flag153 (Id, V);
     end Set_Is_Obsolescent;
  
--- 3834,3839 ----
*************** package body Einfo is
*** 3638,3643 ****
--- 3876,3887 ----
        Set_Flag59 (Id, V);
     end Set_Is_Preelaborated;
  
+    procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
+    begin
+       pragma Assert (Ekind (Id) = E_Procedure);
+       Set_Flag195 (Id, V);
+    end Set_Is_Primitive_Wrapper;
+ 
     procedure Set_Is_Private_Composite (Id : E; V : B := True) is
     begin
        pragma Assert (Is_Type (Id));
*************** package body Einfo is
*** 3649,3654 ****
--- 3893,3904 ----
        Set_Flag53 (Id, V);
     end Set_Is_Private_Descendant;
  
+    procedure Set_Is_Protected_Interface (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Interface (Id));
+       Set_Flag198 (Id, V);
+    end Set_Is_Protected_Interface;
+ 
     procedure Set_Is_Public (Id : E; V : B := True) is
     begin
        pragma Assert (Nkind (Id) in N_Entity);
*************** package body Einfo is
*** 3660,3665 ****
--- 3910,3921 ----
        Set_Flag44 (Id, V);
     end Set_Is_Pure;
  
+    procedure Set_Is_Pure_Unit_Access_Type (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Access_Type (Id));
+       Set_Flag189 (Id, V);
+    end Set_Is_Pure_Unit_Access_Type;
+ 
     procedure Set_Is_Remote_Call_Interface (Id : E; V : B := True) is
     begin
        Set_Flag62 (Id, V);
*************** package body Einfo is
*** 3691,3696 ****
--- 3947,3958 ----
        Set_Flag28 (Id, V);
     end Set_Is_Statically_Allocated;
  
+    procedure Set_Is_Synchronized_Interface (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Interface (Id));
+       Set_Flag199 (Id, V);
+    end Set_Is_Synchronized_Interface;
+ 
     procedure Set_Is_Tag (Id : E; V : B := True) is
     begin
        pragma Assert (Nkind (Id) in N_Entity);
*************** package body Einfo is
*** 3707,3712 ****
--- 3969,3980 ----
        Set_Flag77 (Id, V);
     end Set_Is_Thread_Body;
  
+    procedure Set_Is_Task_Interface (Id : E; V : B := True) is
+    begin
+       pragma Assert (Is_Interface (Id));
+       Set_Flag200 (Id, V);
+    end Set_Is_Task_Interface;
+ 
     procedure Set_Is_True_Constant (Id : E; V : B := True) is
     begin
        Set_Flag163 (Id, V);
*************** package body Einfo is
*** 3913,3919 ****
  
     procedure Set_Obsolescent_Warning (Id : E; V : N) is
     begin
!       pragma Assert (Is_Subprogram (Id));
        Set_Node24 (Id, V);
     end Set_Obsolescent_Warning;
  
--- 4181,4188 ----
  
     procedure Set_Obsolescent_Warning (Id : E; V : N) is
     begin
!       pragma Assert
!         (Is_Subprogram (Id) or else Is_Package_Or_Generic_Package (Id));
        Set_Node24 (Id, V);
     end Set_Obsolescent_Warning;
  
*************** package body Einfo is
*** 3940,3945 ****
--- 4209,4228 ----
        Set_Node22 (Id, V);
     end Set_Original_Record_Component;
  
+    procedure Set_Overridden_Operation (Id : E; V : E) is
+    begin
+       Set_Node26 (Id, V);
+    end Set_Overridden_Operation;
+ 
+    procedure Set_Package_Instantiation (Id : E; V : N) is
+    begin
+       pragma Assert
+         (Ekind (Id) = E_Void
+            or else Ekind (Id) = E_Generic_Package
+            or else Ekind (Id) = E_Package);
+       Set_Node26 (Id, V);
+    end Set_Package_Instantiation;
+ 
     procedure Set_Packed_Array_Type (Id : E; V : E) is
     begin
        pragma Assert (Is_Array_Type (Id));
*************** package body Einfo is
*** 4194,4199 ****
--- 4477,4489 ----
        Set_Flag165 (Id, V);
     end Set_Suppress_Style_Checks;
  
+    procedure Set_Task_Body_Procedure (Id : E; V : N) is
+    begin
+       pragma Assert (Ekind (Id) = E_Task_Type
+                       or else Ekind (Id) = E_Task_Subtype);
+       Set_Node24 (Id, V);
+    end Set_Task_Body_Procedure;
+ 
     procedure Set_Treat_As_Volatile (Id : E; V : B := True) is
     begin
        Set_Flag41 (Id, V);
*************** package body Einfo is
*** 4226,4231 ****
--- 4516,4533 ----
        Set_Flag96 (Id, V);
     end Set_Warnings_Off;
  
+    procedure Set_Was_Hidden (Id : E; V : B := True) is
+    begin
+       Set_Flag196 (Id, V);
+    end Set_Was_Hidden;
+ 
+    procedure Set_Wrapped_Entity (Id : E; V : E) is
+    begin
+       pragma Assert (Ekind (Id) = E_Procedure
+                        and then Is_Primitive_Wrapper (Id));
+       Set_Node27 (Id, V);
+    end Set_Wrapped_Entity;
+ 
     -----------------------------------
     -- Field Initialization Routines --
     -----------------------------------
*************** package body Einfo is
*** 5474,5490 ****
        end if;
     end Is_Limited_Type;
  
!    ----------------
!    -- Is_Package --
!    ----------------
  
!    function Is_Package (Id : E) return B is
     begin
        return
          Ekind (Id) = E_Package
            or else
          Ekind (Id) = E_Generic_Package;
!    end Is_Package;
  
     --------------------------
     -- Is_Protected_Private --
--- 5776,5792 ----
        end if;
     end Is_Limited_Type;
  
!    -----------------------------------
!    -- Is_Package_Or_Generic_Package --
!    -----------------------------------
  
!    function Is_Package_Or_Generic_Package (Id : E) return B is
     begin
        return
          Ekind (Id) = E_Package
            or else
          Ekind (Id) = E_Generic_Package;
!    end Is_Package_Or_Generic_Package;
  
     --------------------------
     -- Is_Protected_Private --
*************** package body Einfo is
*** 6039,6049 ****
        return Kind;
     end Subtype_Kind;
  
!    -------------------
!    -- Tag_Component --
!    -------------------
  
!    function Tag_Component (Id : E) return E is
        Comp : Entity_Id;
        Typ  : Entity_Id := Id;
  
--- 6341,6351 ----
        return Kind;
     end Subtype_Kind;
  
!    -------------------------
!    -- First_Tag_Component --
!    -------------------------
  
!    function First_Tag_Component (Id : E) return E is
        Comp : Entity_Id;
        Typ  : Entity_Id := Id;
  
*************** package body Einfo is
*** 6070,6076 ****
        --  No tag component found
  
        return Empty;
!    end Tag_Component;
  
     ---------------------
     -- Type_High_Bound --
--- 6372,6405 ----
        --  No tag component found
  
        return Empty;
!    end First_Tag_Component;
! 
!    ------------------------
!    -- Next_Tag_Component --
!    ------------------------
! 
!    function Next_Tag_Component (Id : E) return E is
!       Comp : Entity_Id;
!       Typ  : constant Entity_Id := Scope (Id);
! 
!    begin
!       pragma Assert (Ekind (Id) = E_Component
!                        and then Is_Tagged_Type (Typ));
! 
!       Comp := Next_Entity (Id);
!       while Present (Comp) loop
!          if Is_Tag (Comp) then
!             pragma Assert (Chars (Comp) /= Name_uTag);
!             return Comp;
!          end if;
! 
!          Comp := Next_Entity (Comp);
!       end loop;
! 
!       --  No tag component found
! 
!       return Empty;
!    end Next_Tag_Component;
  
     ---------------------
     -- Type_High_Bound --
*************** package body Einfo is
*** 6127,6132 ****
--- 6456,6470 ----
                 return Underlying_Type (Full_View (Id));
              end if;
  
+          --  If we have an incomplete entity that comes from the limited
+          --  view then we return the Underlying_Type of its non-limited
+          --  view.
+ 
+          elsif From_With_Type (Id)
+            and then Present (Non_Limited_View (Id))
+          then
+             return Underlying_Type (Non_Limited_View (Id));
+ 
           --  Otherwise check for the case where we have a derived type or
           --  subtype, and if so get the Underlying_Type of the parent type.
  
*************** package body Einfo is
*** 6211,6217 ****
        W ("Delay_Subprogram_Descriptors",  Flag50  (Id));
        W ("Depends_On_Private",            Flag14  (Id));
        W ("Discard_Names",                 Flag88  (Id));
-       W ("Elaborate_All_Desirable",       Flag146 (Id));
        W ("Elaboration_Entity_Required",   Flag174 (Id));
        W ("Entry_Accepted",                Flag152 (Id));
        W ("Finalize_Storage_Only",         Flag158 (Id));
--- 6549,6554 ----
*************** package body Einfo is
*** 6220,6225 ****
--- 6557,6563 ----
        W ("Has_Aliased_Components",        Flag135 (Id));
        W ("Has_Alignment_Clause",          Flag46  (Id));
        W ("Has_All_Calls_Remote",          Flag79  (Id));
+       W ("Has_Anon_Block_Suffix",         Flag201 (Id));
        W ("Has_Atomic_Components",         Flag86  (Id));
        W ("Has_Biased_Representation",     Flag139 (Id));
        W ("Has_Completion",                Flag26  (Id));
*************** package body Einfo is
*** 6246,6251 ****
--- 6584,6590 ----
        W ("Has_Non_Standard_Rep",          Flag75  (Id));
        W ("Has_Object_Size_Clause",        Flag172 (Id));
        W ("Has_Per_Object_Constraint",     Flag154 (Id));
+       W ("Has_Persistent_BSS",            Flag188 (Id));
        W ("Has_Pragma_Controlled",         Flag27  (Id));
        W ("Has_Pragma_Elaborate_Body",     Flag150 (Id));
        W ("Has_Pragma_Inline",             Flag157 (Id));
*************** package body Einfo is
*** 6260,6265 ****
--- 6599,6608 ----
        W ("Has_Size_Clause",               Flag29  (Id));
        W ("Has_Small_Clause",              Flag67  (Id));
        W ("Has_Specified_Layout",          Flag100 (Id));
+       W ("Has_Specified_Stream_Input",    Flag190 (Id));
+       W ("Has_Specified_Stream_Output",   Flag191 (Id));
+       W ("Has_Specified_Stream_Read",     Flag192 (Id));
+       W ("Has_Specified_Stream_Write",    Flag193 (Id));
        W ("Has_Storage_Size_Clause",       Flag23  (Id));
        W ("Has_Stream_Size_Clause",        Flag184 (Id));
        W ("Has_Subprogram_Descriptor",     Flag93  (Id));
*************** package body Einfo is
*** 6273,6278 ****
--- 6616,6622 ----
        W ("In_Use",                        Flag8   (Id));
        W ("Is_AST_Entry",                  Flag132 (Id));
        W ("Is_Abstract",                   Flag19  (Id));
+       W ("Is_Local_Anonymous_Access",     Flag194 (Id));
        W ("Is_Access_Constant",            Flag69  (Id));
        W ("Is_Ada_2005",                   Flag185 (Id));
        W ("Is_Aliased",                    Flag15  (Id));
*************** package body Einfo is
*** 6311,6316 ****
--- 6655,6661 ----
        W ("Is_Imported",                   Flag24  (Id));
        W ("Is_Inlined",                    Flag11  (Id));
        W ("Is_Instantiated",               Flag126 (Id));
+       W ("Is_Interface",                  Flag186 (Id));
        W ("Is_Internal",                   Flag17  (Id));
        W ("Is_Interrupt_Handler",          Flag89  (Id));
        W ("Is_Intrinsic_Subprogram",       Flag64  (Id));
*************** package body Einfo is
*** 6318,6323 ****
--- 6663,6669 ----
        W ("Is_Known_Valid",                Flag37  (Id));
        W ("Is_Known_Valid",                Flag170 (Id));
        W ("Is_Limited_Composite",          Flag106 (Id));
+       W ("Is_Limited_Interface",          Flag197 (Id));
        W ("Is_Limited_Record",             Flag25  (Id));
        W ("Is_Machine_Code_Subprogram",    Flag137 (Id));
        W ("Is_Non_Static_Subtype",         Flag109 (Id));
*************** package body Einfo is
*** 6330,6346 ****
--- 6676,6697 ----
        W ("Is_Packed_Array_Type",          Flag138 (Id));
        W ("Is_Potentially_Use_Visible",    Flag9   (Id));
        W ("Is_Preelaborated",              Flag59  (Id));
+       W ("Is_Primitive_Wrapper",          Flag195 (Id));
        W ("Is_Private_Composite",          Flag107 (Id));
        W ("Is_Private_Descendant",         Flag53  (Id));
+       W ("Is_Protected_Interface",        Flag198 (Id));
        W ("Is_Public",                     Flag10  (Id));
        W ("Is_Pure",                       Flag44  (Id));
+       W ("Is_Pure_Unit_Access_Type",      Flag189 (Id));
        W ("Is_Remote_Call_Interface",      Flag62  (Id));
        W ("Is_Remote_Types",               Flag61  (Id));
        W ("Is_Renaming_Of_Object",         Flag112 (Id));
        W ("Is_Shared_Passive",             Flag60  (Id));
+       W ("Is_Synchronized_Interface",     Flag199 (Id));
        W ("Is_Statically_Allocated",       Flag28  (Id));
        W ("Is_Tag",                        Flag78  (Id));
        W ("Is_Tagged_Type",                Flag55  (Id));
+       W ("Is_Task_Interface",             Flag200 (Id));
        W ("Is_Thread_Body",                Flag77  (Id));
        W ("Is_True_Constant",              Flag163 (Id));
        W ("Is_Unchecked_Union",            Flag117 (Id));
*************** package body Einfo is
*** 6380,6385 ****
--- 6731,6737 ----
        W ("Uses_Sec_Stack",                Flag95  (Id));
        W ("Vax_Float",                     Flag151 (Id));
        W ("Warnings_Off",                  Flag96  (Id));
+       W ("Was_Hidden",                    Flag196 (Id));
     end Write_Entity_Flags;
  
     -----------------------
*************** package body Einfo is
*** 6939,6945 ****
                E_Procedure                                =>
              Write_Str ("Alias");
  
!          when E_Record_Type                =>
              Write_Str ("Corresponding_Concurrent_Type");
  
           when E_Entry_Index_Parameter                    =>
--- 7291,7297 ----
                E_Procedure                                =>
              Write_Str ("Alias");
  
!          when E_Record_Type                              =>
              Write_Str ("Corresponding_Concurrent_Type");
  
           when E_Entry_Index_Parameter                    =>
*************** package body Einfo is
*** 7255,7263 ****
     procedure Write_Field24_Name (Id : Entity_Id) is
     begin
        case Ekind (Id) is
!          when Subprogram_Kind                            =>
              Write_Str ("Obsolescent_Warning");
  
           when others                                     =>
              Write_Str ("Field24??");
        end case;
--- 7607,7626 ----
     procedure Write_Field24_Name (Id : Entity_Id) is
     begin
        case Ekind (Id) is
!          when E_Record_Type                              |
!               E_Record_Subtype                           |
!               E_Record_Type_With_Private                 |
!               E_Record_Subtype_With_Private              =>
!             Write_Str ("Abstract_Interfaces");
! 
!          when Subprogram_Kind                            |
!               E_Package                                  |
!               E_Generic_Package                          =>
              Write_Str ("Obsolescent_Warning");
  
+          when Task_Kind                                  =>
+             Write_Str ("Task_Body_Procedure");
+ 
           when others                                     =>
              Write_Str ("Field24??");
        end case;
*************** package body Einfo is
*** 7270,7275 ****
--- 7633,7645 ----
     procedure Write_Field25_Name (Id : Entity_Id) is
     begin
        case Ekind (Id) is
+          when E_Procedure                                |
+               E_Function                                 =>
+             Write_Str ("Abstract_Interface_Alias");
+ 
+          when E_Package                                  =>
+             Write_Str ("Current_Use_Clause");
+ 
           when others                                     =>
              Write_Str ("Field25??");
        end case;
*************** package body Einfo is
*** 7282,7287 ****
--- 7652,7665 ----
     procedure Write_Field26_Name (Id : Entity_Id) is
     begin
        case Ekind (Id) is
+          when E_Generic_Package                          |
+               E_Package                                  =>
+             Write_Str ("Package_Instantiation");
+ 
+          when E_Procedure                                |
+               E_Function                                 =>
+             Write_Str ("Overridden_Operation");
+ 
           when others                                     =>
              Write_Str ("Field26??");
        end case;
*************** package body Einfo is
*** 7294,7299 ****
--- 7672,7680 ----
     procedure Write_Field27_Name (Id : Entity_Id) is
     begin
        case Ekind (Id) is
+          when E_Procedure                                =>
+             Write_Str ("Wrapped_Entity");
+ 
           when others                                     =>
              Write_Str ("Field27??");
        end case;
diff -Nrcpad gcc-4.0.2/gcc/ada/einfo.ads gcc-4.1.0/gcc/ada/einfo.ads
*** gcc-4.0.2/gcc/ada/einfo.ads	Thu Feb 10 13:50:25 2005
--- gcc-4.1.0/gcc/ada/einfo.ads	Tue Nov 15 13:54:36 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Einfo is
*** 115,121 ****
  --     There can only be a single statement, contained on a single line,
  --     not counting any pragma Assert statements.
  
! --     This single statement must either by a function call with simple,
  --     single token arguments, or it must be a membership test of the form
  --     a in b, where a and b are single tokens.
  
--- 115,121 ----
  --     There can only be a single statement, contained on a single line,
  --     not counting any pragma Assert statements.
  
! --     This single statement must either be a function call with simple,
  --     single token arguments, or it must be a membership test of the form
  --     a in b, where a and b are single tokens.
  
*************** package Einfo is
*** 183,189 ****
  --       dynamic bounds, it is assumed that the value can range down or up
  --       to the corresponding bound of the ancestor
  
! --    The RM defined attribute Size corresponds to the Value_Size attribute.
  
  --    The Size attribute may be defined for a first-named subtype. This sets
  --    the Value_Size of the first-named subtype to the given value, and the
--- 183,189 ----
  --       dynamic bounds, it is assumed that the value can range down or up
  --       to the corresponding bound of the ancestor
  
! --    The RM defined attribute Size corresponds to the Value_Size attribute
  
  --    The Size attribute may be defined for a first-named subtype. This sets
  --    the Value_Size of the first-named subtype to the given value, and the
*************** package Einfo is
*** 286,291 ****
--- 286,302 ----
  --  and if assertions are enabled, an attempt to set the attribute on a
  --  subtype will raise an assert error.
  
+ --    Abstract_Interfaces (Elist24)
+ --       Present in record types and subtypes. List of abstract interfaces
+ --       implemented by a tagged type that are not already implemented by the
+ --       ancestors (Ada 2005: AI-251).
+ 
+ --    Abstract_Interface_Alias (Node25)
+ --       Present in subprograms that cover a primitive operation of an abstract
+ --       interface type. Points to its associated interface subprogram. It is
+ --       used to register the subprogram in secondary dispatch table of the
+ --       interface (Ada 2005: AI-251).
+ 
  --    Accept_Address (Elist21)
  --       Present in entries. If an accept has a statement sequence, then an
  --       address variable is created, which is used to hold the address of the
*************** package Einfo is
*** 313,321 ****
  --       rather irregular, and the semantic checks that depend on the nominal
  --       subtype being unconstrained use flag Is_Constr_Subt_For_U_Nominal(qv).
  
! --    Access_Disp_Table (Node16) [implementation base type only]
  --       Present in record type entities. For a tagged type, points to the
! --       dispatch table associated with the tagged type. For a non-tagged
  --       record, contains Empty.
  
  --    Address_Clause (synthesized)
--- 324,332 ----
  --       rather irregular, and the semantic checks that depend on the nominal
  --       subtype being unconstrained use flag Is_Constr_Subt_For_U_Nominal(qv).
  
! --    Access_Disp_Table (Elist16) [implementation base type only]
  --       Present in record type entities. For a tagged type, points to the
! --       dispatch tables associated with the tagged type. For a non-tagged
  --       record, contains Empty.
  
  --    Address_Clause (synthesized)
*************** package Einfo is
*** 583,588 ****
--- 594,604 ----
  --      created at the same time as the discriminal, and used to replace
  --      occurrences of the discriminant within the type declaration.
  
+ --    Current_Use_Clause (Node25)
+ --      Present in packages. Indicates the use clause currently in scope
+ --      that makes the package use_visible. Used to detect redundant use
+ --      clauses for the same package.
+ 
  --    Current_Value (Node9)
  --       Present in E_Variable, E_Out_Parameter and E_In_Out_Parameter
  --       entities. Set non-Empty if the (constant) current value of the
*************** package Einfo is
*** 790,802 ****
  --       Present in all entities. Contains a value of the enumeration type
  --       Entity_Kind declared in a subsequent section in this spec.
  
- --    Elaborate_All_Desirable (Flag146)
- --       Present in package and subprogram entities, and in generic package
- --       and subprogram entities. Set if internal analysis of a client that
- --       with's this unit determines that Elaborate_All is desirable, i.e.
- --       that there is a possibility that Program_Error may be raised if
- --       Elaborate_All conditions cannot be met.
- 
  --    Elaboration_Entity (Node13)
  --       Present in generic and non-generic package and subprogram
  --       entities. This is a boolean entity associated with the unit that
--- 806,811 ----
*************** package Einfo is
*** 1219,1224 ****
--- 1228,1238 ----
  --       be RCI entities, so the flag Is_Remote_Call_Interface will always
  --       be set if this flag is set.
  
+ --    Has_Anon_Block_Suffix (Flag201)
+ --       Present in all entities. Set if the entity is nested within one or
+ --       more anonymous blocks and the Chars field contains a name with an
+ --       anonymous block suffix (see Exp_Dbug for furthert details).
+ 
  --    Has_Atomic_Components (Flag86) [implementation base type only]
  --       Present in all types and objects. Set only for an array type or
  --       an array object if a valid pragma Atomic_Components applies to the
*************** package Einfo is
*** 1270,1275 ****
--- 1284,1295 ----
  --       present for the given type. Note that this flag can be False even
  --       if Component_Size is non-zero (happens in the case of derived types).
  
+ --    Has_Constrained_Partial_View (Flag187)
+ --       Present in private type and their completions, when the private
+ --       type has no discriminants and the full view has discriminants with
+ --       defaults. In Ada 2005 heap-allocated objects of such types are not
+ --       constrained, and can change their discriminants with full assignment.
+ 
  --    Has_Contiguous_Rep (Flag181)
  --       Present in enumeration types. True if the type as a representation
  --       clause whose entries are successive integers.
*************** package Einfo is
*** 1279,1288 ****
  --       function of a tagged type which can dispatch on result
  
  --    Has_Controlled_Component (Flag43) [base type only]
! --       Present in composite type entities. Indicates that the type has a
! --       component that either is a controlled type, or itself contains a
! --       controlled component (i.e. either Has_Controlled_Component or
! --       Is_Controlled is set for at least one component).
  
  --    Has_Convention_Pragma (Flag119)
  --       Present in an entity for which a Convention, Import, or Export
--- 1299,1308 ----
  --       function of a tagged type which can dispatch on result
  
  --    Has_Controlled_Component (Flag43) [base type only]
! --       Present in all entities. Set only for composite type entities which
! --       contain a component that either is a controlled type, or itself
! --       contains controlled component (i.e. either Has_Controlled_Component
! --       or Is_Controlled is set for at least one component).
  
  --    Has_Convention_Pragma (Flag119)
  --       Present in an entity for which a Convention, Import, or Export
*************** package Einfo is
*** 1341,1353 ****
  
  --    Has_Gigi_Rep_Item (Flag82)
  --       This flag is set if the rep item chain (referenced by First_Rep_Item
! --       and linked through the Next_Rep_Item chain contains a representation
  --       item that needs to be specially processed by Gigi, i.e. one of the
  --       following items:
  --
  --          Machine_Attribute pragma
  --          Linker_Alias pragma
  --          Linker_Section pragma
  --          Weak_External pragma
  --
  --       If this flag is set, then Gigi should scan the rep item chain to
--- 1361,1375 ----
  
  --    Has_Gigi_Rep_Item (Flag82)
  --       This flag is set if the rep item chain (referenced by First_Rep_Item
! --       and linked through the Next_Rep_Item chain) contains a representation
  --       item that needs to be specially processed by Gigi, i.e. one of the
  --       following items:
  --
  --          Machine_Attribute pragma
  --          Linker_Alias pragma
  --          Linker_Section pragma
+ --          Linker_Constructor pragma
+ --          Linker_Destructor pragma
  --          Weak_External pragma
  --
  --       If this flag is set, then Gigi should scan the rep item chain to
*************** package Einfo is
*** 1417,1422 ****
--- 1439,1451 ----
  --       5. N_Range_Constraint - when the range expression uses the
  --          discriminant of the enclosing type.
  
+ --    Has_Persistent_BSS (Flag188)
+ --       Present in all entities. Set True for entities to which a valid
+ --       pragma Persistent_BSS applies. Note that although the pragma is
+ --       only meaningful for objects, we set it for all entities in a unit
+ --       to which the pragma applies, as well as the unit entity itself, for
+ --       convenience in propagating the flag to contained entities.
+ 
  --    Has_Pragma_Controlled (Flag27) [implementation base type only]
  --       Present in access type entities. It is set if a pragma Controlled
  --       applies to the access type.
*************** package Einfo is
*** 1512,1517 ****
--- 1541,1556 ----
  --       representation clause, and thus is not inherited by a derived type.
  --       This flag is always False for non-record types.
  
+ --    Has_Specified_Stream_Input (Flag190)
+ --    Has_Specified_Stream_Output (Flag191)
+ --    Has_Specified_Stream_Read (Flag192)
+ --    Has_Specified_Stream_Write (Flag193)
+ --       Present in all type and subtype entities. Set for a given view if the
+ --       corresponding stream-oriented attribute has been defined by an
+ --       attribute definition clause. When such a clause occurs, a TSS is set
+ --       on the underlying full view; the flags are used to track visibility of
+ --       the attribute definition clause for partial or incomplete views.
+ 
  --    Has_Storage_Size_Clause (Flag23) [implementation base type only]
  --       Present in task types and access types. It is set if a Storage_Size
  --       clause is present for the type. Used to prevent multiple clauses for
*************** package Einfo is
*** 1597,1606 ****
  --    Implementation_Base_Type (synthesized)
  --       Applies to all types. Similar to Base_Type, but never returns a
  --       private type when applied to a non-private type. Instead in this
! --       case, it always returns the Representation_Type of the base type
! --       in this case, so that we still have a concrete type. Note: it is
! --       allowed to apply Implementation_Base_Type to other than a type,
! --       in which case it simply returns the entity unchanged.
  
  --    In_Package_Body (Flag48)
  --       Set on the entity that denotes the package (the defining occurrence
--- 1636,1645 ----
  --    Implementation_Base_Type (synthesized)
  --       Applies to all types. Similar to Base_Type, but never returns a
  --       private type when applied to a non-private type. Instead in this
! --       case, it always returns the Underlying_Type of the base type, so that
! --       we still have a concrete type. Note: it is allowed to apply
! --       Implementation_Base_Type to other than a type, in which case it
! --       simply returns the entity unchanged.
  
  --    In_Package_Body (Flag48)
  --       Set on the entity that denotes the package (the defining occurrence
*************** package Einfo is
*** 1651,1656 ****
--- 1690,1703 ----
  --       Present in all types, and also for functions and procedures. Set
  --       for abstract types and abstract subprograms.
  
+ --    Is_Local_Anonymous_Access (Flag194)
+ --       Present in access types. Set for an anonymous access type to indicate
+ --       that the type is created for a record component with an access
+ --       definition, an array component, or a stand-alone object. Such
+ --       anonymous types have an accessibility level equal to that of the
+ --       declaration in which they appear, unlike the anonymous access types
+ --       that are created for access parameters and access discriminants.
+ 
  --    Is_Access_Constant (Flag69)
  --       Present in access types and subtypes. Indicates that the keyword
  --       constant was present in the access type definition.
*************** package Einfo is
*** 1959,1968 ****
  --    Is_Integer_Type (synthesized)
  --       Applies to all entities, true for integer types and subtypes
  
  --    Is_Internal (Flag17)
  --       Present in all entities. Set to indicate an entity created during
! --       semantic processing (e.g. an implicit type). Need more documentation
! --       on this one! ???
  
  --    Is_Interrupt_Handler (Flag89)
  --       Present in procedures. Set if a pragma Interrupt_Handler applies
--- 2006,2026 ----
  --    Is_Integer_Type (synthesized)
  --       Applies to all entities, true for integer types and subtypes
  
+ --    Is_Interface (Flag186)
+ --       Present in record types and subtypes to indicate that the current
+ --       entity corresponds with an abstract interface. Because abstract
+ --       interfaces are conceptually a special kind of abstract tagged types
+ --       we represent them by means of tagged record types and subtypes
+ --       marked with this attribute. This allows us to reuse most of the
+ --       compiler support for abstract tagged types to implement interfaces
+ --       (Ada 2005: AI-251).
+ 
  --    Is_Internal (Flag17)
  --       Present in all entities. Set to indicate an entity created during
! --       semantic processing (e.g. an implicit type, or a temporary). The
! --       only current use of this flag is to indicate that temporaries
! --       generated for the result of an inlined function call need not be
! --       initialized, even when scalars are initialized or normalized.
  
  --    Is_Interrupt_Handler (Flag89)
  --       Present in procedures. Set if a pragma Interrupt_Handler applies
*************** package Einfo is
*** 2051,2056 ****
--- 2109,2118 ----
  --       do not become visible until the immediate scope of the composite
  --       type itself (RM 7.3.1 (5)).
  
+ --    Is_Limited_Interface (Flag197)
+ --       Present in types that are interfaces. True if interface is declared
+ --       limited, or is derived from limited interfaces.
+ 
  --    Is_Limited_Record (Flag25)
  --       Present in all entities. Set to true for record (sub)types if the
  --       record is declared to be limited. Note that this flag is not set
*************** package Einfo is
*** 2104,2111 ****
  --       including generic formal parameters.
  
  --    Is_Obsolescent (Flag153)
! --       Present in subprogram entities. Set if a valid pragma Obsolescent
! --       applies to the subprogram.
  
  --    Is_Optional_Parameter (Flag134)
  --       Present in parameter entities. Set if the parameter is specified as
--- 2166,2173 ----
  --       including generic formal parameters.
  
  --    Is_Obsolescent (Flag153)
! --       Present in all entities. Set only for packages and subprograms to
! --       which a valid pragma Obsolescent applies.
  
  --    Is_Optional_Parameter (Flag134)
  --       Present in parameter entities. Set if the parameter is specified as
*************** package Einfo is
*** 2120,2126 ****
  --       Present in subprograms. Set if the subprogram is a primitive
  --       operation of a derived type, that overrides an inherited operation.
  
! --    Is_Package (synthesized)
  --       Applies to all entities. True for packages and generic packages.
  --       False for all other entities.
  
--- 2182,2188 ----
  --       Present in subprograms. Set if the subprogram is a primitive
  --       operation of a derived type, that overrides an inherited operation.
  
! --    Is_Package_Or_Generic_Package (synthesized)
  --       Applies to all entities. True for packages and generic packages.
  --       False for all other entities.
  
*************** package Einfo is
*** 2188,2197 ****
  --       flag is set does not necesarily mean that no elaboration code is
  --       generated for the package.
  
  --    Is_Private_Composite (Flag107)
  --       Present in composite types that have a private component. Used to
  --       enforce the rule that operations on the composite type that depend
! --       on the fulll view of the component, do not become visible until the
  --       immediate scope of the composite type itself (7.3.1 (5)). Both this
  --       flag and Is_Limited_Composite are needed.
  
--- 2250,2264 ----
  --       flag is set does not necesarily mean that no elaboration code is
  --       generated for the package.
  
+ --    Is_Primitive_Wrapper (Flag195)
+ --       Present in E_Procedures. Primitive wrappers are Expander-generated
+ --       procedures that wrap entries of protected or task types implementing
+ --       a limited interface.
+ 
  --    Is_Private_Composite (Flag107)
  --       Present in composite types that have a private component. Used to
  --       enforce the rule that operations on the composite type that depend
! --       on the full view of the component, do not become visible until the
  --       immediate scope of the composite type itself (7.3.1 (5)). Both this
  --       flag and Is_Limited_Composite are needed.
  
*************** package Einfo is
*** 2204,2209 ****
--- 2271,2280 ----
  --       Applies to all entities, true for private types and subtypes,
  --       as well as for record with private types as subtypes
  
+ --    Is_Protected_Interface (Flag198)
+ --       Present in types that are interfaces. True if interface is declared
+ --       protected, or is derived from protected interfaces.
+ 
  --    Is_Protected_Type (synthesized)
  --       Applies to all entities, true for protected types and subtypes
  
*************** package Einfo is
*** 2232,2237 ****
--- 2303,2313 ----
  --       resulting from assignment to out parameters, or to objects designated
  --       by access parameters).
  
+ --    Is_Pure_Unit_Access_Type (Flag189)
+ --       Present in access type and subtype entities. Set if the type or
+ --       subtype appears in a pure unit. Used to give an error message at
+ --       freeze time if the access type has a storage pool.
+ 
  --    Is_Real_Type (synthesized)
  --       Applies to all entities, true for real types and subtypes
  
*************** package Einfo is
*** 2293,2298 ****
--- 2369,2378 ----
  --       or a string slice type, or an array type with one dimension and a
  --       component type that is a character type.
  
+ --    Is_Synchronized_Interface (Flag199)
+ --       Present_types that are interfaces. True is interface is declared
+ --       synchronized, or is derived from synchronized interfaces.
+ 
  --    Is_Tag (Flag78)
  --       Present in E_Component. For regular tagged type this flag is set on
  --       the tag component (whose name is Name_uTag) and for CPP_Class tagged
*************** package Einfo is
*** 2302,2307 ****
--- 2382,2391 ----
  --    Is_Tagged_Type (Flag55)
  --       Present in all entities, true for an entity for a tagged type.
  
+ --    Is_Task_Interface (Flag200)
+ --       Present in types that are interfaces. True is interface is declared
+ --        as such, or if it is derived from task interfaces.
+ 
  --    Is_Task_Record_Type (synthesized)
  --       Applies to all entities, true if Is_Concurrent_Record_Type
  --       Corresponding_Concurrent_Type is a task type.
*************** package Einfo is
*** 2472,2478 ****
  --       accurately a storage unit boundary). The front end checks that
  --       component clauses respect this rule, and the back end ensures
  --       that record packing does not violate this rule. Currently the
! --       flag is set only for packed arrays longer than 64 bits.
  
  --    Needs_Debug_Info (Flag147)
  --       Present in all entities. Set if the entity requires debugging
--- 2556,2563 ----
  --       accurately a storage unit boundary). The front end checks that
  --       component clauses respect this rule, and the back end ensures
  --       that record packing does not violate this rule. Currently the
! --       flag is set only for packed arrays longer than 64 bits where
! --       the component size is not a power of 2.
  
  --    Needs_Debug_Info (Flag147)
  --       Present in all entities. Set if the entity requires debugging
*************** package Einfo is
*** 2666,2673 ****
  --       formals as a value of type Pos.
  
  --    Obsolescent_Warning (Node24)
! --       Present in subprogram entities. Set non-empty only if the pragma
! --       Obsolescent had a string argument, in which case it records the
  --       contents of the corresponding string literal node.
  
  --    Original_Access_Type (Node21)
--- 2751,2758 ----
  --       formals as a value of type Pos.
  
  --    Obsolescent_Warning (Node24)
! --       Present in package and subprogram entities. Set non-empty only if the
! --       pragma Obsolescent had a string argument, in which case it records the
  --       contents of the corresponding string literal node.
  
  --    Original_Access_Type (Node21)
*************** package Einfo is
*** 2708,2713 ****
--- 2793,2814 ----
  --       In subtypes (tagged and untagged):
  --         Points to the component in the base type.
  
+ --    Overridden_Operation (Node26)
+ --       Present in subprograms. For overriding operations, points to the
+ --       user-defined parent subprogram that is being overridden.
+ 
+ --    Package_Instantiation (Node26)
+ --       Present in packages and generic packages. When present, this field
+ --       references an N_Package_Instantiation node associated with an
+ --       instantiated package. In the case where the referenced node has
+ --       been rewritten to an N_Package_Specification, the instantiation
+ --       node is available from the Original_Node field of the package spec
+ --       node. This is currently not guaranteed to be set in all cases, but
+ --       when set, the field is used in Get_Package_Instantiation_Node as
+ --       one of the means of obtaining the instantiation node. Eventually
+ --       it should be set in all cases, including package entities associated
+ --       with formal packages. ???
+ 
  --    Packed_Array_Type (Node23)
  --       Present in array types and subtypes, including the string literal
  --       subtype case, if the corresponding type is packed (either bit packed
*************** package Einfo is
*** 3070,3078 ****
  --       Present in all entities. Suppresses any style checks specifically
  --       associated with the given entity if set.
  
! --    Tag_Component (synthesized)
! --       Applies to tagged record types, returns the entity for the _Tag
! --       field in this record, which must be present.
  
  --    Treat_As_Volatile (Flag41)
  --       Present in all type entities, and also in constants, components and
--- 3171,3189 ----
  --       Present in all entities. Suppresses any style checks specifically
  --       associated with the given entity if set.
  
! --    Task_Body_Procedure (Node24)
! --       Present in task types and subtypes. Points to the entity for
! --       the task body procedure (as further described in Exp_Ch9, task
! --       bodies are expanded into procedures). A convenient function to
! --       retrieve this field is Sem_Util.Get_Task_Body_Procedure.
! 
! --    First_Tag_Component (synthesized)
! --       Applies to tagged record types, returns the entity for the first
! --       _Tag field in this record.
! 
! --    Next_Tag_Component (synthesized)
! --       Applies to components of tagged record types. Given a _Tag field
! --       of a record, returns the next _Tag field in this record.
  
  --    Treat_As_Volatile (Flag41)
  --       Present in all type entities, and also in constants, components and
*************** package Einfo is
*** 3149,3154 ****
--- 3260,3273 ----
  --       is used to suppress warnings for a given entity. It is also used by
  --       the compiler in some situations to kill spurious warnings.
  
+ --    Was_Hidden (Flag196)
+ --       Present in all entities. Used to save the value of the Is_Hidden
+ --       attribute when the limited-view is installed (Ada 2005: AI-217).
+ 
+ --    Wrapped_Entity (Node27)
+ --       Present in an E_Procedure classified as a Is_Primitive_Wrapper. Set
+ --       to the entity that is being wrapped.
+ 
     ------------------
     -- Access Kinds --
     ------------------
*************** package Einfo is
*** 3417,3423 ****
        --  A record type, created by a record type declaration
  
        E_Record_Subtype,
!       --  A record subtype, created by a record subtype declaration.
  
        E_Record_Type_With_Private,
        --  Used for types defined by a private extension declaration, and
--- 3536,3542 ----
        --  A record type, created by a record type declaration
  
        E_Record_Subtype,
!       --  A record subtype, created by a record subtype declaration
  
        E_Record_Type_With_Private,
        --  Used for types defined by a private extension declaration, and
*************** package Einfo is
*** 3428,3434 ****
        --  a private type.
  
        E_Record_Subtype_With_Private,
!       --  A subtype of a type defined by a private extension declaration.
  
        E_Private_Type,
        --  A private type, created by a private type declaration
--- 3547,3553 ----
        --  a private type.
  
        E_Record_Subtype_With_Private,
!       --  A subtype of a type defined by a private extension declaration
  
        E_Private_Type,
        --  A private type, created by a private type declaration
*************** package Einfo is
*** 3902,3908 ****
     --  For each enumeration value defined in Entity_Kind we list all the
     --  attributes defined in Einfo which can legally be applied to an entity
     --  of that kind. The implementation of the attribute functions (and for
!    --  non-synthesized attributes, or the corresponding set procedures) are
     --  in the Einfo body.
  
     --  The following attributes apply to all entities
--- 4021,4027 ----
     --  For each enumeration value defined in Entity_Kind we list all the
     --  attributes defined in Einfo which can legally be applied to an entity
     --  of that kind. The implementation of the attribute functions (and for
!    --  non-synthetized attributes, of the corresponding set procedures) are
     --  in the Einfo body.
  
     --  The following attributes apply to all entities
*************** package Einfo is
*** 3921,3931 ****
--- 4040,4053 ----
     --    Can_Never_Be_Null             (Flag38)
     --    Checks_May_Be_Suppressed      (Flag31)
     --    Debug_Info_Off                (Flag166)
+    --    Has_Anon_Block_Suffix         (Flag201)
+    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    Has_Convention_Pragma         (Flag119)
     --    Has_Delayed_Freeze            (Flag18)
     --    Has_Fully_Qualified_Name      (Flag173)
     --    Has_Gigi_Rep_Item             (Flag82)
     --    Has_Homonym                   (Flag56)
+    --    Has_Persistent_BSS            (Flag188)
     --    Has_Pragma_Elaborate_Body     (Flag150)
     --    Has_Pragma_Inline             (Flag157)
     --    Has_Pragma_Unreferenced       (Flag180)
*************** package Einfo is
*** 3955,3964 ****
--- 4077,4088 ----
     --    Is_Known_Valid                (Flag170)
     --    Is_Limited_Composite          (Flag106)
     --    Is_Limited_Record             (Flag25)
+    --    Is_Obsolescent                (Flag153)
     --    Is_Package_Body_Entity        (Flag160)
     --    Is_Packed_Array_Type          (Flag138)
     --    Is_Potentially_Use_Visible    (Flag9)
     --    Is_Preelaborated              (Flag59)
+    --    Is_Primitive_Wrapper          (Flag195)
     --    Is_Public                     (Flag10)
     --    Is_Pure                       (Flag44)
     --    Is_Remote_Call_Interface      (Flag62)
*************** package Einfo is
*** 3976,3981 ****
--- 4100,4106 ----
     --    Referenced_As_LHS             (Flag36)
     --    Suppress_Elaboration_Warnings (Flag148)
     --    Suppress_Style_Checks         (Flag165)
+    --    Was_Hidden                    (Flag196)
  
     --    Declaration_Node              (synth)
     --    Enclosing_Dynamic_Scope       (synth)
*************** package Einfo is
*** 4005,4016 ****
--- 4130,4146 ----
     --    Has_Alignment_Clause          (Flag46)
     --    Has_Atomic_Components         (Flag86)   (base type only)
     --    Has_Complex_Representation    (Flag140)  (base type only)
+    --    Has_Constrained_Partial_View  (Flag187)
     --    Has_Discriminants             (Flag5)
     --    Has_Non_Standard_Rep          (Flag75)   (base type only)
     --    Has_Object_Size_Clause        (Flag172)
     --    Has_Primitive_Operations      (Flag120)  (base type only)
     --    Has_Size_Clause               (Flag29)
     --    Has_Specified_Layout          (Flag100)  (base type only)
+    --    Has_Specified_Stream_Input    (Flag190)
+    --    Has_Specified_Stream_Output   (Flag191)
+    --    Has_Specified_Stream_Read     (Flag192)
+    --    Has_Specified_Stream_Write    (Flag193)
     --    Has_Task                      (Flag30)   (base type only)
     --    Has_Unchecked_Union           (Flag123)  (base type only)
     --    Has_Volatile_Components       (Flag87)   (base type only)
*************** package Einfo is
*** 4025,4030 ****
--- 4155,4164 ----
     --    Is_Frozen                     (Flag4)
     --    Is_Generic_Actual_Type        (Flag94)
     --    Is_Generic_Type               (Flag13)
+    --    Is_Limited_Interface          (Flag197)
+    --    Is_Protected_Interface        (Flag198)
+    --    Is_Synchronized_Interface     (Flag199)
+    --    Is_Task_Interface             (Flag200)
     --    Is_Non_Static_Subtype         (Flag109)
     --    Is_Packed                     (Flag51)   (base type only)
     --    Is_Private_Composite          (Flag107)
*************** package Einfo is
*** 4078,4084 ****
--- 4212,4220 ----
     --    Associated_Final_Chain        (Node23)
     --    Has_Pragma_Controlled         (Flag27)   (base type only)
     --    Has_Storage_Size_Clause       (Flag23)   (base type only)
+    --    Is_Local_Anonymous_Access     (Flag194)
     --    Is_Access_Constant            (Flag69)
+    --    Is_Pure_Unit_Access_Type      (Flag189)
     --    No_Pool_Assigned              (Flag131)  (base type only)
     --    No_Strict_Aliasing            (Flag136)  (base type only)
     --    (plus type attributes)
*************** package Einfo is
*** 4108,4114 ****
     --    Packed_Array_Type             (Node23)
     --    Component_Alignment           (special)  (base type only)
     --    Has_Component_Size_Clause     (Flag68)   (base type only)
-    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    Has_Pragma_Pack               (Flag121)  (base type only)
     --    Is_Aliased                    (Flag15)
     --    Is_Constrained                (Flag12)
--- 4244,4249 ----
*************** package Einfo is
*** 4137,4143 ****
     --    First_Entity                  (Node17)
     --    Equivalent_Type               (Node18)   (always Empty in type case)
     --    Last_Entity                   (Node20)
-    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    First_Component               (synth)
     --    (plus type attributes)
  
--- 4272,4277 ----
*************** package Einfo is
*** 4165,4170 ****
--- 4299,4305 ----
     --    Treat_As_Volatile             (Flag41)
     --    Is_Protected_Private          (synth)
     --    Next_Component                (synth)
+    --    Next_Tag_Component            (synth)
  
     --  E_Constant
     --  E_Loop_Parameter
*************** package Einfo is
*** 4320,4325 ****
--- 4455,4462 ----
     --    Inner_Instances               (Elist23)  (for a generic function)
     --    Privals_Chain                 (Elist23)  (for a protected function)
     --    Obsolescent_Warning           (Node24)
+    --    Abstract_Interface_Alias      (Node25)
+    --    Overridden_Operation          (Node26)
     --    Body_Needed_For_SAL           (Flag40)
     --    Elaboration_Entity_Required   (Flag174)
     --    Function_Returns_With_DSP     (Flag169)
*************** package Einfo is
*** 4327,4333 ****
     --    Delay_Cleanups                (Flag114)
     --    Delay_Subprogram_Descriptors  (Flag50)
     --    Discard_Names                 (Flag88)
-    --    Elaborate_All_Desirable       (Flag146)
     --    Has_Completion                (Flag26)
     --    Has_Controlling_Result        (Flag98)
     --    Has_Master_Entity             (Flag21)
--- 4464,4469 ----
*************** package Einfo is
*** 4344,4350 ****
     --    Is_Instantiated               (Flag126)  (generic case only)
     --    Is_Intrinsic_Subprogram       (Flag64)
     --    Is_Machine_Code_Subprogram    (Flag137)  (non-generic case only)
-    --    Is_Obsolescent                (Flag153)
     --    Is_Overriding_Operation       (Flag39)   (non-generic case only)
     --    Is_Private_Descendant         (Flag53)
     --    Is_Pure                       (Flag44)
--- 4480,4485 ----
*************** package Einfo is
*** 4496,4505 ****
     --    Generic_Renamings             (Elist23)  (for an instance)
     --    Inner_Instances               (Elist23)  (generic case only)
     --    Limited_View                  (Node23)   (non-generic, not instance)
     --    Delay_Subprogram_Descriptors  (Flag50)
     --    Body_Needed_For_SAL           (Flag40)
     --    Discard_Names                 (Flag88)
-    --    Elaborate_All_Desirable       (Flag146)
     --    Elaboration_Entity_Required   (Flag174)
     --    From_With_Type                (Flag159)
     --    Has_All_Calls_Remote          (Flag79)
--- 4631,4642 ----
     --    Generic_Renamings             (Elist23)  (for an instance)
     --    Inner_Instances               (Elist23)  (generic case only)
     --    Limited_View                  (Node23)   (non-generic, not instance)
+    --    Obsolescent_Warning           (Node24)
+    --    Current_Use_Clause            (Node25)
+    --    Package_Instantiation         (Node26)
     --    Delay_Subprogram_Descriptors  (Flag50)
     --    Body_Needed_For_SAL           (Flag40)
     --    Discard_Names                 (Flag88)
     --    Elaboration_Entity_Required   (Flag174)
     --    From_With_Type                (Flag159)
     --    Has_All_Calls_Remote          (Flag79)
*************** package Einfo is
*** 4567,4572 ****
--- 4704,4713 ----
     --    Inner_Instances               (Elist23)  (for a generic procedure)
     --    Privals_Chain                 (Elist23)  (for a protected procedure)
     --    Obsolescent_Warning           (Node24)
+    --    Abstract_Interface_Alias      (Node25)
+    --    Overridden_Operation          (Node26)
+    --    Wrapped_Entity                (Node27)   (non-generic case only)
+ 
     --    Body_Needed_For_SAL           (Flag40)
     --    Elaboration_Entity_Required   (Flag174)
     --    Function_Returns_With_DSP     (Flag169)  (always False for procedure)
*************** package Einfo is
*** 4574,4580 ****
     --    Delay_Cleanups                (Flag114)
     --    Delay_Subprogram_Descriptors  (Flag50)
     --    Discard_Names                 (Flag88)
-    --    Elaborate_All_Desirable       (Flag146)
     --    Has_Completion                (Flag26)
     --    Has_Master_Entity             (Flag21)
     --    Has_Nested_Block_With_Handler (Flag101)
--- 4715,4720 ----
*************** package Einfo is
*** 4591,4598 ****
     --    Is_Intrinsic_Subprogram       (Flag64)
     --    Is_Machine_Code_Subprogram    (Flag137)  (non-generic case only)
     --    Is_Null_Init_Proc             (Flag178)
-    --    Is_Obsolescent                (Flag153)
     --    Is_Overriding_Operation       (Flag39)   (non-generic case only)
     --    Is_Private_Descendant         (Flag53)
     --    Is_Pure                       (Flag44)
     --    Is_Thread_Body                (Flag77)   (non-generic case only)
--- 4731,4739 ----
     --    Is_Intrinsic_Subprogram       (Flag64)
     --    Is_Machine_Code_Subprogram    (Flag137)  (non-generic case only)
     --    Is_Null_Init_Proc             (Flag178)
     --    Is_Overriding_Operation       (Flag39)   (non-generic case only)
+    --    Is_Primitive_Wrapper          (Flag195)  (non-generic case only)
+ 
     --    Is_Private_Descendant         (Flag53)
     --    Is_Pure                       (Flag44)
     --    Is_Thread_Body                (Flag77)   (non-generic case only)
*************** package Einfo is
*** 4623,4629 ****
     --    Scope_Depth_Value             (Uint22)
     --    Scope_Depth                   (synth)
     --    Stored_Constraint             (Elist23)
-    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    Has_Interrupt_Handler         (synth)
     --    Sec_Stack_Needed_For_Return   (Flag167) ???
     --    Uses_Sec_Stack                (Flag95) ???
--- 4764,4769 ----
*************** package Einfo is
*** 4633,4639 ****
     --  E_Record_Type
     --  E_Record_Subtype
     --    Primitive_Operations          (Elist15)
!    --    Access_Disp_Table             (Node16)   (base type only)
     --    Cloned_Subtype                (Node16)   (subtype case only)
     --    First_Entity                  (Node17)
     --    Corresponding_Concurrent_Type (Node18)
--- 4773,4779 ----
     --  E_Record_Type
     --  E_Record_Subtype
     --    Primitive_Operations          (Elist15)
!    --    Access_Disp_Table             (Elist16)  (base type only)
     --    Cloned_Subtype                (Node16)   (subtype case only)
     --    First_Entity                  (Node17)
     --    Corresponding_Concurrent_Type (Node18)
*************** package Einfo is
*** 4642,4667 ****
     --    Discriminant_Constraint       (Elist21)
     --    Corresponding_Remote_Type     (Node22)
     --    Stored_Constraint             (Elist23)
     --    Component_Alignment           (special)  (base type only)
     --    C_Pass_By_Copy                (Flag125)  (base type only)
-    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    Has_External_Tag_Rep_Clause   (Flag110)
     --    Has_Record_Rep_Clause         (Flag65)   (base type only)
     --    Is_Class_Wide_Equivalent_Type (Flag35)
     --    Is_Concurrent_Record_Type     (Flag20)
     --    Is_Constrained                (Flag12)
     --    Is_Controlled                 (Flag42)   (base type only)
     --    Reverse_Bit_Order             (Flag164)  (base type only)
     --    First_Component               (synth)
     --    First_Discriminant            (synth)
     --    First_Stored_Discriminant     (synth)
!    --    Tag_Component                 (synth)
     --    (plus type attributes)
  
     --  E_Record_Type_With_Private
     --  E_Record_Subtype_With_Private
     --    Primitive_Operations          (Elist15)
!    --    Access_Disp_Table             (Node16)   (base type only)
     --    First_Entity                  (Node17)
     --    Private_Dependents            (Elist18)
     --    Underlying_Full_View          (Node19)
--- 4782,4808 ----
     --    Discriminant_Constraint       (Elist21)
     --    Corresponding_Remote_Type     (Node22)
     --    Stored_Constraint             (Elist23)
+    --    Abstract_Interfaces           (Elist24)
     --    Component_Alignment           (special)  (base type only)
     --    C_Pass_By_Copy                (Flag125)  (base type only)
     --    Has_External_Tag_Rep_Clause   (Flag110)
     --    Has_Record_Rep_Clause         (Flag65)   (base type only)
     --    Is_Class_Wide_Equivalent_Type (Flag35)
     --    Is_Concurrent_Record_Type     (Flag20)
     --    Is_Constrained                (Flag12)
     --    Is_Controlled                 (Flag42)   (base type only)
+    --    Is_Interface                  (Flag186)
     --    Reverse_Bit_Order             (Flag164)  (base type only)
     --    First_Component               (synth)
     --    First_Discriminant            (synth)
     --    First_Stored_Discriminant     (synth)
!    --    First_Tag_Component           (synth)
     --    (plus type attributes)
  
     --  E_Record_Type_With_Private
     --  E_Record_Subtype_With_Private
     --    Primitive_Operations          (Elist15)
!    --    Access_Disp_Table             (Elist16)  (base type only)
     --    First_Entity                  (Node17)
     --    Private_Dependents            (Elist18)
     --    Underlying_Full_View          (Node19)
*************** package Einfo is
*** 4669,4687 ****
     --    Discriminant_Constraint       (Elist21)
     --    Private_View                  (Node22)
     --    Stored_Constraint             (Elist23)
     --    Has_Completion                (Flag26)
     --    Has_Completion_In_Body        (Flag71)
-    --    Has_Controlled_Component      (Flag43)   (base type only)
     --    Has_Record_Rep_Clause         (Flag65)   (base type only)
     --    Has_External_Tag_Rep_Clause   (Flag110)
     --    Is_Concurrent_Record_Type     (Flag20)
     --    Is_Constrained                (Flag12)
     --    Is_Controlled                 (Flag42)   (base type only)
     --    Reverse_Bit_Order             (Flag164)  (base type only)
     --    First_Component               (synth)
     --    First_Discriminant            (synth)
     --    First_Stored_Discriminant     (synth)
!    --    Tag_Component                 (synth)
     --    (plus type attributes)
  
     --  E_Signed_Integer_Type
--- 4810,4829 ----
     --    Discriminant_Constraint       (Elist21)
     --    Private_View                  (Node22)
     --    Stored_Constraint             (Elist23)
+    --    Abstract_Interfaces           (Elist24)
     --    Has_Completion                (Flag26)
     --    Has_Completion_In_Body        (Flag71)
     --    Has_Record_Rep_Clause         (Flag65)   (base type only)
     --    Has_External_Tag_Rep_Clause   (Flag110)
     --    Is_Concurrent_Record_Type     (Flag20)
     --    Is_Constrained                (Flag12)
     --    Is_Controlled                 (Flag42)   (base type only)
+    --    Is_Interface                  (Flag186)
     --    Reverse_Bit_Order             (Flag164)  (base type only)
     --    First_Component               (synth)
     --    First_Discriminant            (synth)
     --    First_Stored_Discriminant     (synth)
!    --    First_Tag_Component           (synth)
     --    (plus type attributes)
  
     --  E_Signed_Integer_Type
*************** package Einfo is
*** 4737,4742 ****
--- 4879,4885 ----
     --    Scope_Depth_Value             (Uint22)
     --    Scope_Depth                   (synth)
     --    Stored_Constraint             (Elist23)
+    --    Task_Body_Procedure           (Node24)
     --    Delay_Cleanups                (Flag114)
     --    Has_Master_Entity             (Flag21)
     --    Has_Storage_Size_Clause       (Flag23)   (base type only)
*************** package Einfo is
*** 5006,5016 ****
     --  section contains the functions used to obtain attribute values which
     --  correspond to values in fields or flags in the entity itself.
  
     function Accept_Address                     (Id : E) return L;
!    function Access_Disp_Table                  (Id : E) return E;
     function Actual_Subtype                     (Id : E) return E;
     function Address_Taken                      (Id : E) return B;
     function Alias                              (Id : E) return E;
     function Alignment                          (Id : E) return U;
     function Associated_Final_Chain             (Id : E) return E;
     function Associated_Formal_Package          (Id : E) return E;
--- 5149,5161 ----
     --  section contains the functions used to obtain attribute values which
     --  correspond to values in fields or flags in the entity itself.
  
+    function Abstract_Interfaces                (Id : E) return L;
     function Accept_Address                     (Id : E) return L;
!    function Access_Disp_Table                  (Id : E) return L;
     function Actual_Subtype                     (Id : E) return E;
     function Address_Taken                      (Id : E) return B;
     function Alias                              (Id : E) return E;
+    function Abstract_Interface_Alias           (Id : E) return E;
     function Alignment                          (Id : E) return U;
     function Associated_Final_Chain             (Id : E) return E;
     function Associated_Formal_Package          (Id : E) return E;
*************** package Einfo is
*** 5036,5041 ****
--- 5181,5187 ----
     function Corresponding_Equality             (Id : E) return E;
     function Corresponding_Record_Type          (Id : E) return E;
     function Corresponding_Remote_Type          (Id : E) return E;
+    function Current_Use_Clause                 (Id : E) return E;
     function Current_Value                      (Id : E) return N;
     function Debug_Info_Off                     (Id : E) return B;
     function Debug_Renaming_Link                (Id : E) return E;
*************** package Einfo is
*** 5059,5065 ****
     function Discriminant_Constraint            (Id : E) return L;
     function Discriminant_Default_Value         (Id : E) return N;
     function Discriminant_Number                (Id : E) return U;
-    function Elaborate_All_Desirable            (Id : E) return B;
     function Elaboration_Entity                 (Id : E) return E;
     function Elaboration_Entity_Required        (Id : E) return B;
     function Enclosing_Scope                    (Id : E) return E;
--- 5205,5210 ----
*************** package Einfo is
*** 5099,5110 ****
--- 5244,5257 ----
     function Has_Aliased_Components             (Id : E) return B;
     function Has_Alignment_Clause               (Id : E) return B;
     function Has_All_Calls_Remote               (Id : E) return B;
+    function Has_Anon_Block_Suffix              (Id : E) return B;
     function Has_Atomic_Components              (Id : E) return B;
     function Has_Biased_Representation          (Id : E) return B;
     function Has_Completion                     (Id : E) return B;
     function Has_Completion_In_Body             (Id : E) return B;
     function Has_Complex_Representation         (Id : E) return B;
     function Has_Component_Size_Clause          (Id : E) return B;
+    function Has_Constrained_Partial_View       (Id : E) return B;
     function Has_Contiguous_Rep                 (Id : E) return B;
     function Has_Controlled_Component           (Id : E) return B;
     function Has_Controlling_Result             (Id : E) return B;
*************** package Einfo is
*** 5126,5131 ****
--- 5273,5279 ----
     function Has_Non_Standard_Rep               (Id : E) return B;
     function Has_Object_Size_Clause             (Id : E) return B;
     function Has_Per_Object_Constraint          (Id : E) return B;
+    function Has_Persistent_BSS                 (Id : E) return B;
     function Has_Pragma_Controlled              (Id : E) return B;
     function Has_Pragma_Elaborate_Body          (Id : E) return B;
     function Has_Pragma_Inline                  (Id : E) return B;
*************** package Einfo is
*** 5139,5144 ****
--- 5287,5296 ----
     function Has_Size_Clause                    (Id : E) return B;
     function Has_Small_Clause                   (Id : E) return B;
     function Has_Specified_Layout               (Id : E) return B;
+    function Has_Specified_Stream_Input         (Id : E) return B;
+    function Has_Specified_Stream_Output        (Id : E) return B;
+    function Has_Specified_Stream_Read          (Id : E) return B;
+    function Has_Specified_Stream_Write         (Id : E) return B;
     function Has_Storage_Size_Clause            (Id : E) return B;
     function Has_Stream_Size_Clause             (Id : E) return B;
     function Has_Subprogram_Descriptor          (Id : E) return B;
*************** package Einfo is
*** 5156,5161 ****
--- 5308,5314 ----
     function Interface_Name                     (Id : E) return N;
     function Is_AST_Entry                       (Id : E) return B;
     function Is_Abstract                        (Id : E) return B;
+    function Is_Local_Anonymous_Access          (Id : E) return B;
     function Is_Access_Constant                 (Id : E) return B;
     function Is_Ada_2005                        (Id : E) return B;
     function Is_Aliased                         (Id : E) return B;
*************** package Einfo is
*** 5189,5194 ****
--- 5342,5348 ----
     function Is_Immediately_Visible             (Id : E) return B;
     function Is_Imported                        (Id : E) return B;
     function Is_Inlined                         (Id : E) return B;
+    function Is_Interface                       (Id : E) return B;
     function Is_Instantiated                    (Id : E) return B;
     function Is_Internal                        (Id : E) return B;
     function Is_Interrupt_Handler               (Id : E) return B;
*************** package Einfo is
*** 5197,5202 ****
--- 5351,5357 ----
     function Is_Known_Non_Null                  (Id : E) return B;
     function Is_Known_Valid                     (Id : E) return B;
     function Is_Limited_Composite               (Id : E) return B;
+    function Is_Limited_Interface               (Id : E) return B;
     function Is_Machine_Code_Subprogram         (Id : E) return B;
     function Is_Non_Static_Subtype              (Id : E) return B;
     function Is_Null_Init_Proc                  (Id : E) return B;
*************** package Einfo is
*** 5207,5223 ****
--- 5362,5384 ----
     function Is_Packed_Array_Type               (Id : E) return B;
     function Is_Potentially_Use_Visible         (Id : E) return B;
     function Is_Preelaborated                   (Id : E) return B;
+    function Is_Primitive_Wrapper               (Id : E) return B;
+ 
     function Is_Private_Composite               (Id : E) return B;
     function Is_Private_Descendant              (Id : E) return B;
+    function Is_Protected_Interface             (Id : E) return B;
     function Is_Public                          (Id : E) return B;
     function Is_Pure                            (Id : E) return B;
+    function Is_Pure_Unit_Access_Type           (Id : E) return B;
     function Is_Remote_Call_Interface           (Id : E) return B;
     function Is_Remote_Types                    (Id : E) return B;
     function Is_Renaming_Of_Object              (Id : E) return B;
     function Is_Shared_Passive                  (Id : E) return B;
     function Is_Statically_Allocated            (Id : E) return B;
+    function Is_Synchronized_Interface          (Id : E) return B;
     function Is_Tag                             (Id : E) return B;
     function Is_Tagged_Type                     (Id : E) return B;
+    function Is_Task_Interface                  (Id : E) return B;
     function Is_Thread_Body                     (Id : E) return B;
     function Is_True_Constant                   (Id : E) return B;
     function Is_Unchecked_Union                 (Id : E) return B;
*************** package Einfo is
*** 5258,5263 ****
--- 5419,5426 ----
     function Original_Access_Type               (Id : E) return E;
     function Original_Array_Type                (Id : E) return E;
     function Original_Record_Component          (Id : E) return E;
+    function Overridden_Operation               (Id : E) return E;
+    function Package_Instantiation              (Id : E) return N;
     function Packed_Array_Type                  (Id : E) return E;
     function Parent_Subtype                     (Id : E) return E;
     function Primitive_Operations               (Id : E) return L;
*************** package Einfo is
*** 5302,5313 ****
--- 5465,5479 ----
     function Suppress_Elaboration_Warnings      (Id : E) return B;
     function Suppress_Init_Proc                 (Id : E) return B;
     function Suppress_Style_Checks              (Id : E) return B;
+    function Task_Body_Procedure                (Id : E) return N;
     function Treat_As_Volatile                  (Id : E) return B;
     function Underlying_Full_View               (Id : E) return E;
     function Unset_Reference                    (Id : E) return N;
     function Uses_Sec_Stack                     (Id : E) return B;
     function Vax_Float                          (Id : E) return B;
     function Warnings_Off                       (Id : E) return B;
+    function Was_Hidden                         (Id : E) return B;
+    function Wrapped_Entity                     (Id : E) return E;
  
     -------------------------------
     -- Classification Attributes --
*************** package Einfo is
*** 5395,5401 ****
     function Is_Dynamic_Scope                   (Id : E) return B;
     function Is_Indefinite_Subtype              (Id : E) return B;
     function Is_Limited_Type                    (Id : E) return B;
!    function Is_Package                         (Id : E) return B;
     function Is_Protected_Private               (Id : E) return B;
     function Is_Protected_Record_Type           (Id : E) return B;
     function Is_Return_By_Reference_Type        (Id : E) return B;
--- 5561,5567 ----
     function Is_Dynamic_Scope                   (Id : E) return B;
     function Is_Indefinite_Subtype              (Id : E) return B;
     function Is_Limited_Type                    (Id : E) return B;
!    function Is_Package_Or_Generic_Package      (Id : E) return B;
     function Is_Protected_Private               (Id : E) return B;
     function Is_Protected_Record_Type           (Id : E) return B;
     function Is_Return_By_Reference_Type        (Id : E) return B;
*************** package Einfo is
*** 5416,5422 ****
     function Scope_Depth_Set                    (Id : E) return B;
     function Size_Clause                        (Id : E) return N;
     function Stream_Size_Clause                 (Id : E) return N;
!    function Tag_Component                      (Id : E) return E;
     function Type_High_Bound                    (Id : E) return N;
     function Type_Low_Bound                     (Id : E) return N;
     function Underlying_Type                    (Id : E) return E;
--- 5582,5589 ----
     function Scope_Depth_Set                    (Id : E) return B;
     function Size_Clause                        (Id : E) return N;
     function Stream_Size_Clause                 (Id : E) return N;
!    function First_Tag_Component                (Id : E) return E;
!    function Next_Tag_Component                 (Id : E) return E;
     function Type_High_Bound                    (Id : E) return N;
     function Type_Low_Bound                     (Id : E) return N;
     function Underlying_Type                    (Id : E) return E;
*************** package Einfo is
*** 5481,5491 ****
     -- Attribute Set Procedures --
     ------------------------------
  
     procedure Set_Accept_Address                (Id : E; V : L);
!    procedure Set_Access_Disp_Table             (Id : E; V : E);
     procedure Set_Actual_Subtype                (Id : E; V : E);
     procedure Set_Address_Taken                 (Id : E; V : B := True);
     procedure Set_Alias                         (Id : E; V : E);
     procedure Set_Alignment                     (Id : E; V : U);
     procedure Set_Associated_Final_Chain        (Id : E; V : E);
     procedure Set_Associated_Formal_Package     (Id : E; V : E);
--- 5648,5660 ----
     -- Attribute Set Procedures --
     ------------------------------
  
+    procedure Set_Abstract_Interfaces           (Id : E; V : L);
     procedure Set_Accept_Address                (Id : E; V : L);
!    procedure Set_Access_Disp_Table             (Id : E; V : L);
     procedure Set_Actual_Subtype                (Id : E; V : E);
     procedure Set_Address_Taken                 (Id : E; V : B := True);
     procedure Set_Alias                         (Id : E; V : E);
+    procedure Set_Abstract_Interface_Alias      (Id : E; V : E);
     procedure Set_Alignment                     (Id : E; V : U);
     procedure Set_Associated_Final_Chain        (Id : E; V : E);
     procedure Set_Associated_Formal_Package     (Id : E; V : E);
*************** package Einfo is
*** 5511,5516 ****
--- 5680,5686 ----
     procedure Set_Corresponding_Equality        (Id : E; V : E);
     procedure Set_Corresponding_Record_Type     (Id : E; V : E);
     procedure Set_Corresponding_Remote_Type     (Id : E; V : E);
+    procedure Set_Current_Use_Clause            (Id : E; V : E);
     procedure Set_Current_Value                 (Id : E; V : N);
     procedure Set_Debug_Info_Off                (Id : E; V : B := True);
     procedure Set_Debug_Renaming_Link           (Id : E; V : E);
*************** package Einfo is
*** 5534,5540 ****
     procedure Set_Discriminant_Constraint       (Id : E; V : L);
     procedure Set_Discriminant_Default_Value    (Id : E; V : N);
     procedure Set_Discriminant_Number           (Id : E; V : U);
-    procedure Set_Elaborate_All_Desirable       (Id : E; V : B := True);
     procedure Set_Elaboration_Entity            (Id : E; V : E);
     procedure Set_Elaboration_Entity_Required   (Id : E; V : B := True);
     procedure Set_Enclosing_Scope               (Id : E; V : E);
--- 5704,5709 ----
*************** package Einfo is
*** 5573,5584 ****
--- 5742,5755 ----
     procedure Set_Has_Aliased_Components        (Id : E; V : B := True);
     procedure Set_Has_Alignment_Clause          (Id : E; V : B := True);
     procedure Set_Has_All_Calls_Remote          (Id : E; V : B := True);
+    procedure Set_Has_Anon_Block_Suffix         (Id : E; V : B := True);
     procedure Set_Has_Atomic_Components         (Id : E; V : B := True);
     procedure Set_Has_Biased_Representation     (Id : E; V : B := True);
     procedure Set_Has_Completion                (Id : E; V : B := True);
     procedure Set_Has_Completion_In_Body        (Id : E; V : B := True);
     procedure Set_Has_Complex_Representation    (Id : E; V : B := True);
     procedure Set_Has_Component_Size_Clause     (Id : E; V : B := True);
+    procedure Set_Has_Constrained_Partial_View  (Id : E; V : B := True);
     procedure Set_Has_Contiguous_Rep            (Id : E; V : B := True);
     procedure Set_Has_Controlled_Component      (Id : E; V : B := True);
     procedure Set_Has_Controlling_Result        (Id : E; V : B := True);
*************** package Einfo is
*** 5599,5604 ****
--- 5770,5776 ----
     procedure Set_Has_Non_Standard_Rep          (Id : E; V : B := True);
     procedure Set_Has_Object_Size_Clause        (Id : E; V : B := True);
     procedure Set_Has_Per_Object_Constraint     (Id : E; V : B := True);
+    procedure Set_Has_Persistent_BSS            (Id : E; V : B := True);
     procedure Set_Has_Pragma_Controlled         (Id : E; V : B := True);
     procedure Set_Has_Pragma_Elaborate_Body     (Id : E; V : B := True);
     procedure Set_Has_Pragma_Inline             (Id : E; V : B := True);
*************** package Einfo is
*** 5613,5618 ****
--- 5785,5794 ----
     procedure Set_Has_Size_Clause               (Id : E; V : B := True);
     procedure Set_Has_Small_Clause              (Id : E; V : B := True);
     procedure Set_Has_Specified_Layout          (Id : E; V : B := True);
+    procedure Set_Has_Specified_Stream_Input    (Id : E; V : B := True);
+    procedure Set_Has_Specified_Stream_Output   (Id : E; V : B := True);
+    procedure Set_Has_Specified_Stream_Read     (Id : E; V : B := True);
+    procedure Set_Has_Specified_Stream_Write    (Id : E; V : B := True);
     procedure Set_Has_Storage_Size_Clause       (Id : E; V : B := True);
     procedure Set_Has_Stream_Size_Clause        (Id : E; V : B := True);
     procedure Set_Has_Subprogram_Descriptor     (Id : E; V : B := True);
*************** package Einfo is
*** 5630,5635 ****
--- 5806,5812 ----
     procedure Set_Interface_Name                (Id : E; V : N);
     procedure Set_Is_AST_Entry                  (Id : E; V : B := True);
     procedure Set_Is_Abstract                   (Id : E; V : B := True);
+    procedure Set_Is_Local_Anonymous_Access     (Id : E; V : B := True);
     procedure Set_Is_Access_Constant            (Id : E; V : B := True);
     procedure Set_Is_Ada_2005                   (Id : E; V : B := True);
     procedure Set_Is_Aliased                    (Id : E; V : B := True);
*************** package Einfo is
*** 5667,5672 ****
--- 5844,5850 ----
     procedure Set_Is_Immediately_Visible        (Id : E; V : B := True);
     procedure Set_Is_Imported                   (Id : E; V : B := True);
     procedure Set_Is_Inlined                    (Id : E; V : B := True);
+    procedure Set_Is_Interface                  (Id : E; V : B := True);
     procedure Set_Is_Instantiated               (Id : E; V : B := True);
     procedure Set_Is_Internal                   (Id : E; V : B := True);
     procedure Set_Is_Interrupt_Handler          (Id : E; V : B := True);
*************** package Einfo is
*** 5675,5680 ****
--- 5853,5859 ----
     procedure Set_Is_Known_Non_Null             (Id : E; V : B := True);
     procedure Set_Is_Known_Valid                (Id : E; V : B := True);
     procedure Set_Is_Limited_Composite          (Id : E; V : B := True);
+    procedure Set_Is_Limited_Interface          (Id : E; V : B := True);
     procedure Set_Is_Limited_Record             (Id : E; V : B := True);
     procedure Set_Is_Machine_Code_Subprogram    (Id : E; V : B := True);
     procedure Set_Is_Non_Static_Subtype         (Id : E; V : B := True);
*************** package Einfo is
*** 5687,5703 ****
--- 5866,5887 ----
     procedure Set_Is_Packed_Array_Type          (Id : E; V : B := True);
     procedure Set_Is_Potentially_Use_Visible    (Id : E; V : B := True);
     procedure Set_Is_Preelaborated              (Id : E; V : B := True);
+    procedure Set_Is_Primitive_Wrapper          (Id : E; V : B := True);
     procedure Set_Is_Private_Composite          (Id : E; V : B := True);
     procedure Set_Is_Private_Descendant         (Id : E; V : B := True);
+    procedure Set_Is_Protected_Interface        (Id : E; V : B := True);
     procedure Set_Is_Public                     (Id : E; V : B := True);
     procedure Set_Is_Pure                       (Id : E; V : B := True);
+    procedure Set_Is_Pure_Unit_Access_Type      (Id : E; V : B := True);
     procedure Set_Is_Remote_Call_Interface      (Id : E; V : B := True);
     procedure Set_Is_Remote_Types               (Id : E; V : B := True);
     procedure Set_Is_Renaming_Of_Object         (Id : E; V : B := True);
     procedure Set_Is_Shared_Passive             (Id : E; V : B := True);
     procedure Set_Is_Statically_Allocated       (Id : E; V : B := True);
+    procedure Set_Is_Synchronized_Interface     (Id : E; V : B := True);
     procedure Set_Is_Tag                        (Id : E; V : B := True);
     procedure Set_Is_Tagged_Type                (Id : E; V : B := True);
+    procedure Set_Is_Task_Interface             (Id : E; V : B := True);
     procedure Set_Is_Thread_Body                (Id : E; V : B := True);
     procedure Set_Is_True_Constant              (Id : E; V : B := True);
     procedure Set_Is_Unchecked_Union            (Id : E; V : B := True);
*************** package Einfo is
*** 5737,5742 ****
--- 5921,5928 ----
     procedure Set_Original_Access_Type          (Id : E; V : E);
     procedure Set_Original_Array_Type           (Id : E; V : E);
     procedure Set_Original_Record_Component     (Id : E; V : E);
+    procedure Set_Overridden_Operation          (Id : E; V : E);
+    procedure Set_Package_Instantiation         (Id : E; V : N);
     procedure Set_Packed_Array_Type             (Id : E; V : E);
     procedure Set_Parent_Subtype                (Id : E; V : E);
     procedure Set_Primitive_Operations          (Id : E; V : L);
*************** package Einfo is
*** 5781,5792 ****
--- 5967,5981 ----
     procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True);
     procedure Set_Suppress_Init_Proc            (Id : E; V : B := True);
     procedure Set_Suppress_Style_Checks         (Id : E; V : B := True);
+    procedure Set_Task_Body_Procedure           (Id : E; V : N);
     procedure Set_Treat_As_Volatile             (Id : E; V : B := True);
     procedure Set_Underlying_Full_View          (Id : E; V : E);
     procedure Set_Unset_Reference               (Id : E; V : N);
     procedure Set_Uses_Sec_Stack                (Id : E; V : B := True);
     procedure Set_Vax_Float                     (Id : E; V : B := True);
     procedure Set_Warnings_Off                  (Id : E; V : B := True);
+    procedure Set_Was_Hidden                    (Id : E; V : B := True);
+    procedure Set_Wrapped_Entity                (Id : E; V : E);
  
     -----------------------------------
     -- Field Initialization Routines --
*************** package Einfo is
*** 5912,5918 ****
       (E  : Entity_Id;
        Id : Attribute_Id) return Node_Id;
     --  Searches the Rep_Item chain for a given entity E, for an instance
!    --  of an attribute definition clause with the given attibute Id Id. If
     --  found, the value returned is the N_Attribute_Definition_Clause node,
     --  otherwise Empty is returned.
  
--- 6101,6107 ----
       (E  : Entity_Id;
        Id : Attribute_Id) return Node_Id;
     --  Searches the Rep_Item chain for a given entity E, for an instance
!    --  of an attribute definition clause with the given attribute Id. If
     --  found, the value returned is the N_Attribute_Definition_Clause node,
     --  otherwise Empty is returned.
  
*************** package Einfo is
*** 5930,5936 ****
       (E  : Entity_Id;
        Id : Attribute_Id) return Boolean;
     --  Searches the Rep_Item chain for a given entity E, for an instance
!    --  of an attribute definition clause with the given attibute Id Id. If
     --  found, True is returned, otherwise False indicates that no matching
     --  entry was found.
  
--- 6119,6125 ----
       (E  : Entity_Id;
        Id : Attribute_Id) return Boolean;
     --  Searches the Rep_Item chain for a given entity E, for an instance
!    --  of an attribute definition clause with the given attribute Id. If
     --  found, True is returned, otherwise False indicates that no matching
     --  entry was found.
  
*************** package Einfo is
*** 6012,6021 ****
--- 6201,6212 ----
     --  subprograms meeting the requirements documented in the section on
     --  XEINFO may be referenced in this section.
  
+    pragma Inline (Abstract_Interfaces);
     pragma Inline (Accept_Address);
     pragma Inline (Access_Disp_Table);
     pragma Inline (Actual_Subtype);
     pragma Inline (Address_Taken);
+    pragma Inline (Abstract_Interface_Alias);
     pragma Inline (Alias);
     pragma Inline (Alignment);
     pragma Inline (Associated_Final_Chain);
*************** package Einfo is
*** 6041,6046 ****
--- 6232,6238 ----
     pragma Inline (Corresponding_Equality);
     pragma Inline (Corresponding_Record_Type);
     pragma Inline (Corresponding_Remote_Type);
+    pragma Inline (Current_Use_Clause);
     pragma Inline (Current_Value);
     pragma Inline (Debug_Info_Off);
     pragma Inline (Debug_Renaming_Link);
*************** package Einfo is
*** 6064,6070 ****
     pragma Inline (Discriminant_Constraint);
     pragma Inline (Discriminant_Default_Value);
     pragma Inline (Discriminant_Number);
-    pragma Inline (Elaborate_All_Desirable);
     pragma Inline (Elaboration_Entity);
     pragma Inline (Elaboration_Entity_Required);
     pragma Inline (Enclosing_Scope);
--- 6256,6261 ----
*************** package Einfo is
*** 6103,6114 ****
--- 6294,6307 ----
     pragma Inline (Has_Aliased_Components);
     pragma Inline (Has_Alignment_Clause);
     pragma Inline (Has_All_Calls_Remote);
+    pragma Inline (Has_Anon_Block_Suffix);
     pragma Inline (Has_Atomic_Components);
     pragma Inline (Has_Biased_Representation);
     pragma Inline (Has_Completion);
     pragma Inline (Has_Completion_In_Body);
     pragma Inline (Has_Complex_Representation);
     pragma Inline (Has_Component_Size_Clause);
+    pragma Inline (Has_Constrained_Partial_View);
     pragma Inline (Has_Contiguous_Rep);
     pragma Inline (Has_Controlled_Component);
     pragma Inline (Has_Controlling_Result);
*************** package Einfo is
*** 6129,6134 ****
--- 6322,6328 ----
     pragma Inline (Has_Non_Standard_Rep);
     pragma Inline (Has_Object_Size_Clause);
     pragma Inline (Has_Per_Object_Constraint);
+    pragma Inline (Has_Persistent_BSS);
     pragma Inline (Has_Pragma_Controlled);
     pragma Inline (Has_Pragma_Elaborate_Body);
     pragma Inline (Has_Pragma_Inline);
*************** package Einfo is
*** 6143,6148 ****
--- 6337,6346 ----
     pragma Inline (Has_Size_Clause);
     pragma Inline (Has_Small_Clause);
     pragma Inline (Has_Specified_Layout);
+    pragma Inline (Has_Specified_Stream_Input);
+    pragma Inline (Has_Specified_Stream_Output);
+    pragma Inline (Has_Specified_Stream_Read);
+    pragma Inline (Has_Specified_Stream_Write);
     pragma Inline (Has_Storage_Size_Clause);
     pragma Inline (Has_Stream_Size_Clause);
     pragma Inline (Has_Subprogram_Descriptor);
*************** package Einfo is
*** 6160,6165 ****
--- 6358,6364 ----
     pragma Inline (Interface_Name);
     pragma Inline (Is_AST_Entry);
     pragma Inline (Is_Abstract);
+    pragma Inline (Is_Local_Anonymous_Access);
     pragma Inline (Is_Access_Constant);
     pragma Inline (Is_Ada_2005);
     pragma Inline (Is_Access_Type);
*************** package Einfo is
*** 6216,6221 ****
--- 6415,6421 ----
     pragma Inline (Is_Imported);
     pragma Inline (Is_Incomplete_Or_Private_Type);
     pragma Inline (Is_Inlined);
+    pragma Inline (Is_Interface);
     pragma Inline (Is_Instantiated);
     pragma Inline (Is_Integer_Type);
     pragma Inline (Is_Internal);
*************** package Einfo is
*** 6225,6230 ****
--- 6425,6431 ----
     pragma Inline (Is_Known_Non_Null);
     pragma Inline (Is_Known_Valid);
     pragma Inline (Is_Limited_Composite);
+    pragma Inline (Is_Limited_Interface);
     pragma Inline (Is_Limited_Record);
     pragma Inline (Is_Machine_Code_Subprogram);
     pragma Inline (Is_Modular_Integer_Type);
*************** package Einfo is
*** 6243,6254 ****
--- 6444,6459 ----
     pragma Inline (Is_Packed_Array_Type);
     pragma Inline (Is_Potentially_Use_Visible);
     pragma Inline (Is_Preelaborated);
+    pragma Inline (Is_Primitive_Wrapper);
+ 
     pragma Inline (Is_Private_Composite);
     pragma Inline (Is_Private_Descendant);
     pragma Inline (Is_Private_Type);
+    pragma Inline (Is_Protected_Interface);
     pragma Inline (Is_Protected_Type);
     pragma Inline (Is_Public);
     pragma Inline (Is_Pure);
+    pragma Inline (Is_Pure_Unit_Access_Type);
     pragma Inline (Is_Real_Type);
     pragma Inline (Is_Record_Type);
     pragma Inline (Is_Remote_Call_Interface);
*************** package Einfo is
*** 6259,6266 ****
--- 6464,6473 ----
     pragma Inline (Is_Signed_Integer_Type);
     pragma Inline (Is_Statically_Allocated);
     pragma Inline (Is_Subprogram);
+    pragma Inline (Is_Synchronized_Interface);
     pragma Inline (Is_Tag);
     pragma Inline (Is_Tagged_Type);
+    pragma Inline (Is_Task_Interface);
     pragma Inline (Is_Thread_Body);
     pragma Inline (Is_True_Constant);
     pragma Inline (Is_Task_Type);
*************** package Einfo is
*** 6303,6308 ****
--- 6510,6517 ----
     pragma Inline (Original_Access_Type);
     pragma Inline (Original_Array_Type);
     pragma Inline (Original_Record_Component);
+    pragma Inline (Overridden_Operation);
+    pragma Inline (Package_Instantiation);
     pragma Inline (Packed_Array_Type);
     pragma Inline (Parameter_Mode);
     pragma Inline (Parent_Subtype);
*************** package Einfo is
*** 6348,6359 ****
--- 6557,6571 ----
     pragma Inline (Suppress_Elaboration_Warnings);
     pragma Inline (Suppress_Init_Proc);
     pragma Inline (Suppress_Style_Checks);
+    pragma Inline (Task_Body_Procedure);
     pragma Inline (Treat_As_Volatile);
     pragma Inline (Underlying_Full_View);
     pragma Inline (Unset_Reference);
     pragma Inline (Uses_Sec_Stack);
     pragma Inline (Vax_Float);
     pragma Inline (Warnings_Off);
+    pragma Inline (Was_Hidden);
+    pragma Inline (Wrapped_Entity);
  
     pragma Inline (Init_Alignment);
     pragma Inline (Init_Component_Bit_Offset);
*************** package Einfo is
*** 6362,6371 ****
--- 6574,6585 ----
     pragma Inline (Init_Esize);
     pragma Inline (Init_RM_Size);
  
+    pragma Inline (Set_Abstract_Interfaces);
     pragma Inline (Set_Accept_Address);
     pragma Inline (Set_Access_Disp_Table);
     pragma Inline (Set_Actual_Subtype);
     pragma Inline (Set_Address_Taken);
+    pragma Inline (Set_Abstract_Interface_Alias);
     pragma Inline (Set_Alias);
     pragma Inline (Set_Alignment);
     pragma Inline (Set_Associated_Final_Chain);
*************** package Einfo is
*** 6391,6396 ****
--- 6605,6611 ----
     pragma Inline (Set_Corresponding_Equality);
     pragma Inline (Set_Corresponding_Record_Type);
     pragma Inline (Set_Corresponding_Remote_Type);
+    pragma Inline (Set_Current_Use_Clause);
     pragma Inline (Set_Current_Value);
     pragma Inline (Set_Debug_Info_Off);
     pragma Inline (Set_Debug_Renaming_Link);
*************** package Einfo is
*** 6413,6419 ****
     pragma Inline (Set_Discriminant_Constraint);
     pragma Inline (Set_Discriminant_Default_Value);
     pragma Inline (Set_Discriminant_Number);
-    pragma Inline (Set_Elaborate_All_Desirable);
     pragma Inline (Set_Elaboration_Entity);
     pragma Inline (Set_Elaboration_Entity_Required);
     pragma Inline (Set_Enclosing_Scope);
--- 6628,6633 ----
*************** package Einfo is
*** 6450,6461 ****
--- 6664,6677 ----
     pragma Inline (Set_Has_Aliased_Components);
     pragma Inline (Set_Has_Alignment_Clause);
     pragma Inline (Set_Has_All_Calls_Remote);
+    pragma Inline (Set_Has_Anon_Block_Suffix);
     pragma Inline (Set_Has_Atomic_Components);
     pragma Inline (Set_Has_Biased_Representation);
     pragma Inline (Set_Has_Completion);
     pragma Inline (Set_Has_Completion_In_Body);
     pragma Inline (Set_Has_Complex_Representation);
     pragma Inline (Set_Has_Component_Size_Clause);
+    pragma Inline (Set_Has_Constrained_Partial_View);
     pragma Inline (Set_Has_Contiguous_Rep);
     pragma Inline (Set_Has_Controlled_Component);
     pragma Inline (Set_Has_Controlling_Result);
*************** package Einfo is
*** 6476,6481 ****
--- 6692,6698 ----
     pragma Inline (Set_Has_Non_Standard_Rep);
     pragma Inline (Set_Has_Object_Size_Clause);
     pragma Inline (Set_Has_Per_Object_Constraint);
+    pragma Inline (Set_Has_Persistent_BSS);
     pragma Inline (Set_Has_Pragma_Controlled);
     pragma Inline (Set_Has_Pragma_Elaborate_Body);
     pragma Inline (Set_Has_Pragma_Inline);
*************** package Einfo is
*** 6490,6495 ****
--- 6707,6716 ----
     pragma Inline (Set_Has_Size_Clause);
     pragma Inline (Set_Has_Small_Clause);
     pragma Inline (Set_Has_Specified_Layout);
+    pragma Inline (Set_Has_Specified_Stream_Input);
+    pragma Inline (Set_Has_Specified_Stream_Output);
+    pragma Inline (Set_Has_Specified_Stream_Read);
+    pragma Inline (Set_Has_Specified_Stream_Write);
     pragma Inline (Set_Has_Storage_Size_Clause);
     pragma Inline (Set_Has_Subprogram_Descriptor);
     pragma Inline (Set_Has_Task);
*************** package Einfo is
*** 6506,6511 ****
--- 6727,6733 ----
     pragma Inline (Set_Interface_Name);
     pragma Inline (Set_Is_AST_Entry);
     pragma Inline (Set_Is_Abstract);
+    pragma Inline (Set_Is_Local_Anonymous_Access);
     pragma Inline (Set_Is_Access_Constant);
     pragma Inline (Set_Is_Ada_2005);
     pragma Inline (Set_Is_Aliased);
*************** package Einfo is
*** 6543,6548 ****
--- 6765,6771 ----
     pragma Inline (Set_Is_Immediately_Visible);
     pragma Inline (Set_Is_Imported);
     pragma Inline (Set_Is_Inlined);
+    pragma Inline (Set_Is_Interface);
     pragma Inline (Set_Is_Instantiated);
     pragma Inline (Set_Is_Internal);
     pragma Inline (Set_Is_Interrupt_Handler);
*************** package Einfo is
*** 6551,6556 ****
--- 6774,6780 ----
     pragma Inline (Set_Is_Known_Non_Null);
     pragma Inline (Set_Is_Known_Valid);
     pragma Inline (Set_Is_Limited_Composite);
+    pragma Inline (Set_Is_Limited_Interface);
     pragma Inline (Set_Is_Limited_Record);
     pragma Inline (Set_Is_Machine_Code_Subprogram);
     pragma Inline (Set_Is_Non_Static_Subtype);
*************** package Einfo is
*** 6563,6579 ****
--- 6787,6809 ----
     pragma Inline (Set_Is_Packed_Array_Type);
     pragma Inline (Set_Is_Potentially_Use_Visible);
     pragma Inline (Set_Is_Preelaborated);
+    pragma Inline (Set_Is_Primitive_Wrapper);
+ 
     pragma Inline (Set_Is_Private_Composite);
     pragma Inline (Set_Is_Private_Descendant);
+    pragma Inline (Set_Is_Protected_Interface);
     pragma Inline (Set_Is_Public);
     pragma Inline (Set_Is_Pure);
+    pragma Inline (Set_Is_Pure_Unit_Access_Type);
     pragma Inline (Set_Is_Remote_Call_Interface);
     pragma Inline (Set_Is_Remote_Types);
     pragma Inline (Set_Is_Renaming_Of_Object);
     pragma Inline (Set_Is_Shared_Passive);
     pragma Inline (Set_Is_Statically_Allocated);
+    pragma Inline (Set_Is_Synchronized_Interface);
     pragma Inline (Set_Is_Tag);
     pragma Inline (Set_Is_Tagged_Type);
+    pragma Inline (Set_Is_Task_Interface);
     pragma Inline (Set_Is_Thread_Body);
     pragma Inline (Set_Is_True_Constant);
     pragma Inline (Set_Is_Unchecked_Union);
*************** package Einfo is
*** 6613,6618 ****
--- 6843,6850 ----
     pragma Inline (Set_Original_Access_Type);
     pragma Inline (Set_Original_Array_Type);
     pragma Inline (Set_Original_Record_Component);
+    pragma Inline (Set_Overridden_Operation);
+    pragma Inline (Set_Package_Instantiation);
     pragma Inline (Set_Packed_Array_Type);
     pragma Inline (Set_Parent_Subtype);
     pragma Inline (Set_Primitive_Operations);
*************** package Einfo is
*** 6657,6668 ****
--- 6889,6903 ----
     pragma Inline (Set_Suppress_Elaboration_Warnings);
     pragma Inline (Set_Suppress_Init_Proc);
     pragma Inline (Set_Suppress_Style_Checks);
+    pragma Inline (Set_Task_Body_Procedure);
     pragma Inline (Set_Treat_As_Volatile);
     pragma Inline (Set_Underlying_Full_View);
     pragma Inline (Set_Unset_Reference);
     pragma Inline (Set_Uses_Sec_Stack);
     pragma Inline (Set_Vax_Float);
     pragma Inline (Set_Warnings_Off);
+    pragma Inline (Set_Was_Hidden);
+    pragma Inline (Set_Wrapped_Entity);
  
     --  END XEINFO INLINES
  
*************** package Einfo is
*** 6673,6679 ****
     --  things here which are small, but not of the canonical attribute
     --  access/set format that can be handled by xeinfo.
  
!    pragma Inline (Is_Package);
     pragma Inline (Is_Wrapper_Package);
     pragma Inline (Known_RM_Size);
     pragma Inline (Known_Static_Component_Bit_Offset);
--- 6908,6914 ----
     --  things here which are small, but not of the canonical attribute
     --  access/set format that can be handled by xeinfo.
  
!    pragma Inline (Is_Package_Or_Generic_Package);
     pragma Inline (Is_Wrapper_Package);
     pragma Inline (Known_RM_Size);
     pragma Inline (Known_Static_Component_Bit_Offset);
diff -Nrcpad gcc-4.0.2/gcc/ada/elists.adb gcc-4.1.0/gcc/ada/elists.adb
*** gcc-4.0.2/gcc/ada/elists.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/elists.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/elists.ads gcc-4.1.0/gcc/ada/elists.ads
*** gcc-4.0.2/gcc/ada/elists.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/elists.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Elists is
*** 122,131 ****
     --  that contains no items.
  
     procedure Append_Elmt (Node : Node_Id; To : Elist_Id);
!    --  Appends Node at the end of To, allocating a new element.
  
     procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id);
!    --  Appends Node at the beginning of To, allocating a new element.
  
     procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id);
     --  Add a new element (Node) right after the pre-existing element Elmt
--- 122,131 ----
     --  that contains no items.
  
     procedure Append_Elmt (Node : Node_Id; To : Elist_Id);
!    --  Appends Node at the end of To, allocating a new element
  
     procedure Prepend_Elmt (Node : Node_Id; To : Elist_Id);
!    --  Appends Node at the beginning of To, allocating a new element
  
     procedure Insert_Elmt_After (Node : Node_Id; Elmt : Elmt_Id);
     --  Add a new element (Node) right after the pre-existing element Elmt
diff -Nrcpad gcc-4.0.2/gcc/ada/elists.h gcc-4.1.0/gcc/ada/elists.h
*** gcc-4.0.2/gcc/ada/elists.h	Fri Oct 24 13:02:42 2003
--- gcc-4.1.0/gcc/ada/elists.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/err_vars.ads gcc-4.1.0/gcc/ada/err_vars.ads
*** gcc-4.0.2/gcc/ada/err_vars.ads	Tue Oct 21 13:41:58 2003
--- gcc-4.1.0/gcc/ada/err_vars.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Err_Vars is
*** 103,108 ****
--- 103,112 ----
     --  note get reset by any Error_Msg call, so the caller is responsible
     --  for resetting it.
  
+    Error_Msg_Warn : Boolean;
+    --  Used if current message contains a < insertion character to indicate
+    --  if the current message is a warning message.
+ 
     Warn_On_Instance : Boolean := False;
     --  Normally if a warning is generated in a generic template from the
     --  analysis of the template, then the warning really belongs in the
diff -Nrcpad gcc-4.0.2/gcc/ada/errno.c gcc-4.1.0/gcc/ada/errno.c
*** gcc-4.0.2/gcc/ada/errno.c	Mon Feb  9 10:44:12 2004
--- gcc-4.1.0/gcc/ada/errno.c	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  /****************************************************************************
   *                                                                          *
!  *                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               *
   *                                                                          *
   *                                E R R N O                                 *
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *           Copyright (C) 1992-2004 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- *
--- 1,12 ----
  /****************************************************************************
   *                                                                          *
!  *                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 *
   *                                                                          *
   *                                E R R N O                                 *
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *           Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/errout.adb gcc-4.1.0/gcc/ada/errout.adb
*** gcc-4.0.2/gcc/ada/errout.adb	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/errout.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Sinfo;    use Sinfo;
*** 49,55 ****
  with Snames;   use Snames;
  with Stand;    use Stand;
  with Style;
- with Uintp;    use Uintp;
  with Uname;    use Uname;
  
  with Unchecked_Conversion;
--- 49,54 ----
*************** package body Errout is
*** 322,335 ****
           return;
        end if;
  
!       --  The idea at this stage is that we have two kinds of messages.
  
!       --  First, we have those that are to be placed as requested at
!       --  Flag_Location. This includes messages that have nothing to
!       --  do with generics, and also messages placed on generic templates
!       --  that reflect an error in the template itself. For such messages
!       --  we simply call Error_Msg_Internal to place the message in the
!       --  requested location.
  
        if Instantiation (Sindex) = No_Location then
           Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False);
--- 321,333 ----
           return;
        end if;
  
!       --  The idea at this stage is that we have two kinds of messages
  
!       --  First, we have those messages that are to be placed as requested at
!       --  Flag_Location. This includes messages that have nothing to do with
!       --  generics, and also messages placed on generic templates that reflect
!       --  an error in the template itself. For such messages we simply call
!       --  Error_Msg_Internal to place the message in the requested location.
  
        if Instantiation (Sindex) = No_Location then
           Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False);
*************** package body Errout is
*** 493,498 ****
--- 491,499 ----
        --  since there may be white space inside the literal and we don't want
        --  to stop on that white space.
  
+       --  Note: since this is an error recovery issue anyway, it is not worth
+       --  worrying about special UTF_32 line terminator characters here.
+ 
        if Prev_Token = Tok_String_Literal then
           loop
              S1 := S1 + 1;
*************** package body Errout is
*** 512,518 ****
  
        --  Otherwise we search forward for the end of the current token, marked
        --  by a line terminator, white space, a comment symbol or if we bump
!       --  into the following token (i.e. the current token)
  
        else
           while Source (S1) not in Line_Terminator
--- 513,522 ----
  
        --  Otherwise we search forward for the end of the current token, marked
        --  by a line terminator, white space, a comment symbol or if we bump
!       --  into the following token (i.e. the current token).
! 
!       --  Again, it is not worth worrying about UTF_32 special line terminator
!       --  characters in this context, since this is only for error recovery.
  
        else
           while Source (S1) not in Line_Terminator
*************** package body Errout is
*** 528,534 ****
        --  S1 is now set to the location for the flag
  
        Error_Msg (Msg, S1);
- 
     end Error_Msg_AP;
  
     ------------------
--- 532,537 ----
*************** package body Errout is
*** 577,583 ****
        S : String (1 .. Feature'Length + 1 + CCRT'Length);
        L : Natural;
  
- 
     begin
        S (1) := '|';
        S (2 .. Feature'Length + 1) := Feature;
--- 580,585 ----
*************** package body Errout is
*** 602,608 ****
  
     procedure Error_Msg_F (Msg : String; N : Node_Id) is
     begin
!       Error_Msg_NEL (Msg, N, N, First_Sloc (N));
     end Error_Msg_F;
  
     ------------------
--- 604,610 ----
  
     procedure Error_Msg_F (Msg : String; N : Node_Id) is
     begin
!       Error_Msg_NEL (Msg, N, N, Sloc (First_Node (N)));
     end Error_Msg_F;
  
     ------------------
*************** package body Errout is
*** 1029,1035 ****
        N     : Node_Or_Entity_Id)
     is
     begin
!       if Eflag and then In_Extended_Main_Source_Unit (N) then
           Error_Msg_NEL (Msg, N, N, Sloc (N));
        end if;
     end Error_Msg_NW;
--- 1031,1040 ----
        N     : Node_Or_Entity_Id)
     is
     begin
!       if Eflag
!         and then In_Extended_Main_Source_Unit (N)
!         and then Comes_From_Source (N)
!       then
           Error_Msg_NEL (Msg, N, N, Sloc (N));
        end if;
     end Error_Msg_NW;
*************** package body Errout is
*** 1117,1125 ****
        --  Brief Error mode
  
        if Brief_Output or (not Full_List and not Verbose_Mode) then
-          E := First_Error_Msg;
           Set_Standard_Error;
  
           while E /= No_Error_Msg loop
              if not Errors.Table (E).Deleted and then not Debug_Flag_KK then
                 if Full_Path_Name_For_Brief_Errors then
--- 1122,1130 ----
        --  Brief Error mode
  
        if Brief_Output or (not Full_List and not Verbose_Mode) then
           Set_Standard_Error;
  
+          E := First_Error_Msg;
           while E /= No_Error_Msg loop
              if not Errors.Table (E).Deleted and then not Debug_Flag_KK then
                 if Full_Path_Name_For_Brief_Errors then
*************** package body Errout is
*** 1606,1612 ****
     procedure Remove_Warning_Messages (N : Node_Id) is
  
        function Check_For_Warning (N : Node_Id) return Traverse_Result;
!       --  This function checks one node for a possible warning message.
  
        function Check_All_Warnings is new
          Traverse_Func (Check_For_Warning);
--- 1611,1617 ----
     procedure Remove_Warning_Messages (N : Node_Id) is
  
        function Check_For_Warning (N : Node_Id) return Traverse_Result;
!       --  This function checks one node for a possible warning message
  
        function Check_All_Warnings is new
          Traverse_Func (Check_For_Warning);
*************** package body Errout is
*** 1746,1752 ****
        --  Casing required for result. Default value of Mixed_Case is used if
        --  for some reason we cannot find the right file name in the table.
  
- 
     begin
        --  Get length of file name
  
--- 1751,1756 ----
*************** package body Errout is
*** 2234,2240 ****
              when '>' =>
                 Set_Msg_Insertion_Run_Time_Name;
  
- 
              when '^' =>
                 Set_Msg_Insertion_Uint;
  
--- 2238,2243 ----
*************** package body Errout is
*** 2248,2253 ****
--- 2251,2259 ----
              when '?' =>
                 null; -- already dealt with
  
+             when '<' =>
+                null; -- already dealt with
+ 
              when '|' =>
                 null; -- already dealt with
  
diff -Nrcpad gcc-4.0.2/gcc/ada/errout.ads gcc-4.1.0/gcc/ada/errout.ads
*** gcc-4.0.2/gcc/ada/errout.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/errout.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Errout is
*** 243,248 ****
--- 243,254 ----
     --      phase anyway. Messages starting with (style) are also treated as
     --      warning messages.
  
+    --    Insertion character < (Less Than: conditional warning message)
+    --      The character < appearing anywhere in a message is used for a
+    --      conditional error message. If Error_Msg_Warn is True, then the
+    --      effect is the same as ? described above. If Error_Msg_Warn is
+    --      False, then there is no effect.
+ 
     --    Insertion character A-Z (Upper case letter: Ada reserved word)
     --      If two or more upper case letters appear in the message, they are
     --      taken as an Ada reserved word, and are converted to the default
*************** package Errout is
*** 327,333 ****
     --  passed to the error message routine for insertion sequences described
     --  above. The reason these are passed globally is that the insertion
     --  mechanism is essentially an untyped one in which the appropriate
!    --  variables are set dependingon the specific insertion characters used.
  
     Error_Msg_Col : Column_Number renames Err_Vars.Error_Msg_Col;
     --  Column for @ insertion character in message
--- 333,342 ----
     --  passed to the error message routine for insertion sequences described
     --  above. The reason these are passed globally is that the insertion
     --  mechanism is essentially an untyped one in which the appropriate
!    --  variables are set depending on the specific insertion characters used.
! 
!    --  Note that is mandatory that the caller ensure that global variables
!    --  are set before the Error_Msg call, otherwise the result is undefined.
  
     Error_Msg_Col : Column_Number renames Err_Vars.Error_Msg_Col;
     --  Column for @ insertion character in message
*************** package Errout is
*** 358,363 ****
--- 367,376 ----
     --  note get reset by any Error_Msg call, so the caller is responsible
     --  for resetting it.
  
+    Error_Msg_Warn : Boolean renames Err_Vars.Error_Msg_Warn;
+    --  Used if current message contains a < insertion character to indicate
+    --  if the current message is a warning message.
+ 
     -----------------------------------------------------
     -- Format of Messages and Manual Quotation Control --
     -----------------------------------------------------
*************** package Errout is
*** 440,446 ****
  
     function Get_Location (E : Error_Msg_Id) return Source_Ptr
       renames Erroutc.Get_Location;
!    --  Returns the flag location of the error message with the given id E.
  
     ------------------------
     -- List Pragmas Table --
--- 453,459 ----
  
     function Get_Location (E : Error_Msg_Id) return Source_Ptr
       renames Erroutc.Get_Location;
!    --  Returns the flag location of the error message with the given id E
  
     ------------------------
     -- List Pragmas Table --
*************** package Errout is
*** 574,580 ****
     --  This routine is used for posting a message conditionally. The message
     --  is posted (with the same effect as Error_Msg_N (Msg, N) if and only
     --  if Eflag is True and if the node N is within the main extended source
!    --  unit. Typically this is a warning mode flag.
  
     procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
     --  The error message text of the message identified by Id is replaced by
--- 587,593 ----
     --  This routine is used for posting a message conditionally. The message
     --  is posted (with the same effect as Error_Msg_N (Msg, N) if and only
     --  if Eflag is True and if the node N is within the main extended source
!    --  unit and comes from source. Typically this is a warning mode flag.
  
     procedure Change_Error_Text (Error_Id : Error_Msg_Id; New_Msg : String);
     --  The error message text of the message identified by Id is replaced by
*************** package Errout is
*** 601,607 ****
     --  of its descendent nodes. No effect if no such warnings.
  
     procedure Remove_Warning_Messages (L : List_Id);
!    --  Remove warnings on all elements of a list.
  
     procedure Set_Ignore_Errors (To : Boolean);
     --  Following a call to this procedure with To=True, all error calls are
--- 614,620 ----
     --  of its descendent nodes. No effect if no such warnings.
  
     procedure Remove_Warning_Messages (L : List_Id);
!    --  Remove warnings on all elements of a list
  
     procedure Set_Ignore_Errors (To : Boolean);
     --  Following a call to this procedure with To=True, all error calls are
diff -Nrcpad gcc-4.0.2/gcc/ada/erroutc.adb gcc-4.1.0/gcc/ada/erroutc.adb
*** gcc-4.0.2/gcc/ada/erroutc.adb	Mon May 10 16:18:52 2004
--- gcc-4.1.0/gcc/ada/erroutc.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Sinput;   use Sinput;
*** 40,46 ****
  with Snames;   use Snames;
  with Targparm; use Targparm;
  with Table;
- with Types;    use Types;
  with Uintp;    use Uintp;
  
  package body Erroutc is
--- 40,45 ----
*************** package body Erroutc is
*** 983,988 ****
--- 982,992 ----
           then
              Is_Warning_Msg := True;
  
+          elsif Msg (J) = '<'
+            and then (J = Msg'First or else Msg (J - 1) /= ''')
+          then
+             Is_Warning_Msg := Error_Msg_Warn;
+ 
           elsif Msg (J) = '|'
             and then (J = Msg'First or else Msg (J - 1) /= ''')
           then
diff -Nrcpad gcc-4.0.2/gcc/ada/erroutc.ads gcc-4.1.0/gcc/ada/erroutc.ads
*** gcc-4.0.2/gcc/ada/erroutc.ads	Mon May 10 16:18:52 2004
--- gcc-4.1.0/gcc/ada/erroutc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  reporting packages, including Errout and Prj.Err.
  
  with Table;
! with Types;  use Types;
  
  package Erroutc is
  
--- 28,34 ----
  --  reporting packages, including Errout and Prj.Err.
  
  with Table;
! with Types; use Types;
  
  package Erroutc is
  
*************** package Erroutc is
*** 122,128 ****
     --  Error_Msg routines.
  
     function Get_Location (E : Error_Msg_Id) return Source_Ptr;
!    --  Returns the flag location of the error message with the given id E.
  
     -----------------------------------
     -- Error Message Data Structures --
--- 122,128 ----
     --  Error_Msg routines.
  
     function Get_Location (E : Error_Msg_Id) return Source_Ptr;
!    --  Returns the flag location of the error message with the given id E
  
     -----------------------------------
     -- Error Message Data Structures --
*************** package Erroutc is
*** 332,338 ****
     --  Handle name insertion (% insertion character)
  
     procedure Set_Msg_Insertion_Reserved_Name;
!    --  Handle insertion of reserved word name (* insertion character).
  
     procedure Set_Msg_Insertion_Reserved_Word
       (Text : String;
--- 332,338 ----
     --  Handle name insertion (% insertion character)
  
     procedure Set_Msg_Insertion_Reserved_Name;
!    --  Handle insertion of reserved word name (* insertion character)
  
     procedure Set_Msg_Insertion_Reserved_Word
       (Text : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/errutil.adb gcc-4.1.0/gcc/ada/errutil.adb
*** gcc-4.0.2/gcc/ada/errutil.adb	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/errutil.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1991-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1991-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Errutil is
*** 44,50 ****
     -----------------------
  
     procedure Error_Msg_AP (Msg : String);
!    --  Output a message just after the previous token.
  
     procedure Output_Source_Line
       (L           : Physical_Line_Number;
--- 44,50 ----
     -----------------------
  
     procedure Error_Msg_AP (Msg : String);
!    --  Output a message just after the previous token
  
     procedure Output_Source_Line
       (L           : Physical_Line_Number;
*************** package body Errutil is
*** 100,105 ****
--- 100,109 ----
        --  since there may be white space inside the literal and we don't want
        --  to stop on that white space.
  
+       --  Note that it is not worth worrying about special UTF_32 line
+       --  terminator characters in this context, since this is only about
+       --  error recovery anyway.
+ 
        if Prev_Token = Tok_String_Literal then
           loop
              S1 := S1 + 1;
*************** package body Errutil is
*** 121,126 ****
--- 125,134 ----
        --  by a line terminator, white space, a comment symbol or if we bump
        --  into the following token (i.e. the current token)
  
+       --  Note that it is not worth worrying about special UTF_32 line
+       --  terminator characters in this context, since this is only about
+       --  error recovery anyway.
+ 
        else
           while Source (S1) not in Line_Terminator
             and then Source (S1) /= ' '
*************** package body Errutil is
*** 176,187 ****
           return;
        end if;
  
!       --  Return without doing anything if message is killed and this
!       --  is not the first error message. The philosophy is that if we
!       --  get a weird error message and we already have had a message,
!       --  then we hope the weird message is a junk cascaded message
  
!       --  Immediate return if warning message and warnings are suppressed
        --  Note that style messages are not warnings for this purpose.
  
        if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
--- 184,195 ----
           return;
        end if;
  
!       --  Return without doing anything if message is killed and this is not
!       --  the first error message. The philosophy is that if we get a weird
!       --  error message and we already have had a message, then we hope the
!       --  weird message is a junk cascaded message
  
!       --  Immediate return if warning message and warnings are suppressed.
        --  Note that style messages are not warnings for this purpose.
  
        if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
*************** package body Errutil is
*** 238,257 ****
          and then Errors.Table (Prev_Msg).Sfile =
          Errors.Table (Cur_Msg).Sfile
        then
!          --  Don't delete unconditional messages and at this stage,
!          --  don't delete continuation lines (we attempted to delete
!          --  those earlier if the parent message was deleted.
  
           if not Errors.Table (Cur_Msg).Uncond
             and then not Continuation
           then
  
!             --  Don't delete if prev msg is warning and new msg is
!             --  an error. This is because we don't want a real error
!             --  masked by a warning. In all other cases (that is parse
!             --  errors for the same line that are not unconditional)
!             --  we do delete the message. This helps to avoid
!             --  junk extra messages from cascaded parsing errors
  
              if not (Errors.Table (Prev_Msg).Warn
                        or
--- 246,264 ----
          and then Errors.Table (Prev_Msg).Sfile =
          Errors.Table (Cur_Msg).Sfile
        then
!          --  Don't delete unconditional messages and at this stage, don't
!          --  delete continuation lines (we attempted to delete those earlier
!          --  if the parent message was deleted.
  
           if not Errors.Table (Cur_Msg).Uncond
             and then not Continuation
           then
  
!             --  Don't delete if prev msg is warning and new msg is an error.
!             --  This is because we don't want a real error masked by a warning.
!             --  In all other cases (that is parse errors for the same line that
!             --  are not unconditional) we do delete the message. This helps to
!             --  avoid junk extra messages from cascaded parsing errors
  
              if not (Errors.Table (Prev_Msg).Warn
                        or
*************** package body Errutil is
*** 261,268 ****
                        or
                      Errors.Table (Cur_Msg).Style)
              then
!                --  All tests passed, delete the message by simply
!                --  returning without any further processing.
  
                 if not Continuation then
                    Last_Killed := True;
--- 268,275 ----
                        or
                      Errors.Table (Cur_Msg).Style)
              then
!                --  All tests passed, delete the message by simply returning
!                --  without any further processing.
  
                 if not Continuation then
                    Last_Killed := True;
*************** package body Errutil is
*** 430,436 ****
  
                 Write_Eol;
              end if;
- 
           end loop;
  
           --  Then output errors, if any, for subsidiary units
--- 437,442 ----
*************** package body Errutil is
*** 556,562 ****
           Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
           Warnings_Detected := 0;
        end if;
- 
     end Finalize;
  
     ----------------
--- 562,567 ----
*************** package body Errutil is
*** 577,583 ****
        --  an initial dummy entry covering all possible source locations.
  
        Warnings.Init;
- 
     end Initialize;
  
     ------------------------
--- 582,587 ----
*************** package body Errutil is
*** 674,679 ****
--- 678,684 ----
              Set_Msg_Insertion_Name;
  
           elsif C = '$' then
+ 
              --  '$' is ignored
  
              null;
*************** package body Errutil is
*** 682,687 ****
--- 687,693 ----
              Set_Msg_Insertion_File_Name;
  
           elsif C = '}' then
+ 
              --  '}' is ignored
  
              null;
*************** package body Errutil is
*** 690,695 ****
--- 696,702 ----
              Set_Msg_Insertion_Reserved_Name;
  
           elsif C = '&' then
+ 
              --  '&' is ignored
  
              null;
*************** package body Errutil is
*** 716,721 ****
--- 723,731 ----
           elsif C = '?' then
              null;
  
+          elsif C = '<' then
+             null;
+ 
           elsif C = '|' then
              null;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/errutil.ads gcc-4.1.0/gcc/ada/errutil.ads
*** gcc-4.0.2/gcc/ada/errutil.ads	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/errutil.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,33 ****
  --  This package contains routines to output error messages and the
  --  corresponding instantiation of Styleg, suitable to instantiate Scng.
  
! --  It is not dependent on the GNAT tree packages (Atree, Sinfo, ...).
  
  --  It uses the same global variables as Errout, located in package
  --  Err_Vars. Like Errout, it also uses the common variables and routines
--- 27,33 ----
  --  This package contains routines to output error messages and the
  --  corresponding instantiation of Styleg, suitable to instantiate Scng.
  
! --  It is not dependent on the GNAT tree packages (Atree, Sinfo, ...)
  
  --  It uses the same global variables as Errout, located in package
  --  Err_Vars. Like Errout, it also uses the common variables and routines
*************** package Errutil is
*** 222,231 ****
     --  preprocessor).
  
     procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
!    --  Output a message at specified location.
  
     procedure Error_Msg_S (Msg : String);
!    --  Output a message at current scan pointer location.
  
     procedure Error_Msg_SC (Msg : String);
     --  Output a message at the start of the current token, unless we are at
--- 222,231 ----
     --  preprocessor).
  
     procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
!    --  Output a message at specified location
  
     procedure Error_Msg_S (Msg : String);
!    --  Output a message at current scan pointer location
  
     procedure Error_Msg_SC (Msg : String);
     --  Output a message at the start of the current token, unless we are at
*************** package Errutil is
*** 233,239 ****
     --  last real token in the file.
  
     procedure Error_Msg_SP (Msg : String);
!    --  Output a message at the start of the previous token.
  
     procedure Set_Ignore_Errors (To : Boolean);
     --  Indicate, when To = True, that all reported errors should
--- 233,239 ----
     --  last real token in the file.
  
     procedure Error_Msg_SP (Msg : String);
!    --  Output a message at the start of the previous token
  
     procedure Set_Ignore_Errors (To : Boolean);
     --  Indicate, when To = True, that all reported errors should
diff -Nrcpad gcc-4.0.2/gcc/ada/eval_fat.adb gcc-4.1.0/gcc/ada/eval_fat.adb
*** gcc-4.0.2/gcc/ada/eval_fat.adb	Mon Jan  3 15:36:06 2005
--- gcc-4.1.0/gcc/ada/eval_fat.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Eval_Fat is
*** 419,425 ****
              Exponent := Exponent + 1;
           end if;
  
!          --  Put back sign after applying the rounding.
  
           if UR_Is_Negative (X) then
              Fraction := -Fraction;
--- 419,425 ----
              Exponent := Exponent + 1;
           end if;
  
!          --  Put back sign after applying the rounding
  
           if UR_Is_Negative (X) then
              Fraction := -Fraction;
diff -Nrcpad gcc-4.0.2/gcc/ada/eval_fat.ads gcc-4.1.0/gcc/ada/eval_fat.ads
*** gcc-4.0.2/gcc/ada/eval_fat.ads	Mon Apr 19 15:19:57 2004
--- gcc-4.1.0/gcc/ada/eval_fat.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exit.c gcc-4.1.0/gcc/ada/exit.c
*** gcc-4.0.2/gcc/ada/exit.c	Tue Nov  4 12:51:45 2003
--- gcc-4.1.0/gcc/ada/exit.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_aggr.adb gcc-4.1.0/gcc/ada/exp_aggr.adb
*** gcc-4.0.2/gcc/ada/exp_aggr.adb	Thu Feb 10 13:53:58 2005
--- gcc-4.1.0/gcc/ada/exp_aggr.adb	Tue Nov 15 13:56:39 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Aggr is
*** 158,163 ****
--- 158,170 ----
     -- Local Subprograms for Array Aggregate Expansion --
     -----------------------------------------------------
  
+    function Aggr_Size_OK (Typ : Entity_Id) return Boolean;
+    --  Very large static aggregates present problems to the back-end, and
+    --  are transformed into assignments and loops. This function verifies
+    --  that the total number of components of an aggregate is acceptable
+    --  for transformation into a purely positional static form. It is called
+    --  prior to calling Flatten.
+ 
     procedure Convert_Array_Aggr_In_Allocator
       (Decl   : Node_Id;
        Aggr   : Node_Id;
*************** package body Exp_Aggr is
*** 269,274 ****
--- 276,427 ----
     --  the assignment can be done in place even if bounds are not static,
     --  by converting it into a loop over the discrete range of the slice.
  
+    ------------------
+    -- Aggr_Size_OK --
+    ------------------
+ 
+    function Aggr_Size_OK (Typ : Entity_Id) return Boolean is
+       Lo   : Node_Id;
+       Hi   : Node_Id;
+       Indx : Node_Id;
+       Siz  : Int;
+       Lov  : Uint;
+       Hiv  : Uint;
+ 
+       --  The following constant determines the maximum size of an
+       --  aggregate produced by converting named to positional
+       --  notation (e.g. from others clauses). This avoids running
+       --  away with attempts to convert huge aggregates, which hit
+       --  memory limits in the backend.
+ 
+       --  The normal limit is 5000, but we increase this limit to
+       --  2**24 (about 16 million) if Restrictions (No_Elaboration_Code)
+       --  or Restrictions (No_Implicit_Loops) is specified, since in
+       --  either case, we are at risk of declaring the program illegal
+       --  because of this limit.
+ 
+       Max_Aggr_Size : constant Nat :=
+                         5000 + (2 ** 24 - 5000) *
+                           Boolean'Pos
+                             (Restriction_Active (No_Elaboration_Code)
+                                or else
+                              Restriction_Active (No_Implicit_Loops));
+ 
+       function Component_Count (T : Entity_Id) return Int;
+       --  The limit is applied to the total number of components that the
+       --  aggregate will have, which is the number of static expressions
+       --  that will appear in the flattened array. This requires a recursive
+       --  computation of the the number of scalar components of the structure.
+ 
+       ---------------------
+       -- Component_Count --
+       ---------------------
+ 
+       function Component_Count (T : Entity_Id) return Int is
+          Res  : Int := 0;
+          Comp : Entity_Id;
+ 
+       begin
+          if Is_Scalar_Type (T) then
+             return 1;
+ 
+          elsif Is_Record_Type (T) then
+             Comp := First_Component (T);
+             while Present (Comp) loop
+                Res := Res + Component_Count (Etype (Comp));
+                Next_Component (Comp);
+             end loop;
+ 
+             return Res;
+ 
+          elsif Is_Array_Type (T) then
+             declare
+                Lo : constant Node_Id :=
+                       Type_Low_Bound (Etype (First_Index (T)));
+                Hi : constant Node_Id :=
+                       Type_High_Bound (Etype (First_Index (T)));
+ 
+                Siz  : constant Int := Component_Count (Component_Type (T));
+ 
+             begin
+                if not Compile_Time_Known_Value (Lo)
+                  or else not Compile_Time_Known_Value (Hi)
+                then
+                   return 0;
+                else
+                   return
+                     Siz * UI_To_Int (Expr_Value (Hi) - Expr_Value (Lo) + 1);
+                end if;
+             end;
+ 
+          else
+             --  Can only be a null for an access type
+ 
+             return 1;
+          end if;
+       end Component_Count;
+ 
+    --  Start of processing for Aggr_Size_OK
+ 
+    begin
+       Siz  := Component_Count (Component_Type (Typ));
+       Indx := First_Index (Typ);
+ 
+       while Present (Indx) loop
+          Lo  := Type_Low_Bound (Etype (Indx));
+          Hi  := Type_High_Bound (Etype (Indx));
+ 
+          --  Bounds need to be known at compile time
+ 
+          if not Compile_Time_Known_Value (Lo)
+            or else not Compile_Time_Known_Value (Hi)
+          then
+             return False;
+          end if;
+ 
+          Lov := Expr_Value (Lo);
+          Hiv := Expr_Value (Hi);
+ 
+          --  A flat array is always safe
+ 
+          if Hiv < Lov then
+             return True;
+          end if;
+ 
+          declare
+             Rng : constant Uint := Hiv - Lov + 1;
+ 
+          begin
+             --  Check if size is too large
+ 
+             if not UI_Is_In_Int_Range (Rng) then
+                return False;
+             end if;
+ 
+             Siz := Siz * UI_To_Int (Rng);
+          end;
+ 
+          if Siz <= 0
+            or else Siz > Max_Aggr_Size
+          then
+             return False;
+          end if;
+ 
+          --  Bounds must be in integer range, for later array construction
+ 
+          if not UI_Is_In_Int_Range (Lov)
+              or else
+             not UI_Is_In_Int_Range (Hiv)
+          then
+             return False;
+          end if;
+ 
+          Next_Index (Indx);
+       end loop;
+ 
+       return True;
+    end Aggr_Size_OK;
+ 
     ---------------------------------
     -- Backend_Processing_Possible --
     ---------------------------------
*************** package body Exp_Aggr is
*** 892,897 ****
--- 1045,1070 ----
  
              if Present (Comp_Type) and then Controlled_Type (Comp_Type) then
                 Set_No_Ctrl_Actions (A);
+ 
+                --  If this is an aggregate for an array of arrays, each
+                --  subaggregate will be expanded as well, and even with
+                --  No_Ctrl_Actions the assignments of inner components will
+                --  require attachment in their assignments to temporaries.
+                --  These temporaries must be finalized for each subaggregate,
+                --  to prevent multiple attachments of the same temporary
+                --  location to same finalization chain (and consequently
+                --  circular lists). To ensure that finalization takes place
+                --  for each subaggregate we wrap the assignment in a block.
+ 
+                if Is_Array_Type (Comp_Type)
+                  and then Nkind (Expr) = N_Aggregate
+                then
+                   A :=
+                     Make_Block_Statement (Loc,
+                       Handled_Statement_Sequence =>
+                         Make_Handled_Sequence_Of_Statements (Loc,
+                            Statements => New_List (A)));
+                end if;
              end if;
  
              Append_To (L, A);
*************** package body Exp_Aggr is
*** 910,921 ****
                       Make_Selected_Component (Loc,
                         Prefix =>  New_Copy_Tree (Indexed_Comp),
                         Selector_Name =>
!                          New_Reference_To (Tag_Component (Comp_Type), Loc)),
  
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
!                        New_Reference_To (
!                          Access_Disp_Table (Comp_Type), Loc)));
  
                 Append_To (L, A);
              end if;
--- 1083,1096 ----
                       Make_Selected_Component (Loc,
                         Prefix =>  New_Copy_Tree (Indexed_Comp),
                         Selector_Name =>
!                          New_Reference_To
!                            (First_Tag_Component (Comp_Type), Loc)),
  
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
!                        New_Reference_To
!                          (Node (First_Elmt (Access_Disp_Table (Comp_Type))),
!                           Loc)));
  
                 Append_To (L, A);
              end if;
*************** package body Exp_Aggr is
*** 1419,1425 ****
     is
        Loc     : constant Source_Ptr := Sloc (N);
        L       : constant List_Id    := New_List;
-       Start_L : constant List_Id    := New_List;
        N_Typ   : constant Entity_Id  := Etype (N);
  
        Comp      : Node_Id;
--- 1594,1599 ----
*************** package body Exp_Aggr is
*** 1445,1450 ****
--- 1619,1625 ----
  
        Init_Typ : Entity_Id := Empty;
        Attach   : Node_Id;
+       Ctrl_Stuff_Done : Boolean := False;
  
        function Get_Constraint_Association (T : Entity_Id) return Node_Id;
        --  Returns the first discriminant association in the constraint
*************** package body Exp_Aggr is
*** 1472,1477 ****
--- 1647,1656 ----
        --  it to finalization list F. Init_Pr conditions the call to the
        --  init proc since it may already be done due to ancestor initialization
  
+       procedure Gen_Ctrl_Actions_For_Aggr;
+       --  Deal with the various controlled type data structure
+       --  initializations
+ 
        ---------------------------------
        -- Ancestor_Discriminant_Value --
        ---------------------------------
*************** package body Exp_Aggr is
*** 1666,1671 ****
--- 1845,1851 ----
        is
           L   : constant List_Id := New_List;
           Ref : Node_Id;
+          RC  : RE_Id;
  
        begin
           --  Generate:
*************** package body Exp_Aggr is
*** 1699,1746 ****
                and then Present (Etype (Prefix (Expression (Target))))
                and then Is_Limited_Type (Etype (Prefix (Expression (Target)))))
           then
!             if Init_Pr then
!                Append_List_To (L,
!                  Build_Initialization_Call (Loc,
!                    Id_Ref       => Ref,
!                    Typ          => RTE (RE_Limited_Record_Controller),
!                    In_Init_Proc => Within_Init_Proc));
!             end if;
! 
!             Append_To (L,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To
!                          (Find_Prim_Op (RTE (RE_Limited_Record_Controller),
!                     Name_Initialize), Loc),
!                 Parameter_Associations => New_List (New_Copy_Tree (Ref))));
! 
           else
!             if Init_Pr then
!                Append_List_To (L,
!                  Build_Initialization_Call (Loc,
!                    Id_Ref       => Ref,
!                    Typ          => RTE (RE_Record_Controller),
!                    In_Init_Proc => Within_Init_Proc));
!             end if;
! 
!             Append_To (L,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (Find_Prim_Op (RTE (RE_Record_Controller),
!                     Name_Initialize), Loc),
!                 Parameter_Associations => New_List (New_Copy_Tree (Ref))));
  
           end if;
  
           Append_To (L,
             Make_Attach_Call (
               Obj_Ref     => New_Copy_Tree (Ref),
               Flist_Ref   => F,
               With_Attach => Attach));
           return L;
        end Init_Controller;
  
     --  Start of processing for Build_Record_Aggr_Code
  
     begin
--- 1879,2111 ----
                and then Present (Etype (Prefix (Expression (Target))))
                and then Is_Limited_Type (Etype (Prefix (Expression (Target)))))
           then
!             RC := RE_Limited_Record_Controller;
           else
!             RC := RE_Record_Controller;
!          end if;
  
+          if Init_Pr then
+             Append_List_To (L,
+               Build_Initialization_Call (Loc,
+                 Id_Ref       => Ref,
+                 Typ          => RTE (RC),
+                 In_Init_Proc => Within_Init_Proc));
           end if;
  
           Append_To (L,
+            Make_Procedure_Call_Statement (Loc,
+              Name =>
+                New_Reference_To (
+                  Find_Prim_Op (RTE (RC), Name_Initialize), Loc),
+              Parameter_Associations =>
+                New_List (New_Copy_Tree (Ref))));
+ 
+          Append_To (L,
             Make_Attach_Call (
               Obj_Ref     => New_Copy_Tree (Ref),
               Flist_Ref   => F,
               With_Attach => Attach));
+ 
           return L;
        end Init_Controller;
  
+       -------------------------------
+       -- Gen_Ctrl_Actions_For_Aggr --
+       -------------------------------
+ 
+       procedure Gen_Ctrl_Actions_For_Aggr is
+       begin
+          if Present (Obj)
+           and then Finalize_Storage_Only (Typ)
+           and then (Is_Library_Level_Entity (Obj)
+             or else Entity (Constant_Value (RTE (RE_Garbage_Collected))) =
+                                                               Standard_True)
+          then
+             Attach := Make_Integer_Literal (Loc, 0);
+ 
+          elsif Nkind (Parent (N)) = N_Qualified_Expression
+            and then Nkind (Parent (Parent (N))) = N_Allocator
+          then
+             Attach := Make_Integer_Literal (Loc, 2);
+ 
+          else
+             Attach := Make_Integer_Literal (Loc, 1);
+          end if;
+ 
+          --  Determine the external finalization list. It is either the
+          --  finalization list of the outer-scope or the one coming from
+          --  an outer aggregate.  When the target is not a temporary, the
+          --  proper scope is the scope of the target rather than the
+          --  potentially transient current scope.
+ 
+          if Controlled_Type (Typ) then
+             if Present (Flist) then
+                External_Final_List := New_Copy_Tree (Flist);
+ 
+             elsif Is_Entity_Name (Target)
+               and then Present (Scope (Entity (Target)))
+             then
+                External_Final_List
+                  := Find_Final_List (Scope (Entity (Target)));
+ 
+             else
+                External_Final_List := Find_Final_List (Current_Scope);
+             end if;
+ 
+          else
+             External_Final_List := Empty;
+          end if;
+ 
+          --  Initialize and attach the outer object in the is_controlled case
+ 
+          if Is_Controlled (Typ) then
+             if Ancestor_Is_Subtype_Mark then
+                Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
+                Set_Assignment_OK (Ref);
+                Append_To (L,
+                  Make_Procedure_Call_Statement (Loc,
+                    Name =>
+                      New_Reference_To
+                        (Find_Prim_Op (Init_Typ, Name_Initialize), Loc),
+                    Parameter_Associations => New_List (New_Copy_Tree (Ref))));
+             end if;
+ 
+             if not Has_Controlled_Component (Typ) then
+                Ref := New_Copy_Tree (Target);
+                Set_Assignment_OK (Ref);
+                Append_To (L,
+                  Make_Attach_Call (
+                    Obj_Ref     => Ref,
+                    Flist_Ref   => New_Copy_Tree (External_Final_List),
+                    With_Attach => Attach));
+             end if;
+          end if;
+ 
+          --  In the Has_Controlled component case, all the intermediate
+          --  controllers must be initialized
+ 
+          if Has_Controlled_Component (Typ)
+            and not Is_Limited_Ancestor_Expansion
+          then
+             declare
+                Inner_Typ : Entity_Id;
+                Outer_Typ : Entity_Id;
+                At_Root   : Boolean;
+ 
+             begin
+ 
+                Outer_Typ := Base_Type (Typ);
+ 
+                --  Find outer type with a controller
+ 
+                while Outer_Typ /= Init_Typ
+                  and then not Has_New_Controlled_Component (Outer_Typ)
+                loop
+                   Outer_Typ := Etype (Outer_Typ);
+                end loop;
+ 
+                --  Attach it to the outer record controller to the
+                --  external final list
+ 
+                if Outer_Typ = Init_Typ then
+                   Append_List_To (L,
+                     Init_Controller (
+                       Target  => Target,
+                       Typ     => Outer_Typ,
+                       F       => External_Final_List,
+                       Attach  => Attach,
+                       Init_Pr => False));
+ 
+                   At_Root   := True;
+                   Inner_Typ := Init_Typ;
+ 
+                else
+                   Append_List_To (L,
+                     Init_Controller (
+                       Target  => Target,
+                       Typ     => Outer_Typ,
+                       F       => External_Final_List,
+                       Attach  => Attach,
+                       Init_Pr => True));
+ 
+                   Inner_Typ := Etype (Outer_Typ);
+                   At_Root   :=
+                     not Is_Tagged_Type (Typ) or else Inner_Typ = Outer_Typ;
+                end if;
+ 
+                --  The outer object has to be attached as well
+ 
+                if Is_Controlled (Typ) then
+                   Ref := New_Copy_Tree (Target);
+                   Set_Assignment_OK (Ref);
+                   Append_To (L,
+                     Make_Attach_Call (
+                       Obj_Ref     => Ref,
+                       Flist_Ref   => New_Copy_Tree (External_Final_List),
+                       With_Attach => New_Copy_Tree (Attach)));
+                end if;
+ 
+                --  Initialize the internal controllers for tagged types with
+                --  more than one controller.
+ 
+                while not At_Root and then Inner_Typ /= Init_Typ loop
+                   if Has_New_Controlled_Component (Inner_Typ) then
+                      F :=
+                        Make_Selected_Component (Loc,
+                          Prefix =>
+                            Convert_To (Outer_Typ, New_Copy_Tree (Target)),
+                          Selector_Name =>
+                            Make_Identifier (Loc, Name_uController));
+                      F :=
+                        Make_Selected_Component (Loc,
+                          Prefix => F,
+                          Selector_Name => Make_Identifier (Loc, Name_F));
+ 
+                      Append_List_To (L,
+                        Init_Controller (
+                          Target  => Target,
+                          Typ     => Inner_Typ,
+                          F       => F,
+                          Attach  => Make_Integer_Literal (Loc, 1),
+                          Init_Pr => True));
+                      Outer_Typ := Inner_Typ;
+                   end if;
+ 
+                   --  Stop at the root
+ 
+                   At_Root := Inner_Typ = Etype (Inner_Typ);
+                   Inner_Typ := Etype (Inner_Typ);
+                end loop;
+ 
+                --  If not done yet attach the controller of the ancestor part
+ 
+                if Outer_Typ /= Init_Typ
+                  and then Inner_Typ = Init_Typ
+                  and then Has_Controlled_Component (Init_Typ)
+                then
+                   F :=
+                     Make_Selected_Component (Loc,
+                       Prefix => Convert_To (Outer_Typ, New_Copy_Tree (Target)),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Name_uController));
+                   F :=
+                     Make_Selected_Component (Loc,
+                       Prefix => F,
+                       Selector_Name => Make_Identifier (Loc, Name_F));
+ 
+                   Attach := Make_Integer_Literal (Loc, 1);
+                   Append_List_To (L,
+                     Init_Controller (
+                       Target  => Target,
+                       Typ     => Init_Typ,
+                       F       => F,
+                       Attach  => Attach,
+                       Init_Pr => Ancestor_Is_Expression));
+                end if;
+             end;
+          end if;
+       end Gen_Ctrl_Actions_For_Aggr;
+ 
     --  Start of processing for Build_Record_Aggr_Code
  
     begin
*************** package body Exp_Aggr is
*** 1750,1755 ****
--- 2115,2121 ----
        if Nkind (N) = N_Extension_Aggregate then
           declare
              A : constant Node_Id := Ancestor_Part (N);
+             Assign : List_Id;
  
           begin
              --  If the ancestor part is a subtype mark "T", we generate
*************** package body Exp_Aggr is
*** 1817,1830 ****
                 if Has_Default_Init_Comps (N)
                   or else Has_Task (Base_Type (Init_Typ))
                 then
!                   Append_List_To (Start_L,
                      Build_Initialization_Call (Loc,
                        Id_Ref       => Ref,
                        Typ          => Init_Typ,
                        In_Init_Proc => Within_Init_Proc,
                        With_Default_Init => True));
                 else
!                   Append_List_To (Start_L,
                      Build_Initialization_Call (Loc,
                        Id_Ref       => Ref,
                        Typ          => Init_Typ,
--- 2183,2196 ----
                 if Has_Default_Init_Comps (N)
                   or else Has_Task (Base_Type (Init_Typ))
                 then
!                   Append_List_To (L,
                      Build_Initialization_Call (Loc,
                        Id_Ref       => Ref,
                        Typ          => Init_Typ,
                        In_Init_Proc => Within_Init_Proc,
                        With_Default_Init => True));
                 else
!                   Append_List_To (L,
                      Build_Initialization_Call (Loc,
                        Id_Ref       => Ref,
                        Typ          => Init_Typ,
*************** package body Exp_Aggr is
*** 1843,1849 ****
              elsif Is_Limited_Type (Etype (A)) then
                 Ancestor_Is_Expression := True;
  
!                Append_List_To (Start_L,
                    Build_Record_Aggr_Code (
                      N                             => Expression (A),
                      Typ                           => Etype (Expression (A)),
--- 2209,2215 ----
              elsif Is_Limited_Type (Etype (A)) then
                 Ancestor_Is_Expression := True;
  
!                Append_List_To (L,
                    Build_Record_Aggr_Code (
                      N                             => Expression (A),
                      Typ                           => Etype (Expression (A)),
*************** package body Exp_Aggr is
*** 1859,1867 ****
                 Ancestor_Is_Expression := True;
                 Init_Typ := Etype (A);
  
!                --  Assign the tag before doing the assignment to make sure
!                --  that the dispatching call in the subsequent deep_adjust
!                --  works properly (unless Java_VM, where tags are implicit).
  
                 if not Java_VM then
                    Instr :=
--- 2225,2258 ----
                 Ancestor_Is_Expression := True;
                 Init_Typ := Etype (A);
  
!                --  If the ancestor part is an aggregate, force its full
!                --  expansion, which was delayed.
! 
!                if Nkind (A) = N_Qualified_Expression
!                  and then (Nkind (Expression (A)) = N_Aggregate
!                              or else
!                            Nkind (Expression (A)) = N_Extension_Aggregate)
!                then
!                   Set_Analyzed (A, False);
!                   Set_Analyzed (Expression (A), False);
!                end if;
! 
!                Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
!                Set_Assignment_OK (Ref);
! 
!                --  Make the assignment without usual controlled actions since
!                --  we only want the post adjust but not the pre finalize here
!                --  Add manual adjust when necessary
! 
!                Assign := New_List (
!                  Make_OK_Assignment_Statement (Loc,
!                    Name       => Ref,
!                    Expression => A));
!                Set_No_Ctrl_Actions (First (Assign));
! 
!                --  Assign the tag now to make sure that the dispatching call in
!                --  the subsequent deep_adjust works properly (unless Java_VM,
!                --  where tags are implicit).
  
                 if not Java_VM then
                    Instr :=
*************** package body Exp_Aggr is
*** 1869,1907 ****
                        Name =>
                          Make_Selected_Component (Loc,
                            Prefix => New_Copy_Tree (Target),
!                           Selector_Name => New_Reference_To (
!                             Tag_Component (Base_Type (Typ)), Loc)),
  
                        Expression =>
                          Unchecked_Convert_To (RTE (RE_Tag),
!                           New_Reference_To (
!                             Access_Disp_Table (Base_Type (Typ)), Loc)));
  
                    Set_Assignment_OK (Name (Instr));
!                   Append_To (L, Instr);
                 end if;
  
!                --  If the ancestor part is an aggregate, force its full
!                --  expansion, which was delayed.
  
!                if Nkind (A) = N_Qualified_Expression
!                  and then (Nkind (Expression (A)) = N_Aggregate
!                              or else
!                            Nkind (Expression (A)) = N_Extension_Aggregate)
!                then
!                   Set_Analyzed (A, False);
!                   Set_Analyzed (Expression (A), False);
                 end if;
  
-                Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
-                Set_Assignment_OK (Ref);
                 Append_To (L,
!                  Make_Unsuppress_Block (Loc,
!                    Name_Discriminant_Check,
!                    New_List (
!                      Make_OK_Assignment_Statement (Loc,
!                        Name       => Ref,
!                        Expression => A))));
  
                 if Has_Discriminants (Init_Typ) then
                    Check_Ancestor_Discriminants (Init_Typ);
--- 2260,2294 ----
                        Name =>
                          Make_Selected_Component (Loc,
                            Prefix => New_Copy_Tree (Target),
!                           Selector_Name =>
!                             New_Reference_To
!                               (First_Tag_Component (Base_Type (Typ)), Loc)),
  
                        Expression =>
                          Unchecked_Convert_To (RTE (RE_Tag),
!                           New_Reference_To
!                             (Node (First_Elmt
!                                (Access_Disp_Table (Base_Type (Typ)))),
!                              Loc)));
  
                    Set_Assignment_OK (Name (Instr));
!                   Append_To (Assign, Instr);
                 end if;
  
!                --  Call Adjust manually
  
!                if Controlled_Type (Etype (A)) then
!                   Append_List_To (Assign,
!                     Make_Adjust_Call (
!                       Ref         => New_Copy_Tree (Ref),
!                       Typ         => Etype (A),
!                       Flist_Ref   => New_Reference_To (
!                         RTE (RE_Global_Final_List), Loc),
!                       With_Attach => Make_Integer_Literal (Loc, 0)));
                 end if;
  
                 Append_To (L,
!                  Make_Unsuppress_Block (Loc, Name_Discriminant_Check, Assign));
  
                 if Has_Discriminants (Init_Typ) then
                    Check_Ancestor_Discriminants (Init_Typ);
*************** package body Exp_Aggr is
*** 1999,2008 ****
  
                    if not Inside_Init_Proc and not Inside_Allocator then
                       Build_Activation_Chain_Entity (N);
- 
-                      if not Has_Master_Entity (Current_Scope) then
-                         Build_Master_Entity (Etype (N));
-                      end if;
                    end if;
                 end if;
              end;
--- 2386,2391 ----
*************** package body Exp_Aggr is
*** 2019,2029 ****
              goto Next_Comp;
           end if;
  
!          --  ???
  
           if Ekind (Selector) /= E_Discriminant
             or else Nkind (N) = N_Extension_Aggregate
           then
              Comp_Type := Etype (Selector);
              Comp_Expr :=
                Make_Selected_Component (Loc,
--- 2402,2424 ----
              goto Next_Comp;
           end if;
  
!          --  Prepare for component assignment
  
           if Ekind (Selector) /= E_Discriminant
             or else Nkind (N) = N_Extension_Aggregate
           then
+ 
+             --  All the discriminants have now been assigned
+             --  This is now a good moment to initialize and attach all the
+             --  controllers. Their position may depend on the discriminants.
+ 
+             if Ekind (Selector) /= E_Discriminant
+               and then not Ctrl_Stuff_Done
+             then
+                Gen_Ctrl_Actions_For_Aggr;
+                Ctrl_Stuff_Done := True;
+             end if;
+ 
              Comp_Type := Etype (Selector);
              Comp_Expr :=
                Make_Selected_Component (Loc,
*************** package body Exp_Aggr is
*** 2061,2067 ****
                 Internal_Final_List := Empty;
              end if;
  
!             --  ???
  
              if Is_Delayed_Aggregate (Expr_Q) then
                 Append_List_To (L,
--- 2456,2463 ----
                 Internal_Final_List := Empty;
              end if;
  
!             --  Now either create the assignment or generate the code for the
!             --  inner aggregate top-down.
  
              if Is_Delayed_Aggregate (Expr_Q) then
                 Append_List_To (L,
*************** package body Exp_Aggr is
*** 2090,2101 ****
                          Make_Selected_Component (Loc,
                            Prefix =>  New_Copy_Tree (Comp_Expr),
                            Selector_Name =>
!                             New_Reference_To (Tag_Component (Comp_Type), Loc)),
  
                        Expression =>
                          Unchecked_Convert_To (RTE (RE_Tag),
!                           New_Reference_To (
!                             Access_Disp_Table (Comp_Type), Loc)));
  
                    Append_To (L, Instr);
                 end if;
--- 2486,2499 ----
                          Make_Selected_Component (Loc,
                            Prefix =>  New_Copy_Tree (Comp_Expr),
                            Selector_Name =>
!                             New_Reference_To
!                               (First_Tag_Component (Comp_Type), Loc)),
  
                        Expression =>
                          Unchecked_Convert_To (RTE (RE_Tag),
!                           New_Reference_To
!                             (Node (First_Elmt (Access_Disp_Table (Comp_Type))),
!                              Loc)));
  
                    Append_To (L, Instr);
                 end if;
*************** package body Exp_Aggr is
*** 2172,2377 ****
                 Make_Selected_Component (Loc,
                    Prefix => New_Copy_Tree (Target),
                   Selector_Name =>
!                    New_Reference_To (Tag_Component (Base_Type (Typ)), Loc)),
  
               Expression =>
                 Unchecked_Convert_To (RTE (RE_Tag),
!                  New_Reference_To (Access_Disp_Table (Base_Type (Typ)), Loc)));
  
           Append_To (L, Instr);
        end if;
  
!       --  Now deal with the various controlled type data structure
!       --  initializations
! 
!       if Present (Obj)
!         and then Finalize_Storage_Only (Typ)
!         and then (Is_Library_Level_Entity (Obj)
!         or else Entity (Constant_Value (RTE (RE_Garbage_Collected)))
!                   = Standard_True)
!       then
!          Attach := Make_Integer_Literal (Loc, 0);
! 
!       elsif Nkind (Parent (N)) = N_Qualified_Expression
!         and then Nkind (Parent (Parent (N))) = N_Allocator
!       then
!          Attach := Make_Integer_Literal (Loc, 2);
! 
!       else
!          Attach := Make_Integer_Literal (Loc, 1);
!       end if;
! 
!       --  Determine the external finalization list. It is either the
!       --  finalization list of the outer-scope or the one coming from
!       --  an outer aggregate.  When the target is not a temporary, the
!       --  proper scope is the scope of the target rather than the
!       --  potentially transient current scope.
! 
!       if Controlled_Type (Typ) then
!          if Present (Flist) then
!             External_Final_List := New_Copy_Tree (Flist);
! 
!          elsif Is_Entity_Name (Target)
!            and then Present (Scope (Entity (Target)))
!          then
!             External_Final_List := Find_Final_List (Scope (Entity (Target)));
! 
!          else
!             External_Final_List := Find_Final_List (Current_Scope);
!          end if;
! 
!       else
!          External_Final_List := Empty;
!       end if;
! 
!       --  Initialize and attach the outer object in the is_controlled case
! 
!       if Is_Controlled (Typ) then
!          if Ancestor_Is_Subtype_Mark then
!             Ref := Convert_To (Init_Typ, New_Copy_Tree (Target));
!             Set_Assignment_OK (Ref);
!             Append_To (L,
!               Make_Procedure_Call_Statement (Loc,
!                 Name => New_Reference_To (
!                   Find_Prim_Op (Init_Typ, Name_Initialize), Loc),
!                 Parameter_Associations => New_List (New_Copy_Tree (Ref))));
!          end if;
! 
!          if not Has_Controlled_Component (Typ) then
!             Ref := New_Copy_Tree (Target);
!             Set_Assignment_OK (Ref);
!             Append_To (Start_L,
!               Make_Attach_Call (
!                 Obj_Ref     => Ref,
!                 Flist_Ref   => New_Copy_Tree (External_Final_List),
!                 With_Attach => Attach));
!          end if;
!       end if;
! 
!       --  In the Has_Controlled component case, all the intermediate
!       --  controllers must be initialized
! 
!       if Has_Controlled_Component (Typ)
!         and not Is_Limited_Ancestor_Expansion
!       then
!          declare
!             Inner_Typ : Entity_Id;
!             Outer_Typ : Entity_Id;
!             At_Root   : Boolean;
! 
!          begin
! 
!             Outer_Typ := Base_Type (Typ);
! 
!             --  Find outer type with a controller
! 
!             while Outer_Typ /= Init_Typ
!               and then not Has_New_Controlled_Component (Outer_Typ)
!             loop
!                Outer_Typ := Etype (Outer_Typ);
!             end loop;
! 
!             --  Attach it to the outer record controller to the
!             --  external final list
! 
!             if Outer_Typ = Init_Typ then
!                Append_List_To (Start_L,
!                  Init_Controller (
!                    Target  => Target,
!                    Typ     => Outer_Typ,
!                    F       => External_Final_List,
!                    Attach  => Attach,
!                    Init_Pr => Ancestor_Is_Expression));
! 
!                At_Root   := True;
!                Inner_Typ := Init_Typ;
! 
!             else
!                Append_List_To (Start_L,
!                  Init_Controller (
!                    Target  => Target,
!                    Typ     => Outer_Typ,
!                    F       => External_Final_List,
!                    Attach  => Attach,
!                    Init_Pr => True));
! 
!                Inner_Typ := Etype (Outer_Typ);
!                At_Root   :=
!                  not Is_Tagged_Type (Typ) or else Inner_Typ = Outer_Typ;
!             end if;
! 
!             --  The outer object has to be attached as well
! 
!             if Is_Controlled (Typ) then
!                Ref := New_Copy_Tree (Target);
!                Set_Assignment_OK (Ref);
!                Append_To (Start_L,
!                   Make_Attach_Call (
!                     Obj_Ref     => Ref,
!                     Flist_Ref   => New_Copy_Tree (External_Final_List),
!                     With_Attach => New_Copy_Tree (Attach)));
!             end if;
! 
!             --  Initialize the internal controllers for tagged types with
!             --  more than one controller.
! 
!             while not At_Root and then Inner_Typ /= Init_Typ loop
!                if Has_New_Controlled_Component (Inner_Typ) then
!                   F :=
!                     Make_Selected_Component (Loc,
!                       Prefix => Convert_To (Outer_Typ, New_Copy_Tree (Target)),
!                       Selector_Name =>
!                         Make_Identifier (Loc, Name_uController));
!                   F :=
!                     Make_Selected_Component (Loc,
!                       Prefix => F,
!                       Selector_Name => Make_Identifier (Loc, Name_F));
! 
!                   Append_List_To (Start_L,
!                     Init_Controller (
!                       Target  => Target,
!                       Typ     => Inner_Typ,
!                       F       => F,
!                       Attach  => Make_Integer_Literal (Loc, 1),
!                       Init_Pr => True));
!                   Outer_Typ := Inner_Typ;
!                end if;
! 
!                --  Stop at the root
! 
!                At_Root := Inner_Typ = Etype (Inner_Typ);
!                Inner_Typ := Etype (Inner_Typ);
!             end loop;
! 
!             --  If not done yet attach the controller of the ancestor part
! 
!             if Outer_Typ /= Init_Typ
!               and then Inner_Typ = Init_Typ
!               and then Has_Controlled_Component (Init_Typ)
!             then
!                F :=
!                   Make_Selected_Component (Loc,
!                     Prefix => Convert_To (Outer_Typ, New_Copy_Tree (Target)),
!                     Selector_Name => Make_Identifier (Loc, Name_uController));
!                F :=
!                   Make_Selected_Component (Loc,
!                     Prefix => F,
!                     Selector_Name => Make_Identifier (Loc, Name_F));
  
!                Attach := Make_Integer_Literal (Loc, 1);
!                Append_List_To (Start_L,
!                  Init_Controller (
!                    Target  => Target,
!                    Typ     => Init_Typ,
!                    F       => F,
!                    Attach  => Attach,
!                    Init_Pr => Ancestor_Is_Expression));
!             end if;
!          end;
        end if;
  
!       Append_List_To (Start_L, L);
!       return Start_L;
     end Build_Record_Aggr_Code;
  
     -------------------------------
--- 2570,2596 ----
                 Make_Selected_Component (Loc,
                    Prefix => New_Copy_Tree (Target),
                   Selector_Name =>
!                    New_Reference_To
!                      (First_Tag_Component (Base_Type (Typ)), Loc)),
  
               Expression =>
                 Unchecked_Convert_To (RTE (RE_Tag),
!                  New_Reference_To
!                    (Node (First_Elmt (Access_Disp_Table (Base_Type (Typ)))),
!                     Loc)));
  
           Append_To (L, Instr);
        end if;
  
!       --  If the controllers have not been initialized yet (by lack of non-
!       --  discriminant components), let's do it now.
  
!       if not Ctrl_Stuff_Done then
!          Gen_Ctrl_Actions_For_Aggr;
!          Ctrl_Stuff_Done := True;
        end if;
  
!       return L;
     end Build_Record_Aggr_Code;
  
     -------------------------------
*************** package body Exp_Aggr is
*** 2532,2537 ****
--- 2751,2761 ----
           return;
        end if;
  
+       if Requires_Transient_Scope (Typ) then
+          Establish_Transient_Scope (Aggr, Sec_Stack =>
+            Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
+       end if;
+ 
        Insert_Actions_After (N, Late_Expansion (Aggr, Typ, Occ, Obj => Obj));
        Set_No_Initialization (N);
        Initialize_Discriminants (N, Typ);
*************** package body Exp_Aggr is
*** 2665,2671 ****
          (N   : Node_Id;
           Ix  : Node_Id;
           Ixb : Node_Id) return Boolean;
!       --  Convert the aggregate into a purely positional form if possible
  
        function Is_Flat (N : Node_Id; Dims : Int) return Boolean;
        --  Return True iff the array N is flat (which is not rivial
--- 2889,2897 ----
          (N   : Node_Id;
           Ix  : Node_Id;
           Ixb : Node_Id) return Boolean;
!       --  Convert the aggregate into a purely positional form if possible.
!       --  On entry the bounds of all dimensions are known to be static,
!       --  and the total number of components is safe enough to expand.
  
        function Is_Flat (N : Node_Id; Dims : Int) return Boolean;
        --  Return True iff the array N is flat (which is not rivial
*************** package body Exp_Aggr is
*** 2687,2725 ****
           Lov : Uint;
           Hiv : Uint;
  
-          --  The following constant determines the maximum size of an
-          --  aggregate produced by converting named to positional
-          --  notation (e.g. from others clauses). This avoids running
-          --  away with attempts to convert huge aggregates.
- 
-          --  The normal limit is 5000, but we increase this limit to
-          --  2**24 (about 16 million) if Restrictions (No_Elaboration_Code)
-          --  or Restrictions (No_Implicit_Loops) is specified, since in
-          --  either case, we are at risk of declaring the program illegal
-          --  because of this limit.
- 
-          Max_Aggr_Size : constant Nat :=
-                            5000 + (2 ** 24 - 5000) *
-                              Boolean'Pos
-                                (Restriction_Active (No_Elaboration_Code)
-                                   or else
-                                 Restriction_Active (No_Implicit_Loops));
- 
        begin
           if Nkind (Original_Node (N)) = N_String_Literal then
              return True;
           end if;
  
!          --  Bounds need to be known at compile time
! 
!          if not Compile_Time_Known_Value (Lo)
!            or else not Compile_Time_Known_Value (Hi)
!          then
!             return False;
!          end if;
! 
!          --  Get bounds and check reasonable size (positive, not too large)
!          --  Also only handle bounds starting at the base type low bound
           --  for now since the compiler isn't able to handle different low
           --  bounds yet. Case such as new String'(3..5 => ' ') will get
           --  the wrong bounds, though it seems that the aggregate should
--- 2913,2924 ----
           Lov : Uint;
           Hiv : Uint;
  
        begin
           if Nkind (Original_Node (N)) = N_String_Literal then
              return True;
           end if;
  
!          --  Only handle bounds starting at the base type low bound
           --  for now since the compiler isn't able to handle different low
           --  bounds yet. Case such as new String'(3..5 => ' ') will get
           --  the wrong bounds, though it seems that the aggregate should
*************** package body Exp_Aggr is
*** 2729,2750 ****
           Hiv := Expr_Value (Hi);
  
           if Hiv < Lov
-            or else (Hiv - Lov > Max_Aggr_Size)
             or else not Compile_Time_Known_Value (Blo)
             or else (Lov /= Expr_Value (Blo))
           then
              return False;
           end if;
  
-          --  Bounds must be in integer range (for array Vals below)
- 
-          if not UI_Is_In_Int_Range (Lov)
-              or else
-             not UI_Is_In_Int_Range (Hiv)
-          then
-             return False;
-          end if;
- 
           --  Determine if set of alternatives is suitable for conversion
           --  and build an array containing the values in sequence.
  
--- 2928,2939 ----
*************** package body Exp_Aggr is
*** 2972,2978 ****
           return;
        end if;
  
!       if Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ))) then
           Analyze_And_Resolve (N, Typ);
        end if;
     end Convert_To_Positional;
--- 3161,3170 ----
           return;
        end if;
  
!       if Aggr_Size_OK (Typ)
!         and then
!           Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ)))
!       then
           Analyze_And_Resolve (N, Typ);
        end if;
     end Convert_To_Positional;
*************** package body Exp_Aggr is
*** 4282,4288 ****
                Parent_Expr => A);
           else
              Expand_Record_Aggregate (N,
!               Orig_Tag    => New_Occurrence_Of (Access_Disp_Table (Typ), Loc),
                Parent_Expr => A);
           end if;
        end if;
--- 4474,4482 ----
                Parent_Expr => A);
           else
              Expand_Record_Aggregate (N,
!               Orig_Tag    =>
!                 New_Occurrence_Of
!                   (Node (First_Elmt (Access_Disp_Table (Typ))), Loc),
                Parent_Expr => A);
           end if;
        end if;
*************** package body Exp_Aggr is
*** 4649,4655 ****
              elsif Java_VM then
                 Tag_Value := Empty;
              else
!                Tag_Value := New_Occurrence_Of (Access_Disp_Table (Typ), Loc);
              end if;
  
              --  For a derived type, an aggregate for the parent is formed with
--- 4843,4851 ----
              elsif Java_VM then
                 Tag_Value := Empty;
              else
!                Tag_Value :=
!                  New_Occurrence_Of
!                    (Node (First_Elmt (Access_Disp_Table (Typ))), Loc);
              end if;
  
              --  For a derived type, an aggregate for the parent is formed with
*************** package body Exp_Aggr is
*** 4712,4718 ****
              elsif not Java_VM then
                 declare
                    Tag_Name  : constant Node_Id :=
!                                 New_Occurrence_Of (Tag_Component (Typ), Loc);
                    Typ_Tag   : constant Entity_Id := RTE (RE_Tag);
                    Conv_Node : constant Node_Id :=
                                  Unchecked_Convert_To (Typ_Tag, Tag_Value);
--- 4908,4915 ----
              elsif not Java_VM then
                 declare
                    Tag_Name  : constant Node_Id :=
!                                 New_Occurrence_Of
!                                   (First_Tag_Component (Typ), Loc);
                    Typ_Tag   : constant Entity_Id := RTE (RE_Tag);
                    Conv_Node : constant Node_Id :=
                                  Unchecked_Convert_To (Typ_Tag, Tag_Value);
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_aggr.ads gcc-4.1.0/gcc/ada/exp_aggr.ads
*** gcc-4.0.2/gcc/ada/exp_aggr.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_aggr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_attr.adb gcc-4.1.0/gcc/ada/exp_attr.adb
*** gcc-4.0.2/gcc/ada/exp_attr.adb	Thu Feb 10 13:50:22 2005
--- gcc-4.1.0/gcc/ada/exp_attr.adb	Tue Nov 15 13:56:51 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Exp_Pakd; use Exp_Pakd;
*** 35,40 ****
--- 35,41 ----
  with Exp_Strm; use Exp_Strm;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
+ with Exp_VFpt; use Exp_VFpt;
  with Gnatvsn;  use Gnatvsn;
  with Hostparm; use Hostparm;
  with Lib;      use Lib;
*************** package body Exp_Attr is
*** 84,99 ****
  
     procedure Expand_Fpt_Attribute
       (N    : Node_Id;
!       Rtp  : Entity_Id;
        Nam  : Name_Id;
        Args : List_Id);
     --  This procedure expands a call to a floating-point attribute function.
     --  N is the attribute reference node, and Args is a list of arguments to
!    --  be passed to the function call. Rtp is the root type of the floating
!    --  point type involved (used to select the proper generic instantiation
!    --  of the package containing the attribute routines). The Nam argument
!    --  is the attribute processing routine to be called. This is normally
!    --  the same as the attribute name, except in the Unaligned_Valid case.
  
     procedure Expand_Fpt_Attribute_R (N : Node_Id);
     --  This procedure expands a call to a floating-point attribute function
--- 85,101 ----
  
     procedure Expand_Fpt_Attribute
       (N    : Node_Id;
!       Pkg  : RE_Id;
        Nam  : Name_Id;
        Args : List_Id);
     --  This procedure expands a call to a floating-point attribute function.
     --  N is the attribute reference node, and Args is a list of arguments to
!    --  be passed to the function call. Pkg identifies the package containing
!    --  the appropriate instantiation of System.Fat_Gen. Float arguments in Args
!    --  have already been converted to the floating-point type for which Pkg was
!    --  instantiated. The Nam argument is the relevant attribute processing
!    --  routine to be called. This is the same as the attribute name, except in
!    --  the Unaligned_Valid case.
  
     procedure Expand_Fpt_Attribute_R (N : Node_Id);
     --  This procedure expands a call to a floating-point attribute function
*************** package body Exp_Attr is
*** 122,133 ****
     --  A reference to a type within its own scope is resolved to a reference
     --  to the current instance of the type in its initialization procedure.
  
!    function Find_Inherited_TSS
!      (Typ : Entity_Id;
!       Nam : TSS_Name_Type) return Entity_Id;
!    --  Returns the TSS of name Nam of Typ, or of its closest ancestor defining
!    --  such a TSS. Empty is returned is neither Typ nor any of its ancestors
!    --  have such a TSS.
  
     function Find_Stream_Subprogram
       (Typ : Entity_Id;
--- 124,137 ----
     --  A reference to a type within its own scope is resolved to a reference
     --  to the current instance of the type in its initialization procedure.
  
!    procedure Find_Fat_Info
!      (T        : Entity_Id;
!       Fat_Type : out Entity_Id;
!       Fat_Pkg  : out RE_Id);
!    --  Given a floating-point type T, identifies the package containing the
!    --  attributes for this type (returned in Fat_Pkg), and the corresponding
!    --  type for which this package was instantiated from Fat_Gen. Error if T
!    --  is not a floating-point type.
  
     function Find_Stream_Subprogram
       (Typ : Entity_Id;
*************** package body Exp_Attr is
*** 182,188 ****
        if Check then
           Insert_Action (N, Decl);
        else
!          Insert_Action (N, Decl, All_Checks);
        end if;
  
        if Installed then
--- 186,192 ----
        if Check then
           Insert_Action (N, Decl);
        else
!          Insert_Action (N, Decl, Suppress => All_Checks);
        end if;
  
        if Installed then
*************** package body Exp_Attr is
*** 266,283 ****
  
     procedure Expand_Fpt_Attribute
       (N    : Node_Id;
!       Rtp  : Entity_Id;
        Nam  : Name_Id;
        Args : List_Id)
     is
        Loc : constant Source_Ptr := Sloc (N);
        Typ : constant Entity_Id  := Etype (N);
-       Pkg : RE_Id;
        Fnm : Node_Id;
  
     begin
!       --  The function name is the selected component Fat_xxx.yyy where xxx
!       --  is the floating-point root type, and yyy is the argument Nam.
  
        --  Note: it would be more usual to have separate RE entries for each
        --  of the entities in the Fat packages, but first they have identical
--- 270,286 ----
  
     procedure Expand_Fpt_Attribute
       (N    : Node_Id;
!       Pkg  : RE_Id;
        Nam  : Name_Id;
        Args : List_Id)
     is
        Loc : constant Source_Ptr := Sloc (N);
        Typ : constant Entity_Id  := Etype (N);
        Fnm : Node_Id;
  
     begin
!       --  The function name is the selected component Attr_xxx.yyy where
!       --  Attr_xxx is the package name, and yyy is the argument Nam.
  
        --  Note: it would be more usual to have separate RE entries for each
        --  of the entities in the Fat packages, but first they have identical
*************** package body Exp_Attr is
*** 285,300 ****
        --  meet the normal RE rule of separate names for all runtime entities),
        --  and second there would be an awful lot of them!
  
-       if Rtp = Standard_Short_Float then
-          Pkg := RE_Fat_Short_Float;
-       elsif Rtp = Standard_Float then
-          Pkg := RE_Fat_Float;
-       elsif Rtp = Standard_Long_Float then
-          Pkg := RE_Fat_Long_Float;
-       else
-          Pkg := RE_Fat_Long_Long_Float;
-       end if;
- 
        Fnm :=
          Make_Selected_Component (Loc,
            Prefix        => New_Reference_To (RTE (Pkg), Loc),
--- 288,293 ----
*************** package body Exp_Attr is
*** 308,314 ****
        Rewrite (N,
          Unchecked_Convert_To (Base_Type (Etype (N)),
            Make_Function_Call (Loc,
!             Name => Fnm,
              Parameter_Associations => Args)));
  
        Analyze_And_Resolve (N, Typ);
--- 301,307 ----
        Rewrite (N,
          Unchecked_Convert_To (Base_Type (Etype (N)),
            Make_Function_Call (Loc,
!             Name                   => Fnm,
              Parameter_Associations => Args)));
  
        Analyze_And_Resolve (N, Typ);
*************** package body Exp_Attr is
*** 324,335 ****
  
     procedure Expand_Fpt_Attribute_R (N : Node_Id) is
        E1  : constant Node_Id    := First (Expressions (N));
!       Rtp : constant Entity_Id  := Root_Type (Etype (E1));
! 
     begin
        Expand_Fpt_Attribute
!         (N, Rtp, Attribute_Name (N),
!          New_List (Unchecked_Convert_To (Rtp, Relocate_Node (E1))));
     end Expand_Fpt_Attribute_R;
  
     -----------------------------
--- 317,329 ----
  
     procedure Expand_Fpt_Attribute_R (N : Node_Id) is
        E1  : constant Node_Id    := First (Expressions (N));
!       Ftp : Entity_Id;
!       Pkg : RE_Id;
     begin
+       Find_Fat_Info (Etype (E1), Ftp, Pkg);
        Expand_Fpt_Attribute
!         (N, Pkg, Attribute_Name (N),
!          New_List (Unchecked_Convert_To (Ftp, Relocate_Node (E1))));
     end Expand_Fpt_Attribute_R;
  
     -----------------------------
*************** package body Exp_Attr is
*** 343,356 ****
  
     procedure Expand_Fpt_Attribute_RI (N : Node_Id) is
        E1  : constant Node_Id   := First (Expressions (N));
!       Rtp : constant Entity_Id := Root_Type (Etype (E1));
        E2  : constant Node_Id   := Next (E1);
- 
     begin
        Expand_Fpt_Attribute
!         (N, Rtp, Attribute_Name (N),
           New_List (
!            Unchecked_Convert_To (Rtp, Relocate_Node (E1)),
             Unchecked_Convert_To (Standard_Integer, Relocate_Node (E2))));
     end Expand_Fpt_Attribute_RI;
  
--- 337,351 ----
  
     procedure Expand_Fpt_Attribute_RI (N : Node_Id) is
        E1  : constant Node_Id   := First (Expressions (N));
!       Ftp : Entity_Id;
!       Pkg : RE_Id;
        E2  : constant Node_Id   := Next (E1);
     begin
+       Find_Fat_Info (Etype (E1), Ftp, Pkg);
        Expand_Fpt_Attribute
!         (N, Pkg, Attribute_Name (N),
           New_List (
!            Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
             Unchecked_Convert_To (Standard_Integer, Relocate_Node (E2))));
     end Expand_Fpt_Attribute_RI;
  
*************** package body Exp_Attr is
*** 364,378 ****
  
     procedure Expand_Fpt_Attribute_RR (N : Node_Id) is
        E1  : constant Node_Id   := First (Expressions (N));
!       Rtp : constant Entity_Id := Root_Type (Etype (E1));
        E2  : constant Node_Id   := Next (E1);
- 
     begin
        Expand_Fpt_Attribute
!         (N, Rtp, Attribute_Name (N),
           New_List (
!            Unchecked_Convert_To (Rtp, Relocate_Node (E1)),
!            Unchecked_Convert_To (Rtp, Relocate_Node (E2))));
     end Expand_Fpt_Attribute_RR;
  
     ----------------------------------
--- 359,374 ----
  
     procedure Expand_Fpt_Attribute_RR (N : Node_Id) is
        E1  : constant Node_Id   := First (Expressions (N));
!       Ftp : Entity_Id;
!       Pkg : RE_Id;
        E2  : constant Node_Id   := Next (E1);
     begin
+       Find_Fat_Info (Etype (E1), Ftp, Pkg);
        Expand_Fpt_Attribute
!         (N, Pkg, Attribute_Name (N),
           New_List (
!            Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
!            Unchecked_Convert_To (Ftp, Relocate_Node (E2))));
     end Expand_Fpt_Attribute_RR;
  
     ----------------------------------
*************** package body Exp_Attr is
*** 633,638 ****
--- 629,644 ----
                       Rewrite (N, Conversion);
                       Analyze_And_Resolve (N, Typ);
                    end if;
+ 
+                --  Ada 2005 (AI-251): If the designated type is an interface,
+                --  then rewrite the referenced object as a conversion to force
+                --  the displacement of the pointer to the secondary dispatch
+                --  table.
+ 
+                elsif Is_Interface (Directly_Designated_Type (Btyp)) then
+                   Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
+                   Rewrite (N, Conversion);
+                   Analyze_And_Resolve (N, Typ);
                 end if;
              end;
  
*************** package body Exp_Attr is
*** 1003,1014 ****
        -- Callable --
        --------------
  
!       --  Transforms 'Callable attribute into a call to the Callable function.
  
        when Attribute_Callable => Callable :
        begin
!          Rewrite (N,
!            Build_Call_With_Task (Pref, RTE (RE_Callable)));
           Analyze_And_Resolve (N, Standard_Boolean);
        end Callable;
  
--- 1009,1043 ----
        -- Callable --
        --------------
  
!       --  Transforms 'Callable attribute into a call to the Callable function
  
        when Attribute_Callable => Callable :
        begin
!          --  We have an object of a task interface class-wide type as a prefix
!          --  to Callable. Generate:
! 
!          --    callable (Pref._disp_get_task_id);
! 
!          if Ada_Version >= Ada_05
!            and then Ekind (Etype (Pref)) = E_Class_Wide_Type
!            and then Is_Interface      (Etype (Pref))
!            and then Is_Task_Interface (Etype (Pref))
!          then
!             Rewrite (N,
!               Make_Function_Call (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Callable), Loc),
!                 Parameter_Associations => New_List (
!                   Make_Selected_Component (Loc,
!                     Prefix =>
!                       New_Copy_Tree (Pref),
!                     Selector_Name =>
!                       Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
!          else
!             Rewrite (N,
!               Build_Call_With_Task (Pref, RTE (RE_Callable)));
!          end if;
! 
           Analyze_And_Resolve (N, Standard_Boolean);
        end Callable;
  
*************** package body Exp_Attr is
*** 1113,1118 ****
--- 1142,1148 ----
  
        when Attribute_Constrained => Constrained : declare
           Formal_Ent : constant Entity_Id := Param_Entity (Pref);
+          Typ        : constant Entity_Id := Etype (Pref);
  
        begin
           --  Reference to a parameter where the value is passed as an extra
*************** package body Exp_Attr is
*** 1196,1210 ****
  
           --  Prefix is not an entity name. These are also cases where
           --  we can always tell at compile time by looking at the form
!          --  and type of the prefix.
  
           else
              Rewrite (N,
                New_Reference_To (
                  Boolean_Literals (
                    not Is_Variable (Pref)
!                     or else Nkind (Pref) = N_Explicit_Dereference
!                     or else Is_Constrained (Etype (Pref))),
                  Loc));
           end if;
  
--- 1226,1245 ----
  
           --  Prefix is not an entity name. These are also cases where
           --  we can always tell at compile time by looking at the form
!          --  and type of the prefix. If an explicit dereference of an
!          --  object with constrained partial view, this is unconstrained
!          --  (Ada 2005 AI-363).
  
           else
              Rewrite (N,
                New_Reference_To (
                  Boolean_Literals (
                    not Is_Variable (Pref)
!                     or else
!                      (Nkind (Pref) = N_Explicit_Dereference
!                         and then
!                           not Has_Constrained_Partial_View (Base_Type (Typ)))
!                     or else Is_Constrained (Typ)),
                  Loc));
           end if;
  
*************** package body Exp_Attr is
*** 1620,1627 ****
  
        --  expands into
  
!       --    Result_Type (System.Fore (Long_Long_Float (Type'First)),
!       --                              Long_Long_Float (Type'Last))
  
        --  Note that we know that the type is a non-static subtype, or Fore
        --  would have itself been computed dynamically in Eval_Attribute.
--- 1655,1662 ----
  
        --  expands into
  
!       --    Result_Type (System.Fore (Universal_Real (Type'First)),
!       --                              Universal_Real (Type'Last))
  
        --  Note that we know that the type is a non-static subtype, or Fore
        --  would have itself been computed dynamically in Eval_Attribute.
*************** package body Exp_Attr is
*** 1637,1648 ****
                 Name => New_Reference_To (RTE (RE_Fore), Loc),
  
                 Parameter_Associations => New_List (
!                  Convert_To (Standard_Long_Long_Float,
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Ptyp, Loc),
                       Attribute_Name => Name_First)),
  
!                  Convert_To (Standard_Long_Long_Float,
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Ptyp, Loc),
                       Attribute_Name => Name_Last))))));
--- 1672,1683 ----
                 Name => New_Reference_To (RTE (RE_Fore), Loc),
  
                 Parameter_Associations => New_List (
!                  Convert_To (Universal_Real,
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Ptyp, Loc),
                       Attribute_Name => Name_First)),
  
!                  Convert_To (Universal_Real,
                     Make_Attribute_Reference (Loc,
                       Prefix => New_Reference_To (Ptyp, Loc),
                       Attribute_Name => Name_Last))))));
*************** package body Exp_Attr is
*** 1672,1678 ****
  
        --    taskV!(Prefix)._Task_Id, converted to the type Task_Id defined
  
!       --  in Ada.Task_Identification.
  
        when Attribute_Identity => Identity : declare
           Id_Kind : Entity_Id;
--- 1707,1713 ----
  
        --    taskV!(Prefix)._Task_Id, converted to the type Task_Id defined
  
!       --  in Ada.Task_Identification
  
        when Attribute_Identity => Identity : declare
           Id_Kind : Entity_Id;
*************** package body Exp_Attr is
*** 1872,1881 ****
                    --  initialize a dummy tag object:
  
                    --    Dnn : Ada.Tags.Tag
!                   --             := Internal_Tag (String'Input (Strm));
  
                    --  This dummy object is used only to provide a controlling
!                   --  argument for the eventual _Input call.
  
                    Dnn :=
                      Make_Defining_Identifier (Loc,
--- 1907,1922 ----
                    --  initialize a dummy tag object:
  
                    --    Dnn : Ada.Tags.Tag
!                   --           := Descendant_Tag (String'Input (Strm), P_Type);
  
                    --  This dummy object is used only to provide a controlling
!                   --  argument for the eventual _Input call. Descendant_Tag is
!                   --  called rather than Internal_Tag to ensure that we have a
!                   --  tag for a type that is descended from the prefix type and
!                   --  declared at the same accessibility level (the exception
!                   --  Tag_Error will be raised otherwise). The level check is
!                   --  required for Ada 2005 because tagged types can be
!                   --  extended in nested scopes (AI-344).
  
                    Dnn :=
                      Make_Defining_Identifier (Loc,
*************** package body Exp_Attr is
*** 1889,1895 ****
                        Expression =>
                          Make_Function_Call (Loc,
                            Name =>
!                             New_Occurrence_Of (RTE (RE_Internal_Tag), Loc),
                            Parameter_Associations => New_List (
                              Make_Attribute_Reference (Loc,
                                Prefix =>
--- 1930,1936 ----
                        Expression =>
                          Make_Function_Call (Loc,
                            Name =>
!                             New_Occurrence_Of (RTE (RE_Descendant_Tag), Loc),
                            Parameter_Associations => New_List (
                              Make_Attribute_Reference (Loc,
                                Prefix =>
*************** package body Exp_Attr is
*** 1897,1911 ****
                                Attribute_Name => Name_Input,
                                Expressions => New_List (
                                  Relocate_Node
!                                   (Duplicate_Subexpr (Strm)))))));
  
                    Insert_Action (N, Decl);
  
                    --  Now we need to get the entity for the call, and construct
                    --  a function call node, where we preset a reference to Dnn
!                   --  as the controlling argument (doing an unchecked
!                   --  conversion to the class-wide tagged type to make it
!                   --  look like a real tagged object).
  
                    Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input);
                    Cntrl := Unchecked_Convert_To (P_Type,
--- 1938,1955 ----
                                Attribute_Name => Name_Input,
                                Expressions => New_List (
                                  Relocate_Node
!                                   (Duplicate_Subexpr (Strm)))),
!                             Make_Attribute_Reference (Loc,
!                               Prefix => New_Reference_To (P_Type, Loc),
!                               Attribute_Name => Name_Tag))));
  
                    Insert_Action (N, Decl);
  
                    --  Now we need to get the entity for the call, and construct
                    --  a function call node, where we preset a reference to Dnn
!                   --  as the controlling argument (doing an unchecked convert
!                   --  to the class-wide tagged type to make it look like a real
!                   --  tagged object).
  
                    Fname := Find_Prim_Op (Rtyp, TSS_Stream_Input);
                    Cntrl := Unchecked_Convert_To (P_Type,
*************** package body Exp_Attr is
*** 1919,1927 ****
              elsif Is_Tagged_Type (U_Type) then
                 Fname := Find_Prim_Op (U_Type, TSS_Stream_Input);
  
!             --  All other record type cases, including protected records.
!             --  The latter only arise for expander generated code for
!             --  handling shared passive partition access.
  
              else
                 pragma Assert
--- 1963,1971 ----
              elsif Is_Tagged_Type (U_Type) then
                 Fname := Find_Prim_Op (U_Type, TSS_Stream_Input);
  
!             --  All other record type cases, including protected records. The
!             --  latter only arise for expander generated code for handling
!             --  shared passive partition access.
  
              else
                 pragma Assert
*************** package body Exp_Attr is
*** 1974,1982 ****
              end if;
           end if;
  
!          --  If we fall through, Fname is the function to be called. The
!          --  result is obtained by calling the appropriate function, then
!          --  converting the result. The conversion does a subtype check.
  
           Call :=
             Make_Function_Call (Loc,
--- 2018,2026 ----
              end if;
           end if;
  
!          --  If we fall through, Fname is the function to be called. The result
!          --  is obtained by calling the appropriate function, then converting
!          --  the result. The conversion does a subtype check.
  
           Call :=
             Make_Function_Call (Loc,
*************** package body Exp_Attr is
*** 2088,2097 ****
        --  function Leading_Part in Fat_xxx (where xxx is the root type)
  
        --  Note: strictly, we should have special case code to deal with
!       --  absurdly large positive arguments (greater than Integer'Last),
!       --  which result in returning the first argument unchanged, but it
!       --  hardly seems worth the effort. We raise constraint error for
!       --  absurdly negative arguments which is fine.
  
        when Attribute_Leading_Part =>
           Expand_Fpt_Attribute_RI (N);
--- 2132,2141 ----
        --  function Leading_Part in Fat_xxx (where xxx is the root type)
  
        --  Note: strictly, we should have special case code to deal with
!       --  absurdly large positive arguments (greater than Integer'Last), which
!       --  result in returning the first argument unchanged, but it hardly seems
!       --  worth the effort. We raise constraint error for absurdly negative
!       --  arguments which is fine.
  
        when Attribute_Leading_Part =>
           Expand_Fpt_Attribute_RI (N);
*************** package body Exp_Attr is
*** 2264,2269 ****
--- 2308,2324 ----
        when Attribute_Machine =>
           Expand_Fpt_Attribute_R (N);
  
+       ----------------------
+       -- Machine_Rounding --
+       ----------------------
+ 
+       --  Transforms 'Machine_Rounding into a call to the floating-point
+       --  attribute function Machine_Rounding in Fat_xxx (where xxx is the root
+       --  type).
+ 
+       when Attribute_Machine_Rounding =>
+          Expand_Fpt_Attribute_R (N);
+ 
        ------------------
        -- Machine_Size --
        ------------------
*************** package body Exp_Attr is
*** 2283,2291 ****
        -- Mantissa --
        --------------
  
!       --  The only case that can get this far is the dynamic case of the
!       --  old Ada 83 Mantissa attribute for the fixed-point case. For this
!       --  case, we expand:
  
        --    typ'Mantissa
  
--- 2338,2346 ----
        -- Mantissa --
        --------------
  
!       --  The only case that can get this far is the dynamic case of the old
!       --  Ada 83 Mantissa attribute for the fixed-point case. For this case, we
!       --  expand:
  
        --    typ'Mantissa
  
*************** package body Exp_Attr is
*** 2354,2370 ****
                    Right_Opnd => Make_Integer_Literal (Loc, Modv))));
  
           --  Here we know that the modulus is larger than type'Last of the
!          --  integer type. There are three possible cases to consider:
  
           --    a) The integer value is non-negative. In this case, it is
           --    returned as the result (since it is less than the modulus).
  
!          --    b) The integer value is negative. In this case, we know that
!          --    the result is modulus + value, where the value might be as
!          --    small as -modulus. The trouble is what type do we use to do
!          --    this subtraction. No type will do, since modulus can be as
!          --    big as 2**64, and no integer type accomodates this value.
!          --    Let's do a bit of algebra
  
           --         modulus + value
           --      =  modulus - (-value)
--- 2409,2424 ----
                    Right_Opnd => Make_Integer_Literal (Loc, Modv))));
  
           --  Here we know that the modulus is larger than type'Last of the
!          --  integer type. There are two cases to consider:
  
           --    a) The integer value is non-negative. In this case, it is
           --    returned as the result (since it is less than the modulus).
  
!          --    b) The integer value is negative. In this case, we know that the
!          --    result is modulus + value, where the value might be as small as
!          --    -modulus. The trouble is what type do we use to do the subtract.
!          --    No type will do, since modulus can be as big as 2**64, and no
!          --    integer type accomodates this value. Let's do bit of algebra
  
           --         modulus + value
           --      =  modulus - (-value)
*************** package body Exp_Attr is
*** 2376,2381 ****
--- 2430,2439 ----
           --    Furthermore, (-value - 1) can be expressed as -(value + 1)
           --    which we can compute using the integer base type.
  
+          --  Once this is done we analyze the conditional expression without
+          --  range checks, because we know everything is in range, and we
+          --  want to prevent spurious warnings on either branch.
+ 
           else
              Rewrite (N,
                Make_Conditional_Expression (Loc,
*************** package body Exp_Attr is
*** 2403,2409 ****
  
           end if;
  
!          Analyze_And_Resolve (N, Btyp);
        end Mod_Case;
  
        -----------
--- 2461,2467 ----
  
           end if;
  
!          Analyze_And_Resolve (N, Btyp, Suppress => All_Checks);
        end Mod_Case;
  
        -----------
*************** package body Exp_Attr is
*** 2459,2468 ****
  
              --     strmtyp'Output (Stream, strmwrite (acttyp (Item)));
  
!             --  where strmwrite is the given Write function that converts
!             --  an argument of type sourcetyp or a type acctyp, from which
!             --  it is derived to type strmtyp. The conversion to acttyp is
!             --  required for the derived case.
  
              Prag := Get_Stream_Convert_Pragma (P_Type);
  
--- 2517,2526 ----
  
              --     strmtyp'Output (Stream, strmwrite (acttyp (Item)));
  
!             --  where strmwrite is the given Write function that converts an
!             --  argument of type sourcetyp or a type acctyp, from which it is
!             --  derived to type strmtyp. The conversion to acttyp is required
!             --  for the derived case.
  
              Prag := Get_Stream_Convert_Pragma (P_Type);
  
*************** package body Exp_Attr is
*** 2525,2531 ****
  
                 begin
                    --  The code is:
!                   --  String'Output (Strm, External_Tag (Item'Tag))
  
                    Insert_Action (N,
                      Make_Attribute_Reference (Loc,
--- 2583,2625 ----
  
                 begin
                    --  The code is:
!                   --  if Get_Access_Level (Item'Tag)
!                   --       /= Get_Access_Level (P_Type'Tag)
!                   --  then
!                   --     raise Tag_Error;
!                   --  end if;
!                   --  String'Output (Strm, External_Tag (Item'Tag));
! 
!                   --  Ada 2005 (AI-344): Check that the accessibility level
!                   --  of the type of the output object is not deeper than
!                   --  that of the attribute's prefix type.
! 
!                   if Ada_Version >= Ada_05 then
!                      Insert_Action (N,
!                        Make_Implicit_If_Statement (N,
!                          Condition =>
!                            Make_Op_Ne (Loc,
!                              Left_Opnd  =>
!                                Make_Function_Call (Loc,
!                                  Name =>
!                                    New_Reference_To
!                                      (RTE (RE_Get_Access_Level), Loc),
!                                  Parameter_Associations =>
!                                    New_List (Make_Attribute_Reference (Loc,
!                                                Prefix         =>
!                                                  Relocate_Node (
!                                                    Duplicate_Subexpr (Item,
!                                                      Name_Req => True)),
!                                                Attribute_Name =>
!                                                   Name_Tag))),
!                              Right_Opnd =>
!                                Make_Integer_Literal
!                                  (Loc, Type_Access_Level (P_Type))),
!                          Then_Statements =>
!                            New_List (Make_Raise_Statement (Loc,
!                                        New_Occurrence_Of (
!                                          RTE (RE_Tag_Error), Loc)))));
!                   end if;
  
                    Insert_Action (N,
                      Make_Attribute_Reference (Loc,
*************** package body Exp_Attr is
*** 2551,2559 ****
              elsif Is_Tagged_Type (U_Type) then
                 Pname := Find_Prim_Op (U_Type, TSS_Stream_Output);
  
!             --  All other record type cases, including protected records.
!             --  The latter only arise for expander generated code for
!             --  handling shared passive partition access.
  
              else
                 pragma Assert
--- 2645,2653 ----
              elsif Is_Tagged_Type (U_Type) then
                 Pname := Find_Prim_Op (U_Type, TSS_Stream_Output);
  
! --              --  All other record type cases, including protected records.
! --              --  The latter only arise for expander generated code for
! --              --  handling shared passive partition access.
  
              else
                 pragma Assert
*************** package body Exp_Attr is
*** 2864,2873 ****
  
              --     Item := sourcetyp (strmread (strmtyp'Input (Stream)));
  
!             --  where strmread is the given Read function that converts
!             --  an argument of type strmtyp to type sourcetyp or a type
!             --  from which it is derived. The conversion to sourcetyp
!             --  is required in the latter case.
  
              --  A special case arises if Item is a type conversion in which
              --  case, we have to expand to:
--- 2958,2967 ----
  
              --     Item := sourcetyp (strmread (strmtyp'Input (Stream)));
  
!             --  where strmread is the given Read function that converts an
!             --  argument of type strmtyp to type sourcetyp or a type from which
!             --  it is derived. The conversion to sourcetyp is required in the
!             --  latter case.
  
              --  A special case arises if Item is a type conversion in which
              --  case, we have to expand to:
*************** package body Exp_Attr is
*** 2950,2958 ****
              elsif Is_Tagged_Type (U_Type) then
                 Pname := Find_Prim_Op (U_Type, TSS_Stream_Read);
  
!             --  All other record type cases, including protected records.
!             --  The latter only arise for expander generated code for
!             --  handling shared passive partition access.
  
              else
                 pragma Assert
--- 3044,3052 ----
              elsif Is_Tagged_Type (U_Type) then
                 Pname := Find_Prim_Op (U_Type, TSS_Stream_Read);
  
!             --  All other record type cases, including protected records. The
!             --  latter only arise for expander generated code for handling
!             --  shared passive partition access.
  
              else
                 pragma Assert
*************** package body Exp_Attr is
*** 3004,3039 ****
        -- Round --
        -----------
  
!       --  The handling of the Round attribute is quite delicate. The
!       --  processing in Sem_Attr introduced a conversion to universal
!       --  real, reflecting the semantics of Round, but we do not want
!       --  anything to do with universal real at runtime, since this
!       --  corresponds to using floating-point arithmetic.
  
!       --  What we have now is that the Etype of the Round attribute
!       --  correctly indicates the final result type. The operand of
!       --  the Round is the conversion to universal real, described
!       --  above, and the operand of this conversion is the actual
!       --  operand of Round, which may be the special case of a fixed
!       --  point multiplication or division (Etype = universal fixed)
  
!       --  The exapander will expand first the operand of the conversion,
!       --  then the conversion, and finally the round attribute itself,
!       --  since we always work inside out. But we cannot simply process
!       --  naively in this order. In the semantic world where universal
!       --  fixed and real really exist and have infinite precision, there
!       --  is no problem, but in the implementation world, where universal
!       --  real is a floating-point type, we would get the wrong result.
  
!       --  So the approach is as follows. First, when expanding a multiply
!       --  or divide whose type is universal fixed, we do nothing at all,
!       --  instead deferring the operation till later.
  
        --  The actual processing is done in Expand_N_Type_Conversion which
!       --  handles the special case of Round by looking at its parent to
!       --  see if it is a Round attribute, and if it is, handling the
!       --  conversion (or its fixed multiply/divide child) in an appropriate
!       --  manner.
  
        --  This means that by the time we get to expanding the Round attribute
        --  itself, the Round is nothing more than a type conversion (and will
--- 3098,3132 ----
        -- Round --
        -----------
  
!       --  The handling of the Round attribute is quite delicate. The processing
!       --  in Sem_Attr introduced a conversion to universal real, reflecting the
!       --  semantics of Round, but we do not want anything to do with universal
!       --  real at runtime, since this corresponds to using floating-point
!       --  arithmetic.
  
!       --  What we have now is that the Etype of the Round attribute correctly
!       --  indicates the final result type. The operand of the Round is the
!       --  conversion to universal real, described above, and the operand of
!       --  this conversion is the actual operand of Round, which may be the
!       --  special case of a fixed point multiplication or division (Etype =
!       --  universal fixed)
  
!       --  The exapander will expand first the operand of the conversion, then
!       --  the conversion, and finally the round attribute itself, since we
!       --  always work inside out. But we cannot simply process naively in this
!       --  order. In the semantic world where universal fixed and real really
!       --  exist and have infinite precision, there is no problem, but in the
!       --  implementation world, where universal real is a floating-point type,
!       --  we would get the wrong result.
  
!       --  So the approach is as follows. First, when expanding a multiply or
!       --  divide whose type is universal fixed, we do nothing at all, instead
!       --  deferring the operation till later.
  
        --  The actual processing is done in Expand_N_Type_Conversion which
!       --  handles the special case of Round by looking at its parent to see if
!       --  it is a Round attribute, and if it is, handling the conversion (or
!       --  its fixed multiply/divide child) in an appropriate manner.
  
        --  This means that by the time we get to expanding the Round attribute
        --  itself, the Round is nothing more than a type conversion (and will
*************** package body Exp_Attr is
*** 3127,3135 ****
                    Rewrite (Pref, New_Occurrence_Of (Etype (Pref), Loc));
                 end if;
  
!                --  For a scalar type for which no size was
!                --  explicitly given, VADS_Size means Object_Size. This is the
!                --  other respect in which VADS_Size differs from Size.
  
                 if Is_Scalar_Type (Etype (Pref))
                   and then No (Size_Clause (Etype (Pref)))
--- 3220,3228 ----
                    Rewrite (Pref, New_Occurrence_Of (Etype (Pref), Loc));
                 end if;
  
!                --  For a scalar type for which no size was explicitly given,
!                --  VADS_Size means Object_Size. This is the other respect in
!                --  which VADS_Size differs from Size.
  
                 if Is_Scalar_Type (Etype (Pref))
                   and then No (Size_Clause (Etype (Pref)))
*************** package body Exp_Attr is
*** 3154,3160 ****
              Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
              return;
  
!          --  For x'Size applied to an object of a class-wide type, transform
           --  X'Size into a call to the primitive operation _Size applied to X.
  
           elsif Is_Class_Wide_Type (Ptyp) then
--- 3247,3253 ----
              Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
              return;
  
!          --  For X'Size applied to an object of a class-wide type, transform
           --  X'Size into a call to the primitive operation _Size applied to X.
  
           elsif Is_Class_Wide_Type (Ptyp) then
*************** package body Exp_Attr is
*** 3184,3192 ****
           elsif Nkind (Pref) = N_Indexed_Component then
              Siz := Component_Size (Etype (Prefix (Pref)));
  
!          --  For a record component, we can do Size in the front end
!          --  if there is a component clause, or if the record is packed
!          --  and the component's size is known at compile time.
  
           elsif Nkind (Pref) = N_Selected_Component then
              declare
--- 3277,3285 ----
           elsif Nkind (Pref) = N_Indexed_Component then
              Siz := Component_Size (Etype (Prefix (Pref)));
  
!          --  For a record component, we can do Size in the front end if there
!          --  is a component clause, or if the record is packed and the
!          --  component's size is known at compile time.
  
           elsif Nkind (Pref) = N_Selected_Component then
              declare
*************** package body Exp_Attr is
*** 3211,3218 ****
           else
              Apply_Universal_Integer_Attribute_Checks (N);
  
!             --  If we have Size applied to a formal parameter, that is a
!             --  packed array subtype, then apply size to the actual subtype.
  
              if Is_Entity_Name (Pref)
                and then Is_Formal (Entity (Pref))
--- 3304,3311 ----
           else
              Apply_Universal_Integer_Attribute_Checks (N);
  
!             --  If Size is applied to a formal parameter that is of a packed
!             --  array subtype, then apply Size to the actual subtype.
  
              if Is_Entity_Name (Pref)
                and then Is_Formal (Entity (Pref))
*************** package body Exp_Attr is
*** 3227,3232 ****
--- 3320,3339 ----
                 Analyze_And_Resolve (N, Typ);
              end if;
  
+             --  If Size is applied to a dereference of an access to
+             --  unconstrained packed array, GIGI needs to see its
+             --  unconstrained nominal type, but also a hint to the actual
+             --  constrained type.
+ 
+             if Nkind (Pref) = N_Explicit_Dereference
+               and then Is_Array_Type (Etype (Pref))
+               and then not Is_Constrained (Etype (Pref))
+               and then Is_Packed (Etype (Pref))
+             then
+                Set_Actual_Designated_Subtype (Pref,
+                  Get_Actual_Subtype (Pref));
+             end if;
+ 
              return;
           end if;
  
*************** package body Exp_Attr is
*** 3510,3516 ****
              if not Java_VM then
                 Rewrite (N,
                   Unchecked_Convert_To (RTE (RE_Tag),
!                    New_Reference_To (Access_Disp_Table (Ttyp), Loc)));
                 Analyze_And_Resolve (N, RTE (RE_Tag));
              end if;
  
--- 3617,3624 ----
              if not Java_VM then
                 Rewrite (N,
                   Unchecked_Convert_To (RTE (RE_Tag),
!                    New_Reference_To
!                      (Node (First_Elmt (Access_Disp_Table (Ttyp))), Loc)));
                 Analyze_And_Resolve (N, RTE (RE_Tag));
              end if;
  
*************** package body Exp_Attr is
*** 3519,3525 ****
                Make_Selected_Component (Loc,
                  Prefix => Relocate_Node (Pref),
                  Selector_Name =>
!                   New_Reference_To (Tag_Component (Ttyp), Loc)));
              Analyze_And_Resolve (N, RTE (RE_Tag));
           end if;
        end Tag;
--- 3627,3633 ----
                Make_Selected_Component (Loc,
                  Prefix => Relocate_Node (Pref),
                  Selector_Name =>
!                   New_Reference_To (First_Tag_Component (Ttyp), Loc)));
              Analyze_And_Resolve (N, RTE (RE_Tag));
           end if;
        end Tag;
*************** package body Exp_Attr is
*** 3528,3538 ****
        -- Terminated --
        ----------------
  
!       --  Transforms 'Terminated attribute into a call to Terminated function.
  
        when Attribute_Terminated => Terminated :
        begin
!          if Restricted_Profile then
              Rewrite (N,
                Build_Call_With_Task (Pref, RTE (RE_Restricted_Terminated)));
  
--- 3636,3667 ----
        -- Terminated --
        ----------------
  
!       --  Transforms 'Terminated attribute into a call to Terminated function
  
        when Attribute_Terminated => Terminated :
        begin
!          --  The prefix of Terminated is of a task interface class-wide type.
!          --  Generate:
! 
!          --    terminated (Pref._disp_get_task_id);
! 
!          if Ada_Version >= Ada_05
!            and then Ekind (Etype (Pref)) = E_Class_Wide_Type
!            and then Is_Interface      (Etype (Pref))
!            and then Is_Task_Interface (Etype (Pref))
!          then
!             Rewrite (N,
!               Make_Function_Call (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Terminated), Loc),
!                 Parameter_Associations => New_List (
!                   Make_Selected_Component (Loc,
!                     Prefix =>
!                       New_Copy_Tree (Pref),
!                     Selector_Name =>
!                       Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
! 
!          elsif Restricted_Profile then
              Rewrite (N,
                Build_Call_With_Task (Pref, RTE (RE_Restricted_Terminated)));
  
*************** package body Exp_Attr is
*** 3583,3589 ****
        ----------------------
  
        when Attribute_Unchecked_Access =>
!          Expand_Access_To_Type (N);
  
        -----------------
        -- UET_Address --
--- 3712,3737 ----
        ----------------------
  
        when Attribute_Unchecked_Access =>
! 
!          --  Ada 2005 (AI-251): If the designated type is an interface, then
!          --  rewrite the referenced object as a conversion to force the
!          --  displacement of the pointer to the secondary dispatch table.
! 
!          if Is_Interface (Directly_Designated_Type (Btyp)) then
!             declare
!                Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
!                Conversion : Node_Id;
!             begin
!                Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
!                Rewrite (N, Conversion);
!                Analyze_And_Resolve (N, Typ);
!             end;
! 
!          --  Otherwise this is like normal Access without a check
! 
!          else
!             Expand_Access_To_Type (N);
!          end if;
  
        -----------------
        -- UET_Address --
*************** package body Exp_Attr is
*** 3629,3635 ****
        -------------------------
  
        when Attribute_Unrestricted_Access =>
!          Expand_Access_To_Type (N);
  
        ---------------
        -- VADS_Size --
--- 3777,3802 ----
        -------------------------
  
        when Attribute_Unrestricted_Access =>
! 
!          --  Ada 2005 (AI-251): If the designated type is an interface, then
!          --  rewrite the referenced object as a conversion to force the
!          --  displacement of the pointer to the secondary dispatch table.
! 
!          if Is_Interface (Directly_Designated_Type (Btyp)) then
!             declare
!                Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
!                Conversion : Node_Id;
!             begin
!                Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
!                Rewrite (N, Conversion);
!                Analyze_And_Resolve (N, Typ);
!             end;
! 
!          --  Otherwise this is like Access without a check
! 
!          else
!             Expand_Access_To_Type (N);
!          end if;
  
        ---------------
        -- VADS_Size --
*************** package body Exp_Attr is
*** 3766,3801 ****
  
           if Is_Floating_Point_Type (Ptyp) then
              declare
!                Rtp : constant Entity_Id := Root_Type (Etype (Pref));
  
              begin
!                --  If the floating-point object might be unaligned, we need
!                --  to call the special routine Unaligned_Valid, which makes
!                --  the needed copy, being careful not to load the value into
!                --  any floating-point register. The argument in this case is
!                --  obj'Address (see Unchecked_Valid routine in s-fatgen.ads).
  
!                if Is_Possibly_Unaligned_Object (Pref) then
!                   Set_Attribute_Name (N, Name_Unaligned_Valid);
!                   Expand_Fpt_Attribute
!                     (N, Rtp, Name_Unaligned_Valid,
!                      New_List (
!                        Make_Attribute_Reference (Loc,
!                          Prefix         => Relocate_Node (Pref),
!                          Attribute_Name => Name_Address)));
  
!                --  In the normal case where we are sure the object is aligned,
!                --  we generate a caqll to Valid, and the argument in this case
!                --  is obj'Unrestricted_Access (after converting obj to the
!                --  right floating-point type).
  
                 else
!                   Expand_Fpt_Attribute
!                     (N, Rtp, Name_Valid,
!                      New_List (
!                        Make_Attribute_Reference (Loc,
!                          Prefix         => Unchecked_Convert_To (Rtp, Pref),
!                          Attribute_Name => Name_Unrestricted_Access)));
                 end if;
  
                 --  One more task, we still need a range check. Required
--- 3933,3982 ----
  
           if Is_Floating_Point_Type (Ptyp) then
              declare
!                Pkg : RE_Id;
!                Ftp : Entity_Id;
  
              begin
!                --  For vax fpt types, call appropriate routine in special vax
!                --  floating point unit. We do not have to worry about loads in
!                --  this case, since these types have no signalling NaN's.
  
!                if Vax_Float (Btyp) then
!                   Expand_Vax_Valid (N);
  
!                --  Non VAX float case
  
                 else
!                   Find_Fat_Info (Etype (Pref), Ftp, Pkg);
! 
!                   --  If the floating-point object might be unaligned, we need
!                   --  to call the special routine Unaligned_Valid, which makes
!                   --  the needed copy, being careful not to load the value into
!                   --  any floating-point register. The argument in this case is
!                   --  obj'Address (see Unchecked_Valid routine in Fat_Gen).
! 
!                   if Is_Possibly_Unaligned_Object (Pref) then
!                      Set_Attribute_Name (N, Name_Unaligned_Valid);
!                      Expand_Fpt_Attribute
!                        (N, Pkg, Name_Unaligned_Valid,
!                         New_List (
!                           Make_Attribute_Reference (Loc,
!                             Prefix => Relocate_Node (Pref),
!                             Attribute_Name => Name_Address)));
! 
!                   --  In the normal case where we are sure the object is
!                   --  aligned, we generate a call to Valid, and the argument in
!                   --  this case is obj'Unrestricted_Access (after converting
!                   --  obj to the right floating-point type).
! 
!                   else
!                      Expand_Fpt_Attribute
!                        (N, Pkg, Name_Valid,
!                         New_List (
!                           Make_Attribute_Reference (Loc,
!                             Prefix => Unchecked_Convert_To (Ftp, Pref),
!                             Attribute_Name => Name_Unrestricted_Access)));
!                   end if;
                 end if;
  
                 --  One more task, we still need a range check. Required
*************** package body Exp_Attr is
*** 3887,3895 ****
              Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
  
           --  For biased representations, we will be doing an unchecked
!          --  conversion without unbiasing the result. That means that
!          --  the range test has to take this into account, and the
!          --  proper form of the test is:
  
           --    Btyp!(Pref) < Btyp!(Ptyp'Range_Length)
  
--- 4068,4076 ----
              Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
  
           --  For biased representations, we will be doing an unchecked
!          --  conversion without unbiasing the result. That means that the range
!          --  test has to take this into account, and the proper form of the
!          --  test is:
  
           --    Btyp!(Pref) < Btyp!(Ptyp'Range_Length)
  
*************** package body Exp_Attr is
*** 3930,3947 ****
  
           --  Unsigned types. Note: it is safe to consider only whether the
           --  subtype is unsigned, since we will in that case be doing all
!          --  unsigned comparisons based on the subtype range. Since we use
!          --  the actual subtype object size, this is appropriate.
  
           --  For example, if we have
  
           --    subtype x is integer range 1 .. 200;
           --    for x'Object_Size use 8;
  
!          --  Now the base type is signed, but objects of this type are 8
!          --  bits unsigned, and doing an unsigned test of the range 1 to
!          --  200 is correct, even though a value greater than 127 looks
!          --  signed to a signed comparison.
  
           elsif Is_Unsigned_Type (Ptyp) then
              if Esize (Ptyp) <= 32 then
--- 4111,4128 ----
  
           --  Unsigned types. Note: it is safe to consider only whether the
           --  subtype is unsigned, since we will in that case be doing all
!          --  unsigned comparisons based on the subtype range. Since we use the
!          --  actual subtype object size, this is appropriate.
  
           --  For example, if we have
  
           --    subtype x is integer range 1 .. 200;
           --    for x'Object_Size use 8;
  
!          --  Now the base type is signed, but objects of this type are bits
!          --  unsigned, and doing an unsigned test of the range 1 to 200 is
!          --  correct, even though a value greater than 127 looks signed to a
!          --  signed comparison.
  
           elsif Is_Unsigned_Type (Ptyp) then
              if Esize (Ptyp) <= 32 then
*************** package body Exp_Attr is
*** 4194,4203 ****
  
              --     strmtyp'Output (Stream, strmwrite (acttyp (Item)));
  
!             --  where strmwrite is the given Write function that converts
!             --  an argument of type sourcetyp or a type acctyp, from which
!             --  it is derived to type strmtyp. The conversion to acttyp is
!             --  required for the derived case.
  
              Prag := Get_Stream_Convert_Pragma (P_Type);
  
--- 4375,4384 ----
  
              --     strmtyp'Output (Stream, strmwrite (acttyp (Item)));
  
!             --  where strmwrite is the given Write function that converts an
!             --  argument of type sourcetyp or a type acctyp, from which it is
!             --  derived to type strmtyp. The conversion to acttyp is required
!             --  for the derived case.
  
              Prag := Get_Stream_Convert_Pragma (P_Type);
  
*************** package body Exp_Attr is
*** 4278,4299 ****
           Rewrite_Stream_Proc_Call (Pname);
        end Write;
  
!       --  Component_Size is handled by Gigi, unless the component size is
!       --  known at compile time, which is always true in the packed array
!       --  case. It is important that the packed array case is handled in
!       --  the front end (see Eval_Attribute) since Gigi would otherwise
!       --  get confused by the equivalent packed array type.
  
        when Attribute_Component_Size =>
           null;
  
        --  The following attributes are handled by Gigi (except that static
!       --  cases have already been evaluated by the semantics, but in any
!       --  case Gigi should not count on that).
  
!       --  In addition Gigi handles the non-floating-point cases of Pred
!       --  and Succ (including the fixed-point cases, which can just be
!       --  treated as integer increment/decrement operations)
  
        --  Gigi also handles the non-class-wide cases of Size
  
--- 4459,4480 ----
           Rewrite_Stream_Proc_Call (Pname);
        end Write;
  
!       --  Component_Size is handled by Gigi, unless the component size is known
!       --  at compile time, which is always true in the packed array case. It is
!       --  important that the packed array case is handled in the front end (see
!       --  Eval_Attribute) since Gigi would otherwise get confused by the
!       --  equivalent packed array type.
  
        when Attribute_Component_Size =>
           null;
  
        --  The following attributes are handled by Gigi (except that static
!       --  cases have already been evaluated by the semantics, but in any case
!       --  Gigi should not count on that).
  
!       --  In addition Gigi handles the non-floating-point cases of Pred and
!       --  Succ (including the fixed-point cases, which can just be treated as
!       --  integer increment/decrement operations)
  
        --  Gigi also handles the non-class-wide cases of Size
  
*************** package body Exp_Attr is
*** 4423,4462 ****
            Reason => CE_Overflow_Check_Failed));
     end Expand_Pred_Succ;
  
!    ------------------------
!    -- Find_Inherited_TSS --
!    ------------------------
  
!    function Find_Inherited_TSS
!      (Typ : Entity_Id;
!       Nam : TSS_Name_Type) return Entity_Id
     is
!       Btyp : Entity_Id := Typ;
!       Proc : Entity_Id;
  
     begin
!       loop
!          Btyp := Base_Type (Btyp);
!          Proc :=  TSS (Btyp, Nam);
  
!          exit when Present (Proc)
!            or else not Is_Derived_Type (Btyp);
  
!          --  If Typ is a derived type, it may inherit attributes from
!          --  some ancestor.
  
!          Btyp := Etype (Btyp);
!       end loop;
  
!       if No (Proc) then
  
!          --  If nothing else, use the TSS of the root type
  
!          Proc := TSS (Base_Type (Underlying_Type (Typ)), Nam);
!       end if;
  
!       return Proc;
!    end Find_Inherited_TSS;
  
     ----------------------------
     -- Find_Stream_Subprogram --
--- 4604,4680 ----
            Reason => CE_Overflow_Check_Failed));
     end Expand_Pred_Succ;
  
!    -------------------
!    -- Find_Fat_Info --
!    -------------------
  
!    procedure Find_Fat_Info
!      (T        : Entity_Id;
!       Fat_Type : out Entity_Id;
!       Fat_Pkg  : out RE_Id)
     is
!       Btyp : constant Entity_Id := Base_Type (T);
!       Rtyp : constant Entity_Id := Root_Type (T);
!       Digs : constant Nat       := UI_To_Int (Digits_Value (Btyp));
  
     begin
!       --  If the base type is VAX float, then get appropriate VAX float type
  
!       if Vax_Float (Btyp) then
!          case Digs is
!             when 6 =>
!                Fat_Type := RTE (RE_Fat_VAX_F);
!                Fat_Pkg  := RE_Attr_VAX_F_Float;
  
!             when 9 =>
!                Fat_Type := RTE (RE_Fat_VAX_D);
!                Fat_Pkg  := RE_Attr_VAX_D_Float;
  
!             when 15 =>
!                Fat_Type := RTE (RE_Fat_VAX_G);
!                Fat_Pkg  := RE_Attr_VAX_G_Float;
  
!             when others =>
!                raise Program_Error;
!          end case;
  
!       --  If root type is VAX float, this is the case where the library has
!       --  been recompiled in VAX float mode, and we have an IEEE float type.
!       --  This is when we use the special IEEE Fat packages.
  
!       elsif Vax_Float (Rtyp) then
!          case Digs is
!             when 6 =>
!                Fat_Type := RTE (RE_Fat_IEEE_Short);
!                Fat_Pkg  := RE_Attr_IEEE_Short;
  
!             when 15 =>
!                Fat_Type := RTE (RE_Fat_IEEE_Long);
!                Fat_Pkg  := RE_Attr_IEEE_Long;
! 
!             when others =>
!                raise Program_Error;
!          end case;
! 
!       --  If neither the base type nor the root type is VAX_Float then VAX
!       --  float is out of the picture, and we can just use the root type.
! 
!       else
!          Fat_Type := Rtyp;
! 
!          if Fat_Type = Standard_Short_Float then
!             Fat_Pkg := RE_Attr_Short_Float;
!          elsif Fat_Type = Standard_Float then
!             Fat_Pkg := RE_Attr_Float;
!          elsif Fat_Type = Standard_Long_Float then
!             Fat_Pkg := RE_Attr_Long_Float;
!          elsif Fat_Type = Standard_Long_Long_Float then
!             Fat_Pkg := RE_Attr_Long_Long_Float;
!          else
!             raise Program_Error;
!          end if;
!       end if;
!    end Find_Fat_Info;
  
     ----------------------------
     -- Find_Stream_Subprogram --
*************** package body Exp_Attr is
*** 4464,4471 ****
  
     function Find_Stream_Subprogram
       (Typ : Entity_Id;
!       Nam : TSS_Name_Type) return Entity_Id is
     begin
        if Is_Tagged_Type (Typ)
          and then Is_Derived_Type (Typ)
        then
--- 4682,4695 ----
  
     function Find_Stream_Subprogram
       (Typ : Entity_Id;
!       Nam : TSS_Name_Type) return Entity_Id
!    is
!       Ent : constant Entity_Id := TSS (Typ, Nam);
     begin
+       if Present (Ent) then
+          return Ent;
+       end if;
+ 
        if Is_Tagged_Type (Typ)
          and then Is_Derived_Type (Typ)
        then
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_attr.ads gcc-4.1.0/gcc/ada/exp_attr.ads
*** gcc-4.0.2/gcc/ada/exp_attr.ads	Mon Jan  3 15:43:24 2005
--- gcc-4.1.0/gcc/ada/exp_attr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch10.ads gcc-4.1.0/gcc/ada/exp_ch10.ads
*** gcc-4.0.2/gcc/ada/exp_ch10.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch10.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch11.adb gcc-4.1.0/gcc/ada/exp_ch11.adb
*** gcc-4.0.2/gcc/ada/exp_ch11.adb	Thu Feb 10 13:50:42 2005
--- gcc-4.1.0/gcc/ada/exp_ch11.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Errout;   use Errout;
*** 32,39 ****
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Util; use Exp_Util;
  with Hostparm; use Hostparm;
- with Inline;   use Inline;
- with Lib;      use Lib;
  with Namet;    use Namet;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
--- 32,37 ----
*************** with Rtsfind;  use Rtsfind;
*** 42,48 ****
  with Restrict; use Restrict;
  with Rident;   use Rident;
  with Sem;      use Sem;
- with Sem_Ch5;  use Sem_Ch5;
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
--- 40,45 ----
*************** with Stringt;  use Stringt;
*** 54,91 ****
  with Targparm; use Targparm;
  with Tbuild;   use Tbuild;
  with Uintp;    use Uintp;
- with Uname;    use Uname;
  
  package body Exp_Ch11 is
  
-    SD_List : List_Id;
-    --  This list gathers the values SDn'Unrestricted_Access used to
-    --  construct the unit exception table. It is set to Empty_List if
-    --  there are no subprogram descriptors.
- 
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    procedure Expand_Exception_Handler_Tables (HSS : Node_Id);
-    --  Subsidiary procedure called by Expand_Exception_Handlers if zero
-    --  cost exception handling is installed for this target. Replaces the
-    --  exception handler structure with appropriate labeled code and tables
-    --  that allow the zero cost exception handling circuits to find the
-    --  correct handler (see unit Ada.Exceptions for details).
- 
-    procedure Generate_Subprogram_Descriptor
-      (N     : Node_Id;
-       Loc   : Source_Ptr;
-       Spec  : Entity_Id;
-       Slist : List_Id);
-    --  Procedure called to generate a subprogram descriptor. N is the
-    --  subprogram body node or, in the case of an imported subprogram, is
-    --  Empty, and Spec is the entity of the sunprogram. For details of the
-    --  required structure, see package System.Exceptions. The generated
-    --  subprogram descriptor is appended to Slist. Loc provides the
-    --  source location to be used for the generated descriptor.
- 
     ---------------------------
     -- Expand_At_End_Handler --
     ---------------------------
--- 51,59 ----
*************** package body Exp_Ch11 is
*** 130,136 ****
  
        --  Don't expand if back end exception handling active
  
!       if Exception_Mechanism = Back_End_ZCX_Exceptions then
           return;
        end if;
  
--- 98,104 ----
  
        --  Don't expand if back end exception handling active
  
!       if Exception_Mechanism = Back_End_Exceptions then
           return;
        end if;
  
*************** package body Exp_Ch11 is
*** 172,669 ****
        end if;
     end Expand_At_End_Handler;
  
-    -------------------------------------
-    -- Expand_Exception_Handler_Tables --
-    -------------------------------------
- 
-    --  See Ada.Exceptions specification for full details of the data
-    --  structures that we need to construct here. As an example of the
-    --  transformation that is required, given the structure:
- 
-    --     declare
-    --        {declarations}
-    --        ..
-    --     begin
-    --        {statements-1}
-    --        ...
-    --     exception
-    --        when a | b =>
-    --           {statements-2}
-    --           ...
-    --        when others =>
-    --           {statements-3}
-    --           ...
-    --     end;
- 
-    --  We transform this into:
- 
-    --     declare
-    --        {declarations}
-    --        ...
-    --        L1 : label;
-    --        L2 : label;
-    --        L3 : label;
-    --        L4 : Label;
-    --        L5 : label;
- 
-    --     begin
-    --        <<L1>>
-    --           {statements-1}
-    --        <<L2>>
- 
-    --     exception
- 
-    --        when a | b =>
-    --           <<L3>>
-    --           {statements-2}
- 
-    --           HR2 : constant Handler_Record := (
-    --                   Lo      => L1'Address,
-    --                   Hi      => L2'Address,
-    --                   Id      => a'Identity,
-    --                   Handler => L5'Address);
- 
-    --           HR3 : constant Handler_Record := (
-    --                   Lo      => L1'Address,
-    --                   Hi      => L2'Address,
-    --                   Id      => b'Identity,
-    --                   Handler => L4'Address);
- 
-    --        when others =>
-    --           <<L4>>
-    --           {statements-3}
- 
-    --           HR1 : constant Handler_Record := (
-    --                   Lo      => L1'Address,
-    --                   Hi      => L2'Address,
-    --                   Id      => Others_Id,
-    --                   Handler => L4'Address);
-    --     end;
- 
-    --  The exception handlers in the transformed version are marked with the
-    --  Zero_Cost_Handling flag set, and all gigi does in this case is simply
-    --  to put the handler code somewhere. It can optionally be put inline
-    --  between the goto L3 and the label <<L3>> (which is why we generate
-    --  that goto in the first place).
- 
-    procedure Expand_Exception_Handler_Tables (HSS : Node_Id) is
-       Loc     : constant Source_Ptr := Sloc (HSS);
-       Handlrs : constant List_Id    := Exception_Handlers (HSS);
-       Stms    : constant List_Id    := Statements (HSS);
-       Handler : Node_Id;
- 
-       Hlist : List_Id;
-       --  This is the list to which handlers are to be appended. It is
-       --  either the list for the enclosing subprogram, or the enclosing
-       --  selective accept statement (which will turn into a subprogram
-       --  during expansion later on).
- 
-       L1 : constant Entity_Id :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_Internal_Name ('L'));
- 
-       L2 : constant Entity_Id :=
-              Make_Defining_Identifier (Loc,
-                Chars => New_Internal_Name ('L'));
- 
-       Lnn    : Entity_Id;
-       Choice : Node_Id;
-       E_Id   : Node_Id;
-       HR_Ent : Node_Id;
-       HL_Ref : Node_Id;
-       Item   : Node_Id;
- 
-       Subp_Entity : Entity_Id;
-       --  This is the entity for the subprogram (or library level package)
-       --  to which the handler record is to be attached for later reference
-       --  in a subprogram descriptor for this entity.
- 
-       procedure Append_To_Stms (N : Node_Id);
-       --  Append given statement to the end of the statements of the
-       --  handled sequence of statements and analyze it in place.
- 
-       function Inside_Selective_Accept return Boolean;
-       --  This function is called if we are inside the scope of an entry
-       --  or task. It checks if the handler is appearing in the context
-       --  of a selective accept statement. If so, Hlist is set to
-       --  temporarily park the handlers in the N_Accept_Alternative.
-       --  node. They will subsequently be moved to the procedure entity
-       --  for the procedure built for this alternative. The statements that
-       --  follow the Accept within the alternative are not inside the Accept
-       --  for purposes of this test, and handlers that may appear within
-       --  them belong in the enclosing task procedure.
- 
-       procedure Set_Hlist;
-       --  Sets the handler list corresponding to Subp_Entity
- 
-       --------------------
-       -- Append_To_Stms --
-       --------------------
- 
-       procedure Append_To_Stms (N : Node_Id) is
-       begin
-          Insert_After_And_Analyze (Last (Stms), N);
-          Set_Exception_Junk (N);
-       end Append_To_Stms;
- 
-       -----------------------------
-       -- Inside_Selective_Accept --
-       -----------------------------
- 
-       function Inside_Selective_Accept return Boolean is
-          Parnt : Node_Id;
-          Curr  : Node_Id := HSS;
- 
-       begin
-          Parnt := Parent (HSS);
-          while Nkind (Parnt) /= N_Compilation_Unit loop
-             if Nkind (Parnt) = N_Accept_Alternative
-               and then Curr = Accept_Statement (Parnt)
-             then
-                if Present (Accept_Handler_Records (Parnt)) then
-                   Hlist := Accept_Handler_Records (Parnt);
-                else
-                   Hlist := New_List;
-                   Set_Accept_Handler_Records (Parnt, Hlist);
-                end if;
- 
-                return True;
-             else
-                Curr  := Parnt;
-                Parnt := Parent (Parnt);
-             end if;
-          end loop;
- 
-          return False;
-       end Inside_Selective_Accept;
- 
-       ---------------
-       -- Set_Hlist --
-       ---------------
- 
-       procedure Set_Hlist is
-       begin
-          --  Never try to inline a subprogram with exception handlers
- 
-          Set_Is_Inlined (Subp_Entity, False);
- 
-          if Present (Subp_Entity)
-            and then Present (Handler_Records (Subp_Entity))
-          then
-             Hlist := Handler_Records (Subp_Entity);
-          else
-             Hlist := New_List;
-             Set_Handler_Records (Subp_Entity, Hlist);
-          end if;
-       end Set_Hlist;
- 
-    --  Start of processing for Expand_Exception_Handler_Tables
- 
-    begin
-       --  Nothing to do if this handler has already been processed
- 
-       if Zero_Cost_Handling (HSS) then
-          return;
-       end if;
- 
-       Set_Zero_Cost_Handling (HSS);
- 
-       --  Find the parent subprogram or package scope containing this
-       --  exception frame. This should always find a real package or
-       --  subprogram. If it does not it will stop at Standard, but
-       --  this cannot legitimately occur.
- 
-       --  We only stop at library level packages, for inner packages
-       --  we always attach handlers to the containing procedure.
- 
-       Subp_Entity := Current_Scope;
-       Scope_Loop : loop
- 
-          --  Never need tables expanded inside a generic template
- 
-          if Is_Generic_Unit (Subp_Entity) then
-             return;
- 
-          --  Stop if we reached containing subprogram. Go to protected
-          --  subprogram if there is one defined.
- 
-          elsif Ekind (Subp_Entity) = E_Function
-            or else Ekind (Subp_Entity) = E_Procedure
-          then
-             if Present (Protected_Body_Subprogram (Subp_Entity)) then
-                Subp_Entity := Protected_Body_Subprogram (Subp_Entity);
-             end if;
- 
-             Set_Hlist;
-             exit Scope_Loop;
- 
-          --  Case of within an entry
- 
-          elsif Is_Entry (Subp_Entity) then
- 
-             --  Protected entry, use corresponding body subprogram
- 
-             if Present (Protected_Body_Subprogram (Subp_Entity)) then
-                Subp_Entity := Protected_Body_Subprogram (Subp_Entity);
-                Set_Hlist;
-                exit Scope_Loop;
- 
-             --  Check if we are within a selective accept alternative
- 
-             elsif Inside_Selective_Accept then
- 
-                --  As a side effect, Inside_Selective_Accept set Hlist,
-                --  in much the same manner as Set_Hlist, except that
-                --  the list involved was the one for the selective accept.
- 
-                exit Scope_Loop;
-             end if;
- 
-          --  Case of within library level package
- 
-          elsif Ekind (Subp_Entity) = E_Package
-            and then Is_Compilation_Unit (Subp_Entity)
-          then
-             if Is_Body_Name (Unit_Name (Get_Code_Unit (HSS))) then
-                Subp_Entity := Body_Entity (Subp_Entity);
-             end if;
- 
-             Set_Hlist;
-             exit Scope_Loop;
- 
-          --  Task type case
- 
-          elsif Ekind (Subp_Entity) = E_Task_Type then
- 
-             --  Check if we are within a selective accept alternative
- 
-             if Inside_Selective_Accept then
- 
-                --  As a side effect, Inside_Selective_Accept set Hlist,
-                --  in much the same manner as Set_Hlist, except that the
-                --  list involved was the one for the selective accept.
- 
-                exit Scope_Loop;
- 
-             --  Stop if we reached task type with task body procedure,
-             --  use the task body procedure.
- 
-             elsif Present (Get_Task_Body_Procedure (Subp_Entity)) then
-                Subp_Entity := Get_Task_Body_Procedure (Subp_Entity);
-                Set_Hlist;
-                exit Scope_Loop;
-             end if;
-          end if;
- 
-          --  If we fall through, keep looking
- 
-          Subp_Entity := Scope (Subp_Entity);
-       end loop Scope_Loop;
- 
-       pragma Assert (Subp_Entity /= Standard_Standard);
- 
-       --  Analyze standard labels
- 
-       Analyze_Label_Entity (L1);
-       Analyze_Label_Entity (L2);
- 
-       Insert_Before_And_Analyze (First (Stms),
-         Make_Label (Loc,
-           Identifier => New_Occurrence_Of (L1, Loc)));
-       Set_Exception_Junk (First (Stms));
- 
-       Append_To_Stms (
-         Make_Label (Loc,
-           Identifier => New_Occurrence_Of (L2, Loc)));
- 
-       --  Loop through exception handlers
- 
-       Handler := First_Non_Pragma (Handlrs);
-       while Present (Handler) loop
-          Set_Zero_Cost_Handling (Handler);
- 
-          --  Add label at start of handler, and goto at the end
- 
-          Lnn :=
-            Make_Defining_Identifier (Loc,
-              Chars => New_Internal_Name ('L'));
- 
-          Analyze_Label_Entity (Lnn);
- 
-          Item :=
-            Make_Label (Loc,
-              Identifier => New_Occurrence_Of (Lnn, Loc));
-          Set_Exception_Junk (Item);
-          Insert_Before_And_Analyze (First (Statements (Handler)), Item);
- 
-          --  Loop through choices
- 
-          Choice := First (Exception_Choices (Handler));
-          while Present (Choice) loop
- 
-             --  Others (or all others) choice
- 
-             if Nkind (Choice) = N_Others_Choice then
-                if All_Others (Choice) then
-                   E_Id := New_Occurrence_Of (RTE (RE_All_Others_Id), Loc);
-                else
-                   E_Id := New_Occurrence_Of (RTE (RE_Others_Id), Loc);
-                end if;
- 
-             --  Special case of VMS_Exception. Not clear what we will do
-             --  eventually here if and when we implement zero cost exceptions
-             --  on VMS. But at least for now, don't blow up trying to take
-             --  a garbage code address for such an exception.
- 
-             elsif Is_VMS_Exception (Entity (Choice)) then
-                E_Id := New_Occurrence_Of (RTE (RE_Null_Id), Loc);
- 
-             --  Normal case of specific exception choice
- 
-             else
-                E_Id :=
-                  Make_Attribute_Reference (Loc,
-                    Prefix => New_Occurrence_Of (Entity (Choice), Loc),
-                    Attribute_Name => Name_Identity);
-             end if;
- 
-             HR_Ent :=
-               Make_Defining_Identifier (Loc,
-                 Chars => New_Internal_Name ('H'));
- 
-             HL_Ref :=
-               Make_Attribute_Reference (Loc,
-                 Prefix => New_Occurrence_Of (HR_Ent, Loc),
-                 Attribute_Name => Name_Unrestricted_Access);
- 
-             --  Now we need to add the entry for the new handler record to
-             --  the list of handler records for the current subprogram.
- 
-             --  Normally we end up generating the handler records in exactly
-             --  the right order. Here right order means innermost first,
-             --  since the table will be searched sequentially. Since we
-             --  generally expand from outside to inside, the order is just
-             --  what we want, and we need to append the new entry to the
-             --  end of the list.
- 
-             --  However, there are exceptions, notably in the case where
-             --  a generic body is inserted later on. See for example the
-             --  case of ACVC test C37213J, which has the following form:
- 
-             --    generic package x ... end x;
-             --    package body x is
-             --    begin
-             --       ...
-             --    exception  (1)
-             --       ...
-             --    end x;
- 
-             --    ...
- 
-             --    declare
-             --       package q is new x;
-             --    begin
-             --       ...
-             --    exception (2)
-             --       ...
-             --    end;
- 
-             --  In this case, we will expand exception handler (2) first,
-             --  since the expansion of (1) is delayed till later when the
-             --  generic body is inserted. But (1) belongs before (2) in
-             --  the chain.
- 
-             --  Note that scopes are not totally ordered, because two
-             --  scopes can be in parallel blocks, so that it does not
-             --  matter what order these entries appear in. An ordering
-             --  relation exists if one scope is inside another, and what
-             --  we really want is some partial ordering.
- 
-             --  A simple, not very efficient, but adequate algorithm to
-             --  achieve this partial ordering is to search the list for
-             --  the first entry containing the given scope, and put the
-             --  new entry just before it.
- 
-             declare
-                New_Scop : constant Entity_Id := Current_Scope;
-                Ent      : Node_Id;
- 
-             begin
-                Ent := First (Hlist);
-                loop
-                   --  If all searched, then we can just put the new
-                   --  entry at the end of the list (it actually does
-                   --  not matter where we put it in this case).
- 
-                   if No (Ent) then
-                      Append_To (Hlist, HL_Ref);
-                      exit;
- 
-                   --  If the current scope is within the scope of the
-                   --  entry then insert the entry before to retain the
-                   --  proper order as per above discussion.
- 
-                   --  Note that for equal entries, we just keep going,
-                   --  which is fine, the entry will end up at the end
-                   --  of the list where it belongs.
- 
-                   elsif Scope_Within
-                           (New_Scop, Scope (Entity (Prefix (Ent))))
-                   then
-                      Insert_Before (Ent, HL_Ref);
-                      exit;
- 
-                   --  Otherwise keep looking
- 
-                   else
-                      Next (Ent);
-                   end if;
-                end loop;
-             end;
- 
-             Item :=
-               Make_Object_Declaration (Loc,
-                 Defining_Identifier => HR_Ent,
-                 Constant_Present    => True,
-                 Aliased_Present     => True,
-                 Object_Definition   =>
-                   New_Occurrence_Of (RTE (RE_Handler_Record), Loc),
- 
-                 Expression          =>
-                   Make_Aggregate (Loc,
-                     Expressions => New_List (
-                       Make_Attribute_Reference (Loc,             -- Lo
-                         Prefix => New_Occurrence_Of (L1, Loc),
-                         Attribute_Name => Name_Address),
- 
-                       Make_Attribute_Reference (Loc,             -- Hi
-                         Prefix => New_Occurrence_Of (L2, Loc),
-                         Attribute_Name => Name_Address),
- 
-                       E_Id,                                      -- Id
- 
-                       Make_Attribute_Reference (Loc,
-                         Prefix => New_Occurrence_Of (Lnn, Loc),  -- Handler
-                         Attribute_Name => Name_Address))));
- 
-             Set_Handler_List_Entry (Item, HL_Ref);
-             Set_Exception_Junk (Item);
-             Insert_After_And_Analyze (Last (Statements (Handler)), Item);
-             Set_Is_Statically_Allocated (HR_Ent);
- 
-             --  If this is a late insertion (from body instance) it is being
-             --  inserted in the component list of an already analyzed aggre-
-             --  gate, and must be analyzed explicitly.
- 
-             Analyze_And_Resolve (HL_Ref, RTE (RE_Handler_Record_Ptr));
- 
-             Next (Choice);
-          end loop;
- 
-          Next_Non_Pragma (Handler);
-       end loop;
-    end Expand_Exception_Handler_Tables;
- 
     -------------------------------
     -- Expand_Exception_Handlers --
     -------------------------------
--- 140,145 ----
*************** package body Exp_Ch11 is
*** 730,736 ****
              end;
           end if;
  
- 
           --  If an exception occurrence is present, then we must declare it
           --  and initialize it from the value stored in the TSD
  
--- 206,211 ----
*************** package body Exp_Ch11 is
*** 851,863 ****
        then
           Set_Exception_Handlers (HSS, No_List);
        end if;
- 
-       --  The last step for expanding exception handlers is to expand the
-       --  exception tables if zero cost exception handling is active.
- 
-       if Exception_Mechanism = Front_End_ZCX_Exceptions then
-          Expand_Exception_Handler_Tables (HSS);
-       end if;
     end Expand_Exception_Handlers;
  
     ------------------------------------
--- 326,331 ----
*************** package body Exp_Ch11 is
*** 1067,1072 ****
--- 535,563 ----
        Str   : String_Id;
  
     begin
+       --  If a string expression is present, then the raise statement is
+       --  converted to a call:
+ 
+       --     Raise_Exception (exception-name'Identity, string);
+ 
+       --  and there is nothing else to do
+ 
+       if Present (Expression (N)) then
+          Rewrite (N,
+            Make_Procedure_Call_Statement (Loc,
+              Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc),
+              Parameter_Associations => New_List (
+                Make_Attribute_Reference (Loc,
+                  Prefix => Name (N),
+                  Attribute_Name => Name_Identity),
+                Expression (N))));
+          Analyze (N);
+          return;
+       end if;
+ 
+       --  Remaining processing is for the case where no string expression
+       --  is present.
+ 
        --  There is no expansion needed for statement "raise <exception>;" when
        --  compiling for the JVM since the JVM has a built-in exception
        --  mechanism. However we need the keep the expansion for "raise;"
*************** package body Exp_Ch11 is
*** 1152,1158 ****
                 Name_Buffer (Name_Len) := ASCII.NUL;
              end if;
  
- 
              if Opt.Exception_Locations_Suppressed then
                 Name_Len := 0;
              end if;
--- 643,648 ----
*************** package body Exp_Ch11 is
*** 1310,1883 ****
        Analyze_And_Resolve (N, RTE (RE_Code_Loc));
     end Expand_N_Subprogram_Info;
  
-    ------------------------------------
-    -- Generate_Subprogram_Descriptor --
-    ------------------------------------
- 
-    procedure Generate_Subprogram_Descriptor
-      (N     : Node_Id;
-       Loc   : Source_Ptr;
-       Spec  : Entity_Id;
-       Slist : List_Id)
-    is
-       Code  : Node_Id;
-       Ent   : Entity_Id;
-       Decl  : Node_Id;
-       Dtyp  : Entity_Id;
-       Numh  : Nat;
-       Sdes  : Node_Id;
-       Hrc   : List_Id;
- 
-    begin
-       if Exception_Mechanism /= Front_End_ZCX_Exceptions then
-          return;
-       end if;
- 
-       if Restriction_Active (No_Exception_Handlers) then
-          return;
-       end if;
- 
-       --  Suppress descriptor if we are not generating code. This happens
-       --  in the case of a -gnatc -gnatt compilation where we force generics
-       --  to be generated, but we still don't want exception tables.
- 
-       if Operating_Mode /= Generate_Code then
-          return;
-       end if;
- 
-       --  Suppress descriptor if we are in No_Exceptions restrictions mode,
-       --  since we can never propagate exceptions in any case in this mode.
-       --  The same consideration applies for No_Exception_Handlers (which
-       --  is also set in High_Integrity_Mode).
- 
-       if Restriction_Active (No_Exceptions)
-         or Restriction_Active (No_Exception_Handlers)
-       then
-          return;
-       end if;
- 
-       --  Suppress descriptor if we are inside a generic. There are two
-       --  ways that we can tell that, depending on what is going on. If
-       --  we are actually inside the processing for a generic right now,
-       --  then Expander_Active will be reset. If we are outside the
-       --  generic, then we will see the generic entity.
- 
-       if not Expander_Active then
-          return;
-       end if;
- 
-       --  Suppress descriptor is subprogram is marked as eliminated, for
-       --  example if this is a subprogram created to analyze a default
-       --  expression with potential side effects. Ditto if it is nested
-       --  within an eliminated subprogram, for example a cleanup action.
- 
-       declare
-          Scop : Entity_Id;
- 
-       begin
-          Scop := Spec;
-          while Scop /= Standard_Standard loop
-             if Is_Generic_Unit (Scop) or else Is_Eliminated (Scop) then
-                return;
-             end if;
- 
-             Scop := Scope (Scop);
-          end loop;
-       end;
- 
-       --  Suppress descriptor for original protected subprogram (we will
-       --  be called again later to generate the descriptor for the actual
-       --  protected body subprogram.) This does not apply to barrier
-       --  functions which are there own protected subprogram.
- 
-       if Is_Subprogram (Spec)
-         and then Present (Protected_Body_Subprogram (Spec))
-         and then Protected_Body_Subprogram (Spec) /= Spec
-       then
-          return;
-       end if;
- 
-       --  Suppress descriptors for packages unless they have at least one
-       --  handler. The binder will generate the dummy (no handler) descriptors
-       --  for elaboration procedures. We can't do it here, because we don't
-       --  know if an elaboration routine does in fact exist.
- 
-       --  If there is at least one handler for the package spec or body
-       --  then most certainly an elaboration routine must exist, so we
-       --  can safely reference it.
- 
-       if (Nkind (N) = N_Package_Declaration
-             or else
-           Nkind (N) = N_Package_Body)
-         and then No (Handler_Records (Spec))
-       then
-          return;
-       end if;
- 
-       --  Suppress all subprogram descriptors for the file System.Exceptions.
-       --  We similarly suppress subprogram descriptors for Ada.Exceptions.
-       --  These are all init procs for types which cannot raise exceptions.
-       --  The reason this is done is that otherwise we get embarassing
-       --  elaboration dependencies.
- 
-       Get_Name_String (Unit_File_Name (Current_Sem_Unit));
- 
-       if Name_Buffer (1 .. 12) = "s-except.ads"
-            or else
-          Name_Buffer (1 .. 12) = "a-except.ads"
-       then
-          return;
-       end if;
- 
-       --  Similarly, we need to suppress entries for System.Standard_Library,
-       --  since otherwise we get elaboration circularities. Again, this would
-       --  better be done with a Suppress_Initialization pragma :-)
- 
-       if Name_Buffer (1 .. 11) = "s-stalib.ad" then
-          return;
-       end if;
- 
-       --  For now, also suppress entries for s-stoele because we have
-       --  some kind of unexplained error there ???
- 
-       if Name_Buffer (1 .. 11) = "s-stoele.ad" then
-          return;
-       end if;
- 
-       --  And also for g-htable, because it cannot raise exceptions,
-       --  and generates some kind of elaboration order problem.
- 
-       if Name_Buffer (1 .. 11) = "g-htable.ad" then
-          return;
-       end if;
- 
-       --  Suppress subprogram descriptor if already generated. This happens
-       --  in the case of late generation from Delay_Subprogram_Descriptors
-       --  beging set (where there is more than one instantiation in the list)
- 
-       if Has_Subprogram_Descriptor (Spec) then
-          return;
-       else
-          Set_Has_Subprogram_Descriptor (Spec);
-       end if;
- 
-       --  Never generate descriptors for inlined bodies
- 
-       if Analyzing_Inlined_Bodies then
-          return;
-       end if;
- 
-       --  Here we definitely are going to generate a subprogram descriptor
- 
-       declare
-          Hnum : Nat := Homonym_Number (Spec);
- 
-       begin
-          if Hnum = 1 then
-             Hnum := 0;
-          end if;
- 
-          Ent :=
-            Make_Defining_Identifier (Loc,
-              Chars => New_External_Name (Chars (Spec), "SD", Hnum));
-       end;
- 
-       if No (Handler_Records (Spec)) then
-          Hrc  := Empty_List;
-          Numh := 0;
-       else
-          Hrc  := Handler_Records (Spec);
-          Numh := List_Length (Hrc);
-       end if;
- 
-       New_Scope (Spec);
- 
-       --  We need a static subtype for the declaration of the subprogram
-       --  descriptor. For the case of 0-3 handlers we can use one of the
-       --  predefined subtypes in System.Exceptions. For more handlers,
-       --  we build our own subtype here.
- 
-       case Numh is
-          when 0 =>
-             Dtyp := RTE (RE_Subprogram_Descriptor_0);
- 
-          when 1 =>
-             Dtyp := RTE (RE_Subprogram_Descriptor_1);
- 
-          when 2 =>
-             Dtyp := RTE (RE_Subprogram_Descriptor_2);
- 
-          when 3 =>
-             Dtyp := RTE (RE_Subprogram_Descriptor_3);
- 
-          when others =>
-             Dtyp :=
-               Make_Defining_Identifier (Loc,
-                 Chars => New_Internal_Name ('T'));
- 
-             --  Set the constructed type as global, since we will be
-             --  referencing the object that is of this type globally
- 
-             Set_Is_Statically_Allocated (Dtyp);
- 
-             Decl :=
-               Make_Subtype_Declaration (Loc,
-                 Defining_Identifier => Dtyp,
-                 Subtype_Indication =>
-                   Make_Subtype_Indication (Loc,
-                     Subtype_Mark =>
-                       New_Occurrence_Of (RTE (RE_Subprogram_Descriptor), Loc),
-                     Constraint =>
-                       Make_Index_Or_Discriminant_Constraint (Loc,
-                         Constraints => New_List (
-                           Make_Integer_Literal (Loc, Numh)))));
- 
-             Append (Decl, Slist);
- 
-             --  We analyze the descriptor for the subprogram and package
-             --  case, but not for the imported subprogram case (it will
-             --  be analyzed when the freeze entity actions are analyzed.
- 
-             if Present (N) then
-                Analyze (Decl);
-             end if;
- 
-             Set_Exception_Junk (Decl);
-       end case;
- 
-       --  Prepare the code address entry for the table entry. For the normal
-       --  case of being within a procedure, this is simply:
- 
-       --    P'Code_Address
- 
-       --  where P is the procedure, but for the package case, it is
- 
-       --    P'Elab_Body'Code_Address
-       --    P'Elab_Spec'Code_Address
- 
-       --  for the body and spec respectively. Note that we do our own
-       --  analysis of these attribute references, because we know in this
-       --  case that the prefix of ELab_Body/Spec is a visible package,
-       --  which can be referenced directly instead of using the general
-       --  case expansion for these attributes.
- 
-       if Ekind (Spec) = E_Package then
-          Code :=
-            Make_Attribute_Reference (Loc,
-              Prefix         => New_Occurrence_Of (Spec, Loc),
-              Attribute_Name => Name_Elab_Spec);
-          Set_Etype (Code, Standard_Void_Type);
-          Set_Analyzed (Code);
- 
-       elsif Ekind (Spec) = E_Package_Body then
-          Code :=
-            Make_Attribute_Reference (Loc,
-              Prefix         => New_Occurrence_Of (Spec_Entity (Spec), Loc),
-              Attribute_Name => Name_Elab_Body);
-          Set_Etype (Code, Standard_Void_Type);
-          Set_Analyzed (Code);
- 
-       else
-          Code := New_Occurrence_Of (Spec, Loc);
-       end if;
- 
-       Code :=
-         Make_Attribute_Reference (Loc,
-           Prefix         => Code,
-           Attribute_Name => Name_Code_Address);
- 
-       Set_Etype (Code, RTE (RE_Address));
-       Set_Analyzed (Code);
- 
-       --  Now we can build the subprogram descriptor
- 
-       Sdes :=
-         Make_Object_Declaration (Loc,
-           Defining_Identifier      => Ent,
-           Constant_Present         => True,
-           Aliased_Present          => True,
-           Object_Definition        => New_Occurrence_Of (Dtyp, Loc),
- 
-           Expression               =>
-             Make_Aggregate (Loc,
-               Expressions => New_List (
-                 Make_Integer_Literal (Loc, Numh),          -- Num_Handlers
- 
-                 Code,                                      -- Code
- 
- --  temp code ???
- 
- --                Make_Subprogram_Info (Loc,                 -- Subprogram_Info
- --                  Identifier =>
- --                    New_Occurrence_Of (Spec, Loc)),
- 
-                 New_Copy_Tree (Code),
- 
-                 Make_Aggregate (Loc,                       -- Handler_Records
-                   Expressions => Hrc))));
- 
-       Set_Exception_Junk (Sdes);
-       Set_Is_Subprogram_Descriptor (Sdes);
- 
-       Append (Sdes, Slist);
- 
-       --  We analyze the descriptor for the subprogram and package case,
-       --  but not for the imported subprogram case (it will be analyzed
-       --  when the freeze entity actions are analyzed.
- 
-       if Present (N) then
-          Analyze (Sdes);
-       end if;
- 
-       --  We can now pop the scope used for analyzing the descriptor
- 
-       Pop_Scope;
- 
-       --  We need to set the descriptor as statically allocated, since
-       --  it will be referenced from the unit exception table.
- 
-       Set_Is_Statically_Allocated (Ent);
- 
-       --  Append the resulting descriptor to the list. We do this only
-       --  if we are in the main unit. You might think that we could
-       --  simply skip generating the descriptors completely if we are
-       --  not in the main unit, but in fact this is not the case, since
-       --  we have problems with inconsistent serial numbers for internal
-       --  names if we do this.
- 
-       if In_Extended_Main_Code_Unit (Spec) then
-          Append_To (SD_List,
-            Make_Attribute_Reference (Loc,
-              Prefix => New_Occurrence_Of (Ent, Loc),
-              Attribute_Name => Name_Unrestricted_Access));
- 
-          Unit_Exception_Table_Present := True;
-       end if;
- 
-    end Generate_Subprogram_Descriptor;
- 
-    ------------------------------------------------------------
-    -- Generate_Subprogram_Descriptor_For_Imported_Subprogram --
-    ------------------------------------------------------------
- 
-    procedure Generate_Subprogram_Descriptor_For_Imported_Subprogram
-      (Spec  : Entity_Id;
-       Slist : List_Id)
-    is
-    begin
-       Generate_Subprogram_Descriptor (Empty, Sloc (Spec), Spec, Slist);
-    end Generate_Subprogram_Descriptor_For_Imported_Subprogram;
- 
-    ------------------------------------------------
-    -- Generate_Subprogram_Descriptor_For_Package --
-    ------------------------------------------------
- 
-    procedure Generate_Subprogram_Descriptor_For_Package
-      (N    : Node_Id;
-       Spec : Entity_Id)
-    is
-       Adecl : Node_Id;
- 
-    begin
-       --  If N is empty with prior errors, ignore
- 
-       if Total_Errors_Detected /= 0 and then No (N) then
-          return;
-       end if;
- 
-       --  Do not generate if no exceptions
- 
-       if Restriction_Active (No_Exception_Handlers) then
-          return;
-       end if;
- 
-       --  Otherwise generate descriptor
- 
-       Adecl := Aux_Decls_Node (Parent (N));
- 
-       if No (Actions (Adecl)) then
-          Set_Actions (Adecl, New_List);
-       end if;
- 
-       Generate_Subprogram_Descriptor (N, Sloc (N), Spec, Actions (Adecl));
-    end Generate_Subprogram_Descriptor_For_Package;
- 
-    ---------------------------------------------------
-    -- Generate_Subprogram_Descriptor_For_Subprogram --
-    ---------------------------------------------------
- 
-    procedure Generate_Subprogram_Descriptor_For_Subprogram
-      (N    : Node_Id;
-       Spec : Entity_Id)
-    is
-    begin
-       --  If we have no subprogram body and prior errors, ignore
- 
-       if Total_Errors_Detected /= 0 and then No (N) then
-          return;
-       end if;
- 
-       --  Do not generate if no exceptions
- 
-       if Restriction_Active (No_Exception_Handlers) then
-          return;
-       end if;
- 
-       --  Else generate descriptor
- 
-       declare
-          HSS : constant Node_Id := Handled_Statement_Sequence (N);
- 
-       begin
-          if No (Exception_Handlers (HSS)) then
-             Generate_Subprogram_Descriptor
-               (N, Sloc (N), Spec, Statements (HSS));
-          else
-             Generate_Subprogram_Descriptor
-               (N, Sloc (N),
-                Spec, Statements (Last (Exception_Handlers (HSS))));
-          end if;
-       end;
-    end Generate_Subprogram_Descriptor_For_Subprogram;
- 
-    -----------------------------------
-    -- Generate_Unit_Exception_Table --
-    -----------------------------------
- 
-    --  The only remaining thing to generate here is to generate the
-    --  reference to the subprogram descriptor chain. See Ada.Exceptions
-    --  for details of required data structures.
- 
-    procedure Generate_Unit_Exception_Table is
-       Loc      : constant Source_Ptr := No_Location;
-       Num      : Nat;
-       Decl     : Node_Id;
-       Ent      : Entity_Id;
-       Next_Ent : Entity_Id;
-       Stent    : Entity_Id;
- 
-    begin
-       --  Nothing to be done if zero length exceptions not active
- 
-       if Exception_Mechanism /= Front_End_ZCX_Exceptions then
-          return;
-       end if;
- 
-       --  Nothing to do if no exceptions
- 
-       if Restriction_Active (No_Exception_Handlers) then
-          return;
-       end if;
- 
-       --  Remove any entries from SD_List that correspond to eliminated
-       --  subprograms.
- 
-       Ent := First (SD_List);
-       while Present (Ent) loop
-          Next_Ent := Next (Ent);
-          if Is_Eliminated (Scope (Entity (Prefix (Ent)))) then
-             Remove (Ent); -- After this, there is no Next (Ent) anymore
-          end if;
- 
-          Ent := Next_Ent;
-       end loop;
- 
-       --  Nothing to do if no unit exception table present.
-       --  An empty table can result from subprogram elimination,
-       --  in such a case, eliminate the exception table itself.
- 
-       if Is_Empty_List (SD_List) then
-          Unit_Exception_Table_Present := False;
-          return;
-       end if;
- 
-       --  Do not generate table in a generic
- 
-       if Inside_A_Generic then
-          return;
-       end if;
- 
-       --  Generate the unit exception table
- 
-       --    subtype Tnn is Subprogram_Descriptors_Record (Num);
-       --    __gnat_unitname__SDP : aliased constant Tnn :=
-       --                             Num,
-       --                             (sub1'unrestricted_access,
-       --                              sub2'unrestricted_access,
-       --                              ...
-       --                              subNum'unrestricted_access));
- 
-       Num := List_Length (SD_List);
- 
-       Stent :=
-         Make_Defining_Identifier (Loc,
-           Chars => New_Internal_Name ('T'));
- 
-       Insert_Library_Level_Action (
-         Make_Subtype_Declaration (Loc,
-           Defining_Identifier => Stent,
-           Subtype_Indication =>
-             Make_Subtype_Indication (Loc,
-               Subtype_Mark =>
-                 New_Occurrence_Of
-                  (RTE (RE_Subprogram_Descriptors_Record), Loc),
-               Constraint =>
-                 Make_Index_Or_Discriminant_Constraint (Loc,
-                   Constraints => New_List (
-                     Make_Integer_Literal (Loc, Num))))));
- 
-       Set_Is_Statically_Allocated (Stent);
- 
-       Get_External_Unit_Name_String (Unit_Name (Main_Unit));
-       Name_Buffer (1 + 7 .. Name_Len + 7) := Name_Buffer (1 .. Name_Len);
-       Name_Buffer (1 .. 7) := "__gnat_";
-       Name_Len := Name_Len + 7;
-       Add_Str_To_Name_Buffer ("__SDP");
- 
-       Ent :=
-         Make_Defining_Identifier (Loc,
-           Chars => Name_Find);
- 
-       Get_Name_String (Chars (Ent));
-       Set_Interface_Name (Ent,
-         Make_String_Literal (Loc, Strval => String_From_Name_Buffer));
- 
-       Decl :=
-         Make_Object_Declaration (Loc,
-              Defining_Identifier => Ent,
-              Object_Definition   => New_Occurrence_Of (Stent, Loc),
-           Constant_Present => True,
-           Aliased_Present  => True,
-           Expression =>
-             Make_Aggregate (Loc,
-               New_List (
-                 Make_Integer_Literal (Loc, List_Length (SD_List)),
- 
-               Make_Aggregate (Loc,
-                 Expressions => SD_List))));
- 
-       Insert_Library_Level_Action (Decl);
- 
-       Set_Is_Exported             (Ent, True);
-       Set_Is_Public               (Ent, True);
-       Set_Is_Statically_Allocated (Ent, True);
- 
-       Get_Name_String (Chars (Ent));
-       Set_Interface_Name (Ent,
-         Make_String_Literal (Loc,
-           Strval => String_From_Name_Buffer));
- 
-    end Generate_Unit_Exception_Table;
- 
-    ----------------
-    -- Initialize --
-    ----------------
- 
-    procedure Initialize is
-    begin
-       SD_List := Empty_List;
-    end Initialize;
- 
     ----------------------
     -- Is_Non_Ada_Error --
     ----------------------
--- 800,805 ----
*************** package body Exp_Ch11 is
*** 1901,1959 ****
        return True;
     end Is_Non_Ada_Error;
  
-    ----------------------------
-    -- Remove_Handler_Entries --
-    ----------------------------
- 
-    procedure Remove_Handler_Entries (N : Node_Id) is
-       function Check_Handler_Entry (N : Node_Id) return Traverse_Result;
-       --  This function checks one node for a possible reference to a
-       --  handler entry that must be deleted. it always returns OK.
- 
-       function Remove_All_Handler_Entries is new
-         Traverse_Func (Check_Handler_Entry);
-       --  This defines the traversal operation
- 
-       Discard : Traverse_Result;
-       pragma Warnings (Off, Discard);
- 
-       function Check_Handler_Entry (N : Node_Id) return Traverse_Result is
-       begin
-          if Nkind (N) = N_Object_Declaration then
- 
-             if Present (Handler_List_Entry (N)) then
-                Remove (Handler_List_Entry (N));
-                Delete_Tree (Handler_List_Entry (N));
-                Set_Handler_List_Entry (N, Empty);
- 
-             elsif Is_Subprogram_Descriptor (N) then
-                declare
-                   SDN : Node_Id;
- 
-                begin
-                   SDN := First (SD_List);
-                   while Present (SDN) loop
-                      if Defining_Identifier (N) = Entity (Prefix (SDN)) then
-                         Remove (SDN);
-                         Delete_Tree (SDN);
-                         exit;
-                      end if;
- 
-                      Next (SDN);
-                   end loop;
-                end;
-             end if;
-          end if;
- 
-          return OK;
-       end Check_Handler_Entry;
- 
-    --  Start of processing for Remove_Handler_Entries
- 
-    begin
-       if Exception_Mechanism = Front_End_ZCX_Exceptions then
-          Discard := Remove_All_Handler_Entries (N);
-       end if;
-    end Remove_Handler_Entries;
- 
  end Exp_Ch11;
--- 823,826 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch11.ads gcc-4.1.0/gcc/ada/exp_ch11.ads
*** gcc-4.0.2/gcc/ada/exp_ch11.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch11.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Exp_Ch11 is
*** 41,49 ****
     --  See runtime routine Ada.Exceptions for full details on the format and
     --  content of these tables.
  
-    procedure Initialize;
-    --  Initializes these data structures for a new main unit file
- 
     procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id);
     --  Given a handled statement sequence, HSS, for which the At_End_Proc
     --  field is set, and which currently has no exception handlers, this
--- 41,46 ----
*************** package Exp_Ch11 is
*** 59,117 ****
     --  is also called to expand the special exception handler built for
     --  accept bodies (see Exp_Ch9.Build_Accept_Body).
  
-    procedure Generate_Unit_Exception_Table;
-    --  Procedure called by main driver to generate unit exception table if
-    --  zero cost exceptions are enabled. See System.Exceptions for details.
- 
     function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
     --  This function is provided for Gigi use. It returns True if operating on
     --  VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
     --  This is used to generate the special matching code for this exception.
  
-    procedure Remove_Handler_Entries (N : Node_Id);
-    --  This procedure is called when optimization circuits determine that
-    --  an entire subtree can be removed. If the subtree contains handler
-    --  entries in zero cost exception mode, then such removal can lead to
-    --  dangling references to non-existent handlers in the handler table.
-    --  This procedure removes such references.
- 
-    --------------------------------------
-    -- Subprogram_Descriptor Generation --
-    --------------------------------------
- 
-    --  Subprogram descriptors are required for all subprograms, including
-    --  explicit subprograms defined in the program, subprograms that are
-    --  imported via pragma Import, and also for the implicit elaboration
-    --  subprograms used to elaborate package specs and bodies.
- 
-    procedure Generate_Subprogram_Descriptor_For_Package
-      (N    : Node_Id;
-       Spec : Entity_Id);
-    --  This is used to create a descriptor for the implicit elaboration
-    --  procedure for a package spec of body. The compiler only generates
-    --  such descriptors if the package spec or body contains exception
-    --  handlers (either explicitly in the case of a body, or from generic
-    --  package instantiations). N is the node for the package body or
-    --  spec, and Spec is the package body or package entity respectively.
-    --  N must be a compilation unit, and the descriptor is placed at
-    --  the end of the actions for the auxiliary compilation unit node.
- 
-    procedure Generate_Subprogram_Descriptor_For_Subprogram
-      (N    : Node_Id;
-       Spec : Entity_Id);
-    --  This is used to create a desriptor for a subprogram, both those
-    --  present in the source, and those implicitly generated by code
-    --  expansion. N is the subprogram body node, and Spec is the entity
-    --  for the subprogram. The descriptor is placed at the end of the
-    --  Last exception handler, or, if there are no handlers, at the end
-    --  of the statement sequence.
- 
-    procedure Generate_Subprogram_Descriptor_For_Imported_Subprogram
-      (Spec  : Entity_Id;
-       Slist : List_Id);
-    --  This is used to create a descriptor for an imported subprogram.
-    --  Such descriptors are needed for propagation of exceptions through
-    --  such subprograms. The descriptor never references any handlers,
-    --  and is appended to the given Slist.
- 
  end Exp_Ch11;
--- 56,64 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch12.adb gcc-4.1.0/gcc/ada/exp_ch12.adb
*** gcc-4.0.2/gcc/ada/exp_ch12.adb	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch12.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch12.ads gcc-4.1.0/gcc/ada/exp_ch12.ads
*** gcc-4.0.2/gcc/ada/exp_ch12.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch12.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch13.adb gcc-4.1.0/gcc/ada/exp_ch13.adb
*** gcc-4.0.2/gcc/ada/exp_ch13.adb	Thu Mar 17 19:53:05 2005
--- gcc-4.1.0/gcc/ada/exp_ch13.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Ch13 is
*** 389,396 ****
           end loop;
        end if;
  
!       --  If we are to delete this N_Freeze_Entity, do so by rewriting
!       --  so that a loop on all nodes being inserted will work propertly.
        if Delete then
           Rewrite (N, Make_Null_Statement (Sloc (N)));
        end if;
--- 389,397 ----
           end loop;
        end if;
  
!       --  If we are to delete this N_Freeze_Entity, do so by rewriting so that
!       --  a loop on all nodes being inserted will work propertly.
! 
        if Delete then
           Rewrite (N, Make_Null_Statement (Sloc (N)));
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch13.ads gcc-4.1.0/gcc/ada/exp_ch13.ads
*** gcc-4.0.2/gcc/ada/exp_ch13.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch13.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch2.adb gcc-4.1.0/gcc/ada/exp_ch2.adb
*** gcc-4.0.2/gcc/ada/exp_ch2.adb	Wed Dec  8 11:49:37 2004
--- gcc-4.1.0/gcc/ada/exp_ch2.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Ch2 is
*** 475,481 ****
              return In_Assignment_Context (Parent (N));
  
           elsif (Nkind (Parent (N)) = N_Selected_Component
!                  or else Nkind (Parent (N)) = N_Indexed_Component)
             and then In_Assignment_Context (Parent (N))
           then
              return True;
--- 475,482 ----
              return In_Assignment_Context (Parent (N));
  
           elsif (Nkind (Parent (N)) = N_Selected_Component
!                  or else Nkind (Parent (N)) = N_Indexed_Component
!                  or else Nkind (Parent (N)) = N_Slice)
             and then In_Assignment_Context (Parent (N))
           then
              return True;
*************** package body Exp_Ch2 is
*** 712,718 ****
     begin
        --  Simple reference case
  
!       if Nkind (N) = N_Identifier then
           if Is_Formal (Entity (N)) then
              return Entity (N);
  
--- 713,719 ----
     begin
        --  Simple reference case
  
!       if Nkind (N) = N_Identifier or else Nkind (N) = N_Expanded_Name then
           if Is_Formal (Entity (N)) then
              return Entity (N);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch2.ads gcc-4.1.0/gcc/ada/exp_ch2.ads
*** gcc-4.0.2/gcc/ada/exp_ch2.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch2.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch3.adb gcc-4.1.0/gcc/ada/exp_ch3.adb
*** gcc-4.0.2/gcc/ada/exp_ch3.adb	Thu Mar 17 19:53:05 2005
--- gcc-4.1.0/gcc/ada/exp_ch3.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,33 ****
  with Atree;    use Atree;
  with Checks;   use Checks;
  with Einfo;    use Einfo;
- with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Aggr; use Exp_Aggr;
  with Exp_Ch4;  use Exp_Ch4;
--- 27,32 ----
*************** with Restrict; use Restrict;
*** 49,54 ****
--- 48,54 ----
  with Rident;   use Rident;
  with Rtsfind;  use Rtsfind;
  with Sem;      use Sem;
+ with Sem_Attr; use Sem_Attr;
  with Sem_Ch3;  use Sem_Ch3;
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Eval; use Sem_Eval;
*************** package body Exp_Ch3 is
*** 79,91 ****
     --  used for attachment of any actions required in its construction.
     --  It also supplies the source location used for the procedure.
  
-    procedure Build_Class_Wide_Master (T : Entity_Id);
-    --  for access to class-wide limited types we must build a task master
-    --  because some subsequent extension may add a task component. To avoid
-    --  bringing in the tasking run-time whenever an access-to-class-wide
-    --  limited type is used, we use the soft-link mechanism and add a level
-    --  of indirection to calls to routines that manipulate Master_Ids.
- 
     function Build_Discriminant_Formals
       (Rec_Id : Entity_Id;
        Use_Dl : Boolean) return List_Id;
--- 79,84 ----
*************** package body Exp_Ch3 is
*** 124,131 ****
  
     procedure Check_Stream_Attributes (Typ : Entity_Id);
     --  Check that if a limited extension has a parent with user-defined
!    --  stream attributes, any limited component of the extension also has
!    --  the corresponding user-defined stream attributes.
  
     procedure Expand_Tagged_Root (T : Entity_Id);
     --  Add a field _Tag at the beginning of the record. This field carries
--- 117,125 ----
  
     procedure Check_Stream_Attributes (Typ : Entity_Id);
     --  Check that if a limited extension has a parent with user-defined
!    --  stream attributes, and does not itself have user-definer
!    --  stream-attributes, then any limited component of the extension also
!    --  has the corresponding user-defined stream attributes.
  
     procedure Expand_Tagged_Root (T : Entity_Id);
     --  Add a field _Tag at the beginning of the record. This field carries
*************** package body Exp_Ch3 is
*** 285,294 ****
     --  Freeze entities of all predefined primitive operations. This is needed
     --  because the bodies of these operations do not normally do any freezeing.
  
!    function Stream_Operations_OK (Typ : Entity_Id) return Boolean;
!    --  Check whether stream operations must be emitted for a given type.
!    --  Various restrictions prevent the generation of these operations, as
!    --  a useful optimization or for certification purposes.
  
     --------------------------
     -- Adjust_Discriminants --
--- 279,292 ----
     --  Freeze entities of all predefined primitive operations. This is needed
     --  because the bodies of these operations do not normally do any freezeing.
  
!    function Stream_Operation_OK
!      (Typ       : Entity_Id;
!       Operation : TSS_Name_Type) return Boolean;
!    --  Check whether the named stream operation must be emitted for a given
!    --  type. The rules for inheritance of stream attributes by type extensions
!    --  are enforced by this function. Furthermore, various restrictions prevent
!    --  the generation of these operations, as a useful optimization or for
!    --  certification purposes.
  
     --------------------------
     -- Adjust_Discriminants --
*************** package body Exp_Ch3 is
*** 646,651 ****
--- 644,650 ----
        M_Id : Entity_Id;
        Decl : Node_Id;
        P    : Node_Id;
+       Par  : Node_Id;
  
     begin
        --  Nothing to do if there is no task hierarchy
*************** package body Exp_Ch3 is
*** 654,659 ****
--- 653,668 ----
           return;
        end if;
  
+       --  Find declaration that created the access type: either a
+       --  type declaration, or an object declaration with an
+       --  access definition, in which case the type is anonymous.
+ 
+       if Is_Itype (T) then
+          P := Associated_Node_For_Itype (T);
+       else
+          P := Parent (T);
+       end if;
+ 
        --  Nothing to do if we already built a master entity for this scope
  
        if not Has_Master_Entity (Scope (T)) then
*************** package body Exp_Ch3 is
*** 672,695 ****
                 Make_Explicit_Dereference (Loc,
                   New_Reference_To (RTE (RE_Current_Master), Loc)));
  
-          P := Parent (T);
           Insert_Before (P, Decl);
           Analyze (Decl);
           Set_Has_Master_Entity (Scope (T));
  
           --  Now mark the containing scope as a task master
  
!          while Nkind (P) /= N_Compilation_Unit loop
!             P := Parent (P);
  
              --  If we fall off the top, we are at the outer level, and the
              --  environment task is our effective master, so nothing to mark.
  
!             if Nkind (P) = N_Task_Body
!               or else Nkind (P) = N_Block_Statement
!               or else Nkind (P) = N_Subprogram_Body
              then
!                Set_Is_Task_Master (P, True);
                 exit;
              end if;
           end loop;
--- 681,704 ----
                 Make_Explicit_Dereference (Loc,
                   New_Reference_To (RTE (RE_Current_Master), Loc)));
  
           Insert_Before (P, Decl);
           Analyze (Decl);
           Set_Has_Master_Entity (Scope (T));
  
           --  Now mark the containing scope as a task master
  
!          Par := P;
!          while Nkind (Par) /= N_Compilation_Unit loop
!             Par := Parent (Par);
  
              --  If we fall off the top, we are at the outer level, and the
              --  environment task is our effective master, so nothing to mark.
  
!             if Nkind (Par) = N_Task_Body
!               or else Nkind (Par) = N_Block_Statement
!               or else Nkind (Par) = N_Subprogram_Body
              then
!                Set_Is_Task_Master (Par, True);
                 exit;
              end if;
           end loop;
*************** package body Exp_Ch3 is
*** 706,712 ****
            Defining_Identifier => M_Id,
            Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
            Name => Make_Identifier (Loc, Name_uMaster));
!       Insert_Before (Parent (T), Decl);
        Analyze (Decl);
  
        Set_Master_Id (T, M_Id);
--- 715,721 ----
            Defining_Identifier => M_Id,
            Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
            Name => Make_Identifier (Loc, Name_uMaster));
!       Insert_Before (P, Decl);
        Analyze (Decl);
  
        Set_Master_Id (T, M_Id);
*************** package body Exp_Ch3 is
*** 861,868 ****
           Parameter_List := Build_Discriminant_Formals (Rec_Id, False);
  
           Set_Parameter_Specifications (Spec_Node, Parameter_List);
!          Set_Subtype_Mark (Spec_Node,
!                            New_Reference_To (Standard_Boolean,  Loc));
           Set_Specification (Body_Node, Spec_Node);
           Set_Declarations (Body_Node, New_List);
  
--- 870,877 ----
           Parameter_List := Build_Discriminant_Formals (Rec_Id, False);
  
           Set_Parameter_Specifications (Spec_Node, Parameter_List);
!          Set_Result_Definition (Spec_Node,
!                                 New_Reference_To (Standard_Boolean,  Loc));
           Set_Specification (Body_Node, Spec_Node);
           Set_Declarations (Body_Node, New_List);
  
*************** package body Exp_Ch3 is
*** 1401,1412 ****
  
        function Component_Needs_Simple_Initialization
          (T : Entity_Id) return Boolean;
!       --  Determines if a component needs simple initialization, given its
!       --  type T. This is the same as Needs_Simple_Initialization except
!       --  for the following difference: the types Tag and Vtable_Ptr, which
!       --  are access types which would normally require simple initialization
!       --  to null, do not require initialization as components, since they
!       --  are explicitly initialized by other means.
  
        procedure Constrain_Array
          (SI         : Node_Id;
--- 1410,1421 ----
  
        function Component_Needs_Simple_Initialization
          (T : Entity_Id) return Boolean;
!       --  Determines if a component needs simple initialization, given its type
!       --  T. This is the same as Needs_Simple_Initialization except for the
!       --  following difference: the types Tag, Interface_Tag, and Vtable_Ptr
!       --  which are access types which would normally require simple
!       --  initialization to null, do not require initialization as components,
!       --  since they are explicitly initialized by other means.
  
        procedure Constrain_Array
          (SI         : Node_Id;
*************** package body Exp_Ch3 is
*** 1476,1491 ****
                  Attribute_Name => Name_Unrestricted_Access);
           end if;
  
!          --  Ada 2005 (AI-231): Generate conversion to the null-excluding
!          --  type to force the corresponding run-time check.
  
           if Ada_Version >= Ada_05
!            and then Can_Never_Be_Null (Etype (Id))  -- Lhs
!            and then Present (Etype (Exp))
!            and then not Can_Never_Be_Null (Etype (Exp))
           then
!             Rewrite (Exp, Convert_To (Etype (Id), Relocate_Node (Exp)));
!             Analyze_And_Resolve (Exp, Etype (Id));
           end if;
  
           --  Take a copy of Exp to ensure that later copies of this
--- 1485,1505 ----
                  Attribute_Name => Name_Unrestricted_Access);
           end if;
  
!          --  Ada 2005 (AI-231): Add the run-time check if required
  
           if Ada_Version >= Ada_05
!            and then Can_Never_Be_Null (Etype (Id))            -- Lhs
           then
!             if Nkind (Exp) = N_Null then
!                return New_List (
!                  Make_Raise_Constraint_Error (Sloc (Exp),
!                    Reason => CE_Null_Not_Allowed));
! 
!             elsif Present (Etype (Exp))
!               and then not Can_Never_Be_Null (Etype (Exp))
!             then
!                Install_Null_Excluding_Check (Exp);
!             end if;
           end if;
  
           --  Take a copy of Exp to ensure that later copies of this
*************** package body Exp_Ch3 is
*** 1512,1522 ****
                    Make_Selected_Component (Loc,
                      Prefix =>  New_Copy_Tree (Lhs),
                      Selector_Name =>
!                       New_Reference_To (Tag_Component (Typ), Loc)),
  
                  Expression =>
                    Unchecked_Convert_To (RTE (RE_Tag),
!                     New_Reference_To (Access_Disp_Table (Typ), Loc))));
           end if;
  
           --  Adjust the component if controlled except if it is an
--- 1526,1537 ----
                    Make_Selected_Component (Loc,
                      Prefix =>  New_Copy_Tree (Lhs),
                      Selector_Name =>
!                       New_Reference_To (First_Tag_Component (Typ), Loc)),
  
                  Expression =>
                    Unchecked_Convert_To (RTE (RE_Tag),
!                     New_Reference_To
!                       (Node (First_Elmt (Access_Disp_Table (Typ))), Loc))));
           end if;
  
           --  Adjust the component if controlled except if it is an
*************** package body Exp_Ch3 is
*** 1724,1729 ****
--- 1739,1853 ----
           Record_Extension_Node : Node_Id;
           Init_Tag              : Node_Id;
  
+          procedure Init_Secondary_Tags (Typ : Entity_Id);
+          --  Ada 2005 (AI-251): Initialize the tags of all the secondary
+          --  tables associated with abstract interface types
+ 
+          -------------------------
+          -- Init_Secondary_Tags --
+          -------------------------
+ 
+          procedure Init_Secondary_Tags (Typ : Entity_Id) is
+             ADT : Elmt_Id;
+ 
+             procedure Init_Secondary_Tags_Internal (Typ : Entity_Id);
+             --  Internal subprogram used to recursively climb to the root type
+ 
+             ----------------------------------
+             -- Init_Secondary_Tags_Internal --
+             ----------------------------------
+ 
+             procedure Init_Secondary_Tags_Internal (Typ : Entity_Id) is
+                E     : Entity_Id;
+                Aux_N : Node_Id;
+ 
+             begin
+                if not Is_Interface (Typ) then
+ 
+                   --  Climb to the ancestor (if any) handling private types
+ 
+                   if Present (Full_View (Etype (Typ))) then
+                      if Full_View (Etype (Typ)) /= Typ then
+                         Init_Secondary_Tags_Internal (Full_View (Etype (Typ)));
+                      end if;
+ 
+                   elsif Etype (Typ) /= Typ then
+                      Init_Secondary_Tags_Internal (Etype (Typ));
+                   end if;
+                end if;
+ 
+                if Present (Abstract_Interfaces (Typ))
+                  and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
+                then
+                   E := First_Entity (Typ);
+                   while Present (E) loop
+                      if Is_Tag (E)
+                        and then Chars (E) /= Name_uTag
+                      then
+                         Aux_N := Node (ADT);
+                         pragma Assert (Present (Aux_N));
+ 
+                         --  Initialize the pointer to the secondary DT
+                         --  associated with the interface
+ 
+                         Append_To (Body_Stmts,
+                           Make_Assignment_Statement (Loc,
+                             Name =>
+                               Make_Selected_Component (Loc,
+                                 Prefix => Make_Identifier (Loc, Name_uInit),
+                                 Selector_Name =>
+                                   New_Reference_To (E, Loc)),
+                             Expression =>
+                               New_Reference_To (Aux_N, Loc)));
+ 
+                         --  Generate:
+                         --    Set_Offset_To_Top (DT_Ptr, n);
+ 
+                         Append_To (Body_Stmts,
+                           Make_Procedure_Call_Statement (Loc,
+                             Name => New_Reference_To
+                                       (RTE (RE_Set_Offset_To_Top), Loc),
+                             Parameter_Associations => New_List (
+                               Unchecked_Convert_To (RTE (RE_Tag),
+                                 New_Reference_To (Aux_N, Loc)),
+                               Unchecked_Convert_To (RTE (RE_Storage_Offset),
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix         =>
+                                    Make_Selected_Component (Loc,
+                                      Prefix         => Make_Identifier (Loc,
+                                                          Name_uInit),
+                                      Selector_Name  => New_Reference_To
+                                                          (E, Loc)),
+                                  Attribute_Name => Name_Position)))));
+ 
+                         Next_Elmt (ADT);
+                      end if;
+ 
+                      Next_Entity (E);
+                   end loop;
+                end if;
+             end Init_Secondary_Tags_Internal;
+ 
+          --  Start of processing for Init_Secondary_Tags
+ 
+          begin
+             --  Skip the first _Tag, which is the main tag of the
+             --  tagged type. Following tags correspond with abstract
+             --  interfaces.
+ 
+             ADT := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
+ 
+             --  Handle private types
+ 
+             if Present (Full_View (Typ)) then
+                Init_Secondary_Tags_Internal (Full_View (Typ));
+             else
+                Init_Secondary_Tags_Internal (Typ);
+             end if;
+          end Init_Secondary_Tags;
+ 
+       --  Start of processing for Build_Init_Procedure
+ 
        begin
           Body_Stmts := New_List;
           Body_Node := New_Node (N_Subprogram_Body, Loc);
*************** package body Exp_Ch3 is
*** 1825,1834 ****
                    Make_Selected_Component (Loc,
                      Prefix => Make_Identifier (Loc, Name_uInit),
                      Selector_Name =>
!                       New_Reference_To (Tag_Component (Rec_Type), Loc)),
  
                  Expression =>
!                   New_Reference_To (Access_Disp_Table (Rec_Type), Loc));
  
              --  The tag must be inserted before the assignments to other
              --  components,  because the initial value of the component may
--- 1949,1959 ----
                    Make_Selected_Component (Loc,
                      Prefix => Make_Identifier (Loc, Name_uInit),
                      Selector_Name =>
!                       New_Reference_To (First_Tag_Component (Rec_Type), Loc)),
  
                  Expression =>
!                   New_Reference_To
!                     (Node (First_Elmt (Access_Disp_Table (Rec_Type))), Loc));
  
              --  The tag must be inserted before the assignments to other
              --  components,  because the initial value of the component may
*************** package body Exp_Ch3 is
*** 1849,1854 ****
--- 1974,1988 ----
              if not Is_CPP_Class (Etype (Rec_Type)) then
                 Prepend_To (Body_Stmts, Init_Tag);
  
+                --  Ada 2005 (AI-251): Initialization of all the tags
+                --  corresponding with abstract interfaces
+ 
+                if Ada_Version >= Ada_05
+                  and then not Is_Interface (Rec_Type)
+                then
+                   Init_Secondary_Tags (Rec_Type);
+                end if;
+ 
              else
                 declare
                    Nod : Node_Id := First (Body_Stmts);
*************** package body Exp_Ch3 is
*** 2230,2236 ****
           return
             Needs_Simple_Initialization (T)
               and then not Is_RTE (T, RE_Tag)
!              and then not Is_RTE (T, RE_Vtable_Ptr);
        end Component_Needs_Simple_Initialization;
  
        ---------------------
--- 2364,2371 ----
           return
             Needs_Simple_Initialization (T)
               and then not Is_RTE (T, RE_Tag)
!              and then not Is_RTE (T, RE_Vtable_Ptr)
!              and then not Is_RTE (T, RE_Interface_Tag); --  Ada 2005 (AI-251)
        end Component_Needs_Simple_Initialization;
  
        ---------------------
*************** package body Exp_Ch3 is
*** 2362,2367 ****
--- 2497,2509 ----
              return False;
           end if;
  
+          --  If it is a type derived from a type with unknown discriminants,
+          --  we cannot build an initialization procedure for it.
+ 
+          if Has_Unknown_Discriminants (Rec_Id) then
+             return False;
+          end if;
+ 
           --  Otherwise we need to generate an initialization procedure if
           --  Is_CPP_Class is False and at least one of the following applies:
  
*************** package body Exp_Ch3 is
*** 2382,2388 ****
  
           --  6. One or more components is a type that requires simple
           --     initialization (see Needs_Simple_Initialization), except
!          --     that types Tag and Vtable_Ptr are excluded, since fields
           --     of these types are initialized by other means.
  
           --  7. The type is the record type built for a task type (since at
--- 2524,2530 ----
  
           --  6. One or more components is a type that requires simple
           --     initialization (see Needs_Simple_Initialization), except
!          --     that types Tag and Interface_Tag are excluded, since fields
           --     of these types are initialized by other means.
  
           --  7. The type is the record type built for a task type (since at
*************** package body Exp_Ch3 is
*** 2905,2911 ****
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => F,
                Parameter_Specifications => Pspecs,
!               Subtype_Mark => New_Reference_To (Standard_Boolean, Loc)),
            Declarations               => New_List,
            Handled_Statement_Sequence =>
              Make_Handled_Sequence_Of_Statements (Loc,
--- 3047,3053 ----
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => F,
                Parameter_Specifications => Pspecs,
!               Result_Definition => New_Reference_To (Standard_Boolean, Loc)),
            Declarations               => New_List,
            Handled_Statement_Sequence =>
              Make_Handled_Sequence_Of_Statements (Loc,
*************** package body Exp_Ch3 is
*** 3006,3032 ****
  
     procedure Check_Stream_Attributes (Typ : Entity_Id) is
        Comp      : Entity_Id;
!       Par       : constant Entity_Id := Root_Type (Base_Type (Typ));
!       Par_Read  : constant Boolean   := Present (TSS (Par, TSS_Stream_Read));
!       Par_Write : constant Boolean   := Present (TSS (Par, TSS_Stream_Write));
  
     begin
        if Par_Read or else Par_Write then
           Comp := First_Component (Typ);
           while Present (Comp) loop
              if Comes_From_Source (Comp)
!               and then  Original_Record_Component (Comp) = Comp
                and then Is_Limited_Type (Etype (Comp))
              then
!                if (Par_Read and then
!                      No (TSS (Base_Type (Etype (Comp)), TSS_Stream_Read)))
!                  or else
!                   (Par_Write and then
!                      No (TSS (Base_Type (Etype (Comp)), TSS_Stream_Write)))
!                then
!                   Error_Msg_N
!                     ("|component must have Stream attribute",
!                        Parent (Comp));
                 end if;
              end if;
  
--- 3148,3192 ----
  
     procedure Check_Stream_Attributes (Typ : Entity_Id) is
        Comp      : Entity_Id;
!       Par_Read  : constant Boolean :=
!                     Stream_Attribute_Available (Typ, TSS_Stream_Read)
!                       and then not Has_Specified_Stream_Read (Typ);
!       Par_Write : constant Boolean :=
!                     Stream_Attribute_Available (Typ, TSS_Stream_Write)
!                       and then not Has_Specified_Stream_Write (Typ);
! 
!       procedure Check_Attr (Nam : Name_Id; TSS_Nam : TSS_Name_Type);
!       --  Check that Comp has a user-specified Nam stream attribute
! 
!       ----------------
!       -- Check_Attr --
!       ----------------
! 
!       procedure Check_Attr (Nam : Name_Id; TSS_Nam : TSS_Name_Type) is
!       begin
!          if not Stream_Attribute_Available (Etype (Comp), TSS_Nam) then
!             Error_Msg_Name_1 := Nam;
!             Error_Msg_N
!               ("|component& in limited extension must have% attribute", Comp);
!          end if;
!       end Check_Attr;
! 
!    --  Start of processing for Check_Stream_Attributes
  
     begin
        if Par_Read or else Par_Write then
           Comp := First_Component (Typ);
           while Present (Comp) loop
              if Comes_From_Source (Comp)
!               and then Original_Record_Component (Comp) = Comp
                and then Is_Limited_Type (Etype (Comp))
              then
!                if Par_Read then
!                   Check_Attr (Name_Read, TSS_Stream_Read);
!                end if;
! 
!                if Par_Write then
!                   Check_Attr (Name_Write, TSS_Stream_Write);
                 end if;
              end if;
  
*************** package body Exp_Ch3 is
*** 3407,3418 ****
           --  simple initialization expression in place. This special
           --  initialization is required even though No_Init_Flag is present.
  
!          elsif Needs_Simple_Initialization (Typ) then
              Set_No_Initialization (N, False);
              Set_Expression (N, Get_Simple_Init_Val (Typ, Loc, Esize (Def_Id)));
              Analyze_And_Resolve (Expression (N), Typ);
           end if;
  
        --  Explicit initialization present
  
        else
--- 3567,3602 ----
           --  simple initialization expression in place. This special
           --  initialization is required even though No_Init_Flag is present.
  
!          --  An internally generated temporary needs no initialization because
!          --  it will be assigned subsequently. In particular, there is no
!          --  point in applying Initialize_Scalars to such a temporary.
! 
!          elsif Needs_Simple_Initialization (Typ)
!             and then not Is_Internal (Def_Id)
!          then
              Set_No_Initialization (N, False);
              Set_Expression (N, Get_Simple_Init_Val (Typ, Loc, Esize (Def_Id)));
              Analyze_And_Resolve (Expression (N), Typ);
           end if;
  
+          --  Generate attribute for Persistent_BSS if needed
+ 
+          declare
+             Prag : Node_Id;
+          begin
+             if Persistent_BSS_Mode
+               and then Comes_From_Source (N)
+               and then Is_Potentially_Persistent_Type (Typ)
+               and then Is_Library_Level_Entity (Def_Id)
+             then
+                Prag :=
+                  Make_Linker_Section_Pragma
+                    (Def_Id, Sloc (N), ".persistent.bss");
+                Insert_After (N, Prag);
+                Analyze (Prag);
+             end if;
+          end;
+ 
        --  Explicit initialization present
  
        else
*************** package body Exp_Ch3 is
*** 3497,3514 ****
                 end;
              end if;
  
!             --  For tagged types, when an init value is given, the tag has
!             --  to be re-initialized separately in order to avoid the
!             --  propagation of a wrong tag coming from a view conversion
!             --  unless the type is class wide (in this case the tag comes
!             --  from the init value). Suppress the tag assignment when
!             --  Java_VM because JVM tags are represented implicitly
!             --  in objects. Ditto for types that are CPP_CLASS.
  
              if Is_Tagged_Type (Typ)
                and then not Is_Class_Wide_Type (Typ)
                and then not Is_CPP_Class (Typ)
                and then not Java_VM
              then
                 --  The re-assignment of the tag has to be done even if
                 --  the object is a constant
--- 3681,3700 ----
                 end;
              end if;
  
!             --  For tagged types, when an init value is given, the tag has to
!             --  be re-initialized separately in order to avoid the propagation
!             --  of a wrong tag coming from a view conversion unless the type
!             --  is class wide (in this case the tag comes from the init
!             --  value). Suppress the tag assignment when Java_VM because JVM
!             --  tags are represented implicitly in objects. Ditto for types
!             --  that are CPP_CLASS, and for initializations that are
!             --  aggregates, because they have to have the right tag.
  
              if Is_Tagged_Type (Typ)
                and then not Is_Class_Wide_Type (Typ)
                and then not Is_CPP_Class (Typ)
                and then not Java_VM
+               and then Nkind (Expr) /= N_Aggregate
              then
                 --  The re-assignment of the tag has to be done even if
                 --  the object is a constant
*************** package body Exp_Ch3 is
*** 3517,3523 ****
                   Make_Selected_Component (Loc,
                      Prefix => New_Reference_To (Def_Id, Loc),
                      Selector_Name =>
!                       New_Reference_To (Tag_Component (Typ), Loc));
  
                 Set_Assignment_OK (New_Ref);
  
--- 3703,3709 ----
                   Make_Selected_Component (Loc,
                      Prefix => New_Reference_To (Def_Id, Loc),
                      Selector_Name =>
!                       New_Reference_To (First_Tag_Component (Typ), Loc));
  
                 Set_Assignment_OK (New_Ref);
  
*************** package body Exp_Ch3 is
*** 3527,3533 ****
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
                         New_Reference_To
!                          (Access_Disp_Table (Base_Type (Typ)), Loc))));
  
              --  For discrete types, set the Is_Known_Valid flag if the
              --  initializing value is known to be valid.
--- 3713,3722 ----
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
                         New_Reference_To
!                          (Node
!                            (First_Elmt
!                              (Access_Disp_Table (Base_Type (Typ)))),
!                           Loc))));
  
              --  For discrete types, set the Is_Known_Valid flag if the
              --  initializing value is known to be valid.
*************** package body Exp_Ch3 is
*** 3539,3560 ****
  
              elsif Is_Access_Type (Typ) then
  
-                --  Ada 2005 (AI-231): Generate conversion to the null-excluding
-                --  type to force the corresponding run-time check
- 
-                if Ada_Version >= Ada_05
-                  and then (Can_Never_Be_Null (Def_Id)
-                              or else Can_Never_Be_Null (Typ))
-                then
-                   Rewrite
-                     (Expr_Q,
-                      Convert_To (Etype (Def_Id), Relocate_Node (Expr_Q)));
-                   Analyze_And_Resolve (Expr_Q, Etype (Def_Id));
-                end if;
- 
                 --  For access types set the Is_Known_Non_Null flag if the
!                --  initializing value is known to be non-null. We can also
!                --  set Can_Never_Be_Null if this is a constant.
  
                 if Known_Non_Null (Expr) then
                    Set_Is_Known_Non_Null (Def_Id);
--- 3728,3736 ----
  
              elsif Is_Access_Type (Typ) then
  
                 --  For access types set the Is_Known_Non_Null flag if the
!                --  initializing value is known to be non-null. We can also set
!                --  Can_Never_Be_Null if this is a constant.
  
                 if Known_Non_Null (Expr) then
                    Set_Is_Known_Non_Null (Def_Id);
*************** package body Exp_Ch3 is
*** 3575,3595 ****
              end if;
           end if;
  
!          if Is_Possibly_Unaligned_Slice (Expr) then
  
!             --  Make a separate assignment that will be expanded into a
!             --  loop, to bypass back-end problems with misaligned arrays.
  
              declare
                 Stat : constant Node_Id :=
                         Make_Assignment_Statement (Loc,
!                          Name => New_Reference_To (Def_Id, Loc),
                           Expression => Relocate_Node (Expr));
- 
              begin
                 Set_Expression (N, Empty);
                 Set_No_Initialization (N);
                 Set_Assignment_OK (Name (Stat));
                 Insert_After (N, Stat);
                 Analyze (Stat);
              end;
--- 3751,3783 ----
              end if;
           end if;
  
!          --  Cases where the back end cannot handle the initialization
!          --  directly. In such cases, we expand an assignment that will
!          --  be appropriately handled by Expand_N_Assignment_Statement.
  
!          --  The exclusion of the unconstrained case is wrong, but for
!          --  now it is too much trouble ???
! 
!          if (Is_Possibly_Unaligned_Slice (Expr)
!                or else (Is_Possibly_Unaligned_Object (Expr)
!                           and then not Represented_As_Scalar (Etype (Expr))))
  
+             --  The exclusion of the unconstrained case is wrong, but for
+             --  now it is too much trouble ???
+ 
+            and then not (Is_Array_Type (Etype (Expr))
+                            and then not Is_Constrained (Etype (Expr)))
+          then
              declare
                 Stat : constant Node_Id :=
                         Make_Assignment_Statement (Loc,
!                          Name       => New_Reference_To (Def_Id, Loc),
                           Expression => Relocate_Node (Expr));
              begin
                 Set_Expression (N, Empty);
                 Set_No_Initialization (N);
                 Set_Assignment_OK (Name (Stat));
+                Set_No_Ctrl_Actions (Stat);
                 Insert_After (N, Stat);
                 Analyze (Stat);
              end;
*************** package body Exp_Ch3 is
*** 3612,3621 ****
     -- Expand_N_Subtype_Indication --
     ---------------------------------
  
!    --  Add a check on the range of the subtype. The static case is
!    --  partially duplicated by Process_Range_Expr_In_Decl in Sem_Ch3,
!    --  but we still need to check here for the static case in order to
!    --  avoid generating extraneous expanded code.
  
     procedure Expand_N_Subtype_Indication (N : Node_Id) is
        Ran : constant Node_Id   := Range_Expression (Constraint (N));
--- 3800,3809 ----
     -- Expand_N_Subtype_Indication --
     ---------------------------------
  
!    --  Add a check on the range of the subtype. The static case is partially
!    --  duplicated by Process_Range_Expr_In_Decl in Sem_Ch3, but we still need
!    --  to check here for the static case in order to avoid generating
!    --  extraneous expanded code.
  
     procedure Expand_N_Subtype_Indication (N : Node_Id) is
        Ran : constant Node_Id   := Range_Expression (Constraint (N));
*************** package body Exp_Ch3 is
*** 3634,3651 ****
     -- Expand_N_Variant_Part --
     ---------------------------
  
!    --  If the last variant does not contain the Others choice, replace
!    --  it with an N_Others_Choice node since Gigi always wants an Others.
!    --  Note that we do not bother to call Analyze on the modified variant
!    --  part, since it's only effect would be to compute the contents of
!    --  the Others_Discrete_Choices node laboriously, and of course we
!    --  already know the list of choices that corresponds to the others
!    --  choice (it's the list we are replacing!)
  
     procedure Expand_N_Variant_Part (N : Node_Id) is
        Last_Var    : constant Node_Id := Last_Non_Pragma (Variants (N));
        Others_Node : Node_Id;
- 
     begin
        if Nkind (First (Discrete_Choices (Last_Var))) /= N_Others_Choice then
           Others_Node := Make_Others_Choice (Sloc (Last_Var));
--- 3822,3838 ----
     -- Expand_N_Variant_Part --
     ---------------------------
  
!    --  If the last variant does not contain the Others choice, replace it with
!    --  an N_Others_Choice node since Gigi always wants an Others. Note that we
!    --  do not bother to call Analyze on the modified variant part, since it's
!    --  only effect would be to compute the contents of the
!    --  Others_Discrete_Choices node laboriously, and of course we already know
!    --  the list of choices that corresponds to the others choice (it's the
!    --  list we are replacing!)
  
     procedure Expand_N_Variant_Part (N : Node_Id) is
        Last_Var    : constant Node_Id := Last_Non_Pragma (Variants (N));
        Others_Node : Node_Id;
     begin
        if Nkind (First (Discrete_Choices (Last_Var))) /= N_Others_Choice then
           Others_Node := Make_Others_Choice (Sloc (Last_Var));
*************** package body Exp_Ch3 is
*** 3737,3745 ****
           Set_Null_Present (Comp_List, False);
  
        else
!          --  The controller cannot be placed before the _Parent field
!          --  since gigi lays out field in order and _parent must be
!          --  first to preserve the polymorphism of tagged types.
  
           First_Comp := First (Component_Items (Comp_List));
  
--- 3924,3932 ----
           Set_Null_Present (Comp_List, False);
  
        else
!          --  The controller cannot be placed before the _Parent field since
!          --  gigi lays out field in order and _parent must be first to
!          --  preserve the polymorphism of tagged types.
  
           First_Comp := First (Component_Items (Comp_List));
  
*************** package body Exp_Ch3 is
*** 3757,3765 ****
        Set_Ekind (Ent, E_Component);
        Init_Component_Location (Ent);
  
!       --  Move the _controller entity ahead in the list of internal
!       --  entities of the enclosing record so that it is selected
!       --  instead of a potentially inherited one.
  
        declare
           E    : constant Entity_Id := Last_Entity (T);
--- 3944,3952 ----
        Set_Ekind (Ent, E_Component);
        Init_Component_Location (Ent);
  
!       --  Move the _controller entity ahead in the list of internal entities
!       --  of the enclosing record so that it is selected instead of a
!       --  potentially inherited one.
  
        declare
           E    : constant Entity_Id := Last_Entity (T);
*************** package body Exp_Ch3 is
*** 3818,3824 ****
  
        Comp_Decl :=
          Make_Component_Declaration (Sloc_N,
!           Defining_Identifier => Tag_Component (T),
            Component_Definition =>
              Make_Component_Definition (Sloc_N,
                Aliased_Present => False,
--- 4005,4011 ----
  
        Comp_Decl :=
          Make_Component_Declaration (Sloc_N,
!           Defining_Identifier => First_Tag_Component (T),
            Component_Definition =>
              Make_Component_Definition (Sloc_N,
                Aliased_Present => False,
*************** package body Exp_Ch3 is
*** 3835,3842 ****
        end if;
  
        --  We don't Analyze the whole expansion because the tag component has
!       --  already been analyzed previously. Here we just insure that the
!       --  tree is coherent with the semantic decoration
  
        Find_Type (Subtype_Indication (Component_Definition (Comp_Decl)));
  
--- 4022,4029 ----
        end if;
  
        --  We don't Analyze the whole expansion because the tag component has
!       --  already been analyzed previously. Here we just insure that the tree
!       --  is coherent with the semantic decoration
  
        Find_Type (Subtype_Indication (Component_Definition (Comp_Decl)));
  
*************** package body Exp_Ch3 is
*** 3856,3865 ****
     begin
        if not Is_Bit_Packed_Array (Typ) then
  
!          --  If the component contains tasks, so does the array type.
!          --  This may not be indicated in the array type because the
!          --  component may have been a private type at the point of
!          --  definition. Same if component type is controlled.
  
           Set_Has_Task (Base, Has_Task (Component_Type (Typ)));
           Set_Has_Controlled_Component (Base,
--- 4043,4052 ----
     begin
        if not Is_Bit_Packed_Array (Typ) then
  
!          --  If the component contains tasks, so does the array type. This may
!          --  not be indicated in the array type because the component may have
!          --  been a private type at the point of definition. Same if component
!          --  type is controlled.
  
           Set_Has_Task (Base, Has_Task (Component_Type (Typ)));
           Set_Has_Controlled_Component (Base,
*************** package body Exp_Ch3 is
*** 3868,3876 ****
  
           if No (Init_Proc (Base)) then
  
!             --  If this is an anonymous array created for a declaration
!             --  with an initial value, its init_proc will never be called.
!             --  The initial value itself may have been expanded into assign-
              --  ments, in which case the object declaration is carries the
              --  No_Initialization flag.
  
--- 4055,4063 ----
  
           if No (Init_Proc (Base)) then
  
!             --  If this is an anonymous array created for a declaration with
!             --  an initial value, its init_proc will never be called. The
!             --  initial value itself may have been expanded into assign-
              --  ments, in which case the object declaration is carries the
              --  No_Initialization flag.
  
*************** package body Exp_Ch3 is
*** 3911,3919 ****
              end if;
           end if;
  
!       --  For packed case, there is a default initialization, except
!       --  if the component type is itself a packed structure with an
!       --  initialization procedure.
  
        elsif Present (Init_Proc (Component_Type (Base)))
          and then No (Base_Init_Proc (Base))
--- 4098,4106 ----
              end if;
           end if;
  
!       --  For packed case, there is a default initialization, except if the
!       --  component type is itself a packed structure with an initialization
!       --  procedure.
  
        elsif Present (Init_Proc (Component_Type (Base)))
          and then No (Base_Init_Proc (Base))
*************** package body Exp_Ch3 is
*** 3943,3950 ****
        pragma Warnings (Off, Func);
  
     begin
!       --  Various optimization are possible if the given representation
!       --  is contiguous.
  
        Is_Contiguous := True;
        Ent := First_Literal (Typ);
--- 4130,4137 ----
        pragma Warnings (Off, Func);
  
     begin
!       --  Various optimization are possible if the given representation is
!       --  contiguous.
  
        Is_Contiguous := True;
        Ent := First_Literal (Typ);
*************** package body Exp_Ch3 is
*** 3987,3995 ****
        --    typA : array (Natural range 0 .. num - 1) of ctype :=
        --             (v, v, v, v, v, ....)
  
!       --  where ctype is the corresponding integer type. If the
!       --  representation is contiguous, we only keep the first literal,
!       --  which provides the offset for Pos_To_Rep computations.
  
        Arr :=
          Make_Defining_Identifier (Loc,
--- 4174,4182 ----
        --    typA : array (Natural range 0 .. num - 1) of ctype :=
        --             (v, v, v, v, v, ....)
  
!       --  where ctype is the corresponding integer type. If the representation
!       --  is contiguous, we only keep the first literal, which provides the
!       --  offset for Pos_To_Rep computations.
  
        Arr :=
          Make_Defining_Identifier (Loc,
*************** package body Exp_Ch3 is
*** 4044,4065 ****
        --  representation) raises Constraint_Error or returns a unique value
        --  of minus one. The latter case is used, e.g. in 'Valid code.
  
!       --  Note: the reason we use Enum_Rep values in the case here is to
!       --  avoid the code generator making inappropriate assumptions about
!       --  the range of the values in the case where the value is invalid.
!       --  ityp is a signed or unsigned integer type of appropriate width.
  
        --  Note: if exceptions are not supported, then we suppress the raise
        --  and return -1 unconditionally (this is an erroneous program in any
!       --  case and there is no obligation to raise Constraint_Error here!)
!       --  We also do this if pragma Restrictions (No_Exceptions) is active.
  
        --  Representations are signed
  
        if Enumeration_Rep (First_Literal (Typ)) < 0 then
  
           --  The underlying type is signed. Reset the Is_Unsigned_Type
!          --  explicitly, because it might have been inherited from a
           --  parent type.
  
           Set_Is_Unsigned_Type (Typ, False);
--- 4231,4252 ----
        --  representation) raises Constraint_Error or returns a unique value
        --  of minus one. The latter case is used, e.g. in 'Valid code.
  
!       --  Note: the reason we use Enum_Rep values in the case here is to avoid
!       --  the code generator making inappropriate assumptions about the range
!       --  of the values in the case where the value is invalid. ityp is a
!       --  signed or unsigned integer type of appropriate width.
  
        --  Note: if exceptions are not supported, then we suppress the raise
        --  and return -1 unconditionally (this is an erroneous program in any
!       --  case and there is no obligation to raise Constraint_Error here!) We
!       --  also do this if pragma Restrictions (No_Exceptions) is active.
  
        --  Representations are signed
  
        if Enumeration_Rep (First_Literal (Typ)) < 0 then
  
           --  The underlying type is signed. Reset the Is_Unsigned_Type
!          --  explicitly, because it might have been inherited from
           --  parent type.
  
           Set_Is_Unsigned_Type (Typ, False);
*************** package body Exp_Ch3 is
*** 4080,4087 ****
           end if;
        end if;
  
!       --  The body of the function is a case statement. First collect
!       --  case alternatives, or optimize the contiguous case.
  
        Lst := New_List;
  
--- 4267,4274 ----
           end if;
        end if;
  
!       --  The body of the function is a case statement. First collect case
!       --  alternatives, or optimize the contiguous case.
  
        Lst := New_List;
  
*************** package body Exp_Ch3 is
*** 4192,4198 ****
                      Make_Defining_Identifier (Loc, Name_uF),
                    Parameter_Type => New_Reference_To (Standard_Boolean, Loc))),
  
!               Subtype_Mark => New_Reference_To (Standard_Integer, Loc)),
  
              Declarations => Empty_List,
  
--- 4379,4385 ----
                      Make_Defining_Identifier (Loc, Name_uF),
                    Parameter_Type => New_Reference_To (Standard_Boolean, Loc))),
  
!               Result_Definition => New_Reference_To (Standard_Integer, Loc)),
  
              Declarations => Empty_List,
  
*************** package body Exp_Ch3 is
*** 4222,4231 ****
     ------------------------
  
     procedure Freeze_Record_Type (N : Node_Id) is
-       Def_Id      : constant Node_Id := Entity (N);
        Comp        : Entity_Id;
!       Type_Decl   : constant Node_Id := Parent (Def_Id);
        Predef_List : List_Id;
  
        Renamed_Eq  : Node_Id := Empty;
        --  Could use some comments ???
--- 4409,4418 ----
     ------------------------
  
     procedure Freeze_Record_Type (N : Node_Id) is
        Comp        : Entity_Id;
!       Def_Id      : constant Node_Id := Entity (N);
        Predef_List : List_Id;
+       Type_Decl   : constant Node_Id := Parent (Def_Id);
  
        Renamed_Eq  : Node_Id := Empty;
        --  Could use some comments ???
*************** package body Exp_Ch3 is
*** 4303,4331 ****
        end loop;
  
        --  Creation of the Dispatch Table. Note that a Dispatch Table is
!       --  created for regular tagged types as well as for Ada types
!       --  deriving from a C++ Class, but not for tagged types directly
!       --  corresponding to the C++ classes. In the later case we assume
!       --  that the Vtable is created in the C++ side and we just use it.
  
        if Is_Tagged_Type (Def_Id) then
           if Is_CPP_Class (Def_Id) then
              Set_All_DT_Position (Def_Id);
              Set_Default_Constructor (Def_Id);
  
           else
!             --  Usually inherited primitives are not delayed but the first
!             --  Ada extension of a CPP_Class is an exception since the
!             --  address of the inherited subprogram has to be inserted in
!             --  the new Ada Dispatch Table and this is a freezing action
!             --  (usually the inherited primitive address is inserted in the
!             --  DT by Inherit_DT)
  
!             --  Similarly, if this is an inherited operation whose parent
!             --  is not frozen yet, it is not in the DT of the parent, and
!             --  we generate an explicit freeze node for the inherited
!             --  operation, so that it is properly inserted in the DT of the
!             --  current type.
  
              declare
                 Elmt : Elmt_Id := First_Elmt (Primitive_Operations (Def_Id));
--- 4490,4518 ----
        end loop;
  
        --  Creation of the Dispatch Table. Note that a Dispatch Table is
!       --  created for regular tagged types as well as for Ada types deriving
!       --  from a C++ Class, but not for tagged types directly corresponding to
!       --  the C++ classes. In the later case we assume that the Vtable is
!       --  created in the C++ side and we just use it.
  
        if Is_Tagged_Type (Def_Id) then
+ 
           if Is_CPP_Class (Def_Id) then
              Set_All_DT_Position (Def_Id);
              Set_Default_Constructor (Def_Id);
  
           else
!             --  Usually inherited primitives are not delayed but the first Ada
!             --  extension of a CPP_Class is an exception since the address of
!             --  the inherited subprogram has to be inserted in the new Ada
!             --  Dispatch Table and this is a freezing action (usually the
!             --  inherited primitive address is inserted in the DT by
!             --  Inherit_DT)
  
!             --  Similarly, if this is an inherited operation whose parent is
!             --  not frozen yet, it is not in the DT of the parent, and we
!             --  generate an explicit freeze node for the inherited operation,
!             --  so that it is properly inserted in the DT of the current type.
  
              declare
                 Elmt : Elmt_Id := First_Elmt (Primitive_Operations (Def_Id));
*************** package body Exp_Ch3 is
*** 4355,4390 ****
                 Expand_Tagged_Root (Def_Id);
              end if;
  
!             --  Unfreeze momentarily the type to add the predefined
!             --  primitives operations. The reason we unfreeze is so
!             --  that these predefined operations will indeed end up
!             --  as primitive operations (which must be before the
!             --  freeze point).
  
              Set_Is_Frozen (Def_Id, False);
              Make_Predefined_Primitive_Specs
                (Def_Id, Predef_List, Renamed_Eq);
              Insert_List_Before_And_Analyze (N, Predef_List);
              Set_Is_Frozen (Def_Id, True);
              Set_All_DT_Position (Def_Id);
  
              --  Add the controlled component before the freezing actions
!             --  it is referenced in those actions.
  
              if Has_New_Controlled_Component (Def_Id) then
                 Expand_Record_Controller (Def_Id);
              end if;
  
!             --  Suppress creation of a dispatch table when Java_VM because
!             --  the dispatching mechanism is handled internally by the JVM.
  
              if not Java_VM then
!                Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
              end if;
  
!             --  Make sure that the primitives Initialize, Adjust and
!             --  Finalize are Frozen before other TSS subprograms. We
!             --  don't want them Frozen inside.
  
              if Is_Controlled (Def_Id) then
                 if not Is_Limited_Type (Def_Id) then
--- 4542,4650 ----
                 Expand_Tagged_Root (Def_Id);
              end if;
  
!             --  Unfreeze momentarily the type to add the predefined primitives
!             --  operations. The reason we unfreeze is so that these predefined
!             --  operations will indeed end up as primitive operations (which
!             --  must be before the freeze point).
  
              Set_Is_Frozen (Def_Id, False);
              Make_Predefined_Primitive_Specs
                (Def_Id, Predef_List, Renamed_Eq);
              Insert_List_Before_And_Analyze (N, Predef_List);
+ 
              Set_Is_Frozen (Def_Id, True);
              Set_All_DT_Position (Def_Id);
  
              --  Add the controlled component before the freezing actions
!             --  referenced in those actions.
  
              if Has_New_Controlled_Component (Def_Id) then
                 Expand_Record_Controller (Def_Id);
              end if;
  
!             --  Suppress creation of a dispatch table when Java_VM because the
!             --  dispatching mechanism is handled internally by the JVM.
  
              if not Java_VM then
! 
!                --  Ada 2005 (AI-251): Build the secondary dispatch tables
! 
!                declare
!                   ADT : Elist_Id := Access_Disp_Table (Def_Id);
! 
!                   procedure Add_Secondary_Tables (Typ : Entity_Id);
!                   --  Internal subprogram, recursively climb to the ancestors
! 
!                   --------------------------
!                   -- Add_Secondary_Tables --
!                   --------------------------
! 
!                   procedure Add_Secondary_Tables (Typ : Entity_Id) is
!                      E            : Entity_Id;
!                      Iface        : Elmt_Id;
!                      Result       : List_Id;
!                      Suffix_Index : Int;
! 
!                   begin
!                      --  Climb to the ancestor (if any) handling private types
! 
!                      if Present (Full_View (Etype (Typ))) then
!                         if Full_View (Etype (Typ)) /= Typ then
!                            Add_Secondary_Tables (Full_View (Etype (Typ)));
!                         end if;
! 
!                      elsif Etype (Typ) /= Typ then
!                         Add_Secondary_Tables (Etype (Typ));
!                      end if;
! 
!                      if Present (Abstract_Interfaces (Typ))
!                        and then
!                          not Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
!                      then
!                         Iface := First_Elmt (Abstract_Interfaces (Typ));
!                         Suffix_Index := 0;
! 
!                         E := First_Entity (Typ);
!                         while Present (E) loop
!                            if Is_Tag (E) and then Chars (E) /= Name_uTag then
!                               Make_Secondary_DT
!                                 (Typ             => Def_Id,
!                                  Ancestor_Typ    => Typ,
!                                  Suffix_Index    => Suffix_Index,
!                                  Iface           => Node (Iface),
!                                  AI_Tag          => E,
!                                  Acc_Disp_Tables => ADT,
!                                  Result          => Result);
! 
!                               Append_Freeze_Actions (Def_Id, Result);
!                               Suffix_Index := Suffix_Index + 1;
!                               Next_Elmt (Iface);
!                            end if;
! 
!                            Next_Entity (E);
!                         end loop;
!                      end if;
!                   end Add_Secondary_Tables;
! 
!                --  Start of processing to build secondary dispatch tables
! 
!                begin
!                   --  Handle private types
! 
!                   if Present (Full_View (Def_Id)) then
!                      Add_Secondary_Tables  (Full_View (Def_Id));
!                   else
!                      Add_Secondary_Tables  (Def_Id);
!                   end if;
! 
!                   Set_Access_Disp_Table (Def_Id, ADT);
!                   Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
!                end;
              end if;
  
!             --  Make sure that the primitives Initialize, Adjust and Finalize
!             --  are Frozen before other TSS subprograms. We don't want them
!             --  Frozen inside.
  
              if Is_Controlled (Def_Id) then
                 if not Is_Limited_Type (Def_Id) then
*************** package body Exp_Ch3 is
*** 4406,4415 ****
  
              Append_Freeze_Actions
                (Def_Id, Predefined_Primitive_Freeze (Def_Id));
           end if;
  
!       --  In the non-tagged case, an equality function is provided only
!       --  for variant records (that are not unchecked unions).
  
        elsif Has_Discriminants (Def_Id)
          and then not Is_Limited_Type (Def_Id)
--- 4666,4677 ----
  
              Append_Freeze_Actions
                (Def_Id, Predefined_Primitive_Freeze (Def_Id));
+             Append_Freeze_Actions
+               (Def_Id, Init_Predefined_Interface_Primitives (Def_Id));
           end if;
  
!       --  In the non-tagged case, an equality function is provided only for
!       --  variant records (that are not unchecked unions).
  
        elsif Has_Discriminants (Def_Id)
          and then not Is_Limited_Type (Def_Id)
*************** package body Exp_Ch3 is
*** 4428,4437 ****
        end if;
  
        --  Before building the record initialization procedure, if we are
!       --  dealing with a concurrent record value type, then we must go
!       --  through the discriminants, exchanging discriminals between the
!       --  concurrent type and the concurrent record value type. See the
!       --  section "Handling of Discriminants" in the Einfo spec for details.
  
        if Is_Concurrent_Record_Type (Def_Id)
          and then Has_Discriminants (Def_Id)
--- 4690,4699 ----
        end if;
  
        --  Before building the record initialization procedure, if we are
!       --  dealing with a concurrent record value type, then we must go through
!       --  the discriminants, exchanging discriminals between the concurrent
!       --  type and the concurrent record value type. See the section "Handling
!       --  of Discriminants" in the Einfo spec for details.
  
        if Is_Concurrent_Record_Type (Def_Id)
          and then Has_Discriminants (Def_Id)
*************** package body Exp_Ch3 is
*** 4472,4487 ****
        Adjust_Discriminants (Def_Id);
        Build_Record_Init_Proc (Type_Decl, Def_Id);
  
!       --  For tagged type, build bodies of primitive operations. Note
!       --  that we do this after building the record initialization
!       --  experiment, since the primitive operations may need the
!       --  initialization routine
  
        if Is_Tagged_Type (Def_Id) then
           Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
           Append_Freeze_Actions (Def_Id, Predef_List);
-       end if;
  
     end Freeze_Record_Type;
  
     ------------------------------
--- 4734,4765 ----
        Adjust_Discriminants (Def_Id);
        Build_Record_Init_Proc (Type_Decl, Def_Id);
  
!       --  For tagged type, build bodies of primitive operations. Note that we
!       --  do this after building the record initialization experiment, since
!       --  the primitive operations may need the initialization routine
  
        if Is_Tagged_Type (Def_Id) then
           Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
           Append_Freeze_Actions (Def_Id, Predef_List);
  
+          --  Populate the two auxiliary tables used for dispatching
+          --  asynchronous, conditional and timed selects for tagged
+          --  types that implement a limited interface.
+ 
+          if Ada_Version >= Ada_05
+            and then not Is_Interface  (Def_Id)
+            and then not Is_Abstract   (Def_Id)
+            and then not Is_Controlled (Def_Id)
+            and then
+              Implements_Interface
+                (Typ          => Def_Id,
+                 Kind         => Any_Limited_Interface,
+                 Check_Parent => True)
+          then
+             Append_Freeze_Actions (Def_Id,
+               Make_Select_Specific_Data_Table (Def_Id));
+          end if;
+       end if;
     end Freeze_Record_Type;
  
     ------------------------------
*************** package body Exp_Ch3 is
*** 4525,4534 ****
     -- Freeze_Type --
     -----------------
  
!    --  Full type declarations are expanded at the point at which the type
!    --  is frozen. The formal N is the Freeze_Node for the type. Any statements
!    --  or declarations generated by the freezing (e.g. the procedure generated
!    --  for initialization) are chained in the Acions field list of the freeze
     --  node using Append_Freeze_Actions.
  
     function Freeze_Type (N : Node_Id) return Boolean is
--- 4803,4812 ----
     -- Freeze_Type --
     -----------------
  
!    --  Full type declarations are expanded at the point at which the type is
!    --  frozen. The formal N is the Freeze_Node for the type. Any statements or
!    --  declarations generated by the freezing (e.g. the procedure generated
!    --  for initialization) are chained in the Actions field list of the freeze
     --  node using Append_Freeze_Actions.
  
     function Freeze_Type (N : Node_Id) return Boolean is
*************** package body Exp_Ch3 is
*** 4567,4579 ****
           if Ekind (Def_Id) = E_Record_Type then
              Freeze_Record_Type (N);
  
!          --  The subtype may have been declared before the type was frozen.
!          --  If the type has controlled components it is necessary to create
!          --  the entity for the controller explicitly because it did not
!          --  exist at the point of the subtype declaration. Only the entity is
!          --  needed, the back-end will obtain the layout from the type.
!          --  This is only necessary if this is constrained subtype whose
!          --  component list is not shared with the base type.
  
           elsif Ekind (Def_Id) = E_Record_Subtype
             and then Has_Discriminants (Def_Id)
--- 4845,4857 ----
           if Ekind (Def_Id) = E_Record_Type then
              Freeze_Record_Type (N);
  
!          --  The subtype may have been declared before the type was frozen. If
!          --  the type has controlled components it is necessary to create the
!          --  entity for the controller explicitly because it did not exist at
!          --  the point of the subtype declaration. Only the entity is needed,
!          --  the back-end will obtain the layout from the type. This is only
!          --  necessary if this is constrained subtype whose component list is
!          --  not shared with the base type.
  
           elsif Ekind (Def_Id) = E_Record_Subtype
             and then Has_Discriminants (Def_Id)
*************** package body Exp_Ch3 is
*** 4609,4616 ****
                 Result := True;
              end if;
  
!          --  Similar process if the controller of the subtype is not
!          --  present but the parent has it. This can happen with constrained
           --  record components where the subtype is an itype.
  
           elsif Ekind (Def_Id) = E_Record_Subtype
--- 4887,4894 ----
                 Result := True;
              end if;
  
!          --  Similar process if the controller of the subtype is not present
!          --  but the parent has it. This can happen with constrained
           --  record components where the subtype is an itype.
  
           elsif Ekind (Def_Id) = E_Record_Subtype
*************** package body Exp_Ch3 is
*** 4702,4710 ****
                    DT_Align : Node_Id;
  
                 begin
!                   --  For unconstrained composite types we give a size of
!                   --  zero so that the pool knows that it needs a special
!                   --  algorithm for variable size object allocation.
  
                    if Is_Composite_Type (Desig_Type)
                      and then not Is_Constrained (Desig_Type)
--- 4980,4988 ----
                    DT_Align : Node_Id;
  
                 begin
!                   --  For unconstrained composite types we give a size of zero
!                   --  so that the pool knows that it needs a special algorithm
!                   --  for variable size object allocation.
  
                    if Is_Composite_Type (Desig_Type)
                      and then not Is_Constrained (Desig_Type)
*************** package body Exp_Ch3 is
*** 4731,4741 ****
                      Make_Defining_Identifier (Loc,
                        Chars => New_External_Name (Chars (Def_Id), 'P'));
  
!                   --  We put the code associated with the pools in the
!                   --  entity that has the later freeze node, usually the
!                   --  acces type but it can also be the designated_type;
!                   --  because the pool code requires both those types to be
!                   --  frozen
  
                    if Is_Frozen (Desig_Type)
                      and then (not Present (Freeze_Node (Desig_Type))
--- 5009,5018 ----
                      Make_Defining_Identifier (Loc,
                        Chars => New_External_Name (Chars (Def_Id), 'P'));
  
!                   --  We put the code associated with the pools in the entity
!                   --  that has the later freeze node, usually the acces type
!                   --  but it can also be the designated_type; because the pool
!                   --  code requires both those types to be frozen
  
                    if Is_Frozen (Desig_Type)
                      and then (not Present (Freeze_Node (Desig_Type))
*************** package body Exp_Ch3 is
*** 4797,4812 ****
                 null;
              end if;
  
!             --  For access-to-controlled types (including class-wide types
!             --  and Taft-amendment types which potentially have controlled
!             --  components), expand the list controller object that will
!             --  store the dynamically allocated objects. Do not do this
              --  transformation for expander-generated access types, but do it
              --  for types that are the full view of types derived from other
              --  private types. Also suppress the list controller in the case
              --  of a designated type with convention Java, since this is used
!             --  when binding to Java API specs, where there's no equivalent
!             --  of a finalization list and we don't want to pull in the
              --  finalization support if not needed.
  
              if not Comes_From_Source (Def_Id)
--- 5074,5089 ----
                 null;
              end if;
  
!             --  For access-to-controlled types (including class-wide types and
!             --  Taft-amendment types which potentially have controlled
!             --  components), expand the list controller object that will store
!             --  the dynamically allocated objects. Do not do this
              --  transformation for expander-generated access types, but do it
              --  for types that are the full view of types derived from other
              --  private types. Also suppress the list controller in the case
              --  of a designated type with convention Java, since this is used
!             --  when binding to Java API specs, where there's no equivalent of
!             --  a finalization list and we don't want to pull in the
              --  finalization support if not needed.
  
              if not Comes_From_Source (Def_Id)
*************** package body Exp_Ch3 is
*** 4880,4888 ****
           Result := Freeze_Type (N);
           Set_Entity (N, Def_Id);
  
!       --  All other types require no expander action. There are such
!       --  cases (e.g. task types and protected types). In such cases,
!       --  the freeze nodes are there for use by Gigi.
  
        end if;
  
--- 5157,5165 ----
           Result := Freeze_Type (N);
           Set_Entity (N, Def_Id);
  
!       --  All other types require no expander action. There are such cases
!       --  (e.g. task types and protected types). In such cases, the freeze
!       --  nodes are there for use by Gigi.
  
        end if;
  
*************** package body Exp_Ch3 is
*** 4916,4925 ****
        --  These are the values computed by the procedure Check_Subtype_Bounds
  
        procedure Check_Subtype_Bounds;
!       --  This procedure examines the subtype T, and its ancestor subtypes
!       --  and derived types to determine the best known information about
!       --  the bounds of the subtype. After the call Lo_Bound is set either
!       --  to No_Uint if no information can be determined, or to a value which
        --  represents a known low bound, i.e. a valid value of the subtype can
        --  not be less than this value. Hi_Bound is similarly set to a known
        --  high bound (valid value cannot be greater than this).
--- 5193,5202 ----
        --  These are the values computed by the procedure Check_Subtype_Bounds
  
        procedure Check_Subtype_Bounds;
!       --  This procedure examines the subtype T, and its ancestor subtypes and
!       --  derived types to determine the best known information about the
!       --  bounds of the subtype. After the call Lo_Bound is set either to
!       --  No_Uint if no information can be determined, or to a value which
        --  represents a known low bound, i.e. a valid value of the subtype can
        --  not be less than this value. Hi_Bound is similarly set to a known
        --  high bound (valid value cannot be greater than this).
*************** package body Exp_Ch3 is
*** 4983,4998 ****
     begin
        --  For a private type, we should always have an underlying type
        --  (because this was already checked in Needs_Simple_Initialization).
!       --  What we do is to get the value for the underlying type and then
!       --  do an Unchecked_Convert to the private type.
  
        if Is_Private_Type (T) then
           Val := Get_Simple_Init_Val (Underlying_Type (T), Loc, Size);
  
!          --  A special case, if the underlying value is null, then qualify
!          --  it with the underlying type, so that the null is properly typed
!          --  Similarly, if it is an aggregate it must be qualified, because
!          --  an unchecked conversion does not provide a context for it.
  
           if Nkind (Val) = N_Null
             or else Nkind (Val) = N_Aggregate
--- 5260,5275 ----
     begin
        --  For a private type, we should always have an underlying type
        --  (because this was already checked in Needs_Simple_Initialization).
!       --  What we do is to get the value for the underlying type and then do
!       --  an Unchecked_Convert to the private type.
  
        if Is_Private_Type (T) then
           Val := Get_Simple_Init_Val (Underlying_Type (T), Loc, Size);
  
!          --  A special case, if the underlying value is null, then qualify it
!          --  with the underlying type, so that the null is properly typed
!          --  Similarly, if it is an aggregate it must be qualified, because an
!          --  unchecked conversion does not provide a context for it.
  
           if Nkind (Val) = N_Null
             or else Nkind (Val) = N_Aggregate
*************** package body Exp_Ch3 is
*** 5021,5029 ****
        elsif Is_Scalar_Type (T) then
           pragma Assert (Init_Or_Norm_Scalars);
  
!          --  Compute size of object. If it is given by the caller, we can
!          --  use it directly, otherwise we use Esize (T) as an estimate. As
!          --  far as we know this covers all cases correctly.
  
           if Size = No_Uint or else Size <= Uint_0 then
              Size_To_Use := UI_Max (Uint_1, Esize (T));
--- 5298,5306 ----
        elsif Is_Scalar_Type (T) then
           pragma Assert (Init_Or_Norm_Scalars);
  
!          --  Compute size of object. If it is given by the caller, we can use
!          --  it directly, otherwise we use Esize (T) as an estimate. As far as
!          --  we know this covers all cases correctly.
  
           if Size = No_Uint or else Size <= Uint_0 then
              Size_To_Use := UI_Max (Uint_1, Esize (T));
*************** package body Exp_Ch3 is
*** 5088,5096 ****
  
                 begin
                    --  Normally we like to use the most negative number. The
!                   --  one exception is when this number is in the known subtype
!                   --  range and the largest positive number is not in the known
!                   --  subtype range.
  
                    --  For this exceptional case, use largest positive value
  
--- 5365,5373 ----
  
                 begin
                    --  Normally we like to use the most negative number. The
!                   --  one exception is when this number is in the known
!                   --  subtype range and the largest positive number is not in
!                   --  the known subtype range.
  
                    --  For this exceptional case, use largest positive value
  
*************** package body Exp_Ch3 is
*** 5505,5550 ****
     begin
        Renamed_Eq := Empty;
  
!       --  Spec of _Alignment
  
        Append_To (Res, Predef_Spec_Or_Body (Loc,
          Tag_Typ => Tag_Typ,
!         Name    => Name_uAlignment,
          Profile => New_List (
            Make_Parameter_Specification (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
              Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!         Ret_Type => Standard_Integer));
  
!       --  Spec of _Size
  
        Append_To (Res, Predef_Spec_Or_Body (Loc,
          Tag_Typ => Tag_Typ,
!         Name    => Name_uSize,
          Profile => New_List (
            Make_Parameter_Specification (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
              Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!         Ret_Type => Standard_Long_Long_Integer));
! 
!       --  Specs for dispatching stream attributes. We skip these for limited
!       --  types, since there is no question of dispatching in the limited case.
  
!       --  We also skip these operations if dispatching is not available
!       --  or if streams are not available (since what's the point?)
  
!       if Stream_Operations_OK (Tag_Typ) then
!          Append_To (Res,
!            Predef_Stream_Attr_Spec (Loc, Tag_Typ, TSS_Stream_Read));
!          Append_To (Res,
!            Predef_Stream_Attr_Spec (Loc, Tag_Typ, TSS_Stream_Write));
!          Append_To (Res,
!            Predef_Stream_Attr_Spec (Loc, Tag_Typ, TSS_Stream_Input));
!          Append_To (Res,
!            Predef_Stream_Attr_Spec (Loc, Tag_Typ, TSS_Stream_Output));
!       end if;
  
        --  Spec of "=" if expanded if the type is not limited and if a
        --  user defined "=" was not already declared for the non-full
--- 5782,5829 ----
     begin
        Renamed_Eq := Empty;
  
!       --  Spec of _Size
  
        Append_To (Res, Predef_Spec_Or_Body (Loc,
          Tag_Typ => Tag_Typ,
!         Name    => Name_uSize,
          Profile => New_List (
            Make_Parameter_Specification (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
              Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!         Ret_Type => Standard_Long_Long_Integer));
  
!       --  Spec of _Alignment
  
        Append_To (Res, Predef_Spec_Or_Body (Loc,
          Tag_Typ => Tag_Typ,
!         Name    => Name_uAlignment,
          Profile => New_List (
            Make_Parameter_Specification (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
              Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!         Ret_Type => Standard_Integer));
  
!       --  Specs for dispatching stream attributes
  
!       declare
!          Stream_Op_TSS_Names :
!            constant array (Integer range <>) of TSS_Name_Type :=
!              (TSS_Stream_Read,
!               TSS_Stream_Write,
!               TSS_Stream_Input,
!               TSS_Stream_Output);
!       begin
!          for Op in Stream_Op_TSS_Names'Range loop
!             if Stream_Operation_OK (Tag_Typ, Stream_Op_TSS_Names (Op)) then
!                Append_To (Res,
!                   Predef_Stream_Attr_Spec (Loc, Tag_Typ,
!                     Stream_Op_TSS_Names (Op)));
!             end if;
!          end loop;
!       end;
  
        --  Spec of "=" if expanded if the type is not limited and if a
        --  user defined "=" was not already declared for the non-full
*************** package body Exp_Ch3 is
*** 5670,5675 ****
--- 5949,6002 ----
                 Parameter_Type      => New_Reference_To (Tag_Typ, Loc)))));
        end if;
  
+       --  Generate the declarations for the following primitive operations:
+       --    disp_asynchronous_select
+       --    disp_conditional_select
+       --    disp_get_prim_op_kind
+       --    disp_get_task_id
+       --    disp_timed_select
+       --  for limited interfaces and tagged types that implement a limited
+       --  interface.
+ 
+       if Ada_Version >= Ada_05
+         and then
+             ((Is_Interface (Tag_Typ)
+                 and then Is_Limited_Record (Tag_Typ))
+           or else
+              (not Is_Abstract (Tag_Typ)
+                 and then not Is_Controlled (Tag_Typ)
+               and then
+                 Implements_Interface
+                   (Typ          => Tag_Typ,
+                    Kind         => Any_Limited_Interface,
+                    Check_Parent => True)))
+       then
+          Append_To (Res,
+            Make_Subprogram_Declaration (Loc,
+              Specification =>
+                Make_Disp_Asynchronous_Select_Spec (Tag_Typ)));
+ 
+          Append_To (Res,
+            Make_Subprogram_Declaration (Loc,
+              Specification =>
+                Make_Disp_Conditional_Select_Spec (Tag_Typ)));
+ 
+          Append_To (Res,
+            Make_Subprogram_Declaration (Loc,
+              Specification =>
+                Make_Disp_Get_Prim_Op_Kind_Spec (Tag_Typ)));
+ 
+          Append_To (Res,
+            Make_Subprogram_Declaration (Loc,
+              Specification =>
+                Make_Disp_Get_Task_Id_Spec (Tag_Typ)));
+ 
+          Append_To (Res,
+            Make_Subprogram_Declaration (Loc,
+              Specification =>
+                Make_Disp_Timed_Select_Spec (Tag_Typ)));
+       end if;
+ 
        --  Specs for finalization actions that may be required in case a
        --  future extension contain a controlled element. We generate those
        --  only for root tagged types where they will get dummy bodies or
*************** package body Exp_Ch3 is
*** 5842,5848 ****
             Make_Function_Specification (Loc,
               Defining_Unit_Name       => Id,
               Parameter_Specifications => Profile,
!              Subtype_Mark             =>
                 New_Reference_To (Ret_Type, Loc));
        end if;
  
--- 6169,6175 ----
             Make_Function_Specification (Loc,
               Defining_Unit_Name       => Id,
               Parameter_Specifications => Profile,
!              Result_Definition        =>
                 New_Reference_To (Ret_Type, Loc));
        end if;
  
*************** package body Exp_Ch3 is
*** 5990,6022 ****
        --  non-limited types (in the limited case there is no dispatching).
        --  We also skip them if dispatching or finalization are not available.
  
!       if Stream_Operations_OK (Tag_Typ) then
!          if No (TSS (Tag_Typ, TSS_Stream_Read)) then
!             Build_Record_Read_Procedure (Loc, Tag_Typ, Decl, Ent);
              Append_To (Res, Decl);
           end if;
  
!          if No (TSS (Tag_Typ, TSS_Stream_Write)) then
!             Build_Record_Write_Procedure (Loc, Tag_Typ, Decl, Ent);
              Append_To (Res, Decl);
           end if;
  
!          --  Skip bodies of _Input and _Output for the abstract case, since
!          --  the corresponding specs are abstract (see Predef_Spec_Or_Body)
  
!          if not Is_Abstract (Tag_Typ) then
!             if No (TSS (Tag_Typ, TSS_Stream_Input)) then
!                Build_Record_Or_Elementary_Input_Function
!                  (Loc, Tag_Typ, Decl, Ent);
!                Append_To (Res, Decl);
!             end if;
  
!             if No (TSS (Tag_Typ, TSS_Stream_Output)) then
!                Build_Record_Or_Elementary_Output_Procedure
!                  (Loc, Tag_Typ, Decl, Ent);
!                Append_To (Res, Decl);
!             end if;
!          end if;
        end if;
  
        if not Is_Limited_Type (Tag_Typ) then
--- 6317,6385 ----
        --  non-limited types (in the limited case there is no dispatching).
        --  We also skip them if dispatching or finalization are not available.
  
!       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Read)
!         and then No (TSS (Tag_Typ, TSS_Stream_Read))
!       then
!          Build_Record_Read_Procedure (Loc, Tag_Typ, Decl, Ent);
!          Append_To (Res, Decl);
!       end if;
! 
!       if Stream_Operation_OK (Tag_Typ, TSS_Stream_Write)
!         and then No (TSS (Tag_Typ, TSS_Stream_Write))
!       then
!          Build_Record_Write_Procedure (Loc, Tag_Typ, Decl, Ent);
!          Append_To (Res, Decl);
!       end if;
! 
!       --  Skip bodies of _Input and _Output for the abstract case, since
!       --  the corresponding specs are abstract (see Predef_Spec_Or_Body)
! 
!       if not Is_Abstract (Tag_Typ) then
!          if Stream_Operation_OK (Tag_Typ, TSS_Stream_Input)
!            and then No (TSS (Tag_Typ, TSS_Stream_Input))
!          then
!             Build_Record_Or_Elementary_Input_Function
!               (Loc, Tag_Typ, Decl, Ent);
              Append_To (Res, Decl);
           end if;
  
!          if Stream_Operation_OK (Tag_Typ, TSS_Stream_Output)
!            and then No (TSS (Tag_Typ, TSS_Stream_Output))
!          then
!             Build_Record_Or_Elementary_Output_Procedure
!               (Loc, Tag_Typ, Decl, Ent);
              Append_To (Res, Decl);
           end if;
+       end if;
  
!       --  Generate the bodies for the following primitive operations:
  
!       --    disp_asynchronous_select
!       --    disp_conditional_select
!       --    disp_get_prim_op_kind
!       --    disp_get_task_id
!       --    disp_timed_select
  
!       --  for limited interfaces and tagged types that implement a limited
!       --  interface. The interface versions will have null bodies.
! 
!       if Ada_Version >= Ada_05
!         and then
!           ((Is_Interface (Tag_Typ) and then Is_Limited_Record (Tag_Typ))
!               or else
!                 (not Is_Abstract (Tag_Typ)
!                    and then not Is_Controlled (Tag_Typ)
!                    and then
!                      Implements_Interface
!                        (Typ          => Tag_Typ,
!                         Kind         => Any_Limited_Interface,
!                         Check_Parent => True)))
!       then
!          Append_To (Res, Make_Disp_Asynchronous_Select_Body (Tag_Typ));
!          Append_To (Res, Make_Disp_Conditional_Select_Body  (Tag_Typ));
!          Append_To (Res, Make_Disp_Get_Prim_Op_Kind_Body    (Tag_Typ));
!          Append_To (Res, Make_Disp_Get_Task_Id_Body         (Tag_Typ));
!          Append_To (Res, Make_Disp_Timed_Select_Body        (Tag_Typ));
        end if;
  
        if not Is_Limited_Type (Tag_Typ) then
*************** package body Exp_Ch3 is
*** 6024,6046 ****
           --  Body for equality
  
           if Eq_Needed then
  
!             Decl := Predef_Spec_Or_Body (Loc,
!               Tag_Typ => Tag_Typ,
!               Name    => Eq_Name,
!               Profile => New_List (
!                 Make_Parameter_Specification (Loc,
!                   Defining_Identifier =>
!                     Make_Defining_Identifier (Loc, Name_X),
!                   Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
! 
!                 Make_Parameter_Specification (Loc,
!                   Defining_Identifier =>
!                     Make_Defining_Identifier (Loc, Name_Y),
!                   Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!               Ret_Type => Standard_Boolean,
!               For_Body => True);
  
              declare
                 Def          : constant Node_Id := Parent (Tag_Typ);
--- 6387,6409 ----
           --  Body for equality
  
           if Eq_Needed then
+             Decl :=
+               Predef_Spec_Or_Body (Loc,
+                 Tag_Typ => Tag_Typ,
+                 Name    => Eq_Name,
+                 Profile => New_List (
+                   Make_Parameter_Specification (Loc,
+                     Defining_Identifier =>
+                       Make_Defining_Identifier (Loc, Name_X),
+                     Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
  
!                   Make_Parameter_Specification (Loc,
!                     Defining_Identifier =>
!                       Make_Defining_Identifier (Loc, Name_Y),
!                     Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
  
!                 Ret_Type => Standard_Boolean,
!                 For_Body => True);
  
              declare
                 Def          : constant Node_Id := Parent (Tag_Typ);
*************** package body Exp_Ch3 is
*** 6090,6108 ****
  
           --  Body for dispatching assignment
  
!          Decl := Predef_Spec_Or_Body (Loc,
!            Tag_Typ => Tag_Typ,
!            Name    => Name_uAssign,
!            Profile => New_List (
!              Make_Parameter_Specification (Loc,
!                Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
!                Out_Present         => True,
!                Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
  
!              Make_Parameter_Specification (Loc,
!                Defining_Identifier => Make_Defining_Identifier (Loc, Name_Y),
!                Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
!            For_Body => True);
  
           Set_Handled_Statement_Sequence (Decl,
             Make_Handled_Sequence_Of_Statements (Loc, New_List (
--- 6453,6472 ----
  
           --  Body for dispatching assignment
  
!          Decl :=
!            Predef_Spec_Or_Body (Loc,
!              Tag_Typ => Tag_Typ,
!              Name    => Name_uAssign,
!              Profile => New_List (
!                Make_Parameter_Specification (Loc,
!                  Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
!                  Out_Present         => True,
!                  Parameter_Type      => New_Reference_To (Tag_Typ, Loc)),
  
!                Make_Parameter_Specification (Loc,
!                  Defining_Identifier => Make_Defining_Identifier (Loc, Name_Y),
!                  Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
!              For_Body => True);
  
           Set_Handled_Statement_Sequence (Decl,
             Make_Handled_Sequence_Of_Statements (Loc, New_List (
*************** package body Exp_Ch3 is
*** 6202,6218 ****
        return Res;
     end Predefined_Primitive_Freeze;
  
!    --------------------------
!    -- Stream_Operations_OK --
!    --------------------------
  
-    function Stream_Operations_OK (Typ : Entity_Id) return Boolean is
     begin
        return
!         not Is_Limited_Type (Typ)
            and then RTE_Available (RE_Tag)
            and then RTE_Available (RE_Root_Stream_Type)
            and then not Restriction_Active (No_Dispatch)
            and then not Restriction_Active (No_Streams);
!    end Stream_Operations_OK;
  end Exp_Ch3;
--- 6566,6601 ----
        return Res;
     end Predefined_Primitive_Freeze;
  
!    -------------------------
!    -- Stream_Operation_OK --
!    -------------------------
! 
!    function Stream_Operation_OK
!      (Typ       : Entity_Id;
!       Operation : TSS_Name_Type) return Boolean
!    is
!       Has_Inheritable_Stream_Attribute : Boolean := False;
  
     begin
+       if Is_Limited_Type (Typ)
+         and then Is_Tagged_Type (Typ)
+         and then Is_Derived_Type (Typ)
+       then
+          --  Special case of a limited type extension: a default implementation
+          --  of the stream attributes Read and Write exists if the attribute
+          --  has been specified for an ancestor type.
+ 
+          Has_Inheritable_Stream_Attribute :=
+            Present (Find_Inherited_TSS (Base_Type (Etype (Typ)), Operation));
+       end if;
+ 
        return
!         not (Is_Limited_Type (Typ)
!                and then not Has_Inheritable_Stream_Attribute)
!           and then not Has_Unknown_Discriminants (Typ)
            and then RTE_Available (RE_Tag)
            and then RTE_Available (RE_Root_Stream_Type)
            and then not Restriction_Active (No_Dispatch)
            and then not Restriction_Active (No_Streams);
!    end Stream_Operation_OK;
  end Exp_Ch3;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch3.ads gcc-4.1.0/gcc/ada/exp_ch3.ads
*** gcc-4.0.2/gcc/ada/exp_ch3.ads	Thu Mar 17 19:53:05 2005
--- gcc-4.1.0/gcc/ada/exp_ch3.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Exp_Ch3 is
*** 40,51 ****
     procedure Expand_Previous_Access_Type (Def_Id : Entity_Id);
     --  For a full type declaration that contains tasks, or that is a task,
     --  check whether there exists an access type whose designated type is an
!    --  incomplete declarations for the current composite type. If so, build
!    --  the master for that access type, now that it is known to denote an
!    --  object with tasks.
  
     procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id);
!    --  Add a field _parent in the extension part of the record.
  
     procedure Build_Discr_Checking_Funcs (N : Node_Id);
     --  Builds function which checks whether the component name is consistent
--- 40,60 ----
     procedure Expand_Previous_Access_Type (Def_Id : Entity_Id);
     --  For a full type declaration that contains tasks, or that is a task,
     --  check whether there exists an access type whose designated type is an
!    --  incomplete declarations for the current composite type. If so, build the
!    --  master for that access type, now that it is known to denote an object
!    --  with tasks.
  
     procedure Expand_Record_Extension (T : Entity_Id; Def : Node_Id);
!    --  Add a field _parent in the extension part of the record
! 
!    procedure Build_Class_Wide_Master (T : Entity_Id);
!    --  For access to class-wide limited types we must build a task master
!    --  because some subsequent extension may add a task component. To avoid
!    --  bringing in the tasking run-time whenever an access-to-class-wide
!    --  limited type is used, we use the soft-link mechanism and add a level of
!    --  indirection to calls to routines that manipulate Master_Ids. This must
!    --  also be used for anonymous access types whose designated type is a task
!    --  or synchronized interface.
  
     procedure Build_Discr_Checking_Funcs (N : Node_Id);
     --  Builds function which checks whether the component name is consistent
*************** package Exp_Ch3 is
*** 66,75 ****
     --  constructed tree, and Typ is the type of the entity (the initialization
     --  procedure of the base type is the procedure that actually gets called).
     --  In_Init_Proc has to be set to True when the call is itself in an init
!    --  proc in order to enable the use of discriminals. Enclos_type is the
!    --  type of the init proc and it is used for various expansion cases
!    --  including the case where Typ is a task type which is a array component,
!    --  the indices of the enclosing type are used to build the string that
     --  identifies each task at runtime.
     --
     --  Discr_Map is used to replace discriminants by their discriminals in
--- 75,84 ----
     --  constructed tree, and Typ is the type of the entity (the initialization
     --  procedure of the base type is the procedure that actually gets called).
     --  In_Init_Proc has to be set to True when the call is itself in an init
!    --  proc in order to enable the use of discriminals. Enclos_type is the type
!    --  of the init proc and it is used for various expansion cases including
!    --  the case where Typ is a task type which is a array component, the
!    --  indices of the enclosing type are used to build the string that
     --  identifies each task at runtime.
     --
     --  Discr_Map is used to replace discriminants by their discriminals in
*************** package Exp_Ch3 is
*** 84,116 ****
  
     function Freeze_Type (N : Node_Id) return Boolean;
     --  This function executes the freezing actions associated with the given
!    --  freeze type node N and returns True if the node is to be deleted.
!    --  We delete the node if it is present just for front end purpose and
!    --  we don't want Gigi to see the node.  This function can't delete the
!    --  node itself since it would confuse any remaining processing of the
!    --  freeze node.
  
     function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
     --  Certain types need initialization even though there is no specific
!    --  initialization routine. In this category are access types (which
!    --  need initializing to null), packed array types whose implementation
!    --  is a modular type, and all scalar types if Normalize_Scalars is set,
!    --  as well as private types whose underlying type is present and meets
!    --  any of these criteria. Finally, descendants of String and Wide_String
!    --  also need initialization in Initialize/Normalize_Scalars mode.
  
     function Get_Simple_Init_Val
       (T    : Entity_Id;
        Loc  : Source_Ptr;
        Size : Uint := No_Uint) return Node_Id;
!    --  For a type which Needs_Simple_Initialization (see above), prepares
!    --  the tree for an expression representing the required initial value.
!    --  Loc is the source location used in constructing this tree which is
!    --  returned as the result of the call. The Size parameter indicates the
!    --  target size of the object if it is known (indicated by a value that
!    --  is not No_Uint and is greater than zero). If Size is not given (Size
!    --  set to No_Uint, or non-positive), then the Esize of T is used as an
!    --  estimate of the Size. The object size is needed to prepare a known
!    --  invalid value for use by Normalize_Scalars.
  
  end Exp_Ch3;
--- 93,124 ----
  
     function Freeze_Type (N : Node_Id) return Boolean;
     --  This function executes the freezing actions associated with the given
!    --  freeze type node N and returns True if the node is to be deleted. We
!    --  delete the node if it is present just for front end purpose and we don't
!    --  want Gigi to see the node. This function can't delete the node itself
!    --  since it would confuse any remaining processing of the freeze node.
  
     function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
     --  Certain types need initialization even though there is no specific
!    --  initialization routine. In this category are access types (which need
!    --  initializing to null), packed array types whose implementation is a
!    --  modular type, and all scalar types if Normalize_Scalars is set, as well
!    --  as private types whose underlying type is present and meets any of these
!    --  criteria. Finally, descendants of String and Wide_String also need
!    --  initialization in Initialize/Normalize_Scalars mode.
  
     function Get_Simple_Init_Val
       (T    : Entity_Id;
        Loc  : Source_Ptr;
        Size : Uint := No_Uint) return Node_Id;
!    --  For a type which Needs_Simple_Initialization (see above), prepares the
!    --  tree for an expression representing the required initial value. Loc is
!    --  the source location used in constructing this tree which is returned as
!    --  the result of the call. The Size parameter indicates the target size of
!    --  the object if it is known (indicated by a value that is not No_Uint and
!    --  is greater than zero). If Size is not given (Size set to No_Uint, or
!    --  non-positive), then the Esize of T is used as an estimate of the Size.
!    --  The object size is needed to prepare a known invalid value for use by
!    --  Normalize_Scalars.
  
  end Exp_Ch3;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch4.adb gcc-4.1.0/gcc/ada/exp_ch4.adb
*** gcc-4.0.2/gcc/ada/exp_ch4.adb	Thu Feb 10 13:54:15 2005
--- gcc-4.1.0/gcc/ada/exp_ch4.adb	Tue Nov 15 13:51:09 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Exp_Aggr; use Exp_Aggr;
*** 33,44 ****
  with Exp_Ch3;  use Exp_Ch3;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch9;  use Exp_Ch9;
- with Exp_Disp; use Exp_Disp;
  with Exp_Fixd; use Exp_Fixd;
  with Exp_Pakd; use Exp_Pakd;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
  with Exp_VFpt; use Exp_VFpt;
  with Hostparm; use Hostparm;
  with Inline;   use Inline;
  with Nlists;   use Nlists;
--- 33,44 ----
  with Exp_Ch3;  use Exp_Ch3;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch9;  use Exp_Ch9;
  with Exp_Fixd; use Exp_Fixd;
  with Exp_Pakd; use Exp_Pakd;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
  with Exp_VFpt; use Exp_VFpt;
+ with Freeze;   use Freeze;
  with Hostparm; use Hostparm;
  with Inline;   use Inline;
  with Nlists;   use Nlists;
*************** package body Exp_Ch4 is
*** 362,375 ****
     ---------------------------------
  
     procedure Expand_Allocator_Expression (N : Node_Id) is
!       Loc   : constant Source_Ptr := Sloc (N);
!       Exp   : constant Node_Id    := Expression (Expression (N));
!       Indic : constant Node_Id    := Subtype_Mark (Expression (N));
!       PtrT  : constant Entity_Id  := Etype (N);
!       T     : constant Entity_Id  := Entity (Indic);
!       Flist : Node_Id;
!       Node  : Node_Id;
!       Temp  : Entity_Id;
  
        Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp);
  
--- 362,376 ----
     ---------------------------------
  
     procedure Expand_Allocator_Expression (N : Node_Id) is
!       Loc    : constant Source_Ptr := Sloc (N);
!       Exp    : constant Node_Id    := Expression (Expression (N));
!       Indic  : constant Node_Id    := Subtype_Mark (Expression (N));
!       PtrT   : constant Entity_Id  := Etype (N);
!       DesigT : constant Entity_Id  := Designated_Type (PtrT);
!       T      : constant Entity_Id  := Entity (Indic);
!       Flist  : Node_Id;
!       Node   : Node_Id;
!       Temp   : Entity_Id;
  
        Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp);
  
*************** package body Exp_Ch4 is
*** 445,450 ****
--- 446,489 ----
                  Expression          => Node));
           end if;
  
+          --  Ada 2005 (AI-344): For an allocator with a class-wide designated
+          --  type, generate an accessibility check to verify that the level of
+          --  the type of the created object is not deeper than the level of the
+          --  access type. If the type of the qualified expression is class-
+          --  wide, then always generate the check. Otherwise, only generate the
+          --  check if the level of the qualified expression type is statically
+          --  deeper than the access type. Although the static accessibility
+          --  will generally have been performed as a legality check, it won't
+          --  have been done in cases where the allocator appears in generic
+          --  body, so a run-time check is needed in general.
+ 
+          if Ada_Version >= Ada_05
+            and then Is_Class_Wide_Type (DesigT)
+            and then not Scope_Suppress (Accessibility_Check)
+            and then
+              (Is_Class_Wide_Type (Etype (Exp))
+                 or else
+               Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT))
+          then
+             Insert_Action (N,
+                Make_Raise_Program_Error (Loc,
+                  Condition =>
+                    Make_Op_Gt (Loc,
+                      Left_Opnd  =>
+                        Make_Function_Call (Loc,
+                          Name =>
+                            New_Reference_To (RTE (RE_Get_Access_Level), Loc),
+                          Parameter_Associations =>
+                            New_List (Make_Attribute_Reference (Loc,
+                                        Prefix         =>
+                                           New_Reference_To (Temp, Loc),
+                                        Attribute_Name =>
+                                           Name_Tag))),
+                      Right_Opnd =>
+                        Make_Integer_Literal (Loc, Type_Access_Level (PtrT))),
+                  Reason => PE_Accessibility_Check_Failed));
+          end if;
+ 
           --  Suppress the tag assignment when Java_VM because JVM tags
           --  are represented implicitly in objects.
  
*************** package body Exp_Ch4 is
*** 458,468 ****
                    Make_Selected_Component (Loc,
                      Prefix => New_Reference_To (Temp, Loc),
                      Selector_Name =>
!                       New_Reference_To (Tag_Component (T), Loc)),
  
                  Expression =>
                    Unchecked_Convert_To (RTE (RE_Tag),
!                     New_Reference_To (Access_Disp_Table (T), Loc)));
  
              --  The previous assignment has to be done in any case
  
--- 497,509 ----
                    Make_Selected_Component (Loc,
                      Prefix => New_Reference_To (Temp, Loc),
                      Selector_Name =>
!                       New_Reference_To (First_Tag_Component (T), Loc)),
  
                  Expression =>
                    Unchecked_Convert_To (RTE (RE_Tag),
!                     New_Reference_To
!                       (Elists.Node (First_Elmt (Access_Disp_Table (T))),
!                        Loc)));
  
              --  The previous assignment has to be done in any case
  
*************** package body Exp_Ch4 is
*** 487,505 ****
                       Make_Selected_Component (Loc,
                         Prefix => Ref,
                         Selector_Name =>
!                          New_Reference_To (Tag_Component (Utyp), Loc)),
  
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
                         New_Reference_To (
!                          Access_Disp_Table (Utyp), Loc)));
  
                 Set_Assignment_OK (Name (Tag_Assign));
                 Insert_Action (N, Tag_Assign);
              end;
           end if;
  
!          if Controlled_Type (Designated_Type (PtrT))
              and then Controlled_Type (T)
           then
              declare
--- 528,547 ----
                       Make_Selected_Component (Loc,
                         Prefix => Ref,
                         Selector_Name =>
!                          New_Reference_To (First_Tag_Component (Utyp), Loc)),
  
                     Expression =>
                       Unchecked_Convert_To (RTE (RE_Tag),
                         New_Reference_To (
!                          Elists.Node (First_Elmt (Access_Disp_Table (Utyp))),
!                          Loc)));
  
                 Set_Assignment_OK (Name (Tag_Assign));
                 Insert_Action (N, Tag_Assign);
              end;
           end if;
  
!          if Controlled_Type (DesigT)
              and then Controlled_Type (T)
           then
              declare
*************** package body Exp_Ch4 is
*** 589,602 ****
           Rewrite (N, New_Reference_To (Temp, Loc));
           Analyze_And_Resolve (N, PtrT);
  
!       elsif Is_Access_Type (Designated_Type (PtrT))
          and then Nkind (Exp) = N_Allocator
          and then Nkind (Expression (Exp)) /= N_Qualified_Expression
        then
           --  Apply constraint to designated subtype indication
  
           Apply_Constraint_Check (Expression (Exp),
!            Designated_Type (Designated_Type (PtrT)),
             No_Sliding => True);
  
           if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
--- 631,644 ----
           Rewrite (N, New_Reference_To (Temp, Loc));
           Analyze_And_Resolve (N, PtrT);
  
!       elsif Is_Access_Type (DesigT)
          and then Nkind (Exp) = N_Allocator
          and then Nkind (Expression (Exp)) /= N_Qualified_Expression
        then
           --  Apply constraint to designated subtype indication
  
           Apply_Constraint_Check (Expression (Exp),
!            Designated_Type (DesigT),
             No_Sliding => True);
  
           if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
*************** package body Exp_Ch4 is
*** 623,634 ****
           --  on the qualified expression does not allow sliding,
           --  but this check does (a relaxation from Ada 83).
  
!          if Is_Constrained (Designated_Type (PtrT))
             and then not Subtypes_Statically_Match
!                           (T, Designated_Type (PtrT))
           then
              Apply_Constraint_Check
!               (Exp, Designated_Type (PtrT), No_Sliding => False);
  
           --  The nonsliding check should really be performed
           --  (unconditionally) against the subtype of the
--- 665,676 ----
           --  on the qualified expression does not allow sliding,
           --  but this check does (a relaxation from Ada 83).
  
!          if Is_Constrained (DesigT)
             and then not Subtypes_Statically_Match
!                           (T, DesigT)
           then
              Apply_Constraint_Check
!               (Exp, DesigT, No_Sliding => False);
  
           --  The nonsliding check should really be performed
           --  (unconditionally) against the subtype of the
*************** package body Exp_Ch4 is
*** 637,644 ****
  
           else
              Apply_Constraint_Check
!               (Exp, Designated_Type (PtrT), No_Sliding => True);
           end if;
        end if;
  
     exception
--- 679,711 ----
  
           else
              Apply_Constraint_Check
!               (Exp, DesigT, No_Sliding => True);
!          end if;
! 
!          --  For an access to unconstrained packed array, GIGI needs
!          --  to see an expression with a constrained subtype in order
!          --  to compute the proper size for the allocator.
! 
!          if Is_Array_Type (T)
!            and then not Is_Constrained (T)
!            and then Is_Packed (T)
!          then
!             declare
!                ConstrT      : constant Entity_Id :=
!                                 Make_Defining_Identifier (Loc,
!                                   Chars => New_Internal_Name ('A'));
!                Internal_Exp : constant Node_Id   := Relocate_Node (Exp);
!             begin
!                Insert_Action (Exp,
!                  Make_Subtype_Declaration (Loc,
!                    Defining_Identifier => ConstrT,
!                    Subtype_Indication  =>
!                      Make_Subtype_From_Expr (Exp, T)));
!                Freeze_Itype (ConstrT, Exp);
!                Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
!             end;
           end if;
+ 
        end if;
  
     exception
*************** package body Exp_Ch4 is
*** 1063,1072 ****
           Test := Expand_Composite_Equality
                     (Nod, Component_Type (Typ), L, R, Decls);
  
!          --  If some (sub)component is an unchecked_union, the whole
!          --  operation will raise program error.
  
           if Nkind (Test) = N_Raise_Program_Error then
              return Test;
  
           else
--- 1130,1145 ----
           Test := Expand_Composite_Equality
                     (Nod, Component_Type (Typ), L, R, Decls);
  
!          --  If some (sub)component is an unchecked_union, the whole operation
!          --  will raise program error.
  
           if Nkind (Test) = N_Raise_Program_Error then
+ 
+             --  This node is going to be inserted at a location where a
+             --  statement is expected: clear its Etype so analysis will
+             --  set it to the expected Standard_Void_Type.
+ 
+             Set_Etype (Test, Empty);
              return Test;
  
           else
*************** package body Exp_Ch4 is
*** 1160,1165 ****
--- 1233,1239 ----
             Handle_One_Dimension (N + 1, Next_Index (Index)));
  
           if Need_Separate_Indexes then
+ 
              --  Generate guard for loop, followed by increments of indices
  
              Append_To (Stm_List,
*************** package body Exp_Ch4 is
*** 1188,1195 ****
                      Expressions    => New_List (New_Reference_To (Bn, Loc)))));
           end if;
  
!          --  If separate indexes, we need a declare block for An and Bn,
!          --  and a loop without an iteration scheme.
  
           if Need_Separate_Indexes then
              Loop_Stm :=
--- 1262,1269 ----
                      Expressions    => New_List (New_Reference_To (Bn, Loc)))));
           end if;
  
!          --  If separate indexes, we need a declare block for An and Bn, and a
!          --  loop without an iteration scheme.
  
           if Need_Separate_Indexes then
              Loop_Stm :=
*************** package body Exp_Ch4 is
*** 1344,1350 ****
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Subtype_Mark => New_Reference_To (Standard_Boolean, Loc)),
  
            Declarations =>  Decls,
  
--- 1418,1424 ----
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Result_Definition => New_Reference_To (Standard_Boolean, Loc)),
  
            Declarations =>  Decls,
  
*************** package body Exp_Ch4 is
*** 1419,1479 ****
        Typ : constant Entity_Id  := Etype (N);
  
     begin
!       if Is_Bit_Packed_Array (Typ) then
           Expand_Packed_Boolean_Operator (N);
  
!       else
!          --  For the normal non-packed case, the general expansion is
!          --  to build a function for carrying out the comparison (using
!          --  Make_Boolean_Array_Op) and then inserting it into the tree.
!          --  The original operator node is then rewritten as a call to
!          --  this function.
  
!          declare
!             Loc       : constant Source_Ptr := Sloc (N);
!             L         : constant Node_Id    := Relocate_Node (Left_Opnd  (N));
!             R         : constant Node_Id    := Relocate_Node (Right_Opnd (N));
!             Func_Body : Node_Id;
!             Func_Name : Entity_Id;
  
!          begin
!             Convert_To_Actual_Subtype (L);
!             Convert_To_Actual_Subtype (R);
!             Ensure_Defined (Etype (L), N);
!             Ensure_Defined (Etype (R), N);
!             Apply_Length_Check (R, Etype (L));
  
!             if Nkind (Parent (N)) = N_Assignment_Statement
!                and then Safe_In_Place_Array_Op (Name (Parent (N)), L, R)
!             then
!                Build_Boolean_Array_Proc_Call (Parent (N), L, R);
  
!             elsif Nkind (Parent (N)) = N_Op_Not
!                and then Nkind (N) = N_Op_And
!                and then
!                  Safe_In_Place_Array_Op (Name (Parent (Parent (N))), L, R)
!             then
!                return;
!             else
  
!                Func_Body := Make_Boolean_Array_Op (Etype (L), N);
!                Func_Name := Defining_Unit_Name (Specification (Func_Body));
!                Insert_Action (N, Func_Body);
  
!                --  Now rewrite the expression with a call
  
!                Rewrite (N,
!                  Make_Function_Call (Loc,
!                    Name => New_Reference_To (Func_Name, Loc),
!                    Parameter_Associations =>
!                      New_List
!                        (L, Make_Type_Conversion
!                           (Loc, New_Reference_To (Etype (L), Loc), R))));
  
!                Analyze_And_Resolve (N, Typ);
!             end if;
!          end;
!       end if;
     end Expand_Boolean_Operator;
  
     -------------------------------
--- 1493,1561 ----
        Typ : constant Entity_Id  := Etype (N);
  
     begin
!       --  Special case of bit packed array where both operands are known
!       --  to be properly aligned. In this case we use an efficient run time
!       --  routine to carry out the operation (see System.Bit_Ops).
! 
!       if Is_Bit_Packed_Array (Typ)
!         and then not Is_Possibly_Unaligned_Object (Left_Opnd (N))
!         and then not Is_Possibly_Unaligned_Object (Right_Opnd (N))
!       then
           Expand_Packed_Boolean_Operator (N);
+          return;
+       end if;
  
!       --  For the normal non-packed case, the general expansion is to build
!       --  function for carrying out the comparison (use Make_Boolean_Array_Op)
!       --  and then inserting it into the tree. The original operator node is
!       --  then rewritten as a call to this function. We also use this in the
!       --  packed case if either operand is a possibly unaligned object.
  
!       declare
!          Loc       : constant Source_Ptr := Sloc (N);
!          L         : constant Node_Id    := Relocate_Node (Left_Opnd  (N));
!          R         : constant Node_Id    := Relocate_Node (Right_Opnd (N));
!          Func_Body : Node_Id;
!          Func_Name : Entity_Id;
  
!       begin
!          Convert_To_Actual_Subtype (L);
!          Convert_To_Actual_Subtype (R);
!          Ensure_Defined (Etype (L), N);
!          Ensure_Defined (Etype (R), N);
!          Apply_Length_Check (R, Etype (L));
  
!          if Nkind (Parent (N)) = N_Assignment_Statement
!            and then Safe_In_Place_Array_Op (Name (Parent (N)), L, R)
!          then
!             Build_Boolean_Array_Proc_Call (Parent (N), L, R);
  
!          elsif Nkind (Parent (N)) = N_Op_Not
!            and then Nkind (N) = N_Op_And
!            and then
!          Safe_In_Place_Array_Op (Name (Parent (Parent (N))), L, R)
!          then
!             return;
!          else
  
!             Func_Body := Make_Boolean_Array_Op (Etype (L), N);
!             Func_Name := Defining_Unit_Name (Specification (Func_Body));
!             Insert_Action (N, Func_Body);
  
!             --  Now rewrite the expression with a call
  
!             Rewrite (N,
!               Make_Function_Call (Loc,
!                 Name                   => New_Reference_To (Func_Name, Loc),
!                 Parameter_Associations =>
!                   New_List (
!                     L,
!                     Make_Type_Conversion
!                       (Loc, New_Reference_To (Etype (L), Loc), R))));
  
!             Analyze_And_Resolve (N, Typ);
!          end if;
!       end;
     end Expand_Boolean_Operator;
  
     -------------------------------
*************** package body Exp_Ch4 is
*** 1781,1787 ****
     --            end loop;
     --         end if;
  
!    --         . . .
  
     --         if Sn'Length /= 0 then
     --            P := Sn'First;
--- 1863,1869 ----
     --            end loop;
     --         end if;
  
!    --         ...
  
     --         if Sn'Length /= 0 then
     --            P := Sn'First;
*************** package body Exp_Ch4 is
*** 2163,2169 ****
          Make_Function_Specification (Loc,
            Defining_Unit_Name       => Func_Id,
            Parameter_Specifications => Param_Specs,
!           Subtype_Mark             => New_Reference_To (Base_Typ, Loc));
  
        --  Construct L's object declaration
  
--- 2245,2251 ----
          Make_Function_Specification (Loc,
            Defining_Unit_Name       => Func_Id,
            Parameter_Specifications => Param_Specs,
!           Result_Definition        => New_Reference_To (Base_Typ, Loc));
  
        --  Construct L's object declaration
  
*************** package body Exp_Ch4 is
*** 2982,3003 ****
        Rop    : constant Node_Id    := Right_Opnd (N);
        Static : constant Boolean    := Is_OK_Static_Expression (N);
  
     begin
!       --  If we have an explicit range, do a bit of optimization based
!       --  on range analysis (we may be able to kill one or both checks).
  
        if Nkind (Rop) = N_Range then
           declare
!             Lcheck : constant Compare_Result :=
!                        Compile_Time_Compare (Lop, Low_Bound (Rop));
!             Ucheck : constant Compare_Result :=
!                        Compile_Time_Compare (Lop, High_Bound (Rop));
  
           begin
!             --  If either check is known to fail, replace result
!             --  by False, since the other check does not matter.
!             --  Preserve the static flag for legality checks, because
!             --  we are constant-folding beyond RM 4.9.
  
              if Lcheck = LT or else Ucheck = GT then
                 Rewrite (N,
--- 3064,3144 ----
        Rop    : constant Node_Id    := Right_Opnd (N);
        Static : constant Boolean    := Is_OK_Static_Expression (N);
  
+       procedure Substitute_Valid_Check;
+       --  Replaces node N by Lop'Valid. This is done when we have an explicit
+       --  test for the left operand being in range of its subtype.
+ 
+       ----------------------------
+       -- Substitute_Valid_Check --
+       ----------------------------
+ 
+       procedure Substitute_Valid_Check is
+       begin
+          Rewrite (N,
+            Make_Attribute_Reference (Loc,
+              Prefix         => Relocate_Node (Lop),
+              Attribute_Name => Name_Valid));
+ 
+          Analyze_And_Resolve (N, Rtyp);
+ 
+          Error_Msg_N ("?explicit membership test may be optimized away", N);
+          Error_Msg_N ("\?use ''Valid attribute instead", N);
+          return;
+       end Substitute_Valid_Check;
+ 
+    --  Start of processing for Expand_N_In
+ 
     begin
!       --  Check case of explicit test for an expression in range of its
!       --  subtype. This is suspicious usage and we replace it with a 'Valid
!       --  test and give a warning.
! 
!       if Is_Scalar_Type (Etype (Lop))
!         and then Nkind (Rop) in N_Has_Entity
!         and then Etype (Lop) = Entity (Rop)
!         and then Comes_From_Source (N)
!       then
!          Substitute_Valid_Check;
!          return;
!       end if;
! 
!       --  Case of explicit range
  
        if Nkind (Rop) = N_Range then
           declare
!             Lo : constant Node_Id := Low_Bound (Rop);
!             Hi : constant Node_Id := High_Bound (Rop);
! 
!             Lo_Orig : constant Node_Id := Original_Node (Lo);
!             Hi_Orig : constant Node_Id := Original_Node (Hi);
! 
!             Lcheck : constant Compare_Result := Compile_Time_Compare (Lop, Lo);
!             Ucheck : constant Compare_Result := Compile_Time_Compare (Lop, Hi);
  
           begin
!             --  If test is explicit x'first .. x'last, replace by valid check
! 
!             if Is_Scalar_Type (Etype (Lop))
!               and then Nkind (Lo_Orig) = N_Attribute_Reference
!               and then Attribute_Name (Lo_Orig) = Name_First
!               and then Nkind (Prefix (Lo_Orig)) in N_Has_Entity
!               and then Entity (Prefix (Lo_Orig)) = Etype (Lop)
!               and then Nkind (Hi_Orig) = N_Attribute_Reference
!               and then Attribute_Name (Hi_Orig) = Name_Last
!               and then Nkind (Prefix (Hi_Orig)) in N_Has_Entity
!               and then Entity (Prefix (Hi_Orig)) = Etype (Lop)
!               and then Comes_From_Source (N)
!             then
!                Substitute_Valid_Check;
!                return;
!             end if;
! 
!             --  If we have an explicit range, do a bit of optimization based
!             --  on range analysis (we may be able to kill one or both checks).
! 
!             --  If either check is known to fail, replace result by False since
!             --  the other check does not matter. Preserve the static flag for
!             --  legality checks, because we are constant-folding beyond RM 4.9.
  
              if Lcheck = LT or else Ucheck = GT then
                 Rewrite (N,
*************** package body Exp_Ch4 is
*** 3400,3407 ****
     --  can be done. This avoids needing to duplicate this expansion code.
  
     procedure Expand_N_Not_In (N : Node_Id) is
!       Loc  : constant Source_Ptr := Sloc (N);
!       Typ  : constant Entity_Id  := Etype (N);
  
     begin
        Rewrite (N,
--- 3541,3549 ----
     --  can be done. This avoids needing to duplicate this expansion code.
  
     procedure Expand_N_Not_In (N : Node_Id) is
!       Loc : constant Source_Ptr := Sloc (N);
!       Typ : constant Entity_Id  := Etype (N);
!       Cfs : constant Boolean    := Comes_From_Source (N);
  
     begin
        Rewrite (N,
*************** package body Exp_Ch4 is
*** 3409,3415 ****
            Right_Opnd =>
              Make_In (Loc,
                Left_Opnd  => Left_Opnd (N),
!               Right_Opnd => Right_Opnd (N))));
        Analyze_And_Resolve (N, Typ);
     end Expand_N_Not_In;
  
--- 3551,3566 ----
            Right_Opnd =>
              Make_In (Loc,
                Left_Opnd  => Left_Opnd (N),
!                      Right_Opnd => Right_Opnd (N))));
! 
!       --  We want this tp appear as coming from source if original does (see
!       --  tranformations in Expand_N_In).
! 
!       Set_Comes_From_Source (N, Cfs);
!       Set_Comes_From_Source (Right_Opnd (N), Cfs);
! 
!       --  Now analyze tranformed node
! 
        Analyze_And_Resolve (N, Typ);
     end Expand_N_Not_In;
  
*************** package body Exp_Ch4 is
*** 3730,3742 ****
     begin
        Binary_Op_Validity_Checks (N);
  
-       --  Vax_Float is a special case
- 
-       if Vax_Float (Typ) then
-          Expand_Vax_Arith (N);
-          return;
-       end if;
- 
        --  N / 1 = N for integer types
  
        if Is_Integer_Type (Typ)
--- 3881,3886 ----
*************** package body Exp_Ch4 is
*** 3827,3833 ****
  
           Analyze_And_Resolve (Left_Opnd (N), Universal_Real);
  
!       --  Non-fixed point cases, do zero divide and overflow checks
  
        elsif Is_Integer_Type (Typ) then
           Apply_Divide_Check (N);
--- 3971,3977 ----
  
           Analyze_And_Resolve (Left_Opnd (N), Universal_Real);
  
!       --  Non-fixed point cases, do integer zero divide and overflow checks
  
        elsif Is_Integer_Type (Typ) then
           Apply_Divide_Check (N);
*************** package body Exp_Ch4 is
*** 3839,3844 ****
--- 3983,3994 ----
           then
              Error_Msg_CRT ("64-bit division", N);
           end if;
+ 
+       --  Deal with Vax_Float
+ 
+       elsif Vax_Float (Typ) then
+          Expand_Vax_Arith (N);
+          return;
        end if;
     end Expand_N_Op_Divide;
  
*************** package body Exp_Ch4 is
*** 3899,3905 ****
              begin
                 --  Per-object constrained selected components require special
                 --  attention. If the enclosing scope of the component is an
!                --  Unchecked_Union, we can not reference its discriminants
                 --  directly. This is why we use the two extra parameters of
                 --  the equality function of the enclosing Unchecked_Union.
  
--- 4049,4055 ----
              begin
                 --  Per-object constrained selected components require special
                 --  attention. If the enclosing scope of the component is an
!                --  Unchecked_Union, we cannot reference its discriminants
                 --  directly. This is why we use the two extra parameters of
                 --  the equality function of the enclosing Unchecked_Union.
  
*************** package body Exp_Ch4 is
*** 3943,3949 ****
                 --     Obj1 : Enclosing_Non_UU_Type;
                 --     Obj2 : Enclosing_Non_UU_Type (1);
  
!                --     . . . Obj1 = Obj2 . . .
  
                 --     Generated code:
  
--- 4093,4099 ----
                 --     Obj1 : Enclosing_Non_UU_Type;
                 --     Obj2 : Enclosing_Non_UU_Type (1);
  
!                --     ...  Obj1 = Obj2 ...
  
                 --     Generated code:
  
*************** package body Exp_Ch4 is
*** 4059,4065 ****
          (Typ : Node_Id) return Boolean
        is
           Tdef  : constant Node_Id :=
!                    Type_Definition (Declaration_Node (Typ));
           Clist : Node_Id;
           Vpart : Node_Id;
  
--- 4209,4215 ----
          (Typ : Node_Id) return Boolean
        is
           Tdef  : constant Node_Id :=
!                    Type_Definition (Declaration_Node (Base_Type (Typ)));
           Clist : Node_Id;
           Vpart : Node_Id;
  
*************** package body Exp_Ch4 is
*** 4115,4128 ****
                 return False;
              end if;
  
              declare
                 Comp : Node_Id := First (Component_Items (Clist));
  
              begin
                 while Present (Comp) loop
- 
-                   --  One component is sufficent
- 
                    if Component_Is_Unconstrained_UU (Comp) then
                       return True;
                    end if;
--- 4265,4277 ----
                 return False;
              end if;
  
+             --  We only need to test one component
+ 
              declare
                 Comp : Node_Id := First (Component_Items (Clist));
  
              begin
                 while Present (Comp) loop
                    if Component_Is_Unconstrained_UU (Comp) then
                       return True;
                    end if;
*************** package body Exp_Ch4 is
*** 4200,4208 ****
  
        if Ekind (Typl) = E_Private_Type then
           Typl := Underlying_Type (Typl);
- 
        elsif Ekind (Typl) = E_Private_Subtype then
           Typl := Underlying_Type (Base_Type (Typl));
        end if;
  
        --  It may happen in error situations that the underlying type is not
--- 4349,4358 ----
  
        if Ekind (Typl) = E_Private_Type then
           Typl := Underlying_Type (Typl);
        elsif Ekind (Typl) = E_Private_Subtype then
           Typl := Underlying_Type (Base_Type (Typl));
+       else
+          null;
        end if;
  
        --  It may happen in error situations that the underlying type is not
*************** package body Exp_Ch4 is
*** 4215,4229 ****
  
        Typl := Base_Type (Typl);
  
-       --  Vax float types
- 
-       if Vax_Float (Typl) then
-          Expand_Vax_Comparison (N);
-          return;
- 
        --  Boolean types (requiring handling of non-standard case)
  
!       elsif Is_Boolean_Type (Typl) then
           Adjust_Condition (Left_Opnd (N));
           Adjust_Condition (Right_Opnd (N));
           Set_Etype (N, Standard_Boolean);
--- 4365,4373 ----
  
        Typl := Base_Type (Typl);
  
        --  Boolean types (requiring handling of non-standard case)
  
!       if Is_Boolean_Type (Typl) then
           Adjust_Condition (Left_Opnd (N));
           Adjust_Condition (Right_Opnd (N));
           Set_Etype (N, Standard_Boolean);
*************** package body Exp_Ch4 is
*** 4254,4273 ****
                 Force_Validity_Checks := Save_Force_Validity_Checks;
              end;
  
!          --  Packed case
  
!          elsif Is_Bit_Packed_Array (Typl) then
              Expand_Packed_Eq (N);
  
           --  Where the component type is elementary we can use a block bit
           --  comparison (if supported on the target) exception in the case
           --  of floating-point (negative zero issues require element by
           --  element comparison), and atomic types (where we must be sure
!          --  to load elements independently).
  
           elsif Is_Elementary_Type (Component_Type (Typl))
             and then not Is_Floating_Point_Type (Component_Type (Typl))
             and then not Is_Atomic (Component_Type (Typl))
             and then Support_Composite_Compare_On_Target
           then
              null;
--- 4398,4422 ----
                 Force_Validity_Checks := Save_Force_Validity_Checks;
              end;
  
!          --  Packed case where both operands are known aligned
  
!          elsif Is_Bit_Packed_Array (Typl)
!            and then not Is_Possibly_Unaligned_Object (Lhs)
!            and then not Is_Possibly_Unaligned_Object (Rhs)
!          then
              Expand_Packed_Eq (N);
  
           --  Where the component type is elementary we can use a block bit
           --  comparison (if supported on the target) exception in the case
           --  of floating-point (negative zero issues require element by
           --  element comparison), and atomic types (where we must be sure
!          --  to load elements independently) and possibly unaligned arrays.
  
           elsif Is_Elementary_Type (Component_Type (Typl))
             and then not Is_Floating_Point_Type (Component_Type (Typl))
             and then not Is_Atomic (Component_Type (Typl))
+            and then not Is_Possibly_Unaligned_Object (Lhs)
+            and then not Is_Possibly_Unaligned_Object (Rhs)
             and then Support_Composite_Compare_On_Target
           then
              null;
*************** package body Exp_Ch4 is
*** 4422,4432 ****
        end if;
  
        --  If we still have an equality comparison (i.e. it was not rewritten
!       --  in some way), then we can test if result is needed at compile time).
  
        if Nkind (N) = N_Op_Eq then
           Rewrite_Comparison (N);
        end if;
     end Expand_N_Op_Eq;
  
     -----------------------
--- 4571,4588 ----
        end if;
  
        --  If we still have an equality comparison (i.e. it was not rewritten
!       --  in some way), then we can test if result is known at compile time).
  
        if Nkind (N) = N_Op_Eq then
           Rewrite_Comparison (N);
        end if;
+ 
+       --  If we still have comparison for Vax_Float, process it
+ 
+       if Vax_Float (Typl) and then Nkind (N) in N_Op_Compare  then
+          Expand_Vax_Comparison (N);
+          return;
+       end if;
     end Expand_N_Op_Eq;
  
     -----------------------
*************** package body Exp_Ch4 is
*** 4741,4751 ****
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Vax_Float (Typ1) then
!          Expand_Vax_Comparison (N);
!          return;
! 
!       elsif Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
--- 4897,4903 ----
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
*************** package body Exp_Ch4 is
*** 4758,4763 ****
--- 4910,4922 ----
        end if;
  
        Rewrite_Comparison (N);
+ 
+       --  If we still have comparison, and Vax_Float type, process it
+ 
+       if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+          Expand_Vax_Comparison (N);
+          return;
+       end if;
     end Expand_N_Op_Ge;
  
     --------------------
*************** package body Exp_Ch4 is
*** 4773,4783 ****
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Vax_Float (Typ1) then
!          Expand_Vax_Comparison (N);
!          return;
! 
!       elsif Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
--- 4932,4938 ----
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
*************** package body Exp_Ch4 is
*** 4790,4795 ****
--- 4945,4957 ----
        end if;
  
        Rewrite_Comparison (N);
+ 
+       --  If we still have comparison, and Vax_Float type, process it
+ 
+       if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+          Expand_Vax_Comparison (N);
+          return;
+       end if;
     end Expand_N_Op_Gt;
  
     --------------------
*************** package body Exp_Ch4 is
*** 4805,4815 ****
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Vax_Float (Typ1) then
!          Expand_Vax_Comparison (N);
!          return;
! 
!       elsif Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
--- 4967,4973 ----
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
*************** package body Exp_Ch4 is
*** 4822,4827 ****
--- 4980,4992 ----
        end if;
  
        Rewrite_Comparison (N);
+ 
+       --  If we still have comparison, and Vax_Float type, process it
+ 
+       if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+          Expand_Vax_Comparison (N);
+          return;
+       end if;
     end Expand_N_Op_Le;
  
     --------------------
*************** package body Exp_Ch4 is
*** 4837,4847 ****
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Vax_Float (Typ1) then
!          Expand_Vax_Comparison (N);
!          return;
! 
!       elsif Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
--- 5002,5008 ----
     begin
        Binary_Op_Validity_Checks (N);
  
!       if Is_Array_Type (Typ1) then
           Expand_Array_Comparison (N);
           return;
        end if;
*************** package body Exp_Ch4 is
*** 4854,4859 ****
--- 5015,5027 ----
        end if;
  
        Rewrite_Comparison (N);
+ 
+       --  If we still have comparison, and Vax_Float type, process it
+ 
+       if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+          Expand_Vax_Comparison (N);
+          return;
+       end if;
     end Expand_N_Op_Lt;
  
     -----------------------
*************** package body Exp_Ch4 is
*** 5058,5070 ****
           end if;
        end if;
  
-       --  Deal with VAX float case
- 
-       if Vax_Float (Typ) then
-          Expand_Vax_Arith (N);
-          return;
-       end if;
- 
        --  Convert x * 2 ** y to Shift_Left (x, y). Note that the fact that
        --  Is_Power_Of_2_For_Shift is set means that we know that our left
        --  operand is an integer, as required for this to work.
--- 5226,5231 ----
*************** package body Exp_Ch4 is
*** 5175,5180 ****
--- 5336,5347 ----
  
        elsif Is_Signed_Integer_Type (Etype (N)) then
           Apply_Arithmetic_Overflow_Check (N);
+ 
+       --  Deal with VAX float case
+ 
+       elsif Vax_Float (Typ) then
+          Expand_Vax_Arith (N);
+          return;
        end if;
     end Expand_N_Op_Multiply;
  
*************** package body Exp_Ch4 is
*** 5182,5220 ****
     -- Expand_N_Op_Ne --
     --------------------
  
-    --  Rewrite node as the negation of an equality operation, and reanalyze.
-    --  The equality to be used is defined in the same scope and has the same
-    --  signature. It must be set explicitly because in an instance it may not
-    --  have the same visibility as in the generic unit.
- 
     procedure Expand_N_Op_Ne (N : Node_Id) is
!       Loc : constant Source_Ptr := Sloc (N);
!       Neg : Node_Id;
!       Ne  : constant Entity_Id := Entity (N);
  
     begin
!       Binary_Op_Validity_Checks (N);
  
!       Neg :=
!         Make_Op_Not (Loc,
!           Right_Opnd =>
!             Make_Op_Eq (Loc,
!               Left_Opnd =>  Left_Opnd (N),
!               Right_Opnd => Right_Opnd (N)));
!       Set_Paren_Count (Right_Opnd (Neg), 1);
  
!       if Scope (Ne) /= Standard_Standard then
!          Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
!       end if;
  
!       --  For navigation purposes, the inequality is treated as an implicit
!       --  reference to the corresponding equality. Preserve the Comes_From_
!       --  source flag so that the proper Xref entry is generated.
  
!       Preserve_Comes_From_Source (Neg, N);
!       Preserve_Comes_From_Source (Right_Opnd (Neg), N);
!       Rewrite (N, Neg);
!       Analyze_And_Resolve (N, Standard_Boolean);
     end Expand_N_Op_Ne;
  
     ---------------------
--- 5349,5422 ----
     -- Expand_N_Op_Ne --
     --------------------
  
     procedure Expand_N_Op_Ne (N : Node_Id) is
!       Typ : constant Entity_Id := Etype (Left_Opnd (N));
  
     begin
!       --  Case of elementary type with standard operator
  
!       if Is_Elementary_Type (Typ)
!         and then Sloc (Entity (N)) = Standard_Location
!       then
!          Binary_Op_Validity_Checks (N);
  
!          --  Boolean types (requiring handling of non-standard case)
  
!          if Is_Boolean_Type (Typ) then
!             Adjust_Condition (Left_Opnd (N));
!             Adjust_Condition (Right_Opnd (N));
!             Set_Etype (N, Standard_Boolean);
!             Adjust_Result_Type (N, Typ);
!          end if;
  
!          Rewrite_Comparison (N);
! 
!          --  If we still have comparison for Vax_Float, process it
! 
!          if Vax_Float (Typ) and then Nkind (N) in N_Op_Compare  then
!             Expand_Vax_Comparison (N);
!             return;
!          end if;
! 
!       --  For all cases other than elementary types, we rewrite node as the
!       --  negation of an equality operation, and reanalyze. The equality to be
!       --  used is defined in the same scope and has the same signature. This
!       --  signature must be set explicitly since in an instance it may not have
!       --  the same visibility as in the generic unit. This avoids duplicating
!       --  or factoring the complex code for record/array equality tests etc.
! 
!       else
!          declare
!             Loc : constant Source_Ptr := Sloc (N);
!             Neg : Node_Id;
!             Ne  : constant Entity_Id := Entity (N);
! 
!          begin
!             Binary_Op_Validity_Checks (N);
! 
!             Neg :=
!               Make_Op_Not (Loc,
!                 Right_Opnd =>
!                   Make_Op_Eq (Loc,
!                     Left_Opnd =>  Left_Opnd (N),
!                     Right_Opnd => Right_Opnd (N)));
!             Set_Paren_Count (Right_Opnd (Neg), 1);
! 
!             if Scope (Ne) /= Standard_Standard then
!                Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
!             end if;
! 
!             --  For navigation purposes, the inequality is treated as an
!             --  implicit reference to the corresponding equality. Preserve the
!             --  Comes_From_ source flag so that the proper Xref entry is
!             --  generated.
! 
!             Preserve_Comes_From_Source (Neg, N);
!             Preserve_Comes_From_Source (Right_Opnd (Neg), N);
!             Rewrite (N, Neg);
!             Analyze_And_Resolve (N, Standard_Boolean);
!          end;
!       end if;
     end Expand_N_Op_Ne;
  
     ---------------------
*************** package body Exp_Ch4 is
*** 5278,5286 ****
           return;
        end if;
  
!       --  Case of array operand. If bit packed, handle it in Exp_Pakd
  
!       if Is_Bit_Packed_Array (Typ) and then Component_Size (Typ) = 1 then
           Expand_Packed_Not (N);
           return;
        end if;
--- 5480,5492 ----
           return;
        end if;
  
!       --  Case of array operand. If bit packed with a component size of 1,
!       --  handle it in Exp_Pakd if the operand is known to be aligned.
  
!       if Is_Bit_Packed_Array (Typ)
!         and then Component_Size (Typ) = 1
!         and then not Is_Possibly_Unaligned_Object (Right_Opnd (N))
!       then
           Expand_Packed_Not (N);
           return;
        end if;
*************** package body Exp_Ch4 is
*** 5385,5391 ****
                  Make_Parameter_Specification (Loc,
                    Defining_Identifier => A,
                    Parameter_Type      => New_Reference_To (Typ, Loc))),
!               Subtype_Mark => New_Reference_To (Typ, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
--- 5591,5597 ----
                  Make_Parameter_Specification (Loc,
                    Defining_Identifier => A,
                    Parameter_Type      => New_Reference_To (Typ, Loc))),
!               Result_Definition => New_Reference_To (Typ, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
*************** package body Exp_Ch4 is
*** 6347,6354 ****
           --  then we do not trust it to be in range (might be infinite)
  
           declare
!             S_Lo : constant Node_Id   := Type_Low_Bound (Xtyp);
!             S_Hi : constant Node_Id   := Type_High_Bound (Xtyp);
  
           begin
              if (not Is_Floating_Point_Type (Xtyp)
--- 6553,6560 ----
           --  then we do not trust it to be in range (might be infinite)
  
           declare
!             S_Lo : constant Node_Id := Type_Low_Bound (Xtyp);
!             S_Hi : constant Node_Id := Type_High_Bound (Xtyp);
  
           begin
              if (not Is_Floating_Point_Type (Xtyp)
*************** package body Exp_Ch4 is
*** 6400,6408 ****
             (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
           Set_Etype (Conv, Btyp);
  
!          --  Enable overflow except in the case of integer to float
!          --  conversions, where it is never required, since we can
!          --  never have overflow in this case.
  
           if not Is_Integer_Type (Etype (Operand)) then
              Enable_Overflow_Check (Conv);
--- 6606,6614 ----
             (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
           Set_Etype (Conv, Btyp);
  
!          --  Enable overflow except for case of integer to float conversions,
!          --  where it is never required, since we can never have overflow in
!          --  this case.
  
           if not Is_Integer_Type (Etype (Operand)) then
              Enable_Overflow_Check (Conv);
*************** package body Exp_Ch4 is
*** 6455,6467 ****
           return;
        end if;
  
-       --  Deal with Vax floating-point cases
- 
-       if Vax_Float (Operand_Type) or else Vax_Float (Target_Type) then
-          Expand_Vax_Conversion (N);
-          return;
-       end if;
- 
        --  Nothing to do if this is the second argument of read. This
        --  is a "backwards" conversion that will be handled by the
        --  specialized code in attribute processing.
--- 6661,6666 ----
*************** package body Exp_Ch4 is
*** 6748,6754 ****
           --  this type with proper overflow checking, and so gigi is doing an
           --  approximation of what is required by doing floating-point compares
           --  with the end-point. But that can lose precision in some cases, and
!          --  give a wrong result. Converting the operand to Long_Long_Float is
           --  helpful, but still does not catch all cases with 64-bit integers
           --  on targets with only 64-bit floats ???
  
--- 6947,6953 ----
           --  this type with proper overflow checking, and so gigi is doing an
           --  approximation of what is required by doing floating-point compares
           --  with the end-point. But that can lose precision in some cases, and
!          --  give a wrong result. Converting the operand to Universal_Real is
           --  helpful, but still does not catch all cases with 64-bit integers
           --  on targets with only 64-bit floats ???
  
*************** package body Exp_Ch4 is
*** 6756,6766 ****
              Rewrite (Operand,
                Make_Type_Conversion (Loc,
                  Subtype_Mark =>
!                   New_Occurrence_Of (Standard_Long_Long_Float, Loc),
                  Expression =>
                    Relocate_Node (Operand)));
  
!             Set_Etype (Operand, Standard_Long_Long_Float);
              Enable_Range_Check (Operand);
              Set_Do_Range_Check (Expression (Operand), False);
           end if;
--- 6955,6965 ----
              Rewrite (Operand,
                Make_Type_Conversion (Loc,
                  Subtype_Mark =>
!                   New_Occurrence_Of (Universal_Real, Loc),
                  Expression =>
                    Relocate_Node (Operand)));
  
!             Set_Etype (Operand, Universal_Real);
              Enable_Range_Check (Operand);
              Set_Do_Range_Check (Expression (Operand), False);
           end if;
*************** package body Exp_Ch4 is
*** 6853,6863 ****
  
        elsif Is_Floating_Point_Type (Target_Type) then
           Real_Range_Check;
- 
-       --  The remaining cases require no front end processing
- 
-       else
-          null;
        end if;
  
        --  At this stage, either the conversion node has been transformed
--- 7052,7057 ----
*************** package body Exp_Ch4 is
*** 6932,6937 ****
--- 7126,7141 ----
              end if;
           end;
        end if;
+ 
+       --  Final step, if the result is a type conversion involving Vax_Float
+       --  types, then it is subject for further special processing.
+ 
+       if Nkind (N) = N_Type_Conversion
+         and then (Vax_Float (Operand_Type) or else Vax_Float (Target_Type))
+       then
+          Expand_Vax_Conversion (N);
+          return;
+       end if;
     end Expand_N_Type_Conversion;
  
     -----------------------------------
*************** package body Exp_Ch4 is
*** 7654,7660 ****
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Subtype_Mark => New_Reference_To (Standard_Boolean, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
--- 7858,7864 ----
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Result_Definition => New_Reference_To (Standard_Boolean, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
*************** package body Exp_Ch4 is
*** 7670,7676 ****
                Statements => New_List (If_Stat)));
  
        return Func_Body;
- 
     end Make_Array_Comparison_Op;
  
     ---------------------------
--- 7874,7879 ----
*************** package body Exp_Ch4 is
*** 7785,7791 ****
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Subtype_Mark             => New_Reference_To (Typ, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
--- 7988,7994 ----
              Make_Function_Specification (Loc,
                Defining_Unit_Name       => Func_Name,
                Parameter_Specifications => Formals,
!               Result_Definition        => New_Reference_To (Typ, Loc)),
  
            Declarations => New_List (
              Make_Object_Declaration (Loc,
*************** package body Exp_Ch4 is
*** 7827,7832 ****
--- 8030,8047 ----
              True_Result  := Res in Compare_GE;
              False_Result := Res = LT;
  
+             if Res = LE
+               and then Constant_Condition_Warnings
+               and then Comes_From_Source (Original_Node (N))
+               and then Nkind (Original_Node (N)) = N_Op_Ge
+               and then not In_Instance
+               and then not Warnings_Off (Etype (Left_Opnd (N)))
+               and then Is_Integer_Type (Etype (Left_Opnd (N)))
+             then
+                Error_Msg_N
+                  ("can never be greater than, could replace by ""'=""?", N);
+             end if;
+ 
           when N_Op_Gt =>
              True_Result  := Res = GT;
              False_Result := Res in Compare_LE;
*************** package body Exp_Ch4 is
*** 7839,7847 ****
              True_Result  := Res in Compare_LE;
              False_Result := Res = GT;
  
           when N_Op_Ne =>
!             True_Result  := Res = NE;
!             False_Result := Res = LT or else Res = GT or else Res = EQ;
        end case;
  
        if True_Result then
--- 8054,8074 ----
              True_Result  := Res in Compare_LE;
              False_Result := Res = GT;
  
+             if Res = GE
+               and then Constant_Condition_Warnings
+               and then Comes_From_Source (Original_Node (N))
+               and then Nkind (Original_Node (N)) = N_Op_Le
+               and then not In_Instance
+               and then not Warnings_Off (Etype (Left_Opnd (N)))
+               and then Is_Integer_Type (Etype (Left_Opnd (N)))
+             then
+                Error_Msg_N
+                  ("can never be less than, could replace by ""'=""?", N);
+             end if;
+ 
           when N_Op_Ne =>
!             True_Result  := Res = NE or else Res = GT or else Res = LT;
!             False_Result := Res = EQ;
        end case;
  
        if True_Result then
*************** package body Exp_Ch4 is
*** 7984,8007 ****
        Obj_Tag :=
          Make_Selected_Component (Loc,
            Prefix        => Relocate_Node (Left),
!           Selector_Name => New_Reference_To (Tag_Component (Left_Type), Loc));
  
        if Is_Class_Wide_Type (Right_Type) then
!          return
!            Make_DT_Access_Action (Left_Type,
!              Action => CW_Membership,
!              Args   => New_List (
!                Obj_Tag,
!                New_Reference_To (
!                  Access_Disp_Table (Root_Type (Right_Type)), Loc)));
        else
           return
             Make_Op_Eq (Loc,
!            Left_Opnd  => Obj_Tag,
!            Right_Opnd =>
!              New_Reference_To (Access_Disp_Table (Right_Type), Loc));
        end if;
- 
     end Tagged_Membership;
  
     ------------------------------
--- 8211,8263 ----
        Obj_Tag :=
          Make_Selected_Component (Loc,
            Prefix        => Relocate_Node (Left),
!           Selector_Name =>
!             New_Reference_To (First_Tag_Component (Left_Type), Loc));
  
        if Is_Class_Wide_Type (Right_Type) then
! 
!          --  Ada 2005 (AI-251): Class-wide applied to interfaces
! 
!          if Is_Interface (Etype (Class_Wide_Type (Right_Type)))
! 
!             --   Give support to: "Iface_CW_Typ in Typ'Class"
! 
!            or else Is_Interface (Left_Type)
!          then
!             return
!               Make_Function_Call (Loc,
!                  Name => New_Occurrence_Of (RTE (RE_IW_Membership), Loc),
!                  Parameter_Associations => New_List (
!                    Make_Attribute_Reference (Loc,
!                      Prefix => Obj_Tag,
!                      Attribute_Name => Name_Address),
!                    New_Reference_To (
!                      Node (First_Elmt
!                             (Access_Disp_Table (Root_Type (Right_Type)))),
!                      Loc)));
! 
!          --  Ada 95: Normal case
! 
!          else
!             return
!               Make_Function_Call (Loc,
!                  Name => New_Occurrence_Of (RTE (RE_CW_Membership), Loc),
!                  Parameter_Associations => New_List (
!                    Obj_Tag,
!                    New_Reference_To (
!                      Node (First_Elmt
!                             (Access_Disp_Table (Root_Type (Right_Type)))),
!                      Loc)));
!          end if;
! 
        else
           return
             Make_Op_Eq (Loc,
!              Left_Opnd  => Obj_Tag,
!              Right_Opnd =>
!                New_Reference_To
!                  (Node (First_Elmt (Access_Disp_Table (Right_Type))), Loc));
        end if;
     end Tagged_Membership;
  
     ------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch4.ads gcc-4.1.0/gcc/ada/exp_ch4.ads
*** gcc-4.0.2/gcc/ada/exp_ch4.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch4.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch5.adb gcc-4.1.0/gcc/ada/exp_ch5.adb
*** gcc-4.0.2/gcc/ada/exp_ch5.adb	Wed Dec  8 11:49:37 2004
--- gcc-4.1.0/gcc/ada/exp_ch5.adb	Tue Nov 15 13:57:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,32 ****
--- 27,33 ----
  with Atree;    use Atree;
  with Checks;   use Checks;
  with Einfo;    use Einfo;
+ with Elists;   use Elists;
  with Exp_Aggr; use Exp_Aggr;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch11; use Exp_Ch11;
*************** with Rtsfind;  use Rtsfind;
*** 44,49 ****
--- 45,51 ----
  with Sinfo;    use Sinfo;
  with Sem;      use Sem;
  with Sem_Ch3;  use Sem_Ch3;
+ with Sem_Ch5;  use Sem_Ch5;
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Ch13; use Sem_Ch13;
  with Sem_Eval; use Sem_Eval;
*************** package body Exp_Ch5 is
*** 454,466 ****
              end if;
           end Check_Unconstrained_Bit_Packed_Array;
  
!       --  Gigi can always handle the assignment if the right side is a string
!       --  literal (note that overlap is definitely impossible in this case).
!       --  If the type is packed, a string literal is always converted into a
!       --  aggregate, except in the case of a null slice, for which no aggregate
!       --  can be written. In that case, rewrite the assignment as a null
!       --  statement, a length check has already been emitted to verify that
!       --  the range of the left-hand side is empty.
  
        --  Note that this code is not executed if we had an assignment of
        --  a string literal to a non-bit aligned component of a record, a
--- 456,468 ----
              end if;
           end Check_Unconstrained_Bit_Packed_Array;
  
!       --  The back end can always handle the assignment if the right side is a
!       --  string literal (note that overlap is definitely impossible in this
!       --  case). If the type is packed, a string literal is always converted
!       --  into aggregate, except in the case of a null slice, for which no
!       --  aggregate can be written. In that case, rewrite the assignment as a
!       --  null statement, a length check has already been emitted to verify
!       --  that the range of the left-hand side is empty.
  
        --  Note that this code is not executed if we had an assignment of
        --  a string literal to a non-bit aligned component of a record, a
*************** package body Exp_Ch5 is
*** 479,485 ****
        --  If either operand is bit packed, then we need a loop, since we
        --  can't be sure that the slice is byte aligned. Similarly, if either
        --  operand is a possibly unaligned slice, then we need a loop (since
!       --  gigi cannot handle unaligned slices).
  
        elsif Is_Bit_Packed_Array (L_Type)
          or else Is_Bit_Packed_Array (R_Type)
--- 481,487 ----
        --  If either operand is bit packed, then we need a loop, since we
        --  can't be sure that the slice is byte aligned. Similarly, if either
        --  operand is a possibly unaligned slice, then we need a loop (since
!       --  the back end cannot handle unaligned slices).
  
        elsif Is_Bit_Packed_Array (L_Type)
          or else Is_Bit_Packed_Array (R_Type)
*************** package body Exp_Ch5 is
*** 490,496 ****
  
        --  If we are not bit-packed, and we have only one slice, then no
        --  overlap is possible except in the parameter case, so we can let
!       --  gigi handle things.
  
        elsif not (L_Slice and R_Slice) then
           if Forwards_OK (N) then
--- 492,498 ----
  
        --  If we are not bit-packed, and we have only one slice, then no
        --  overlap is possible except in the parameter case, so we can let
!       --  the back end handle things.
  
        elsif not (L_Slice and R_Slice) then
           if Forwards_OK (N) then
*************** package body Exp_Ch5 is
*** 641,647 ****
           if not Loop_Required then
              if Forwards_OK (N) then
                 return;
- 
              else
                 null;
                 --  Here is where a memmove would be appropriate ???
--- 643,648 ----
*************** package body Exp_Ch5 is
*** 843,849 ****
              then
  
                 --  Call TSS procedure for array assignment, passing the
!                --  the explicit bounds of right- and left-hand side.
  
                 declare
                    Proc    : constant Node_Id :=
--- 844,850 ----
              then
  
                 --  Call TSS procedure for array assignment, passing the
!                --  the explicit bounds of right and left hand sides.
  
                 declare
                    Proc    : constant Node_Id :=
*************** package body Exp_Ch5 is
*** 999,1011 ****
             Make_Assignment_Statement (Loc,
               Name =>
                 Make_Indexed_Component (Loc,
!                  Prefix => Duplicate_Subexpr (Larray, Name_Req => True),
                   Expressions => ExprL),
               Expression =>
                 Make_Indexed_Component (Loc,
!                  Prefix => Duplicate_Subexpr (Rarray, Name_Req => True),
                   Expressions => ExprR));
  
           --  Propagate the No_Ctrl_Actions flag to individual assignments
  
           Set_No_Ctrl_Actions (Assign, No_Ctrl_Actions (N));
--- 1000,1019 ----
             Make_Assignment_Statement (Loc,
               Name =>
                 Make_Indexed_Component (Loc,
!                  Prefix      => Duplicate_Subexpr (Larray, Name_Req => True),
                   Expressions => ExprL),
               Expression =>
                 Make_Indexed_Component (Loc,
!                  Prefix      => Duplicate_Subexpr (Rarray, Name_Req => True),
                   Expressions => ExprR));
  
+          --  We set assignment OK, since there are some cases, e.g. in object
+          --  declarations, where we are actually assigning into a constant.
+          --  If there really is an illegality, it was caught long before now,
+          --  and was flagged when the original assignment was analyzed.
+ 
+          Set_Assignment_OK (Name (Assign));
+ 
           --  Propagate the No_Ctrl_Actions flag to individual assignments
  
           Set_No_Ctrl_Actions (Assign, No_Ctrl_Actions (N));
*************** package body Exp_Ch5 is
*** 1356,1364 ****
     -- Expand_N_Assignment_Statement --
     -----------------------------------
  
!    --  For array types, deal with slice assignments and setting the flags
!    --  to indicate if it can be statically determined which direction the
!    --  move should go in. Also deal with generating range/length checks.
  
     procedure Expand_N_Assignment_Statement (N : Node_Id) is
        Loc  : constant Source_Ptr := Sloc (N);
--- 1364,1371 ----
     -- Expand_N_Assignment_Statement --
     -----------------------------------
  
!    --  This procedure implements various cases where an assignment statement
!    --  cannot just be passed on to the back end in untransformed state.
  
     procedure Expand_N_Assignment_Statement (N : Node_Id) is
        Loc  : constant Source_Ptr := Sloc (N);
*************** package body Exp_Ch5 is
*** 1469,1475 ****
  
              declare
                 Uses_Transient_Scope : constant Boolean :=
!                   Scope_Is_Transient and then N = Node_To_Be_Wrapped;
  
              begin
                 if Uses_Transient_Scope then
--- 1476,1483 ----
  
              declare
                 Uses_Transient_Scope : constant Boolean :=
!                                         Scope_Is_Transient
!                                           and then N = Node_To_Be_Wrapped;
  
              begin
                 if Uses_Transient_Scope then
*************** package body Exp_Ch5 is
*** 1535,1541 ****
        --  create dereferences but are not semantic aliasings.
  
        elsif Is_Private_Type (Etype (Lhs))
!         and then  Has_Discriminants (Typ)
          and then Nkind (Lhs) = N_Explicit_Dereference
          and then Comes_From_Source (Lhs)
        then
--- 1543,1549 ----
        --  create dereferences but are not semantic aliasings.
  
        elsif Is_Private_Type (Etype (Lhs))
!         and then Has_Discriminants (Typ)
          and then Nkind (Lhs) = N_Explicit_Dereference
          and then Comes_From_Source (Lhs)
        then
*************** package body Exp_Ch5 is
*** 1614,1630 ****
             (Expression (Rhs), Designated_Type (Etype (Lhs)));
        end if;
  
!       --  Ada 2005 (AI-231): Generate conversion to the null-excluding
!       --  type to force the corresponding run-time check
  
        if Is_Access_Type (Typ)
!         and then
!           ((Is_Entity_Name (Lhs) and then Can_Never_Be_Null (Entity (Lhs)))
!              or else Can_Never_Be_Null (Etype (Lhs)))
        then
!          Rewrite (Rhs, Convert_To (Etype (Lhs),
!                                    Relocate_Node (Rhs)));
!          Analyze_And_Resolve (Rhs, Etype (Lhs));
        end if;
  
        --  If we are assigning an access type and the left side is an
--- 1622,1634 ----
             (Expression (Rhs), Designated_Type (Etype (Lhs)));
        end if;
  
!       --  Ada 2005 (AI-231): Generate the run-time check
  
        if Is_Access_Type (Typ)
!         and then Can_Never_Be_Null (Etype (Lhs))
!         and then not Can_Never_Be_Null (Etype (Rhs))
        then
!          Apply_Constraint_Check (Rhs, Etype (Lhs));
        end if;
  
        --  If we are assigning an access type and the left side is an
*************** package body Exp_Ch5 is
*** 1647,1654 ****
           Expand_Bit_Packed_Element_Set (N);
           return;
  
-       --  Case of tagged type assignment
- 
        elsif Is_Tagged_Type (Typ)
          or else (Controlled_Type (Typ) and then not Is_Array_Type (Typ))
        then
--- 1651,1656 ----
*************** package body Exp_Ch5 is
*** 1673,1691 ****
  
              if Is_Class_Wide_Type (Typ)
  
!             --  If the type is tagged, we may as well use the predefined
!             --  primitive assignment. This avoids inlining a lot of code
!             --  and in the class-wide case, the assignment is replaced by
!             --  a dispatch call to _assign. Note that this cannot be done
!             --  when discriminant checks are locally suppressed (as in
!             --  extension aggregate expansions) because otherwise the
!             --  discriminant check will be performed within the _assign
!             --  call.
  
!             or else (Is_Tagged_Type (Typ)
!               and then Chars (Current_Scope) /= Name_uAssign
!               and then Expand_Ctrl_Actions
!               and then not Discriminant_Checks_Suppressed (Empty))
              then
                 --  Fetch the primitive op _assign and proper type to call
                 --  it. Because of possible conflits between private and
--- 1675,1697 ----
  
              if Is_Class_Wide_Type (Typ)
  
!                --  If the type is tagged, we may as well use the predefined
!                --  primitive assignment. This avoids inlining a lot of code
!                --  and in the class-wide case, the assignment is replaced by
!                --  dispatch call to _assign. Note that this cannot be done
!                --  when discriminant checks are locally suppressed (as in
!                --  extension aggregate expansions) because otherwise the
!                --  discriminant check will be performed within the _assign
!                --  call. It is also suppressed for assignmments created by the
!                --  expander that correspond to initializations, where we do
!                --  want to copy the tag (No_Ctrl_Actions flag set True).
!                --  by the expander and we do not need to mess with tags ever
!                --  (Expand_Ctrl_Actions flag is set True in this case).
  
!                or else (Is_Tagged_Type (Typ)
!                           and then Chars (Current_Scope) /= Name_uAssign
!                           and then Expand_Ctrl_Actions
!                           and then not Discriminant_Checks_Suppressed (Empty))
              then
                 --  Fetch the primitive op _assign and proper type to call
                 --  it. Because of possible conflits between private and
*************** package body Exp_Ch5 is
*** 1787,1794 ****
              then
                 declare
                    Blk : constant Entity_Id :=
!                     New_Internal_Entity (
!                       E_Block, Current_Scope, Sloc (N), 'B');
  
                 begin
                    Set_Scope (Blk, Current_Scope);
--- 1793,1800 ----
              then
                 declare
                    Blk : constant Entity_Id :=
!                           New_Internal_Entity
!                             (E_Block, Current_Scope, Sloc (N), 'B');
  
                 begin
                    Set_Scope (Blk, Current_Scope);
*************** package body Exp_Ch5 is
*** 1803,1809 ****
                 end;
              end if;
  
!             Analyze (N);
              return;
           end Tagged_Case;
  
--- 1809,1819 ----
                 end;
              end if;
  
!             --  N has been rewritten to a block statement for which it is
!             --  known by construction that no checks are necessary: analyze
!             --  it with all checks suppressed.
! 
!             Analyze (N, Suppress => All_Checks);
              return;
           end Tagged_Case;
  
*************** package body Exp_Ch5 is
*** 2254,2259 ****
--- 2264,2276 ----
                 Set_Condition       (N, Condition (Hed));
                 Set_Then_Statements (N, Then_Statements (Hed));
  
+                --  Hed might have been captured as the condition determining
+                --  the current value for an entity. Now it is detached from
+                --  the tree, so a Current_Value pointer in the condition might
+                --  need to be updated.
+ 
+                Check_Possible_Current_Value_Condition (N);
+ 
                 if Is_Empty_List (Elsif_Parts (N)) then
                    Set_Elsif_Parts (N, No_List);
                 end if;
*************** package body Exp_Ch5 is
*** 2757,2836 ****
           Analyze (Exp);
        end if;
  
-       --  Implement the rules of 6.5(8-10), which require a tag check in
-       --  the case of a limited tagged return type, and tag reassignment
-       --  for nonlimited tagged results. These actions are needed when
-       --  the return type is a specific tagged type and the result
-       --  expression is a conversion or a formal parameter, because in
-       --  that case the tag of the expression might differ from the tag
-       --  of the specific result type.
- 
-       if Is_Tagged_Type (Utyp)
-         and then not Is_Class_Wide_Type (Utyp)
-         and then (Nkind (Exp) = N_Type_Conversion
-                     or else Nkind (Exp) = N_Unchecked_Type_Conversion
-                     or else (Is_Entity_Name (Exp)
-                                and then Ekind (Entity (Exp)) in Formal_Kind))
-       then
-          --  When the return type is limited, perform a check that the
-          --  tag of the result is the same as the tag of the return type.
- 
-          if Is_Limited_Type (Return_Type) then
-             Insert_Action (Exp,
-               Make_Raise_Constraint_Error (Loc,
-                 Condition =>
-                   Make_Op_Ne (Loc,
-                     Left_Opnd =>
-                       Make_Selected_Component (Loc,
-                         Prefix => Duplicate_Subexpr (Exp),
-                         Selector_Name =>
-                           New_Reference_To (Tag_Component (Utyp), Loc)),
-                     Right_Opnd =>
-                       Unchecked_Convert_To (RTE (RE_Tag),
-                         New_Reference_To
-                           (Access_Disp_Table (Base_Type (Utyp)), Loc))),
-                 Reason => CE_Tag_Check_Failed));
- 
-          --  If the result type is a specific nonlimited tagged type,
-          --  then we have to ensure that the tag of the result is that
-          --  of the result type. This is handled by making a copy of the
-          --  expression in the case where it might have a different tag,
-          --  namely when the expression is a conversion or a formal
-          --  parameter. We create a new object of the result type and
-          --  initialize it from the expression, which will implicitly
-          --  force the tag to be set appropriately.
- 
-          else
-             Result_Id :=
-               Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-             Result_Exp := New_Reference_To (Result_Id, Loc);
- 
-             Result_Obj :=
-               Make_Object_Declaration (Loc,
-                 Defining_Identifier => Result_Id,
-                 Object_Definition   => New_Reference_To (Return_Type, Loc),
-                 Constant_Present    => True,
-                 Expression          => Relocate_Node (Exp));
- 
-             Set_Assignment_OK (Result_Obj);
-             Insert_Action (Exp, Result_Obj);
- 
-             Rewrite (Exp, Result_Exp);
-             Analyze_And_Resolve (Exp, Return_Type);
-          end if;
-       end if;
- 
        --  Deal with returning variable length objects and controlled types
  
        --  Nothing to do if we are returning by reference, or this is not
        --  a type that requires special processing (indicated by the fact
        --  that it requires a cleanup scope for the secondary stack case)
  
!       if Is_Return_By_Reference_Type (T)
!         or else not Requires_Transient_Scope (Return_Type)
!       then
           null;
  
        --  Case of secondary stack not used
  
        elsif Function_Returns_With_DSP (Scope_Id) then
--- 2774,2811 ----
           Analyze (Exp);
        end if;
  
        --  Deal with returning variable length objects and controlled types
  
        --  Nothing to do if we are returning by reference, or this is not
        --  a type that requires special processing (indicated by the fact
        --  that it requires a cleanup scope for the secondary stack case)
  
!       if Is_Return_By_Reference_Type (T) then
           null;
  
+       elsif not Requires_Transient_Scope (Return_Type) then
+ 
+          --  mutable records with no variable length components are not
+          --  returned on the sec-stack so we need to make sure that the
+          --  backend will only copy back the size of the actual value  and not
+          --  the maximum size. We create an actual subtype for this purpose
+ 
+          declare
+             Ubt  : constant Entity_Id := Underlying_Type (Base_Type (T));
+             Decl : Node_Id;
+             Ent  : Entity_Id;
+          begin
+             if Has_Discriminants (Ubt)
+               and then not Is_Constrained (Ubt)
+               and then not Has_Unchecked_Union (Ubt)
+             then
+                Decl := Build_Actual_Subtype (Ubt, Exp);
+                Ent := Defining_Identifier (Decl);
+                Insert_Action (Exp, Decl);
+                Rewrite (Exp, Unchecked_Convert_To (Ent, Exp));
+             end if;
+          end;
+ 
        --  Case of secondary stack not used
  
        elsif Function_Returns_With_DSP (Scope_Id) then
*************** package body Exp_Ch5 is
*** 3015,3020 ****
--- 2990,3001 ----
           then
              Set_By_Ref (N);
  
+             --  Remove side effects from the expression now so that
+             --  other part of the expander do not have to reanalyze
+             --  this node without this optimization
+ 
+             Rewrite (Exp, Duplicate_Subexpr_No_Checks (Exp));
+ 
           --  For controlled types, do the allocation on the sec-stack
           --  manually in order to call adjust at the right time
           --    type Anon1 is access Return_Type;
*************** package body Exp_Ch5 is
*** 3080,3085 ****
--- 3061,3172 ----
           end if;
        end if;
  
+       --  Implement the rules of 6.5(8-10), which require a tag check in
+       --  the case of a limited tagged return type, and tag reassignment
+       --  for nonlimited tagged results. These actions are needed when
+       --  the return type is a specific tagged type and the result
+       --  expression is a conversion or a formal parameter, because in
+       --  that case the tag of the expression might differ from the tag
+       --  of the specific result type.
+ 
+       if Is_Tagged_Type (Utyp)
+         and then not Is_Class_Wide_Type (Utyp)
+         and then (Nkind (Exp) = N_Type_Conversion
+                     or else Nkind (Exp) = N_Unchecked_Type_Conversion
+                     or else (Is_Entity_Name (Exp)
+                                and then Ekind (Entity (Exp)) in Formal_Kind))
+       then
+          --  When the return type is limited, perform a check that the
+          --  tag of the result is the same as the tag of the return type.
+ 
+          if Is_Limited_Type (Return_Type) then
+             Insert_Action (Exp,
+               Make_Raise_Constraint_Error (Loc,
+                 Condition =>
+                   Make_Op_Ne (Loc,
+                     Left_Opnd =>
+                       Make_Selected_Component (Loc,
+                         Prefix => Duplicate_Subexpr (Exp),
+                         Selector_Name =>
+                           New_Reference_To (First_Tag_Component (Utyp), Loc)),
+                     Right_Opnd =>
+                       Unchecked_Convert_To (RTE (RE_Tag),
+                         New_Reference_To
+                           (Node (First_Elmt
+                                   (Access_Disp_Table (Base_Type (Utyp)))),
+                            Loc))),
+                 Reason => CE_Tag_Check_Failed));
+ 
+          --  If the result type is a specific nonlimited tagged type,
+          --  then we have to ensure that the tag of the result is that
+          --  of the result type. This is handled by making a copy of the
+          --  expression in the case where it might have a different tag,
+          --  namely when the expression is a conversion or a formal
+          --  parameter. We create a new object of the result type and
+          --  initialize it from the expression, which will implicitly
+          --  force the tag to be set appropriately.
+ 
+          else
+             Result_Id :=
+               Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+             Result_Exp := New_Reference_To (Result_Id, Loc);
+ 
+             Result_Obj :=
+               Make_Object_Declaration (Loc,
+                 Defining_Identifier => Result_Id,
+                 Object_Definition   => New_Reference_To (Return_Type, Loc),
+                 Constant_Present    => True,
+                 Expression          => Relocate_Node (Exp));
+ 
+             Set_Assignment_OK (Result_Obj);
+             Insert_Action (Exp, Result_Obj);
+ 
+             Rewrite (Exp, Result_Exp);
+             Analyze_And_Resolve (Exp, Return_Type);
+          end if;
+ 
+       --  Ada 2005 (AI-344): If the result type is class-wide, then insert
+       --  a check that the level of the return expression's underlying type
+       --  is not deeper than the level of the master enclosing the function.
+       --  Always generate the check when the type of the return expression
+       --  is class-wide, when it's a type conversion, or when it's a formal
+       --  parameter. Otherwise, suppress the check in the case where the
+       --  return expression has a specific type whose level is known not to
+       --  be statically deeper than the function's result type.
+ 
+       elsif Ada_Version >= Ada_05
+         and then Is_Class_Wide_Type (Return_Type)
+         and then not Scope_Suppress (Accessibility_Check)
+         and then
+           (Is_Class_Wide_Type (Etype (Exp))
+             or else Nkind (Exp) = N_Type_Conversion
+             or else Nkind (Exp) = N_Unchecked_Type_Conversion
+             or else (Is_Entity_Name (Exp)
+                        and then Ekind (Entity (Exp)) in Formal_Kind)
+             or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) >
+                       Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))
+       then
+          Insert_Action (Exp,
+            Make_Raise_Program_Error (Loc,
+              Condition =>
+                Make_Op_Gt (Loc,
+                  Left_Opnd =>
+                    Make_Function_Call (Loc,
+                      Name =>
+                        New_Reference_To
+                          (RTE (RE_Get_Access_Level), Loc),
+                      Parameter_Associations =>
+                        New_List (Make_Attribute_Reference (Loc,
+                                    Prefix         =>
+                                       Duplicate_Subexpr (Exp),
+                                    Attribute_Name =>
+                                       Name_Tag))),
+                  Right_Opnd =>
+                    Make_Integer_Literal (Loc,
+                      Scope_Depth (Enclosing_Dynamic_Scope (Scope_Id)))),
+              Reason => PE_Accessibility_Check_Failed));
+       end if;
+ 
     exception
        when RE_Not_Available =>
           return;
*************** package body Exp_Ch5 is
*** 3127,3133 ****
        if not Ctrl_Act then
           null;
  
!       --  The left hand side is an uninitialized  temporary
  
        elsif Nkind (L) = N_Type_Conversion
          and then Is_Entity_Name (Expression (L))
--- 3214,3220 ----
        if not Ctrl_Act then
           null;
  
!       --  The left hand side is an uninitialized temporary
  
        elsif Nkind (L) = N_Type_Conversion
          and then Is_Entity_Name (Expression (L))
*************** package body Exp_Ch5 is
*** 3155,3161 ****
               Expression =>
                 Make_Selected_Component (Loc,
                   Prefix        => Duplicate_Subexpr_No_Checks (L),
!                  Selector_Name => New_Reference_To (Tag_Component (T), Loc))));
  
        --  Otherwise Tag_Tmp not used
  
--- 3242,3249 ----
               Expression =>
                 Make_Selected_Component (Loc,
                   Prefix        => Duplicate_Subexpr_No_Checks (L),
!                  Selector_Name => New_Reference_To (First_Tag_Component (T),
!                                                     Loc))));
  
        --  Otherwise Tag_Tmp not used
  
*************** package body Exp_Ch5 is
*** 3194,3200 ****
              --  Index of first byte to be copied after outermost record
              --  controller data.
  
!             Expr, Source_Size      : Node_Id;
              --  Used for computation of the size of the data to be copied
  
              Range_Type  : Entity_Id;
--- 3282,3289 ----
              --  Index of first byte to be copied after outermost record
              --  controller data.
  
!             Expr, Source_Size     : Node_Id;
!             Source_Actual_Subtype : Entity_Id;
              --  Used for computation of the size of the data to be copied
  
              Range_Type  : Entity_Id;
*************** package body Exp_Ch5 is
*** 3269,3294 ****
                 Expr := Expression (Expr);
              end if;
  
              Source_Size :=
                Make_Op_Add (Loc,
                  Left_Opnd =>
                    Make_Attribute_Reference (Loc,
                      Prefix =>
!                       Expr,
                      Attribute_Name =>
                        Name_Size),
                  Right_Opnd =>
                    Make_Integer_Literal (Loc,
                    System_Storage_Unit - 1));
- 
-             --  If Expr is a type conversion, standard Ada does not allow
-             --  'Size to be taken on it, but Gigi can handle this case,
-             --  and thus we can determine the amount of data to be copied.
-             --  The appropriate circuitry is enabled only for conversions
-             --  that do not Come_From_Source.
- 
-             Set_Comes_From_Source (Prefix (Left_Opnd (Source_Size)), False);
- 
              Source_Size :=
                Make_Op_Divide (Loc,
                  Left_Opnd => Source_Size,
--- 3358,3384 ----
                 Expr := Expression (Expr);
              end if;
  
+             Source_Actual_Subtype := Etype (Expr);
+ 
+             if Has_Discriminants (Source_Actual_Subtype)
+               and then not Is_Constrained (Source_Actual_Subtype)
+             then
+                Append_To (Res,
+                  Build_Actual_Subtype (Source_Actual_Subtype, Expr));
+                Source_Actual_Subtype := Defining_Identifier (Last (Res));
+             end if;
+ 
              Source_Size :=
                Make_Op_Add (Loc,
                  Left_Opnd =>
                    Make_Attribute_Reference (Loc,
                      Prefix =>
!                       New_Occurrence_Of (Source_Actual_Subtype, Loc),
                      Attribute_Name =>
                        Name_Size),
                  Right_Opnd =>
                    Make_Integer_Literal (Loc,
                    System_Storage_Unit - 1));
              Source_Size :=
                Make_Op_Divide (Loc,
                  Left_Opnd => Source_Size,
*************** package body Exp_Ch5 is
*** 3484,3490 ****
               Name =>
                 Make_Selected_Component (Loc,
                   Prefix        => Duplicate_Subexpr_No_Checks (L),
!                  Selector_Name => New_Reference_To (Tag_Component (T), Loc)),
               Expression => New_Reference_To (Tag_Tmp, Loc)));
        end if;
  
--- 3574,3581 ----
               Name =>
                 Make_Selected_Component (Loc,
                   Prefix        => Duplicate_Subexpr_No_Checks (L),
!                  Selector_Name => New_Reference_To (First_Tag_Component (T),
!                                                     Loc)),
               Expression => New_Reference_To (Tag_Tmp, Loc)));
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch5.ads gcc-4.1.0/gcc/ada/exp_ch5.ads
*** gcc-4.0.2/gcc/ada/exp_ch5.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch5.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch6.adb gcc-4.1.0/gcc/ada/exp_ch6.adb
*** gcc-4.0.2/gcc/ada/exp_ch6.adb	Thu Feb 10 13:50:45 2005
--- gcc-4.1.0/gcc/ada/exp_ch6.adb	Tue Nov 15 13:54:36 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Exp_Ch2;  use Exp_Ch2;
*** 34,40 ****
  with Exp_Ch3;  use Exp_Ch3;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch9;  use Exp_Ch9;
- with Exp_Ch11; use Exp_Ch11;
  with Exp_Dbug; use Exp_Dbug;
  with Exp_Disp; use Exp_Disp;
  with Exp_Dist; use Exp_Dist;
--- 34,39 ----
*************** with Sem_Ch12; use Sem_Ch12;
*** 60,65 ****
--- 59,65 ----
  with Sem_Ch13; use Sem_Ch13;
  with Sem_Disp; use Sem_Disp;
  with Sem_Dist; use Sem_Dist;
+ with Sem_Mech; use Sem_Mech;
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
*************** package body Exp_Ch6 is
*** 99,108 ****
     --  we have an infinite recursion.
  
     procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id);
!    --  For each actual of an in-out parameter which is a numeric conversion
!    --  of the form T(A), where A denotes a variable, we insert the declaration:
     --
!    --    Temp : T := T (A);
     --
     --  prior to the call. Then we replace the actual with a reference to Temp,
     --  and append the assignment:
--- 99,109 ----
     --  we have an infinite recursion.
  
     procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id);
!    --  For each actual of an in-out or out parameter which is a numeric
!    --  (view) conversion of the form T (A), where A denotes a variable,
!    --  we insert the declaration:
     --
!    --    Temp : T[ := T (A)];
     --
     --  prior to the call. Then we replace the actual with a reference to Temp,
     --  and append the assignment:
*************** package body Exp_Ch6 is
*** 123,128 ****
--- 124,132 ----
     --
     --  For all parameter modes, actuals that denote components and slices
     --  of packed arrays are expanded into suitable temporaries.
+    --
+    --  For non-scalar objects that are possibly unaligned, add call by copy
+    --  code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
  
     procedure Expand_Inlined_Call
      (N         : Node_Id;
*************** package body Exp_Ch6 is
*** 168,177 ****
          and then In_Open_Scopes (Scope (Etype (Typ)))
          and then Typ = Base_Type (Typ)
        then
!          --  Subp overrides an inherited private operation if there is
!          --  an inherited operation with a different name than Subp (see
!          --  Derive_Subprogram) whose Alias is a hidden  subprogram with
!          --  the same name as Subp.
  
           Op_Elmt := First_Elmt (Op_List);
           while Present (Op_Elmt) loop
--- 172,181 ----
          and then In_Open_Scopes (Scope (Etype (Typ)))
          and then Typ = Base_Type (Typ)
        then
!          --  Subp overrides an inherited private operation if there is an
!          --  inherited operation with a different name than Subp (see
!          --  Derive_Subprogram) whose Alias is a hidden subprogram with the
!          --  same name as Subp.
  
           Op_Elmt := First_Elmt (Op_List);
           while Present (Op_Elmt) loop
*************** package body Exp_Ch6 is
*** 207,218 ****
        --  List of recursive calls in body of procedure
  
        Shad_List : constant Elist_Id := New_Elmt_List;
!       --  List of entity id's for entities created to capture the
!       --  value of referenced globals on entry to the procedure.
  
        Scop : constant Uint := Scope_Depth (Spec);
!       --  This is used to record the scope depth of the current
!       --  procedure, so that we can identify global references.
  
        Max_Vars : constant := 4;
        --  Do not test more than four global variables
--- 211,222 ----
        --  List of recursive calls in body of procedure
  
        Shad_List : constant Elist_Id := New_Elmt_List;
!       --  List of entity id's for entities created to capture the value of
!       --  referenced globals on entry to the procedure.
  
        Scop : constant Uint := Scope_Depth (Spec);
!       --  This is used to record the scope depth of the current procedure, so
!       --  that we can identify global references.
  
        Max_Vars : constant := 4;
        --  Do not test more than four global variables
*************** package body Exp_Ch6 is
*** 355,363 ****
     --  Start of processing for Detect_Infinite_Recursion
  
     begin
!       --  Do not attempt detection in No_Implicit_Conditional mode,
!       --  since we won't be able to generate the code to handle the
!       --  recursion in any case.
  
        if Restriction_Active (No_Implicit_Conditionals) then
           return;
--- 359,367 ----
     --  Start of processing for Detect_Infinite_Recursion
  
     begin
!       --  Do not attempt detection in No_Implicit_Conditional mode, since we
!       --  won't be able to generate the code to handle the recursion in any
!       --  case.
  
        if Restriction_Active (No_Implicit_Conditionals) then
           return;
*************** package body Exp_Ch6 is
*** 368,376 ****
        if Traverse_Body (N) = Abandon then
           return;
  
!       --  We must have a call, since Has_Recursive_Call was set. If not
!       --  just ignore (this is only an error check, so if we have a funny
!       --  situation, due to bugs or errors, we do not want to bomb!)
  
        elsif Is_Empty_Elmt_List (Call_List) then
           return;
--- 372,380 ----
        if Traverse_Body (N) = Abandon then
           return;
  
!       --  We must have a call, since Has_Recursive_Call was set. If not just
!       --  ignore (this is only an error check, so if we have a funny situation,
!       --  due to bugs or errors, we do not want to bomb!)
  
        elsif Is_Empty_Elmt_List (Call_List) then
           return;
*************** package body Exp_Ch6 is
*** 378,392 ****
  
        --  Here is the case where we detect recursion at compile time
  
!       --  Push our current scope for analyzing the declarations and
!       --  code that we will insert for the checking.
  
        New_Scope (Spec);
  
!       --  This loop builds temporary variables for each of the
!       --  referenced globals, so that at the end of the loop the
!       --  list Shad_List contains these temporaries in one-to-one
!       --  correspondence with the elements in Var_List.
  
        Last := Empty;
        Elm := First_Elmt (Var_List);
--- 382,396 ----
  
        --  Here is the case where we detect recursion at compile time
  
!       --  Push our current scope for analyzing the declarations and code that
!       --  we will insert for the checking.
  
        New_Scope (Spec);
  
!       --  This loop builds temporary variables for each of the referenced
!       --  globals, so that at the end of the loop the list Shad_List contains
!       --  these temporaries in one-to-one correspondence with the elements in
!       --  Var_List.
  
        Last := Empty;
        Elm := First_Elmt (Var_List);
*************** package body Exp_Ch6 is
*** 397,406 ****
               Chars => New_Internal_Name ('S'));
           Append_Elmt (Ent, Shad_List);
  
!          --  Insert a declaration for this temporary at the start of
!          --  the declarations for the procedure. The temporaries are
!          --  declared as constant objects initialized to the current
!          --  values of the corresponding temporaries.
  
           Decl :=
             Make_Object_Declaration (Loc,
--- 401,410 ----
               Chars => New_Internal_Name ('S'));
           Append_Elmt (Ent, Shad_List);
  
!          --  Insert a declaration for this temporary at the start of the
!          --  declarations for the procedure. The temporaries are declared as
!          --  constant objects initialized to the current values of the
!          --  corresponding temporaries.
  
           Decl :=
             Make_Object_Declaration (Loc,
*************** package body Exp_Ch6 is
*** 501,511 ****
        --  also takes care of any constraint checks required for the type
        --  conversion case (on both the way in and the way out).
  
!       procedure Add_Packed_Call_By_Copy_Code;
!       --  This is used when the actual involves a reference to an element
!       --  of a packed array, where we can appropriately use a simpler
!       --  approach than the full call by copy code. We just copy the value
!       --  in and out of an appropriate temporary.
  
        procedure Check_Fortran_Logical;
        --  A value of type Logical that is passed through a formal parameter
--- 505,514 ----
        --  also takes care of any constraint checks required for the type
        --  conversion case (on both the way in and the way out).
  
!       procedure Add_Simple_Call_By_Copy_Code;
!       --  This is similar to the above, but is used in cases where we know
!       --  that all that is needed is to simply create a temporary and copy
!       --  the value in and out of the temporary.
  
        procedure Check_Fortran_Logical;
        --  A value of type Logical that is passed through a formal parameter
*************** package body Exp_Ch6 is
*** 513,518 ****
--- 516,529 ----
        --  representation as True. We assume that .FALSE. = False = 0.
        --  What about functions that return a logical type ???
  
+       function Is_Legal_Copy return Boolean;
+       --  Check that an actual can be copied before generating the temporary
+       --  to be used in the call. If the actual is of a by_reference type then
+       --  the program is illegal (this can only happen in the presence of
+       --  rep. clauses that force an incorrect alignment). If the formal is
+       --  a by_reference parameter imposed by a DEC pragma, emit a warning to
+       --  the effect that this might lead to unaligned arguments.
+ 
        function Make_Var (Actual : Node_Id) return Entity_Id;
        --  Returns an entity that refers to the given actual parameter,
        --  Actual (not including any type conversion). If Actual is an
*************** package body Exp_Ch6 is
*** 532,546 ****
           Expr  : Node_Id;
           Init  : Node_Id;
           Temp  : Entity_Id;
!          Indic : Node_Id := New_Occurrence_Of (Etype (Formal), Loc);
           Var   : Entity_Id;
           F_Typ : constant Entity_Id := Etype (Formal);
           V_Typ : Entity_Id;
           Crep  : Boolean;
  
        begin
           Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
  
           if Nkind (Actual) = N_Type_Conversion then
              V_Typ := Etype (Expression (Actual));
  
--- 543,571 ----
           Expr  : Node_Id;
           Init  : Node_Id;
           Temp  : Entity_Id;
!          Indic : Node_Id;
           Var   : Entity_Id;
           F_Typ : constant Entity_Id := Etype (Formal);
           V_Typ : Entity_Id;
           Crep  : Boolean;
  
        begin
+          if not Is_Legal_Copy then
+             return;
+          end if;
+ 
           Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
  
+          --  Use formal type for temp, unless formal type is an unconstrained
+          --  array, in which case we don't have to worry about bounds checks,
+          --  and we use the actual type, since that has appropriate bounds.
+ 
+          if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+             Indic := New_Occurrence_Of (Etype (Actual), Loc);
+          else
+             Indic := New_Occurrence_Of (Etype (Formal), Loc);
+          end if;
+ 
           if Nkind (Actual) = N_Type_Conversion then
              V_Typ := Etype (Expression (Actual));
  
*************** package body Exp_Ch6 is
*** 584,590 ****
              then
                 --  Actual is a one-dimensional array or slice, and the type
                 --  requires no initialization. Create a temporary of the
!                --  right size, but do copy actual into it (optimization).
  
                 Init := Empty;
                 Indic :=
--- 609,615 ----
              then
                 --  Actual is a one-dimensional array or slice, and the type
                 --  requires no initialization. Create a temporary of the
!                --  right size, but do not copy actual into it (optimization).
  
                 Init := Empty;
                 Indic :=
*************** package body Exp_Ch6 is
*** 621,631 ****
                       Is_Bit_Packed_Array (Etype (Expression (Actual))))
           then
              if Conversion_OK (Actual) then
!                Init :=
!                  OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
              else
!                Init :=
!                  Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
              end if;
  
           elsif Ekind (Formal) = E_In_Parameter then
--- 646,654 ----
                       Is_Bit_Packed_Array (Etype (Expression (Actual))))
           then
              if Conversion_OK (Actual) then
!                Init := OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
              else
!                Init := Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
              end if;
  
           elsif Ekind (Formal) = E_In_Parameter then
*************** package body Exp_Ch6 is
*** 639,645 ****
             Make_Object_Declaration (Loc,
               Defining_Identifier => Temp,
               Object_Definition   => Indic,
!              Expression => Init);
           Set_Assignment_OK (N_Node);
           Insert_Action (N, N_Node);
  
--- 662,668 ----
             Make_Object_Declaration (Loc,
               Defining_Identifier => Temp,
               Object_Definition   => Indic,
!              Expression          => Init);
           Set_Assignment_OK (N_Node);
           Insert_Action (N, N_Node);
  
*************** package body Exp_Ch6 is
*** 700,737 ****
        end Add_Call_By_Copy_Code;
  
        ----------------------------------
!       -- Add_Packed_Call_By_Copy_Code --
        ----------------------------------
  
!       procedure Add_Packed_Call_By_Copy_Code is
           Temp   : Entity_Id;
           Incod  : Node_Id;
           Outcod : Node_Id;
           Lhs    : Node_Id;
           Rhs    : Node_Id;
  
        begin
!          Reset_Packed_Prefix;
  
           --  Prepare to generate code
  
           Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
           Incod  := Relocate_Node (Actual);
           Outcod := New_Copy_Tree (Incod);
  
           --  Generate declaration of temporary variable, initializing it
!          --  with the input parameter unless we have an OUT variable.
  
           if Ekind (Formal) = E_Out_Parameter then
              Incod := Empty;
           end if;
  
!          Insert_Action (N,
             Make_Object_Declaration (Loc,
               Defining_Identifier => Temp,
!              Object_Definition   =>
!                New_Occurrence_Of (Etype (Formal), Loc),
!              Expression => Incod));
  
           --  The actual is simply a reference to the temporary
  
--- 723,823 ----
        end Add_Call_By_Copy_Code;
  
        ----------------------------------
!       -- Add_Simple_Call_By_Copy_Code --
        ----------------------------------
  
!       procedure Add_Simple_Call_By_Copy_Code is
           Temp   : Entity_Id;
+          Decl   : Node_Id;
           Incod  : Node_Id;
           Outcod : Node_Id;
           Lhs    : Node_Id;
           Rhs    : Node_Id;
+          Indic  : Node_Id;
+          F_Typ  : constant Entity_Id := Etype (Formal);
  
        begin
!          if not Is_Legal_Copy then
!             return;
!          end if;
! 
!          --  Use formal type for temp, unless formal type is an unconstrained
!          --  array, in which case we don't have to worry about bounds checks,
!          --  and we use the actual type, since that has appropriate bounds.
! 
!          if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
!             Indic := New_Occurrence_Of (Etype (Actual), Loc);
!          else
!             Indic := New_Occurrence_Of (Etype (Formal), Loc);
!          end if;
  
           --  Prepare to generate code
  
+          Reset_Packed_Prefix;
+ 
           Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
           Incod  := Relocate_Node (Actual);
           Outcod := New_Copy_Tree (Incod);
  
           --  Generate declaration of temporary variable, initializing it
!          --  with the input parameter unless we have an OUT formal or
!          --  this is an initialization call.
! 
!          --  If the formal is an out parameter with discriminants, the
!          --  discriminants must be captured even if the rest of the object
!          --  is in principle uninitialized, because the discriminants may
!          --  be read by the called subprogram.
  
           if Ekind (Formal) = E_Out_Parameter then
              Incod := Empty;
+ 
+             if Has_Discriminants (Etype (Formal)) then
+                Indic := New_Occurrence_Of (Etype (Actual), Loc);
+             end if;
+ 
+          elsif Inside_Init_Proc then
+ 
+             --  Could use a comment here to match comment below ???
+ 
+             if Nkind (Actual) /= N_Selected_Component
+               or else
+                 not Has_Discriminant_Dependent_Constraint
+                   (Entity (Selector_Name (Actual)))
+             then
+                Incod := Empty;
+ 
+             --  Otherwise, keep the component in order to generate the proper
+             --  actual subtype, that depends on enclosing discriminants.
+ 
+             else
+                null;
+             end if;
           end if;
  
!          Decl :=
             Make_Object_Declaration (Loc,
               Defining_Identifier => Temp,
!              Object_Definition   => Indic,
!              Expression          => Incod);
! 
!          if Inside_Init_Proc
!            and then No (Incod)
!          then
!             --  If the call is to initialize a component of a composite type,
!             --  and the component does not depend on discriminants, use the
!             --  actual type of the component. This is required in case the
!             --  component is constrained, because in general the formal of the
!             --  initialization procedure will be unconstrained. Note that if
!             --  the component being initialized is constrained by an enclosing
!             --  discriminant, the presence of the initialization in the
!             --  declaration will generate an expression for the actual subtype.
! 
!             Set_No_Initialization (Decl);
!             Set_Object_Definition (Decl,
!               New_Occurrence_Of (Etype (Actual), Loc));
!          end if;
! 
!          Insert_Action (N, Decl);
  
           --  The actual is simply a reference to the temporary
  
*************** package body Exp_Ch6 is
*** 754,761 ****
                Make_Assignment_Statement (Loc,
                  Name       => Lhs,
                  Expression => Rhs));
           end if;
!       end Add_Packed_Call_By_Copy_Code;
  
        ---------------------------
        -- Check_Fortran_Logical --
--- 840,848 ----
                Make_Assignment_Statement (Loc,
                  Name       => Lhs,
                  Expression => Rhs));
+             Set_Assignment_OK (Name (Last (Post_Call)));
           end if;
!       end Add_Simple_Call_By_Copy_Code;
  
        ---------------------------
        -- Check_Fortran_Logical --
*************** package body Exp_Ch6 is
*** 789,794 ****
--- 876,913 ----
           end if;
        end Check_Fortran_Logical;
  
+       -------------------
+       -- Is_Legal_Copy --
+       -------------------
+ 
+       function Is_Legal_Copy return Boolean is
+       begin
+          --  An attempt to copy a value of such a type can only occur if
+          --  representation clauses give the actual a misaligned address.
+ 
+          if Is_By_Reference_Type (Etype (Formal)) then
+             Error_Msg_N
+               ("misaligned actual cannot be passed by reference", Actual);
+             return False;
+ 
+          --  For users of Starlet, we assume that the specification of by-
+          --  reference mechanism is mandatory. This may lead to unligned
+          --  objects but at least for DEC legacy code it is known to work.
+          --  The warning will alert users of this code that a problem may
+          --  be lurking.
+ 
+          elsif Mechanism (Formal) = By_Reference
+            and then Is_Valued_Procedure (Scope (Formal))
+          then
+             Error_Msg_N
+               ("by_reference actual may be misaligned?", Actual);
+             return False;
+ 
+          else
+             return True;
+          end if;
+       end Is_Legal_Copy;
+ 
        --------------
        -- Make_Var --
        --------------
*************** package body Exp_Ch6 is
*** 821,827 ****
  
        procedure Reset_Packed_Prefix is
           Pfx : Node_Id := Actual;
- 
        begin
           loop
              Set_Analyzed (Pfx, False);
--- 940,945 ----
*************** package body Exp_Ch6 is
*** 834,844 ****
     --  Start of processing for Expand_Actuals
  
     begin
-       Formal := First_Formal (Subp);
-       Actual := First_Actual (N);
- 
        Post_Call := New_List;
  
        while Present (Formal) loop
           E_Formal := Etype (Formal);
  
--- 952,961 ----
     --  Start of processing for Expand_Actuals
  
     begin
        Post_Call := New_List;
  
+       Formal := First_Formal (Subp);
+       Actual := First_Actual (N);
        while Present (Formal) loop
           E_Formal := Etype (Formal);
  
*************** package body Exp_Ch6 is
*** 930,936 ****
              --  [in] out parameters.
  
              elsif Is_Ref_To_Bit_Packed_Array (Actual) then
!                Add_Packed_Call_By_Copy_Code;
  
              --  References to slices of bit packed arrays are expanded
  
--- 1047,1060 ----
              --  [in] out parameters.
  
              elsif Is_Ref_To_Bit_Packed_Array (Actual) then
!                Add_Simple_Call_By_Copy_Code;
! 
!             --  If a non-scalar actual is possibly unaligned, we need a copy
! 
!             elsif Is_Possibly_Unaligned_Object (Actual)
!               and then not Represented_As_Scalar (Etype (Formal))
!             then
!                Add_Simple_Call_By_Copy_Code;
  
              --  References to slices of bit packed arrays are expanded
  
*************** package body Exp_Ch6 is
*** 983,989 ****
              --  the special processing above for the OUT and IN OUT cases
              --  could be performed. We could make the test in Exp_Ch4 more
              --  complex and have it detect the parameter mode, but it is
!             --  easier simply to handle all cases here.
  
              if Nkind (Actual) = N_Indexed_Component
                and then Is_Packed (Etype (Prefix (Actual)))
--- 1107,1113 ----
              --  the special processing above for the OUT and IN OUT cases
              --  could be performed. We could make the test in Exp_Ch4 more
              --  complex and have it detect the parameter mode, but it is
!             --  easier simply to handle all cases here.)
  
              if Nkind (Actual) = N_Indexed_Component
                and then Is_Packed (Etype (Prefix (Actual)))
*************** package body Exp_Ch6 is
*** 997,1003 ****
              --  Is this really necessary in all cases???
  
              elsif Is_Ref_To_Bit_Packed_Array (Actual) then
!                Add_Packed_Call_By_Copy_Code;
  
              --  Similarly, we have to expand slices of packed arrays here
              --  because the result must be byte aligned.
--- 1121,1134 ----
              --  Is this really necessary in all cases???
  
              elsif Is_Ref_To_Bit_Packed_Array (Actual) then
!                Add_Simple_Call_By_Copy_Code;
! 
!             --  If a non-scalar actual is possibly unaligned, we need a copy
! 
!             elsif Is_Possibly_Unaligned_Object (Actual)
!               and then not Represented_As_Scalar (Etype (Formal))
!             then
!                Add_Simple_Call_By_Copy_Code;
  
              --  Similarly, we have to expand slices of packed arrays here
              --  because the result must be byte aligned.
*************** package body Exp_Ch6 is
*** 1022,1031 ****
  
        if not Is_Empty_List (Post_Call) then
  
!          --  If call is not a list member, it must be the triggering
!          --  statement of a triggering alternative or an entry call
!          --  alternative, and we can add the post call stuff to the
!          --  corresponding statement list.
  
           if not Is_List_Member (N) then
              declare
--- 1153,1161 ----
  
        if not Is_Empty_List (Post_Call) then
  
!          --  If call is not a list member, it must be the triggering statement
!          --  of a triggering alternative or an entry call alternative, and we
!          --  can add the post call stuff to the corresponding statement list.
  
           if not Is_List_Member (N) then
              declare
*************** package body Exp_Ch6 is
*** 1086,1105 ****
        Actual        : Node_Id;
        Formal        : Entity_Id;
        Prev          : Node_Id := Empty;
!       Prev_Orig     : Node_Id;
        Scop          : Entity_Id;
        Extra_Actuals : List_Id := No_List;
!       Cond          : Node_Id;
  
        procedure Add_Actual_Parameter (Insert_Param : Node_Id);
        --  Adds one entry to the end of the actual parameter list. Used for
!       --  default parameters and for extra actuals (for Extra_Formals).
!       --  The argument is an N_Parameter_Association node.
  
        procedure Add_Extra_Actual (Expr : Node_Id; EF : Entity_Id);
!       --  Adds an extra actual to the list of extra actuals. Expr
!       --  is the expression for the value of the actual, EF is the
!       --  entity for the extra formal.
  
        function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
        --  Within an instance, a type derived from a non-tagged formal derived
--- 1216,1242 ----
        Actual        : Node_Id;
        Formal        : Entity_Id;
        Prev          : Node_Id := Empty;
! 
!       Prev_Orig : Node_Id;
!       --  Original node for an actual, which may have been rewritten. If the
!       --  actual is a function call that has been transformed from a selected
!       --  component, the original node is unanalyzed. Otherwise, it carries
!       --  semantic information used to generate additional actuals.
! 
        Scop          : Entity_Id;
        Extra_Actuals : List_Id := No_List;
! 
!       CW_Interface_Formals_Present : Boolean := False;
  
        procedure Add_Actual_Parameter (Insert_Param : Node_Id);
        --  Adds one entry to the end of the actual parameter list. Used for
!       --  default parameters and for extra actuals (for Extra_Formals). The
!       --  argument is an N_Parameter_Association node.
  
        procedure Add_Extra_Actual (Expr : Node_Id; EF : Entity_Id);
!       --  Adds an extra actual to the list of extra actuals. Expr is the
!       --  expression for the value of the actual, EF is the entity for the
!       --  extra formal.
  
        function Inherited_From_Formal (S : Entity_Id) return Entity_Id;
        --  Within an instance, a type derived from a non-tagged formal derived
*************** package body Exp_Ch6 is
*** 1189,1196 ****
  
           if Nkind (Parent (S)) /= N_Full_Type_Declaration
             or else not Is_Derived_Type (Defining_Identifier (Parent (S)))
!            or else Nkind (Type_Definition (Original_Node (Parent (S))))
!              /= N_Derived_Type_Definition
             or else not In_Instance
           then
              return Empty;
--- 1326,1333 ----
  
           if Nkind (Parent (S)) /= N_Full_Type_Declaration
             or else not Is_Derived_Type (Defining_Identifier (Parent (S)))
!            or else Nkind (Type_Definition (Original_Node (Parent (S)))) /=
!                                                    N_Derived_Type_Definition
             or else not In_Instance
           then
              return Empty;
*************** package body Exp_Ch6 is
*** 1218,1248 ****
              Gen_Par := Generic_Parent_Type (Parent (Par));
           end if;
  
!          --  If the generic parent type is still the generic type, this
!          --  is a private formal, not a derived formal, and there are no
!          --  operations inherited from the formal.
  
           if Nkind (Parent (Gen_Par)) = N_Formal_Type_Declaration then
              return Empty;
           end if;
  
           Gen_Prim := Collect_Primitive_Operations (Gen_Par);
-          Elmt := First_Elmt (Gen_Prim);
  
           while Present (Elmt) loop
              if Chars (Node (Elmt)) = Chars (S) then
                 declare
                    F1 : Entity_Id;
                    F2 : Entity_Id;
-                begin
  
                    F1 := First_Formal (S);
                    F2 := First_Formal (Node (Elmt));
- 
                    while Present (F1)
                      and then Present (F2)
                    loop
- 
                       if Etype (F1) = Etype (F2)
                         or else Etype (F2) = Gen_Par
                       then
--- 1355,1383 ----
              Gen_Par := Generic_Parent_Type (Parent (Par));
           end if;
  
!          --  If the generic parent type is still the generic type, this is a
!          --  private formal, not a derived formal, and there are no operations
!          --  inherited from the formal.
  
           if Nkind (Parent (Gen_Par)) = N_Formal_Type_Declaration then
              return Empty;
           end if;
  
           Gen_Prim := Collect_Primitive_Operations (Gen_Par);
  
+          Elmt := First_Elmt (Gen_Prim);
           while Present (Elmt) loop
              if Chars (Node (Elmt)) = Chars (S) then
                 declare
                    F1 : Entity_Id;
                    F2 : Entity_Id;
  
+                begin
                    F1 := First_Formal (S);
                    F2 := First_Formal (Node (Elmt));
                    while Present (F1)
                      and then Present (F2)
                    loop
                       if Etype (F1) = Etype (F2)
                         or else Etype (F2) = Gen_Par
                       then
*************** package body Exp_Ch6 is
*** 1313,1319 ****
  
              begin
                 --  The case we catch is where the first argument is obtained
!                --  using the Identity attribute (which must always be non-null)
  
                 if Nkind (FA) = N_Attribute_Reference
                   and then Attribute_Name (FA) = Name_Identity
--- 1448,1455 ----
  
              begin
                 --  The case we catch is where the first argument is obtained
!                --  using the Identity attribute (which must always be
!                --  non-null).
  
                 if Nkind (FA) = N_Attribute_Reference
                   and then Attribute_Name (FA) = Name_Identity
*************** package body Exp_Ch6 is
*** 1329,1334 ****
--- 1465,1512 ----
           end if;
        end if;
  
+       --  Ada 2005 (AI-345): We have a procedure call as a triggering
+       --  alternative in an asynchronous select or as an entry call in
+       --  a conditional or timed select. Check whether the procedure call
+       --  is a renaming of an entry and rewrite it as an entry call.
+ 
+       if Ada_Version >= Ada_05
+         and then Nkind (N) = N_Procedure_Call_Statement
+         and then
+            ((Nkind (Parent (N)) = N_Triggering_Alternative
+                and then Triggering_Statement (Parent (N)) = N)
+           or else
+             (Nkind (Parent (N)) = N_Entry_Call_Alternative
+                and then Entry_Call_Statement (Parent (N)) = N))
+       then
+          declare
+             Ren_Decl : Node_Id;
+             Ren_Root : Entity_Id := Subp;
+ 
+          begin
+             --  This may be a chain of renamings, find the root
+ 
+             if Present (Alias (Ren_Root)) then
+                Ren_Root := Alias (Ren_Root);
+             end if;
+ 
+             if Present (Original_Node (Parent (Parent (Ren_Root)))) then
+                Ren_Decl := Original_Node (Parent (Parent (Ren_Root)));
+ 
+                if Nkind (Ren_Decl) = N_Subprogram_Renaming_Declaration then
+                   Rewrite (N,
+                     Make_Entry_Call_Statement (Loc,
+                       Name =>
+                         New_Copy_Tree (Name (Ren_Decl)),
+                       Parameter_Associations =>
+                         New_Copy_List_Tree (Parameter_Associations (N))));
+ 
+                   return;
+                end if;
+             end if;
+          end;
+       end if;
+ 
        --  First step, compute extra actuals, corresponding to any
        --  Extra_Formals present. Note that we do not access Extra_Formals
        --  directly, instead we simply note the presence of the extra
*************** package body Exp_Ch6 is
*** 1355,1370 ****
           Prev := Actual;
           Prev_Orig := Original_Node (Prev);
  
!          --  Create possible extra actual for constrained case. Usually,
!          --  the extra actual is of the form actual'constrained, but since
!          --  this attribute is only available for unconstrained records,
!          --  TRUE is expanded if the type of the formal happens to be
!          --  constrained (for instance when this procedure is inherited
!          --  from an unconstrained record to a constrained one) or if the
!          --  actual has no discriminant (its type is constrained). An
!          --  exception to this is the case of a private type without
!          --  discriminants. In this case we pass FALSE because the
!          --  object has underlying discriminants with defaults.
  
           if Present (Extra_Constrained (Formal)) then
              if Ekind (Etype (Prev)) in Private_Kind
--- 1533,1566 ----
           Prev := Actual;
           Prev_Orig := Original_Node (Prev);
  
!          if not Analyzed (Prev_Orig)
!            and then Nkind (Actual) = N_Function_Call
!          then
!             Prev_Orig := Prev;
!          end if;
! 
!          --  Ada 2005 (AI-251): Check if any formal is a class-wide interface
!          --  to expand it in a further round.
! 
!          CW_Interface_Formals_Present :=
!            CW_Interface_Formals_Present
!              or else
!                (Ekind (Etype (Formal)) = E_Class_Wide_Type
!                   and then Is_Interface (Etype (Etype (Formal))))
!              or else
!                (Ekind (Etype (Formal)) = E_Anonymous_Access_Type
!                  and then Is_Interface (Directly_Designated_Type
!                                          (Etype (Etype (Formal)))));
! 
!          --  Create possible extra actual for constrained case. Usually, the
!          --  extra actual is of the form actual'constrained, but since this
!          --  attribute is only available for unconstrained records, TRUE is
!          --  expanded if the type of the formal happens to be constrained (for
!          --  instance when this procedure is inherited from an unconstrained
!          --  record to a constrained one) or if the actual has no discriminant
!          --  (its type is constrained). An exception to this is the case of a
!          --  private type without discriminants. In this case we pass FALSE
!          --  because the object has underlying discriminants with defaults.
  
           if Present (Extra_Constrained (Formal)) then
              if Ekind (Etype (Prev)) in Private_Kind
*************** package body Exp_Ch6 is
*** 1392,1417 ****
                 --  test applies to the actual, not the target type.
  
                 declare
!                   Act_Prev : Node_Id := Prev;
  
                 begin
!                   --  Test for unchecked conversions as well, which can
!                   --  occur as out parameter actuals on calls to stream
!                   --  procedures.
  
                    while Nkind (Act_Prev) = N_Type_Conversion
                      or else Nkind (Act_Prev) = N_Unchecked_Type_Conversion
                    loop
                       Act_Prev := Expression (Act_Prev);
                    end loop;
  
!                   Add_Extra_Actual (
!                     Make_Attribute_Reference (Sloc (Prev),
!                       Prefix =>
!                         Duplicate_Subexpr_No_Checks
!                           (Act_Prev, Name_Req => True),
!                       Attribute_Name => Name_Constrained),
!                     Extra_Constrained (Formal));
                 end;
              end if;
           end if;
--- 1588,1629 ----
                 --  test applies to the actual, not the target type.
  
                 declare
!                   Act_Prev : Node_Id;
  
                 begin
!                   --  Test for unchecked conversions as well, which can occur
!                   --  as out parameter actuals on calls to stream procedures.
  
+                   Act_Prev := Prev;
                    while Nkind (Act_Prev) = N_Type_Conversion
                      or else Nkind (Act_Prev) = N_Unchecked_Type_Conversion
                    loop
                       Act_Prev := Expression (Act_Prev);
                    end loop;
  
!                   --  If the expression is a conversion of a dereference,
!                   --  this is internally generated code that manipulates
!                   --  addresses, e.g. when building interface tables. No
!                   --  check should occur in this case, and the discriminated
!                   --  object is not directly a hand.
! 
!                   if not Comes_From_Source (Actual)
!                     and then Nkind (Actual) = N_Unchecked_Type_Conversion
!                     and then Nkind (Act_Prev) = N_Explicit_Dereference
!                   then
!                      Add_Extra_Actual
!                        (New_Occurrence_Of (Standard_False, Loc),
!                         Extra_Constrained (Formal));
! 
!                   else
!                      Add_Extra_Actual
!                        (Make_Attribute_Reference (Sloc (Prev),
!                         Prefix =>
!                           Duplicate_Subexpr_No_Checks
!                             (Act_Prev, Name_Req => True),
!                         Attribute_Name => Name_Constrained),
!                         Extra_Constrained (Formal));
!                   end if;
                 end;
              end if;
           end if;
*************** package body Exp_Ch6 is
*** 1438,1447 ****
                       pragma Assert (Present (Parm_Ent));
  
                       if Present (Extra_Accessibility (Parm_Ent)) then
!                         Add_Extra_Actual (
!                           New_Occurrence_Of
!                             (Extra_Accessibility (Parm_Ent), Loc),
!                           Extra_Accessibility (Formal));
  
                       --  If the actual access parameter does not have an
                       --  associated extra formal providing its scope level,
--- 1650,1659 ----
                       pragma Assert (Present (Parm_Ent));
  
                       if Present (Extra_Accessibility (Parm_Ent)) then
!                         Add_Extra_Actual
!                           (New_Occurrence_Of
!                              (Extra_Accessibility (Parm_Ent), Loc),
!                            Extra_Accessibility (Formal));
  
                       --  If the actual access parameter does not have an
                       --  associated extra formal providing its scope level,
*************** package body Exp_Ch6 is
*** 1449,1458 ****
                       --  accessibility.
  
                       else
!                         Add_Extra_Actual (
!                           Make_Integer_Literal (Loc,
!                             Intval => Scope_Depth (Standard_Standard)),
!                           Extra_Accessibility (Formal));
                       end if;
                    end;
  
--- 1661,1670 ----
                       --  accessibility.
  
                       else
!                         Add_Extra_Actual
!                           (Make_Integer_Literal (Loc,
!                            Intval => Scope_Depth (Standard_Standard)),
!                            Extra_Accessibility (Formal));
                       end if;
                    end;
  
*************** package body Exp_Ch6 is
*** 1460,1469 ****
                 --  level of the actual's access type.
  
                 else
!                   Add_Extra_Actual (
!                     Make_Integer_Literal (Loc,
!                       Intval => Type_Access_Level (Etype (Prev_Orig))),
!                     Extra_Accessibility (Formal));
                 end if;
  
              else
--- 1672,1681 ----
                 --  level of the actual's access type.
  
                 else
!                   Add_Extra_Actual
!                     (Make_Integer_Literal (Loc,
!                      Intval => Type_Access_Level (Etype (Prev_Orig))),
!                      Extra_Accessibility (Formal));
                 end if;
  
              else
*************** package body Exp_Ch6 is
*** 1522,1576 ****
              end if;
           end if;
  
!          --  Perform the check of 4.6(49) that prevents a null value
!          --  from being passed as an actual to an access parameter.
!          --  Note that the check is elided in the common cases of
!          --  passing an access attribute or access parameter as an
!          --  actual. Also, we currently don't enforce this check for
!          --  expander-generated actuals and when -gnatdj is set.
  
!          if Ekind (Etype (Formal)) /= E_Anonymous_Access_Type
!            or else Access_Checks_Suppressed (Subp)
!          then
!             null;
  
!          elsif Debug_Flag_J then
!             null;
  
!          elsif not Comes_From_Source (Prev) then
!             null;
  
!          elsif Is_Entity_Name (Prev)
!            and then Ekind (Etype (Prev)) = E_Anonymous_Access_Type
!          then
!             null;
  
!          elsif Nkind (Prev) = N_Allocator
!            or else Nkind (Prev) = N_Attribute_Reference
!          then
!             null;
  
!          --  Suppress null checks when passing to access parameters
!          --  of Java subprograms. (Should this be done for other
!          --  foreign conventions as well ???)
  
!          elsif Convention (Subp) = Convention_Java then
!             null;
  
!             --  Ada 2005 (AI-231): do not force the check in case of Ada 2005
!             --  unless it is a null-excluding type
  
!          elsif Ada_Version < Ada_05
!            or else Can_Never_Be_Null (Etype (Prev))
!          then
!             Cond :=
!               Make_Op_Eq (Loc,
!                 Left_Opnd => Duplicate_Subexpr_No_Checks (Prev),
!                 Right_Opnd => Make_Null (Loc));
!             Insert_Action (Prev,
!               Make_Raise_Constraint_Error (Loc,
!                 Condition => Cond,
!                 Reason    => CE_Access_Parameter_Is_Null));
           end if;
  
           --  Perform appropriate validity checks on parameters that
--- 1734,1792 ----
              end if;
           end if;
  
!          --  Perform the check of 4.6(49) that prevents a null value from being
!          --  passed as an actual to an access parameter. Note that the check is
!          --  elided in the common cases of passing an access attribute or
!          --  access parameter as an actual. Also, we currently don't enforce
!          --  this check for expander-generated actuals and when -gnatdj is set.
  
!          if Ada_Version >= Ada_05 then
  
!             --  Ada 2005 (AI-231): Check null-excluding access types
  
!             if Is_Access_Type (Etype (Formal))
!               and then Can_Never_Be_Null (Etype (Formal))
!               and then Nkind (Prev) /= N_Raise_Constraint_Error
!               and then (Nkind (Prev) = N_Null
!                           or else not Can_Never_Be_Null (Etype (Prev)))
!             then
!                Install_Null_Excluding_Check (Prev);
!             end if;
  
!          --  Ada_Version < Ada_05
  
!          else
!             if Ekind (Etype (Formal)) /= E_Anonymous_Access_Type
!               or else Access_Checks_Suppressed (Subp)
!             then
!                null;
  
!             elsif Debug_Flag_J then
!                null;
  
!             elsif not Comes_From_Source (Prev) then
!                null;
  
!             elsif Is_Entity_Name (Prev)
!               and then Ekind (Etype (Prev)) = E_Anonymous_Access_Type
!             then
!                null;
  
!             elsif Nkind (Prev) = N_Allocator
!               or else Nkind (Prev) = N_Attribute_Reference
!             then
!                null;
! 
!             --  Suppress null checks when passing to access parameters of Java
!             --  subprograms. (Should this be done for other foreign conventions
!             --  as well ???)
! 
!             elsif Convention (Subp) = Convention_Java then
!                null;
! 
!             else
!                Install_Null_Excluding_Check (Prev);
!             end if;
           end if;
  
           --  Perform appropriate validity checks on parameters that
*************** package body Exp_Ch6 is
*** 1720,1725 ****
--- 1936,1951 ----
           end;
        end if;
  
+       --  Ada 2005 (AI-251): If some formal is a class-wide interface, expand
+       --  it to point to the correct secondary virtual table
+ 
+       if (Nkind (N) = N_Function_Call
+            or else Nkind (N) = N_Procedure_Call_Statement)
+         and then CW_Interface_Formals_Present
+       then
+          Expand_Interface_Actuals (N);
+       end if;
+ 
        --  Deals with Dispatch_Call if we still have a call, before expanding
        --  extra actuals since this will be done on the re-analysis of the
        --  dispatching call. Note that we do not try to shorten the actual
*************** package body Exp_Ch6 is
*** 1768,1780 ****
           end loop;
        end if;
  
!       if Ekind (Subp) = E_Procedure
!          or else (Ekind (Subp) = E_Subprogram_Type
!                    and then Etype (Subp) = Standard_Void_Type)
!          or else Is_Entry (Subp)
!       then
!          Expand_Actuals (N, Subp);
!       end if;
  
        --  If the subprogram is a renaming, or if it is inherited, replace it
        --  in the call with the name of the actual subprogram being called.
--- 1994,2003 ----
           end loop;
        end if;
  
!       --  At this point we have all the actuals, so this is the point at
!       --  which the various expansion activities for actuals is carried out.
! 
!       Expand_Actuals (N, Subp);
  
        --  If the subprogram is a renaming, or if it is inherited, replace it
        --  in the call with the name of the actual subprogram being called.
*************** package body Exp_Ch6 is
*** 1820,1826 ****
             or else Is_Generic_Instance (Parent_Subp)
           then
              while Present (Formal) loop
- 
                 if Etype (Formal) /= Etype (Parent_Formal)
                   and then Is_Scalar_Type (Etype (Formal))
                   and then Ekind (Formal) = E_In_Parameter
--- 2043,2048 ----
*************** package body Exp_Ch6 is
*** 1835,1842 ****
                    Enable_Range_Check (Actual);
  
                 elsif Is_Access_Type (Etype (Formal))
!                  and then Base_Type (Etype (Parent_Formal))
!                    /= Base_Type (Etype (Actual))
                 then
                    if Ekind (Formal) /= E_In_Parameter then
                       Rewrite (Actual,
--- 2057,2064 ----
                    Enable_Range_Check (Actual);
  
                 elsif Is_Access_Type (Etype (Formal))
!                  and then Base_Type (Etype (Parent_Formal)) /=
!                           Base_Type (Etype (Actual))
                 then
                    if Ekind (Formal) /= E_In_Parameter then
                       Rewrite (Actual,
*************** package body Exp_Ch6 is
*** 1924,1937 ****
                         Designated_Type (Base_Type (Etype (Ptr)));
  
              begin
!                Obj := Make_Selected_Component (Loc,
!                  Prefix => Unchecked_Convert_To (T, Ptr),
!                  Selector_Name => New_Occurrence_Of (First_Entity (T), Loc));
  
!                Nam := Make_Selected_Component (Loc,
!                  Prefix => Unchecked_Convert_To (T, Ptr),
!                  Selector_Name => New_Occurrence_Of (
!                    Next_Entity (First_Entity (T)), Loc));
  
                 Nam := Make_Explicit_Dereference (Loc, Nam);
  
--- 2146,2162 ----
                         Designated_Type (Base_Type (Etype (Ptr)));
  
              begin
!                Obj :=
!                  Make_Selected_Component (Loc,
!                    Prefix        => Unchecked_Convert_To (T, Ptr),
!                    Selector_Name =>
!                      New_Occurrence_Of (First_Entity (T), Loc));
  
!                Nam :=
!                  Make_Selected_Component (Loc,
!                    Prefix        => Unchecked_Convert_To (T, Ptr),
!                    Selector_Name =>
!                      New_Occurrence_Of (Next_Entity (First_Entity (T)), Loc));
  
                 Nam := Make_Explicit_Dereference (Loc, Nam);
  
*************** package body Exp_Ch6 is
*** 2004,2012 ****
                 --------------------------
  
                 function In_Unfrozen_Instance return Boolean is
!                   S : Entity_Id := Scop;
  
                 begin
                    while Present (S)
                      and then S /= Standard_Standard
                    loop
--- 2229,2238 ----
                 --------------------------
  
                 function In_Unfrozen_Instance return Boolean is
!                   S : Entity_Id;
  
                 begin
+                   S := Scop;
                    while Present (S)
                      and then S /= Standard_Standard
                    loop
*************** package body Exp_Ch6 is
*** 2026,2035 ****
              --  Start of processing for Inlined_Subprogram
  
              begin
!                --  Verify that the body to inline has already been seen,
!                --  and that if the body is in the current unit the inlining
!                --  does not occur earlier. This avoids order-of-elaboration
!                --  problems in gigi.
  
                 if No (Spec)
                   or else Nkind (Spec) /= N_Subprogram_Declaration
--- 2252,2263 ----
              --  Start of processing for Inlined_Subprogram
  
              begin
!                --  Verify that the body to inline has already been seen, and
!                --  that if the body is in the current unit the inlining does
!                --  not occur earlier. This avoids order-of-elaboration problems
!                --  in the back end.
! 
!                --  This should be documented in sinfo/einfo ???
  
                 if No (Spec)
                   or else Nkind (Spec) /= N_Subprogram_Declaration
*************** package body Exp_Ch6 is
*** 2526,2540 ****
                 Original_Assignment : constant Node_Id := Parent (N);
  
              begin
!                --  Preserve the original assignment node to keep the
!                --  complete assignment subtree consistent enough for
!                --  Analyze_Assignment to proceed (specifically, the
!                --  original Lhs node must still have an assignment
!                --  statement as its parent).
  
!                --  We cannot rely on Original_Node to go back from the
!                --  block node to the assignment node, because the
!                --  assignment might already be a rewrite substitution.
  
                 Discard_Node (Relocate_Node (Original_Assignment));
                 Rewrite (Original_Assignment, Blk);
--- 2754,2767 ----
                 Original_Assignment : constant Node_Id := Parent (N);
  
              begin
!                --  Preserve the original assignment node to keep the complete
!                --  assignment subtree consistent enough for Analyze_Assignment
!                --  to proceed (specifically, the original Lhs node must still
!                --  have an assignment statement as its parent).
  
!                --  We cannot rely on Original_Node to go back from the block
!                --  node to the assignment node, because the assignment might
!                --  already be a rewrite substitution.
  
                 Discard_Node (Relocate_Node (Original_Assignment));
                 Rewrite (Original_Assignment, Blk);
*************** package body Exp_Ch6 is
*** 2584,2591 ****
              if Nkind (N) = N_Identifier
                and then Present (Entity (N))
  
!                --  The original node's entity points to the one in the
!                --  copied body.
  
                and then Nkind (Entity (N)) = N_Identifier
                and then Present (Entity (Entity (N)))
--- 2811,2817 ----
              if Nkind (N) = N_Identifier
                and then Present (Entity (N))
  
!                --  Original node's entity points to the one in the copied body
  
                and then Nkind (Entity (N)) = N_Identifier
                and then Present (Entity (Entity (N)))
*************** package body Exp_Ch6 is
*** 2621,2631 ****
     --  Start of processing for Expand_Inlined_Call
  
     begin
!       --  Check for special case of To_Address call, and if so, just
!       --  do an unchecked conversion instead of expanding the call.
!       --  Not only is this more efficient, but it also avoids a
!       --  problem with order of elaboration when address clauses
!       --  are inlined (address expr elaborated at wrong point).
  
        if Subp = RTE (RE_To_Address) then
           Rewrite (N,
--- 2847,2857 ----
     --  Start of processing for Expand_Inlined_Call
  
     begin
!       --  Check for special case of To_Address call, and if so, just do an
!       --  unchecked conversion instead of expanding the call. Not only is this
!       --  more efficient, but it also avoids problem with order of elaboration
!       --  when address clauses are inlined (address expression elaborated at
!       --  wrong point).
  
        if Subp = RTE (RE_To_Address) then
           Rewrite (N,
*************** package body Exp_Ch6 is
*** 2635,2647 ****
           return;
        end if;
  
!       if Nkind (Orig_Bod) = N_Defining_Identifier then
  
           --  Subprogram is a renaming_as_body. Calls appearing after the
           --  renaming can be replaced with calls to the renamed entity
!          --  directly, because the subprograms are subtype conformant.
  
           Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc));
           return;
        end if;
  
--- 2861,2892 ----
           return;
        end if;
  
!       --  Check for an illegal attempt to inline a recursive procedure. If the
!       --  subprogram has parameters this is detected when trying to supply a
!       --  binding for parameters that already have one. For parameterless
!       --  subprograms this must be done explicitly.
! 
!       if In_Open_Scopes (Subp) then
!          Error_Msg_N ("call to recursive subprogram cannot be inlined?", N);
!          Set_Is_Inlined (Subp, False);
!          return;
!       end if;
  
+       if Nkind (Orig_Bod) = N_Defining_Identifier
+         or else Nkind (Orig_Bod) = N_Defining_Operator_Symbol
+       then
           --  Subprogram is a renaming_as_body. Calls appearing after the
           --  renaming can be replaced with calls to the renamed entity
!          --  directly, because the subprograms are subtype conformant. If
!          --  the renamed subprogram is an inherited operation, we must redo
!          --  the expansion because implicit conversions may be needed.
  
           Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc));
+ 
+          if Present (Alias (Orig_Bod)) then
+             Expand_Call (N);
+          end if;
+ 
           return;
        end if;
  
*************** package body Exp_Ch6 is
*** 2672,2694 ****
           Ret_Type := Etype (Subp);
        end if;
  
-       F := First_Formal (Subp);
-       A := First_Actual (N);
- 
        --  Create temporaries for the actuals that are expressions, or that
        --  are scalars and require copying to preserve semantics.
  
        while Present (F) loop
           if Present (Renamed_Object (F)) then
!             Error_Msg_N (" cannot inline call to recursive subprogram", N);
              return;
           end if;
  
           --  If the argument may be a controlling argument in a call within
!          --  the inlined body, we must preserve its classwide nature to
!          --  insure that dynamic dispatching take place subsequently.
!          --  If the formal has a constraint it must be preserved to retain
!          --  the semantics of the body.
  
           if Is_Class_Wide_Type (Etype (F))
             or else (Is_Access_Type (Etype (F))
--- 2917,2938 ----
           Ret_Type := Etype (Subp);
        end if;
  
        --  Create temporaries for the actuals that are expressions, or that
        --  are scalars and require copying to preserve semantics.
  
+       F := First_Formal (Subp);
+       A := First_Actual (N);
        while Present (F) loop
           if Present (Renamed_Object (F)) then
!             Error_Msg_N ("cannot inline call to recursive subprogram", N);
              return;
           end if;
  
           --  If the argument may be a controlling argument in a call within
!          --  the inlined body, we must preserve its classwide nature to insure
!          --  that dynamic dispatching take place subsequently. If the formal
!          --  has a constraint it must be preserved to retain the semantics of
!          --  the body.
  
           if Is_Class_Wide_Type (Etype (F))
             or else (Is_Access_Type (Etype (F))
*************** package body Exp_Ch6 is
*** 2803,2808 ****
--- 3047,3053 ----
  
              Temp :=
                Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
+             Set_Is_Internal (Temp);
  
              Decl :=
                Make_Object_Declaration (Loc,
*************** package body Exp_Ch6 is
*** 2847,2853 ****
        end if;
  
        --  Analyze Blk with In_Inlined_Body set, to avoid spurious errors on
!       --  conflicting private views that Gigi would ignore. If this is a
        --  predefined unit, analyze with checks off, as is done in the non-
        --  inlined run-time units.
  
--- 3092,3098 ----
        end if;
  
        --  Analyze Blk with In_Inlined_Body set, to avoid spurious errors on
!       --  conflicting private views that Gigi would ignore. If this is
        --  predefined unit, analyze with checks off, as is done in the non-
        --  inlined run-time units.
  
*************** package body Exp_Ch6 is
*** 2884,2890 ****
        --  Cleanup mapping between formals and actuals for other expansions
  
        F := First_Formal (Subp);
- 
        while Present (F) loop
           Set_Renamed_Object (F, Empty);
           Next_Formal (F);
--- 3129,3134 ----
*************** package body Exp_Ch6 is
*** 2907,2919 ****
        --  If the call is the right side of an assignment or the expression in
        --  an object declaration, we don't need to create a temp as the left
        --  side will already trigger stack checking if necessary.
  
        ---------------------------
        -- Returned_By_Reference --
        ---------------------------
  
        function Returned_By_Reference return Boolean is
!          S : Entity_Id := Current_Scope;
  
        begin
           if Is_Return_By_Reference_Type (Typ) then
--- 3151,3169 ----
        --  If the call is the right side of an assignment or the expression in
        --  an object declaration, we don't need to create a temp as the left
        --  side will already trigger stack checking if necessary.
+       --
+       --  If the call is a component in an extension aggregate, it will be
+       --  expanded into assignments as well, so no temporary is needed. This
+       --  also solves the problem of functions returning types with unknown
+       --  discriminants, where it is not possible to declare an object of the
+       --  type altogether.
  
        ---------------------------
        -- Returned_By_Reference --
        ---------------------------
  
        function Returned_By_Reference return Boolean is
!          S : Entity_Id;
  
        begin
           if Is_Return_By_Reference_Type (Typ) then
*************** package body Exp_Ch6 is
*** 2924,2932 ****
  
           elsif Requires_Transient_Scope (Typ) then
  
!             --  Verify that the return type of the enclosing function has
!             --  the same constrained status as that of the expression.
  
              while Ekind (S) /= E_Function loop
                 S := Scope (S);
              end loop;
--- 3174,3183 ----
  
           elsif Requires_Transient_Scope (Typ) then
  
!             --  Verify that the return type of the enclosing function has the
!             --  same constrained status as that of the expression.
  
+             S := Current_Scope;
              while Ekind (S) /= E_Function loop
                 S := Scope (S);
              end loop;
*************** package body Exp_Ch6 is
*** 2957,2962 ****
--- 3208,3216 ----
                  and then Expression (Parent (N)) = N
                    and then Nkind (Parent (Parent (N))) = N_Aggregate
                      and then Rhs_Of_Assign_Or_Decl (Parent (Parent (N))))
+            or else
+              (Nkind (Parent (N)) = N_Extension_Aggregate
+                and then Is_Private_Type (Etype (Typ)))
           then
              return True;
           else
*************** package body Exp_Ch6 is
*** 2968,2983 ****
  
     begin
        --  A special check. If stack checking is enabled, and the return type
!       --  might generate a large temporary, and the call is not the right
!       --  side of an assignment, then generate an explicit temporary. We do
!       --  this because otherwise gigi may generate a large temporary on the
!       --  fly and this can cause trouble with stack checking.
  
        --  This is unecessary if the call is the expression in an object
!       --  declaration, or if it appears outside of any library unit. This
!       --  can only happen if it appears as an actual in a library-level
!       --  instance, in which case a temporary will be generated for it once
!       --  the instance itself is installed.
  
        if May_Generate_Large_Temp (Typ)
          and then not Rhs_Of_Assign_Or_Decl (N)
--- 3222,3237 ----
  
     begin
        --  A special check. If stack checking is enabled, and the return type
!       --  might generate a large temporary, and the call is not the right side
!       --  of an assignment, then generate an explicit temporary. We do this
!       --  because otherwise gigi may generate a large temporary on the fly and
!       --  this can cause trouble with stack checking.
  
        --  This is unecessary if the call is the expression in an object
!       --  declaration, or if it appears outside of any library unit. This can
!       --  only happen if it appears as an actual in a library-level instance,
!       --  in which case a temporary will be generated for it once the instance
!       --  itself is installed.
  
        if May_Generate_Large_Temp (Typ)
          and then not Rhs_Of_Assign_Or_Decl (N)
*************** package body Exp_Ch6 is
*** 2986,2995 ****
        then
           if Stack_Checking_Enabled then
  
!             --  Note: it might be thought that it would be OK to use a call
!             --  to Force_Evaluation here, but that's not good enough, because
!             --  that can results in a 'Reference construct that may still
!             --  need a temporary.
  
              declare
                 Loc      : constant Source_Ptr := Sloc (N);
--- 3240,3249 ----
        then
           if Stack_Checking_Enabled then
  
!             --  Note: it might be thought that it would be OK to use a call to
!             --  Force_Evaluation here, but that's not good enough, because
!             --  that can results in a 'Reference construct that may still need
!             --  a temporary.
  
              declare
                 Loc      : constant Source_Ptr := Sloc (N);
*************** package body Exp_Ch6 is
*** 3025,3033 ****
                       --  object is not classwide.
  
                       Proc := Entity (Name (Parent (N)));
                       F    := First_Formal (Proc);
                       A    := First_Actual (Parent (N));
- 
                       while A /= N loop
                          Next_Formal (F);
                          Next_Actual (A);
--- 3279,3287 ----
                       --  object is not classwide.
  
                       Proc := Entity (Name (Parent (N)));
+ 
                       F    := First_Formal (Proc);
                       A    := First_Actual (Parent (N));
                       while A /= N loop
                          Next_Formal (F);
                          Next_Actual (A);
*************** package body Exp_Ch6 is
*** 3086,3094 ****
     --  Add poll call if ATC polling is enabled, unless the body will be
     --  inlined by the back-end.
  
!    --  Add return statement if last statement in body is not a return
!    --  statement (this makes things easier on Gigi which does not want
!    --  to have to handle a missing return).
  
     --  Add call to Activate_Tasks if body is a task activator
  
--- 3340,3348 ----
     --  Add poll call if ATC polling is enabled, unless the body will be
     --  inlined by the back-end.
  
!    --  Add return statement if last statement in body is not a return statement
!    --  (this makes things easier on Gigi which does not want to have to handle
!    --  a missing return).
  
     --  Add call to Activate_Tasks if body is a task activator
  
*************** package body Exp_Ch6 is
*** 3358,3366 ****
          and then not Has_Pragma_Pure_Function (Spec_Id)
        then
           declare
!             F : Entity_Id := First_Formal (Spec_Id);
  
           begin
              while Present (F) loop
                 if Is_Descendent_Of_Address (Etype (F)) then
                    Set_Is_Pure (Spec_Id, False);
--- 3612,3621 ----
          and then not Has_Pragma_Pure_Function (Spec_Id)
        then
           declare
!             F : Entity_Id;
  
           begin
+             F := First_Formal (Spec_Id);
              while Present (F) loop
                 if Is_Descendent_Of_Address (Etype (F)) then
                    Set_Is_Pure (Spec_Id, False);
*************** package body Exp_Ch6 is
*** 3381,3387 ****
  
        if Init_Or_Norm_Scalars and then Is_Subprogram (Spec_Id) then
           declare
!             F : Entity_Id        := First_Formal (Spec_Id);
              V : constant Boolean := Validity_Checks_On;
  
           begin
--- 3636,3642 ----
  
        if Init_Or_Norm_Scalars and then Is_Subprogram (Spec_Id) then
           declare
!             F : Entity_Id;
              V : constant Boolean := Validity_Checks_On;
  
           begin
*************** package body Exp_Ch6 is
*** 3393,3398 ****
--- 3648,3654 ----
  
              --  Loop through formals
  
+             F := First_Formal (Spec_Id);
              while Present (F) loop
                 if Is_Scalar_Type (Etype (F))
                   and then Ekind (F) = E_Out_Parameter
*************** package body Exp_Ch6 is
*** 3412,3420 ****
  
        Scop := Scope (Spec_Id);
  
!       --  Add discriminal renamings to protected subprograms.
!       --  Install new discriminals for expansion of the next
!       --  subprogram of this protected type, if any.
  
        if Is_List_Member (N)
          and then Present (Parent (List_Containing (N)))
--- 3668,3676 ----
  
        Scop := Scope (Spec_Id);
  
!       --  Add discriminal renamings to protected subprograms. Install new
!       --  discriminals for expansion of the next subprogram of this protected
!       --  type, if any.
  
        if Is_List_Member (N)
          and then Present (Parent (List_Containing (N)))
*************** package body Exp_Ch6 is
*** 3425,3433 ****
           Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
  
           --  Associate privals and discriminals with the next protected
!          --  operation body to be expanded. These are used to expand
!          --  references to private data objects and discriminants,
!          --  respectively.
  
           Next_Op := Next_Protected_Operation (N);
  
--- 3681,3688 ----
           Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
  
           --  Associate privals and discriminals with the next protected
!          --  operation body to be expanded. These are used to expand references
!          --  to private data objects and discriminants, respectively.
  
           Next_Op := Next_Protected_Operation (N);
  
*************** package body Exp_Ch6 is
*** 3456,3462 ****
        end if;
  
        --  Returns_By_Ref flag is normally set when the subprogram is frozen
!       --  but subprograms with no specs are not frozen
  
        declare
           Typ  : constant Entity_Id := Etype (Spec_Id);
--- 3711,3717 ----
        end if;
  
        --  Returns_By_Ref flag is normally set when the subprogram is frozen
!       --  but subprograms with no specs are not frozen.
  
        declare
           Typ  : constant Entity_Id := Etype (Spec_Id);
*************** package body Exp_Ch6 is
*** 3488,3494 ****
  
           if Present (Exception_Handlers (H)) then
              Except_H := First_Non_Pragma (Exception_Handlers (H));
- 
              while Present (Except_H) loop
                 Add_Return (Statements (Except_H));
                 Next_Non_Pragma (Except_H);
--- 3743,3748 ----
*************** package body Exp_Ch6 is
*** 3565,3571 ****
  
           begin
              Formal := First_Formal (Spec_Id);
- 
              while Present (Formal) loop
                 Floc := Sloc (Formal);
  
--- 3819,3824 ----
*************** package body Exp_Ch6 is
*** 3592,3609 ****
           Expand_Thread_Body;
        end if;
  
-       --  If the subprogram does not have pending instantiations, then we
-       --  must generate the subprogram descriptor now, since the code for
-       --  the subprogram is complete, and this is our last chance. However
-       --  if there are pending instantiations, then the code is not
-       --  complete, and we will delay the generation.
- 
-       if Is_Subprogram (Spec_Id)
-         and then not Delay_Subprogram_Descriptors (Spec_Id)
-       then
-          Generate_Subprogram_Descriptor_For_Subprogram (N, Spec_Id);
-       end if;
- 
        --  Set to encode entity names in package body before gigi is called
  
        Qualify_Entity_Names (N);
--- 3845,3850 ----
*************** package body Exp_Ch6 is
*** 3630,3635 ****
--- 3871,3878 ----
     --  protected subprogram an associated formals. For a normal protected
     --  operation, this is done when expanding the protected type declaration.
  
+    --  If the declaration is for a null procedure, emit null body
+ 
     procedure Expand_N_Subprogram_Declaration (N : Node_Id) is
        Loc       : constant Source_Ptr := Sloc (N);
        Subp      : constant Entity_Id  := Defining_Entity (N);
*************** package body Exp_Ch6 is
*** 3639,3646 ****
        Prot_Id   : Entity_Id;
  
     begin
!       --  Deal with case of protected subprogram. Do not generate
!       --  protected operation if operation is flagged as eliminated.
  
        if Is_List_Member (N)
          and then Present (Parent (List_Containing (N)))
--- 3882,3889 ----
        Prot_Id   : Entity_Id;
  
     begin
!       --  Deal with case of protected subprogram. Do not generate protected
!       --  operation if operation is flagged as eliminated.
  
        if Is_List_Member (N)
          and then Present (Parent (List_Containing (N)))
*************** package body Exp_Ch6 is
*** 3654,3660 ****
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (N, Scop, Unprotected => True));
  
              --  The protected subprogram is declared outside of the protected
              --  body. Given that the body has frozen all entities so far, we
--- 3897,3903 ----
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (N, Scop, Unprotected_Mode));
  
              --  The protected subprogram is declared outside of the protected
              --  body. Given that the body has frozen all entities so far, we
*************** package body Exp_Ch6 is
*** 3677,3682 ****
--- 3920,3954 ----
              Set_Protected_Body_Subprogram (Subp, Prot_Id);
              Pop_Scope;
           end if;
+ 
+       elsif Nkind (Specification (N)) = N_Procedure_Specification
+         and then Null_Present (Specification (N))
+       then
+          declare
+             Bod : constant Node_Id :=
+                     Make_Subprogram_Body (Loc,
+                       Specification =>
+                         New_Copy_Tree (Specification (N)),
+                       Declarations => New_List,
+                      Handled_Statement_Sequence =>
+                         Make_Handled_Sequence_Of_Statements (Loc,
+                           Statements => New_List (Make_Null_Statement (Loc))));
+          begin
+             Set_Body_To_Inline (N, Bod);
+             Insert_After (N, Bod);
+             Analyze (Bod);
+ 
+             --  Corresponding_Spec isn't being set by Analyze_Subprogram_Body,
+             --  evidently because Set_Has_Completion is called earlier for null
+             --  procedures in Analyze_Subprogram_Declaration, so we force its
+             --  setting here. If the setting of Has_Completion is not set
+             --  earlier, then it can result in missing body errors if other
+             --  errors were already reported (since expansion is turned off).
+ 
+             --  Should creation of the empty body be moved to the analyzer???
+ 
+             Set_Corresponding_Spec (Bod, Defining_Entity (Specification (N)));
+          end;
        end if;
     end Expand_N_Subprogram_Declaration;
  
*************** package body Exp_Ch6 is
*** 3699,3716 ****
        Rec := Make_Identifier (Loc, Name_uObject);
        Set_Etype (Rec, Corresponding_Record_Type (Scop));
  
!       --  Find enclosing protected operation, and retrieve its first
!       --  parameter, which denotes the enclosing protected object.
!       --  If the enclosing operation is an entry, we are immediately
!       --  within the protected body, and we can retrieve the object
!       --  from the service entries procedure. A barrier function has
!       --  has the same signature as an entry. A barrier function is
!       --  compiled within the protected object, but unlike protected
!       --  operations its never needs locks, so that its protected body
!       --  subprogram points to itself.
  
        Proc := Current_Scope;
- 
        while Present (Proc)
          and then Scope (Proc) /= Scop
        loop
--- 3971,3986 ----
        Rec := Make_Identifier (Loc, Name_uObject);
        Set_Etype (Rec, Corresponding_Record_Type (Scop));
  
!       --  Find enclosing protected operation, and retrieve its first parameter,
!       --  which denotes the enclosing protected object. If the enclosing
!       --  operation is an entry, we are immediately within the protected body,
!       --  and we can retrieve the object from the service entries procedure. A
!       --  barrier function has has the same signature as an entry. A barrier
!       --  function is compiled within the protected object, but unlike
!       --  protected operations its never needs locks, so that its protected
!       --  body subprogram points to itself.
  
        Proc := Current_Scope;
        while Present (Proc)
          and then Scope (Proc) /= Scop
        loop
*************** package body Exp_Ch6 is
*** 3738,3754 ****
  
           Set_Entity (Rec, Param);
  
!          --  Rec is a reference to an entity which will not be in scope
!          --  when the call is reanalyzed, and needs no further analysis.
  
           Set_Analyzed (Rec);
  
        else
!          --  Entry or barrier function for entry body.
!          --  The first parameter of the entry body procedure is a
!          --  pointer to the object. We create a local variable
!          --  of the proper type, duplicating what is done to define
!          --  _object later on.
  
           declare
              Decls : List_Id;
--- 4008,4023 ----
  
           Set_Entity (Rec, Param);
  
!          --  Rec is a reference to an entity which will not be in scope when
!          --  the call is reanalyzed, and needs no further analysis.
  
           Set_Analyzed (Rec);
  
        else
!          --  Entry or barrier function for entry body. The first parameter of
!          --  the entry body procedure is pointer to the object. We create a
!          --  local variable of the proper type, duplicating what is done to
!          --  define _object later on.
  
           declare
              Decls : List_Id;
*************** package body Exp_Ch6 is
*** 3774,3782 ****
                  Unchecked_Convert_To (Obj_Ptr,
                    New_Occurrence_Of (Param, Loc)));
  
!             --  Analyze new actual. Other actuals in calls are already
!             --  analyzed and the list of actuals is not renalyzed after
!             --  rewriting.
  
              Set_Parent (Rec, N);
              Analyze (Rec);
--- 4043,4050 ----
                  Unchecked_Convert_To (Obj_Ptr,
                    New_Occurrence_Of (Param, Loc)));
  
!             --  Analyze new actual. Other actuals in calls are already analyzed
!             --  and the list of actuals is not renalyzed after rewriting.
  
              Set_Parent (Rec, N);
              Analyze (Rec);
*************** package body Exp_Ch6 is
*** 3852,3858 ****
     -----------------------
  
     procedure Freeze_Subprogram (N : Node_Id) is
!       E : constant Entity_Id := Entity (N);
  
     begin
        --  When a primitive is frozen, enter its name in the corresponding
--- 4120,4430 ----
     -----------------------
  
     procedure Freeze_Subprogram (N : Node_Id) is
!       Loc : constant Source_Ptr := Sloc (N);
!       E   : constant Entity_Id  := Entity (N);
! 
!       procedure Check_Overriding_Inherited_Interfaces (E : Entity_Id);
!       --  (Ada 2005): Check if the primitive E covers some interface already
!       --  implemented by some ancestor of the tagged-type associated with E.
! 
!       procedure Register_Interface_DT_Entry
!         (Prim                : Entity_Id;
!          Ancestor_Iface_Prim : Entity_Id := Empty);
!       --  (Ada 2005): Register an interface primitive in a secondary dispatch
!       --  table. If Prim overrides an ancestor primitive of its associated
!       --  tagged-type then Ancestor_Iface_Prim indicates the entity of that
!       --  immediate ancestor associated with the interface; otherwise Prim and
!       --  Ancestor_Iface_Prim have the same info.
! 
!       procedure Register_Predefined_DT_Entry (Prim : Entity_Id);
!       --  (Ada 2005): Register a predefined primitive in all the secondary
!       --  dispatch tables of its primitive type.
! 
!       -------------------------------------------
!       -- Check_Overriding_Inherited_Interfaces --
!       -------------------------------------------
! 
!       procedure Check_Overriding_Inherited_Interfaces (E : Entity_Id) is
!          Typ          : Entity_Id;
!          Elmt         : Elmt_Id;
!          Prim_Op      : Entity_Id;
!          Overriden_Op : Entity_Id := Empty;
! 
!       begin
!          if Ada_Version < Ada_05
!            or else not Is_Overriding_Operation (E)
!            or else Is_Predefined_Dispatching_Operation (E)
!            or else Present (Alias (E))
!          then
!             return;
!          end if;
! 
!          --  Get the entity associated with this primitive operation
! 
!          Typ := Scope (DTC_Entity (E));
!          loop
!             exit when Etype (Typ) = Typ
!               or else (Present (Full_View (Etype (Typ)))
!                          and then Full_View (Etype (Typ)) = Typ);
! 
!             --  Climb to the immediate ancestor handling private types
! 
!             if Present (Full_View (Etype (Typ))) then
!                Typ := Full_View (Etype (Typ));
!             else
!                Typ := Etype (Typ);
!             end if;
! 
!             if Present (Abstract_Interfaces (Typ)) then
! 
!                --  Look for the overriden subprogram in the primary dispatch
!                --  table of the ancestor.
! 
!                Overriden_Op := Empty;
!                Elmt         := First_Elmt (Primitive_Operations (Typ));
!                while Present (Elmt) loop
!                   Prim_Op := Node (Elmt);
! 
!                   if Chars (Prim_Op) = Chars (E)
!                     and then Type_Conformant
!                                (New_Id => Prim_Op,
!                                 Old_Id => E,
!                                 Skip_Controlling_Formals => True)
!                     and then DT_Position (Prim_Op) = DT_Position (E)
!                     and then Etype (DTC_Entity (Prim_Op)) = RTE (RE_Tag)
!                     and then not Present (Abstract_Interface_Alias (Prim_Op))
!                   then
!                      if Overriden_Op = Empty then
!                         Overriden_Op := Prim_Op;
! 
!                      --  Additional check to ensure that if two candidates have
!                      --  been found then they refer to the same subprogram.
! 
!                      else
!                         declare
!                            A1 : Entity_Id;
!                            A2 : Entity_Id;
! 
!                         begin
!                            A1 := Overriden_Op;
!                            while Present (Alias (A1)) loop
!                               A1 := Alias (A1);
!                            end loop;
! 
!                            A2 := Prim_Op;
!                            while Present (Alias (A2)) loop
!                               A2 := Alias (A2);
!                            end loop;
! 
!                            if A1 /= A2 then
!                               raise Program_Error;
!                            end if;
!                         end;
!                      end if;
!                   end if;
! 
!                   Next_Elmt (Elmt);
!                end loop;
! 
!                --  If not found this is the first overriding of some abstract
!                --  interface.
! 
!                if Overriden_Op /= Empty then
! 
!                   --  Find the entries associated with interfaces that are
!                   --  alias of this primitive operation in the ancestor.
! 
!                   Elmt := First_Elmt (Primitive_Operations (Typ));
!                   while Present (Elmt) loop
!                      Prim_Op := Node (Elmt);
! 
!                      if Present (Abstract_Interface_Alias (Prim_Op))
!                        and then Alias (Prim_Op) = Overriden_Op
!                      then
!                         Register_Interface_DT_Entry (E, Prim_Op);
!                      end if;
! 
!                      Next_Elmt (Elmt);
!                   end loop;
!                end if;
!             end if;
!          end loop;
!       end Check_Overriding_Inherited_Interfaces;
! 
!       ---------------------------------
!       -- Register_Interface_DT_Entry --
!       ---------------------------------
! 
!       procedure Register_Interface_DT_Entry
!         (Prim                : Entity_Id;
!          Ancestor_Iface_Prim : Entity_Id := Empty)
!       is
!          Prim_Typ     : Entity_Id;
!          Prim_Op      : Entity_Id;
!          Iface_Typ    : Entity_Id;
!          Iface_DT_Ptr : Entity_Id;
!          Iface_Tag    : Entity_Id;
!          New_Thunk    : Node_Id;
!          Thunk_Id     : Entity_Id;
! 
!       begin
!          if not Present (Ancestor_Iface_Prim) then
!             Prim_Typ  := Scope (DTC_Entity (Alias (Prim)));
!             Iface_Typ := Scope (DTC_Entity (Abstract_Interface_Alias (Prim)));
! 
!             --  Generate the code of the thunk only when this primitive
!             --  operation is associated with a secondary dispatch table.
! 
!             if Is_Interface (Iface_Typ) then
!                Iface_Tag := Find_Interface_Tag
!                               (T     => Prim_Typ,
!                                Iface => Iface_Typ);
! 
!                if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
!                   Thunk_Id  :=
!                     Make_Defining_Identifier (Loc,
!                       Chars => New_Internal_Name ('T'));
! 
!                   New_Thunk :=
!                     Expand_Interface_Thunk
!                       (N           => Prim,
!                        Thunk_Alias => Alias (Prim),
!                        Thunk_Id    => Thunk_Id,
!                        Thunk_Tag   => Iface_Tag);
! 
!                   Insert_After (N, New_Thunk);
! 
!                   Iface_DT_Ptr :=
!                     Find_Interface_ADT
!                       (T     => Prim_Typ,
!                        Iface => Iface_Typ);
! 
!                   Insert_After (New_Thunk,
!                     Fill_Secondary_DT_Entry (Sloc (Prim),
!                       Prim         => Prim,
!                       Iface_DT_Ptr => Iface_DT_Ptr,
!                       Thunk_Id     => Thunk_Id));
!                end if;
!             end if;
! 
!          else
!             Iface_Typ :=
!               Scope (DTC_Entity (Abstract_Interface_Alias
!                                   (Ancestor_Iface_Prim)));
! 
!             Iface_Tag :=
!               Find_Interface_Tag
!                 (T     => Scope (DTC_Entity (Alias (Ancestor_Iface_Prim))),
!                  Iface => Iface_Typ);
! 
!             --  Generate the thunk only if the associated tag is an interface
!             --  tag. The case in which the associated tag is the primary tag
!             --  occurs when a tagged type is a direct derivation of an
!             --  interface. For example:
! 
!             --    type I is interface;
!             --    ...
!             --    type T is new I with ...
! 
!             if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
!                Thunk_Id :=
!                  Make_Defining_Identifier (Loc,
!                    Chars => New_Internal_Name ('T'));
! 
!                if Present (Alias (Prim)) then
!                   Prim_Op := Alias (Prim);
!                else
!                   Prim_Op := Prim;
!                end if;
! 
!                New_Thunk :=
!                  Expand_Interface_Thunk
!                    (N           => Ancestor_Iface_Prim,
!                     Thunk_Alias => Prim_Op,
!                     Thunk_Id    => Thunk_Id,
!                     Thunk_Tag   => Iface_Tag);
! 
!                Insert_After (N, New_Thunk);
! 
!                Iface_DT_Ptr :=
!                  Find_Interface_ADT
!                    (T     => Scope (DTC_Entity (Prim_Op)),
!                     Iface => Iface_Typ);
! 
!                Insert_After (New_Thunk,
!                  Fill_Secondary_DT_Entry (Sloc (Prim),
!                    Prim         => Ancestor_Iface_Prim,
!                    Iface_DT_Ptr => Iface_DT_Ptr,
!                    Thunk_Id     => Thunk_Id));
!             end if;
!          end if;
!       end Register_Interface_DT_Entry;
! 
!       ----------------------------------
!       -- Register_Predefined_DT_Entry --
!       ----------------------------------
! 
!       procedure Register_Predefined_DT_Entry (Prim : Entity_Id) is
!          Iface_DT_Ptr : Elmt_Id;
!          Iface_Tag    : Entity_Id;
!          Iface_Typ    : Elmt_Id;
!          New_Thunk    : Entity_Id;
!          Prim_Typ     : Entity_Id;
!          Thunk_Id     : Entity_Id;
! 
!       begin
!          Prim_Typ := Scope (DTC_Entity (Prim));
! 
!          if not Present (Access_Disp_Table (Prim_Typ))
!            or else not Present (Abstract_Interfaces (Prim_Typ))
!          then
!             return;
!          end if;
! 
!          --  Skip the first acces-to-dispatch-table pointer since it leads
!          --  to the primary dispatch table. We are only concerned with the
!          --  secondary dispatch table pointers. Note that the access-to-
!          --  dispatch-table pointer corresponds to the first implemented
!          --  interface retrieved below.
! 
!          Iface_DT_Ptr := Next_Elmt (First_Elmt (Access_Disp_Table (Prim_Typ)));
!          Iface_Typ := First_Elmt (Abstract_Interfaces (Prim_Typ));
!          while Present (Iface_DT_Ptr) and then Present (Iface_Typ) loop
!             Iface_Tag := Find_Interface_Tag (Prim_Typ, Node (Iface_Typ));
!             pragma Assert (Present (Iface_Tag));
! 
!             if Etype (Iface_Tag) = RTE (RE_Interface_Tag) then
!                Thunk_Id := Make_Defining_Identifier (Loc,
!                              New_Internal_Name ('T'));
! 
!                New_Thunk :=
!                  Expand_Interface_Thunk
!                   (N           => Prim,
!                    Thunk_Alias => Prim,
!                    Thunk_Id    => Thunk_Id,
!                    Thunk_Tag   => Iface_Tag);
! 
!                Insert_After (N, New_Thunk);
!                Insert_After (New_Thunk,
!                  Make_DT_Access_Action (Node (Iface_Typ),
!                    Action => Set_Prim_Op_Address,
!                    Args   => New_List (
!                      Unchecked_Convert_To (RTE (RE_Tag),
!                        New_Reference_To (Node (Iface_DT_Ptr), Loc)),
! 
!                      Make_Integer_Literal (Loc, DT_Position (Prim)),
! 
!                      Make_Attribute_Reference (Loc,
!                        Prefix         => New_Reference_To (Thunk_Id, Loc),
!                        Attribute_Name => Name_Address))));
!             end if;
! 
!             Next_Elmt (Iface_DT_Ptr);
!             Next_Elmt (Iface_Typ);
!          end loop;
!       end Register_Predefined_DT_Entry;
! 
!    --  Start of processing for Freeze_Subprogram
  
     begin
        --  When a primitive is frozen, enter its name in the corresponding
*************** package body Exp_Ch6 is
*** 3864,3879 ****
        if Is_Dispatching_Operation (E)
          and then not Is_Abstract (E)
          and then Present (DTC_Entity (E))
-         and then not Is_CPP_Class (Scope (DTC_Entity (E)))
          and then not Java_VM
        then
           Check_Overriding_Operation (E);
!          Insert_After (N, Fill_DT_Entry (Sloc (N), E));
        end if;
  
        --  Mark functions that return by reference. Note that it cannot be
        --  part of the normal semantic analysis of the spec since the
!       --  underlying returned type may not be known yet (for private types)
  
        declare
           Typ  : constant Entity_Id := Etype (E);
--- 4436,4489 ----
        if Is_Dispatching_Operation (E)
          and then not Is_Abstract (E)
          and then Present (DTC_Entity (E))
          and then not Java_VM
+         and then not Is_CPP_Class (Scope (DTC_Entity (E)))
        then
           Check_Overriding_Operation (E);
! 
!          if Ada_Version < Ada_05 then
!             Insert_After (N,
!               Fill_DT_Entry (Sloc (N), Prim => E));
! 
!          else
!             declare
!                Typ : constant Entity_Id := Scope (DTC_Entity (E));
! 
!             begin
!                --  There is no dispatch table associated with abstract
!                --  interface types; each type implementing interfaces
!                --  will fill the associated secondary DT entries.
! 
!                if not Is_Interface (Typ)
!                  or else Present (Alias (E))
!                then
!                   --  Ada 2005 (AI-251): Check if this entry corresponds with
!                   --  a subprogram that covers an abstract interface type.
! 
!                   if Present (Abstract_Interface_Alias (E)) then
!                      Register_Interface_DT_Entry (E);
! 
!                   --  Common case: Primitive subprogram
! 
!                   else
!                      --  Generate thunks for all the predefined operations
! 
!                      if Is_Predefined_Dispatching_Operation (E) then
!                         Register_Predefined_DT_Entry (E);
!                      end if;
! 
!                      Insert_After (N,
!                        Fill_DT_Entry (Sloc (N), Prim => E));
!                      Check_Overriding_Inherited_Interfaces (E);
!                   end if;
!                end if;
!             end;
!          end if;
        end if;
  
        --  Mark functions that return by reference. Note that it cannot be
        --  part of the normal semantic analysis of the spec since the
!       --  underlying returned type may not be known yet (for private types).
  
        declare
           Typ  : constant Entity_Id := Etype (E);
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch6.ads gcc-4.1.0/gcc/ada/exp_ch6.ads
*** gcc-4.0.2/gcc/ada/exp_ch6.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch6.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch7.adb gcc-4.1.0/gcc/ada/exp_ch7.adb
*** gcc-4.0.2/gcc/ada/exp_ch7.adb	Wed Dec  8 11:45:51 2004
--- gcc-4.1.0/gcc/ada/exp_ch7.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Ch7 is
*** 291,297 ****
     --      controller but this would not tackle view conversions properly.
     --    - A classwide type can always potentially have controlled components
     --      but the record controller of the corresponding actual type may not
!    --      be nown at compile time so the dispatch table contains a special
     --      field that allows to compute the offset of the record controller
     --      dynamically. See s-finimp.Deep_Tag_Attach and a-tags.RC_Offset
  
--- 291,297 ----
     --      controller but this would not tackle view conversions properly.
     --    - A classwide type can always potentially have controlled components
     --      but the record controller of the corresponding actual type may not
!    --      be known at compile time so the dispatch table contains a special
     --      field that allows to compute the offset of the record controller
     --      dynamically. See s-finimp.Deep_Tag_Attach and a-tags.RC_Offset
  
*************** package body Exp_Ch7 is
*** 984,990 ****
          and then Present (Atyp)
          and then
            (Is_Private_Type (Ftyp) or else Is_Private_Type (Atyp))
!         and then Underlying_Type (Atyp) = Underlying_Type (Ftyp)
        then
           return Unchecked_Convert_To (Ftyp, Arg);
  
--- 984,992 ----
          and then Present (Atyp)
          and then
            (Is_Private_Type (Ftyp) or else Is_Private_Type (Atyp))
!         and then
!            Base_Type (Underlying_Type (Atyp)) =
!              Base_Type (Underlying_Type (Ftyp))
        then
           return Unchecked_Convert_To (Ftyp, Arg);
  
*************** package body Exp_Ch7 is
*** 1558,1576 ****
        end if;
  
        Set_Elaboration_Flag (N, Corresponding_Spec (N));
- 
-       --  Generate a subprogram descriptor for the elaboration routine of
-       --  a package body if the package body has no pending instantiations
-       --  and it has generated at least one exception handler
- 
-       if Present (Handler_Records (Body_Entity (Ent)))
-         and then Is_Compilation_Unit (Ent)
-         and then not Delay_Subprogram_Descriptors (Body_Entity (Ent))
-       then
-          Generate_Subprogram_Descriptor_For_Package
-            (N, Body_Entity (Ent));
-       end if;
- 
        Set_In_Package_Body (Ent, False);
  
        --  Set to encode entity names in package body before gigi is called
--- 1560,1565 ----
*************** package body Exp_Ch7 is
*** 1756,1762 ****
                   N_Procedure_Call_Statement =>
                 if Nkind (Parent (The_Parent)) = N_Entry_Call_Alternative
                   and then
!                    Nkind (Parent (Parent (The_Parent))) = N_Timed_Entry_Call
                 then
                    return Parent (Parent (The_Parent));
                 else
--- 1745,1755 ----
                   N_Procedure_Call_Statement =>
                 if Nkind (Parent (The_Parent)) = N_Entry_Call_Alternative
                   and then
!                    (Nkind (Parent (Parent (The_Parent)))
!                      = N_Timed_Entry_Call
!                    or else
!                      Nkind (Parent (Parent (The_Parent)))
!                        = N_Conditional_Entry_Call)
                 then
                    return Parent (Parent (The_Parent));
                 else
*************** package body Exp_Ch7 is
*** 1800,1805 ****
--- 1793,1805 ----
                    return The_Parent;
                 end if;
  
+             --  A raise statement can be wrapped. This will arise when the
+             --  expression in a raise_with_expression uses the secondary
+             --  stack, for example.
+ 
+             when N_Raise_Statement  =>
+                return The_Parent;
+ 
              --  If the expression is within the iteration scheme of a loop,
              --  we must create a declaration for it, followed by an assignment
              --  in order to have a usable statement to wrap.
*************** package body Exp_Ch7 is
*** 2139,2145 ****
  
           --  Add statements to the cleanup handler of the (ordinary)
           --  subprogram expanded to implement a protected subprogram,
!          --  unlocking the protected object parameter and undeferring abortion.
           --  If this is a protected procedure, and the object contains
           --  entries, this also calls the entry service routine.
  
--- 2139,2145 ----
  
           --  Add statements to the cleanup handler of the (ordinary)
           --  subprogram expanded to implement a protected subprogram,
!          --  unlocking the protected object parameter and undeferring abort.
           --  If this is a protected procedure, and the object contains
           --  entries, this also calls the entry service routine.
  
*************** package body Exp_Ch7 is
*** 2214,2219 ****
--- 2214,2221 ----
                or else Has_Interrupt_Handler (Pid)
                or else (Has_Attach_Handler (Pid)
                           and then not Restricted_Profile)
+               or else (Ada_Version >= Ada_05
+                          and then Present (Interface_List (Parent (Pid))))
              then
                 if Abort_Allowed
                   or else Restriction_Active (No_Entry_Queue) = False
*************** package body Exp_Ch7 is
*** 2733,2745 ****
        Utyp := Underlying_Type (Base_Type (Utyp));
        Set_Assignment_OK (Cref);
  
!       --  Deal with non-tagged derivation of private views
  
        if Is_Untagged_Derivation (Typ) then
!          Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
           Cref := Unchecked_Convert_To (Utyp, Cref);
           Set_Assignment_OK (Cref);
-          --  To prevent problems with UC see 1.156 RH ???
        end if;
  
        --  If the underlying_type is a subtype, we are dealing with
--- 2735,2761 ----
        Utyp := Underlying_Type (Base_Type (Utyp));
        Set_Assignment_OK (Cref);
  
!       --  Deal with non-tagged derivation of private views. If the parent is
!       --  now known to be protected, the finalization routine is the one
!       --  defined on the corresponding record of the ancestor (corresponding
!       --  records do not automatically inherit operations, but maybe they
!       --  should???)
  
        if Is_Untagged_Derivation (Typ) then
!          if Is_Protected_Type (Typ) then
!             Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
!          else
!             Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
!          end if;
! 
           Cref := Unchecked_Convert_To (Utyp, Cref);
+ 
+          --  We need to set Assignment_OK to prevent problems with unchecked
+          --  conversions, where we do not want them to be converted back in the
+          --  case of untagged record derivation (see code in Make_*_Call
+          --  procedures for similar situations).
+ 
           Set_Assignment_OK (Cref);
        end if;
  
        --  If the underlying_type is a subtype, we are dealing with
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch7.ads gcc-4.1.0/gcc/ada/exp_ch7.ads
*** gcc-4.0.2/gcc/ada/exp_ch7.ads	Mon Jan  3 15:38:00 2005
--- gcc-4.1.0/gcc/ada/exp_ch7.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Exp_Ch7 is
*** 164,170 ****
     function Cleanup_Protected_Object
       (N   : Node_Id;
        Ref : Node_Id) return Node_Id;
!    --  Generate code to finalize a protected object without entries.
  
     function Cleanup_Record
       (N   : Node_Id;
--- 164,170 ----
     function Cleanup_Protected_Object
       (N   : Node_Id;
        Ref : Node_Id) return Node_Id;
!    --  Generate code to finalize a protected object without entries
  
     function Cleanup_Record
       (N   : Node_Id;
*************** package Exp_Ch7 is
*** 176,185 ****
     function Cleanup_Task
       (N   : Node_Id;
        Ref : Node_Id) return Node_Id;
!    --  Generate code to finalize a task.
  
     function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
!    --  Check whether composite type contains a simple protected component.
  
     function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
     --  Check whether argument is a protected type without entries.
--- 176,185 ----
     function Cleanup_Task
       (N   : Node_Id;
        Ref : Node_Id) return Node_Id;
!    --  Generate code to finalize a task
  
     function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
!    --  Check whether composite type contains a simple protected component
  
     function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
     --  Check whether argument is a protected type without entries.
*************** package Exp_Ch7 is
*** 203,209 ****
     --  secondary stack is brought in, otherwise it isn't.
  
     function Node_To_Be_Wrapped return Node_Id;
!    --  return the node to be wrapped if the current scope is transient.
  
     procedure Store_Before_Actions_In_Scope (L : List_Id);
     --  Append the list L of actions to the end of the before-actions store
--- 203,209 ----
     --  secondary stack is brought in, otherwise it isn't.
  
     function Node_To_Be_Wrapped return Node_Id;
!    --  return the node to be wrapped if the current scope is transient
  
     procedure Store_Before_Actions_In_Scope (L : List_Id);
     --  Append the list L of actions to the end of the before-actions store
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch8.adb gcc-4.1.0/gcc/ada/exp_ch8.adb
*** gcc-4.0.2/gcc/ada/exp_ch8.adb	Wed Dec  8 11:49:37 2004
--- gcc-4.1.0/gcc/ada/exp_ch8.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch8.ads gcc-4.1.0/gcc/ada/exp_ch8.ads
*** gcc-4.0.2/gcc/ada/exp_ch8.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_ch8.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch9.adb gcc-4.1.0/gcc/ada/exp_ch9.adb
*** gcc-4.0.2/gcc/ada/exp_ch9.adb	Wed Dec  8 11:49:38 2004
--- gcc-4.1.0/gcc/ada/exp_ch9.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Restrict; use Restrict;
*** 46,52 ****
  with Rident;   use Rident;
  with Rtsfind;  use Rtsfind;
  with Sem;      use Sem;
! with Sem_Ch6;
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Ch11; use Sem_Ch11;
  with Sem_Elab; use Sem_Elab;
--- 46,52 ----
  with Rident;   use Rident;
  with Rtsfind;  use Rtsfind;
  with Sem;      use Sem;
! with Sem_Ch6;  use Sem_Ch6;
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Ch11; use Sem_Ch11;
  with Sem_Elab; use Sem_Elab;
*************** with Snames;   use Snames;
*** 57,67 ****
  with Stand;    use Stand;
  with Targparm; use Targparm;
  with Tbuild;   use Tbuild;
- with Types;    use Types;
  with Uintp;    use Uintp;
  
  package body Exp_Ch9 is
  
     -----------------------
     -- Local Subprograms --
     -----------------------
--- 57,306 ----
  with Stand;    use Stand;
  with Targparm; use Targparm;
  with Tbuild;   use Tbuild;
  with Uintp;    use Uintp;
  
  package body Exp_Ch9 is
  
+    --------------------------------
+    -- Select_Expansion_Utilities --
+    --------------------------------
+ 
+    --  The following constant establishes the upper bound for the index of
+    --  an entry family. It is used to limit the allocated size of protected
+    --  types with defaulted discriminant of an integer type, when the bound
+    --  of some entry family depends on a discriminant. The limitation to
+    --  entry families of 128K should be reasonable in all cases, and is a
+    --  documented implementation restriction. It will be lifted when protected
+    --  entry families are re-implemented as a single ordered queue.
+ 
+    Entry_Family_Bound : constant Int := 2**16;
+ 
+    --  The following package contains helper routines used in the expansion of
+    --  dispatching asynchronous, conditional and timed selects.
+ 
+    package Select_Expansion_Utilities is
+       function Build_Abort_Block
+         (Loc         : Source_Ptr;
+          Abr_Blk_Ent : Entity_Id;
+          Cln_Blk_Ent : Entity_Id;
+          Blk         : Node_Id) return Node_Id;
+       --  Generate:
+       --    begin
+       --       Blk
+       --    exception
+       --       when Abort_Signal => Abort_Undefer;
+       --    end;
+       --  Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is
+       --  the name of the encapsulated cleanup block, Blk is the actual
+       --  block node.
+ 
+       function Build_B
+         (Loc   : Source_Ptr;
+          Decls : List_Id) return Entity_Id;
+       --  Generate:
+       --    B : Boolean := False;
+       --  Append the object declaration to the list and return the name of
+       --  the object.
+ 
+       function Build_C
+         (Loc   : Source_Ptr;
+          Decls : List_Id) return Entity_Id;
+       --  Generate:
+       --    C : Ada.Tags.Prim_Op_Kind;
+       --  Append the object declaration to the list and return the name of
+       --  the object.
+ 
+       function Build_Cleanup_Block
+         (Loc       : Source_Ptr;
+          Blk_Ent   : Entity_Id;
+          Stmts     : List_Id;
+          Clean_Ent : Entity_Id) return Node_Id;
+       --  Generate:
+       --    declare
+       --       procedure _clean is
+       --       begin
+       --          ...
+       --       end _clean;
+       --    begin
+       --       Stmts
+       --    at end
+       --       _clean;
+       --    end;
+       --  Blk_Ent is the name of the generated block, Stmts is the list
+       --  of encapsulated statements and Clean_Ent is the parameter to
+       --  the _clean procedure.
+ 
+       function Build_S
+         (Loc      : Source_Ptr;
+          Decls    : List_Id;
+          Obj      : Entity_Id;
+          Call_Ent : Entity_Id) return Entity_Id;
+       --  Generate:
+       --    S : constant Integer :=
+       --          Ada.Tags.Get_Offset_Index (
+       --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+       --            DT_Position (Call_Ent));
+       --  where Obj is the pointer to a secondary table, Call_Ent is the
+       --  entity of the dispatching call name. Append the object declaration
+       --  to the list and return its defining identifier.
+ 
+    end Select_Expansion_Utilities;
+ 
+    -----------------------------------------
+    -- Body for Select_Expansion_Utilities --
+    -----------------------------------------
+ 
+    package body Select_Expansion_Utilities is
+ 
+       -----------------------
+       -- Build_Abort_Block --
+       -----------------------
+ 
+       function Build_Abort_Block
+         (Loc         : Source_Ptr;
+          Abr_Blk_Ent : Entity_Id;
+          Cln_Blk_Ent : Entity_Id;
+          Blk         : Node_Id) return Node_Id
+       is
+       begin
+          return
+            Make_Block_Statement (Loc,
+              Identifier   => New_Reference_To (Abr_Blk_Ent, Loc),
+ 
+              Declarations => No_List,
+ 
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  Statements =>
+                    New_List (
+                      Make_Implicit_Label_Declaration (Loc,
+                        Defining_Identifier =>
+                          Cln_Blk_Ent,
+                        Label_Construct =>
+                          Blk),
+                      Blk),
+ 
+                  Exception_Handlers =>
+                    New_List (
+                      Make_Exception_Handler (Loc,
+                        Exception_Choices =>
+                          New_List (
+                            New_Reference_To (Stand.Abort_Signal, Loc)),
+                        Statements =>
+                          New_List (
+                            Make_Procedure_Call_Statement (Loc,
+                              Name =>
+                                New_Reference_To (RTE (
+                                  RE_Abort_Undefer), Loc),
+                              Parameter_Associations => No_List))))));
+       end Build_Abort_Block;
+ 
+       -------------
+       -- Build_B --
+       -------------
+ 
+       function Build_B
+         (Loc   : Source_Ptr;
+          Decls : List_Id) return Entity_Id
+       is
+          B : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                      Chars => New_Internal_Name ('B'));
+ 
+       begin
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                B,
+              Object_Definition =>
+                New_Reference_To (Standard_Boolean, Loc),
+              Expression =>
+                New_Reference_To (Standard_False, Loc)));
+ 
+          return B;
+       end Build_B;
+ 
+       -------------
+       -- Build_C --
+       -------------
+ 
+       function Build_C
+         (Loc   : Source_Ptr;
+          Decls : List_Id) return Entity_Id
+       is
+          C : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                      Chars => New_Internal_Name ('C'));
+ 
+       begin
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                C,
+              Object_Definition =>
+                New_Reference_To (RTE (RE_Prim_Op_Kind), Loc)));
+ 
+          return C;
+       end Build_C;
+ 
+       -------------------------
+       -- Build_Cleanup_Block --
+       -------------------------
+ 
+       function Build_Cleanup_Block
+         (Loc       : Source_Ptr;
+          Blk_Ent   : Entity_Id;
+          Stmts     : List_Id;
+          Clean_Ent : Entity_Id) return Node_Id
+       is
+          Cleanup_Block : constant Node_Id :=
+                            Make_Block_Statement (Loc,
+                              Identifier   => New_Reference_To (Blk_Ent, Loc),
+                              Declarations => No_List,
+                              Handled_Statement_Sequence =>
+                                Make_Handled_Sequence_Of_Statements (Loc,
+                                  Statements => Stmts),
+                              Is_Asynchronous_Call_Block => True);
+ 
+       begin
+          Set_Entry_Cancel_Parameter (Blk_Ent, Clean_Ent);
+ 
+          return Cleanup_Block;
+       end Build_Cleanup_Block;
+ 
+       -------------
+       -- Build_S --
+       -------------
+ 
+       function Build_S
+         (Loc      : Source_Ptr;
+          Decls    : List_Id;
+          Obj      : Entity_Id;
+          Call_Ent : Entity_Id) return Entity_Id
+       is
+          S : constant Entity_Id := Make_Defining_Identifier (Loc,
+                                      Chars => New_Internal_Name ('S'));
+ 
+       begin
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier => S,
+              Constant_Present    => True,
+ 
+              Object_Definition   =>
+                New_Reference_To (Standard_Integer, Loc),
+ 
+              Expression          =>
+                Make_Function_Call (Loc,
+                  Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
+                  Parameter_Associations => New_List (
+                    Unchecked_Convert_To (RTE (RE_Interface_Tag), Obj),
+                    Make_Integer_Literal (Loc, DT_Position (Call_Ent))))));
+ 
+          return S;
+       end Build_S;
+    end Select_Expansion_Utilities;
+ 
+    package SEU renames Select_Expansion_Utilities;
+ 
     -----------------------
     -- Local Subprograms --
     -----------------------
*************** package body Exp_Ch9 is
*** 76,92 ****
     --  the expression computed by this function uses the discriminants
     --  of the target task.
  
-    function Index_Constant_Declaration
-      (N        : Node_Id;
-       Index_Id : Entity_Id;
-       Prot     : Entity_Id) return List_Id;
-    --  For an entry family and its barrier function, we define a local entity
-    --  that maps the index in the call into the entry index into the object:
-    --
-    --     I : constant Index_Type := Index_Type'Val (
-    --       E - <<index of first family member>> +
-    --       Protected_Entry_Index (Index_Type'Pos (Index_Type'First)));
- 
     procedure Add_Object_Pointer
       (Decls : List_Id;
        Pid   : Entity_Id;
--- 315,320 ----
*************** package body Exp_Ch9 is
*** 96,102 ****
     --  of the System.Address pointer passed to entry barrier functions
     --  and entry body procedures.
  
!    function Build_Accept_Body (Astat : Node_Id) return  Node_Id;
     --  Transform accept statement into a block with added exception handler.
     --  Used both for simple accept statements and for accept alternatives in
     --  select statements. Astat is the accept statement.
--- 324,342 ----
     --  of the System.Address pointer passed to entry barrier functions
     --  and entry body procedures.
  
!    procedure Add_Formal_Renamings
!      (Spec  : Node_Id;
!       Decls : List_Id;
!       Ent   : Entity_Id;
!       Loc   : Source_Ptr);
!    --  Create renaming declarations for the formals, inside the procedure
!    --  that implements an entry body. The renamings make the original names
!    --  of the formals accessible to gdb, and serve no other purpose.
!    --    Spec is the specification of the procedure being built.
!    --    Decls is the list of declarations to be enhanced.
!    --    Ent is the entity for the original entry body.
! 
!    function Build_Accept_Body (Astat : Node_Id) return Node_Id;
     --  Transform accept statement into a block with added exception handler.
     --  Used both for simple accept statements and for accept alternatives in
     --  select statements. Astat is the accept statement.
*************** package body Exp_Ch9 is
*** 131,136 ****
--- 371,417 ----
     --  of the range of each entry family. A single array with that size is
     --  allocated for each concurrent object of the type.
  
+    function Build_Parameter_Block
+      (Loc     : Source_Ptr;
+       Actuals : List_Id;
+       Formals : List_Id;
+       Decls   : List_Id) return Entity_Id;
+    --  Generate an access type for each actual parameter in the list Actuals.
+    --  Cleate an encapsulating record that contains all the actuals and return
+    --  its type. Generate:
+    --    type Ann1 is access all <actual1-type>
+    --    ...
+    --    type AnnN is access all <actualN-type>
+    --    type Pnn is record
+    --       <formal1> : Ann1;
+    --       ...
+    --       <formalN> : AnnN;
+    --    end record;
+ 
+    function Build_Wrapper_Body
+      (Loc      : Source_Ptr;
+       Proc_Nam : Entity_Id;
+       Obj_Typ  : Entity_Id;
+       Formals  : List_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Build the body that wraps a primitive operation
+    --  associated with a protected or task type. This is required to implement
+    --  dispatching calls through interfaces. Proc_Nam is the entry name to be
+    --  wrapped, Obj_Typ is the type of the newly added formal parameter to
+    --  handle object notation, Formals are the original entry formals that will
+    --  be explicitly replicated.
+ 
+    function Build_Wrapper_Spec
+      (Loc      : Source_Ptr;
+       Proc_Nam : Entity_Id;
+       Obj_Typ  : Entity_Id;
+       Formals  : List_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Build the specification of a primitive operation
+    --  associated with a protected or task type. This is required implement
+    --  dispatching calls through interfaces. Proc_Nam is the entry name to be
+    --  wrapped, Obj_Typ is the type of the newly added formal parameter to
+    --  handle object notation, Formals are the original entry formals that will
+    --  be explicitly replicated.
+ 
     function Build_Find_Body_Index (Typ : Entity_Id) return Node_Id;
     --  Build the function that translates the entry index in the call
     --  (which depends on the size of entry families) into an index into the
*************** package body Exp_Ch9 is
*** 162,168 ****
        Pid       : Node_Id;
        N_Op_Spec : Node_Id) return Node_Id;
     --  This function is used to construct the protected version of a protected
!    --  subprogram. Its statement sequence first defers abortion, then locks
     --  the associated protected object, and then enters a block that contains
     --  a call to the unprotected version of the subprogram (for details, see
     --  Build_Unprotected_Subprogram_Body). This block statement requires
--- 443,449 ----
        Pid       : Node_Id;
        N_Op_Spec : Node_Id) return Node_Id;
     --  This function is used to construct the protected version of a protected
!    --  subprogram. Its statement sequence first defers abort, then locks
     --  the associated protected object, and then enters a block that contains
     --  a call to the unprotected version of the subprogram (for details, see
     --  Build_Unprotected_Subprogram_Body). This block statement requires
*************** package body Exp_Ch9 is
*** 183,190 ****
     --  The object is a limited record and therefore a by_reference type.
  
     function Build_Selected_Name
!      (Prefix, Selector : Name_Id;
!       Append_Char      : Character := ' ') return Name_Id;
     --  Build a name in the form of Prefix__Selector, with an optional
     --  character appended. This is used for internal subprograms generated
     --  for operations of protected types, including barrier functions.
--- 464,472 ----
     --  The object is a limited record and therefore a by_reference type.
  
     function Build_Selected_Name
!      (Prefix      : Entity_Id;
!       Selector    : Entity_Id;
!       Append_Char : Character := ' ') return Name_Id;
     --  Build a name in the form of Prefix__Selector, with an optional
     --  character appended. This is used for internal subprograms generated
     --  for operations of protected types, including barrier functions.
*************** package body Exp_Ch9 is
*** 248,253 ****
--- 530,545 ----
     --  to the use of 'Length on the index type, but must use Family_Offset
     --  to handle properly the case of bounds that depend on discriminants.
  
+    procedure Extract_Dispatching_Call
+      (N        : Node_Id;
+       Call_Ent : out Entity_Id;
+       Object   : out Entity_Id;
+       Actuals  : out List_Id;
+       Formals  : out List_Id);
+    --  Given a dispatching call, extract the entity of the name of the call,
+    --  its object parameter, its actual parameters and the formal parameters
+    --  of the overriden interface-level version.
+ 
     procedure Extract_Entry
       (N       : Node_Id;
        Concval : out Node_Id;
*************** package body Exp_Ch9 is
*** 265,270 ****
--- 557,604 ----
     --  when P is Name_uPriority, the call will also find Interrupt_Priority.
     --  ??? Should be implemented with the rep item chain mechanism.
  
+    function Index_Constant_Declaration
+      (N        : Node_Id;
+       Index_Id : Entity_Id;
+       Prot     : Entity_Id) return List_Id;
+    --  For an entry family and its barrier function, we define a local entity
+    --  that maps the index in the call into the entry index into the object:
+    --
+    --     I : constant Index_Type := Index_Type'Val (
+    --       E - <<index of first family member>> +
+    --       Protected_Entry_Index (Index_Type'Pos (Index_Type'First)));
+ 
+    function Parameter_Block_Pack
+      (Loc     : Source_Ptr;
+       Blk_Typ : Entity_Id;
+       Actuals : List_Id;
+       Formals : List_Id;
+       Decls   : List_Id;
+       Stmts   : List_Id) return Entity_Id;
+    --  Set the components of the generated parameter block with the values of
+    --  the actual parameters. Generate aliased temporaries to capture the
+    --  values for types that are passed by copy. Otherwise generate a reference
+    --  to the actual's value. Return the address of the aggregate block.
+    --  Generate:
+    --    Jnn1 : alias <formal-type1>;
+    --    Jnn1 := <actual1>;
+    --    ...
+    --    P : Blk_Typ := (
+    --      Jnn1'unchecked_access;
+    --      <actual2>'reference;
+    --      ...);
+ 
+    function Parameter_Block_Unpack
+      (Loc     : Source_Ptr;
+       P       : Entity_Id;
+       Actuals : List_Id;
+       Formals : List_Id) return List_Id;
+    --  Retrieve the values of the components from the parameter block and
+    --  assign then to the original actual parameters. Generate:
+    --    <actual1> := P.<formal1>;
+    --    ...
+    --    <actualN> := P.<formalN>;
+ 
     procedure Update_Prival_Subtypes (N : Node_Id);
     --  The actual subtypes of the privals will differ from the type of the
     --  private declaration in the original protected type, if the protected
*************** package body Exp_Ch9 is
*** 464,469 ****
--- 798,804 ----
        Pid   : Entity_Id;
        Loc   : Source_Ptr)
     is
+       Decl    : Node_Id;
        Obj_Ptr : Node_Id;
  
     begin
*************** package body Exp_Ch9 is
*** 481,494 ****
              New_External_Name
                (Chars (Corresponding_Record_Type (Pid)), 'P'));
  
!       Prepend_To (Decls,
          Make_Object_Declaration (Loc,
            Defining_Identifier =>
              Make_Defining_Identifier (Loc, Name_uObject),
            Object_Definition => New_Reference_To (Obj_Ptr, Loc),
            Expression =>
              Unchecked_Convert_To (Obj_Ptr,
!               Make_Identifier (Loc, Name_uO))));
  
        Prepend_To (Decls,
          Make_Full_Type_Declaration (Loc,
--- 816,831 ----
              New_External_Name
                (Chars (Corresponding_Record_Type (Pid)), 'P'));
  
!       Decl :=
          Make_Object_Declaration (Loc,
            Defining_Identifier =>
              Make_Defining_Identifier (Loc, Name_uObject),
            Object_Definition => New_Reference_To (Obj_Ptr, Loc),
            Expression =>
              Unchecked_Convert_To (Obj_Ptr,
!               Make_Identifier (Loc, Name_uO)));
!       Set_Needs_Debug_Info (Defining_Identifier (Decl));
!       Prepend_To (Decls, Decl);
  
        Prepend_To (Decls,
          Make_Full_Type_Declaration (Loc,
*************** package body Exp_Ch9 is
*** 498,503 ****
--- 835,899 ----
                New_Reference_To (Corresponding_Record_Type (Pid), Loc))));
     end Add_Object_Pointer;
  
+    --------------------------
+    -- Add_Formal_Renamings --
+    --------------------------
+ 
+    procedure Add_Formal_Renamings
+      (Spec  : Node_Id;
+       Decls : List_Id;
+       Ent   : Entity_Id;
+       Loc   : Source_Ptr)
+    is
+       Ptr : constant Entity_Id :=
+               Defining_Identifier
+                 (Next (First (Parameter_Specifications (Spec))));
+       --  The name of the formal that holds the address of the parameter block
+       --  for the call.
+ 
+       Comp   : Entity_Id;
+       Decl   : Node_Id;
+       Formal : Entity_Id;
+       New_F  : Entity_Id;
+ 
+    begin
+       Formal := First_Formal (Ent);
+       while Present (Formal) loop
+          Comp   := Entry_Component (Formal);
+          New_F  :=
+            Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
+          Set_Etype (New_F, Etype (Formal));
+          Set_Scope (New_F, Ent);
+          Set_Needs_Debug_Info (New_F);   --  That's the whole point.
+ 
+          if Ekind (Formal) = E_In_Parameter then
+             Set_Ekind (New_F, E_Constant);
+          else
+             Set_Ekind (New_F, E_Variable);
+             Set_Extra_Constrained (New_F, Extra_Constrained (Formal));
+          end if;
+ 
+          Set_Actual_Subtype (New_F, Actual_Subtype (Formal));
+ 
+          Decl :=
+            Make_Object_Renaming_Declaration (Loc,
+            Defining_Identifier => New_F,
+            Subtype_Mark => New_Reference_To (Etype (Formal), Loc),
+            Name =>
+              Make_Explicit_Dereference (Loc,
+                Make_Selected_Component (Loc,
+                  Prefix =>
+                    Unchecked_Convert_To (Entry_Parameters_Type (Ent),
+                      Make_Identifier (Loc, Chars (Ptr))),
+                  Selector_Name =>
+                    New_Reference_To (Comp, Loc))));
+ 
+          Append (Decl, Decls);
+          Set_Renamed_Object (Formal, New_F);
+          Next_Formal (Formal);
+       end loop;
+    end Add_Formal_Renamings;
+ 
     ------------------------------
     -- Add_Private_Declarations --
     ------------------------------
*************** package body Exp_Ch9 is
*** 509,514 ****
--- 905,911 ----
        Loc   : Source_Ptr)
     is
        Def      : constant Node_Id   := Protected_Definition (Parent (Typ));
+       Decl     : Node_Id;
        Body_Ent : constant Entity_Id := Corresponding_Body   (Parent (Typ));
        P        : Node_Id;
        Pdef     : Entity_Id;
*************** package body Exp_Ch9 is
*** 518,545 ****
  
        if Present (Private_Declarations (Def)) then
           P := First (Private_Declarations (Def));
- 
           while Present (P) loop
              if Nkind (P) = N_Component_Declaration then
                 Pdef := Defining_Identifier (P);
!                Prepend_To (Decls,
                   Make_Object_Renaming_Declaration (Loc,
                     Defining_Identifier => Prival (Pdef),
                     Subtype_Mark => New_Reference_To (Etype (Pdef), Loc),
                     Name =>
                       Make_Selected_Component (Loc,
                         Prefix        => Make_Identifier (Loc, Name),
!                        Selector_Name => Make_Identifier (Loc, Chars (Pdef)))));
              end if;
              Next (P);
           end loop;
        end if;
  
!       --  One more "prival" for the object itself, with the right protection
!       --  type.
  
        declare
           Protection_Type : RE_Id;
        begin
           if Has_Attach_Handler (Typ) then
              if Restricted_Profile then
--- 915,944 ----
  
        if Present (Private_Declarations (Def)) then
           P := First (Private_Declarations (Def));
           while Present (P) loop
              if Nkind (P) = N_Component_Declaration then
                 Pdef := Defining_Identifier (P);
!                Decl :=
                   Make_Object_Renaming_Declaration (Loc,
                     Defining_Identifier => Prival (Pdef),
                     Subtype_Mark => New_Reference_To (Etype (Pdef), Loc),
                     Name =>
                       Make_Selected_Component (Loc,
                         Prefix        => Make_Identifier (Loc, Name),
!                        Selector_Name => Make_Identifier (Loc, Chars (Pdef))));
!                Set_Needs_Debug_Info (Defining_Identifier (Decl));
!                Prepend_To (Decls, Decl);
              end if;
+ 
              Next (P);
           end loop;
        end if;
  
!       --  One more "prival" for object itself, with the right protection type
  
        declare
           Protection_Type : RE_Id;
+ 
        begin
           if Has_Attach_Handler (Typ) then
              if Restricted_Profile then
*************** package body Exp_Ch9 is
*** 555,561 ****
           elsif Has_Interrupt_Handler (Typ) then
              Protection_Type := RE_Dynamic_Interrupt_Protection;
  
!          elsif Has_Entries (Typ) then
              if Abort_Allowed
                or else Restriction_Active (No_Entry_Queue) = False
                or else Number_Entries (Typ) > 1
--- 954,966 ----
           elsif Has_Interrupt_Handler (Typ) then
              Protection_Type := RE_Dynamic_Interrupt_Protection;
  
!          --  The type has explicit entries or generated primitive entry
!          --  wrappers.
! 
!          elsif Has_Entries (Typ)
!             or else (Ada_Version >= Ada_05
!                        and then Present (Interface_List (Parent (Typ))))
!          then
              if Abort_Allowed
                or else Restriction_Active (No_Entry_Queue) = False
                or else Number_Entries (Typ) > 1
*************** package body Exp_Ch9 is
*** 569,582 ****
              Protection_Type := RE_Protection;
           end if;
  
!          Prepend_To (Decls,
             Make_Object_Renaming_Declaration (Loc,
               Defining_Identifier => Object_Ref (Body_Ent),
               Subtype_Mark => New_Reference_To (RTE (Protection_Type), Loc),
               Name =>
                 Make_Selected_Component (Loc,
                   Prefix        => Make_Identifier (Loc, Name),
!                  Selector_Name => Make_Identifier (Loc, Name_uObject))));
        end;
     end Add_Private_Declarations;
  
--- 974,989 ----
              Protection_Type := RE_Protection;
           end if;
  
!          Decl :=
             Make_Object_Renaming_Declaration (Loc,
               Defining_Identifier => Object_Ref (Body_Ent),
               Subtype_Mark => New_Reference_To (RTE (Protection_Type), Loc),
               Name =>
                 Make_Selected_Component (Loc,
                   Prefix        => Make_Identifier (Loc, Name),
!                  Selector_Name => Make_Identifier (Loc, Name_uObject)));
!          Set_Needs_Debug_Info (Defining_Identifier (Decl));
!          Prepend_To (Decls, Decl);
        end;
     end Add_Private_Declarations;
  
*************** package body Exp_Ch9 is
*** 594,602 ****
  
     begin
        --  At the end of the statement sequence, Complete_Rendezvous is called.
!       --  A label skipping the Complete_Rendezvous, and all other
!       --  accept processing, has already been added for the expansion
!       --  of requeue statements.
  
        Call := Build_Runtime_Call (Loc, RE_Complete_Rendezvous);
        Insert_Before (Last (Statements (Stats)), Call);
--- 1001,1009 ----
  
     begin
        --  At the end of the statement sequence, Complete_Rendezvous is called.
!       --  A label skipping the Complete_Rendezvous, and all other accept
!       --  processing, has already been added for the expansion of requeue
!       --  statements.
  
        Call := Build_Runtime_Call (Loc, RE_Complete_Rendezvous);
        Insert_Before (Last (Statements (Stats)), Call);
*************** package body Exp_Ch9 is
*** 812,818 ****
              Parameter_Type =>
                New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
  
!         Subtype_Mark => New_Reference_To (Standard_Boolean, Loc));
     end Build_Barrier_Function_Specification;
  
     --------------------------
--- 1219,1225 ----
              Parameter_Type =>
                New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
  
!         Result_Definition => New_Reference_To (Standard_Boolean, Loc));
     end Build_Barrier_Function_Specification;
  
     --------------------------
*************** package body Exp_Ch9 is
*** 824,830 ****
        E : Entity_Id) return Node_Id
     is
        Loc : constant Source_Ptr := Sloc (N);
- 
     begin
        return
          Make_Function_Call (Loc,
--- 1231,1236 ----
*************** package body Exp_Ch9 is
*** 850,856 ****
        Cdecls   : List_Id;
  
     begin
!       Set_Corresponding_Record_Type (Ctyp, Rec_Ent);
        Set_Ekind                         (Rec_Ent, E_Record_Type);
        Set_Has_Delayed_Freeze            (Rec_Ent, Has_Delayed_Freeze (Ctyp));
        Set_Is_Concurrent_Record_Type     (Rec_Ent, True);
--- 1256,1262 ----
        Cdecls   : List_Id;
  
     begin
!       Set_Corresponding_Record_Type     (Ctyp, Rec_Ent);
        Set_Ekind                         (Rec_Ent, E_Record_Type);
        Set_Has_Delayed_Freeze            (Rec_Ent, Has_Delayed_Freeze (Ctyp));
        Set_Is_Concurrent_Record_Type     (Rec_Ent, True);
*************** package body Exp_Ch9 is
*** 895,903 ****
        end if;
  
        --  Now we can construct the record type declaration. Note that this
!       --  record is limited, reflecting the underlying limitedness of the
!       --  task or protected object that it represents, and ensuring for
!       --  example that it is properly passed by reference.
  
        return
          Make_Full_Type_Declaration (Loc,
--- 1301,1311 ----
        end if;
  
        --  Now we can construct the record type declaration. Note that this
!       --  record is "limited tagged". It is "limited" to reflect the underlying
!       --  limitedness of the task or protected object that it represents, and
!       --  ensuring for example that it is properly passed by reference. It is
!       --  "tagged" to give support to dispatching calls through interfaces (Ada
!       --  2005: AI-345)
  
        return
          Make_Full_Type_Declaration (Loc,
*************** package body Exp_Ch9 is
*** 908,913 ****
--- 1316,1323 ----
                Component_List =>
                  Make_Component_List (Loc,
                    Component_Items => Cdecls),
+               Tagged_Present  =>
+                  Ada_Version >= Ada_05 and then Is_Tagged_Type (Ctyp),
                Limited_Present => True));
     end Build_Corresponding_Record;
  
*************** package body Exp_Ch9 is
*** 929,939 ****
        Typ    : Entity_Id;
  
     begin
-       Ent := First_Entity (Concurrent_Type);
-       Eindx := 0;
- 
        --  Count number of non-family entries
  
        while Present (Ent) loop
           if Ekind (Ent) = E_Entry then
              Eindx := Eindx + 1;
--- 1339,1348 ----
        Typ    : Entity_Id;
  
     begin
        --  Count number of non-family entries
  
+       Eindx := 0;
+       Ent := First_Entity (Concurrent_Type);
        while Present (Ent) loop
           if Ekind (Ent) = E_Entry then
              Eindx := Eindx + 1;
*************** package body Exp_Ch9 is
*** 948,954 ****
  
        Ent := First_Entity (Concurrent_Type);
        Comp := First (Component_List);
- 
        while Present (Ent) loop
           if Ekind (Ent) = E_Entry_Family then
              while Chars (Ent) /= Chars (Defining_Identifier (Comp)) loop
--- 1357,1362 ----
*************** package body Exp_Ch9 is
*** 972,977 ****
--- 1380,1882 ----
     end Build_Entry_Count_Expression;
  
     ---------------------------
+    -- Build_Parameter_Block --
+    ---------------------------
+ 
+    function Build_Parameter_Block
+      (Loc     : Source_Ptr;
+       Actuals : List_Id;
+       Formals : List_Id;
+       Decls   : List_Id) return Entity_Id
+    is
+       Actual   : Entity_Id;
+       Comp_Nam : Node_Id;
+       Comps    : List_Id;
+       Formal   : Entity_Id;
+       Has_Comp : Boolean := False;
+       Rec_Nam  : Node_Id;
+ 
+    begin
+       Actual := First (Actuals);
+       Comps  := New_List;
+       Formal := Defining_Identifier (First (Formals));
+ 
+       while Present (Actual) loop
+          if not Is_Controlling_Actual (Actual) then
+ 
+             --  Generate:
+             --    type Ann is access all <actual-type>
+ 
+             Comp_Nam :=
+               Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
+ 
+             Append_To (Decls,
+               Make_Full_Type_Declaration (Loc,
+                 Defining_Identifier =>
+                   Comp_Nam,
+                 Type_Definition =>
+                   Make_Access_To_Object_Definition (Loc,
+                     All_Present =>
+                       True,
+                     Constant_Present =>
+                       Ekind (Formal) = E_In_Parameter,
+                     Subtype_Indication =>
+                       New_Reference_To (Etype (Actual), Loc))));
+ 
+             --  Generate:
+             --    Param : Ann;
+ 
+             Append_To (Comps,
+               Make_Component_Declaration (Loc,
+                 Defining_Identifier =>
+                   Make_Defining_Identifier (Loc, Chars (Formal)),
+                 Component_Definition =>
+                   Make_Component_Definition (Loc,
+                     Aliased_Present =>
+                       False,
+                     Subtype_Indication =>
+                       New_Reference_To (Comp_Nam, Loc))));
+ 
+             Has_Comp := True;
+          end if;
+ 
+          Next_Actual (Actual);
+          Next_Formal_With_Extras (Formal);
+       end loop;
+ 
+       Rec_Nam :=
+         Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+ 
+       if Has_Comp then
+ 
+          --  Generate:
+          --    type Pnn is record
+          --       Param1 : Ann1;
+          --       ...
+          --       ParamN : AnnN;
+ 
+          --  where Pnn is a parameter wrapping record, Param1 .. ParamN are
+          --  the original parameter names and Ann1 .. AnnN are the access to
+          --  actual types.
+ 
+          Append_To (Decls,
+            Make_Full_Type_Declaration (Loc,
+              Defining_Identifier =>
+                Rec_Nam,
+              Type_Definition =>
+                Make_Record_Definition (Loc,
+                  Component_List =>
+                    Make_Component_List (Loc, Comps))));
+       else
+          --  Generate:
+          --    type Pnn is null record;
+ 
+          Append_To (Decls,
+            Make_Full_Type_Declaration (Loc,
+              Defining_Identifier =>
+                Rec_Nam,
+              Type_Definition =>
+                Make_Record_Definition (Loc,
+                  Null_Present   => True,
+                  Component_List => Empty)));
+       end if;
+ 
+       return Rec_Nam;
+    end Build_Parameter_Block;
+ 
+    ------------------------
+    -- Build_Wrapper_Body --
+    ------------------------
+ 
+    function Build_Wrapper_Body
+      (Loc      : Source_Ptr;
+       Proc_Nam : Entity_Id;
+       Obj_Typ  : Entity_Id;
+       Formals  : List_Id) return Node_Id
+    is
+       Actuals      : List_Id := No_List;
+       Body_Spec    : Node_Id;
+       Conv_Id      : Node_Id;
+       First_Formal : Node_Id;
+       Formal       : Node_Id;
+ 
+    begin
+       Body_Spec := Build_Wrapper_Spec (Loc, Proc_Nam, Obj_Typ, Formals);
+ 
+       --  If we did not generate the specification do have nothing else to do
+ 
+       if Body_Spec = Empty then
+          return Empty;
+       end if;
+ 
+       --  Map formals to actuals. Use the list built for the wrapper spec,
+       --  skipping the object notation parameter.
+ 
+       First_Formal := First (Parameter_Specifications (Body_Spec));
+ 
+       Formal := First_Formal;
+       Next (Formal);
+ 
+       if Present (Formal) then
+          Actuals := New_List;
+ 
+          while Present (Formal) loop
+             Append_To (Actuals,
+               Make_Identifier (Loc, Chars =>
+                 Chars (Defining_Identifier (Formal))));
+ 
+             Next (Formal);
+          end loop;
+       end if;
+ 
+       --  An access-to-variable first parameter will require an explicit
+       --  dereference in the unchecked conversion. This case occurs when
+       --  a protected entry wrapper must override an interface-level
+       --  procedure with interface access as first parameter.
+ 
+       --     SubprgName (O.all).Proc_Nam (Formal_1 .. Formal_N)
+ 
+       if Nkind (Parameter_Type (First_Formal)) = N_Access_Definition then
+          Conv_Id :=
+            Make_Explicit_Dereference (Loc,
+              Prefix =>
+                Make_Identifier (Loc, Chars => Name_uO));
+       else
+          Conv_Id :=
+            Make_Identifier (Loc, Chars => Name_uO);
+       end if;
+ 
+       if Ekind (Proc_Nam) = E_Function then
+          return
+            Make_Subprogram_Body (Loc,
+              Specification => Body_Spec,
+              Declarations  => Empty_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  Statements =>
+                    New_List (
+                      Make_Return_Statement (Loc,
+                         Make_Function_Call (Loc,
+                           Name =>
+                             Make_Selected_Component (Loc,
+                               Prefix =>
+                                 Unchecked_Convert_To (
+                                   Corresponding_Concurrent_Type (Obj_Typ),
+                                   Conv_Id),
+                               Selector_Name =>
+                                 New_Reference_To (Proc_Nam, Loc)),
+                           Parameter_Associations => Actuals)))));
+       else
+          return
+            Make_Subprogram_Body (Loc,
+              Specification => Body_Spec,
+              Declarations  => Empty_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  Statements =>
+                    New_List (
+                      Make_Procedure_Call_Statement (Loc,
+                        Name =>
+                          Make_Selected_Component (Loc,
+                            Prefix =>
+                              Unchecked_Convert_To (
+                                Corresponding_Concurrent_Type (Obj_Typ),
+                                Conv_Id),
+                            Selector_Name =>
+                              New_Reference_To (Proc_Nam, Loc)),
+                        Parameter_Associations => Actuals))));
+       end if;
+    end Build_Wrapper_Body;
+ 
+    ------------------------
+    -- Build_Wrapper_Spec --
+    ------------------------
+ 
+    function Build_Wrapper_Spec
+      (Loc      : Source_Ptr;
+       Proc_Nam : Entity_Id;
+       Obj_Typ  : Entity_Id;
+       Formals  : List_Id) return Node_Id
+    is
+       New_Name_Id : constant Entity_Id :=
+                       Make_Defining_Identifier (Loc, Chars (Proc_Nam));
+ 
+       First_Param        : Node_Id := Empty;
+       Iface              : Entity_Id;
+       Iface_Elmt         : Elmt_Id := No_Elmt;
+       New_Formals        : List_Id;
+       Obj_Param          : Node_Id;
+       Obj_Param_Typ      : Node_Id;
+       Iface_Prim_Op      : Entity_Id;
+       Iface_Prim_Op_Elmt : Elmt_Id;
+ 
+       function Overriding_Possible
+         (Iface_Prim_Op : Entity_Id;
+          Proc_Nam      : Entity_Id) return Boolean;
+       --  Determine whether a primitive operation can be overriden by the
+       --  wrapper. Iface_Prim_Op is the candidate primitive operation of an
+       --  abstract interface type, Proc_Nam is the generated entry wrapper.
+ 
+       function Replicate_Entry_Formals
+         (Loc     : Source_Ptr;
+          Formals : List_Id) return List_Id;
+       --  An explicit parameter replication is required due to the
+       --  Is_Entry_Formal flag being set for all the formals. The explicit
+       --  replication removes the flag that would otherwise cause a different
+       --  path of analysis.
+ 
+       -------------------------
+       -- Overriding_Possible --
+       -------------------------
+ 
+       function Overriding_Possible
+         (Iface_Prim_Op : Entity_Id;
+          Proc_Nam      : Entity_Id) return Boolean
+       is
+          Prim_Op_Spec  : constant Node_Id := Parent (Iface_Prim_Op);
+          Proc_Spec     : constant Node_Id := Parent (Proc_Nam);
+ 
+          Is_Access_To_Variable : Boolean;
+          Is_Out_Present        : Boolean;
+ 
+          function Type_Conformant_Parameters
+            (Prim_Op_Param_Specs : List_Id;
+             Proc_Param_Specs    : List_Id) return Boolean;
+          --  Determine whether the parameters of the generated entry wrapper
+          --  and those of a primitive operation are type conformant. During
+          --  this check, the first parameter of the primitive operation is
+          --  always skipped.
+ 
+          --------------------------------
+          -- Type_Conformant_Parameters --
+          --------------------------------
+ 
+          function Type_Conformant_Parameters
+            (Prim_Op_Param_Specs : List_Id;
+             Proc_Param_Specs    : List_Id) return Boolean
+          is
+             Prim_Op_Param : Node_Id;
+             Proc_Param    : Node_Id;
+ 
+          begin
+             --  Skip the first parameter of the primitive operation
+ 
+             Prim_Op_Param := Next (First (Prim_Op_Param_Specs));
+             Proc_Param    := First (Proc_Param_Specs);
+             while Present (Prim_Op_Param)
+               and then Present (Proc_Param)
+             loop
+                --  The two parameters must be mode conformant and have
+                --  the exact same types.
+ 
+                if Ekind (Defining_Identifier (Prim_Op_Param)) /=
+                   Ekind (Defining_Identifier (Proc_Param))
+                  or else Etype (Parameter_Type (Prim_Op_Param)) /=
+                          Etype (Parameter_Type (Proc_Param))
+                then
+                   return False;
+                end if;
+ 
+                Next (Prim_Op_Param);
+                Next (Proc_Param);
+             end loop;
+ 
+             --  One of the lists is longer than the other
+ 
+             if Present (Prim_Op_Param) or else Present (Proc_Param) then
+                return False;
+             end if;
+ 
+             return True;
+          end Type_Conformant_Parameters;
+ 
+       --  Start of processing for Overriding_Possible
+ 
+       begin
+          if Chars (Iface_Prim_Op) /= Chars (Proc_Nam) then
+             return False;
+          end if;
+ 
+          --  Special check for protected procedures: If an inherited subprogram
+          --  is implemented by a protected procedure or an entry, then the
+          --  first parameter of the inherited subprogram shall be of mode OUT
+          --  or IN OUT, or an access-to-variable parameter.
+ 
+          if Ekind (Iface_Prim_Op) = E_Procedure then
+ 
+             Is_Out_Present :=
+               Present (Parameter_Specifications (Prim_Op_Spec))
+                 and then
+               Out_Present (First (Parameter_Specifications (Prim_Op_Spec)));
+ 
+             Is_Access_To_Variable :=
+               Present (Parameter_Specifications (Prim_Op_Spec))
+                 and then
+               Nkind (Parameter_Type
+                      (First
+                       (Parameter_Specifications (Prim_Op_Spec))))
+                         = N_Access_Definition;
+ 
+             if not Is_Out_Present
+               and then not Is_Access_To_Variable
+             then
+                return False;
+             end if;
+          end if;
+ 
+          return Type_Conformant_Parameters (
+            Parameter_Specifications (Prim_Op_Spec),
+            Parameter_Specifications (Proc_Spec));
+       end Overriding_Possible;
+ 
+       -----------------------------
+       -- Replicate_Entry_Formals --
+       -----------------------------
+ 
+       function Replicate_Entry_Formals
+         (Loc     : Source_Ptr;
+          Formals : List_Id) return List_Id
+       is
+          New_Formals : constant List_Id := New_List;
+          Formal      : Node_Id;
+ 
+       begin
+          Formal := First (Formals);
+          while Present (Formal) loop
+ 
+             --  Create an explicit copy of the entry parameter
+ 
+             Append_To (New_Formals,
+               Make_Parameter_Specification (Loc,
+                 Defining_Identifier =>
+                   Make_Defining_Identifier (Loc,
+                     Chars          => Chars (Defining_Identifier (Formal))),
+                     In_Present     => In_Present  (Formal),
+                     Out_Present    => Out_Present (Formal),
+                     Parameter_Type => New_Reference_To (Etype (
+                                         Parameter_Type (Formal)), Loc)));
+ 
+             Next (Formal);
+          end loop;
+ 
+          return New_Formals;
+       end Replicate_Entry_Formals;
+ 
+    --  Start of processing for Build_Wrapper_Spec
+ 
+    begin
+       --  The mode is determined by the first parameter of the interface-level
+       --  procedure that the current entry is trying to override.
+ 
+       pragma Assert (Present (Abstract_Interfaces
+                      (Corresponding_Record_Type (Scope (Proc_Nam)))));
+ 
+       Iface_Elmt :=
+         First_Elmt (Abstract_Interfaces
+                     (Corresponding_Record_Type (Scope (Proc_Nam))));
+ 
+       --  We must examine all the protected operations of the implemented
+       --  interfaces in order to discover a possible overriding candidate.
+ 
+       Examine_Interfaces : while Present (Iface_Elmt) loop
+          Iface := Node (Iface_Elmt);
+ 
+          if Present (Primitive_Operations (Iface)) then
+             Iface_Prim_Op_Elmt := First_Elmt (Primitive_Operations (Iface));
+             while Present (Iface_Prim_Op_Elmt) loop
+                Iface_Prim_Op := Node (Iface_Prim_Op_Elmt);
+ 
+                while Present (Alias (Iface_Prim_Op)) loop
+                   Iface_Prim_Op := Alias (Iface_Prim_Op);
+                end loop;
+ 
+                --  The current primitive operation can be overriden by the
+                --  generated entry wrapper.
+ 
+                if Overriding_Possible (Iface_Prim_Op, Proc_Nam) then
+                   First_Param :=
+                     First (Parameter_Specifications (Parent (Iface_Prim_Op)));
+ 
+                   exit Examine_Interfaces;
+                end if;
+ 
+                Next_Elmt (Iface_Prim_Op_Elmt);
+             end loop;
+          end if;
+ 
+          Next_Elmt (Iface_Elmt);
+       end loop Examine_Interfaces;
+ 
+       --  Return if no interface primitive can be overriden
+ 
+       if not Present (First_Param) then
+          return Empty;
+       end if;
+ 
+       New_Formals := Replicate_Entry_Formals (Loc, Formals);
+ 
+       --  ??? Certain source packages contain protected or task types that do
+       --  not implement any interfaces and are compiled with the -gnat05
+       --  switch.  In this case, a default first parameter is created.
+ 
+       if Present (First_Param) then
+          if Nkind (Parameter_Type (First_Param)) = N_Access_Definition then
+             Obj_Param_Typ :=
+               Make_Access_Definition (Loc,
+                 Subtype_Mark =>
+                   New_Reference_To (Obj_Typ, Loc));
+          else
+             Obj_Param_Typ := New_Reference_To (Obj_Typ, Loc);
+          end if;
+ 
+          Obj_Param :=
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uO),
+              In_Present  => In_Present  (First_Param),
+              Out_Present => Out_Present (First_Param),
+              Parameter_Type => Obj_Param_Typ);
+ 
+       else
+          Obj_Param :=
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uO),
+              In_Present  => True,
+              Out_Present => True,
+                Parameter_Type => New_Reference_To (Obj_Typ, Loc));
+       end if;
+ 
+       Prepend_To (New_Formals, Obj_Param);
+ 
+       --  Minimum decoration needed to catch the entity in
+       --  Sem_Ch6.Override_Dispatching_Operation
+ 
+       if Ekind (Proc_Nam) = E_Procedure
+         or else Ekind (Proc_Nam) = E_Entry
+       then
+          Set_Ekind                (New_Name_Id, E_Procedure);
+          Set_Is_Primitive_Wrapper (New_Name_Id);
+          Set_Wrapped_Entity       (New_Name_Id, Proc_Nam);
+ 
+          return
+            Make_Procedure_Specification (Loc,
+              Defining_Unit_Name => New_Name_Id,
+              Parameter_Specifications => New_Formals);
+ 
+       else pragma Assert (Ekind (Proc_Nam) = E_Function);
+          Set_Ekind (New_Name_Id, E_Function);
+ 
+          return
+            Make_Function_Specification (Loc,
+              Defining_Unit_Name => New_Name_Id,
+              Parameter_Specifications => New_Formals,
+              Result_Definition =>
+                New_Copy (Result_Definition (Parent (Proc_Nam))));
+       end if;
+    end Build_Wrapper_Spec;
+ 
+    ---------------------------
     -- Build_Find_Body_Index --
     ---------------------------
  
*************** package body Exp_Ch9 is
*** 1081,1089 ****
        Spec := Build_Find_Body_Index_Spec (Typ);
  
        Ent := First_Entity (Typ);
- 
        while Present (Ent) loop
- 
           if Ekind (Ent) = E_Entry_Family then
              Has_F := True;
              exit;
--- 1986,1992 ----
*************** package body Exp_Ch9 is
*** 1139,1150 ****
  
           elsif Nkind (Ret) = N_If_Statement then
  
!             --  Ranges are in increasing order, so last one doesn't need a
!             --  guard.
  
              declare
                 Nod : constant Node_Id := Last (Elsif_Parts (Ret));
- 
              begin
                 Remove (Nod);
                 Set_Else_Statements (Ret, Then_Statements (Nod));
--- 2042,2051 ----
  
           elsif Nkind (Ret) = N_If_Statement then
  
!             --  Ranges are in increasing order, so last one doesn't need guard
  
              declare
                 Nod : constant Node_Id := Last (Elsif_Parts (Ret));
              begin
                 Remove (Nod);
                 Set_Else_Statements (Ret, Then_Statements (Nod));
*************** package body Exp_Ch9 is
*** 1187,1193 ****
                Defining_Identifier => Parm2,
                Parameter_Type =>
                  New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
!           Subtype_Mark => New_Occurrence_Of (
              RTE (RE_Protected_Entry_Index), Loc));
     end Build_Find_Body_Index_Spec;
  
--- 2088,2094 ----
                Defining_Identifier => Parm2,
                Parameter_Type =>
                  New_Reference_To (RTE (RE_Protected_Entry_Index), Loc))),
!           Result_Definition => New_Occurrence_Of (
              RTE (RE_Protected_Entry_Index), Loc));
     end Build_Find_Body_Index_Spec;
  
*************** package body Exp_Ch9 is
*** 1205,1211 ****
        S := Scope (E);
  
        --  Ada 2005 (AI-287): Do not set/get the has_master_entity reminder
!       --  in internal scopes. Required for nested limited aggregates.
  
        if Ada_Version >= Ada_05 then
           while Is_Internal (S) loop
--- 2106,2113 ----
        S := Scope (E);
  
        --  Ada 2005 (AI-287): Do not set/get the has_master_entity reminder
!       --  in internal scopes, unless present already.. Required for nested
!       --  limited aggregates. This could use some more explanation ????
  
        if Ada_Version >= Ada_05 then
           while Is_Internal (S) loop
*************** package body Exp_Ch9 is
*** 1294,1305 ****
        Espec := Build_Protected_Entry_Specification (Edef, Empty, Loc);
  
        --  <object pointer declaration>
!       --  Add object pointer declaration. This is needed by the
!       --  discriminal and prival renamings, which should already
!       --  have been inserted into the declaration list.
  
        Add_Object_Pointer (Op_Decls, Pid, Loc);
  
        if Abort_Allowed
          or else Restriction_Active (No_Entry_Queue) = False
          or else Number_Entries (Pid) > 1
--- 2196,2212 ----
        Espec := Build_Protected_Entry_Specification (Edef, Empty, Loc);
  
        --  <object pointer declaration>
! 
!       --  Add object pointer declaration. This is needed by the discriminal and
!       --  prival renamings, which should already have been inserted into the
!       --  declaration list.
  
        Add_Object_Pointer (Op_Decls, Pid, Loc);
  
+       --  Add renamings for formals for use by debugger
+ 
+       Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc);
+ 
        if Abort_Allowed
          or else Restriction_Active (No_Entry_Queue) = False
          or else Number_Entries (Pid) > 1
*************** package body Exp_Ch9 is
*** 1353,1358 ****
--- 2260,2268 ----
                RTE (RE_Exceptional_Complete_Single_Entry_Body), Loc);
           end if;
  
+          --  Create body of entry procedure. The renaming declarations are
+          --  placed ahead of the block that contains the actual entry body.
+ 
           return
             Make_Subprogram_Body (Loc,
               Specification => Espec,
*************** package body Exp_Ch9 is
*** 1432,1437 ****
--- 2342,2348 ----
        Ident       : Entity_Id) return List_Id
     is
        Loc         : constant Source_Ptr := Sloc (N);
+       Decl        : Node_Id;
        Formal      : Entity_Id;
        New_Plist   : List_Id;
        New_Param   : Node_Id;
*************** package body Exp_Ch9 is
*** 1439,1445 ****
     begin
        New_Plist := New_List;
        Formal := First_Formal (Ident);
- 
        while Present (Formal) loop
           New_Param :=
             Make_Parameter_Specification (Loc,
--- 2350,2355 ----
*************** package body Exp_Ch9 is
*** 1462,1468 ****
        --  to protected subprogram, the parameter is in-out. Otherwise it is
        --  an in parameter.
  
!       Prepend_To (New_Plist,
          Make_Parameter_Specification (Loc,
            Defining_Identifier =>
              Make_Defining_Identifier (Loc, Name_uObject),
--- 2372,2378 ----
        --  to protected subprogram, the parameter is in-out. Otherwise it is
        --  an in parameter.
  
!       Decl :=
          Make_Parameter_Specification (Loc,
            Defining_Identifier =>
              Make_Defining_Identifier (Loc, Name_uObject),
*************** package body Exp_Ch9 is
*** 1470,1476 ****
            Out_Present =>
             (Etype (Ident) = Standard_Void_Type
                and then not Is_RTE (Obj_Type, RE_Address)),
!           Parameter_Type => New_Reference_To (Obj_Type, Loc)));
  
        return New_Plist;
     end Build_Protected_Spec;
--- 2380,2388 ----
            Out_Present =>
             (Etype (Ident) = Standard_Void_Type
                and then not Is_RTE (Obj_Type, RE_Address)),
!           Parameter_Type => New_Reference_To (Obj_Type, Loc));
!       Set_Needs_Debug_Info (Defining_Identifier (Decl));
!       Prepend_To (New_Plist, Decl);
  
        return New_Plist;
     end Build_Protected_Spec;
*************** package body Exp_Ch9 is
*** 1480,1498 ****
     ---------------------------------------
  
     function Build_Protected_Sub_Specification
!      (N           : Node_Id;
!       Prottyp     : Entity_Id;
!       Unprotected : Boolean := False) return Node_Id
     is
!       Loc         : constant Source_Ptr := Sloc (N);
!       Decl        : Node_Id;
!       Protnm      : constant Name_Id := Chars (Prottyp);
!       Ident       : Entity_Id;
!       Nam         : Name_Id;
!       New_Id      : Entity_Id;
!       New_Plist   : List_Id;
!       Append_Char : Character;
!       New_Spec    : Node_Id;
  
     begin
        if Ekind
--- 2392,2412 ----
     ---------------------------------------
  
     function Build_Protected_Sub_Specification
!      (N       : Node_Id;
!       Prottyp : Entity_Id;
!       Mode    : Subprogram_Protection_Mode) return Node_Id
     is
!       Loc       : constant Source_Ptr := Sloc (N);
!       Decl      : Node_Id;
!       Ident     : Entity_Id;
!       New_Id    : Entity_Id;
!       New_Plist : List_Id;
!       New_Spec  : Node_Id;
! 
!       Append_Chr : constant array (Subprogram_Protection_Mode) of Character :=
!                      (Dispatching_Mode => ' ',
!                       Protected_Mode   => 'P',
!                       Unprotected_Mode => 'N');
  
     begin
        if Ekind
*************** package body Exp_Ch9 is
*** 1504,1524 ****
        end if;
  
        Ident := Defining_Unit_Name (Specification (Decl));
-       Nam := Chars (Ident);
  
!       New_Plist := Build_Protected_Spec
!                         (Decl, Corresponding_Record_Type (Prottyp),
!                          Unprotected, Ident);
! 
!       if Unprotected then
!          Append_Char := 'N';
!       else
!          Append_Char := 'P';
!       end if;
  
        New_Id :=
          Make_Defining_Identifier (Loc,
!           Chars => Build_Selected_Name (Protnm, Nam, Append_Char));
  
        --  The unprotected operation carries the user code, and debugging
        --  information must be generated for it, even though this spec does
--- 2418,2432 ----
        end if;
  
        Ident := Defining_Unit_Name (Specification (Decl));
  
!       New_Plist :=
!         Build_Protected_Spec (Decl,
!           Corresponding_Record_Type (Prottyp),
!                               Mode = Unprotected_Mode, Ident);
  
        New_Id :=
          Make_Defining_Identifier (Loc,
!           Chars => Build_Selected_Name (Prottyp, Ident, Append_Chr (Mode)));
  
        --  The unprotected operation carries the user code, and debugging
        --  information must be generated for it, even though this spec does
*************** package body Exp_Ch9 is
*** 1539,1545 ****
             Make_Function_Specification (Loc,
               Defining_Unit_Name => New_Id,
               Parameter_Specifications => New_Plist,
!              Subtype_Mark => New_Copy (Subtype_Mark (Specification (Decl))));
           Set_Return_Present (Defining_Unit_Name (New_Spec));
           return New_Spec;
        end if;
--- 2447,2454 ----
             Make_Function_Specification (Loc,
               Defining_Unit_Name => New_Id,
               Parameter_Specifications => New_Plist,
!              Result_Definition =>
!                New_Copy (Result_Definition (Specification (Decl))));
           Set_Return_Present (Defining_Unit_Name (New_Spec));
           return New_Spec;
        end if;
*************** package body Exp_Ch9 is
*** 1581,1604 ****
        function Is_Exception_Safe (Subprogram : Node_Id) return Boolean is
  
           function Has_Side_Effect (N : Node_Id) return Boolean;
!          --  Return True whenever encountering a subprogram call or a
!          --  raise statement of any kind in the sequence of statements N
  
           ---------------------
           -- Has_Side_Effect --
           ---------------------
  
!          --  What is this doing buried two levels down in exp_ch9. It
!          --  seems like a generally useful function, and indeed there
!          --  may be code duplication going on here ???
  
           function Has_Side_Effect (N : Node_Id) return Boolean is
!             Stmt : Node_Id := N;
              Expr : Node_Id;
  
              function Is_Call_Or_Raise (N : Node_Id) return Boolean;
              --  Indicate whether N is a subprogram call or a raise statement
  
              function Is_Call_Or_Raise (N : Node_Id) return Boolean is
              begin
                 return Nkind (N) = N_Procedure_Call_Statement
--- 2490,2517 ----
        function Is_Exception_Safe (Subprogram : Node_Id) return Boolean is
  
           function Has_Side_Effect (N : Node_Id) return Boolean;
!          --  Return True whenever encountering a subprogram call or raise
!          --  statement of any kind in the sequence of statements
  
           ---------------------
           -- Has_Side_Effect --
           ---------------------
  
!          --  What is this doing buried two levels down in exp_ch9. It seems
!          --  like a generally useful function, and indeed there may be code
!          --  duplication going on here ???
  
           function Has_Side_Effect (N : Node_Id) return Boolean is
!             Stmt : Node_Id;
              Expr : Node_Id;
  
              function Is_Call_Or_Raise (N : Node_Id) return Boolean;
              --  Indicate whether N is a subprogram call or a raise statement
  
+             ----------------------
+             -- Is_Call_Or_Raise --
+             ----------------------
+ 
              function Is_Call_Or_Raise (N : Node_Id) return Boolean is
              begin
                 return Nkind (N) = N_Procedure_Call_Statement
*************** package body Exp_Ch9 is
*** 1612,1617 ****
--- 2525,2531 ----
           --  Start of processing for Has_Side_Effect
  
           begin
+             Stmt := N;
              while Present (Stmt) loop
                 if Is_Call_Or_Raise (Stmt) then
                    return True;
*************** package body Exp_Ch9 is
*** 1667,1682 ****
        Exc_Safe := Is_Exception_Safe (N);
  
        P_Op_Spec :=
!         Build_Protected_Sub_Specification (N,
!           Pid, Unprotected => False);
  
!       --  Build a list of the formal parameters of the protected
!       --  version of the subprogram to use as the actual parameters
!       --  of the unprotected version.
  
        Uactuals := New_List;
        Pformal := First (Parameter_Specifications (P_Op_Spec));
- 
        while Present (Pformal) loop
           Append (
             Make_Identifier (Loc, Chars (Defining_Identifier (Pformal))),
--- 2581,2594 ----
        Exc_Safe := Is_Exception_Safe (N);
  
        P_Op_Spec :=
!         Build_Protected_Sub_Specification (N, Pid, Protected_Mode);
  
!       --  Build a list of the formal parameters of the protected version of
!       --  the subprogram to use as the actual parameters of the unprotected
!       --  version.
  
        Uactuals := New_List;
        Pformal := First (Parameter_Specifications (P_Op_Spec));
        while Present (Pformal) loop
           Append (
             Make_Identifier (Loc, Chars (Defining_Identifier (Pformal))),
*************** package body Exp_Ch9 is
*** 1684,1691 ****
           Next (Pformal);
        end loop;
  
!       --  Make a call to the unprotected version of the subprogram
!       --  built above for use by the protected version built below.
  
        if Nkind (Op_Spec) = N_Function_Specification then
           if Exc_Safe then
--- 2596,2603 ----
           Next (Pformal);
        end loop;
  
!       --  Make a call to the unprotected version of the subprogram built above
!       --  for use by the protected version built below.
  
        if Nkind (Op_Spec) = N_Function_Specification then
           if Exc_Safe then
*************** package body Exp_Ch9 is
*** 1694,1700 ****
                Make_Object_Declaration (Loc,
                  Defining_Identifier => R,
                  Constant_Present => True,
!                 Object_Definition => New_Copy (Subtype_Mark (N_Op_Spec)),
                  Expression =>
                    Make_Function_Call (Loc,
                      Name => Make_Identifier (Loc,
--- 2606,2612 ----
                Make_Object_Declaration (Loc,
                  Defining_Identifier => R,
                  Constant_Present => True,
!                 Object_Definition => New_Copy (Result_Definition (N_Op_Spec)),
                  Expression =>
                    Make_Function_Call (Loc,
                      Name => Make_Identifier (Loc,
*************** package body Exp_Ch9 is
*** 1740,1746 ****
  
        if Has_Entries (Pid)
          or else Has_Interrupt_Handler (Pid)
!         or else (Has_Attach_Handler (Pid) and then not Restricted_Profile)
        then
           if Abort_Allowed
             or else Restriction_Active (No_Entry_Queue) = False
--- 2652,2661 ----
  
        if Has_Entries (Pid)
          or else Has_Interrupt_Handler (Pid)
!         or else (Has_Attach_Handler (Pid)
!                   and then not Restricted_Profile)
!         or else (Ada_Version >= Ada_05
!                   and then Present (Interface_List (Parent (Pid))))
        then
           if Abort_Allowed
             or else Restriction_Active (No_Entry_Queue) = False
*************** package body Exp_Ch9 is
*** 1893,1909 ****
     -------------------------
  
     function Build_Selected_Name
!      (Prefix, Selector : Name_Id;
!       Append_Char      : Character := ' ') return Name_Id
     is
        Select_Buffer : String (1 .. Hostparm.Max_Name_Length);
        Select_Len    : Natural;
  
     begin
!       Get_Name_String (Selector);
        Select_Len := Name_Len;
        Select_Buffer (1 .. Select_Len) := Name_Buffer (1 .. Name_Len);
!       Get_Name_String (Prefix);
  
        --  If scope is anonymous type, discard suffix to recover name of
        --  single protected object. Otherwise use protected type name.
--- 2808,2825 ----
     -------------------------
  
     function Build_Selected_Name
!      (Prefix      : Entity_Id;
!       Selector    : Entity_Id;
!       Append_Char : Character := ' ') return Name_Id
     is
        Select_Buffer : String (1 .. Hostparm.Max_Name_Length);
        Select_Len    : Natural;
  
     begin
!       Get_Name_String (Chars (Selector));
        Select_Len := Name_Len;
        Select_Buffer (1 .. Select_Len) := Name_Buffer (1 .. Name_Len);
!       Get_Name_String (Chars (Prefix));
  
        --  If scope is anonymous type, discard suffix to recover name of
        --  single protected object. Otherwise use protected type name.
*************** package body Exp_Ch9 is
*** 1921,1932 ****
           Name_Buffer (Name_Len) := Select_Buffer (J);
        end loop;
  
        if Append_Char /= ' ' then
!          Name_Len := Name_Len + 1;
!          Name_Buffer (Name_Len) := Append_Char;
        end if;
- 
-       return Name_Find;
     end Build_Selected_Name;
  
     -----------------------------
--- 2837,2864 ----
           Name_Buffer (Name_Len) := Select_Buffer (J);
        end loop;
  
+       --  Now add the Append_Char if specified. The encoding to follow
+       --  depends on the type of entity. If Append_Char is either 'N' or 'P',
+       --  then the entity is associated to a protected type subprogram.
+       --  Otherwise, it is a protected type entry. For each case, the
+       --  encoding to follow for the suffix is documented in exp_dbug.ads.
+ 
+       --  It would be better to encapsulate this as a routine in Exp_Dbug ???
+ 
        if Append_Char /= ' ' then
!          if Append_Char = 'P' or Append_Char = 'N' then
!             Name_Len := Name_Len + 1;
!             Name_Buffer (Name_Len) := Append_Char;
!             return Name_Find;
!          else
!             Name_Buffer (Name_Len + 1) := '_';
!             Name_Buffer (Name_Len + 2) := Append_Char;
!             Name_Len := Name_Len + 2;
!             return New_External_Name (Name_Find, ' ', -1);
!          end if;
!       else
!          return Name_Find;
        end if;
     end Build_Selected_Name;
  
     -----------------------------
*************** package body Exp_Ch9 is
*** 1997,2020 ****
           Loc       : constant Source_Ptr := Sloc (N);
           Parms     : constant List_Id    := Parameter_Associations (N);
           Stats     : constant List_Id    := New_List;
!          Pdecl     : Node_Id;
!          Xdecl     : Node_Id;
!          Decls     : List_Id;
           Conctyp   : Node_Id;
           Ent       : Entity_Id;
           Ent_Acc   : Entity_Id;
           P         : Entity_Id;
-          X         : Entity_Id;
-          Plist     : List_Id;
           Parm1     : Node_Id;
           Parm2     : Node_Id;
           Parm3     : Node_Id;
!          Call      : Node_Id;
!          Actual    : Node_Id;
!          Formal    : Node_Id;
!          N_Node    : Node_Id;
!          N_Var     : Node_Id;
!          Comm_Name : Entity_Id;
  
        begin
           --  Simple entry and entry family cases merge here
--- 2929,2954 ----
           Loc       : constant Source_Ptr := Sloc (N);
           Parms     : constant List_Id    := Parameter_Associations (N);
           Stats     : constant List_Id    := New_List;
!          Actual    : Node_Id;
!          Call      : Node_Id;
!          Comm_Name : Entity_Id;
           Conctyp   : Node_Id;
+          Decls     : List_Id;
           Ent       : Entity_Id;
           Ent_Acc   : Entity_Id;
+          Formal    : Node_Id;
+          Iface_Tag : Entity_Id;
+          Iface_Typ : Entity_Id;
+          N_Node    : Node_Id;
+          N_Var     : Node_Id;
           P         : Entity_Id;
           Parm1     : Node_Id;
           Parm2     : Node_Id;
           Parm3     : Node_Id;
!          Pdecl     : Node_Id;
!          Plist     : List_Id;
!          X         : Entity_Id;
!          Xdecl     : Node_Id;
  
        begin
           --  Simple entry and entry family cases merge here
*************** package body Exp_Ch9 is
*** 2081,2087 ****
           end if;
  
           --  The third parameter is the packaged parameters. If there are
!          --  none, then it is just the null address, since nothing is passed
  
           if No (Parms) then
              Parm3 := New_Reference_To (RTE (RE_Null_Address), Loc);
--- 3015,3021 ----
           end if;
  
           --  The third parameter is the packaged parameters. If there are
!          --  none, then it is just the null address, since nothing is passed.
  
           if No (Parms) then
              Parm3 := New_Reference_To (RTE (RE_Null_Address), Loc);
*************** package body Exp_Ch9 is
*** 2091,2098 ****
           --  of a packaged record containing the required parameter values.
  
           else
!             --  First build a list of parameter values, which are
!             --  references to objects of the parameter types.
  
              Plist := New_List;
  
--- 3025,3032 ----
           --  of a packaged record containing the required parameter values.
  
           else
!             --  First build a list of parameter values, which are references to
!             --  objects of the parameter types.
  
              Plist := New_List;
  
*************** package body Exp_Ch9 is
*** 2114,2122 ****
                        Object_Definition =>
                          New_Reference_To (Etype (Formal), Loc));
  
!                   --  We have to make an assignment statement separate for
!                   --  the case of limited type. We can not assign it unless
!                   --  the Assignment_OK flag is set first.
  
                    if Ekind (Formal) /= E_Out_Parameter then
                       N_Var :=
--- 3048,3056 ----
                        Object_Definition =>
                          New_Reference_To (Etype (Formal), Loc));
  
!                   --  We have to make an assignment statement separate for the
!                   --  case of limited type. We cannot assign it unless the
!                   --  Assignment_OK flag is set first.
  
                    if Ekind (Formal) /= E_Out_Parameter then
                       N_Var :=
*************** package body Exp_Ch9 is
*** 2136,2143 ****
                      Prefix =>
                        New_Reference_To (Defining_Identifier (N_Node), Loc)));
                 else
!                   Append_To (Plist,
!                     Make_Reference (Loc, Prefix => Relocate_Node (Actual)));
                 end if;
  
                 Next_Actual (Actual);
--- 3070,3105 ----
                      Prefix =>
                        New_Reference_To (Defining_Identifier (N_Node), Loc)));
                 else
!                   --  Interface class-wide formal
! 
!                   if Ada_Version >= Ada_05
!                     and then Ekind (Etype (Formal)) = E_Class_Wide_Type
!                     and then Is_Interface (Etype (Formal))
!                   then
!                      Iface_Typ := Etype (Etype (Formal));
! 
!                      --  Generate:
!                      --    formal_iface_type! (actual.iface_tag)'reference
! 
!                      Iface_Tag :=
!                        Find_Interface_Tag (Etype (Actual), Iface_Typ);
!                      pragma Assert (Present (Iface_Tag));
! 
!                      Append_To (Plist,
!                        Make_Reference (Loc,
!                          Unchecked_Convert_To (Iface_Typ,
!                            Make_Selected_Component (Loc,
!                              Prefix =>
!                                Relocate_Node (Actual),
!                              Selector_Name =>
!                                New_Reference_To (Iface_Tag, Loc)))));
!                   else
!                      --  Generate:
!                      --    actual'reference
! 
!                      Append_To (Plist,
!                        Make_Reference (Loc, Relocate_Node (Actual)));
!                   end if;
                 end if;
  
                 Next_Actual (Actual);
*************** package body Exp_Ch9 is
*** 2248,2255 ****
  
           Append_To (Stats, Call);
  
!          --  If there are out or in/out parameters by copy
!          --  add assignment statements for the result values.
  
           if Present (Parms) then
              Actual := First_Actual (N);
--- 3210,3217 ----
  
           Append_To (Stats, Call);
  
!          --  If there are out or in/out parameters by copy add assignment
!          --  statements for the result values.
  
           if Present (Parms) then
              Actual := First_Actual (N);
*************** package body Exp_Ch9 is
*** 2270,2286 ****
                              Selector_Name =>
                                Make_Identifier (Loc, Chars (Formal)))));
  
!                   --  In all cases (including limited private types) we
!                   --  want the assignment to be valid.
  
                    Set_Assignment_OK (Name (N_Node));
  
                    --  If the call is the triggering alternative in an
!                   --  asynchronous select, or the entry_call alternative
!                   --  of a conditional entry call, the assignments for in-out
!                   --  parameters are incorporated into the statement list
!                   --  that follows, so that there are executed only if the
!                   --  entry call succeeds.
  
                    if (Nkind (Parent (N)) = N_Triggering_Alternative
                         and then N = Triggering_Statement (Parent (N)))
--- 3232,3248 ----
                              Selector_Name =>
                                Make_Identifier (Loc, Chars (Formal)))));
  
!                   --  In all cases (including limited private types) we want
!                   --  the assignment to be valid.
  
                    Set_Assignment_OK (Name (N_Node));
  
                    --  If the call is the triggering alternative in an
!                   --  asynchronous select, or the entry_call alternative of a
!                   --  conditional entry call, the assignments for in-out
!                   --  parameters are incorporated into the statement list that
!                   --  follows, so that there are executed only if the entry
!                   --  call succeeds.
  
                    if (Nkind (Parent (N)) = N_Triggering_Alternative
                         and then N = Triggering_Statement (Parent (N)))
*************** package body Exp_Ch9 is
*** 2531,2540 ****
     -----------------------------------
  
     function Build_Task_Proc_Specification (T : Entity_Id) return Node_Id is
!       Loc  : constant Source_Ptr := Sloc (T);
!       Nam  : constant Name_Id    := Chars (T);
!       Tdec : constant Node_Id    := Declaration_Node (T);
!       Ent  : Entity_Id;
  
     begin
        Ent :=
--- 3493,3501 ----
     -----------------------------------
  
     function Build_Task_Proc_Specification (T : Entity_Id) return Node_Id is
!       Loc : constant Source_Ptr := Sloc (T);
!       Nam : constant Name_Id    := Chars (T);
!       Ent : Entity_Id;
  
     begin
        Ent :=
*************** package body Exp_Ch9 is
*** 2545,2552 ****
        --  Associate the procedure with the task, if this is the declaration
        --  (and not the body) of the procedure.
  
!       if No (Task_Body_Procedure (Tdec)) then
!          Set_Task_Body_Procedure (Tdec, Ent);
        end if;
  
        return
--- 3506,3513 ----
        --  Associate the procedure with the task, if this is the declaration
        --  (and not the body) of the procedure.
  
!       if No (Task_Body_Procedure (T)) then
!          Set_Task_Body_Procedure (T, Ent);
        end if;
  
        return
*************** package body Exp_Ch9 is
*** 2577,2590 ****
        Op_Decls  : List_Id;
  
     begin
!       --  Make an unprotected version of the subprogram for use
!       --  within the same object, with a new name and an additional
!       --  parameter representing the object.
  
        Op_Decls := Declarations (N);
        N_Op_Spec :=
!         Build_Protected_Sub_Specification
!           (N, Pid, Unprotected => True);
  
        return
          Make_Subprogram_Body (Loc,
--- 3538,3550 ----
        Op_Decls  : List_Id;
  
     begin
!       --  Make an unprotected version of the subprogram for use within the same
!       --  object, with a new name and an additional parameter representing the
!       --  object.
  
        Op_Decls := Declarations (N);
        N_Op_Spec :=
!         Build_Protected_Sub_Specification (N, Pid, Unprotected_Mode);
  
        return
          Make_Subprogram_Body (Loc,
*************** package body Exp_Ch9 is
*** 2618,2639 ****
                Make_Defining_Identifier (Loc,
                  Chars => New_Internal_Name ('F'));
  
!             Efam_Decl :=
!               Make_Full_Type_Declaration (Loc,
!                 Defining_Identifier => Efam_Type,
!                 Type_Definition =>
!                   Make_Unconstrained_Array_Definition (Loc,
!                     Subtype_Marks => (New_List (
!                       New_Occurrence_Of (
                         Base_Type
!                          (Etype (Discrete_Subtype_Definition
!                            (Parent (Efam)))), Loc))),
  
                      Component_Definition =>
                        Make_Component_Definition (Loc,
                          Aliased_Present    => False,
                          Subtype_Indication =>
                            New_Reference_To (Standard_Character, Loc))));
  
              Insert_After (Current_Node, Efam_Decl);
              Current_Node := Efam_Decl;
--- 3578,3638 ----
                Make_Defining_Identifier (Loc,
                  Chars => New_Internal_Name ('F'));
  
!             declare
!                Bas : Entity_Id :=
                         Base_Type
!                         (Etype (Discrete_Subtype_Definition (Parent (Efam))));
!                Bas_Decl : Node_Id := Empty;
!                Lo, Hi   : Node_Id;
! 
!             begin
!                Get_Index_Bounds
!                  (Discrete_Subtype_Definition (Parent (Efam)), Lo, Hi);
!                if Scope (Bas) = Standard_Standard
!                  and then Bas = Base_Type (Standard_Integer)
!                  and then Has_Discriminants (Conctyp)
!                  and then Present
!                    (Discriminant_Default_Value (First_Discriminant (Conctyp)))
!                  and then
!                    (Denotes_Discriminant (Lo, True)
!                      or else Denotes_Discriminant (Hi, True))
!                then
!                   Bas :=
!                     Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
!                   Bas_Decl :=
!                     Make_Subtype_Declaration (Loc,
!                        Defining_Identifier => Bas,
!                        Subtype_Indication =>
!                          Make_Subtype_Indication (Loc,
!                            Subtype_Mark =>
!                              New_Occurrence_Of (Standard_Integer, Loc),
!                            Constraint =>
!                              Make_Range_Constraint (Loc,
!                                Range_Expression => Make_Range (Loc,
!                                  Make_Integer_Literal
!                                    (Loc, -Entry_Family_Bound),
!                                  Make_Integer_Literal
!                                    (Loc, Entry_Family_Bound - 1)))));
! 
!                   Insert_After (Current_Node, Bas_Decl);
!                   Current_Node := Bas_Decl;
!                   Analyze (Bas_Decl);
!                end if;
! 
!                Efam_Decl :=
!                  Make_Full_Type_Declaration (Loc,
!                    Defining_Identifier => Efam_Type,
!                    Type_Definition =>
!                      Make_Unconstrained_Array_Definition (Loc,
!                        Subtype_Marks =>
!                          (New_List (New_Occurrence_Of (Bas, Loc))),
  
                      Component_Definition =>
                        Make_Component_Definition (Loc,
                          Aliased_Present    => False,
                          Subtype_Indication =>
                            New_Reference_To (Standard_Character, Loc))));
+             end;
  
              Insert_After (Current_Node, Efam_Decl);
              Current_Node := Efam_Decl;
*************** package body Exp_Ch9 is
*** 2669,2676 ****
     -- Concurrent_Ref --
     --------------------
  
!    --  The expression returned for a reference to a concurrent
!    --  object has the form:
  
     --    taskV!(name)._Task_Id
  
--- 3668,3675 ----
     -- Concurrent_Ref --
     --------------------
  
!    --  The expression returned for a reference to a concurrent object has the
!    --  form:
  
     --    taskV!(name)._Task_Id
  
*************** package body Exp_Ch9 is
*** 2685,2692 ****
     --    objectV!(name.all)._Object
  
     --  here taskV and objectV are the types for the associated records, which
!    --  contain the required _Task_Id and _Object fields for tasks and
!    --  protected objects, respectively.
  
     --  For the case of a task type name, the expression is
  
--- 3684,3691 ----
     --    objectV!(name.all)._Object
  
     --  here taskV and objectV are the types for the associated records, which
!    --  contain the required _Task_Id and _Object fields for tasks and protected
!    --  objects, respectively.
  
     --  For the case of a task type name, the expression is
  
*************** package body Exp_Ch9 is
*** 2698,2705 ****
  
     --    objectR
  
!    --  which is a renaming of the _object field of the current object
!    --  object record, passed into protected operations as a parameter.
  
     function Concurrent_Ref (N : Node_Id) return Node_Id is
        Loc  : constant Source_Ptr := Sloc (N);
--- 3697,3704 ----
  
     --    objectR
  
!    --  which is a renaming of the _object field of the current object object
!    --  record, passed into protected operations as a parameter.
  
     function Concurrent_Ref (N : Node_Id) return Node_Id is
        Loc  : constant Source_Ptr := Sloc (N);
*************** package body Exp_Ch9 is
*** 2744,2751 ****
              end if;
           end loop;
  
!          --  We know that we are within the task body, so should have
!          --  found it in scope.
  
           raise Program_Error;
        end Is_Current_Task;
--- 3743,3750 ----
              end if;
           end loop;
  
!          --  We know that we are within the task body, so should have found it
!          --  in scope.
  
           raise Program_Error;
        end Is_Current_Task;
*************** package body Exp_Ch9 is
*** 2782,2791 ****
              else
                 declare
                    Decl   : Node_Id;
!                   T_Self : constant Entity_Id
!                     := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
!                   T_Body : constant Node_Id
!                     := Parent (Corresponding_Body (Parent (Entity (N))));
  
                 begin
                    Decl := Make_Object_Declaration (Loc,
--- 3781,3791 ----
              else
                 declare
                    Decl   : Node_Id;
!                   T_Self : constant Entity_Id :=
!                              Make_Defining_Identifier (Loc,
!                                Chars => New_Internal_Name ('T'));
!                   T_Body : constant Node_Id :=
!                              Parent (Corresponding_Body (Parent (Entity (N))));
  
                 begin
                    Decl := Make_Object_Declaration (Loc,
*************** package body Exp_Ch9 is
*** 2864,2885 ****
        S    : Node_Id;
  
     begin
!       --  The queues of entries and entry families appear in  textual
!       --  order in the associated record. The entry index is computed as
!       --  the sum of the number of queues for all entries that precede the
!       --  designated one, to which is added the index expression, if this
!       --  expression denotes a member of a family.
  
        --  The following is a place holder for the count of simple entries
  
        Num := Make_Integer_Literal (Sloc, 1);
  
!       --  We construct an expression which is a series of addition
!       --  operations. The first operand is the number of single entries that
!       --  precede this one, the second operand is the index value relative
!       --  to the start of the referenced family, and the remaining operands
!       --  are the lengths of the entry families that precede this entry, i.e.
!       --  the constructed expression is:
  
        --    number_simple_entries +
        --      (s'pos (index-value) - s'pos (family'first)) + 1 +
--- 3864,3885 ----
        S    : Node_Id;
  
     begin
!       --  The queues of entries and entry families appear in textual order in
!       --  the associated record. The entry index is computed as the sum of the
!       --  number of queues for all entries that precede the designated one, to
!       --  which is added the index expression, if this expression denotes a
!       --  member of a family.
  
        --  The following is a place holder for the count of simple entries
  
        Num := Make_Integer_Literal (Sloc, 1);
  
!       --  We construct an expression which is a series of addition operations.
!       --  The first operand is the number of single entries that precede this
!       --  one, the second operand is the index value relative to the start of
!       --  the referenced family, and the remaining operands are the lengths of
!       --  the entry families that precede this entry, i.e. the constructed
!       --  expression is:
  
        --    number_simple_entries +
        --      (s'pos (index-value) - s'pos (family'first)) + 1 +
*************** package body Exp_Ch9 is
*** 2887,2894 ****
  
        --  where index-value is the given index value, and s is the index
        --  subtype (we have to use pos because the subtype might be an
!       --  enumeration type preventing direct subtraction).
!       --  Note that the task entry array is one-indexed.
  
        --  The upper bound of the entry family may be a discriminant, so we
        --  retrieve the lower bound explicitly to compute offset, rather than
--- 3887,3894 ----
  
        --  where index-value is the given index value, and s is the index
        --  subtype (we have to use pos because the subtype might be an
!       --  enumeration type preventing direct subtraction). Note that the task
!       --  entry array is one-indexed.
  
        --  The upper bound of the entry family may be a discriminant, so we
        --  retrieve the lower bound explicitly to compute offset, rather than
*************** package body Exp_Ch9 is
*** 2954,2960 ****
  
     procedure Establish_Task_Master (N : Node_Id) is
        Call : Node_Id;
- 
     begin
        if Restriction_Active (No_Task_Hierarchy) = False then
           Call := Build_Runtime_Call (Sloc (N), RE_Enter_Master);
--- 3954,3959 ----
*************** package body Exp_Ch9 is
*** 3006,3018 ****
     --  We can distinguish the two cases by seeing whether the accept statement
     --  is part of a list. If not, then it must be in an accept alternative.
  
!    --  To expand the requeue statement, a label is provided at the end of
!    --  the accept statement or alternative of which it is a part, so that
!    --  the statement can be skipped after the requeue is complete.
!    --  This label is created here rather than during the expansion of the
!    --  accept statement, because it will be needed by any requeue
!    --  statements within the accept, which are expanded before the
!    --  accept.
  
     procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
--- 4005,4016 ----
     --  We can distinguish the two cases by seeing whether the accept statement
     --  is part of a list. If not, then it must be in an accept alternative.
  
!    --  To expand the requeue statement, a label is provided at the end of the
!    --  accept statement or alternative of which it is a part, so that the
!    --  statement can be skipped after the requeue is complete. This label is
!    --  created here rather than during the expansion of the accept statement,
!    --  because it will be needed by any requeue statements within the accept,
!    --  which are expanded before the accept.
  
     procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
*************** package body Exp_Ch9 is
*** 3048,3055 ****
  
           --  Create and declare two labels to be placed at the end of the
           --  accept statement. The first label is used to allow requeues to
!          --  skip the remainder of entry processing. The second label is
!          --  used to skip the remainder of entry processing if the rendezvous
           --  completes in the middle of the accept body.
  
           if Present (Handled_Statement_Sequence (N)) then
--- 4046,4053 ----
  
           --  Create and declare two labels to be placed at the end of the
           --  accept statement. The first label is used to allow requeues to
!          --  skip the remainder of entry processing. The second label is used
!          --  to skip the remainder of entry processing if the rendezvous
           --  completes in the middle of the accept body.
  
           if Present (Handled_Statement_Sequence (N)) then
*************** package body Exp_Ch9 is
*** 3136,3146 ****
                    Next (Alt);
                 end loop;
  
!                --  If we are the first accept statement, then we have to
!                --  create the Ann variable, as for the stand alone case,
!                --  except that it is inserted before the selective accept.
!                --  Similarly, a label for requeue expansion must be
!                --  declared.
  
                 if N = Accept_Statement (Alt) then
                    Ann :=
--- 4134,4143 ----
                    Next (Alt);
                 end loop;
  
!                --  If we are the first accept statement, then we have to create
!                --  the Ann variable, as for the stand alone case, except that
!                --  it is inserted before the selective accept. Similarly, a
!                --  label for requeue expansion must be declared.
  
                 if N = Accept_Statement (Alt) then
                    Ann :=
*************** package body Exp_Ch9 is
*** 3155,3162 ****
                    Insert_Before (Sel_Acc, Adecl);
                    Analyze (Adecl);
  
!                --  If we are not the first accept statement, then find the
!                --  Ann variable allocated by the first accept and use it.
  
                 else
                    Ann :=
--- 4152,4159 ----
                    Insert_Before (Sel_Acc, Adecl);
                    Analyze (Adecl);
  
!                --  If we are not the first accept statement, then find the Ann
!                --  variable allocated by the first accept and use it.
  
                 else
                    Ann :=
*************** package body Exp_Ch9 is
*** 3175,3204 ****
              Set_Needs_Debug_Info (Ann);
           end if;
  
!          --  Create renaming declarations for the entry formals. Each
!          --  reference to a formal becomes a dereference of a component
!          --  of the parameter block, whose address is held in Ann.
!          --  These declarations are eventually inserted into the accept
!          --  block, and analyzed there so that they have the proper scope
!          --  for gdb and do not conflict with other declarations.
  
           if Present (Parameter_Specifications (N))
             and then Present (Handled_Statement_Sequence (N))
           then
              declare
-                Formal : Entity_Id;
-                New_F  : Entity_Id;
                 Comp   : Entity_Id;
                 Decl   : Node_Id;
  
              begin
                 New_Scope (Ent);
                 Formal := First_Formal (Ent);
  
                 while Present (Formal) loop
!                   Comp   := Entry_Component (Formal);
!                   New_F  :=
                      Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
                    Set_Etype (New_F, Etype (Formal));
                    Set_Scope (New_F, Ent);
                    Set_Needs_Debug_Info (New_F);   --  That's the whole point.
--- 4172,4202 ----
              Set_Needs_Debug_Info (Ann);
           end if;
  
!          --  Create renaming declarations for the entry formals. Each reference
!          --  to a formal becomes a dereference of a component of the parameter
!          --  block, whose address is held in Ann. These declarations are
!          --  eventually inserted into the accept block, and analyzed there so
!          --  that they have the proper scope for gdb and do not conflict with
!          --  other declarations.
  
           if Present (Parameter_Specifications (N))
             and then Present (Handled_Statement_Sequence (N))
           then
              declare
                 Comp   : Entity_Id;
                 Decl   : Node_Id;
+                Formal : Entity_Id;
+                New_F  : Entity_Id;
  
              begin
                 New_Scope (Ent);
                 Formal := First_Formal (Ent);
  
                 while Present (Formal) loop
!                   Comp  := Entry_Component (Formal);
!                   New_F :=
                      Make_Defining_Identifier (Sloc (Formal), Chars (Formal));
+ 
                    Set_Etype (New_F, Etype (Formal));
                    Set_Scope (New_F, Ent);
                    Set_Needs_Debug_Info (New_F);   --  That's the whole point.
*************** package body Exp_Ch9 is
*** 3214,3229 ****
  
                    Decl :=
                      Make_Object_Renaming_Declaration (Loc,
!                     Defining_Identifier => New_F,
!                     Subtype_Mark => New_Reference_To (Etype (Formal), Loc),
!                     Name =>
!                       Make_Explicit_Dereference (Loc,
!                         Make_Selected_Component (Loc,
!                           Prefix =>
!                             Unchecked_Convert_To (Entry_Parameters_Type (Ent),
!                               New_Reference_To (Ann, Loc)),
!                           Selector_Name =>
!                             New_Reference_To (Comp, Loc))));
  
                    if No (Declarations (N)) then
                       Set_Declarations (N, New_List);
--- 4212,4230 ----
  
                    Decl :=
                      Make_Object_Renaming_Declaration (Loc,
!                       Defining_Identifier =>
!                         New_F,
!                       Subtype_Mark =>
!                         New_Reference_To (Etype (Formal), Loc),
!                       Name =>
!                         Make_Explicit_Dereference (Loc,
!                           Make_Selected_Component (Loc,
!                             Prefix =>
!                               Unchecked_Convert_To (
!                                 Entry_Parameters_Type (Ent),
!                                 New_Reference_To (Ann, Loc)),
!                             Selector_Name =>
!                               New_Reference_To (Comp, Loc))));
  
                    if No (Declarations (N)) then
                       Set_Declarations (N, New_List);
*************** package body Exp_Ch9 is
*** 3249,3258 ****
        Comps  : List_Id;
        T      : constant Entity_Id  := Defining_Identifier (N);
        D_T    : constant Entity_Id  := Designated_Type (T);
!       D_T2   : constant Entity_Id  := Make_Defining_Identifier
!                                         (Loc, New_Internal_Name ('D'));
!       E_T    : constant Entity_Id  := Make_Defining_Identifier
!                                         (Loc, New_Internal_Name ('E'));
        P_List : constant List_Id    := Build_Protected_Spec
                                          (N, RTE (RE_Address), False, D_T);
        Decl1  : Node_Id;
--- 4250,4259 ----
        Comps  : List_Id;
        T      : constant Entity_Id  := Defining_Identifier (N);
        D_T    : constant Entity_Id  := Designated_Type (T);
!       D_T2   : constant Entity_Id  := Make_Defining_Identifier (Loc,
!                                         Chars => New_Internal_Name ('D'));
!       E_T    : constant Entity_Id  := Make_Defining_Identifier (Loc,
!                                         Chars => New_Internal_Name ('E'));
        P_List : constant List_Id    := Build_Protected_Spec
                                          (N, RTE (RE_Address), False, D_T);
        Decl1  : Node_Id;
*************** package body Exp_Ch9 is
*** 3266,3272 ****
           Def1 :=
             Make_Access_Function_Definition (Loc,
               Parameter_Specifications => P_List,
!              Subtype_Mark => New_Copy (Subtype_Mark (Type_Definition (N))));
  
        else
           Def1 :=
--- 4267,4274 ----
           Def1 :=
             Make_Access_Function_Definition (Loc,
               Parameter_Specifications => P_List,
!              Result_Definition =>
!                New_Copy (Result_Definition (Type_Definition (N))));
  
        else
           Def1 :=
*************** package body Exp_Ch9 is
*** 3282,3289 ****
        Analyze (Decl1);
        Insert_After (N, Decl1);
  
!       --  Create Equivalent_Type, a record with two components for an
!       --  access to object and an access to subprogram.
  
        Comps := New_List (
          Make_Component_Declaration (Loc,
--- 4284,4291 ----
        Analyze (Decl1);
        Insert_After (N, Decl1);
  
!       --  Create Equivalent_Type, a record with two components for an access to
!       --  object and an access to subprogram.
  
        Comps := New_List (
          Make_Component_Declaration (Loc,
*************** package body Exp_Ch9 is
*** 3337,3348 ****
           return;
        end if;
  
!       --  The body of the entry barrier must be analyzed in the context of
!       --  the protected object, but its scope is external to it, just as any
!       --  other unprotected version of a protected operation. The specification
!       --  has been produced when the protected type declaration was elaborated.
!       --  We build the body, insert it in the enclosing scope, but analyze it
!       --  in the current context. A more uniform approach would be to treat a
        --  barrier just as a protected function, and discard the protected
        --  version of it because it is never called.
  
--- 4339,4350 ----
           return;
        end if;
  
!       --  The body of the entry barrier must be analyzed in the context of the
!       --  protected object, but its scope is external to it, just as any other
!       --  unprotected version of a protected operation. The specification has
!       --  been produced when the protected type declaration was elaborated. We
!       --  build the body, insert it in the enclosing scope, but analyze it in
!       --  the current context. A more uniform approach would be to treat
        --  barrier just as a protected function, and discard the protected
        --  version of it because it is never called.
  
*************** package body Exp_Ch9 is
*** 3361,3367 ****
  
           Update_Prival_Subtypes (B_F);
  
!          Set_Privals (Spec_Decl, N, Loc);
           Set_Discriminals (Spec_Decl);
           Set_Scope (Func, Scope (Prot));
  
--- 4363,4369 ----
  
           Update_Prival_Subtypes (B_F);
  
!          Set_Privals (Spec_Decl, N, Loc, After_Barrier => True);
           Set_Discriminals (Spec_Decl);
           Set_Scope (Func, Scope (Prot));
  
*************** package body Exp_Ch9 is
*** 3369,3384 ****
           Analyze_And_Resolve (Cond, Any_Boolean);
        end if;
  
!       --  The Ravenscar profile restricts barriers to simple variables
!       --  declared within the protected object. We also allow Boolean
!       --  constants, since these appear in several published examples
!       --  and are also allowed by the Aonix compiler.
  
!       --  Note that after analysis variables in this context will be
!       --  replaced by the corresponding prival, that is to say a renaming
!       --  of a selected component of the form _Object.Var. If expansion is
!       --  disabled, as within a generic, we check that the entity appears in
!       --  the current scope.
  
        if Is_Entity_Name (Cond) then
  
--- 4371,4386 ----
           Analyze_And_Resolve (Cond, Any_Boolean);
        end if;
  
!       --  The Ravenscar profile restricts barriers to simple variables declared
!       --  within the protected object. We also allow Boolean constants, since
!       --  these appear in several published examples and are also allowed by
!       --  the Aonix compiler.
  
!       --  Note that after analysis variables in this context will be replaced
!       --  by the corresponding prival, that is to say a renaming of a selected
!       --  component of the form _Object.Var. If expansion is disabled, as
!       --  within a generic, we check that the entity appears in the current
!       --  scope.
  
        if Is_Entity_Name (Cond) then
  
*************** package body Exp_Ch9 is
*** 3461,3471 ****
  
        while Present (Tasknm) loop
           Count := Count + 1;
!          Append_To (Component_Associations (Aggr),
!            Make_Component_Association (Loc,
!              Choices => New_List (
!                Make_Integer_Literal (Loc, Count)),
!              Expression => Concurrent_Ref (Tasknm)));
           Next (Tasknm);
        end loop;
  
--- 4463,4499 ----
  
        while Present (Tasknm) loop
           Count := Count + 1;
! 
!          --  A task interface class-wide type object is being aborted.
!          --  Retrieve its _task_id by calling a dispatching routine.
! 
!          if Ada_Version >= Ada_05
!            and then Ekind (Etype (Tasknm)) = E_Class_Wide_Type
!            and then Is_Interface      (Etype (Tasknm))
!            and then Is_Task_Interface (Etype (Tasknm))
!          then
!             Append_To (Component_Associations (Aggr),
!               Make_Component_Association (Loc,
!                 Choices => New_List (
!                   Make_Integer_Literal (Loc, Count)),
!                 Expression =>
! 
!                   --  Tasknm._disp_get_task_id
! 
!                     Make_Selected_Component (Loc,
!                       Prefix =>
!                         New_Copy_Tree (Tasknm),
!                       Selector_Name =>
!                         Make_Identifier (Loc, Name_uDisp_Get_Task_Id))));
! 
!          else
!             Append_To (Component_Associations (Aggr),
!               Make_Component_Association (Loc,
!                 Choices => New_List (
!                   Make_Integer_Literal (Loc, Count)),
!                 Expression => Concurrent_Ref (Tasknm)));
!          end if;
! 
           Next (Tasknm);
        end loop;
  
*************** package body Exp_Ch9 is
*** 3523,3532 ****
     --          Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
     --    end;
  
!    --  The first three declarations were already inserted ahead of the
!    --  accept statement by the Expand_Accept_Declarations procedure, which
!    --  was called directly from the semantics during analysis of the accept.
!    --  statement, before analyzing its contained statements.
  
     --  The declarations from the N_Accept_Statement, as noted in Sinfo, come
     --  from possible expansion activity (the original source of course does
--- 4551,4560 ----
     --          Exceptional_Complete_Rendezvous (Get_GNAT_Exception);
     --    end;
  
!    --  The first three declarations were already inserted ahead of the accept
!    --  statement by the Expand_Accept_Declarations procedure, which was called
!    --  directly from the semantics during analysis of the accept. statement,
!    --  before analyzing its contained statements.
  
     --  The declarations from the N_Accept_Statement, as noted in Sinfo, come
     --  from possible expansion activity (the original source of course does
*************** package body Exp_Ch9 is
*** 3555,3561 ****
  
        function Null_Statements (Stats : List_Id) return Boolean;
        --  Check for null statement sequence (i.e a list of labels and
!       --  null statements)
  
        function Null_Statements (Stats : List_Id) return Boolean is
           Stmt : Node_Id;
--- 4583,4593 ----
  
        function Null_Statements (Stats : List_Id) return Boolean;
        --  Check for null statement sequence (i.e a list of labels and
!       --  null statements).
! 
!       ---------------------
!       -- Null_Statements --
!       ---------------------
  
        function Null_Statements (Stats : List_Id) return Boolean is
           Stmt : Node_Id;
*************** package body Exp_Ch9 is
*** 3658,3668 ****
               Declarations               => Declarations (N),
               Handled_Statement_Sequence => Build_Accept_Body (N));
  
!          --  Prepend call to Accept_Call to main statement sequence
!          --  If the accept has exception handlers, the statement sequence
!          --  is wrapped in a block. Insert call and renaming declarations
!          --  in the declarations of the block, so they are elaborated before
!          --  the handlers.
  
           Call :=
             Make_Procedure_Call_Statement (Loc,
--- 4690,4700 ----
               Declarations               => Declarations (N),
               Handled_Statement_Sequence => Build_Accept_Body (N));
  
!          --  Prepend call to Accept_Call to main statement sequence If the
!          --  accept has exception handlers, the statement sequence is wrapped
!          --  in a block. Insert call and renaming declarations in the
!          --  declarations of the block, so they are elaborated before the
!          --  handlers.
  
           Call :=
             Make_Procedure_Call_Statement (Loc,
*************** package body Exp_Ch9 is
*** 3687,3714 ****
              D      : Node_Id;
              Next_D : Node_Id;
              Typ    : Entity_Id;
           begin
              D := First (Declarations (N));
- 
              while Present (D) loop
                 Next_D := Next (D);
  
                 if Nkind (D) = N_Object_Renaming_Declaration then
!                   --  The renaming declarations for the formals were
!                   --  created during analysis of the accept statement,
!                   --  and attached to the list of declarations. Place
!                   --  them now in the context of the accept block or
!                   --  subprogram.
  
                    Remove (D);
                    Typ := Entity (Subtype_Mark (D));
                    Insert_After (Call, D);
                    Analyze (D);
  
!                   --  If the formal is class_wide, it does not have an
!                   --  actual subtype. The analysis of the renaming declaration
!                   --  creates one, but we need to retain the class-wide
!                   --  nature of the entity.
  
                    if Is_Class_Wide_Type (Typ) then
                       Set_Etype (Defining_Identifier (D), Typ);
--- 4719,4746 ----
              D      : Node_Id;
              Next_D : Node_Id;
              Typ    : Entity_Id;
+ 
           begin
              D := First (Declarations (N));
              while Present (D) loop
                 Next_D := Next (D);
  
                 if Nkind (D) = N_Object_Renaming_Declaration then
! 
!                   --  The renaming declarations for the formals were created
!                   --  during analysis of the accept statement, and attached to
!                   --  the list of declarations. Place them now in the context
!                   --  of the accept block or subprogram.
  
                    Remove (D);
                    Typ := Entity (Subtype_Mark (D));
                    Insert_After (Call, D);
                    Analyze (D);
  
!                   --  If the formal is class_wide, it does not have an actual
!                   --  subtype. The analysis of the renaming declaration creates
!                   --  one, but we need to retain the class-wide nature of the
!                   --  entity.
  
                    if Is_Class_Wide_Type (Typ) then
                       Set_Etype (Defining_Identifier (D), Typ);
*************** package body Exp_Ch9 is
*** 3737,3745 ****
     -- Expand_N_Asynchronous_Select --
     ----------------------------------
  
!    --  This procedure assumes that the trigger statement is an entry call. A
!    --  delay alternative should already have been expanded into an entry call
!    --  to the appropriate delay object Wait entry.
  
     --  If the trigger is a task entry call, the select is implemented with
     --  a Task_Entry_Call:
--- 4769,4778 ----
     -- Expand_N_Asynchronous_Select --
     ----------------------------------
  
!    --  This procedure assumes that the trigger statement is an entry call or
!    --  a dispatching procedure call. A delay alternative should already have
!    --  been expanded into an entry call to the appropriate delay object Wait
!    --  entry.
  
     --  If the trigger is a task entry call, the select is implemented with
     --  a Task_Entry_Call:
*************** package body Exp_Ch9 is
*** 3770,3788 ****
     --       begin
     --          begin
     --             Abort_Undefer;
!    --             abortable-part
     --          at end
     --             _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
     --          end;
- 
     --       exception
!    --       when Abort_Signal => Abort_Undefer;
     --       end;
     --       parm := P.param;
     --       parm := P.param;
     --       ...
     --       if not C then
!    --          triggered-statements
     --       end if;
     --    end;
  
--- 4803,4821 ----
     --       begin
     --          begin
     --             Abort_Undefer;
!    --             <abortable-part>
     --          at end
     --             _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
     --          end;
     --       exception
!    --          when Abort_Signal => Abort_Undefer;
     --       end;
+ 
     --       parm := P.param;
     --       parm := P.param;
     --       ...
     --       if not C then
!    --          <triggered-statements>
     --       end if;
     --    end;
  
*************** package body Exp_Ch9 is
*** 3829,3848 ****
     --             Mode => Asynchronous_Call;
     --             Block => Bnn);
     --           if Enqueued (Bnn) then
!    --              <abortable part>
     --           end if;
     --        at end
     --           _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
     --        end;
- 
     --     exception
!    --        when Abort_Signal =>
!    --           Abort_Undefer;
!    --           null;
     --     end;
  
     --     if not Cancelled (Bnn) then
!    --        triggered statements
     --     end if;
     --  end;
  
--- 4862,4878 ----
     --             Mode => Asynchronous_Call;
     --             Block => Bnn);
     --           if Enqueued (Bnn) then
!    --              <abortable-part>
     --           end if;
     --        at end
     --           _clean;        --  Added by Exp_Ch7.Expand_Cleanup_Actions.
     --        end;
     --     exception
!    --        when Abort_Signal => Abort_Undefer;
     --     end;
  
     --     if not Cancelled (Bnn) then
!    --        <triggered-statements>
     --     end if;
     --  end;
  
*************** package body Exp_Ch9 is
*** 3865,3870 ****
--- 4895,4984 ----
     --       ...
     --  end;
  
+    --  Ada 2005 (AI-345): If the trigger is a dispatching call, the select is
+    --  expanded into:
+ 
+    --  declare
+    --     B   : Boolean := False;
+    --     Bnn : Communication_Block;
+    --     C   : Ada.Tags.Prim_Op_Kind;
+    --     P   : Parameters := (Param1 .. ParamN)
+    --     S   : constant Integer := DT_Position (<dispatching-call>);
+    --     U   : Boolean;
+ 
+    --  begin
+    --     disp_get_prim_op_kind (<object>, S, C);
+ 
+    --     if C = POK_Protected_Entry then
+    --        declare
+    --           procedure _clean is
+    --           begin
+    --              if Enqueued (Bnn) then
+    --                 Cancel_Protected_Entry_Call (Bnn);
+    --              end if;
+    --           end _clean;
+ 
+    --        begin
+    --           begin
+    --              disp_asynchronous_select
+    --                (Obj, S, P'address, Bnn, B);
+ 
+    --              Param1 := P.Param1;
+    --              ...
+    --              ParamN := P.ParamN;
+ 
+    --              if Enqueued (Bnn) then
+    --                 <abortable-statements>
+    --              end if;
+    --           at end
+    --              _clean;
+    --           end;
+    --        exception
+    --           when Abort_Signal => Abort_Undefer;
+    --        end;
+ 
+    --        if not Cancelled (Bnn) then
+    --           <triggering-statements>
+    --        end if;
+ 
+    --     elsif C = POK_Task_Entry then
+    --        declare
+    --           procedure _clean is
+    --           begin
+    --              Cancel_Task_Entry_Call (U);
+    --           end _clean;
+ 
+    --        begin
+    --           Abort_Defer;
+ 
+    --           disp_asynchronous_select
+    --             (<object>, S, P'address, Bnn, B);
+ 
+    --           Param1 := P.Param1;
+    --           ...
+    --           ParamN := P.ParamN;
+ 
+    --           begin
+    --              begin
+    --                 Abort_Undefer;
+    --                 <abortable-statements>
+    --              at end
+    --                 _clean;
+    --              end;
+    --           exception
+    --              when Abort_Signal => Abort_Undefer;
+    --           end;
+ 
+    --           if not U then
+    --              <triggering-statements>
+    --           end if;
+    --        end;
+ 
+    --     else
+    --        <dispatching-call>;
+    --        <triggering-statements>
+    --     end if;
+ 
     --  The job is to convert this to the asynchronous form
  
     --  If the trigger is a delay statement, it will have been expanded into a
*************** package body Exp_Ch9 is
*** 3881,3917 ****
  
     procedure Expand_N_Asynchronous_Select (N : Node_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
-       Trig   : constant Node_Id    := Triggering_Alternative (N);
        Abrt   : constant Node_Id    := Abortable_Part (N);
-       Tstats : constant List_Id    := Statements (Trig);
        Astats : constant List_Id    := Statements (Abrt);
  
!       Ecall           : Node_Id;
!       Concval         : Node_Id;
!       Ename           : Node_Id;
!       Index           : Node_Id;
!       Hdle            : List_Id;
!       Decls           : List_Id;
!       Decl            : Node_Id;
!       Parms           : List_Id;
!       Parm            : Node_Id;
!       Call            : Node_Id;
!       Stmts           : List_Id;
!       Enqueue_Call    : Node_Id;
!       Stmt            : Node_Id;
!       B               : Entity_Id;
!       Pdef            : Entity_Id;
!       Dblock_Ent      : Entity_Id;
!       N_Orig          : Node_Id;
!       Abortable_Block : Node_Id;
!       Cancel_Param    : Entity_Id;
!       Blkent          : Entity_Id;
!       Target_Undefer  : RE_Id;
!       Undefer_Args    : List_Id := No_List;
  
     begin
!       Blkent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
!       Ecall := Triggering_Statement (Trig);
  
        --  The arguments in the call may require dynamic allocation, and the
        --  call statement may have been transformed into a block. The block
--- 4995,5049 ----
  
     procedure Expand_N_Asynchronous_Select (N : Node_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
        Abrt   : constant Node_Id    := Abortable_Part (N);
        Astats : constant List_Id    := Statements (Abrt);
+       Trig   : constant Node_Id    := Triggering_Alternative (N);
+       Tstats : constant List_Id    := Statements (Trig);
  
!       Abort_Block_Ent   : Entity_Id;
!       Abortable_Block   : Node_Id;
!       Actuals           : List_Id;
!       Blk_Ent           : Entity_Id;
!       Blk_Typ           : Entity_Id;
!       Call              : Node_Id;
!       Call_Ent          : Entity_Id;
!       Cancel_Param      : Entity_Id;
!       Cleanup_Block     : Node_Id;
!       Cleanup_Block_Ent : Entity_Id;
!       Cleanup_Stmts     : List_Id;
!       Concval           : Node_Id;
!       Dblock_Ent        : Entity_Id;
!       Decl              : Node_Id;
!       Decls             : List_Id;
!       Ecall             : Node_Id;
!       Ename             : Node_Id;
!       Enqueue_Call      : Node_Id;
!       Formals           : List_Id;
!       Hdle              : List_Id;
!       Index             : Node_Id;
!       N_Orig            : Node_Id;
!       Obj               : Entity_Id;
!       Param             : Node_Id;
!       Params            : List_Id;
!       Pdef              : Entity_Id;
!       ProtE_Stmts       : List_Id;
!       ProtP_Stmts       : List_Id;
!       Stmt              : Node_Id;
!       Stmts             : List_Id;
!       Target_Undefer    : RE_Id;
!       TaskE_Stmts       : List_Id;
!       Undefer_Args      : List_Id := No_List;
! 
!       B   : Entity_Id;  --  Call status flag
!       Bnn : Entity_Id;  --  Communication block
!       C   : Entity_Id;  --  Call kind
!       P   : Entity_Id;  --  Parameter block
!       S   : Entity_Id;  --  Primitive operation slot
!       T   : Entity_Id;  --  Additional status flag
  
     begin
!       Blk_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
!       Ecall   := Triggering_Statement (Trig);
  
        --  The arguments in the call may require dynamic allocation, and the
        --  call statement may have been transformed into a block. The block
*************** package body Exp_Ch9 is
*** 3920,3926 ****
  
        if Nkind (Ecall) = N_Block_Statement then
           Ecall := First (Statements (Handled_Statement_Sequence (Ecall)));
- 
           while Nkind (Ecall) /= N_Procedure_Call_Statement
             and then Nkind (Ecall) /= N_Entry_Call_Statement
           loop
--- 5052,5057 ----
*************** package body Exp_Ch9 is
*** 3928,4038 ****
           end loop;
        end if;
  
!       --  If a delay was used as a trigger, it will have been expanded
!       --  into a procedure call. Convert it to the appropriate sequence of
!       --  statements, similar to what is done for a task entry call.
!       --  Note that this currently supports only Duration, Real_Time.Time,
!       --  and Calendar.Time.
  
        if Nkind (Ecall) = N_Procedure_Call_Statement then
  
!          --  Add a Delay_Block object to the parameter list of the
!          --  delay procedure to form the parameter list of the Wait
!          --  entry call.
  
!          Dblock_Ent := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
  
!          Pdef := Entity (Name (Ecall));
  
!          if Is_RTE (Pdef, RO_CA_Delay_For) then
!             Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_Duration), Loc);
  
!          elsif Is_RTE (Pdef, RO_CA_Delay_Until) then
!             Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_Calendar), Loc);
  
!          else pragma Assert (Is_RTE (Pdef, RO_RT_Delay_Until));
!             Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_RT), Loc);
!          end if;
  
!          Append_To (Parameter_Associations (Ecall),
!            Make_Attribute_Reference (Loc,
!              Prefix => New_Reference_To (Dblock_Ent, Loc),
!              Attribute_Name => Name_Unchecked_Access));
  
!          --  Create the inner block to protect the abortable part
  
!          Hdle := New_List (
!            Make_Exception_Handler (Loc,
!              Exception_Choices =>
!                New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
!              Statements => New_List (
!                Make_Procedure_Call_Statement (Loc,
!                  Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
  
!          Prepend_To (Astats,
!            Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)));
  
!          Abortable_Block :=
!            Make_Block_Statement (Loc,
!              Identifier => New_Reference_To (Blkent, Loc),
!              Handled_Statement_Sequence =>
!                Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => Astats),
!              Has_Created_Identifier => True,
!              Is_Asynchronous_Call_Block => True);
  
!          --  Append call to if Enqueue (When, DB'Unchecked_Access) then
  
!          Rewrite (Ecall,
!            Make_Implicit_If_Statement (N,
!              Condition => Make_Function_Call (Loc,
!                Name => Enqueue_Call,
!                Parameter_Associations => Parameter_Associations (Ecall)),
!              Then_Statements =>
!                New_List (Make_Block_Statement (Loc,
!                  Handled_Statement_Sequence =>
!                    Make_Handled_Sequence_Of_Statements (Loc,
!                      Statements => New_List (
!                        Make_Implicit_Label_Declaration (Loc,
!                          Defining_Identifier => Blkent,
!                          Label_Construct     => Abortable_Block),
!                        Abortable_Block),
!                      Exception_Handlers => Hdle)))));
  
!          Stmts := New_List (Ecall);
  
!          --  Construct statement sequence for new block
  
!          Append_To (Stmts,
!            Make_Implicit_If_Statement (N,
!              Condition => Make_Function_Call (Loc,
!                Name => New_Reference_To (
!                  RTE (RE_Timed_Out), Loc),
!                Parameter_Associations => New_List (
!                  Make_Attribute_Reference (Loc,
!                    Prefix => New_Reference_To (Dblock_Ent, Loc),
!                    Attribute_Name => Name_Unchecked_Access))),
!              Then_Statements => Tstats));
  
!          --  The result is the new block
  
!          Set_Entry_Cancel_Parameter (Blkent, Dblock_Ent);
  
!          Rewrite (N,
!            Make_Block_Statement (Loc,
!              Declarations => New_List (
!                Make_Object_Declaration (Loc,
!                  Defining_Identifier => Dblock_Ent,
!                  Aliased_Present => True,
!                  Object_Definition => New_Reference_To (
!                    RTE (RE_Delay_Block), Loc))),
  
!              Handled_Statement_Sequence =>
!                Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
  
!          Analyze (N);
!          return;
  
        else
           N_Orig := N;
--- 5059,5522 ----
           end loop;
        end if;
  
!       --  This is either a dispatching call or a delay statement used as a
!       --  trigger which was expanded into a procedure call.
  
        if Nkind (Ecall) = N_Procedure_Call_Statement then
+          if Ada_Version >= Ada_05
+            and then
+              (not Present (Original_Node (Ecall))
+                 or else
+               Nkind (Original_Node (Ecall)) /= N_Delay_Relative_Statement)
+          then
+             Extract_Dispatching_Call (Ecall, Call_Ent, Obj, Actuals, Formals);
  
!             Decls := New_List;
!             Stmts := New_List;
  
!             --  Call status flag processing, generate:
!             --    B : Boolean := False;
  
!             B := SEU.Build_B (Loc, Decls);
  
!             --  Communication block processing, generate:
!             --    Bnn : Communication_Block;
  
!             Bnn := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
  
!             Append_To (Decls,
!               Make_Object_Declaration (Loc,
!                 Defining_Identifier =>
!                   Bnn,
!                 Object_Definition =>
!                   New_Reference_To (RTE (RE_Communication_Block), Loc)));
  
!             --  Call kind processing, generate:
!             --    C : Ada.Tags.Prim_Op_Kind;
  
!             C := SEU.Build_C (Loc, Decls);
  
!             --  Parameter block processing
  
!             Blk_Typ := Build_Parameter_Block
!                          (Loc, Actuals, Formals, Decls);
!             P       := Parameter_Block_Pack
!                          (Loc, Blk_Typ, Actuals, Formals, Decls, Stmts);
  
!             --  Dispatch table slot processing, generate:
!             --    S : constant Integer :=
!             --          Ada.Tags.Get_Offset_Index (
!             --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
!             --            DT_Position (<dispatching-procedure>));
  
!             S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
  
!             --  Additional status flag processing, generate:
  
!             T := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
  
!             Append_To (Decls,
!               Make_Object_Declaration (Loc,
!                 Defining_Identifier =>
!                   T,
!                 Object_Definition =>
!                   New_Reference_To (Standard_Boolean, Loc)));
  
!             Append_To (Stmts,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (
!                     Find_Prim_Op (Etype (Etype (Obj)),
!                       Name_uDisp_Get_Prim_Op_Kind),
!                   Loc),
!                 Parameter_Associations =>
!                   New_List (
!                     New_Copy_Tree    (Obj),
!                     New_Reference_To (S, Loc),
!                     New_Reference_To (C, Loc))));
  
!             --  ---------------------------------------------------------------
!             --  Protected entry handling
  
!             --  Generate:
!             --    Param1 := P.Param1;
!             --    ...
!             --    ParamN := P.ParamN;
  
!             Cleanup_Stmts := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
  
!             --  Generate:
!             --    _dispatching_asynchronous_select
!             --      (<object>, S, P'address, Bnn, B);
  
!             Prepend_To (Cleanup_Stmts,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (
!                     Find_Prim_Op (Etype (Etype (Obj)),
!                       Name_uDisp_Asynchronous_Select),
!                   Loc),
!                 Parameter_Associations =>
!                   New_List (
!                     New_Copy_Tree    (Obj),
!                     New_Reference_To (S, Loc),
!                     Make_Attribute_Reference (Loc,
!                       Prefix => New_Reference_To (P, Loc),
!                       Attribute_Name => Name_Address),
!                     New_Reference_To (Bnn, Loc),
!                     New_Reference_To (B, Loc))));
! 
!             --  Generate:
!             --    if Enqueued (Bnn) then
!             --       <abortable-statements>
!             --    end if;
! 
!             Append_To (Cleanup_Stmts,
!               Make_If_Statement (Loc,
!                 Condition =>
!                   Make_Function_Call (Loc,
!                     Name =>
!                       New_Reference_To (RTE (RE_Enqueued), Loc),
!                     Parameter_Associations =>
!                       New_List (
!                         New_Reference_To (Bnn, Loc))),
! 
!                 Then_Statements =>
!                   New_Copy_List_Tree (Astats)));
! 
!             --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
!             --  will then generate a _clean for the communication block Bnn.
! 
!             --  Generate:
!             --    declare
!             --       procedure _clean is
!             --       begin
!             --          if Enqueued (Bnn) then
!             --             Cancel_Protected_Entry_Call (Bnn);
!             --          end if;
!             --       end _clean;
!             --    begin
!             --       Cleanup_Stmts
!             --    at end
!             --       _clean;
!             --    end;
! 
!             Cleanup_Block_Ent :=
!               Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
! 
!             Cleanup_Block := SEU.Build_Cleanup_Block (Loc,
!               Cleanup_Block_Ent, Cleanup_Stmts, Bnn);
! 
!             --  Wrap the cleanup block in an exception handling block
! 
!             --  Generate:
!             --    begin
!             --       Cleanup_Block
!             --    exception
!             --       when Abort_Signal => Abort_Undefer;
!             --    end;
! 
!             Abort_Block_Ent :=
!               Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
! 
!             ProtE_Stmts :=
!               New_List (
!                 Make_Implicit_Label_Declaration (Loc,
!                   Defining_Identifier => Abort_Block_Ent),
! 
!                 SEU.Build_Abort_Block (Loc,
!                   Abort_Block_Ent, Cleanup_Block_Ent, Cleanup_Block));
! 
!             --  Generate:
!             --    if not Cancelled (Bnn) then
!             --       <triggering-statements>
!             --    end if;
! 
!             Append_To (ProtE_Stmts,
!               Make_If_Statement (Loc,
!                 Condition =>
!                   Make_Op_Not (Loc,
!                     Right_Opnd =>
!                       Make_Function_Call (Loc,
!                         Name =>
!                           New_Reference_To (RTE (RE_Cancelled), Loc),
!                         Parameter_Associations =>
!                           New_List (
!                             New_Reference_To (Bnn, Loc)))),
! 
!                 Then_Statements =>
!                   New_Copy_List_Tree (Tstats)));
! 
!             --  ---------------------------------------------------------------
!             --  Task entry handling
! 
!             --  Generate:
!             --    Param1 := P.Param1;
!             --    ...
!             --    ParamN := P.ParamN;
! 
!             TaskE_Stmts := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
! 
!             --  Generate:
!             --    _dispatching_asynchronous_select
!             --      (<object>, S, P'address, Bnn, B);
! 
!             Prepend_To (TaskE_Stmts,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (
!                     Find_Prim_Op (Etype (Etype (Obj)),
!                       Name_uDisp_Asynchronous_Select),
!                   Loc),
!                 Parameter_Associations =>
!                   New_List (
!                     New_Copy_Tree    (Obj),
!                     New_Reference_To (S, Loc),
!                     Make_Attribute_Reference (Loc,
!                       Prefix => New_Reference_To (P, Loc),
!                       Attribute_Name => Name_Address),
!                     New_Reference_To (Bnn, Loc),
!                     New_Reference_To (B, Loc))));
! 
!             --  Generate:
!             --    Abort_Defer;
! 
!             Prepend_To (TaskE_Stmts,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Abort_Defer), Loc),
!                 Parameter_Associations =>
!                   No_List));
! 
!             --  Generate:
!             --    Abort_Undefer;
!             --    <abortable-statements>
! 
!             Cleanup_Stmts := New_Copy_List_Tree (Astats);
! 
!             Prepend_To (Cleanup_Stmts,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Abort_Undefer), Loc),
!                 Parameter_Associations =>
!                   No_List));
! 
!             --  Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
!             --  will generate a _clean for the additional status flag.
! 
!             --  Generate:
!             --    declare
!             --       procedure _clean is
!             --       begin
!             --          Cancel_Task_Entry_Call (U);
!             --       end _clean;
!             --    begin
!             --       Cleanup_Stmts
!             --    at end
!             --       _clean;
!             --    end;
! 
!             Cleanup_Block_Ent :=
!               Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
! 
!             Cleanup_Block := SEU.Build_Cleanup_Block (Loc,
!               Cleanup_Block_Ent, Cleanup_Stmts, T);
! 
!             --  Wrap the cleanup block in an exception handling block
! 
!             --  Generate:
!             --    begin
!             --       Cleanup_Block
!             --    exception
!             --       when Abort_Signal => Abort_Undefer;
!             --    end;
! 
!             Abort_Block_Ent :=
!               Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
! 
!             Append_To (TaskE_Stmts,
!               Make_Implicit_Label_Declaration (Loc,
!                 Defining_Identifier => Abort_Block_Ent));
! 
!             Append_To (TaskE_Stmts,
!               SEU.Build_Abort_Block (Loc,
!                 Abort_Block_Ent, Cleanup_Block_Ent, Cleanup_Block));
! 
!             --  Generate:
!             --    if not T then
!             --       <triggering-statements>
!             --    end if;
! 
!             Append_To (TaskE_Stmts,
!               Make_If_Statement (Loc,
!                 Condition =>
!                   Make_Op_Not (Loc,
!                     Right_Opnd =>
!                       New_Reference_To (T, Loc)),
! 
!                 Then_Statements =>
!                   New_Copy_List_Tree (Tstats)));
! 
!             -------------------------------------------------------------------
!             --  Protected procedure handling
! 
!             --  Generate:
!             --    <dispatching-call>;
!             --    <triggering-statements>
! 
!             ProtP_Stmts := New_Copy_List_Tree (Tstats);
!             Prepend_To (ProtP_Stmts, New_Copy_Tree (Ecall));
! 
!             --  Generate:
!             --    if C = POK_Procedure_Entry then
!             --       ProtE_Stmts
!             --    elsif C = POK_Task_Entry then
!             --       TaskE_Stmts
!             --    else
!             --       ProtP_Stmts
!             --    end if;
! 
!             Append_To (Stmts,
!               Make_If_Statement (Loc,
!                 Condition =>
!                   Make_Op_Eq (Loc,
!                     Left_Opnd =>
!                       New_Reference_To (C, Loc),
!                     Right_Opnd =>
!                       New_Reference_To (RTE (RE_POK_Protected_Entry), Loc)),
! 
!                 Then_Statements =>
!                   ProtE_Stmts,
! 
!                 Elsif_Parts =>
!                   New_List (
!                     Make_Elsif_Part (Loc,
!                       Condition =>
!                         Make_Op_Eq (Loc,
!                           Left_Opnd =>
!                             New_Reference_To (C, Loc),
!                           Right_Opnd =>
!                             New_Reference_To (RTE (RE_POK_Task_Entry), Loc)),
! 
!                       Then_Statements =>
!                         TaskE_Stmts)),
! 
!                 Else_Statements =>
!                   ProtP_Stmts));
! 
!             Rewrite (N,
!               Make_Block_Statement (Loc,
!                 Declarations =>
!                   Decls,
!                 Handled_Statement_Sequence =>
!                   Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
! 
!             Analyze (N);
!             return;
! 
!          --  Delay triggering statement processing
! 
!          else
!             --  Add a Delay_Block object to the parameter list of the delay
!             --  procedure to form the parameter list of the Wait entry call.
! 
!             Dblock_Ent :=
!               Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
! 
!             Pdef := Entity (Name (Ecall));
! 
!             if Is_RTE (Pdef, RO_CA_Delay_For) then
!                Enqueue_Call :=
!                  New_Reference_To (RTE (RE_Enqueue_Duration), Loc);
! 
!             elsif Is_RTE (Pdef, RO_CA_Delay_Until) then
!                Enqueue_Call :=
!                  New_Reference_To (RTE (RE_Enqueue_Calendar), Loc);
! 
!             else pragma Assert (Is_RTE (Pdef, RO_RT_Delay_Until));
!                Enqueue_Call := New_Reference_To (RTE (RE_Enqueue_RT), Loc);
!             end if;
! 
!             Append_To (Parameter_Associations (Ecall),
!               Make_Attribute_Reference (Loc,
!                 Prefix => New_Reference_To (Dblock_Ent, Loc),
!                 Attribute_Name => Name_Unchecked_Access));
! 
!             --  Create the inner block to protect the abortable part
! 
!             Hdle := New_List (
!               Make_Exception_Handler (Loc,
!                 Exception_Choices =>
!                   New_List (New_Reference_To (Stand.Abort_Signal, Loc)),
!                 Statements => New_List (
!                   Make_Procedure_Call_Statement (Loc,
!                     Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)))));
! 
!             Prepend_To (Astats,
!               Make_Procedure_Call_Statement (Loc,
!                 Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)));
! 
!             Abortable_Block :=
!               Make_Block_Statement (Loc,
!                 Identifier => New_Reference_To (Blk_Ent, Loc),
!                 Handled_Statement_Sequence =>
!                   Make_Handled_Sequence_Of_Statements (Loc,
!                     Statements => Astats),
!                 Has_Created_Identifier => True,
!                 Is_Asynchronous_Call_Block => True);
! 
!             --  Append call to if Enqueue (When, DB'Unchecked_Access) then
! 
!             Rewrite (Ecall,
!               Make_Implicit_If_Statement (N,
!                 Condition => Make_Function_Call (Loc,
!                   Name => Enqueue_Call,
!                   Parameter_Associations => Parameter_Associations (Ecall)),
!                 Then_Statements =>
!                   New_List (Make_Block_Statement (Loc,
!                     Handled_Statement_Sequence =>
!                       Make_Handled_Sequence_Of_Statements (Loc,
!                         Statements => New_List (
!                           Make_Implicit_Label_Declaration (Loc,
!                             Defining_Identifier => Blk_Ent,
!                             Label_Construct     => Abortable_Block),
!                           Abortable_Block),
!                         Exception_Handlers => Hdle)))));
! 
!             Stmts := New_List (Ecall);
! 
!             --  Construct statement sequence for new block
! 
!             Append_To (Stmts,
!               Make_Implicit_If_Statement (N,
!                 Condition => Make_Function_Call (Loc,
!                   Name => New_Reference_To (
!                     RTE (RE_Timed_Out), Loc),
!                   Parameter_Associations => New_List (
!                     Make_Attribute_Reference (Loc,
!                       Prefix => New_Reference_To (Dblock_Ent, Loc),
!                       Attribute_Name => Name_Unchecked_Access))),
!                 Then_Statements => Tstats));
! 
!             --  The result is the new block
! 
!             Set_Entry_Cancel_Parameter (Blk_Ent, Dblock_Ent);
! 
!             Rewrite (N,
!               Make_Block_Statement (Loc,
!                 Declarations => New_List (
!                   Make_Object_Declaration (Loc,
!                     Defining_Identifier => Dblock_Ent,
!                     Aliased_Present => True,
!                     Object_Definition => New_Reference_To (
!                       RTE (RE_Delay_Block), Loc))),
! 
!                 Handled_Statement_Sequence =>
!                   Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
! 
!             Analyze (N);
!             return;
!          end if;
  
        else
           N_Orig := N;
*************** package body Exp_Ch9 is
*** 4050,4058 ****
  
           Decl := First (Decls);
           while Present (Decl)
!            and then (Nkind (Decl) /= N_Object_Declaration
!              or else not Is_RTE
!                (Etype (Object_Definition (Decl)), RE_Communication_Block))
           loop
              Next (Decl);
           end loop;
--- 5534,5543 ----
  
           Decl := First (Decls);
           while Present (Decl)
!            and then
!              (Nkind (Decl) /= N_Object_Declaration
!                or else not Is_RTE (Etype (Object_Definition (Decl)),
!                                    RE_Communication_Block))
           loop
              Next (Decl);
           end loop;
*************** package body Exp_Ch9 is
*** 4060,4066 ****
           pragma Assert (Present (Decl));
           Cancel_Param := Defining_Identifier (Decl);
  
!          --  Change the mode of the Protected_Entry_Call call.
           --  Protected_Entry_Call (
           --    Object => po._object'Access,
           --    E => <entry index>;
--- 5545,5552 ----
           pragma Assert (Present (Decl));
           Cancel_Param := Defining_Identifier (Decl);
  
!          --  Change the mode of the Protected_Entry_Call call
! 
           --  Protected_Entry_Call (
           --    Object => po._object'Access,
           --    E => <entry index>;
*************** package body Exp_Ch9 is
*** 4070,4076 ****
  
           Stmt := First (Stmts);
  
!          --  Skip assignments to temporaries created for in-out parameters.
           --  This makes unwarranted assumptions about the shape of the expanded
           --  tree for the call, and should be cleaned up ???
  
--- 5556,5563 ----
  
           Stmt := First (Stmts);
  
!          --  Skip assignments to temporaries created for in-out parameters
! 
           --  This makes unwarranted assumptions about the shape of the expanded
           --  tree for the call, and should be cleaned up ???
  
*************** package body Exp_Ch9 is
*** 4080,4098 ****
  
           Call := Stmt;
  
!          Parm := First (Parameter_Associations (Call));
!          while Present (Parm)
!            and then not Is_RTE (Etype (Parm), RE_Call_Modes)
           loop
!             Next (Parm);
           end loop;
  
!          pragma Assert (Present (Parm));
!          Rewrite (Parm, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
!          Analyze (Parm);
  
!          --  Append an if statement to execute the abortable part.
!          --  if Enqueued (Bnn) then
  
           Append_To (Stmts,
             Make_Implicit_If_Statement (N,
--- 5567,5587 ----
  
           Call := Stmt;
  
!          Param := First (Parameter_Associations (Call));
!          while Present (Param)
!            and then not Is_RTE (Etype (Param), RE_Call_Modes)
           loop
!             Next (Param);
           end loop;
  
!          pragma Assert (Present (Param));
!          Rewrite (Param, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
!          Analyze (Param);
  
!          --  Append an if statement to execute the abortable part
! 
!          --  Generate:
!          --    if Enqueued (Bnn) then
  
           Append_To (Stmts,
             Make_Implicit_If_Statement (N,
*************** package body Exp_Ch9 is
*** 4105,4111 ****
  
           Abortable_Block :=
             Make_Block_Statement (Loc,
!              Identifier => New_Reference_To (Blkent, Loc),
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => Stmts),
--- 5594,5600 ----
  
           Abortable_Block :=
             Make_Block_Statement (Loc,
!              Identifier => New_Reference_To (Blk_Ent, Loc),
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => Stmts),
*************** package body Exp_Ch9 is
*** 4131,4137 ****
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => New_List (
                     Make_Implicit_Label_Declaration (Loc,
!                      Defining_Identifier => Blkent,
                       Label_Construct     => Abortable_Block),
                     Abortable_Block),
  
--- 5620,5626 ----
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => New_List (
                     Make_Implicit_Label_Declaration (Loc,
!                      Defining_Identifier => Blk_Ent,
                       Label_Construct     => Abortable_Block),
                     Abortable_Block),
  
*************** package body Exp_Ch9 is
*** 4219,4225 ****
  
           Abortable_Block :=
             Make_Block_Statement (Loc,
!              Identifier => New_Reference_To (Blkent, Loc),
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => Astats),
--- 5708,5714 ----
  
           Abortable_Block :=
             Make_Block_Statement (Loc,
!              Identifier => New_Reference_To (Blk_Ent, Loc),
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => Astats),
*************** package body Exp_Ch9 is
*** 4232,4261 ****
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => New_List (
                     Make_Implicit_Label_Declaration (Loc,
!                      Defining_Identifier => Blkent,
                       Label_Construct     => Abortable_Block),
                     Abortable_Block),
                   Exception_Handlers => Hdle)));
  
           --  Create new call statement
  
!          Parms := Parameter_Associations (Call);
!          Append_To (Parms, New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
!          Append_To (Parms, New_Reference_To (B, Loc));
           Rewrite (Call,
             Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
!              Parameter_Associations => Parms));
  
           --  Construct statement sequence for new block
  
           Append_To (Stmts,
             Make_Implicit_If_Statement (N,
!              Condition => Make_Op_Not (Loc,
!                New_Reference_To (Cancel_Param, Loc)),
               Then_Statements => Tstats));
  
!          --  Protected the call against abortion
  
           Prepend_To (Stmts,
             Make_Procedure_Call_Statement (Loc,
--- 5721,5756 ----
                 Make_Handled_Sequence_Of_Statements (Loc,
                   Statements => New_List (
                     Make_Implicit_Label_Declaration (Loc,
!                      Defining_Identifier => Blk_Ent,
                       Label_Construct     => Abortable_Block),
                     Abortable_Block),
                   Exception_Handlers => Hdle)));
  
           --  Create new call statement
  
!          Params := Parameter_Associations (Call);
! 
!          Append_To (Params,
!            New_Reference_To (RTE (RE_Asynchronous_Call), Loc));
!          Append_To (Params,
!            New_Reference_To (B, Loc));
! 
           Rewrite (Call,
             Make_Procedure_Call_Statement (Loc,
!              Name =>
!                New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
!              Parameter_Associations => Params));
  
           --  Construct statement sequence for new block
  
           Append_To (Stmts,
             Make_Implicit_If_Statement (N,
!              Condition =>
!                Make_Op_Not (Loc,
!                  New_Reference_To (Cancel_Param, Loc)),
               Then_Statements => Tstats));
  
!          --  Protected the call against abort
  
           Prepend_To (Stmts,
             Make_Procedure_Call_Statement (Loc,
*************** package body Exp_Ch9 is
*** 4263,4269 ****
               Parameter_Associations => Empty_List));
        end if;
  
!       Set_Entry_Cancel_Parameter (Blkent, Cancel_Param);
  
        --  The result is the new block
  
--- 5758,5764 ----
               Parameter_Associations => Empty_List));
        end if;
  
!       Set_Entry_Cancel_Parameter (Blk_Ent, Cancel_Param);
  
        --  The result is the new block
  
*************** package body Exp_Ch9 is
*** 4365,4385 ****
     --         ...
     --    end;
  
     procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is
        Loc : constant Source_Ptr := Sloc (N);
        Alt : constant Node_Id    := Entry_Call_Alternative (N);
        Blk : Node_Id             := Entry_Call_Statement (Alt);
        Transient_Blk : Node_Id;
  
!       Parms   : List_Id;
!       Parm    : Node_Id;
!       Call    : Node_Id;
!       Stmts   : List_Id;
!       B       : Entity_Id;
!       Decl    : Node_Id;
!       Stmt    : Node_Id;
  
     begin
        --  As described above, The entry alternative is transformed into a
        --  block that contains the gnulli call, and possibly assignment
        --  statements for in-out parameters. The gnulli call may itself be
--- 5860,6073 ----
     --         ...
     --    end;
  
+    --  Ada 2005 (AI-345): A dispatching conditional entry call is converted
+    --  into:
+ 
+    --    declare
+    --       B : Boolean := False;
+    --       C : Ada.Tags.Prim_Op_Kind;
+    --       P : Parameters := (Param1 .. ParamN);
+    --       S : constant Integer := DT_Position (<dispatching-procedure>);
+ 
+    --    begin
+    --       disp_conditional_select (<object>, S, P'address, C, B);
+ 
+    --       if C = POK_Protected_Entry
+    --         or else C = POK_Task_Entry
+    --       then
+    --          Param1 := P.Param1;
+    --          ...
+    --          ParamN := P.ParamN;
+    --       end if;
+ 
+    --       if B then
+    --          if C = POK_Procedure
+    --            or else C = POK_Protected_Procedure
+    --            or else C = POK_Task_Procedure
+    --          then
+    --             <dispatching-procedure> (<object>, Param1 .. ParamN);
+    --          end if;
+    --          <normal-statements>
+    --       else
+    --          <else-statements>
+    --       end if;
+    --    end;
+ 
     procedure Expand_N_Conditional_Entry_Call (N : Node_Id) is
        Loc : constant Source_Ptr := Sloc (N);
        Alt : constant Node_Id    := Entry_Call_Alternative (N);
        Blk : Node_Id             := Entry_Call_Statement (Alt);
        Transient_Blk : Node_Id;
  
!       Actuals  : List_Id;
!       Blk_Typ  : Entity_Id;
!       Call     : Node_Id;
!       Call_Ent : Entity_Id;
!       Decl     : Node_Id;
!       Decls    : List_Id;
!       Formals  : List_Id;
!       N_Stats  : List_Id;
!       Obj      : Entity_Id;
!       Param    : Node_Id;
!       Params   : List_Id;
!       Stmt     : Node_Id;
!       Stmts    : List_Id;
!       Unpack   : List_Id;
! 
!       B        : Entity_Id;  --  Call status flag
!       C        : Entity_Id;  --  Call kind
!       P        : Entity_Id;  --  Parameter block
!       S        : Entity_Id;  --  Primitive operation slot
  
     begin
+       if Ada_Version >= Ada_05
+         and then Nkind (Blk) = N_Procedure_Call_Statement
+       then
+          Extract_Dispatching_Call (Blk, Call_Ent, Obj, Actuals, Formals);
+ 
+          Decls := New_List;
+          Stmts := New_List;
+ 
+          --  Call status flag processing, generate:
+          --    B : Boolean := False;
+ 
+          B := SEU.Build_B (Loc, Decls);
+ 
+          --  Call kind processing, generate:
+          --    C : Ada.Tags.Prim_Op_Kind;
+ 
+          C := SEU.Build_C (Loc, Decls);
+ 
+          --  Parameter block processing
+ 
+          Blk_Typ := Build_Parameter_Block (Loc, Actuals, Formals, Decls);
+          P       := Parameter_Block_Pack  (Loc, Blk_Typ, Actuals, Formals,
+                       Decls, Stmts);
+ 
+          --  Dispatch table slot processing, generate:
+          --    S : constant Integer :=
+          --          Ada.Tags.Get_Offset_Index (
+          --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
+          --            DT_Position (<dispatching-procedure>));
+ 
+          S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
+ 
+          --  Generate:
+          --    _dispatching_conditional_select (<object>, S, P'address, C, B);
+ 
+          Append_To (Stmts,
+            Make_Procedure_Call_Statement (Loc,
+              Name =>
+                New_Reference_To (
+                  Find_Prim_Op (Etype (Etype (Obj)),
+                    Name_uDisp_Conditional_Select),
+                  Loc),
+              Parameter_Associations =>
+                New_List (
+                  New_Copy_Tree    (Obj),
+                  New_Reference_To (S, Loc),
+                  Make_Attribute_Reference (Loc,
+                    Prefix => New_Reference_To (P, Loc),
+                    Attribute_Name => Name_Address),
+                  New_Reference_To (C, Loc),
+                  New_Reference_To (B, Loc))));
+ 
+          --  Generate:
+          --    if C = POK_Protected_Entry
+          --      or else C = POK_Task_Entry
+          --    then
+          --       Param1 := P.Param1;
+          --       ...
+          --       ParamN := P.ParamN;
+          --    end if;
+ 
+          Unpack := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
+ 
+          --  Generate the if statement only when the packed parameters need
+          --  explicit assignments to their corresponding actuals.
+ 
+          if Present (Unpack) then
+             Append_To (Stmts,
+               Make_If_Statement (Loc,
+ 
+                 Condition =>
+                   Make_Or_Else (Loc,
+                     Left_Opnd =>
+                       Make_Op_Eq (Loc,
+                         Left_Opnd =>
+                           New_Reference_To (C, Loc),
+                         Right_Opnd =>
+                           New_Reference_To (RTE (
+                             RE_POK_Protected_Entry), Loc)),
+                     Right_Opnd =>
+                       Make_Op_Eq (Loc,
+                         Left_Opnd =>
+                           New_Reference_To (C, Loc),
+                         Right_Opnd =>
+                           New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
+ 
+                  Then_Statements => Unpack));
+          end if;
+ 
+          --  Generate:
+          --    if B then
+          --       if C = POK_Procedure
+          --         or else C = POK_Protected_Procedure
+          --         or else C = POK_Task_Procedure
+          --       then
+          --          <dispatching-procedure-call>
+          --       end if;
+          --       <normal-statements>
+          --    else
+          --       <else-statements>
+          --    end if;
+ 
+          N_Stats := New_Copy_List_Tree (Statements (Alt));
+ 
+          Prepend_To (N_Stats,
+            Make_If_Statement (Loc,
+              Condition =>
+                Make_Or_Else (Loc,
+                  Left_Opnd =>
+                    Make_Op_Eq (Loc,
+                      Left_Opnd =>
+                        New_Reference_To (C, Loc),
+                      Right_Opnd =>
+                        New_Reference_To (RTE (RE_POK_Procedure), Loc)),
+ 
+                  Right_Opnd =>
+                    Make_Or_Else (Loc,
+                      Left_Opnd =>
+                        Make_Op_Eq (Loc,
+                          Left_Opnd =>
+                            New_Reference_To (C, Loc),
+                          Right_Opnd =>
+                            New_Reference_To (RTE (
+                              RE_POK_Protected_Procedure), Loc)),
+ 
+                      Right_Opnd =>
+                        Make_Op_Eq (Loc,
+                          Left_Opnd =>
+                            New_Reference_To (C, Loc),
+                          Right_Opnd =>
+                            New_Reference_To (RTE (
+                              RE_POK_Task_Procedure), Loc)))),
+ 
+              Then_Statements =>
+                New_List (Blk)));
+ 
+          Append_To (Stmts,
+            Make_If_Statement (Loc,
+              Condition       => New_Reference_To (B, Loc),
+              Then_Statements => N_Stats,
+              Else_Statements => Else_Statements (N)));
+ 
+          Rewrite (N,
+            Make_Block_Statement (Loc,
+              Declarations               => Decls,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
+ 
        --  As described above, The entry alternative is transformed into a
        --  block that contains the gnulli call, and possibly assignment
        --  statements for in-out parameters. The gnulli call may itself be
*************** package body Exp_Ch9 is
*** 4387,4496 ****
        --  require it. We need to retrieve the call to complete its parameter
        --  list.
  
!       Transient_Blk :=
!          First_Real_Statement (Handled_Statement_Sequence (Blk));
! 
!       if Present (Transient_Blk)
!         and then
!         Nkind (Transient_Blk) =  N_Block_Statement
!       then
!          Blk := Transient_Blk;
!       end if;
! 
!       Stmts := Statements (Handled_Statement_Sequence (Blk));
  
!       Stmt := First (Stmts);
  
!       while Nkind (Stmt) /= N_Procedure_Call_Statement loop
!          Next (Stmt);
!       end loop;
  
!       Call := Stmt;
  
!       Parms := Parameter_Associations (Call);
  
!       if Is_RTE (Entity (Name (Call)), RE_Protected_Entry_Call) then
  
!          --  Substitute Conditional_Entry_Call for Simple_Call
!          --  parameter.
  
!          Parm := First (Parms);
!          while Present (Parm)
!            and then not Is_RTE (Etype (Parm), RE_Call_Modes)
!          loop
!             Next (Parm);
!          end loop;
  
!          pragma Assert (Present (Parm));
!          Rewrite (Parm, New_Reference_To (RTE (RE_Conditional_Call), Loc));
  
!          Analyze (Parm);
  
!          --  Find the Communication_Block parameter for the call
!          --  to the Cancelled function.
  
!          Decl := First (Declarations (Blk));
!          while Present (Decl)
!            and then not
!              Is_RTE (Etype (Object_Definition (Decl)), RE_Communication_Block)
!          loop
!             Next (Decl);
!          end loop;
  
!          --  Add an if statement to execute the else part if the call
!          --  does not succeed (as indicated by the Cancelled predicate).
  
!          Append_To (Stmts,
!            Make_Implicit_If_Statement (N,
!              Condition => Make_Function_Call (Loc,
!                Name => New_Reference_To (RTE (RE_Cancelled), Loc),
!                Parameter_Associations => New_List (
!                  New_Reference_To (Defining_Identifier (Decl), Loc))),
!              Then_Statements => Else_Statements (N),
!              Else_Statements => Statements (Alt)));
  
!       else
!          B := Make_Defining_Identifier (Loc, Name_uB);
  
!          --  Insert declaration of B in declarations of existing block
  
!          if No (Declarations (Blk)) then
!             Set_Declarations (Blk, New_List);
!          end if;
  
!          Prepend_To (Declarations (Blk),
!          Make_Object_Declaration (Loc,
!            Defining_Identifier => B,
!            Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
  
!          --  Create new call statement
  
!          Append_To (Parms, New_Reference_To (RTE (RE_Conditional_Call), Loc));
!          Append_To (Parms, New_Reference_To (B, Loc));
  
!          Rewrite (Call,
!            Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
!              Parameter_Associations => Parms));
  
!          --  Construct statement sequence for new block
  
!          Append_To (Stmts,
!            Make_Implicit_If_Statement (N,
!              Condition => New_Reference_To (B, Loc),
!              Then_Statements => Statements (Alt),
!              Else_Statements => Else_Statements (N)));
  
        end if;
  
-       --  The result is the new block
- 
-       Rewrite (N,
-         Make_Block_Statement (Loc,
-           Declarations => Declarations (Blk),
-           Handled_Statement_Sequence =>
-             Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
- 
        Analyze (N);
     end Expand_N_Conditional_Entry_Call;
  
--- 6075,6182 ----
        --  require it. We need to retrieve the call to complete its parameter
        --  list.
  
!       else
!          Transient_Blk :=
!             First_Real_Statement (Handled_Statement_Sequence (Blk));
  
!          if Present (Transient_Blk)
!            and then Nkind (Transient_Blk) = N_Block_Statement
!          then
!             Blk := Transient_Blk;
!          end if;
  
!          Stmts := Statements (Handled_Statement_Sequence (Blk));
!          Stmt  := First (Stmts);
!          while Nkind (Stmt) /= N_Procedure_Call_Statement loop
!             Next (Stmt);
!          end loop;
  
!          Call   := Stmt;
!          Params := Parameter_Associations (Call);
  
!          if Is_RTE (Entity (Name (Call)), RE_Protected_Entry_Call) then
  
!             --  Substitute Conditional_Entry_Call for Simple_Call parameter
  
!             Param := First (Params);
!             while Present (Param)
!               and then not Is_RTE (Etype (Param), RE_Call_Modes)
!             loop
!                Next (Param);
!             end loop;
  
!             pragma Assert (Present (Param));
!             Rewrite (Param, New_Reference_To (RTE (RE_Conditional_Call), Loc));
  
!             Analyze (Param);
  
!             --  Find the Communication_Block parameter for the call to the
!             --  Cancelled function.
  
!             Decl := First (Declarations (Blk));
!             while Present (Decl)
!               and then not Is_RTE (Etype (Object_Definition (Decl)),
!                              RE_Communication_Block)
!             loop
!                Next (Decl);
!             end loop;
  
!             --  Add an if statement to execute the else part if the call
!             --  does not succeed (as indicated by the Cancelled predicate).
  
!             Append_To (Stmts,
!               Make_Implicit_If_Statement (N,
!                 Condition => Make_Function_Call (Loc,
!                   Name => New_Reference_To (RTE (RE_Cancelled), Loc),
!                   Parameter_Associations => New_List (
!                     New_Reference_To (Defining_Identifier (Decl), Loc))),
!                 Then_Statements => Else_Statements (N),
!                 Else_Statements => Statements (Alt)));
  
!          else
!             B := Make_Defining_Identifier (Loc, Name_uB);
  
!             --  Insert declaration of B in declarations of existing block
  
!             if No (Declarations (Blk)) then
!                Set_Declarations (Blk, New_List);
!             end if;
  
!             Prepend_To (Declarations (Blk),
!               Make_Object_Declaration (Loc,
!                 Defining_Identifier => B,
!                 Object_Definition =>
!                   New_Reference_To (Standard_Boolean, Loc)));
  
!             --  Create new call statement
  
!             Append_To (Params,
!               New_Reference_To (RTE (RE_Conditional_Call), Loc));
!             Append_To (Params, New_Reference_To (B, Loc));
  
!             Rewrite (Call,
!               Make_Procedure_Call_Statement (Loc,
!                 Name => New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
!                 Parameter_Associations => Params));
  
!             --  Construct statement sequence for new block
  
!             Append_To (Stmts,
!               Make_Implicit_If_Statement (N,
!                 Condition => New_Reference_To (B, Loc),
!                 Then_Statements => Statements (Alt),
!                 Else_Statements => Else_Statements (N)));
!          end if;
  
!          --  The result is the new block
  
+          Rewrite (N,
+            Make_Block_Statement (Loc,
+              Declarations => Declarations (Blk),
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
        end if;
  
        Analyze (N);
     end Expand_N_Conditional_Entry_Call;
  
*************** package body Exp_Ch9 is
*** 4504,4510 ****
  
     procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
        Loc : constant Source_Ptr := Sloc (N);
- 
     begin
        Rewrite (N,
          Make_Procedure_Call_Statement (Loc,
--- 6190,6195 ----
*************** package body Exp_Ch9 is
*** 4577,4586 ****
           end if;
        end if;
  
!       --  Associate privals and discriminals with the next protected
!       --  operation body to be expanded. These are used to expand
!       --  references to private data objects and discriminants,
!       --  respectively.
  
        Next_Op := Next_Protected_Operation (N);
  
--- 6262,6270 ----
           end if;
        end if;
  
!       --  Associate privals and discriminals with the next protected operation
!       --  body to be expanded. These are used to expand references to private
!       --  data objects and discriminants, respectively.
  
        Next_Op := Next_Protected_Operation (N);
  
*************** package body Exp_Ch9 is
*** 4608,4623 ****
           return;
        end if;
  
!       --  If this entry call is part of an asynchronous select, don't
!       --  expand it here; it will be expanded with the select statement.
!       --  Don't expand timed entry calls either, as they are translated
!       --  into asynchronous entry calls.
  
!       --  ??? This whole approach is questionable; it may be better
!       --  to go back to allowing the expansion to take place and then
!       --  attempting to fix it up in Expand_N_Asynchronous_Select.
!       --  The tricky part is figuring out whether the expanded
!       --  call is on a task or protected entry.
  
        if (Nkind (Parent (N)) /= N_Triggering_Alternative
             or else N /= Triggering_Statement (Parent (N)))
--- 6292,6306 ----
           return;
        end if;
  
!       --  If this entry call is part of an asynchronous select, don't expand it
!       --  here; it will be expanded with the select statement. Don't expand
!       --  timed entry calls either, as they are translated into asynchronous
!       --  entry calls.
  
!       --  ??? This whole approach is questionable; it may be better to go back
!       --  to allowing the expansion to take place and then attempting to fix it
!       --  up in Expand_N_Asynchronous_Select. The tricky part is figuring out
!       --  whether the expanded call is on a task or protected entry.
  
        if (Nkind (Parent (N)) /= N_Triggering_Alternative
             or else N /= Triggering_Statement (Parent (N)))
*************** package body Exp_Ch9 is
*** 4634,4650 ****
     -- Expand_N_Entry_Declaration --
     --------------------------------
  
!    --  If there are parameters, then first, each of the formals is marked
!    --  by setting Is_Entry_Formal. Next a record type is built which is
!    --  used to hold the parameter values. The name of this record type is
!    --  entryP where entry is the name of the entry, with an additional
!    --  corresponding access type called entryPA. The record type has matching
!    --  components for each formal (the component names are the same as the
!    --  formal names). For elementary types, the component type matches the
!    --  formal type. For composite types, an access type is declared (with
!    --  the name formalA) which designates the formal type, and the type of
!    --  the component is this access type. Finally the Entry_Component of
!    --  each formal is set to reference the corresponding record component.
  
     procedure Expand_N_Entry_Declaration (N : Node_Id) is
        Loc        : constant Source_Ptr := Sloc (N);
--- 6317,6333 ----
     -- Expand_N_Entry_Declaration --
     --------------------------------
  
!    --  If there are parameters, then first, each of the formals is marked by
!    --  setting Is_Entry_Formal. Next a record type is built which is used to
!    --  hold the parameter values. The name of this record type is entryP where
!    --  entry is the name of the entry, with an additional corresponding access
!    --  type called entryPA. The record type has matching components for each
!    --  formal (the component names are the same as the formal names). For
!    --  elementary types, the component type matches the formal type. For
!    --  composite types, an access type is declared (with the name formalA)
!    --  which designates the formal type, and the type of the component is this
!    --  access type. Finally the Entry_Component of each formal is set to
!    --  reference the corresponding record component.
  
     procedure Expand_N_Entry_Declaration (N : Node_Id) is
        Loc        : constant Source_Ptr := Sloc (N);
*************** package body Exp_Ch9 is
*** 4748,4758 ****
     -----------------------------
  
     --  Protected bodies are expanded to the completion of the subprograms
!    --  created for the corresponding protected type. These are a protected
!    --  and unprotected version of each protected subprogram in the object,
!    --  a function to calculate each entry barrier, and a procedure to
!    --  execute the sequence of statements of each protected entry body.
!    --  For example, for protected type ptype:
  
     --  function entB
     --    (O : System.Address;
--- 6431,6441 ----
     -----------------------------
  
     --  Protected bodies are expanded to the completion of the subprograms
!    --  created for the corresponding protected type. These are a protected and
!    --  unprotected version of each protected subprogram in the object, a
!    --  function to calculate each entry barrier, and a procedure to execute the
!    --  sequence of statements of each protected entry body. For example, for
!    --  protected type ptype:
  
     --  function entB
     --    (O : System.Address;
*************** package body Exp_Ch9 is
*** 4772,4778 ****
     --     <sequence of statements>
     --  end pprocN;
  
!    --  procedure pproc (_object : in out poV;...) is
     --     procedure _clean is
     --       Pn : Boolean;
     --     begin
--- 6455,6461 ----
     --     <sequence of statements>
     --  end pprocN;
  
!    --  procedure pprocP (_object : in out poV;...) is
     --     procedure _clean is
     --       Pn : Boolean;
     --     begin
*************** package body Exp_Ch9 is
*** 4796,4802 ****
     --     <sequence of statements>
     --  end pfuncN;
  
!    --  function pfunc (_object : poV) return Return_Type is
     --     procedure _clean is
     --     begin
     --        Unlock (_object._object'Access);
--- 6479,6485 ----
     --     <sequence of statements>
     --  end pfuncN;
  
!    --  function pfuncP (_object : poV) return Return_Type is
     --     procedure _clean is
     --     begin
     --        Unlock (_object._object'Access);
*************** package body Exp_Ch9 is
*** 4837,4851 ****
--- 6520,6621 ----
     --  the state of the protected object.
  
     procedure Expand_N_Protected_Body (N : Node_Id) is
+       Loc          : constant Source_Ptr := Sloc (N);
        Pid          : constant Entity_Id  := Corresponding_Spec (N);
        Has_Entries  : Boolean := False;
        Op_Decl      : Node_Id;
        Op_Body      : Node_Id;
        Op_Id        : Entity_Id;
+       Disp_Op_Body : Node_Id;
        New_Op_Body  : Node_Id;
        Current_Node : Node_Id;
        Num_Entries  : Natural := 0;
  
+       function Build_Dispatching_Subprogram_Body
+         (N        : Node_Id;
+          Pid      : Node_Id;
+          Prot_Bod : Node_Id) return Node_Id;
+       --  Build a dispatching version of the protected subprogram body. The
+       --  newly generated subprogram contains a call to the original protected
+       --  body. The following code is generated:
+       --
+       --  function <protected-function-name> (Param1 .. ParamN) return
+       --    <return-type> is
+       --  begin
+       --     return <protected-function-name>P (Param1 .. ParamN);
+       --  end <protected-function-name>;
+       --
+       --  or
+       --
+       --  procedure <protected-procedure-name> (Param1 .. ParamN) is
+       --  begin
+       --     <protected-procedure-name>P (Param1 .. ParamN);
+       --  end <protected-procedure-name>
+ 
+       ---------------------------------------
+       -- Build_Dispatching_Subprogram_Body --
+       ---------------------------------------
+ 
+       function Build_Dispatching_Subprogram_Body
+         (N        : Node_Id;
+          Pid      : Node_Id;
+          Prot_Bod : Node_Id) return Node_Id
+       is
+          Loc     : constant Source_Ptr := Sloc (N);
+          Actuals : List_Id;
+          Formal  : Node_Id;
+          Spec    : Node_Id;
+          Stmts   : List_Id;
+ 
+       begin
+          --  Generate a specification without a letter suffix in order to
+          --  override an interface function or procedure.
+ 
+          Spec :=
+            Build_Protected_Sub_Specification (N, Pid, Dispatching_Mode);
+ 
+          --  The formal parameters become the actuals of the protected
+          --  function or procedure call.
+ 
+          Actuals := New_List;
+          Formal  := First (Parameter_Specifications (Spec));
+          while Present (Formal) loop
+             Append_To (Actuals,
+               Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
+ 
+             Next (Formal);
+          end loop;
+ 
+          if Nkind (Spec) = N_Procedure_Specification then
+             Stmts :=
+               New_List (
+                 Make_Procedure_Call_Statement (Loc,
+                   Name =>
+                     New_Reference_To (Corresponding_Spec (Prot_Bod), Loc),
+                   Parameter_Associations => Actuals));
+          else
+             pragma Assert (Nkind (Spec) = N_Function_Specification);
+ 
+             Stmts :=
+               New_List (
+                 Make_Return_Statement (Loc,
+                   Expression =>
+                     Make_Function_Call (Loc,
+                       Name =>
+                         New_Reference_To (Corresponding_Spec (Prot_Bod), Loc),
+                       Parameter_Associations => Actuals)));
+          end if;
+ 
+          return
+            Make_Subprogram_Body (Loc,
+              Declarations  => Empty_List,
+              Specification => Spec,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc, Stmts));
+       end Build_Dispatching_Subprogram_Body;
+ 
+    --  Start of processing for Expand_N_Protected_Body
+ 
     begin
        if No_Run_Time_Mode then
           Error_Msg_CRT ("protected body", N);
*************** package body Exp_Ch9 is
*** 4918,4923 ****
--- 6688,6713 ----
  
                          Insert_After (Current_Node, New_Op_Body);
                          Analyze (New_Op_Body);
+ 
+                         Current_Node := New_Op_Body;
+ 
+                         --  Generate an overriding primitive operation body for
+                         --  this subprogram if the protected type implements
+                         --  an inerface.
+ 
+                         if Ada_Version >= Ada_05
+                           and then Present (Abstract_Interfaces (
+                                      Corresponding_Record_Type (Pid)))
+                         then
+                            Disp_Op_Body :=
+                              Build_Dispatching_Subprogram_Body (
+                                Op_Body, Pid, New_Op_Body);
+ 
+                            Insert_After (Current_Node, Disp_Op_Body);
+                            Analyze (Disp_Op_Body);
+ 
+                            Current_Node := Disp_Op_Body;
+                         end if;
                       end if;
                    end if;
                 end if;
*************** package body Exp_Ch9 is
*** 4986,4993 ****
--- 6776,6844 ----
        then
           New_Op_Body := Build_Find_Body_Index (Pid);
           Insert_After (Current_Node, New_Op_Body);
+          Current_Node := New_Op_Body;
           Analyze (New_Op_Body);
        end if;
+ 
+       --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies after
+       --  the protected body. At this point the entry specs have been created,
+       --  frozen and included in the dispatch table for the protected type.
+ 
+       pragma Assert (Present (Corresponding_Record_Type (Pid)));
+ 
+       if Ada_Version >= Ada_05
+         and then Present (Protected_Definition (Parent (Pid)))
+         and then Present (Abstract_Interfaces
+                           (Corresponding_Record_Type (Pid)))
+       then
+          declare
+             Vis_Decl  : Node_Id :=
+                           First (Visible_Declarations
+                                  (Protected_Definition (Parent (Pid))));
+             Wrap_Body : Node_Id;
+ 
+          begin
+             --  Examine the visible declarations of the protected type, looking
+             --  for an entry declaration. We do not consider entry families
+             --  since they cannot have dispatching operations, thus they do not
+             --  need entry wrappers.
+ 
+             while Present (Vis_Decl) loop
+                if Nkind (Vis_Decl) = N_Entry_Declaration then
+                   Wrap_Body :=
+                     Build_Wrapper_Body (Loc,
+                       Proc_Nam => Defining_Identifier (Vis_Decl),
+                       Obj_Typ  => Corresponding_Record_Type (Pid),
+                       Formals  => Parameter_Specifications (Vis_Decl));
+ 
+                   if Wrap_Body /= Empty then
+                      Insert_After (Current_Node, Wrap_Body);
+                      Current_Node := Wrap_Body;
+ 
+                      Analyze (Wrap_Body);
+                   end if;
+ 
+                elsif Nkind (Vis_Decl) = N_Subprogram_Declaration then
+                   Wrap_Body :=
+                     Build_Wrapper_Body (Loc,
+                       Proc_Nam => Defining_Unit_Name
+                                         (Specification (Vis_Decl)),
+                       Obj_Typ  => Corresponding_Record_Type (Pid),
+                       Formals  => Parameter_Specifications
+                                         (Specification (Vis_Decl)));
+ 
+                   if Wrap_Body /= Empty then
+                      Insert_After (Current_Node, Wrap_Body);
+                      Current_Node := Wrap_Body;
+ 
+                      Analyze (Wrap_Body);
+                   end if;
+                end if;
+ 
+                Next (Vis_Decl);
+             end loop;
+          end;
+       end if;
     end Expand_N_Protected_Body;
  
     -----------------------------------------
*************** package body Exp_Ch9 is
*** 5005,5061 ****
     --      <private data fields>
     --    end record;
  
!    --  The discriminants are present only if the corresponding protected
!    --  type has discriminants, and they exactly mirror the protected type
!    --  discriminants. The private data fields similarly mirror the
!    --  private declarations of the protected type.
  
!    --  The Object field is always present. It contains RTS specific data
!    --  used to control the protected object. It is declared as Aliased
!    --  so that it can be passed as a pointer to the RTS. This allows the
!    --  protected record to be referenced within RTS data structures.
!    --  An appropriate Protection type and discriminant are generated.
  
     --  The Service field is present for protected objects with entries. It
!    --  contains sufficient information to allow the entry service procedure
!    --  for this object to be called when the object is not known till runtime.
  
     --  One entry_family component is present for each entry family in the
     --  task definition (see Expand_N_Task_Type_Declaration).
  
     --  When a protected object is declared, an instance of the protected type
!    --  value record is created. The elaboration of this declaration creates
!    --  the correct bounds for the entry families, and also evaluates the
!    --  priority expression if needed. The initialization routine for
!    --  the protected type itself then calls Initialize_Protection with
!    --  appropriate parameters to initialize the value of the Task_Id field.
!    --  Install_Handlers may be also called if a pragma Attach_Handler applies.
  
!    --  Note: this record is passed to the subprograms created by the
!    --  expansion of protected subprograms and entries. It is an in parameter
!    --  to protected functions and an in out parameter to procedures and
!    --  entry bodies. The Entity_Id for this created record type is placed
!    --  in the Corresponding_Record_Type field of the associated protected
!    --  type entity.
  
!    --  Next we create a procedure specifications for protected subprograms
!    --  and entry bodies. For each protected subprograms two subprograms are
!    --  created, an unprotected and a protected version. The unprotected
!    --  version is called from within other operations of the same protected
!    --  object.
  
     --  We also build the call to register the procedure if a pragma
     --  Interrupt_Handler applies.
  
     --  A single subprogram is created to service all entry bodies; it has an
!    --  additional boolean out parameter indicating that the previous entry
!    --  call made by the current task was serviced immediately, i.e. not by
!    --  proxy. The O parameter contains a pointer to a record object of the
!    --  type described above. An untyped interface is used here to allow this
     --  procedure to be called in places where the type of the object to be
!    --  serviced is not known. This must be done, for example, when a call
!    --  that may have been requeued is cancelled; the corresponding object
!    --  must be serviced, but which object that is not known till runtime.
  
     --  procedure ptypeS
     --    (O : System.Address; P : out Boolean);
--- 6856,6910 ----
     --      <private data fields>
     --    end record;
  
!    --  The discriminants are present only if the corresponding protected type
!    --  has discriminants, and they exactly mirror the protected type
!    --  discriminants. The private data fields similarly mirror the private
!    --  declarations of the protected type.
  
!    --  The Object field is always present. It contains RTS specific data used
!    --  to control the protected object. It is declared as Aliased so that it
!    --  can be passed as a pointer to the RTS. This allows the protected record
!    --  to be referenced within RTS data structures. An appropriate Protection
!    --  type and discriminant are generated.
  
     --  The Service field is present for protected objects with entries. It
!    --  contains sufficient information to allow the entry service procedure for
!    --  this object to be called when the object is not known till runtime.
  
     --  One entry_family component is present for each entry family in the
     --  task definition (see Expand_N_Task_Type_Declaration).
  
     --  When a protected object is declared, an instance of the protected type
!    --  value record is created. The elaboration of this declaration creates the
!    --  correct bounds for the entry families, and also evaluates the priority
!    --  expression if needed. The initialization routine for the protected type
!    --  itself then calls Initialize_Protection with appropriate parameters to
!    --  initialize the value of the Task_Id field. Install_Handlers may be also
!    --  called if a pragma Attach_Handler applies.
  
!    --  Note: this record is passed to the subprograms created by the expansion
!    --  of protected subprograms and entries. It is an in parameter to protected
!    --  functions and an in out parameter to procedures and entry bodies. The
!    --  Entity_Id for this created record type is placed in the
!    --  Corresponding_Record_Type field of the associated protected type entity.
  
!    --  Next we create a procedure specifications for protected subprograms and
!    --  entry bodies. For each protected subprograms two subprograms are
!    --  created, an unprotected and a protected version. The unprotected version
!    --  is called from within other operations of the same protected object.
  
     --  We also build the call to register the procedure if a pragma
     --  Interrupt_Handler applies.
  
     --  A single subprogram is created to service all entry bodies; it has an
!    --  additional boolean out parameter indicating that the previous entry call
!    --  made by the current task was serviced immediately, i.e. not by proxy.
!    --  The O parameter contains a pointer to a record object of the type
!    --  described above. An untyped interface is used here to allow this
     --  procedure to be called in places where the type of the object to be
!    --  serviced is not known. This must be done, for example, when a call that
!    --  may have been requeued is cancelled; the corresponding object must be
!    --  serviced, but which object that is not known till runtime.
  
     --  procedure ptypeS
     --    (O : System.Address; P : out Boolean);
*************** package body Exp_Ch9 is
*** 5071,5079 ****
     procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
        Loc     : constant Source_Ptr := Sloc (N);
        Prottyp : constant Entity_Id  := Defining_Identifier (N);
-       Protnm  : constant Name_Id    := Chars (Prottyp);
  
!       Pdef : constant Node_Id    := Protected_Definition (N);
        --  This contains two lists; one for visible and one for private decls
  
        Rec_Decl     : Node_Id;
--- 6920,6927 ----
     procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
        Loc     : constant Source_Ptr := Sloc (N);
        Prottyp : constant Entity_Id  := Defining_Identifier (N);
  
!       Pdef : constant Node_Id := Protected_Definition (N);
        --  This contains two lists; one for visible and one for private decls
  
        Rec_Decl     : Node_Id;
*************** package body Exp_Ch9 is
*** 5095,5101 ****
        Object_Comp  : Node_Id;
  
        procedure Register_Handler;
!       --  for a protected operation that is an interrupt handler, add the
        --  freeze action that will register it as such.
  
        ----------------------
--- 6943,6949 ----
        Object_Comp  : Node_Id;
  
        procedure Register_Handler;
!       --  For a protected operation that is an interrupt handler, add the
        --  freeze action that will register it as such.
  
        ----------------------
*************** package body Exp_Ch9 is
*** 5137,5142 ****
--- 6985,6995 ----
                        (Component_List (Type_Definition (Rec_Decl)));
        end if;
  
+       --  Ada 2005 (AI-345): Propagate the attribute that contains the list
+       --  of implemented interfaces.
+ 
+       Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
+ 
        Qualify_Entity_Names (N);
  
        --  If the type has discriminants, their occurrences in the declaration
*************** package body Exp_Ch9 is
*** 5145,5151 ****
        --  corresponding record type must refer to the discriminants of that
        --  record, so we must apply a new renaming to subtypes_indications:
  
!       --     protected discriminant => discriminal => record discriminant.
        --  This replacement is not applied to default expressions, for which
        --  the discriminal is correct.
  
--- 6998,7005 ----
        --  corresponding record type must refer to the discriminants of that
        --  record, so we must apply a new renaming to subtypes_indications:
  
!       --     protected discriminant => discriminal => record discriminant
! 
        --  This replacement is not applied to default expressions, for which
        --  the discriminal is correct.
  
*************** package body Exp_Ch9 is
*** 5153,5163 ****
           declare
              Disc : Entity_Id;
              Decl : Node_Id;
- 
           begin
              Disc := First_Discriminant (Prottyp);
              Decl := First (Discriminant_Specifications (Rec_Decl));
- 
              while Present (Disc) loop
                 Append_Elmt (Discriminal (Disc), Discr_Map);
                 Append_Elmt (Defining_Identifier (Decl), Discr_Map);
--- 7007,7015 ----
*************** package body Exp_Ch9 is
*** 5169,5183 ****
  
        --  Fill in the component declarations
  
!       --  Add components for entry families. For each entry family,
!       --  create an anonymous type declaration with the same size, and
!       --  analyze the type.
  
        Collect_Entry_Families (Loc, Cdecls, Current_Node, Prottyp);
  
!       --  Prepend the _Object field with the right type to the component
!       --  list. We need to compute the number of entries, and in some cases
!       --  the number of Attach_Handler pragmas.
  
        declare
           Ritem              : Node_Id;
--- 7021,7034 ----
  
        --  Fill in the component declarations
  
!       --  Add components for entry families. For each entry family, create an
!       --  anonymous type declaration with the same size, and analyze the type.
  
        Collect_Entry_Families (Loc, Cdecls, Current_Node, Prottyp);
  
!       --  Prepend the _Object field with the right type to the component list.
!       --  We need to compute the number of entries, and in some cases the
!       --  number of Attach_Handler pragmas.
  
        declare
           Ritem              : Node_Id;
*************** package body Exp_Ch9 is
*** 5234,5240 ****
                       Sloc => Loc,
                       Constraints => New_List (Entry_Count_Expr)));
  
!          elsif Has_Entries (Prottyp) then
              if Abort_Allowed
                or else Restriction_Active (No_Entry_Queue) = False
                or else Number_Entries (Prottyp) > 1
--- 7085,7096 ----
                       Sloc => Loc,
                       Constraints => New_List (Entry_Count_Expr)));
  
!          --  Type has explicit entries or generated primitive entry wrappers
! 
!          elsif Has_Entries (Prottyp)
!            or else (Ada_Version >= Ada_05
!                       and then Present (Interface_List (N)))
!          then
              if Abort_Allowed
                or else Restriction_Active (No_Entry_Queue) = False
                or else Number_Entries (Prottyp) > 1
*************** package body Exp_Ch9 is
*** 5306,5312 ****
                   Make_Subprogram_Declaration (Loc,
                     Specification =>
                       Build_Protected_Sub_Specification
!                        (Priv, Prottyp, Unprotected => True));
  
                 Insert_After (Current_Node, Sub);
                 Analyze (Sub);
--- 7162,7168 ----
                   Make_Subprogram_Declaration (Loc,
                     Specification =>
                       Build_Protected_Sub_Specification
!                        (Priv, Prottyp, Unprotected_Mode));
  
                 Insert_After (Current_Node, Sub);
                 Analyze (Sub);
*************** package body Exp_Ch9 is
*** 5316,5321 ****
--- 7172,7178 ----
                    Defining_Unit_Name (Specification (Sub)));
  
                 Current_Node := Sub;
+ 
                 if Is_Interrupt_Handler
                   (Defining_Unit_Name (Specification (Priv)))
                 then
*************** package body Exp_Ch9 is
*** 5323,5329 ****
                      Make_Subprogram_Declaration (Loc,
                        Specification =>
                          Build_Protected_Sub_Specification
!                           (Priv, Prottyp, Unprotected => False));
  
                    Insert_After (Current_Node, Sub);
                    Analyze (Sub);
--- 7180,7186 ----
                      Make_Subprogram_Declaration (Loc,
                        Specification =>
                          Build_Protected_Sub_Specification
!                           (Priv, Prottyp, Protected_Mode));
  
                    Insert_After (Current_Node, Sub);
                    Analyze (Sub);
*************** package body Exp_Ch9 is
*** 5354,5359 ****
--- 7211,7280 ----
  
        Analyze (Rec_Decl, Suppress => All_Checks);
  
+       --  Ada 2005 (AI-345): Construct the primitive entry wrappers before
+       --  the corresponding record is frozen
+ 
+       if Ada_Version >= Ada_05
+         and then Present (Visible_Declarations (Pdef))
+         and then Present (Corresponding_Record_Type
+                           (Defining_Identifier (Parent (Pdef))))
+         and then Present (Abstract_Interfaces
+                           (Corresponding_Record_Type
+                            (Defining_Identifier (Parent (Pdef)))))
+       then
+          declare
+             Current_Node : Node_Id := Rec_Decl;
+             Vis_Decl     : Node_Id;
+             Wrap_Spec    : Node_Id;
+             New_N        : Node_Id;
+ 
+          begin
+             --  Examine the visible declarations of the protected type, looking
+             --  for declarations of entries, and subprograms. We do not
+             --  consider entry families since they cannot have dispatching
+             --  operations, thus they do not need entry wrappers.
+ 
+             Vis_Decl := First (Visible_Declarations (Pdef));
+ 
+             while Present (Vis_Decl) loop
+ 
+                Wrap_Spec := Empty;
+ 
+                if Nkind (Vis_Decl) = N_Entry_Declaration
+                  and then not Present (Discrete_Subtype_Definition (Vis_Decl))
+                then
+                   Wrap_Spec :=
+                     Build_Wrapper_Spec (Loc,
+                       Proc_Nam => Defining_Identifier (Vis_Decl),
+                       Obj_Typ  => Defining_Identifier (Rec_Decl),
+                       Formals  => Parameter_Specifications (Vis_Decl));
+ 
+                elsif Nkind (Vis_Decl) = N_Subprogram_Declaration then
+                   Wrap_Spec :=
+                     Build_Wrapper_Spec (Loc,
+                       Proc_Nam => Defining_Unit_Name
+                                     (Specification (Vis_Decl)),
+                       Obj_Typ  => Defining_Identifier (Rec_Decl),
+                       Formals  => Parameter_Specifications
+                                     (Specification (Vis_Decl)));
+ 
+                end if;
+ 
+                if Wrap_Spec /= Empty then
+                   New_N := Make_Subprogram_Declaration (Loc,
+                              Specification => Wrap_Spec);
+ 
+                   Insert_After (Current_Node, New_N);
+                   Current_Node := New_N;
+ 
+                   Analyze (New_N);
+                end if;
+ 
+                Next (Vis_Decl);
+             end loop;
+          end;
+       end if;
+ 
        --  Collect pointers to entry bodies and their barriers, to be placed
        --  in the Entry_Bodies_Array for the type. For each entry/family we
        --  add an expression to the aggregate which is the initial value of
*************** package body Exp_Ch9 is
*** 5367,5378 ****
           Entries_Aggr := Empty;
        end if;
  
!       --  Build two new procedure specifications for each protected
!       --  subprogram; one to call from outside the object and one to
!       --  call from inside. Build a barrier function and an entry
!       --  body action procedure specification for each protected entry.
!       --  Initialize the entry body array. If subprogram is flagged as
!       --  eliminated, do not generate any internal operations.
  
        E_Count := 0;
  
--- 7288,7299 ----
           Entries_Aggr := Empty;
        end if;
  
!       --  Build two new procedure specifications for each protected subprogram;
!       --  one to call from outside the object and one to call from inside.
!       --  Build a barrier function and an entry body action procedure
!       --  specification for each protected entry. Initialize the entry body
!       --  array. If subprogram is flagged as eliminated, do not generate any
!       --  internal operations.
  
        E_Count := 0;
  
*************** package body Exp_Ch9 is
*** 5386,5392 ****
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (Comp, Prottyp, Unprotected => True));
  
              Insert_After (Current_Node, Sub);
              Analyze (Sub);
--- 7307,7313 ----
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (Comp, Prottyp, Unprotected_Mode));
  
              Insert_After (Current_Node, Sub);
              Analyze (Sub);
*************** package body Exp_Ch9 is
*** 5395,5402 ****
                (Defining_Unit_Name (Specification (Comp)),
                 Defining_Unit_Name (Specification (Sub)));
  
!             --  Make the protected version of the subprogram available
!             --  for expansion of external calls.
  
              Current_Node := Sub;
  
--- 7316,7323 ----
                (Defining_Unit_Name (Specification (Comp)),
                 Defining_Unit_Name (Specification (Sub)));
  
!             --  Make the protected version of the subprogram available for
!             --  expansion of external calls.
  
              Current_Node := Sub;
  
*************** package body Exp_Ch9 is
*** 5404,5424 ****
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (Comp, Prottyp, Unprotected => False));
  
              Insert_After (Current_Node, Sub);
              Analyze (Sub);
              Current_Node := Sub;
  
!             --  If a pragma Interrupt_Handler applies, build and add
!             --  a call to Register_Interrupt_Handler to the freezing actions
!             --  of the protected version (Current_Node) of the subprogram:
              --    system.interrupts.register_interrupt_handler
              --       (prot_procP'address);
  
              if not Restricted_Profile
                and then Is_Interrupt_Handler
!                 (Defining_Unit_Name (Specification (Comp)))
              then
                 Register_Handler;
              end if;
--- 7325,7367 ----
                Make_Subprogram_Declaration (Loc,
                  Specification =>
                    Build_Protected_Sub_Specification
!                     (Comp, Prottyp, Protected_Mode));
  
              Insert_After (Current_Node, Sub);
              Analyze (Sub);
+ 
              Current_Node := Sub;
  
!             --  Generate an overriding primitive operation specification for
!             --  this subprogram if the protected type implements an inerface.
! 
!             if Ada_Version >= Ada_05
!               and then
!                 Present (Abstract_Interfaces
!                           (Corresponding_Record_Type (Prottyp)))
!             then
!                Sub :=
!                  Make_Subprogram_Declaration (Loc,
!                    Specification =>
!                      Build_Protected_Sub_Specification
!                        (Comp, Prottyp, Dispatching_Mode));
! 
!                Insert_After (Current_Node, Sub);
!                Analyze (Sub);
! 
!                Current_Node := Sub;
!             end if;
! 
!             --  If a pragma Interrupt_Handler applies, build and add a call to
!             --  Register_Interrupt_Handler to the freezing actions of the
!             --  protected version (Current_Node) of the subprogram:
! 
              --    system.interrupts.register_interrupt_handler
              --       (prot_procP'address);
  
              if not Restricted_Profile
                and then Is_Interrupt_Handler
!                          (Defining_Unit_Name (Specification (Comp)))
              then
                 Register_Handler;
              end if;
*************** package body Exp_Ch9 is
*** 5429,5438 ****
              Set_Privals_Chain (Comp_Id, New_Elmt_List);
              Edef :=
                Make_Defining_Identifier (Loc,
!                 Build_Selected_Name
!                  (Protnm,
!                   New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
!                   'E'));
              Sub :=
                Make_Subprogram_Declaration (Loc,
                  Specification =>
--- 7372,7378 ----
              Set_Privals_Chain (Comp_Id, New_Elmt_List);
              Edef :=
                Make_Defining_Identifier (Loc,
!                 Build_Selected_Name (Prottyp, Comp_Id, 'E'));
              Sub :=
                Make_Subprogram_Declaration (Loc,
                  Specification =>
*************** package body Exp_Ch9 is
*** 5449,5458 ****
  
              Bdef :=
                Make_Defining_Identifier (Loc,
!                 Build_Selected_Name
!                  (Protnm,
!                   New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
!                   'B'));
              Sub :=
                Make_Subprogram_Declaration (Loc,
                  Specification =>
--- 7389,7395 ----
  
              Bdef :=
                Make_Defining_Identifier (Loc,
!                 Build_Selected_Name (Prottyp, Comp_Id, 'B'));
              Sub :=
                Make_Subprogram_Declaration (Loc,
                  Specification =>
*************** package body Exp_Ch9 is
*** 5489,5495 ****
  
        if Present (Private_Declarations (Pdef)) then
           Comp := First (Private_Declarations (Pdef));
- 
           while Present (Comp) loop
              if Nkind (Comp) = N_Entry_Declaration then
                 E_Count := E_Count + 1;
--- 7426,7431 ----
*************** package body Exp_Ch9 is
*** 5497,5506 ****
                 Set_Privals_Chain (Comp_Id, New_Elmt_List);
                 Edef :=
                   Make_Defining_Identifier (Loc,
!                   Build_Selected_Name
!                    (Protnm,
!                     New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
!                     'E'));
  
                 Sub :=
                   Make_Subprogram_Declaration (Loc,
--- 7433,7439 ----
                 Set_Privals_Chain (Comp_Id, New_Elmt_List);
                 Edef :=
                   Make_Defining_Identifier (Loc,
!                   Build_Selected_Name (Prottyp, Comp_Id, 'E'));
  
                 Sub :=
                   Make_Subprogram_Declaration (Loc,
*************** package body Exp_Ch9 is
*** 5518,5527 ****
  
                 Bdef :=
                   Make_Defining_Identifier (Loc,
!                   Build_Selected_Name
!                    (Protnm,
!                     New_External_Name (Chars (Comp_Id), Suffix_Index => -1),
!                     'B'));
                 Sub :=
                   Make_Subprogram_Declaration (Loc,
                     Specification =>
--- 7451,7458 ----
  
                 Bdef :=
                   Make_Defining_Identifier (Loc,
!                     Build_Selected_Name (Prottyp, Comp_Id, 'E'));
! 
                 Sub :=
                   Make_Subprogram_Declaration (Loc,
                     Specification =>
*************** package body Exp_Ch9 is
*** 5534,5542 ****
                 Set_Scope (Bdef, Scope (Comp_Id));
                 Current_Node := Sub;
  
!                --  Collect pointers to the protected subprogram and the
!                --  barrier of the current entry, for insertion into
!                --  Entry_Bodies_Array.
  
                 Append (
                   Make_Aggregate (Loc,
--- 7465,7472 ----
                 Set_Scope (Bdef, Scope (Comp_Id));
                 Current_Node := Sub;
  
!                --  Collect pointers to the protected subprogram and the barrier
!                --  of the current entry, for insertion into Entry_Bodies_Array.
  
                 Append (
                   Make_Aggregate (Loc,
*************** package body Exp_Ch9 is
*** 5596,5604 ****
                        Attribute_Name => Name_Unrestricted_Access))));
           end if;
  
!          --  A pointer to this array will be placed in the corresponding
!          --  record by its initialization procedure, so this needs to be
!          --  analyzed here.
  
           Insert_After (Current_Node, Body_Arr);
           Current_Node := Body_Arr;
--- 7526,7533 ----
                        Attribute_Name => Name_Unrestricted_Access))));
           end if;
  
!          --  A pointer to this array will be placed in the corresponding record
!          --  by its initialization procedure so this needs to be analyzed here.
  
           Insert_After (Current_Node, Body_Arr);
           Current_Node := Body_Arr;
*************** package body Exp_Ch9 is
*** 5629,5639 ****
     --------------------------------
  
     --  A requeue statement is expanded into one of four GNARLI operations,
!    --  depending on the source and destination (task or protected object).
!    --  In addition, code must be generated to jump around the remainder of
!    --  processing for the original entry and, if the destination is a
!    --  (different) protected object, to attempt to service it.
!    --  The following illustrates the various cases:
  
     --  procedure entE
     --    (O : System.Address;
--- 7558,7568 ----
     --------------------------------
  
     --  A requeue statement is expanded into one of four GNARLI operations,
!    --  depending on the source and destination (task or protected object). In
!    --  addition, code must be generated to jump around the remainder of
!    --  processing for the original entry and, if the destination is (different)
!    --  protected object, to attempt to service it. The following illustrates
!    --  the various cases:
  
     --  procedure entE
     --    (O : System.Address;
*************** package body Exp_Ch9 is
*** 5790,5797 ****
              Prepend (Self_Param, Params);
              exit;
  
!          --  If neither task type or protected type, must be in some
!          --  inner enclosing block, so move on out
  
           else
              Oldtyp := Scope (Oldtyp);
--- 7719,7726 ----
              Prepend (Self_Param, Params);
              exit;
  
!          --  If neither task type or protected type, must be in some inner
!          --  enclosing block, so move on out
  
           else
              Oldtyp := Scope (Oldtyp);
*************** package body Exp_Ch9 is
*** 5824,5831 ****
           end loop;
  
           --  The last statement is the second label, used for completing the
!          --  rendezvous the usual way.
!          --  The label we are looking for is right before it.
  
           Lab_Node :=
             Prev (Last (Statements (Handled_Statement_Sequence (Acc_Stat))));
--- 7753,7760 ----
           end loop;
  
           --  The last statement is the second label, used for completing the
!          --  rendezvous the usual way. The label we are looking for is right
!          --  before it.
  
           Lab_Node :=
             Prev (Last (Statements (Handled_Statement_Sequence (Acc_Stat))));
*************** package body Exp_Ch9 is
*** 6076,6084 ****
  
              --  During the analysis of the body of the accept statement, any
              --  zero cost exception handler records were collected in the
!             --  Accept_Handler_Records field of the N_Accept_Alternative
!             --  node. This is where we move them to where they belong,
!             --  namely the newly created procedure.
  
              Set_Handler_Records (PB_Ent, Accept_Handler_Records (Alt));
              Append (Proc_Body, Body_List);
--- 8005,8013 ----
  
              --  During the analysis of the body of the accept statement, any
              --  zero cost exception handler records were collected in the
!             --  Accept_Handler_Records field of the N_Accept_Alternative node.
!             --  This is where we move them to where they belong, namely the
!             --  newly created procedure.
  
              Set_Handler_Records (PB_Ent, Accept_Handler_Records (Alt));
              Append (Proc_Body, Body_List);
*************** package body Exp_Ch9 is
*** 6086,6093 ****
           else
              Null_Body := New_Reference_To (Standard_True,  Loc);
  
!             --  if accept statement has declarations, insert above, given
!             --  that we are not creating a body for the accept.
  
              if Present (Declarations (Acc_Stm)) then
                 Insert_Actions (N, Declarations (Acc_Stm));
--- 8015,8022 ----
           else
              Null_Body := New_Reference_To (Standard_True,  Loc);
  
!             --  if accept statement has declarations, insert above, given that
!             --  we are not creating a body for the accept.
  
              if Present (Declarations (Acc_Stm)) then
                 Insert_Actions (N, Declarations (Acc_Stm));
*************** package body Exp_Ch9 is
*** 6182,6190 ****
                 Alt_Stats := New_List;
              end if;
  
!             --  After the call, if any, branch to to trailing statements.
!             --  We create a label for each, as well as the corresponding
!             --  label declaration.
  
              Lab := Make_And_Declare_Label (Index);
              Append_To (Alt_Stats,
--- 8111,8119 ----
                 Alt_Stats := New_List;
              end if;
  
!             --  After the call, if any, branch to to trailing statements. We
!             --  create a label for each, as well as the corresponding label
!             --  declaration.
  
              Lab := Make_And_Declare_Label (Index);
              Append_To (Alt_Stats,
*************** package body Exp_Ch9 is
*** 6318,6325 ****
  
           Append_List (Delay_Alt, Delay_List);
  
!          --  If the delay alternative has a statement part, add a
!          --  choice to the case statements for delays.
  
           if Present (Statements (Alt)) then
  
--- 8247,8254 ----
  
           Append_List (Delay_Alt, Delay_List);
  
!          --  If the delay alternative has a statement part, add choice to the
!          --  case statements for delays.
  
           if Present (Statements (Alt)) then
  
*************** package body Exp_Ch9 is
*** 6688,6701 ****
            Discrete_Choices => Choices,
            Statements => Alt_Stats));
  
!       --  We make use of the fact that Accept_Index is an integer type,
!       --  and generate successive literals for entries for each accept.
!       --  Only those for which there is a body or trailing statements are
!       --  given a case entry.
  
        Alt := First (Select_Alternatives (N));
        Proc := First (Body_List);
- 
        while Present (Alt) loop
  
           if Nkind (Alt) = N_Accept_Alternative then
--- 8617,8628 ----
            Discrete_Choices => Choices,
            Statements => Alt_Stats));
  
!       --  We make use of the fact that Accept_Index is an integer type, and
!       --  generate successive literals for entries for each accept. Only those
!       --  for which there is a body or trailing statements get a case entry.
  
        Alt := First (Select_Alternatives (N));
        Proc := First (Body_List);
        while Present (Alt) loop
  
           if Nkind (Alt) = N_Accept_Alternative then
*************** package body Exp_Ch9 is
*** 6838,6845 ****
                  Name => New_Reference_To (RTE (RE_Timed_Selective_Wait), Loc),
                  Parameter_Associations => Parms));
  
!             --  This new call should follow the calculation of the
!             --  minimum delay.
  
              Insert_List_Before (Select_Call, Delay_List);
  
--- 8765,8772 ----
                  Name => New_Reference_To (RTE (RE_Timed_Selective_Wait), Loc),
                  Parameter_Associations => Parms));
  
!             --  This new call should follow the calculation of the minimum
!             --  delay.
  
              Insert_List_Before (Select_Call, Delay_List);
  
*************** package body Exp_Ch9 is
*** 6903,6911 ****
     --------------------------------------
  
     --  Single task declarations should never be present after semantic
!    --  analysis, since we expect them to be replaced by a declaration of
!    --  an anonymous task type, followed by a declaration of the task
!    --  object. We include this routine to make sure that is happening!
  
     procedure Expand_N_Single_Task_Declaration (N : Node_Id) is
     begin
--- 8830,8838 ----
     --------------------------------------
  
     --  Single task declarations should never be present after semantic
!    --  analysis, since we expect them to be replaced by a declaration of an
!    --  anonymous task type, followed by a declaration of the task object. We
!    --  include this routine to make sure that is happening!
  
     procedure Expand_N_Single_Task_Declaration (N : Node_Id) is
     begin
*************** package body Exp_Ch9 is
*** 6950,6965 ****
  
     --    tnameE := True;
  
!    --  In addition, if the task body is an activator, then a call to
!    --  activate tasks is added at the start of the statements, before
!    --  the call to Complete_Activation, and if in addition the task is
!    --  a master then it must be established as a master. These calls are
!    --  inserted and analyzed in Expand_Cleanup_Actions, when the
!    --  Handled_Sequence_Of_Statements is expanded.
  
     --  There is one discriminal declaration line generated for each
!    --  discriminant that is present to provide an easy reference point
!    --  for discriminant references inside the body (see Exp_Ch2.Expand_Name).
  
     --  Note on relationship to GNARLI definition. In the GNARLI definition,
     --  task body procedures have a profile (Arg : System.Address). That is
--- 8877,8892 ----
  
     --    tnameE := True;
  
!    --  In addition, if the task body is an activator, then a call to activate
!    --  tasks is added at the start of the statements, before the call to
!    --  Complete_Activation, and if in addition the task is a master then it
!    --  must be established as a master. These calls are inserted and analyzed
!    --  in Expand_Cleanup_Actions, when the Handled_Sequence_Of_Statements is
!    --  expanded.
  
     --  There is one discriminal declaration line generated for each
!    --  discriminant that is present to provide an easy reference point for
!    --  discriminant references inside the body (see Exp_Ch2.Expand_Name).
  
     --  Note on relationship to GNARLI definition. In the GNARLI definition,
     --  task body procedures have a profile (Arg : System.Address). That is
*************** package body Exp_Ch9 is
*** 7028,7036 ****
        Rewrite (N, New_N);
        Analyze (N);
  
!       --  Set elaboration flag immediately after task body. If the body
!       --  is a subunit, the flag is set in  the declarative part that
!       --  contains the stub.
  
        if Nkind (Parent (N)) /= N_Subunit then
           Insert_After (N,
--- 8955,8962 ----
        Rewrite (N, New_N);
        Analyze (N);
  
!       --  Set elaboration flag immediately after task body. If the body is a
!       --  subunit, the flag is set in the declarative part containing the stub.
  
        if Nkind (Parent (N)) /= N_Subunit then
           Insert_After (N,
*************** package body Exp_Ch9 is
*** 7039,7044 ****
--- 8965,9025 ----
                 Make_Identifier (Loc, New_External_Name (Chars (Ttyp), 'E')),
               Expression => New_Reference_To (Standard_True, Loc)));
        end if;
+ 
+       --  Ada 2005 (AI-345): Construct the primitive entry wrapper bodies after
+       --  the task body. At this point the entry specs have been created,
+       --  frozen and included in the dispatch table for the task type.
+ 
+       pragma Assert (Present (Corresponding_Record_Type (Ttyp)));
+ 
+       if Ada_Version >= Ada_05
+         and then Present (Task_Definition (Parent (Ttyp)))
+         and then Present (Abstract_Interfaces
+                           (Corresponding_Record_Type (Ttyp)))
+       then
+          declare
+             Current_Node : Node_Id;
+             Vis_Decl     : Node_Id :=
+               First (Visible_Declarations (Task_Definition (Parent (Ttyp))));
+             Wrap_Body    : Node_Id;
+ 
+          begin
+             if Nkind (Parent (N)) = N_Subunit then
+                Current_Node := Corresponding_Stub (Parent (N));
+             else
+                Current_Node := N;
+             end if;
+ 
+             --  Examine the visible declarations of the task type, looking for
+             --  an entry declaration. We do not consider entry families since
+             --  they cannot have dispatching operations, thus they do not need
+             --  entry wrappers.
+ 
+             while Present (Vis_Decl) loop
+                if Nkind (Vis_Decl) = N_Entry_Declaration
+                  and then Ekind (Defining_Identifier (Vis_Decl)) = E_Entry
+                then
+ 
+                   --  Create the specification of the wrapper
+ 
+                   Wrap_Body :=
+                     Build_Wrapper_Body (Loc,
+                       Proc_Nam => Defining_Identifier (Vis_Decl),
+                       Obj_Typ  => Corresponding_Record_Type (Ttyp),
+                       Formals  => Parameter_Specifications (Vis_Decl));
+ 
+                   if Wrap_Body /= Empty then
+                      Insert_After (Current_Node, Wrap_Body);
+                      Current_Node := Wrap_Body;
+ 
+                      Analyze (Wrap_Body);
+                   end if;
+                end if;
+ 
+                Next (Vis_Decl);
+             end loop;
+          end;
+       end if;
     end Expand_N_Task_Body;
  
     ------------------------------------
*************** package body Exp_Ch9 is
*** 7053,7060 ****
  
     --    taskE : aliased Boolean := False;
  
!    --  Next a variable is declared to hold the task stack size (either
!    --  the default : Unspecified_Size, or a value that is set by a pragma
     --  Storage_Size). If the value of the pragma Storage_Size is static, then
     --  the variable is initialized with this value:
  
--- 9034,9041 ----
  
     --    taskE : aliased Boolean := False;
  
!    --  Next a variable is declared to hold the task stack size (either the
!    --  default : Unspecified_Size, or a value that is set by a pragma
     --  Storage_Size). If the value of the pragma Storage_Size is static, then
     --  the variable is initialized with this value:
  
*************** package body Exp_Ch9 is
*** 7076,7103 ****
     --  The discriminants are present only if the corresponding task type has
     --  discriminants, and they exactly mirror the task type discriminants.
  
!    --  The Id field is always present. It contains the Task_Id value, as
!    --  set by the call to Create_Task. Note that although the task is
!    --  limited, the task value record type is not limited, so there is no
!    --  problem in passing this field as an out parameter to Create_Task.
  
!    --  One entry_family component is present for each entry family in the
!    --  task definition. The bounds correspond to the bounds of the entry
!    --  family (which may depend on discriminants). The element type is
!    --  void, since we only need the bounds information for determining
!    --  the entry index. Note that the use of an anonymous array would
!    --  normally be illegal in this context, but this is a parser check,
!    --  and the semantics is quite prepared to handle such a case.
  
!    --  The _Size field is present only if a Storage_Size pragma appears in
!    --  the task definition. The expression captures the argument that was
!    --  present in the pragma, and is used to override the task stack size
!    --  otherwise associated with the task type.
  
     --  The _Priority field is present only if a Priority or Interrupt_Priority
     --  pragma appears in the task definition. The expression captures the
!    --  argument that was present in the pragma, and is used to provide
!    --  the Size parameter to the call to Create_Task.
  
     --  The _Task_Info field is present only if a Task_Info pragma appears in
     --  the task definition. The expression captures the argument that was
--- 9057,9084 ----
     --  The discriminants are present only if the corresponding task type has
     --  discriminants, and they exactly mirror the task type discriminants.
  
!    --  The Id field is always present. It contains the Task_Id value, as set by
!    --  the call to Create_Task. Note that although the task is limited, the
!    --  task value record type is not limited, so there is no problem in passing
!    --  this field as an out parameter to Create_Task.
  
!    --  One entry_family component is present for each entry family in the task
!    --  definition. The bounds correspond to the bounds of the entry family
!    --  (which may depend on discriminants). The element type is void, since we
!    --  only need the bounds information for determining the entry index. Note
!    --  that the use of an anonymous array would normally be illegal in this
!    --  context, but this is a parser check, and the semantics is quite prepared
!    --  to handle such a case.
  
!    --  The _Size field is present only if a Storage_Size pragma appears in the
!    --  task definition. The expression captures the argument that was present
!    --  in the pragma, and is used to override the task stack size otherwise
!    --  associated with the task type.
  
     --  The _Priority field is present only if a Priority or Interrupt_Priority
     --  pragma appears in the task definition. The expression captures the
!    --  argument that was present in the pragma, and is used to provide the Size
!    --  parameter to the call to Create_Task.
  
     --  The _Task_Info field is present only if a Task_Info pragma appears in
     --  the task definition. The expression captures the argument that was
*************** package body Exp_Ch9 is
*** 7105,7122 ****
     --  to the call to Create_Task.
  
     --  When a task is declared, an instance of the task value record is
!    --  created. The elaboration of this declaration creates the correct
!    --  bounds for the entry families, and also evaluates the size, priority,
!    --  and task_Info expressions if needed. The initialization routine for
!    --  the task type itself then calls Create_Task with appropriate
!    --  parameters to initialize the value of the Task_Id field.
  
     --  Note: the address of this record is passed as the "Discriminants"
!    --  parameter for Create_Task. Since Create_Task merely passes this onto
!    --  the body procedure, it does not matter that it does not quite match
!    --  the GNARLI model of what is being passed (the record contains more
!    --  than just the discriminants, but the discriminants can be found from
!    --  the record value).
  
     --  The Entity_Id for this created record type is placed in the
     --  Corresponding_Record_Type field of the associated task type entity.
--- 9086,9103 ----
     --  to the call to Create_Task.
  
     --  When a task is declared, an instance of the task value record is
!    --  created. The elaboration of this declaration creates the correct bounds
!    --  for the entry families, and also evaluates the size, priority, and
!    --  task_Info expressions if needed. The initialization routine for the task
!    --  type itself then calls Create_Task with appropriate parameters to
!    --  initialize the value of the Task_Id field.
  
     --  Note: the address of this record is passed as the "Discriminants"
!    --  parameter for Create_Task. Since Create_Task merely passes this onto the
!    --  body procedure, it does not matter that it does not quite match the
!    --  GNARLI model of what is being passed (the record contains more than just
!    --  the discriminants, but the discriminants can be found from the record
!    --  value).
  
     --  The Entity_Id for this created record type is placed in the
     --  Corresponding_Record_Type field of the associated task type entity.
*************** package body Exp_Ch9 is
*** 7161,7166 ****
--- 9142,9153 ----
        --  Here we will do the expansion
  
        Rec_Decl := Build_Corresponding_Record (N, Tasktyp, Loc);
+ 
+       --  Ada 2005 (AI-345): Propagate the attribute that contains the list
+       --  of implemented interfaces.
+ 
+       Set_Interface_List (Type_Definition (Rec_Decl), Interface_List (N));
+ 
        Rec_Ent  := Defining_Identifier (Rec_Decl);
        Cdecls   := Component_Items (Component_List
                                       (Type_Definition (Rec_Decl)));
*************** package body Exp_Ch9 is
*** 7212,7220 ****
  
        Insert_After (Elab_Decl, Size_Decl);
  
!       --  Next build the rest of the corresponding record declaration.
!       --  This is done last, since the corresponding record initialization
!       --  procedure will reference the previously created entities.
  
        --  Fill in the component declarations -- first the _Task_Id field
  
--- 9199,9207 ----
  
        Insert_After (Elab_Decl, Size_Decl);
  
!       --  Next build the rest of the corresponding record declaration. This is
!       --  done last, since the corresponding record initialization procedure
!       --  will reference the previously created entities.
  
        --  Fill in the component declarations -- first the _Task_Id field
  
*************** package body Exp_Ch9 is
*** 7228,7235 ****
                Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_Id),
                                      Loc))));
  
!       --  Declare static ATCB (that is, created by the expander) if we
!       --  are using the Restricted run time.
  
        if Restricted_Profile then
           Append_To (Cdecls,
--- 9215,9222 ----
                Subtype_Indication => New_Reference_To (RTE (RO_ST_Task_Id),
                                      Loc))));
  
!       --  Declare static ATCB (that is, created by the expander) if we are
!       --  using the Restricted run time.
  
        if Restricted_Profile then
           Append_To (Cdecls,
*************** package body Exp_Ch9 is
*** 7251,7258 ****
  
        end if;
  
!       --  Declare static stack (that is, created by the expander) if we
!       --  are using the Restricted run time on a bare board configuration.
  
        if Restricted_Profile
          and then Preallocated_Stacks_On_Target
--- 9238,9245 ----
  
        end if;
  
!       --  Declare static stack (that is, created by the expander) if we are
!       --  using the Restricted run time on a bare board configuration.
  
        if Restricted_Profile
          and then Preallocated_Stacks_On_Target
*************** package body Exp_Ch9 is
*** 7291,7298 ****
  
           Append_To (Cdecls, Decl_Stack);
  
!          --  The appropriate alignment for the stack is ensured by the
!          --  run-time code in charge of task creation.
  
        end if;
  
--- 9278,9285 ----
  
           Append_To (Cdecls, Decl_Stack);
  
!          --  The appropriate alignment for the stack is ensured by the run-time
!          --  code in charge of task creation.
  
        end if;
  
*************** package body Exp_Ch9 is
*** 7407,7435 ****
  
        Insert_After (Rec_Decl, Body_Decl);
  
!       --  The subprogram does not comes from source, so we have to indicate
!       --  the need for debugging information explicitly.
  
        Set_Needs_Debug_Info
          (Defining_Entity (Proc_Spec), Comes_From_Source (Original_Node (N)));
  
!       --  Now we can freeze the corresponding record. This needs manually
!       --  freezing, since it is really part of the task type, and the task
!       --  type is frozen at this stage. We of course need the initialization
!       --  procedure for this corresponding record type and we won't get it
!       --  in time if we don't freeze now.
  
!       declare
!          L : constant List_Id := Freeze_Entity (Rec_Ent, Loc);
  
!       begin
!          if Is_Non_Empty_List (L) then
!             Insert_List_After (Body_Decl, L);
!          end if;
!       end;
  
!       --  Complete the expansion of access types to the current task
!       --  type, if any were declared.
  
        Expand_Previous_Access_Type (Tasktyp);
     end Expand_N_Task_Type_Declaration;
--- 9394,9478 ----
  
        Insert_After (Rec_Decl, Body_Decl);
  
!       --  The subprogram does not comes from source, so we have to indicate the
!       --  need for debugging information explicitly.
  
        Set_Needs_Debug_Info
          (Defining_Entity (Proc_Spec), Comes_From_Source (Original_Node (N)));
  
!       --  Ada 2005 (AI-345): Construct the primitive entry wrapper specs before
!       --  the corresponding record has been frozen.
  
!       if Ada_Version >= Ada_05
!         and then Present (Taskdef)
!         and then Present (Corresponding_Record_Type
!                           (Defining_Identifier (Parent (Taskdef))))
!         and then Present (Abstract_Interfaces
!                           (Corresponding_Record_Type
!                            (Defining_Identifier (Parent (Taskdef)))))
!       then
!          declare
!             Current_Node : Node_Id := Rec_Decl;
!             Vis_Decl     : Node_Id := First (Visible_Declarations (Taskdef));
!             Wrap_Spec    : Node_Id;
!             New_N        : Node_Id;
  
!          begin
!             --  Examine the visible declarations of the task type, looking for
!             --  an entry declaration. We do not consider entry families since
!             --  they cannot have dispatching operations, thus they do not need
!             --  entry wrappers.
  
!             while Present (Vis_Decl) loop
!                if Nkind (Vis_Decl) = N_Entry_Declaration
!                  and then Ekind (Defining_Identifier (Vis_Decl)) = E_Entry
!                then
!                   Wrap_Spec :=
!                     Build_Wrapper_Spec (Loc,
!                       Proc_Nam => Defining_Identifier (Vis_Decl),
!                       Obj_Typ  => Etype (Rec_Ent),
!                       Formals  => Parameter_Specifications (Vis_Decl));
! 
!                   if Wrap_Spec /= Empty then
!                      New_N :=
!                        Make_Subprogram_Declaration (Loc,
!                          Specification => Wrap_Spec);
! 
!                      Insert_After (Current_Node, New_N);
!                      Current_Node := New_N;
! 
!                      Analyze (New_N);
!                   end if;
!                end if;
! 
!                Next (Vis_Decl);
!             end loop;
!          end;
!       end if;
! 
!       --  Ada 2005 (AI-345): We must defer freezing to allow further
!       --  declaration of primitive subprograms covering task interfaces
! 
!       if Ada_Version <= Ada_95 then
! 
!          --  Now we can freeze the corresponding record. This needs manually
!          --  freezing, since it is really part of the task type, and the task
!          --  type is frozen at this stage. We of course need the initialization
!          --  procedure for this corresponding record type and we won't get it
!          --  in time if we don't freeze now.
! 
!          declare
!             L : constant List_Id := Freeze_Entity (Rec_Ent, Loc);
! 
!          begin
!             if Is_Non_Empty_List (L) then
!                Insert_List_After (Body_Decl, L);
!             end if;
!          end;
!       end if;
! 
!       --  Complete the expansion of access types to the current task type, if
!       --  any were declared.
  
        Expand_Previous_Access_Type (Tasktyp);
     end Expand_N_Task_Type_Declaration;
*************** package body Exp_Ch9 is
*** 7438,7445 ****
     -- Expand_N_Timed_Entry_Call --
     -------------------------------
  
!    --  A timed entry call in normal case is not implemented using ATC
!    --  mechanism anymore for efficiency reason.
  
     --     select
     --        T.E;
--- 9481,9488 ----
     -- Expand_N_Timed_Entry_Call --
     -------------------------------
  
!    --  A timed entry call in normal case is not implemented using ATC mechanism
!    --  anymore for efficiency reason.
  
     --     select
     --        T.E;
*************** package body Exp_Ch9 is
*** 7454,7464 ****
     --  1) When T.E is a task entry_call;
  
     --    declare
!    --       B : Boolean;
!    --       X : Task_Entry_Index := <entry index>;
     --       DX : Duration := To_Duration (D);
!    --       M : Delay_Mode := <discriminant>;
!    --       P : parms := (parm, parm, parm);
  
     --    begin
     --       Timed_Protected_Entry_Call (<acceptor-task>, X, P'Address,
--- 9497,9507 ----
     --  1) When T.E is a task entry_call;
  
     --    declare
!    --       B  : Boolean;
!    --       X  : Task_Entry_Index := <entry index>;
     --       DX : Duration := To_Duration (D);
!    --       M  : Delay_Mode := <discriminant>;
!    --       P  : parms := (parm, parm, parm);
  
     --    begin
     --       Timed_Protected_Entry_Call (<acceptor-task>, X, P'Address,
*************** package body Exp_Ch9 is
*** 7476,7482 ****
     --       B  : Boolean;
     --       X  : Protected_Entry_Index := <entry index>;
     --       DX : Duration := To_Duration (D);
!    --       M : Delay_Mode := <discriminant>;
     --       P  : parms := (parm, parm, parm);
  
     --    begin
--- 9519,9525 ----
     --       B  : Boolean;
     --       X  : Protected_Entry_Index := <entry index>;
     --       DX : Duration := To_Duration (D);
!    --       M  : Delay_Mode := <discriminant>;
     --       P  : parms := (parm, parm, parm);
  
     --    begin
*************** package body Exp_Ch9 is
*** 7489,7494 ****
--- 9532,9571 ----
     --       end if;
     --    end;
  
+    --  3) Ada 2005 (AI-345): When T.E is a dispatching procedure call;
+ 
+    --    declare
+    --       B  : Boolean := False;
+    --       C  : Ada.Tags.Prim_Op_Kind;
+    --       DX : Duration := To_Duration (D)
+    --       M  : Integer :=...;
+    --       P  : Parameters := (Param1 .. ParamN);
+    --       S  : constant Iteger := DT_Position (<dispatching-procedure>);
+ 
+    --    begin
+    --       disp_timed_select (<object>, S, P'Address, DX, M, C, B);
+ 
+    --       if C = POK_Protected_Entry
+    --         or else C = POK_Task_Entry
+    --       then
+    --          Param1 := P.Param1;
+    --          ...
+    --          ParamN := P.ParamN;
+    --       end if;
+ 
+    --       if B then
+    --          if C = POK_Procedure
+    --            or else C = POK_Protected_Procedure
+    --            or else C = POK_Task_Procedure
+    --          then
+    --             T.E;
+    --          end if;
+    --          S1;
+    --       else
+    --          S2;
+    --       end if;
+    --    end;
+ 
     procedure Expand_N_Timed_Entry_Call (N : Node_Id) is
        Loc : constant Source_Ptr := Sloc (N);
  
*************** package body Exp_Ch9 is
*** 7501,7525 ****
        D_Stats : constant List_Id :=
                    Statements (Delay_Alternative (N));
  
!       Stmts : List_Id;
!       Stmt  : Node_Id;
!       Parms : List_Id;
!       Parm  : Node_Id;
! 
!       Concval : Node_Id;
!       Ename   : Node_Id;
!       Index   : Node_Id;
! 
!       Decls : List_Id;
!       Disc  : Node_Id;
!       Conv  : Node_Id;
!       B     : Entity_Id;
!       D     : Entity_Id;
!       Dtyp  : Entity_Id;
!       M     : Entity_Id;
  
!       Call  : Node_Id;
!       Dummy : Node_Id;
  
     begin
        --  The arguments in the call may require dynamic allocation, and the
--- 9578,9610 ----
        D_Stats : constant List_Id :=
                    Statements (Delay_Alternative (N));
  
!       Actuals  : List_Id;
!       Blk_Typ  : Entity_Id;
!       Call     : Node_Id;
!       Call_Ent : Entity_Id;
!       Concval  : Node_Id;
!       D_Conv   : Node_Id;
!       D_Disc   : Node_Id;
!       D_Type   : Entity_Id;
!       Decls    : List_Id;
!       Dummy    : Node_Id;
!       Ename    : Node_Id;
!       Formals  : List_Id;
!       Index    : Node_Id;
!       N_Stats  : List_Id;
!       Obj      : Entity_Id;
!       Param    : Node_Id;
!       Params   : List_Id;
!       Stmt     : Node_Id;
!       Stmts    : List_Id;
!       Unpack   : List_Id;
  
!       B : Entity_Id;  --  Call status flag
!       C : Entity_Id;  --  Call kind
!       D : Entity_Id;  --  Delay
!       M : Entity_Id;  --  Delay mode
!       P : Entity_Id;  --  Parameter block
!       S : Entity_Id;  --  Primitive operation slot
  
     begin
        --  The arguments in the call may require dynamic allocation, and the
*************** package body Exp_Ch9 is
*** 7529,7535 ****
  
        if Nkind (E_Call) = N_Block_Statement then
           E_Call := First (Statements (Handled_Statement_Sequence (E_Call)));
- 
           while Nkind (E_Call) /= N_Procedure_Call_Statement
             and then Nkind (E_Call) /= N_Entry_Call_Statement
           loop
--- 9614,9619 ----
*************** package body Exp_Ch9 is
*** 7537,7706 ****
           end loop;
        end if;
  
!       --  Build an entry call using Simple_Entry_Call. We will use this as the
!       --  base for creating appropriate calls.
  
!       Extract_Entry (E_Call, Concval, Ename, Index);
!       Build_Simple_Entry_Call (E_Call, Concval, Ename, Index);
  
!       Stmts := Statements (Handled_Statement_Sequence (E_Call));
!       Decls := Declarations (E_Call);
  
!       if No (Decls) then
!          Decls := New_List;
        end if;
  
!       Dtyp := Base_Type (Etype (Expression (D_Stat)));
  
        --  Use the type of the delay expression (Calendar or Real_Time)
        --  to generate the appropriate conversion.
  
        if Nkind (D_Stat) = N_Delay_Relative_Statement then
!          Disc := Make_Integer_Literal (Loc, 0);
!          Conv := Relocate_Node (Expression (D_Stat));
  
!       elsif Is_RTE (Dtyp, RO_CA_Time) then
!          Disc := Make_Integer_Literal (Loc, 1);
!          Conv := Make_Function_Call (Loc,
             New_Reference_To (RTE (RO_CA_To_Duration), Loc),
             New_List (New_Copy (Expression (D_Stat))));
  
!       else pragma Assert (Is_RTE (Dtyp, RO_RT_Time));
!          Disc := Make_Integer_Literal (Loc, 2);
!          Conv := Make_Function_Call (Loc,
             New_Reference_To (RTE (RO_RT_To_Duration), Loc),
             New_List (New_Copy (Expression (D_Stat))));
        end if;
  
-       --  Create Duration and Delay_Mode objects for passing a delay value
- 
        D := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
!       M := Make_Defining_Identifier (Loc, New_Internal_Name ('M'));
  
        Append_To (Decls,
          Make_Object_Declaration (Loc,
!           Defining_Identifier => D,
!           Object_Definition => New_Reference_To (Standard_Duration, Loc)));
  
        Append_To (Decls,
          Make_Object_Declaration (Loc,
!           Defining_Identifier => M,
!           Object_Definition => New_Reference_To (Standard_Integer, Loc),
!           Expression        => Disc));
  
!       B := Make_Defining_Identifier (Loc, Name_uB);
  
!       --  Create a boolean object used for a return parameter
  
!       Prepend_To (Decls,
!         Make_Object_Declaration (Loc,
!           Defining_Identifier => B,
!           Object_Definition => New_Reference_To (Standard_Boolean, Loc)));
  
!       Stmt := First (Stmts);
  
!       --  Skip assignments to temporaries created for in-out parameters.
!       --  This makes unwarranted assumptions about the shape of the expanded
!       --  tree for the call, and should be cleaned up ???
  
!       while Nkind (Stmt) /= N_Procedure_Call_Statement loop
!          Next (Stmt);
!       end loop;
  
!       --  Do the assignement at this stage only because the evaluation of the
!       --  expression must not occur before (see ACVC C97302A).
  
!       Insert_Before (Stmt,
!         Make_Assignment_Statement (Loc,
!           Name => New_Reference_To (D, Loc),
!           Expression => Conv));
  
!       Call := Stmt;
  
!       Parms := Parameter_Associations (Call);
  
!       --  For a protected type, we build a Timed_Protected_Entry_Call
  
!       if Is_Protected_Type (Etype (Concval)) then
  
!          --  Create a new call statement
  
!          Parm := First (Parms);
  
!          while Present (Parm)
!            and then not Is_RTE (Etype (Parm), RE_Call_Modes)
!          loop
!             Next (Parm);
!          end loop;
  
!          Dummy := Remove_Next (Next (Parm));
  
!          --  Remove garbage is following the Cancel_Param if present
  
!          Dummy := Next (Parm);
  
!          --  Remove the mode of the Protected_Entry_Call call, then remove the
!          --  Communication_Block of the Protected_Entry_Call call, and finally
!          --  add Duration and a Delay_Mode parameter
  
!          pragma Assert (Present (Parm));
!          Rewrite (Parm, New_Reference_To (D, Loc));
  
!          Rewrite (Dummy, New_Reference_To (M, Loc));
  
!          --  Add a Boolean flag for successful entry call
  
!          Append_To (Parms, New_Reference_To (B, Loc));
  
!          if Abort_Allowed
!            or else Restriction_Active (No_Entry_Queue) = False
!            or else Number_Entries (Etype (Concval)) > 1
!          then
!             Rewrite (Call,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Timed_Protected_Entry_Call), Loc),
!                 Parameter_Associations => Parms));
  
!          else
!             Parm := First (Parms);
  
!             while Present (Parm)
!               and then not Is_RTE (Etype (Parm), RE_Protected_Entry_Index)
              loop
!                Next (Parm);
              end loop;
  
!             Remove (Parm);
  
!             Rewrite (Call,
!               Make_Procedure_Call_Statement (Loc,
!                 Name => New_Reference_To (
!                   RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
!                 Parameter_Associations => Parms));
!          end if;
  
!       --  For the task case, build a Timed_Task_Entry_Call
  
!       else
!          --  Create a new call statement
  
!          Append_To (Parms, New_Reference_To (D, Loc));
!          Append_To (Parms, New_Reference_To (M, Loc));
!          Append_To (Parms, New_Reference_To (B, Loc));
  
!          Rewrite (Call,
!            Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Timed_Task_Entry_Call), Loc),
!              Parameter_Associations => Parms));
  
!       end if;
  
!       Append_To (Stmts,
!         Make_Implicit_If_Statement (N,
!           Condition => New_Reference_To (B, Loc),
!           Then_Statements => E_Stats,
!           Else_Statements => D_Stats));
  
        Rewrite (N,
          Make_Block_Statement (Loc,
--- 9621,9985 ----
           end loop;
        end if;
  
!       if Ada_Version >= Ada_05
!         and then Nkind (E_Call) = N_Procedure_Call_Statement
!       then
!          Extract_Dispatching_Call (E_Call, Call_Ent, Obj, Actuals, Formals);
  
!          Decls := New_List;
!          Stmts := New_List;
  
!       else
!          --  Build an entry call using Simple_Entry_Call
  
!          Extract_Entry (E_Call, Concval, Ename, Index);
!          Build_Simple_Entry_Call (E_Call, Concval, Ename, Index);
! 
!          Decls := Declarations (E_Call);
!          Stmts := Statements (Handled_Statement_Sequence (E_Call));
! 
!          if No (Decls) then
!             Decls := New_List;
!          end if;
        end if;
  
!       --  Call status flag processing
! 
!       if Ada_Version >= Ada_05
!         and then Nkind (E_Call) = N_Procedure_Call_Statement
!       then
!          --  Generate:
!          --    B : Boolean := False;
! 
!          B := SEU.Build_B (Loc, Decls);
! 
!       else
!          --  Generate:
!          --    B : Boolean;
! 
!          B := Make_Defining_Identifier (Loc, Name_uB);
! 
!          Prepend_To (Decls,
!            Make_Object_Declaration (Loc,
!              Defining_Identifier =>
!                B,
!              Object_Definition =>
!                New_Reference_To (Standard_Boolean, Loc)));
!       end if;
! 
!       --  Call kind processing
! 
!       if Ada_Version >= Ada_05
!         and then Nkind (E_Call) = N_Procedure_Call_Statement
!       then
!          --  Generate:
!          --    C : Ada.Tags.Prim_Op_Kind;
! 
!          C := SEU.Build_C (Loc, Decls);
!       end if;
! 
!       --  Duration and mode processing
! 
!       D_Type := Base_Type (Etype (Expression (D_Stat)));
  
        --  Use the type of the delay expression (Calendar or Real_Time)
        --  to generate the appropriate conversion.
  
        if Nkind (D_Stat) = N_Delay_Relative_Statement then
!          D_Disc := Make_Integer_Literal (Loc, 0);
!          D_Conv := Relocate_Node (Expression (D_Stat));
  
!       elsif Is_RTE (D_Type, RO_CA_Time) then
!          D_Disc := Make_Integer_Literal (Loc, 1);
!          D_Conv := Make_Function_Call (Loc,
             New_Reference_To (RTE (RO_CA_To_Duration), Loc),
             New_List (New_Copy (Expression (D_Stat))));
  
!       else pragma Assert (Is_RTE (D_Type, RO_RT_Time));
!          D_Disc := Make_Integer_Literal (Loc, 2);
!          D_Conv := Make_Function_Call (Loc,
             New_Reference_To (RTE (RO_RT_To_Duration), Loc),
             New_List (New_Copy (Expression (D_Stat))));
        end if;
  
        D := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
! 
!       --  Generate:
!       --    D : Duration;
  
        Append_To (Decls,
          Make_Object_Declaration (Loc,
!           Defining_Identifier =>
!             D,
!           Object_Definition =>
!             New_Reference_To (Standard_Duration, Loc)));
! 
!       M := Make_Defining_Identifier (Loc, New_Internal_Name ('M'));
! 
!       --  Generate:
!       --    M : Integer := (0 | 1 | 2);
  
        Append_To (Decls,
          Make_Object_Declaration (Loc,
!           Defining_Identifier =>
!             M,
!           Object_Definition =>
!             New_Reference_To (Standard_Integer, Loc),
!           Expression =>
!             D_Disc));
  
!       --  Do the assignement at this stage only because the evaluation of the
!       --  expression must not occur before (see ACVC C97302A).
  
!       Append_To (Stmts,
!         Make_Assignment_Statement (Loc,
!           Name =>
!             New_Reference_To (D, Loc),
!           Expression =>
!             D_Conv));
  
!       --  Parameter block processing
  
!       --  Manually create the parameter block for dispatching calls. In the
!       --  case of entries, the block has already been created during the call
!       --  to Build_Simple_Entry_Call.
  
!       if Ada_Version >= Ada_05
!         and then Nkind (E_Call) = N_Procedure_Call_Statement
!       then
!          Blk_Typ := Build_Parameter_Block (Loc, Actuals, Formals, Decls);
!          P       := Parameter_Block_Pack  (Loc, Blk_Typ, Actuals, Formals,
!                       Decls, Stmts);
  
!          --  Dispatch table slot processing, generate:
!          --    S : constant Integer :=
!          --          Ada.Tags.Get_Offset_Index (
!          --            Unchecked_Convert_To (Ada.Tags.Interface_Tag, Obj),
!          --            DT_Position (<dispatching-procedure>));
  
!          S := SEU.Build_S (Loc, Decls, Obj, Call_Ent);
  
!          --  Generate:
!          --    _dispatching_timed_select (Obj, S, P'address, D, M, C, B);
  
!          --  where Obj is the controlling formal parameter, S is the dispatch
!          --  table slot number of the dispatching operation, P is the wrapped
!          --  parameter block, D is the duration, M is the duration mode, C is
!          --  the call kind and B is the call status.
  
!          Params := New_List;
  
!          Append_To (Params, New_Copy_Tree    (Obj));
!          Append_To (Params, New_Reference_To (S, Loc));
!          Append_To (Params, Make_Attribute_Reference (Loc,
!                               Prefix => New_Reference_To (P, Loc),
!                               Attribute_Name => Name_Address));
!          Append_To (Params, New_Reference_To (D, Loc));
!          Append_To (Params, New_Reference_To (M, Loc));
!          Append_To (Params, New_Reference_To (C, Loc));
!          Append_To (Params, New_Reference_To (B, Loc));
  
!          Append_To (Stmts,
!            Make_Procedure_Call_Statement (Loc,
!              Name =>
!                New_Reference_To (
!                  Find_Prim_Op (Etype (Etype (Obj)),
!                    Name_uDisp_Timed_Select),
!                  Loc),
!              Parameter_Associations =>
!                Params));
  
!          --  Generate:
!          --    if C = POK_Protected_Entry
!          --      or else C = POK_Task_Entry
!          --    then
!          --       Param1 := P.Param1;
!          --       ...
!          --       ParamN := P.ParamN;
!          --    end if;
  
!          Unpack := Parameter_Block_Unpack (Loc, P, Actuals, Formals);
  
!          --  Generate the if statement only when the packed parameters need
!          --  explicit assignments to their corresponding actuals.
  
!          if Present (Unpack) then
!             Append_To (Stmts,
!               Make_If_Statement (Loc,
  
!                 Condition =>
!                   Make_Or_Else (Loc,
!                     Left_Opnd =>
!                       Make_Op_Eq (Loc,
!                         Left_Opnd =>
!                           New_Reference_To (C, Loc),
!                         Right_Opnd =>
!                           New_Reference_To (RTE (
!                             RE_POK_Protected_Entry), Loc)),
!                     Right_Opnd =>
!                       Make_Op_Eq (Loc,
!                         Left_Opnd =>
!                           New_Reference_To (C, Loc),
!                         Right_Opnd =>
!                           New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
  
!                 Then_Statements => Unpack));
!          end if;
  
!          --  Generate:
  
!          --    if B then
!          --       if C = POK_Procedure
!          --         or else C = POK_Protected_Procedure
!          --         or else C = POK_Task_Procedure
!          --       then
!          --          <dispatching-procedure-call>
!          --       end if;
!          --       <normal-statements>
!          --    else
!          --       <delay-statements>
!          --    end if;
  
!          N_Stats := New_Copy_List_Tree (E_Stats);
  
!          Prepend_To (N_Stats,
!            Make_If_Statement (Loc,
  
!              Condition =>
!                Make_Or_Else (Loc,
!                  Left_Opnd =>
!                    Make_Op_Eq (Loc,
!                      Left_Opnd =>
!                        New_Reference_To (C, Loc),
!                      Right_Opnd =>
!                        New_Reference_To (RTE (RE_POK_Procedure), Loc)),
!                  Right_Opnd =>
!                    Make_Or_Else (Loc,
!                      Left_Opnd =>
!                        Make_Op_Eq (Loc,
!                          Left_Opnd =>
!                            New_Reference_To (C, Loc),
!                          Right_Opnd =>
!                            New_Reference_To (RTE (
!                              RE_POK_Protected_Procedure), Loc)),
!                      Right_Opnd =>
!                        Make_Op_Eq (Loc,
!                          Left_Opnd =>
!                            New_Reference_To (C, Loc),
!                          Right_Opnd =>
!                            New_Reference_To (RTE (
!                              RE_POK_Task_Procedure), Loc)))),
  
!              Then_Statements =>
!                New_List (E_Call)));
  
!          Append_To (Stmts,
!            Make_If_Statement (Loc,
!              Condition       => New_Reference_To (B, Loc),
!              Then_Statements => N_Stats,
!              Else_Statements => D_Stats));
!       else
!          --  Skip assignments to temporaries created for in-out parameters.
!          --  This makes unwarranted assumptions about the shape of the expanded
!          --  tree for the call, and should be cleaned up ???
  
!          Stmt := First (Stmts);
!          while Nkind (Stmt) /= N_Procedure_Call_Statement loop
!             Next (Stmt);
!          end loop;
! 
!          --  Do the assignement at this stage only because the evaluation
!          --  of the expression must not occur before (see ACVC C97302A).
! 
!          Insert_Before (Stmt,
!            Make_Assignment_Statement (Loc,
!              Name => New_Reference_To (D, Loc),
!              Expression => D_Conv));
! 
!          Call   := Stmt;
!          Params := Parameter_Associations (Call);
! 
!          --  For a protected type, we build a Timed_Protected_Entry_Call
! 
!          if Is_Protected_Type (Etype (Concval)) then
! 
!             --  Create a new call statement
! 
!             Param := First (Params);
!             while Present (Param)
!               and then not Is_RTE (Etype (Param), RE_Call_Modes)
              loop
!                Next (Param);
              end loop;
  
!             Dummy := Remove_Next (Next (Param));
  
!             --  Remove garbage is following the Cancel_Param if present
  
!             Dummy := Next (Param);
  
!             --  Remove the mode of the Protected_Entry_Call call, then remove
!             --  the Communication_Block of the Protected_Entry_Call call, and
!             --  finally add Duration and a Delay_Mode parameter
  
!             pragma Assert (Present (Param));
!             Rewrite (Param, New_Reference_To (D, Loc));
  
!             Rewrite (Dummy, New_Reference_To (M, Loc));
  
!             --  Add a Boolean flag for successful entry call
  
!             Append_To (Params, New_Reference_To (B, Loc));
! 
!             if Abort_Allowed
!               or else Restriction_Active (No_Entry_Queue) = False
!               or else Number_Entries (Etype (Concval)) > 1
!             then
!                Rewrite (Call,
!                  Make_Procedure_Call_Statement (Loc,
!                    Name =>
!                      New_Reference_To (RTE (
!                        RE_Timed_Protected_Entry_Call), Loc),
!                    Parameter_Associations => Params));
!             else
!                Param := First (Params);
!                while Present (Param)
!                  and then not Is_RTE (Etype (Param), RE_Protected_Entry_Index)
!                loop
!                   Next (Param);
!                end loop;
! 
!                Remove (Param);
! 
!                Rewrite (Call,
!                  Make_Procedure_Call_Statement (Loc,
!                    Name => New_Reference_To (
!                      RTE (RE_Timed_Protected_Single_Entry_Call), Loc),
!                    Parameter_Associations => Params));
!             end if;
! 
!          --  For the task case, build a Timed_Task_Entry_Call
! 
!          else
!             --  Create a new call statement
! 
!             Append_To (Params, New_Reference_To (D, Loc));
!             Append_To (Params, New_Reference_To (M, Loc));
!             Append_To (Params, New_Reference_To (B, Loc));
! 
!             Rewrite (Call,
!               Make_Procedure_Call_Statement (Loc,
!                 Name =>
!                   New_Reference_To (RTE (RE_Timed_Task_Entry_Call), Loc),
!                 Parameter_Associations => Params));
!          end if;
! 
!          Append_To (Stmts,
!            Make_Implicit_If_Statement (N,
!              Condition => New_Reference_To (B, Loc),
!              Then_Statements => E_Stats,
!              Else_Statements => D_Stats));
!       end if;
  
        Rewrite (N,
          Make_Block_Statement (Loc,
*************** package body Exp_Ch9 is
*** 7715,7732 ****
     -- Expand_Protected_Body_Declarations --
     ----------------------------------------
  
!    --  Part of the expansion of a protected body involves the creation of
!    --  a declaration that can be referenced from the statement sequences of
!    --  the entry bodies:
  
     --    A : Address;
  
!    --  This declaration is inserted in the declarations of the service
!    --  entries procedure for the protected body, and it is important that
!    --  it be inserted before the statements of the entry body statement
!    --  sequences are analyzed. Thus it would be too late to create this
!    --  declaration in the Expand_N_Protected_Body routine, which is why
!    --  there is a separate procedure to be called directly from Sem_Ch9.
  
     --  Ann is used to hold the address of the record containing the parameters
     --  (see Expand_N_Entry_Call for more details on how this record is built).
--- 9994,10011 ----
     -- Expand_Protected_Body_Declarations --
     ----------------------------------------
  
!    --  Part of the expansion of a protected body involves the creation of a
!    --  declaration that can be referenced from the statement sequences of the
!    --  entry bodies:
  
     --    A : Address;
  
!    --  This declaration is inserted in the declarations of the service entries
!    --  procedure for the protected body, and it is important that it be
!    --  inserted before the statements of the entry body statement sequences are
!    --  analyzed. Thus it would be too late to create this declaration in the
!    --  Expand_N_Protected_Body routine, which is why there is a separate
!    --  procedure to be called directly from Sem_Ch9.
  
     --  Ann is used to hold the address of the record containing the parameters
     --  (see Expand_N_Entry_Call for more details on how this record is built).
*************** package body Exp_Ch9 is
*** 7737,7750 ****
     --  Accept_Address stack in the corresponding entry entity, and this element
     --  must be set in place  before the statements are processed.
  
!    --  No stack is needed for entry bodies, since they cannot be nested, but
!    --  it is kept for consistency between protected and task entries. The
!    --  stack will never contain more than one element. There is also only one
!    --  such variable for a given protected body, but this is placed on the
     --  Accept_Address stack of all of the entries, again for consistency.
  
!    --  To expand the requeue statement, a label is provided at the end of
!    --  the loop in the entry service routine created by the expander (see
     --  Expand_N_Protected_Body for details), so that the statement can be
     --  skipped after the requeue is complete. This label is created during the
     --  expansion of the entry body, which will take place after the expansion
--- 10016,10029 ----
     --  Accept_Address stack in the corresponding entry entity, and this element
     --  must be set in place  before the statements are processed.
  
!    --  No stack is needed for entry bodies, since they cannot be nested, but it
!    --  is kept for consistency between protected and task entries. The stack
!    --  will never contain more than one element. There is also only one such
!    --  variable for a given protected body, but this is placed on the
     --  Accept_Address stack of all of the entries, again for consistency.
  
!    --  To expand the requeue statement, a label is provided at the end of the
!    --  loop in the entry service routine created by the expander (see
     --  Expand_N_Protected_Body for details), so that the statement can be
     --  skipped after the requeue is complete. This label is created during the
     --  expansion of the entry body, which will take place after the expansion
*************** package body Exp_Ch9 is
*** 7772,7780 ****
  
        elsif Expander_Active then
  
!          --  Associate privals with the first subprogram or entry
!          --  body to be expanded. These are used to expand references
!          --  to private data objects.
  
           Op := First_Protected_Operation (Declarations (N));
  
--- 10051,10059 ----
  
        elsif Expander_Active then
  
!          --  Associate privals with the first subprogram or entry body to be
!          --  expanded. These are used to expand references to private data
!          --  objects.
  
           Op := First_Protected_Operation (Declarations (N));
  
*************** package body Exp_Ch9 is
*** 7810,7815 ****
--- 10089,10143 ----
        end if;
     end External_Subprogram;
  
+    ------------------------------
+    -- Extract_Dispatching_Call --
+    ------------------------------
+ 
+    procedure Extract_Dispatching_Call
+      (N        : Node_Id;
+       Call_Ent : out Entity_Id;
+       Object   : out Entity_Id;
+       Actuals  : out List_Id;
+       Formals  : out List_Id)
+    is
+       Call_Nam : Node_Id;
+ 
+    begin
+       pragma Assert (Nkind (N) = N_Procedure_Call_Statement);
+ 
+       if Present (Original_Node (N)) then
+          Call_Nam := Name (Original_Node (N));
+       else
+          Call_Nam := Name (N);
+       end if;
+ 
+       --  Retrieve the name of the dispatching procedure. It contains the
+       --  dispatch table slot number.
+ 
+       loop
+          case Nkind (Call_Nam) is
+             when N_Identifier =>
+                exit;
+ 
+             when N_Selected_Component =>
+                Call_Nam := Selector_Name (Call_Nam);
+ 
+             when others =>
+                raise Program_Error;
+ 
+          end case;
+       end loop;
+ 
+       Actuals  := Parameter_Associations (N);
+       Call_Ent := Entity (Call_Nam);
+       Formals  := Parameter_Specifications (Parent (Call_Ent));
+       Object   := First (Actuals);
+ 
+       if Present (Original_Node (Object)) then
+          Object := Original_Node (Object);
+       end if;
+    end Extract_Dispatching_Call;
+ 
     -------------------
     -- Extract_Entry --
     -------------------
*************** package body Exp_Ch9 is
*** 7831,7845 ****
           Ename   := Selector_Name (Nam);
           Index   := Empty;
  
!          --  For a member of an entry family, the name is an indexed
!          --  component where the prefix is a selected component,
!          --  whose prefix in turn is the task value, and whose
!          --  selector is the entry family. The single expression in
!          --  the expressions list of the indexed component is the
!          --  subscript for the family.
  
!       else
!          pragma Assert (Nkind (Nam) = N_Indexed_Component);
           Concval := Prefix (Prefix (Nam));
           Ename   := Selector_Name (Prefix (Nam));
           Index   := First (Expressions (Nam));
--- 10159,10171 ----
           Ename   := Selector_Name (Nam);
           Index   := Empty;
  
!       --  For a member of an entry family, the name is an indexed component
!       --  where the prefix is a selected component, whose prefix in turn is
!       --  the task value, and whose selector is the entry family. The single
!       --  expression in the expressions list of the indexed component is the
!       --  subscript for the family.
  
!       else pragma Assert (Nkind (Nam) = N_Indexed_Component);
           Concval := Prefix (Prefix (Nam));
           Ename   := Selector_Name (Prefix (Nam));
           Index   := First (Expressions (Nam));
*************** package body Exp_Ch9 is
*** 7857,7868 ****
        Ttyp : Entity_Id) return Node_Id
     is
        function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
!       --  If one of the bounds is a reference to a discriminant, replace
!       --  with corresponding discriminal of type. Within the body of a task
!       --  retrieve the renamed discriminant by simple visibility, using its
!       --  generated name. Within a protected object, find the original dis-
!       --  criminant and replace it with the discriminal of the current prot-
!       --  ected operation.
  
        ------------------------------
        -- Convert_Discriminant_Ref --
--- 10183,10193 ----
        Ttyp : Entity_Id) return Node_Id
     is
        function Convert_Discriminant_Ref (Bound : Node_Id) return Node_Id;
!       --  If one of the bounds is a reference to a discriminant, replace with
!       --  corresponding discriminal of type. Within the body of a task retrieve
!       --  the renamed discriminant by simple visibility, using its generated
!       --  name. Within a protected object, find the original dis- criminant and
!       --  replace it with the discriminal of the current prot- ected operation.
  
        ------------------------------
        -- Convert_Discriminant_Ref --
*************** package body Exp_Ch9 is
*** 7885,7891 ****
  
              elsif Is_Protected_Type (Ttyp) then
                 D := First_Discriminant (Ttyp);
- 
                 while Chars (D) /= Chars (Entity (Bound)) loop
                    Next_Discriminant (D);
                 end loop;
--- 10210,10215 ----
*************** package body Exp_Ch9 is
*** 7963,7969 ****
  
     begin
        N := First (Visible_Declarations (T));
- 
        while Present (N) loop
           if Nkind (N) = N_Pragma then
              if Chars (N) = P then
--- 10287,10292 ----
*************** package body Exp_Ch9 is
*** 7984,7990 ****
        end loop;
  
        N := First (Private_Declarations (T));
- 
        while Present (N) loop
           if Nkind (N) = N_Pragma then
              if  Chars (N) = P then
--- 10307,10312 ----
*************** package body Exp_Ch9 is
*** 8044,8053 ****
        Lo : Node_Id := Type_Low_Bound  (Etype (Index_Id));
  
        function Replace_Discriminant (Bound : Node_Id) return Node_Id;
!       --  The bounds of the entry index may depend on discriminants, so
!       --  each declaration of an entry_index_constant must have its own
!       --  subtype declaration, using the local renaming of the object discri-
!       --  minant.
  
        --------------------------
        -- Replace_Discriminant --
--- 10366,10374 ----
        Lo : Node_Id := Type_Low_Bound  (Etype (Index_Id));
  
        function Replace_Discriminant (Bound : Node_Id) return Node_Id;
!       --  The bounds of the entry index may depend on discriminants, so each
!       --  declaration of an entry_index_constant must have its own subtype
!       --  declaration, using the local renaming of the object discriminant.
  
        --------------------------
        -- Replace_Discriminant --
*************** package body Exp_Ch9 is
*** 8151,8172 ****
        Restricted  : constant Boolean := Restricted_Profile;
  
     begin
!       --  We may need two calls to properly initialize the object, one
!       --  to Initialize_Protection, and possibly one to Install_Handlers
!       --  if we have a pragma Attach_Handler.
  
        --  Get protected declaration. In the case of a task type declaration,
!       --  this is simply the parent of the protected type entity.
!       --  In the single protected object
!       --  declaration, this parent will be the implicit type, and we can find
!       --  the corresponding single protected object declaration by
!       --  searching forward in the declaration list in the tree.
!       --  ??? I am not sure that the test for N_Single_Protected_Declaration
!       --      is needed here. Nodes of this type should have been removed
!       --      during semantic analysis.
  
!       Pdec := Parent (Ptyp);
  
        while Nkind (Pdec) /= N_Protected_Type_Declaration
          and then Nkind (Pdec) /= N_Single_Protected_Declaration
        loop
--- 10472,10491 ----
        Restricted  : constant Boolean := Restricted_Profile;
  
     begin
!       --  We may need two calls to properly initialize the object, one to
!       --  Initialize_Protection, and possibly one to Install_Handlers if we
!       --  have a pragma Attach_Handler.
  
        --  Get protected declaration. In the case of a task type declaration,
!       --  this is simply the parent of the protected type entity. In the single
!       --  protected object declaration, this parent will be the implicit type,
!       --  and we can find the corresponding single protected object declaration
!       --  by searching forward in the declaration list in the tree.
  
!       --  Is the test for N_Single_Protected_Declaration needed here??? Nodes
!       --  of this type should have been removed during semantic analysis.
  
+       Pdec := Parent (Ptyp);
        while Nkind (Pdec) /= N_Protected_Type_Declaration
          and then Nkind (Pdec) /= N_Single_Protected_Declaration
        loop
*************** package body Exp_Ch9 is
*** 8228,8233 ****
--- 10547,10554 ----
        if Has_Entry
          or else Has_Interrupt_Handler (Ptyp)
          or else Has_Attach_Handler (Ptyp)
+         or else (Ada_Version >= Ada_05
+                    and then Present (Interface_List (Parent (Ptyp))))
        then
           --  Compiler_Info parameter. This parameter allows entry body
           --  procedures and barrier functions to be called from the runtime.
*************** package body Exp_Ch9 is
*** 8242,8251 ****
           end if;
  
           if Has_Entry then
              --  Entry_Bodies parameter. This is a pointer to an array of
!             --  pointers to the entry body procedures and barrier functions
!             --  of the object. If the protected type has no entries this
!             --  object will not exist; in this case, pass a null.
  
              P_Arr := Entry_Bodies_Array (Ptyp);
  
--- 10563,10573 ----
           end if;
  
           if Has_Entry then
+ 
              --  Entry_Bodies parameter. This is a pointer to an array of
!             --  pointers to the entry body procedures and barrier functions of
!             --  the object. If the protected type has no entries this object
!             --  will not exist; in this case, pass a null.
  
              P_Arr := Entry_Bodies_Array (Ptyp);
  
*************** package body Exp_Ch9 is
*** 8310,8320 ****
  
        if Has_Attach_Handler (Ptyp) then
  
!          --  We have a list of N Attach_Handler (ProcI, ExprI),
!          --  and we have to make the following call:
           --  Install_Handlers (_object,
           --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
           --  or, in the case of Ravenscar:
           --  Install_Handlers
           --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
  
--- 10632,10645 ----
  
        if Has_Attach_Handler (Ptyp) then
  
!          --  We have a list of N Attach_Handler (ProcI, ExprI), and we have to
!          --  make the following call:
! 
           --  Install_Handlers (_object,
           --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
+ 
           --  or, in the case of Ravenscar:
+ 
           --  Install_Handlers
           --    ((Expr1, Proc1'access), ...., (ExprN, ProcN'access));
  
*************** package body Exp_Ch9 is
*** 8325,8330 ****
--- 10650,10656 ----
  
           begin
              if not Restricted then
+ 
                 --  Appends the _object argument
  
                 Append_To (Args,
*************** package body Exp_Ch9 is
*** 8400,8416 ****
        Ttyp := Corresponding_Concurrent_Type (Task_Rec);
        Tnam := Chars (Ttyp);
  
!       --  Get task declaration. In the case of a task type declaration, this
!       --  is simply the parent of the task type entity. In the single task
        --  declaration, this parent will be the implicit type, and we can find
!       --  the corresponding single task declaration by searching forward in
!       --  the declaration list in the tree.
!       --  ??? I am not sure that the test for N_Single_Task_Declaration
!       --      is needed here. Nodes of this type should have been removed
!       --      during semantic analysis.
  
!       Tdec := Parent (Ttyp);
  
        while Nkind (Tdec) /= N_Task_Type_Declaration
          and then Nkind (Tdec) /= N_Single_Task_Declaration
        loop
--- 10726,10741 ----
        Ttyp := Corresponding_Concurrent_Type (Task_Rec);
        Tnam := Chars (Ttyp);
  
!       --  Get task declaration. In the case of a task type declaration, this is
!       --  simply the parent of the task type entity. In the single task
        --  declaration, this parent will be the implicit type, and we can find
!       --  the corresponding single task declaration by searching forward in the
!       --  declaration list in the tree.
  
!       --  Is the test for N_Single_Task_Declaration needed here??? Nodes of
!       --  this type should have been removed during semantic analysis.
  
+       Tdec := Parent (Ttyp);
        while Nkind (Tdec) /= N_Task_Type_Declaration
          and then Nkind (Tdec) /= N_Single_Task_Declaration
        loop
*************** package body Exp_Ch9 is
*** 8605,8611 ****
  
     begin
        Next_Op := Next (N);
- 
        while Present (Next_Op)
          and then Nkind (Next_Op) /= N_Subprogram_Body
          and then Nkind (Next_Op) /= N_Entry_Body
--- 10930,10935 ----
*************** package body Exp_Ch9 is
*** 8616,8621 ****
--- 10940,11112 ----
        return Next_Op;
     end Next_Protected_Operation;
  
+    --------------------------
+    -- Parameter_Block_Pack --
+    --------------------------
+ 
+    function Parameter_Block_Pack
+      (Loc     : Source_Ptr;
+       Blk_Typ : Entity_Id;
+       Actuals : List_Id;
+       Formals : List_Id;
+       Decls   : List_Id;
+       Stmts   : List_Id) return Node_Id
+    is
+       Actual    : Entity_Id;
+       Expr      : Node_Id := Empty;
+       Formal    : Entity_Id;
+       Has_Param : Boolean := False;
+       P         : Entity_Id;
+       Params    : List_Id;
+       Temp_Asn  : Node_Id;
+       Temp_Nam  : Node_Id;
+ 
+    begin
+       Actual := First (Actuals);
+       Formal := Defining_Identifier (First (Formals));
+       Params := New_List;
+ 
+       while Present (Actual) loop
+          if Is_By_Copy_Type (Etype (Actual)) then
+             --  Generate:
+             --    Jnn : aliased <formal-type>
+ 
+             Temp_Nam :=
+               Make_Defining_Identifier (Loc, New_Internal_Name ('J'));
+ 
+             Append_To (Decls,
+               Make_Object_Declaration (Loc,
+                 Aliased_Present =>
+                   True,
+                 Defining_Identifier =>
+                   Temp_Nam,
+                 Object_Definition =>
+                   New_Reference_To (Etype (Formal), Loc)));
+ 
+             if Ekind (Formal) /= E_Out_Parameter then
+ 
+                --  Generate:
+                --    Jnn := <actual>
+ 
+                Temp_Asn :=
+                  New_Reference_To (Temp_Nam, Loc);
+ 
+                Set_Assignment_OK (Temp_Asn);
+ 
+                Append_To (Stmts,
+                  Make_Assignment_Statement (Loc,
+                    Name =>
+                      Temp_Asn,
+                    Expression =>
+                      New_Copy_Tree (Actual)));
+             end if;
+ 
+             --  Generate:
+             --    Jnn'unchecked_access
+ 
+             Append_To (Params,
+               Make_Attribute_Reference (Loc,
+                 Attribute_Name =>
+                   Name_Unchecked_Access,
+                 Prefix =>
+                   New_Reference_To (Temp_Nam, Loc)));
+ 
+             Has_Param := True;
+ 
+          --  The controlling parameter is omitted
+ 
+          else
+             if not Is_Controlling_Actual (Actual) then
+                Append_To (Params,
+                  Make_Reference (Loc, New_Copy_Tree (Actual)));
+ 
+                Has_Param := True;
+             end if;
+          end if;
+ 
+          Next_Actual (Actual);
+          Next_Formal_With_Extras (Formal);
+       end loop;
+ 
+       if Has_Param then
+          Expr := Make_Aggregate (Loc, Params);
+       end if;
+ 
+       --  Generate:
+       --    P : Ann := (
+       --      J1'unchecked_access;
+       --      <actual2>'reference;
+       --      ...);
+ 
+       P := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+ 
+       Append_To (Decls,
+         Make_Object_Declaration (Loc,
+           Defining_Identifier =>
+             P,
+           Object_Definition =>
+             New_Reference_To (Blk_Typ, Loc),
+           Expression =>
+             Expr));
+ 
+       return P;
+    end Parameter_Block_Pack;
+ 
+    ----------------------------
+    -- Parameter_Block_Unpack --
+    ----------------------------
+ 
+    function Parameter_Block_Unpack
+      (Loc     : Source_Ptr;
+       P       : Entity_Id;
+       Actuals : List_Id;
+       Formals : List_Id) return List_Id
+    is
+       Actual    : Entity_Id;
+       Asnmt     : Node_Id;
+       Formal    : Entity_Id;
+       Has_Asnmt : Boolean := False;
+       Result    : constant List_Id := New_List;
+ 
+    begin
+       Actual := First (Actuals);
+       Formal := Defining_Identifier (First (Formals));
+       while Present (Actual) loop
+          if Is_By_Copy_Type (Etype (Actual))
+            and then Ekind (Formal) /= E_In_Parameter
+          then
+             --  Generate:
+             --    <actual> := P.<formal>;
+ 
+             Asnmt :=
+               Make_Assignment_Statement (Loc,
+                 Name =>
+                   New_Copy (Actual),
+                 Expression =>
+                   Make_Explicit_Dereference (Loc,
+                     Make_Selected_Component (Loc,
+                       Prefix =>
+                         New_Reference_To (P, Loc),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Chars (Formal)))));
+ 
+             Set_Assignment_OK (Name (Asnmt));
+             Append_To (Result, Asnmt);
+ 
+             Has_Asnmt := True;
+          end if;
+ 
+          Next_Actual (Actual);
+          Next_Formal_With_Extras (Formal);
+       end loop;
+ 
+       if Has_Asnmt then
+          return Result;
+       else
+          return New_List (Make_Null_Statement (Loc));
+       end if;
+    end Parameter_Block_Unpack;
+ 
     ----------------------
     -- Set_Discriminals --
     ----------------------
*************** package body Exp_Ch9 is
*** 8631,8637 ****
  
        if Has_Discriminants (Pdef) then
           D := First_Discriminant (Pdef);
- 
           while Present (D) loop
              D_Minal :=
                Make_Defining_Identifier (Sloc (D),
--- 11122,11127 ----
*************** package body Exp_Ch9 is
*** 8653,8667 ****
     -----------------
  
     procedure Set_Privals
!       (Dec : Node_Id;
!        Op  : Node_Id;
!        Loc : Source_Ptr)
     is
!       P_Decl    : Node_Id;
!       P_Id      : Entity_Id;
!       Priv      : Entity_Id;
!       Def       : Node_Id;
!       Body_Ent  : Entity_Id;
        Prec_Decl : constant Node_Id :=
                      Parent (Corresponding_Record_Type
                               (Defining_Identifier (Dec)));
--- 11143,11161 ----
     -----------------
  
     procedure Set_Privals
!       (Dec           : Node_Id;
!        Op            : Node_Id;
!        Loc           : Source_Ptr;
!        After_Barrier : Boolean := False)
     is
!       P_Decl      : Node_Id;
!       P_Id        : Entity_Id;
!       Priv        : Entity_Id;
!       Def         : Node_Id;
!       Body_Ent    : Entity_Id;
!       For_Barrier : constant Boolean :=
!                       Nkind (Op) = N_Entry_Body and then not After_Barrier;
! 
        Prec_Decl : constant Node_Id :=
                      Parent (Corresponding_Record_Type
                               (Defining_Identifier (Dec)));
*************** package body Exp_Ch9 is
*** 8679,8693 ****
        Def := Protected_Definition (Dec);
  
        if Present (Private_Declarations (Def)) then
- 
           P_Decl := First (Private_Declarations (Def));
- 
           while Present (P_Decl) loop
              if Nkind (P_Decl) = N_Component_Declaration then
                 P_Id := Defining_Identifier (P_Decl);
!                Priv :=
!                  Make_Defining_Identifier (Loc,
!                    New_External_Name (Chars (P_Id), 'P'));
  
                 Set_Ekind     (Priv, E_Variable);
                 Set_Etype     (Priv, Etype (P_Id));
--- 11173,11192 ----
        Def := Protected_Definition (Dec);
  
        if Present (Private_Declarations (Def)) then
           P_Decl := First (Private_Declarations (Def));
           while Present (P_Decl) loop
              if Nkind (P_Decl) = N_Component_Declaration then
                 P_Id := Defining_Identifier (P_Decl);
! 
!                if For_Barrier then
!                   Priv :=
!                     Make_Defining_Identifier (Loc,
!                       Chars => New_External_Name (Chars (P_Id), 'P'));
!                else
!                   Priv :=
!                     Make_Defining_Identifier (Loc,
!                       Chars => New_External_Name (Chars (P_Id)));
!                end if;
  
                 Set_Ekind     (Priv, E_Variable);
                 Set_Etype     (Priv, Etype (P_Id));
*************** package body Exp_Ch9 is
*** 8695,8705 ****
                 Set_Esize     (Priv, Esize (Etype (P_Id)));
                 Set_Alignment (Priv, Alignment (Etype (P_Id)));
  
!                --  If the type of the component is an itype, we must
!                --  create a new itype for the corresponding prival in
!                --  each protected operation, to avoid scoping problems.
!                --  We create new itypes by copying the tree for the
!                --  component definition.
  
                 if Is_Itype (Etype (P_Id)) then
                    Append_Elmt (P_Id, Assoc_L);
--- 11194,11203 ----
                 Set_Esize     (Priv, Esize (Etype (P_Id)));
                 Set_Alignment (Priv, Alignment (Etype (P_Id)));
  
!                --  If the type of the component is an itype, we must create a
!                --  new itype for the corresponding prival in each protected
!                --  operation, to avoid scoping problems. We create new itypes
!                --  by copying the tree for the component definition.
  
                 if Is_Itype (Etype (P_Id)) then
                    Append_Elmt (P_Id, Assoc_L);
*************** package body Exp_Ch9 is
*** 8723,8731 ****
           end loop;
        end if;
  
!       --  There is one more implicit private declaration: the object
!       --  itself. A "prival" for this is attached to the protected
!       --  body defining identifier.
  
        Body_Ent := Corresponding_Body (Dec);
  
--- 11221,11228 ----
           end loop;
        end if;
  
!       --  There is one more implicit private decl: the object itself. "prival"
!       --  for this is attached to the protected body defining identifier.
  
        Body_Ent := Corresponding_Body (Dec);
  
*************** package body Exp_Ch9 is
*** 8780,8786 ****
           if Is_Entity_Name (N)  then
              declare
                 E : constant Entity_Id := Entity (N);
- 
              begin
                 if Present (E)
                   and then (Ekind (E) = E_Constant
--- 11277,11282 ----
*************** package body Exp_Ch9 is
*** 8821,8831 ****
              Update_Array_Bounds (Etype (Defining_Identifier (N)));
              return OK;
  
!          --  For array components of discriminated records, use the
!          --  base type directly, because it may depend indirectly
!          --  on the discriminants of the protected type. Cleaner would
!          --  be a systematic mechanism to compute actual subtypes of
!          --  private components ???
  
           elsif Nkind (N) in N_Has_Etype
             and then Present (Etype (N))
--- 11317,11328 ----
              Update_Array_Bounds (Etype (Defining_Identifier (N)));
              return OK;
  
!          --  For array components of discriminated records, use the base type
!          --  directly, because it may depend indirectly on the discriminants of
!          --  the protected type.
! 
!          --  Cleaner would be a systematic mechanism to compute actual subtypes
!          --  of private components???
  
           elsif Nkind (N) in N_Has_Etype
             and then Present (Etype (N))
*************** package body Exp_Ch9 is
*** 8861,8870 ****
  
        procedure Update_Array_Bounds (E : Entity_Id) is
           Ind : Node_Id;
- 
        begin
           Ind := First_Index (E);
- 
           while Present (Ind) loop
              Update_Prival_Subtypes (Type_Low_Bound  (Etype (Ind)));
              Update_Prival_Subtypes (Type_High_Bound (Etype (Ind)));
--- 11358,11365 ----
*************** package body Exp_Ch9 is
*** 8879,8891 ****
        procedure Update_Index_Types (N : Node_Id) is
           Indx1 : Node_Id;
           I_Typ : Node_Id;
        begin
!          --  If the prefix has an actual subtype that is different
!          --  from the nominal one, update the types of the indices,
!          --  so that the proper constraints are applied. Do not
!          --  apply this transformation to a packed array, where the
!          --  index type is computed for a byte array and is different
!          --  from the source index.
  
           if Nkind (Parent (N)) = N_Indexed_Component
             and then
--- 11374,11386 ----
        procedure Update_Index_Types (N : Node_Id) is
           Indx1 : Node_Id;
           I_Typ : Node_Id;
+ 
        begin
!          --  If the prefix has an actual subtype that is different from the
!          --  nominal one, update the types of the indices, so that the proper
!          --  constraints are applied. Do not apply this transformation to a
!          --  packed array, where the index type is computed for a byte array
!          --  and is different from the source index.
  
           if Nkind (Parent (N)) = N_Indexed_Component
             and then
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_ch9.ads gcc-4.1.0/gcc/ada/exp_ch9.ads
*** gcc-4.0.2/gcc/ada/exp_ch9.ads	Mon Jun  7 14:16:18 2004
--- gcc-4.1.0/gcc/ada/exp_ch9.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Types; use Types;
*** 30,35 ****
--- 30,42 ----
  
  package Exp_Ch9 is
  
+    type Subprogram_Protection_Mode is
+      (Dispatching_Mode,
+       Protected_Mode,
+       Unprotected_Mode);
+    --  This type is used to distinguish the different protection modes of a
+    --  protected subprogram.
+ 
     procedure Add_Discriminal_Declarations
       (Decls : List_Id;
        Typ   : Entity_Id;
*************** package Exp_Ch9 is
*** 102,111 ****
     --  declarative part.
  
     function Build_Protected_Sub_Specification
!      (N           : Node_Id;
!       Prottyp     : Entity_Id;
!       Unprotected : Boolean := False)
!       return        Node_Id;
     --  Build specification for protected subprogram. This is called when
     --  expanding a protected type, and also when expanding the declaration for
     --  an Access_To_Protected_Subprogram type. In the latter case, Prottyp is
--- 109,117 ----
     --  declarative part.
  
     function Build_Protected_Sub_Specification
!      (N       : Node_Id;
!       Prottyp : Entity_Id;
!       Mode    : Subprogram_Protection_Mode) return Node_Id;
     --  Build specification for protected subprogram. This is called when
     --  expanding a protected type, and also when expanding the declaration for
     --  an Access_To_Protected_Subprogram type. In the latter case, Prottyp is
*************** package Exp_Ch9 is
*** 214,220 ****
     --  routine to make sure Complete_Master is called on exit).
  
     procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
!    --  Build Equivalent_Type for an Access_to_protected_Subprogram.
  
     procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
     --  Expand declarations required for accept statement. See bodies of
--- 220,226 ----
     --  routine to make sure Complete_Master is called on exit).
  
     procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id);
!    --  Build Equivalent_Type for an Access_to_protected_Subprogram
  
     procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id);
     --  Expand declarations required for accept statement. See bodies of
*************** package Exp_Ch9 is
*** 305,317 ****
     --  protected type.
  
     procedure Set_Privals
!       (Dec : Node_Id;
!        Op  : Node_Id;
!        Loc : Source_Ptr);
     --  Associates a new set of privals (placeholders for later access to
     --  private components of protected objects) with the private object
     --  declarations of a protected object. These will be used to expand
     --  the references to private objects in the next protected
     --  subprogram or entry body to be expanded.
  
  end Exp_Ch9;
--- 311,331 ----
     --  protected type.
  
     procedure Set_Privals
!       (Dec           : Node_Id;
!        Op            : Node_Id;
!        Loc           : Source_Ptr;
!        After_Barrier : Boolean := False);
     --  Associates a new set of privals (placeholders for later access to
     --  private components of protected objects) with the private object
     --  declarations of a protected object. These will be used to expand
     --  the references to private objects in the next protected
     --  subprogram or entry body to be expanded.
+    --
+    --  The flag After_Barrier indicates whether this is called after building
+    --  the barrier function for an entry body. This flag determines whether
+    --  the privals should have source names (which simplifies debugging) or
+    --  internally generated names. Entry barriers contain no debuggable code,
+    --  and there may be visibility conflicts between an entry index and a
+    --  a prival, so  privals for barrier function have internal names.
  
  end Exp_Ch9;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_code.adb gcc-4.1.0/gcc/ada/exp_code.adb
*** gcc-4.0.2/gcc/ada/exp_code.adb	Mon Jun  7 14:16:18 2004
--- gcc-4.1.0/gcc/ada/exp_code.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_code.ads gcc-4.1.0/gcc/ada/exp_code.ads
*** gcc-4.0.2/gcc/ada/exp_code.ads	Thu Apr 24 17:54:00 2003
--- gcc-4.1.0/gcc/ada/exp_code.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_dbug.adb gcc-4.1.0/gcc/ada/exp_dbug.adb
*** gcc-4.0.2/gcc/ada/exp_dbug.adb	Thu Feb 10 13:50:42 2005
--- gcc-4.1.0/gcc/ada/exp_dbug.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Einfo;    use Einfo;
*** 31,37 ****
  with Namet;    use Namet;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
! with Opt;
  with Output;   use Output;
  with Sem_Eval; use Sem_Eval;
  with Sem_Util; use Sem_Util;
--- 31,37 ----
  with Namet;    use Namet;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
! with Opt;      use Opt;
  with Output;   use Output;
  with Sem_Eval; use Sem_Eval;
  with Sem_Util; use Sem_Util;
*************** package body Exp_Dbug is
*** 134,140 ****
     --  used to determine whether encoding is required for a discrete type.
  
     procedure Output_Homonym_Numbers_Suffix;
!    --  If homonym numbers are stored, then output them into Name_Buffer.
  
     procedure Prepend_String_To_Buffer (S : String);
     --  Prepend given string to the contents of the string buffer, updating
--- 134,140 ----
     --  used to determine whether encoding is required for a discrete type.
  
     procedure Output_Homonym_Numbers_Suffix;
!    --  If homonym numbers are stored, then output them into Name_Buffer
  
     procedure Prepend_String_To_Buffer (S : String);
     --  Prepend given string to the contents of the string buffer, updating
*************** package body Exp_Dbug is
*** 250,258 ****
        then
           return True;
  
!       --  Here we check if the static bounds match the natural size, which
!       --  is the size passed through with the debugging information. This
!       --  is the Esize rounded up to 8, 16, 32 or 64 as appropriate.
  
        else
           declare
--- 250,258 ----
        then
           return True;
  
!       --  Here we check if the static bounds match the natural size, which is
!       --  the size passed through with the debugging information. This is the
!       --  Esize rounded up to 8, 16, 32 or 64 as appropriate.
  
        else
           declare
*************** package body Exp_Dbug is
*** 305,316 ****
        Def : Entity_Id;
  
        function Output_Subscript (N : Node_Id; S : String) return Boolean;
!       --  Outputs a single subscript value as ?nnn (subscript is compile
!       --  time known value with value nnn) or as ?e (subscript is local
!       --  constant with name e), where S supplies the proper string to
!       --  use for ?. Returns False if the subscript is not of an appropriate
!       --  type to output in one of these two forms. The result is prepended
!       --  to the name stored in Name_Buffer.
  
        ----------------------
        -- Output_Subscript --
--- 305,316 ----
        Def : Entity_Id;
  
        function Output_Subscript (N : Node_Id; S : String) return Boolean;
!       --  Outputs a single subscript value as ?nnn (subscript is compile time
!       --  known value with value nnn) or as ?e (subscript is local constant
!       --  with name e), where S supplies the proper string to use for ?.
!       --  Returns False if the subscript is not of an appropriate type to
!       --  output in one of these two forms. The result is prepended to the
!       --  name stored in Name_Buffer.
  
        ----------------------
        -- Output_Subscript --
*************** package body Exp_Dbug is
*** 358,366 ****
           when N_Package_Renaming_Declaration =>
              Add_Str_To_Name_Buffer ("___XRP");
  
!             --  If it is a child unit create a fully qualified name,
!             --  to disambiguate multiple child units with the same
!             --  name and different parents.
  
              if Is_Child_Unit (Ent) then
                 Prepend_String_To_Buffer ("__");
--- 358,366 ----
           when N_Package_Renaming_Declaration =>
              Add_Str_To_Name_Buffer ("___XRP");
  
!             --  If it is a child unit create a fully qualified name, to
!             --  disambiguate multiple child units with the same name and
!             --  different parents.
  
              if Is_Child_Unit (Ent) then
                 Prepend_String_To_Buffer ("__");
*************** package body Exp_Dbug is
*** 386,393 ****
  
              when N_Expanded_Name =>
  
!                --  The entity field for an N_Expanded_Name is on the
!                --  expanded name node itself, so we are done here too.
  
                 exit;
  
--- 386,393 ----
  
              when N_Expanded_Name =>
  
!                --  The entity field for an N_Expanded_Name is on the expanded
!                --  name node itself, so we are done here too.
  
                 exit;
  
*************** package body Exp_Dbug is
*** 492,497 ****
--- 492,506 ----
        Has_Suffix : Boolean;
  
     begin
+       --  If not generating code, there is no need to create encoded
+       --  names, and problems when the back-end is called to annotate
+       --  types without full code generation. See comments at beginning
+       --  of Get_External_Name_With_Suffix for additional details.
+ 
+       if Operating_Mode /= Generate_Code then
+          return;
+       end if;
+ 
        Get_Name_String (Chars (E));
  
        --  Nothing to do if we do not have a type
*************** package body Exp_Dbug is
*** 553,564 ****
        elsif Is_Discrete_Type (E)
          and then not Bounds_Match_Size (E)
        then
-          if Has_Biased_Representation (E) then
-             Get_External_Name_With_Suffix (E, "XB");
-          else
-             Get_External_Name_With_Suffix (E, "XD");
-          end if;
- 
           declare
              Lo : constant Node_Id := Type_Low_Bound (E);
              Hi : constant Node_Id := Type_High_Bound (E);
--- 562,567 ----
*************** package body Exp_Dbug is
*** 579,594 ****
              Lo_Encode : constant Boolean := Lo_Con or Lo_Discr;
              Hi_Encode : constant Boolean := Hi_Con or Hi_Discr;
  
           begin
              if Lo_Encode or Hi_Encode then
!                if Lo_Encode then
!                   if Hi_Encode then
!                      Add_Str_To_Name_Buffer ("LU_");
                    else
!                      Add_Str_To_Name_Buffer ("L_");
                    end if;
-                else
-                   Add_Str_To_Name_Buffer ("U_");
                 end if;
  
                 if Lo_Con then
--- 582,609 ----
              Lo_Encode : constant Boolean := Lo_Con or Lo_Discr;
              Hi_Encode : constant Boolean := Hi_Con or Hi_Discr;
  
+             Biased : constant Boolean := Has_Biased_Representation (E);
+ 
           begin
+             if Biased then
+                Get_External_Name_With_Suffix (E, "XB");
+             else
+                Get_External_Name_With_Suffix (E, "XD");
+             end if;
+ 
              if Lo_Encode or Hi_Encode then
!                if Biased then
!                   Add_Str_To_Name_Buffer ("_");
!                else
!                   if Lo_Encode then
!                      if Hi_Encode then
!                         Add_Str_To_Name_Buffer ("LU_");
!                      else
!                         Add_Str_To_Name_Buffer ("L_");
!                      end if;
                    else
!                      Add_Str_To_Name_Buffer ("U_");
                    end if;
                 end if;
  
                 if Lo_Con then
*************** package body Exp_Dbug is
*** 698,703 ****
--- 713,719 ----
           --  If this is a library level subprogram (i.e. a subprogram that is a
           --  compilation unit other than a subunit), then we prepend _ada_ to
           --  ensure distinctions required as described in the spec.
+ 
           --  Check explicitly for child units, because those are not flagged
           --  as Compilation_Units by lib. Should they be ???
  
*************** package body Exp_Dbug is
*** 738,757 ****
        Suffix : String)
     is
        Has_Suffix : constant Boolean := (Suffix /= "");
-       use type Opt.Operating_Mode_Type;
  
     begin
!       if Opt.Operating_Mode /= Opt.Generate_Code then
  
!          --  If we are not in code generation mode, we still may call this
!          --  procedure from Back_End (more specifically - from gigi for doing
!          --  type representation annotation or some representation-specific
!          --  checks). But in this mode there is no need to mess with external
!          --  names. Furthermore, the call causes difficulties in this case
!          --  because the string representing the homonym number is not
!          --  correctly reset as a part of the call to
!          --  Output_Homonym_Numbers_Suffix (which is not called in gigi)
  
           return;
        end if;
  
--- 754,772 ----
        Suffix : String)
     is
        Has_Suffix : constant Boolean := (Suffix /= "");
  
     begin
!       --  If we are not in code generation mode, this procedure may still be
!       --  called from Back_End (more specifically - from gigi for doing type
!       --  representation annotation or some representation-specific checks).
!       --  But in this mode there is no need to mess with external names.
  
!       --  Furthermore, the call causes difficulties in this case because the
!       --  string representing the homonym number is not correctly reset as a
!       --  part of the call to Output_Homonym_Numbers_Suffix (which is not
!       --  called in gigi).
  
+       if Operating_Mode /= Generate_Code then
           return;
        end if;
  
*************** package body Exp_Dbug is
*** 760,766 ****
        if Has_Suffix then
           Add_Str_To_Name_Buffer ("___");
           Add_Str_To_Name_Buffer (Suffix);
- 
           Name_Buffer (Name_Len + 1) := ASCII.Nul;
        end if;
     end Get_External_Name_With_Suffix;
--- 775,780 ----
*************** package body Exp_Dbug is
*** 782,790 ****
  
        procedure Choice_Val (Typ : Character; Choice : Node_Id) is
        begin
-          Add_Char_To_Name_Buffer (Typ);
- 
           if Nkind (Choice) = N_Integer_Literal then
              Add_Uint_To_Buffer (Intval (Choice));
  
           --  Character literal with no entity present (this is the case
--- 796,803 ----
  
        procedure Choice_Val (Typ : Character; Choice : Node_Id) is
        begin
           if Nkind (Choice) = N_Integer_Literal then
+             Add_Char_To_Name_Buffer (Typ);
              Add_Uint_To_Buffer (Intval (Choice));
  
           --  Character literal with no entity present (this is the case
*************** package body Exp_Dbug is
*** 793,798 ****
--- 806,812 ----
           elsif Nkind (Choice) = N_Character_Literal
             and then No (Entity (Choice))
           then
+             Add_Char_To_Name_Buffer (Typ);
              Add_Uint_To_Buffer (Char_Literal_Value (Choice));
  
           else
*************** package body Exp_Dbug is
*** 801,806 ****
--- 815,821 ----
  
              begin
                 if Ekind (Ent) = E_Enumeration_Literal then
+                   Add_Char_To_Name_Buffer (Typ);
                    Add_Uint_To_Buffer (Enumeration_Rep (Ent));
  
                 else
*************** package body Exp_Dbug is
*** 866,871 ****
--- 881,919 ----
        end if;
     end Get_Variant_Encoding;
  
+    ------------------------------------
+    -- Get_Secondary_DT_External_Name --
+    ------------------------------------
+ 
+    procedure Get_Secondary_DT_External_Name
+      (Typ             : Entity_Id;
+       Ancestor_Typ    : Entity_Id;
+       Suffix_Index    : Int) is
+    begin
+       Get_External_Name (Typ, Has_Suffix => False);
+ 
+       if Ancestor_Typ /= Typ then
+          declare
+             Len      : constant Natural := Name_Len;
+             Save_Str : constant String (1 .. Name_Len)
+                          := Name_Buffer (1 .. Name_Len);
+          begin
+             Get_External_Name (Ancestor_Typ, Has_Suffix => False);
+ 
+             --  Append the extended name of the ancestor to the
+             --  extended name of Typ
+ 
+             Name_Buffer (Len + 2 .. Len + Name_Len + 1) :=
+               Name_Buffer (1 .. Name_Len);
+             Name_Buffer (1 .. Len) := Save_Str;
+             Name_Buffer (Len + 1) := '_';
+             Name_Len := Len + Name_Len + 1;
+          end;
+       end if;
+ 
+       Add_Nat_To_Name_Buffer (Suffix_Index);
+    end Get_Secondary_DT_External_Name;
+ 
     ---------------------------------
     -- Make_Packed_Array_Type_Name --
     ---------------------------------
*************** package body Exp_Dbug is
*** 1152,1158 ****
           else
              Add_Char_To_Name_Buffer ('X');
           end if;
- 
        end Set_BNPE_Suffix;
  
        ---------------------
--- 1200,1205 ----
*************** package body Exp_Dbug is
*** 1324,1330 ****
              exit;
           end if;
        end loop;
- 
     end Strip_Suffixes;
  
  end Exp_Dbug;
--- 1371,1376 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_dbug.ads gcc-4.1.0/gcc/ada/exp_dbug.ads
*** gcc-4.0.2/gcc/ada/exp_dbug.ads	Fri Nov 19 10:57:35 2004
--- gcc-4.1.0/gcc/ada/exp_dbug.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Exp_Dbug is
*** 89,95 ****
     --    x
     --    y.z
  
!    --  The separating dots are translated into double underscores.
  
        -----------------------------
        -- Handling of Overloading --
--- 89,95 ----
     --    x
     --    y.z
  
!    --  The separating dots are translated into double underscores
  
        -----------------------------
        -- Handling of Overloading --
*************** package Exp_Dbug is
*** 360,366 ****
        --  Operations generated for protected entries follow the same encoding.
        --  Each entry results in two suprograms: a procedure that holds the
        --  entry body, and a function that holds the evaluation of the barrier.
!       --  The names of these subprograms include the prefix 'E' or 'B' res-
        --  pectively. The names also include a numeric suffix to render them
        --  unique in the presence of overloaded entries.
  
--- 360,366 ----
        --  Operations generated for protected entries follow the same encoding.
        --  Each entry results in two suprograms: a procedure that holds the
        --  entry body, and a function that holds the evaluation of the barrier.
!       --  The names of these subprograms include the prefix '_E' or '_B' res-
        --  pectively. The names also include a numeric suffix to render them
        --  unique in the presence of overloaded entries.
  
*************** package Exp_Dbug is
*** 382,389 ****
        --    lock_setN
        --    lock_setP
  
!       --    lock_update1sE
!       --    lock_udpate2sB
  
     ----------------------------------------------------
     -- Conversion between Entities and External Names --
--- 382,411 ----
        --    lock_setN
        --    lock_setP
  
!       --    lock_update_E1s
!       --    lock_udpate_B2s
! 
!       --  If the protected type implements at least one interface, the
!       --  following additional operations are created:
! 
!       --    lock_get
! 
!       --    lock_set
! 
!       --  These operations are used to ensure overriding of interface level
!       --  subprograms and proper dispatching on interface class-wide objects.
!       --  The bodies of these operations contain calls to their respective
!       --  protected versions:
! 
!       --    function lock_get return Integer is
!       --    begin
!       --       return lock_getP;
!       --    end lock_get;
! 
!       --    procedure lock_set (X : Integer) is
!       --    begin
!       --       lock_setP (X);
!       --    end lock_set;
  
     ----------------------------------------------------
     -- Conversion between Entities and External Names --
*************** package Exp_Dbug is
*** 432,439 ****
     --        or is defined within an overloaded subprogram.
     --    - the string "___" followed by Suffix
     --
!    --  If this procedure is called in the ASIS mode, it does nothing. See the
!    --  comments in the body for more details.
  
     --------------------------------------------
     -- Subprograms for Handling Qualification --
--- 454,462 ----
     --        or is defined within an overloaded subprogram.
     --    - the string "___" followed by Suffix
     --
!    --  Note that a call to this procedure has no effect if we are not
!    --  generating code, since the necessary information for computing the
!    --  proper encoded name is not available in this case.
  
     --------------------------------------------
     -- Subprograms for Handling Qualification --
*************** package Exp_Dbug is
*** 515,520 ****
--- 538,549 ----
        --  field, and neither the outer structure name, nor the field name
        --  should appear when the value is printed.
  
+       --  When the debugger sees a record named REP being a field inside
+       --  another record, it should treat the fields inside REP as being
+       --  part of the outer record (this REP field is only present for
+       --  code generation purposes). The REP record should not appear in
+       --  the values printed by the debugger.
+ 
        -----------------------
        -- Fixed-Point Types --
        -----------------------
*************** package Exp_Dbug is
*** 685,693 ****
        --  follows. In this description, let P represent the current
        --  bit position in the record.
  
!       --    1. Initialize P to 0.
  
!       --    2. For each field in the record,
  
        --       2a. If an alignment is given (see below), then round P
        --       up, if needed, to the next multiple of that alignment.
--- 714,722 ----
        --  follows. In this description, let P represent the current
        --  bit position in the record.
  
!       --    1. Initialize P to 0
  
!       --    2. For each field in the record:
  
        --       2a. If an alignment is given (see below), then round P
        --       up, if needed, to the next multiple of that alignment.
*************** package Exp_Dbug is
*** 696,702 ****
        --       amount (that is, treat it as an offset from the end of the
        --       preceding record).
  
!       --       2c. Assign P as the actual position of the field.
  
        --       2d. Compute the length, L, of the represented field (see below)
        --       and compute P'=P+L. Unless the field represents a variant part
--- 725,731 ----
        --       amount (that is, treat it as an offset from the end of the
        --       preceding record).
  
!       --       2c. Assign P as the actual position of the field
  
        --       2d. Compute the length, L, of the represented field (see below)
        --       and compute P'=P+L. Unless the field represents a variant part
*************** package Exp_Dbug is
*** 923,933 ****
     -------------------------------------------------
  
     procedure Get_Encoded_Name (E : Entity_Id);
!    --  If the entity is a typename, store the external name of
!    --  the entity as in Get_External_Name, followed by three underscores
!    --  plus the type encoding in Name_Buffer with the length in Name_Len,
!    --  and an ASCII.NUL character stored following the name.
!    --  Otherwise set Name_Buffer and Name_Len to hold the entity name.
  
     --------------
     -- Renaming --
--- 952,964 ----
     -------------------------------------------------
  
     procedure Get_Encoded_Name (E : Entity_Id);
!    --  If the entity is a typename, store the external name of the entity as in
!    --  Get_External_Name, followed by three underscores plus the type encoding
!    --  in Name_Buffer with the length in Name_Len, and an ASCII.NUL character
!    --  stored following the name. Otherwise set Name_Buffer and Name_Len to
!    --  hold the entity name. Note that a call to this procedure has no effect
!    --  if we are not generating code, since the necessary information for
!    --  computing the proper encoded name is not available in this case.
  
     --------------
     -- Renaming --
*************** package Exp_Dbug is
*** 960,966 ****
     --  name of the parent unit, to disambiguate child units with the same
     --  simple name and (of necessity) different parents.
  
!    --  Note: subprogram renamings are not encoded at the present time.
  
     --  The type is an enumeration type with a single enumeration literal
     --  that is an identifier which describes the renamed variable.
--- 991,997 ----
     --  name of the parent unit, to disambiguate child units with the same
     --  simple name and (of necessity) different parents.
  
!    --  Note: subprogram renamings are not encoded at the present time
  
     --  The type is an enumeration type with a single enumeration literal
     --  that is an identifier which describes the renamed variable.
*************** package Exp_Dbug is
*** 1407,1412 ****
--- 1438,1503 ----
     --  the second enumeration literal would be named QU43 and the
     --  value assigned to it would be 1.
  
+    -----------------------------------------------
+    -- Secondary Dispatch tables of tagged types --
+    -----------------------------------------------
+ 
+    procedure Get_Secondary_DT_External_Name
+      (Typ          : Entity_Id;
+       Ancestor_Typ : Entity_Id;
+       Suffix_Index : Int);
+    --  Set Name_Buffer and Name_Len to the external name of one secondary
+    --  dispatch table of Typ. If the interface has been inherited from some
+    --  ancestor then Ancestor_Typ is such node (in this case the secondary
+    --  DT is needed to handle overriden primitives); if there is no such
+    --  ancestor then  Ancestor_Typ is equal to Typ.
+    --
+    --  Internal rule followed for the generation of the external name:
+    --
+    --  Case 1. If the secondary dispatch has not been inherited from some
+    --          ancestor of Typ then the external name is composed as
+    --          follows:
+    --             External_Name (Typ) + Suffix_Number + 'P'
+    --
+    --  Case 2. if the secondary dispatch table has been inherited from some
+    --          ancestor then the external name is composed as follows:
+    --             External_Name (Typ) + '_' + External_Name (Ancestor_Typ)
+    --               + Suffix_Number + 'P'
+    --
+    --  Note: We have to use the external names (instead of simply their
+    --  names) to protect the frontend against programs that give the same
+    --  name to all the interfaces and use the expanded name to reference
+    --  them. The Suffix_Number is used to differentiate all the secondary
+    --  dispatch tables of a given type.
+    --
+    --  Examples:
+    --
+    --        package Pkg1 is | package Pkg2 is | package Pkg3 is
+    --          type Typ is   |   type Typ is   |   type Typ is
+    --            interface;  |     interface;  |     interface;
+    --        end Pkg1;       | end Pkg;        | end Pkg3;
+    --
+    --  with Pkg1, Pkg2, Pkg3;
+    --  package Case_1 is
+    --    type Typ is new Pkg1.Typ and Pkg2.Typ and Pkg3.Typ with ...
+    --  end Case_1;
+    --
+    --  with Case_1;
+    --  package Case_2 is
+    --    type Typ is new Case_1.Typ with ...
+    --  end Case_2;
+    --
+    --  These are the external names generated for Case_1.Typ (note that
+    --  Pkg1.Typ is associated with the Primary Dispatch Table, because it
+    --  is the the parent of this type, and hence no external name is
+    --  generated for it).
+    --      case_1__typ0P   (associated with Pkg2.Typ)
+    --      case_1__typ1P   (associated with Pkg3.Typ)
+    --
+    --  These are the external names generated for Case_2.Typ:
+    --      case_2__typ_case_1__typ0P
+    --      case_2__typ_case_1__typ1P
+ 
     ----------------------------
     -- Effect of Optimization --
     ----------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_disp.adb gcc-4.1.0/gcc/ada/exp_disp.adb
*** gcc-4.0.2/gcc/ada/exp_disp.adb	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/exp_disp.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,46 ****
  
  with Atree;    use Atree;
  with Checks;   use Checks;
  with Einfo;    use Einfo;
  with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
- with Fname;    use Fname;
  with Itypes;   use Itypes;
- with Lib;      use Lib;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
  with Opt;      use Opt;
  with Rtsfind;  use Rtsfind;
  with Sem_Disp; use Sem_Disp;
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
  with Snames;   use Snames;
--- 26,50 ----
  
  with Atree;    use Atree;
  with Checks;   use Checks;
+ with Debug;    use Debug;
  with Einfo;    use Einfo;
  with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Ch7;  use Exp_Ch7;
+ with Exp_Dbug; use Exp_Dbug;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
  with Itypes;   use Itypes;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
+ with Namet;    use Namet;
  with Opt;      use Opt;
+ with Output;   use Output;
  with Rtsfind;  use Rtsfind;
+ with Sem;      use Sem;
  with Sem_Disp; use Sem_Disp;
  with Sem_Res;  use Sem_Res;
+ with Sem_Type; use Sem_Type;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
  with Snames;   use Snames;
*************** with Uintp;    use Uintp;
*** 50,147 ****
  
  package body Exp_Disp is
  
     Ada_Actions : constant array (DT_Access_Action) of RE_Id :=
        (CW_Membership           => RE_CW_Membership,
         DT_Entry_Size           => RE_DT_Entry_Size,
         DT_Prologue_Size        => RE_DT_Prologue_Size,
!        Get_Expanded_Name       => RE_Get_Expanded_Name,
         Get_External_Tag        => RE_Get_External_Tag,
         Get_Prim_Op_Address     => RE_Get_Prim_Op_Address,
         Get_RC_Offset           => RE_Get_RC_Offset,
         Get_Remotely_Callable   => RE_Get_Remotely_Callable,
-        Get_TSD                 => RE_Get_TSD,
         Inherit_DT              => RE_Inherit_DT,
         Inherit_TSD             => RE_Inherit_TSD,
         Register_Tag            => RE_Register_Tag,
         Set_Expanded_Name       => RE_Set_Expanded_Name,
         Set_External_Tag        => RE_Set_External_Tag,
         Set_Prim_Op_Address     => RE_Set_Prim_Op_Address,
         Set_RC_Offset           => RE_Set_RC_Offset,
         Set_Remotely_Callable   => RE_Set_Remotely_Callable,
         Set_TSD                 => RE_Set_TSD,
         TSD_Entry_Size          => RE_TSD_Entry_Size,
         TSD_Prologue_Size       => RE_TSD_Prologue_Size);
  
-    CPP_Actions : constant array (DT_Access_Action) of RE_Id :=
-       (CW_Membership           => RE_CPP_CW_Membership,
-        DT_Entry_Size           => RE_CPP_DT_Entry_Size,
-        DT_Prologue_Size        => RE_CPP_DT_Prologue_Size,
-        Get_Expanded_Name       => RE_CPP_Get_Expanded_Name,
-        Get_External_Tag        => RE_CPP_Get_External_Tag,
-        Get_Prim_Op_Address     => RE_CPP_Get_Prim_Op_Address,
-        Get_RC_Offset           => RE_CPP_Get_RC_Offset,
-        Get_Remotely_Callable   => RE_CPP_Get_Remotely_Callable,
-        Get_TSD                 => RE_CPP_Get_TSD,
-        Inherit_DT              => RE_CPP_Inherit_DT,
-        Inherit_TSD             => RE_CPP_Inherit_TSD,
-        Register_Tag            => RE_CPP_Register_Tag,
-        Set_Expanded_Name       => RE_CPP_Set_Expanded_Name,
-        Set_External_Tag        => RE_CPP_Set_External_Tag,
-        Set_Prim_Op_Address     => RE_CPP_Set_Prim_Op_Address,
-        Set_RC_Offset           => RE_CPP_Set_RC_Offset,
-        Set_Remotely_Callable   => RE_CPP_Set_Remotely_Callable,
-        Set_TSD                 => RE_CPP_Set_TSD,
-        TSD_Entry_Size          => RE_CPP_TSD_Entry_Size,
-        TSD_Prologue_Size       => RE_CPP_TSD_Prologue_Size);
- 
     Action_Is_Proc : constant array (DT_Access_Action) of Boolean :=
        (CW_Membership           => False,
         DT_Entry_Size           => False,
         DT_Prologue_Size        => False,
!        Get_Expanded_Name       => False,
         Get_External_Tag        => False,
         Get_Prim_Op_Address     => False,
         Get_Remotely_Callable   => False,
         Get_RC_Offset           => False,
-        Get_TSD                 => False,
         Inherit_DT              => True,
         Inherit_TSD             => True,
         Register_Tag            => True,
         Set_Expanded_Name       => True,
         Set_External_Tag        => True,
         Set_Prim_Op_Address     => True,
         Set_RC_Offset           => True,
         Set_Remotely_Callable   => True,
         Set_TSD                 => True,
         TSD_Entry_Size          => False,
         TSD_Prologue_Size       => False);
  
     Action_Nb_Arg : constant array (DT_Access_Action) of Int :=
        (CW_Membership           => 2,
         DT_Entry_Size           => 0,
         DT_Prologue_Size        => 0,
!        Get_Expanded_Name       => 1,
         Get_External_Tag        => 1,
         Get_Prim_Op_Address     => 2,
         Get_RC_Offset           => 1,
         Get_Remotely_Callable   => 1,
-        Get_TSD                 => 1,
         Inherit_DT              => 3,
         Inherit_TSD             => 2,
         Register_Tag            => 1,
         Set_Expanded_Name       => 2,
         Set_External_Tag        => 2,
         Set_Prim_Op_Address     => 3,
         Set_RC_Offset           => 2,
         Set_Remotely_Callable   => 2,
         Set_TSD                 => 2,
         TSD_Entry_Size          => 0,
         TSD_Prologue_Size       => 0);
  
     function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean;
     --  Check if the type has a private view or if the public view appears
     --  in the visible part of a package spec.
  
     -----------------------------
     -- Expand_Dispatching_Call --
     -----------------------------
--- 54,582 ----
  
  package body Exp_Disp is
  
+    --------------------------------
+    -- Select_Expansion_Utilities --
+    --------------------------------
+ 
+    --  The following package contains helper routines used in the expansion of
+    --  dispatching asynchronous, conditional and timed selects.
+ 
+    package Select_Expansion_Utilities is
+       procedure Build_B
+         (Loc    : Source_Ptr;
+          Params : List_Id);
+       --  Generate:
+       --    B : out Communication_Block
+ 
+       procedure Build_C
+         (Loc    : Source_Ptr;
+          Params : List_Id);
+       --  Generate:
+       --    C : out Prim_Op_Kind
+ 
+       procedure Build_Common_Dispatching_Select_Statements
+         (Loc    : Source_Ptr;
+          Typ    : Entity_Id;
+          DT_Ptr : Entity_Id;
+          Stmts  : List_Id);
+       --  Ada 2005 (AI-345): Generate statements that are common between
+       --  asynchronous, conditional and timed select expansion.
+ 
+       procedure Build_F
+         (Loc    : Source_Ptr;
+          Params : List_Id);
+       --  Generate:
+       --    F : out Boolean
+ 
+       procedure Build_P
+         (Loc    : Source_Ptr;
+          Params : List_Id);
+       --  Generate:
+       --    P : Address
+ 
+       procedure Build_S
+         (Loc    : Source_Ptr;
+          Params : List_Id);
+       --  Generate:
+       --    S : Integer
+ 
+       procedure Build_T
+         (Loc    : Source_Ptr;
+          Typ    : Entity_Id;
+          Params : List_Id);
+       --  Generate:
+       --    T : in out Typ
+    end Select_Expansion_Utilities;
+ 
+    package body Select_Expansion_Utilities is
+ 
+       -------------
+       -- Build_B --
+       -------------
+ 
+       procedure Build_B
+         (Loc    : Source_Ptr;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uB),
+              Parameter_Type =>
+                New_Reference_To (RTE (RE_Communication_Block), Loc),
+              Out_Present => True));
+       end Build_B;
+ 
+       -------------
+       -- Build_C --
+       -------------
+ 
+       procedure Build_C
+         (Loc    : Source_Ptr;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uC),
+              Parameter_Type =>
+                New_Reference_To (RTE (RE_Prim_Op_Kind), Loc),
+              Out_Present => True));
+       end Build_C;
+ 
+       ------------------------------------------------
+       -- Build_Common_Dispatching_Select_Statements --
+       ------------------------------------------------
+ 
+       procedure Build_Common_Dispatching_Select_Statements
+         (Loc   : Source_Ptr;
+          Typ   : Entity_Id;
+          DT_Ptr : Entity_Id;
+          Stmts : List_Id)
+       is
+       begin
+          --  Generate:
+          --    C := get_prim_op_kind (tag! (<type>VP), S);
+ 
+          --  where C is the out parameter capturing the call kind and S is the
+          --  dispatch table slot number.
+ 
+          Append_To (Stmts,
+            Make_Assignment_Statement (Loc,
+              Name =>
+                Make_Identifier (Loc, Name_uC),
+              Expression =>
+                Make_DT_Access_Action (Typ,
+                  Action =>
+                    Get_Prim_Op_Kind,
+                  Args =>
+                    New_List (
+                      Unchecked_Convert_To (RTE (RE_Tag),
+                        New_Reference_To (DT_Ptr, Loc)),
+                      Make_Identifier (Loc, Name_uS)))));
+ 
+          --  Generate:
+ 
+          --    if C = POK_Procedure
+          --      or else C = POK_Protected_Procedure
+          --      or else C = POK_Task_Procedure;
+          --    then
+          --       F := True;
+          --       return;
+ 
+          --  where F is the out parameter capturing the status of a potential
+          --  entry call.
+ 
+          Append_To (Stmts,
+            Make_If_Statement (Loc,
+ 
+              Condition =>
+                Make_Or_Else (Loc,
+                  Left_Opnd =>
+                    Make_Op_Eq (Loc,
+                      Left_Opnd =>
+                        Make_Identifier (Loc, Name_uC),
+                      Right_Opnd =>
+                        New_Reference_To (RTE (RE_POK_Procedure), Loc)),
+                  Right_Opnd =>
+                    Make_Or_Else (Loc,
+                      Left_Opnd =>
+                        Make_Op_Eq (Loc,
+                          Left_Opnd =>
+                            Make_Identifier (Loc, Name_uC),
+                          Right_Opnd =>
+                            New_Reference_To (RTE (
+                              RE_POK_Protected_Procedure), Loc)),
+                      Right_Opnd =>
+                        Make_Op_Eq (Loc,
+                          Left_Opnd =>
+                            Make_Identifier (Loc, Name_uC),
+                          Right_Opnd =>
+                            New_Reference_To (RTE (
+                              RE_POK_Task_Procedure), Loc)))),
+ 
+              Then_Statements =>
+                New_List (
+                  Make_Assignment_Statement (Loc,
+                    Name       => Make_Identifier (Loc, Name_uF),
+                    Expression => New_Reference_To (Standard_True, Loc)),
+ 
+                  Make_Return_Statement (Loc))));
+       end Build_Common_Dispatching_Select_Statements;
+ 
+       -------------
+       -- Build_F --
+       -------------
+ 
+       procedure Build_F
+         (Loc    : Source_Ptr;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uF),
+              Parameter_Type =>
+                New_Reference_To (Standard_Boolean, Loc),
+              Out_Present => True));
+       end Build_F;
+ 
+       -------------
+       -- Build_P --
+       -------------
+ 
+       procedure Build_P
+         (Loc    : Source_Ptr;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uP),
+              Parameter_Type =>
+                New_Reference_To (RTE (RE_Address), Loc)));
+       end Build_P;
+ 
+       -------------
+       -- Build_S --
+       -------------
+ 
+       procedure Build_S
+         (Loc    : Source_Ptr;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uS),
+              Parameter_Type =>
+                New_Reference_To (Standard_Integer, Loc)));
+       end Build_S;
+ 
+       -------------
+       -- Build_T --
+       -------------
+ 
+       procedure Build_T
+         (Loc    : Source_Ptr;
+          Typ    : Entity_Id;
+          Params : List_Id)
+       is
+       begin
+          Append_To (Params,
+            Make_Parameter_Specification (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uT),
+              Parameter_Type =>
+                New_Reference_To (Typ, Loc),
+              In_Present  => True,
+              Out_Present => True));
+       end Build_T;
+    end Select_Expansion_Utilities;
+ 
+    package SEU renames Select_Expansion_Utilities;
+ 
     Ada_Actions : constant array (DT_Access_Action) of RE_Id :=
        (CW_Membership           => RE_CW_Membership,
+        IW_Membership           => RE_IW_Membership,
         DT_Entry_Size           => RE_DT_Entry_Size,
         DT_Prologue_Size        => RE_DT_Prologue_Size,
!        Get_Access_Level        => RE_Get_Access_Level,
!        Get_Entry_Index         => RE_Get_Entry_Index,
         Get_External_Tag        => RE_Get_External_Tag,
+        Get_Offset_Index        => RE_Get_Offset_Index,
         Get_Prim_Op_Address     => RE_Get_Prim_Op_Address,
+        Get_Prim_Op_Kind        => RE_Get_Prim_Op_Kind,
         Get_RC_Offset           => RE_Get_RC_Offset,
         Get_Remotely_Callable   => RE_Get_Remotely_Callable,
         Inherit_DT              => RE_Inherit_DT,
         Inherit_TSD             => RE_Inherit_TSD,
+        Register_Interface_Tag  => RE_Register_Interface_Tag,
         Register_Tag            => RE_Register_Tag,
+        Set_Access_Level        => RE_Set_Access_Level,
+        Set_Entry_Index         => RE_Set_Entry_Index,
         Set_Expanded_Name       => RE_Set_Expanded_Name,
         Set_External_Tag        => RE_Set_External_Tag,
+        Set_Offset_Index        => RE_Set_Offset_Index,
+        Set_OSD                 => RE_Set_OSD,
         Set_Prim_Op_Address     => RE_Set_Prim_Op_Address,
+        Set_Prim_Op_Kind        => RE_Set_Prim_Op_Kind,
         Set_RC_Offset           => RE_Set_RC_Offset,
         Set_Remotely_Callable   => RE_Set_Remotely_Callable,
+        Set_SSD                 => RE_Set_SSD,
         Set_TSD                 => RE_Set_TSD,
         TSD_Entry_Size          => RE_TSD_Entry_Size,
         TSD_Prologue_Size       => RE_TSD_Prologue_Size);
  
     Action_Is_Proc : constant array (DT_Access_Action) of Boolean :=
        (CW_Membership           => False,
+        IW_Membership           => False,
         DT_Entry_Size           => False,
         DT_Prologue_Size        => False,
!        Get_Access_Level        => False,
!        Get_Entry_Index         => False,
         Get_External_Tag        => False,
+        Get_Offset_Index        => False,
         Get_Prim_Op_Address     => False,
+        Get_Prim_Op_Kind        => False,
         Get_Remotely_Callable   => False,
         Get_RC_Offset           => False,
         Inherit_DT              => True,
         Inherit_TSD             => True,
+        Register_Interface_Tag  => True,
         Register_Tag            => True,
+        Set_Access_Level        => True,
+        Set_Entry_Index         => True,
         Set_Expanded_Name       => True,
         Set_External_Tag        => True,
+        Set_Offset_Index        => True,
+        Set_OSD                 => True,
         Set_Prim_Op_Address     => True,
+        Set_Prim_Op_Kind        => True,
         Set_RC_Offset           => True,
         Set_Remotely_Callable   => True,
+        Set_SSD                 => True,
         Set_TSD                 => True,
         TSD_Entry_Size          => False,
         TSD_Prologue_Size       => False);
  
     Action_Nb_Arg : constant array (DT_Access_Action) of Int :=
        (CW_Membership           => 2,
+        IW_Membership           => 2,
         DT_Entry_Size           => 0,
         DT_Prologue_Size        => 0,
!        Get_Access_Level        => 1,
!        Get_Entry_Index         => 2,
         Get_External_Tag        => 1,
+        Get_Offset_Index        => 2,
         Get_Prim_Op_Address     => 2,
+        Get_Prim_Op_Kind        => 2,
         Get_RC_Offset           => 1,
         Get_Remotely_Callable   => 1,
         Inherit_DT              => 3,
         Inherit_TSD             => 2,
+        Register_Interface_Tag  => 2,
         Register_Tag            => 1,
+        Set_Access_Level        => 2,
+        Set_Entry_Index         => 3,
         Set_Expanded_Name       => 2,
         Set_External_Tag        => 2,
+        Set_Offset_Index        => 3,
+        Set_OSD                 => 2,
         Set_Prim_Op_Address     => 3,
+        Set_Prim_Op_Kind        => 3,
         Set_RC_Offset           => 2,
         Set_Remotely_Callable   => 2,
+        Set_SSD                 => 2,
         Set_TSD                 => 2,
         TSD_Entry_Size          => 0,
         TSD_Prologue_Size       => 0);
  
+    procedure Collect_All_Interfaces (T : Entity_Id);
+    --  Ada 2005 (AI-251): Collect the whole list of interfaces that are
+    --  directly or indirectly implemented by T. Used to compute the size
+    --  of the table of interfaces.
+ 
+    function Default_Prim_Op_Position (Subp : Entity_Id) return Uint;
+    --  Ada 2005 (AI-251): Returns the fixed position in the dispatch table
+    --  of the default primitive operations.
+ 
     function Original_View_In_Visible_Part (Typ : Entity_Id) return Boolean;
     --  Check if the type has a private view or if the public view appears
     --  in the visible part of a package spec.
  
+    function Prim_Op_Kind
+      (Prim : Entity_Id;
+       Typ  : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Determine the primitive operation kind of Prim
+    --  according to its type Typ. Return a reference to an RTE Prim_Op_Kind
+    --  enumeration value.
+ 
+    ----------------------------
+    -- Collect_All_Interfaces --
+    ----------------------------
+ 
+    procedure Collect_All_Interfaces (T : Entity_Id) is
+ 
+       procedure Add_Interface (Iface : Entity_Id);
+       --  Add the interface it if is not already in the list
+ 
+       procedure Collect (Typ   : Entity_Id);
+       --  Subsidiary subprogram used to traverse the whole list
+       --  of directly and indirectly implemented interfaces
+ 
+       -------------------
+       -- Add_Interface --
+       -------------------
+ 
+       procedure Add_Interface (Iface : Entity_Id) is
+          Elmt : Elmt_Id;
+ 
+       begin
+          Elmt := First_Elmt (Abstract_Interfaces (T));
+          while Present (Elmt) and then Node (Elmt) /= Iface loop
+             Next_Elmt (Elmt);
+          end loop;
+ 
+          if not Present (Elmt) then
+             Append_Elmt (Iface, Abstract_Interfaces (T));
+          end if;
+       end Add_Interface;
+ 
+       -------------
+       -- Collect --
+       -------------
+ 
+       procedure Collect (Typ : Entity_Id) is
+          Nod      : constant Node_Id := Type_Definition (Parent (Typ));
+          Id       : Node_Id;
+          Iface    : Entity_Id;
+          Ancestor : Entity_Id;
+ 
+       begin
+          pragma Assert (False
+             or else Nkind (Nod) = N_Derived_Type_Definition
+             or else Nkind (Nod) = N_Record_Definition);
+ 
+          if Nkind (Nod) = N_Record_Definition then
+             return;
+          end if;
+ 
+          --  Include the ancestor if we are generating the whole list
+          --  of interfaces. This is used to know the size of the table
+          --  that stores the tag of all the ancestor interfaces.
+ 
+          Ancestor := Etype (Typ);
+ 
+          if Is_Interface (Ancestor) then
+             Add_Interface (Ancestor);
+          end if;
+ 
+          if Ancestor /= Typ
+            and then Ekind (Ancestor) /= E_Record_Type_With_Private
+          then
+             Collect (Ancestor);
+          end if;
+ 
+          --  Traverse the graph of ancestor interfaces
+ 
+          if Is_Non_Empty_List (Interface_List (Nod)) then
+             Id := First (Interface_List (Nod));
+             while Present (Id) loop
+                Iface := Etype (Id);
+ 
+                if Is_Interface (Iface) then
+                   Add_Interface (Iface);
+                   Collect (Iface);
+                end if;
+ 
+                Next (Id);
+             end loop;
+          end if;
+       end Collect;
+ 
+    --  Start of processing for Collect_All_Interfaces
+ 
+    begin
+       Collect (T);
+    end Collect_All_Interfaces;
+ 
+    ------------------------------
+    -- Default_Prim_Op_Position --
+    ------------------------------
+ 
+    function Default_Prim_Op_Position (Subp : Entity_Id) return Uint is
+       TSS_Name : TSS_Name_Type;
+       E        : Entity_Id := Subp;
+ 
+    begin
+       --  Handle overriden subprograms
+ 
+       while Present (Alias (E)) loop
+          E := Alias (E);
+       end loop;
+ 
+       Get_Name_String (Chars (E));
+       TSS_Name :=
+         TSS_Name_Type
+           (Name_Buffer (Name_Len - TSS_Name'Length + 1 .. Name_Len));
+ 
+       if Chars (E) = Name_uSize then
+          return Uint_1;
+ 
+       elsif Chars (E) = Name_uAlignment then
+          return Uint_2;
+ 
+       elsif TSS_Name = TSS_Stream_Read then
+          return Uint_3;
+ 
+       elsif TSS_Name = TSS_Stream_Write then
+          return Uint_4;
+ 
+       elsif TSS_Name = TSS_Stream_Input then
+          return Uint_5;
+ 
+       elsif TSS_Name = TSS_Stream_Output then
+          return Uint_6;
+ 
+       elsif Chars (E) = Name_Op_Eq then
+          return Uint_7;
+ 
+       elsif Chars (E) = Name_uAssign then
+          return Uint_8;
+ 
+       elsif TSS_Name = TSS_Deep_Adjust then
+          return Uint_9;
+ 
+       elsif TSS_Name = TSS_Deep_Finalize then
+          return Uint_10;
+ 
+       elsif Ada_Version >= Ada_05 then
+          if Chars (E) = Name_uDisp_Asynchronous_Select then
+             return Uint_11;
+ 
+          elsif Chars (E) = Name_uDisp_Conditional_Select then
+             return Uint_12;
+ 
+          elsif Chars (E) = Name_uDisp_Get_Prim_Op_Kind then
+             return Uint_13;
+ 
+          elsif Chars (E) = Name_uDisp_Get_Task_Id then
+             return Uint_14;
+ 
+          elsif Chars (E) = Name_uDisp_Timed_Select then
+             return Uint_15;
+          end if;
+       end if;
+ 
+       raise Program_Error;
+    end Default_Prim_Op_Position;
+ 
     -----------------------------
     -- Expand_Dispatching_Call --
     -----------------------------
*************** package body Exp_Disp is
*** 201,209 ****
  
           else
              declare
!                Formal : Entity_Id := First_Formal (Subp);
  
              begin
                 while Present (Formal) loop
                    if Is_Controlling_Formal (Formal) then
                       if Is_Access_Type (Etype (Formal)) then
--- 636,645 ----
  
           else
              declare
!                Formal : Entity_Id;
  
              begin
+                Formal := First_Formal (Subp);
                 while Present (Formal) loop
                    if Is_Controlling_Formal (Formal) then
                       if Is_Access_Type (Etype (Formal)) then
*************** package body Exp_Disp is
*** 255,261 ****
        --  This capability of dispatching directly by tag is also needed by the
        --  implementation of AI-260 (for the generic dispatching constructors).
  
!       if Etype (Ctrl_Arg) = RTE (RE_Tag) then
           CW_Typ := Class_Wide_Type (Controlling_Type (Subp));
  
        elsif Is_Access_Type (Etype (Ctrl_Arg)) then
--- 691,699 ----
        --  This capability of dispatching directly by tag is also needed by the
        --  implementation of AI-260 (for the generic dispatching constructors).
  
!       if Etype (Ctrl_Arg) = RTE (RE_Tag)
!         or else Etype (Ctrl_Arg) = RTE (RE_Interface_Tag)
!       then
           CW_Typ := Class_Wide_Type (Controlling_Type (Subp));
  
        elsif Is_Access_Type (Etype (Ctrl_Arg)) then
*************** package body Exp_Disp is
*** 267,272 ****
--- 705,714 ----
  
        Typ := Root_Type (CW_Typ);
  
+       if Ekind (Typ) = E_Incomplete_Type then
+          Typ := Non_Limited_View (Typ);
+       end if;
+ 
        if not Is_Limited_Type (Typ) then
           Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
        end if;
*************** package body Exp_Disp is
*** 278,324 ****
           New_Params := New_List;
           Param := First_Actual (Call_Node);
           while Present (Param) loop
! 
!             --  We assume that dispatching through the main dispatch table
!             --  (referenced by Tag_Component) doesn't require a displacement
!             --  so the expansion below is only done when dispatching on
!             --  another vtable pointer, in which case the first argument
!             --  is expanded into :
! 
!             --     typ!(Displaced_This (Address!(Param)))
! 
!             if Param = Ctrl_Arg
!               and then DTC_Entity (Subp) /= Tag_Component (Typ)
!             then
!                Append_To (New_Params,
! 
!                  Unchecked_Convert_To (Etype (Param),
!                    Make_Function_Call (Loc,
!                      Name => New_Reference_To (RTE (RE_Displaced_This), Loc),
!                      Parameter_Associations => New_List (
! 
!                      --  Current_This
! 
!                        Make_Unchecked_Type_Conversion (Loc,
!                          Subtype_Mark =>
!                            New_Reference_To (RTE (RE_Address), Loc),
!                          Expression   => Relocate_Node (Param)),
! 
!                      --  Vptr
! 
!                        Make_Selected_Component (Loc,
!                           Prefix => Duplicate_Subexpr (Ctrl_Arg),
!                           Selector_Name =>
!                             New_Reference_To (DTC_Entity (Subp), Loc)),
! 
!                      --  Position
! 
!                        Make_Integer_Literal (Loc, DT_Position (Subp))))));
! 
!             else
!                Append_To (New_Params, Relocate_Node (Param));
!             end if;
! 
              Next_Actual (Param);
           end loop;
  
--- 720,726 ----
           New_Params := New_List;
           Param := First_Actual (Call_Node);
           while Present (Param) loop
!             Append_To (New_Params, Relocate_Node (Param));
              Next_Actual (Param);
           end loop;
  
*************** package body Exp_Disp is
*** 390,403 ****
                           Make_Selected_Component (Loc,
                             Prefix => New_Value (Ctrl_Arg),
                             Selector_Name =>
!                              New_Reference_To (Tag_Component (Typ), Loc)),
  
                         Right_Opnd =>
                           Make_Selected_Component (Loc,
                             Prefix =>
                               Unchecked_Convert_To (Typ, New_Value (Param)),
                             Selector_Name =>
!                              New_Reference_To (Tag_Component (Typ), Loc))),
  
                     Then_Statements =>
                       New_List (New_Constraint_Error (Loc))));
--- 792,807 ----
                           Make_Selected_Component (Loc,
                             Prefix => New_Value (Ctrl_Arg),
                             Selector_Name =>
!                              New_Reference_To
!                                (First_Tag_Component (Typ), Loc)),
  
                         Right_Opnd =>
                           Make_Selected_Component (Loc,
                             Prefix =>
                               Unchecked_Convert_To (Typ, New_Value (Param)),
                             Selector_Name =>
!                              New_Reference_To
!                                (First_Tag_Component (Typ), Loc))),
  
                     Then_Statements =>
                       New_List (New_Constraint_Error (Loc))));
*************** package body Exp_Disp is
*** 499,505 ****
        --  use it directly.  Otherwise, the tag must be extracted from
        --  the controlling object.
  
!       if Etype (Ctrl_Arg) = RTE (RE_Tag) then
           Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
  
        else
--- 903,911 ----
        --  use it directly.  Otherwise, the tag must be extracted from
        --  the controlling object.
  
!       if Etype (Ctrl_Arg) = RTE (RE_Tag)
!         or else Etype (Ctrl_Arg) = RTE (RE_Interface_Tag)
!       then
           Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
  
        else
*************** package body Exp_Disp is
*** 527,561 ****
                Make_Integer_Literal (Loc, DT_Position (Subp)))));
  
        if Nkind (Call_Node) = N_Function_Call then
-          New_Call :=
-            Make_Function_Call (Loc,
-              Name => New_Call_Name,
-              Parameter_Associations => New_Params);
  
!          --  If this is a dispatching "=", we must first compare the tags so
!          --  we generate: x.tag = y.tag and then x = y
  
!          if Subp = Eq_Prim_Op then
              Param := First_Actual (Call_Node);
              New_Call :=
!               Make_And_Then (Loc,
!                 Left_Opnd =>
!                      Make_Op_Eq (Loc,
!                        Left_Opnd =>
!                          Make_Selected_Component (Loc,
!                            Prefix => New_Value (Param),
!                            Selector_Name =>
!                              New_Reference_To (Tag_Component (Typ), Loc)),
  
!                        Right_Opnd =>
!                          Make_Selected_Component (Loc,
!                            Prefix =>
!                              Unchecked_Convert_To (Typ,
!                                New_Value (Next_Actual (Param))),
!                            Selector_Name =>
!                              New_Reference_To (Tag_Component (Typ), Loc))),
  
!                 Right_Opnd => New_Call);
           end if;
  
        else
--- 933,996 ----
                Make_Integer_Literal (Loc, DT_Position (Subp)))));
  
        if Nkind (Call_Node) = N_Function_Call then
  
!          --  Ada 2005 (AI-251): A dispatching "=" with an abstract interface
!          --  just requires the comparison of the tags.
  
!          if Ekind (Etype (Ctrl_Arg)) = E_Class_Wide_Type
!            and then Is_Interface (Etype (Ctrl_Arg))
!            and then Subp = Eq_Prim_Op
!          then
              Param := First_Actual (Call_Node);
+ 
              New_Call :=
!                 Make_Op_Eq (Loc,
!                    Left_Opnd =>
!                      Make_Selected_Component (Loc,
!                        Prefix => New_Value (Param),
!                        Selector_Name =>
!                          New_Reference_To (First_Tag_Component (Typ), Loc)),
  
!                    Right_Opnd =>
!                      Make_Selected_Component (Loc,
!                        Prefix =>
!                          Unchecked_Convert_To (Typ,
!                            New_Value (Next_Actual (Param))),
!                        Selector_Name =>
!                          New_Reference_To (First_Tag_Component (Typ), Loc)));
  
!          else
!             New_Call :=
!               Make_Function_Call (Loc,
!                 Name => New_Call_Name,
!                 Parameter_Associations => New_Params);
! 
!             --  If this is a dispatching "=", we must first compare the tags so
!             --  we generate: x.tag = y.tag and then x = y
! 
!             if Subp = Eq_Prim_Op then
!                Param := First_Actual (Call_Node);
!                New_Call :=
!                  Make_And_Then (Loc,
!                    Left_Opnd =>
!                         Make_Op_Eq (Loc,
!                           Left_Opnd =>
!                             Make_Selected_Component (Loc,
!                               Prefix => New_Value (Param),
!                               Selector_Name =>
!                                 New_Reference_To (First_Tag_Component (Typ),
!                                                   Loc)),
! 
!                           Right_Opnd =>
!                             Make_Selected_Component (Loc,
!                               Prefix =>
!                                 Unchecked_Convert_To (Typ,
!                                   New_Value (Next_Actual (Param))),
!                               Selector_Name =>
!                                 New_Reference_To (First_Tag_Component (Typ),
!                                                   Loc))),
!                    Right_Opnd => New_Call);
!             end if;
           end if;
  
        else
*************** package body Exp_Disp is
*** 569,607 ****
        Analyze_And_Resolve (Call_Node, Call_Typ);
     end Expand_Dispatching_Call;
  
!    -------------
!    -- Fill_DT --
!    -------------
  
     function Fill_DT_Entry
!      (Loc  : Source_Ptr;
!       Prim : Entity_Id)
!       return Node_Id
     is
!       Typ    : constant Entity_Id := Scope (DTC_Entity (Prim));
!       DT_Ptr : constant Entity_Id := Access_Disp_Table (Typ);
  
     begin
        return
          Make_DT_Access_Action (Typ,
            Action => Set_Prim_Op_Address,
            Args   => New_List (
!             New_Reference_To (DT_Ptr, Loc),                     -- DTptr
  
!             Make_Integer_Literal (Loc, DT_Position (Prim)),     -- Position
  
              Make_Attribute_Reference (Loc,                      -- Value
                Prefix          => New_Reference_To (Prim, Loc),
                Attribute_Name  => Name_Address)));
     end Fill_DT_Entry;
  
     ---------------------------
     -- Get_Remotely_Callable --
     ---------------------------
  
     function Get_Remotely_Callable (Obj : Node_Id) return Node_Id is
        Loc : constant Source_Ptr := Sloc (Obj);
- 
     begin
        return Make_DT_Access_Action
          (Typ    => Etype (Obj),
--- 1004,1662 ----
        Analyze_And_Resolve (Call_Node, Call_Typ);
     end Expand_Dispatching_Call;
  
!    ---------------------------------
!    -- Expand_Interface_Conversion --
!    ---------------------------------
! 
!    procedure Expand_Interface_Conversion (N : Node_Id) is
!       Loc         : constant Source_Ptr := Sloc (N);
!       Operand     : constant Node_Id    := Expression (N);
!       Operand_Typ : Entity_Id           := Etype (Operand);
!       Iface_Typ   : Entity_Id           := Etype (N);
!       Iface_Tag   : Entity_Id;
!       Fent        : Entity_Id;
!       Func        : Node_Id;
!       P           : Node_Id;
!       Null_Op_Nod : Node_Id;
! 
!    begin
!       pragma Assert (Nkind (Operand) /= N_Attribute_Reference);
! 
!       --  Ada 2005 (AI-345): Handle task interfaces
! 
!       if Ekind (Operand_Typ) = E_Task_Type
!         or else Ekind (Operand_Typ) = E_Protected_Type
!       then
!          Operand_Typ := Corresponding_Record_Type (Operand_Typ);
!       end if;
! 
!       --  Handle access types to interfaces
! 
!       if Is_Access_Type (Iface_Typ) then
!          Iface_Typ := Etype (Directly_Designated_Type (Iface_Typ));
!       end if;
! 
!       --  Handle class-wide interface types. This conversion can appear
!       --  explicitly in the source code. Example: I'Class (Obj)
! 
!       if Is_Class_Wide_Type (Iface_Typ) then
!          Iface_Typ := Etype (Iface_Typ);
!       end if;
! 
!       pragma Assert (not Is_Class_Wide_Type (Iface_Typ)
!         and then Is_Interface (Iface_Typ));
! 
!       Iface_Tag := Find_Interface_Tag (Operand_Typ, Iface_Typ);
!       pragma Assert (Iface_Tag /= Empty);
! 
!       --  Keep separate access types to interfaces because one internal
!       --  function is used to handle the null value (see following comment)
! 
!       if not Is_Access_Type (Etype (N)) then
!          Rewrite (N,
!            Unchecked_Convert_To (Etype (N),
!              Make_Selected_Component (Loc,
!                Prefix => Relocate_Node (Expression (N)),
!                Selector_Name =>
!                  New_Occurrence_Of (Iface_Tag, Loc))));
! 
!       else
!          --  Build internal function to handle the case in which the
!          --  actual is null. If the actual is null returns null because
!          --  no displacement is required; otherwise performs a type
!          --  conversion that will be expanded in the code that returns
!          --  the value of the displaced actual. That is:
! 
!          --     function Func (O : Operand_Typ) return Iface_Typ is
!          --     begin
!          --        if O = null then
!          --           return null;
!          --        else
!          --           return Iface_Typ!(O);
!          --        end if;
!          --     end Func;
! 
!          Fent :=
!            Make_Defining_Identifier (Loc, New_Internal_Name ('F'));
! 
!          --  Decorate the "null" in the if-statement condition
! 
!          Null_Op_Nod := Make_Null (Loc);
!          Set_Etype (Null_Op_Nod, Etype (Operand));
!          Set_Analyzed (Null_Op_Nod);
! 
!          Func :=
!            Make_Subprogram_Body (Loc,
!              Specification =>
!                Make_Function_Specification (Loc,
!                  Defining_Unit_Name       => Fent,
! 
!                  Parameter_Specifications => New_List (
!                    Make_Parameter_Specification (Loc,
!                      Defining_Identifier =>
!                        Make_Defining_Identifier (Loc, Name_uO),
!                      Parameter_Type =>
!                        New_Reference_To (Etype (Operand), Loc))),
!                  Result_Definition =>
!                    New_Reference_To (Etype (N), Loc)),
! 
!              Declarations => Empty_List,
! 
!              Handled_Statement_Sequence =>
!                Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => New_List (
!                    Make_If_Statement (Loc,
!                      Condition       =>
!                        Make_Op_Eq (Loc,
!                           Left_Opnd  => Make_Identifier (Loc, Name_uO),
!                           Right_Opnd => Null_Op_Nod),
!                      Then_Statements => New_List (
!                        Make_Return_Statement (Loc,
!                          Make_Null (Loc))),
!                      Else_Statements => New_List (
!                        Make_Return_Statement (Loc,
!                          Unchecked_Convert_To (Etype (N),
!                             Make_Attribute_Reference (Loc,
!                               Prefix =>
!                                 Make_Selected_Component (Loc,
!                                   Prefix => Relocate_Node (Expression (N)),
!                                   Selector_Name =>
!                                     New_Occurrence_Of (Iface_Tag, Loc)),
!                               Attribute_Name => Name_Address))))))));
! 
!          --  Insert the new declaration in the nearest enclosing scope
!          --  that has declarations.
! 
!          P := N;
!          while not Has_Declarations (Parent (P)) loop
!             P := Parent (P);
!          end loop;
! 
!          if Is_List_Member (P) then
!             Insert_Before (P, Func);
! 
!          elsif Nkind (Parent (P)) = N_Package_Specification then
!             Append_To (Visible_Declarations (Parent (P)), Func);
! 
!          else
!             Append_To (Declarations (Parent (P)), Func);
!          end if;
! 
!          Analyze (Func);
! 
!          Rewrite (N,
!            Make_Function_Call (Loc,
!              Name => New_Reference_To (Fent, Loc),
!              Parameter_Associations => New_List (
!                Relocate_Node (Expression (N)))));
!       end if;
! 
!       Analyze (N);
!    end Expand_Interface_Conversion;
! 
!    ------------------------------
!    -- Expand_Interface_Actuals --
!    ------------------------------
! 
!    procedure Expand_Interface_Actuals (Call_Node : Node_Id) is
!       Loc        : constant Source_Ptr := Sloc (Call_Node);
!       Actual     : Node_Id;
!       Actual_Dup : Node_Id;
!       Actual_Typ : Entity_Id;
!       Anon       : Entity_Id;
!       Conversion : Node_Id;
!       Formal     : Entity_Id;
!       Formal_Typ : Entity_Id;
!       Subp       : Entity_Id;
!       Nam        : Name_Id;
!       Formal_DDT : Entity_Id;
!       Actual_DDT : Entity_Id;
! 
!    begin
!       --  This subprogram is called directly from the semantics, so we need a
!       --  check to see whether expansion is active before proceeding.
! 
!       if not Expander_Active then
!          return;
!       end if;
! 
!       --  Call using access to subprogram with explicit dereference
! 
!       if Nkind (Name (Call_Node)) = N_Explicit_Dereference then
!          Subp := Etype (Name (Call_Node));
! 
!       --  Normal case
! 
!       else
!          Subp := Entity (Name (Call_Node));
!       end if;
! 
!       Formal := First_Formal (Subp);
!       Actual := First_Actual (Call_Node);
!       while Present (Formal) loop
! 
!          --  Ada 2005 (AI-251): Conversion to interface to force "this"
!          --  displacement.
! 
!          Formal_Typ := Etype (Etype (Formal));
! 
!          if Ekind (Formal_Typ) = E_Record_Type_With_Private then
!             Formal_Typ := Full_View (Formal_Typ);
!          end if;
! 
!          if Is_Access_Type (Formal_Typ) then
!             Formal_DDT := Directly_Designated_Type (Formal_Typ);
!          end if;
! 
!          Actual_Typ := Etype (Actual);
! 
!          if Is_Access_Type (Actual_Typ) then
!             Actual_DDT := Directly_Designated_Type (Actual_Typ);
!          end if;
! 
!          if Is_Interface (Formal_Typ) then
! 
!             --  No need to displace the pointer if the type of the actual
!             --  is class-wide of the formal-type interface; in this case the
!             --  displacement of the pointer was already done at the point of
!             --  the call to the enclosing subprogram. This case corresponds
!             --  with the call to P (Obj) in the following example:
! 
!             --     type I is interface;
!             --     procedure P (X : I) is abstract;
! 
!             --     procedure General_Op (Obj : I'Class) is
!             --     begin
!             --        P (Obj);
!             --     end General_Op;
! 
!             if Is_Class_Wide_Type (Actual_Typ)
!               and then Etype (Actual_Typ) = Formal_Typ
!             then
!                null;
! 
!             --  No need to displace the pointer if the type of the actual is a
!             --  derivation of the formal-type interface because in this case
!             --  the interface primitives are located in the primary dispatch
!             --  table.
! 
!             elsif Is_Ancestor (Formal_Typ, Actual_Typ) then
!                null;
! 
!             else
!                Conversion := Convert_To (Formal_Typ, Relocate_Node (Actual));
!                Rewrite             (Actual, Conversion);
!                Analyze_And_Resolve (Actual, Formal_Typ);
!             end if;
! 
!          --  Anonymous access type
! 
!          elsif Is_Access_Type (Formal_Typ)
!            and then Is_Interface (Etype (Formal_DDT))
!            and then Interface_Present_In_Ancestor
!                       (Typ   => Actual_DDT,
!                        Iface => Etype (Formal_DDT))
!          then
!             if Nkind (Actual) = N_Attribute_Reference
!               and then
!                (Attribute_Name (Actual) = Name_Access
!                  or else Attribute_Name (Actual) = Name_Unchecked_Access)
!             then
!                Nam := Attribute_Name (Actual);
! 
!                Conversion := Convert_To (Etype (Formal_DDT), Prefix (Actual));
! 
!                Rewrite (Actual, Conversion);
!                Analyze_And_Resolve (Actual, Etype (Formal_DDT));
! 
!                Rewrite (Actual,
!                  Unchecked_Convert_To (Formal_Typ,
!                    Make_Attribute_Reference (Loc,
!                      Prefix => Relocate_Node (Actual),
!                      Attribute_Name => Nam)));
! 
!                Analyze_And_Resolve (Actual, Formal_Typ);
! 
!             --  No need to displace the pointer if the actual is a class-wide
!             --  type of the formal-type interface because in this case the
!             --  displacement of the pointer was already done at the point of
!             --  the call to the enclosing subprogram (this case is similar
!             --  to the example described above for the non access-type case)
! 
!             elsif Is_Class_Wide_Type (Actual_DDT)
!               and then Etype (Actual_DDT) = Formal_DDT
!             then
!                null;
! 
!             --  No need to displace the pointer if the type of the actual is a
!             --  derivation of the interface (because in this case the interface
!             --  primitives are located in the primary dispatch table)
! 
!             elsif Is_Ancestor (Formal_DDT, Actual_DDT) then
!                null;
! 
!             else
!                Actual_Dup := Relocate_Node (Actual);
! 
!                if From_With_Type (Actual_Typ) then
! 
!                   --  If the type of the actual parameter comes from a limited
!                   --  with-clause and the non-limited view is already available
!                   --  we replace the anonymous access type by a duplicate decla
!                   --  ration whose designated type is the non-limited view
! 
!                   if Ekind (Actual_DDT) = E_Incomplete_Type
!                     and then Present (Non_Limited_View (Actual_DDT))
!                   then
!                      Anon := New_Copy (Actual_Typ);
! 
!                      if Is_Itype (Anon) then
!                         Set_Scope (Anon, Current_Scope);
!                      end if;
! 
!                      Set_Directly_Designated_Type (Anon,
!                        Non_Limited_View (Actual_DDT));
!                      Set_Etype (Actual_Dup, Anon);
! 
!                   elsif Is_Class_Wide_Type (Actual_DDT)
!                     and then Ekind (Etype (Actual_DDT)) = E_Incomplete_Type
!                     and then Present (Non_Limited_View (Etype (Actual_DDT)))
!                   then
!                      Anon := New_Copy (Actual_Typ);
! 
!                      if Is_Itype (Anon) then
!                         Set_Scope (Anon, Current_Scope);
!                      end if;
! 
!                      Set_Directly_Designated_Type (Anon,
!                        New_Copy (Actual_DDT));
!                      Set_Class_Wide_Type (Directly_Designated_Type (Anon),
!                        New_Copy (Class_Wide_Type (Actual_DDT)));
!                      Set_Etype (Directly_Designated_Type (Anon),
!                        Non_Limited_View (Etype (Actual_DDT)));
!                      Set_Etype (
!                        Class_Wide_Type (Directly_Designated_Type (Anon)),
!                        Non_Limited_View (Etype (Actual_DDT)));
!                      Set_Etype (Actual_Dup, Anon);
!                   end if;
!                end if;
! 
!                Conversion := Convert_To (Formal_Typ, Actual_Dup);
!                Rewrite (Actual, Conversion);
!                Analyze_And_Resolve (Actual, Formal_Typ);
!             end if;
!          end if;
! 
!          Next_Actual (Actual);
!          Next_Formal (Formal);
!       end loop;
!    end Expand_Interface_Actuals;
! 
!    ----------------------------
!    -- Expand_Interface_Thunk --
!    ----------------------------
! 
!    function Expand_Interface_Thunk
!      (N           : Node_Id;
!       Thunk_Alias : Entity_Id;
!       Thunk_Id    : Entity_Id;
!       Thunk_Tag   : Entity_Id) return Node_Id
!    is
!       Loc         : constant Source_Ptr := Sloc (N);
!       Actuals     : constant List_Id    := New_List;
!       Decl        : constant List_Id    := New_List;
!       Formals     : constant List_Id    := New_List;
!       Target      : Entity_Id;
!       New_Code    : Node_Id;
!       Formal      : Node_Id;
!       New_Formal  : Node_Id;
!       Decl_1      : Node_Id;
!       Decl_2      : Node_Id;
!       E           : Entity_Id;
! 
!    begin
!       --  Traverse the list of alias to find the final target
! 
!       Target := Thunk_Alias;
!       while Present (Alias (Target)) loop
!          Target := Alias (Target);
!       end loop;
! 
!       --  Duplicate the formals
! 
!       Formal := First_Formal (Target);
!       E      := First_Formal (N);
!       while Present (Formal) loop
!          New_Formal := Copy_Separate_Tree (Parent (Formal));
! 
!          --  Propagate the parameter type to the copy. This is required to
!          --  properly handle the case in which the subprogram covering the
!          --  interface has been inherited:
! 
!          --  Example:
!          --     type I is interface;
!          --     procedure P (X : in I) is abstract;
! 
!          --     type T is tagged null record;
!          --     procedure P (X : T);
! 
!          --     type DT is new T and I with ...
! 
!          Set_Parameter_Type (New_Formal, New_Reference_To (Etype (E), Loc));
!          Append_To (Formals, New_Formal);
! 
!          Next_Formal (Formal);
!          Next_Formal (E);
!       end loop;
! 
!       if Ekind (First_Formal (Target)) = E_In_Parameter
!         and then Ekind (Etype (First_Formal (Target)))
!                   = E_Anonymous_Access_Type
!       then
!          --  Generate:
! 
!          --     type T is access all <<type of the first formal>>
!          --     S1 := Storage_Offset!(First_formal)
!          --           - Storage_Offset!(First_Formal.Thunk_Tag'Position)
! 
!          --  ... and the first actual of the call is generated as T!(S1)
! 
!          Decl_2 :=
!            Make_Full_Type_Declaration (Loc,
!              Defining_Identifier =>
!                Make_Defining_Identifier (Loc,
!                  New_Internal_Name ('T')),
!              Type_Definition =>
!                Make_Access_To_Object_Definition (Loc,
!                  All_Present            => True,
!                  Null_Exclusion_Present => False,
!                  Constant_Present       => False,
!                  Subtype_Indication     =>
!                    New_Reference_To
!                      (Directly_Designated_Type
!                         (Etype (First_Formal (Target))), Loc)));
! 
!          Decl_1 :=
!            Make_Object_Declaration (Loc,
!              Defining_Identifier =>
!                Make_Defining_Identifier (Loc,
!                  New_Internal_Name ('S')),
!              Constant_Present    => True,
!              Object_Definition   =>
!                New_Reference_To (RTE (RE_Storage_Offset), Loc),
!              Expression          =>
!                Make_Op_Subtract (Loc,
!                  Left_Opnd  =>
!                    Unchecked_Convert_To
!                      (RTE (RE_Storage_Offset),
!                       New_Reference_To
!                         (Defining_Identifier (First (Formals)), Loc)),
!                   Right_Opnd =>
!                     Unchecked_Convert_To
!                       (RTE (RE_Storage_Offset),
!                        Make_Attribute_Reference (Loc,
!                          Prefix =>
!                            Make_Selected_Component (Loc,
!                              Prefix =>
!                                New_Reference_To
!                                  (Defining_Identifier (First (Formals)), Loc),
!                              Selector_Name =>
!                                New_Occurrence_Of (Thunk_Tag, Loc)),
!                          Attribute_Name => Name_Position))));
! 
!          Append_To (Decl, Decl_2);
!          Append_To (Decl, Decl_1);
! 
!          --  Reference the new first actual
! 
!          Append_To (Actuals,
!            Unchecked_Convert_To
!              (Defining_Identifier (Decl_2),
!               New_Reference_To (Defining_Identifier (Decl_1), Loc)));
! 
!          --  Side note: The reverse order of declarations is just to ensure
!          --  that the call to RE_Print is correct.
! 
!       else
!          --  Generate:
!          --
!          --     S1 := Storage_Offset!(First_formal'Address)
!          --           - Storage_Offset!(First_Formal.Thunk_Tag'Position)
!          --     S2 := Tag_Ptr!(S3)
! 
!          Decl_1 :=
!            Make_Object_Declaration (Loc,
!              Defining_Identifier =>
!                Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
!              Constant_Present    => True,
!              Object_Definition   =>
!                New_Reference_To (RTE (RE_Storage_Offset), Loc),
!              Expression          =>
!                Make_Op_Subtract (Loc,
!                  Left_Opnd =>
!                    Unchecked_Convert_To
!                      (RTE (RE_Storage_Offset),
!                       Make_Attribute_Reference (Loc,
!                         Prefix =>
!                           New_Reference_To
!                             (Defining_Identifier (First (Formals)), Loc),
!                         Attribute_Name => Name_Address)),
!                  Right_Opnd =>
!                    Unchecked_Convert_To
!                      (RTE (RE_Storage_Offset),
!                       Make_Attribute_Reference (Loc,
!                         Prefix =>
!                           Make_Selected_Component (Loc,
!                             Prefix =>
!                               New_Reference_To
!                                 (Defining_Identifier (First (Formals)), Loc),
!                                  Selector_Name =>
!                                    New_Occurrence_Of (Thunk_Tag, Loc)),
!                         Attribute_Name => Name_Position))));
! 
!          Decl_2 :=
!            Make_Object_Declaration (Loc,
!              Defining_Identifier =>
!                Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
!              Constant_Present    => True,
!              Object_Definition   => New_Reference_To (RTE (RE_Addr_Ptr), Loc),
!              Expression          =>
!                Unchecked_Convert_To
!                  (RTE (RE_Addr_Ptr),
!                   New_Reference_To (Defining_Identifier (Decl_1), Loc)));
! 
!          Append_To (Decl, Decl_1);
!          Append_To (Decl, Decl_2);
! 
!          --  Reference the new first actual
! 
!          Append_To (Actuals,
!            Unchecked_Convert_To
!              (Etype (First_Entity (Target)),
!               Make_Explicit_Dereference (Loc,
!                 New_Reference_To (Defining_Identifier (Decl_2), Loc))));
!       end if;
! 
!       Formal := Next (First (Formals));
!       while Present (Formal) loop
!          Append_To (Actuals,
!             New_Reference_To (Defining_Identifier (Formal), Loc));
!          Next (Formal);
!       end loop;
! 
!       if Ekind (Target) = E_Procedure then
!          New_Code :=
!            Make_Subprogram_Body (Loc,
!               Specification =>
!                 Make_Procedure_Specification (Loc,
!                   Defining_Unit_Name       => Thunk_Id,
!                   Parameter_Specifications => Formals),
!               Declarations => Decl,
!               Handled_Statement_Sequence =>
!                 Make_Handled_Sequence_Of_Statements (Loc,
!                   Statements => New_List (
!                     Make_Procedure_Call_Statement (Loc,
!                        Name => New_Occurrence_Of (Target, Loc),
!                        Parameter_Associations => Actuals))));
! 
!       else pragma Assert (Ekind (Target) = E_Function);
! 
!          New_Code :=
!            Make_Subprogram_Body (Loc,
!               Specification =>
!                 Make_Function_Specification (Loc,
!                   Defining_Unit_Name       => Thunk_Id,
!                   Parameter_Specifications => Formals,
!                   Result_Definition =>
!                     New_Copy (Result_Definition (Parent (Target)))),
!               Declarations => Decl,
!               Handled_Statement_Sequence =>
!                 Make_Handled_Sequence_Of_Statements (Loc,
!                   Statements => New_List (
!                     Make_Return_Statement (Loc,
!                       Make_Function_Call (Loc,
!                         Name => New_Occurrence_Of (Target, Loc),
!                         Parameter_Associations => Actuals)))));
!       end if;
! 
!       Analyze (New_Code);
!       return New_Code;
!    end Expand_Interface_Thunk;
! 
!    -------------------
!    -- Fill_DT_Entry --
!    -------------------
  
     function Fill_DT_Entry
!      (Loc     : Source_Ptr;
!       Prim    : Entity_Id) return Node_Id
     is
!       Typ     : constant Entity_Id := Scope (DTC_Entity (Prim));
!       DT_Ptr  : constant Entity_Id :=
!                   Node (First_Elmt (Access_Disp_Table (Typ)));
!       Pos     : constant Uint      := DT_Position (Prim);
!       Tag     : constant Entity_Id := First_Tag_Component (Typ);
  
     begin
+       if Pos = Uint_0 or else Pos > DT_Entry_Count (Tag) then
+          raise Program_Error;
+       end if;
+ 
        return
          Make_DT_Access_Action (Typ,
            Action => Set_Prim_Op_Address,
            Args   => New_List (
!             Unchecked_Convert_To (RTE (RE_Tag),
!               New_Reference_To (DT_Ptr, Loc)),                  -- DTptr
  
!             Make_Integer_Literal (Loc, Pos),                    -- Position
  
              Make_Attribute_Reference (Loc,                      -- Value
                Prefix          => New_Reference_To (Prim, Loc),
                Attribute_Name  => Name_Address)));
     end Fill_DT_Entry;
  
+    -----------------------------
+    -- Fill_Secondary_DT_Entry --
+    -----------------------------
+ 
+    function Fill_Secondary_DT_Entry
+      (Loc          : Source_Ptr;
+       Prim         : Entity_Id;
+       Thunk_Id     : Entity_Id;
+       Iface_DT_Ptr : Entity_Id) return Node_Id
+    is
+       Typ        : constant Entity_Id := Scope (DTC_Entity (Alias (Prim)));
+       Iface_Prim : constant Entity_Id := Abstract_Interface_Alias (Prim);
+       Pos        : constant Uint      := DT_Position (Iface_Prim);
+       Tag        : constant Entity_Id :=
+                      First_Tag_Component (Scope (DTC_Entity (Iface_Prim)));
+ 
+    begin
+       if Pos = Uint_0 or else Pos > DT_Entry_Count (Tag) then
+          raise Program_Error;
+       end if;
+ 
+       return
+         Make_DT_Access_Action (Typ,
+           Action => Set_Prim_Op_Address,
+           Args   => New_List (
+             Unchecked_Convert_To (RTE (RE_Tag),
+               New_Reference_To (Iface_DT_Ptr, Loc)),            -- DTptr
+ 
+             Make_Integer_Literal (Loc, Pos),                    -- Position
+ 
+             Make_Attribute_Reference (Loc,                      -- Value
+               Prefix          => New_Reference_To (Thunk_Id, Loc),
+               Attribute_Name  => Name_Address)));
+    end Fill_Secondary_DT_Entry;
+ 
     ---------------------------
     -- Get_Remotely_Callable --
     ---------------------------
  
     function Get_Remotely_Callable (Obj : Node_Id) return Node_Id is
        Loc : constant Source_Ptr := Sloc (Obj);
     begin
        return Make_DT_Access_Action
          (Typ    => Etype (Obj),
*************** package body Exp_Disp is
*** 612,645 ****
               Selector_Name => Make_Identifier (Loc, Name_uTag))));
     end Get_Remotely_Callable;
  
     -------------
     -- Make_DT --
     -------------
  
     function Make_DT (Typ : Entity_Id) return List_Id is
!       Loc : constant Source_Ptr := Sloc (Typ);
! 
!       Result    : constant List_Id := New_List;
!       Elab_Code : constant List_Id := New_List;
  
        Tname       : constant Name_Id := Chars (Typ);
        Name_DT     : constant Name_Id := New_External_Name (Tname, 'T');
        Name_DT_Ptr : constant Name_Id := New_External_Name (Tname, 'P');
        Name_TSD    : constant Name_Id := New_External_Name (Tname, 'B');
        Name_Exname : constant Name_Id := New_External_Name (Tname, 'E');
        Name_No_Reg : constant Name_Id := New_External_Name (Tname, 'F');
  
        DT     : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT);
        DT_Ptr : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT_Ptr);
        TSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_TSD);
        Exname : constant Node_Id := Make_Defining_Identifier (Loc, Name_Exname);
        No_Reg : constant Node_Id := Make_Defining_Identifier (Loc, Name_No_Reg);
  
        I_Depth         : Int;
-       Generalized_Tag : Entity_Id;
        Size_Expr_Node  : Node_Id;
!       Old_Tag         : Node_Id;
!       Old_TSD         : Node_Id;
  
     begin
        if not RTE_Available (RE_Tag) then
--- 1667,2577 ----
               Selector_Name => Make_Identifier (Loc, Name_uTag))));
     end Get_Remotely_Callable;
  
+    ------------------------------------------
+    -- Init_Predefined_Interface_Primitives --
+    ------------------------------------------
+ 
+    function Init_Predefined_Interface_Primitives
+      (Typ : Entity_Id) return List_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       DT_Ptr : constant Node_Id :=
+                  Node (First_Elmt (Access_Disp_Table (Typ)));
+       Result : constant List_Id := New_List;
+       AI     : Elmt_Id;
+ 
+    begin
+       --  No need to inherit primitives if we have an abstract interface
+       --  type or a concurrent type.
+ 
+       if Is_Interface (Typ) or else Is_Concurrent_Record_Type (Typ) then
+          return Result;
+       end if;
+ 
+       AI := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
+       while Present (AI) loop
+ 
+          --  All the secondary tables inherit the dispatch table entries
+          --  associated with predefined primitives.
+ 
+          --  Generate:
+          --    Inherit_DT (T'Tag, Iface'Tag, Default_Prim_Op_Count);
+ 
+          Append_To (Result,
+            Make_DT_Access_Action (Typ,
+              Action => Inherit_DT,
+              Args   => New_List (
+                Node1 => New_Reference_To (DT_Ptr, Loc),
+                Node2 => Unchecked_Convert_To (RTE (RE_Tag),
+                           New_Reference_To (Node (AI), Loc)),
+                Node3 => Make_Integer_Literal (Loc, Default_Prim_Op_Count))));
+ 
+          Next_Elmt (AI);
+       end loop;
+ 
+       return Result;
+    end Init_Predefined_Interface_Primitives;
+ 
+    ----------------------------------------
+    -- Make_Disp_Asynchronous_Select_Body --
+    ----------------------------------------
+ 
+    function Make_Disp_Asynchronous_Select_Body
+      (Typ : Entity_Id) return Node_Id
+    is
+       Conc_Typ : Entity_Id           := Empty;
+       Decls    : constant List_Id    := New_List;
+       DT_Ptr   : Entity_Id;
+       Loc      : constant Source_Ptr := Sloc (Typ);
+       Stmts    : constant List_Id    := New_List;
+ 
+    begin
+       if Is_Interface (Typ) then
+          return
+            Make_Subprogram_Body (Loc,
+              Specification =>
+                Make_Disp_Asynchronous_Select_Spec (Typ),
+              Declarations =>
+                New_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  New_List (Make_Null_Statement (Loc))));
+       end if;
+ 
+       if Is_Concurrent_Record_Type (Typ) then
+          Conc_Typ := Corresponding_Concurrent_Type (Typ);
+       end if;
+ 
+       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+ 
+       if Present (Conc_Typ) then
+ 
+          --  Generate:
+          --    I : Integer := get_entry_index (tag! (<type>VP), S);
+ 
+          --  where I will be used to capture the entry index of the primitive
+          --  wrapper at position S.
+ 
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uI),
+              Object_Definition =>
+                New_Reference_To (Standard_Integer, Loc),
+              Expression =>
+                Make_DT_Access_Action (Typ,
+                  Action =>
+                    Get_Entry_Index,
+                  Args =>
+                    New_List (
+                      Unchecked_Convert_To (RTE (RE_Tag),
+                        New_Reference_To (DT_Ptr, Loc)),
+                      Make_Identifier (Loc, Name_uS)))));
+ 
+          if Ekind (Conc_Typ) = E_Protected_Type then
+ 
+             --  Generate:
+             --    Protected_Entry_Call (
+             --      T._object'access,
+             --      protected_entry_index! (I),
+             --      P,
+             --      Asynchronous_Call,
+             --      B);
+ 
+             --  where T is the protected object, I is the entry index, P are
+             --  the wrapped parameters and B is the name of the communication
+             --  block.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Attribute_Reference (Loc,        -- T._object'access
+                       Attribute_Name =>
+                         Name_Unchecked_Access,
+                       Prefix =>
+                         Make_Selected_Component (Loc,
+                           Prefix =>
+                             Make_Identifier (Loc, Name_uT),
+                           Selector_Name =>
+                             Make_Identifier (Loc, Name_uObject))),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     New_Reference_To (                    --  Asynchronous_Call
+                       RTE (RE_Asynchronous_Call), Loc),
+                     Make_Identifier (Loc, Name_uB))));    --  comm block
+          else
+             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
+ 
+             --  Generate:
+             --    Protected_Entry_Call (
+             --      T._task_id,
+             --      task_entry_index! (I),
+             --      P,
+             --      Conditional_Call,
+             --      F);
+ 
+             --  where T is the task object, I is the entry index, P are the
+             --  wrapped parameters and F is the status flag.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Selected_Component (Loc,         -- T._task_id
+                       Prefix =>
+                         Make_Identifier (Loc, Name_uT),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Name_uTask_Id)),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Task_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     New_Reference_To (                    --  Asynchronous_Call
+                       RTE (RE_Asynchronous_Call), Loc),
+                     Make_Identifier (Loc, Name_uF))));    --  status flag
+          end if;
+ 
+       --  Implementation for limited tagged types
+ 
+       else
+          Append_To (Stmts,
+            Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
+       end if;
+ 
+       return
+         Make_Subprogram_Body (Loc,
+           Specification =>
+             Make_Disp_Asynchronous_Select_Spec (Typ),
+           Declarations =>
+             Decls,
+           Handled_Statement_Sequence =>
+             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
+    end Make_Disp_Asynchronous_Select_Body;
+ 
+    ----------------------------------------
+    -- Make_Disp_Asynchronous_Select_Spec --
+    ----------------------------------------
+ 
+    function Make_Disp_Asynchronous_Select_Spec
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       Def_Id : constant Node_Id    :=
+                  Make_Defining_Identifier (Loc,
+                    Name_uDisp_Asynchronous_Select);
+       Params : constant List_Id    := New_List;
+ 
+    begin
+       --  "T" - Object parameter
+       --  "S" - Primitive operation slot
+       --  "P" - Wrapped parameters
+       --  "B" - Communication block
+       --  "F" - Status flag
+ 
+       SEU.Build_T (Loc, Typ, Params);
+       SEU.Build_S (Loc, Params);
+       SEU.Build_P (Loc, Params);
+       SEU.Build_B (Loc, Params);
+       SEU.Build_F (Loc, Params);
+ 
+       Set_Is_Internal (Def_Id);
+ 
+       return
+          Make_Procedure_Specification (Loc,
+            Defining_Unit_Name       => Def_Id,
+            Parameter_Specifications => Params);
+    end Make_Disp_Asynchronous_Select_Spec;
+ 
+    ---------------------------------------
+    -- Make_Disp_Conditional_Select_Body --
+    ---------------------------------------
+ 
+    function Make_Disp_Conditional_Select_Body
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc      : constant Source_Ptr := Sloc (Typ);
+       Blk_Nam  : Entity_Id;
+       Conc_Typ : Entity_Id           := Empty;
+       Decls    : constant List_Id    := New_List;
+       DT_Ptr   : Entity_Id;
+       Stmts    : constant List_Id    := New_List;
+ 
+    begin
+       if Is_Interface (Typ) then
+          return
+            Make_Subprogram_Body (Loc,
+              Specification =>
+                Make_Disp_Conditional_Select_Spec (Typ),
+              Declarations =>
+                No_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  New_List (Make_Null_Statement (Loc))));
+       end if;
+ 
+       if Is_Concurrent_Record_Type (Typ) then
+          Conc_Typ := Corresponding_Concurrent_Type (Typ);
+       end if;
+ 
+       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+ 
+       if Present (Conc_Typ) then
+ 
+          --  Generate:
+          --    I : Integer;
+ 
+          --  where I will be used to capture the entry index of the primitive
+          --  wrapper at position S.
+ 
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uI),
+              Object_Definition =>
+                New_Reference_To (Standard_Integer, Loc)));
+       end if;
+ 
+       --  Generate:
+       --    C := get_prim_op_kind (tag! (<type>VP), S);
+ 
+       --    if C = POK_Procedure
+       --      or else C = POK_Protected_Procedure
+       --      or else C = POK_Task_Procedure;
+       --    then
+       --       F := True;
+       --       return;
+       --    end if;
+ 
+       SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, DT_Ptr, Stmts);
+ 
+       if Present (Conc_Typ) then
+ 
+          --  Generate:
+          --    Bnn : Communication_Block;
+ 
+          --  where Bnn is the name of the communication block used in
+          --  the call to Protected_Entry_Call.
+ 
+          Blk_Nam := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
+ 
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                Blk_Nam,
+              Object_Definition =>
+                New_Reference_To (RTE (RE_Communication_Block), Loc)));
+ 
+          --  Generate:
+          --    I := get_entry_index (tag! (<type>VP), S);
+ 
+          --  I is the entry index and S is the dispatch table slot
+ 
+          Append_To (Stmts,
+            Make_Assignment_Statement (Loc,
+              Name =>
+                Make_Identifier (Loc, Name_uI),
+              Expression =>
+                Make_DT_Access_Action (Typ,
+                  Action =>
+                    Get_Entry_Index,
+                  Args =>
+                    New_List (
+                      Unchecked_Convert_To (RTE (RE_Tag),
+                        New_Reference_To (DT_Ptr, Loc)),
+                      Make_Identifier (Loc, Name_uS)))));
+ 
+          if Ekind (Conc_Typ) = E_Protected_Type then
+ 
+             --  Generate:
+             --    Protected_Entry_Call (
+             --      T._object'access,
+             --      protected_entry_index! (I),
+             --      P,
+             --      Conditional_Call,
+             --      Bnn);
+ 
+             --  where T is the protected object, I is the entry index, P are
+             --  the wrapped parameters and Bnn is the name of the communication
+             --  block.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Protected_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Attribute_Reference (Loc,        -- T._object'access
+                       Attribute_Name =>
+                         Name_Unchecked_Access,
+                       Prefix =>
+                         Make_Selected_Component (Loc,
+                           Prefix =>
+                             Make_Identifier (Loc, Name_uT),
+                           Selector_Name =>
+                             Make_Identifier (Loc, Name_uObject))),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     New_Reference_To (                    --  Conditional_Call
+                       RTE (RE_Conditional_Call), Loc),
+                     New_Reference_To (                    --  Bnn
+                       Blk_Nam, Loc))));
+ 
+             --  Generate:
+             --    F := not Cancelled (Bnn);
+ 
+             --  where F is the success flag. The status of Cancelled is negated
+             --  in order to match the behaviour of the version for task types.
+ 
+             Append_To (Stmts,
+               Make_Assignment_Statement (Loc,
+                 Name =>
+                   Make_Identifier (Loc, Name_uF),
+                 Expression =>
+                   Make_Op_Not (Loc,
+                     Right_Opnd =>
+                       Make_Function_Call (Loc,
+                         Name =>
+                           New_Reference_To (RTE (RE_Cancelled), Loc),
+                         Parameter_Associations =>
+                           New_List (
+                             New_Reference_To (Blk_Nam, Loc))))));
+          else
+             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
+ 
+             --  Generate:
+             --    Protected_Entry_Call (
+             --      T._task_id,
+             --      task_entry_index! (I),
+             --      P,
+             --      Conditional_Call,
+             --      F);
+ 
+             --  where T is the task object, I is the entry index, P are the
+             --  wrapped parameters and F is the status flag.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Task_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Selected_Component (Loc,         -- T._task_id
+                       Prefix =>
+                         Make_Identifier (Loc, Name_uT),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Name_uTask_Id)),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Task_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     New_Reference_To (                    --  Conditional_Call
+                       RTE (RE_Conditional_Call), Loc),
+                     Make_Identifier (Loc, Name_uF))));    --  status flag
+          end if;
+ 
+       --  Implementation for limited tagged types
+ 
+       else
+          Append_To (Stmts,
+            Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
+       end if;
+ 
+       return
+         Make_Subprogram_Body (Loc,
+           Specification =>
+             Make_Disp_Conditional_Select_Spec (Typ),
+           Declarations =>
+             Decls,
+           Handled_Statement_Sequence =>
+             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
+    end Make_Disp_Conditional_Select_Body;
+ 
+    ---------------------------------------
+    -- Make_Disp_Conditional_Select_Spec --
+    ---------------------------------------
+ 
+    function Make_Disp_Conditional_Select_Spec
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       Def_Id : constant Node_Id    :=
+                  Make_Defining_Identifier (Loc,
+                    Name_uDisp_Conditional_Select);
+       Params : constant List_Id    := New_List;
+ 
+    begin
+       --  "T" - Object parameter
+       --  "S" - Primitive operation slot
+       --  "P" - Wrapped parameters
+       --  "C" - Call kind
+       --  "F" - Status flag
+ 
+       SEU.Build_T (Loc, Typ, Params);
+       SEU.Build_S (Loc, Params);
+       SEU.Build_P (Loc, Params);
+       SEU.Build_C (Loc, Params);
+       SEU.Build_F (Loc, Params);
+ 
+       Set_Is_Internal (Def_Id);
+ 
+       return
+         Make_Procedure_Specification (Loc,
+           Defining_Unit_Name       => Def_Id,
+           Parameter_Specifications => Params);
+    end Make_Disp_Conditional_Select_Spec;
+ 
+    -------------------------------------
+    -- Make_Disp_Get_Prim_Op_Kind_Body --
+    -------------------------------------
+ 
+    function Make_Disp_Get_Prim_Op_Kind_Body
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       DT_Ptr : Entity_Id;
+ 
+    begin
+       if Is_Interface (Typ) then
+          return
+            Make_Subprogram_Body (Loc,
+              Specification =>
+                Make_Disp_Get_Prim_Op_Kind_Spec (Typ),
+              Declarations =>
+                New_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  New_List (Make_Null_Statement (Loc))));
+       end if;
+ 
+       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+ 
+       --  Generate:
+       --    C := get_prim_op_kind (tag! (<type>VP), S);
+ 
+       --  where C is the out parameter capturing the call kind and S is the
+       --  dispatch table slot number.
+ 
+       return
+         Make_Subprogram_Body (Loc,
+           Specification =>
+             Make_Disp_Get_Prim_Op_Kind_Spec (Typ),
+           Declarations =>
+             New_List,
+           Handled_Statement_Sequence =>
+             Make_Handled_Sequence_Of_Statements (Loc,
+               New_List (
+                 Make_Assignment_Statement (Loc,
+                   Name =>
+                     Make_Identifier (Loc, Name_uC),
+                   Expression =>
+                     Make_DT_Access_Action (Typ,
+                       Action =>
+                         Get_Prim_Op_Kind,
+                       Args =>
+                         New_List (
+                           Unchecked_Convert_To (RTE (RE_Tag),
+                             New_Reference_To (DT_Ptr, Loc)),
+                             Make_Identifier (Loc, Name_uS)))))));
+    end Make_Disp_Get_Prim_Op_Kind_Body;
+ 
+    -------------------------------------
+    -- Make_Disp_Get_Prim_Op_Kind_Spec --
+    -------------------------------------
+ 
+    function Make_Disp_Get_Prim_Op_Kind_Spec
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       Def_Id : constant Node_Id    :=
+                  Make_Defining_Identifier (Loc,
+                    Name_uDisp_Get_Prim_Op_Kind);
+       Params : constant List_Id    := New_List;
+ 
+    begin
+       --  "T" - Object parameter
+       --  "S" - Primitive operation slot
+       --  "C" - Call kind
+ 
+       SEU.Build_T (Loc, Typ, Params);
+       SEU.Build_S (Loc, Params);
+       SEU.Build_C (Loc, Params);
+ 
+       Set_Is_Internal (Def_Id);
+ 
+       return
+         Make_Procedure_Specification (Loc,
+            Defining_Unit_Name       => Def_Id,
+            Parameter_Specifications => Params);
+    end Make_Disp_Get_Prim_Op_Kind_Spec;
+ 
+    --------------------------------
+    -- Make_Disp_Get_Task_Id_Body --
+    --------------------------------
+ 
+    function Make_Disp_Get_Task_Id_Body
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc : constant Source_Ptr := Sloc (Typ);
+       Ret : Node_Id;
+ 
+    begin
+       if Is_Concurrent_Record_Type (Typ)
+         and then Ekind (Corresponding_Concurrent_Type (Typ)) = E_Task_Type
+       then
+          Ret :=
+            Make_Return_Statement (Loc,
+              Expression =>
+                Make_Selected_Component (Loc,
+                  Prefix =>
+                    Make_Identifier (Loc, Name_uT),
+                  Selector_Name =>
+                    Make_Identifier (Loc, Name_uTask_Id)));
+ 
+       --  A null body is constructed for non-task types
+ 
+       else
+          Ret :=
+            Make_Return_Statement (Loc,
+              Expression =>
+                New_Reference_To (RTE (RO_ST_Null_Task), Loc));
+       end if;
+ 
+       return
+         Make_Subprogram_Body (Loc,
+           Specification =>
+             Make_Disp_Get_Task_Id_Spec (Typ),
+           Declarations =>
+             New_List,
+           Handled_Statement_Sequence =>
+             Make_Handled_Sequence_Of_Statements (Loc,
+               New_List (Ret)));
+    end Make_Disp_Get_Task_Id_Body;
+ 
+    --------------------------------
+    -- Make_Disp_Get_Task_Id_Spec --
+    --------------------------------
+ 
+    function Make_Disp_Get_Task_Id_Spec
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       Def_Id : constant Node_Id    :=
+                  Make_Defining_Identifier (Loc,
+                    Name_uDisp_Get_Task_Id);
+ 
+    begin
+       Set_Is_Internal (Def_Id);
+ 
+       return
+         Make_Function_Specification (Loc,
+           Defining_Unit_Name       => Def_Id,
+           Parameter_Specifications => New_List (
+             Make_Parameter_Specification (Loc,
+               Defining_Identifier =>
+                 Make_Defining_Identifier (Loc, Name_uT),
+               Parameter_Type =>
+                 New_Reference_To (Typ, Loc))),
+           Result_Definition =>
+             New_Reference_To (RTE (RO_ST_Task_Id), Loc));
+    end Make_Disp_Get_Task_Id_Spec;
+ 
+    ---------------------------------
+    -- Make_Disp_Timed_Select_Body --
+    ---------------------------------
+ 
+    function Make_Disp_Timed_Select_Body
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc      : constant Source_Ptr := Sloc (Typ);
+       Conc_Typ : Entity_Id           := Empty;
+       Decls    : constant List_Id    := New_List;
+       DT_Ptr   : Entity_Id;
+       Stmts    : constant List_Id    := New_List;
+ 
+    begin
+       if Is_Interface (Typ) then
+          return
+            Make_Subprogram_Body (Loc,
+              Specification =>
+                Make_Disp_Timed_Select_Spec (Typ),
+              Declarations =>
+                New_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  New_List (Make_Null_Statement (Loc))));
+       end if;
+ 
+       if Is_Concurrent_Record_Type (Typ) then
+          Conc_Typ := Corresponding_Concurrent_Type (Typ);
+       end if;
+ 
+       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+ 
+       if Present (Conc_Typ) then
+ 
+          --  Generate:
+          --    I : Integer;
+ 
+          --  where I will be used to capture the entry index of the primitive
+          --  wrapper at position S.
+ 
+          Append_To (Decls,
+            Make_Object_Declaration (Loc,
+              Defining_Identifier =>
+                Make_Defining_Identifier (Loc, Name_uI),
+              Object_Definition =>
+                New_Reference_To (Standard_Integer, Loc)));
+       end if;
+ 
+       --  Generate:
+       --    C := get_prim_op_kind (tag! (<type>VP), S);
+ 
+       --    if C = POK_Procedure
+       --      or else C = POK_Protected_Procedure
+       --      or else C = POK_Task_Procedure;
+       --    then
+       --       F := True;
+       --       return;
+       --    end if;
+ 
+       SEU.Build_Common_Dispatching_Select_Statements (Loc, Typ, DT_Ptr, Stmts);
+ 
+       if Present (Conc_Typ) then
+ 
+          --  Generate:
+          --    I := get_entry_index (tag! (<type>VP), S);
+ 
+          --  I is the entry index and S is the dispatch table slot
+ 
+          Append_To (Stmts,
+            Make_Assignment_Statement (Loc,
+              Name =>
+                Make_Identifier (Loc, Name_uI),
+              Expression =>
+                Make_DT_Access_Action (Typ,
+                  Action =>
+                    Get_Entry_Index,
+                  Args =>
+                    New_List (
+                      Unchecked_Convert_To (RTE (RE_Tag),
+                        New_Reference_To (DT_Ptr, Loc)),
+                      Make_Identifier (Loc, Name_uS)))));
+ 
+          if Ekind (Conc_Typ) = E_Protected_Type then
+ 
+             --  Generate:
+             --    Timed_Protected_Entry_Call (
+             --      T._object'access,
+             --      protected_entry_index! (I),
+             --      P,
+             --      D,
+             --      M,
+             --      F);
+ 
+             --  where T is the protected object, I is the entry index, P are
+             --  the wrapped parameters, D is the delay amount, M is the delay
+             --  mode and F is the status flag.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Timed_Protected_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Attribute_Reference (Loc,        -- T._object'access
+                       Attribute_Name =>
+                         Name_Unchecked_Access,
+                       Prefix =>
+                         Make_Selected_Component (Loc,
+                           Prefix =>
+                             Make_Identifier (Loc, Name_uT),
+                           Selector_Name =>
+                             Make_Identifier (Loc, Name_uObject))),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Protected_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     Make_Identifier (Loc, Name_uD),       --  delay
+                     Make_Identifier (Loc, Name_uM),       --  delay mode
+                     Make_Identifier (Loc, Name_uF))));    --  status flag
+ 
+          else
+             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
+ 
+             --  Generate:
+             --    Timed_Task_Entry_Call (
+             --      T._task_id,
+             --      task_entry_index! (I),
+             --      P,
+             --      D,
+             --      M,
+             --      F);
+ 
+             --  where T is the task object, I is the entry index, P are the
+             --  wrapped parameters, D is the delay amount, M is the delay
+             --  mode and F is the status flag.
+ 
+             Append_To (Stmts,
+               Make_Procedure_Call_Statement (Loc,
+                 Name =>
+                   New_Reference_To (RTE (RE_Timed_Task_Entry_Call), Loc),
+                 Parameter_Associations =>
+                   New_List (
+ 
+                     Make_Selected_Component (Loc,         --  T._task_id
+                       Prefix =>
+                         Make_Identifier (Loc, Name_uT),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Name_uTask_Id)),
+ 
+                     Make_Unchecked_Type_Conversion (Loc,  --  entry index
+                       Subtype_Mark =>
+                         New_Reference_To (RTE (RE_Task_Entry_Index), Loc),
+                       Expression =>
+                         Make_Identifier (Loc, Name_uI)),
+ 
+                     Make_Identifier (Loc, Name_uP),       --  parameter block
+                     Make_Identifier (Loc, Name_uD),       --  delay
+                     Make_Identifier (Loc, Name_uM),       --  delay mode
+                     Make_Identifier (Loc, Name_uF))));    --  status flag
+          end if;
+ 
+       --  Implementation for limited tagged types
+ 
+       else
+          Append_To (Stmts,
+            Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
+       end if;
+ 
+       return
+         Make_Subprogram_Body (Loc,
+           Specification =>
+             Make_Disp_Timed_Select_Spec (Typ),
+           Declarations =>
+             Decls,
+           Handled_Statement_Sequence =>
+             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
+    end Make_Disp_Timed_Select_Body;
+ 
+    ---------------------------------
+    -- Make_Disp_Timed_Select_Spec --
+    ---------------------------------
+ 
+    function Make_Disp_Timed_Select_Spec
+      (Typ : Entity_Id) return Node_Id
+    is
+       Loc    : constant Source_Ptr := Sloc (Typ);
+       Def_Id : constant Node_Id    :=
+                  Make_Defining_Identifier (Loc,
+                    Name_uDisp_Timed_Select);
+       Params : constant List_Id    := New_List;
+ 
+    begin
+       --  "T" - Object parameter
+       --  "S" - Primitive operation slot
+       --  "P" - Wrapped parameters
+       --  "D" - Delay
+       --  "M" - Delay Mode
+       --  "C" - Call kind
+       --  "F" - Status flag
+ 
+       SEU.Build_T (Loc, Typ, Params);
+       SEU.Build_S (Loc, Params);
+       SEU.Build_P (Loc, Params);
+ 
+       Append_To (Params,
+         Make_Parameter_Specification (Loc,
+           Defining_Identifier =>
+             Make_Defining_Identifier (Loc, Name_uD),
+           Parameter_Type =>
+             New_Reference_To (Standard_Duration, Loc)));
+ 
+       Append_To (Params,
+         Make_Parameter_Specification (Loc,
+           Defining_Identifier =>
+             Make_Defining_Identifier (Loc, Name_uM),
+           Parameter_Type =>
+             New_Reference_To (Standard_Integer, Loc)));
+ 
+       SEU.Build_C (Loc, Params);
+       SEU.Build_F (Loc, Params);
+ 
+       Set_Is_Internal (Def_Id);
+ 
+       return
+         Make_Procedure_Specification (Loc,
+           Defining_Unit_Name       => Def_Id,
+           Parameter_Specifications => Params);
+    end Make_Disp_Timed_Select_Spec;
+ 
     -------------
     -- Make_DT --
     -------------
  
     function Make_DT (Typ : Entity_Id) return List_Id is
!       Loc         : constant Source_Ptr := Sloc (Typ);
!       Result      : constant List_Id    := New_List;
!       Elab_Code   : constant List_Id    := New_List;
  
        Tname       : constant Name_Id := Chars (Typ);
        Name_DT     : constant Name_Id := New_External_Name (Tname, 'T');
        Name_DT_Ptr : constant Name_Id := New_External_Name (Tname, 'P');
+       Name_SSD    : constant Name_Id := New_External_Name (Tname, 'S');
        Name_TSD    : constant Name_Id := New_External_Name (Tname, 'B');
        Name_Exname : constant Name_Id := New_External_Name (Tname, 'E');
        Name_No_Reg : constant Name_Id := New_External_Name (Tname, 'F');
  
        DT     : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT);
        DT_Ptr : constant Node_Id := Make_Defining_Identifier (Loc, Name_DT_Ptr);
+       SSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_SSD);
        TSD    : constant Node_Id := Make_Defining_Identifier (Loc, Name_TSD);
        Exname : constant Node_Id := Make_Defining_Identifier (Loc, Name_Exname);
        No_Reg : constant Node_Id := Make_Defining_Identifier (Loc, Name_No_Reg);
  
+       Generalized_Tag : constant Entity_Id := RTE (RE_Tag);
        I_Depth         : Int;
        Size_Expr_Node  : Node_Id;
!       Old_Tag1        : Node_Id;
!       Old_Tag2        : Node_Id;
!       Num_Ifaces      : Int;
!       Nb_Prim         : Int;
!       TSD_Num_Entries : Int;
!       Typ_Copy        : constant Entity_Id := New_Copy (Typ);
!       AI              : Elmt_Id;
  
     begin
        if not RTE_Available (RE_Tag) then
*************** package body Exp_Disp is
*** 647,656 ****
           return New_List;
        end if;
  
!       if Is_CPP_Class (Root_Type (Typ)) then
!          Generalized_Tag := RTE (RE_Vtable_Ptr);
        else
!          Generalized_Tag := RTE (RE_Tag);
        end if;
  
        --  Dispatch table and related entities are allocated statically
--- 2579,2645 ----
           return New_List;
        end if;
  
!       --  Collect full list of directly and indirectly implemented interfaces
! 
!       Set_Parent              (Typ_Copy, Parent (Typ));
!       Set_Abstract_Interfaces (Typ_Copy, New_Elmt_List);
!       Collect_All_Interfaces  (Typ_Copy);
! 
!       --  Calculate the size of the DT and the TSD
! 
!       if Is_Interface (Typ) then
!          --  Abstract interfaces need neither the DT nor the ancestors table.
!          --  We reserve a single entry for its DT because at run-time the
!          --  pointer to this dummy DT is the tag of this abstract interface
!          --  type.
! 
!          Nb_Prim         := 1;
!          TSD_Num_Entries := 0;
! 
        else
!          --  Calculate the number of entries for the table of interfaces
! 
!          Num_Ifaces := 0;
!          AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
!          while Present (AI) loop
!             Num_Ifaces := Num_Ifaces + 1;
!             Next_Elmt (AI);
!          end loop;
! 
!          --  Count ancestors to compute the inheritance depth. For private
!          --  extensions, always go to the full view in order to compute the
!          --  real inheritance depth.
! 
!          declare
!             Parent_Type : Entity_Id := Typ;
!             P           : Entity_Id;
! 
!          begin
!             I_Depth := 0;
!             loop
!                P := Etype (Parent_Type);
! 
!                if Is_Private_Type (P) then
!                   P := Full_View (Base_Type (P));
!                end if;
! 
!                exit when P = Parent_Type;
! 
!                I_Depth := I_Depth + 1;
!                Parent_Type := P;
!             end loop;
!          end;
! 
!          TSD_Num_Entries := I_Depth + Num_Ifaces + 1;
!          Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ)));
! 
!          --  If the number of primitives of Typ is less that the number of
!          --  predefined primitives, we must reserve at least enough space
!          --  for the predefined primitives.
! 
!          if Nb_Prim < Default_Prim_Op_Count then
!             Nb_Prim := Default_Prim_Op_Count;
!          end if;
        end if;
  
        --  Dispatch table and related entities are allocated statically
*************** package body Exp_Disp is
*** 661,666 ****
--- 2650,2658 ----
        Set_Ekind (DT_Ptr, E_Variable);
        Set_Is_Statically_Allocated (DT_Ptr);
  
+       Set_Ekind (SSD, E_Variable);
+       Set_Is_Statically_Allocated (SSD);
+ 
        Set_Ekind (TSD, E_Variable);
        Set_Is_Statically_Allocated (TSD);
  
*************** package body Exp_Disp is
*** 683,690 ****
                Left_Opnd  =>
                  Make_DT_Access_Action (Typ, DT_Entry_Size, No_List),
                Right_Opnd =>
!                 Make_Integer_Literal (Loc,
!                   DT_Entry_Count (Tag_Component (Typ)))));
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
--- 2675,2681 ----
                Left_Opnd  =>
                  Make_DT_Access_Action (Typ, DT_Entry_Size, No_List),
                Right_Opnd =>
!                 Make_Integer_Literal (Loc, Nb_Prim)));
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
*************** package body Exp_Disp is
*** 692,698 ****
            Aliased_Present     => True,
            Object_Definition   =>
              Make_Subtype_Indication (Loc,
!               Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
                Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
                  Constraints => New_List (
                    Make_Range (Loc,
--- 2683,2690 ----
            Aliased_Present     => True,
            Object_Definition   =>
              Make_Subtype_Indication (Loc,
!               Subtype_Mark => New_Reference_To
!                                 (RTE (RE_Storage_Array), Loc),
                Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
                  Constraints => New_List (
                    Make_Range (Loc,
*************** package body Exp_Disp is
*** 708,723 ****
                Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
                Attribute_Name => Name_Alignment)));
  
        --  Generate code to create the pointer to the dispatch table
  
!       --    DT_Ptr : Tag := Tag!(DT'Address);                 Ada case
!       --  or
!       --    DT_Ptr : Vtable_Ptr := Vtable_Ptr!(DT'Address);   CPP case
  
!       --  According to the C++ ABI, the base of the vtable is located
!       --  after the following prologue: Offset_To_Top, Typeinfo_Ptr.
!       --  Hence, move the pointer to the base of the vtable down, after
!       --  this prologue.
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
--- 2700,2758 ----
                Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
                Attribute_Name => Name_Alignment)));
  
+       --  Initialize the signature of the interface tag. It is a sequence
+       --  two bytes located in the header of the dispatch table.
+ 
+       Append_To (Result,
+         Make_Assignment_Statement (Loc,
+           Name =>
+             Make_Indexed_Component (Loc,
+               Prefix => New_Occurrence_Of (DT, Loc),
+               Expressions => New_List (
+                 Make_Integer_Literal (Loc, Uint_1))),
+           Expression =>
+             Unchecked_Convert_To (RTE (RE_Storage_Element),
+               New_Reference_To (RTE (RE_Valid_Signature), Loc))));
+ 
+       if not Is_Interface (Typ) then
+ 
+          --  The signature of a Primary Dispatch table is:
+          --    (Valid_Signature, Primary_DT)
+ 
+          Append_To (Result,
+            Make_Assignment_Statement (Loc,
+              Name =>
+                Make_Indexed_Component (Loc,
+                  Prefix => New_Occurrence_Of (DT, Loc),
+                  Expressions => New_List (
+                    Make_Integer_Literal (Loc, Uint_2))),
+              Expression =>
+                Unchecked_Convert_To (RTE (RE_Storage_Element),
+                  New_Reference_To (RTE (RE_Primary_DT), Loc))));
+ 
+       else
+          --  The signature of an abstract interface is:
+          --    (Valid_Signature, Abstract_Interface)
+ 
+          Append_To (Result,
+            Make_Assignment_Statement (Loc,
+              Name =>
+                Make_Indexed_Component (Loc,
+                  Prefix => New_Occurrence_Of (DT, Loc),
+                  Expressions => New_List (
+                    Make_Integer_Literal (Loc, Uint_2))),
+              Expression =>
+                Unchecked_Convert_To (RTE (RE_Storage_Element),
+                  New_Reference_To (RTE (RE_Abstract_Interface), Loc))));
+       end if;
+ 
        --  Generate code to create the pointer to the dispatch table
  
!       --    DT_Ptr : Tag := Tag!(DT'Address);
  
!       --  According to the C++ ABI, the base of the vtable is located after a
!       --  prologue containing Offset_To_Top, and Typeinfo_Ptr. Hence, we move
!       --  down the pointer to the real base of the vtable
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
*************** package body Exp_Disp is
*** 738,744 ****
  
        --  Generate code to define the boolean that controls registration, in
        --  order to avoid multiple registrations for tagged types defined in
!       --  multiple-called scopes
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
--- 2773,2779 ----
  
        --  Generate code to define the boolean that controls registration, in
        --  order to avoid multiple registrations for tagged types defined in
!       --  multiple-called scopes.
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
*************** package body Exp_Disp is
*** 748,783 ****
  
        --  Set Access_Disp_Table field to be the dispatch table pointer
  
!       Set_Access_Disp_Table (Typ, DT_Ptr);
! 
!       --  Count ancestors to compute the inheritance depth. For private
!       --  extensions, always go to the full view in order to compute the real
!       --  inheritance depth.
! 
!       declare
!          Parent_Type : Entity_Id := Typ;
!          P           : Entity_Id;
! 
!       begin
!          I_Depth := 0;
! 
!          loop
!             P := Etype (Parent_Type);
! 
!             if Is_Private_Type (P) then
!                P := Full_View (Base_Type (P));
!             end if;
! 
!             exit when P = Parent_Type;
  
!             I_Depth := I_Depth + 1;
!             Parent_Type := P;
!          end loop;
!       end;
  
        --  Generate code to create the storage for the type specific data object
  
!       --   TSD: Storage_Array (1..TSD_Prologue_Size+(1+Idepth)*TSD_Entry_Size);
        --   for TSD'Alignment use Address'Alignment
  
        Size_Expr_Node :=
--- 2783,2800 ----
  
        --  Set Access_Disp_Table field to be the dispatch table pointer
  
!       if not Present (Access_Disp_Table (Typ)) then
!          Set_Access_Disp_Table (Typ, New_Elmt_List);
!       end if;
  
!       Prepend_Elmt (DT_Ptr, Access_Disp_Table (Typ));
  
        --  Generate code to create the storage for the type specific data object
+       --  with enough space to store the tags of the ancestors plus the tags
+       --  of all the implemented interfaces (as described in a-tags.adb).
  
!       --   TSD: Storage_Array
!       --     (1..TSD_Prologue_Size+TSD_Num_Entries*TSD_Entry_Size);
        --   for TSD'Alignment use Address'Alignment
  
        Size_Expr_Node :=
*************** package body Exp_Disp is
*** 789,798 ****
                Left_Opnd  =>
                  Make_DT_Access_Action (Typ, TSD_Entry_Size, No_List),
                Right_Opnd =>
!                 Make_Op_Add (Loc,
!                   Left_Opnd  => Make_Integer_Literal (Loc, 1),
!                   Right_Opnd =>
!                     Make_Integer_Literal (Loc, I_Depth))));
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
--- 2806,2812 ----
                Left_Opnd  =>
                  Make_DT_Access_Action (Typ, TSD_Entry_Size, No_List),
                Right_Opnd =>
!                 Make_Integer_Literal (Loc, TSD_Num_Entries)));
  
        Append_To (Result,
          Make_Object_Declaration (Loc,
*************** package body Exp_Disp is
*** 825,872 ****
            Args   => New_List (
              New_Reference_To (DT_Ptr, Loc),                  -- DTptr
                Make_Attribute_Reference (Loc,                 -- Value
!               Prefix          => New_Reference_To (TSD, Loc),
!               Attribute_Name  => Name_Address))));
! 
!       if Typ = Etype (Typ)
!         or else Is_CPP_Class (Etype (Typ))
!       then
!          Old_Tag :=
!            Unchecked_Convert_To (Generalized_Tag,
!              Make_Integer_Literal (Loc, 0));
  
!          Old_TSD :=
!            Unchecked_Convert_To (RTE (RE_Address),
!              Make_Integer_Literal (Loc, 0));
  
!       else
!          Old_Tag := New_Reference_To (Access_Disp_Table (Etype (Typ)), Loc);
!          Old_TSD :=
!            Make_DT_Access_Action (Typ,
!              Action => Get_TSD,
!              Args   => New_List (
!                New_Reference_To (Access_Disp_Table (Etype (Typ)), Loc)));
        end if;
  
!       --  Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
  
!       Append_To (Elab_Code,
!         Make_DT_Access_Action (Typ,
!           Action => Inherit_DT,
!           Args   => New_List (
!             Node1 => Old_Tag,
!             Node2 => New_Reference_To (DT_Ptr, Loc),
!             Node3 => Make_Integer_Literal (Loc,
!                        DT_Entry_Count (Tag_Component (Etype (Typ)))))));
  
!       --  Generate: Inherit_TSD (Get_TSD (parent), DT_Ptr);
  
!       Append_To (Elab_Code,
!         Make_DT_Access_Action (Typ,
!           Action => Inherit_TSD,
!           Args   => New_List (
!             Node1 => Old_TSD,
!             Node2 => New_Reference_To (DT_Ptr, Loc))));
  
        --  Generate: Exname : constant String := full_qualified_name (typ);
        --  The type itself may be an anonymous parent type, so use the first
--- 2839,2897 ----
            Args   => New_List (
              New_Reference_To (DT_Ptr, Loc),                  -- DTptr
                Make_Attribute_Reference (Loc,                 -- Value
!                 Prefix          => New_Reference_To (TSD, Loc),
!                 Attribute_Name  => Name_Address))));
  
!       --  Generate:
!       --    Set_Num_Prim_Ops (T'Tag, Nb_Prim)
  
!       if not Is_Interface (Typ) then
!          Append_To (Elab_Code,
!            Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
!              Parameter_Associations => New_List (
!                New_Reference_To (DT_Ptr, Loc),
!                Make_Integer_Literal (Loc, Nb_Prim))));
        end if;
  
!       if Ada_Version >= Ada_05
!         and then not Is_Interface  (Typ)
!         and then not Is_Abstract   (Typ)
!         and then not Is_Controlled (Typ)
!         and then Implements_Interface (
!           Typ  => Typ,
!           Kind => Any_Limited_Interface,
!           Check_Parent => True)
!         and then (Nb_Prim - Default_Prim_Op_Count) > 0
!       then
!          --  Generate the Select Specific Data table for tagged types that
!          --  implement a synchronized interface. The size of the table is
!          --  constrained by the number of non-predefined primitive operations.
  
!          Append_To (Result,
!            Make_Object_Declaration (Loc,
!              Defining_Identifier => SSD,
!              Aliased_Present     => True,
!              Object_Definition   =>
!                Make_Subtype_Indication (Loc,
!                  Subtype_Mark => New_Reference_To (
!                    RTE (RE_Select_Specific_Data), Loc),
!                  Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
!                    Constraints => New_List (
!                      Make_Integer_Literal (Loc,
!                        Nb_Prim - Default_Prim_Op_Count))))));
  
!          --  Set the pointer to the Select Specific Data table in the TSD
  
!          Append_To (Elab_Code,
!            Make_DT_Access_Action (Typ,
!              Action => Set_SSD,
!              Args   => New_List (
!                New_Reference_To (DT_Ptr, Loc),               -- DTptr
!                Make_Attribute_Reference (Loc,                -- Value
!                  Prefix         => New_Reference_To (SSD, Loc),
!                  Attribute_Name => Name_Address))));
!       end if;
  
        --  Generate: Exname : constant String := full_qualified_name (typ);
        --  The type itself may be an anonymous parent type, so use the first
*************** package body Exp_Disp is
*** 893,979 ****
                  Prefix => New_Reference_To (Exname, Loc),
                  Attribute_Name => Name_Address))));
  
!       --  for types with no controlled components
!       --    Generate: Set_RC_Offset (DT_Ptr, 0);
!       --  for simple types with controlled components
!       --    Generate: Set_RC_Offset (DT_Ptr, type._record_controller'position);
!       --  for complex types with controlled components where the position
        --  of the record controller is not statically computable, if there are
!       --  controlled components at this level
!       --    Generate: Set_RC_Offset (DT_Ptr, -1);
!       --  to indicate that the _controller field is right after the _parent or
!       --  if there are no controlled components at this level,
!       --    Generate: Set_RC_Offset (DT_Ptr, -2);
        --  to indicate that we need to get the position from the parent.
  
!       declare
!          Position : Node_Id;
  
!       begin
!          if not Has_Controlled_Component (Typ) then
!             Position := Make_Integer_Literal (Loc, 0);
  
!          elsif Etype (Typ) /= Typ and then Has_Discriminants (Etype (Typ)) then
!             if Has_New_Controlled_Component (Typ) then
!                Position := Make_Integer_Literal (Loc, -1);
              else
!                Position := Make_Integer_Literal (Loc, -2);
              end if;
-          else
-             Position :=
-               Make_Attribute_Reference (Loc,
-                 Prefix =>
-                   Make_Selected_Component (Loc,
-                     Prefix => New_Reference_To (Typ, Loc),
-                     Selector_Name =>
-                       New_Reference_To (Controller_Component (Typ), Loc)),
-                 Attribute_Name => Name_Position);
  
!             --  This is not proper Ada code to use the attribute 'Position
!             --  on something else than an object but this is supported by
!             --  the back end (see comment on the Bit_Component attribute in
!             --  sem_attr). So we avoid semantic checking here.
  
!             Set_Analyzed (Position);
!             Set_Etype (Prefix (Position), RTE (RE_Record_Controller));
!             Set_Etype (Prefix (Prefix (Position)), Typ);
!             Set_Etype (Selector_Name (Prefix (Position)),
!               RTE (RE_Record_Controller));
!             Set_Etype (Position, RTE (RE_Storage_Offset));
!          end if;
  
!          Append_To (Elab_Code,
!            Make_DT_Access_Action (Typ,
!              Action => Set_RC_Offset,
!              Args   => New_List (
!                Node1 => New_Reference_To (DT_Ptr, Loc),
!                Node2 => Position)));
!       end;
  
!       --  Generate: Set_Remotely_Callable (DT_Ptr, Status);
!       --  where Status is described in E.4 (18)
  
!       declare
!          Status : Entity_Id;
  
!       begin
!          Status :=
!            Boolean_Literals
!              (Is_Pure (Typ)
!                 or else Is_Shared_Passive (Typ)
!                 or else
!                   ((Is_Remote_Types (Typ)
!                       or else Is_Remote_Call_Interface (Typ))
!                    and then Original_View_In_Visible_Part (Typ))
!                 or else not Comes_From_Source (Typ));
  
           Append_To (Elab_Code,
!            Make_DT_Access_Action (Typ,
!              Action => Set_Remotely_Callable,
!              Args   => New_List (
!                New_Occurrence_Of (DT_Ptr, Loc),
!                New_Occurrence_Of (Status, Loc))));
!       end;
  
        --  Generate: Set_External_Tag (DT_Ptr, exname'Address);
        --  Should be the external name not the qualified name???
--- 2918,3172 ----
                  Prefix => New_Reference_To (Exname, Loc),
                  Attribute_Name => Name_Address))));
  
!       if not Is_Interface (Typ) then
!          --  Generate: Set_Access_Level (DT_Ptr, <type's accessibility level>);
! 
!          Append_To (Elab_Code,
!            Make_DT_Access_Action (Typ,
!              Action => Set_Access_Level,
!              Args   => New_List (
!                Node1 => New_Reference_To (DT_Ptr, Loc),
!                Node2 => Make_Integer_Literal (Loc, Type_Access_Level (Typ)))));
!       end if;
! 
!       if Typ = Etype (Typ)
!         or else Is_CPP_Class (Etype (Typ))
!         or else Is_Interface (Typ)
!       then
!          Old_Tag1 :=
!            Unchecked_Convert_To (Generalized_Tag,
!              Make_Integer_Literal (Loc, 0));
!          Old_Tag2 :=
!            Unchecked_Convert_To (Generalized_Tag,
!              Make_Integer_Literal (Loc, 0));
! 
!       else
!          Old_Tag1 :=
!            New_Reference_To
!              (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
!          Old_Tag2 :=
!            New_Reference_To
!              (Node (First_Elmt (Access_Disp_Table (Etype (Typ)))), Loc);
!       end if;
! 
!       if Typ /= Etype (Typ)
!         and then not Is_Interface (Typ)
!       then
!          --  Generate: Inherit_DT (parent'tag, DT_Ptr, nb_prim of parent);
! 
!          if not Is_Interface (Etype (Typ)) then
!             Append_To (Elab_Code,
!               Make_DT_Access_Action (Typ,
!                 Action => Inherit_DT,
!                 Args   => New_List (
!                   Node1 => Old_Tag1,
!                   Node2 => New_Reference_To (DT_Ptr, Loc),
!                   Node3 =>
!                     Make_Integer_Literal (Loc,
!                       DT_Entry_Count (First_Tag_Component (Etype (Typ)))))));
!          end if;
! 
!          --  Inherit the secondary dispatch tables of the ancestor
! 
!          if not Is_CPP_Class (Etype (Typ)) then
!             declare
!                Sec_DT_Ancestor : Elmt_Id :=
!                                    Next_Elmt
!                                      (First_Elmt
!                                         (Access_Disp_Table (Etype (Typ))));
!                Sec_DT_Typ      : Elmt_Id :=
!                                    Next_Elmt
!                                      (First_Elmt
!                                         (Access_Disp_Table (Typ)));
! 
!                procedure Copy_Secondary_DTs (Typ : Entity_Id);
!                --  Local procedure required to climb through the ancestors and
!                --  copy the contents of all their secondary dispatch tables.
! 
!                ------------------------
!                -- Copy_Secondary_DTs --
!                ------------------------
! 
!                procedure Copy_Secondary_DTs (Typ : Entity_Id) is
!                   E              : Entity_Id;
!                   Iface          : Elmt_Id;
! 
!                begin
!                   --  Climb to the ancestor (if any) handling private types
! 
!                   if Present (Full_View (Etype (Typ))) then
!                      if Full_View (Etype (Typ)) /= Typ then
!                         Copy_Secondary_DTs (Full_View (Etype (Typ)));
!                      end if;
! 
!                   elsif Etype (Typ) /= Typ then
!                      Copy_Secondary_DTs (Etype (Typ));
!                   end if;
! 
!                   if Present (Abstract_Interfaces (Typ))
!                     and then not Is_Empty_Elmt_List
!                                    (Abstract_Interfaces (Typ))
!                   then
!                      Iface := First_Elmt (Abstract_Interfaces (Typ));
!                      E     := First_Entity (Typ);
! 
!                      while Present (E)
!                        and then Present (Node (Sec_DT_Ancestor))
!                      loop
!                         if Is_Tag (E) and then Chars (E) /= Name_uTag then
!                            if not Is_Interface (Etype (Typ)) then
!                               Append_To (Elab_Code,
!                                 Make_DT_Access_Action (Typ,
!                                   Action => Inherit_DT,
!                                   Args   => New_List (
!                                     Node1 => Unchecked_Convert_To
!                                                (RTE (RE_Tag),
!                                                 New_Reference_To
!                                                   (Node (Sec_DT_Ancestor),
!                                                    Loc)),
!                                     Node2 => Unchecked_Convert_To
!                                                (RTE (RE_Tag),
!                                                 New_Reference_To
!                                                   (Node (Sec_DT_Typ), Loc)),
!                                     Node3 => Make_Integer_Literal (Loc,
!                                                DT_Entry_Count (E)))));
!                            end if;
! 
!                            Next_Elmt (Sec_DT_Ancestor);
!                            Next_Elmt (Sec_DT_Typ);
!                            Next_Elmt (Iface);
!                         end if;
! 
!                         Next_Entity (E);
!                      end loop;
!                   end if;
!                end Copy_Secondary_DTs;
! 
!             begin
!                if Present (Node (Sec_DT_Ancestor)) then
! 
!                   --  Handle private types
! 
!                   if Present (Full_View (Typ)) then
!                      Copy_Secondary_DTs (Full_View (Typ));
!                   else
!                      Copy_Secondary_DTs (Typ);
!                   end if;
!                end if;
!             end;
!          end if;
!       end if;
! 
!       --  Generate:
!       --    Inherit_TSD (parent'tag, DT_Ptr);
! 
!       Append_To (Elab_Code,
!         Make_DT_Access_Action (Typ,
!           Action => Inherit_TSD,
!           Args   => New_List (
!             Node1 => Old_Tag2,
!             Node2 => New_Reference_To (DT_Ptr, Loc))));
! 
!       --  For types with no controlled components, generate:
!       --    Set_RC_Offset (DT_Ptr, 0);
! 
!       --  For simple types with controlled components, generate:
!       --    Set_RC_Offset (DT_Ptr, type._record_controller'position);
! 
!       --  For complex types with controlled components where the position
        --  of the record controller is not statically computable, if there are
!       --  controlled components at this level, generate:
!       --    Set_RC_Offset (DT_Ptr, -1);
!       --  to indicate that the _controller field is right after the _parent
! 
!       --  Or if there are no controlled components at this level, generate:
!       --    Set_RC_Offset (DT_Ptr, -2);
        --  to indicate that we need to get the position from the parent.
  
!       if not Is_Interface (Typ) then
!          declare
!             Position : Node_Id;
  
!          begin
!             if not Has_Controlled_Component (Typ) then
!                Position := Make_Integer_Literal (Loc, 0);
  
!             elsif Etype (Typ) /= Typ
!               and then Has_Discriminants (Etype (Typ))
!             then
!                if Has_New_Controlled_Component (Typ) then
!                   Position := Make_Integer_Literal (Loc, -1);
!                else
!                   Position := Make_Integer_Literal (Loc, -2);
!                end if;
              else
!                Position :=
!                  Make_Attribute_Reference (Loc,
!                    Prefix =>
!                      Make_Selected_Component (Loc,
!                        Prefix => New_Reference_To (Typ, Loc),
!                        Selector_Name =>
!                          New_Reference_To (Controller_Component (Typ), Loc)),
!                    Attribute_Name => Name_Position);
! 
!                --  This is not proper Ada code to use the attribute 'Position
!                --  on something else than an object but this is supported by
!                --  the back end (see comment on the Bit_Component attribute in
!                --  sem_attr). So we avoid semantic checking here.
! 
!                --  Is this documented in sinfo.ads??? it should be!
! 
!                Set_Analyzed (Position);
!                Set_Etype (Prefix (Position), RTE (RE_Record_Controller));
!                Set_Etype (Prefix (Prefix (Position)), Typ);
!                Set_Etype (Selector_Name (Prefix (Position)),
!                  RTE (RE_Record_Controller));
!                Set_Etype (Position, RTE (RE_Storage_Offset));
              end if;
  
!             Append_To (Elab_Code,
!               Make_DT_Access_Action (Typ,
!                 Action => Set_RC_Offset,
!                 Args   => New_List (
!                   Node1 => New_Reference_To (DT_Ptr, Loc),
!                   Node2 => Position)));
!          end;
  
!          --  Generate: Set_Remotely_Callable (DT_Ptr, Status); where Status is
!          --  described in E.4 (18)
  
!          declare
!             Status : Entity_Id;
  
!          begin
!             Status :=
!               Boolean_Literals
!                 (Is_Pure (Typ)
!                    or else Is_Shared_Passive (Typ)
!                    or else
!                      ((Is_Remote_Types (Typ)
!                          or else Is_Remote_Call_Interface (Typ))
!                       and then Original_View_In_Visible_Part (Typ))
!                    or else not Comes_From_Source (Typ));
  
!             Append_To (Elab_Code,
!               Make_DT_Access_Action (Typ,
!                 Action => Set_Remotely_Callable,
!                 Args   => New_List (
!                   New_Occurrence_Of (DT_Ptr, Loc),
!                   New_Occurrence_Of (Status, Loc))));
!          end;
  
!          --  Generate:
!          --    Set_Offset_To_Top (DT_Ptr, 0);
  
           Append_To (Elab_Code,
!            Make_Procedure_Call_Statement (Loc,
!              Name => New_Reference_To (RTE (RE_Set_Offset_To_Top), Loc),
!              Parameter_Associations => New_List (
!                New_Reference_To (DT_Ptr, Loc),
!                Make_Integer_Literal (Loc, Uint_0))));
!       end if;
  
        --  Generate: Set_External_Tag (DT_Ptr, exname'Address);
        --  Should be the external name not the qualified name???
*************** package body Exp_Disp is
*** 995,1004 ****
        --        Register_Tag (Dt_Ptr);
  
        --  Skip this if routine not available, or in No_Run_Time mode
  
!          if RTE_Available (RE_Register_Tag)
             and then Is_RTE (Generalized_Tag, RE_Tag)
!            and then not No_Run_Time_Mode
           then
              Append_To (Elab_Code,
                Make_Procedure_Call_Statement (Loc,
--- 3188,3201 ----
        --        Register_Tag (Dt_Ptr);
  
        --  Skip this if routine not available, or in No_Run_Time mode
+       --  or Typ is an abstract interface type (because the table to
+       --  register it is not available in the abstract type but in
+       --  types implementing this interface)
  
!          if not No_Run_Time_Mode
!            and then RTE_Available (RE_Register_Tag)
             and then Is_RTE (Generalized_Tag, RE_Tag)
!            and then not Is_Interface (Typ)
           then
              Append_To (Elab_Code,
                Make_Procedure_Call_Statement (Loc,
*************** package body Exp_Disp is
*** 1024,1029 ****
--- 3221,3254 ----
            Condition       => New_Reference_To (No_Reg, Loc),
            Then_Statements => Elab_Code));
  
+       --  Ada 2005 (AI-251): Register the tag of the interfaces into
+       --  the table of implemented interfaces and ...
+ 
+       if not Is_Interface (Typ)
+         and then Present (Abstract_Interfaces (Typ_Copy))
+         and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ_Copy))
+       then
+          AI := First_Elmt (Abstract_Interfaces (Typ_Copy));
+          while Present (AI) loop
+ 
+             --  Generate:
+             --    Register_Interface (DT_Ptr, Interface'Tag);
+ 
+             Append_To (Result,
+               Make_DT_Access_Action (Typ,
+                 Action => Register_Interface_Tag,
+                 Args   => New_List (
+                   Node1 => New_Reference_To (DT_Ptr, Loc),
+                   Node2 => New_Reference_To
+                              (Node
+                               (First_Elmt
+                                (Access_Disp_Table (Node (AI)))),
+                               Loc))));
+ 
+             Next_Elmt (AI);
+          end loop;
+       end if;
+ 
        return Result;
     end Make_DT;
  
*************** package body Exp_Disp is
*** 1034,1052 ****
     function Make_DT_Access_Action
       (Typ    : Entity_Id;
        Action : DT_Access_Action;
!       Args   : List_Id)
!       return Node_Id
     is
!       Action_Name : Entity_Id;
        Loc         : Source_Ptr;
  
     begin
-       if Is_CPP_Class (Root_Type (Typ)) then
-          Action_Name := RTE (CPP_Actions (Action));
-       else
-          Action_Name := RTE (Ada_Actions (Action));
-       end if;
- 
        if No (Args) then
  
           --  This is a constant
--- 3259,3270 ----
     function Make_DT_Access_Action
       (Typ    : Entity_Id;
        Action : DT_Access_Action;
!       Args   : List_Id) return Node_Id
     is
!       Action_Name : constant Entity_Id := RTE (Ada_Actions (Action));
        Loc         : Source_Ptr;
  
     begin
        if No (Args) then
  
           --  This is a constant
*************** package body Exp_Disp is
*** 1072,1077 ****
--- 3290,3718 ----
        end if;
     end Make_DT_Access_Action;
  
+    -----------------------
+    -- Make_Secondary_DT --
+    -----------------------
+ 
+    procedure Make_Secondary_DT
+      (Typ             : Entity_Id;
+       Ancestor_Typ    : Entity_Id;
+       Suffix_Index    : Int;
+       Iface           : Entity_Id;
+       AI_Tag          : Entity_Id;
+       Acc_Disp_Tables : in out Elist_Id;
+       Result          : out List_Id)
+    is
+       Loc             : constant Source_Ptr := Sloc (AI_Tag);
+       Generalized_Tag : constant Entity_Id := RTE (RE_Interface_Tag);
+       Name_DT         : constant Name_Id := New_Internal_Name ('T');
+       Iface_DT        : Node_Id;
+       Iface_DT_Ptr    : Node_Id;
+       Name_DT_Ptr     : Name_Id;
+       Nb_Prim         : Int;
+       OSD             : Entity_Id;
+       Size_Expr_Node  : Node_Id;
+       Tname           : Name_Id;
+ 
+    begin
+       Result := New_List;
+ 
+       --  Generate a unique external name associated with the secondary
+       --  dispatch table. This external name will be used to declare an
+       --  access to this secondary dispatch table, value that will be used
+       --  for the elaboration of Typ's objects and also for the elaboration
+       --  of objects of any derivation of Typ that do not override any
+       --  primitive operation of Typ.
+ 
+       Get_Secondary_DT_External_Name (Typ, Ancestor_Typ, Suffix_Index);
+ 
+       Tname        := Name_Find;
+       Name_DT_Ptr  := New_External_Name (Tname, "P");
+       Iface_DT     := Make_Defining_Identifier (Loc, Name_DT);
+       Iface_DT_Ptr := Make_Defining_Identifier (Loc, Name_DT_Ptr);
+ 
+       --  Dispatch table and related entities are allocated statically
+ 
+       Set_Ekind (Iface_DT, E_Variable);
+       Set_Is_Statically_Allocated (Iface_DT);
+ 
+       Set_Ekind (Iface_DT_Ptr, E_Variable);
+       Set_Is_Statically_Allocated (Iface_DT_Ptr);
+ 
+       --  Generate code to create the storage for the Dispatch_Table object.
+       --  If the number of primitives of Typ is less that the number of
+       --  predefined primitives, we must reserve at least enough space
+       --  for the predefined primitives.
+ 
+       Nb_Prim := UI_To_Int (DT_Entry_Count (AI_Tag));
+ 
+       if Nb_Prim < Default_Prim_Op_Count then
+          Nb_Prim := Default_Prim_Op_Count;
+       end if;
+ 
+       --    DT : Storage_Array (1..DT_Prologue_Size+nb_prim*DT_Entry_Size);
+       --    for DT'Alignment use Address'Alignment
+ 
+       Size_Expr_Node :=
+         Make_Op_Add (Loc,
+           Left_Opnd  => Make_DT_Access_Action (Etype (AI_Tag),
+                           DT_Prologue_Size,
+                           No_List),
+           Right_Opnd =>
+             Make_Op_Multiply (Loc,
+               Left_Opnd  =>
+                 Make_DT_Access_Action (Etype (AI_Tag),
+                                        DT_Entry_Size,
+                                        No_List),
+               Right_Opnd =>
+                 Make_Integer_Literal (Loc, Nb_Prim)));
+ 
+       Append_To (Result,
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Iface_DT,
+           Aliased_Present     => True,
+           Object_Definition   =>
+             Make_Subtype_Indication (Loc,
+               Subtype_Mark => New_Reference_To (RTE (RE_Storage_Array), Loc),
+               Constraint   => Make_Index_Or_Discriminant_Constraint (Loc,
+                 Constraints => New_List (
+                   Make_Range (Loc,
+                     Low_Bound  => Make_Integer_Literal (Loc, 1),
+                     High_Bound => Size_Expr_Node))))));
+ 
+       Append_To (Result,
+         Make_Attribute_Definition_Clause (Loc,
+           Name       => New_Reference_To (Iface_DT, Loc),
+           Chars      => Name_Alignment,
+           Expression =>
+             Make_Attribute_Reference (Loc,
+               Prefix => New_Reference_To (RTE (RE_Integer_Address), Loc),
+               Attribute_Name => Name_Alignment)));
+ 
+       --  Initialize the signature of the interface tag. It is a sequence of
+       --  two bytes located in the header of the dispatch table. The signature
+       --  of a Secondary Dispatch Table is (Valid_Signature, Secondary_DT).
+ 
+       Append_To (Result,
+         Make_Assignment_Statement (Loc,
+           Name =>
+             Make_Indexed_Component (Loc,
+               Prefix => New_Occurrence_Of (Iface_DT, Loc),
+               Expressions => New_List (
+                 Make_Integer_Literal (Loc, Uint_1))),
+           Expression =>
+             Unchecked_Convert_To (RTE (RE_Storage_Element),
+               New_Reference_To (RTE (RE_Valid_Signature), Loc))));
+ 
+       Append_To (Result,
+         Make_Assignment_Statement (Loc,
+           Name =>
+             Make_Indexed_Component (Loc,
+               Prefix => New_Occurrence_Of (Iface_DT, Loc),
+               Expressions => New_List (
+                 Make_Integer_Literal (Loc, Uint_2))),
+           Expression =>
+             Unchecked_Convert_To (RTE (RE_Storage_Element),
+               New_Reference_To (RTE (RE_Secondary_DT), Loc))));
+ 
+       --  Generate code to create the pointer to the dispatch table
+ 
+       --    Iface_DT_Ptr : Tag := Tag!(DT'Address);
+ 
+       --  According to the C++ ABI, the base of the vtable is located
+       --  after the following prologue: Offset_To_Top, and Typeinfo_Ptr.
+       --  Hence, move the pointer down to the real base of the vtable.
+ 
+       Append_To (Result,
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Iface_DT_Ptr,
+           Constant_Present    => True,
+           Object_Definition   => New_Reference_To (Generalized_Tag, Loc),
+           Expression          =>
+             Unchecked_Convert_To (Generalized_Tag,
+               Make_Op_Add (Loc,
+                 Left_Opnd =>
+                   Unchecked_Convert_To (RTE (RE_Storage_Offset),
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => New_Reference_To (Iface_DT, Loc),
+                       Attribute_Name => Name_Address)),
+                 Right_Opnd =>
+                   Make_DT_Access_Action (Etype (AI_Tag),
+                     DT_Prologue_Size, No_List)))));
+ 
+       --  Note: Offset_To_Top will be initialized by the init subprogram
+ 
+       --  Set Access_Disp_Table field to be the dispatch table pointer
+ 
+       if not (Present (Acc_Disp_Tables)) then
+          Acc_Disp_Tables := New_Elmt_List;
+       end if;
+ 
+       Append_Elmt (Iface_DT_Ptr, Acc_Disp_Tables);
+ 
+       --  Step 1: Generate an Object Specific Data (OSD) table
+ 
+       OSD := Make_Defining_Identifier (Loc, New_Internal_Name ('I'));
+ 
+       --  Generate:
+       --    OSD : Ada.Tags.Object_Specific_Data
+       --            (Nb_Prims - Default_Prim_Op_Count);
+       --  where the constraint is used to allocate space for the
+       --  non-predefined primitive operations only.
+ 
+       Append_To (Result,
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => OSD,
+           Object_Definition   =>
+             Make_Subtype_Indication (Loc,
+               Subtype_Mark => New_Reference_To (
+                 RTE (RE_Object_Specific_Data), Loc),
+               Constraint =>
+                 Make_Index_Or_Discriminant_Constraint (Loc,
+                   Constraints => New_List (
+                     Make_Integer_Literal (Loc,
+                       Nb_Prim - Default_Prim_Op_Count))))));
+ 
+       --  Generate:
+       --    Ada.Tags.Set_OSD (Iface_DT_Ptr, OSD);
+ 
+       Append_To (Result,
+         Make_DT_Access_Action (Typ,
+           Action => Set_OSD,
+           Args   => New_List (
+             New_Reference_To (Iface_DT_Ptr, Loc),
+             Make_Attribute_Reference (Loc,
+               Prefix         => New_Reference_To (OSD, Loc),
+               Attribute_Name => Name_Address))));
+ 
+       --  Offset table creation
+ 
+       if not Is_Interface (Typ)
+         and then not Is_Abstract   (Typ)
+         and then not Is_Controlled (Typ)
+         and then Implements_Interface
+                   (Typ  => Typ,
+                    Kind => Any_Limited_Interface,
+                    Check_Parent => True)
+         and then (Nb_Prim - Default_Prim_Op_Count) > 0
+       then
+          declare
+             Prim       : Entity_Id;
+             Prim_Alias : Entity_Id;
+             Prim_Elmt  : Elmt_Id;
+ 
+          begin
+             --  Step 2: Populate the OSD table
+ 
+             Prim_Alias := Empty;
+             Prim_Elmt  := First_Elmt (Primitive_Operations (Typ));
+             while Present (Prim_Elmt) loop
+                Prim := Node (Prim_Elmt);
+ 
+                if Present (Abstract_Interface_Alias (Prim)) then
+                   Prim_Alias := Abstract_Interface_Alias (Prim);
+                end if;
+ 
+                if Present (Prim_Alias)
+                  and then Present (First_Entity (Prim_Alias))
+                  and then Etype (First_Entity (Prim_Alias)) = Iface
+                then
+                   --  Generate:
+                   --    Ada.Tags.Set_Offset_Index (
+                   --      Iface_DT_Ptr, secondary_DT_Pos, primary_DT_pos);
+ 
+                   Append_To (Result,
+                     Make_DT_Access_Action (Iface,
+                       Action => Set_Offset_Index,
+                       Args   => New_List (
+                         New_Reference_To (Iface_DT_Ptr, Loc),
+                         Make_Integer_Literal (Loc, DT_Position (Prim_Alias)),
+                         Make_Integer_Literal (Loc, DT_Position (Prim)))));
+ 
+                   Prim_Alias := Empty;
+                end if;
+ 
+                Next_Elmt (Prim_Elmt);
+             end loop;
+          end;
+       end if;
+ 
+       --  Generate:
+       --    Set_Num_Prim_Ops (T'Tag, Nb_Prim)
+ 
+       Append_To (Result,
+         Make_Procedure_Call_Statement (Loc,
+           Name => New_Reference_To (RTE (RE_Set_Num_Prim_Ops), Loc),
+           Parameter_Associations => New_List (
+             Unchecked_Convert_To (RTE (RE_Tag),
+               New_Reference_To (Iface_DT_Ptr, Loc)),
+             Make_Integer_Literal (Loc, Nb_Prim))));
+ 
+    end Make_Secondary_DT;
+ 
+    -------------------------------------
+    -- Make_Select_Specific_Data_Table --
+    -------------------------------------
+ 
+    function Make_Select_Specific_Data_Table
+      (Typ : Entity_Id) return List_Id
+    is
+       Assignments : constant List_Id    := New_List;
+       Loc         : constant Source_Ptr := Sloc (Typ);
+ 
+       Conc_Typ    : Entity_Id;
+       Decls       : List_Id;
+       DT_Ptr      : Entity_Id;
+       Prim        : Entity_Id;
+       Prim_Als    : Entity_Id;
+       Prim_Elmt   : Elmt_Id;
+       Prim_Pos    : Uint;
+       Nb_Prim     : Int := 0;
+ 
+       type Examined_Array is array (Int range <>) of Boolean;
+ 
+       function Find_Entry_Index (E : Entity_Id) return Uint;
+       --  Given an entry, find its index in the visible declarations of the
+       --  corresponding concurrent type of Typ.
+ 
+       ----------------------
+       -- Find_Entry_Index --
+       ----------------------
+ 
+       function Find_Entry_Index (E : Entity_Id) return Uint is
+          Index     : Uint := Uint_1;
+          Subp_Decl : Entity_Id;
+ 
+       begin
+          if Present (Decls)
+            and then not Is_Empty_List (Decls)
+          then
+             Subp_Decl := First (Decls);
+             while Present (Subp_Decl) loop
+                if Nkind (Subp_Decl) = N_Entry_Declaration then
+                   if Defining_Identifier (Subp_Decl) = E then
+                      return Index;
+                   end if;
+ 
+                   Index := Index + 1;
+                end if;
+ 
+                Next (Subp_Decl);
+             end loop;
+          end if;
+ 
+          return Uint_0;
+       end Find_Entry_Index;
+ 
+    --  Start of processing for Make_Select_Specific_Data_Table
+ 
+    begin
+       DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ)));
+ 
+       if Present (Corresponding_Concurrent_Type (Typ)) then
+          Conc_Typ := Corresponding_Concurrent_Type (Typ);
+ 
+          if Ekind (Conc_Typ) = E_Protected_Type then
+             Decls := Visible_Declarations (Protected_Definition (
+                        Parent (Conc_Typ)));
+          else
+             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
+             Decls := Visible_Declarations (Task_Definition (
+                        Parent (Conc_Typ)));
+          end if;
+       end if;
+ 
+       --  Count the non-predefined primitive operations
+ 
+       Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+       while Present (Prim_Elmt) loop
+          if not Is_Predefined_Dispatching_Operation (Node (Prim_Elmt)) then
+             Nb_Prim := Nb_Prim + 1;
+          end if;
+ 
+          Next_Elmt (Prim_Elmt);
+       end loop;
+ 
+       declare
+          Examined_Size : constant Int := Nb_Prim + Default_Prim_Op_Count;
+          Examined : Examined_Array (1 .. Examined_Size) := (others => False);
+ 
+       begin
+          Prim_Elmt := First_Elmt (Primitive_Operations (Typ));
+          while Present (Prim_Elmt) loop
+             Prim := Node (Prim_Elmt);
+             Prim_Pos := DT_Position (Prim);
+ 
+             pragma Assert (UI_To_Int (Prim_Pos) <= Examined_Size);
+ 
+             if Examined (UI_To_Int (Prim_Pos)) then
+                goto Continue;
+             else
+                Examined (UI_To_Int (Prim_Pos)) := True;
+             end if;
+ 
+             --  The current primitive overrides an interface-level subprogram
+ 
+             if Present (Abstract_Interface_Alias (Prim)) then
+ 
+                --  Set the primitive operation kind regardless of subprogram
+                --  type. Generate:
+                --    Ada.Tags.Set_Prim_Op_Kind (DT_Ptr, <position>, <kind>);
+ 
+                Append_To (Assignments,
+                  Make_DT_Access_Action (Typ,
+                    Action =>
+                      Set_Prim_Op_Kind,
+                    Args =>
+                      New_List (
+                        New_Reference_To (DT_Ptr, Loc),
+                        Make_Integer_Literal (Loc, Prim_Pos),
+                        Prim_Op_Kind (Prim, Typ))));
+ 
+                --  Retrieve the root of the alias chain if one is present
+ 
+                if Present (Alias (Prim)) then
+                   Prim_Als := Prim;
+                   while Present (Alias (Prim_Als)) loop
+                      Prim_Als := Alias (Prim_Als);
+                   end loop;
+                else
+                   Prim_Als := Empty;
+                end if;
+ 
+                --  In the case of an entry wrapper, set the entry index
+ 
+                if Ekind (Prim) = E_Procedure
+                  and then Present (Prim_Als)
+                  and then Is_Primitive_Wrapper (Prim_Als)
+                  and then Ekind (Wrapped_Entity (Prim_Als)) = E_Entry
+                then
+ 
+                   --  Generate:
+                   --    Ada.Tags.Set_Entry_Index (DT_Ptr, <position>, <index>);
+ 
+                   Append_To (Assignments,
+                     Make_DT_Access_Action (Typ,
+                       Action =>
+                         Set_Entry_Index,
+                       Args =>
+                         New_List (
+                           New_Reference_To (DT_Ptr, Loc),
+                           Make_Integer_Literal (Loc, Prim_Pos),
+                           Make_Integer_Literal (Loc,
+                             Find_Entry_Index (Wrapped_Entity (Prim_Als))))));
+                end if;
+             end if;
+ 
+             <<Continue>>
+ 
+             Next_Elmt (Prim_Elmt);
+          end loop;
+       end;
+ 
+       return Assignments;
+    end Make_Select_Specific_Data_Table;
+ 
     -----------------------------------
     -- Original_View_In_Visible_Part --
     -----------------------------------
*************** package body Exp_Disp is
*** 1099,1104 ****
--- 3740,3830 ----
          Visible_Declarations (Specification (Unit_Declaration_Node (Scop)));
     end Original_View_In_Visible_Part;
  
+    ------------------
+    -- Prim_Op_Kind --
+    ------------------
+ 
+    function Prim_Op_Kind
+      (Prim : Entity_Id;
+       Typ  : Entity_Id) return Node_Id
+    is
+       Full_Typ : Entity_Id := Typ;
+       Loc      : constant Source_Ptr := Sloc (Prim);
+       Prim_Op  : Entity_Id := Prim;
+ 
+    begin
+       --  Retrieve the original primitive operation
+ 
+       while Present (Alias (Prim_Op)) loop
+          Prim_Op := Alias (Prim_Op);
+       end loop;
+ 
+       if Ekind (Typ) = E_Record_Type
+         and then Present (Corresponding_Concurrent_Type (Typ))
+       then
+          Full_Typ := Corresponding_Concurrent_Type (Typ);
+       end if;
+ 
+       if Ekind (Prim_Op) = E_Function then
+ 
+          --  Protected function
+ 
+          if Ekind (Full_Typ) = E_Protected_Type then
+             return New_Reference_To (RTE (RE_POK_Protected_Function), Loc);
+ 
+          --  Task function
+ 
+          elsif Ekind (Full_Typ) = E_Task_Type then
+             return New_Reference_To (RTE (RE_POK_Task_Function), Loc);
+ 
+          --  Regular function
+ 
+          else
+             return New_Reference_To (RTE (RE_POK_Function), Loc);
+          end if;
+ 
+       else
+          pragma Assert (Ekind (Prim_Op) = E_Procedure);
+ 
+          if Ekind (Full_Typ) = E_Protected_Type then
+ 
+             --  Protected entry
+ 
+             if Is_Primitive_Wrapper (Prim_Op)
+               and then Ekind (Wrapped_Entity (Prim_Op)) = E_Entry
+             then
+                return New_Reference_To (RTE (RE_POK_Protected_Entry), Loc);
+ 
+             --  Protected procedure
+ 
+             else
+                return New_Reference_To (RTE (RE_POK_Protected_Procedure), Loc);
+             end if;
+ 
+          elsif Ekind (Full_Typ) = E_Task_Type then
+ 
+             --  Task entry
+ 
+             if Is_Primitive_Wrapper (Prim_Op)
+               and then Ekind (Wrapped_Entity (Prim_Op)) = E_Entry
+             then
+                return New_Reference_To (RTE (RE_POK_Task_Entry), Loc);
+ 
+             --  Task "procedure". These are the internally Expander-generated
+             --  procedures (task body for instance).
+ 
+             else
+                return New_Reference_To (RTE (RE_POK_Task_Procedure), Loc);
+             end if;
+ 
+          --  Regular procedure
+ 
+          else
+             return New_Reference_To (RTE (RE_POK_Procedure), Loc);
+          end if;
+       end if;
+    end Prim_Op_Kind;
+ 
     -------------------------
     -- Set_All_DT_Position --
     -------------------------
*************** package body Exp_Disp is
*** 1107,1128 ****
        Parent_Typ : constant Entity_Id := Etype (Typ);
        Root_Typ   : constant Entity_Id := Root_Type (Typ);
        First_Prim : constant Elmt_Id := First_Elmt (Primitive_Operations (Typ));
!       The_Tag    : constant Entity_Id := Tag_Component (Typ);
        Adjusted   : Boolean := False;
        Finalized  : Boolean := False;
!       Parent_EC  : Int;
        Nb_Prim    : Int;
        Prim       : Entity_Id;
        Prim_Elmt  : Elmt_Id;
  
!    begin
  
        --  Get Entry_Count of the parent
  
        if Parent_Typ /= Typ
!         and then DT_Entry_Count (Tag_Component (Parent_Typ)) /= No_Uint
        then
!          Parent_EC := UI_To_Int (DT_Entry_Count (Tag_Component (Parent_Typ)));
        else
           Parent_EC := 0;
        end if;
--- 3833,3935 ----
        Parent_Typ : constant Entity_Id := Etype (Typ);
        Root_Typ   : constant Entity_Id := Root_Type (Typ);
        First_Prim : constant Elmt_Id := First_Elmt (Primitive_Operations (Typ));
!       The_Tag    : constant Entity_Id := First_Tag_Component (Typ);
! 
        Adjusted   : Boolean := False;
        Finalized  : Boolean := False;
! 
!       Count_Prim : Int;
!       DT_Length  : Int;
        Nb_Prim    : Int;
+       Parent_EC  : Int;
        Prim       : Entity_Id;
        Prim_Elmt  : Elmt_Id;
  
!       procedure Validate_Position (Prim : Entity_Id);
!       --  Check that the position assignated to Prim is completely safe
!       --  (it has not been assigned to a previously defined primitive
!       --   operation of Typ)
! 
!       -----------------------
!       -- Validate_Position --
!       -----------------------
  
+       procedure Validate_Position (Prim : Entity_Id) is
+          Prim_Elmt : Elmt_Id;
+ 
+       begin
+          Prim_Elmt :=  First_Elmt (Primitive_Operations (Typ));
+          while Present (Prim_Elmt)
+             and then Node (Prim_Elmt) /= Prim
+          loop
+             --  Primitive operations covering abstract interfaces are
+             --  allocated later
+ 
+             if Present (Abstract_Interface_Alias (Node (Prim_Elmt))) then
+                null;
+ 
+             --  Predefined dispatching operations are completely safe.
+             --  They are allocated at fixed positions.
+ 
+             elsif Is_Predefined_Dispatching_Operation (Node (Prim_Elmt)) then
+                null;
+ 
+             --  Aliased subprograms are safe
+ 
+             elsif Present (Alias (Prim)) then
+                null;
+ 
+             elsif DT_Position (Node (Prim_Elmt)) = DT_Position (Prim) then
+ 
+                --  Handle aliased subprograms
+ 
+                declare
+                   Op_1 : Entity_Id;
+                   Op_2 : Entity_Id;
+ 
+                begin
+                   Op_1 := Node (Prim_Elmt);
+                   loop
+                      if Present (Overridden_Operation (Op_1)) then
+                         Op_1 := Overridden_Operation (Op_1);
+                      elsif Present (Alias (Op_1)) then
+                         Op_1 := Alias (Op_1);
+                      else
+                         exit;
+                      end if;
+                   end loop;
+ 
+                   Op_2 := Prim;
+                   loop
+                      if Present (Overridden_Operation (Op_2)) then
+                         Op_2 := Overridden_Operation (Op_2);
+                      elsif Present (Alias (Op_2)) then
+                         Op_2 := Alias (Op_2);
+                      else
+                         exit;
+                      end if;
+                   end loop;
+ 
+                   if Op_1 /= Op_2 then
+                      raise Program_Error;
+                   end if;
+                end;
+             end if;
+ 
+             Next_Elmt (Prim_Elmt);
+          end loop;
+       end Validate_Position;
+ 
+    --  Start of processing for Set_All_DT_Position
+ 
+    begin
        --  Get Entry_Count of the parent
  
        if Parent_Typ /= Typ
!         and then DT_Entry_Count (First_Tag_Component (Parent_Typ)) /= No_Uint
        then
!          Parent_EC := UI_To_Int (DT_Entry_Count
!                                    (First_Tag_Component (Parent_Typ)));
        else
           Parent_EC := 0;
        end if;
*************** package body Exp_Disp is
*** 1159,1167 ****
                 --  Get the slot from the parent subprogram if any
  
                 declare
!                   H : Entity_Id := Homonym (Prim);
  
                 begin
                    while Present (H) loop
                       if Present (DTC_Entity (H))
                         and then Root_Type (Scope (DTC_Entity (H))) = Root_Typ
--- 3966,3975 ----
                 --  Get the slot from the parent subprogram if any
  
                 declare
!                   H : Entity_Id;
  
                 begin
+                   H := Homonym (Prim);
                    while Present (H) loop
                       if Present (DTC_Entity (H))
                         and then Root_Type (Scope (DTC_Entity (H))) = Root_Typ
*************** package body Exp_Disp is
*** 1192,1198 ****
           --  Check that the declared size of the Vtable is bigger or equal
           --  than the number of primitive operations (if bigger it means that
           --  some of the c++ virtual functions were not imported, that is
!          --  allowed)
  
           if DT_Entry_Count (The_Tag) = No_Uint
             or else not Is_CPP_Class (Typ)
--- 4000,4006 ----
           --  Check that the declared size of the Vtable is bigger or equal
           --  than the number of primitive operations (if bigger it means that
           --  some of the c++ virtual functions were not imported, that is
!          --  allowed).
  
           if DT_Entry_Count (The_Tag) = No_Uint
             or else not Is_CPP_Class (Typ)
*************** package body Exp_Disp is
*** 1205,1211 ****
           end if;
  
           --  Check that Positions are not duplicate nor outside the range of
!          --  the Vtable
  
           declare
              Size : constant Int := UI_To_Int (DT_Entry_Count (The_Tag));
--- 4013,4019 ----
           end if;
  
           --  Check that Positions are not duplicate nor outside the range of
!          --  the Vtable.
  
           declare
              Size : constant Int := UI_To_Int (DT_Entry_Count (The_Tag));
*************** package body Exp_Disp is
*** 1238,1272 ****
              end loop;
           end;
  
        --  For regular Ada tagged types, just set the DT_Position for
        --  each primitive operation. Perform some sanity checks to avoid
        --  to build completely inconsistant dispatch tables.
  
        --  Note that the _Size primitive is always set at position 1 in order
        --  to comply with the needs of Ada.Tags.Parent_Size (see documentation
!       --  in a-tags.ad?)
  
        else
!          Nb_Prim := 1;
!          Prim_Elmt := First_Prim;
           while Present (Prim_Elmt) loop
!             Nb_Prim := Nb_Prim + 1;
!             Prim := Node (Prim_Elmt);
!             Set_DTC_Entity (Prim, The_Tag);
  
-             if Chars (Prim) = Name_uSize then
-                Set_DT_Position (Prim, Uint_1);
-                Nb_Prim := Nb_Prim - 1;
              else
!                Set_DT_Position (Prim, UI_From_Int (Nb_Prim));
              end if;
  
!             if Chars (Prim) = Name_Finalize
!               and then
!                 (Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
!                    or else not Is_Predefined_File_Name
!                                   (Unit_File_Name (Get_Source_Unit (Prim))))
              then
                 Finalized := True;
              end if;
  
--- 4046,4288 ----
              end loop;
           end;
  
+          --  Generate listing showing the contents of the dispatch tables
+ 
+          if Debug_Flag_ZZ then
+             Write_DT (Typ);
+          end if;
+ 
        --  For regular Ada tagged types, just set the DT_Position for
        --  each primitive operation. Perform some sanity checks to avoid
        --  to build completely inconsistant dispatch tables.
  
        --  Note that the _Size primitive is always set at position 1 in order
        --  to comply with the needs of Ada.Tags.Parent_Size (see documentation
!       --  in Ada.Tags).
  
        else
!          --  First stage: Set the DTC entity of all the primitive operations
!          --  This is required to properly read the DT_Position attribute in
!          --  the latter stages.
! 
!          Prim_Elmt  := First_Prim;
!          Count_Prim := 0;
           while Present (Prim_Elmt) loop
!             Count_Prim := Count_Prim + 1;
!             Prim       := Node (Prim_Elmt);
! 
!             --  Ada 2005 (AI-251)
! 
!             if Present (Abstract_Interface_Alias (Prim))
!               and then Is_Interface (Scope (DTC_Entity
!                                       (Abstract_Interface_Alias (Prim))))
!             then
!                Set_DTC_Entity (Prim,
!                   Find_Interface_Tag
!                     (T => Typ,
!                      Iface => Scope (DTC_Entity
!                                       (Abstract_Interface_Alias (Prim)))));
  
              else
!                Set_DTC_Entity (Prim, The_Tag);
              end if;
  
!             --  Clear any previous value of the DT_Position attribute. In this
!             --  way we ensure that the final position of all the primitives is
!             --  stablished by the following stages of this algorithm.
! 
!             Set_DT_Position (Prim, No_Uint);
! 
!             Next_Elmt (Prim_Elmt);
!          end loop;
! 
!          declare
!             Fixed_Prim : array (Int range 0 .. Default_Prim_Op_Count +
!                                   Parent_EC + Count_Prim)
!                            of Boolean := (others => False);
! 
!             E : Entity_Id;
! 
!          begin
!             --  Second stage: Register fixed entries
! 
!             Nb_Prim   := Default_Prim_Op_Count;
!             Prim_Elmt := First_Prim;
!             while Present (Prim_Elmt) loop
!                Prim := Node (Prim_Elmt);
! 
!                --  Predefined primitives have a fixed position in all the
!                --  dispatch tables
! 
!                if Is_Predefined_Dispatching_Operation (Prim) then
!                   Set_DT_Position (Prim, Default_Prim_Op_Position (Prim));
!                   Fixed_Prim (UI_To_Int (DT_Position (Prim))) := True;
! 
!                --  Overriding interface primitives of an ancestor
! 
!                elsif DT_Position (Prim) = No_Uint
!                  and then Present (Abstract_Interface_Alias (Prim))
!                  and then Present (DTC_Entity
!                                    (Abstract_Interface_Alias (Prim)))
!                  and then DT_Position (Abstract_Interface_Alias (Prim))
!                                         /= No_Uint
!                  and then Is_Inherited_Operation (Prim)
!                  and then Is_Ancestor (Scope
!                                        (DTC_Entity
!                                         (Abstract_Interface_Alias (Prim))),
!                                        Typ)
!                then
!                   Set_DT_Position (Prim,
!                     DT_Position (Abstract_Interface_Alias (Prim)));
!                   Set_DT_Position (Alias (Prim),
!                     DT_Position (Abstract_Interface_Alias (Prim)));
!                   Fixed_Prim (UI_To_Int (DT_Position (Prim))) := True;
! 
!                --  Overriding primitives must use the same entry as the
!                --  overriden primitive
! 
!                elsif DT_Position (Prim) = No_Uint
!                  and then Present (Alias (Prim))
!                  and then Present (DTC_Entity (Alias (Prim)))
!                  and then DT_Position (Alias (Prim)) /= No_Uint
!                  and then Is_Inherited_Operation (Prim)
!                  and then Is_Ancestor (Scope (DTC_Entity (Alias (Prim))), Typ)
!                then
!                   E := Alias (Prim);
!                   while not (Present (DTC_Entity (E))
!                               or else DT_Position (E) = No_Uint)
!                     and then Present (Alias (E))
!                   loop
!                      E := Alias (E);
!                   end loop;
! 
!                   pragma Assert (Present (DTC_Entity (E))
!                                    and then
!                                  DT_Position (E) /= No_Uint);
! 
!                   Set_DT_Position (Prim, DT_Position (E));
!                   Fixed_Prim (UI_To_Int (DT_Position (E))) := True;
! 
!                   --  If this is not the last element in the chain continue
!                   --  traversing the chain. This is required to properly
!                   --  handling renamed primitives
! 
!                   while Present (Alias (E)) loop
!                      E   := Alias (E);
!                      Fixed_Prim (UI_To_Int (DT_Position (E))) := True;
!                   end loop;
!                end if;
! 
!                Next_Elmt (Prim_Elmt);
!             end loop;
! 
!             --  Third stage: Fix the position of all the new primitives
!             --  Entries associated with primitives covering interfaces
!             --  are handled in a latter round.
! 
!             Prim_Elmt := First_Prim;
!             while Present (Prim_Elmt) loop
!                Prim := Node (Prim_Elmt);
! 
!                --  Skip primitives previously set entries
! 
!                if DT_Position (Prim) /= No_Uint then
!                   null;
! 
!                elsif Etype (DTC_Entity (Prim)) /= RTE (RE_Tag) then
!                   null;
! 
!                --  Primitives covering interface primitives are
!                --  handled later
! 
!                elsif Present (Abstract_Interface_Alias (Prim)) then
!                   null;
! 
!                else
!                   --  Take the next available position in the DT
! 
!                   loop
!                      Nb_Prim := Nb_Prim + 1;
!                      exit when not Fixed_Prim (Nb_Prim);
!                   end loop;
! 
!                   Set_DT_Position (Prim, UI_From_Int (Nb_Prim));
!                   Fixed_Prim (Nb_Prim) := True;
!                end if;
! 
!                Next_Elmt (Prim_Elmt);
!             end loop;
!          end;
! 
!          --  Fourth stage: Complete the decoration of primitives covering
!          --  interfaces (that is, propagate the DT_Position attribute
!          --  from the aliased primitive)
! 
!          Prim_Elmt := First_Prim;
!          while Present (Prim_Elmt) loop
!             Prim := Node (Prim_Elmt);
! 
!             if DT_Position (Prim) = No_Uint
!                and then Present (Abstract_Interface_Alias (Prim))
              then
+                --  Check if this entry will be placed in the primary DT
+ 
+                if Etype (DTC_Entity (Abstract_Interface_Alias (Prim)))
+                     = RTE (RE_Tag)
+                then
+                   pragma Assert (DT_Position (Alias (Prim)) /= No_Uint);
+                   Set_DT_Position (Prim, DT_Position (Alias (Prim)));
+ 
+                --  Otherwise it will be placed in the secondary DT
+ 
+                else
+                   pragma Assert
+                     (DT_Position (Abstract_Interface_Alias (Prim)) /= No_Uint);
+ 
+                   Set_DT_Position (Prim,
+                      DT_Position (Abstract_Interface_Alias (Prim)));
+                end if;
+             end if;
+ 
+             Next_Elmt (Prim_Elmt);
+          end loop;
+ 
+          --  Generate listing showing the contents of the dispatch tables.
+          --  This action is done before some further static checks because
+          --  in case of critical errors caused by a wrong dispatch table
+          --  we need to see the contents of such table.
+ 
+          if Debug_Flag_ZZ then
+             Write_DT (Typ);
+          end if;
+ 
+          --  Final stage: Ensure that the table is correct plus some further
+          --  verifications concerning the primitives.
+ 
+          Prim_Elmt := First_Prim;
+          DT_Length := 0;
+          while Present (Prim_Elmt) loop
+             Prim := Node (Prim_Elmt);
+ 
+             --  At this point all the primitives MUST have a position
+             --  in the dispatch table
+ 
+             if DT_Position (Prim) = No_Uint then
+                raise Program_Error;
+             end if;
+ 
+             --  Calculate real size of the dispatch table
+ 
+             if UI_To_Int (DT_Position (Prim)) > DT_Length then
+                DT_Length := UI_To_Int (DT_Position (Prim));
+             end if;
+ 
+             --  Ensure that the asignated position in the dispatch
+             --  table is correct
+ 
+             Validate_Position (Prim);
+ 
+             if Chars (Prim) = Name_Finalize then
                 Finalized := True;
              end if;
  
*************** package body Exp_Disp is
*** 1276,1292 ****
  
              --  An abstract operation cannot be declared in the private part
              --  for a visible abstract type, because it could never be over-
!             --  ridden. For explicit declarations this is checked at the point
!             --  of declaration, but for inherited operations it must be done
!             --  when building the dispatch table. Input is excluded because
  
              if Is_Abstract (Typ)
                and then Is_Abstract (Prim)
                and then Present (Alias (Prim))
                and then Is_Derived_Type (Typ)
                and then In_Private_Part (Current_Scope)
!               and then List_Containing (Parent (Prim))
!                =  Private_Declarations
                     (Specification (Unit_Declaration_Node (Current_Scope)))
                and then Original_View_In_Visible_Part (Typ)
              then
--- 4292,4310 ----
  
              --  An abstract operation cannot be declared in the private part
              --  for a visible abstract type, because it could never be over-
!             --  ridden. For explicit declarations this is checked at the
!             --  point of declaration, but for inherited operations it must
!             --  be done when building the dispatch table. Input is excluded
!             --  because
  
              if Is_Abstract (Typ)
                and then Is_Abstract (Prim)
                and then Present (Alias (Prim))
                and then Is_Derived_Type (Typ)
                and then In_Private_Part (Current_Scope)
!               and then
!                 List_Containing (Parent (Prim)) =
!                   Private_Declarations
                     (Specification (Unit_Declaration_Node (Current_Scope)))
                and then Original_View_In_Visible_Part (Typ)
              then
*************** package body Exp_Disp is
*** 1302,1313 ****
                    Error_Msg_NE
                      ("abstract inherited private operation&" &
                       " must be overridden ('R'M 3.9.3(10))",
!                      Parent (Typ), Prim);
                 end if;
              end if;
              Next_Elmt (Prim_Elmt);
           end loop;
  
           if Is_Controlled (Typ) then
              if not Finalized then
                 Error_Msg_N
--- 4320,4334 ----
                    Error_Msg_NE
                      ("abstract inherited private operation&" &
                       " must be overridden ('R'M 3.9.3(10))",
!                     Parent (Typ), Prim);
                 end if;
              end if;
+ 
              Next_Elmt (Prim_Elmt);
           end loop;
  
+          --  Additional check
+ 
           if Is_Controlled (Typ) then
              if not Finalized then
                 Error_Msg_N
*************** package body Exp_Disp is
*** 1319,1333 ****
              end if;
           end if;
  
!          Set_DT_Entry_Count (The_Tag, UI_From_Int (Nb_Prim));
  
           --  The derived type must have at least as many components as its
           --  parent (for root types, the Etype points back to itself
           --  and the test should not fail)
  
!          pragma Assert (
!            DT_Entry_Count (The_Tag) >=
!            DT_Entry_Count (Tag_Component (Parent_Typ)));
        end if;
     end Set_All_DT_Position;
  
--- 4340,4363 ----
              end if;
           end if;
  
!          --  Set the final size of the Dispatch Table
! 
!          Set_DT_Entry_Count (The_Tag, UI_From_Int (DT_Length));
  
           --  The derived type must have at least as many components as its
           --  parent (for root types, the Etype points back to itself
           --  and the test should not fail)
  
!          --  This test fails compiling the partial view of a tagged type
!          --  derived from an interface which defines the overriding subprogram
!          --  in the private part. This needs further investigation???
! 
!          if not Has_Private_Declaration (Typ) then
!             pragma Assert (
!               DT_Entry_Count (The_Tag) >=
!               DT_Entry_Count (First_Tag_Component (Parent_Typ)));
!             null;
!          end if;
        end if;
     end Set_All_DT_Position;
  
*************** package body Exp_Disp is
*** 1383,1386 ****
--- 4413,4516 ----
        end if;
     end Set_Default_Constructor;
  
+    --------------
+    -- Write_DT --
+    --------------
+ 
+    procedure Write_DT (Typ : Entity_Id) is
+       Elmt : Elmt_Id;
+       Prim : Node_Id;
+ 
+    begin
+       --  Protect this procedure against wrong usage. Required because it will
+       --  be used directly from GDB
+ 
+       if not (Typ in First_Node_Id .. Last_Node_Id)
+         or else not Is_Tagged_Type (Typ)
+       then
+          Write_Str ("wrong usage: Write_DT must be used with tagged types");
+          Write_Eol;
+          return;
+       end if;
+ 
+       Write_Int (Int (Typ));
+       Write_Str (": ");
+       Write_Name (Chars (Typ));
+ 
+       if Is_Interface (Typ) then
+          Write_Str (" is interface");
+       end if;
+ 
+       Write_Eol;
+ 
+       Elmt := First_Elmt (Primitive_Operations (Typ));
+       while Present (Elmt) loop
+          Prim := Node (Elmt);
+          Write_Str  (" - ");
+ 
+          --  Indicate if this primitive will be allocated in the primary
+          --  dispatch table or in a secondary dispatch table associated
+          --  with an abstract interface type
+ 
+          if Present (DTC_Entity (Prim)) then
+             if Etype (DTC_Entity (Prim)) = RTE (RE_Tag) then
+                Write_Str ("[P] ");
+             else
+                Write_Str ("[s] ");
+             end if;
+          end if;
+ 
+          --  Output the node of this primitive operation and its name
+ 
+          Write_Int  (Int (Prim));
+          Write_Str  (": ");
+          Write_Name (Chars (Prim));
+ 
+          --  Indicate if this primitive has an aliased primitive
+ 
+          if Present (Alias (Prim)) then
+             Write_Str (" (alias = ");
+             Write_Int (Int (Alias (Prim)));
+ 
+             --  If the DTC_Entity attribute is already set we can also output
+             --  the name of the interface covered by this primitive (if any)
+ 
+             if Present (DTC_Entity (Alias (Prim)))
+               and then Is_Interface (Scope (DTC_Entity (Alias (Prim))))
+             then
+                Write_Str  (" from interface ");
+                Write_Name (Chars (Scope (DTC_Entity (Alias (Prim)))));
+             end if;
+ 
+             if Present (Abstract_Interface_Alias (Prim)) then
+                Write_Str  (", AI_Alias of ");
+                Write_Name (Chars (Scope (DTC_Entity
+                                           (Abstract_Interface_Alias (Prim)))));
+                Write_Char (':');
+                Write_Int  (Int (Abstract_Interface_Alias (Prim)));
+             end if;
+ 
+             Write_Str (")");
+          end if;
+ 
+          --  Display the final position of this primitive in its associated
+          --  (primary or secondary) dispatch table
+ 
+          if Present (DTC_Entity (Prim))
+            and then DT_Position (Prim) /= No_Uint
+          then
+             Write_Str (" at #");
+             Write_Int (UI_To_Int (DT_Position (Prim)));
+          end if;
+ 
+          if Is_Abstract (Prim) then
+             Write_Str (" is abstract;");
+          end if;
+ 
+          Write_Eol;
+ 
+          Next_Elmt (Elmt);
+       end loop;
+    end Write_DT;
+ 
  end Exp_Disp;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_disp.ads gcc-4.1.0/gcc/ada/exp_disp.ads
*** gcc-4.0.2/gcc/ada/exp_disp.ads	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/exp_disp.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,69 ****
  ------------------------------------------------------------------------------
  
  --  This package contains routines involved in tagged types and dynamic
! --  dispatching expansion
  
  with Types; use Types;
  package Exp_Disp is
  
     type DT_Access_Action is
        (CW_Membership,
         DT_Entry_Size,
         DT_Prologue_Size,
!        Get_Expanded_Name,
         Get_External_Tag,
         Get_Prim_Op_Address,
         Get_RC_Offset,
         Get_Remotely_Callable,
-        Get_TSD,
         Inherit_DT,
         Inherit_TSD,
         Register_Tag,
         Set_Expanded_Name,
         Set_External_Tag,
         Set_Prim_Op_Address,
         Set_RC_Offset,
         Set_Remotely_Callable,
         Set_TSD,
         TSD_Entry_Size,
         TSD_Prologue_Size);
  
     function Fill_DT_Entry
!      (Loc  : Source_Ptr;
!       Prim : Entity_Id)
!       return Node_Id;
     --  Generate the code necessary to fill the appropriate entry of the
     --  dispatch table of Prim's controlling type with Prim's address.
  
     function Make_DT_Access_Action
       (Typ    : Entity_Id;
        Action : DT_Access_Action;
!       Args   : List_Id)
!       return Node_Id;
     --  Generate a call to one of the Dispatch Table Access Subprograms defined
     --  in Ada.Tags or in Interfaces.Cpp
  
--- 25,266 ----
  ------------------------------------------------------------------------------
  
  --  This package contains routines involved in tagged types and dynamic
! --  dispatching expansion.
  
  with Types; use Types;
+ 
  package Exp_Disp is
  
+    -------------------------------------
+    -- Predefined primitive operations --
+    -------------------------------------
+ 
+    --  The predefined primitive operations (PPOs) are subprograms generated
+    --  by GNAT for a particular tagged type. Their role is to provide support
+    --  for different Ada language features such as the attribute 'Size or
+    --  handling of dispatching triggers in select statements. PPOs are created
+    --  when a tagged type is expanded or frozen. These subprograms are later
+    --  collected and inserted into the dispatch table of a tagged type at
+    --  fixed positions. Some of the PPOs that manipulate data in tagged objects
+    --  require the generation of thunks.
+ 
+    --  List of predefined primitive operations
+ 
+    --    Leading underscores designate reserved names. Bracketed numerical
+    --    values represent dispatch table slot numbers.
+ 
+    --      _Size (1) - implementation of the attribute 'Size for any tagged
+    --      type. Constructs of the form Prefix'Size are converted into
+    --      Prefix._Size.
+ 
+    --      _Alignment (2) - implementation of the attribute 'Alignment for
+    --      any tagged type. Constructs of the form Prefix'Alignment are
+    --      converted into Prefix._Alignment.
+ 
+    --      TSS_Stream_Read (3) - implementation of the stream attribute Read
+    --      for any tagged type.
+ 
+    --      TSS_Stream_Write (4) - implementation of the stream attribute Write
+    --      for any tagged type.
+ 
+    --      TSS_Stream_Input (5) - implementation of the stream attribute Input
+    --      for any tagged type.
+ 
+    --      TSS_Stream_Output (6) - implementation of the stream attribute
+    --      Output for any tagged type.
+ 
+    --      Op_Eq (7) - implementation of the equality operator for any non-
+    --      limited tagged type.
+ 
+    --      _Assign (8) - implementation of the assignment operator for any
+    --      non-limited tagged type.
+ 
+    --      TSS_Deep_Adjust (9) - implementation of the finalization operation
+    --      Adjust for any non-limited tagged type.
+ 
+    --      TSS_Deep_Finalize (10) - implementation of the finalization
+    --      operation Finalize for any non-limited tagged type.
+ 
+    --      _Disp_Asynchronous_Select (11) - used in the expansion of ATC with
+    --      dispatching triggers. Null implementation for limited interfaces,
+    --      full body generation for types that implement limited interfaces,
+    --      not generated for the rest of the cases. See Expand_N_Asynchronous_
+    --      Select in Exp_Ch9 for more information.
+ 
+    --      _Disp_Conditional_Select (12) - used in the expansion of conditional
+    --      selects with dispatching triggers. Null implementation for limited
+    --      interfaces, full body generation for types that implement limited
+    --      interfaces, not generated for the rest of the cases. See Expand_N_
+    --      Conditional_Entry_Call in Exp_Ch9 for more information.
+ 
+    --      _Disp_Get_Prim_Op_Kind (13) - helper routine used in the expansion
+    --      of ATC with dispatching triggers. Null implementation for limited
+    --      interfaces, full body generation for types that implement limited
+    --      interfaces, not generated for the rest of the cases.
+ 
+    --      _Disp_Get_Task_Id (14) - helper routine used in the expansion of
+    --      Abort, attributes 'Callable and 'Terminated for task interface
+    --      class-wide types. Full body generation for task types, null
+    --      implementation for limited interfaces, not generated for the rest
+    --      of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
+    --      Expand_N_Abort_Statement in Exp_Ch9 for more information.
+ 
+    --      _Disp_Timed_Select (15) - used in the expansion of timed selects
+    --      with dispatching triggers. Null implementation for limited
+    --      interfaces, full body generation for types that implement limited
+    --      interfaces, not generated for the rest of the cases. See Expand_N_
+    --      Timed_Entry_Call for more information.
+ 
+    --  Lifecycle of predefined primitive operations
+ 
+    --      The specifications and bodies of the PPOs are created by
+    --      Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
+    --      in Exp_Ch3. The generated specifications are immediately analyzed,
+    --      while the bodies are left as freeze actions to the tagged type for
+    --      which they are created.
+ 
+    --      PPOs are collected and added to the Primitive_Operations list of
+    --      a type by the regular analysis mechanism.
+ 
+    --      PPOs are frozen in Predefined_Primitive_Freeze in Exp_Ch3.
+ 
+    --      Thunks for PPOs are created in Freeze_Subprogram in Exp_Ch6, by a
+    --      call to Register_Predefined_DT_Entry, also in Exp_Ch6.
+ 
+    --      Dispatch table positions of PPOs are set in Set_All_DT_Position in
+    --      Exp_Disp.
+ 
+    --      Calls to PPOs procede as regular dispatching calls. If the PPO
+    --      has a thunk, a call procedes as a regular dispatching call with
+    --      a thunk.
+ 
+    --  Guidelines for addition of new predefined primitive operations
+ 
+    --      Update the value of constant Default_Prim_Op_Count in Exp_Disp.ads
+    --      to reflect the new number of PPOs.
+ 
+    --      Update the value of constant Default_Prim_Op_Count in A-Tags.ads
+    --      to reflect the new number of PPOs. This value should be the same
+    --      as the one in Exp_Disp.ads.
+ 
+    --      Introduce a new predefined name for the new PPO in Snames.ads and
+    --      Snames.adb.
+ 
+    --      Categorize the new PPO name as predefined by adding an entry in
+    --      Is_Predefined_Dispatching_Operation in Exp_Util.adb.
+ 
+    --      Reserve a dispatch table position for the new PPO by adding an entry
+    --      in Default_Prim_Op_Position in Exp_Disp.adb.
+ 
+    --      Generate the specification of the new PPO in Make_Predefined_
+    --      Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
+    --      identifier of the specification must be set to True.
+ 
+    --      Generate the body of the new PPO in Predefined_Primitive_Bodies in
+    --      Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
+    --      specification must be set to True.
+ 
+    --      If the new PPO requires a thunk, add an entry in Freeze_Subprogram
+    --      in Exp_Ch6.adb.
+ 
+    --      When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
+    --      to retrieve the entity of the operation directly.
+ 
+    --  Number of predefined primitive operations added by the Expander
+    --  for a tagged type. If more predefined primitive operations are
+    --  added, the following items must be changed:
+ 
+    --    Ada.Tags.Defailt_Prim_Op_Count    - indirect use
+    --    Exp_Disp.Default_Prim_Op_Position - indirect use
+    --    Exp_Disp.Set_All_DT_Position      - direct   use
+ 
+    Default_Prim_Op_Count : constant Int := 15;
+ 
     type DT_Access_Action is
        (CW_Membership,
+        IW_Membership,
         DT_Entry_Size,
         DT_Prologue_Size,
!        Get_Access_Level,
!        Get_Entry_Index,
         Get_External_Tag,
+        Get_Offset_Index,
         Get_Prim_Op_Address,
+        Get_Prim_Op_Kind,
         Get_RC_Offset,
         Get_Remotely_Callable,
         Inherit_DT,
         Inherit_TSD,
+        Register_Interface_Tag,
         Register_Tag,
+        Set_Access_Level,
+        Set_Entry_Index,
         Set_Expanded_Name,
         Set_External_Tag,
+        Set_Offset_Index,
+        Set_OSD,
         Set_Prim_Op_Address,
+        Set_Prim_Op_Kind,
         Set_RC_Offset,
         Set_Remotely_Callable,
+        Set_SSD,
         Set_TSD,
         TSD_Entry_Size,
         TSD_Prologue_Size);
  
+    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
+    --  Expand the call to the operation through the dispatch table and perform
+    --  the required tag checks when appropriate. For CPP types the call is
+    --  done through the Vtable (tag checks are not relevant)
+ 
+    procedure Expand_Interface_Actuals    (Call_Node : Node_Id);
+    --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
+    --  interfaces to reference the interface tag of the actual object
+ 
+    procedure Expand_Interface_Conversion (N : Node_Id);
+    --  Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
+    --  the object to give access to the interface tag associated with the
+    --  secondary dispatch table
+ 
+    function Expand_Interface_Thunk
+      (N           : Node_Id;
+       Thunk_Alias : Node_Id;
+       Thunk_Id    : Entity_Id;
+       Thunk_Tag   : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
+    --  generate additional subprograms (thunks) to have a layout compatible
+    --  with the C++ ABI. The thunk modifies the value of the first actual of
+    --  the call (that is, the pointer to the object) before transferring
+    --  control to the target function.
+ 
     function Fill_DT_Entry
!      (Loc          : Source_Ptr;
!       Prim         : Entity_Id) return Node_Id;
     --  Generate the code necessary to fill the appropriate entry of the
     --  dispatch table of Prim's controlling type with Prim's address.
  
+    function Fill_Secondary_DT_Entry
+      (Loc          : Source_Ptr;
+       Prim         : Entity_Id;
+       Thunk_Id     : Entity_Id;
+       Iface_DT_Ptr : Entity_Id) return Node_Id;
+    --  (Ada 2005): Generate the code necessary to fill the appropriate entry of
+    --  the secondary dispatch table of Prim's controlling type with Thunk_Id's
+    --  address.
+ 
+    function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
+    --  Return an expression that holds True if the object can be transmitted
+    --  onto another partition according to E.4 (18)
+ 
+    function Init_Predefined_Interface_Primitives
+      (Typ : Entity_Id) return List_Id;
+    --  Ada 2005 (AI-251): Initialize the entries associated with predefined
+    --  primitives in all the secondary dispatch tables of Typ.
+ 
     function Make_DT_Access_Action
       (Typ    : Entity_Id;
        Action : DT_Access_Action;
!       Args   : List_Id) return Node_Id;
     --  Generate a call to one of the Dispatch Table Access Subprograms defined
     --  in Ada.Tags or in Interfaces.Cpp
  
*************** package Exp_Disp is
*** 71,93 ****
     --  Expand the declarations for the Dispatch Table (or the Vtable in
     --  the case of type whose ancestor is a CPP_Class)
  
     procedure Set_All_DT_Position (Typ : Entity_Id);
     --  Set the DT_Position field for each primitive operation. In the CPP
!    --  Class case check that no pragma CPP_Virtual is missing  and that the
     --  DT_Position are coherent
  
-    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
-    --  Expand the call to the operation through the dispatch table and perform
-    --  the required tag checks when appropriate. For CPP types the call is
-    --  done through the Vtable (tag checks are not relevant)
- 
     procedure Set_Default_Constructor (Typ : Entity_Id);
     --  Typ is a CPP_Class type. Create the Init procedure of that type to
     --  be the default constructor (i.e. the function returning this type,
     --  having a pragma CPP_Constructor and no parameter)
  
!    function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
!    --  Return an expression that holds True if the object can be transmitted
!    --  onto another partition according to E.4 (18)
  
  end Exp_Disp;
--- 268,365 ----
     --  Expand the declarations for the Dispatch Table (or the Vtable in
     --  the case of type whose ancestor is a CPP_Class)
  
+    function Make_Disp_Asynchronous_Select_Body
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+    --  Typ used for dispatching in asynchronous selects. Generate a null body
+    --  if Typ is an interface type.
+ 
+    function Make_Disp_Asynchronous_Select_Spec
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+    --  of type Typ used for dispatching in asynchronous selects.
+ 
+    function Make_Disp_Conditional_Select_Body
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+    --  Typ used for dispatching in conditional selects. Generate a null body
+    --  if Typ is an interface type.
+ 
+    function Make_Disp_Conditional_Select_Spec
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+    --  of type Typ used for dispatching in conditional selects.
+ 
+    function Make_Disp_Get_Prim_Op_Kind_Body
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+    --  Typ used for retrieving the callable entity kind during dispatching in
+    --  asynchronous selects. Generate a null body if Typ is an interface type.
+ 
+    function Make_Disp_Get_Prim_Op_Kind_Spec
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+    --  of the type Typ use for retrieving the callable entity kind during
+    --  dispatching in asynchronous selects.
+ 
+    function Make_Disp_Get_Task_Id_Body
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+    --  Typ used for retrieving the _task_id field of a task interface class-
+    --  wide type. Generate a null body if Typ is an interface or a non-task
+    --  type.
+ 
+    function Make_Disp_Get_Task_Id_Spec
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+    --  of type Typ used for retrieving the _task_id field of a task interface
+    --  class-wide type.
+ 
+    function Make_Disp_Timed_Select_Body
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+    --  Typ used for dispatching in timed selects. Generate a null body if Nul
+    --  is an interface type.
+ 
+    function Make_Disp_Timed_Select_Spec
+      (Typ : Entity_Id) return Node_Id;
+    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+    --  of type Typ used for dispatching in timed selects.
+ 
+    function Make_Select_Specific_Data_Table
+      (Typ : Entity_Id) return List_Id;
+    --  Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
+    --  of Typ used for dispatching in asynchronous, conditional and timed
+    --  selects. Generate code to set the primitive operation kinds and entry
+    --  indices of primitive operations and primitive wrappers.
+ 
+    procedure Make_Secondary_DT
+      (Typ             : Entity_Id;
+       Ancestor_Typ    : Entity_Id;
+       Suffix_Index    : Int;
+       Iface           : Entity_Id;
+       AI_Tag          : Entity_Id;
+       Acc_Disp_Tables : in out Elist_Id;
+       Result          : out List_Id);
+    --  Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch
+    --  Table of Typ associated with Iface (each abstract interface implemented
+    --  by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ
+    --  and Suffix_Index are used to generate an unique external name which
+    --  is added at the end of Acc_Disp_Tables; this external name will be
+    --  used later by the subprogram Exp_Ch3.Build_Init_Procedure.
+ 
     procedure Set_All_DT_Position (Typ : Entity_Id);
     --  Set the DT_Position field for each primitive operation. In the CPP
!    --  Class case check that no pragma CPP_Virtual is missing and that the
     --  DT_Position are coherent
  
     procedure Set_Default_Constructor (Typ : Entity_Id);
     --  Typ is a CPP_Class type. Create the Init procedure of that type to
     --  be the default constructor (i.e. the function returning this type,
     --  having a pragma CPP_Constructor and no parameter)
  
!    procedure Write_DT (Typ : Entity_Id);
!    pragma Export (Ada, Write_DT);
!    --  Debugging procedure (to be called within gdb)
  
  end Exp_Disp;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_dist.adb gcc-4.1.0/gcc/ada/exp_dist.adb
*** gcc-4.0.2/gcc/ada/exp_dist.adb	Thu Feb 10 13:50:17 2005
--- gcc-4.1.0/gcc/ada/exp_dist.adb	Tue Nov 15 13:57:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Dist is
*** 97,103 ****
     --  DSA expansion associates stubs to distributed object types using
     --  a hash table on entity ids.
  
!    function Hash (F : Name_Id)   return Hash_Index;
     --  The generation of subprogram identifiers requires an overload counter
     --  to be associated with each remote subprogram names. These counters
     --  are maintained in a hash table on name ids.
--- 97,103 ----
     --  DSA expansion associates stubs to distributed object types using
     --  a hash table on entity ids.
  
!    function Hash (F : Name_Id) return Hash_Index;
     --  The generation of subprogram identifiers requires an overload counter
     --  to be associated with each remote subprogram names. These counters
     --  are maintained in a hash table on name ids.
*************** package body Exp_Dist is
*** 152,162 ****
     pragma Warnings (Off, Get_Subprogram_Id);
     --  One homonym only is unreferenced (specific to the GARLIC version)
  
-    function Get_PCS_Name return PCS_Names;
-    --  Return the name of a literal of type
-    --    System.Partition_Interface.DSA_Implementation_Type
-    --  indicating what PCS is currently in use.
- 
     procedure Add_RAS_Dereference_TSS (N : Node_Id);
     --  Add a subprogram body for RAS Dereference TSS
  
--- 152,157 ----
*************** package body Exp_Dist is
*** 266,272 ****
     procedure Set_Renaming_TSS
       (Typ     : Entity_Id;
        Nam     : Entity_Id;
!       TSS_Nam : Name_Id);
     --  Create a renaming declaration of subprogram Nam,
     --  and register it as a TSS for Typ with name TSS_Nam.
  
--- 261,267 ----
     procedure Set_Renaming_TSS
       (Typ     : Entity_Id;
        Nam     : Entity_Id;
!       TSS_Nam : TSS_Name_Type);
     --  Create a renaming declaration of subprogram Nam,
     --  and register it as a TSS for Typ with name TSS_Nam.
  
*************** package body Exp_Dist is
*** 275,281 ****
     --  its constrained status.
  
     function Is_RACW_Controlling_Formal
!      (Parameter : Node_Id; Stub_Type : Entity_Id) return Boolean;
     --  Return True if the current parameter is a controlling formal argument
     --  of type Stub_Type or access to Stub_Type.
  
--- 270,277 ----
     --  its constrained status.
  
     function Is_RACW_Controlling_Formal
!      (Parameter : Node_Id;
!       Stub_Type : Entity_Id) return Boolean;
     --  Return True if the current parameter is a controlling formal argument
     --  of type Stub_Type or access to Stub_Type.
  
*************** package body Exp_Dist is
*** 439,449 ****
  
     procedure Specific_Add_RAST_Features
       (Vis_Decl : Node_Id;
!       RAS_Type : Entity_Id;
!       Decls    : List_Id);
!    --  Add declaration for TSSs for a given RAS type. The declarations are
!    --  added just after the declaration of the RAS type itself, while the
!    --  bodies are inserted at the end of Decls. PCS-specific ancillary
     --  subprogram for Add_RAST_Features.
  
     --  An RPC_Target record is used during construction of calling stubs
--- 435,442 ----
  
     procedure Specific_Add_RAST_Features
       (Vis_Decl : Node_Id;
!       RAS_Type : Entity_Id);
!    --  Add declaration for TSSs for a given RAS type. PCS-specific ancillary
     --  subprogram for Add_RAST_Features.
  
     --  An RPC_Target record is used during construction of calling stubs
*************** package body Exp_Dist is
*** 491,497 ****
     --    Is_Known_Async... : True if we know that this is asynchronous
     --    Is_Known_Non_A... : True if we know that this is not asynchronous
     --    Spec              : a node with a Parameter_Specifications and
!    --                        a Subtype_Mark if applicable
     --    Stub_Type         : in case of RACW stubs, parameters of type access
     --                        to Stub_Type will be marshalled using the
     --                        address of the object (the addr field) rather
--- 484,490 ----
     --    Is_Known_Async... : True if we know that this is asynchronous
     --    Is_Known_Non_A... : True if we know that this is not asynchronous
     --    Spec              : a node with a Parameter_Specifications and
!    --                        a Result_Definition if applicable
     --    Stub_Type         : in case of RACW stubs, parameters of type access
     --                        to Stub_Type will be marshalled using the
     --                        address of the object (the addr field) rather
*************** package body Exp_Dist is
*** 581,588 ****
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id;
!          Decls    : List_Id);
  
        procedure Build_General_Calling_Stubs
          (Decls                     : List_Id;
--- 574,580 ----
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id);
  
        procedure Build_General_Calling_Stubs
          (Decls                     : List_Id;
*************** package body Exp_Dist is
*** 657,664 ****
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id;
!          Decls    : List_Id);
  
        procedure Build_General_Calling_Stubs
          (Decls                     : List_Id;
--- 649,655 ----
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id);
  
        procedure Build_General_Calling_Stubs
          (Decls                     : List_Id;
*************** package body Exp_Dist is
*** 1174,1184 ****
              --  simple sequence of string comparisons.
  
              RPC_Receiver_Elsif_Parts := New_List;
-             Append_To (RPC_Receiver_Statements,
-               Make_Implicit_If_Statement (Designated_Type,
-                 Condition       => New_Occurrence_Of (Standard_False, Loc),
-                 Then_Statements => New_List,
-                 Elsif_Parts     => RPC_Receiver_Elsif_Parts));
           end if;
        end if;
  
--- 1165,1170 ----
*************** package body Exp_Dist is
*** 1318,1323 ****
--- 1304,1319 ----
        --  Build the case statement and the heart of the subprogram
  
        if not Is_RAS then
+          if Get_PCS_Name = Name_PolyORB_DSA
+            and then Present (First (RPC_Receiver_Elsif_Parts))
+          then
+             Append_To (RPC_Receiver_Statements,
+               Make_Implicit_If_Statement (Designated_Type,
+                 Condition       => New_Occurrence_Of (Standard_False, Loc),
+                 Then_Statements => New_List,
+                 Elsif_Parts     => RPC_Receiver_Elsif_Parts));
+          end if;
+ 
           Append_To (RPC_Receiver_Case_Alternatives,
             Make_Case_Statement_Alternative (Loc,
               Discrete_Choices => New_List (Make_Others_Choice (Loc)),
*************** package body Exp_Dist is
*** 1485,1497 ****
             Make_Function_Specification (Loc,
               Defining_Unit_Name       => Proc,
               Parameter_Specifications => Param_Specs,
!              Subtype_Mark             =>
                 New_Occurrence_Of (
!                  Entity (Subtype_Mark (Spec)), Loc));
  
           Set_Ekind (Proc, E_Function);
           Set_Etype (Proc,
!            New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc));
  
        else
           Proc_Spec :=
--- 1481,1493 ----
             Make_Function_Specification (Loc,
               Defining_Unit_Name       => Proc,
               Parameter_Specifications => Param_Specs,
!              Result_Definition        =>
                 New_Occurrence_Of (
!                  Entity (Result_Definition (Spec)), Loc));
  
           Set_Ekind (Proc, E_Function);
           Set_Etype (Proc,
!            New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));
  
        else
           Proc_Spec :=
*************** package body Exp_Dist is
*** 1716,1735 ****
     procedure Add_RAST_Features (Vis_Decl : Node_Id) is
        RAS_Type : constant Entity_Id :=
                     Equivalent_Type (Defining_Identifier (Vis_Decl));
- 
-       Spec  : constant Node_Id :=
-                 Specification (Unit (Enclosing_Lib_Unit_Node (Vis_Decl)));
-       Decls : List_Id := Private_Declarations (Spec);
- 
     begin
        pragma Assert (No (TSS (RAS_Type, TSS_RAS_Access)));
- 
-       if No (Decls) then
-          Decls := Visible_Declarations (Spec);
-       end if;
- 
        Add_RAS_Dereference_TSS (Vis_Decl);
!       Specific_Add_RAST_Features (Vis_Decl, RAS_Type, Decls);
     end Add_RAST_Features;
  
     -------------------
--- 1712,1721 ----
     procedure Add_RAST_Features (Vis_Decl : Node_Id) is
        RAS_Type : constant Entity_Id :=
                     Equivalent_Type (Defining_Identifier (Vis_Decl));
     begin
        pragma Assert (No (TSS (RAS_Type, TSS_RAS_Access)));
        Add_RAS_Dereference_TSS (Vis_Decl);
!       Specific_Add_RAST_Features (Vis_Decl, RAS_Type);
     end Add_RAST_Features;
  
     -------------------
*************** package body Exp_Dist is
*** 1866,1872 ****
                Prefix =>
                  New_Occurrence_Of (Pointer, Loc),
                Selector_Name =>
!                 New_Occurrence_Of (Tag_Component
                    (Designated_Type (Etype (Pointer))), Loc)),
            Expression =>
              Make_Attribute_Reference (Loc,
--- 1852,1858 ----
                Prefix =>
                  New_Occurrence_Of (Pointer, Loc),
                Selector_Name =>
!                 New_Occurrence_Of (First_Tag_Component
                    (Designated_Type (Etype (Pointer))), Loc)),
            Expression =>
              Make_Attribute_Reference (Loc,
*************** package body Exp_Dist is
*** 2328,2335 ****
                    Make_Defining_Identifier (Loc,
                      Chars => Name_For_New_Spec),
                  Parameter_Specifications => Parameters,
!                 Subtype_Mark             =>
!                   New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc));
  
           when N_Procedure_Specification | N_Access_Procedure_Definition =>
              return
--- 2314,2321 ----
                    Make_Defining_Identifier (Loc,
                      Chars => Name_For_New_Spec),
                  Parameter_Specifications => Parameters,
!                 Result_Definition        =>
!                   New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));
  
           when N_Procedure_Specification | N_Access_Procedure_Definition =>
              return
*************** package body Exp_Dist is
*** 3245,3251 ****
                   Parameter_Type      =>
                     New_Occurrence_Of (Standard_Boolean, Loc))),
  
!             Subtype_Mark =>
                New_Occurrence_Of (Fat_Type, Loc));
  
           --  Set the kind and return type of the function to prevent
--- 3231,3237 ----
                   Parameter_Type      =>
                     New_Occurrence_Of (Standard_Boolean, Loc))),
  
!             Result_Definition =>
                New_Occurrence_Of (Fat_Type, Loc));
  
           --  Set the kind and return type of the function to prevent
*************** package body Exp_Dist is
*** 3271,3281 ****
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id;
!          Decls    : List_Id)
        is
           pragma Warnings (Off);
!          pragma Unreferenced (RAS_Type, Decls);
           pragma Warnings (On);
        begin
           Add_RAS_Access_TSS (Vis_Decl);
--- 3257,3266 ----
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id)
        is
           pragma Warnings (Off);
!          pragma Unreferenced (RAS_Type);
           pragma Warnings (On);
        begin
           Add_RAS_Access_TSS (Vis_Decl);
*************** package body Exp_Dist is
*** 3433,3439 ****
                         True,
                       Parameter_Type =>
                         New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))),
!                  Subtype_Mark =>
                     New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)));
           Append_To (Decls, Current_Declaration);
           Analyze (Current_Declaration);
--- 3418,3424 ----
                         True,
                       Parameter_Type =>
                         New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))),
!                  Result_Definition =>
                     New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)));
           Append_To (Decls, Current_Declaration);
           Analyze (Current_Declaration);
*************** package body Exp_Dist is
*** 4008,4014 ****
                         Make_Attribute_Reference (Loc,
                           Prefix         =>
                             New_Occurrence_Of (
!                              Etype (Subtype_Mark (Spec)), Loc),
  
                           Attribute_Name => Name_Input,
  
--- 3993,3999 ----
                         Make_Attribute_Reference (Loc,
                           Prefix         =>
                             New_Occurrence_Of (
!                              Etype (Result_Definition (Spec)), Loc),
  
                           Attribute_Name => Name_Input,
  
*************** package body Exp_Dist is
*** 4622,4628 ****
  
              declare
                 Etyp   : constant Entity_Id :=
!                           Etype (Subtype_Mark (Specification (Vis_Decl)));
                 Result : constant Node_Id   :=
                            Make_Defining_Identifier (Loc,
                               New_Internal_Name ('R'));
--- 4607,4613 ----
  
              declare
                 Etyp   : constant Entity_Id :=
!                           Etype (Result_Definition (Specification (Vis_Decl)));
                 Result : constant Node_Id   :=
                            Make_Defining_Identifier (Loc,
                               New_Internal_Name ('R'));
*************** package body Exp_Dist is
*** 4785,4802 ****
                 Selector_Name => Make_Identifier (Loc, Selector_Name));
     end Make_Selected_Component;
  
-    ------------------
-    -- Get_PCS_Name --
-    ------------------
- 
-    function Get_PCS_Name return PCS_Names is
-       PCS_Name : constant PCS_Names :=
-                    Chars (Entity (Expression
-                                     (Parent (RTE (RE_DSA_Implementation)))));
-    begin
-       return PCS_Name;
-    end Get_PCS_Name;
- 
     -----------------------
     -- Get_Subprogram_Id --
     -----------------------
--- 4770,4775 ----
*************** package body Exp_Dist is
*** 4901,4907 ****
            Specification              => Make_Function_Specification (Loc,
              Defining_Unit_Name =>
                Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
!             Subtype_Mark       => New_Occurrence_Of (Var_Type, Loc)),
            Declarations               => No_List,
            Handled_Statement_Sequence =>
              Make_Handled_Sequence_Of_Statements (Loc, New_List (
--- 4874,4880 ----
            Specification              => Make_Function_Specification (Loc,
              Defining_Unit_Name =>
                Make_Defining_Identifier (Loc, New_Internal_Name ('S')),
!             Result_Definition  => New_Occurrence_Of (Var_Type, Loc)),
            Declarations               => No_List,
            Handled_Statement_Sequence =>
              Make_Handled_Sequence_Of_Statements (Loc, New_List (
*************** package body Exp_Dist is
*** 5111,5129 ****
           Declarations    : List_Id);
        --  Add the TypeCode TSS for this RACW type
  
!       procedure Add_RAS_From_Any
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id);
        --  Add the From_Any TSS for this RAS type
  
!       procedure Add_RAS_To_Any
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id);
        --  Add the To_Any TSS for this RAS type
  
!       procedure Add_RAS_TypeCode
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id);
        --  Add the TypeCode TSS for this RAS type
  
        procedure Add_RAS_Access_TSS (N : Node_Id);
--- 5084,5096 ----
           Declarations    : List_Id);
        --  Add the TypeCode TSS for this RACW type
  
!       procedure Add_RAS_From_Any (RAS_Type : Entity_Id);
        --  Add the From_Any TSS for this RAS type
  
!       procedure Add_RAS_To_Any   (RAS_Type : Entity_Id);
        --  Add the To_Any TSS for this RAS type
  
!       procedure Add_RAS_TypeCode (RAS_Type : Entity_Id);
        --  Add the TypeCode TSS for this RAS type
  
        procedure Add_RAS_Access_TSS (N : Node_Id);
*************** package body Exp_Dist is
*** 5447,5453 ****
                     Any_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RTE (RE_Any), Loc))),
!              Subtype_Mark => New_Occurrence_Of (RACW_Type, Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not those
--- 5414,5420 ----
                     Any_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RTE (RE_Any), Loc))),
!              Result_Definition => New_Occurrence_Of (RACW_Type, Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not those
*************** package body Exp_Dist is
*** 5467,5473 ****
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, Name_uFrom_Any);
        end Add_RACW_From_Any;
  
        -----------------------------
--- 5434,5440 ----
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, TSS_From_Any);
        end Add_RACW_From_Any;
  
        -----------------------------
*************** package body Exp_Dist is
*** 5761,5767 ****
                     RACW_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RACW_Type, Loc))),
!              Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not in
--- 5728,5734 ----
                     RACW_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RACW_Type, Loc))),
!              Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not in
*************** package body Exp_Dist is
*** 5781,5787 ****
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, Name_uTo_Any);
        end Add_RACW_To_Any;
  
        -----------------------
--- 5748,5754 ----
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, TSS_To_Any);
        end Add_RACW_To_Any;
  
        -----------------------
*************** package body Exp_Dist is
*** 5805,5813 ****
           Func_Decl : Node_Id;
           Func_Body : Node_Id;
  
-          RACW_Parameter : constant Entity_Id :=
-                             Make_Defining_Identifier (Loc, Name_R);
- 
        begin
           Fnam :=
             Make_Defining_Identifier (Loc,
--- 5772,5777 ----
*************** package body Exp_Dist is
*** 5820,5834 ****
             Make_Function_Specification (Loc,
               Defining_Unit_Name =>
                 Fnam,
!              Parameter_Specifications => New_List (
!                Make_Parameter_Specification (Loc,
!                  Defining_Identifier =>
!                    RACW_Parameter,
!                  Parameter_Type =>
!                    Make_Access_Definition (Loc,
!                      Subtype_Mark =>
!                        New_Occurrence_Of (RACW_Type, Loc)))),
!              Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not those
--- 5784,5790 ----
             Make_Function_Specification (Loc,
               Defining_Unit_Name =>
                 Fnam,
!              Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
  
           --  NOTE: The usage occurrences of RACW_Parameter must
           --  refer to the entity in the declaration spec, not those
*************** package body Exp_Dist is
*** 5855,5861 ****
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, Name_uTypeCode);
        end Add_RACW_TypeCode;
  
        ------------------------------
--- 5811,5817 ----
           Insert_After (Declaration_Node (RACW_Type), Func_Decl);
           Append_To (Declarations, Func_Body);
  
!          Set_Renaming_TSS (RACW_Type, Fnam, TSS_TypeCode);
        end Add_RACW_TypeCode;
  
        ------------------------------
*************** package body Exp_Dist is
*** 5957,5974 ****
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id;
!          Decls    : List_Id)
        is
        begin
           Add_RAS_Access_TSS (Vis_Decl);
  
!          Add_RAS_From_Any (RAS_Type, Decls);
!          Add_RAS_TypeCode (RAS_Type, Decls);
  
           --  To_Any uses TypeCode, and therefore needs to be generated last
  
!          Add_RAS_To_Any (RAS_Type, Decls);
        end Add_RAST_Features;
  
        ------------------------
--- 5913,5929 ----
  
        procedure Add_RAST_Features
          (Vis_Decl : Node_Id;
!          RAS_Type : Entity_Id)
        is
        begin
           Add_RAS_Access_TSS (Vis_Decl);
  
!          Add_RAS_From_Any (RAS_Type);
!          Add_RAS_TypeCode (RAS_Type);
  
           --  To_Any uses TypeCode, and therefore needs to be generated last
  
!          Add_RAS_To_Any   (RAS_Type);
        end Add_RAST_Features;
  
        ------------------------
*************** package body Exp_Dist is
*** 6282,6288 ****
                   Parameter_Type      =>
                     New_Occurrence_Of (Standard_Boolean, Loc))),
  
!             Subtype_Mark =>
                New_Occurrence_Of (Fat_Type, Loc));
  
           --  Set the kind and return type of the function to prevent
--- 6237,6243 ----
                   Parameter_Type      =>
                     New_Occurrence_Of (Standard_Boolean, Loc))),
  
!             Result_Definition =>
                New_Occurrence_Of (Fat_Type, Loc));
  
           --  Set the kind and return type of the function to prevent
*************** package body Exp_Dist is
*** 6306,6323 ****
        -- Add_RAS_From_Any --
        ----------------------
  
!       procedure Add_RAS_From_Any
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id)
!       is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : constant Entity_Id :=
!                   Make_Defining_Identifier (Loc, New_Internal_Name ('F'));
  
           Func_Spec : Node_Id;
-          Func_Decl : Node_Id;
-          Func_Body : Node_Id;
  
           Statements : List_Id;
  
--- 6261,6273 ----
        -- Add_RAS_From_Any --
        ----------------------
  
!       procedure Add_RAS_From_Any (RAS_Type : Entity_Id) is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
!                   Make_TSS_Name (RAS_Type, TSS_From_Any));
  
           Func_Spec : Node_Id;
  
           Statements : List_Id;
  
*************** package body Exp_Dist is
*** 6349,6395 ****
                     Any_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RTE (RE_Any), Loc))),
!              Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc));
! 
!          --  NOTE: The usage occurrences of RACW_Parameter must
!          --  refer to the entity in the declaration spec, not those
!          --  of the body spec.
! 
!          Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
  
!          Func_Body :=
             Make_Subprogram_Body (Loc,
!              Specification              =>
!                Copy_Specification (Loc, Func_Spec),
               Declarations               => No_List,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => Statements));
! 
!          Insert_After (Declaration_Node (RAS_Type), Func_Decl);
!          Append_To (Declarations, Func_Body);
! 
!          Set_Renaming_TSS (RAS_Type, Fnam, Name_uFrom_Any);
        end Add_RAS_From_Any;
  
        --------------------
        -- Add_RAS_To_Any --
        --------------------
  
!       procedure Add_RAS_To_Any
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id)
!       is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : Entity_Id;
  
!          Decls : List_Id;
           Statements : List_Id;
  
           Func_Spec : Node_Id;
-          Func_Decl : Node_Id;
-          Func_Body : Node_Id;
  
           Any            : constant Entity_Id :=
                              Make_Defining_Identifier (Loc,
--- 6299,6330 ----
                     Any_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RTE (RE_Any), Loc))),
!              Result_Definition => New_Occurrence_Of (RAS_Type, Loc));
  
!          Discard_Node (
             Make_Subprogram_Body (Loc,
!              Specification              => Func_Spec,
               Declarations               => No_List,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => Statements)));
!          Set_TSS (RAS_Type, Fnam);
        end Add_RAS_From_Any;
  
        --------------------
        -- Add_RAS_To_Any --
        --------------------
  
!       procedure Add_RAS_To_Any (RAS_Type : Entity_Id) is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
!                   Make_TSS_Name (RAS_Type, TSS_To_Any));
  
!          Decls      : List_Id;
           Statements : List_Id;
  
           Func_Spec : Node_Id;
  
           Any            : constant Entity_Id :=
                              Make_Defining_Identifier (Loc,
*************** package body Exp_Dist is
*** 6428,6436 ****
               Expression =>
                 New_Occurrence_Of (Any, Loc)));
  
-          Fnam := Make_Defining_Identifier (
-            Loc, New_Internal_Name ('T'));
- 
           Func_Spec :=
             Make_Function_Specification (Loc,
               Defining_Unit_Name =>
--- 6363,6368 ----
*************** package body Exp_Dist is
*** 6441,6526 ****
                     RAS_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RAS_Type, Loc))),
!              Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
! 
!          --  NOTE: The usage occurrences of RAS_Parameter must
!          --  refer to the entity in the declaration spec, not in
!          --  the body spec.
! 
!          Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
  
!          Func_Body :=
             Make_Subprogram_Body (Loc,
!              Specification              =>
!                Copy_Specification (Loc, Func_Spec),
               Declarations               => Decls,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => Statements));
! 
!          Insert_After (Declaration_Node (RAS_Type), Func_Decl);
!          Append_To (Declarations, Func_Body);
! 
!          Set_Renaming_TSS (RAS_Type, Fnam, Name_uTo_Any);
        end Add_RAS_To_Any;
  
        ----------------------
        -- Add_RAS_TypeCode --
        ----------------------
  
!       procedure Add_RAS_TypeCode
!         (RAS_Type     : Entity_Id;
!          Declarations : List_Id)
!       is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : Entity_Id;
  
           Func_Spec : Node_Id;
-          Func_Decl : Node_Id;
-          Func_Body : Node_Id;
  
           Decls : constant List_Id := New_List;
           Name_String, Repo_Id_String : String_Id;
  
-          RAS_Parameter : constant Entity_Id :=
-                            Make_Defining_Identifier (Loc, Name_R);
- 
        begin
- 
-          Fnam :=
-            Make_Defining_Identifier (Loc,
-              Chars => New_Internal_Name ('T'));
- 
-          --  The spec for this subprogram has a dummy 'access RAS'
-          --  argument, which serves only for overloading purposes.
- 
           Func_Spec :=
             Make_Function_Specification (Loc,
               Defining_Unit_Name =>
                 Fnam,
!              Parameter_Specifications => New_List (
!                Make_Parameter_Specification (Loc,
!                  Defining_Identifier =>
!                    RAS_Parameter,
!                  Parameter_Type =>
!                    Make_Access_Definition (Loc,
!                      Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc)))),
!              Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
! 
!          --  NOTE: The usage occurrences of RAS_Parameter must
!          --  refer to the entity in the declaration spec, not those
!          --  of the body spec.
! 
!          Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
  
           PolyORB_Support.Helpers.Build_Name_And_Repository_Id
             (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String);
  
!          Func_Body :=
             Make_Subprogram_Body (Loc,
!              Specification              =>
!                Copy_Specification (Loc, Func_Spec),
               Declarations               => Decls,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
--- 6373,6418 ----
                     RAS_Parameter,
                   Parameter_Type =>
                     New_Occurrence_Of (RAS_Type, Loc))),
!              Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
  
!          Discard_Node (
             Make_Subprogram_Body (Loc,
!              Specification              => Func_Spec,
               Declarations               => Decls,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
!                  Statements => Statements)));
!          Set_TSS (RAS_Type, Fnam);
        end Add_RAS_To_Any;
  
        ----------------------
        -- Add_RAS_TypeCode --
        ----------------------
  
!       procedure Add_RAS_TypeCode (RAS_Type : Entity_Id) is
           Loc : constant Source_Ptr := Sloc (RAS_Type);
  
!          Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
!                   Make_TSS_Name (RAS_Type, TSS_TypeCode));
  
           Func_Spec : Node_Id;
  
           Decls : constant List_Id := New_List;
           Name_String, Repo_Id_String : String_Id;
  
        begin
           Func_Spec :=
             Make_Function_Specification (Loc,
               Defining_Unit_Name =>
                 Fnam,
!              Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
  
           PolyORB_Support.Helpers.Build_Name_And_Repository_Id
             (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String);
  
!          Discard_Node (
             Make_Subprogram_Body (Loc,
!              Specification              => Func_Spec,
               Declarations               => Decls,
               Handled_Statement_Sequence =>
                 Make_Handled_Sequence_Of_Statements (Loc,
*************** package body Exp_Dist is
*** 6545,6556 ****
                                       RTE (RE_TA_String), Loc),
                                     Parameter_Associations => New_List (
                                       Make_String_Literal (Loc,
!                                        Repo_Id_String)))))))))));
! 
!          Insert_After (Declaration_Node (RAS_Type), Func_Decl);
!          Append_To (Declarations, Func_Body);
! 
!          Set_Renaming_TSS (RAS_Type, Fnam, Name_uTypeCode);
        end Add_RAS_TypeCode;
  
        -----------------------------------------
--- 6437,6444 ----
                                       RTE (RE_TA_String), Loc),
                                     Parameter_Associations => New_List (
                                       Make_String_Literal (Loc,
!                                        Repo_Id_String))))))))))));
!          Set_TSS (RAS_Type, Fnam);
        end Add_RAS_TypeCode;
  
        -----------------------------------------
*************** package body Exp_Dist is
*** 7107,7113 ****
  
           if Is_Function then
              Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
!               Etype (Subtype_Mark (Spec)), Decls);
           else
              Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc);
           end if;
--- 6995,7001 ----
  
           if Is_Function then
              Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
!               Etype (Result_Definition (Spec)), Decls);
           else
              Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc);
           end if;
*************** package body Exp_Dist is
*** 7404,7410 ****
                   Make_Tag_Check (Loc,
                     Make_Return_Statement (Loc,
                       PolyORB_Support.Helpers.Build_From_Any_Call (
!                          Etype (Subtype_Mark (Spec)),
                           Make_Selected_Component (Loc,
                             Prefix        => Result,
                             Selector_Name => Name_Argument),
--- 7292,7298 ----
                   Make_Tag_Check (Loc,
                     Make_Return_Statement (Loc,
                       PolyORB_Support.Helpers.Build_From_Any_Call (
!                          Etype (Result_Definition (Spec)),
                           Make_Selected_Component (Loc,
                             Prefix        => Result,
                             Selector_Name => Name_Argument),
*************** package body Exp_Dist is
*** 7981,7987 ****
  
              declare
                 Etyp   : constant Entity_Id :=
!                           Etype (Subtype_Mark (Specification (Vis_Decl)));
                 Result : constant Node_Id   :=
                            Make_Defining_Identifier (Loc,
                              New_Internal_Name ('R'));
--- 7869,7875 ----
  
              declare
                 Etyp   : constant Entity_Id :=
!                           Etype (Result_Definition (Specification (Vis_Decl)));
                 Result : constant Node_Id   :=
                            Make_Defining_Identifier (Loc,
                              New_Internal_Name ('R'));
*************** package body Exp_Dist is
*** 8099,8111 ****
           -- Local Subprograms --
           -----------------------
  
-          function Find_Inherited_TSS
-            (Typ : Entity_Id;
-             Nam : Name_Id) return Entity_Id;
-          --  A TSS reference for a representation aspect of a derived tagged
-          --  type must take into account inheritance of that aspect from
-          --  ancestor types. (copied from exp_attr.adb, should be shared???)
- 
           function Find_Numeric_Representation
             (Typ : Entity_Id) return Entity_Id;
           --  Given a numeric type Typ, return the smallest integer or floarting
--- 7987,7992 ----
*************** package body Exp_Dist is
*** 8236,8242 ****
              --  First simple case where the From_Any function is present
              --  in the type's TSS.
  
!             Fnam := Find_Inherited_TSS (U_Type, Name_uFrom_Any);
  
              if Sloc (U_Type) <= Standard_Location then
                 U_Type := Base_Type (U_Type);
--- 8117,8123 ----
              --  First simple case where the From_Any function is present
              --  in the type's TSS.
  
!             Fnam := Find_Inherited_TSS (U_Type, TSS_From_Any);
  
              if Sloc (U_Type) <= Standard_Location then
                 U_Type := Base_Type (U_Type);
*************** package body Exp_Dist is
*** 8367,8380 ****
                        Any_Parameter,
                      Parameter_Type =>
                        New_Occurrence_Of (RTE (RE_Any), Loc))),
!                 Subtype_Mark => New_Occurrence_Of (Typ, Loc));
  
              --  The following  is taken care of by Exp_Dist.Add_RACW_From_Any
  
              pragma Assert
                (not (Is_Remote_Access_To_Class_Wide_Type (Typ)));
  
- 
              if Is_Derived_Type (Typ)
                and then not Is_Tagged_Type (Typ)
              then
--- 8248,8260 ----
                        Any_Parameter,
                      Parameter_Type =>
                        New_Occurrence_Of (RTE (RE_Any), Loc))),
!                 Result_Definition => New_Occurrence_Of (Typ, Loc));
  
              --  The following  is taken care of by Exp_Dist.Add_RACW_From_Any
  
              pragma Assert
                (not (Is_Remote_Access_To_Class_Wide_Type (Typ)));
  
              if Is_Derived_Type (Typ)
                and then not Is_Tagged_Type (Typ)
              then
*************** package body Exp_Dist is
*** 9017,9023 ****
              --  First simple case where the To_Any function is present
              --  in the type's TSS.
  
!             Fnam := Find_Inherited_TSS (U_Type, Name_uTo_Any);
  
              --  Check first for Boolean and Character. These are enumeration
              --  types, but we treat them specially, since they may require
--- 8897,8903 ----
              --  First simple case where the To_Any function is present
              --  in the type's TSS.
  
!             Fnam := Find_Inherited_TSS (U_Type, TSS_To_Any);
  
              --  Check first for Boolean and Character. These are enumeration
              --  types, but we treat them specially, since they may require
*************** package body Exp_Dist is
*** 9159,9165 ****
                        Expr_Parameter,
                      Parameter_Type =>
                        New_Occurrence_Of (Typ, Loc))),
!                 Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc));
              Set_Etype (Expr_Parameter, Typ);
  
              Any_Decl :=
--- 9039,9045 ----
                        Expr_Parameter,
                      Parameter_Type =>
                        New_Occurrence_Of (Typ, Loc))),
!                 Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
              Set_Etype (Expr_Parameter, Typ);
  
              Any_Decl :=
*************** package body Exp_Dist is
*** 9668,9676 ****
              --  if Typ is incomplete.
  
              Fnam    : Entity_Id := Empty;
-             Tnam    : Entity_Id := Empty;
-             Pnam    : Entity_Id := Empty;
-             Args    : List_Id := Empty_List;
              Lib_RE  : RE_Id := RE_Null;
  
              Expr : Node_Id;
--- 9548,9553 ----
*************** package body Exp_Dist is
*** 9686,9729 ****
                 --  First simple case where the TypeCode is present
                 --  in the type's TSS.
  
!                Fnam := Find_Inherited_TSS (U_Type, Name_uTypeCode);
! 
!                if Present (Fnam) then
! 
!                   --  When a TypeCode TSS exists, it has a single parameter
!                   --  that is an anonymous access to the corresponding type.
!                   --  This parameter is not used in any way; its purpose is
!                   --  solely to provide overloading of the TSS.
! 
!                   Tnam :=
!                     Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
!                   Pnam :=
!                     Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
! 
!                   Append_To (Decls,
!                     Make_Full_Type_Declaration (Loc,
!                       Defining_Identifier => Tnam,
!                       Type_Definition =>
!                         Make_Access_To_Object_Definition (Loc,
!                           Subtype_Indication =>
!                             New_Occurrence_Of (U_Type, Loc))));
!                   Append_To (Decls,
!                     Make_Object_Declaration (Loc,
!                       Defining_Identifier => Pnam,
!                       Constant_Present    => True,
!                       Object_Definition   => New_Occurrence_Of (Tnam, Loc),
! 
!                      --  Use a variable here to force proper freezing of Tnam
! 
!                       Expression          => Make_Null (Loc)));
! 
!                   --  Normally, calling _TypeCode with a null access parameter
!                   --  should raise Constraint_Error, but this check is
!                   --  suppressed for expanded code, and we do not care anyway
!                   --  because we do not actually ever use this value.
! 
!                   Args := New_List (New_Occurrence_Of (Pnam, Loc));
!                end if;
              end if;
  
              if No (Fnam) then
--- 9563,9569 ----
                 --  First simple case where the TypeCode is present
                 --  in the type's TSS.
  
!                Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode);
              end if;
  
              if No (Fnam) then
*************** package body Exp_Dist is
*** 9735,9745 ****
                    U_Type := Base_Type (U_Type);
                 end if;
  
-                if Is_Itype (U_Type) then
-                   return Build_TypeCode_Call
-                     (Loc, Associated_Node_For_Itype (U_Type), Decls);
-                end if;
- 
                 if U_Type = Standard_Boolean then
                    Lib_RE := RE_TC_B;
  
--- 9575,9580 ----
*************** package body Exp_Dist is
*** 9822,9830 ****
              --  Call the function
  
              Expr :=
!               Make_Function_Call (Loc,
!                 Name => New_Occurrence_Of (Fnam, Loc),
!                 Parameter_Associations => Args);
  
              --  Allow Expr to be used as arg to Build_To_Any_Call immediately
  
--- 9657,9663 ----
              --  Call the function
  
              Expr :=
!               Make_Function_Call (Loc, Name => New_Occurrence_Of (Fnam, Loc));
  
              --  Allow Expr to be used as arg to Build_To_Any_Call immediately
  
*************** package body Exp_Dist is
*** 10191,10197 ****
                Make_Function_Specification (Loc,
                  Defining_Unit_Name => Fnam,
                  Parameter_Specifications => Empty_List,
!                 Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
  
              Build_Name_And_Repository_Id (Typ,
                Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str);
--- 10024,10031 ----
                Make_Function_Specification (Loc,
                  Defining_Unit_Name => Fnam,
                  Parameter_Specifications => Empty_List,
!                 Result_Definition =>
!                   New_Occurrence_Of (RTE (RE_TypeCode), Loc));
  
              Build_Name_And_Repository_Id (Typ,
                Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str);
*************** package body Exp_Dist is
*** 10202,10219 ****
                and then not Is_Tagged_Type (Typ)
              then
                 declare
-                   D_Node : constant Node_Id := Declaration_Node (Typ);
                    Parent_Type : Entity_Id := Etype (Typ);
                 begin
  
!                   if Is_Enumeration_Type (Typ)
!                     and then Nkind (D_Node) = N_Subtype_Declaration
!                     and then Nkind (Original_Node (D_Node))
!                     /= N_Subtype_Declaration
!                   then
  
!                      --  Parent_Type is the implicit intermediate base type
!                      --  created by Build_Derived_Enumeration_Type.
  
                       Parent_Type := Etype (Parent_Type);
                    end if;
--- 10036,10047 ----
                and then not Is_Tagged_Type (Typ)
              then
                 declare
                    Parent_Type : Entity_Id := Etype (Typ);
                 begin
  
!                   if Is_Itype (Parent_Type) then
  
!                      --  Skip implicit base type
  
                       Parent_Type := Etype (Parent_Type);
                    end if;
*************** package body Exp_Dist is
*** 10346,10403 ****
                      Statements => Stms));
           end Build_TypeCode_Function;
  
-          ------------------------
-          -- Find_Inherited_TSS --
-          ------------------------
- 
-          function Find_Inherited_TSS
-            (Typ : Entity_Id;
-             Nam : Name_Id) return Entity_Id
-          is
-             P_Type : Entity_Id := Typ;
-             Proc   : Entity_Id;
- 
-          begin
-             Proc :=  TSS (Base_Type (Typ), Nam);
- 
-             --  Check first if there is a TSS given for the type itself
- 
-             if Present (Proc) then
-                return Proc;
-             end if;
- 
-             --  If Typ is a derived type, it may inherit attributes from some
-             --  ancestor which is not the ultimate underlying one. If Typ is a
-             --  derived tagged type, The corresponding primitive operation has
-             --  been created explicitly.
- 
-             if Is_Derived_Type (P_Type) then
-                if Is_Tagged_Type (P_Type) then
-                   return Find_Prim_Op (P_Type, Nam);
-                else
-                   while Is_Derived_Type (P_Type) loop
-                      Proc :=  TSS (Base_Type (Etype (Typ)), Nam);
- 
-                      if Present (Proc) then
-                         return Proc;
-                      else
-                         P_Type := Base_Type (Etype (P_Type));
-                      end if;
-                   end loop;
-                end if;
-             end if;
- 
-             --  If nothing else, use the TSS of the root type
- 
-             return TSS (Base_Type (Underlying_Type (Typ)), Nam);
-          end Find_Inherited_TSS;
- 
           ---------------------------------
           -- Find_Numeric_Representation --
           ---------------------------------
  
!          function Find_Numeric_Representation (Typ : Entity_Id)
!            return Entity_Id
           is
              FST    : constant Entity_Id := First_Subtype (Typ);
              P_Size : constant Uint      := Esize (FST);
--- 10174,10185 ----
                      Statements => Stms));
           end Build_TypeCode_Function;
  
           ---------------------------------
           -- Find_Numeric_Representation --
           ---------------------------------
  
!          function Find_Numeric_Representation
!            (Typ : Entity_Id) return Entity_Id
           is
              FST    : constant Entity_Id := First_Subtype (Typ);
              P_Size : constant Uint      := Esize (FST);
*************** package body Exp_Dist is
*** 10505,10530 ****
              Append_To (Indices,
                Make_Identifier (Loc, New_External_Name ('L', Depth)));
  
!             if Constrained then
!                Inner_Any := Any;
!                Inner_Counter := Counter;
!             else
                 Inner_Any := Make_Defining_Identifier (Loc,
!                  New_External_Name ('A', Depth));
                 Set_Etype (Inner_Any, RTE (RE_Any));
  
!                if Present (Counter) then
!                   Inner_Counter := Make_Defining_Identifier (Loc,
!                     New_External_Name ('J', Depth));
!                else
!                   Inner_Counter := Empty;
!                end if;
              end if;
  
!             Append_Array_Traversal (Inner_Stmts,
!               Any     => Inner_Any,
!               Counter => Inner_Counter,
!               Depth   => Depth + 1);
  
              Loop_Stm :=
                Make_Implicit_Loop_Statement (Subprogram,
--- 10287,10324 ----
              Append_To (Indices,
                Make_Identifier (Loc, New_External_Name ('L', Depth)));
  
!             if not Constrained or else Depth > 1 then
                 Inner_Any := Make_Defining_Identifier (Loc,
!                               New_External_Name ('A', Depth));
                 Set_Etype (Inner_Any, RTE (RE_Any));
+             else
+                Inner_Any := Empty;
+             end if;
  
!             if Present (Counter) then
!                Inner_Counter := Make_Defining_Identifier (Loc,
!                                   New_External_Name ('J', Depth));
!             else
!                Inner_Counter := Empty;
              end if;
  
!             declare
!                Loop_Any : Node_Id := Inner_Any;
!             begin
! 
!                --  For the first dimension of a constrained array, we add
!                --  elements directly in the corresponding Any; there is no
!                --  intervening inner Any.
! 
!                if No (Loop_Any) then
!                   Loop_Any := Any;
!                end if;
! 
!                Append_Array_Traversal (Inner_Stmts,
!                  Any     => Loop_Any,
!                  Counter => Inner_Counter,
!                  Depth   => Depth + 1);
!             end;
  
              Loop_Stm :=
                Make_Implicit_Loop_Statement (Subprogram,
*************** package body Exp_Dist is
*** 10545,10555 ****
                                Make_Integer_Literal (Loc, Depth))))),
                  Statements => Inner_Stmts);
  
-             if Constrained then
-                Append_To (Stmts, Loop_Stm);
-                return;
-             end if;
- 
              declare
                 Decls       : constant List_Id := New_List;
                 Dimen_Stmts : constant List_Id := New_List;
--- 10339,10344 ----
*************** package body Exp_Dist is
*** 10563,10575 ****
  
              begin
                 if Depth = 1 then
!                   Inner_Any_TypeCode_Expr :=
!                     Make_Function_Call (Loc,
!                       Name =>
!                         New_Occurrence_Of (RTE (RE_Any_Member_Type), Loc),
!                       Parameter_Associations => New_List (
!                         New_Occurrence_Of (Any, Loc),
!                         Make_Integer_Literal (Loc, Ndim)));
                 else
                    Inner_Any_TypeCode_Expr :=
                      Make_Function_Call (Loc,
--- 10352,10373 ----
  
              begin
                 if Depth = 1 then
!                   if Constrained then
!                      Inner_Any_TypeCode_Expr :=
!                        Make_Function_Call (Loc,
!                          Name =>
!                            New_Occurrence_Of (RTE (RE_Get_TC), Loc),
!                          Parameter_Associations => New_List (
!                            New_Occurrence_Of (Any, Loc)));
!                   else
!                      Inner_Any_TypeCode_Expr :=
!                        Make_Function_Call (Loc,
!                          Name =>
!                            New_Occurrence_Of (RTE (RE_Any_Member_Type), Loc),
!                              Parameter_Associations => New_List (
!                                New_Occurrence_Of (Any, Loc),
!                                Make_Integer_Literal (Loc, Ndim)));
!                   end if;
                 else
                    Inner_Any_TypeCode_Expr :=
                      Make_Function_Call (Loc,
*************** package body Exp_Dist is
*** 10587,10604 ****
                     Object_Definition   => New_Occurrence_Of (
                                              RTE (RE_TypeCode), Loc),
                     Expression          => Inner_Any_TypeCode_Expr));
!                Append_To (Decls,
!                  Make_Object_Declaration (Loc,
!                    Defining_Identifier => Inner_Any,
!                    Object_Definition   =>
!                      New_Occurrence_Of (RTE (RE_Any), Loc),
!                    Expression          =>
!                      Make_Function_Call (Loc,
!                        Name =>
!                          New_Occurrence_Of (
!                            RTE (RE_Create_Any), Loc),
!                        Parameter_Associations => New_List (
!                          New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
  
                 if Present (Inner_Counter) then
                    Append_To (Decls,
--- 10385,10405 ----
                     Object_Definition   => New_Occurrence_Of (
                                              RTE (RE_TypeCode), Loc),
                     Expression          => Inner_Any_TypeCode_Expr));
! 
!                if Present (Inner_Any) then
!                   Append_To (Decls,
!                     Make_Object_Declaration (Loc,
!                       Defining_Identifier => Inner_Any,
!                       Object_Definition   =>
!                         New_Occurrence_Of (RTE (RE_Any), Loc),
!                       Expression          =>
!                         Make_Function_Call (Loc,
!                           Name =>
!                             New_Occurrence_Of (
!                               RTE (RE_Create_Any), Loc),
!                           Parameter_Associations => New_List (
!                             New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
!                end if;
  
                 if Present (Inner_Counter) then
                    Append_To (Decls,
*************** package body Exp_Dist is
*** 10610,10626 ****
                          Make_Integer_Literal (Loc, 0)));
                 end if;
  
!                Length_Node := Make_Attribute_Reference (Loc,
!                      Prefix         => New_Occurrence_Of (Arry, Loc),
!                      Attribute_Name => Name_Length,
!                      Expressions    =>
!                        New_List (Make_Integer_Literal (Loc, Depth)));
!                Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
  
!                Add_Process_Element (Dimen_Stmts,
!                  Datum   => Length_Node,
!                  Any     => Inner_Any,
!                  Counter => Inner_Counter);
  
                 --  Loop_Stm does approrpriate processing for each element
                 --  of Inner_Any.
--- 10411,10429 ----
                          Make_Integer_Literal (Loc, 0)));
                 end if;
  
!                if not Constrained then
!                   Length_Node := Make_Attribute_Reference (Loc,
!                         Prefix         => New_Occurrence_Of (Arry, Loc),
!                         Attribute_Name => Name_Length,
!                         Expressions    =>
!                           New_List (Make_Integer_Literal (Loc, Depth)));
!                   Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
  
!                   Add_Process_Element (Dimen_Stmts,
!                     Datum   => Length_Node,
!                     Any     => Inner_Any,
!                     Counter => Inner_Counter);
!                end if;
  
                 --  Loop_Stm does approrpriate processing for each element
                 --  of Inner_Any.
*************** package body Exp_Dist is
*** 10629,10639 ****
  
                 --  Link outer and inner any
  
!                Add_Process_Element (Dimen_Stmts,
!                  Any     => Any,
!                  Counter => Counter,
!                  Datum   => New_Occurrence_Of (Inner_Any, Loc));
! 
  
                 Append_To (Stmts,
                   Make_Block_Statement (Loc,
--- 10432,10443 ----
  
                 --  Link outer and inner any
  
!                if Present (Inner_Any) then
!                   Add_Process_Element (Dimen_Stmts,
!                     Any     => Any,
!                     Counter => Counter,
!                     Datum   => New_Occurrence_Of (Inner_Any, Loc));
!                end if;
  
                 Append_To (Stmts,
                   Make_Block_Statement (Loc,
*************** package body Exp_Dist is
*** 10752,10760 ****
     -------------------
  
     function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is
!       Unit_Name : Node_Id := Defining_Unit_Name (Spec);
  
     begin
        while Nkind (Unit_Name) /= N_Defining_Identifier loop
           Unit_Name := Defining_Identifier (Unit_Name);
        end loop;
--- 10556,10565 ----
     -------------------
  
     function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is
!       Unit_Name : Node_Id;
  
     begin
+       Unit_Name := Defining_Unit_Name (Spec);
        while Nkind (Unit_Name) /= N_Defining_Identifier loop
           Unit_Name := Defining_Identifier (Unit_Name);
        end loop;
*************** package body Exp_Dist is
*** 10769,10775 ****
     procedure Set_Renaming_TSS
       (Typ     : Entity_Id;
        Nam     : Entity_Id;
!       TSS_Nam : Name_Id)
     is
        Loc  : constant Source_Ptr := Sloc (Nam);
        Spec : constant Node_Id := Parent (Nam);
--- 10574,10580 ----
     procedure Set_Renaming_TSS
       (Typ     : Entity_Id;
        Nam     : Entity_Id;
!       TSS_Nam : TSS_Name_Type)
     is
        Loc  : constant Source_Ptr := Sloc (Nam);
        Spec : constant Node_Id := Parent (Nam);
*************** package body Exp_Dist is
*** 10779,10785 ****
                       Specification =>
                         Copy_Specification (Loc,
                           Spec     => Spec,
!                          New_Name => TSS_Nam),
                         Name => New_Occurrence_Of (Nam, Loc));
  
        Snam : constant Entity_Id :=
--- 10584,10590 ----
                       Specification =>
                         Copy_Specification (Loc,
                           Spec     => Spec,
!                          New_Name => Make_TSS_Name (Typ, TSS_Nam)),
                         Name => New_Occurrence_Of (Nam, Loc));
  
        Snam : constant Entity_Id :=
*************** package body Exp_Dist is
*** 10788,10794 ****
     begin
        if Nkind (Spec) = N_Function_Specification then
           Set_Ekind (Snam, E_Function);
!          Set_Etype (Snam, Entity (Subtype_Mark (Spec)));
        else
           Set_Ekind (Snam, E_Procedure);
           Set_Etype (Snam, Standard_Void_Type);
--- 10593,10599 ----
     begin
        if Nkind (Spec) = N_Function_Specification then
           Set_Ekind (Snam, E_Function);
!          Set_Etype (Snam, Entity (Result_Definition (Spec)));
        else
           Set_Ekind (Snam, E_Procedure);
           Set_Etype (Snam, Standard_Void_Type);
*************** package body Exp_Dist is
*** 10855,10871 ****
  
     procedure Specific_Add_RAST_Features
       (Vis_Decl : Node_Id;
!       RAS_Type : Entity_Id;
!       Decls    : List_Id)
!    is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
!             PolyORB_Support.Add_RAST_Features (
!               Vis_Decl, RAS_Type, Decls);
           when others =>
!             GARLIC_Support.Add_RAST_Features (
!               Vis_Decl, RAS_Type, Decls);
        end case;
     end Specific_Add_RAST_Features;
  
--- 10660,10672 ----
  
     procedure Specific_Add_RAST_Features
       (Vis_Decl : Node_Id;
!       RAS_Type : Entity_Id) is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
!             PolyORB_Support.Add_RAST_Features (Vis_Decl, RAS_Type);
           when others =>
!             GARLIC_Support.Add_RAST_Features (Vis_Decl, RAS_Type);
        end case;
     end Specific_Add_RAST_Features;
  
*************** package body Exp_Dist is
*** 10981,10987 ****
       (Loc                   : Source_Ptr;
        Decls                 : List_Id;
        RCI_Locator           : Entity_Id;
!       Controlling_Parameter : Entity_Id) return RPC_Target is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
--- 10782,10789 ----
       (Loc                   : Source_Ptr;
        Decls                 : List_Id;
        RCI_Locator           : Entity_Id;
!       Controlling_Parameter : Entity_Id) return RPC_Target
!    is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
*************** package body Exp_Dist is
*** 11022,11028 ****
        Dynamically_Asynchronous : Boolean   := False;
        Stub_Type                : Entity_Id := Empty;
        RACW_Type                : Entity_Id := Empty;
!       Parent_Primitive         : Entity_Id := Empty) return Node_Id is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
--- 10824,10831 ----
        Dynamically_Asynchronous : Boolean   := False;
        Stub_Type                : Entity_Id := Empty;
        RACW_Type                : Entity_Id := Empty;
!       Parent_Primitive         : Entity_Id := Empty) return Node_Id
!    is
     begin
        case Get_PCS_Name is
           when Name_PolyORB_DSA =>
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_dist.ads gcc-4.1.0/gcc/ada/exp_dist.ads
*** gcc-4.0.2/gcc/ada/exp_dist.ads	Mon Sep 13 10:18:39 2004
--- gcc-4.1.0/gcc/ada/exp_dist.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_fixd.adb gcc-4.1.0/gcc/ada/exp_fixd.adb
*** gcc-4.0.2/gcc/ada/exp_fixd.adb	Wed May  5 10:09:54 2004
--- gcc-4.1.0/gcc/ada/exp_fixd.adb	Tue Nov 15 13:58:08 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Fixd is
*** 61,68 ****
       (N    : Node_Id;
        Typ  : Entity_Id;
        Expr : Node_Id;
!       Rchk : Boolean := False)
!       return Node_Id;
     --  Build an expression that converts the expression Expr to type Typ,
     --  taking the source location from Sloc (N). If the conversions involve
     --  fixed-point types, then the Conversion_OK flag will be set so that the
--- 61,67 ----
       (N    : Node_Id;
        Typ  : Entity_Id;
        Expr : Node_Id;
!       Rchk : Boolean := False) return Node_Id;
     --  Build an expression that converts the expression Expr to type Typ,
     --  taking the source location from Sloc (N). If the conversions involve
     --  fixed-point types, then the Conversion_OK flag will be set so that the
*************** package body Exp_Fixd is
*** 72,92 ****
  
     function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Divide node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands
!    --  are either both Long_Long_Float, in which case Build_Divide differs
!    --  from Make_Op_Divide only in that the Etype of the resulting node is
!    --  set (to Long_Long_Float), or they can be integer types. In this case
!    --  the integer types need not be the same, and Build_Divide converts
!    --  the operand with the smaller sized type to match the type of the
!    --  other operand and sets this as the result type. The Rounded_Result
!    --  flag of the result in this case is set from the Rounded_Result flag
!    --  of node N. On return, the resulting node is analyzed, and has its
!    --  Etype set.
  
     function Build_Double_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id)
!       return    Node_Id;
     --  Returns a node corresponding to the value X/(Y*Z) using the source
     --  location from Sloc (N). The division is rounded if the Rounded_Result
     --  flag of N is set. The integer types of X, Y, Z may be different. On
--- 71,89 ----
  
     function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Divide node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands are
!    --  either both Universal_Real, in which case Build_Divide differs from
!    --  Make_Op_Divide only in that the Etype of the resulting node is set (to
!    --  Universal_Real), or they can be integer types. In this case the integer
!    --  types need not be the same, and Build_Divide converts the operand with
!    --  the smaller sized type to match the type of the other operand and sets
!    --  this as the result type. The Rounded_Result flag of the result in this
!    --  case is set from the Rounded_Result flag of node N. On return, the
!    --  resulting node is analyzed, and has its Etype set.
  
     function Build_Double_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id) return Node_Id;
     --  Returns a node corresponding to the value X/(Y*Z) using the source
     --  location from Sloc (N). The division is rounded if the Rounded_Result
     --  flag of N is set. The integer types of X, Y, Z may be different. On
*************** package body Exp_Fixd is
*** 100,136 ****
     --  Generates a sequence of code for determining the quotient and remainder
     --  of the division X/(Y*Z), using the source location from Sloc (N).
     --  Entities of appropriate types are allocated for the quotient and
!    --  remainder and returned in Qnn and Rnn. The result is rounded if
!    --  the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
!    --  are appropriately set on return.
  
     function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Multiply node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands
!    --  are either both Long_Long_Float, in which case Build_Divide differs
!    --  from Make_Op_Multiply only in that the Etype of the resulting node is
!    --  set (to Long_Long_Float), or they can be integer types. In this case
!    --  the integer types need not be the same, and Build_Multiply chooses
!    --  a type long enough to hold the product (i.e. twice the size of the
!    --  longer of the two operand types), and both operands are converted
!    --  to this type. The Etype of the result is also set to this value.
!    --  However, the result can never overflow Integer_64, so this is the
!    --  largest type that is ever generated. On return, the resulting node
!    --  is analyzed and has its Etype set.
  
     function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Rem node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands
!    --  are both integer types, which need not be the same. Build_Rem
!    --  converts the operand with the smaller sized type to match the type
!    --  of the other operand and sets this as the result type. The result
!    --  is never rounded (rem operations cannot be rounded in any case!)
!    --  On return, the resulting node is analyzed and has its Etype set.
  
     function Build_Scaled_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id)
!       return    Node_Id;
     --  Returns a node corresponding to the value X*Y/Z using the source
     --  location from Sloc (N). The division is rounded if the Rounded_Result
     --  flag of N is set. The integer types of X, Y, Z may be different. On
--- 97,131 ----
     --  Generates a sequence of code for determining the quotient and remainder
     --  of the division X/(Y*Z), using the source location from Sloc (N).
     --  Entities of appropriate types are allocated for the quotient and
!    --  remainder and returned in Qnn and Rnn. The result is rounded if the
!    --  Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are
!    --  appropriately set on return.
  
     function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Multiply node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands are
!    --  either both Universal_Real, in which case Build_Divide differs from
!    --  Make_Op_Multiply only in that the Etype of the resulting node is set (to
!    --  Universal_Real), or they can be integer types. In this case the integer
!    --  types need not be the same, and Build_Multiply chooses a type long
!    --  enough to hold the product (i.e. twice the size of the longer of the two
!    --  operand types), and both operands are converted to this type. The Etype
!    --  of the result is also set to this value. However, the result can never
!    --  overflow Integer_64, so this is the largest type that is ever generated.
!    --  On return, the resulting node is analyzed and has its Etype set.
  
     function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
     --  Builds an N_Op_Rem node from the given left and right operand
!    --  expressions, using the source location from Sloc (N). The operands are
!    --  both integer types, which need not be the same. Build_Rem converts the
!    --  operand with the smaller sized type to match the type of the other
!    --  operand and sets this as the result type. The result is never rounded
!    --  (rem operations cannot be rounded in any case!) On return, the resulting
!    --  node is analyzed and has its Etype set.
  
     function Build_Scaled_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id) return Node_Id;
     --  Returns a node corresponding to the value X*Y/Z using the source
     --  location from Sloc (N). The division is rounded if the Rounded_Result
     --  flag of N is set. The integer types of X, Y, Z may be different. On
*************** package body Exp_Fixd is
*** 183,192 ****
  
     function Fpt_Value (N : Node_Id) return Node_Id;
     --  Given an operand of fixed-point operation, return an expression that
!    --  represents the corresponding Long_Long_Float value. The expression
     --  can be of integer type, floating-point type, or fixed-point type.
     --  The expression returned is neither analyzed and resolved. The Etype
!    --  of the result is properly set (to Long_Long_Float).
  
     function Integer_Literal (N : Node_Id; V : Uint) return Node_Id;
     --  Given a non-negative universal integer value, build a typed integer
--- 178,187 ----
  
     function Fpt_Value (N : Node_Id) return Node_Id;
     --  Given an operand of fixed-point operation, return an expression that
!    --  represents the corresponding Universal_Real value. The expression
     --  can be of integer type, floating-point type, or fixed-point type.
     --  The expression returned is neither analyzed and resolved. The Etype
!    --  of the result is properly set (to Universal_Real).
  
     function Integer_Literal (N : Node_Id; V : Uint) return Node_Id;
     --  Given a non-negative universal integer value, build a typed integer
*************** package body Exp_Fixd is
*** 198,205 ****
  
     function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
     --  Build a real literal node from the given value, the Etype of the
!    --  returned node is set to Long_Long_Float, since all floating-point
!    --  arithmetic operations that we construct use Long_Long_Float
  
     function Rounded_Result_Set (N : Node_Id) return Boolean;
     --  Returns True if N is a node that contains the Rounded_Result flag
--- 193,200 ----
  
     function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
     --  Build a real literal node from the given value, the Etype of the
!    --  returned node is set to Universal_Real, since all floating-point
!    --  arithmetic operations that we construct use Universal_Real
  
     function Rounded_Result_Set (N : Node_Id) return Boolean;
     --  Returns True if N is a node that contains the Rounded_Result flag
*************** package body Exp_Fixd is
*** 224,231 ****
       (N    : Node_Id;
        Typ  : Entity_Id;
        Expr : Node_Id;
!       Rchk : Boolean := False)
!       return Node_Id
     is
        Loc    : constant Source_Ptr := Sloc (N);
        Result : Node_Id;
--- 219,225 ----
       (N    : Node_Id;
        Typ  : Entity_Id;
        Expr : Node_Id;
!       Rchk : Boolean := False) return Node_Id
     is
        Loc    : constant Source_Ptr := Sloc (N);
        Result : Node_Id;
*************** package body Exp_Fixd is
*** 296,302 ****
  
        Set_Etype (Result, Typ);
        return Result;
- 
     end Build_Conversion;
  
     ------------------
--- 290,295 ----
*************** package body Exp_Fixd is
*** 314,324 ****
        --  Deal with floating-point case first
  
        if Is_Floating_Point_Type (Left_Type) then
!          pragma Assert (Left_Type = Standard_Long_Long_Float);
!          pragma Assert (Right_Type = Standard_Long_Long_Float);
  
           Rnode := Make_Op_Divide (Loc, L, R);
!          Result_Type := Standard_Long_Long_Float;
  
        --  Integer and fixed-point cases
  
--- 307,317 ----
        --  Deal with floating-point case first
  
        if Is_Floating_Point_Type (Left_Type) then
!          pragma Assert (Left_Type = Universal_Real);
!          pragma Assert (Right_Type = Universal_Real);
  
           Rnode := Make_Op_Divide (Loc, L, R);
!          Result_Type := Universal_Real;
  
        --  Integer and fixed-point cases
  
*************** package body Exp_Fixd is
*** 384,390 ****
        end if;
  
        return Rnode;
- 
     end Build_Divide;
  
     -------------------------
--- 377,382 ----
*************** package body Exp_Fixd is
*** 393,400 ****
  
     function Build_Double_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id)
!       return    Node_Id
     is
        Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
        Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
--- 385,391 ----
  
     function Build_Double_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id) return Node_Id
     is
        Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
        Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
*************** package body Exp_Fixd is
*** 582,588 ****
                 New_Occurrence_Of (Rnn, Loc),
                 New_Occurrence_Of (Rnd, Loc))));
        end if;
- 
     end Build_Double_Divide_Code;
  
     --------------------
--- 573,578 ----
*************** package body Exp_Fixd is
*** 603,612 ****
        --  Deal with floating-point case first
  
        if Is_Floating_Point_Type (Left_Type) then
!          pragma Assert (Left_Type = Standard_Long_Long_Float);
!          pragma Assert (Right_Type = Standard_Long_Long_Float);
  
!          Result_Type := Standard_Long_Long_Float;
           Rnode := Make_Op_Multiply (Loc, L, R);
  
        --  Integer and fixed-point cases
--- 593,602 ----
        --  Deal with floating-point case first
  
        if Is_Floating_Point_Type (Left_Type) then
!          pragma Assert (Left_Type = Universal_Real);
!          pragma Assert (Right_Type = Universal_Real);
  
!          Result_Type := Universal_Real;
           Rnode := Make_Op_Multiply (Loc, L, R);
  
        --  Integer and fixed-point cases
*************** package body Exp_Fixd is
*** 782,789 ****
  
     function Build_Scaled_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id)
!       return    Node_Id
     is
        X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
        Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
--- 772,778 ----
  
     function Build_Scaled_Divide
       (N       : Node_Id;
!       X, Y, Z : Node_Id) return Node_Id
     is
        X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
        Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
*************** package body Exp_Fixd is
*** 965,971 ****
                 New_Occurrence_Of (Rnd, Loc))));
        end if;
  
!       --  Set type of result, for use in caller.
  
        Set_Etype (Qnn, QR_Typ);
     end Build_Scaled_Divide_Code;
--- 954,960 ----
                 New_Occurrence_Of (Rnd, Loc))));
        end if;
  
!       --  Set type of result, for use in caller
  
        Set_Etype (Qnn, QR_Typ);
     end Build_Scaled_Divide_Code;
*************** package body Exp_Fixd is
*** 1060,1066 ****
          Build_Multiply (N,
            Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
            Real_Literal (N, Frac)));
- 
     end Do_Divide_Fixed_Fixed;
  
     -------------------------------
--- 1049,1054 ----
*************** package body Exp_Fixd is
*** 1095,1101 ****
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms.
  
     --    If numerator = 1, then for K = 1, the small ratio is the reciprocal
     --    of an integer, and this is clearly the minimum K case, so set K = 1,
--- 1083,1089 ----
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms
  
     --    If numerator = 1, then for K = 1, the small ratio is the reciprocal
     --    of an integer, and this is clearly the minimum K case, so set K = 1,
*************** package body Exp_Fixd is
*** 1176,1182 ****
  
        Set_Result (N,
          Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
- 
     end Do_Divide_Fixed_Universal;
  
     -------------------------------
--- 1164,1169 ----
*************** package body Exp_Fixd is
*** 1213,1219 ****
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms.
  
     --    If denominator = 1, then for K = 1, the small ratio is an integer
     --    (the numerator) and this is clearly the minimum K case, so set K = 1,
--- 1200,1206 ----
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms
  
     --    If denominator = 1, then for K = 1, the small ratio is an integer
     --    (the numerator) and this is clearly the minimum K case, so set K = 1,
*************** package body Exp_Fixd is
*** 1295,1301 ****
  
        Set_Result (N,
          Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
- 
     end Do_Divide_Universal_Fixed;
  
     -----------------------------
--- 1282,1287 ----
*************** package body Exp_Fixd is
*** 1380,1386 ****
          Build_Multiply (N,
            Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
            Real_Literal (N, Frac)));
- 
     end Do_Multiply_Fixed_Fixed;
  
     ---------------------------------
--- 1366,1371 ----
*************** package body Exp_Fixd is
*** 1415,1429 ****
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms.
  
!    --    If denominator = 1, then for K = 1, the small ratio is an
!    --    integer, and this is clearly the minimum K case, so set
!    --    K = 1, Right_Small = Lit_Value.
  
!    --    If denominator > 1, then set K to the numerator of the
!    --    fraction, so that the resulting small ratio is the
!    --    reciprocal of the integer (the denominator value).
  
     procedure Do_Multiply_Fixed_Universal
       (N           : Node_Id;
--- 1400,1415 ----
     --  is an integer or the reciprocal of an integer, and for
     --  implementation efficiency we need the smallest such K.
  
!    --  First we reduce the left fraction to lowest terms
  
!    --    If denominator = 1, then for K = 1, the small ratio is an integer, and
!    --    this is clearly the minimum K case, so set
  
!    --      K = 1, Right_Small = Lit_Value
! 
!    --    If denominator > 1, then set K to the numerator of the fraction, so
!    --    that the resulting small ratio is the reciprocal of the integer (the
!    --    denominator value).
  
     procedure Do_Multiply_Fixed_Universal
       (N           : Node_Id;
*************** package body Exp_Fixd is
*** 1497,1503 ****
  
        Set_Result (N,
          Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
- 
     end Do_Multiply_Fixed_Universal;
  
     ---------------------------------
--- 1483,1488 ----
*************** package body Exp_Fixd is
*** 1552,1558 ****
        Ratio_Den   := Norm_Den (Small_Ratio);
  
        if Ratio_Den = 1 then
- 
           if Ratio_Num = 1 then
              Set_Result (N, Expr);
              return;
--- 1537,1542 ----
*************** package body Exp_Fixd is
*** 1584,1590 ****
            Fpt_Value (Expr),
            Real_Literal (N, Small_Ratio)),
          Rng_Check);
- 
     end Expand_Convert_Fixed_To_Fixed;
  
     -----------------------------------
--- 1568,1573 ----
*************** package body Exp_Fixd is
*** 1593,1599 ****
  
     --  If the small of the fixed type is 1.0, then we simply convert the
     --  integer value directly to the target floating-point type, otherwise
!    --  we first have to multiply by the small, in Long_Long_Float, and then
     --  convert the result to the target floating-point type.
  
     procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
--- 1576,1582 ----
  
     --  If the small of the fixed type is 1.0, then we simply convert the
     --  integer value directly to the target floating-point type, otherwise
!    --  we first have to multiply by the small, in Universal_Real, and then
     --  convert the result to the target floating-point type.
  
     procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
*************** package body Exp_Fixd is
*** 1678,1684 ****
            Fpt_Value (Expr),
            Real_Literal (N, Small)),
          Rng_Check);
- 
     end Expand_Convert_Fixed_To_Integer;
  
     -----------------------------------
--- 1661,1666 ----
*************** package body Exp_Fixd is
*** 1775,1781 ****
            Fpt_Value (Expr),
            Real_Literal (N, Ureal_1 / Small)),
          Rng_Check);
- 
     end Expand_Convert_Integer_To_Fixed;
  
     --------------------------------
--- 1757,1762 ----
*************** package body Exp_Fixd is
*** 1825,1831 ****
     --  division or multiplication by the appropriate power of 10.
  
     procedure Expand_Decimal_Divide_Call (N : Node_Id) is
!       Loc       : constant Source_Ptr := Sloc (N);
  
        Dividend  : Node_Id := First_Actual (N);
        Divisor   : Node_Id := Next_Actual (Dividend);
--- 1806,1812 ----
     --  division or multiplication by the appropriate power of 10.
  
     procedure Expand_Decimal_Divide_Call (N : Node_Id) is
!       Loc : constant Source_Ptr := Sloc (N);
  
        Dividend  : Node_Id := First_Actual (N);
        Divisor   : Node_Id := Next_Actual (Dividend);
*************** package body Exp_Fixd is
*** 1970,1976 ****
                Statements => Stmts)));
  
        Analyze (N);
- 
     end Expand_Decimal_Divide_Call;
  
     -----------------------------------------------
--- 1951,1956 ----
*************** package body Exp_Fixd is
*** 1998,2011 ****
        else
           Do_Divide_Fixed_Fixed (N);
        end if;
- 
     end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
  
     -----------------------------------------------
     -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
     -----------------------------------------------
  
!    --  The division is done in long_long_float, and the result is multiplied
     --  by the small ratio, which is Small (Right) / Small (Left). Special
     --  treatment is required for universal operands, which represent their
     --  own value and do not require conversion.
--- 1978,1990 ----
        else
           Do_Divide_Fixed_Fixed (N);
        end if;
     end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
  
     -----------------------------------------------
     -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
     -----------------------------------------------
  
!    --  The division is done in Universal_Real, and the result is multiplied
     --  by the small ratio, which is Small (Right) / Small (Left). Special
     --  treatment is required for universal operands, which represent their
     --  own value and do not require conversion.
*************** package body Exp_Fixd is
*** 2064,2070 ****
               Real_Literal (N,
                 Small_Value (Left_Type) / Small_Value (Right_Type))));
        end if;
- 
     end Expand_Divide_Fixed_By_Fixed_Giving_Float;
  
     -------------------------------------------------
--- 2043,2048 ----
*************** package body Exp_Fixd is
*** 2074,2091 ****
     procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
        Left  : constant Node_Id := Left_Opnd (N);
        Right : constant Node_Id := Right_Opnd (N);
- 
     begin
        if Etype (Left) = Universal_Real then
           Do_Divide_Universal_Fixed (N);
- 
        elsif Etype (Right) = Universal_Real then
           Do_Divide_Fixed_Universal (N);
- 
        else
           Do_Divide_Fixed_Fixed (N);
        end if;
- 
     end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
  
     -------------------------------------------------
--- 2052,2065 ----
*************** package body Exp_Fixd is
*** 2098,2104 ****
     procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
        Left  : constant Node_Id := Left_Opnd (N);
        Right : constant Node_Id := Right_Opnd (N);
- 
     begin
        Set_Result (N, Build_Divide (N, Left, Right));
     end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
--- 2072,2077 ----
*************** package body Exp_Fixd is
*** 2117,2125 ****
        --  as a fixed * fixed multiplication, and convert the argument to
        --  the target fixed type.
  
!       procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
!          Loc   : constant Source_Ptr := Sloc (N);
  
        begin
           Rewrite (Opnd,
             Make_Type_Conversion (Loc,
--- 2090,2101 ----
        --  as a fixed * fixed multiplication, and convert the argument to
        --  the target fixed type.
  
!       ----------------------------------
!       -- Rewrite_Non_Static_Universal --
!       ----------------------------------
  
+       procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
+          Loc : constant Source_Ptr := Sloc (N);
        begin
           Rewrite (Opnd,
             Make_Type_Conversion (Loc,
*************** package body Exp_Fixd is
*** 2128,2133 ****
--- 2104,2111 ----
           Analyze_And_Resolve (Opnd, Etype (N));
        end Rewrite_Non_Static_Universal;
  
+    --  Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
+ 
     begin
        --  Suppress expansion of a fixed-by-fixed multiplication if the
        --  operation is supported directly by the target.
*************** package body Exp_Fixd is
*** 2157,2170 ****
        else
           Do_Multiply_Fixed_Fixed (N);
        end if;
- 
     end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
  
     -------------------------------------------------
     -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
     -------------------------------------------------
  
!    --  The multiply is done in long_long_float, and the result is multiplied
     --  by the adjustment for the smalls which is Small (Right) * Small (Left).
     --  Special treatment is required for universal operands.
  
--- 2135,2147 ----
        else
           Do_Multiply_Fixed_Fixed (N);
        end if;
     end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
  
     -------------------------------------------------
     -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
     -------------------------------------------------
  
!    --  The multiply is done in Universal_Real, and the result is multiplied
     --  by the adjustment for the smalls which is Small (Right) * Small (Left).
     --  Special treatment is required for universal operands.
  
*************** package body Exp_Fixd is
*** 2219,2225 ****
               Real_Literal (N,
                 Small_Value (Right_Type) * Small_Value (Left_Type))));
        end if;
- 
     end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
  
     ---------------------------------------------------
--- 2196,2201 ----
*************** package body Exp_Fixd is
*** 2229,2246 ****
     procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
        Left  : constant Node_Id := Left_Opnd (N);
        Right : constant Node_Id := Right_Opnd (N);
- 
     begin
        if Etype (Left) = Universal_Real then
           Do_Multiply_Fixed_Universal (N, Right, Left);
- 
        elsif Etype (Right) = Universal_Real then
           Do_Multiply_Fixed_Universal (N, Left, Right);
- 
        else
           Do_Multiply_Fixed_Fixed (N);
        end if;
- 
     end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
  
     ---------------------------------------------------
--- 2205,2218 ----
*************** package body Exp_Fixd is
*** 2280,2296 ****
        if Is_Integer_Type (Typ)
          or else Is_Floating_Point_Type (Typ)
        then
!          return
!            Build_Conversion
!              (N, Standard_Long_Long_Float, N);
  
        --  Fixed-point case, must get integer value first
  
        else
!          return
!            Build_Conversion (N, Standard_Long_Long_Float, N);
        end if;
- 
     end Fpt_Value;
  
     ---------------------
--- 2252,2264 ----
        if Is_Integer_Type (Typ)
          or else Is_Floating_Point_Type (Typ)
        then
!          return Build_Conversion (N, Universal_Real, N);
  
        --  Fixed-point case, must get integer value first
  
        else
!          return Build_Conversion (N, Universal_Real, N);
        end if;
     end Fpt_Value;
  
     ---------------------
*************** package body Exp_Fixd is
*** 2347,2353 ****
  
        --  Set type of result in case used elsewhere (see note at start)
  
!       Set_Etype (L, Standard_Long_Long_Float);
        return L;
     end Real_Literal;
  
--- 2315,2321 ----
  
        --  Set type of result in case used elsewhere (see note at start)
  
!       Set_Etype (L, Universal_Real);
        return L;
     end Real_Literal;
  
*************** package body Exp_Fixd is
*** 2357,2363 ****
  
     function Rounded_Result_Set (N : Node_Id) return Boolean is
        K : constant Node_Kind := Nkind (N);
- 
     begin
        if (K = N_Type_Conversion or else
            K = N_Op_Divide       or else
--- 2325,2330 ----
*************** package body Exp_Fixd is
*** 2398,2404 ****
  
        Rewrite (N, Cnode);
        Analyze_And_Resolve (N, Result_Type);
- 
     end Set_Result;
  
  end Exp_Fixd;
--- 2365,2370 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_fixd.ads gcc-4.1.0/gcc/ada/exp_fixd.ads
*** gcc-4.0.2/gcc/ada/exp_fixd.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_fixd.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_imgv.adb gcc-4.1.0/gcc/ada/exp_imgv.adb
*** gcc-4.0.2/gcc/ada/exp_imgv.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/exp_imgv.adb	Tue Nov 15 13:58:08 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Exp_Util; use Exp_Util;
*** 32,38 ****
  with Namet;    use Namet;
  with Nmake;    use Nmake;
  with Nlists;   use Nlists;
- with Opt;      use Opt;
  with Rtsfind;  use Rtsfind;
  with Sem_Res;  use Sem_Res;
  with Sinfo;    use Sinfo;
--- 32,37 ----
*************** package body Exp_Imgv is
*** 192,203 ****
     --    For types whose root type is Wide_Character
     --      xx = Wide_Character
     --      tv = Wide_Character (Expr)
-    --      pm = Wide_Character_Encoding_Method
  
     --    For types whose root type is Wide_Wide_Character
     --      xx = Wide_Wide_haracter
     --      tv = Wide_Wide_Character (Expr)
-    --      pm = Wide_Character_Encoding_Method
  
     --    For floating-point types
     --      xx = Floating_Point
--- 191,200 ----
*************** package body Exp_Imgv is
*** 391,405 ****
               Prefix         => New_Reference_To (Ptyp, Loc),
               Attribute_Name => Name_Aft));
  
-       --  For wide [wide] character, append encoding method
- 
-       elsif Rtyp = Standard_Wide_Character
-         or else Rtyp = Standard_Wide_Wide_Character
-       then
-          Append_To (Arglist,
-            Make_Integer_Literal (Loc,
-              Intval => Int (Wide_Character_Encoding_Method)));
- 
        --  For decimal, append Scale and also set to do literal conversion
  
        elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
--- 388,393 ----
*************** package body Exp_Imgv is
*** 434,439 ****
--- 422,433 ----
     --    For types whose root type is Character
     --      xx = Character
  
+    --    For types whose root type is Wide_Character
+    --      xx = Wide_Character
+ 
+    --    For types whose root type is Wide_Wide_Character
+    --      xx = Wide_Wide_Character
+ 
     --    For types whose root type is Boolean
     --      xx = Boolean
  
*************** package body Exp_Imgv is
*** 452,465 ****
     --    For floating-point types and ordinary fixed-point types
     --      xx = Real
  
-    --  For types derived from Wide_Character, typ'Value (X) expands into
- 
-    --    Value_Wide_Character (X, Wide_Character_Encoding_Method)
- 
-    --  For types derived from Wide_Wide_Character, typ'Value (X) expands into
- 
-    --    Value_Wide_Wide_Character (X, Wide_Character_Encoding_Method)
- 
     --  For decimal types with size <= Integer'Size, typ'Value (X)
     --  expands into
  
--- 446,451 ----
*************** package body Exp_Imgv is
*** 504,518 ****
  
        elsif Rtyp = Standard_Wide_Character then
           Vid := RE_Value_Wide_Character;
-          Append_To (Args,
-            Make_Integer_Literal (Loc,
-              Intval => Int (Wide_Character_Encoding_Method)));
  
        elsif Rtyp = Standard_Wide_Wide_Character then
           Vid := RE_Value_Wide_Wide_Character;
-          Append_To (Args,
-            Make_Integer_Literal (Loc,
-              Intval => Int (Wide_Character_Encoding_Method)));
  
        elsif     Rtyp = Base_Type (Standard_Short_Short_Integer)
          or else Rtyp = Base_Type (Standard_Short_Integer)
--- 490,498 ----
*************** package body Exp_Imgv is
*** 686,727 ****
     --    Result_Type (Width_Wide_Character (
     --      Wide_Character (typ'First),
     --      Wide_Character (typ'Last),
-    --      Wide_Character_Encoding_Method);
  
     --  and typ'Wide_Width expands into:
  
     --    Result_Type (Wide_Width_Wide_Character (
     --      Wide_Character (typ'First),
     --      Wide_Character (typ'Last));
-    --      Wide_Character_Encoding_Method);
  
     --  and typ'Wide_Wide_Width expands into
  
     --    Result_Type (Wide_Wide_Width_Wide_Character (
     --      Wide_Character (typ'First),
     --      Wide_Character (typ'Last));
-    --      Wide_Character_Encoding_Method);
  
     --  For types derived from Wide_Wide_Character, typ'Width expands into
  
     --    Result_Type (Width_Wide_Wide_Character (
     --      Wide_Wide_Character (typ'First),
     --      Wide_Wide_Character (typ'Last),
-    --      Wide_Character_Encoding_Method);
  
     --  and typ'Wide_Width expands into:
  
     --    Result_Type (Wide_Width_Wide_Wide_Character (
     --      Wide_Wide_Character (typ'First),
     --      Wide_Wide_Character (typ'Last));
-    --      Wide_Character_Encoding_Method);
  
     --  and typ'Wide_Wide_Width expands into
  
     --    Result_Type (Wide_Wide_Width_Wide_Wide_Char (
     --      Wide_Wide_Character (typ'First),
     --      Wide_Wide_Character (typ'Last));
-    --      Wide_Character_Encoding_Method);
  
     --  For real types, typ'Width and typ'Wide_[Wide_]Width expand into
  
--- 666,701 ----
*************** package body Exp_Imgv is
*** 857,862 ****
--- 831,852 ----
        else
           pragma Assert (Is_Enumeration_Type (Rtyp));
  
+          if Discard_Names (Rtyp) then
+ 
+             --  This is a configurable run-time, or else a restriction is in
+             --  effect. In either case the attribute cannot be supported. Force
+             --  a load error from Rtsfind to generate an appropriate message,
+             --  as is done with other ZFP violations.
+ 
+             declare
+                pragma Warnings (Off); -- since Discard is unreferenced
+                Discard : constant Entity_Id := RTE (RE_Null);
+                pragma Warnings (On);
+             begin
+                return;
+             end;
+          end if;
+ 
           Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
  
           case Attr is
*************** package body Exp_Imgv is
*** 914,927 ****
                     Prefix => New_Reference_To (Ptyp, Loc),
                     Attribute_Name => Name_Last))));
  
-          --  For enumeration'Wide_[Wide_]Width, add encoding method parameter
- 
-          if Attr /= Normal then
-             Append_To (Arglist,
-               Make_Integer_Literal (Loc,
-                 Intval => Int (Wide_Character_Encoding_Method)));
-          end if;
- 
           Rewrite (N,
             Convert_To (Typ,
               Make_Function_Call (Loc,
--- 904,909 ----
*************** package body Exp_Imgv is
*** 945,961 ****
              Prefix => New_Reference_To (Ptyp, Loc),
              Attribute_Name => Name_Last)));
  
-       --  For Wide_[Wide_]Character'Width, add encoding method parameter
- 
-       if (Rtyp = Standard_Wide_Character
-            or else
-           Rtyp = Standard_Wide_Wide_Character)
-         and then Attr /= Normal then
-          Append_To (Arglist,
-            Make_Integer_Literal (Loc,
-              Intval => Int (Wide_Character_Encoding_Method)));
-       end if;
- 
        Rewrite (N,
          Convert_To (Typ,
            Make_Function_Call (Loc,
--- 927,932 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_imgv.ads gcc-4.1.0/gcc/ada/exp_imgv.ads
*** gcc-4.0.2/gcc/ada/exp_imgv.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/exp_imgv.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_intr.adb gcc-4.1.0/gcc/ada/exp_intr.adb
*** gcc-4.0.2/gcc/ada/exp_intr.adb	Wed Dec  8 11:27:00 2004
--- gcc-4.1.0/gcc/ada/exp_intr.adb	Tue Nov 15 13:58:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,39 ****
  
  with Atree;    use Atree;
  with Einfo;    use Einfo;
  with Errout;   use Errout;
  with Exp_Ch4;  use Exp_Ch4;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch11; use Exp_Ch11;
  with Exp_Code; use Exp_Code;
  with Exp_Fixd; use Exp_Fixd;
  with Exp_Util; use Exp_Util;
! with Itypes;   use Itypes;
  with Namet;    use Namet;
  with Nmake;    use Nmake;
  with Nlists;   use Nlists;
--- 26,41 ----
  
  with Atree;    use Atree;
  with Einfo;    use Einfo;
+ with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Ch4;  use Exp_Ch4;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Ch11; use Exp_Ch11;
  with Exp_Code; use Exp_Code;
+ with Exp_Disp; use Exp_Disp;
  with Exp_Fixd; use Exp_Fixd;
  with Exp_Util; use Exp_Util;
! with Freeze;   use Freeze;
  with Namet;    use Namet;
  with Nmake;    use Nmake;
  with Nlists;   use Nlists;
*************** package body Exp_Intr is
*** 61,66 ****
--- 63,75 ----
     procedure Expand_Is_Negative (N : Node_Id);
     --  Expand a call to the intrinsic Is_Negative function
  
+    procedure Expand_Dispatching_Constructor_Call (N : Node_Id);
+    --  Expand a call to an instantiation of Generic_Dispatching_Constructor
+    --  into a dispatching call to the actual subprogram associated with the
+    --  Constructor formal subprogram, passing it the Parameters actual of
+    --  the call to the instantiation and dispatching based on call's Tag
+    --  parameter.
+ 
     procedure Expand_Exception_Call (N : Node_Id; Ent : RE_Id);
     --  Expand a call to Exception_Information/Message/Name. The first
     --  parameter, N, is the node for the function call, and Ent is the
*************** package body Exp_Intr is
*** 96,101 ****
--- 105,193 ----
     --    Name_Source_Location  - expand string of form file:line
     --    Name_Enclosing_Entity - expand string  with name of enclosing entity
  
+    -----------------------------------------
+    -- Expand_Dispatching_Constructor_Call --
+    -----------------------------------------
+ 
+    --  Transform a call to an instantiation of Generic_Dispatching_Constructor
+    --  of the form:
+ 
+    --     GDC_Instance (The_Tag, Parameters'Access)
+ 
+    --  to a class-wide conversion of a dispatching call to the actual
+    --  associated with the formal subprogram Construct, designating
+    --  The_Tag as the controlling tag of the call:
+ 
+    --     T'Class (Construct'Actual (Params)) -- Controlling tag is The_Tag
+ 
+    --  which will eventually be expanded to the following:
+ 
+    --     T'Class (The_Tag.all (Construct'Actual'Index).all (Params))
+ 
+    --  A class-wide membership test is also generated, preceding the call,
+    --  to ensure that the controlling tag denotes a type in T'Class.
+ 
+    procedure Expand_Dispatching_Constructor_Call (N : Node_Id) is
+       Loc        : constant Source_Ptr := Sloc (N);
+       Tag_Arg    : constant Node_Id    := First_Actual (N);
+       Param_Arg  : constant Node_Id    := Next_Actual (Tag_Arg);
+       Subp_Decl  : constant Node_Id    := Parent (Parent (Entity (Name (N))));
+       Inst_Pkg   : constant Node_Id    := Parent (Subp_Decl);
+       Act_Rename : Node_Id;
+       Act_Constr : Entity_Id;
+       Result_Typ : Entity_Id;
+       Cnstr_Call : Node_Id;
+ 
+    begin
+       --  The subprogram is the third actual in the instantiation, and is
+       --  retrieved from the corresponding renaming declaration. However,
+       --  freeze nodes may appear before, so we retrieve the declaration
+       --  with an explicit loop.
+ 
+       Act_Rename := First (Visible_Declarations (Inst_Pkg));
+       while Nkind (Act_Rename) /= N_Subprogram_Renaming_Declaration loop
+          Next (Act_Rename);
+       end loop;
+ 
+       Act_Constr := Entity (Name (Act_Rename));
+       Result_Typ := Class_Wide_Type (Etype (Act_Constr));
+ 
+       --  Create the call to the actual Constructor function
+ 
+       Cnstr_Call :=
+         Make_Function_Call (Loc,
+           Name                   => New_Occurrence_Of (Act_Constr, Loc),
+           Parameter_Associations => New_List (Relocate_Node (Param_Arg)));
+ 
+       --  Establish its controlling tag from the tag passed to the instance
+ 
+       Set_Controlling_Argument (Cnstr_Call, Relocate_Node (Tag_Arg));
+ 
+       --  Rewrite and analyze the call to the instance as a class-wide
+       --  conversion of the call to the actual constructor.
+ 
+       Rewrite (N, Convert_To (Result_Typ, Cnstr_Call));
+       Analyze_And_Resolve (N, Etype (Act_Constr));
+ 
+       --  Generate a class-wide membership test to ensure that the call's tag
+       --  argument denotes a type within the class.
+ 
+       Insert_Action (N,
+         Make_Implicit_If_Statement (N,
+           Condition =>
+             Make_Op_Not (Loc,
+               Make_DT_Access_Action (Result_Typ,
+                  Action => CW_Membership,
+                  Args   => New_List (
+                    Duplicate_Subexpr (Tag_Arg),
+                    New_Reference_To (
+                      Node (First_Elmt (Access_Disp_Table (
+                                          Root_Type (Result_Typ)))), Loc)))),
+           Then_Statements =>
+             New_List (Make_Raise_Statement (Loc,
+                         New_Occurrence_Of (RTE (RE_Tag_Error), Loc)))));
+    end Expand_Dispatching_Constructor_Call;
+ 
     ---------------------------
     -- Expand_Exception_Call --
     ---------------------------
*************** package body Exp_Intr is
*** 236,241 ****
--- 328,336 ----
        elsif Nam = Name_Exception_Name then
           Expand_Exception_Call (N, RE_Exception_Name_Simple);
  
+       elsif Nam = Name_Generic_Dispatching_Constructor then
+          Expand_Dispatching_Constructor_Call (N);
+ 
        elsif Nam = Name_Import_Address
                or else
              Nam = Name_Import_Largest_Value
*************** package body Exp_Intr is
*** 407,412 ****
--- 502,562 ----
        Loc : constant Source_Ptr := Sloc (N);
        Ent : Entity_Id;
  
+       procedure Write_Entity_Name (E : Entity_Id);
+       --  Recursive procedure to construct string for qualified name of
+       --  enclosing program unit. The qualification stops at an enclosing
+       --  scope has no source name (block or loop). If entity is a subprogram
+       --  instance, skip enclosing wrapper package.
+ 
+       -----------------------
+       -- Write_Entity_Name --
+       -----------------------
+ 
+       procedure Write_Entity_Name (E : Entity_Id) is
+          SDef : Source_Ptr;
+          TDef : constant Source_Buffer_Ptr :=
+                   Source_Text (Get_Source_File_Index (Sloc (E)));
+ 
+       begin
+          --  Nothing to do if at outer level
+ 
+          if Scope (E) = Standard_Standard then
+             null;
+ 
+          --  If scope comes from source, write its name
+ 
+          elsif Comes_From_Source (Scope (E)) then
+             Write_Entity_Name (Scope (E));
+             Add_Char_To_Name_Buffer ('.');
+ 
+          --  If in wrapper package skip past it
+ 
+          elsif Is_Wrapper_Package (Scope (E)) then
+             Write_Entity_Name (Scope (Scope (E)));
+             Add_Char_To_Name_Buffer ('.');
+ 
+          --  Otherwise nothing to output (happens in unnamed block statements)
+ 
+          else
+             null;
+          end if;
+ 
+          --  Loop to output the name
+ 
+          --  is this right wrt wide char encodings ??? (no!)
+ 
+          SDef := Sloc (E);
+          while TDef (SDef) in '0' .. '9'
+            or else TDef (SDef) >= 'A'
+            or else TDef (SDef) = ASCII.ESC
+          loop
+             Add_Char_To_Name_Buffer (TDef (SDef));
+             SDef := SDef + 1;
+          end loop;
+       end Write_Entity_Name;
+ 
+    --  Start of processing for Expand_Source_Info
+ 
     begin
        --  Integer cases
  
*************** package body Exp_Intr is
*** 432,438 ****
  
                 Ent := Current_Scope;
  
!                --  Skip enclosing blocks to reach enclosing unit.
  
                 while Present (Ent) loop
                    exit when Ekind (Ent) /= E_Block
--- 582,588 ----
  
                 Ent := Current_Scope;
  
!                --  Skip enclosing blocks to reach enclosing unit
  
                 while Present (Ent) loop
                    exit when Ekind (Ent) /= E_Block
*************** package body Exp_Intr is
*** 442,463 ****
  
                 --  Ent now points to the relevant defining entity
  
!                declare
!                   SDef : Source_Ptr := Sloc (Ent);
!                   TDef : Source_Buffer_Ptr;
! 
!                begin
!                   TDef := Source_Text (Get_Source_File_Index (SDef));
!                   Name_Len := 0;
! 
!                   while TDef (SDef) in '0' .. '9'
!                     or else TDef (SDef) >= 'A'
!                     or else TDef (SDef) = ASCII.ESC
!                   loop
!                      Add_Char_To_Name_Buffer (TDef (SDef));
!                      SDef := SDef + 1;
!                   end loop;
!                end;
  
              when others =>
                 raise Program_Error;
--- 592,599 ----
  
                 --  Ent now points to the relevant defining entity
  
!                Name_Len := 0;
!                Write_Entity_Name (Ent);
  
              when others =>
                 raise Program_Error;
*************** package body Exp_Intr is
*** 479,484 ****
--- 615,621 ----
        Func : constant Entity_Id  := Entity (Name (N));
        Conv : Node_Id;
        Ftyp : Entity_Id;
+       Ttyp : Entity_Id;
  
     begin
        --  Rewrite as unchecked conversion node. Note that we must convert
*************** package body Exp_Intr is
*** 500,511 ****
           Analyze_And_Resolve (Conv);
        end if;
  
        --  We do the analysis here, because we do not want the compiler
        --  to try to optimize or otherwise reorganize the unchecked
        --  conversion node.
  
!       Rewrite (N, Unchecked_Convert_To (Etype (E), Conv));
!       Set_Etype (N, Etype (E));
        Set_Analyzed (N);
  
        if Nkind (N) = N_Unchecked_Type_Conversion then
--- 637,669 ----
           Analyze_And_Resolve (Conv);
        end if;
  
+       --  The instantiation of Unchecked_Conversion creates a wrapper package,
+       --  and the target type is declared as a subtype of the actual. Recover
+       --  the actual, which is the subtype indic. in the subtype declaration
+       --  for the target type. This is semantically correct, and avoids
+       --  anomalies with access subtypes. For entities, leave type as is.
+ 
        --  We do the analysis here, because we do not want the compiler
        --  to try to optimize or otherwise reorganize the unchecked
        --  conversion node.
  
!       Ttyp := Etype (E);
! 
!       if Is_Entity_Name (Conv) then
!          null;
! 
!       elsif Nkind (Parent (Ttyp)) = N_Subtype_Declaration then
!          Ttyp := Entity (Subtype_Indication (Parent (Etype (E))));
! 
!       elsif Is_Itype (Ttyp) then
!          Ttyp :=
!            Entity (Subtype_Indication (Associated_Node_For_Itype (Ttyp)));
!       else
!          raise Program_Error;
!       end if;
! 
!       Rewrite (N, Unchecked_Convert_To (Ttyp, Conv));
!       Set_Etype (N, Ttyp);
        Set_Analyzed (N);
  
        if Nkind (N) = N_Unchecked_Type_Conversion then
*************** package body Exp_Intr is
*** 559,570 ****
  
           --  If the type is tagged, then we must force dispatching on the
           --  finalization call because the designated type may not be the
!          --  actual type of the object
  
           if Is_Tagged_Type (Desig_T)
             and then not Is_Class_Wide_Type (Desig_T)
           then
              Deref := Unchecked_Convert_To (Class_Wide_Type (Desig_T), Deref);
           end if;
  
           Free_Cod :=
--- 717,737 ----
  
           --  If the type is tagged, then we must force dispatching on the
           --  finalization call because the designated type may not be the
!          --  actual type of the object.
  
           if Is_Tagged_Type (Desig_T)
             and then not Is_Class_Wide_Type (Desig_T)
           then
              Deref := Unchecked_Convert_To (Class_Wide_Type (Desig_T), Deref);
+ 
+          elsif not Is_Tagged_Type (Desig_T) then
+ 
+             --  Set type of result, to force a conversion when needed (see
+             --  exp_ch7, Convert_View), given that Deep_Finalize may be
+             --  inherited from the parent type, and we need the type of the
+             --  expression to see whether the conversion is in fact needed.
+ 
+             Set_Etype (Deref, Desig_T);
           end if;
  
           Free_Cod :=
*************** package body Exp_Intr is
*** 630,636 ****
                   and then Is_Entity_Name (Nam2)
                   and then Entity (Prefix (Nam1)) = Entity (Nam2)
                 then
!                   Error_Msg_N ("Abort may take time to complete?", N);
                    Error_Msg_N ("\deallocation might have no effect?", N);
                    Error_Msg_N ("\safer to wait for termination.?", N);
                 end if;
--- 797,803 ----
                   and then Is_Entity_Name (Nam2)
                   and then Entity (Prefix (Nam1)) = Entity (Nam2)
                 then
!                   Error_Msg_N ("abort may take time to complete?", N);
                    Error_Msg_N ("\deallocation might have no effect?", N);
                    Error_Msg_N ("\safer to wait for termination.?", N);
                 end if;
*************** package body Exp_Intr is
*** 674,679 ****
--- 841,922 ----
        Append_To (Stmts, Free_Node);
        Set_Storage_Pool (Free_Node, Pool);
  
+       --  Deal with storage pool
+ 
+       if Present (Pool) then
+ 
+          --  Freeing the secondary stack is meaningless
+ 
+          if Is_RTE (Pool, RE_SS_Pool) then
+             null;
+ 
+          elsif Is_Class_Wide_Type (Etype (Pool)) then
+ 
+             --  Case of a class-wide pool type: make a dispatching call
+             --  to Deallocate through the class-wide Deallocate_Any.
+ 
+             Set_Procedure_To_Call (Free_Node,
+               RTE (RE_Deallocate_Any));
+ 
+          else
+             --  Case of a specific pool type: make a statically bound call
+ 
+             Set_Procedure_To_Call (Free_Node,
+               Find_Prim_Op (Etype (Pool), Name_Deallocate));
+          end if;
+       end if;
+ 
+       if Present (Procedure_To_Call (Free_Node)) then
+ 
+          --  For all cases of a Deallocate call, the back-end needs to be
+          --  able to compute the size of the object being freed. This may
+          --  require some adjustments for objects of dynamic size.
+          --
+          --  If the type is class wide, we generate an implicit type with the
+          --  right dynamic size, so that the deallocate call gets the right
+          --  size parameter computed by GIGI. Same for an access to
+          --  unconstrained packed array.
+ 
+          if Is_Class_Wide_Type (Desig_T)
+            or else
+             (Is_Array_Type (Desig_T)
+                and then not Is_Constrained (Desig_T)
+                and then Is_Packed (Desig_T))
+          then
+             declare
+                Deref    : constant Node_Id :=
+                             Make_Explicit_Dereference (Loc,
+                               Duplicate_Subexpr_No_Checks (Arg));
+                D_Subtyp : Node_Id;
+                D_Type   : Entity_Id;
+ 
+             begin
+                Set_Etype  (Deref, Typ);
+                Set_Parent (Deref, Free_Node);
+                D_Subtyp := Make_Subtype_From_Expr (Deref, Desig_T);
+ 
+                if Nkind (D_Subtyp) in N_Has_Entity then
+                   D_Type := Entity (D_Subtyp);
+ 
+                else
+                   D_Type := Make_Defining_Identifier (Loc,
+                               New_Internal_Name ('A'));
+                   Insert_Action (N,
+                     Make_Subtype_Declaration (Loc,
+                       Defining_Identifier => D_Type,
+                       Subtype_Indication  => D_Subtyp));
+                   Freeze_Itype (D_Type, N);
+ 
+                end if;
+ 
+                Set_Actual_Designated_Subtype (Free_Node, D_Type);
+             end;
+ 
+          end if;
+       end if;
+ 
+       Set_Expression (Free_Node, Free_Arg);
+ 
        --  Make implicit if statement. We omit this if we are the then part
        --  of a test of the form:
  
*************** package body Exp_Intr is
*** 726,787 ****
           end if;
        end;
  
!       --  Deal with storage pool
! 
!       if Present (Pool) then
! 
!          --  Freeing the secondary stack is meaningless
! 
!          if Is_RTE (Pool, RE_SS_Pool) then
!             null;
! 
!          elsif Is_Class_Wide_Type (Etype (Pool)) then
!             Set_Procedure_To_Call (Free_Node,
!               RTE (RE_Deallocate_Any));
!          else
!             Set_Procedure_To_Call (Free_Node,
!               Find_Prim_Op (Etype (Pool), Name_Deallocate));
! 
!             --  If the type is class wide, we generate an implicit type
!             --  with the right dynamic size, so that the deallocate call
!             --  gets the right size parameter computed by gigi
! 
!             if Is_Class_Wide_Type (Desig_T) then
!                declare
!                   Acc_Type : constant Entity_Id :=
!                                Create_Itype (E_Access_Type, N);
!                   Deref    : constant Node_Id :=
!                                Make_Explicit_Dereference (Loc,
!                                  Duplicate_Subexpr_No_Checks (Arg));
! 
!                begin
!                   Set_Etype  (Deref, Typ);
!                   Set_Parent (Deref, Free_Node);
  
!                   Set_Etype     (Acc_Type, Acc_Type);
!                   Set_Size_Info (Acc_Type, Typ);
!                   Set_Directly_Designated_Type
!                                 (Acc_Type, Entity (Make_Subtype_From_Expr
!                                                     (Deref, Desig_T)));
  
!                   Free_Arg := Unchecked_Convert_To (Acc_Type, Free_Arg);
!                end;
!             end if;
!          end if;
        end if;
  
!       Set_Expression (Free_Node, Free_Arg);
! 
!       declare
!          Lhs : constant Node_Id := Duplicate_Subexpr_No_Checks (Arg);
! 
!       begin
!          Set_Assignment_OK (Lhs);
!          Append_To (Stmts,
!            Make_Assignment_Statement (Loc,
!              Name       => Lhs,
!              Expression => Make_Null (Loc)));
!       end;
  
        Rewrite (N, Gen_Code);
        Analyze (N);
--- 969,995 ----
           end if;
        end;
  
!       --  Only remaining step is to set result to null, or generate a
!       --  raise of constraint error if the target object is "not null".
  
!       if Can_Never_Be_Null (Etype (Arg)) then
!          Append_To (Stmts,
!            Make_Raise_Constraint_Error (Loc,
!              Reason => CE_Access_Check_Failed));
  
!       else
!          declare
!             Lhs : constant Node_Id := Duplicate_Subexpr_No_Checks (Arg);
!          begin
!             Set_Assignment_OK (Lhs);
!             Append_To (Stmts,
!               Make_Assignment_Statement (Loc,
!                 Name       => Lhs,
!                 Expression => Make_Null (Loc)));
!          end;
        end if;
  
!       --  Rewrite the call
  
        Rewrite (N, Gen_Code);
        Analyze (N);
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_intr.ads gcc-4.1.0/gcc/ada/exp_intr.ads
*** gcc-4.0.2/gcc/ada/exp_intr.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_intr.ads	Tue Nov 15 17:21:54 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_pakd.adb gcc-4.1.0/gcc/ada/exp_pakd.adb
*** gcc-4.0.2/gcc/ada/exp_pakd.adb	Mon Jan  3 15:43:24 2005
--- gcc-4.1.0/gcc/ada/exp_pakd.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,32 ****
--- 27,33 ----
  with Atree;    use Atree;
  with Checks;   use Checks;
  with Einfo;    use Einfo;
+ with Errout;   use Errout;
  with Exp_Dbug; use Exp_Dbug;
  with Exp_Util; use Exp_Util;
  with Nlists;   use Nlists;
*************** package body Exp_Pakd is
*** 1084,1090 ****
           --  discriminants, so we treat it as a default/per-object expression.
  
           Set_Parent (Len_Expr, Typ);
!          Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
  
           --  Use a modular type if possible. We can do this if we have
           --  static bounds, and the length is small enough, and the length
--- 1085,1091 ----
           --  discriminants, so we treat it as a default/per-object expression.
  
           Set_Parent (Len_Expr, Typ);
!          Analyze_Per_Use_Expression (Len_Expr, Standard_Long_Long_Integer);
  
           --  Use a modular type if possible. We can do this if we have
           --  static bounds, and the length is small enough, and the length
*************** package body Exp_Pakd is
*** 1095,1100 ****
--- 1096,1122 ----
           if Compile_Time_Known_Value (Len_Expr) then
              Len_Bits := Expr_Value (Len_Expr) * Csize;
  
+             --  Check for size known to be too large
+ 
+             if Len_Bits >
+               Uint_2 ** (Standard_Integer_Size - 1) * System_Storage_Unit
+             then
+                if System_Storage_Unit = 8 then
+                   Error_Msg_N
+                     ("packed array size cannot exceed " &
+                      "Integer''Last bytes", Typ);
+                else
+                   Error_Msg_N
+                     ("packed array size cannot exceed " &
+                      "Integer''Last storage units", Typ);
+                end if;
+ 
+                --  Reset length to arbitrary not too high value to continue
+ 
+                Len_Expr := Make_Integer_Literal (Loc, 65535);
+                Analyze_And_Resolve (Len_Expr, Standard_Long_Long_Integer);
+             end if;
+ 
              --  We normally consider small enough to mean no larger than the
              --  value of System_Max_Binary_Modulus_Power, checking that in the
              --  case of values longer than word size, we have long shifts.
*************** package body Exp_Pakd is
*** 1207,1227 ****
                   Make_Subtype_Indication (Loc,
                     Subtype_Mark => New_Occurrence_Of (PB_Type, Loc),
                     Constraint =>
- 
                       Make_Index_Or_Discriminant_Constraint (Loc,
                         Constraints => New_List (
                           Make_Range (Loc,
                             Low_Bound =>
                               Make_Integer_Literal (Loc, 0),
!                            High_Bound => PAT_High)))));
  
           Install_PAT;
  
           --  Currently the code in this unit requires that packed arrays
           --  represented by non-modular arrays of bytes be on a byte
!          --  boundary.
  
!          Set_Must_Be_On_Byte_Boundary (Typ);
        end if;
     end Create_Packed_Array_Type;
  
--- 1229,1253 ----
                   Make_Subtype_Indication (Loc,
                     Subtype_Mark => New_Occurrence_Of (PB_Type, Loc),
                     Constraint =>
                       Make_Index_Or_Discriminant_Constraint (Loc,
                         Constraints => New_List (
                           Make_Range (Loc,
                             Low_Bound =>
                               Make_Integer_Literal (Loc, 0),
!                            High_Bound =>
!                              Convert_To (Standard_Integer, PAT_High))))));
  
           Install_PAT;
  
           --  Currently the code in this unit requires that packed arrays
           --  represented by non-modular arrays of bytes be on a byte
!          --  boundary for bit sizes handled by System.Pack_nn units.
!          --  That's because these units assume the array being accessed
!          --  starts on a byte boundary.
  
!          if Get_Id (UI_To_Int (Csize)) /= RE_Null then
!             Set_Must_Be_On_Byte_Boundary (Typ);
!          end if;
        end if;
     end Create_Packed_Array_Type;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_pakd.ads gcc-4.1.0/gcc/ada/exp_pakd.ads
*** gcc-4.0.2/gcc/ada/exp_pakd.ads	Mon Sep 13 10:18:39 2004
--- gcc-4.1.0/gcc/ada/exp_pakd.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_prag.adb gcc-4.1.0/gcc/ada/exp_prag.adb
*** gcc-4.0.2/gcc/ada/exp_prag.adb	Thu Feb 10 13:50:42 2005
--- gcc-4.1.0/gcc/ada/exp_prag.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_prag.ads gcc-4.1.0/gcc/ada/exp_prag.ads
*** gcc-4.0.2/gcc/ada/exp_prag.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_prag.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_smem.adb gcc-4.1.0/gcc/ada/exp_smem.adb
*** gcc-4.0.2/gcc/ada/exp_smem.adb	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_smem.adb	Tue Nov 15 17:21:54 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Smem is
*** 60,66 ****
     procedure Build_Full_Name
       (E : in  Entity_Id;
        N : out String_Id);
!    --  Build the fully qualified string name of a shared variable.
  
     function On_Lhs_Of_Assignment (N : Node_Id) return Boolean;
     --  Determines if N is on the left hand of the assignment. This means
--- 60,66 ----
     procedure Build_Full_Name
       (E : in  Entity_Id;
        N : out String_Id);
!    --  Build the fully qualified string name of a shared variable
  
     function On_Lhs_Of_Assignment (N : Node_Id) return Boolean;
     --  Determines if N is on the left hand of the assignment. This means
*************** package body Exp_Smem is
*** 344,351 ****
              New_Reference_To (S, Loc),
              New_Occurrence_Of (Ent, Loc)));
  
-       Set_OK_For_Stream (Atr, True);
- 
        Insert_After_And_Analyze (N,
          Make_Subprogram_Body (Loc,
            Specification =>
--- 344,349 ----
*************** package body Exp_Smem is
*** 408,415 ****
              New_Reference_To (S, Loc),
              New_Occurrence_Of (Ent, Loc)));
  
-       Set_OK_For_Stream (Atr, True);
- 
        Insert_After_And_Analyze (N,
          Make_Subprogram_Body (Loc,
            Specification =>
--- 406,411 ----
*************** package body Exp_Smem is
*** 496,500 ****
        end if;
     end On_Lhs_Of_Assignment;
  
- 
  end Exp_Smem;
--- 492,495 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_smem.ads gcc-4.1.0/gcc/ada/exp_smem.ads
*** gcc-4.0.2/gcc/ada/exp_smem.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_smem.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_strm.adb gcc-4.1.0/gcc/ada/exp_strm.adb
*** gcc-4.0.2/gcc/ada/exp_strm.adb	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/exp_strm.adb	Tue Nov 15 13:58:31 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Snames;   use Snames;
*** 36,42 ****
  with Stand;    use Stand;
  with Tbuild;   use Tbuild;
  with Ttypes;   use Ttypes;
- with Exp_Tss;  use Exp_Tss;
  with Uintp;    use Uintp;
  
  package body Exp_Strm is
--- 36,41 ----
*************** package body Exp_Strm is
*** 592,612 ****
  
        --  Call the function, and do an unchecked conversion of the result
        --  to the actual type of the prefix. If the target is a discriminant,
!       --  set target type to force a constraint check (13.13.2 (35)).
  
!       if Nkind (Targ) = N_Selected_Component
!         and then Present (Entity (Selector_Name (Targ)))
!         and then Ekind (Entity (Selector_Name (Targ)))
!           = E_Discriminant
        then
           Res :=
!            Unchecked_Convert_To (Base_Type (P_Type),
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (Lib_RE), Loc),
                 Parameter_Associations => New_List (
                   Relocate_Node (Strm))));
  
           Set_Do_Range_Check (Res);
           return Res;
  
        else
--- 591,617 ----
  
        --  Call the function, and do an unchecked conversion of the result
        --  to the actual type of the prefix. If the target is a discriminant,
!       --  and we are in the body of the default implementation of a 'Read
!       --  attribute, set target type to force a constraint check (13.13.2(35)).
!       --  If the type of the discriminant is currently private, add another
!       --  unchecked conversion from the full view.
  
!       if Nkind (Targ) = N_Identifier
!         and then Is_Internal_Name (Chars (Targ))
!         and then Is_TSS (Scope (Entity (Targ)), TSS_Stream_Read)
        then
           Res :=
!            Unchecked_Convert_To (Base_Type (U_Type),
               Make_Function_Call (Loc,
                 Name => New_Occurrence_Of (RTE (Lib_RE), Loc),
                 Parameter_Associations => New_List (
                   Relocate_Node (Strm))));
  
           Set_Do_Range_Check (Res);
+          if Base_Type (P_Type) /= Base_Type (U_Type) then
+             Res := Unchecked_Convert_To (Base_Type (P_Type), Res);
+          end if;
+ 
           return Res;
  
        else
*************** package body Exp_Strm is
*** 786,808 ****
        Decl : out Node_Id;
        Pnam : out Entity_Id)
     is
!       Stms : List_Id;
        --  Statements for the 'Read body
  
        Tmp : constant Entity_Id := Make_Defining_Identifier (Loc, Name_V);
!       --  Temporary, must hide formal (assignments to components of the
        --  record are always generated with V as the identifier for the record).
  
!       Cstr : List_Id;
!       --  List of constraints to be applied on temporary
! 
!       Disc     : Entity_Id;
!       Disc_Ref : Node_Id;
!       Block    : Node_Id;
  
     begin
!       Stms := New_List;
!       Cstr := New_List;
        Disc := First_Discriminant (Typ);
  
        --  A mutable type cannot be a tagged type, so we generate a new name
--- 791,831 ----
        Decl : out Node_Id;
        Pnam : out Entity_Id)
     is
!       Out_Formal : Node_Id;
!       --  Expression denoting the out formal parameter
! 
!       Dcls : constant List_Id := New_List;
!       --  Declarations for the 'Read body
! 
!       Stms : List_Id := New_List;
        --  Statements for the 'Read body
  
+       Disc : Entity_Id;
+       --  Entity of the discriminant being processed
+ 
+       Tmp_For_Disc : Entity_Id;
+       --  Temporary object used to read the value of Disc
+ 
+       Tmps_For_Discs : constant List_Id := New_List;
+       --  List of object declarations for temporaries holding the read values
+       --  for the discriminants.
+ 
+       Cstr : constant List_Id := New_List;
+       --  List of constraints to be applied on temporary record
+ 
+       Discriminant_Checks : constant List_Id := New_List;
+       --  List of discriminant checks to be performed if the actual object
+       --  is constrained.
+ 
        Tmp : constant Entity_Id := Make_Defining_Identifier (Loc, Name_V);
!       --  Temporary record must hide formal (assignments to components of the
        --  record are always generated with V as the identifier for the record).
  
!       Constrained_Stms : List_Id := New_List;
!       --  Statements within the block where we have the constrained temporary
  
     begin
! 
        Disc := First_Discriminant (Typ);
  
        --  A mutable type cannot be a tagged type, so we generate a new name
*************** package body Exp_Strm is
*** 812,844 ****
          Make_Defining_Identifier (Loc,
            Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
  
        --  Generate Reads for the discriminants of the type. The discriminants
        --  need to be read before the rest of the components, so that
!       --  variants are initialized correctly.
  
        while Present (Disc) loop
!          Disc_Ref :=
!            Make_Selected_Component (Loc,
!              Prefix        => Make_Selected_Component (Loc,
!                                 Prefix => New_Occurrence_Of (Pnam, Loc),
!                                 Selector_Name =>
!                                   Make_Identifier (Loc, Name_V)),
!              Selector_Name => New_Occurrence_Of (Disc, Loc));
  
!          Set_Assignment_OK (Disc_Ref);
  
           Append_To (Stms,
             Make_Attribute_Reference (Loc,
               Prefix => New_Occurrence_Of (Etype (Disc), Loc),
!                Attribute_Name => Name_Read,
!                Expressions => New_List (
!                  Make_Identifier (Loc, Name_S),
!                  Disc_Ref)));
  
           Append_To (Cstr,
             Make_Discriminant_Association (Loc,
               Selector_Names => New_List (New_Occurrence_Of (Disc, Loc)),
!              Expression     => New_Copy_Tree (Disc_Ref)));
           Next_Discriminant (Disc);
        end loop;
  
--- 835,884 ----
          Make_Defining_Identifier (Loc,
            Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
  
+       Out_Formal :=
+         Make_Selected_Component (Loc,
+           Prefix => New_Occurrence_Of (Pnam, Loc),
+           Selector_Name => Make_Identifier (Loc, Name_V));
+ 
        --  Generate Reads for the discriminants of the type. The discriminants
        --  need to be read before the rest of the components, so that
!       --  variants are initialized correctly. The discriminants must be read
!       --  into temporary variables so an incomplete Read (interrupted by an
!       --  exception, for example) does not alter the passed object.
  
        while Present (Disc) loop
!          Tmp_For_Disc := Make_Defining_Identifier (Loc,
!                            New_External_Name (Chars (Disc), "D"));
  
!          Append_To (Tmps_For_Discs,
!            Make_Object_Declaration (Loc,
!              Defining_Identifier => Tmp_For_Disc,
!              Object_Definition   => New_Occurrence_Of (Etype (Disc), Loc)));
!          Set_No_Initialization (Last (Tmps_For_Discs));
  
           Append_To (Stms,
             Make_Attribute_Reference (Loc,
               Prefix => New_Occurrence_Of (Etype (Disc), Loc),
!              Attribute_Name => Name_Read,
!              Expressions => New_List (
!                Make_Identifier (Loc, Name_S),
!                New_Occurrence_Of (Tmp_For_Disc, Loc))));
  
           Append_To (Cstr,
             Make_Discriminant_Association (Loc,
               Selector_Names => New_List (New_Occurrence_Of (Disc, Loc)),
!              Expression     => New_Occurrence_Of (Tmp_For_Disc, Loc)));
! 
!          Append_To (Discriminant_Checks,
!            Make_Raise_Constraint_Error (Loc,
!              Condition =>
!                Make_Op_Ne (Loc,
!                  Left_Opnd  => New_Occurrence_Of (Tmp_For_Disc, Loc),
!                  Right_Opnd =>
!                    Make_Selected_Component (Loc,
!                      Prefix => New_Copy_Tree (Out_Formal),
!                      Selector_Name => New_Occurrence_Of (Disc, Loc))),
!              Reason => CE_Discriminant_Check_Failed));
           Next_Discriminant (Disc);
        end loop;
  
*************** package body Exp_Strm is
*** 854,880 ****
        --  prior to being initialized. To this effect, we wrap the component
        --  assignments in a block where V is a constrained temporary.
  
!       Block :=
          Make_Block_Statement (Loc,
!           Declarations => New_List (
!            Make_Object_Declaration (Loc,
!              Defining_Identifier => Tmp,
!              Object_Definition   =>
!                Make_Subtype_Indication (Loc,
!                  Subtype_Mark => New_Occurrence_Of (Typ, Loc),
!                  Constraint =>
!                    Make_Index_Or_Discriminant_Constraint (Loc,
!                      Constraints => Cstr)))),
!           Handled_Statement_Sequence =>
!             Handled_Statement_Sequence (Decl));
  
!       Append_To (Stms, Block);
  
!       Append_To (Statements (Handled_Statement_Sequence (Block)),
          Make_Assignment_Statement (Loc,
!           Name => Make_Selected_Component (Loc,
!                     Prefix => New_Occurrence_Of (Pnam, Loc),
!                     Selector_Name => Make_Identifier (Loc, Name_V)),
            Expression => Make_Identifier (Loc, Name_V)));
  
        if Is_Unchecked_Union (Typ) then
--- 894,926 ----
        --  prior to being initialized. To this effect, we wrap the component
        --  assignments in a block where V is a constrained temporary.
  
!       Append_To (Dcls,
!         Make_Object_Declaration (Loc,
!           Defining_Identifier => Tmp,
!           Object_Definition   =>
!             Make_Subtype_Indication (Loc,
!               Subtype_Mark => New_Occurrence_Of (Typ, Loc),
!               Constraint =>
!                 Make_Index_Or_Discriminant_Constraint (Loc,
!                   Constraints => Cstr))));
! 
!       Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
!       Append_To (Stms,
          Make_Block_Statement (Loc,
!           Declarations => Dcls,
!           Handled_Statement_Sequence => Parent (Constrained_Stms)));
  
!       Append_To (Constrained_Stms,
!         Make_Implicit_If_Statement (Pnam,
!           Condition =>
!             Make_Attribute_Reference (Loc,
!               Prefix => New_Copy_Tree (Out_Formal),
!               Attribute_Name => Name_Constrained),
!           Then_Statements => Discriminant_Checks));
  
!       Append_To (Constrained_Stms,
          Make_Assignment_Statement (Loc,
!           Name => Out_Formal,
            Expression => Make_Identifier (Loc, Name_V)));
  
        if Is_Unchecked_Union (Typ) then
*************** package body Exp_Strm is
*** 890,895 ****
--- 936,942 ----
                 Reason => PE_Unchecked_Union_Restriction));
        end if;
  
+       Set_Declarations (Decl, Tmps_For_Discs);
        Set_Handled_Statement_Sequence (Decl,
          Make_Handled_Sequence_Of_Statements (Loc,
            Statements => Stms));
*************** package body Exp_Strm is
*** 1173,1178 ****
--- 1220,1230 ----
        Stms : List_Id;
        Typt : Entity_Id;
  
+       In_Limited_Extension : Boolean := False;
+       --  Set to True while processing the record extension definition
+       --  for an extension of a limited type (for which an ancestor type
+       --  has an explicit Nam attribute definition).
+ 
        function Make_Component_List_Attributes (CL : Node_Id) return List_Id;
        --  Returns a sequence of attributes to process the components that
        --  are referenced in the given component list.
*************** package body Exp_Strm is
*** 1254,1264 ****
        --------------------------
  
        function Make_Field_Attribute (C : Entity_Id) return Node_Id is
        begin
           return
             Make_Attribute_Reference (Loc,
               Prefix =>
!                New_Occurrence_Of (Stream_Base_Type (Etype (C)), Loc),
               Attribute_Name => Nam,
               Expressions => New_List (
                 Make_Identifier (Loc, Name_S),
--- 1306,1338 ----
        --------------------------
  
        function Make_Field_Attribute (C : Entity_Id) return Node_Id is
+          Field_Typ : constant Entity_Id := Stream_Base_Type (Etype (C));
+ 
+          TSS_Names : constant array (Name_Input .. Name_Write) of
+                        TSS_Name_Type :=
+                         (Name_Read   => TSS_Stream_Read,
+                          Name_Write  => TSS_Stream_Write,
+                          Name_Input  => TSS_Stream_Input,
+                          Name_Output => TSS_Stream_Output,
+                          others      => TSS_Null);
+          pragma Assert (TSS_Names (Nam) /= TSS_Null);
+ 
        begin
+          if In_Limited_Extension
+            and then Is_Limited_Type (Field_Typ)
+            and then No (Find_Inherited_TSS (Field_Typ, TSS_Names (Nam)))
+          then
+             --  The declaration is illegal per 13.13.2(9/1), and this is
+             --  enforced in Exp_Ch3.Check_Stream_Attributes. Keep the
+             --  caller happy by returning a null statement.
+ 
+             return Make_Null_Statement (Loc);
+          end if;
+ 
           return
             Make_Attribute_Reference (Loc,
               Prefix =>
!                New_Occurrence_Of (Field_Typ, Loc),
               Attribute_Name => Nam,
               Expressions => New_List (
                 Make_Identifier (Loc, Name_S),
*************** package body Exp_Strm is
*** 1331,1336 ****
--- 1405,1414 ----
  
        if Nkind (Rdef) = N_Derived_Type_Definition then
           Rdef := Record_Extension_Part (Rdef);
+ 
+          if Is_Limited_Type (Typt) then
+             In_Limited_Extension := True;
+          end if;
        end if;
  
        if Present (Component_List (Rdef)) then
*************** package body Exp_Strm is
*** 1369,1379 ****
--- 1447,1461 ----
        Profile : List_Id;
  
     begin
+       --  (Ada 2005: AI-441): Set the null-excluding attribute because it has
+       --  no semantic meaning in Ada 95 but it is a requirement in Ada2005.
+ 
        Profile := New_List (
          Make_Parameter_Specification (Loc,
            Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
            Parameter_Type      =>
            Make_Access_Definition (Loc,
+              Null_Exclusion_Present => True,
               Subtype_Mark => New_Reference_To (
                 Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc))));
  
*************** package body Exp_Strm is
*** 1405,1410 ****
--- 1487,1495 ----
     begin
        --  Construct function specification
  
+       --  (Ada 2005: AI-441): Set the null-excluding attribute because it has
+       --  no semantic meaning in Ada 95 but it is a requirement in Ada2005.
+ 
        Spec :=
          Make_Function_Specification (Loc,
            Defining_Unit_Name => Fnam,
*************** package body Exp_Strm is
*** 1414,1423 ****
                Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
                Parameter_Type =>
                  Make_Access_Definition (Loc,
                    Subtype_Mark => New_Reference_To (
                      Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc)))),
  
!           Subtype_Mark => New_Occurrence_Of (Typ, Loc));
  
        Decl :=
          Make_Subprogram_Body (Loc,
--- 1499,1509 ----
                Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
                Parameter_Type =>
                  Make_Access_Definition (Loc,
+                   Null_Exclusion_Present => True,
                    Subtype_Mark => New_Reference_To (
                      Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc)))),
  
!           Result_Definition => New_Occurrence_Of (Typ, Loc));
  
        Decl :=
          Make_Subprogram_Body (Loc,
*************** package body Exp_Strm is
*** 1445,1450 ****
--- 1531,1539 ----
     begin
        --  Construct procedure specification
  
+       --  (Ada 2005: AI-441): Set the null-excluding attribute because it has
+       --  no semantic meaning in Ada 95 but it is a requirement in Ada2005.
+ 
        Spec :=
          Make_Procedure_Specification (Loc,
            Defining_Unit_Name => Pnam,
*************** package body Exp_Strm is
*** 1454,1459 ****
--- 1543,1549 ----
                Defining_Identifier => Make_Defining_Identifier (Loc, Name_S),
                Parameter_Type =>
                  Make_Access_Definition (Loc,
+                   Null_Exclusion_Present => True,
                    Subtype_Mark => New_Reference_To (
                      Class_Wide_Type (RTE (RE_Root_Stream_Type)), Loc))),
  
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_strm.ads gcc-4.1.0/gcc/ada/exp_strm.ads
*** gcc-4.0.2/gcc/ada/exp_strm.ads	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/exp_strm.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_tss.adb gcc-4.1.0/gcc/ada/exp_tss.adb
*** gcc-4.0.2/gcc/ada/exp_tss.adb	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/exp_tss.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_Tss is
*** 97,102 ****
--- 97,137 ----
        Prepend_Elmt (TSS, TSS_Elist (FN));
     end Copy_TSS;
  
+    ------------------------
+    -- Find_Inherited_TSS --
+    ------------------------
+ 
+    function Find_Inherited_TSS
+      (Typ : Entity_Id;
+       Nam : TSS_Name_Type) return Entity_Id
+    is
+       Btyp : Entity_Id := Typ;
+       Proc : Entity_Id;
+ 
+    begin
+       loop
+          Btyp := Base_Type (Btyp);
+          Proc :=  TSS (Btyp, Nam);
+ 
+          exit when Present (Proc)
+            or else not Is_Derived_Type (Btyp);
+ 
+          --  If Typ is a derived type, it may inherit attributes from some
+          --  ancestor.
+ 
+          Btyp := Etype (Btyp);
+       end loop;
+ 
+       if No (Proc) then
+ 
+          --  If nothing else, use the TSS of the root type
+ 
+          Proc := TSS (Base_Type (Underlying_Type (Typ)), Nam);
+       end if;
+ 
+       return Proc;
+    end Find_Inherited_TSS;
+ 
     -----------------------
     -- Get_TSS_Name_Type --
     -----------------------
*************** package body Exp_Tss is
*** 112,119 ****
        if C1 in 'A' .. 'Z' and then C2 in 'A' .. 'Z' then
           Nm := (C1, C2);
  
!          for J in OK_TSS_Names'Range loop
!             if Nm = OK_TSS_Names (J) then
                 return Nm;
              end if;
           end loop;
--- 147,154 ----
        if C1 in 'A' .. 'Z' and then C2 in 'A' .. 'Z' then
           Nm := (C1, C2);
  
!          for J in TSS_Names'Range loop
!             if Nm = TSS_Names (J) then
                 return Nm;
              end if;
           end loop;
*************** package body Exp_Tss is
*** 200,210 ****
  
     function Make_Init_Proc_Name (Typ : Entity_Id) return Name_Id is
     begin
!       Get_Name_String (Chars (Typ));
!       Name_Len := Name_Len + 2;
!       Name_Buffer (Name_Len - 1) := TSS_Init_Proc (1);
!       Name_Buffer (Name_Len)     := TSS_Init_Proc (2);
!       return Name_Find;
     end Make_Init_Proc_Name;
  
     -------------------------
--- 235,241 ----
  
     function Make_Init_Proc_Name (Typ : Entity_Id) return Name_Id is
     begin
!       return Make_TSS_Name (Typ, TSS_Init_Proc);
     end Make_Init_Proc_Name;
  
     -------------------------
*************** package body Exp_Tss is
*** 217,226 ****
     is
     begin
        Get_Name_String (Chars (Typ));
-       Add_Char_To_Name_Buffer (Nam (1));
-       Add_Char_To_Name_Buffer (Nam (2));
        Add_Char_To_Name_Buffer ('_');
        Add_Nat_To_Name_Buffer (Increment_Serial_Number);
        return Name_Find;
     end Make_TSS_Name_Local;
  
--- 248,257 ----
     is
     begin
        Get_Name_String (Chars (Typ));
        Add_Char_To_Name_Buffer ('_');
        Add_Nat_To_Name_Buffer (Increment_Serial_Number);
+       Add_Char_To_Name_Buffer (Nam (1));
+       Add_Char_To_Name_Buffer (Nam (2));
        return Name_Find;
     end Make_TSS_Name_Local;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_tss.ads gcc-4.1.0/gcc/ada/exp_tss.ads
*** gcc-4.0.2/gcc/ada/exp_tss.ads	Mon Jan 26 14:47:48 2004
--- gcc-4.1.0/gcc/ada/exp_tss.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Exp_Tss is
*** 64,72 ****
     -- TSS Naming --
     ----------------
  
!    --  A TSS is identified by its Chars name. The name has the form typXY,
!    --  where typ is the type name, and XY are two characters that identify
!    --  the particular TSS routine, using the following codes:
  
     --  Note: When making additions to this list, update the list in snames.adb
  
--- 64,76 ----
     -- TSS Naming --
     ----------------
  
!    --  A TSS is identified by its Chars name. The name has the form typXY or
!    --  typ_<serial>XY, where typ is the type name, and XY are two characters
!    --  that identify the particular TSS routine. A unique serial number is
!    --  included for the case where several local instances of the same TSS
!    --  must be generated (see discussion under Make_TSS_Name_Local).
! 
!    --  The following codes are used to denote TSSs:
  
     --  Note: When making additions to this list, update the list in snames.adb
  
*************** package Exp_Tss is
*** 77,97 ****
     TSS_Deep_Finalize      : constant TNT := "DF";  -- Deep Finalize
     TSS_Deep_Initialize    : constant TNT := "DI";  -- Deep Initialize
     TSS_Composite_Equality : constant TNT := "EQ";  -- Composite Equality
     TSS_Init_Proc          : constant TNT := "IP";  -- Initialization Procedure
!    TSS_RAS_Access         : constant TNT := "RA";  -- RAs type access
!    TSS_RAS_Dereference    : constant TNT := "RD";  -- RAs type deference
     TSS_Rep_To_Pos         : constant TNT := "RP";  -- Rep to Pos conversion
     TSS_Slice_Assign       : constant TNT := "SA";  -- Slice assignment
     TSS_Stream_Input       : constant TNT := "SI";  -- Stream Input attribute
     TSS_Stream_Output      : constant TNT := "SO";  -- Stream Output attribute
     TSS_Stream_Read        : constant TNT := "SR";  -- Stream Read attribute
     TSS_Stream_Write       : constant TNT := "SW";  -- Stream Write attribute
  
!    OK_TSS_Names : constant array (Natural range <>) of TSS_Name_Type :=
       (TSS_Deep_Adjust,
        TSS_Deep_Finalize,
        TSS_Deep_Initialize,
        TSS_Composite_Equality,
        TSS_Init_Proc,
        TSS_RAS_Access,
        TSS_RAS_Dereference,
--- 81,107 ----
     TSS_Deep_Finalize      : constant TNT := "DF";  -- Deep Finalize
     TSS_Deep_Initialize    : constant TNT := "DI";  -- Deep Initialize
     TSS_Composite_Equality : constant TNT := "EQ";  -- Composite Equality
+    TSS_From_Any           : constant TNT := "FA";  -- PolyORB/DSA From_Any
     TSS_Init_Proc          : constant TNT := "IP";  -- Initialization Procedure
!    TSS_RAS_Access         : constant TNT := "RA";  -- RAS type access
!    TSS_RAS_Dereference    : constant TNT := "RD";  -- RAS type deference
     TSS_Rep_To_Pos         : constant TNT := "RP";  -- Rep to Pos conversion
     TSS_Slice_Assign       : constant TNT := "SA";  -- Slice assignment
     TSS_Stream_Input       : constant TNT := "SI";  -- Stream Input attribute
     TSS_Stream_Output      : constant TNT := "SO";  -- Stream Output attribute
     TSS_Stream_Read        : constant TNT := "SR";  -- Stream Read attribute
     TSS_Stream_Write       : constant TNT := "SW";  -- Stream Write attribute
+    TSS_To_Any             : constant TNT := "TA";  -- PolyORB/DSA To_Any
+    TSS_TypeCode           : constant TNT := "TC";  -- PolyORB/DSA TypeCode
  
!    --  The array below contains all valid TSS names
! 
!    TSS_Names : constant array (Natural range <>) of TSS_Name_Type :=
       (TSS_Deep_Adjust,
        TSS_Deep_Finalize,
        TSS_Deep_Initialize,
        TSS_Composite_Equality,
+       TSS_From_Any,
        TSS_Init_Proc,
        TSS_RAS_Access,
        TSS_RAS_Dereference,
*************** package Exp_Tss is
*** 100,106 ****
        TSS_Stream_Input,
        TSS_Stream_Output,
        TSS_Stream_Read,
!       TSS_Stream_Write);
  
     TSS_Null : constant TNT := "  ";
     --  Dummy entry used to indicated that this is not really a TSS
--- 110,118 ----
        TSS_Stream_Input,
        TSS_Stream_Output,
        TSS_Stream_Read,
!       TSS_Stream_Write,
!       TSS_To_Any,
!       TSS_TypeCode);
  
     TSS_Null : constant TNT := "  ";
     --  Dummy entry used to indicated that this is not really a TSS
*************** package Exp_Tss is
*** 118,127 ****
     function Make_TSS_Name_Local
       (Typ : Entity_Id;
        Nam : TSS_Name_Type) return Name_Id;
!    --  Similar to the above call, but a string of the form _nnn is appended
!    --  to the name, where nnn is a unique serial number. This is used when
!    --  multiple instances of the same TSS routine may be generated in the
!    --  same scope (see also discussion above of current limitations).
  
     function Make_Init_Proc_Name (Typ : Entity_Id) return Name_Id;
     --  Version for init procs, same as Make_TSS_Name (Typ, TSS_Init_Proc)
--- 130,140 ----
     function Make_TSS_Name_Local
       (Typ : Entity_Id;
        Nam : TSS_Name_Type) return Name_Id;
!    --  Similar to the above call, but a string of the form _nnn is inserted
!    --  before the TSS code suffix, where nnn is a unique serial number. This
!    --  is used when multiple instances of the same TSS routine may be
!    --  generated in the same scope (see also discussion above of current
!    --  limitations).
  
     function Make_Init_Proc_Name (Typ : Entity_Id) return Name_Id;
     --  Version for init procs, same as Make_TSS_Name (Typ, TSS_Init_Proc)
*************** package Exp_Tss is
*** 206,209 ****
--- 219,229 ----
     --  is used to test for the presence of an init proc in cases where
     --  a null init proc is considered equivalent to no init proc.
  
+    function Find_Inherited_TSS
+      (Typ : Entity_Id;
+       Nam : TSS_Name_Type) return Entity_Id;
+    --  Returns the TSS of name Nam of Typ, or of its closest ancestor defining
+    --  such a TSS. Empty is returned is neither Typ nor any of its ancestors
+    --  have such a TSS.
+ 
  end Exp_Tss;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_util.adb gcc-4.1.0/gcc/ada/exp_util.adb
*** gcc-4.0.2/gcc/ada/exp_util.adb	Thu Mar 17 18:46:43 2005
--- gcc-4.1.0/gcc/ada/exp_util.adb	Wed Jan 25 14:06:59 2006
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Elists;   use Elists;
*** 31,38 ****
  with Errout;   use Errout;
  with Exp_Aggr; use Exp_Aggr;
  with Exp_Ch7;  use Exp_Ch7;
- with Exp_Ch11; use Exp_Ch11;
- with Exp_Tss;  use Exp_Tss;
  with Hostparm; use Hostparm;
  with Inline;   use Inline;
  with Itypes;   use Itypes;
--- 31,36 ----
*************** with Sem;      use Sem;
*** 47,54 ****
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Eval; use Sem_Eval;
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
- with Sinfo;    use Sinfo;
  with Snames;   use Snames;
  with Stand;    use Stand;
  with Stringt;  use Stringt;
--- 45,52 ----
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Eval; use Sem_Eval;
  with Sem_Res;  use Sem_Res;
+ with Sem_Type; use Sem_Type;
  with Sem_Util; use Sem_Util;
  with Snames;   use Snames;
  with Stand;    use Stand;
  with Stringt;  use Stringt;
*************** package body Exp_Util is
*** 684,690 ****
        Spec := Make_Function_Specification (Loc,
          Defining_Unit_Name =>
            Make_Defining_Identifier (Loc, New_Internal_Name ('F')),
!         Subtype_Mark => New_Occurrence_Of (Standard_String, Loc));
  
        --  Calls to 'Image use the secondary stack, which must be cleaned
        --  up after the task name is built.
--- 682,688 ----
        Spec := Make_Function_Specification (Loc,
          Defining_Unit_Name =>
            Make_Defining_Identifier (Loc, New_Internal_Name ('F')),
!         Result_Definition => New_Occurrence_Of (Standard_String, Loc));
  
        --  Calls to 'Image use the secondary stack, which must be cleaned
        --  up after the task name is built.
*************** package body Exp_Util is
*** 1219,1227 ****
        then
           if Is_Itype (Exp_Typ) then
  
!             --  No need to generate a new one
  
!             T := Exp_Typ;
  
           else
              T :=
--- 1217,1248 ----
        then
           if Is_Itype (Exp_Typ) then
  
!             --  Within an initialization procedure, a selected component
!             --  denotes a component of the enclosing record, and it appears
!             --  as an actual in a call to its own initialization procedure.
!             --  If this component depends on the outer discriminant, we must
!             --  generate the proper actual subtype for it.
  
!             if Nkind (Exp) = N_Selected_Component
!               and then Within_Init_Proc
!             then
!                declare
!                   Decl : constant Node_Id :=
!                            Build_Actual_Subtype_Of_Component (Exp_Typ, Exp);
!                begin
!                   if Present (Decl) then
!                      Insert_Action (N, Decl);
!                      T := Defining_Identifier (Decl);
!                   else
!                      T := Exp_Typ;
!                   end if;
!                end;
! 
!             --  No need to generate a new one (new what???)
! 
!             else
!                T := Exp_Typ;
!             end if;
  
           else
              T :=
*************** package body Exp_Util is
*** 1254,1259 ****
--- 1275,1297 ----
        then
           null;
  
+       --  Nothing to be done for derived types with unknown discriminants if
+       --  the parent type also has unknown discriminants.
+ 
+       elsif Is_Record_Type (Unc_Type)
+         and then not Is_Class_Wide_Type (Unc_Type)
+         and then Has_Unknown_Discriminants (Unc_Type)
+         and then Has_Unknown_Discriminants (Underlying_Type (Unc_Type))
+       then
+          null;
+ 
+       --  Nothing to be done if the type of the expression is limited, because
+       --  in this case the expression cannot be copied, and its use can only
+       --  be by reference and there is no need for the actual subtype.
+ 
+       elsif Is_Limited_Type (Exp_Typ) then
+          null;
+ 
        else
           Remove_Side_Effects (Exp);
           Rewrite (Subtype_Indic,
*************** package body Exp_Util is
*** 1261,1266 ****
--- 1299,1647 ----
        end if;
     end Expand_Subtype_From_Expr;
  
+    --------------------------------
+    -- Find_Implemented_Interface --
+    --------------------------------
+ 
+    --  Given the following code (XXX denotes irrelevant value):
+ 
+    --     type Limd_Iface is limited interface;
+    --     type Prot_Iface is protected interface;
+    --     type Sync_Iface is synchronized interface;
+ 
+    --     type Parent_Subtype is new Limd_Iface and Sync_Iface with ...
+    --     type Child_Subtype is new Parent_Subtype and Prot_Iface with ...
+ 
+    --  The following calls will return the following values:
+ 
+    --     Find_Implemented_Interface
+    --       (Child_Subtype, Synchronized_Interface, False)    -> Empty
+ 
+    --     Find_Implemented_Interface
+    --       (Child_Subtype, Synchronized_Interface, True)     -> Sync_Iface
+ 
+    --     Find_Implemented_Interface
+    --       (Child_Subtype, Any_Synchronized_Interface, XXX)  -> Prot_Iface
+ 
+    --     Find_Implemented_Interface
+    --       (Child_Subtype, Any_Limited_Interface, XXX)       -> Prot_Iface
+ 
+    function Find_Implemented_Interface
+      (Typ          : Entity_Id;
+       Kind         : Interface_Kind;
+       Check_Parent : Boolean := False) return Entity_Id
+    is
+       Iface_Elmt : Elmt_Id;
+ 
+       function Interface_In_Kind
+         (I    : Entity_Id;
+          Kind : Interface_Kind) return Boolean;
+       --  Determine whether an interface falls into a specified kind
+ 
+       -----------------------
+       -- Interface_In_Kind --
+       -----------------------
+ 
+       function Interface_In_Kind
+         (I    : Entity_Id;
+          Kind : Interface_Kind) return Boolean is
+       begin
+          if Is_Limited_Interface (I)
+            and then (Kind = Any_Interface
+              or else Kind = Any_Limited_Interface
+              or else Kind = Limited_Interface)
+          then
+             return True;
+ 
+          elsif Is_Protected_Interface (I)
+            and then (Kind = Any_Interface
+              or else Kind = Any_Limited_Interface
+              or else Kind = Any_Synchronized_Interface
+              or else Kind = Protected_Interface)
+          then
+             return True;
+ 
+          elsif Is_Synchronized_Interface (I)
+            and then (Kind = Any_Interface
+              or else Kind = Any_Limited_Interface
+              or else Kind = Synchronized_Interface)
+          then
+             return True;
+ 
+          elsif Is_Task_Interface (I)
+            and then (Kind = Any_Interface
+              or else Kind = Any_Limited_Interface
+              or else Kind = Any_Synchronized_Interface
+              or else Kind = Task_Interface)
+          then
+             return True;
+ 
+          --  Regular interface. This should be the last kind to check since
+          --  all of the previous cases have their Is_Interface flags set.
+ 
+          elsif Is_Interface (I)
+            and then (Kind = Any_Interface
+              or else Kind = Iface)
+          then
+             return True;
+ 
+          else
+             return False;
+          end if;
+       end Interface_In_Kind;
+ 
+    --  Start of processing for Find_Implemented_Interface
+ 
+    begin
+       if not Is_Tagged_Type (Typ) then
+          return Empty;
+       end if;
+ 
+       --  Implementations of the form:
+       --    Typ is new Interface ...
+ 
+       if Is_Interface (Etype (Typ))
+         and then Interface_In_Kind (Etype (Typ), Kind)
+       then
+          return Etype (Typ);
+       end if;
+ 
+       --  Implementations of the form:
+       --     Typ is new Typ_Parent and Interface ...
+ 
+       if Present (Abstract_Interfaces (Typ)) then
+          Iface_Elmt := First_Elmt (Abstract_Interfaces (Typ));
+          while Present (Iface_Elmt) loop
+             if Interface_In_Kind (Node (Iface_Elmt), Kind) then
+                return Node (Iface_Elmt);
+             end if;
+ 
+             Iface_Elmt := Next_Elmt (Iface_Elmt);
+          end loop;
+       end if;
+ 
+       --  Typ is a derived type and may implement a limited interface
+       --  through its parent subtype. Check the parent subtype as well
+       --  as any interfaces explicitly implemented at this level.
+ 
+       if Check_Parent
+         and then Ekind (Typ) = E_Record_Type
+         and then Present (Parent_Subtype (Typ))
+       then
+          return Find_Implemented_Interface (
+            Parent_Subtype (Typ), Kind, Check_Parent);
+       end if;
+ 
+       --  Typ does not implement a limited interface either at this level or
+       --  in any of its parent subtypes.
+ 
+       return Empty;
+    end Find_Implemented_Interface;
+ 
+    ------------------------
+    -- Find_Interface_ADT --
+    ------------------------
+ 
+    function Find_Interface_ADT
+      (T     : Entity_Id;
+       Iface : Entity_Id) return Entity_Id
+    is
+       ADT   : Elmt_Id;
+       Found : Boolean := False;
+       Typ   : Entity_Id := T;
+ 
+       procedure Find_Secondary_Table (Typ : Entity_Id);
+       --  Internal subprogram used to recursively climb to the ancestors
+ 
+       --------------------------
+       -- Find_Secondary_Table --
+       --------------------------
+ 
+       procedure Find_Secondary_Table (Typ : Entity_Id) is
+          AI_Elmt : Elmt_Id;
+          AI      : Node_Id;
+ 
+       begin
+          --  Climb to the ancestor (if any) handling private types
+ 
+          if Present (Full_View (Etype (Typ))) then
+             if Full_View (Etype (Typ)) /= Typ then
+                Find_Secondary_Table (Full_View (Etype (Typ)));
+             end if;
+ 
+          elsif Etype (Typ) /= Typ then
+             Find_Secondary_Table (Etype (Typ));
+          end if;
+ 
+          --  If we already found it there is nothing else to do
+ 
+          if Found then
+             return;
+          end if;
+ 
+          if Present (Abstract_Interfaces (Typ))
+            and then not Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
+          then
+             AI_Elmt := First_Elmt (Abstract_Interfaces (Typ));
+             while Present (AI_Elmt) loop
+                AI := Node (AI_Elmt);
+ 
+                if AI = Iface or else Is_Ancestor (Iface, AI) then
+                   Found := True;
+                   return;
+                end if;
+ 
+                Next_Elmt (ADT);
+                Next_Elmt (AI_Elmt);
+             end loop;
+          end if;
+       end Find_Secondary_Table;
+ 
+    --  Start of processing for Find_Interface_Tag
+ 
+    begin
+       --  Handle private types
+ 
+       if Has_Private_Declaration (Typ)
+         and then Present (Full_View (Typ))
+       then
+          Typ := Full_View (Typ);
+       end if;
+ 
+       --  Handle access types
+ 
+       if Is_Access_Type (Typ) then
+          Typ := Directly_Designated_Type (Typ);
+       end if;
+ 
+       --  Handle task and protected types implementing interfaces
+ 
+       if Ekind (Typ) = E_Protected_Type
+         or else Ekind (Typ) = E_Task_Type
+       then
+          Typ := Corresponding_Record_Type (Typ);
+       end if;
+ 
+       ADT := Next_Elmt (First_Elmt (Access_Disp_Table (Typ)));
+       pragma Assert (Present (Node (ADT)));
+       Find_Secondary_Table (Typ);
+       pragma Assert (Found);
+       return Node (ADT);
+    end Find_Interface_ADT;
+ 
+    ------------------------
+    -- Find_Interface_Tag --
+    ------------------------
+ 
+    function Find_Interface_Tag
+      (T      : Entity_Id;
+       Iface  : Entity_Id) return Entity_Id
+    is
+       AI_Tag : Entity_Id;
+       Found  : Boolean := False;
+       Typ    : Entity_Id := T;
+ 
+       procedure Find_Tag (Typ : in Entity_Id);
+       --  Internal subprogram used to recursively climb to the ancestors
+ 
+       -----------------
+       -- Find_AI_Tag --
+       -----------------
+ 
+       procedure Find_Tag (Typ : in Entity_Id) is
+          AI_Elmt : Elmt_Id;
+          AI      : Node_Id;
+ 
+       begin
+          --  Check if the interface is an immediate ancestor of the type and
+          --  therefore shares the main tag.
+ 
+          if Typ = Iface then
+             pragma Assert (Etype (First_Tag_Component (Typ)) = RTE (RE_Tag));
+             AI_Tag := First_Tag_Component (Typ);
+             Found  := True;
+             return;
+          end if;
+ 
+          --  Climb to the root type handling private types
+ 
+          if Present (Full_View (Etype (Typ))) then
+             if Full_View (Etype (Typ)) /= Typ then
+                Find_Tag (Full_View (Etype (Typ)));
+             end if;
+ 
+          elsif Etype (Typ) /= Typ then
+             Find_Tag (Etype (Typ));
+          end if;
+ 
+          --  Traverse the list of interfaces implemented by the type
+ 
+          if not Found
+            and then Present (Abstract_Interfaces (Typ))
+            and then not (Is_Empty_Elmt_List (Abstract_Interfaces (Typ)))
+          then
+             --  Skip the tag associated with the primary table
+ 
+             pragma Assert (Etype (First_Tag_Component (Typ)) = RTE (RE_Tag));
+             AI_Tag := Next_Tag_Component (First_Tag_Component (Typ));
+             pragma Assert (Present (AI_Tag));
+ 
+             AI_Elmt := First_Elmt (Abstract_Interfaces (Typ));
+             while Present (AI_Elmt) loop
+                AI := Node (AI_Elmt);
+ 
+                if AI = Iface or else Is_Ancestor (Iface, AI) then
+                   Found := True;
+                   return;
+                end if;
+ 
+                AI_Tag := Next_Tag_Component (AI_Tag);
+                Next_Elmt (AI_Elmt);
+             end loop;
+          end if;
+       end Find_Tag;
+ 
+    --  Start of processing for Find_Interface_Tag
+ 
+    begin
+       pragma Assert (Is_Interface (Iface));
+ 
+       --  Handle private types
+ 
+       if Has_Private_Declaration (Typ)
+         and then Present (Full_View (Typ))
+       then
+          Typ := Full_View (Typ);
+       end if;
+ 
+       --  Handle access types
+ 
+       if Is_Access_Type (Typ) then
+          Typ := Directly_Designated_Type (Typ);
+       end if;
+ 
+       --  Handle task and protected types implementing interfaces
+ 
+       if Is_Concurrent_Type (Typ) then
+          Typ := Corresponding_Record_Type (Typ);
+       end if;
+ 
+       if Is_Class_Wide_Type (Typ) then
+          Typ := Etype (Typ);
+       end if;
+ 
+       --  Handle entities from the limited view
+ 
+       if Ekind (Typ) = E_Incomplete_Type then
+          pragma Assert (Present (Non_Limited_View (Typ)));
+          Typ := Non_Limited_View (Typ);
+       end if;
+ 
+       Find_Tag (Typ);
+       pragma Assert (Found);
+       return AI_Tag;
+    end Find_Interface_Tag;
+ 
     ------------------
     -- Find_Prim_Op --
     ------------------
*************** package body Exp_Util is
*** 1313,1356 ****
     ----------------------
  
     procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is
-       Component_In_Lhs : Boolean := False;
-       Par              : Node_Id;
- 
     begin
!       --  Loop to determine whether there is a component reference in
!       --  the left hand side if Exp appears on the left side of an
!       --  assignment statement. Needed to determine if form of result
!       --  must be a variable.
! 
!       Par := Exp;
!       while Present (Par)
!         and then
!          (Nkind (Par) = N_Selected_Component
!             or else
!           Nkind (Par) = N_Indexed_Component)
!       loop
!          if Nkind (Parent (Par)) = N_Assignment_Statement
!            and then Par = Name (Parent (Par))
!          then
!             Component_In_Lhs := True;
!             exit;
!          else
!             Par := Parent (Par);
!          end if;
!       end loop;
! 
!       --  If the expression is a selected component, it is being evaluated
!       --  as part of a discriminant check. If it is part of a left-hand
!       --  side, this is the last use of its value and it is safe to create
!       --  a renaming for it, rather than a temporary. In addition, if it
!       --  is not an addressable field, creating a temporary may be a problem
!       --  for gigi, or might drop the value of the assignment. Therefore,
!       --  if the expression is on the lhs of an assignment, remove side
!       --  effects without requiring a temporary, and create a renaming.
!       --  (See remove_side_effects for details).
! 
!       Remove_Side_Effects
!         (Exp, Name_Req, Variable_Ref => not Component_In_Lhs);
     end Force_Evaluation;
  
     ------------------------
--- 1694,1701 ----
     ----------------------
  
     procedure Force_Evaluation (Exp : Node_Id; Name_Req : Boolean := False) is
     begin
!       Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True);
     end Force_Evaluation;
  
     ------------------------
*************** package body Exp_Util is
*** 1423,1431 ****
  
                 --  If we fall off the top of the tree, then that's odd, but
                 --  perhaps it could occur in some error situation, and the
!                --  safest response is simply to assume that the outcome of
!                --  the condition is unknown. No point in bombing during an
!                --  attempt to optimize things.
  
                 if No (N) then
                    return;
--- 1768,1776 ----
  
                 --  If we fall off the top of the tree, then that's odd, but
                 --  perhaps it could occur in some error situation, and the
!                --  safest response is simply to assume that the outcome of the
!                --  condition is unknown. No point in bombing during an attempt
!                --  to optimize things.
  
                 if No (N) then
                    return;
*************** package body Exp_Util is
*** 1448,1456 ****
              end if;
           end;
  
!       --  ELSIF part. Condition is known true within the referenced
!       --  ELSIF, known False in any subsequent ELSIF or ELSE part,
!       --  and unknown before the ELSE part or after the IF statement.
  
        elsif Nkind (CV) = N_Elsif_Part then
           Stm := Parent (CV);
--- 1793,1801 ----
              end if;
           end;
  
!       --  ELSIF part. Condition is known true within the referenced ELSIF,
!       --  known False in any subsequent ELSIF or ELSE part, and unknown before
!       --  the ELSE part or after the IF statement.
  
        elsif Nkind (CV) = N_Elsif_Part then
           Stm := Parent (CV);
*************** package body Exp_Util is
*** 1468,1475 ****
              return;
           end if;
  
!          --  Again we lack the SLOC of the ELSE, so we need to climb the
!          --  tree to see if we are within the ELSIF part in question.
  
           declare
              N : Node_Id;
--- 1813,1820 ----
              return;
           end if;
  
!          --  Again we lack the SLOC of the ELSE, so we need to climb the tree
!          --  to see if we are within the ELSIF part in question.
  
           declare
              N : Node_Id;
*************** package body Exp_Util is
*** 1481,1489 ****
  
                 --  If we fall off the top of the tree, then that's odd, but
                 --  perhaps it could occur in some error situation, and the
!                --  safest response is simply to assume that the outcome of
!                --  the condition is unknown. No point in bombing during an
!                --  attempt to optimize things.
  
                 if No (N) then
                    return;
--- 1826,1834 ----
  
                 --  If we fall off the top of the tree, then that's odd, but
                 --  perhaps it could occur in some error situation, and the
!                --  safest response is simply to assume that the outcome of the
!                --  condition is unknown. No point in bombing during an attempt
!                --  to optimize things.
  
                 if No (N) then
                    return;
*************** package body Exp_Util is
*** 1510,1518 ****
           return;
        end if;
  
!       --  If we fall through here, then we have a reportable
!       --  condition, Sens is True if the condition is true and
!       --  False if it needs inverting.
  
        --  Deal with NOT operators, inverting sense
  
--- 1855,1862 ----
           return;
        end if;
  
!       --  If we fall through here, then we have a reportable condition, Sens is
!       --  True if the condition is true and False if it needs inverting.
  
        --  Deal with NOT operators, inverting sense
  
*************** package body Exp_Util is
*** 1567,1572 ****
--- 1911,1928 ----
        return Count;
     end Homonym_Number;
  
+    --------------------------
+    -- Implements_Interface --
+    --------------------------
+ 
+    function Implements_Interface
+      (Typ          : Entity_Id;
+       Kind         : Interface_Kind;
+       Check_Parent : Boolean := False) return Boolean is
+    begin
+       return Find_Implemented_Interface (Typ, Kind, Check_Parent) /= Empty;
+    end Implements_Interface;
+ 
     ------------------------------
     -- In_Unconditional_Context --
     ------------------------------
*************** package body Exp_Util is
*** 2199,2205 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Insert_Actions (Assoc_Node, Ins_Actions);
--- 2555,2560 ----
*************** package body Exp_Util is
*** 2209,2215 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Insert_Actions (Assoc_Node, Ins_Actions);
--- 2564,2569 ----
*************** package body Exp_Util is
*** 2320,2373 ****
        return True;
     end Is_All_Null_Statements;
  
     ----------------------------------
     -- Is_Possibly_Unaligned_Object --
     ----------------------------------
  
!    function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean is
     begin
!       --  If target does not have strict alignment, result is always
!       --  False, since correctness of code does no depend on alignment.
  
!       if not Target_Strict_Alignment then
!          return False;
        end if;
  
!       --  If renamed object, apply test to underlying object
  
!       if Is_Entity_Name (P)
!         and then Is_Object (Entity (P))
!         and then Present (Renamed_Object (Entity (P)))
        then
!          return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (P)));
        end if;
  
        --  If this is an element of a packed array, may be unaligned
  
!       if Is_Ref_To_Bit_Packed_Array (P) then
           return True;
        end if;
  
        --  Case of component reference
  
!       if Nkind (P) = N_Selected_Component then
  
!          --  If component reference is for a record that is bit packed
!          --  or has a specified alignment (that might be too small) or
!          --  the component reference has a component clause, then the
!          --  object may be unaligned.
  
!          if Is_Packed (Etype (Prefix (P)))
!            or else Known_Alignment (Etype (Prefix (P)))
!            or else Present (Component_Clause (Entity (Selector_Name (P))))
!          then
!             return True;
  
!          --  Otherwise, for a component reference, test prefix
  
!          else
!             return Is_Possibly_Unaligned_Object (Prefix (P));
!          end if;
  
        --  If not a component reference, must be aligned
  
--- 2674,2860 ----
        return True;
     end Is_All_Null_Statements;
  
+    -----------------------------------------
+    -- Is_Predefined_Dispatching_Operation --
+    -----------------------------------------
+ 
+    function Is_Predefined_Dispatching_Operation
+      (Subp : Entity_Id) return Boolean
+    is
+       TSS_Name : TSS_Name_Type;
+       E        : Entity_Id := Subp;
+    begin
+       pragma Assert (Is_Dispatching_Operation (Subp));
+ 
+       --  Handle overriden subprograms
+ 
+       while Present (Alias (E)) loop
+          E := Alias (E);
+       end loop;
+ 
+       Get_Name_String (Chars (E));
+ 
+       if Name_Len > TSS_Name_Type'Last then
+          TSS_Name := TSS_Name_Type (Name_Buffer (Name_Len - TSS_Name'Length + 1
+                                      .. Name_Len));
+          if Chars (E)        = Name_uSize
+            or else Chars (E) = Name_uAlignment
+            or else TSS_Name  = TSS_Stream_Read
+            or else TSS_Name  = TSS_Stream_Write
+            or else TSS_Name  = TSS_Stream_Input
+            or else TSS_Name  = TSS_Stream_Output
+            or else Chars (E) = Name_Op_Eq
+            or else Chars (E) = Name_uAssign
+            or else TSS_Name  = TSS_Deep_Adjust
+            or else TSS_Name  = TSS_Deep_Finalize
+            or else (Ada_Version >= Ada_05
+              and then (Chars (E) = Name_uDisp_Asynchronous_Select
+                or else Chars (E) = Name_uDisp_Conditional_Select
+                or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
+                or else Chars (E) = Name_uDisp_Get_Task_Id
+                or else Chars (E) = Name_uDisp_Timed_Select))
+          then
+             return True;
+          end if;
+       end if;
+ 
+       return False;
+    end Is_Predefined_Dispatching_Operation;
+ 
     ----------------------------------
     -- Is_Possibly_Unaligned_Object --
     ----------------------------------
  
!    function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean is
!       T  : constant Entity_Id := Etype (N);
! 
     begin
!       --  If renamed object, apply test to underlying object
  
!       if Is_Entity_Name (N)
!         and then Is_Object (Entity (N))
!         and then Present (Renamed_Object (Entity (N)))
!       then
!          return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (N)));
        end if;
  
!       --  Tagged and controlled types and aliased types are always aligned,
!       --  as are concurrent types.
  
!       if Is_Aliased (T)
!         or else Has_Controlled_Component (T)
!         or else Is_Concurrent_Type (T)
!         or else Is_Tagged_Type (T)
!         or else Is_Controlled (T)
        then
!          return False;
        end if;
  
        --  If this is an element of a packed array, may be unaligned
  
!       if Is_Ref_To_Bit_Packed_Array (N) then
           return True;
        end if;
  
        --  Case of component reference
  
!       if Nkind (N) = N_Selected_Component then
!          declare
!             P : constant Node_Id   := Prefix (N);
!             C : constant Entity_Id := Entity (Selector_Name (N));
!             M : Nat;
!             S : Nat;
  
!          begin
!             --  If component reference is for an array with non-static bounds,
!             --  then it is always aligned: we can only process unaligned
!             --  arrays with static bounds (more accurately bounds known at
!             --  compile time).
  
!             if Is_Array_Type (T)
!               and then not Compile_Time_Known_Bounds (T)
!             then
!                return False;
!             end if;
  
!             --  If component is aliased, it is definitely properly aligned
  
!             if Is_Aliased (C) then
!                return False;
!             end if;
! 
!             --  If component is for a type implemented as a scalar, and the
!             --  record is packed, and the component is other than the first
!             --  component of the record, then the component may be unaligned.
! 
!             if Is_Packed (Etype (P))
!               and then Represented_As_Scalar (Etype (C))
!               and then First_Entity (Scope (C)) /= C
!             then
!                return True;
!             end if;
! 
!             --  Compute maximum possible alignment for T
! 
!             --  If alignment is known, then that settles things
! 
!             if Known_Alignment (T) then
!                M := UI_To_Int (Alignment (T));
! 
!             --  If alignment is not known, tentatively set max alignment
! 
!             else
!                M := Ttypes.Maximum_Alignment;
! 
!                --  We can reduce this if the Esize is known since the default
!                --  alignment will never be more than the smallest power of 2
!                --  that does not exceed this Esize value.
! 
!                if Known_Esize (T) then
!                   S := UI_To_Int (Esize (T));
! 
!                   while (M / 2) >= S loop
!                      M := M / 2;
!                   end loop;
!                end if;
!             end if;
! 
!             --  If the component reference is for a record that has a specified
!             --  alignment, and we either know it is too small, or cannot tell,
!             --  then the component may be unaligned
! 
!             if Known_Alignment (Etype (P))
!               and then Alignment (Etype (P)) < Ttypes.Maximum_Alignment
!               and then M > Alignment (Etype (P))
!             then
!                return True;
!             end if;
! 
!             --  Case of component clause present which may specify an
!             --  unaligned position.
! 
!             if Present (Component_Clause (C)) then
! 
!                --  Otherwise we can do a test to make sure that the actual
!                --  start position in the record, and the length, are both
!                --  consistent with the required alignment. If not, we know
!                --  that we are unaligned.
! 
!                declare
!                   Align_In_Bits : constant Nat := M * System_Storage_Unit;
!                begin
!                   if Component_Bit_Offset (C) mod Align_In_Bits /= 0
!                     or else Esize (C) mod Align_In_Bits /= 0
!                   then
!                      return True;
!                   end if;
!                end;
!             end if;
! 
!             --  Otherwise, for a component reference, test prefix
! 
!             return Is_Possibly_Unaligned_Object (P);
!          end;
  
        --  If not a component reference, must be aligned
  
*************** package body Exp_Util is
*** 2380,2386 ****
     -- Is_Possibly_Unaligned_Slice --
     ---------------------------------
  
!    function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
     begin
        --  ??? GCC3 will eventually handle strings with arbitrary alignments,
        --  but for now the following check must be disabled.
--- 2867,2873 ----
     -- Is_Possibly_Unaligned_Slice --
     ---------------------------------
  
!    function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is
     begin
        --  ??? GCC3 will eventually handle strings with arbitrary alignments,
        --  but for now the following check must be disabled.
*************** package body Exp_Util is
*** 2391,2406 ****
  
        --  For renaming case, go to renamed object
  
!       if Is_Entity_Name (P)
!         and then Is_Object (Entity (P))
!         and then Present (Renamed_Object (Entity (P)))
        then
!          return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (P)));
        end if;
  
        --  The reference must be a slice
  
!       if Nkind (P) /= N_Slice then
           return False;
        end if;
  
--- 2878,2893 ----
  
        --  For renaming case, go to renamed object
  
!       if Is_Entity_Name (N)
!         and then Is_Object (Entity (N))
!         and then Present (Renamed_Object (Entity (N)))
        then
!          return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (N)));
        end if;
  
        --  The reference must be a slice
  
!       if Nkind (N) /= N_Slice then
           return False;
        end if;
  
*************** package body Exp_Util is
*** 2408,2417 ****
        --  component clause, which gigi/gcc does not appear to handle well.
        --  It is not clear why this special test is needed at all ???
  
!       if Nkind (Prefix (P)) = N_Selected_Component
!         and then Nkind (Prefix (Prefix (P))) = N_Selected_Component
          and then
!           Present (Component_Clause (Entity (Selector_Name (Prefix (P)))))
        then
           return True;
        end if;
--- 2895,2904 ----
        --  component clause, which gigi/gcc does not appear to handle well.
        --  It is not clear why this special test is needed at all ???
  
!       if Nkind (Prefix (N)) = N_Selected_Component
!         and then Nkind (Prefix (Prefix (N))) = N_Selected_Component
          and then
!           Present (Component_Clause (Entity (Selector_Name (Prefix (N)))))
        then
           return True;
        end if;
*************** package body Exp_Util is
*** 2425,2434 ****
        --  If it is a slice, then look at the array type being sliced
  
        declare
!          Sarr : constant Node_Id := Prefix (P);
           --  Prefix of the slice, i.e. the array being sliced
  
!          Styp : constant Entity_Id := Etype (Prefix (P));
           --  Type of the array being sliced
  
           Pref : Node_Id;
--- 2912,2921 ----
        --  If it is a slice, then look at the array type being sliced
  
        declare
!          Sarr : constant Node_Id := Prefix (N);
           --  Prefix of the slice, i.e. the array being sliced
  
!          Styp : constant Entity_Id := Etype (Prefix (N));
           --  Type of the array being sliced
  
           Pref : Node_Id;
*************** package body Exp_Util is
*** 2520,2549 ****
     -- Is_Ref_To_Bit_Packed_Array --
     --------------------------------
  
!    function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean is
        Result : Boolean;
        Expr   : Node_Id;
  
     begin
!       if Is_Entity_Name (P)
!         and then Is_Object (Entity (P))
!         and then Present (Renamed_Object (Entity (P)))
        then
!          return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (P)));
        end if;
  
!       if Nkind (P) = N_Indexed_Component
             or else
!          Nkind (P) = N_Selected_Component
        then
!          if Is_Bit_Packed_Array (Etype (Prefix (P))) then
              Result := True;
           else
!             Result := Is_Ref_To_Bit_Packed_Array (Prefix (P));
           end if;
  
!          if Result and then Nkind (P) = N_Indexed_Component then
!             Expr := First (Expressions (P));
              while Present (Expr) loop
                 Force_Evaluation (Expr);
                 Next (Expr);
--- 3007,3036 ----
     -- Is_Ref_To_Bit_Packed_Array --
     --------------------------------
  
!    function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean is
        Result : Boolean;
        Expr   : Node_Id;
  
     begin
!       if Is_Entity_Name (N)
!         and then Is_Object (Entity (N))
!         and then Present (Renamed_Object (Entity (N)))
        then
!          return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (N)));
        end if;
  
!       if Nkind (N) = N_Indexed_Component
             or else
!          Nkind (N) = N_Selected_Component
        then
!          if Is_Bit_Packed_Array (Etype (Prefix (N))) then
              Result := True;
           else
!             Result := Is_Ref_To_Bit_Packed_Array (Prefix (N));
           end if;
  
!          if Result and then Nkind (N) = N_Indexed_Component then
!             Expr := First (Expressions (N));
              while Present (Expr) loop
                 Force_Evaluation (Expr);
                 Next (Expr);
*************** package body Exp_Util is
*** 2561,2585 ****
     -- Is_Ref_To_Bit_Packed_Slice --
     --------------------------------
  
!    function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean is
     begin
!       if Is_Entity_Name (P)
!         and then Is_Object (Entity (P))
!         and then Present (Renamed_Object (Entity (P)))
        then
!          return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (P)));
        end if;
  
!       if Nkind (P) = N_Slice
!         and then Is_Bit_Packed_Array (Etype (Prefix (P)))
        then
           return True;
  
!       elsif Nkind (P) = N_Indexed_Component
             or else
!          Nkind (P) = N_Selected_Component
        then
!          return Is_Ref_To_Bit_Packed_Slice (Prefix (P));
  
        else
           return False;
--- 3048,3072 ----
     -- Is_Ref_To_Bit_Packed_Slice --
     --------------------------------
  
!    function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean is
     begin
!       if Is_Entity_Name (N)
!         and then Is_Object (Entity (N))
!         and then Present (Renamed_Object (Entity (N)))
        then
!          return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (N)));
        end if;
  
!       if Nkind (N) = N_Slice
!         and then Is_Bit_Packed_Array (Etype (Prefix (N)))
        then
           return True;
  
!       elsif Nkind (N) = N_Indexed_Component
             or else
!          Nkind (N) = N_Selected_Component
        then
!          return Is_Ref_To_Bit_Packed_Slice (Prefix (N));
  
        else
           return False;
*************** package body Exp_Util is
*** 2630,2636 ****
     procedure Kill_Dead_Code (N : Node_Id) is
     begin
        if Present (N) then
-          Remove_Handler_Entries (N);
           Remove_Warning_Messages (N);
  
           --  Recurse into block statements and bodies to process declarations
--- 3117,3122 ----
*************** package body Exp_Util is
*** 2647,2652 ****
--- 3133,3154 ----
                 Set_Is_Eliminated (Defining_Entity (N));
              end if;
  
+          elsif Nkind (N) = N_Package_Declaration then
+             Kill_Dead_Code (Visible_Declarations (Specification (N)));
+             Kill_Dead_Code (Private_Declarations (Specification (N)));
+ 
+             declare
+                E : Entity_Id := First_Entity (Defining_Entity (N));
+             begin
+                while Present (E) loop
+                   if Ekind (E) = E_Operator then
+                      Set_Is_Eliminated (E);
+                   end if;
+ 
+                   Next_Entity (E);
+                end loop;
+             end;
+ 
           --  Recurse into composite statement to kill individual statements,
           --  in particular instantiations.
  
*************** package body Exp_Util is
*** 3083,3089 ****
              return New_Occurrence_Of (CW_Subtype, Loc);
           end;
  
!       --  Comment needed (what case is this ???)
  
        else
           D := First_Discriminant (Unc_Typ);
--- 3585,3591 ----
              return New_Occurrence_Of (CW_Subtype, Loc);
           end;
  
!       --  Indefinite record type with discriminants.
  
        else
           D := First_Discriminant (Unc_Typ);
*************** package body Exp_Util is
*** 3111,3117 ****
  
     --  At the current time, the only types that we return False for (i.e.
     --  where we decide we know they cannot generate large temps) are ones
!    --  where we know the size is 128 bits or less at compile time, and we
     --  are still not doing a thorough job on arrays and records ???
  
     function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean is
--- 3613,3619 ----
  
     --  At the current time, the only types that we return False for (i.e.
     --  where we decide we know they cannot generate large temps) are ones
!    --  where we know the size is 256 bits or less at compile time, and we
     --  are still not doing a thorough job on arrays and records ???
  
     function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean is
*************** package body Exp_Util is
*** 3194,3200 ****
        E            : Node_Id;
  
        function Side_Effect_Free (N : Node_Id) return Boolean;
!       --  Determines if the tree N represents an expession that is known
        --  not to have side effects, and for which no processing is required.
  
        function Side_Effect_Free (L : List_Id) return Boolean;
--- 3696,3702 ----
        E            : Node_Id;
  
        function Side_Effect_Free (N : Node_Id) return Boolean;
!       --  Determines if the tree N represents an expression that is known
        --  not to have side effects, and for which no processing is required.
  
        function Side_Effect_Free (L : List_Id) return Boolean;
*************** package body Exp_Util is
*** 3515,3524 ****
  
        Scope_Suppress := (others => True);
  
        --  If the expression has the form v.all then we can just capture
        --  the pointer, and then do an explicit dereference on the result.
  
!       if Nkind (Exp) = N_Explicit_Dereference then
           Def_Id :=
             Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
           Res :=
--- 4017,4053 ----
  
        Scope_Suppress := (others => True);
  
+       --  If it is a scalar type and we need to capture the value, just
+       --  make a copy.  Likewise for a function call.  And if we have a
+       --  volatile variable and Nam_Req is not set (see comments above
+       --  for Side_Effect_Free).
+ 
+       if Is_Elementary_Type (Exp_Type)
+         and then (Variable_Ref
+                    or else Nkind (Exp) = N_Function_Call
+                    or else (not Name_Req
+                              and then Is_Entity_Name (Exp)
+                              and then Treat_As_Volatile (Entity (Exp))))
+       then
+ 
+          Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+          Set_Etype (Def_Id, Exp_Type);
+          Res := New_Reference_To (Def_Id, Loc);
+ 
+          E :=
+            Make_Object_Declaration (Loc,
+              Defining_Identifier => Def_Id,
+              Object_Definition   => New_Reference_To (Exp_Type, Loc),
+              Constant_Present    => True,
+              Expression          => Relocate_Node (Exp));
+ 
+          Set_Assignment_OK (E);
+          Insert_Action (Exp, E);
+ 
        --  If the expression has the form v.all then we can just capture
        --  the pointer, and then do an explicit dereference on the result.
  
!       elsif Nkind (Exp) = N_Explicit_Dereference then
           Def_Id :=
             Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
           Res :=
*************** package body Exp_Util is
*** 3538,3544 ****
        elsif Nkind (Exp) = N_Unchecked_Type_Conversion
          and then Nkind (Expression (Exp)) = N_Explicit_Dereference
        then
!          Remove_Side_Effects (Expression (Exp), Variable_Ref);
           Scope_Suppress := Svg_Suppress;
           return;
  
--- 4067,4073 ----
        elsif Nkind (Exp) = N_Unchecked_Type_Conversion
          and then Nkind (Expression (Exp)) = N_Explicit_Dereference
        then
!          Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
           Scope_Suppress := Svg_Suppress;
           return;
  
*************** package body Exp_Util is
*** 3546,3585 ****
        --  the side effects in the expression. This is important in several
        --  circumstances: for change of representations, and also when this
        --  is a view conversion to a smaller object, where gigi can end up
!       --  its own temporary of the wrong size.
! 
!       --  ??? this transformation is inhibited for elementary types that are
!       --  not involved in a change of representation because it causes
!       --  regressions that are not fully understood yet.
  
!       elsif Nkind (Exp) = N_Type_Conversion
!         and then (not Is_Elementary_Type (Underlying_Type (Exp_Type))
!                    or else Nkind (Parent (Exp)) = N_Assignment_Statement)
!       then
!          Remove_Side_Effects (Expression (Exp), Variable_Ref);
           Scope_Suppress := Svg_Suppress;
           return;
  
        --  For expressions that denote objects, we can use a renaming scheme.
        --  We skip using this if we have a volatile variable and we do not
        --  have Nam_Req set true (see comments above for Side_Effect_Free).
-       --  We also skip this scheme for class-wide expressions in order to
-       --  avoid recursive expansion (see Expand_N_Object_Renaming_Declaration)
-       --  If the object is a function call, we need to create a temporary and
-       --  not a renaming.
- 
-       --  Note that we could use ordinary object declarations in the case of
-       --  expressions not appearing as lvalues. That is left as a possible
-       --  optimization in the future but we prefer to generate renamings
-       --  right now, since we may indeed be transforming an lvalue.
  
        elsif Is_Object_Reference (Exp)
          and then Nkind (Exp) /= N_Function_Call
-         and then not Variable_Ref
          and then (Name_Req
                     or else not Is_Entity_Name (Exp)
                     or else not Treat_As_Volatile (Entity (Exp)))
-         and then not Is_Class_Wide_Type (Exp_Type)
        then
           Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
  
--- 4075,4132 ----
        --  the side effects in the expression. This is important in several
        --  circumstances: for change of representations, and also when this
        --  is a view conversion to a smaller object, where gigi can end up
!       --  creating its own temporary of the wrong size.
  
!       elsif Nkind (Exp) = N_Type_Conversion then
!          Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
           Scope_Suppress := Svg_Suppress;
           return;
  
+       --  If this is an unchecked conversion that Gigi can't handle, make
+       --  a copy or a use a renaming to capture the value.
+ 
+       elsif Nkind (Exp) = N_Unchecked_Type_Conversion
+         and then not Safe_Unchecked_Type_Conversion (Exp)
+       then
+          if Controlled_Type (Etype (Exp)) then
+ 
+             --  Use a renaming to capture the expression, rather than create
+             --  a controlled temporary.
+ 
+             Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+             Res := New_Reference_To (Def_Id, Loc);
+ 
+             Insert_Action (Exp,
+               Make_Object_Renaming_Declaration (Loc,
+                 Defining_Identifier => Def_Id,
+                 Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
+                 Name                => Relocate_Node (Exp)));
+ 
+          else
+             Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+             Set_Etype (Def_Id, Exp_Type);
+             Res := New_Reference_To (Def_Id, Loc);
+ 
+             E :=
+               Make_Object_Declaration (Loc,
+                 Defining_Identifier => Def_Id,
+                 Object_Definition   => New_Reference_To (Exp_Type, Loc),
+                 Constant_Present    => not Is_Variable (Exp),
+                 Expression          => Relocate_Node (Exp));
+ 
+             Set_Assignment_OK (E);
+             Insert_Action (Exp, E);
+          end if;
+ 
        --  For expressions that denote objects, we can use a renaming scheme.
        --  We skip using this if we have a volatile variable and we do not
        --  have Nam_Req set true (see comments above for Side_Effect_Free).
  
        elsif Is_Object_Reference (Exp)
          and then Nkind (Exp) /= N_Function_Call
          and then (Name_Req
                     or else not Is_Entity_Name (Exp)
                     or else not Treat_As_Volatile (Entity (Exp)))
        then
           Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
  
*************** package body Exp_Util is
*** 3604,3615 ****
                    New_Reference_To (Base_Type (Etype (Prefix (Exp))), Loc),
                  Name                => Relocate_Node (Prefix (Exp))));
  
-             --  The temporary must be elaborated by gigi, and is of course
-             --  not to be replaced in-line by the expression it renames,
-             --  which would defeat the purpose of removing the side-effect.
- 
-             Set_Is_Renaming_Of_Object (Def_Id, False);
- 
           else
              Res := New_Reference_To (Def_Id, Loc);
  
--- 4151,4156 ----
*************** package body Exp_Util is
*** 3619,3680 ****
                  Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
                  Name                => Relocate_Node (Exp)));
  
-             Set_Is_Renaming_Of_Object (Def_Id, False);
           end if;
  
!       --  If it is a scalar type, just make a copy
! 
!       elsif Is_Elementary_Type (Exp_Type) then
!          Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
!          Set_Etype (Def_Id, Exp_Type);
!          Res := New_Reference_To (Def_Id, Loc);
! 
!          E :=
!            Make_Object_Declaration (Loc,
!              Defining_Identifier => Def_Id,
!              Object_Definition   => New_Reference_To (Exp_Type, Loc),
!              Constant_Present    => True,
!              Expression          => Relocate_Node (Exp));
! 
!          Set_Assignment_OK (E);
!          Insert_Action (Exp, E);
! 
!       --  Always use a renaming for an unchecked conversion
!       --  If this is an unchecked conversion that Gigi can't handle, make
!       --  a copy or a use a renaming to capture the value.
! 
!       elsif Nkind (Exp) = N_Unchecked_Type_Conversion
!         and then not Safe_Unchecked_Type_Conversion (Exp)
!       then
!          if Controlled_Type (Etype (Exp)) then
! 
!             --  Use a renaming to capture the expression, rather than create
!             --  a controlled temporary.
! 
!             Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
!             Res := New_Reference_To (Def_Id, Loc);
! 
!             Insert_Action (Exp,
!               Make_Object_Renaming_Declaration (Loc,
!                 Defining_Identifier => Def_Id,
!                 Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
!                 Name                => Relocate_Node (Exp)));
! 
!          else
!             Def_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
!             Set_Etype (Def_Id, Exp_Type);
!             Res := New_Reference_To (Def_Id, Loc);
! 
!             E :=
!               Make_Object_Declaration (Loc,
!                 Defining_Identifier => Def_Id,
!                 Object_Definition   => New_Reference_To (Exp_Type, Loc),
!                 Constant_Present    => not Is_Variable (Exp),
!                 Expression          => Relocate_Node (Exp));
  
!             Set_Assignment_OK (E);
!             Insert_Action (Exp, E);
!          end if;
  
        --  Otherwise we generate a reference to the value
  
--- 4160,4172 ----
                  Subtype_Mark        => New_Reference_To (Exp_Type, Loc),
                  Name                => Relocate_Node (Exp)));
  
           end if;
  
!          --  The temporary must be elaborated by gigi, and is of course
!          --  not to be replaced in-line by the expression it renames,
!          --  which would defeat the purpose of removing the side-effect.
  
!          Set_Is_Renaming_Of_Object (Def_Id, False);
  
        --  Otherwise we generate a reference to the value
  
*************** package body Exp_Util is
*** 3708,3713 ****
--- 4200,4213 ----
           end if;
  
           if Is_Delayed_Aggregate (E) then
+ 
+             --  The expansion of nested aggregates is delayed until the
+             --  enclosing aggregate is expanded. As aggregates are often
+             --  qualified, the predicate applies to qualified expressions
+             --  as well, indicating that the enclosing aggregate has not
+             --  been expanded yet. At this point the aggregate is part of
+             --  a stand-alone declaration, and must be fully expanded.
+ 
              if Nkind (E) = N_Qualified_Expression then
                 Set_Expansion_Delayed (Expression (E), False);
                 Set_Analyzed (Expression (E), False);
*************** package body Exp_Util is
*** 3738,3743 ****
--- 4238,4255 ----
        Scope_Suppress := Svg_Suppress;
     end Remove_Side_Effects;
  
+    ---------------------------
+    -- Represented_As_Scalar --
+    ---------------------------
+ 
+    function Represented_As_Scalar (T : Entity_Id) return Boolean is
+       UT : constant Entity_Id := Underlying_Type (T);
+    begin
+       return Is_Scalar_Type (UT)
+         or else (Is_Bit_Packed_Array (UT)
+                    and then Is_Scalar_Type (Packed_Array_Type (UT)));
+    end Represented_As_Scalar;
+ 
     ------------------------------------
     -- Safe_Unchecked_Type_Conversion --
     ------------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_util.ads gcc-4.1.0/gcc/ada/exp_util.ads
*** gcc-4.0.2/gcc/ada/exp_util.ads	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/exp_util.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Types;   use Types;
*** 33,38 ****
--- 33,53 ----
  
  package Exp_Util is
  
+    --  An enumeration type used to capture all the possible interface
+    --  kinds and their hierarchical relation. These values are used in
+    --  Find_Implemented_Interface and Implements_Interface.
+ 
+    type Interface_Kind is (
+      Any_Interface,               --  Any interface
+      Any_Limited_Interface,       --  Only limited interfaces
+      Any_Synchronized_Interface,  --  Only synchronized interfaces
+ 
+      Iface,                       --  Individual kinds
+      Limited_Interface,
+      Protected_Interface,
+      Synchronized_Interface,
+      Task_Interface);
+ 
     -----------------------------------------------
     -- Handling of Actions Associated with Nodes --
     -----------------------------------------------
*************** package Exp_Util is
*** 135,141 ****
     --  Actions field of the N_Compilation_Aux node for the main unit).
  
     procedure Insert_Library_Level_Actions (L : List_Id);
!    --  Similar, but inserts a list of actions.
  
     -----------------------
     -- Other Subprograms --
--- 150,156 ----
     --  Actions field of the N_Compilation_Aux node for the main unit).
  
     procedure Insert_Library_Level_Actions (L : List_Id);
!    --  Similar, but inserts a list of actions
  
     -----------------------
     -- Other Subprograms --
*************** package Exp_Util is
*** 145,191 ****
     --  The node N is an expression whose root-type is Boolean, and which
     --  represents a boolean value used as a condition (i.e. a True/False
     --  value). This routine handles the case of C and Fortran convention
!    --  boolean types, which have zero/non-zero semantics rather than the
!    --  normal 0/1 semantics, and also the case of an enumeration rep
!    --  clause that specifies a non-standard representation. On return,
!    --  node N always has the type Standard.Boolean, with a value that
!    --  is a standard Boolean values of 0/1 for False/True. This procedure
!    --  is used in two situations. First, the processing for a condition
!    --  field always calls Adjust_Condition, so that the boolean value
!    --  presented to the backend is a standard value. Second, for the
!    --  code for boolean operations such as AND, Adjust_Condition is
!    --  called on both operands, and then the operation is done in the
!    --  domain of Standard_Boolean, then Adjust_Result_Type is called
!    --  on the result to possibly reset the original type. This procedure
     --  also takes care of validity checking if Validity_Checks = Tests.
  
     procedure Adjust_Result_Type (N : Node_Id; T : Entity_Id);
     --  The processing of boolean operations like AND uses the procedure
!    --  Adjust_Condition so that it can operate on Standard.Boolean, which
!    --  is the only boolean type on which the backend needs to be able to
!    --  implement such operators. This means that the result is also of
!    --  type Standard.Boolean. In general the type must be reset back to
!    --  the original type to get proper semantics, and that is the purpose
!    --  of this procedure. N is the node (of type Standard.Boolean), and
!    --  T is the desired type. As an optimization, this procedure leaves
!    --  the type as Standard.Boolean in contexts where this is permissible
!    --  (in particular for Condition fields, and for operands of other
!    --  logical operations higher up the tree). The call to this procedure
!    --  is completely ignored if the argument N is not of type Boolean.
  
     procedure Append_Freeze_Action (T : Entity_Id; N : Node_Id);
     --  Add a new freeze action for the given type. The freeze action is
!    --  attached to the freeze node for the type. Actions will be elaborated
!    --  in the order in which they are added. Note that the added node is not
     --  analyzed. The analyze call is found in Sem_Ch13.Expand_N_Freeze_Entity.
  
     procedure Append_Freeze_Actions (T : Entity_Id; L : List_Id);
!    --  Adds the given list of freeze actions (declarations or statements)
!    --  for the given type. The freeze actions are attached to the freeze
!    --  node for the type. Actions will be elaborated in the order in which
!    --  they are added, and the actions within the list will be elaborated in
!    --  list order. Note that the added nodes are not analyzed. The analyze
!    --  call is found in Sem_Ch13.Expand_N_Freeze_Entity.
  
     function Build_Runtime_Call (Loc : Source_Ptr; RE : RE_Id) return Node_Id;
     --  Build an N_Procedure_Call_Statement calling the given runtime entity.
--- 160,205 ----
     --  The node N is an expression whose root-type is Boolean, and which
     --  represents a boolean value used as a condition (i.e. a True/False
     --  value). This routine handles the case of C and Fortran convention
!    --  boolean types, which have zero/non-zero semantics rather than the normal
!    --  0/1 semantics, and also the case of an enumeration rep clause that
!    --  specifies a non-standard representation. On return, node N always has
!    --  the type Standard.Boolean, with a value that is a standard Boolean
!    --  values of 0/1 for False/True. This procedure is used in two situations.
!    --  First, the processing for a condition field always calls
!    --  Adjust_Condition, so that the boolean value presented to the backend is
!    --  a standard value. Second, for the code for boolean operations such as
!    --  AND, Adjust_Condition is called on both operands, and then the operation
!    --  is done in the domain of Standard_Boolean, then Adjust_Result_Type is
!    --  called on the result to possibly reset the original type. This procedure
     --  also takes care of validity checking if Validity_Checks = Tests.
  
     procedure Adjust_Result_Type (N : Node_Id; T : Entity_Id);
     --  The processing of boolean operations like AND uses the procedure
!    --  Adjust_Condition so that it can operate on Standard.Boolean, which is
!    --  the only boolean type on which the backend needs to be able to implement
!    --  such operators. This means that the result is also of type
!    --  Standard.Boolean. In general the type must be reset back to the original
!    --  type to get proper semantics, and that is the purpose of this procedure.
!    --  N is the node (of type Standard.Boolean), and T is the desired type. As
!    --  an optimization, this procedure leaves the type as Standard.Boolean in
!    --  contexts where this is permissible (in particular for Condition fields,
!    --  and for operands of other logical operations higher up the tree). The
!    --  call to this procedure is completely ignored if the argument N is not of
!    --  type Boolean.
  
     procedure Append_Freeze_Action (T : Entity_Id; N : Node_Id);
     --  Add a new freeze action for the given type. The freeze action is
!    --  attached to the freeze node for the type. Actions will be elaborated in
!    --  the order in which they are added. Note that the added node is not
     --  analyzed. The analyze call is found in Sem_Ch13.Expand_N_Freeze_Entity.
  
     procedure Append_Freeze_Actions (T : Entity_Id; L : List_Id);
!    --  Adds the given list of freeze actions (declarations or statements) for
!    --  the given type. The freeze actions are attached to the freeze node for
!    --  the type. Actions will be elaborated in the order in which they are
!    --  added, and the actions within the list will be elaborated in list order.
!    --  Note that the added nodes are not analyzed. The analyze call is found in
!    --  Sem_Ch13.Expand_N_Freeze_Entity.
  
     function Build_Runtime_Call (Loc : Source_Ptr; RE : RE_Id) return Node_Id;
     --  Build an N_Procedure_Call_Statement calling the given runtime entity.
*************** package Exp_Util is
*** 198,252 ****
        Id_Ref : Node_Id;
        A_Type : Entity_Id)
        return   List_Id;
!    --  Build declaration for a variable that holds an identifying string
!    --  to be used as a task name. Id_Ref is an identifier if the task is
!    --  a variable, and a selected or indexed component if the task is a
!    --  component of an object. If it is an indexed component, A_Type is
!    --  the corresponding array type. Its index types are used to build the
!    --  string as an image of the index values. For composite types, the
!    --  result includes two declarations: one for a generated function that
!    --  computes the image without using concatenation, and one for the
!    --  variable that holds the result.
  
     function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean;
!    --  This function is in charge of detecting record components that may
!    --  cause trouble in the back end if an attempt is made to assign the
!    --  component. The back end can handle such assignments with no problem
!    --  if the components involved are small (64-bits or less) records or
!    --  scalar items (including bit-packed arrays represented with modular
!    --  types) or are both aligned on a byte boundary (starting on a byte
!    --  boundary, and occupying an integral number of bytes).
     --
!    --  However, problems arise for records larger than 64 bits, or for
!    --  arrays (other than bit-packed arrays represented with a modular
!    --  type) if the component starts on a non-byte boundary, or does
!    --  not occupy an integral number of bytes (i.e. there are some bits
!    --  possibly shared with fields at the start or beginning of the
!    --  component). The back end cannot handle loading and storing such
!    --  components in a single operation.
     --
     --  This function is used to detect the troublesome situation. it is
!    --  conservative in the sense that it produces True unless it knows
!    --  for sure that the component is safe (as outlined in the first
!    --  paragraph above). The code generation for record and array
!    --  assignment checks for trouble using this function, and if so
!    --  the assignment is generated component-wise, which the back end
!    --  is required to handle correctly.
     --
!    --  Note that in GNAT 3, the back end will reject such components
!    --  anyway, so the hard work in checking for this case is wasted
!    --  in GNAT 3, but it's harmless, so it is easier to do it in
!    --  all cases, rather than conditionalize it in GNAT 5 or beyond.
  
     procedure Convert_To_Actual_Subtype (Exp : Node_Id);
!    --  The Etype of an expression is the nominal type of the expression,
!    --  not the actual subtype. Often these are the same, but not always.
!    --  For example, a reference to a formal of unconstrained type has the
!    --  unconstrained type as its Etype, but the actual subtype is obtained
!    --  by applying the actual bounds. This routine is given an expression,
!    --  Exp, and (if necessary), replaces it using Rewrite, with a conversion
!    --  to the actual subtype, building the actual subtype if necessary. If
!    --  the expression is already of the requested type, then it is unchanged.
  
     function Current_Sem_Unit_Declarations return List_Id;
     --  Return the a place where it is fine to insert declarations for the
--- 212,263 ----
        Id_Ref : Node_Id;
        A_Type : Entity_Id)
        return   List_Id;
!    --  Build declaration for a variable that holds an identifying string to be
!    --  used as a task name. Id_Ref is an identifier if the task is a variable,
!    --  and a selected or indexed component if the task is component of an
!    --  object. If it is an indexed component, A_Type is the corresponding array
!    --  type. Its index types are used to build the string as an image of the
!    --  index values. For composite types, the result includes two declarations:
!    --  one for a generated function that computes the image without using
!    --  concatenation, and one for the variable that holds the result.
  
     function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean;
!    --  This function is in charge of detecting record components that may cause
!    --  trouble in the back end if an attempt is made to assign the component.
!    --  The back end can handle such assignments with no problem if the
!    --  components involved are small (64-bits or less) records or scalar items
!    --  (including bit-packed arrays represented with modular types) or are both
!    --  aligned on a byte boundary (starting on a byte boundary, and occupying
!    --  an integral number of bytes).
     --
!    --  However, problems arise for records larger than 64 bits, or for arrays
!    --  (other than bit-packed arrays represented with a modular type) if the
!    --  component starts on a non-byte boundary, or does not occupy an integral
!    --  number of bytes (i.e. there are some bits possibly shared with fields at
!    --  the start or beginning of the component). The back end cannot handle
!    --  loading and storing such components in a single operation.
     --
     --  This function is used to detect the troublesome situation. it is
!    --  conservative in the sense that it produces True unless it knows for sure
!    --  that the component is safe (as outlined in the first paragraph above).
!    --  The code generation for record and array assignment checks for trouble
!    --  using this function, and if so the assignment is generated
!    --  component-wise, which the back end is required to handle correctly.
     --
!    --  Note that in GNAT 3, the back end will reject such components anyway, so
!    --  the hard work in checking for this case is wasted in GNAT 3, but it's
!    --  harmless, so it is easier to do it in all cases, rather than
!    --  conditionalize it in GNAT 5 or beyond.
  
     procedure Convert_To_Actual_Subtype (Exp : Node_Id);
!    --  The Etype of an expression is the nominal type of the expression, not
!    --  the actual subtype. Often these are the same, but not always. For
!    --  example, a reference to a formal of unconstrained type has the
!    --  unconstrained type as its Etype, but the actual subtype is obtained by
!    --  applying the actual bounds. This routine is given an expression, Exp,
!    --  and (if necessary), replaces it using Rewrite, with a conversion to the
!    --  actual subtype, building the actual subtype if necessary. If the
!    --  expression is already of the requested type, then it is unchanged.
  
     function Current_Sem_Unit_Declarations return List_Id;
     --  Return the a place where it is fine to insert declarations for the
*************** package Exp_Util is
*** 258,277 ****
     function Duplicate_Subexpr
       (Exp      : Node_Id;
        Name_Req : Boolean := False) return Node_Id;
!    --  Given the node for a subexpression, this function makes a logical
!    --  copy of the subexpression, and returns it. This is intended for use
!    --  when the expansion of an expression needs to repeat part of it. For
!    --  example, replacing a**2 by a*a requires two references to a which
!    --  may be a complex subexpression. Duplicate_Subexpr guarantees not
!    --  to duplicate side effects. If necessary, it generates actions to
!    --  save the expression value in a temporary, inserting these actions
!    --  into the tree using Insert_Actions with Exp as the insertion location.
!    --  The original expression and the returned result then become references
!    --  to this saved value. Exp must be analyzed on entry. On return, Exp
!    --  is analyzed, but the caller is responsible for analyzing the returned
!    --  copy after it is attached to the tree. The Name_Req flag is set to
!    --  ensure that the result is suitable for use in a context requiring a
!    --  name (e.g. the prefix of an attribute reference).
     --
     --  Note that if there are any run time checks in Exp, these same checks
     --  will be duplicated in the returned duplicated expression. The two
--- 269,288 ----
     function Duplicate_Subexpr
       (Exp      : Node_Id;
        Name_Req : Boolean := False) return Node_Id;
!    --  Given the node for a subexpression, this function makes a logical copy
!    --  of the subexpression, and returns it. This is intended for use when the
!    --  expansion of an expression needs to repeat part of it. For example,
!    --  replacing a**2 by a*a requires two references to a which may be a
!    --  complex subexpression. Duplicate_Subexpr guarantees not to duplicate
!    --  side effects. If necessary, it generates actions to save the expression
!    --  value in a temporary, inserting these actions into the tree using
!    --  Insert_Actions with Exp as the insertion location. The original
!    --  expression and the returned result then become references to this saved
!    --  value. Exp must be analyzed on entry. On return, Exp is analyzed, but
!    --  the caller is responsible for analyzing the returned copy after it is
!    --  attached to the tree. The Name_Req flag is set to ensure that the result
!    --  is suitable for use in a context requiring name (e.g. the prefix of an
!    --  attribute reference).
     --
     --  Note that if there are any run time checks in Exp, these same checks
     --  will be duplicated in the returned duplicated expression. The two
*************** package Exp_Util is
*** 289,301 ****
     function Duplicate_Subexpr_Move_Checks
       (Exp      : Node_Id;
        Name_Req : Boolean := False) return Node_Id;
!    --  Identical in effect to Duplicate_Subexpr, except that Remove_Checks
!    --  is called on Exp after the duplication is complete, so that the
!    --  original expression does not include checks. In this case the result
!    --  returned (the duplicated expression) will retain the original checks.
!    --  This is appropriate for use when the duplicated expression is sure
!    --  to be elaborated before the original expression Exp, so that there
!    --  is no need to repeat the checks.
  
     procedure Ensure_Defined (Typ : Entity_Id; N : Node_Id);
     --  This procedure ensures that type referenced by Typ is defined. For the
--- 300,312 ----
     function Duplicate_Subexpr_Move_Checks
       (Exp      : Node_Id;
        Name_Req : Boolean := False) return Node_Id;
!    --  Identical in effect to Duplicate_Subexpr, except that Remove_Checks is
!    --  called on Exp after the duplication is complete, so that the original
!    --  expression does not include checks. In this case the result returned
!    --  (the duplicated expression) will retain the original checks. This is
!    --  appropriate for use when the duplicated expression is sure to be
!    --  elaborated before the original expression Exp, so that there is no need
!    --  to repeat the checks.
  
     procedure Ensure_Defined (Typ : Entity_Id; N : Node_Id);
     --  This procedure ensures that type referenced by Typ is defined. For the
*************** package Exp_Util is
*** 309,323 ****
     --  Rewrites Cond with the expression: Cond and then Cond1. If Cond is
     --  Empty, then simply returns Cond1 (this allows the use of Empty to
     --  initialize a series of checks evolved by this routine, with a final
!    --  result of Empty indicating that no checks were required). The Sloc
!    --  field of the constructed N_And_Then node is copied from Cond1.
  
     procedure Evolve_Or_Else (Cond : in out Node_Id; Cond1 : Node_Id);
!    --  Rewrites Cond with the expression: Cond or else Cond1. If Cond is
!    --  Empty, then simply returns Cond1 (this allows the use of Empty to
!    --  initialize a series of checks evolved by this routine, with a final
!    --  result of Empty indicating that no checks were required). The Sloc
!    --  field of the constructed N_Or_Else node is copied from Cond1.
  
     procedure Expand_Subtype_From_Expr
       (N             : Node_Id;
--- 320,334 ----
     --  Rewrites Cond with the expression: Cond and then Cond1. If Cond is
     --  Empty, then simply returns Cond1 (this allows the use of Empty to
     --  initialize a series of checks evolved by this routine, with a final
!    --  result of Empty indicating that no checks were required). The Sloc field
!    --  of the constructed N_And_Then node is copied from Cond1.
  
     procedure Evolve_Or_Else (Cond : in out Node_Id; Cond1 : Node_Id);
!    --  Rewrites Cond with the expression: Cond or else Cond1. If Cond is Empty,
!    --  then simply returns Cond1 (this allows the use of Empty to initialize a
!    --  series of checks evolved by this routine, with a final result of Empty
!    --  indicating that no checks were required). The Sloc field of the
!    --  constructed N_Or_Else node is copied from Cond1.
  
     procedure Expand_Subtype_From_Expr
       (N             : Node_Id;
*************** package Exp_Util is
*** 328,333 ****
--- 339,366 ----
     --  declarations and/or allocations when the type is indefinite (including
     --  class-wide).
  
+    function Find_Interface_ADT
+      (T     : Entity_Id;
+       Iface : Entity_Id) return Entity_Id;
+    --  Ada 2005 (AI-251): Given a type T implementing the interface Iface,
+    --  return the Access_Disp_Table value of the interface.
+ 
+    function Find_Interface_Tag
+      (T     : Entity_Id;
+       Iface : Entity_Id) return Entity_Id;
+    --  Ada 2005 (AI-251): Given a type T implementing the interface Iface,
+    --  return the record component containing the tag of Iface.
+ 
+    function Find_Implemented_Interface
+      (Typ          : Entity_Id;
+       Kind         : Interface_Kind;
+       Check_Parent : Boolean := False) return Entity_Id;
+    --  Ada 2005 (AI-345): Find a designated kind of interface implemented by
+    --  Typ or any parent subtype. Return the first encountered interface that
+    --  correspond to the selected class. Return Empty if no such interface is
+    --  found. Use Check_Parent to climb a potential derivation chain and
+    --  examine the parent subtypes for any implementation.
+ 
     function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id;
     --  Find the first primitive operation of type T whose name is 'Name'.
     --  This function allows the use of a primitive operation which is not
*************** package Exp_Util is
*** 362,466 ****
       (Var : Node_Id;
        Op  : out Node_Kind;
        Val : out Node_Id);
!    --  This routine processes the Current_Value field of the variable Var.
!    --  If the Current_Value field is null or if it represents a known value,
!    --  then on return Cond is set to N_Empty, and Val is set to Empty.
     --
!    --  The other case is when Current_Value points to an N_If_Statement
!    --  or an N_Elsif_Part (while statement). Such a setting only occurs
!    --  if the condition of an IF or ELSIF is of the form X op Y, where X
!    --  is the variable in question, Y is a compile-time known value, and
!    --  op is one of the six possible relational operators.
     --
!    --  In this case, Get_Current_Condition digs out the condition, and
!    --  then checks if the condition is known false, known true, or not
!    --  known at all. In the first two cases, Get_Current_Condition will
!    --  return with Op set to the appropriate conditional operator (inverted
!    --  if the condition is known false), and Val set to the constant value.
!    --  If the condition is not known, then Cond and Val are set for the
!    --  empty case (N_Empty and Empty).
     --
     --  The check for whether the condition is true/false unknown depends
     --  on the case:
     --
!    --     For an IF, the condition is known true in the THEN part, known
!    --     false in any ELSIF or ELSE part, and not known outside the IF
!    --     statement in question.
     --
!    --     For an ELSIF, the condition is known true in the ELSIF part,
!    --     known FALSE in any subsequent ELSIF, or ELSE part, and not
!    --     known before the ELSIF, or after the end of the IF statement.
     --
!    --  The caller can use this result to determine the value (for the
!    --  case of N_Op_Eq), or to determine the result of some other test
!    --  in other cases (e.g. no access check required if N_Op_Ne Null).
  
     function Homonym_Number (Subp : Entity_Id) return Nat;
     --  Here subp is the entity for a subprogram. This routine returns the
!    --  homonym number used to disambiguate overloaded subprograms in the
!    --  same scope (the number is used as part of constructed names to make
!    --  sure that they are unique). The number is the ordinal position on
!    --  the Homonym chain, counting only entries in the curren scope. If
!    --  an entity is not overloaded, the returned number will be one.
  
     function Inside_Init_Proc return Boolean;
     --  Returns True if current scope is within an init proc
  
     function In_Unconditional_Context (Node : Node_Id) return Boolean;
!    --  Node is the node for a statement or a component of a statement.
!    --  This function deteermines if the statement appears in a context
!    --  that is unconditionally executed, i.e. it is not within a loop
!    --  or a conditional or a case statement etc.
  
     function Is_All_Null_Statements (L : List_Id) return Boolean;
!    --  Return True if all the items of the list are N_Null_Statement
!    --  nodes. False otherwise. True for an empty list. It is an error
!    --  to call this routine with No_List as the argument.
  
!    function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean;
!    --  Determine whether the node P is a reference to a bit packed
!    --  array, i.e. whether the designated object is a component of
!    --  a bit packed array, or a subcomponent of such a component.
!    --  If so, then all subscripts in P are evaluated with a call
!    --  to Force_Evaluation, and True is returned. Otherwise False
!    --  is returned, and P is not affected.
  
!    function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean;
!    --  Determine whether the node P is a reference to a bit packed
!    --  slice, i.e. whether the designated object is bit packed slice
!    --  or a component of a bit packed slice. Return True if so.
  
!    function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean;
     --  Determine whether the node P is a slice of an array where the slice
     --  result may cause alignment problems because it has an alignment that
     --  is not compatible with the type. Return True if so.
  
!    function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean;
!    --  Node P is an object reference. This function returns True if it
!    --  is possible that the object may not be aligned according to the
!    --  normal default alignment requirement for its type (e.g. if it
!    --  appears in a packed record, or as part of a component that has
!    --  a component clause.
  
     function Is_Renamed_Object (N : Node_Id) return Boolean;
!    --  Returns True if the node N is a renamed object. An expression
!    --  is considered to be a renamed object if either it is the Name
!    --  of an object renaming declaration, or is the prefix of a name
!    --  which is a renamed object. For example, in:
     --
     --     x : r renames a (1 .. 2) (1);
     --
!    --  We consider that a (1 .. 2) is a renamed object since it is the
!    --  prefix of the name in the renaming declaration.
  
     function Is_Untagged_Derivation (T : Entity_Id) return Boolean;
     --  Returns true if type T is not tagged and is a derived type,
     --  or is a private type whose completion is such a type.
  
     procedure Kill_Dead_Code (N : Node_Id);
!    --  N represents a node for a section of code that is known to be
!    --  dead. The node is deleted, and any exception handler references
!    --  and warning messages relating to this code are removed.
  
     procedure Kill_Dead_Code (L : List_Id);
     --  Like the above procedure, but applies to every element in the given
--- 395,509 ----
       (Var : Node_Id;
        Op  : out Node_Kind;
        Val : out Node_Id);
!    --  This routine processes the Current_Value field of the variable Var. If
!    --  the Current_Value field is null or if it represents a known value, then
!    --  on return Cond is set to N_Empty, and Val is set to Empty.
     --
!    --  The other case is when Current_Value points to an N_If_Statement or an
!    --  N_Elsif_Part (while statement). Such a setting only occurs if the
!    --  condition of an IF or ELSIF is of the form X op Y, where is the variable
!    --  in question, Y is a compile-time known value, and op is one of the six
!    --  possible relational operators.
     --
!    --  In this case, Get_Current_Condition digs out the condition, and then
!    --  checks if the condition is known false, known true, or not known at all.
!    --  In the first two cases, Get_Current_Condition will return with Op set to
!    --  the appropriate conditional operator (inverted if the condition is known
!    --  false), and Val set to the constant value. If the condition is not
!    --  known, then Cond and Val are set for the empty case (N_Empty and Empty).
     --
     --  The check for whether the condition is true/false unknown depends
     --  on the case:
     --
!    --     For an IF, the condition is known true in the THEN part, known false
!    --     in any ELSIF or ELSE part, and not known outside the IF statement in
!    --     question.
     --
!    --     For an ELSIF, the condition is known true in the ELSIF part, known
!    --     FALSE in any subsequent ELSIF, or ELSE part, and not known before the
!    --     ELSIF, or after the end of the IF statement.
     --
!    --  The caller can use this result to determine the value (for the case of
!    --  N_Op_Eq), or to determine the result of some other test in other cases
!    --  (e.g. no access check required if N_Op_Ne Null).
  
     function Homonym_Number (Subp : Entity_Id) return Nat;
     --  Here subp is the entity for a subprogram. This routine returns the
!    --  homonym number used to disambiguate overloaded subprograms in the same
!    --  scope (the number is used as part of constructed names to make sure that
!    --  they are unique). The number is the ordinal position on the Homonym
!    --  chain, counting only entries in the curren scope. If an entity is not
!    --  overloaded, the returned number will be one.
! 
!    function Implements_Interface
!      (Typ          : Entity_Id;
!       Kind         : Interface_Kind;
!       Check_Parent : Boolean := False) return Boolean;
!    --  Ada 2005 (AI-345): Determine whether Typ implements a designated kind
!    --  of interface. Use Check_Parent to climb a potential derivation chain
!    --  and examine the parent subtypes for any implementation.
  
     function Inside_Init_Proc return Boolean;
     --  Returns True if current scope is within an init proc
  
     function In_Unconditional_Context (Node : Node_Id) return Boolean;
!    --  Node is the node for a statement or a component of a statement. This
!    --  function deteermines if the statement appears in a context that is
!    --  unconditionally executed, i.e. it is not within a loop or a conditional
!    --  or a case statement etc.
  
     function Is_All_Null_Statements (L : List_Id) return Boolean;
!    --  Return True if all the items of the list are N_Null_Statement nodes.
!    --  False otherwise. True for an empty list. It is an error to call this
!    --  routine with No_List as the argument.
  
!    function Is_Predefined_Dispatching_Operation
!      (Subp : Entity_Id) return Boolean;
!    --  Ada 2005 (AI-251): Determines if Subp is a predefined primitive
!    --  operation.
  
!    function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean;
!    --  Determine whether the node P is a reference to a bit packed array, i.e.
!    --  whether the designated object is a component of a bit packed array, or a
!    --  subcomponent of such a component. If so, then all subscripts in P are
!    --  evaluated with a call to Force_Evaluation, and True is returned.
!    --  Otherwise False is returned, and P is not affected.
  
!    function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean;
!    --  Determine whether the node P is a reference to a bit packed slice, i.e.
!    --  whether the designated object is bit packed slice or a component of a
!    --  bit packed slice. Return True if so.
! 
!    function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean;
     --  Determine whether the node P is a slice of an array where the slice
     --  result may cause alignment problems because it has an alignment that
     --  is not compatible with the type. Return True if so.
  
!    function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean;
!    --  Node N is an object reference. This function returns True if it is
!    --  possible that the object may not be aligned according to the normal
!    --  default alignment requirement for its type (e.g. if it appears in a
!    --  packed record, or as part of a component that has a component clause.
  
     function Is_Renamed_Object (N : Node_Id) return Boolean;
!    --  Returns True if the node N is a renamed object. An expression is
!    --  considered to be a renamed object if either it is the Name of an object
!    --  renaming declaration, or is the prefix of a name which is a renamed
!    --  object. For example, in:
     --
     --     x : r renames a (1 .. 2) (1);
     --
!    --  We consider that a (1 .. 2) is a renamed object since it is the prefix
!    --  of the name in the renaming declaration.
  
     function Is_Untagged_Derivation (T : Entity_Id) return Boolean;
     --  Returns true if type T is not tagged and is a derived type,
     --  or is a private type whose completion is such a type.
  
     procedure Kill_Dead_Code (N : Node_Id);
!    --  N represents a node for a section of code that is known to be dead. The
!    --  node is deleted, and any exception handler references and warning
!    --  messages relating to this code are removed.
  
     procedure Kill_Dead_Code (L : List_Id);
     --  Like the above procedure, but applies to every element in the given
*************** package Exp_Util is
*** 485,533 ****
     --  a classwide type.
  
     function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean;
!    --  Determines if the given type, Typ, may require a large temporary
!    --  of the kind that causes back-end trouble if stack checking is enabled.
!    --  The result is True only the size of the type is known at compile time
!    --  and large, where large is defined heuristically by the body of this
!    --  routine. The purpose of this routine is to help avoid generating
!    --  troublesome temporaries that interfere with stack checking mechanism.
!    --  Note that the caller has to check whether stack checking is actually
!    --  enabled in order to guide the expansion (typically of a function call).
  
     procedure Remove_Side_Effects
       (Exp          : Node_Id;
        Name_Req     : Boolean := False;
        Variable_Ref : Boolean := False);
!    --  Given the node for a subexpression, this function replaces the node
!    --  if necessary by an equivalent subexpression that is guaranteed to be
!    --  side effect free. This is done by extracting any actions that could
!    --  cause side effects, and inserting them using Insert_Actions into the
!    --  tree to which Exp is attached. Exp must be analyzed and resolved
!    --  before the call and is analyzed and resolved on return. The Name_Req
!    --  may only be set to True if Exp has the form of a name, and the
!    --  effect is to guarantee that any replacement maintains the form of a
!    --  name. If Variable_Ref is set to TRUE, a variable is considered as a
!    --  side effect (used in implementing Force_Evaluation). Note: after a
!    --  call to Remove_Side_Effects, it is safe to call New_Copy_Tree to
!    --  obtain a copy of the resulting expression.
  
     function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
!    --  Given the node for an N_Unchecked_Type_Conversion, return True
!    --  if this is an unchecked conversion that Gigi can handle directly.
!    --  Otherwise return False if it is one for which the front end must
!    --  provide a temporary. Note that the node need not be analyzed, and
!    --  thus the Etype field may not be set, but in that case it must be
!    --  the case that the Subtype_Mark field of the node is set/analyzed.
  
     procedure Set_Elaboration_Flag (N : Node_Id; Spec_Id : Entity_Id);
!    --  N is the node for a subprogram or generic body, and Spec_Id
!    --  is the entity for the corresponding spec. If an elaboration
!    --  entity is defined, then this procedure generates an assignment
!    --  statement to set it True, immediately after the body is elaborated.
!    --  However, no assignment is generated in the case of library level
!    --  procedures, since the setting of the flag in this case is generated
!    --  in the binder. We do that so that we can detect cases where this is
!    --  the only elaboration action that is required.
  
     function Target_Has_Fixed_Ops
       (Left_Typ   : Entity_Id;
--- 528,580 ----
     --  a classwide type.
  
     function May_Generate_Large_Temp (Typ : Entity_Id) return Boolean;
!    --  Determines if the given type, Typ, may require a large temporary of the
!    --  kind that causes back-end trouble if stack checking is enabled. The
!    --  result is True only the size of the type is known at compile time and
!    --  large, where large is defined heuristically by the body of this routine.
!    --  The purpose of this routine is to help avoid generating troublesome
!    --  temporaries that interfere with stack checking mechanism. Note that the
!    --  caller has to check whether stack checking is actually enabled in order
!    --  to guide the expansion (typically of a function call).
  
     procedure Remove_Side_Effects
       (Exp          : Node_Id;
        Name_Req     : Boolean := False;
        Variable_Ref : Boolean := False);
!    --  Given the node for a subexpression, this function replaces the node if
!    --  necessary by an equivalent subexpression that is guaranteed to be side
!    --  effect free. This is done by extracting any actions that could cause
!    --  side effects, and inserting them using Insert_Actions into the tree to
!    --  which Exp is attached. Exp must be analyzed and resolved before the call
!    --  and is analyzed and resolved on return. The Name_Req may only be set to
!    --  True if Exp has the form of a name, and the effect is to guarantee that
!    --  any replacement maintains the form of name. If Variable_Ref is set to
!    --  TRUE, a variable is considered as side effect (used in implementing
!    --  Force_Evaluation). Note: after call to Remove_Side_Effects, it is safe
!    --  to call New_Copy_Tree to obtain a copy of the resulting expression.
! 
!    function Represented_As_Scalar (T : Entity_Id) return Boolean;
!    --  Returns True iff the implementation of this type in code generation
!    --  terms is scalar. This is true for scalars in the Ada sense, and for
!    --  packed arrays which are represented by a scalar (modular) type.
  
     function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
!    --  Given the node for an N_Unchecked_Type_Conversion, return True if this
!    --  is an unchecked conversion that Gigi can handle directly. Otherwise
!    --  return False if it is one for which the front end must provide a
!    --  temporary. Note that the node need not be analyzed, and thus the Etype
!    --  field may not be set, but in that case it must be the case that the
!    --  Subtype_Mark field of the node is set/analyzed.
  
     procedure Set_Elaboration_Flag (N : Node_Id; Spec_Id : Entity_Id);
!    --  N is the node for a subprogram or generic body, and Spec_Id is the
!    --  entity for the corresponding spec. If an elaboration entity is defined,
!    --  then this procedure generates an assignment statement to set it True,
!    --  immediately after the body is elaborated. However, no assignment is
!    --  generated in the case of library level procedures, since the setting of
!    --  the flag in this case is generated in the binder. We do that so that we
!    --  can detect cases where this is the only elaboration action that is
!    --  required.
  
     function Target_Has_Fixed_Ops
       (Left_Typ   : Entity_Id;
*************** package Exp_Util is
*** 540,559 ****
  
     function Type_May_Have_Bit_Aligned_Components
       (Typ : Entity_Id) return Boolean;
!    --  Determines if Typ is a composite type that has within it (looking
!    --  down recursively at any subcomponents), a record type which has a
!    --  component that may be bit aligned (see Possible_Bit_Aligned_Component).
!    --  The result is conservative, in that a result of False is decisive.
!    --  A result of True means that such a component may or may not be present.
  
     procedure Wrap_Cleanup_Procedure (N : Node_Id);
!    --  Given an N_Subprogram_Body node, this procedure adds an Abort_Defer
!    --  call at the start of the statement sequence, and an Abort_Undefer call
!    --  at the end of the statement sequence. All cleanup routines (i.e. those
!    --  that are called from "at end" handlers) must defer abort on entry and
!    --  undefer abort on exit. Note that it is assumed that the code for the
!    --  procedure does not contain any return statements which would allow the
!    --  flow of control to escape doing the undefer call.
  
  private
     pragma Inline (Force_Evaluation);
--- 587,606 ----
  
     function Type_May_Have_Bit_Aligned_Components
       (Typ : Entity_Id) return Boolean;
!    --  Determines if Typ is a composite type that has within it (looking down
!    --  recursively at any subcomponents), a record type which has component
!    --  that may be bit aligned (see Possible_Bit_Aligned_Component). The result
!    --  is conservative, in that a result of False is decisive. A result of True
!    --  means that such a component may or may not be present.
  
     procedure Wrap_Cleanup_Procedure (N : Node_Id);
!    --  Given an N_Subprogram_Body node, this procedure adds an Abort_Defer call
!    --  at the start of the statement sequence, and an Abort_Undefer call at the
!    --  end of the statement sequence. All cleanup routines (i.e. those that are
!    --  called from "at end" handlers) must defer abort on entry and undefer
!    --  abort on exit. Note that it is assumed that the code for the procedure
!    --  does not contain any return statements which would allow the flow of
!    --  control to escape doing the undefer call.
  
  private
     pragma Inline (Force_Evaluation);
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_vfpt.adb gcc-4.1.0/gcc/ada/exp_vfpt.adb
*** gcc-4.0.2/gcc/ada/exp_vfpt.adb	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/exp_vfpt.adb	Tue Nov 15 13:51:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Exp_VFpt is
*** 196,201 ****
--- 196,208 ----
                 Func := RE_Lt_G;
              end if;
  
+          when N_Op_Ne =>
+             if Typc = 'F' then
+                Func := RE_Ne_F;
+             else
+                Func := RE_Ne_G;
+             end if;
+ 
           when others =>
              Func := RE_Null;
              raise Program_Error;
*************** package body Exp_VFpt is
*** 295,308 ****
           end if;
        end Call_Type;
  
        function Equivalent_Integer_Type (T : Entity_Id) return Entity_Id is
        begin
           if Esize (T) = Esize (Standard_Long_Long_Integer) then
              return Standard_Long_Long_Integer;
- 
           elsif Esize (T) = Esize (Standard_Long_Integer) then
              return  Standard_Long_Integer;
- 
           else
              return Standard_Integer;
           end if;
--- 302,317 ----
           end if;
        end Call_Type;
  
+       -------------------------------------------------
+       -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
+       -------------------------------------------------
+ 
        function Equivalent_Integer_Type (T : Entity_Id) return Entity_Id is
        begin
           if Esize (T) = Esize (Standard_Long_Long_Integer) then
              return Standard_Long_Long_Integer;
           elsif Esize (T) = Esize (Standard_Long_Integer) then
              return  Standard_Long_Integer;
           else
              return Standard_Integer;
           end if;
*************** package body Exp_VFpt is
*** 320,359 ****
           Rewrite (N,
             Unchecked_Convert_To (T_Typ, Expr));
  
        elsif Is_Fixed_Point_Type (S_Typ) then
  
!          --  convert the scaled integer value to the target type, and multiply
!          --  by 'Small of type.
  
!          Rewrite (N,
!             Make_Op_Multiply (Loc,
!               Left_Opnd =>
!                 Make_Type_Conversion (Loc,
!                   Subtype_Mark => New_Occurrence_Of (T_Typ, Loc),
!                   Expression   =>
!                     Unchecked_Convert_To (
!                       Equivalent_Integer_Type (S_Typ), Expr)),
!               Right_Opnd =>
!                 Make_Real_Literal (Loc, Realval => Small_Value (S_Typ))));
  
        elsif Is_Fixed_Point_Type (T_Typ) then
  
!          --  multiply value by 'small of type, and convert to the corresponding
!          --  integer type.
  
!          Rewrite (N,
!            Unchecked_Convert_To (T_Typ,
!              Make_Type_Conversion (Loc,
!                Subtype_Mark =>
!                  New_Occurrence_Of (Equivalent_Integer_Type (T_Typ), Loc),
!                Expression =>
!                  Make_Op_Multiply (Loc,
!                    Left_Opnd => Expr,
!                    Right_Opnd =>
!                      Make_Real_Literal (Loc,
!                        Realval => Ureal_1 / Small_Value (T_Typ))))));
  
!       --  All other cases.
  
        else
           --  Compute types for call
--- 329,392 ----
           Rewrite (N,
             Unchecked_Convert_To (T_Typ, Expr));
  
+       --  Case of conversion of fixed-point type to Vax_Float type
+ 
        elsif Is_Fixed_Point_Type (S_Typ) then
  
!          --  If Conversion_OK set, then we introduce an intermediate IEEE
!          --  target type since we are expecting the code generator to handle
!          --  the case of integer to IEEE float.
  
!          if Conversion_OK (N) then
!             Rewrite (N,
!               Convert_To (T_Typ, OK_Convert_To (Universal_Real, Expr)));
! 
!          --  Otherwise, convert the scaled integer value to the target type,
!          --  and multiply by 'Small of type.
! 
!          else
!             Rewrite (N,
!                Make_Op_Multiply (Loc,
!                  Left_Opnd =>
!                    Make_Type_Conversion (Loc,
!                      Subtype_Mark => New_Occurrence_Of (T_Typ, Loc),
!                      Expression   =>
!                        Unchecked_Convert_To (
!                          Equivalent_Integer_Type (S_Typ), Expr)),
!                  Right_Opnd =>
!                    Make_Real_Literal (Loc, Realval => Small_Value (S_Typ))));
!          end if;
! 
!       --  Case of conversion of Vax_Float type to fixed-point type
  
        elsif Is_Fixed_Point_Type (T_Typ) then
  
!          --  If Conversion_OK set, then we introduce an intermediate IEEE
!          --  target type, since we are expecting the code generator to handle
!          --  the case of IEEE float to integer.
  
!          if Conversion_OK (N) then
!             Rewrite (N,
!               OK_Convert_To (T_Typ, Convert_To (Universal_Real, Expr)));
  
!          --  Otherwise, multiply value by 'small of type, and convert to the
!          --  corresponding integer type.
! 
!          else
!             Rewrite (N,
!               Unchecked_Convert_To (T_Typ,
!                 Make_Type_Conversion (Loc,
!                   Subtype_Mark =>
!                     New_Occurrence_Of (Equivalent_Integer_Type (T_Typ), Loc),
!                   Expression =>
!                     Make_Op_Multiply (Loc,
!                       Left_Opnd => Expr,
!                       Right_Opnd =>
!                         Make_Real_Literal (Loc,
!                           Realval => Ureal_1 / Small_Value (T_Typ))))));
!          end if;
! 
!       --  All other cases
  
        else
           --  Compute types for call
*************** package body Exp_VFpt is
*** 499,502 ****
--- 532,569 ----
        end if;
     end Expand_Vax_Real_Literal;
  
+    ----------------------
+    -- Expand_Vax_Valid --
+    ----------------------
+ 
+    procedure Expand_Vax_Valid (N : Node_Id) is
+       Loc  : constant Source_Ptr := Sloc (N);
+       Pref : constant Node_Id    := Prefix (N);
+       Ptyp : constant Entity_Id  := Root_Type (Etype (Pref));
+       Rtyp : constant Entity_Id  := Etype (N);
+       Vtyp : RE_Id;
+       Func : RE_Id;
+ 
+    begin
+       if Digits_Value (Ptyp) = VAXFF_Digits then
+          Func := RE_Valid_F;
+          Vtyp := RE_F;
+       elsif Digits_Value (Ptyp) = VAXDF_Digits then
+          Func := RE_Valid_D;
+          Vtyp := RE_D;
+       else pragma Assert (Digits_Value (Ptyp) = VAXGF_Digits);
+          Func := RE_Valid_G;
+          Vtyp := RE_G;
+       end if;
+ 
+       Rewrite (N,
+         Convert_To (Rtyp,
+           Make_Function_Call (Loc,
+             Name                   => New_Occurrence_Of (RTE (Func), Loc),
+             Parameter_Associations => New_List (
+               Convert_To (RTE (Vtyp), Pref)))));
+ 
+       Analyze_And_Resolve (N);
+    end Expand_Vax_Valid;
+ 
  end Exp_VFpt;
diff -Nrcpad gcc-4.0.2/gcc/ada/exp_vfpt.ads gcc-4.1.0/gcc/ada/exp_vfpt.ads
*** gcc-4.0.2/gcc/ada/exp_vfpt.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/exp_vfpt.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 1997 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,32 ****
  
  --  This package contains specialized routines for handling the expansion
  --  of arithmetic and conversion operations involving Vax format floating-
! --  point formats as used on the Vax and the Alpha.
  
  with Types; use Types;
  
--- 26,32 ----
  
  --  This package contains specialized routines for handling the expansion
  --  of arithmetic and conversion operations involving Vax format floating-
! --  point formats as used on the Vax and the Alpha and the ia64.
  
  with Types; use Types;
  
*************** package Exp_VFpt is
*** 34,54 ****
  
     procedure Expand_Vax_Arith (N : Node_Id);
     --  The node N is an arithmetic node (N_Op_Abs, N_Op_Add, N_Op_Sub,
!    --  N_Op_Div, N_Op_Mul, N_Op_Minus where the operands are in Vax
!    --  float format. This procedure expands the necessary call.
  
     procedure Expand_Vax_Comparison (N : Node_Id);
!    --  The node N is an arithmetic comparison node where the types to
!    --  be compared are in Vax float format. This procedure expands the
!    --  necessary call.
  
     procedure Expand_Vax_Conversion (N : Node_Id);
!    --  The node N is a type conversion node where either the source or
!    --  the target type, or both, are Vax floating-point type.
  
     procedure Expand_Vax_Real_Literal (N : Node_Id);
!    --  The node N is a real literal node where the type is a Vax
!    --  floating-point type. This procedure rewrites the node to eliminate
!    --  the occurrence of such constants.
  
  end Exp_VFpt;
--- 34,59 ----
  
     procedure Expand_Vax_Arith (N : Node_Id);
     --  The node N is an arithmetic node (N_Op_Abs, N_Op_Add, N_Op_Sub,
!    --  N_Op_Div, N_Op_Mul, N_Op_Minus where the operands are in Vax float
!    --  format. This procedure expands the necessary call.
  
     procedure Expand_Vax_Comparison (N : Node_Id);
!    --  The node N is an arithmetic comparison node where the types to be
!    --  compared are in Vax float format. This procedure expands the necessary
!    --  call.
  
     procedure Expand_Vax_Conversion (N : Node_Id);
!    --  The node N is a type conversion node where either the source or the
!    --  target type, or both, are Vax floating-point type.
  
     procedure Expand_Vax_Real_Literal (N : Node_Id);
!    --  The node N is a real literal node where the type is a Vax floating-point
!    --  type. This procedure rewrites the node to eliminate the occurrence of
!    --  such constants.
! 
!    procedure Expand_Vax_Valid (N : Node_Id);
!    --  The node N is an attribute reference node for the Valid attribute where
!    --  the prefix is of a Vax floating-point type. This procedure expands the
!    --  necessary call for the validity test.
  
  end Exp_VFpt;
diff -Nrcpad gcc-4.0.2/gcc/ada/expander.adb gcc-4.1.0/gcc/ada/expander.adb
*** gcc-4.0.2/gcc/ada/expander.adb	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/expander.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/expander.ads gcc-4.1.0/gcc/ada/expander.ads
*** gcc-4.0.2/gcc/ada/expander.ads	Tue Oct 21 13:41:59 2003
--- gcc-4.1.0/gcc/ada/expander.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/expect.c gcc-4.1.0/gcc/ada/expect.c
*** gcc-4.0.2/gcc/ada/expect.c	Fri Nov 19 11:24:39 2004
--- gcc-4.1.0/gcc/ada/expect.c	Tue Nov 15 13:57:56 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *           Copyright (C) 2001-2004 Ada Core Technologies, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *                     Copyright (C) 2001-2005, AdaCore                     *
   *                                                                          *
   * 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 43,48 ****
--- 43,60 ----
  #include "system.h"
  #endif
  
+ #include <sys/types.h>
+ 
+ #ifdef __MINGW32__
+ #if OLD_MINGW
+ #include <sys/wait.h>
+ #endif
+ #elif defined (__vxworks) && defined (__RTP__)
+ #include <wait.h>
+ #else
+ #include <sys/wait.h>
+ #endif
+ 
  /* This file provides the low level functionalities needed to implement Expect
     capabilities in GNAT.Expect.
     Implementations for unix and windows systems is provided.
***************
*** 64,82 ****
  #include <process.h>
  
  void
! __gnat_kill (int pid, int sig)
  {
-   HANDLE process_handle;
- 
    if (sig == 9)
      {
!       process_handle = OpenProcess (PROCESS_TERMINATE, FALSE, pid);
!       if (process_handle != NULL)
! 	TerminateProcess (process_handle, 0);
      }
  }
  
  int
  __gnat_expect_fork (void)
  {
    return 0;
--- 76,111 ----
  #include <process.h>
  
  void
! __gnat_kill (int pid, int sig, int close)
  {
    if (sig == 9)
      {
!       if ((HANDLE)pid != NULL)
! 	{
! 	  TerminateProcess ((HANDLE)pid, 0);
! 	  if (close)
! 	    CloseHandle ((HANDLE)pid);
! 	}
      }
  }
  
  int
+ __gnat_waitpid (int pid)
+ {
+   DWORD exitcode = 1;
+   DWORD res;
+ 
+   if ((HANDLE)pid != NULL)
+     {
+       res = WaitForSingleObject ((HANDLE)pid, INFINITE);
+       GetExitCodeProcess ((HANDLE)pid, &exitcode);
+       CloseHandle ((HANDLE)pid);
+     }
+ 
+   return (int) exitcode;
+ }
+ 
+ int
  __gnat_expect_fork (void)
  {
    return 0;
*************** __gnat_expect_poll (int *fd, int num_fd,
*** 152,161 ****
  #include <unixio.h>
  #include <stdlib.h>
  #include <string.h>
! #include <descrip.h>
  #include <stdio.h>
! #include <stsdef.h>
! #include <iodef.h>
  
  int
  __gnat_pipe (int *fd)
--- 181,201 ----
  #include <unixio.h>
  #include <stdlib.h>
  #include <string.h>
! #include <vms/descrip.h>
  #include <stdio.h>
! #include <vms/stsdef.h>
! #include <vms/iodef.h>
! 
! int
! __gnat_waitpid (int pid)
! {
!   int status = 0;
! 
!   waitpid (pid, &status, 0);
!   status = WEXITSTATUS (status);
! 
!   return status;
! }
  
  int
  __gnat_pipe (int *fd)
*************** typedef long fd_mask;
*** 292,303 ****
  #endif /* !NO_FD_SET */
  
  void
! __gnat_kill (int pid, int sig)
  {
    kill (pid, sig);
  }
  
  int
  __gnat_pipe (int *fd)
  {
    return pipe (fd);
--- 332,354 ----
  #endif /* !NO_FD_SET */
  
  void
! __gnat_kill (int pid, int sig, int close)
  {
    kill (pid, sig);
  }
  
  int
+ __gnat_waitpid (int pid)
+ {
+   int status = 0;
+ 
+   waitpid (pid, &status, 0);
+   status = WEXITSTATUS (status);
+ 
+   return status;
+ }
+ 
+ int
  __gnat_pipe (int *fd)
  {
    return pipe (fd);
*************** __gnat_expect_poll (int *fd, int num_fd,
*** 400,407 ****
  #else
  
  void
! __gnat_kill (int pid, int sig)
  {
  }
  
  int
--- 451,464 ----
  #else
  
  void
! __gnat_kill (int pid, int sig, int close)
! {
! }
! 
! int
! __gnat_waitpid (int pid, int sig)
  {
+   return 0;
  }
  
  int
diff -Nrcpad gcc-4.0.2/gcc/ada/fe.h gcc-4.1.0/gcc/ada/fe.h
*** gcc-4.0.2/gcc/ada/fe.h	Mon Mar 15 14:50:56 2004
--- gcc-4.1.0/gcc/ada/fe.h	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-2004 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- *
--- 6,12 ----
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** extern Boolean In_Same_Source_Unit      
*** 150,162 ****
  
  /* opt: */
  
! #define Global_Discard_Names   opt__global_discard_names
! #define Exception_Mechanism    opt__exception_mechanism
! #define Back_Annotate_Rep_Info opt__back_annotate_rep_info
  
! typedef enum {Setjmp_Longjmp, Front_End_ZCX, GCC_ZCX} Exception_Mechanism_Type;
  
  extern Boolean Global_Discard_Names;
  extern Exception_Mechanism_Type Exception_Mechanism;
  extern Boolean Back_Annotate_Rep_Info;
  
--- 150,164 ----
  
  /* opt: */
  
! #define Global_Discard_Names           opt__global_discard_names
! #define Exception_Locations_Suppressed opt__exception_locations_suppressed
! #define Exception_Mechanism            opt__exception_mechanism
! #define Back_Annotate_Rep_Info         opt__back_annotate_rep_info
  
! typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;
  
  extern Boolean Global_Discard_Names;
+ extern Boolean Exception_Locations_Suppressed;
  extern Exception_Mechanism_Type Exception_Mechanism;
  extern Boolean Back_Annotate_Rep_Info;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/final.c gcc-4.1.0/gcc/ada/final.c
*** gcc-4.0.2/gcc/ada/final.c	Fri Oct 31 01:08:42 2003
--- gcc-4.1.0/gcc/ada/final.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/fmap.adb gcc-4.1.0/gcc/ada/fmap.adb
*** gcc-4.0.2/gcc/ada/fmap.adb	Mon Dec  1 13:29:27 2003
--- gcc-4.1.0/gcc/ada/fmap.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Fmap is
*** 62,68 ****
       Table_Initial        => 1_000,
       Table_Increment      => 1_000,
       Table_Name           => "Fmap.File_Mapping");
!    --  Mapping table to map unit names to file names.
  
     package Path_Mapping is new Table.Table (
       Table_Component_Type => Mapping,
--- 62,68 ----
       Table_Initial        => 1_000,
       Table_Increment      => 1_000,
       Table_Name           => "Fmap.File_Mapping");
!    --  Mapping table to map unit names to file names
  
     package Path_Mapping is new Table.Table (
       Table_Component_Type => Mapping,
*************** package body Fmap is
*** 297,303 ****
                 return;
              end if;
  
- 
              Name_Len := Last - First + 1;
              Name_Buffer (1 .. Name_Len) := SP (First .. Last);
              Uname := Find_Name;
--- 297,302 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/fmap.ads gcc-4.1.0/gcc/ada/fmap.ads
*** gcc-4.0.2/gcc/ada/fmap.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/fmap.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/fname-sf.adb gcc-4.1.0/gcc/ada/fname-sf.adb
*** gcc-4.0.2/gcc/ada/fname-sf.adb	Mon Mar 29 12:03:09 2004
--- gcc-4.1.0/gcc/ada/fname-sf.adb	Mon Sep  5 07:50:46 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Fname.UF; use Fname.UF;
*** 30,36 ****
  with SFN_Scan; use SFN_Scan;
  with Namet;    use Namet;
  with Osint;    use Osint;
- with Types;    use Types;
  
  with Unchecked_Conversion;
  
--- 30,35 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/fname-sf.ads gcc-4.1.0/gcc/ada/fname-sf.ads
*** gcc-4.0.2/gcc/ada/fname-sf.ads	Thu Apr 24 17:54:01 2003
--- gcc-4.1.0/gcc/ada/fname-sf.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/fname-uf.adb gcc-4.1.0/gcc/ada/fname-uf.adb
*** gcc-4.0.2/gcc/ada/fname-uf.adb	Mon Mar 29 12:03:09 2004
--- gcc-4.1.0/gcc/ada/fname-uf.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/fname-uf.ads gcc-4.1.0/gcc/ada/fname-uf.ads
*** gcc-4.0.2/gcc/ada/fname-uf.ads	Mon Mar 29 12:03:09 2004
--- gcc-4.1.0/gcc/ada/fname-uf.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/fname.adb gcc-4.1.0/gcc/ada/fname.adb
*** gcc-4.0.2/gcc/ada/fname.adb	Fri Jun 25 16:39:27 2004
--- gcc-4.1.0/gcc/ada/fname.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/fname.ads gcc-4.1.0/gcc/ada/fname.ads
*** gcc-4.0.2/gcc/ada/fname.ads	Mon Mar 29 12:03:09 2004
--- gcc-4.1.0/gcc/ada/fname.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/freeze.adb gcc-4.1.0/gcc/ada/freeze.adb
*** gcc-4.0.2/gcc/ada/freeze.adb	Thu Mar 17 19:53:06 2005
--- gcc-4.1.0/gcc/ada/freeze.adb	Tue Nov 15 13:58:51 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Einfo;    use Einfo;
*** 30,36 ****
  with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Ch7;  use Exp_Ch7;
- with Exp_Ch11; use Exp_Ch11;
  with Exp_Pakd; use Exp_Pakd;
  with Exp_Util; use Exp_Util;
  with Exp_Tss;  use Exp_Tss;
--- 30,35 ----
*************** package body Freeze is
*** 78,84 ****
       (Decl  : Node_Id;
        New_S : Entity_Id;
        After : in out Node_Id);
!    --  Build body for a renaming declaration, insert in tree and analyze.
  
     procedure Check_Address_Clause (E : Entity_Id);
     --  Apply legality checks to address clauses for object declarations,
--- 77,83 ----
       (Decl  : Node_Id;
        New_S : Entity_Id;
        After : in out Node_Id);
!    --  Build body for a renaming declaration, insert in tree and analyze
  
     procedure Check_Address_Clause (E : Entity_Id);
     --  Apply legality checks to address clauses for object declarations,
*************** package body Freeze is
*** 393,399 ****
               Parameter_Associations => Actuals);
        end if;
  
!       --  Create entities for subprogram body and formals.
  
        Set_Defining_Unit_Name (Spec,
          Make_Defining_Identifier (Loc, Chars => Chars (New_S)));
--- 392,398 ----
               Parameter_Associations => Actuals);
        end if;
  
!       --  Create entities for subprogram body and formals
  
        Set_Defining_Unit_Name (Spec,
          Make_Defining_Identifier (Loc, Chars => Chars (New_S)));
*************** package body Freeze is
*** 1380,1396 ****
        Atype  : Entity_Id;
  
        procedure Check_Current_Instance (Comp_Decl : Node_Id);
!       --  Check that an Access or Unchecked_Access attribute with
!       --  a prefix which is the current instance type can only be
!       --  applied when the type is limited.
  
        function After_Last_Declaration return Boolean;
        --  If Loc is a freeze_entity that appears after the last declaration
        --  in the scope, inhibit error messages on late completion.
  
        procedure Freeze_Record_Type (Rec : Entity_Id);
!       --  Freeze each component, handle some representation clauses, and
!       --  freeze primitive operations if this is a tagged type.
  
        ----------------------------
        -- After_Last_Declaration --
--- 1379,1395 ----
        Atype  : Entity_Id;
  
        procedure Check_Current_Instance (Comp_Decl : Node_Id);
!       --  Check that an Access or Unchecked_Access attribute with a prefix
!       --  which is the current instance type can only be applied when the type
!       --  is limited.
  
        function After_Last_Declaration return Boolean;
        --  If Loc is a freeze_entity that appears after the last declaration
        --  in the scope, inhibit error messages on late completion.
  
        procedure Freeze_Record_Type (Rec : Entity_Id);
!       --  Freeze each component, handle some representation clauses, and freeze
!       --  primitive operations if this is a tagged type.
  
        ----------------------------
        -- After_Last_Declaration --
*************** package body Freeze is
*** 1422,1428 ****
        procedure Check_Current_Instance (Comp_Decl : Node_Id) is
  
           function Process (N : Node_Id) return Traverse_Result;
!          --  Process routine to apply check to given node.
  
           -------------
           -- Process --
--- 1421,1427 ----
        procedure Check_Current_Instance (Comp_Decl : Node_Id) is
  
           function Process (N : Node_Id) return Traverse_Result;
!          --  Process routine to apply check to given node
  
           -------------
           -- Process --
*************** package body Freeze is
*** 1530,1558 ****
              then
                 Set_First_Entity (Rec, First_Entity (Base_Type (Rec)));
  
!             --  If this is an internal type without a declaration, as for a
              --  record component, the base type may not yet be frozen, and its
              --  controller has not been created. Add an explicit freeze node
!             --  for the itype, so it will be frozen after the base type.
  
              elsif Is_Itype (Rec)
                and then Has_Delayed_Freeze (Base_Type (Rec))
                and then
                  Nkind (Associated_Node_For_Itype (Rec)) =
!                   N_Component_Declaration
              then
                 Ensure_Freeze_Node (Rec);
              end if;
           end if;
  
!          --  Freeze components and embedded subtypes.
  
           Comp := First_Entity (Rec);
           Prev := Empty;
  
           while Present (Comp) loop
  
!             --  First handle the (real) component case.
  
              if Ekind (Comp) = E_Component
                or else Ekind (Comp) = E_Discriminant
--- 1529,1563 ----
              then
                 Set_First_Entity (Rec, First_Entity (Base_Type (Rec)));
  
!             --  If this is an internal type without a declaration, as for
              --  record component, the base type may not yet be frozen, and its
              --  controller has not been created. Add an explicit freeze node
!             --  for the itype, so it will be frozen after the base type. This
!             --  freeze node is used to communicate with the expander, in order
!             --  to create the controller for the enclosing record, and it is
!             --  deleted afterwards (see exp_ch3). It must not be created when
!             --  expansion is off, because it might appear in the wrong context
!             --  for the back end.
  
              elsif Is_Itype (Rec)
                and then Has_Delayed_Freeze (Base_Type (Rec))
                and then
                  Nkind (Associated_Node_For_Itype (Rec)) =
!                                                      N_Component_Declaration
!               and then Expander_Active
              then
                 Ensure_Freeze_Node (Rec);
              end if;
           end if;
  
!          --  Freeze components and embedded subtypes
  
           Comp := First_Entity (Rec);
           Prev := Empty;
  
           while Present (Comp) loop
  
!             --  First handle the (real) component case
  
              if Ekind (Comp) = E_Component
                or else Ekind (Comp) = E_Discriminant
*************** package body Freeze is
*** 1562,1573 ****
  
                 begin
                    --  Freezing a record type freezes the type of each of its
!                   --  components.  However, if the type of the component is
                    --  part of this record, we do not want or need a separate
!                   --  Freeze_Node.  Note that Is_Itype is wrong because that's
!                   --  also set in private type cases.  We also can't check
!                   --  for the Scope being exactly Rec because of private types
!                   --  and record extensions.
                    if Is_Itype (Etype (Comp))
                      and then Is_Record_Type (Underlying_Type
                                               (Scope (Etype (Comp))))
--- 1567,1579 ----
  
                 begin
                    --  Freezing a record type freezes the type of each of its
!                   --  components. However, if the type of the component is
                    --  part of this record, we do not want or need a separate
!                   --  Freeze_Node. Note that Is_Itype is wrong because that's
!                   --  also set in private type cases. We also can't check for
!                   --  the Scope being exactly Rec because of private types and
!                   --  record extensions.
! 
                    if Is_Itype (Etype (Comp))
                      and then Is_Record_Type (Underlying_Type
                                               (Scope (Etype (Comp))))
*************** package body Freeze is
*** 1737,1750 ****
                 end;
              end if;
  
!             --  If the component is an Itype with Delayed_Freeze and is
!             --  either a record or array subtype and its base type has not
!             --  yet been frozen, we must remove this from the entity list
!             --  of this record and put it on the entity list of the scope of
!             --  its base type.  Note that we know that this is not the type
!             --  of a component since we cleared Has_Delayed_Freeze for it
!             --  in the previous loop.  Thus this must be the Designated_Type
!             --  of an access type, which is the type of a component.
              if Is_Itype (Comp)
                and then Is_Type (Scope (Comp))
                and then Is_Composite_Type (Comp)
--- 1743,1757 ----
                 end;
              end if;
  
!             --  If the component is an Itype with Delayed_Freeze and is either
!             --  a record or array subtype and its base type has not yet been
!             --  frozen, we must remove this from the entity list of this
!             --  record and put it on the entity list of the scope of its base
!             --  type. Note that we know that this is not the type of a
!             --  component since we cleared Has_Delayed_Freeze for it in the
!             --  previous loop. Thus this must be the Designated_Type of an
!             --  access type, which is the type of a component.
! 
              if Is_Itype (Comp)
                and then Is_Type (Scope (Comp))
                and then Is_Composite_Type (Comp)
*************** package body Freeze is
*** 1757,1776 ****
                    S : Entity_Id := Scope (Rec);
  
                 begin
!                   --  We have a pretty bad kludge here.  Suppose Rec is a
                    --  subtype being defined in a subprogram that's created
!                   --  as part of the freezing of Rec'Base.  In that case,
                    --  we know that Comp'Base must have already been frozen by
                    --  the time we get to elaborate this because Gigi doesn't
                    --  elaborate any bodies until it has elaborated all of the
!                   --  declarative part.  But Is_Frozen will not be  set at this
                    --  point because we are processing code in lexical order.
  
                    --  We detect this case by going up the Scope chain of
                    --  Rec and seeing if we have a subprogram scope before
                    --  reaching the top of the scope chain or that of Comp'Base.
                    --  If we do, then mark that Comp'Base will actually be
!                   --  frozen.  If so, we merely undelay it.
                    while Present (S) loop
                       if Is_Subprogram (S) then
                          Will_Be_Frozen := True;
--- 1764,1784 ----
                    S : Entity_Id := Scope (Rec);
  
                 begin
!                   --  We have a pretty bad kludge here. Suppose Rec is a
                    --  subtype being defined in a subprogram that's created
!                   --  as part of the freezing of Rec'Base. In that case,
                    --  we know that Comp'Base must have already been frozen by
                    --  the time we get to elaborate this because Gigi doesn't
                    --  elaborate any bodies until it has elaborated all of the
!                   --  declarative part. But Is_Frozen will not be  set at this
                    --  point because we are processing code in lexical order.
  
                    --  We detect this case by going up the Scope chain of
                    --  Rec and seeing if we have a subprogram scope before
                    --  reaching the top of the scope chain or that of Comp'Base.
                    --  If we do, then mark that Comp'Base will actually be
!                   --  frozen. If so, we merely undelay it.
! 
                    while Present (S) loop
                       if Is_Subprogram (S) then
                          Will_Be_Frozen := True;
*************** package body Freeze is
*** 1798,1813 ****
                    end if;
                 end;
  
!             --  If the component is an access type with an allocator
!             --  as default value, the designated type will be frozen
!             --  by the corresponding expression in init_proc. In  order
!             --  to place the freeze node for the designated type before
!             --  that for the current record type, freeze it now.
  
              --  Same process if the component is an array of access types,
              --  initialized with an aggregate. If the designated type is
!             --  private, it cannot contain allocators, and it is premature
!             --  to freeze the type, so we check for this as well.
  
              elsif Is_Access_Type (Etype (Comp))
                and then Present (Parent (Comp))
--- 1806,1821 ----
                    end if;
                 end;
  
!             --  If the component is an access type with an allocator as
!             --  default value, the designated type will be frozen by the
!             --  corresponding expression in init_proc. In order to place the
!             --  freeze node for the designated type before that for the
!             --  current record type, freeze it now.
  
              --  Same process if the component is an array of access types,
              --  initialized with an aggregate. If the designated type is
!             --  private, it cannot contain allocators, and it is premature to
!             --  freeze the type, so we check for this as well.
  
              elsif Is_Access_Type (Etype (Comp))
                and then Present (Parent (Comp))
*************** package body Freeze is
*** 1967,1975 ****
     --  Start of processing for Freeze_Entity
  
     begin
!       --  We are going to test for various reasons why this entity need
!       --  not be frozen here, but in the case of an Itype that's defined
!       --  within a record, that test actually applies to the record.
        if Is_Itype (E) and then Is_Record_Type (Scope (E)) then
           Test_E := Scope (E);
        elsif Is_Itype (E) and then Present (Underlying_Type (Scope (E)))
--- 1975,1984 ----
     --  Start of processing for Freeze_Entity
  
     begin
!       --  We are going to test for various reasons why this entity need not be
!       --  frozen here, but in the case of an Itype that's defined within a
!       --  record, that test actually applies to the record.
! 
        if Is_Itype (E) and then Is_Record_Type (Scope (E)) then
           Test_E := Scope (E);
        elsif Is_Itype (E) and then Present (Underlying_Type (Scope (E)))
*************** package body Freeze is
*** 1983,1992 ****
        if Is_Frozen (E) then
           return No_List;
  
!       --  It is improper to freeze an external entity within a generic
!       --  because its freeze node will appear in a non-valid context.
!       --  The entity will be frozen in the proper scope after the current
!       --  generic is analyzed.
  
        elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
           return No_List;
--- 1992,2000 ----
        if Is_Frozen (E) then
           return No_List;
  
!       --  It is improper to freeze an external entity within a generic because
!       --  its freeze node will appear in a non-valid context. The entity will
!       --  be frozen in the proper scope after the current generic is analyzed.
  
        elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
           return No_List;
*************** package body Freeze is
*** 2040,2045 ****
--- 2048,2054 ----
        then
           declare
              S : Entity_Id := Scope (Test_E);
+ 
           begin
              while Present (S) loop
                 if Is_Generic_Instance (S) then
*************** package body Freeze is
*** 2225,2230 ****
--- 2234,2268 ----
                          Error_Msg_Qual_Level := 0;
                       end if;
  
+                      --  Ada 2005 (AI-326): Check wrong use of tag incomplete
+                      --  types with unknown discriminants. For example:
+ 
+                      --    type T (<>) is tagged;
+                      --    procedure P (X : access T); -- ERROR
+                      --    procedure P (X : T);        -- ERROR
+ 
+                      if not From_With_Type (F_Type) then
+                         if Is_Access_Type (F_Type) then
+                            F_Type := Designated_Type (F_Type);
+                         end if;
+ 
+                         if Ekind (F_Type) = E_Incomplete_Type
+                           and then Is_Tagged_Type (F_Type)
+                           and then not Is_Class_Wide_Type (F_Type)
+                           and then No (Full_View (F_Type))
+                           and then Unknown_Discriminants_Present
+                                      (Parent (F_Type))
+                           and then No (Stored_Constraint (F_Type))
+                         then
+                            Error_Msg_N
+                              ("(Ada 2005): invalid use of unconstrained tagged"
+                               & " incomplete type", E);
+ 
+                         elsif Ekind (F_Type) = E_Subprogram_Type then
+                            Freeze_And_Append (F_Type, Loc, Result);
+                         end if;
+                      end if;
+ 
                       Next_Formal (Formal);
                    end loop;
  
*************** package body Freeze is
*** 2249,2254 ****
--- 2287,2306 ----
                          Error_Msg_N
                            ("?foreign convention function& should not " &
                             "return unconstrained array", E);
+ 
+                      --  Ada 2005 (AI-326): Check wrong use of tagged
+                      --  incomplete type
+                      --
+                      --    type T is tagged;
+                      --    function F (X : Boolean) return T; -- ERROR
+ 
+                      elsif Ekind (Etype (E)) = E_Incomplete_Type
+                        and then Is_Tagged_Type (Etype (E))
+                        and then No (Full_View (Etype (E)))
+                      then
+                         Error_Msg_N
+                           ("(Ada 2005): invalid use of tagged incomplete type",
+                            E);
                       end if;
                    end if;
                 end;
*************** package body Freeze is
*** 2938,2952 ****
  
              Freeze_Subprogram (E);
  
           --  For access to a protected subprogram, freeze the equivalent
!          --  type (however this is not set if we are not generating code)
           --  or if this is an anonymous type used just for resolution).
  
!          elsif Ekind (E) = E_Access_Protected_Subprogram_Type
!            and then Operating_Mode = Generate_Code
!            and then Present (Equivalent_Type (E))
!          then
!             Freeze_And_Append (Equivalent_Type (E), Loc, Result);
           end if;
  
           --  Generic types are never seen by the back-end, and are also not
--- 2990,3042 ----
  
              Freeze_Subprogram (E);
  
+             --  AI-326: Check wrong use of tag incomplete type
+             --
+             --    type T is tagged;
+             --    type Acc is access function (X : T) return T; -- ERROR
+ 
+             if Ekind (Etype (E)) = E_Incomplete_Type
+               and then Is_Tagged_Type (Etype (E))
+               and then No (Full_View (Etype (E)))
+             then
+                Error_Msg_N
+                  ("(Ada 2005): invalid use of tagged incomplete type", E);
+             end if;
+ 
           --  For access to a protected subprogram, freeze the equivalent
!          --  type (however this is not set if we are not generating code
           --  or if this is an anonymous type used just for resolution).
  
!          elsif Ekind (E) = E_Access_Protected_Subprogram_Type then
! 
!             --  AI-326: Check wrong use of tagged incomplete types
! 
!             --    type T is tagged;
!             --    type As3D is access protected
!             --      function (X : Float) return T; -- ERROR
! 
!             declare
!                Etyp : Entity_Id;
! 
!             begin
!                Etyp := Etype (Directly_Designated_Type (E));
! 
!                if Is_Class_Wide_Type (Etyp) then
!                   Etyp := Etype (Etyp);
!                end if;
! 
!                if Ekind (Etyp) = E_Incomplete_Type
!                  and then Is_Tagged_Type (Etyp)
!                  and then No (Full_View (Etyp))
!                then
!                   Error_Msg_N
!                     ("(Ada 2005): invalid use of tagged incomplete type", E);
!                end if;
!             end;
! 
!             if Present (Equivalent_Type (E)) then
!                Freeze_And_Append (Equivalent_Type (E), Loc, Result);
!             end if;
           end if;
  
           --  Generic types are never seen by the back-end, and are also not
*************** package body Freeze is
*** 3000,3025 ****
           elsif Is_Integer_Type (E) then
              Adjust_Esize_For_Alignment (E);
  
!          elsif Is_Access_Type (E)
!            and then No (Associated_Storage_Pool (E))
!          then
!             Check_Restriction (No_Standard_Storage_Pools, E);
           end if;
  
           if Is_Composite_Type (E) then
  
!             --  AI-117 requires that all new primitives of a tagged type
!             --  must inherit the convention of the full view of the type.
!             --  Inherited and overriding operations are defined to inherit
!             --  the convention of their parent or overridden subprogram
!             --  (also specified in AI-117), and that will have occurred
!             --  earlier (in Derive_Subprogram and New_Overloaded_Entity).
!             --  Here we set the convention of primitives that are still
!             --  convention Ada, which will ensure that any new primitives
!             --  inherit the type's convention. Class-wide types can have
!             --  a foreign convention inherited from their specific type,
!             --  but are excluded from this since they don't have any
!             --  associated primitives.
  
              if Is_Tagged_Type (E)
                and then not Is_Class_Wide_Type (E)
--- 3090,3129 ----
           elsif Is_Integer_Type (E) then
              Adjust_Esize_For_Alignment (E);
  
!          elsif Is_Access_Type (E) then
! 
!             --  Check restriction for standard storage pool
! 
!             if No (Associated_Storage_Pool (E)) then
!                Check_Restriction (No_Standard_Storage_Pools, E);
!             end if;
! 
!             --  Deal with error message for pure access type. This is not an
!             --  error in Ada 2005 if there is no pool (see AI-366).
! 
!             if Is_Pure_Unit_Access_Type (E)
!               and then (Ada_Version < Ada_05
!                         or else not No_Pool_Assigned (E))
!             then
!                Error_Msg_N ("named access type not allowed in pure unit", E);
!             end if;
           end if;
  
+          --  Case of composite types
+ 
           if Is_Composite_Type (E) then
  
!             --  AI-117 requires that all new primitives of a tagged type must
!             --  inherit the convention of the full view of the type. Inherited
!             --  and overriding operations are defined to inherit the convention
!             --  of their parent or overridden subprogram (also specified in
!             --  AI-117), and that will have occurred earlier (in
!             --  Derive_Subprogram and New_Overloaded_Entity). Here we set the
!             --  convention of primitives that are still convention Ada, which
!             --  will ensure that any new primitives inherit the type's
!             --  convention. Class-wide types can have a foreign convention
!             --  inherited from their specific type, but are excluded from this
!             --  since they don't have any associated primitives.
  
              if Is_Tagged_Type (E)
                and then not Is_Class_Wide_Type (E)
*************** package body Freeze is
*** 3047,3065 ****
             and then not Is_Class_Wide_Type (E)
           then
              declare
!                Prim_List : constant Elist_Id := Primitive_Operations (E);
                 Prim      : Elmt_Id;
                 Ent       : Entity_Id;
  
              begin
                 Prim := First_Elmt (Prim_List);
                 while Present (Prim) loop
                    Ent := Node (Prim);
  
!                   --  If the operation is derived, get the original for
!                   --  cross-reference purposes (it is the original for
!                   --  which we want the xref, and for which the comes
!                   --  from source test needs to be performed).
  
                    while Present (Alias (Ent)) loop
                       Ent := Alias (Ent);
--- 3151,3191 ----
             and then not Is_Class_Wide_Type (E)
           then
              declare
!                Prim_List : Elist_Id;
                 Prim      : Elmt_Id;
                 Ent       : Entity_Id;
  
              begin
+                --  Ada 2005 (AI-345): In case of concurrent type generate
+                --  reference to the wrapper that allow us to dispatch calls
+                --  through their implemented abstract interface types.
+ 
+                --  The check for Present here is to protect against previously
+                --  reported critical errors.
+ 
+                if Is_Concurrent_Type (E)
+                  and then Present (Corresponding_Record_Type (E))
+                then
+                   pragma Assert (not Is_Empty_Elmt_List
+                                        (Abstract_Interfaces
+                                         (Corresponding_Record_Type (E))));
+ 
+                   Prim_List := Primitive_Operations
+                                 (Corresponding_Record_Type (E));
+                else
+                   Prim_List := Primitive_Operations (E);
+                end if;
+ 
+                --  Loop to generate references for primitive operations
+ 
                 Prim := First_Elmt (Prim_List);
                 while Present (Prim) loop
                    Ent := Node (Prim);
  
!                   --  If the operation is derived, get the original for cross-
!                   --  reference purposes (it is the original for which we want
!                   --  the xref, and for which the comes from source test needs
!                   --  to be performed).
  
                    while Present (Alias (Ent)) loop
                       Ent := Alias (Ent);
*************** package body Freeze is
*** 3239,3247 ****
              if Result = No_List then
                 Result := Empty_List;
              end if;
- 
-             Generate_Subprogram_Descriptor_For_Imported_Subprogram
-               (E, Result);
           end if;
        end if;
  
--- 3365,3370 ----
*************** package body Freeze is
*** 3286,3292 ****
  
        function In_Exp_Body (N : Node_Id) return Boolean;
        --  Given an N_Handled_Sequence_Of_Statements node N, determines whether
!       --  it is the handled statement sequence of an expander generated
        --  subprogram (init proc, or stream subprogram). If so, it returns
        --  True, otherwise False.
  
--- 3409,3415 ----
  
        function In_Exp_Body (N : Node_Id) return Boolean;
        --  Given an N_Handled_Sequence_Of_Statements node N, determines whether
!       --  it is the handled statement sequence of an expander-generated
        --  subprogram (init proc, or stream subprogram). If so, it returns
        --  True, otherwise False.
  
*************** package body Freeze is
*** 3327,3336 ****
     --  Start of processing for Freeze_Expression
  
     begin
!       --  Immediate return if freezing is inhibited. This flag is set by
!       --  the analyzer to stop freezing on generated expressions that would
!       --  cause freezing if they were in the source program, but which are
!       --  not supposed to freeze, since they are created.
  
        if Must_Not_Freeze (N) then
           return;
--- 3450,3459 ----
     --  Start of processing for Freeze_Expression
  
     begin
!       --  Immediate return if freezing is inhibited. This flag is set by the
!       --  analyzer to stop freezing on generated expressions that would cause
!       --  freezing if they were in the source program, but which are not
!       --  supposed to freeze, since they are created.
  
        if Must_Not_Freeze (N) then
           return;
*************** package body Freeze is
*** 3384,3390 ****
           Nam := Empty;
        end if;
  
!       --  For an allocator freeze designated type if not frozen already.
  
        --  For an aggregate whose component type is an access type, freeze
        --  the designated type now, so that its freeze  does not appear within
--- 3507,3513 ----
           Nam := Empty;
        end if;
  
!       --  For an allocator freeze designated type if not frozen already
  
        --  For an aggregate whose component type is an access type, freeze
        --  the designated type now, so that its freeze  does not appear within
*************** package body Freeze is
*** 3458,3469 ****
  
           case Nkind (Parent_P) is
  
!             --  A special test for the exception of (RM 13.14(8)) for the
!             --  case of per-object expressions (RM 3.8(18)) occurring in a
!             --  component definition or a discrete subtype definition. Note
!             --  that we test for a component declaration which includes both
!             --  cases we are interested in, and furthermore the tree does not
!             --  have explicit nodes for either of these two constructs.
  
              when N_Component_Declaration =>
  
--- 3581,3592 ----
  
           case Nkind (Parent_P) is
  
!             --  A special test for the exception of (RM 13.14(8)) for the case
!             --  of per-object expressions (RM 3.8(18)) occurring in component
!             --  definition or a discrete subtype definition. Note that we test
!             --  for a component declaration which includes both cases we are
!             --  interested in, and furthermore the tree does not have explicit
!             --  nodes for either of these two constructs.
  
              when N_Component_Declaration =>
  
*************** package body Freeze is
*** 3494,3502 ****
                    end if;
                 end if;
  
!             --  If we have an enumeration literal that appears as the
!             --  choice in the aggregate of an enumeration representation
!             --  clause, then freezing does not occur (RM 13.14(10)).
  
              when N_Enumeration_Representation_Clause =>
  
--- 3617,3625 ----
                    end if;
                 end if;
  
!             --  If we have an enumeration literal that appears as the choice in
!             --  the aggregate of an enumeration representation clause, then
!             --  freezing does not occur (RM 13.14(10)).
  
              when N_Enumeration_Representation_Clause =>
  
*************** package body Freeze is
*** 3535,3545 ****
  
              when N_Handled_Sequence_Of_Statements =>
  
!                --  An exception occurs when the sequence of statements is
!                --  for an expander generated body that did not do the usual
!                --  freeze all operation. In this case we usually want to
!                --  freeze outside this body, not inside it, and we skip
!                --  past the subprogram body that we are inside.
  
                 if In_Exp_Body (Parent_P) then
  
--- 3658,3668 ----
  
              when N_Handled_Sequence_Of_Statements =>
  
!                --  An exception occurs when the sequence of statements is for
!                --  an expander generated body that did not do the usual freeze
!                --  all operation. In this case we usually want to freeze
!                --  outside this body, not inside it, and we skip past the
!                --  subprogram body that we are inside.
  
                 if In_Exp_Body (Parent_P) then
  
*************** package body Freeze is
*** 3621,3631 ****
  
              --  Note: The N_Loop_Statement is a special case. A type that
              --  appears in the source can never be frozen in a loop (this
!             --  occurs only because of a loop expanded by the expander),
!             --  so we keep on going. Otherwise we terminate the search.
!             --  Same is true of any entity which comes from source. (if they
!             --  have a predefined type, that type does not appear to come
!             --  from source, but the entity should not be frozen here).
  
              when N_Loop_Statement =>
                 exit when not Comes_From_Source (Etype (N))
--- 3744,3754 ----
  
              --  Note: The N_Loop_Statement is a special case. A type that
              --  appears in the source can never be frozen in a loop (this
!             --  occurs only because of a loop expanded by the expander), so we
!             --  keep on going. Otherwise we terminate the search. Same is true
!             --  of any entity which comes from source. (if they have a
!             --  predefined type, that type does not appear to come from source,
!             --  but the entity should not be frozen here).
  
              when N_Loop_Statement =>
                 exit when not Comes_From_Source (Etype (N))
*************** package body Freeze is
*** 3643,3655 ****
           P := Parent_P;
        end loop;
  
!       --  If the expression appears in a record or an initialization
!       --  procedure, the freeze nodes are collected and attached to
!       --  the current scope, to be inserted and analyzed on exit from
!       --  the scope, to insure that generated entities appear in the
!       --  correct scope. If the expression is a default for a discriminant
!       --  specification, the scope is still void. The expression can also
!       --  appear in the discriminant part of a private or concurrent type.
  
        --  The other case requiring this special handling is if we are in
        --  a default expression, since in that case we are about to freeze
--- 3766,3783 ----
           P := Parent_P;
        end loop;
  
!       --  If the expression appears in a record or an initialization procedure,
!       --  the freeze nodes are collected and attached to the current scope, to
!       --  be inserted and analyzed on exit from the scope, to insure that
!       --  generated entities appear in the correct scope. If the expression is
!       --  a default for a discriminant specification, the scope is still void.
!       --  The expression can also appear in the discriminant part of a private
!       --  or concurrent type.
! 
!       --  If the expression appears in a constrained subcomponent of an
!       --  enclosing record declaration, the freeze nodes must be attached to
!       --  the outer record type so they can eventually be placed in the
!       --  enclosing declaration list.
  
        --  The other case requiring this special handling is if we are in
        --  a default expression, since in that case we are about to freeze
*************** package body Freeze is
*** 3670,3675 ****
--- 3798,3804 ----
           declare
              Loc          : constant Source_Ptr := Sloc (Current_Scope);
              Freeze_Nodes : List_Id := No_List;
+             Pos          : Int := Scope_Stack.Last;
  
           begin
              if Present (Desig_Typ) then
*************** package body Freeze is
*** 3684,3699 ****
                 Freeze_And_Append (Nam, Loc, Freeze_Nodes);
              end if;
  
              if Is_Non_Empty_List (Freeze_Nodes) then
!                if No (Scope_Stack.Table
!                  (Scope_Stack.Last).Pending_Freeze_Actions)
!                then
!                   Scope_Stack.Table
!                     (Scope_Stack.Last).Pending_Freeze_Actions :=
                        Freeze_Nodes;
                 else
                    Append_List (Freeze_Nodes, Scope_Stack.Table
!                                    (Scope_Stack.Last).Pending_Freeze_Actions);
                 end if;
              end if;
           end;
--- 3813,3833 ----
                 Freeze_And_Append (Nam, Loc, Freeze_Nodes);
              end if;
  
+             --  The current scope may be that of a constrained component of
+             --  an enclosing record declaration, which is above the current
+             --  scope in the scope stack.
+ 
+             if Is_Record_Type (Scope (Current_Scope)) then
+                Pos := Pos - 1;
+             end if;
+ 
              if Is_Non_Empty_List (Freeze_Nodes) then
!                if No (Scope_Stack.Table (Pos).Pending_Freeze_Actions) then
!                   Scope_Stack.Table (Pos).Pending_Freeze_Actions :=
                        Freeze_Nodes;
                 else
                    Append_List (Freeze_Nodes, Scope_Stack.Table
!                                    (Pos).Pending_Freeze_Actions);
                 end if;
              end if;
           end;
*************** package body Freeze is
*** 3739,3753 ****
     -- Freeze_Fixed_Point_Type --
     -----------------------------
  
!    --  Certain fixed-point types and subtypes, including implicit base
!    --  types and declared first subtypes, have not yet set up a range.
!    --  This is because the range cannot be set until the Small and Size
!    --  values are known, and these are not known till the type is frozen.
  
!    --  To signal this case, Scalar_Range contains an unanalyzed syntactic
!    --  range whose bounds are unanalyzed real literals. This routine will
!    --  recognize this case, and transform this range node into a properly
!    --  typed range with properly analyzed and resolved values.
  
     procedure Freeze_Fixed_Point_Type (Typ : Entity_Id) is
        Rng   : constant Node_Id    := Scalar_Range (Typ);
--- 3873,3887 ----
     -- Freeze_Fixed_Point_Type --
     -----------------------------
  
!    --  Certain fixed-point types and subtypes, including implicit base types
!    --  and declared first subtypes, have not yet set up a range. This is
!    --  because the range cannot be set until the Small and Size values are
!    --  known, and these are not known till the type is frozen.
  
!    --  To signal this case, Scalar_Range contains an unanalyzed syntactic range
!    --  whose bounds are unanalyzed real literals. This routine will recognize
!    --  this case, and transform this range node into a properly typed range
!    --  with properly analyzed and resolved values.
  
     procedure Freeze_Fixed_Point_Type (Typ : Entity_Id) is
        Rng   : constant Node_Id    := Scalar_Range (Typ);
*************** package body Freeze is
*** 3871,3880 ****
              end if;
  
              --  Compute the fudged bounds. If the number is a model number,
!             --  then we do nothing to include it, but we are allowed to
!             --  backoff to the next adjacent model number when we exclude
!             --  it. If it is not a model number then we straddle the two
!             --  values with the model numbers on either side.
  
              Model_Num := UR_Trunc (Loval / Small) * Small;
  
--- 4005,4014 ----
              end if;
  
              --  Compute the fudged bounds. If the number is a model number,
!             --  then we do nothing to include it, but we are allowed to backoff
!             --  to the next adjacent model number when we exclude it. If it is
!             --  not a model number then we straddle the two values with the
!             --  model numbers on either side.
  
              Model_Num := UR_Trunc (Loval / Small) * Small;
  
*************** package body Freeze is
*** 4007,4034 ****
                    Actual_Hi   := Hival_Incl_EP;
                 end if;
  
!                --  One pathological case: normally we never fudge a low
!                --  bound down, since it would seem to increase the size
!                --  (if it has any effect), but for ranges containing a
!                --  single value, or no values, the high bound can be
!                --  small too large. Consider:
  
                 --    type t is delta 2.0**(-14)
                 --      range 131072.0 .. 0;
  
!                --  That lower bound is *just* outside the range of 32
!                --  bits, and does need fudging down in this case. Note
!                --  that the bounds will always have crossed here, since
!                --  the high bound will be fudged down if necessary, as
!                --  in the case of:
  
                 --    type t is delta 2.0**(-14)
                 --      range 131072.0 .. 131072.0;
  
!                --  So we can detect the situation by looking for crossed
!                --  bounds, and if the bounds are crossed, and the low
!                --  bound is greater than zero, we will always back it
!                --  off by small, since this is completely harmless.
  
                 if Actual_Lo > Actual_Hi then
                    if UR_Is_Positive (Actual_Lo) then
--- 4141,4166 ----
                    Actual_Hi   := Hival_Incl_EP;
                 end if;
  
!                --  One pathological case: normally we never fudge a low bound
!                --  down, since it would seem to increase the size (if it has
!                --  any effect), but for ranges containing single value, or no
!                --  values, the high bound can be small too large. Consider:
  
                 --    type t is delta 2.0**(-14)
                 --      range 131072.0 .. 0;
  
!                --  That lower bound is *just* outside the range of 32 bits, and
!                --  does need fudging down in this case. Note that the bounds
!                --  will always have crossed here, since the high bound will be
!                --  fudged down if necessary, as in the case of:
  
                 --    type t is delta 2.0**(-14)
                 --      range 131072.0 .. 131072.0;
  
!                --  So we detect the situation by looking for crossed bounds,
!                --  and if the bounds are crossed, and the low bound is greater
!                --  than zero, we will always back it off by small, since this
!                --  is completely harmless.
  
                 if Actual_Lo > Actual_Hi then
                    if UR_Is_Positive (Actual_Lo) then
*************** package body Freeze is
*** 4098,4106 ****
           Adjust_Esize_For_Alignment (Typ);
        end if;
  
!       --  If we have a base type, then expand the bounds so that they
!       --  extend to the full width of the allocated size in bits, to
!       --  avoid junk range checks on intermediate computations.
  
        if Base_Type (Typ) = Typ then
           Set_Realval (Lo, -(Small * (Uint_2 ** (Actual_Size - 1))));
--- 4230,4238 ----
           Adjust_Esize_For_Alignment (Typ);
        end if;
  
!       --  If we have a base type, then expand the bounds so that they extend to
!       --  the full width of the allocated size in bits, to avoid junk range
!       --  checks on intermediate computations.
  
        if Base_Type (Typ) = Typ then
           Set_Realval (Lo, -(Small * (Uint_2 ** (Actual_Size - 1))));
*************** package body Freeze is
*** 4114,4122 ****
        Set_Analyzed (Lo, False);
        Analyze (Lo);
  
!       --  Resolve with universal fixed if the base type, and the base
!       --  type if it is a subtype. Note we can't resolve the base type
!       --  with itself, that would be a reference before definition.
  
        if Typ = Btyp then
           Resolve (Lo, Universal_Fixed);
--- 4246,4254 ----
        Set_Analyzed (Lo, False);
        Analyze (Lo);
  
!       --  Resolve with universal fixed if the base type, and the base type if
!       --  it is a subtype. Note we can't resolve the base type with itself,
!       --  that would be a reference before definition.
  
        if Typ = Btyp then
           Resolve (Lo, Universal_Fixed);
*************** package body Freeze is
*** 4339,4348 ****
     begin
        Ensure_Type_Is_SA (Etype (E));
  
!       --  Reset True_Constant flag, since something strange is going on
!       --  with the scoping here, and our simple value tracing may not
!       --  be sufficient for this indication to be reliable. We kill the
!       --  Constant_Value indication for the same reason.
  
        Set_Is_True_Constant (E, False);
        Set_Current_Value    (E, Empty);
--- 4471,4480 ----
     begin
        Ensure_Type_Is_SA (Etype (E));
  
!       --  Reset True_Constant flag, since something strange is going on with
!       --  the scoping here, and our simple value tracing may not be sufficient
!       --  for this indication to be reliable. We kill the Constant_Value
!       --  indication for the same reason.
  
        Set_Is_True_Constant (E, False);
        Set_Current_Value    (E, Empty);
*************** package body Freeze is
*** 4390,4398 ****
        --  Reset the Pure indication on an imported subprogram unless an
        --  explicit Pure_Function pragma was present. We do this because
        --  otherwise it is an insidious error to call a non-pure function
!       --  from a pure unit and have calls mysteriously optimized away.
!       --  What happens here is that the Import can bypass the normal
!       --  check to ensure that pure units call only pure subprograms.
  
        if Is_Imported (E)
          and then Is_Pure (E)
--- 4522,4530 ----
        --  Reset the Pure indication on an imported subprogram unless an
        --  explicit Pure_Function pragma was present. We do this because
        --  otherwise it is an insidious error to call a non-pure function
!       --  from pure unit and have calls mysteriously optimized away. What
!       --  happens here is that the Import can bypass the normal check to
!       --  ensure that pure units call only pure subprograms.
  
        if Is_Imported (E)
          and then Is_Pure (E)
*************** package body Freeze is
*** 4443,4450 ****
                 null;
  
              --  If the return type is generic, we have emitted a warning
!             --  earlier on, and there is nothing else to check here.
!             --  Specific instantiations may lead to erroneous behavior.
  
              elsif Is_Generic_Type (Etype (E)) then
                 null;
--- 4575,4582 ----
                 null;
  
              --  If the return type is generic, we have emitted a warning
!             --  earlier on, and there is nothing else to check here. Specific
!             --  instantiations may lead to erroneous behavior.
  
              elsif Is_Generic_Type (Etype (E)) then
                 null;
*************** package body Freeze is
*** 4462,4469 ****
           end if;
  
           --  If any of the formals for an exported foreign convention
!          --  subprogram have defaults, then emit an appropriate warning
!          --  since this is odd (default cannot be used from non-Ada code)
  
           if Is_Exported (E) then
              F := First_Formal (E);
--- 4594,4601 ----
           end if;
  
           --  If any of the formals for an exported foreign convention
!          --  subprogram have defaults, then emit an appropriate warning since
!          --  this is odd (default cannot be used from non-Ada code)
  
           if Is_Exported (E) then
              F := First_Formal (E);
*************** package body Freeze is
*** 4499,4504 ****
--- 4631,4647 ----
              end loop;
           end if;
        end if;
+ 
+       --  Pragma Inline_Always is disallowed for dispatching subprograms
+       --  because the address of such subprograms is saved in the dispatch
+       --  table to support dispatching calls, and dispatching calls cannot
+       --  be inlined. This is consistent with the restriction against using
+       --  'Access or 'Address on an Inline_Always subprogram.
+ 
+       if Is_Dispatching_Operation (E) and then Is_Always_Inlined (E) then
+          Error_Msg_N
+            ("pragma Inline_Always not allowed for dispatching subprograms", E);
+       end if;
     end Freeze_Subprogram;
  
     ----------------------
*************** package body Freeze is
*** 4784,4796 ****
        --  Full_View or Corresponding_Record_Type to have one either.
  
        --  ??? Fundamentally, this whole handling is a kludge. What we really
!       --  want is to be sure that for an Itype that's part of record R and
!       --  is a subtype of type T, that it's frozen after the later of the
!       --  freeze points of R and T.  We have no way of doing that directly,
!       --  so what we do is force most such Itypes to be frozen as part of
!       --  freezing R via this procedure and only delay the ones that need
!       --  to be delayed (mostly the designated types of access types that are
!       --  defined as part of the record).
  
        if Is_Private_Type (T)
          and then Present (Full_View (T))
--- 4927,4939 ----
        --  Full_View or Corresponding_Record_Type to have one either.
  
        --  ??? Fundamentally, this whole handling is a kludge. What we really
!       --  want is to be sure that for an Itype that's part of record R and is
!       --  a subtype of type T, that it's frozen after the later of the freeze
!       --  points of R and T. We have no way of doing that directly, so what we
!       --  do is force most such Itypes to be frozen as part of freezing R via
!       --  this procedure and only delay the ones that need to be delayed
!       --  (mostly the designated types of access types that are defined as
!       --  part of the record).
  
        if Is_Private_Type (T)
          and then Present (Full_View (T))
*************** package body Freeze is
*** 4819,4825 ****
        Nam  : Entity_Id)
     is
        Ent : constant Entity_Id := Entity (Nam);
!       --  The object to which the address clause applies.
  
        Init : Node_Id;
        Old  : Entity_Id := Empty;
--- 4962,4968 ----
        Nam  : Entity_Id)
     is
        Ent : constant Entity_Id := Entity (Nam);
!       --  The object to which the address clause applies
  
        Init : Node_Id;
        Old  : Entity_Id := Empty;
*************** package body Freeze is
*** 4840,4848 ****
           return;
        end if;
  
!       --  We only give the warning for non-imported entities of a type
!       --  for which a non-null base init proc is defined (or for access
!       --  types which have implicit null initialization).
  
        if Present (Expr)
          and then (Has_Non_Null_Base_Init_Proc (Typ)
--- 4983,4991 ----
           return;
        end if;
  
!       --  We only give the warning for non-imported entities of a type for
!       --  which a non-null base init proc is defined (or for access types which
!       --  have implicit null initialization).
  
        if Present (Expr)
          and then (Has_Non_Null_Base_Init_Proc (Typ)
diff -Nrcpad gcc-4.0.2/gcc/ada/freeze.ads gcc-4.1.0/gcc/ada/freeze.ads
*** gcc-4.0.2/gcc/ada/freeze.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/freeze.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Freeze is
*** 199,205 ****
     --  frozen entities.
  
     procedure Freeze_Before (N : Node_Id; T : Entity_Id);
!    --  Freeze T then Insert the generated Freeze nodes before the node N.
  
     procedure Freeze_Expression (N : Node_Id);
     --  Freezes the required entities when the Expression N causes freezing.
--- 199,205 ----
     --  frozen entities.
  
     procedure Freeze_Before (N : Node_Id; T : Entity_Id);
!    --  Freeze T then Insert the generated Freeze nodes before the node N
  
     procedure Freeze_Expression (N : Node_Id);
     --  Freezes the required entities when the Expression N causes freezing.
diff -Nrcpad gcc-4.0.2/gcc/ada/frontend.adb gcc-4.1.0/gcc/ada/frontend.adb
*** gcc-4.0.2/gcc/ada/frontend.adb	Mon May 10 16:18:52 2004
--- gcc-4.1.0/gcc/ada/frontend.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Checks;
*** 31,37 ****
  with CStand;
  with Debug;    use Debug;
  with Elists;
- with Exp_Ch11;
  with Exp_Dbug;
  with Fmap;
  with Fname.UF;
--- 31,36 ----
*************** begin
*** 80,86 ****
     Lib.Load.Initialize;
     Sem_Ch8.Initialize;
     Fname.UF.Initialize;
-    Exp_Ch11.Initialize;
     Checks.Initialize;
  
     --  Create package Standard
--- 79,84 ----
*************** begin
*** 329,339 ****
              end if;
  
              Check_Elab_Calls;
- 
-             --  Build unit exception table. We leave this up to the end to
-             --  make sure that all the necessary information is at hand.
- 
-             Exp_Ch11.Generate_Unit_Exception_Table;
           end if;
  
           --  List library units if requested
--- 327,332 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/frontend.ads gcc-4.1.0/gcc/ada/frontend.ads
*** gcc-4.0.2/gcc/ada/frontend.ads	Thu Apr 24 17:54:02 2003
--- gcc-4.1.0/gcc/ada/frontend.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-arrspl.adb gcc-4.1.0/gcc/ada/g-arrspl.adb
*** gcc-4.0.2/gcc/ada/g-arrspl.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-arrspl.adb	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --                      G N A T . A R R A Y _ S P I T                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
--- 2,12 ----
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --                     G N A T . A R R A Y _ S P L I T                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Array_Split is
*** 43,50 ****
  
     function Count
       (Source  : Element_Sequence;
!       Pattern : Element_Set)
!       return    Natural;
     --  Returns the number of occurences of Pattern elements in Source, 0 is
     --  returned if no occurence is found in Source.
  
--- 43,49 ----
  
     function Count
       (Source  : Element_Sequence;
!       Pattern : Element_Set) return Natural;
     --  Returns the number of occurences of Pattern elements in Source, 0 is
     --  returned if no occurence is found in Source.
  
*************** package body GNAT.Array_Split is
*** 92,99 ****
  
     function Count
       (Source  : Element_Sequence;
!       Pattern : Element_Set)
!       return    Natural
     is
        C : Natural := 0;
     begin
--- 91,97 ----
  
     function Count
       (Source  : Element_Sequence;
!       Pattern : Element_Set) return Natural
     is
        C : Natural := 0;
     begin
*************** package body GNAT.Array_Split is
*** 144,151 ****
  
     function Separators
       (S     : Slice_Set;
!       Index : Slice_Number)
!       return  Slice_Separators
     is
     begin
        if Index > S.N_Slice then
--- 142,148 ----
  
     function Separators
       (S     : Slice_Set;
!       Index : Slice_Number) return Slice_Separators
     is
     begin
        if Index > S.N_Slice then
*************** package body GNAT.Array_Split is
*** 154,160 ****
        elsif Index = 0
          or else (Index = 1 and then S.N_Slice = 1)
        then
!          --  Whole string, or no separator used.
  
           return (Before => Array_End,
                   After  => Array_End);
--- 151,157 ----
        elsif Index = 0
          or else (Index = 1 and then S.N_Slice = 1)
        then
!          --  Whole string, or no separator used
  
           return (Before => Array_End,
                   After  => Array_End);
*************** package body GNAT.Array_Split is
*** 238,245 ****
  
           loop
              if K > Count_Sep then
!                --  No more separator, last slice end at the end of the source
                 --  string.
                 Stop := S.Source'Last;
              else
                 Stop := S.Indexes (K) - 1;
--- 235,244 ----
  
           loop
              if K > Count_Sep then
! 
!                --  No more separators, last slice ends at the end of the source
                 --  string.
+ 
                 Stop := S.Source'Last;
              else
                 Stop := S.Indexes (K) - 1;
*************** package body GNAT.Array_Split is
*** 255,267 ****
              case Mode is
  
                 when Single =>
                    --  In this mode just set start to character next to the
                    --  current separator, advance the separator index.
                    Start := S.Indexes (K) + 1;
                    K := K + 1;
  
                 when Multiple =>
!                   --  In this mode skip separators following each others
                    loop
                       Start := S.Indexes (K) + 1;
                       K := K + 1;
--- 254,270 ----
              case Mode is
  
                 when Single =>
+ 
                    --  In this mode just set start to character next to the
                    --  current separator, advance the separator index.
+ 
                    Start := S.Indexes (K) + 1;
                    K := K + 1;
  
                 when Multiple =>
! 
!                   --  In this mode skip separators following each other
! 
                    loop
                       Start := S.Indexes (K) + 1;
                       K := K + 1;
*************** package body GNAT.Array_Split is
*** 282,289 ****
  
     function Slice
       (S     : Slice_Set;
!       Index : Slice_Number)
!       return Element_Sequence
     is
     begin
        if Index = 0 then
--- 285,291 ----
  
     function Slice
       (S     : Slice_Set;
!       Index : Slice_Number) return Element_Sequence
     is
     begin
        if Index = 0 then
diff -Nrcpad gcc-4.0.2/gcc/ada/g-arrspl.ads gcc-4.1.0/gcc/ada/g-arrspl.ads
*** gcc-4.0.2/gcc/ada/g-arrspl.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-arrspl.ads	Tue Nov 15 14:06:45 2005
***************
*** 2,12 ****
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --                      G N A T . A R R A Y _ S P L T                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          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- --
--- 2,12 ----
  --                                                                          --
  --                         GNAT COMPILER COMPONENTS                         --
  --                                                                          --
! --                     G N A T . A R R A Y _ S P L I T                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 42,48 ****
     --  Element of the array, this must be a discrete type
  
     type Element_Sequence is array (Positive range <>) of Element;
!    --  The array which is a sequence of element.
  
     type Element_Set is private;
     --  This type represent a set of elements. This set does not defined a
--- 42,48 ----
     --  Element of the array, this must be a discrete type
  
     type Element_Sequence is array (Positive range <>) of Element;
!    --  The array which is a sequence of element
  
     type Element_Set is private;
     --  This type represent a set of elements. This set does not defined a
*************** package GNAT.Array_Split is
*** 120,127 ****
  
     function Slice
       (S     : Slice_Set;
!       Index : Slice_Number)
!       return  Element_Sequence;
     pragma Inline (Slice);
     --  Returns the slice at position Index. First slice is 1. If Index is 0
     --  the whole array is returned including the separators (this is the
--- 120,126 ----
  
     function Slice
       (S     : Slice_Set;
!       Index : Slice_Number) return Element_Sequence;
     pragma Inline (Slice);
     --  Returns the slice at position Index. First slice is 1. If Index is 0
     --  the whole array is returned including the separators (this is the
*************** package GNAT.Array_Split is
*** 138,145 ****
  
     function Separators
       (S     : Slice_Set;
!       Index : Slice_Number)
!       return  Slice_Separators;
     --  Returns the separators used to slice (front and back) the slice at
     --  position Index. For slices at start and end of the original array, the
     --  Array_End value is returned for the corresponding outer bound. In
--- 137,143 ----
  
     function Separators
       (S     : Slice_Set;
!       Index : Slice_Number) return Slice_Separators;
     --  Returns the separators used to slice (front and back) the slice at
     --  position Index. For slices at start and end of the original array, the
     --  Array_End value is returned for the corresponding outer bound. In
*************** private
*** 165,171 ****
        Start : Positive;
        Stop  : Natural;
     end record;
!    --  Starting/Ending position of a slice. This does not include separators.
  
     type Slices_Indexes is array (Slice_Number range <>) of Slice_Info;
     type Slices_Access is access Slices_Indexes;
--- 163,169 ----
        Start : Positive;
        Stop  : Natural;
     end record;
!    --  Starting/Ending position of a slice. This does not include separators
  
     type Slices_Indexes is array (Slice_Number range <>) of Slice_Info;
     type Slices_Access is access Slices_Indexes;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-awk.adb gcc-4.1.0/gcc/ada/g-awk.adb
*** gcc-4.0.2/gcc/ada/g-awk.adb	Wed Dec  3 11:47:52 2003
--- gcc-4.1.0/gcc/ada/g-awk.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.AWK is
*** 65,71 ****
  
        procedure Current_Line (S : Mode; Session : Session_Type)
          is abstract;
!       --  Split Session's current line using split mode.
  
        ------------------------
        -- Split on separator --
--- 65,71 ----
  
        procedure Current_Line (S : Mode; Session : Session_Type)
          is abstract;
!       --  Split current line of Session using split mode S
  
        ------------------------
        -- Split on separator --
*************** package body GNAT.AWK is
*** 102,108 ****
  
     package File_Table is
        new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
!    --  List of filename associated with a Session.
  
     procedure Free is new Unchecked_Deallocation (String, AWK_File);
  
--- 102,108 ----
  
     package File_Table is
        new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
!    --  List of file names associated with a Session
  
     procedure Free is new Unchecked_Deallocation (String, AWK_File);
  
*************** package body GNAT.AWK is
*** 114,130 ****
        First : Positive;
        Last  : Natural;
     end record;
!    --  This is a field slice (First .. Last) in session's current line.
  
     package Field_Table is
        new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
!    --  List of fields for the current line.
  
     --------------
     -- Patterns --
     --------------
  
!    --  Define all patterns style : exact string, regular expression, boolean
     --  function.
  
     package Patterns is
--- 114,130 ----
        First : Positive;
        Last  : Natural;
     end record;
!    --  This is a field slice (First .. Last) in session's current line
  
     package Field_Table is
        new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
!    --  List of fields for the current line
  
     --------------
     -- Patterns --
     --------------
  
!    --  Define all patterns style: exact string, regular expression, boolean
     --  function.
  
     package Patterns is
*************** package body GNAT.AWK is
*** 137,149 ****
  
        function Match
          (P       : Pattern;
!          Session : Session_Type)
!          return    Boolean
        is abstract;
!       --  Returns True if P match for the current session and False otherwise.
  
        procedure Release (P : in out Pattern);
!       --  Release memory used by the pattern structure.
  
        --------------------------
        -- Exact string pattern --
--- 137,148 ----
  
        function Match
          (P       : Pattern;
!          Session : Session_Type) return Boolean
        is abstract;
!       --  Returns True if P match for the current session and False otherwise
  
        procedure Release (P : in out Pattern);
!       --  Release memory used by the pattern structure
  
        --------------------------
        -- Exact string pattern --
*************** package body GNAT.AWK is
*** 156,163 ****
  
        function Match
          (P       : String_Pattern;
!          Session : Session_Type)
!          return    Boolean;
  
        --------------------------------
        -- Regular expression pattern --
--- 155,161 ----
  
        function Match
          (P       : String_Pattern;
!          Session : Session_Type) return Boolean;
  
        --------------------------------
        -- Regular expression pattern --
*************** package body GNAT.AWK is
*** 172,179 ****
  
        function Match
          (P       : Regexp_Pattern;
!          Session : Session_Type)
!          return    Boolean;
  
        procedure Release (P : in out Regexp_Pattern);
  
--- 170,176 ----
  
        function Match
          (P       : Regexp_Pattern;
!          Session : Session_Type) return Boolean;
  
        procedure Release (P : in out Regexp_Pattern);
  
*************** package body GNAT.AWK is
*** 187,194 ****
  
        function Match
          (P       : Callback_Pattern;
!          Session : Session_Type)
!          return    Boolean;
  
     end Patterns;
  
--- 184,190 ----
  
        function Match
          (P       : Callback_Pattern;
!          Session : Session_Type) return Boolean;
  
     end Patterns;
  
*************** package body GNAT.AWK is
*** 211,219 ****
  
        procedure Call
          (A       : Action;
!          Session : Session_Type)
!          is abstract;
!       --  Call action A as required.
  
        -------------------
        -- Simple action --
--- 207,214 ----
  
        procedure Call
          (A       : Action;
!          Session : Session_Type) is abstract;
!       --  Call action A as required
  
        -------------------
        -- Simple action --
*************** package body GNAT.AWK is
*** 271,277 ****
        NR           : Natural := 0;
        FNR          : Natural := 0;
        Matches      : Regpat.Match_Array (0 .. 100);
!       --  latest matches for the regexp pattern
     end record;
  
     procedure Free is
--- 266,272 ----
        NR           : Natural := 0;
        FNR          : Natural := 0;
        Matches      : Regpat.Match_Array (0 .. 100);
!       --  Latest matches for the regexp pattern
     end record;
  
     procedure Free is
*************** package body GNAT.AWK is
*** 317,329 ****
  
     procedure Finalize (Session : in out Session_Type) is
     begin
!       --  We release the session data only if it is not the default session.
  
        if Session.Data /= Def_Session.Data then
           Free (Session.Data);
  
!          --  Since we have closed the current session, set it to point
!          --  now to the default session.
  
           Cur_Session.Data := Def_Session.Data;
        end if;
--- 312,324 ----
  
     procedure Finalize (Session : in out Session_Type) is
     begin
!       --  We release the session data only if it is not the default session
  
        if Session.Data /= Def_Session.Data then
           Free (Session.Data);
  
!          --  Since we have closed the current session, set it to point now to
!          --  the default session.
  
           Cur_Session.Data := Def_Session.Data;
        end if;
*************** package body GNAT.AWK is
*** 334,344 ****
     ----------------------
  
     function Always_True return Boolean;
!    --  A function that always returns True.
  
     function Apply_Filters
!      (Session : Session_Type := Current_Session)
!       return    Boolean;
     --  Apply any filters for which the Pattern is True for Session. It returns
     --  True if a least one filters has been applied (i.e. associated action
     --  callback has been called).
--- 329,338 ----
     ----------------------
  
     function Always_True return Boolean;
!    --  A function that always returns True
  
     function Apply_Filters
!      (Session : Session_Type := Current_Session) return Boolean;
     --  Apply any filters for which the Pattern is True for Session. It returns
     --  True if a least one filters has been applied (i.e. associated action
     --  callback has been called).
*************** package body GNAT.AWK is
*** 358,364 ****
     --  number and the filename if possible.
  
     procedure Read_Line (Session : Session_Type);
!    --  Read a line for the Session and set Current_Line.
  
     procedure Split_Line (Session : Session_Type);
     --  Split session's Current_Line according to the session separators and
--- 352,358 ----
     --  number and the filename if possible.
  
     procedure Read_Line (Session : Session_Type);
!    --  Read a line for the Session and set Current_Line
  
     procedure Split_Line (Session : Session_Type);
     --  Split session's Current_Line according to the session separators and
*************** package body GNAT.AWK is
*** 383,389 ****
           Session : Session_Type)
        is
           pragma Unreferenced (Session);
- 
        begin
           A.Proc.all;
        end Call;
--- 377,382 ----
*************** package body GNAT.AWK is
*** 414,421 ****
  
        function Match
          (P       : String_Pattern;
!          Session : Session_Type)
!          return    Boolean
        is
        begin
           return P.Str = Field (P.Rank, Session);
--- 407,413 ----
  
        function Match
          (P       : String_Pattern;
!          Session : Session_Type) return Boolean
        is
        begin
           return P.Str = Field (P.Rank, Session);
*************** package body GNAT.AWK is
*** 427,437 ****
  
        function Match
          (P       : Regexp_Pattern;
!          Session : Session_Type)
!          return    Boolean
        is
           use type Regpat.Match_Location;
- 
        begin
           Regpat.Match
             (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
--- 419,427 ----
  
        function Match
          (P       : Regexp_Pattern;
!          Session : Session_Type) return Boolean
        is
           use type Regpat.Match_Location;
        begin
           Regpat.Match
             (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
*************** package body GNAT.AWK is
*** 444,454 ****
  
        function Match
          (P       : Callback_Pattern;
!          Session : Session_Type)
!          return    Boolean
        is
           pragma Unreferenced (Session);
- 
        begin
           return P.Pattern.all;
        end Match;
--- 434,442 ----
  
        function Match
          (P       : Callback_Pattern;
!          Session : Session_Type) return Boolean
        is
           pragma Unreferenced (Session);
        begin
           return P.Pattern.all;
        end Match;
*************** package body GNAT.AWK is
*** 459,465 ****
  
        procedure Release (P : in out Pattern) is
           pragma Unreferenced (P);
- 
        begin
           null;
        end Release;
--- 447,452 ----
*************** package body GNAT.AWK is
*** 471,477 ****
        procedure Release (P : in out Regexp_Pattern) is
           procedure Free is new Unchecked_Deallocation
             (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
- 
        begin
           Free (P.Regx);
        end Release;
--- 458,463 ----
*************** package body GNAT.AWK is
*** 664,677 ****
     -------------------
  
     function Apply_Filters
!      (Session : Session_Type := Current_Session)
!       return    Boolean
     is
        Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
        Results : Boolean := False;
  
     begin
!       --  Iterate through the filters table, if pattern match call action.
  
        for F in 1 .. Pattern_Action_Table.Last (Filters) loop
           if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
--- 650,662 ----
     -------------------
  
     function Apply_Filters
!      (Session : Session_Type := Current_Session) return Boolean
     is
        Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
        Results : Boolean := False;
  
     begin
!       --  Iterate through the filters table, if pattern match call action
  
        for F in 1 .. Pattern_Action_Table.Last (Filters) loop
           if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
*************** package body GNAT.AWK is
*** 748,755 ****
  
     function Discrete_Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Discrete
     is
     begin
        return Discrete'Value (Field (Rank, Session));
--- 733,739 ----
  
     function Discrete_Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Discrete
     is
     begin
        return Discrete'Value (Field (Rank, Session));
*************** package body GNAT.AWK is
*** 760,767 ****
     -----------------
  
     function End_Of_Data
!      (Session : Session_Type := Current_Session)
!       return    Boolean
     is
     begin
        return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
--- 744,750 ----
     -----------------
  
     function End_Of_Data
!      (Session : Session_Type := Current_Session) return Boolean
     is
     begin
        return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
*************** package body GNAT.AWK is
*** 773,780 ****
     -----------------
  
     function End_Of_File
!      (Session : Session_Type := Current_Session)
!       return    Boolean
     is
     begin
        return Text_IO.End_Of_File (Session.Data.Current_File);
--- 756,762 ----
     -----------------
  
     function End_Of_File
!      (Session : Session_Type := Current_Session) return Boolean
     is
     begin
        return Text_IO.End_Of_File (Session.Data.Current_File);
*************** package body GNAT.AWK is
*** 786,793 ****
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    String
     is
        Fields : Field_Table.Instance renames Session.Data.Fields;
  
--- 768,774 ----
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return String
     is
        Fields : Field_Table.Instance renames Session.Data.Fields;
  
*************** package body GNAT.AWK is
*** 800,806 ****
  
        elsif Rank = 0 then
  
!          --  Returns the whole line, this is what $0 does under Session_Type.
  
           return To_String (Session.Data.Current_Line);
  
--- 781,787 ----
  
        elsif Rank = 0 then
  
!          --  Returns the whole line, this is what $0 does under Session_Type
  
           return To_String (Session.Data.Current_Line);
  
*************** package body GNAT.AWK is
*** 813,820 ****
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Integer
     is
     begin
        return Integer'Value (Field (Rank, Session));
--- 794,800 ----
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Integer
     is
     begin
        return Integer'Value (Field (Rank, Session));
*************** package body GNAT.AWK is
*** 830,837 ****
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Float
     is
     begin
        return Float'Value (Field (Rank, Session));
--- 810,816 ----
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Float
     is
     begin
        return Float'Value (Field (Rank, Session));
*************** package body GNAT.AWK is
*** 850,857 ****
     ----------
  
     function File
!      (Session : Session_Type := Current_Session)
!       return    String
     is
        Files : File_Table.Instance renames Session.Data.Files;
  
--- 829,835 ----
     ----------
  
     function File
!      (Session : Session_Type := Current_Session) return String
     is
        Files : File_Table.Instance renames Session.Data.Files;
  
*************** package body GNAT.AWK is
*** 942,949 ****
     ----------------------
  
     function Number_Of_Fields
!      (Session : Session_Type := Current_Session)
!       return    Count
     is
     begin
        return Count (Field_Table.Last (Session.Data.Fields));
--- 920,926 ----
     ----------------------
  
     function Number_Of_Fields
!      (Session : Session_Type := Current_Session) return Count
     is
     begin
        return Count (Field_Table.Last (Session.Data.Fields));
*************** package body GNAT.AWK is
*** 954,961 ****
     --------------------------
  
     function Number_Of_File_Lines
!      (Session : Session_Type := Current_Session)
!       return    Count
     is
     begin
        return Count (Session.Data.FNR);
--- 931,937 ----
     --------------------------
  
     function Number_Of_File_Lines
!      (Session : Session_Type := Current_Session) return Count
     is
     begin
        return Count (Session.Data.FNR);
*************** package body GNAT.AWK is
*** 966,976 ****
     ---------------------
  
     function Number_Of_Files
!      (Session : Session_Type := Current_Session)
!       return    Natural
     is
        Files : File_Table.Instance renames Session.Data.Files;
- 
     begin
        return File_Table.Last (Files);
     end Number_Of_Files;
--- 942,950 ----
     ---------------------
  
     function Number_Of_Files
!      (Session : Session_Type := Current_Session) return Natural
     is
        Files : File_Table.Instance renames Session.Data.Files;
     begin
        return File_Table.Last (Files);
     end Number_Of_Files;
*************** package body GNAT.AWK is
*** 980,987 ****
     ---------------------
  
     function Number_Of_Lines
!      (Session : Session_Type := Current_Session)
!       return    Count
     is
     begin
        return Count (Session.Data.NR);
--- 954,960 ----
     ---------------------
  
     function Number_Of_Lines
!      (Session : Session_Type := Current_Session) return Count
     is
     begin
        return Count (Session.Data.NR);
*************** package body GNAT.AWK is
*** 1078,1084 ****
        Session : Session_Type)
     is
        function Filename return String;
!       --  Returns current filename and "??" if the informations is not
        --  available.
  
        function Line return String;
--- 1051,1057 ----
        Session : Session_Type)
     is
        function Filename return String;
!       --  Returns current filename and "??" if this information is not
        --  available.
  
        function Line return String;
*************** package body GNAT.AWK is
*** 1090,1096 ****
  
        function Filename return String is
           File : constant String := AWK.File (Session);
- 
        begin
           if File = "" then
              return "??";
--- 1063,1068 ----
*************** package body GNAT.AWK is
*** 1105,1111 ****
  
        function Line return String is
           L : constant String := Natural'Image (Session.Data.FNR);
- 
        begin
           return L (2 .. L'Last);
        end Line;
--- 1077,1082 ----
*************** package body GNAT.AWK is
*** 1132,1137 ****
--- 1103,1112 ----
        NR  : Natural renames Session.Data.NR;
        FNR : Natural renames Session.Data.FNR;
  
+       ---------------
+       -- Read_Line --
+       ---------------
+ 
        function Read_Line return String is
           Buffer : String (1 .. 1_024);
           Last   : Natural;
*************** package body GNAT.AWK is
*** 1277,1284 ****
  
     procedure Set_Field_Widths
       (Field_Widths : Widths_Set;
!       Session      : Session_Type := Current_Session) is
! 
     begin
        Free (Session.Data.Separators);
  
--- 1252,1259 ----
  
     procedure Set_Field_Widths
       (Field_Widths : Widths_Set;
!       Session      : Session_Type := Current_Session)
!    is
     begin
        Free (Session.Data.Separators);
  
*************** package body GNAT.AWK is
*** 1299,1308 ****
  
     procedure Split_Line (Session : Session_Type) is
        Fields : Field_Table.Instance renames Session.Data.Fields;
- 
     begin
        Field_Table.Init (Fields);
- 
        Split.Current_Line (Session.Data.Separators.all, Session);
     end Split_Line;
  
--- 1274,1281 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-awk.ads gcc-4.1.0/gcc/ada/g-awk.ads
*** gcc-4.0.2/gcc/ada/g-awk.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-awk.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with GNAT.Regpat;
*** 187,217 ****
  package GNAT.AWK is
  
     Session_Error : exception;
!    --  Raised when a Session is reused but is not closed.
  
     File_Error : exception;
!    --  Raised when there is a file problem (see below).
  
     End_Error : exception;
     --  Raised when an attempt is made to read beyond the end of the last
     --  file of a session.
  
     Field_Error : exception;
!    --  Raised when accessing a field value which does not exist.
  
     Data_Error : exception;
!    --  Raised when it is not possible to convert a field value to a specific
!    --  type.
  
     type Count is new Natural;
  
     type Widths_Set is array (Positive range <>) of Positive;
!    --  Used to store a set of columns widths.
  
     Default_Separators : constant String := " " & ASCII.HT;
  
     Use_Current : constant String := "";
!    --  Value used when no separator or filename is specified in iterators.
  
     type Session_Type is limited private;
     --  This is the main exported type. A session is used to keep the state of
--- 187,216 ----
  package GNAT.AWK is
  
     Session_Error : exception;
!    --  Raised when a Session is reused but is not closed
  
     File_Error : exception;
!    --  Raised when there is a file problem (see below)
  
     End_Error : exception;
     --  Raised when an attempt is made to read beyond the end of the last
     --  file of a session.
  
     Field_Error : exception;
!    --  Raised when accessing a field value which does not exist
  
     Data_Error : exception;
!    --  Raised when it is impossible to convert a field value to a specific type
  
     type Count is new Natural;
  
     type Widths_Set is array (Positive range <>) of Positive;
!    --  Used to store a set of columns widths
  
     Default_Separators : constant String := " " & ASCII.HT;
  
     Use_Current : constant String := "";
!    --  Value used when no separator or filename is specified in iterators
  
     type Session_Type is limited private;
     --  This is the main exported type. A session is used to keep the state of
*************** package GNAT.AWK is
*** 256,262 ****
       (Separators : String       := Default_Separators;
        Session    : Session_Type := Current_Session)
       renames Set_Field_Separators;
!    --  FS is the AWK abbreviation for above service.
  
     procedure Set_Field_Widths
       (Field_Widths : Widths_Set;
--- 255,261 ----
       (Separators : String       := Default_Separators;
        Session    : Session_Type := Current_Session)
       renames Set_Field_Separators;
!    --  FS is the AWK abbreviation for above service
  
     procedure Set_Field_Widths
       (Field_Widths : Widths_Set;
*************** package GNAT.AWK is
*** 294,347 ****
     -------------------------------------
  
     function Number_Of_Fields
!      (Session : Session_Type := Current_Session)
!       return    Count;
     pragma Inline (Number_Of_Fields);
     --  Returns the number of fields in the current record. It returns 0 when
     --  no file is being processed.
  
     function NF
!      (Session : Session_Type := Current_Session)
!       return    Count
       renames Number_Of_Fields;
!    --  AWK abbreviation for above service.
  
     function Number_Of_File_Lines
!      (Session : Session_Type := Current_Session)
!       return    Count;
     pragma Inline (Number_Of_File_Lines);
     --  Returns the current line number in the processed file. It returns 0 when
     --  no file is being processed.
  
!    function FNR
!      (Session : Session_Type := Current_Session)
!       return    Count renames Number_Of_File_Lines;
!    --  AWK abbreviation for above service.
  
     function Number_Of_Lines
!      (Session : Session_Type := Current_Session)
!       return    Count;
     pragma Inline (Number_Of_Lines);
     --  Returns the number of line processed until now. This is equal to number
     --  of line in each already processed file plus FNR. It returns 0 when
     --  no file is being processed.
  
!    function NR
!      (Session : Session_Type := Current_Session)
!       return    Count
       renames Number_Of_Lines;
!    --  AWK abbreviation for above service.
  
     function Number_Of_Files
!      (Session : Session_Type := Current_Session)
!       return    Natural;
     pragma Inline (Number_Of_Files);
     --  Returns the number of files associated with Session. This is the total
     --  number of files added with Add_File and Add_Files services.
  
!    function File
!      (Session : Session_Type := Current_Session)
!       return    String;
     --  Returns the name of the file being processed. It returns the empty
     --  string when no file is being processed.
  
--- 293,336 ----
     -------------------------------------
  
     function Number_Of_Fields
!      (Session : Session_Type := Current_Session) return Count;
     pragma Inline (Number_Of_Fields);
     --  Returns the number of fields in the current record. It returns 0 when
     --  no file is being processed.
  
     function NF
!      (Session : Session_Type := Current_Session) return Count
       renames Number_Of_Fields;
!    --  AWK abbreviation for above service
  
     function Number_Of_File_Lines
!      (Session : Session_Type := Current_Session) return Count;
     pragma Inline (Number_Of_File_Lines);
     --  Returns the current line number in the processed file. It returns 0 when
     --  no file is being processed.
  
!    function FNR (Session : Session_Type := Current_Session) return Count
!      renames Number_Of_File_Lines;
!    --  AWK abbreviation for above service
  
     function Number_Of_Lines
!      (Session : Session_Type := Current_Session) return Count;
     pragma Inline (Number_Of_Lines);
     --  Returns the number of line processed until now. This is equal to number
     --  of line in each already processed file plus FNR. It returns 0 when
     --  no file is being processed.
  
!    function NR (Session : Session_Type := Current_Session) return Count
       renames Number_Of_Lines;
!    --  AWK abbreviation for above service
  
     function Number_Of_Files
!      (Session : Session_Type := Current_Session) return Natural;
     pragma Inline (Number_Of_Files);
     --  Returns the number of files associated with Session. This is the total
     --  number of files added with Add_File and Add_Files services.
  
!    function File (Session : Session_Type := Current_Session) return String;
     --  Returns the name of the file being processed. It returns the empty
     --  string when no file is being processed.
  
*************** package GNAT.AWK is
*** 351,374 ****
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    String;
     --  Returns field number Rank value of the current record. If Rank = 0 it
     --  returns the current record (i.e. the line as read in the file). It
     --  raises Field_Error if Rank > NF or if Session is not open.
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Integer;
     --  Returns field number Rank value of the current record as an integer. It
     --  raises Field_Error if Rank > NF or if Session is not open. It
     --  raises Data_Error if the field value cannot be converted to an integer.
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Float;
     --  Returns field number Rank value of the current record as a float. It
     --  raises Field_Error if Rank > NF or if Session is not open. It
     --  raises Data_Error if the field value cannot be converted to a float.
--- 340,360 ----
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return String;
     --  Returns field number Rank value of the current record. If Rank = 0 it
     --  returns the current record (i.e. the line as read in the file). It
     --  raises Field_Error if Rank > NF or if Session is not open.
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Integer;
     --  Returns field number Rank value of the current record as an integer. It
     --  raises Field_Error if Rank > NF or if Session is not open. It
     --  raises Data_Error if the field value cannot be converted to an integer.
  
     function Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Float;
     --  Returns field number Rank value of the current record as a float. It
     --  raises Field_Error if Rank > NF or if Session is not open. It
     --  raises Data_Error if the field value cannot be converted to a float.
*************** package GNAT.AWK is
*** 377,384 ****
        type Discrete is (<>);
     function Discrete_Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session)
!       return    Discrete;
     --  Returns field number Rank value of the current record as a type
     --  Discrete. It raises Field_Error if Rank > NF. It raises Data_Error if
     --  the field value cannot be converted to type Discrete.
--- 363,369 ----
        type Discrete is (<>);
     function Discrete_Field
       (Rank    : Count;
!       Session : Session_Type := Current_Session) return Discrete;
     --  Returns field number Rank value of the current record as a type
     --  Discrete. It raises Field_Error if Rank > NF. It raises Data_Error if
     --  the field value cannot be converted to type Discrete.
*************** package GNAT.AWK is
*** 527,542 ****
     --  or by an instantiation of For_Every_Line (see below).
  
     function End_Of_Data
!      (Session : Session_Type := Current_Session)
!       return    Boolean;
     pragma Inline (End_Of_Data);
     --  Returns True if there is no more data to be processed in Session. It
     --  means that the latest session's file is being processed and that
     --  there is no more data to be read in this file (End_Of_File is True).
  
     function End_Of_File
!      (Session : Session_Type := Current_Session)
!       return    Boolean;
     pragma Inline (End_Of_File);
     --  Returns True when there is no more data to be processed on the current
     --  session's file.
--- 512,525 ----
     --  or by an instantiation of For_Every_Line (see below).
  
     function End_Of_Data
!      (Session : Session_Type := Current_Session) return Boolean;
     pragma Inline (End_Of_Data);
     --  Returns True if there is no more data to be processed in Session. It
     --  means that the latest session's file is being processed and that
     --  there is no more data to be read in this file (End_Of_File is True).
  
     function End_Of_File
!      (Session : Session_Type := Current_Session) return Boolean;
     pragma Inline (End_Of_File);
     --  Returns True when there is no more data to be processed on the current
     --  session's file.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-boubuf.adb gcc-4.1.0/gcc/ada/g-boubuf.adb
*** gcc-4.0.2/gcc/ada/g-boubuf.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-boubuf.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                Copyright (C) 2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Bounded_Buffers is
*** 89,93 ****
  
     end Bounded_Buffer;
  
- 
  end GNAT.Bounded_Buffers;
--- 89,92 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-boubuf.ads gcc-4.1.0/gcc/ada/g-boubuf.ads
*** gcc-4.0.2/gcc/ada/g-boubuf.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-boubuf.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;
*** 44,78 ****
  generic
     type Element is private;
     --  The type of the values contained within buffer objects
  package GNAT.Bounded_Buffers is
     pragma Pure;
  
     type Content is array (Positive range <>) of Element;
!    --  Content is an internal artefact that cannot be hidden
!    --  because protected types cannot contain type declarations.
  
     Default_Ceiling : constant System.Priority := System.Default_Priority;
!    --  A convenience value for the Ceiling discriminant.
  
     protected type Bounded_Buffer
        (Capacity : Positive;
!       --  Objects of type Bounded_Buffer specify the maximum
!       --  number of Element values they can hold via the
!       --  discriminant Capacity.
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object.
!       --  If the Real-Time Systems Annex is not in use this value
!       --  is not important.
     is
        pragma Priority (Ceiling);
  
        entry Insert (Item : in Element);
!       --  Insert Item into the buffer. Blocks caller
!       --  until space is available.
  
        entry Remove (Item : out Element);
!       --  Remove next available Element from buffer.
!       --  Blocks caller until an Element is available.
  
        function Empty return Boolean;
        --  Returns whether the instance contains any Elements.
--- 44,77 ----
  generic
     type Element is private;
     --  The type of the values contained within buffer objects
+ 
  package GNAT.Bounded_Buffers is
     pragma Pure;
  
     type Content is array (Positive range <>) of Element;
!    --  Content is an internal artefact that cannot be hidden because protected
!    --  types cannot contain type declarations.
  
     Default_Ceiling : constant System.Priority := System.Default_Priority;
!    --  A convenience value for the Ceiling discriminant
  
     protected type Bounded_Buffer
        (Capacity : Positive;
!       --  Objects of type Bounded_Buffer specify the maximum number of Element
!       --  values they can hold via the discriminant Capacity.
! 
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object. If the
!       --  Real-Time Systems Annex is not in use this value is not important.
     is
        pragma Priority (Ceiling);
  
        entry Insert (Item : in Element);
!       --  Insert Item into the buffer, blocks caller until space is available
  
        entry Remove (Item : out Element);
!       --  Remove next available Element from buffer. Blocks caller until an
!       --  Element is available.
  
        function Empty return Boolean;
        --  Returns whether the instance contains any Elements.
*************** package GNAT.Bounded_Buffers is
*** 89,101 ****
  
     private
        Values   : Content (1 .. Capacity);
!       --  The container for the values held by the buffer instance.
        Next_In  : Positive := 1;
!       --  The index of the next Element inserted. Wraps around.
        Next_Out : Positive := 1;
!       --  The index of the next Element removed. Wraps around.
        Count    : Natural  := 0;
!       --  The number of Elements currently held.
     end Bounded_Buffer;
  
  end GNAT.Bounded_Buffers;
--- 88,103 ----
  
     private
        Values   : Content (1 .. Capacity);
!       --  The container for the values held by the buffer instance
! 
        Next_In  : Positive := 1;
!       --  The index of the next Element inserted. Wraps around
! 
        Next_Out : Positive := 1;
!       --  The index of the next Element removed. Wraps around
! 
        Count    : Natural  := 0;
!       --  The number of Elements currently held
     end Bounded_Buffer;
  
  end GNAT.Bounded_Buffers;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-boumai.ads gcc-4.1.0/gcc/ada/g-boumai.ads
*** gcc-4.0.2/gcc/ada/g-boumai.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-boumai.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-bubsor.adb gcc-4.1.0/gcc/ada/g-bubsor.adb
*** gcc-4.0.2/gcc/ada/g-bubsor.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-bubsor.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-bubsor.ads gcc-4.1.0/gcc/ada/g-bubsor.ads
*** gcc-4.0.2/gcc/ada/g-bubsor.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-bubsor.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . B U B B L E _ S O R T                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . B U B B L E _ S O R T                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,50 ****
  --  has the advantage of being Pure, while this unit can only be Preelaborate.
  
  package GNAT.Bubble_Sort is
! pragma Preelaborate (Bubble_Sort);
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted.
--- 44,50 ----
  --  has the advantage of being Pure, while this unit can only be Preelaborate.
  
  package GNAT.Bubble_Sort is
!    pragma Preelaborate;
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-busora.adb gcc-4.1.0/gcc/ada/g-busora.adb
*** gcc-4.0.2/gcc/ada/g-busora.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-busora.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-1998 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-busora.ads gcc-4.1.0/gcc/ada/g-busora.ads
*** gcc-4.0.2/gcc/ada/g-busora.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-busora.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ A                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  --  offers a similar routine with a more convenient interface.
  
  package GNAT.Bubble_Sort_A is
! pragma Preelaborate (Bubble_Sort_A);
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted. In addition, the
--- 39,45 ----
  --  offers a similar routine with a more convenient interface.
  
  package GNAT.Bubble_Sort_A is
!    pragma Preelaborate;
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted. In addition, the
diff -Nrcpad gcc-4.0.2/gcc/ada/g-busorg.adb gcc-4.1.0/gcc/ada/g-busorg.adb
*** gcc-4.0.2/gcc/ada/g-busorg.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-busorg.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ G                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-1998 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ G                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-busorg.ads gcc-4.1.0/gcc/ada/g-busorg.ads
*** gcc-4.0.2/gcc/ada/g-busorg.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-busorg.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ G                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                   G N A T . B U B B L E _ S O R T _ G                    --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,50 ****
  
  --  There is also GNAT.Bubble_Sort_A, which is now considered obsolete, but
  --  was an older version working with subprogram parameters. This version
! --  is retained for bacwards compatibility with old versions of GNAT.
  
  generic
     --  The data to be sorted is assumed to be indexed by integer values from
--- 44,50 ----
  
  --  There is also GNAT.Bubble_Sort_A, which is now considered obsolete, but
  --  was an older version working with subprogram parameters. This version
! --  is retained for baccwards compatibility with old versions of GNAT.
  
  generic
     --  The data to be sorted is assumed to be indexed by integer values from
*************** generic
*** 63,69 ****
     --  item is greater than or equal to the Op1 item.
  
  package GNAT.Bubble_Sort_G is
! pragma Pure (Bubble_Sort_G);
  
     procedure Sort (N : Natural);
     --  This procedures sorts items in the range from 1 to N into ascending
--- 63,69 ----
     --  item is greater than or equal to the Op1 item.
  
  package GNAT.Bubble_Sort_G is
!    pragma Pure;
  
     procedure Sort (N : Natural);
     --  This procedures sorts items in the range from 1 to N into ascending
diff -Nrcpad gcc-4.0.2/gcc/ada/g-calend.adb gcc-4.1.0/gcc/ada/g-calend.adb
*** gcc-4.0.2/gcc/ada/g-calend.adb	Thu Apr 24 17:54:02 2003
--- gcc-4.1.0/gcc/ada/g-calend.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Calendar is
*** 96,103 ****
     function Julian_Day
       (Year  : Year_Number;
        Month : Month_Number;
!       Day   : Day_Number)
!       return  Integer
     is
        Internal_Year  : Integer;
        Internal_Month : Integer;
--- 96,102 ----
     function Julian_Day
       (Year  : Year_Number;
        Month : Month_Number;
!       Day   : Day_Number) return Integer
     is
        Internal_Year  : Integer;
        Internal_Month : Integer;
*************** package body GNAT.Calendar is
*** 227,234 ****
        Hour       : Hour_Number;
        Minute     : Minute_Number;
        Second     : Second_Number;
!       Sub_Second : Second_Duration := 0.0)
!       return Time
     is
        Dsecs : constant Day_Duration :=
                  Day_Duration (Hour * 3600 + Minute * 60 + Second) +
--- 226,232 ----
        Hour       : Hour_Number;
        Minute     : Minute_Number;
        Second     : Second_Number;
!       Sub_Second : Second_Duration := 0.0) return Time
     is
        Dsecs : constant Day_Duration :=
                  Day_Duration (Hour * 3600 + Minute * 60 + Second) +
*************** package body GNAT.Calendar is
*** 253,259 ****
        sec   : aliased C.long;
        usec  : aliased C.long;
  
- 
     begin
        timeval_to_duration (T, sec'Access, usec'Access);
        return Duration (sec) + Duration (usec) / Micro;
--- 251,256 ----
*************** package body GNAT.Calendar is
*** 292,299 ****
     ------------------
  
     function Week_In_Year
!      (Date : Ada.Calendar.Time)
!       return Week_In_Year_Number
     is
        Year       : Year_Number;
        Month      : Month_Number;
--- 289,295 ----
     ------------------
  
     function Week_In_Year
!      (Date : Ada.Calendar.Time) return Week_In_Year_Number
     is
        Year       : Year_Number;
        Month      : Month_Number;
*************** package body GNAT.Calendar is
*** 307,313 ****
     begin
        Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  
!       --  Day offset number for the first week of the year.
  
        Offset := Julian_Day (Year, 1, 1) mod 7;
  
--- 303,309 ----
     begin
        Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
  
!       --  Day offset number for the first week of the year
  
        Offset := Julian_Day (Year, 1, 1) mod 7;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-calend.ads gcc-4.1.0/gcc/ada/g-calend.ads
*** gcc-4.0.2/gcc/ada/g-calend.ads	Thu Apr 24 17:54:02 2003
--- gcc-4.1.0/gcc/ada/g-calend.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Calendar is
*** 65,71 ****
     --  Second_Duration precision depends on the target clock precision.
  
     function Day_Of_Week (Date : Ada.Calendar.Time) return Day_Name;
!    --  Return the day name.
  
     function Day_In_Year (Date : Ada.Calendar.Time) return Day_In_Year_Number;
     --  Returns the day number in the year. (1st January is day 1 and 31st
--- 65,71 ----
     --  Second_Duration precision depends on the target clock precision.
  
     function Day_Of_Week (Date : Ada.Calendar.Time) return Day_Name;
!    --  Return the day name
  
     function Day_In_Year (Date : Ada.Calendar.Time) return Day_In_Year_Number;
     --  Returns the day number in the year. (1st January is day 1 and 31st
*************** package GNAT.Calendar is
*** 93,101 ****
        Hour       : Hour_Number;
        Minute     : Minute_Number;
        Second     : Second_Number;
!       Sub_Second : Second_Duration := 0.0)
!       return Ada.Calendar.Time;
!    --  Returns an Ada.Calendar.Time data built from the date and time values.
  
     --  C timeval conversion
  
--- 93,100 ----
        Hour       : Hour_Number;
        Minute     : Minute_Number;
        Second     : Second_Number;
!       Sub_Second : Second_Duration := 0.0) return Ada.Calendar.Time;
!    --  Returns an Ada.Calendar.Time data built from the date and time values
  
     --  C timeval conversion
  
*************** private
*** 119,129 ****
     function Julian_Day
       (Year  : Ada.Calendar.Year_Number;
        Month : Ada.Calendar.Month_Number;
!       Day   : Ada.Calendar.Day_Number)
!       return  Integer;
!    --  Compute Julian day number.
     --
!    --  The code of this function is a modified version of algorithm
!    --  199 from the Collected Algorithms of the ACM.
!    --  The author of algorithm 199 is Robert G. Tantzen.
  end GNAT.Calendar;
--- 118,128 ----
     function Julian_Day
       (Year  : Ada.Calendar.Year_Number;
        Month : Ada.Calendar.Month_Number;
!       Day   : Ada.Calendar.Day_Number) return Integer;
!    --  Compute Julian day number
     --
!    --  The code of this function is a modified version of algorithm 199 from
!    --  the Collected Algorithms of the ACM. The author of algorithm 199 is
!    --  Robert G. Tantzen.
! 
  end GNAT.Calendar;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-casuti.adb gcc-4.1.0/gcc/ada/g-casuti.adb
*** gcc-4.0.2/gcc/ada/g-casuti.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-casuti.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       G N A T . C A S E _ U T I L                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       G N A T . C A S E _ U T I L                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-casuti.ads gcc-4.1.0/gcc/ada/g-casuti.ads
*** gcc-4.0.2/gcc/ada/g-casuti.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-casuti.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       G N A T . C A S E _ U T I L                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       G N A T . C A S E _ U T I L                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,55 ****
  with System.Case_Util;
  
  package GNAT.Case_Util is
! pragma Pure (Case_Util);
! 
! pragma Elaborate_Body;
! --  The elaborate body is because we have a dummy body to deal with bootstrap
! --  path problems (we used to have a real body, and now we don't need it any
! --  more, but the bootstrap requires that we have a dummy body, since otherwise
! --  the old body gets picked up.
  
     --  Note: all the following functions handle the full Latin-1 set
  
--- 43,54 ----
  with System.Case_Util;
  
  package GNAT.Case_Util is
!    pragma Pure;
!    pragma Elaborate_Body;
!    --  The elaborate body is because we have a dummy body to deal with
!    --  bootstrap path problems (we used to have a real body, and now we don't
!    --  need it any more, but the bootstrap requires that we have a dummy body,
!    --  since otherwise the old body gets picked up.
  
     --  Note: all the following functions handle the full Latin-1 set
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-catiio.adb gcc-4.1.0/gcc/ada/g-catiio.adb
*** gcc-4.0.2/gcc/ada/g-catiio.adb	Fri Oct 24 13:02:41 2003
--- gcc-4.1.0/gcc/ada/g-catiio.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1999-2003 Ada Core Technologies, Inc.           --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Calendar.Time_IO is
*** 63,72 ****
     -----------------------
  
     function Am_Pm (H : Natural) return String;
!    --  return AM or PM depending on the hour H
  
     function Hour_12 (H : Natural) return Positive;
!    --  Convert a 1-24h format to a 0-12 hour format.
  
     function Image (Str : String; Length : Natural := 0) return String;
     --  Return Str capitalized and cut to length number of characters. If
--- 63,72 ----
     -----------------------
  
     function Am_Pm (H : Natural) return String;
!    --  Return AM or PM depending on the hour H
  
     function Hour_12 (H : Natural) return Positive;
!    --  Convert a 1-24h format to a 0-12 hour format
  
     function Image (Str : String; Length : Natural := 0) return String;
     --  Return Str capitalized and cut to length number of characters. If
*************** package body GNAT.Calendar.Time_IO is
*** 75,92 ****
     function Image
       (N       : Long_Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0)
!       return    String;
!    --  Return image of N. This number is eventually padded with zeros or
!    --  spaces depending of the length required. If length is 0 then no padding
!    --  occurs.
  
     function Image
       (N       : Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0)
!       return    String;
!    --  As above with N provided in Integer format.
  
     -----------
     -- Am_Pm --
--- 75,89 ----
     function Image
       (N       : Long_Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0) return String;
!    --  Return image of N. This number is eventually padded with zeros or spaces
!    --  depending of the length required. If length is 0 then no padding occurs.
  
     function Image
       (N       : Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0) return String;
!    --  As above with N provided in Integer format
  
     -----------
     -- Am_Pm --
*************** package body GNAT.Calendar.Time_IO is
*** 122,134 ****
  
     function Image
       (Str    : String;
!       Length : Natural := 0)
!       return   String
     is
        use Ada.Characters.Handling;
        Local : constant String :=
                  To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
- 
     begin
        if Length = 0 then
           return Local;
--- 119,129 ----
  
     function Image
       (Str    : String;
!       Length : Natural := 0) return String
     is
        use Ada.Characters.Handling;
        Local : constant String :=
                  To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
     begin
        if Length = 0 then
           return Local;
*************** package body GNAT.Calendar.Time_IO is
*** 144,151 ****
     function Image
       (N       : Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0)
!       return    String
     is
     begin
        return Image (Long_Integer (N), Padding, Length);
--- 139,145 ----
     function Image
       (N       : Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0) return String
     is
     begin
        return Image (Long_Integer (N), Padding, Length);
*************** package body GNAT.Calendar.Time_IO is
*** 154,161 ****
     function Image
       (N       : Long_Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0)
!       return    String
     is
        function Pad_Char return String;
  
--- 148,154 ----
     function Image
       (N       : Long_Integer;
        Padding : Padding_Mode := Zero;
!       Length  : Natural := 0) return String
     is
        function Pad_Char return String;
  
*************** package body GNAT.Calendar.Time_IO is
*** 180,186 ****
     begin
        if Length = 0 or else Padding = None then
           return NI (2 .. NI'Last);
- 
        else
           return NIP (NIP'Last - Length + 1 .. NIP'Last);
        end if;
--- 173,178 ----
*************** package body GNAT.Calendar.Time_IO is
*** 192,204 ****
  
     function Image
       (Date    : Ada.Calendar.Time;
!       Picture : Picture_String)
!       return    String
     is
!       Padding    : Padding_Mode := Zero;
        --  Padding is set for one directive
  
!       Result     : Unbounded_String;
  
        Year       : Year_Number;
        Month      : Month_Number;
--- 184,195 ----
  
     function Image
       (Date    : Ada.Calendar.Time;
!       Picture : Picture_String) return String
     is
!       Padding : Padding_Mode := Zero;
        --  Padding is set for one directive
  
!       Result : Unbounded_String;
  
        Year       : Year_Number;
        Month      : Month_Number;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-catiio.ads gcc-4.1.0/gcc/ada/g-catiio.ads
*** gcc-4.0.2/gcc/ada/g-catiio.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-catiio.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1999-2003 Ada Core Technologies, Inc.           --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Calendar.Time_IO is
*** 116,131 ****
  
     function Image
       (Date    : Ada.Calendar.Time;
!       Picture : Picture_String)
!       return    String;
!    --  Return Date as a string with format Picture.
!    --  raise Picture_Error if picture string is wrong
  
     procedure Put_Time
       (Date    : Ada.Calendar.Time;
        Picture : Picture_String);
!    --  Put Date with format Picture.
!    --  raise Picture_Error if picture string is wrong
  
  private
     ISO_Date      : constant Picture_String := "%Y-%m-%d";
--- 116,130 ----
  
     function Image
       (Date    : Ada.Calendar.Time;
!       Picture : Picture_String) return String;
!    --  Return Date as a string with format Picture. Raise Picture_Error if
!    --  picture string is wrong.
  
     procedure Put_Time
       (Date    : Ada.Calendar.Time;
        Picture : Picture_String);
!    --  Put Date with format Picture. Raise Picture_Error if picture string is
!    --  wrong
  
  private
     ISO_Date      : constant Picture_String := "%Y-%m-%d";
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgi.adb gcc-4.1.0/gcc/ada/g-cgi.adb
*** gcc-4.0.2/gcc/ada/g-cgi.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgi.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                      Copyright (C) 2001-2005, AdaCore                    --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.CGI is
*** 50,59 ****
     --  services exported by this unit.
  
     Current_Method : Method_Type;
!    --  This is the current method used to pass CGI parameters.
  
     Header_Sent : Boolean := False;
!    --  Will be set to True when the header will be sent.
  
     --  Key/Value table declaration
  
--- 50,59 ----
     --  services exported by this unit.
  
     Current_Method : Method_Type;
!    --  This is the current method used to pass CGI parameters
  
     Header_Sent : Boolean := False;
!    --  Will be set to True when the header will be sent
  
     --  Key/Value table declaration
  
*************** package body GNAT.CGI is
*** 72,78 ****
  
     procedure Check_Environment;
     pragma Inline (Check_Environment);
!    --  This procedure will raise Data_Error if Valid_Environment is False.
  
     procedure Initialize;
     --  Initialize CGI package by reading the runtime environment. This
--- 72,78 ----
  
     procedure Check_Environment;
     pragma Inline (Check_Environment);
!    --  This procedure will raise Data_Error if Valid_Environment is False
  
     procedure Initialize;
     --  Initialize CGI package by reading the runtime environment. This
*************** package body GNAT.CGI is
*** 178,184 ****
        --  for the data is passed in CONTENT_LENGTH environment variable.
  
        procedure Set_Parameter_Table (Data : String);
!       --  Parse the parameter data and set the parameter table.
  
        --------------------
        -- Initialize_GET --
--- 178,184 ----
        --  for the data is passed in CONTENT_LENGTH environment variable.
  
        procedure Set_Parameter_Table (Data : String);
!       --  Parse the parameter data and set the parameter table
  
        --------------------
        -- Initialize_GET --
*************** package body GNAT.CGI is
*** 328,334 ****
        Required : Boolean := False) return String
     is
        function Get_Environment (Variable_Name : String) return String;
!       --  Returns the environment variable content.
  
        ---------------------
        -- Get_Environment --
--- 328,334 ----
        Required : Boolean := False) return String
     is
        function Get_Environment (Variable_Name : String) return String;
!       --  Returns the environment variable content
  
        ---------------------
        -- Get_Environment --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgi.ads gcc-4.1.0/gcc/ada/g-cgi.ads
*** gcc-4.0.2/gcc/ada/g-cgi.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgi.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.CGI is
*** 115,121 ****
     --  and will be raised when calling any services below (except for Ok).
  
     Parameter_Not_Found : exception;
!    --  This exception is raised when a specific parameter is not found.
  
     Default_Header : constant String := "Content-type: text/html";
     --  This is the default header returned by Put_Header. If the CGI program
--- 115,121 ----
     --  and will be raised when calling any services below (except for Ok).
  
     Parameter_Not_Found : exception;
!    --  This exception is raised when a specific parameter is not found
  
     Default_Header : constant String := "Content-type: text/html";
     --  This is the default header returned by Put_Header. If the CGI program
*************** package GNAT.CGI is
*** 186,197 ****
     --  the exception Data_Error.
  
     function Method return Method_Type;
!    --  Returns the method used to call the CGI.
  
     function Metavariable
       (Name     : Metavariable_Name;
!       Required : Boolean := False)
!       return     String;
     --  Returns parameter Name value. Returns the null string if Name
     --  environment variable is not defined or raises Data_Error if
     --  Required is set to True.
--- 186,196 ----
     --  the exception Data_Error.
  
     function Method return Method_Type;
!    --  Returns the method used to call the CGI
  
     function Metavariable
       (Name     : Metavariable_Name;
!       Required : Boolean := False) return String;
     --  Returns parameter Name value. Returns the null string if Name
     --  environment variable is not defined or raises Data_Error if
     --  Required is set to True.
*************** package GNAT.CGI is
*** 215,222 ****
  
     function Value
       (Key      : String;
!       Required : Boolean := False)
!       return     String;
     --  Returns the parameter value associated to the parameter named Key.
     --  If parameter does not exist, returns an empty string if Required
     --  is False and raises the exception Parameter_Not_Found otherwise.
--- 214,220 ----
  
     function Value
       (Key      : String;
!       Required : Boolean := False) return String;
     --  Returns the parameter value associated to the parameter named Key.
     --  If parameter does not exist, returns an empty string if Required
     --  is False and raises the exception Parameter_Not_Found otherwise.
*************** package GNAT.CGI is
*** 227,233 ****
     --  (i.e. Position > Argument_Count)
  
     function Key_Exists (Key : String) return Boolean;
!    --  Returns True if the parameter named Key existx and False otherwise.
  
     function Key (Position : Positive) return String;
     --  Returns the parameter key associated with the CGI parameter number
--- 225,231 ----
     --  (i.e. Position > Argument_Count)
  
     function Key_Exists (Key : String) return Boolean;
!    --  Returns True if the parameter named Key exists and False otherwise
  
     function Key (Position : Positive) return String;
     --  Returns the parameter key associated with the CGI parameter number
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgicoo.adb gcc-4.1.0/gcc/ada/g-cgicoo.adb
*** gcc-4.0.2/gcc/ada/g-cgicoo.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgicoo.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.CGI.Cookie is
*** 43,54 ****
     use Ada;
  
     Valid_Environment : Boolean := False;
!    --  This boolean will be set to True if the initialization was fine.
  
     Header_Sent : Boolean := False;
!    --  Will be set to True when the header will be sent.
  
!    --  Cookie data that have been added.
  
     type String_Access is access String;
  
--- 43,54 ----
     use Ada;
  
     Valid_Environment : Boolean := False;
!    --  This boolean will be set to True if the initialization was fine
  
     Header_Sent : Boolean := False;
!    --  Will be set to True when the header will be sent
  
!    --  Cookie data that has been added
  
     type String_Access is access String;
  
*************** package body GNAT.CGI.Cookie is
*** 67,80 ****
     end record;
  
     package Cookie_Table is new Table (Cookie_Data, Positive, 1, 5, 50);
!    --  This is the table to keep all cookies to be sent back to the server.
  
     package Key_Value_Table is new Table (Key_Value, Positive, 1, 1, 50);
!    --  This is the table to keep all cookies received from the server.
  
     procedure Check_Environment;
     pragma Inline (Check_Environment);
!    --  This procedure will raise Data_Error if Valid_Environment is False.
  
     procedure Initialize;
     --  Initialize CGI package by reading the runtime environment. This
--- 67,80 ----
     end record;
  
     package Cookie_Table is new Table (Cookie_Data, Positive, 1, 5, 50);
!    --  This is the table to keep all cookies to be sent back to the server
  
     package Key_Value_Table is new Table (Key_Value, Positive, 1, 1, 50);
!    --  This is the table to keep all cookies received from the server
  
     procedure Check_Environment;
     pragma Inline (Check_Environment);
!    --  This procedure will raise Data_Error if Valid_Environment is False
  
     procedure Initialize;
     --  Initialize CGI package by reading the runtime environment. This
*************** package body GNAT.CGI.Cookie is
*** 149,155 ****
        HTTP_COOKIE : constant String := Metavariable (CGI.HTTP_Cookie);
  
        procedure Set_Parameter_Table (Data : String);
!       --  Parse Data and insert information in Key_Value_Table.
  
        -------------------------
        -- Set_Parameter_Table --
--- 149,155 ----
        HTTP_COOKIE : constant String := Metavariable (CGI.HTTP_Cookie);
  
        procedure Set_Parameter_Table (Data : String);
!       --  Parse Data and insert information in Key_Value_Table
  
        -------------------------
        -- Set_Parameter_Table --
*************** package body GNAT.CGI.Cookie is
*** 161,168 ****
           --  Add a single parameter into the table at index K. The parameter
           --  format is "key=value".
  
!          Count : constant Positive
!            := 1 + Strings.Fixed.Count (Data, Strings.Maps.To_Set (";"));
           --  Count is the number of parameters in the string. Parameters are
           --  separated by ampersand character.
  
--- 161,168 ----
           --  Add a single parameter into the table at index K. The parameter
           --  format is "key=value".
  
!          Count : constant Positive :=
!                    1 + Strings.Fixed.Count (Data, Strings.Maps.To_Set (";"));
           --  Count is the number of parameters in the string. Parameters are
           --  separated by ampersand character.
  
*************** package body GNAT.CGI.Cookie is
*** 185,190 ****
--- 185,192 ----
              end if;
           end Add_Parameter;
  
+       --  Start of processing for Set_Parameter_Table
+ 
        begin
           Key_Value_Table.Set_Last (Count);
  
*************** package body GNAT.CGI.Cookie is
*** 196,206 ****
              Index := Sep + 2;
           end loop;
  
!          --  add last parameter
  
           Add_Parameter (Count, Data (Index .. Data'Last));
        end Set_Parameter_Table;
  
     begin
        if HTTP_COOKIE /= "" then
           Set_Parameter_Table (HTTP_COOKIE);
--- 198,210 ----
              Index := Sep + 2;
           end loop;
  
!          --  Add last parameter
  
           Add_Parameter (Count, Data (Index .. Data'Last));
        end Set_Parameter_Table;
  
+    --  Start of processing for Initialize
+ 
     begin
        if HTTP_COOKIE /= "" then
           Set_Parameter_Table (HTTP_COOKIE);
*************** package body GNAT.CGI.Cookie is
*** 245,251 ****
       (Header : String  := Default_Header;
        Force  : Boolean := False)
     is
- 
        procedure Output_Cookies;
        --  Iterate through the list of cookies to be sent to the server
        --  and output them.
--- 249,254 ----
*************** package body GNAT.CGI.Cookie is
*** 264,270 ****
              Max_Age : Natural;
              Path    : String;
              Secure  : Boolean);
!          --  Output one cookie in the CGI header.
  
           -----------------------
           -- Output_One_Cookie --
--- 267,273 ----
              Max_Age : Natural;
              Path    : String;
              Secure  : Boolean);
!          --  Output one cookie in the CGI header
  
           -----------------------
           -- Output_One_Cookie --
*************** package body GNAT.CGI.Cookie is
*** 344,350 ****
        Domain  : String   := "";
        Max_Age : Natural  := Natural'Last;
        Path    : String   := "/";
!       Secure  : Boolean  := False) is
     begin
        Cookie_Table.Increment_Last;
  
--- 347,354 ----
        Domain  : String   := "";
        Max_Age : Natural  := Natural'Last;
        Path    : String   := "/";
!       Secure  : Boolean  := False)
!    is
     begin
        Cookie_Table.Increment_Last;
  
*************** package body GNAT.CGI.Cookie is
*** 364,371 ****
  
     function Value
       (Key      : String;
!       Required : Boolean := False)
!       return     String
     is
     begin
        Check_Environment;
--- 368,374 ----
  
     function Value
       (Key      : String;
!       Required : Boolean := False) return String
     is
     begin
        Check_Environment;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgicoo.ads gcc-4.1.0/gcc/ada/g-cgicoo.ads
*** gcc-4.0.2/gcc/ada/g-cgicoo.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgicoo.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2000-2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,46 ****
  --  The complete CGI Cookie specification can be found in the RFC2109 at:
  --     http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
  
! --  This package builds up data tables whose memory is not released.
! --  A CGI program is expected to be a short lived program and so it
! --  is adequate to have the underlying OS free the program on exit.
  
  package GNAT.CGI.Cookie is
  
--- 38,46 ----
  --  The complete CGI Cookie specification can be found in the RFC2109 at:
  --     http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
  
! --  This package builds up data tables whose memory is not released. A CGI
! --  program is expected to be a short lived program and so it is adequate to
! --  have the underlying OS free the program on exit.
  
  package GNAT.CGI.Cookie is
  
*************** package GNAT.CGI.Cookie is
*** 50,56 ****
     --  will be raised when calling any services below (except for Ok).
  
     Cookie_Not_Found : exception;
!    --  This exception is raised when a specific parameter is not found.
  
     procedure Put_Header
       (Header : String  := Default_Header;
--- 50,56 ----
     --  will be raised when calling any services below (except for Ok).
  
     Cookie_Not_Found : exception;
!    --  This exception is raised when a specific parameter is not found
  
     procedure Put_Header
       (Header : String  := Default_Header;
*************** package GNAT.CGI.Cookie is
*** 67,99 ****
     --     max_age=<max_age>; path=<path>[; secured]
  
     function Ok return Boolean;
!    --  Returns True if the CGI cookie environment is valid and False
!    --  otherwise. Every service used when the CGI environment is not valid
!    --  will raise the exception Data_Error.
  
     function Count return Natural;
!    --  Returns the number of cookies received by the CGI.
  
     function Value
       (Key      : String;
!       Required : Boolean := False)
!       return     String;
!    --  Returns the cookie value associated with the cookie named Key. If
!    --  cookie does not exist, returns an empty string if Required is
!    --  False and raises the exception Cookie_Not_Found otherwise.
  
     function Value (Position : Positive) return String;
!    --  Returns the value associated with the cookie number Position
!    --  of the CGI. It raises Cookie_Not_Found if there is no such
!    --  cookie (i.e. Position > Count)
  
     function Exists (Key : String) return Boolean;
!    --  Returns True if the cookie named Key exist and False otherwise.
  
     function Key (Position : Positive) return String;
!    --  Returns the key associated with the cookie number Position of
!    --  the CGI. It raises Cookie_Not_Found if there is no such cookie
!    --  (i.e. Position > Count)
  
     procedure Set
       (Key     : String;
--- 67,98 ----
     --     max_age=<max_age>; path=<path>[; secured]
  
     function Ok return Boolean;
!    --  Returns True if the CGI cookie environment is valid and False otherwise.
!    --  Every service used when the CGI environment is not valid will raise the
!    --  exception Data_Error.
  
     function Count return Natural;
!    --  Returns the number of cookies received by the CGI
  
     function Value
       (Key      : String;
!       Required : Boolean := False) return String;
!    --  Returns the cookie value associated with the cookie named Key. If cookie
!    --  does not exist, returns an empty string if Required is False and raises
!    --  the exception Cookie_Not_Found otherwise.
  
     function Value (Position : Positive) return String;
!    --  Returns the value associated with the cookie number Position of the CGI.
!    --  It raises Cookie_Not_Found if there is no such cookie (i.e. Position >
!    --  Count)
  
     function Exists (Key : String) return Boolean;
!    --  Returns True if the cookie named Key exist and False otherwise
  
     function Key (Position : Positive) return String;
!    --  Returns the key associated with the cookie number Position of the CGI.
!    --  It raises Cookie_Not_Found if there is no such cookie (i.e. Position >
!    --  Count)
  
     procedure Set
       (Key     : String;
*************** package GNAT.CGI.Cookie is
*** 103,110 ****
        Max_Age : Natural := Natural'Last;
        Path    : String  := "/";
        Secure  : Boolean := False);
!    --  Add a cookie to the list of cookies. This will be sent back
!    --  to the server by the Put_Header service above.
  
     generic
        with procedure
--- 102,109 ----
        Max_Age : Natural := Natural'Last;
        Path    : String  := "/";
        Secure  : Boolean := False);
!    --  Add a cookie to the list of cookies. This will be sent back to the
!    --  server by the Put_Header service above.
  
     generic
        with procedure
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgideb.adb gcc-4.1.0/gcc/ada/g-cgideb.adb
*** gcc-4.0.2/gcc/ada/g-cgideb.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgideb.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2000-2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.CGI.Debug is
*** 37,49 ****
  
     use Ada.Strings.Unbounded;
  
!    --
!    --  Define the abstract type which act as a template for all debug IO mode.
     --  To create a new IO mode you must:
     --     1. create a new package spec
     --     2. create a new type derived from IO.Format
     --     3. implement all the abstract rountines in IO
-    --
  
     package IO is
  
--- 37,47 ----
  
     use Ada.Strings.Unbounded;
  
!    --  Define the abstract type which act as a template for all debug IO modes.
     --  To create a new IO mode you must:
     --     1. create a new package spec
     --     2. create a new type derived from IO.Format
     --     3. implement all the abstract rountines in IO
  
     package IO is
  
*************** package body GNAT.CGI.Debug is
*** 54,104 ****
        function Variable
          (Mode  : Format;
           Name  : String;
!          Value : String)
!          return  String
!       is abstract;
!       --  Returns variable Name and its associated value.
  
!       function New_Line
!         (Mode : Format)
!          return String
!       is abstract;
        --  Returns a new line such as this concatenated between two strings
        --  will display the strings on two lines.
  
!       function Title
!         (Mode : Format;
!          Str  : String)
!          return String
!       is abstract;
        --  Returns Str as a Title. A title must be alone and centered on a
        --  line. Next output will be on the following line.
  
        function Header
          (Mode : Format;
!          Str  : String)
!          return String
!       is abstract;
        --  Returns Str as an Header. An header must be alone on its line. Next
        --  output will be on the following line.
  
     end IO;
  
!    --
!    --  IO for HTML mode
!    --
  
     package HTML_IO is
  
!       --  see IO for comments about these routines.
  
        type Format is new IO.Format with null record;
  
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String)
!          return  String;
  
        function New_Line (IO : in Format) return String;
  
--- 52,90 ----
        function Variable
          (Mode  : Format;
           Name  : String;
!          Value : String) return String is abstract;
!       --  Returns variable Name and its associated value
  
!       function New_Line (Mode : Format) return String is abstract;
        --  Returns a new line such as this concatenated between two strings
        --  will display the strings on two lines.
  
!       function Title (Mode : Format; Str : String) return String is abstract;
        --  Returns Str as a Title. A title must be alone and centered on a
        --  line. Next output will be on the following line.
  
        function Header
          (Mode : Format;
!          Str  : String) return String is abstract;
        --  Returns Str as an Header. An header must be alone on its line. Next
        --  output will be on the following line.
  
     end IO;
  
!    ----------------------
!    -- IO for HTML Mode --
!    ----------------------
  
     package HTML_IO is
  
!       --  See IO for comments about these routines
  
        type Format is new IO.Format with null record;
  
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String) return String;
  
        function New_Line (IO : in Format) return String;
  
*************** package body GNAT.CGI.Debug is
*** 108,116 ****
  
     end HTML_IO;
  
!    --
!    --  IO for plain text mode
!    --
  
     package Text_IO is
  
--- 94,102 ----
  
     end HTML_IO;
  
!    ----------------------------
!    -- IO for Plain Text Mode --
!    ----------------------------
  
     package Text_IO is
  
*************** package body GNAT.CGI.Debug is
*** 121,128 ****
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String)
!          return  String;
  
        function New_Line (IO : in Format) return String;
  
--- 107,113 ----
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String) return String;
  
        function New_Line (IO : in Format) return String;
  
*************** package body GNAT.CGI.Debug is
*** 188,197 ****
        NL : constant String := (1 => ASCII.LF);
  
        function Bold (S : in String) return String;
!       --  Returns S as an HTML bold string.
  
        function Italic (S : in String) return String;
!       --  Returns S as an HTML italic string.
  
        ----------
        -- Bold --
--- 173,182 ----
        NL : constant String := (1 => ASCII.LF);
  
        function Bold (S : in String) return String;
!       --  Returns S as an HTML bold string
  
        function Italic (S : in String) return String;
!       --  Returns S as an HTML italic string
  
        ----------
        -- Bold --
*************** package body GNAT.CGI.Debug is
*** 207,214 ****
        ------------
  
        function Header (IO : in Format; Str : in String) return String is
!          pragma Warnings (Off, IO);
! 
        begin
           return "<h2>" & Str & "</h2>" & NL;
        end Header;
--- 192,198 ----
        ------------
  
        function Header (IO : in Format; Str : in String) return String is
!          pragma Unreferenced (IO);
        begin
           return "<h2>" & Str & "</h2>" & NL;
        end Header;
*************** package body GNAT.CGI.Debug is
*** 227,234 ****
        --------------
  
        function New_Line (IO : in Format) return String is
!          pragma Warnings (Off, IO);
! 
        begin
           return "<br>" & NL;
        end New_Line;
--- 211,217 ----
        --------------
  
        function New_Line (IO : in Format) return String is
!          pragma Unreferenced (IO);
        begin
           return "<br>" & NL;
        end New_Line;
*************** package body GNAT.CGI.Debug is
*** 238,245 ****
        -----------
  
        function Title (IO : in Format; Str : in String) return String is
!          pragma Warnings (Off, IO);
! 
        begin
           return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
        end Title;
--- 221,227 ----
        -----------
  
        function Title (IO : in Format; Str : in String) return String is
!          pragma Unreferenced (IO);
        begin
           return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
        end Title;
*************** package body GNAT.CGI.Debug is
*** 251,261 ****
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String)
!          return  String
        is
!          pragma Warnings (Off, IO);
! 
        begin
           return Bold (Name) & " = " & Italic (Value);
        end Variable;
--- 233,241 ----
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String) return String
        is
!          pragma Unreferenced (IO);
        begin
           return Bold (Name) & " = " & Italic (Value);
        end Variable;
*************** package body GNAT.CGI.Debug is
*** 282,289 ****
        --------------
  
        function New_Line (IO : in Format) return String is
!          pragma Warnings (Off, IO);
! 
        begin
           return String'(1 => ASCII.LF);
        end New_Line;
--- 262,268 ----
        --------------
  
        function New_Line (IO : in Format) return String is
!          pragma Unreferenced (IO);
        begin
           return String'(1 => ASCII.LF);
        end New_Line;
*************** package body GNAT.CGI.Debug is
*** 295,301 ****
        function Title (IO : in Format; Str : in String) return String is
           Spaces : constant Natural := (80 - Str'Length) / 2;
           Indent : constant String (1 .. Spaces) := (others => ' ');
- 
        begin
           return Indent & Str & New_Line (IO);
        end Title;
--- 274,279 ----
*************** package body GNAT.CGI.Debug is
*** 307,317 ****
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String)
!          return  String
        is
!          pragma Warnings (Off, IO);
! 
        begin
           return "   " & Name & " = " & Value;
        end Variable;
--- 285,293 ----
        function Variable
          (IO    : Format;
           Name  : String;
!          Value : String) return String
        is
!          pragma Unreferenced (IO);
        begin
           return "   " & Name & " = " & Value;
        end Variable;
*************** package body GNAT.CGI.Debug is
*** 324,330 ****
  
     function HTML_Output return String is
        HTML : HTML_IO.Format;
- 
     begin
        return IO.Output (Mode => HTML);
     end HTML_Output;
--- 300,305 ----
*************** package body GNAT.CGI.Debug is
*** 335,341 ****
  
     function Text_Output return String is
        Text : Text_IO.Format;
- 
     begin
        return IO.Output (Mode => Text);
     end Text_Output;
--- 310,315 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-cgideb.ads gcc-4.1.0/gcc/ada/g-cgideb.ads
*** gcc-4.0.2/gcc/ada/g-cgideb.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-cgideb.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2000 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,44 ****
  
  package GNAT.CGI.Debug is
  
!    --  Both functions below output all possible CGI parameters set. These
!    --  are the form field and all CGI environment variables which make the
!    --  CGI environment at runtime.
  
     function Text_Output return String;
     --  Returns a plain text version of the CGI runtime environment
--- 36,44 ----
  
  package GNAT.CGI.Debug is
  
!    --  Both functions below output all possible CGI parameters set. These are
!    --  the form field and all CGI environment variables which make the CGI
!    --  environment at runtime.
  
     function Text_Output return String;
     --  Returns a plain text version of the CGI runtime environment
diff -Nrcpad gcc-4.0.2/gcc/ada/g-comlin.adb gcc-4.1.0/gcc/ada/g-comlin.adb
*** gcc-4.0.2/gcc/ada/g-comlin.adb	Thu Apr  1 10:04:37 2004
--- gcc-4.1.0/gcc/ada/g-comlin.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Command_Line is
*** 49,71 ****
     The_Parameter : Parameter_Type;
     The_Switch    : Parameter_Type;
     --  This type and this variable are provided to store the current switch
!    --  and parameter
  
     type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
     pragma Pack (Is_Switch_Type);
  
     Is_Switch : Is_Switch_Type := (others => False);
     --  Indicates wich arguments on the command line are considered not be
!    --  switches or parameters to switches (this leaves e.g. the filenames...)
  
     type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
     pragma Pack (Section_Type);
     Section : Section_Type := (others => 1);
!    --  Contains the number of the section associated with the current
!    --  switch.  If this number is 0, then it is a section delimiter, which
!    --  is never returns by GetOpt.
!    --  The last element of this array is set to 0 to avoid the need to test for
!    --  if we have reached the end of the command line in loops.
  
     Current_Argument : Natural := 1;
     --  Number of the current argument parsed on the command line
--- 49,70 ----
     The_Parameter : Parameter_Type;
     The_Switch    : Parameter_Type;
     --  This type and this variable are provided to store the current switch
!    --  and parameter.
  
     type Is_Switch_Type is array (1 .. CL.Argument_Count) of Boolean;
     pragma Pack (Is_Switch_Type);
  
     Is_Switch : Is_Switch_Type := (others => False);
     --  Indicates wich arguments on the command line are considered not be
!    --  switches or parameters to switches (this leaves e.g. the filenames...).
  
     type Section_Type is array (1 .. CL.Argument_Count + 1) of Section_Number;
     pragma Pack (Section_Type);
     Section : Section_Type := (others => 1);
!    --  Contains the number of the section associated with the current switch.
!    --  If this number is 0, then it is a section delimiter, which is never
!    --  returns by GetOpt. The last element of this array is set to 0 to avoid
!    --  the need to test for reaching the end of the command line in loops.
  
     Current_Argument : Natural := 1;
     --  Number of the current argument parsed on the command line
*************** package body GNAT.Command_Line is
*** 82,89 ****
     --  True if we are expanding a file
  
     Switch_Character : Character := '-';
!    --  The character at the beginning of the command line arguments,
!    --  indicating the beginning of a switch
  
     Stop_At_First : Boolean := False;
     --  If it is True then Getopt stops at the first non-switch argument
--- 81,88 ----
     --  True if we are expanding a file
  
     Switch_Character : Character := '-';
!    --  The character at the beginning of the command line arguments, indicating
!    --  the beginning of a switch.
  
     Stop_At_First : Boolean := False;
     --  If it is True then Getopt stops at the first non-switch argument
*************** package body GNAT.Command_Line is
*** 97,120 ****
     --  Set the parameter that will be returned by Parameter below
  
     function Goto_Next_Argument_In_Section return Boolean;
!    --  Go to the next argument on the command line. If we are at the end
!    --  of the current section, we want to make sure there is no other
!    --  identical section on the command line (there might be multiple
!    --  instances of -largs). Returns True iff there is another argument.
  
     function Get_File_Names_Case_Sensitive return Integer;
     pragma Import (C, Get_File_Names_Case_Sensitive,
                    "__gnat_get_file_names_case_sensitive");
     File_Names_Case_Sensitive : constant Boolean :=
                                   Get_File_Names_Case_Sensitive /= 0;
  
     procedure Canonical_Case_File_Name (S : in out String);
!    --  Given a file name, converts it to canonical case form. For systems
!    --  where file names are case sensitive, this procedure has no effect.
!    --  If file names are not case sensitive (i.e. for example if you have
!    --  the file "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then
!    --  this call converts the given string to canonical all lower case form,
!    --  so that two file names compare equal if they refer to the same file.
  
     ------------------------------
     -- Canonical_Case_File_Name --
--- 96,120 ----
     --  Set the parameter that will be returned by Parameter below
  
     function Goto_Next_Argument_In_Section return Boolean;
!    --  Go to the next argument on the command line. If we are at the end of the
!    --  current section, we want to make sure there is no other identical
!    --  section on the command line (there might be multiple instances of
!    --  -largs). Returns True iff there is another argument.
  
     function Get_File_Names_Case_Sensitive return Integer;
     pragma Import (C, Get_File_Names_Case_Sensitive,
                    "__gnat_get_file_names_case_sensitive");
+ 
     File_Names_Case_Sensitive : constant Boolean :=
                                   Get_File_Names_Case_Sensitive /= 0;
  
     procedure Canonical_Case_File_Name (S : in out String);
!    --  Given a file name, converts it to canonical case form. For systems where
!    --  file names are case sensitive, this procedure has no effect. If file
!    --  names are not case sensitive (i.e. for example if you have the file
!    --  "xyz.adb", you can refer to it as XYZ.adb or XyZ.AdB), then this call
!    --  converts the given string to canonical all lower case form, so that two
!    --  file names compare equal if they refer to the same file.
  
     ------------------------------
     -- Canonical_Case_File_Name --
*************** package body GNAT.Command_Line is
*** 150,157 ****
        NL      : Positive;
  
     begin
!       --  It is assumed that a directory is opened at the current level;
!       --  otherwise, GNAT.Directory_Operations.Directory_Error will be raised
        --  at the first call to Read.
  
        loop
--- 150,157 ----
        NL      : Positive;
  
     begin
!       --  It is assumed that a directory is opened at the current level.
!       --  Otherwise GNAT.Directory_Operations.Directory_Error will be raised
        --  at the first call to Read.
  
        loop
*************** package body GNAT.Command_Line is
*** 162,168 ****
           if Last = 0 then
              Close (It.Levels (Current).Dir);
  
!             --  If we are at level 1, we are finished; return an empty string.
  
              if Current = 1 then
                 return String'(1 .. 0 => ' ');
--- 162,168 ----
           if Last = 0 then
              Close (It.Levels (Current).Dir);
  
!             --  If we are at level 1, we are finished; return an empty string
  
              if Current = 1 then
                 return String'(1 .. 0 => ' ');
*************** package body GNAT.Command_Line is
*** 384,394 ****
           Arg            : String renames CL.Argument (Current_Argument);
           Index_Switches : Natural := 0;
           Max_Length     : Natural := 0;
!          Index          : Natural := Switches'First;
           Length         : Natural := 1;
           End_Index      : Natural;
  
        begin
           while Index <= Switches'Last loop
  
              --  Search the length of the parameter at this position in Switches
--- 384,402 ----
           Arg            : String renames CL.Argument (Current_Argument);
           Index_Switches : Natural := 0;
           Max_Length     : Natural := 0;
!          Index          : Natural;
           Length         : Natural := 1;
           End_Index      : Natural;
  
        begin
+          --  Remove all leading spaces first to make sure that Index points
+          --  at the start of the first switch.
+ 
+          Index := Switches'First;
+          while Index <= Switches'Last and then Switches (Index) = ' ' loop
+             Index := Index + 1;
+          end loop;
+ 
           while Index <= Switches'Last loop
  
              --  Search the length of the parameter at this position in Switches
diff -Nrcpad gcc-4.0.2/gcc/ada/g-comlin.ads gcc-4.1.0/gcc/ada/g-comlin.ads
*** gcc-4.0.2/gcc/ada/g-comlin.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-comlin.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1999-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 72,78 ****
  
  --  A more complicated example would involve the use of sections for the
  --  switches, as for instance in gnatmake. These sections are separated by
! --  special switches, chosen by the programer. Each section act as a
  --  command line of its own.
  
  --  begin
--- 72,78 ----
  
  --  A more complicated example would involve the use of sections for the
  --  switches, as for instance in gnatmake. These sections are separated by
! --  special switches chosen by the programer. Each section acts as a
  --  command line of its own.
  
  --  begin
*************** package GNAT.Command_Line is
*** 104,127 ****
        Stop_At_First_Non_Switch : Boolean := False;
        Section_Delimiters       : String := "");
     --  This procedure resets the internal state of the package to prepare
!    --  to rescan the parameters. It need not (but may be) called before the
!    --  first use of Getopt, but it must be called if you want to start
!    --  rescanning the command line parameters from the start. The optional
!    --  parameter Switch_Char can be used to reset the switch character,
!    --  e.g. to '/' for use in DOS-like systems. The optional parameter
!    --  Stop_At_First_Non_Switch indicates if Getopt is to look for switches
!    --  on the whole command line, or if it has to stop as soon as a
     --  non-switch argument is found.
     --
     --  Example:
     --
     --      Arguments: my_application file1 -c
     --
!    --      if Stop_At_First_Non_Switch is False, then -c will be considered
     --      as a switch (returned by getopt), otherwise it will be considered
     --      as a normal argument (returned by Get_Argument).
     --
!    --  if SECTION_DELIMITERS is set, then every following subprogram
     --  (Getopt and Get_Argument) will only operate within a section, which
     --  is delimited by any of these delimiters or the end of the command line.
     --
--- 104,127 ----
        Stop_At_First_Non_Switch : Boolean := False;
        Section_Delimiters       : String := "");
     --  This procedure resets the internal state of the package to prepare
!    --  to rescan the parameters. It does not need to be called before the
!    --  first use of Getopt (but it could be), but it must be called if you want
!    --  to start rescanning the command line parameters from the start. The
!    --  optional parameter Switch_Char can be used to reset the switch
!    --  character, e.g. to '/' for use in DOS-like systems. The optional
!    --  parameter Stop_At_First_Non_Switch indicates if Getopt is to look for
!    --  switches on the whole command line, or if it has to stop as soon as a
     --  non-switch argument is found.
     --
     --  Example:
     --
     --      Arguments: my_application file1 -c
     --
!    --      If Stop_At_First_Non_Switch is False, then -c will be considered
     --      as a switch (returned by getopt), otherwise it will be considered
     --      as a normal argument (returned by Get_Argument).
     --
!    --  If SECTION_DELIMITERS is set, then every following subprogram
     --  (Getopt and Get_Argument) will only operate within a section, which
     --  is delimited by any of these delimiters or the end of the command line.
     --
*************** package GNAT.Command_Line is
*** 134,144 ****
     --      and -largs and includes '-d -e' and the last one includes '-f'
  
     procedure Goto_Section (Name : String := "");
!    --  Change the current section. The next Getopt of Get_Argument will
!    --  start looking at the beginning of the section. An empty name ("")
!    --  refers to the first section between the program name and the first
!    --  section delimiter.
!    --  If the section does not exist, then Invalid_Section is raised.
  
     function Full_Switch return String;
     --  Returns the full name of the last switch found (Getopt only returns
--- 134,144 ----
     --      and -largs and includes '-d -e' and the last one includes '-f'
  
     procedure Goto_Section (Name : String := "");
!    --  Change the current section. The next Getopt of Get_Argument will start
!    --  looking at the beginning of the section. An empty name ("") refers to
!    --  the first section between the program name and the first section
!    --  delimiter. If the section does not exist, then Invalid_Section is
!    --  raised.
  
     function Full_Switch return String;
     --  Returns the full name of the last switch found (Getopt only returns
*************** package GNAT.Command_Line is
*** 147,180 ****
     function Getopt
       (Switches    : String;
        Concatenate : Boolean := True) return Character;
!    --  This function moves to the next switch on the command line (defined
!    --  as a switch character followed by a character within Switches,
!    --  casing being significant). The result returned is the first
!    --  character of the particular switch located. If there are no more
!    --  switches in the current section, returns ASCII.NUL. If Concatenate is
!    --  True (by default), the switches need not be separated by spaces (they
!    --  can be concatenated if they do not require an argument, e.g. -ab is the
!    --  same as two separate arguments -a -b).
     --
     --  Switches is a string of all the possible switches, separated by a
!    --  space. A switch can be followed by one of the following characters :
     --
     --   ':'  The switch requires a parameter. There can optionally be a space
!    --        on the command line between the switch and its parameter
     --   '='  The switch requires a parameter. There can either be a '=' or a
!    --        space on the command line between the switch and its parameter
     --   '!'  The switch requires a parameter, but there can be no space on the
!    --        command line between the switch and its parameter
     --   '?'  The switch may have an optional parameter. There can be no space
!    --        between the switch and its argument
!    --        ex/ if Switches has the following value : "a? b"
!    --            The command line can be :
     --             -afoo    :  -a switch with 'foo' parameter
     --             -a foo   :  -a switch and another element on the
     --                           command line 'foo', returned by Get_Argument
     --
     --     Example: if Switches is "-a: -aO:", you can have the following
!    --              command lines :
     --                -aarg    :  'a' switch with 'arg' parameter
     --                -a arg   :  'a' switch with 'arg' parameter
     --                -aOarg   :  'aO' switch with 'arg' parameter
--- 147,186 ----
     function Getopt
       (Switches    : String;
        Concatenate : Boolean := True) return Character;
!    --  This function moves to the next switch on the command line (defined as
!    --  switch character followed by a character within Switches, casing being
!    --  significant). The result returned is the first character of the switch
!    --  that is located. If there are no more switches in the current section,
!    --  returns ASCII.NUL. If Concatenate is True (by default), the switches
!    --  does not need to be separated by spaces (they can be concatenated if
!    --  they do not require an argument, e.g. -ab is the ame as two separate
!    --  arguments -a -b).
     --
     --  Switches is a string of all the possible switches, separated by a
!    --  space. A switch can be followed by one of the following characters:
     --
     --   ':'  The switch requires a parameter. There can optionally be a space
!    --        on the command line between the switch and its parameter.
!    --
     --   '='  The switch requires a parameter. There can either be a '=' or a
!    --        space on the command line between the switch and its parameter.
!    --
     --   '!'  The switch requires a parameter, but there can be no space on the
!    --        command line between the switch and its parameter.
!    --
     --   '?'  The switch may have an optional parameter. There can be no space
!    --        between the switch and its argument.
!    --
!    --        e.g. if Switches has the following value : "a? b",
!    --        The command line can be:
!    --
     --             -afoo    :  -a switch with 'foo' parameter
     --             -a foo   :  -a switch and another element on the
     --                           command line 'foo', returned by Get_Argument
     --
     --     Example: if Switches is "-a: -aO:", you can have the following
!    --              command lines:
!    --
     --                -aarg    :  'a' switch with 'arg' parameter
     --                -a arg   :  'a' switch with 'arg' parameter
     --                -aOarg   :  'aO' switch with 'arg' parameter
*************** package GNAT.Command_Line is
*** 194,207 ****
     --
     --    Example
     --       Getopt ("* a b")
!    --       If the command line is '-a -c toto.o -b', GetOpt will return
!    --       successively 'a', '*', '*' and 'b'. When '*' is returnd,
     --       Full_Switch returns the corresponding item on the command line.
     --
     --
     --  When Getopt encounters an invalid switch, it raises the exception
     --  Invalid_Switch and sets Full_Switch to return the invalid switch.
!    --  When Getopt can not find the parameter associated with a switch, it
     --  raises Invalid_Parameter, and sets Full_Switch to return the invalid
     --  switch character.
     --
--- 200,213 ----
     --
     --    Example
     --       Getopt ("* a b")
!    --       If the command line is '-a -c toto.o -b', Getopt will return
!    --       successively 'a', '*', '*' and 'b'. When '*' is returned,
     --       Full_Switch returns the corresponding item on the command line.
     --
     --
     --  When Getopt encounters an invalid switch, it raises the exception
     --  Invalid_Switch and sets Full_Switch to return the invalid switch.
!    --  When Getopt cannot find the parameter associated with a switch, it
     --  raises Invalid_Parameter, and sets Full_Switch to return the invalid
     --  switch character.
     --
*************** package GNAT.Command_Line is
*** 221,244 ****
     --       raised and Full_Switch will return "ab".
  
     function Get_Argument (Do_Expansion : Boolean := False) return String;
!    --  Returns the next element in the command line which is not a switch.
     --  This function should not be called before Getopt has returned
     --  ASCII.NUL.
     --
!    --  If Expansion is True, then the parameter on the command
!    --  line will considered as filename with wild cards, and will be
!    --  expanded. The matching file names will be returned one at a time.
!    --  When there are no more arguments on the command line, this function
!    --  returns an empty string. This is useful in non-Unix systems for
!    --  obtaining normal expansion of wild card references.
  
     function Parameter return String;
!    --  Returns parameter associated with the last switch returned by Getopt.
!    --  If no parameter was associated with the last switch, or no previous
!    --  call has been made to Get_Argument, raises Invalid_Parameter.
     --  If the last switch was associated with an optional argument and this
     --  argument was not found on the command line, Parameter returns an empty
!    --  string
  
     type Expansion_Iterator is limited private;
     --  Type used during expansion of file names
--- 227,250 ----
     --       raised and Full_Switch will return "ab".
  
     function Get_Argument (Do_Expansion : Boolean := False) return String;
!    --  Returns the next element on the command line which is not a switch.
     --  This function should not be called before Getopt has returned
     --  ASCII.NUL.
     --
!    --  If Expansion is True, then the parameter on the command line will be
!    --  considered as a filename with wild cards, and will be expanded. The
!    --  matching file names will be returned one at a time. When there are no
!    --  more arguments on the command line, this function returns an empty
!    --  string. This is useful in non-Unix systems for obtaining normal
!    --  expansion of wild card references.
  
     function Parameter return String;
!    --  Returns the parameter associated with the last switch returned by
!    --  Getopt. If no parameter was associated with the last switch, or no
!    --  previous call has been made to Get_Argument, raises Invalid_Parameter.
     --  If the last switch was associated with an optional argument and this
     --  argument was not found on the command line, Parameter returns an empty
!    --  string.
  
     type Expansion_Iterator is limited private;
     --  Type used during expansion of file names
*************** package GNAT.Command_Line is
*** 254,272 ****
     --  Basic_Regexp is True). When Directory is an empty string, the current
     --  directory is searched.
     --
!    --  Pattern may contains directory separators (as in "src/*/*.ada").
     --  Subdirectories of Directory will also be searched, up to one
     --  hundred levels deep.
     --
     --  When Start_Expansion has been called, function Expansion should be
!    --  called repetitively until it returns an empty string, before
     --  Start_Expansion can be called again with the same Expansion_Iterator
     --  variable.
  
     function Expansion (Iterator : Expansion_Iterator) return String;
!    --  Return the next file in the directory matching the parameters given
     --  to Start_Expansion and updates Iterator to point to the next entry.
!    --  Returns an empty string when there are no more files in the directory
     --  and its subdirectories.
     --
     --  If Expansion is called again after an empty string has been returned,
--- 260,278 ----
     --  Basic_Regexp is True). When Directory is an empty string, the current
     --  directory is searched.
     --
!    --  Pattern may contain directory separators (as in "src/*/*.ada").
     --  Subdirectories of Directory will also be searched, up to one
     --  hundred levels deep.
     --
     --  When Start_Expansion has been called, function Expansion should be
!    --  called repeatedly until it returns an empty string, before
     --  Start_Expansion can be called again with the same Expansion_Iterator
     --  variable.
  
     function Expansion (Iterator : Expansion_Iterator) return String;
!    --  Returns the next file in the directory matching the parameters given
     --  to Start_Expansion and updates Iterator to point to the next entry.
!    --  Returns an empty string when there is no more file in the directory
     --  and its subdirectories.
     --
     --  If Expansion is called again after an empty string has been returned,
*************** package GNAT.Command_Line is
*** 279,286 ****
     --  Raised when an invalid switch is detected in the command line
  
     Invalid_Parameter : exception;
!    --  Raised when a parameter is missing, or an attempt is made to obtain
!    --  a parameter for a switch that does not allow a parameter
  
  private
  
--- 285,292 ----
     --  Raised when an invalid switch is detected in the command line
  
     Invalid_Parameter : exception;
!    --  Raised when a parameter is missing, or an attempt is made to obtain a
!    --  parameter for a switch that does not allow a parameter
  
  private
  
*************** private
*** 301,308 ****
  
     type Expansion_Iterator is limited record
        Start : Positive := 1;
!       --  Position of the first character of the relative path to check
!       --  against the pattern.
  
        Dir_Name : String (1 .. Max_Path_Length);
  
--- 307,314 ----
  
     type Expansion_Iterator is limited record
        Start : Positive := 1;
!       --  Position of the first character of the relative path to check against
!       --  the pattern.
  
        Dir_Name : String (1 .. Max_Path_Length);
  
*************** private
*** 314,321 ****
        --  Regular expression built with the pattern
  
        Maximum_Depth : Depth := 1;
!       --  The maximum depth of directories, reflecting the number of
!       --  directory separators in the pattern.
  
     end record;
  
--- 320,327 ----
        --  Regular expression built with the pattern
  
        Maximum_Depth : Depth := 1;
!       --  The maximum depth of directories, reflecting the number of directory
!       --  separators in the pattern.
  
     end record;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-comver.adb gcc-4.1.0/gcc/ada/g-comver.adb
*** gcc-4.0.2/gcc/ada/g-comver.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-comver.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                 Copyright (C) 2002 Ada Core Technologies                 --
  --                                                                          --
  -- 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-comver.ads gcc-4.1.0/gcc/ada/g-comver.ads
*** gcc-4.0.2/gcc/ada/g-comver.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-comver.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                 Copyright (C) 2002 Ada Core Technologies                 --
  --                                                                          --
  -- 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  GNAT compiler used to compile the program. It relies on the generated
  --  constant in the binder generated package that records this information.
  
! --  Note: to use this package you must first instantiate it, e.g.
  
  --    package CVer is new GNAT.Compiler_Version;
  
--- 35,41 ----
  --  GNAT compiler used to compile the program. It relies on the generated
  --  constant in the binder generated package that records this information.
  
! --  Note: to use this package you must first instantiate it, for example:
  
  --    package CVer is new GNAT.Compiler_Version;
  
***************
*** 44,56 ****
  --  to import the necessary variable from the binder file causes trouble when
  --  building a shared library, since the symbol is not available.
  
! --  Note: this unit is only useable if the main program is written
! --  in Ada. It cannot be used if the main program is written in a
! --  foreign language.
  
  generic
  package GNAT.Compiler_Version is
! pragma Pure (Compiler_Version);
  
     function Version return String;
     --  This function returns the version in the form "v.vvx (yyyyddmm)".
--- 44,55 ----
  --  to import the necessary variable from the binder file causes trouble when
  --  building a shared library, since the symbol is not available.
  
! --  Note: this unit is only useable if the main program is written in Ada.
! --  It cannot be used if the main program is written in foreign language.
  
  generic
  package GNAT.Compiler_Version is
!    pragma Pure;
  
     function Version return String;
     --  This function returns the version in the form "v.vvx (yyyyddmm)".
diff -Nrcpad gcc-4.0.2/gcc/ada/g-crc32.adb gcc-4.1.0/gcc/ada/g-crc32.adb
*** gcc-4.0.2/gcc/ada/g-crc32.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-crc32.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2001-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.CRC32 is
*** 49,57 ****
     procedure Update (C : in out CRC32; Value : Ada.Streams.Stream_Element) is
        function To_Char is new Unchecked_Conversion
          (Ada.Streams.Stream_Element, Character);
- 
        V : constant Character := To_Char (Value);
- 
     begin
        Update (C, V);
     end Update;
--- 49,55 ----
*************** package body GNAT.CRC32 is
*** 73,81 ****
     procedure Wide_Update (C : in out CRC32; Value : Wide_Character) is
        subtype S2 is String (1 .. 2);
        function To_S2 is new Unchecked_Conversion (Wide_Character, S2);
- 
        VS : constant S2 := To_S2 (Value);
- 
     begin
        Update (C, VS (1));
        Update (C, VS (2));
--- 71,77 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-crc32.ads gcc-4.1.0/gcc/ada/g-crc32.ads
*** gcc-4.0.2/gcc/ada/g-crc32.ads	Mon Feb  2 12:31:52 2004
--- gcc-4.1.0/gcc/ada/g-crc32.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2004-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  called CRC-32. This is a checksum based on treating the binary data
  --  as a polynomial over a binary field, and the exact specifications of
  --  the CRC-32 algorithm are as follows:
! --
  --     Name   : "CRC-32"
  --     Width  : 32
  --     Poly   : 04C11DB7
--- 35,41 ----
  --  called CRC-32. This is a checksum based on treating the binary data
  --  as a polynomial over a binary field, and the exact specifications of
  --  the CRC-32 algorithm are as follows:
! 
  --     Name   : "CRC-32"
  --     Width  : 32
  --     Poly   : 04C11DB7
***************
*** 44,58 ****
  --     RefOut : True
  --     XorOut : FFFFFFFF
  --     Check  : CBF43926
! --
! --  Note that this is the algorithm used by PKZip, Ethernet and FDDI.
! --
  --  For more information about this algorithm see:
! --
! --  ftp://ftp.rocksoft.com/papers/crc_v3.txt
  
  --  "A Painless Guide to CRC Error Detection Algorithms", Ross N. Williams
! --
  --  "Computation of Cyclic Redundancy Checks via Table Look-Up", Communications
  --  of the ACM, Vol. 31 No. 8, pp.1008-1013 Aug. 1988. Sarwate, D.V.
  
--- 44,58 ----
  --     RefOut : True
  --     XorOut : FFFFFFFF
  --     Check  : CBF43926
! 
! --  Note that this is the algorithm used by PKZip, Ethernet and FDDI
! 
  --  For more information about this algorithm see:
! 
! --    ftp://ftp.rocksoft.com/papers/crc_v3.txt
  
  --  "A Painless Guide to CRC Error Detection Algorithms", Ross N. Williams
! 
  --  "Computation of Cyclic Redundancy Checks via Table Look-Up", Communications
  --  of the ACM, Vol. 31 No. 8, pp.1008-1013 Aug. 1988. Sarwate, D.V.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-ctrl_c.ads gcc-4.1.0/gcc/ada/g-ctrl_c.ads
*** gcc-4.0.2/gcc/ada/g-ctrl_c.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-ctrl_c.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --               Copyright (C) 2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                      Copyright (C) 2002-2005, AdaCore                    --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  --  This package may be used to intercept the interruption of a running
  --  program by the operator typing Control-C, without having to use an Ada
  --  interrupt handler protected object.
! --
! --  This package is currently implemented under Windows and Unix platforms.
! --
  --  Note concerning Unix systems:
  
  --  The behavior of this package when using tasking depends on the interaction
--- 34,42 ----
  --  This package may be used to intercept the interruption of a running
  --  program by the operator typing Control-C, without having to use an Ada
  --  interrupt handler protected object.
! 
! --  This package is currently implemented under Windows and Unix platforms
! 
  --  Note concerning Unix systems:
  
  --  The behavior of this package when using tasking depends on the interaction
*************** package GNAT.Ctrl_C is
*** 55,61 ****
     --  Handler_Type should not propagate exceptions.
  
     procedure Install_Handler (Handler : Handler_Type);
!    --  Set up Handler to be called if the operator hits Ctrl-C.
  
     procedure Uninstall_Handler;
     --  Reinstall the standard Control-C handler.
--- 55,61 ----
     --  Handler_Type should not propagate exceptions.
  
     procedure Install_Handler (Handler : Handler_Type);
!    --  Set up Handler to be called if the operator hits Ctrl-C
  
     procedure Uninstall_Handler;
     --  Reinstall the standard Control-C handler.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-curexc.ads gcc-4.1.0/gcc/ada/g-curexc.ads
*** gcc-4.0.2/gcc/ada/g-curexc.ads	Mon Apr  5 14:57:34 2004
--- gcc-4.1.0/gcc/ada/g-curexc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --         Copyright (C) 1996-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                      Copyright (C) 1996-2005, AdaCore                    --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,56 ****
  --  from an exception handler.
  
  package GNAT.Current_Exception is
! pragma Pure (Current_Exception);
  
     -----------------
     -- Subprograms --
     -----------------
  
!    --  Note: the lower bound of returnd String values is always one.
  
     function Exception_Information return String;
     --  Returns the result of calling Ada.Exceptions.Exception_Information
--- 44,56 ----
  --  from an exception handler.
  
  package GNAT.Current_Exception is
!    pragma Pure;
  
     -----------------
     -- Subprograms --
     -----------------
  
!    --  Note: the lower bound of returnd String values is always one
  
     function Exception_Information return String;
     --  Returns the result of calling Ada.Exceptions.Exception_Information
diff -Nrcpad gcc-4.0.2/gcc/ada/g-debpoo.adb gcc-4.1.0/gcc/ada/g-debpoo.adb
*** gcc-4.0.2/gcc/ada/g-debpoo.adb	Mon Jun 14 13:18:59 2004
--- gcc-4.1.0/gcc/ada/g-debpoo.adb	Tue Nov 15 13:59:11 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with GNAT.Traceback; use GNAT.Traceback;
*** 46,55 ****
  with Ada.Unchecked_Conversion;
  
  package body GNAT.Debug_Pools is
-    use System;
-    use System.Storage_Elements;
  
!    Default_Alignment : constant Storage_Offset := Standard'Maximum_Alignment;
     --  Alignment used for the memory chunks returned by Allocate. Using this
     --  value garantees that this alignment will be compatible with all types
     --  and at the same time makes it easy to find the location of the extra
--- 46,53 ----
  with Ada.Unchecked_Conversion;
  
  package body GNAT.Debug_Pools is
  
!    Default_Alignment : constant := Standard'Maximum_Alignment;
     --  Alignment used for the memory chunks returned by Allocate. Using this
     --  value garantees that this alignment will be compatible with all types
     --  and at the same time makes it easy to find the location of the extra
*************** package body GNAT.Debug_Pools is
*** 65,78 ****
     --  Maximum number of levels that will be ignored in backtraces. This is so
     --  that we still have enough significant levels in the tracebacks returned
     --  to the user.
     --  The value 10 is chosen as being greater than the maximum callgraph
     --  in this package. Its actual value is not really relevant, as long as it
     --  is high enough to make sure we still have enough frames to return to
     --  the user after we have hidden the frames internal to this package.
  
!    -----------------------
!    -- Tracebacks_Htable --
!    -----------------------
  
     --  This package needs to store one set of tracebacks for each allocation
     --  point (when was it allocated or deallocated). This would use too much
--- 63,77 ----
     --  Maximum number of levels that will be ignored in backtraces. This is so
     --  that we still have enough significant levels in the tracebacks returned
     --  to the user.
+    --
     --  The value 10 is chosen as being greater than the maximum callgraph
     --  in this package. Its actual value is not really relevant, as long as it
     --  is high enough to make sure we still have enough frames to return to
     --  the user after we have hidden the frames internal to this package.
  
!    ---------------------------
!    -- Back Trace Hash Table --
!    ---------------------------
  
     --  This package needs to store one set of tracebacks for each allocation
     --  point (when was it allocated or deallocated). This would use too much
*************** package body GNAT.Debug_Pools is
*** 105,123 ****
        Next      : Traceback_Htable_Elem_Ptr;
     end record;
  
     procedure Set_Next
       (E    : Traceback_Htable_Elem_Ptr;
        Next : Traceback_Htable_Elem_Ptr);
     function Next
!      (E    : Traceback_Htable_Elem_Ptr)
!       return Traceback_Htable_Elem_Ptr;
     function Get_Key
!      (E    : Traceback_Htable_Elem_Ptr)
!       return Tracebacks_Array_Access;
     function Hash (T : Tracebacks_Array_Access) return Header;
     function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean;
!    pragma Inline (Set_Next, Next, Get_Key, Hash);
!    --  Subprograms required for instantiation of the htable. See GNAT.HTable.
  
     package Backtrace_Htable is new GNAT.HTable.Static_HTable
       (Header_Num => Header,
--- 104,131 ----
        Next      : Traceback_Htable_Elem_Ptr;
     end record;
  
+    --  Subprograms used for the Backtrace_Htable instantiation
+ 
     procedure Set_Next
       (E    : Traceback_Htable_Elem_Ptr;
        Next : Traceback_Htable_Elem_Ptr);
+    pragma Inline (Set_Next);
+ 
     function Next
!      (E : Traceback_Htable_Elem_Ptr) return Traceback_Htable_Elem_Ptr;
!    pragma Inline (Next);
! 
     function Get_Key
!      (E : Traceback_Htable_Elem_Ptr) return Tracebacks_Array_Access;
!    pragma Inline (Get_Key);
! 
     function Hash (T : Tracebacks_Array_Access) return Header;
+    pragma Inline (Hash);
+ 
     function Equal (K1, K2 : Tracebacks_Array_Access) return Boolean;
!    --  Why is this not inlined???
! 
!    --  The hash table for back traces
  
     package Backtrace_Htable is new GNAT.HTable.Static_HTable
       (Header_Num => Header,
*************** package body GNAT.Debug_Pools is
*** 138,161 ****
     type Allocation_Header;
     type Allocation_Header_Access is access Allocation_Header;
  
-    --  The following record stores extra information that needs to be
-    --  memorized for each block allocated with the special debug pool.
- 
     type Traceback_Ptr_Or_Address is new System.Address;
     --  A type that acts as a C union, and is either a System.Address or a
     --  Traceback_Htable_Elem_Ptr.
  
     type Allocation_Header is record
        Allocation_Address : System.Address;
!       --  Address of the block returned by malloc, possibly unaligned.
  
!       Block_Size    : Storage_Offset;
        --  Needed only for advanced freeing algorithms (traverse all allocated
        --  blocks for potential references). This value is negated when the
        --  chunk of memory has been logically freed by the application. This
        --  chunk has not been physically released yet.
  
!       Alloc_Traceback   : Traceback_Htable_Elem_Ptr;
        Dealloc_Traceback : Traceback_Ptr_Or_Address;
        --  Pointer to the traceback for the allocation (if the memory chunk is
        --  still valid), or to the first deallocation otherwise. Make sure this
--- 146,171 ----
     type Allocation_Header;
     type Allocation_Header_Access is access Allocation_Header;
  
     type Traceback_Ptr_Or_Address is new System.Address;
     --  A type that acts as a C union, and is either a System.Address or a
     --  Traceback_Htable_Elem_Ptr.
  
+    --  The following record stores extra information that needs to be
+    --  memorized for each block allocated with the special debug pool.
+ 
     type Allocation_Header is record
        Allocation_Address : System.Address;
!       --  Address of the block returned by malloc, possibly unaligned
  
!       Block_Size : Storage_Offset;
        --  Needed only for advanced freeing algorithms (traverse all allocated
        --  blocks for potential references). This value is negated when the
        --  chunk of memory has been logically freed by the application. This
        --  chunk has not been physically released yet.
  
!       Alloc_Traceback : Traceback_Htable_Elem_Ptr;
!       --  ??? comment required
! 
        Dealloc_Traceback : Traceback_Ptr_Or_Address;
        --  Pointer to the traceback for the allocation (if the memory chunk is
        --  still valid), or to the first deallocation otherwise. Make sure this
*************** package body GNAT.Debug_Pools is
*** 179,200 ****
  
     function To_Address is new Ada.Unchecked_Conversion
       (Traceback_Ptr_Or_Address, System.Address);
     function To_Address is new Ada.Unchecked_Conversion
       (System.Address, Traceback_Ptr_Or_Address);
     function To_Traceback is new Ada.Unchecked_Conversion
       (Traceback_Ptr_Or_Address, Traceback_Htable_Elem_Ptr);
     function To_Traceback is new Ada.Unchecked_Conversion
       (Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address);
  
!    Header_Offset : constant Storage_Count
!      := Default_Alignment *
!      ((Allocation_Header'Size / System.Storage_Unit + Default_Alignment - 1)
!       / Default_Alignment);
!    --  Offset of user data after allocation header.
  
     Minimum_Allocation : constant Storage_Count :=
!      Default_Alignment - 1
!      + Header_Offset;
     --  Minimal allocation: size of allocation_header rounded up to next
     --  multiple of default alignment + worst-case padding.
  
--- 189,212 ----
  
     function To_Address is new Ada.Unchecked_Conversion
       (Traceback_Ptr_Or_Address, System.Address);
+ 
     function To_Address is new Ada.Unchecked_Conversion
       (System.Address, Traceback_Ptr_Or_Address);
+ 
     function To_Traceback is new Ada.Unchecked_Conversion
       (Traceback_Ptr_Or_Address, Traceback_Htable_Elem_Ptr);
+ 
     function To_Traceback is new Ada.Unchecked_Conversion
       (Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address);
  
!    Header_Offset : constant Storage_Count :=
!                      Default_Alignment *
!                        ((Allocation_Header'Size / System.Storage_Unit
!                           + Default_Alignment - 1) / Default_Alignment);
!    --  Offset of user data after allocation header
  
     Minimum_Allocation : constant Storage_Count :=
!                           Default_Alignment - 1 + Header_Offset;
     --  Minimal allocation: size of allocation_header rounded up to next
     --  multiple of default alignment + worst-case padding.
  
*************** package body GNAT.Debug_Pools is
*** 202,215 ****
     -- Allocations table --
     -----------------------
  
!    --  This table is indexed on addresses modulo Default_Alignment, and
!    --  for each index it indicates whether that memory block is valid.
!    --  Its behavior is similar to GNAT.Table, except that we need to pack
!    --  the table to save space, so we cannot reuse GNAT.Table as is.
  
!    --  This table is the reason why all alignments have to be forced to a
!    --  common value (Default_Alignment), so that this table can be
!    --  kept to a reasonnable size.
  
     type Byte is mod 2 ** System.Storage_Unit;
  
--- 214,227 ----
     -- Allocations table --
     -----------------------
  
!    --  This table is indexed on addresses modulo Default_Alignment, and for
!    --  each index it indicates whether that memory block is valid. Its behavior
!    --  is similar to GNAT.Table, except that we need to pack the table to save
!    --  space, so we cannot reuse GNAT.Table as is.
  
!    --  This table is the reason why all alignments have to be forced to common
!    --  value (Default_Alignment), so that this table can be kept to a
!    --  reasonnable size.
  
     type Byte is mod 2 ** System.Storage_Unit;
  
*************** package body GNAT.Debug_Pools is
*** 244,261 ****
     --  These two variables represents a mapping of the currently allocated
     --  memory. Every time the pool works on an address, we first check that the
     --  index Address / Default_Alignment is True. If not, this means that this
!    --  address is not under control of the debug pool, and thus this is
!    --  probably an invalid memory access (it could also be a general access
!    --  type).
     --
     --  Note that in fact we never allocate the full size of Big_Table, only a
     --  slice big enough to manage the currently allocated memory.
  
!    Edata  : System.Address := System.Null_Address;
     --  Address in memory that matches the index 0 in Valid_Blocks. It is named
     --  after the symbol _edata, which, on most systems, indicate the lowest
!    --  possible address returned by malloc. Unfortunately, this symbol
!    --  doesn't exist on windows, so we cannot use it instead of this variable.
  
     -----------------------
     -- Local subprograms --
--- 256,272 ----
     --  These two variables represents a mapping of the currently allocated
     --  memory. Every time the pool works on an address, we first check that the
     --  index Address / Default_Alignment is True. If not, this means that this
!    --  address is not under control of the debug pool and thus this is probably
!    --  an invalid memory access (it could also be a general access type).
     --
     --  Note that in fact we never allocate the full size of Big_Table, only a
     --  slice big enough to manage the currently allocated memory.
  
!    Edata : System.Address := System.Null_Address;
     --  Address in memory that matches the index 0 in Valid_Blocks. It is named
     --  after the symbol _edata, which, on most systems, indicate the lowest
!    --  possible address returned by malloc. Unfortunately, this symbol doesn't
!    --  exist on windows, so we cannot use it instead of this variable.
  
     -----------------------
     -- Local subprograms --
*************** package body GNAT.Debug_Pools is
*** 266,281 ****
        Kind                : Traceback_Kind;
        Size                : Storage_Count;
        Ignored_Frame_Start : System.Address;
!       Ignored_Frame_End   : System.Address)
!       return                Traceback_Htable_Elem_Ptr;
     --  Return an element matching the current traceback (omitting the frames
     --  that are in the current package). If this traceback already existed in
     --  the htable, a pointer to this is returned to spare memory. Null is
     --  returned if the pool is set not to store tracebacks. If the traceback
     --  already existed in the table, the count is incremented so that
!    --  Dump_Tracebacks returns useful results.
!    --  All addresses up to, and including, an address between
!    --  Ignored_Frame_Start .. Ignored_Frame_End are ignored.
  
     procedure Put_Line
       (Depth               : Natural;
--- 277,291 ----
        Kind                : Traceback_Kind;
        Size                : Storage_Count;
        Ignored_Frame_Start : System.Address;
!       Ignored_Frame_End   : System.Address) return Traceback_Htable_Elem_Ptr;
     --  Return an element matching the current traceback (omitting the frames
     --  that are in the current package). If this traceback already existed in
     --  the htable, a pointer to this is returned to spare memory. Null is
     --  returned if the pool is set not to store tracebacks. If the traceback
     --  already existed in the table, the count is incremented so that
!    --  Dump_Tracebacks returns useful results. All addresses up to, and
!    --  including, an address between Ignored_Frame_Start .. Ignored_Frame_End
!    --  are ignored.
  
     procedure Put_Line
       (Depth               : Natural;
*************** package body GNAT.Debug_Pools is
*** 366,374 ****
     ----------
  
     function Next
!      (E    : Traceback_Htable_Elem_Ptr)
!       return Traceback_Htable_Elem_Ptr
!    is
     begin
        return E.Next;
     end Next;
--- 376,382 ----
     ----------
  
     function Next
!      (E : Traceback_Htable_Elem_Ptr) return Traceback_Htable_Elem_Ptr is
     begin
        return E.Next;
     end Next;
*************** package body GNAT.Debug_Pools is
*** 388,395 ****
     -------------
  
     function Get_Key
!      (E    : Traceback_Htable_Elem_Ptr)
!       return Tracebacks_Array_Access
     is
     begin
        return E.Traceback;
--- 396,402 ----
     -------------
  
     function Get_Key
!      (E : Traceback_Htable_Elem_Ptr) return Tracebacks_Array_Access
     is
     begin
        return E.Traceback;
*************** package body GNAT.Debug_Pools is
*** 401,410 ****
--- 408,419 ----
  
     function Hash (T : Tracebacks_Array_Access) return Header is
        Result : Integer_Address := 0;
+ 
     begin
        for X in T'Range loop
           Result := Result + To_Integer (PC_For (T (X)));
        end loop;
+ 
        return Header (1 + Result mod Integer_Address (Header'Last));
     end Hash;
  
*************** package body GNAT.Debug_Pools is
*** 498,505 ****
        Kind                : Traceback_Kind;
        Size                : Storage_Count;
        Ignored_Frame_Start : System.Address;
!       Ignored_Frame_End   : System.Address)
!       return                Traceback_Htable_Elem_Ptr
     is
     begin
        if Pool.Stack_Trace_Depth = 0 then
--- 507,513 ----
        Kind                : Traceback_Kind;
        Size                : Storage_Count;
        Ignored_Frame_Start : System.Address;
!       Ignored_Frame_End   : System.Address) return Traceback_Htable_Elem_Ptr
     is
     begin
        if Pool.Stack_Trace_Depth = 0 then
*************** package body GNAT.Debug_Pools is
*** 517,523 ****
           Skip_Levels (Pool.Stack_Trace_Depth, Trace, Start, Len,
                        Ignored_Frame_Start, Ignored_Frame_End);
  
!          --  Check if the traceback is already in the table.
  
           Elem :=
             Backtrace_Htable.Get (Trace (Start .. Len)'Unrestricted_Access);
--- 525,531 ----
           Skip_Levels (Pool.Stack_Trace_Depth, Trace, Start, Len,
                        Ignored_Frame_Start, Ignored_Frame_End);
  
!          --  Check if the traceback is already in the table
  
           Elem :=
             Backtrace_Htable.Get (Trace (Start .. Len)'Unrestricted_Access);
*************** package body GNAT.Debug_Pools is
*** 549,557 ****
     function Is_Valid (Storage : System.Address) return Boolean is
        Offset : constant Storage_Offset :=
                   (Storage - Edata) / Default_Alignment;
- 
        Bit : constant Byte := 2 ** Natural (Offset mod System.Storage_Unit);
- 
     begin
        return (Storage mod Default_Alignment) = 0
          and then Offset >= 0
--- 557,563 ----
*************** package body GNAT.Debug_Pools is
*** 623,635 ****
           Valid_Blocks_Size := Valid_Blocks_Size + Bytes;
  
           --  Take into the account the new start address
           Edata := Storage - Edata_Align + (Edata - Storage) mod Edata_Align;
        end if;
  
        --  Second case : the new address is outside of the current scope of
!       --  Valid_Blocks, so we have to grow the table as appropriate
  
!       Offset := (Storage - Edata) / Default_Alignment;
  
        if Offset >= Valid_Blocks_Size * System.Storage_Unit then
           Bytes := Valid_Blocks_Size;
--- 629,655 ----
           Valid_Blocks_Size := Valid_Blocks_Size + Bytes;
  
           --  Take into the account the new start address
+ 
           Edata := Storage - Edata_Align + (Edata - Storage) mod Edata_Align;
        end if;
  
        --  Second case : the new address is outside of the current scope of
!       --  Valid_Blocks, so we have to grow the table as appropriate.
  
!       --  Note: it might seem more natural for the following statement to
!       --  be written:
! 
!       --      Offset := (Storage - Edata) / Default_Alignment;
! 
!       --  but that won't work since Storage_Offset is signed, and it is
!       --  possible to subtract a small address from a large address and
!       --  get a negative value. This may seem strange, but it is quite
!       --  specifically allowed in the RM, and is what most implementations
!       --  including GNAT actually do. Hence the conversion to Integer_Address
!       --  which is a full range modular type, not subject to this glitch.
! 
!       Offset := Storage_Offset ((To_Integer (Storage) - To_Integer (Edata)) /
!                                               Default_Alignment);
  
        if Offset >= Valid_Blocks_Size * System.Storage_Unit then
           Bytes := Valid_Blocks_Size;
*************** package body GNAT.Debug_Pools is
*** 719,728 ****
              P := new Local_Storage_Array;
        end;
  
!       Storage_Address := System.Null_Address + Default_Alignment
!         * (((P.all'Address + Default_Alignment - 1) - System.Null_Address)
!            / Default_Alignment)
          + Header_Offset;
        pragma Assert ((Storage_Address - System.Null_Address)
                       mod Default_Alignment = 0);
        pragma Assert (Storage_Address + Size_In_Storage_Elements
--- 739,750 ----
              P := new Local_Storage_Array;
        end;
  
!       Storage_Address :=
!         System.Null_Address + Default_Alignment
!           * (((P.all'Address + Default_Alignment - 1) - System.Null_Address)
!              / Default_Alignment)
          + Header_Offset;
+ 
        pragma Assert ((Storage_Address - System.Null_Address)
                       mod Default_Alignment = 0);
        pragma Assert (Storage_Address + Size_In_Storage_Elements
*************** package body GNAT.Debug_Pools is
*** 942,948 ****
                 System.Memory.Free (Header.Allocation_Address);
                 Set_Valid (Tmp, False);
  
!                --  Remove this block from the list.
  
                 if Previous = System.Null_Address then
                    Pool.First_Free_Block := Next;
--- 964,970 ----
                 System.Memory.Free (Header.Allocation_Address);
                 Set_Valid (Tmp, False);
  
!                --  Remove this block from the list
  
                 if Previous = System.Null_Address then
                    Pool.First_Free_Block := Next;
*************** package body GNAT.Debug_Pools is
*** 1040,1046 ****
        procedure Reset_Marks is
           Current : System.Address := Pool.First_Free_Block;
           Header  : Allocation_Header_Access;
- 
        begin
           while Current /= System.Null_Address loop
              Header := Header_Of (Current);
--- 1062,1067 ----
*************** package body GNAT.Debug_Pools is
*** 1123,1132 ****
                        Code_Address_For_Deallocate_End);
              Put ("   Memory already deallocated at ");
              Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
           end if;
  
        else
!          --  Remove this block from the list of used blocks.
  
           Previous :=
             To_Address (Header_Of (Storage_Address).Dealloc_Traceback);
--- 1144,1155 ----
                        Code_Address_For_Deallocate_End);
              Put ("   Memory already deallocated at ");
              Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
+             Put ("   Memory was allocated at ");
+             Put_Line (0, Header.Alloc_Traceback.Traceback);
           end if;
  
        else
!          --  Remove this block from the list of used blocks
  
           Previous :=
             To_Address (Header_Of (Storage_Address).Dealloc_Traceback);
*************** package body GNAT.Debug_Pools is
*** 1257,1262 ****
--- 1280,1287 ----
                    Code_Address_For_Dereference_End);
                 Put ("  First deallocation at ");
                 Put_Line (0, To_Traceback (Header.Dealloc_Traceback).Traceback);
+                Put ("  Initial allocation at ");
+                Put_Line (0, Header.Alloc_Traceback.Traceback);
              end if;
           end if;
        end if;
*************** package body GNAT.Debug_Pools is
*** 1285,1291 ****
        Display_Slots : Boolean := False;
        Display_Leaks : Boolean := False)
     is
-       use System.Storage_Elements;
  
        package Backtrace_Htable_Cumulate is new GNAT.HTable.Static_HTable
          (Header_Num => Header,
--- 1310,1315 ----
*************** package body GNAT.Debug_Pools is
*** 1458,1464 ****
  
     function Storage_Size (Pool : Debug_Pool) return Storage_Count is
        pragma Unreferenced (Pool);
- 
     begin
        return Storage_Count'Last;
     end Storage_Size;
--- 1482,1487 ----
*************** package body GNAT.Debug_Pools is
*** 1534,1540 ****
        procedure Internal is new Print_Info
          (Put_Line => GNAT.IO.Put_Line,
           Put      => GNAT.IO.Put);
- 
     begin
        Internal (Pool, Cumulate, Display_Slots, Display_Leaks);
     end Print_Info_Stdout;
--- 1557,1562 ----
*************** package body GNAT.Debug_Pools is
*** 1593,1601 ****
           Tracebk := Header.Alloc_Traceback.Traceback;
           Num_Calls := Tracebk'Length;
  
!          --  Code taken from memtrack.adb in GNAT's sources
!          --  Logs allocation call
!          --  format is:
           --   'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
  
           fputc (Character'Pos ('A'), File);
--- 1615,1624 ----
           Tracebk := Header.Alloc_Traceback.Traceback;
           Num_Calls := Tracebk'Length;
  
!          --  (Code taken from memtrack.adb in GNAT's sources)
! 
!          --  Logs allocation call using the format:
! 
           --   'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
  
           fputc (Character'Pos ('A'), File);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-debpoo.ads gcc-4.1.0/gcc/ada/g-debpoo.ads
*** gcc-4.0.2/gcc/ada/g-debpoo.ads	Fri Jun 25 16:39:27 2004
--- gcc-4.1.0/gcc/ada/g-debpoo.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This packages provides a special implementation of the Ada95 storage pools.
  
  --  The goal of this debug pool is to detect incorrect uses of memory
  --  (multiple deallocations, access to invalid memory,...). Errors are reported
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This packages provides a special implementation of the Ada95 storage pools
  
  --  The goal of this debug pool is to detect incorrect uses of memory
  --  (multiple deallocations, access to invalid memory,...). Errors are reported
***************
*** 70,76 ****
  --  of memory that was allocated. The pool is also designed to work correctly
  --  in conjunction with gnatmem.
  
! --  Finally, a subprogram Print_Pool is provided for use from the debugger.
  
  --  Limitations
  --  ===========
--- 70,76 ----
  --  of memory that was allocated. The pool is also designed to work correctly
  --  in conjunction with gnatmem.
  
! --  Finally, a subprogram Print_Pool is provided for use from the debugger
  
  --  Limitations
  --  ===========
***************
*** 85,91 ****
  --  This allows faster checks, and limits the performance impact of using
  --  this pool.
  
- 
  with System;                  use System;
  with System.Storage_Elements; use System.Storage_Elements;
  with System.Checked_Pools;
--- 85,90 ----
*************** private
*** 301,307 ****
        --  accesed to deallocated memory.
  
        Physically_Deallocated : Byte_Count := 0;
!       --  Total number of bytes that were free()-ed.
  
        Marked_Blocks_Deallocated : Boolean := False;
        --  Set to true if some mark blocks had to be deallocated in the advanced
--- 300,306 ----
        --  accesed to deallocated memory.
  
        Physically_Deallocated : Byte_Count := 0;
!       --  Total number of bytes that were free()-ed
  
        Marked_Blocks_Deallocated : Boolean := False;
        --  Set to true if some mark blocks had to be deallocated in the advanced
*************** private
*** 314,320 ****
  
        First_Free_Block : System.Address := System.Null_Address;
        Last_Free_Block  : System.Address := System.Null_Address;
!       --  Pointers to the first and last logically freed blocks.
  
        First_Used_Block : System.Address := System.Null_Address;
        --  Pointer to the list of currently allocated blocks. This list is
--- 313,319 ----
  
        First_Free_Block : System.Address := System.Null_Address;
        Last_Free_Block  : System.Address := System.Null_Address;
!       --  Pointers to the first and last logically freed blocks
  
        First_Used_Block : System.Address := System.Null_Address;
        --  Pointer to the list of currently allocated blocks. This list is
diff -Nrcpad gcc-4.0.2/gcc/ada/g-debuti.adb gcc-4.1.0/gcc/ada/g-debuti.adb
*** gcc-4.0.2/gcc/ada/g-debuti.adb	Mon Jan  5 15:20:44 2004
--- gcc-4.1.0/gcc/ada/g-debuti.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1997-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Debug_Utilities is
*** 47,59 ****
  
     function Image (A : Address) return Image_String is
        S : Image_String;
!       P : Natural := Address_Image_Length - 1;
!       N : Integer_Address := To_Integer (A);
        U : Natural := 0;
  
     begin
        S (S'Last) := '#';
! 
        while P > 3 loop
           if U = 4 then
              S (P) := '_';
--- 47,60 ----
  
     function Image (A : Address) return Image_String is
        S : Image_String;
!       P : Natural;
!       N : Integer_Address;
        U : Natural := 0;
  
     begin
        S (S'Last) := '#';
!       P := Address_Image_Length - 1;
!       N := To_Integer (A);
        while P > 3 loop
           if U = 4 then
              S (P) := '_';
diff -Nrcpad gcc-4.0.2/gcc/ada/g-debuti.ads gcc-4.1.0/gcc/ada/g-debuti.ads
*** gcc-4.0.2/gcc/ada/g-debuti.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-debuti.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 G N A T . D E B U G _ U T I L I T I E S                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 G N A T . D E B U G _ U T I L I T I E S                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  with System;
  
  package GNAT.Debug_Utilities is
! pragma Pure (Debug_Utilities);
  
     Address_64 : constant Boolean := Standard'Address_Size = 64;
     --  Set true if 64 bit addresses (assumes only 32 and 64 are possible)
--- 39,45 ----
  with System;
  
  package GNAT.Debug_Utilities is
!    pragma Pure;
  
     Address_64 : constant Boolean := Standard'Address_Size = 64;
     --  Set true if 64 bit addresses (assumes only 32 and 64 are possible)
diff -Nrcpad gcc-4.0.2/gcc/ada/g-diopit.adb gcc-4.1.0/gcc/ada/g-diopit.adb
*** gcc-4.0.2/gcc/ada/g-diopit.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-diopit.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2001-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Directory_Operations.I
*** 57,63 ****
        --  recursively for each sub-directories.
  
        function Make_Pathname (Dir, File : String) return String;
!       --  Returns the pathname for File by adding Dir as prefix.
  
        -------------------
        -- Make_Pathname --
--- 57,63 ----
        --  recursively for each sub-directories.
  
        function Make_Pathname (Dir, File : String) return String;
!       --  Returns the pathname for File by adding Dir as prefix
  
        -------------------
        -- Make_Pathname --
*************** package body GNAT.Directory_Operations.I
*** 91,98 ****
  
              declare
                 Dir_Entry : constant String := Buffer (1 .. Last);
!                Pathname  : constant String
!                  := Make_Pathname (Directory, Dir_Entry);
              begin
                 if Regexp.Match (Dir_Entry, File_Regexp) then
                    Quit  := False;
--- 91,99 ----
  
              declare
                 Dir_Entry : constant String := Buffer (1 .. Last);
!                Pathname  : constant String :=
!                              Make_Pathname (Directory, Dir_Entry);
! 
              begin
                 if Regexp.Match (Dir_Entry, File_Regexp) then
                    Quit  := False;
*************** package body GNAT.Directory_Operations.I
*** 203,209 ****
                 --  We have "../dir"
  
                 Read (Current_Path & "..",
!                      SP (SP'First + 4 .. DS - 1),
                       SP (DS .. SP'Last));
              end if;
  
--- 204,210 ----
                 --  We have "../dir"
  
                 Read (Current_Path & "..",
!                      SP (SP'First + 3 .. DS - 1),
                       SP (DS .. SP'Last));
              end if;
  
*************** package body GNAT.Directory_Operations.I
*** 308,314 ****
        ----------
  
        Quit : Boolean := False;
!       --  Global state to be able to exit all recursive calls.
  
        procedure Read
          (Directory      : String;
--- 309,315 ----
        ----------
  
        Quit : Boolean := False;
!       --  Global state to be able to exit all recursive calls
  
        procedure Read
          (Directory      : String;
*************** package body GNAT.Directory_Operations.I
*** 322,329 ****
           Last   : Natural;
  
        begin
!          if OS_Lib.Is_Directory (Directory) then
!             Open (Dir, Directory);
  
              Dir_Iterator : loop
                 Read (Dir, Buffer, Last);
--- 323,330 ----
           Last   : Natural;
  
        begin
!          if OS_Lib.Is_Directory (Directory & Dir_Separator) then
!             Open (Dir, Directory & Dir_Separator);
  
              Dir_Iterator : loop
                 Read (Dir, Buffer, Last);
*************** package body GNAT.Directory_Operations.I
*** 343,349 ****
                       (Dir_Entry = ".." and then File_Pattern /= ".."))
                    then
                       if Regexp.Match (Dir_Entry, File_Regexp) then
- 
                          if Suffix_Pattern = "" then
  
                             --  No more matching needed, call user's callback
--- 344,349 ----
*************** package body GNAT.Directory_Operations.I
*** 352,366 ****
  
                             begin
                                Action (Pathname, Index, Quit);
- 
                             exception
                                when others =>
                                   Close (Dir);
                                   raise;
                             end;
  
-                            exit Dir_Iterator when Quit;
- 
                          else
                             --  Down one level
  
--- 352,363 ----
*************** package body GNAT.Directory_Operations.I
*** 372,386 ****
                    end if;
                 end;
  
!                exit Dir_Iterator when Quit;
  
              end loop Dir_Iterator;
  
              Close (Dir);
           end if;
        end Read;
  
     begin
        Next_Level ("", Path);
     end Wildcard_Iterator;
  
--- 369,391 ----
                    end if;
                 end;
  
!                --  Exit if Quit set by call to Action, either at this level
!                --  or at at some lower recursive call to Next_Level.
  
+                exit Dir_Iterator when Quit;
              end loop Dir_Iterator;
  
              Close (Dir);
           end if;
        end Read;
  
+    --  Start of processing for Wildcard_Iterator
+ 
     begin
+       if Path = "" then
+          return;
+       end if;
+ 
        Next_Level ("", Path);
     end Wildcard_Iterator;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-diopit.ads gcc-4.1.0/gcc/ada/g-diopit.ads
*** gcc-4.0.2/gcc/ada/g-diopit.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-diopit.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dirope.adb gcc-4.1.0/gcc/ada/g-dirope.adb
*** gcc-4.0.2/gcc/ada/g-dirope.adb	Thu Feb 10 13:49:14 2005
--- gcc-4.1.0/gcc/ada/g-dirope.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1998-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Directory_Operations i
*** 105,115 ****
              Cut_Start := Cut_Start + 1;
           end if;
  
!          --  Cut_End point to the last basename character.
  
           Cut_End := Path'Last;
  
!          --  If basename ends with Suffix, adjust Cut_End.
  
           if Suffix /= ""
             and then Path (Path'Last - Suffix'Length + 1 .. Cut_End) = Suffix
--- 105,115 ----
              Cut_Start := Cut_Start + 1;
           end if;
  
!          --  Cut_End point to the last basename character
  
           Cut_End := Path'Last;
  
!          --  If basename ends with Suffix, adjust Cut_End
  
           if Suffix /= ""
             and then Path (Path'Last - Suffix'Length + 1 .. Cut_End) = Suffix
*************** package body GNAT.Directory_Operations i
*** 279,286 ****
  
        procedure Double_Result_Size is
           New_Result : constant OS_Lib.String_Access :=
!            new String (1 .. 2 * Result'Last);
! 
        begin
           New_Result (1 .. Result_Last) := Result (1 .. Result_Last);
           OS_Lib.Free (Result);
--- 279,285 ----
  
        procedure Double_Result_Size is
           New_Result : constant OS_Lib.String_Access :=
!                         new String (1 .. 2 * Result'Last);
        begin
           New_Result (1 .. Result_Last) := Result (1 .. Result_Last);
           OS_Lib.Free (Result);
*************** package body GNAT.Directory_Operations i
*** 306,311 ****
--- 305,311 ----
  
        procedure Read (K : in out Positive) is
           P : Character;
+ 
        begin
           For_All_Characters : loop
              if Is_Var_Prefix (Path (K)) then
*************** package body GNAT.Directory_Operations i
*** 314,320 ****
                 --  Could be a variable
  
                 if K < Path'Last then
- 
                    if Path (K + 1) = P then
  
                       --  Not a variable after all, this is a double $ or %,
--- 314,319 ----
*************** package body GNAT.Directory_Operations i
*** 566,572 ****
     function Get_Current_Dir return Dir_Name_Str is
        Current_Dir : String (1 .. Max_Path + 1);
        Last        : Natural;
- 
     begin
        Get_Current_Dir (Current_Dir, Last);
        return Current_Dir (1 .. Last);
--- 565,570 ----
*************** package body GNAT.Directory_Operations i
*** 708,718 ****
     -------------------------
  
     function Read_Is_Thread_Safe return Boolean is
- 
        function readdir_is_thread_safe return Integer;
        pragma Import
          (C, readdir_is_thread_safe, "__gnat_readdir_is_thread_safe");
- 
     begin
        return (readdir_is_thread_safe /= 0);
     end Read_Is_Thread_Safe;
--- 706,714 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dirope.ads gcc-4.1.0/gcc/ada/g-dirope.ads
*** gcc-4.0.2/gcc/ada/g-dirope.ads	Mon Oct  4 15:00:26 2004
--- gcc-4.1.0/gcc/ada/g-dirope.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1998-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Directory_Operations is
*** 94,100 ****
     --  Dir_Name. Raises Directory_Error if Dir_Name cannot be removed.
  
     function Get_Current_Dir return Dir_Name_Str;
!    --  Returns the current working directory for the execution environment.
  
     procedure Get_Current_Dir (Dir : out Dir_Name_Str; Last : out Natural);
     --  Returns the current working directory for the execution environment
--- 94,100 ----
     --  Dir_Name. Raises Directory_Error if Dir_Name cannot be removed.
  
     function Get_Current_Dir return Dir_Name_Str;
!    --  Returns the current working directory for the execution environment
  
     procedure Get_Current_Dir (Dir : out Dir_Name_Str; Last : out Natural);
     --  Returns the current working directory for the execution environment
*************** package GNAT.Directory_Operations is
*** 137,142 ****
--- 137,146 ----
     --  The comparison of Suffix is case-insensitive on systems such as Windows
     --  and VMS where the file search is case-insensitive (e.g. on such systems,
     --  Base_Name ("/Users/AdaCore/BB12.patch", ".Patch") returns "BB12").
+    --
+    --  Note that the index bounds of the result match the corresponding indexes
+    --  in the Path string (you cannot assume that the lower bound of the
+    --  returned string is one).
  
     function File_Extension (Path : Path_Name) return String;
     --  Return the file extension. This is defined as the string after the
*************** package GNAT.Directory_Operations is
*** 150,165 ****
     --  path information. This is equivalent to Base_Name with default Extension
     --  value.
  
!    type Path_Style is
!      (UNIX,
!       --  Use '/' as the directory separator. The default on Unix systems
!       --  and on OpenVMS.
! 
!       DOS,
!       --  Use '\' as the directory separator. The default on Windows.
! 
!       System_Default);
! 
     function Format_Pathname
       (Path  : Path_Name;
        Style : Path_Style := System_Default) return Path_Name;
--- 154,160 ----
     --  path information. This is equivalent to Base_Name with default Extension
     --  value.
  
!    type Path_Style is (UNIX, DOS, System_Default);
     function Format_Pathname
       (Path  : Path_Name;
        Style : Path_Style := System_Default) return Path_Name;
*************** package GNAT.Directory_Operations is
*** 168,193 ****
     --  function will help to provide a consistent naming scheme running for
     --  different environments. If style is set to System_Default the routine
     --  will use the default directory separator on the running environment.
  
!    type Environment_Style is
!      (UNIX,
!       --  Environment variables and OpenVMS logical names use $ as prefix and
!       --  can use curly brackets as in ${HOME}/mydir. If there is no closing
!       --  curly bracket for an opening one then translation is done, so for
!       --  example ${VAR/toto is returned as ${VAR/toto.
! 
!       DOS,
!       --  Environment variables uses % as prefix and suffix
!       --  (e.g. %HOME%/mydir). The name DOS refer to "DOS-like" environment.
!       --  This includes al Windows systems.
! 
!       Both,
!       --  Recognize both forms described above.
! 
!       System_Default);
!       --  Uses either UNIX on Unix and OpenVMS systems, or DOS on Windows and
!       --  OS/2 depending on the running environment.
! 
     function Expand_Path
       (Path : Path_Name;
        Mode : Environment_Style := System_Default) return Path_Name;
--- 163,182 ----
     --  function will help to provide a consistent naming scheme running for
     --  different environments. If style is set to System_Default the routine
     --  will use the default directory separator on the running environment.
+    --
+    --  The Style argument indicates the syntax to be used for path names:
+    --
+    --    UNIX
+    --      Use '/' as the directory separator. The default on Unix systems
+    --      and on OpenVMS.
+    --
+    --    DOS
+    --      Use '\' as the directory separator. The default on Windows.
+    --
+    --    System_Default
+    --      Use the default style for the current system
  
!    type Environment_Style is (UNIX, DOS, Both, System_Default);
     function Expand_Path
       (Path : Path_Name;
        Mode : Environment_Style := System_Default) return Path_Name;
*************** package GNAT.Directory_Operations is
*** 198,203 ****
--- 187,215 ----
     --  variable does not exists the variable will be replaced by the empty
     --  string. Two dollar or percent signs are replaced by a single
     --  dollar/percent sign. Note that a variable must start with a letter.
+    --
+    --  The Mode argument indicates the recognized syntax for environment
+    --  variables as follows:
+    --
+    --    UNIX
+    --      Environment variables and OpenVMS logical names use $ as prefix and
+    --      can use curly brackets as in ${HOME}/mydir. If there is no closing
+    --      curly bracket for an opening one then no translation is done, so for
+    --      example ${VAR/toto is returned as ${VAR/toto. The use of {} brackets
+    --      is required if the environment variable name contains other than
+    --      alphanumeric characters.
+    --
+    --    DOS
+    --      Environment variables uses % as prefix and suffix (e.g. %HOME%/dir).
+    --      The name DOS refer to "DOS-like" environment. This includes all
+    --      Windows systems.
+    --
+    --    Both
+    --      Recognize both forms described above.
+    --
+    --    System_Default
+    --      Uses either UNIX on Unix and OpenVMS systems, or DOS on Windows and
+    --      OS/2 depending on the running environment.
  
     ---------------
     -- Iterators --
*************** package GNAT.Directory_Operations is
*** 215,221 ****
     --  Raises Directory_Error if Dir has not be opened (Dir = Null_Dir).
  
     function Is_Open (Dir : Dir_Type) return Boolean;
!    --  Returns True if Dir is open, or False otherwise.
  
     procedure Read
       (Dir  : in out Dir_Type;
--- 227,233 ----
     --  Raises Directory_Error if Dir has not be opened (Dir = Null_Dir).
  
     function Is_Open (Dir : Dir_Type) return Boolean;
!    --  Returns True if Dir is open, or False otherwise
  
     procedure Read
       (Dir  : in out Dir_Type;
*************** private
*** 251,256 ****
  
     Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
                  Ada.Strings.Maps.To_Set ("/\");
!    --  UNIX and DOS style directory separators.
  
  end GNAT.Directory_Operations;
--- 263,268 ----
  
     Dir_Seps : constant Ada.Strings.Maps.Character_Set :=
                  Ada.Strings.Maps.To_Set ("/\");
!    --  UNIX and DOS style directory separators
  
  end GNAT.Directory_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dynhta.adb gcc-4.1.0/gcc/ada/g-dynhta.adb
*** gcc-4.0.2/gcc/ada/g-dynhta.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/g-dynhta.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 G N A T . D Y N A M I C _ H T A B L E S                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 G N A T . D Y N A M I C _ H T A B L E S                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with Ada.Unchecked_Deallocation;
+ 
  package body GNAT.Dynamic_HTables is
  
     -------------------
*************** package body GNAT.Dynamic_HTables is
*** 179,184 ****
--- 180,188 ----
        -----------
  
        procedure Reset (T : in out Instance) is
+          procedure Free is
+            new Ada.Unchecked_Deallocation (Instance_Data, Instance);
+ 
        begin
           if T = null then
              return;
*************** package body GNAT.Dynamic_HTables is
*** 187,192 ****
--- 191,198 ----
           for J in T.Table'Range loop
              T.Table (J) := Null_Ptr;
           end loop;
+ 
+          Free (T);
        end Reset;
  
        ---------
*************** package body GNAT.Dynamic_HTables is
*** 205,210 ****
--- 211,217 ----
           Set_Next (E, T.Table (Index));
           T.Table (Index) := E;
        end Set;
+ 
     end Static_HTable;
  
     -------------------
*************** package body GNAT.Dynamic_HTables is
*** 264,270 ****
  
        function Get_Next (T : Instance) return Element is
           Tmp : constant Elmt_Ptr := Tab.Get_Next (Tab.Instance (T));
- 
        begin
           if Tmp = null then
              return No_Element;
--- 271,276 ----
*************** package body GNAT.Dynamic_HTables is
*** 322,328 ****
  
        procedure Set (T : in out Instance; K : Key; E : Element) is
           Tmp : constant Elmt_Ptr := Tab.Get (Tab.Instance (T), K);
- 
        begin
           if Tmp = null then
              Tab.Set (Tab.Instance (T), new Element_Wrapper'(K, E, null));
--- 328,333 ----
*************** package body GNAT.Dynamic_HTables is
*** 339,344 ****
--- 344,350 ----
        begin
           E.Next := Next;
        end Set_Next;
+ 
     end Simple_HTable;
  
  end GNAT.Dynamic_HTables;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dynhta.ads gcc-4.1.0/gcc/ada/g-dynhta.ads
*** gcc-4.0.2/gcc/ada/g-dynhta.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-dynhta.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 G N A T . D Y N A M I C _ H T A B L E S                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 G N A T . D Y N A M I C _ H T A B L E S                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Dynamic_HTables is
*** 75,81 ****
  
     generic
        type Header_Num is range <>;
!       --  An integer type indicating the number and range of hash headers.
  
        type Element (<>) is limited private;
        --  The type of element to be stored
--- 75,81 ----
  
     generic
        type Header_Num is range <>;
!       --  An integer type indicating the number and range of hash headers
  
        type Element (<>) is limited private;
        --  The type of element to be stored
*************** package GNAT.Dynamic_HTables is
*** 85,91 ****
        --  type, but could be some other form of type such as an integer type).
  
        Null_Ptr : Elmt_Ptr;
!       --  The null value of the Elmt_Ptr type.
  
        with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
        with function  Next     (E : Elmt_Ptr) return Elmt_Ptr;
--- 85,91 ----
        --  type, but could be some other form of type such as an integer type).
  
        Null_Ptr : Elmt_Ptr;
!       --  The null value of the Elmt_Ptr type
  
        with procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
        with function  Next     (E : Elmt_Ptr) return Elmt_Ptr;
*************** package GNAT.Dynamic_HTables is
*** 103,115 ****
        Nil : constant Instance;
  
        procedure Reset (T : in out Instance);
!       --  Resets the hash table by setting all its elements to Null_Ptr. The
!       --  effect is to clear the hash table so that it can be reused. For the
        --  most common case where Elmt_Ptr is an access type, and Null_Ptr is
        --  null, this is only needed if the same table is reused in a new
        --  context. If Elmt_Ptr is other than an access type, or Null_Ptr is
!       --  other than null, then Reset must be called before the first use
!       --  of the hash table.
  
        procedure Set (T : in out Instance; E : Elmt_Ptr);
        --  Insert the element pointer in the HTable
--- 103,115 ----
        Nil : constant Instance;
  
        procedure Reset (T : in out Instance);
!       --  Resets the hash table by releasing all memory associated with
!       --  it. The hash table can safely be reused after this call. For the
        --  most common case where Elmt_Ptr is an access type, and Null_Ptr is
        --  null, this is only needed if the same table is reused in a new
        --  context. If Elmt_Ptr is other than an access type, or Null_Ptr is
!       --  other than null, then Reset must be called before the first use of
!       --  the hash table.
  
        procedure Set (T : in out Instance; E : Elmt_Ptr);
        --  Insert the element pointer in the HTable
*************** package GNAT.Dynamic_HTables is
*** 154,160 ****
  
     generic
        type Header_Num is range <>;
!       --  An integer type indicating the number and range of hash headers.
  
        type Element is private;
        --  The type of element to be stored
--- 154,160 ----
  
     generic
        type Header_Num is range <>;
!       --  An integer type indicating the number and range of hash headers
  
        type Element is private;
        --  The type of element to be stored
*************** package GNAT.Dynamic_HTables is
*** 177,183 ****
        --  associated element.
  
        procedure Reset (T : in out Instance);
!       --  Removes and frees all elements in the table
  
        function Get (T : Instance; K : Key) return Element;
        --  Returns the Element associated with a key or No_Element if the
--- 177,185 ----
        --  associated element.
  
        procedure Reset (T : in out Instance);
!       --  Releases all memory associated with the table. The table can be
!       --  reused after this call (it is automatically allocated on the first
!       --  access to the table).
  
        function Get (T : Instance; K : Key) return Element;
        --  Returns the Element associated with a key or No_Element if the
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dyntab.adb gcc-4.1.0/gcc/ada/g-dyntab.adb
*** gcc-4.0.2/gcc/ada/g-dyntab.adb	Fri Mar  5 10:58:56 2004
--- gcc-4.1.0/gcc/ada/g-dyntab.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2000-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Dynamic_Tables is
*** 328,336 ****
     --  Start of processing for Sort_Table
  
     begin
- 
        Heap_Sort.Sort (Natural (Last (Table) - First) + 1);
- 
     end Sort_Table;
  
  end GNAT.Dynamic_Tables;
--- 328,334 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-dyntab.ads gcc-4.1.0/gcc/ada/g-dyntab.ads
*** gcc-4.0.2/gcc/ada/g-dyntab.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-dyntab.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Dynamic_Tables is
*** 101,111 ****
     --  safety is not compromised by this approach.
  
     type Table_Ptr is access all Big_Table_Type;
!    --  The table is actually represented as a pointer to allow
!    --  reallocation.
  
     type Table_Private is private;
!    --  table private data that is not exported in Instance.
  
     type Instance is record
        Table : aliased Table_Ptr := null;
--- 101,110 ----
     --  safety is not compromised by this approach.
  
     type Table_Ptr is access all Big_Table_Type;
!    --  The table is actually represented as a pointer to allow reallocation
  
     type Table_Private is private;
!    --  Table private data that is not exported in Instance
  
     type Instance is record
        Table : aliased Table_Ptr := null;
*************** package GNAT.Dynamic_Tables is
*** 203,211 ****
     --  to return False). The sort is not stable (the order of equal items
     --  in the table is not preserved).
  
- 
  private
- 
     type Table_Private is record
        Max : Integer;
        --  Subscript of the maximum entry in the currently allocated table
--- 202,208 ----
*************** private
*** 215,221 ****
        --  ensures that we initially allocate the table.
  
        Last_Val : Integer;
!       --  Current value of Last.
     end record;
  
  end GNAT.Dynamic_Tables;
--- 212,218 ----
        --  ensures that we initially allocate the table.
  
        Last_Val : Integer;
!       --  Current value of Last
     end record;
  
  end GNAT.Dynamic_Tables;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-eacodu-vms.adb gcc-4.1.0/gcc/ada/g-eacodu-vms.adb
*** gcc-4.0.2/gcc/ada/g-eacodu-vms.adb	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/g-eacodu-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VMS version.
  
  with System;
  with System.Aux_DEC;
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VMS version
  
  with System;
  with System.Aux_DEC;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-eacodu.adb gcc-4.1.0/gcc/ada/g-eacodu.adb
*** gcc-4.0.2/gcc/ada/g-eacodu.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-eacodu.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-enblsp-vms-alpha.adb gcc-4.1.0/gcc/ada/g-enblsp-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/g-enblsp-vms-alpha.adb	Thu Feb 10 13:48:50 2005
--- gcc-4.1.0/gcc/ada/g-enblsp-vms-alpha.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                       Copyright (C) 2005, AdaCore                        --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  for use by the VMS GNAT.Expect package (g-expect-vms.adb). This package
  --  should not be directly with'ed by an application program.
  
! --  This version is for Alpha/VMS.
  
  separate (GNAT.Expect)
  procedure Non_Blocking_Spawn
--- 35,41 ----
  --  for use by the VMS GNAT.Expect package (g-expect-vms.adb). This package
  --  should not be directly with'ed by an application program.
  
! --  This version is for Alpha/VMS
  
  separate (GNAT.Expect)
  procedure Non_Blocking_Spawn
*************** begin
*** 75,81 ****
        raise Invalid_Process;
     end if;
  
!    --  Fork a new process. It's not possible to do this in a subprogram.
  
     if Alloc_Vfork_Blocks >= 0 then
        Descriptor.Pid := Get_Current_Invo_Context (Get_Vfork_Jmpbuf);
--- 75,81 ----
        raise Invalid_Process;
     end if;
  
!    --  Fork a new process (it is not possible to do this in a subprogram)
  
     if Alloc_Vfork_Blocks >= 0 then
        Descriptor.Pid := Get_Current_Invo_Context (Get_Vfork_Jmpbuf);
*************** begin
*** 83,92 ****
        Descriptor.Pid := -1;
     end if;
  
!    --  Are we now in the child (or, for Windows, still in the common
!    --  process).
  
     if Descriptor.Pid = Null_Pid then
        --  Prepare an array of arguments to pass to C
  
        Arg   := new String (1 .. Command_With_Path'Length + 1);
--- 83,92 ----
        Descriptor.Pid := -1;
     end if;
  
!    --  Are we now in the child
  
     if Descriptor.Pid = Null_Pid then
+ 
        --  Prepare an array of arguments to pass to C
  
        Arg   := new String (1 .. Command_With_Path'Length + 1);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-enblsp-vms-ia64.adb gcc-4.1.0/gcc/ada/g-enblsp-vms-ia64.adb
*** gcc-4.0.2/gcc/ada/g-enblsp-vms-ia64.adb	Thu Feb 10 13:48:50 2005
--- gcc-4.1.0/gcc/ada/g-enblsp-vms-ia64.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                       Copyright (C) 2005, AdaCore                        --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  for use by the VMS GNAT.Expect package (g-expect-vms.adb). This package
  --  should not be directly with'ed by an application program.
  
! --  This version is for IA64/VMS.
  
  separate (GNAT.Expect)
  procedure Non_Blocking_Spawn
--- 35,41 ----
  --  for use by the VMS GNAT.Expect package (g-expect-vms.adb). This package
  --  should not be directly with'ed by an application program.
  
! --  This version is for IA64/VMS
  
  separate (GNAT.Expect)
  procedure Non_Blocking_Spawn
*************** begin
*** 73,79 ****
        raise Invalid_Process;
     end if;
  
!    --  Fork a new process. It's not possible to do this in a subprogram.
  
     if Alloc_Vfork_Blocks >= 0 then
        Descriptor.Pid := Setjmp1 (Get_Vfork_Jmpbuf);
--- 73,79 ----
        raise Invalid_Process;
     end if;
  
!    --  Fork a new process (it is not possible to do this in a subprogram)
  
     if Alloc_Vfork_Blocks >= 0 then
        Descriptor.Pid := Setjmp1 (Get_Vfork_Jmpbuf);
*************** begin
*** 81,90 ****
        Descriptor.Pid := -1;
     end if;
  
!    --  Are we now in the child (or, for Windows, still in the common
!    --  process).
  
     if Descriptor.Pid = Null_Pid then
        --  Prepare an array of arguments to pass to C
  
        Arg   := new String (1 .. Command_With_Path'Length + 1);
--- 81,90 ----
        Descriptor.Pid := -1;
     end if;
  
!    --  Are we now in the child
  
     if Descriptor.Pid = Null_Pid then
+ 
        --  Prepare an array of arguments to pass to C
  
        Arg   := new String (1 .. Command_With_Path'Length + 1);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-excact.adb gcc-4.1.0/gcc/ada/g-excact.adb
*** gcc-4.0.2/gcc/ada/g-excact.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-excact.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Ada.Exceptions;       use Ada.Exceptions;
  with Ada.Unchecked_Conversion;
  with System;
  with System.Soft_Links;       use System.Soft_Links;
--- 31,36 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-excact.ads gcc-4.1.0/gcc/ada/g-excact.ads
*** gcc-4.0.2/gcc/ada/g-excact.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-excact.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides support for callbacks on exceptions.
  
  --  These callbacks are called immediately when either a specific exception,
  --  or any exception, is raised, before any other actions taken by raise, in
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides support for callbacks on exceptions
  
  --  These callbacks are called immediately when either a specific exception,
  --  or any exception, is raised, before any other actions taken by raise, in
diff -Nrcpad gcc-4.0.2/gcc/ada/g-except.ads gcc-4.1.0/gcc/ada/g-except.ads
*** gcc-4.0.2/gcc/ada/g-except.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-except.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2000-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,52 ****
  --  package allows for raising the standard predefined exceptions at least.
  
  package GNAT.Exceptions is
! pragma Pure (Exceptions);
  
     type Exception_Type is limited null record;
!    --  Type used to specify which exception to raise.
  
     --  Really Exception_Type is Exception_Id, but Exception_Id can't be
     --  used directly since it is declared in the non-pure unit Ada.Exceptions,
--- 43,52 ----
  --  package allows for raising the standard predefined exceptions at least.
  
  package GNAT.Exceptions is
!    pragma Pure;
  
     type Exception_Type is limited null record;
!    --  Type used to specify which exception to raise
  
     --  Really Exception_Type is Exception_Id, but Exception_Id can't be
     --  used directly since it is declared in the non-pure unit Ada.Exceptions,
diff -Nrcpad gcc-4.0.2/gcc/ada/g-exctra.adb gcc-4.1.0/gcc/ada/g-exctra.adb
*** gcc-4.0.2/gcc/ada/g-exctra.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-exctra.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2000-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Exception_Traces is
*** 48,55 ****
  
     function Decorator_Wrapper
       (Traceback : System.Address;
!       Len       : Natural)
!       return      String;
     --  The wrapper to be called when a decorator is in place for exception
     --  backtraces.
     --
--- 48,54 ----
  
     function Decorator_Wrapper
       (Traceback : System.Address;
!       Len       : Natural) return String;
     --  The wrapper to be called when a decorator is in place for exception
     --  backtraces.
     --
*************** package body GNAT.Exception_Traces is
*** 68,75 ****
  
     function Decorator_Wrapper
       (Traceback : System.Address;
!       Len       : Natural)
!       return      String
     is
        Decorator_Traceback : Tracebacks_Array (1 .. Len);
        for Decorator_Traceback'Address use Traceback;
--- 67,73 ----
  
     function Decorator_Wrapper
       (Traceback : System.Address;
!       Len       : Natural) return String
     is
        Decorator_Traceback : Tracebacks_Array (1 .. Len);
        for Decorator_Traceback'Address use Traceback;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-exctra.ads gcc-4.1.0/gcc/ada/g-exctra.ads
*** gcc-4.0.2/gcc/ada/g-exctra.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-exctra.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2000-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,51 ****
  --  This package provides an interface allowing to control *automatic* output
  --  to standard error upon exception occurrences (as opposed to explicit
  --  generation of traceback information using GNAT.Traceback).
! --
  --  This output includes the basic information associated with the exception
  --  (name, message) as well as a backtrace of the call chain at the point
  --  where the exception occurred. This backtrace is only output if the call
  --  chain information is available, depending if the binder switch dedicated
  --  to that purpose has been used or not.
! --
  --  The default backtrace is in the form of absolute code locations which may
  --  be converted to corresponding source locations using the addr2line utility
  --  or from within GDB. Please refer to GNAT.Traceback for information about
  --  what is necessary to be able to exploit thisg possibility.
! --
  --  The backtrace output can also be customized by way of a "decorator" which
  --  may return any string output in association with a provided call chain.
  
--- 34,51 ----
  --  This package provides an interface allowing to control *automatic* output
  --  to standard error upon exception occurrences (as opposed to explicit
  --  generation of traceback information using GNAT.Traceback).
! 
  --  This output includes the basic information associated with the exception
  --  (name, message) as well as a backtrace of the call chain at the point
  --  where the exception occurred. This backtrace is only output if the call
  --  chain information is available, depending if the binder switch dedicated
  --  to that purpose has been used or not.
! 
  --  The default backtrace is in the form of absolute code locations which may
  --  be converted to corresponding source locations using the addr2line utility
  --  or from within GDB. Please refer to GNAT.Traceback for information about
  --  what is necessary to be able to exploit thisg possibility.
! 
  --  The backtrace output can also be customized by way of a "decorator" which
  --  may return any string output in association with a provided call chain.
  
*************** package GNAT.Exception_Traces is
*** 72,78 ****
     --  traces identified by the above trace kind values.
  
     procedure Trace_On (Kind : Trace_Kind);
!    --  Activate the traces denoted by Kind.
  
     procedure Trace_Off;
     --  Stop the tracing requested by the last call to Trace_On.
--- 72,78 ----
     --  traces identified by the above trace kind values.
  
     procedure Trace_On (Kind : Trace_Kind);
!    --  Activate the traces denoted by Kind
  
     procedure Trace_Off;
     --  Stop the tracing requested by the last call to Trace_On.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-expect-vms.adb gcc-4.1.0/gcc/ada/g-expect-vms.adb
*** gcc-4.0.2/gcc/ada/g-expect-vms.adb	Thu Feb 10 13:48:49 2005
--- gcc-4.1.0/gcc/ada/g-expect-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2002-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VMS version.
  
  with System;        use System;
  with Ada.Calendar;  use Ada.Calendar;
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VMS version
  
  with System;        use System;
  with Ada.Calendar;  use Ada.Calendar;
*************** package body GNAT.Expect is
*** 113,119 ****
  
     function Waitpid (Pid : Process_Id) return Integer;
     pragma Import (C, Waitpid, "__gnat_waitpid");
!    --  Wait for a specific process id, and return its exit code.
  
     ---------
     -- "+" --
--- 113,119 ----
  
     function Waitpid (Pid : Process_Id) return Integer;
     pragma Import (C, Waitpid, "__gnat_waitpid");
!    --  Wait for a specific process id, and return its exit code
  
     ---------
     -- "+" --
*************** package body GNAT.Expect is
*** 330,336 ****
           --  Calculate the timeout for the next turn.
           --  Note that Timeout is, from the caller's perspective, the maximum
           --  time until a match, not the maximum time until some output is
!          --  read, and thus can not be reused as is for Expect_Internal.
  
           if Timeout /= -1 then
              Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
--- 330,336 ----
           --  Calculate the timeout for the next turn.
           --  Note that Timeout is, from the caller's perspective, the maximum
           --  time until a match, not the maximum time until some output is
!          --  read, and thus cannot be reused as is for Expect_Internal.
  
           if Timeout /= -1 then
              Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
*************** package body GNAT.Expect is
*** 660,666 ****
                                     Descriptors (J).Buffer_Size - N;
                                end if;
  
!                               --  Keep what we read in the buffer.
  
                                Descriptors (J).Buffer
                                  (Descriptors (J).Buffer_Index + 1 ..
--- 660,666 ----
                                     Descriptors (J).Buffer_Size - N;
                                end if;
  
!                               --  Keep what we read in the buffer
  
                                Descriptors (J).Buffer
                                  (Descriptors (J).Buffer_Index + 1 ..
*************** package body GNAT.Expect is
*** 761,766 ****
--- 761,849 ----
  
     end Flush;
  
+    ------------------------
+    -- Get_Command_Output --
+    ------------------------
+ 
+    function Get_Command_Output
+      (Command    : String;
+       Arguments  : GNAT.OS_Lib.Argument_List;
+       Input      : String;
+       Status     : access Integer;
+       Err_To_Out : Boolean := False) return String
+    is
+       use GNAT.Expect;
+ 
+       Process : Process_Descriptor;
+ 
+       Output : String_Access := new String (1 .. 1024);
+       --  Buffer used to accumulate standard output from the launched
+       --  command, expanded as necessary during execution.
+ 
+       Last : Integer := 0;
+       --  Index of the last used character within Output
+ 
+    begin
+       Non_Blocking_Spawn
+         (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+ 
+       if Input'Length > 0 then
+          Send (Process, Input);
+       end if;
+ 
+       GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+ 
+       declare
+          Result : Expect_Match;
+ 
+       begin
+          --  This loop runs until the call to Expect raises Process_Died
+ 
+          loop
+             Expect (Process, Result, ".+");
+ 
+             declare
+                NOutput : String_Access;
+                S       : constant String := Expect_Out (Process);
+                pragma Assert (S'Length > 0);
+ 
+             begin
+                --  Expand buffer if we need more space
+ 
+                if Last + S'Length > Output'Last then
+                   NOutput := new String (1 .. 2 * Output'Last);
+                   NOutput (Output'Range) := Output.all;
+                   Free (Output);
+ 
+                   --  Here if current buffer size is OK
+ 
+                else
+                   NOutput := Output;
+                end if;
+ 
+                NOutput (Last + 1 .. Last + S'Length) := S;
+                Last := Last + S'Length;
+                Output := NOutput;
+             end;
+          end loop;
+ 
+       exception
+          when Process_Died =>
+             Close (Process, Status.all);
+       end;
+ 
+       if Last = 0 then
+          return "";
+       end if;
+ 
+       declare
+          S : constant String := Output (1 .. Last);
+       begin
+          Free (Output);
+          return S;
+       end;
+    end Get_Command_Output;
+ 
     ------------------
     -- Get_Error_Fd --
     ------------------
*************** package body GNAT.Expect is
*** 963,969 ****
     is
     begin
        Kill (Descriptor.Pid, Signal);
!       --  ??? Need to check process status here.
     end Send_Signal;
  
     ---------------------------------
--- 1046,1052 ----
     is
     begin
        Kill (Descriptor.Pid, Signal);
!       --  ??? Need to check process status here
     end Send_Signal;
  
     ---------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/g-expect.adb gcc-4.1.0/gcc/ada/g-expect.adb
*** gcc-4.0.2/gcc/ada/g-expect.adb	Thu Feb 10 13:51:58 2005
--- gcc-4.1.0/gcc/ada/g-expect.adb	Tue Nov 15 13:57:56 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2000-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,42 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with System;        use System;
! with Ada.Calendar;  use Ada.Calendar;
  
  with GNAT.IO;
! with GNAT.OS_Lib;   use GNAT.OS_Lib;
! with GNAT.Regpat;   use GNAT.Regpat;
  
  with Unchecked_Deallocation;
  
--- 31,42 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with System;       use System;
! with Ada.Calendar; use Ada.Calendar;
  
  with GNAT.IO;
! with GNAT.OS_Lib;  use GNAT.OS_Lib;
! with GNAT.Regpat;  use GNAT.Regpat;
  
  with Unchecked_Deallocation;
  
*************** package body GNAT.Expect is
*** 69,74 ****
--- 69,77 ----
     procedure Free is new Unchecked_Deallocation
       (Pattern_Matcher, Pattern_Matcher_Access);
  
+    procedure Free is new Unchecked_Deallocation
+      (Filter_List_Elem, Filter_List);
+ 
     procedure Call_Filters
       (Pid       : Process_Descriptor'Class;
        Str       : String;
*************** package body GNAT.Expect is
*** 86,93 ****
     procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
     pragma Import (C, Dup2);
  
!    procedure Kill (Pid : Process_Id; Sig_Num : Integer);
     pragma Import (C, Kill, "__gnat_kill");
  
     function Create_Pipe (Pipe : access Pipe_Type) return Integer;
     pragma Import (C, Create_Pipe, "__gnat_pipe");
--- 89,97 ----
     procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
     pragma Import (C, Dup2);
  
!    procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
     pragma Import (C, Kill, "__gnat_kill");
+    --  if Close is set to 1 all OS resources used by the Pid must be freed
  
     function Create_Pipe (Pipe : access Pipe_Type) return Integer;
     pragma Import (C, Create_Pipe, "__gnat_pipe");
*************** package body GNAT.Expect is
*** 108,114 ****
  
     function Waitpid (Pid : Process_Id) return Integer;
     pragma Import (C, Waitpid, "__gnat_waitpid");
!    --  Wait for a specific process id, and return its exit code.
  
     ---------
     -- "+" --
--- 112,118 ----
  
     function Waitpid (Pid : Process_Id) return Integer;
     pragma Import (C, Waitpid, "__gnat_waitpid");
!    --  Wait for a specific process id, and return its exit code
  
     ---------
     -- "+" --
*************** package body GNAT.Expect is
*** 204,209 ****
--- 208,216 ----
       (Descriptor : in out Process_Descriptor;
        Status     : out Integer)
     is
+       Current_Filter : Filter_List;
+       Next_Filter    : Filter_List;
+ 
     begin
        Close (Descriptor.Input_Fd);
  
*************** package body GNAT.Expect is
*** 214,224 ****
        Close (Descriptor.Output_Fd);
  
        --  ??? Should have timeouts for different signals
!       Kill (Descriptor.Pid, 9);
  
        GNAT.OS_Lib.Free (Descriptor.Buffer);
        Descriptor.Buffer_Size := 0;
  
        Status := Waitpid (Descriptor.Pid);
     end Close;
  
--- 221,241 ----
        Close (Descriptor.Output_Fd);
  
        --  ??? Should have timeouts for different signals
! 
!       Kill (Descriptor.Pid, 9, 0);
  
        GNAT.OS_Lib.Free (Descriptor.Buffer);
        Descriptor.Buffer_Size := 0;
  
+       Current_Filter := Descriptor.Filters;
+ 
+       while Current_Filter /= null loop
+          Next_Filter := Current_Filter.Next;
+          Free (Current_Filter);
+          Current_Filter := Next_Filter;
+       end loop;
+ 
+       Descriptor.Filters := null;
        Status := Waitpid (Descriptor.Pid);
     end Close;
  
*************** package body GNAT.Expect is
*** 323,332 ****
              return;
           end if;
  
!          --  Calculate the timeout for the next turn.
           --  Note that Timeout is, from the caller's perspective, the maximum
           --  time until a match, not the maximum time until some output is
!          --  read, and thus can not be reused as is for Expect_Internal.
  
           if Timeout /= -1 then
              Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
--- 340,350 ----
              return;
           end if;
  
!          --  Calculate the timeout for the next turn
! 
           --  Note that Timeout is, from the caller's perspective, the maximum
           --  time until a match, not the maximum time until some output is
!          --  read, and thus cannot be reused as is for Expect_Internal.
  
           if Timeout /= -1 then
              Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
*************** package body GNAT.Expect is
*** 656,662 ****
                                     Descriptors (J).Buffer_Size - N;
                                end if;
  
!                               --  Keep what we read in the buffer.
  
                                Descriptors (J).Buffer
                                  (Descriptors (J).Buffer_Index + 1 ..
--- 674,680 ----
                                     Descriptors (J).Buffer_Size - N;
                                end if;
  
!                               --  Keep what we read in the buffer
  
                                Descriptors (J).Buffer
                                  (Descriptors (J).Buffer_Index + 1 ..
*************** package body GNAT.Expect is
*** 754,770 ****
                 end if;
           end case;
        end loop;
- 
     end Flush;
  
     ------------------
     -- Get_Error_Fd --
     ------------------
  
     function Get_Error_Fd
!      (Descriptor : Process_Descriptor)
!       return       GNAT.OS_Lib.File_Descriptor
!    is
     begin
        return Descriptor.Error_Fd;
     end Get_Error_Fd;
--- 772,868 ----
                 end if;
           end case;
        end loop;
     end Flush;
  
+    ------------------------
+    -- Get_Command_Output --
+    ------------------------
+ 
+    function Get_Command_Output
+      (Command    : String;
+       Arguments  : GNAT.OS_Lib.Argument_List;
+       Input      : String;
+       Status     : access Integer;
+       Err_To_Out : Boolean := False) return String
+    is
+       use GNAT.Expect;
+ 
+       Process : Process_Descriptor;
+ 
+       Output : String_Access := new String (1 .. 1024);
+       --  Buffer used to accumulate standard output from the launched
+       --  command, expanded as necessary during execution.
+ 
+       Last : Integer := 0;
+       --  Index of the last used character within Output
+ 
+    begin
+       Non_Blocking_Spawn
+         (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+ 
+       if Input'Length > 0 then
+          Send (Process, Input);
+       end if;
+ 
+       GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+ 
+       declare
+          Result : Expect_Match;
+ 
+       begin
+          --  This loop runs until the call to Expect raises Process_Died
+ 
+          loop
+             Expect (Process, Result, ".+");
+ 
+             declare
+                NOutput : String_Access;
+                S       : constant String := Expect_Out (Process);
+                pragma Assert (S'Length > 0);
+ 
+             begin
+                --  Expand buffer if we need more space
+ 
+                if Last + S'Length > Output'Last then
+                   NOutput := new String (1 .. 2 * Output'Last);
+                   NOutput (Output'Range) := Output.all;
+                   Free (Output);
+ 
+                   --  Here if current buffer size is OK
+ 
+                else
+                   NOutput := Output;
+                end if;
+ 
+                NOutput (Last + 1 .. Last + S'Length) := S;
+                Last := Last + S'Length;
+                Output := NOutput;
+             end;
+          end loop;
+ 
+       exception
+          when Process_Died =>
+             Close (Process, Status.all);
+       end;
+ 
+       if Last = 0 then
+          return "";
+       end if;
+ 
+       declare
+          S : constant String := Output (1 .. Last);
+       begin
+          Free (Output);
+          return S;
+       end;
+    end Get_Command_Output;
+ 
     ------------------
     -- Get_Error_Fd --
     ------------------
  
     function Get_Error_Fd
!      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
     begin
        return Descriptor.Error_Fd;
     end Get_Error_Fd;
*************** package body GNAT.Expect is
*** 774,782 ****
     ------------------
  
     function Get_Input_Fd
!      (Descriptor : Process_Descriptor)
!       return       GNAT.OS_Lib.File_Descriptor
!    is
     begin
        return Descriptor.Input_Fd;
     end Get_Input_Fd;
--- 872,878 ----
     ------------------
  
     function Get_Input_Fd
!      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
     begin
        return Descriptor.Input_Fd;
     end Get_Input_Fd;
*************** package body GNAT.Expect is
*** 786,794 ****
     -------------------
  
     function Get_Output_Fd
!      (Descriptor : Process_Descriptor)
!       return       GNAT.OS_Lib.File_Descriptor
!    is
     begin
        return Descriptor.Output_Fd;
     end Get_Output_Fd;
--- 882,888 ----
     -------------------
  
     function Get_Output_Fd
!      (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
     begin
        return Descriptor.Output_Fd;
     end Get_Output_Fd;
*************** package body GNAT.Expect is
*** 798,806 ****
     -------------
  
     function Get_Pid
!      (Descriptor : Process_Descriptor)
!       return       Process_Id
!    is
     begin
        return Descriptor.Pid;
     end Get_Pid;
--- 892,898 ----
     -------------
  
     function Get_Pid
!      (Descriptor : Process_Descriptor) return Process_Id is
     begin
        return Descriptor.Pid;
     end Get_Pid;
*************** package body GNAT.Expect is
*** 847,853 ****
  
        Arg        : String_Access;
        Arg_List   : String_List (1 .. Args'Length + 2);
!       C_Arg_List :  aliased array (1 .. Args'Length + 2) of System.Address;
  
        Command_With_Path : String_Access;
  
--- 939,945 ----
  
        Arg        : String_Access;
        Arg_List   : String_List (1 .. Args'Length + 2);
!       C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
  
        Command_With_Path : String_Access;
  
*************** package body GNAT.Expect is
*** 927,932 ****
--- 1019,1028 ----
        if Buffer_Size /= 0 then
           Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
        end if;
+ 
+       --  Initialize the filters
+ 
+       Descriptor.Filters := null;
     end Non_Blocking_Spawn;
  
     -------------------------
*************** package body GNAT.Expect is
*** 1004,1012 ****
     ----------
  
     procedure Send
!      (Descriptor : in out Process_Descriptor;
!       Str        : String;
!       Add_LF     : Boolean := True;
        Empty_Buffer : Boolean := False)
     is
        Full_Str    : constant String := Str & ASCII.LF;
--- 1100,1108 ----
     ----------
  
     procedure Send
!      (Descriptor   : in out Process_Descriptor;
!       Str          : String;
!       Add_LF       : Boolean := True;
        Empty_Buffer : Boolean := False)
     is
        Full_Str    : constant String := Str & ASCII.LF;
*************** package body GNAT.Expect is
*** 1020,1026 ****
     begin
        if Empty_Buffer then
  
!          --  Force a read on the process if there is anything waiting.
  
           Expect_Internal (Descriptors, Result,
                            Timeout => 0, Full_Buffer => False);
--- 1116,1122 ----
     begin
        if Empty_Buffer then
  
!          --  Force a read on the process if there is anything waiting
  
           Expect_Internal (Descriptors, Result,
                            Timeout => 0, Full_Buffer => False);
*************** package body GNAT.Expect is
*** 1054,1061 ****
        Signal     : Integer)
     is
     begin
!       Kill (Descriptor.Pid, Signal);
!       --  ??? Need to check process status here.
     end Send_Signal;
  
     ---------------------------------
--- 1150,1157 ----
        Signal     : Integer)
     is
     begin
!       Kill (Descriptor.Pid, Signal, 1);
!       --  ??? Need to check process status here
     end Send_Signal;
  
     ---------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/g-expect.ads gcc-4.1.0/gcc/ada/g-expect.ads
*** gcc-4.0.2/gcc/ada/g-expect.ads	Fri Nov 19 11:26:07 2004
--- gcc-4.1.0/gcc/ada/g-expect.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2000-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  for VMS. It is not yet implemented for any of the cross-ports (e.g. it
  --  is not available for VxWorks or LynxOS).
  
! --  Usage
! --  =====
  
  --  This package provides a set of subprograms similar to what is available
  --  with the standard Tcl Expect tool.
--- 35,43 ----
  --  for VMS. It is not yet implemented for any of the cross-ports (e.g. it
  --  is not available for VxWorks or LynxOS).
  
! --  -----------
! --  -- Usage --
! --  -----------
  
  --  This package provides a set of subprograms similar to what is available
  --  with the standard Tcl Expect tool.
***************
*** 111,121 ****
  --      Send (Fd, "command");
  --      Expect (Fd, Result, ".."); -- match only on the output of command
  
! --  Task Safety
! --  ===========
  
  --  This package is not task-safe: there should be not concurrent calls to
! --  the functions defined in this package.
  
  with System;
  with GNAT.OS_Lib;
--- 112,125 ----
  --      Send (Fd, "command");
  --      Expect (Fd, Result, ".."); -- match only on the output of command
  
! --  -----------------
! --  -- Task Safety --
! --  -----------------
  
  --  This package is not task-safe: there should be not concurrent calls to
! --  the functions defined in this package. In other words, separate tasks
! --  may not access the facilities of this package without synchronization
! --  that serializes access.
  
  with System;
  with GNAT.OS_Lib;
*************** package GNAT.Expect is
*** 195,201 ****
     procedure Send_Signal
       (Descriptor : Process_Descriptor;
        Signal     : Integer);
!    --  Send a given signal to the process.
  
     procedure Interrupt (Descriptor : in out Process_Descriptor);
     --  Interrupt the process (the equivalent of Ctrl-C on unix and windows)
--- 199,205 ----
     procedure Send_Signal
       (Descriptor : Process_Descriptor;
        Signal     : Integer);
!    --  Send a given signal to the process
  
     procedure Interrupt (Descriptor : in out Process_Descriptor);
     --  Interrupt the process (the equivalent of Ctrl-C on unix and windows)
*************** package GNAT.Expect is
*** 204,225 ****
     function Get_Input_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the input file descriptor associated with Descriptor.
  
     function Get_Output_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the output file descriptor associated with Descriptor.
  
     function Get_Error_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the error output file descriptor associated with Descriptor.
  
     function Get_Pid
       (Descriptor : Process_Descriptor)
        return       Process_Id;
!    --  Return the process id assocated with a given process descriptor.
  
     --------------------
     -- Adding filters --
--- 208,240 ----
     function Get_Input_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the input file descriptor associated with Descriptor
  
     function Get_Output_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the output file descriptor associated with Descriptor
  
     function Get_Error_Fd
       (Descriptor : Process_Descriptor)
        return       GNAT.OS_Lib.File_Descriptor;
!    --  Return the error output file descriptor associated with Descriptor
  
     function Get_Pid
       (Descriptor : Process_Descriptor)
        return       Process_Id;
!    --  Return the process id assocated with a given process descriptor
! 
!    function Get_Command_Output
!      (Command    : String;
!       Arguments  : GNAT.OS_Lib.Argument_List;
!       Input      : String;
!       Status     : access Integer;
!       Err_To_Out : Boolean := False) return String;
!    --  Execute Command with the specified Arguments and Input, and return the
!    --  generated standard output data as a single string. If Err_To_Out is
!    --  True, generated standard error output is included as well. On return,
!    --  Status is set to the command's exit status.
  
     --------------------
     -- Adding filters --
*************** package GNAT.Expect is
*** 302,311 ****
  
     type Expect_Match is new Integer;
     Expect_Full_Buffer : constant Expect_Match := -1;
!    --  If the buffer was full and some characters were discarded.
  
     Expect_Timeout : constant Expect_Match := -2;
!    --  If not output matching the regexps was found before the timeout.
  
     function "+" (S : String) return GNAT.OS_Lib.String_Access;
     --  Allocate some memory for the string. This is merely a convenience
--- 317,326 ----
  
     type Expect_Match is new Integer;
     Expect_Full_Buffer : constant Expect_Match := -1;
!    --  If the buffer was full and some characters were discarded
  
     Expect_Timeout : constant Expect_Match := -2;
!    --  If not output matching the regexps was found before the timeout
  
     function "+" (S : String) return GNAT.OS_Lib.String_Access;
     --  Allocate some memory for the string. This is merely a convenience
*************** package GNAT.Expect is
*** 380,386 ****
        Matched     : out GNAT.Regpat.Match_Array;
        Timeout     : Integer := 10000;
        Full_Buffer : Boolean := False);
!    --  Same as above, but with a precompiled regular expression.
  
     -------------------------------------------------------------
     -- Working on the output (single process, multiple regexp) --
--- 395,401 ----
        Matched     : out GNAT.Regpat.Match_Array;
        Timeout     : Integer := 10000;
        Full_Buffer : Boolean := False);
!    --  Same as above, but with a precompiled regular expression
  
     -------------------------------------------------------------
     -- Working on the output (single process, multiple regexp) --
*************** package GNAT.Expect is
*** 461,467 ****
        Matched     : out GNAT.Regpat.Match_Array;
        Timeout     : Integer := 10000;
        Full_Buffer : Boolean := False);
!    --  Same as above, but for multi processes.
  
     procedure Expect
       (Result      : out Expect_Match;
--- 476,482 ----
        Matched     : out GNAT.Regpat.Match_Array;
        Timeout     : Integer := 10000;
        Full_Buffer : Boolean := False);
!    --  Same as above, but for multi processes
  
     procedure Expect
       (Result      : out Expect_Match;
*************** private
*** 535,541 ****
     type Pipe_Type is record
        Input, Output : GNAT.OS_Lib.File_Descriptor;
     end record;
!    --  This type represents a pipe, used to communicate between two processes.
  
     procedure Set_Up_Communications
       (Pid        : in out Process_Descriptor;
--- 550,556 ----
     type Pipe_Type is record
        Input, Output : GNAT.OS_Lib.File_Descriptor;
     end record;
!    --  This type represents a pipe, used to communicate between two processes
  
     procedure Set_Up_Communications
       (Pid        : in out Process_Descriptor;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-flocon.ads gcc-4.1.0/gcc/ada/g-flocon.ads
*** gcc-4.0.2/gcc/ada/g-flocon.ads	Thu Apr 24 17:54:03 2003
--- gcc-4.1.0/gcc/ada/g-flocon.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2000 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-heasor.adb gcc-4.1.0/gcc/ada/g-heasor.adb
*** gcc-4.0.2/gcc/ada/g-heasor.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-heasor.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       G N A T . H E A P _ S O R T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       G N A T . H E A P _ S O R T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-heasor.ads gcc-4.1.0/gcc/ada/g-heasor.ads
*** gcc-4.0.2/gcc/ada/g-heasor.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-heasor.ads	Tue Nov 15 17:21:54 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       G N A T . H E A P _ S O R T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       G N A T . H E A P _ S O R T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,54 ****
  --  subprogram parameters, so that it can be used with different types with
  --  shared sorting code.
  
- --  See also GNAT.Heap_Sort_G and GNAT.Heap_Sort_A. These are older versions
- --  of this routine. In some cases GNAT.Heap_Sort_G may be a little faster
- --  than GNAT.Heap_Sort, at the expense of generic code duplication and a
- --  less convenient interface. The generic version also has the advantage
- --  of being Pure, while this unit can only be Preelaborate.
- 
  --  This heapsort algorithm uses approximately N*log(N) compares in the
  --  worst case and is in place with no additional storage required. See
  --  the body for exact details of the algorithm used.
  
  package GNAT.Heap_Sort is
! pragma Preelaborate (Heap_Sort);
  
     --  The data to be sorted is assumed to be indexed by integer values
     --  from 1 to N, where N is the number of items to be sorted.
--- 37,57 ----
  --  subprogram parameters, so that it can be used with different types with
  --  shared sorting code.
  
  --  This heapsort algorithm uses approximately N*log(N) compares in the
  --  worst case and is in place with no additional storage required. See
  --  the body for exact details of the algorithm used.
  
+ --  See also GNAT.Heap_Sort_G which is a generic version that will be faster
+ --  since the overhead of the indirect calls is avoided, at the expense of
+ --  generic code duplication and less convenient interface. The generic version
+ --  also has the advantage of being Pure, while this unit can only be
+ --  Preelaborate, because of the access types.
+ 
+ --  Note: GNAT.Heap_Sort replaces and obsoletes GNAT.Heap_Sort_A, which is
+ --  retained in the GNAT library for backwards compatibility.
+ 
  package GNAT.Heap_Sort is
!    pragma Preelaborate;
  
     --  The data to be sorted is assumed to be indexed by integer values
     --  from 1 to N, where N is the number of items to be sorted.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-hesora.adb gcc-4.1.0/gcc/ada/g-hesora.adb
*** gcc-4.0.2/gcc/ada/g-hesora.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-hesora.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ A                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-1999 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ A                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-hesora.ads gcc-4.1.0/gcc/ada/g-hesora.ads
*** gcc-4.0.2/gcc/ada/g-hesora.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-hesora.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ A                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ A                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,49 ****
  --  the body for exact details of the algorithm used.
  
  package GNAT.Heap_Sort_A is
! pragma Preelaborate (Heap_Sort_A);
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted. In addition, the
--- 43,49 ----
  --  the body for exact details of the algorithm used.
  
  package GNAT.Heap_Sort_A is
!    pragma Preelaborate;
  
     --  The data to be sorted is assumed to be indexed by integer values from
     --  1 to N, where N is the number of items to be sorted. In addition, the
diff -Nrcpad gcc-4.0.2/gcc/ada/g-hesorg.adb gcc-4.1.0/gcc/ada/g-hesorg.adb
*** gcc-4.0.2/gcc/ada/g-hesorg.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-hesorg.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ G                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ G                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-hesorg.ads gcc-4.1.0/gcc/ada/g-hesorg.ads
*** gcc-4.0.2/gcc/ada/g-hesorg.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-hesorg.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ G                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . H E A P _ S O R T _ G                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,50 ****
  
  --  There is also GNAT.Heap_Sort_A, which is now considered obsolete, but
  --  was an older version working with subprogram parameters. This version
! --  is retained for bacwards compatibility with old versions of GNAT.
  
  --  This heapsort algorithm uses approximately N*log(N) compares in the
  --  worst case and is in place with no additional storage required. See
--- 44,50 ----
  
  --  There is also GNAT.Heap_Sort_A, which is now considered obsolete, but
  --  was an older version working with subprogram parameters. This version
! --  is retained for backwards compatibility with old versions of GNAT.
  
  --  This heapsort algorithm uses approximately N*log(N) compares in the
  --  worst case and is in place with no additional storage required. See
*************** generic
*** 58,71 ****
     with procedure Move (From : Natural; To : Natural);
     --  A procedure that moves the data item with index value From to the data
     --  item with index value To (the old value in To being lost). An index
!    --  value of zero is used for moves from and to a single temporary location
  
     with function Lt (Op1, Op2 : Natural) return Boolean;
     --  A function that compares two items and returns True if the item with
     --  index Op1 is less than the item with Index Op2, and False if the Op1
     --  item is greater than the Op2 item. If the two items are equal, then
     --  it does not matter whether True or False is returned (it is slightly
!    --  more efficient to return False).
  
     --  Note on use of temporary location
  
--- 58,73 ----
     with procedure Move (From : Natural; To : Natural);
     --  A procedure that moves the data item with index value From to the data
     --  item with index value To (the old value in To being lost). An index
!    --  value of zero is used for moves from and to a single temporary location.
!    --  For best efficiency, this routine should be marked as inlined.
  
     with function Lt (Op1, Op2 : Natural) return Boolean;
     --  A function that compares two items and returns True if the item with
     --  index Op1 is less than the item with Index Op2, and False if the Op1
     --  item is greater than the Op2 item. If the two items are equal, then
     --  it does not matter whether True or False is returned (it is slightly
!    --  more efficient to return False). For best efficiency, this routine
!    --  should be marked as inlined.
  
     --  Note on use of temporary location
  
*************** generic
*** 77,83 ****
     --  zero will in this case be resolved at instantiation time.
  
  package GNAT.Heap_Sort_G is
! pragma Pure (Heap_Sort_G);
  
     procedure Sort (N : Natural);
     --  This procedures sorts items in the range from 1 to N into ascending
--- 79,85 ----
     --  zero will in this case be resolved at instantiation time.
  
  package GNAT.Heap_Sort_G is
!    pragma Pure;
  
     procedure Sort (N : Natural);
     --  This procedures sorts items in the range from 1 to N into ascending
diff -Nrcpad gcc-4.0.2/gcc/ada/g-htable.adb gcc-4.1.0/gcc/ada/g-htable.adb
*** gcc-4.0.2/gcc/ada/g-htable.adb	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-htable.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . H T A B L E                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . H T A B L E                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-htable.ads gcc-4.1.0/gcc/ada/g-htable.ads
*** gcc-4.0.2/gcc/ada/g-htable.ads	Tue Oct 21 13:42:00 2003
--- gcc-4.1.0/gcc/ada/g-htable.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . H T A B L E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . H T A B L E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 46,58 ****
  with System.HTable;
  
  package GNAT.HTable is
! pragma Preelaborate (HTable);
! 
! pragma Elaborate_Body;
! --  The elaborate body is because we have a dummy body to deal with bootstrap
! --  path problems (we used to have a real body, and now we don't need it any
! --  more, but the bootstrap requires that we have a dummy body, since otherwise
! --  the old body gets picked up.
  
     -------------------
     -- Simple_HTable --
--- 46,57 ----
  with System.HTable;
  
  package GNAT.HTable is
!    pragma Preelaborate;
!    pragma Elaborate_Body;
!    --  The elaborate body is because we have a dummy body to deal with
!    --  bootstrap path problems (we used to have a real body, and now we don't
!    --  need it any more, but the bootstrap requires that we have a dummy body,
!    --  since otherwise the old body gets picked up.
  
     -------------------
     -- Simple_HTable --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-io.adb gcc-4.1.0/gcc/ada/g-io.adb
*** gcc-4.0.2/gcc/ada/g-io.adb	Tue Oct 21 13:42:01 2003
--- gcc-4.1.0/gcc/ada/g-io.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                              G N A T . I O                               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                              G N A T . I O                               --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.IO is
*** 42,60 ****
     ---------
  
     procedure Get (X : out Integer) is
- 
        function Get_Int return Integer;
        pragma Import (C, Get_Int, "get_int");
- 
     begin
        X := Get_Int;
     end Get;
  
     procedure Get (C : out Character) is
- 
        function Get_Char return Character;
        pragma Import (C, Get_Char, "get_char");
- 
     begin
        C := Get_Char;
     end Get;
--- 42,56 ----
*************** package body GNAT.IO is
*** 108,114 ****
     end Put;
  
     procedure Put (File : File_Type; X : Integer) is
- 
        procedure Put_Int (X : Integer);
        pragma Import (C, Put_Int, "put_int");
  
--- 104,109 ----
*************** package body GNAT.IO is
*** 128,134 ****
     end Put;
  
     procedure Put (File : in File_Type; C : Character) is
- 
        procedure Put_Char (C : Character);
        pragma Import (C, Put_Char, "put_char");
  
--- 123,128 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-io.ads gcc-4.1.0/gcc/ada/g-io.ads
*** gcc-4.0.2/gcc/ada/g-io.ads	Tue Oct 21 13:42:02 2003
--- gcc-4.1.0/gcc/ada/g-io.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                              G N A T . I O                               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                              G N A T . I O                               --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  --  If such checks are needed then the regular Text_IO package must be used.
  
  package GNAT.IO is
! pragma Preelaborate (IO);
  
     type File_Type is limited private;
     --  Specifies file to be used (the only possibilities are Standard_Output
--- 41,47 ----
  --  If such checks are needed then the regular Text_IO package must be used.
  
  package GNAT.IO is
!    pragma Preelaborate;
  
     type File_Type is limited private;
     --  Specifies file to be used (the only possibilities are Standard_Output
diff -Nrcpad gcc-4.0.2/gcc/ada/g-io_aux.adb gcc-4.1.0/gcc/ada/g-io_aux.adb
*** gcc-4.0.2/gcc/ada/g-io_aux.adb	Tue Oct 21 13:42:03 2003
--- gcc-4.1.0/gcc/ada/g-io_aux.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . I O _ A U X                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . I O _ A U X                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-io_aux.ads gcc-4.1.0/gcc/ada/g-io_aux.ads
*** gcc-4.0.2/gcc/ada/g-io_aux.ads	Tue Oct 21 13:42:03 2003
--- gcc-4.1.0/gcc/ada/g-io_aux.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . I O _ A U X                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . I O _ A U X                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-locfil.adb gcc-4.1.0/gcc/ada/g-locfil.adb
*** gcc-4.0.2/gcc/ada/g-locfil.adb	Tue Oct 21 13:42:03 2003
--- gcc-4.1.0/gcc/ada/g-locfil.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-locfil.ads gcc-4.1.0/gcc/ada/g-locfil.ads
*** gcc-4.0.2/gcc/ada/g-locfil.ads	Tue Oct 21 13:42:03 2003
--- gcc-4.1.0/gcc/ada/g-locfil.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  purpose of providing realiable system wide locking capability.
  
  package GNAT.Lock_Files is
! pragma Preelaborate;
  
     Lock_Error : exception;
     --  Exception raised if file cannot be locked
--- 35,41 ----
  --  purpose of providing realiable system wide locking capability.
  
  package GNAT.Lock_Files is
!    pragma Preelaborate;
  
     Lock_Error : exception;
     --  Exception raised if file cannot be locked
*************** pragma Preelaborate;
*** 62,68 ****
       (Lock_File_Name : Path_Name;
        Wait           : Duration := 1.0;
        Retries        : Natural  := Natural'Last);
!    --  See above. The full lock file path is given as one string.
  
     procedure Unlock_File (Directory : Path_Name; Lock_File_Name : Path_Name);
     --  Unlock a file. Directory can optionally terminate with a directory
--- 62,68 ----
       (Lock_File_Name : Path_Name;
        Wait           : Duration := 1.0;
        Retries        : Natural  := Natural'Last);
!    --  See above. The full lock file path is given as one string
  
     procedure Unlock_File (Directory : Path_Name; Lock_File_Name : Path_Name);
     --  Unlock a file. Directory can optionally terminate with a directory
diff -Nrcpad gcc-4.0.2/gcc/ada/g-md5.adb gcc-4.1.0/gcc/ada/g-md5.adb
*** gcc-4.0.2/gcc/ada/g-md5.adb	Mon Feb  2 12:31:52 2004
--- gcc-4.1.0/gcc/ada/g-md5.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.MD5 is
*** 138,144 ****
     procedure Transform
       (C     : in out Context;
        Block : String);
!    --  Process one block of 64 characters.
  
     ------------
     -- Decode --
--- 138,144 ----
     procedure Transform
       (C     : in out Context;
        Block : String);
!    --  Process one block of 64 characters
  
     ------------
     -- Decode --
*************** package body GNAT.MD5 is
*** 148,154 ****
       (Block : String;
        X     : out Sixteen_Words)
     is
!       Cur   : Positive := Block'First;
  
     begin
        pragma Assert (Block'Length = 64);
--- 148,154 ----
       (Block : String;
        X     : out Sixteen_Words)
     is
!       Cur : Positive := Block'First;
  
     begin
        pragma Assert (Block'Length = 64);
*************** package body GNAT.MD5 is
*** 171,177 ****
        Result : Message_Digest;
  
        Cur : Natural := 1;
!       --  Index in Result where the next character will be placed.
  
        Last_Block : String (1 .. 64);
  
--- 171,177 ----
        Result : Message_Digest;
  
        Cur : Natural := 1;
!       --  Index in Result where the next character will be placed
  
        Last_Block : String (1 .. 64);
  
*************** package body GNAT.MD5 is
*** 519,525 ****
  
     function Wide_Digest (W : Wide_String) return Message_Digest is
        C : Context;
- 
     begin
        Wide_Update (C, W);
        return Digest (C);
--- 519,524 ----
*************** package body GNAT.MD5 is
*** 533,539 ****
       (C     : in out Context;
        Input : Wide_String)
     is
- 
        String_Input : String (1 .. 2 * Input'Length);
        Cur          : Positive := 1;
  
--- 532,537 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-md5.ads gcc-4.1.0/gcc/ada/g-md5.ads
*** gcc-4.0.2/gcc/ada/g-md5.ads	Mon Feb  2 12:31:52 2004
--- gcc-4.1.0/gcc/ada/g-md5.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.MD5 is
*** 70,76 ****
     --  the same final context as a call with the concatenation of the inputs.
  
     subtype Message_Digest is String (1 .. 32);
!    --  The string type returned by function Digest.
  
     function Digest (C : Context) return Message_Digest;
     --  Extracts the Message-Digest from a context. This function should be
--- 70,76 ----
     --  the same final context as a call with the concatenation of the inputs.
  
     subtype Message_Digest is String (1 .. 32);
!    --  The string type returned by function Digest
  
     function Digest (C : Context) return Message_Digest;
     --  Extracts the Message-Digest from a context. This function should be
*************** package GNAT.MD5 is
*** 88,93 ****
--- 88,94 ----
  private
  
     --  Magic numbers
+ 
     Initial_A : constant := 16#67452301#;
     Initial_B : constant := 16#EFCDAB89#;
     Initial_C : constant := 16#98BADCFE#;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-memdum.adb gcc-4.1.0/gcc/ada/g-memdum.adb
*** gcc-4.0.2/gcc/ada/g-memdum.adb	Wed Dec  3 11:47:52 2003
--- gcc-4.1.0/gcc/ada/g-memdum.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . M E M O R Y _ D U M P                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . M E M O R Y _ D U M P                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-memdum.ads gcc-4.1.0/gcc/ada/g-memdum.ads
*** gcc-4.0.2/gcc/ada/g-memdum.ads	Tue Oct 21 13:42:03 2003
--- gcc-4.1.0/gcc/ada/g-memdum.ads	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . M E M O R Y _ D U M P                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . M E M O R Y _ D U M P                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System;
  
  package GNAT.Memory_Dump is
! pragma Preelaborate (Memory_Dump);
  
     procedure Dump (Addr : System.Address; Count : Natural);
     --  Dumps indicated number (Count) of bytes, starting at the address given
--- 38,44 ----
  with System;
  
  package GNAT.Memory_Dump is
!    pragma Preelaborate;
  
     procedure Dump (Addr : System.Address; Count : Natural);
     --  Dumps indicated number (Count) of bytes, starting at the address given
diff -Nrcpad gcc-4.0.2/gcc/ada/g-moreex.adb gcc-4.1.0/gcc/ada/g-moreex.adb
*** gcc-4.0.2/gcc/ada/g-moreex.adb	Thu Apr 24 17:54:03 2003
--- gcc-4.1.0/gcc/ada/g-moreex.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2000 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-moreex.ads gcc-4.1.0/gcc/ada/g-moreex.ads
*** gcc-4.0.2/gcc/ada/g-moreex.ads	Thu Apr 24 17:54:03 2003
--- gcc-4.1.0/gcc/ada/g-moreex.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2000 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Most_Recent_Exception is
*** 45,53 ****
  
     function Occurrence
       return Ada.Exceptions.Exception_Occurrence;
!    --  Returns the Exception_Occurrence for the most recently raised
!    --  exception in the current task. If no exception has been raised
!    --  in the current task prior to the call, returns Null_Occurrence.
  
     function Occurrence_Access
       return Ada.Exceptions.Exception_Occurrence_Access;
--- 45,53 ----
  
     function Occurrence
       return Ada.Exceptions.Exception_Occurrence;
!    --  Returns the Exception_Occurrence for the most recently raised exception
!    --  in the current task. If no exception has been raised in the current task
!    --  prior to the call, returns Null_Occurrence.
  
     function Occurrence_Access
       return Ada.Exceptions.Exception_Occurrence_Access;
*************** package GNAT.Most_Recent_Exception is
*** 73,77 ****
     --          --  not about the Constraint_Error exception being handled
     --          --  by the current handler code.
  
- 
  end GNAT.Most_Recent_Exception;
--- 73,76 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-os_lib.adb gcc-4.1.0/gcc/ada/g-os_lib.adb
*** gcc-4.0.2/gcc/ada/g-os_lib.adb	Thu Feb 10 13:51:58 2005
--- gcc-4.1.0/gcc/ada/g-os_lib.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Case_Util;
*** 35,63 ****
  with System.CRTL;
  with System.Soft_Links;
  with Unchecked_Conversion;
  with System; use System;
  
  package body GNAT.OS_Lib is
  
     OpenVMS : Boolean;
     --  Note: OpenVMS should be a constant, but it cannot be, because it
     --        prevents bootstrapping on some platforms.
  
-    On_Windows : constant Boolean := Directory_Separator = '\';
- 
     pragma Import (Ada, OpenVMS, "system__openvms");
     --  Needed to avoid doing useless checks when non on a VMS platform (see
     --  Normalize_Pathname).
  
     package SSL renames System.Soft_Links;
  
     --  The following are used by Create_Temp_File
  
!    Current_Temp_File_Name : String := "GNAT-TEMP-000000.TMP";
     --  Name of the temp file last created
  
     Temp_File_Name_Last_Digit : constant Positive :=
!                                  Current_Temp_File_Name'Last - 4;
     --  Position of the last digit in Current_Temp_File_Name
  
     Max_Attempts : constant := 100;
--- 35,78 ----
  with System.CRTL;
  with System.Soft_Links;
  with Unchecked_Conversion;
+ with Unchecked_Deallocation;
  with System; use System;
  
  package body GNAT.OS_Lib is
  
+    --  Imported procedures Dup and Dup2 are used in procedures Spawn and
+    --  Non_Blocking_Spawn.
+ 
+    function Dup (Fd : File_Descriptor) return File_Descriptor;
+    pragma Import (C, Dup, "__gnat_dup");
+ 
+    procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
+    pragma Import (C, Dup2, "__gnat_dup2");
+ 
     OpenVMS : Boolean;
     --  Note: OpenVMS should be a constant, but it cannot be, because it
     --        prevents bootstrapping on some platforms.
  
     pragma Import (Ada, OpenVMS, "system__openvms");
     --  Needed to avoid doing useless checks when non on a VMS platform (see
     --  Normalize_Pathname).
  
+    On_Windows : constant Boolean := Directory_Separator = '\';
+    --  An indication that we are on Windows. Used in Normalize_Pathname, to
+    --  deal with drive letters in the beginning of absolute paths.
+ 
     package SSL renames System.Soft_Links;
  
     --  The following are used by Create_Temp_File
  
!    First_Temp_File_Name : constant String := "GNAT-TEMP-000000.TMP";
!    --  Used to initialize Current_Temp_File_Name and Temp_File_Name_Last_Digit
! 
!    Current_Temp_File_Name : String := First_Temp_File_Name;
     --  Name of the temp file last created
  
     Temp_File_Name_Last_Digit : constant Positive :=
!                                  First_Temp_File_Name'Last - 4;
     --  Position of the last digit in Current_Temp_File_Name
  
     Max_Attempts : constant := 100;
*************** package body GNAT.OS_Lib is
*** 83,95 ****
        Blocking     : Boolean);
     --  Internal routine to implement the two Spawn (blocking/non blocking)
     --  routines. If Blocking is set to True then the spawn is blocking
!    --  otherwise it is non blocking. In this latter case the Pid contains
!    --  the process id number. The first three parameters are as in Spawn.
!    --  Note that Spawn_Internal normalizes the argument list before calling
!    --  the low level system spawn routines (see Normalize_Arguments). Note
!    --  that Normalize_Arguments is designed to do nothing if it is called
!    --  more than once, so calling Normalize_Arguments before calling one
!    --  of the spawn routines is fine.
  
     function To_Path_String_Access
       (Path_Addr : Address;
--- 98,111 ----
        Blocking     : Boolean);
     --  Internal routine to implement the two Spawn (blocking/non blocking)
     --  routines. If Blocking is set to True then the spawn is blocking
!    --  otherwise it is non blocking. In this latter case the Pid contains the
!    --  process id number. The first three parameters are as in Spawn. Note that
!    --  Spawn_Internal normalizes the argument list before calling the low level
!    --  system spawn routines (see Normalize_Arguments).
!    --
!    --  Note: Normalize_Arguments is designed to do nothing if it is called more
!    --  than once, so calling Normalize_Arguments before calling one of the
!    --  spawn routines is fine.
  
     function To_Path_String_Access
       (Path_Addr : Address;
*************** package body GNAT.OS_Lib is
*** 235,244 ****
     ---------------------
  
     function C_String_Length (S : Address) return Integer is
- 
        function Strlen (S : Address) return Integer;
        pragma Import (C, Strlen, "strlen");
- 
     begin
        if S = Null_Address then
           return 0;
--- 251,258 ----
*************** package body GNAT.OS_Lib is
*** 318,323 ****
--- 332,339 ----
              return C = Directory_Separator or else C = '/';
           end Is_Dirsep;
  
+       --  Start of processing for Build_Path
+ 
        begin
           --  Find base file name
  
*************** package body GNAT.OS_Lib is
*** 354,372 ****
  
        procedure Copy (From, To : File_Descriptor) is
           Buf_Size : constant := 200_000;
!          Buffer   : array (1 .. Buf_Size) of Character;
!          R        : Integer;
!          W        : Integer;
  
           Status_From : Boolean;
           Status_To   : Boolean;
           --  Statuses for the calls to Close
  
        begin
           if From = Invalid_FD or else To = Invalid_FD then
              raise Copy_Error;
           end if;
  
           loop
              R := Read (From, Buffer (1)'Address, Buf_Size);
  
--- 370,397 ----
  
        procedure Copy (From, To : File_Descriptor) is
           Buf_Size : constant := 200_000;
!          type Buf is array (1 .. Buf_Size) of Character;
!          type Buf_Ptr is access Buf;
! 
!          Buffer : Buf_Ptr;
!          R      : Integer;
!          W      : Integer;
  
           Status_From : Boolean;
           Status_To   : Boolean;
           --  Statuses for the calls to Close
  
+          procedure Free is new Unchecked_Deallocation (Buf, Buf_Ptr);
+ 
        begin
           if From = Invalid_FD or else To = Invalid_FD then
              raise Copy_Error;
           end if;
  
+          --  Allocate the buffer on the heap
+ 
+          Buffer := new Buf;
+ 
           loop
              R := Read (From, Buffer (1)'Address, Buf_Size);
  
*************** package body GNAT.OS_Lib is
*** 386,391 ****
--- 411,418 ----
                 Close (From, Status_From);
                 Close (To, Status_To);
  
+                Free (Buffer);
+ 
                 raise Copy_Error;
              end if;
           end loop;
*************** package body GNAT.OS_Lib is
*** 393,398 ****
--- 420,427 ----
           Close (From, Status_From);
           Close (To, Status_To);
  
+          Free (Buffer);
+ 
           if not (Status_From and Status_To) then
              raise Copy_Error;
           end if;
*************** package body GNAT.OS_Lib is
*** 476,483 ****
                    Dest : constant String := Build_Path (Pathname, Name);
  
                 begin
!                   --  If the target file exists, we have an error
!                   --  otherwise do the copy.
  
                    if Is_Regular_File (Dest) then
                       raise Copy_Error;
--- 505,511 ----
                    Dest : constant String := Build_Path (Pathname, Name);
  
                 begin
!                   --  If target file exists, we have an error, else do copy
  
                    if Is_Regular_File (Dest) then
                       raise Copy_Error;
*************** package body GNAT.OS_Lib is
*** 492,498 ****
                 Copy_To (Pathname);
              end if;
  
!          --  Overwrite case, destination file may or may not exist
  
           when Overwrite =>
              if Is_Directory (Pathname) then
--- 520,526 ----
                 Copy_To (Pathname);
              end if;
  
!          --  Overwrite case (destination file may or may not exist)
  
           when Overwrite =>
              if Is_Directory (Pathname) then
*************** package body GNAT.OS_Lib is
*** 501,507 ****
                 Copy_To (Pathname);
              end if;
  
!          --  Appending case, destination file may or may not exist
  
           when Append =>
  
--- 529,535 ----
                 Copy_To (Pathname);
              end if;
  
!          --  Append case (destination file may or may not exist)
  
           when Append =>
  
*************** package body GNAT.OS_Lib is
*** 509,516 ****
  
              if Is_Regular_File (Pathname) then
  
!                --  Append mode and destination file exists, append data
!                --  at the end of Pathname.
  
                 From := Open_Read (Name, Binary);
                 To   := Open_Read_Write (Pathname, Binary);
--- 537,544 ----
  
              if Is_Regular_File (Pathname) then
  
!                --  Append mode and destination file exists, append data at the
!                --  end of Pathname.
  
                 From := Open_Read (Name, Binary);
                 To   := Open_Read_Write (Pathname, Binary);
*************** package body GNAT.OS_Lib is
*** 829,835 ****
     function File_Time_Stamp (FD : File_Descriptor) return OS_Time is
        function File_Time (FD    : File_Descriptor) return OS_Time;
        pragma Import (C, File_Time, "__gnat_file_time_fd");
- 
     begin
        return File_Time (FD);
     end File_Time_Stamp;
--- 857,862 ----
*************** package body GNAT.OS_Lib is
*** 837,850 ****
     function File_Time_Stamp (Name : C_File_Name) return OS_Time is
        function File_Time (Name : Address) return OS_Time;
        pragma Import (C, File_Time, "__gnat_file_time_name");
- 
     begin
        return File_Time (Name);
     end File_Time_Stamp;
  
     function File_Time_Stamp (Name : String) return OS_Time is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 864,875 ----
*************** package body GNAT.OS_Lib is
*** 1124,1130 ****
          (Name   : Address;
           Length : Integer) return Integer;
        pragma Import (C, Is_Absolute_Path, "__gnat_is_absolute_path");
- 
     begin
        return Is_Absolute_Path (Name'Address, Name'Length) /= 0;
     end Is_Absolute_Path;
--- 1149,1154 ----
*************** package body GNAT.OS_Lib is
*** 1136,1149 ****
     function Is_Directory (Name : C_File_Name) return Boolean is
        function Is_Directory (Name : Address) return Integer;
        pragma Import (C, Is_Directory, "__gnat_is_directory");
- 
     begin
        return Is_Directory (Name) /= 0;
     end Is_Directory;
  
     function Is_Directory (Name : String) return Boolean is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 1160,1171 ----
*************** package body GNAT.OS_Lib is
*** 1157,1170 ****
     function Is_Regular_File (Name : C_File_Name) return Boolean is
        function Is_Regular_File (Name : Address) return Integer;
        pragma Import (C, Is_Regular_File, "__gnat_is_regular_file");
- 
     begin
        return Is_Regular_File (Name) /= 0;
     end Is_Regular_File;
  
     function Is_Regular_File (Name : String) return Boolean is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 1179,1190 ----
*************** package body GNAT.OS_Lib is
*** 1178,1191 ****
     function Is_Readable_File (Name : C_File_Name) return Boolean is
        function Is_Readable_File (Name : Address) return Integer;
        pragma Import (C, Is_Readable_File, "__gnat_is_readable_file");
- 
     begin
        return Is_Readable_File (Name) /= 0;
     end Is_Readable_File;
  
     function Is_Readable_File (Name : String) return Boolean is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 1198,1209 ----
*************** package body GNAT.OS_Lib is
*** 1199,1212 ****
     function Is_Writable_File (Name : C_File_Name) return Boolean is
        function Is_Writable_File (Name : Address) return Integer;
        pragma Import (C, Is_Writable_File, "__gnat_is_writable_file");
- 
     begin
        return Is_Writable_File (Name) /= 0;
     end Is_Writable_File;
  
     function Is_Writable_File (Name : String) return Boolean is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 1217,1228 ----
*************** package body GNAT.OS_Lib is
*** 1220,1233 ****
     function Is_Symbolic_Link (Name : C_File_Name) return Boolean is
        function Is_Symbolic_Link (Name : Address) return Integer;
        pragma Import (C, Is_Symbolic_Link, "__gnat_is_symbolic_link");
- 
     begin
        return Is_Symbolic_Link (Name) /= 0;
     end Is_Symbolic_Link;
  
     function Is_Symbolic_Link (Name : String) return Boolean is
        F_Name : String (1 .. Name'Length + 1);
- 
     begin
        F_Name (1 .. Name'Length) := Name;
        F_Name (F_Name'Last)      := ASCII.NUL;
--- 1236,1247 ----
*************** package body GNAT.OS_Lib is
*** 1334,1339 ****
--- 1348,1432 ----
        return Pid;
     end Non_Blocking_Spawn;
  
+    function Non_Blocking_Spawn
+      (Program_Name           : String;
+       Args                   : Argument_List;
+       Output_File_Descriptor : File_Descriptor;
+       Err_To_Out             : Boolean := True)
+       return                   Process_Id
+    is
+       Saved_Output : File_Descriptor;
+       Saved_Error  : File_Descriptor := Invalid_FD; -- prevent warning
+       Pid          : Process_Id;
+    begin
+       if Output_File_Descriptor = Invalid_FD then
+          return Invalid_Pid;
+       end if;
+ 
+       --  Set standard output and, if specified, error to the temporary file
+ 
+       Saved_Output := Dup (Standout);
+       Dup2 (Output_File_Descriptor, Standout);
+ 
+       if Err_To_Out then
+          Saved_Error  := Dup (Standerr);
+          Dup2 (Output_File_Descriptor, Standerr);
+       end if;
+ 
+       --  Spawn the program
+ 
+       Pid := Non_Blocking_Spawn (Program_Name, Args);
+ 
+       --  Restore the standard output and error
+ 
+       Dup2 (Saved_Output, Standout);
+ 
+       if Err_To_Out then
+          Dup2 (Saved_Error, Standerr);
+       end if;
+ 
+       --  And close the saved standard output and error file descriptors
+ 
+       Close (Saved_Output);
+ 
+       if Err_To_Out then
+          Close (Saved_Error);
+       end if;
+ 
+       return Pid;
+    end Non_Blocking_Spawn;
+ 
+    function Non_Blocking_Spawn
+      (Program_Name : String;
+       Args         : Argument_List;
+       Output_File  : String;
+       Err_To_Out   : Boolean := True) return Process_Id
+    is
+       Output_File_Descriptor : constant File_Descriptor :=
+                                  Create_Output_Text_File (Output_File);
+       Result : Process_Id;
+ 
+    begin
+       --  Do not attempt to spawn if the output file could not be created
+ 
+       if Output_File_Descriptor = Invalid_FD then
+          return Invalid_Pid;
+ 
+       else
+          Result := Non_Blocking_Spawn
+                      (Program_Name, Args, Output_File_Descriptor, Err_To_Out);
+ 
+          --  Close the file just created for the output, as the file descriptor
+          --  cannot be used anywhere, being a local value. It is safe to do
+          --  that, as the file descriptor has been duplicated to form
+          --  standard output and error of the spawned process.
+ 
+          Close (Output_File_Descriptor);
+ 
+          return Result;
+       end if;
+    end Non_Blocking_Spawn;
+ 
     -------------------------
     -- Normalize_Arguments --
     -------------------------
*************** package body GNAT.OS_Lib is
*** 1420,1425 ****
--- 1513,1520 ----
           end if;
        end Quote_Argument;
  
+    --  Start of processing for Normalize_Arguments
+ 
     begin
        if Argument_Needs_Quote then
           for K in Args'Range loop
*************** package body GNAT.OS_Lib is
*** 1746,1751 ****
--- 1841,1847 ----
              end if;
  
              --  Add the ASCII.NUL to be able to call the C function chdir
+ 
              Path (Pos + 1) := ASCII.NUL;
  
              Status := Change_Dir (Path (1 .. Pos + 1));
*************** package body GNAT.OS_Lib is
*** 1779,1791 ****
  
        --  Start the conversions
  
!       --  If this is not finished after Max_Iterations, give up and
!       --  return an empty string.
  
        for J in 1 .. Max_Iterations loop
  
!          --  If we don't have an absolute pathname, prepend
!          --  the directory Reference_Dir.
  
           if Last = 1
             and then not Is_Absolute_Path (Path_Buffer (1 .. End_Path))
--- 1875,1887 ----
  
        --  Start the conversions
  
!       --  If this is not finished after Max_Iterations, give up and return an
!       --  empty string.
  
        for J in 1 .. Max_Iterations loop
  
!          --  If we don't have an absolute pathname, prepend the directory
!          --  Reference_Dir.
  
           if Last = 1
             and then not Is_Absolute_Path (Path_Buffer (1 .. End_Path))
*************** package body GNAT.OS_Lib is
*** 1835,1842 ****
              end if;
           end loop;
  
!          --  Find the end of the current field: last character
!          --  or the one preceding the next directory separator.
  
           while Finish < End_Path
             and then Path_Buffer (Finish + 1) /= Directory_Separator
--- 1931,1938 ----
              end if;
           end loop;
  
!          --  Find the end of the current field: last character or the one
!          --  preceding the next directory separator.
  
           while Finish < End_Path
             and then Path_Buffer (Finish + 1) /= Directory_Separator
*************** package body GNAT.OS_Lib is
*** 1947,1957 ****
  
        --  Too many iterations: give up
  
!       --  This can happen when there is a circularity in the symbolic links:
!       --  A is a symbolic link for B, which itself is a symbolic link, and
!       --  the target of B or of another symbolic link target of B is A.
!       --  In this case, we return an empty string to indicate failure to
!       --  resolve.
  
        return "";
     end Normalize_Pathname;
--- 2043,2052 ----
  
        --  Too many iterations: give up
  
!       --  This can happen when there is a circularity in the symbolic links: A
!       --  is a symbolic link for B, which itself is a symbolic link, and the
!       --  target of B or of another symbolic link target of B is A. In this
!       --  case, we return an empty string to indicate failure to resolve.
  
        return "";
     end Normalize_Pathname;
*************** package body GNAT.OS_Lib is
*** 2015,2023 ****
     ----------
  
     function Read
!      (FD   : File_Descriptor;
!       A    : System.Address;
!       N    : Integer) return Integer
     is
     begin
        return Integer (System.CRTL.read
--- 2110,2118 ----
     ----------
  
     function Read
!      (FD : File_Descriptor;
!       A  : System.Address;
!       N  : Integer) return Integer
     is
     begin
        return Integer (System.CRTL.read
*************** package body GNAT.OS_Lib is
*** 2167,2184 ****
        Return_Code            : out Integer;
        Err_To_Out             : Boolean := True)
     is
-       function Dup (Fd : File_Descriptor) return File_Descriptor;
-       pragma Import (C, Dup, "__gnat_dup");
- 
-       procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
-       pragma Import (C, Dup2, "__gnat_dup2");
- 
        Saved_Output : File_Descriptor;
!       Saved_Error  : File_Descriptor := Invalid_FD;
!       --  We need to initialize Saved_Error to Invalid_FD to avoid
!       --  a compiler warning that this variable may be used before
!       --  it is initialized (which can not happen, but the compiler
!       --  is not smart enough to figure this out).
  
     begin
        --  Set standard output and error to the temporary file
--- 2262,2269 ----
        Return_Code            : out Integer;
        Err_To_Out             : Boolean := True)
     is
        Saved_Output : File_Descriptor;
!       Saved_Error  : File_Descriptor := Invalid_FD; -- prevent compiler warning
  
     begin
        --  Set standard output and error to the temporary file
*************** package body GNAT.OS_Lib is
*** 2268,2282 ****
                                                + Args_Length (Args);
           Command_Last : Natural := 0;
           Command : aliased Chars (1 .. Command_Len);
!          --  Command contains all characters of the Program_Name and Args,
!          --  all terminated by ASCII.NUL characters
  
           Arg_List_Len : constant Positive := Args'Length + 2;
           Arg_List_Last : Natural := 0;
           Arg_List : aliased array (1 .. Arg_List_Len) of Char_Ptr;
!          --  List with pointers to NUL-terminated strings of the
!          --  Program_Name and the Args and terminated with a null pointer.
!          --  We rely on the default initialization for the last null pointer.
  
           procedure Add_To_Command (S : String);
           --  Add S and a NUL character to Command, updating Last
--- 2353,2367 ----
                                                + Args_Length (Args);
           Command_Last : Natural := 0;
           Command : aliased Chars (1 .. Command_Len);
!          --  Command contains all characters of the Program_Name and Args, all
!          --  terminated by ASCII.NUL characters
  
           Arg_List_Len : constant Positive := Args'Length + 2;
           Arg_List_Last : Natural := 0;
           Arg_List : aliased array (1 .. Arg_List_Len) of Char_Ptr;
!          --  List with pointers to NUL-terminated strings of the Program_Name
!          --  and the Args and terminated with a null pointer. We rely on the
!          --  default initialization for the last null pointer.
  
           procedure Add_To_Command (S : String);
           --  Add S and a NUL character to Command, updating Last
*************** package body GNAT.OS_Lib is
*** 2298,2305 ****
           begin
              Command_Last := Command_Last + S'Length;
  
!             --  Move characters one at a time, because Command has
!             --  aliased components.
  
              for J in S'Range loop
                 Command (First + J - S'First) := S (J);
--- 2383,2392 ----
           begin
              Command_Last := Command_Last + S'Length;
  
!             --  Move characters one at a time, because Command has aliased
!             --  components.
! 
!             --  But not volatile, so why is this necessary ???
  
              for J in S'Range loop
                 Command (First + J - S'First) := S (J);
*************** package body GNAT.OS_Lib is
*** 2404,2412 ****
     -----------
  
     function Write
!      (FD   : File_Descriptor;
!       A    : System.Address;
!       N    : Integer) return Integer
     is
     begin
        return Integer (System.CRTL.write
--- 2491,2499 ----
     -----------
  
     function Write
!      (FD : File_Descriptor;
!       A  : System.Address;
!       N  : Integer) return Integer
     is
     begin
        return Integer (System.CRTL.write
diff -Nrcpad gcc-4.0.2/gcc/ada/g-os_lib.ads gcc-4.1.0/gcc/ada/g-os_lib.ads
*** gcc-4.0.2/gcc/ada/g-os_lib.ads	Thu Feb 10 13:51:58 2005
--- gcc-4.1.0/gcc/ada/g-os_lib.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.OS_Lib is
*** 114,120 ****
     subtype Second_Type is Integer range    0 ..   59;
     --  Declarations similar to those in Calendar, breaking down the time
  
- 
     function GM_Year    (Date : OS_Time) return Year_Type;
     function GM_Month   (Date : OS_Time) return Month_Type;
     function GM_Day     (Date : OS_Time) return Day_Type;
--- 114,119 ----
*************** package GNAT.OS_Lib is
*** 350,365 ****
     --  platforms, Success is always set to False.
  
     function Read
!      (FD   : File_Descriptor;
!       A    : System.Address;
!       N    : Integer) return Integer;
     --  Read N bytes to address A from file referenced by FD. Returned value is
     --  count of bytes actually read, which can be less than N at EOF.
  
     function Write
!      (FD   : File_Descriptor;
!       A    : System.Address;
!       N    : Integer) return Integer;
     --  Write N bytes from address A to file referenced by FD. The returned
     --  value is the number of bytes written, which can be less than N if a
     --  disk full condition was detected.
--- 349,364 ----
     --  platforms, Success is always set to False.
  
     function Read
!      (FD : File_Descriptor;
!       A  : System.Address;
!       N  : Integer) return Integer;
     --  Read N bytes to address A from file referenced by FD. Returned value is
     --  count of bytes actually read, which can be less than N at EOF.
  
     function Write
!      (FD : File_Descriptor;
!       A  : System.Address;
!       N  : Integer) return Integer;
     --  Write N bytes from address A to file referenced by FD. The returned
     --  value is the number of bytes written, which can be less than N if a
     --  disk full condition was detected.
*************** package GNAT.OS_Lib is
*** 715,720 ****
--- 714,753 ----
     --  This function will always return Invalid_Id under VxWorks, since there
     --  is no notion of executables under this OS.
  
+    function Non_Blocking_Spawn
+      (Program_Name           : String;
+       Args                   : Argument_List;
+       Output_File_Descriptor : File_Descriptor;
+       Err_To_Out             : Boolean := True) return Process_Id;
+    --  Similar to the procedure above, but redirects the output to the file
+    --  designated by Output_File_Descriptor. If Err_To_Out is True, then the
+    --  Standard Error output is also redirected. Invalid_Id is returned
+    --  if the program could not be spawned successfully.
+    --
+    --  "Non_Blocking_Spawn" should not be used in tasking applications.
+    --
+    --  This function will always return Invalid_Id under VxWorks, since there
+    --  is no notion of executables under this OS.
+ 
+    function Non_Blocking_Spawn
+      (Program_Name : String;
+       Args         : Argument_List;
+       Output_File  : String;
+       Err_To_Out   : Boolean := True)
+       return         Process_Id;
+    --  Similar to the procedure above, but saves the output of the command to
+    --  a file with the name Output_File.
+    --
+    --  Success is set to True if the command is executed and its output
+    --  successfully written to the file. Invalid_Id is returned if the output
+    --  file could not be created or if the program could not be spawned
+    --  successfully.
+    --
+    --  "Non_Blocking_Spawn" should not be used in tasking applications.
+    --
+    --  This function will always return Invalid_Id under VxWorks, since there
+    --  is no notion of executables under this OS.
+ 
     procedure Wait_Process (Pid : out Process_Id; Success : out Boolean);
     --  Wait for the completion of any of the processes created by previous
     --  calls to Non_Blocking_Spawn. The caller will be suspended until one of
*************** package GNAT.OS_Lib is
*** 730,737 ****
     --  there is no notion of executables under this OS.
  
     function Argument_String_To_List
!      (Arg_String : String)
!       return       Argument_List_Access;
     --  Take a string that is a program and its arguments and parse it into an
     --  Argument_List. Note that the result is allocated on the heap, and must
     --  be freed by the programmer (when it is no longer needed) to avoid
--- 763,769 ----
     --  there is no notion of executables under this OS.
  
     function Argument_String_To_List
!      (Arg_String : String) return Argument_List_Access;
     --  Take a string that is a program and its arguments and parse it into an
     --  Argument_List. Note that the result is allocated on the heap, and must
     --  be freed by the programmer (when it is no longer needed) to avoid
diff -Nrcpad gcc-4.0.2/gcc/ada/g-pehage.adb gcc-4.1.0/gcc/ada/g-pehage.adb
*** gcc-4.0.2/gcc/ada/g-pehage.adb	Mon Sep 13 10:18:39 2004
--- gcc-4.1.0/gcc/ada/g-pehage.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with GNAT.Table;
*** 40,63 ****
  
  package body GNAT.Perfect_Hash_Generators is
  
!    --  We are using the algorithm of J. Czech as described in Zbigniew
!    --  J. Czech, George Havas, and Bohdan S. Majewski ``An Optimal
!    --  Algorithm for Generating Minimal Perfect Hash Functions'',
!    --  Information Processing Letters, 43(1992) pp.257-264, Oct.1992
  
!    --  This minimal perfect hash function generator is based on random
!    --  graphs and produces a hash function of the form:
  
     --             h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
!    --  where f1 and f2 are functions that map strings into integers,
!    --  and g is a function that maps integers into [0, m-1]. h can be
!    --  order preserving. For instance, let W = {w_0, ..., w_i, ...,
     --  w_m-1}, h can be defined such that h (w_i) = i.
  
!    --  This algorithm defines two possible constructions of f1 and
!    --  f2. Method b) stores the hash function in less memory space at
!    --  the expense of greater CPU time.
  
     --  a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
  
--- 40,63 ----
  
  package body GNAT.Perfect_Hash_Generators is
  
!    --  We are using the algorithm of J. Czech as described in Zbigniew J.
!    --  Czech, George Havas, and Bohdan S. Majewski ``An Optimal Algorithm for
!    --  Generating Minimal Perfect Hash Functions'', Information Processing
!    --  Letters, 43(1992) pp.257-264, Oct.1992
  
!    --  This minimal perfect hash function generator is based on random graphs
!    --  and produces a hash function of the form:
  
     --             h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
!    --  where f1 and f2 are functions that map strings into integers, and g is a
!    --  function that maps integers into [0, m-1]. h can be order preserving.
!    --  For instance, let W = {w_0, ..., w_i, ...,
     --  w_m-1}, h can be defined such that h (w_i) = i.
  
!    --  This algorithm defines two possible constructions of f1 and f2. Method
!    --  b) stores the hash function in less memory space at the expense of
!    --  greater CPU time.
  
     --  a) fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
  
*************** package body GNAT.Perfect_Hash_Generator
*** 65,100 ****
  
     --  b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
  
!    --     size (Tk) = max (for w in W) (length (w)) but the table
!    --     lookups are replaced by multiplications.
  
!    --  where Tk values are randomly generated. n is defined later on
!    --  but the algorithm recommends to use a value a little bit
!    --  greater than 2m. Note that for large values of m, the main
!    --  memory space requirements comes from the memory space for
!    --  storing function g (>= 2m entries).
  
!    --  Random graphs are frequently used to solve difficult problems
!    --  that do not have polynomial solutions. This algorithm is based
!    --  on a weighted undirected graph. It comprises two steps: mapping
!    --  and assigment.
  
!    --  In the mapping step, a graph G = (V, E) is constructed, where V
!    --  = {0, 1, ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In
!    --  order for the assignment step to be successful, G has to be
!    --  acyclic. To have a high probability of generating an acyclic
!    --  graph, n >= 2m. If it is not acyclic, Tk have to be regenerated.
  
!    --  In the assignment step, the algorithm builds function g. As G
!    --  is acyclic, there is a vertex v1 with only one neighbor v2. Let
!    --  w_i be the word such that v1 = f1 (w_i) and v2 = f2 (w_i). Let
!    --  g (v1) = 0 by construction and g (v2) = (i - g (v1)) mod n (or
!    --  to be general, (h (i) - g (v1) mod n). If word w_j is such that
!    --  v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j - g (v2)) mod n
!    --  (or to be general, (h (j) - g (v2)) mod n). If w_i has no
!    --  neighbor, then another vertex is selected. The algorithm
!    --  traverses G to assign values to all the vertices. It cannot
!    --  assign a value to an already assigned vertex as G is acyclic.
  
     subtype Word_Id   is Integer;
     subtype Key_Id    is Integer;
--- 65,97 ----
  
     --  b) fk (w) = sum (for i in 1 .. length (w)) (Tk (i) * w (i)) mod n
  
!    --     size (Tk) = max (for w in W) (length (w)) but the table lookups are
!    --     replaced by multiplications.
  
!    --  where Tk values are randomly generated. n is defined later on but the
!    --  algorithm recommends to use a value a little bit greater than 2m. Note
!    --  that for large values of m, the main memory space requirements comes
!    --  from the memory space for storing function g (>= 2m entries).
  
!    --  Random graphs are frequently used to solve difficult problems that do
!    --  not have polynomial solutions. This algorithm is based on a weighted
!    --  undirected graph. It comprises two steps: mapping and assigment.
  
!    --  In the mapping step, a graph G = (V, E) is constructed, where = {0, 1,
!    --  ..., n-1} and E = {(for w in W) (f1 (w), f2 (w))}. In order for the
!    --  assignment step to be successful, G has to be acyclic. To have a high
!    --  probability of generating an acyclic graph, n >= 2m. If it is not
!    --  acyclic, Tk have to be regenerated.
  
!    --  In the assignment step, the algorithm builds function g. As is acyclic,
!    --  there is a vertex v1 with only one neighbor v2. Let w_i be the word such
!    --  that v1 = f1 (w_i) and v2 = f2 (w_i). Let g (v1) = 0 by construction and
!    --  g (v2) = (i - g (v1)) mod n (or to be general, (h (i) - g (v1) mod n).
!    --  If word w_j is such that v2 = f1 (w_j) and v3 = f2 (w_j), g (v3) = (j -
!    --  g (v2)) mod (or to be general, (h (j) - g (v2)) mod n). If w_i has no
!    --  neighbor, then another vertex is selected. The algorithm traverses G to
!    --  assign values to all the vertices. It cannot assign a value to an
!    --  already assigned vertex as G is acyclic.
  
     subtype Word_Id   is Integer;
     subtype Key_Id    is Integer;
*************** package body GNAT.Perfect_Hash_Generator
*** 109,150 ****
     Max_Word_Length : constant := 32;
     subtype Word_Type is String (1 .. Max_Word_Length);
     Null_Word : constant Word_Type := (others => ASCII.NUL);
!    --  Store keyword in a word. Note that the length of word is
!    --  limited to 32 characters.
  
     type Key_Type is record
        Edge : Edge_Id;
     end record;
!    --  A key corresponds to an edge in the algorithm graph.
  
     type Vertex_Type is record
        First : Edge_Id;
        Last  : Edge_Id;
     end record;
!    --  A vertex can be involved in several edges. First and Last are
!    --  the bounds of an array of edges stored in a global edge table.
  
     type Edge_Type is record
        X   : Vertex_Id;
        Y   : Vertex_Id;
        Key : Key_Id;
     end record;
!    --  An edge is a peer of vertices. In the algorithm, a key
!    --  is associated to an edge.
  
     package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
     package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
!    --  The two main tables. IT is used to store several tables of
!    --  components containing only integers.
  
     function Image (Int : Integer; W : Natural := 0) return String;
     function Image (Str : String;  W : Natural := 0) return String;
!    --  Return a string which includes string Str or integer Int
!    --  preceded by leading spaces if required by width W.
  
     Output : File_Descriptor renames GNAT.OS_Lib.Standout;
     --  Shortcuts
  
     Max  : constant := 78;
     Last : Natural  := 0;
     Line : String (1 .. Max);
--- 106,149 ----
     Max_Word_Length : constant := 32;
     subtype Word_Type is String (1 .. Max_Word_Length);
     Null_Word : constant Word_Type := (others => ASCII.NUL);
!    --  Store keyword in a word. Note that the length of word is limited to 32
!    --  characters.
  
     type Key_Type is record
        Edge : Edge_Id;
     end record;
!    --  A key corresponds to an edge in the algorithm graph
  
     type Vertex_Type is record
        First : Edge_Id;
        Last  : Edge_Id;
     end record;
!    --  A vertex can be involved in several edges. First and Last are the bounds
!    --  of an array of edges stored in a global edge table.
  
     type Edge_Type is record
        X   : Vertex_Id;
        Y   : Vertex_Id;
        Key : Key_Id;
     end record;
!    --  An edge is a peer of vertices. In the algorithm, a key is associated to
!    --  an edge.
  
     package WT is new GNAT.Table (Word_Type, Word_Id, 0, 32, 32);
     package IT is new GNAT.Table (Integer, Integer, 0, 32, 32);
!    --  The two main tables. IT is used to store several tables of components
!    --  containing only integers.
  
     function Image (Int : Integer; W : Natural := 0) return String;
     function Image (Str : String;  W : Natural := 0) return String;
!    --  Return a string which includes string Str or integer Int preceded by
!    --  leading spaces if required by width W.
  
     Output : File_Descriptor renames GNAT.OS_Lib.Standout;
     --  Shortcuts
  
+    EOL : constant Character := ASCII.LF;
+ 
     Max  : constant := 78;
     Last : Natural  := 0;
     Line : String (1 .. Max);
*************** package body GNAT.Perfect_Hash_Generator
*** 163,186 ****
        F2 : Natural;
        L2 : Natural;
        C2 : Natural);
!    --  Write string S into file F as a element of an array of one or
!    --  two dimensions. Fk (resp. Lk and Ck) indicates the first (resp
!    --  last and current) index in the k-th dimension. If F1 = L1 the
!    --  array is considered as a one dimension array. This dimension is
!    --  described by F2 and L2. This routine takes care of all the
!    --  parenthesis, spaces and commas needed to format correctly the
!    --  array. Moreover, the array is well indented and is wrapped to
!    --  fit in a 80 col line. When the line is full, the routine writes
!    --  it into file F. When the array is completed, the routine adds a
     --  semi-colon and writes the line into file F.
  
     procedure New_Line
!      (F : File_Descriptor);
     --  Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
  
     procedure Put
!      (F : File_Descriptor;
!       S : String);
     --  Simulate Ada.Text_IO.Put with GNAT.OS_Lib
  
     procedure Put_Used_Char_Set
--- 162,184 ----
        F2 : Natural;
        L2 : Natural;
        C2 : Natural);
!    --  Write string S into file F as a element of an array of one or two
!    --  dimensions. Fk (resp. Lk and Ck) indicates the first (resp last and
!    --  current) index in the k-th dimension. If F1 = L1 the array is considered
!    --  as a one dimension array. This dimension is described by F2 and L2. This
!    --  routine takes care of all the parenthesis, spaces and commas needed to
!    --  format correctly the array. Moreover, the array is well indented and is
!    --  wrapped to fit in a 80 col line. When the line is full, the routine
!    --  writes it into file F. When the array is completed, the routine adds
     --  semi-colon and writes the line into file F.
  
     procedure New_Line
!      (File : File_Descriptor);
     --  Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
  
     procedure Put
!      (File : File_Descriptor;
!       Str  : String);
     --  Simulate Ada.Text_IO.Put with GNAT.OS_Lib
  
     procedure Put_Used_Char_Set
*************** package body GNAT.Perfect_Hash_Generator
*** 191,206 ****
     procedure Put_Int_Vector
       (File   : File_Descriptor;
        Title  : String;
!       Root   : Integer;
        Length : Natural);
     --  Output a title and a vector
  
     procedure Put_Int_Matrix
       (File  : File_Descriptor;
        Title : String;
!       Table : Table_Id);
!    --  Output a title and a matrix. When the matrix has only one
!    --  non-empty dimension, it is output as a vector.
  
     procedure Put_Edges
       (File  : File_Descriptor;
--- 189,206 ----
     procedure Put_Int_Vector
       (File   : File_Descriptor;
        Title  : String;
!       Vector : Integer;
        Length : Natural);
     --  Output a title and a vector
  
     procedure Put_Int_Matrix
       (File  : File_Descriptor;
        Title : String;
!       Table : Table_Id;
!       Len_1 : Natural;
!       Len_2 : Natural);
!    --  Output a title and a matrix. When the matrix has only one non-empty
!    --  dimension (Len_2 = 0), output a vector.
  
     procedure Put_Edges
       (File  : File_Descriptor;
*************** package body GNAT.Perfect_Hash_Generator
*** 226,307 ****
     -- Character Position Selection --
     ----------------------------------
  
!    --  We reduce the maximum key size by selecting representative
!    --  positions in these keys. We build a matrix with one word per
!    --  line. We fill the remaining space of a line with ASCII.NUL. The
!    --  heuristic selects the position that induces the minimum number
!    --  of collisions. If there are collisions, select another position
!    --  on the reduced key set responsible of the collisions. Apply the
!    --  heuristic until there is no more collision.
  
     procedure Apply_Position_Selection;
     --  Apply Position selection and build the reduced key table
  
     procedure Parse_Position_Selection (Argument : String);
!    --  Parse Argument and compute the position set. Argument is a
!    --  list of substrings separated by commas. Each substring
!    --  represents a position or a range of positions (like x-y).
  
     procedure Select_Character_Set;
!    --  Define an optimized used character set like Character'Pos in
!    --  order not to allocate tables of 256 entries.
  
     procedure Select_Char_Position;
!    --  Find a min char position set in order to reduce the max key
!    --  length. The heuristic selects the position that induces the
!    --  minimum number of collisions. If there are collisions, select
!    --  another position on the reduced key set responsible of the
!    --  collisions. Apply the heuristic until there is no collision.
  
     -----------------------------
     -- Random Graph Generation --
     -----------------------------
  
     procedure Random (Seed : in out Natural);
!    --  Simulate Ada.Discrete_Numerics.Random.
  
     procedure Generate_Mapping_Table
!      (T  : Table_Id;
!       L1 : Natural;
!       L2 : Natural;
!       S  : in out Natural);
!    --  Random generation of the tables below. T is already allocated.
  
     procedure Generate_Mapping_Tables
!      (Opt : Optimization;
!       S   : in out Natural);
!    --  Generate the mapping tables T1 and T2. They are used to define :
!    --  fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n.
!    --  Keys, NK and Chars are used to compute the matrix size.
  
     ---------------------------
     -- Algorithm Computation --
     ---------------------------
  
     procedure Compute_Edges_And_Vertices (Opt : Optimization);
!    --  Compute the edge and vertex tables. These are empty when a self
!    --  loop is detected (f1 (w) = f2 (w)). The edge table is sorted by
!    --  X value and then Y value. Keys is the key table and NK the
!    --  number of keys. Chars is the set of characters really used in
!    --  Keys. NV is the number of vertices recommended by the
!    --  algorithm. T1 and T2 are the mapping tables needed to compute
!    --  f1 (w) and f2 (w).
  
     function Acyclic return Boolean;
!    --  Return True when the graph is acyclic. Vertices is the current
!    --  vertex table and Edges the current edge table.
  
     procedure Assign_Values_To_Vertices;
!    --  Execute the assignment step of the algorithm. Keys is the
!    --  current key table. Vertices and Edges represent the random
!    --  graph. G is the result of the assignment step such that:
     --    h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
     function Sum
       (Word  : Word_Type;
        Table : Table_Id;
!       Opt   : Optimization)
!       return  Natural;
     --  For an optimization of CPU_Time return
     --    fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
     --  For an optimization of Memory_Space return
--- 226,304 ----
     -- Character Position Selection --
     ----------------------------------
  
!    --  We reduce the maximum key size by selecting representative positions
!    --  in these keys. We build a matrix with one word per line. We fill the
!    --  remaining space of a line with ASCII.NUL. The heuristic selects the
!    --  position that induces the minimum number of collisions. If there are
!    --  collisions, select another position on the reduced key set responsible
!    --  of the collisions. Apply the heuristic until there is no more collision.
  
     procedure Apply_Position_Selection;
     --  Apply Position selection and build the reduced key table
  
     procedure Parse_Position_Selection (Argument : String);
!    --  Parse Argument and compute the position set. Argument is list of
!    --  substrings separated by commas. Each substring represents a position
!    --  or a range of positions (like x-y).
  
     procedure Select_Character_Set;
!    --  Define an optimized used character set like Character'Pos in order not
!    --  to allocate tables of 256 entries.
  
     procedure Select_Char_Position;
!    --  Find a min char position set in order to reduce the max key length. The
!    --  heuristic selects the position that induces the minimum number of
!    --  collisions. If there are collisions, select another position on the
!    --  reduced key set responsible of the collisions. Apply the heuristic until
!    --  there is no collision.
  
     -----------------------------
     -- Random Graph Generation --
     -----------------------------
  
     procedure Random (Seed : in out Natural);
!    --  Simulate Ada.Discrete_Numerics.Random
  
     procedure Generate_Mapping_Table
!      (Tab  : Table_Id;
!       L1   : Natural;
!       L2   : Natural;
!       Seed : in out Natural);
!    --  Random generation of the tables below. T is already allocated
  
     procedure Generate_Mapping_Tables
!      (Opt  : Optimization;
!       Seed : in out Natural);
!    --  Generate the mapping tables T1 and T2. They are used to define fk (w) =
!    --  sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n. Keys, NK and Chars
!    --  are used to compute the matrix size.
  
     ---------------------------
     -- Algorithm Computation --
     ---------------------------
  
     procedure Compute_Edges_And_Vertices (Opt : Optimization);
!    --  Compute the edge and vertex tables. These are empty when a self loop is
!    --  detected (f1 (w) = f2 (w)). The edge table is sorted by X value and then
!    --  Y value. Keys is the key table and NK the number of keys. Chars is the
!    --  set of characters really used in Keys. NV is the number of vertices
!    --  recommended by the algorithm. T1 and T2 are the mapping tables needed to
!    --  compute f1 (w) and f2 (w).
  
     function Acyclic return Boolean;
!    --  Return True when the graph is acyclic. Vertices is the current vertex
!    --  table and Edges the current edge table.
  
     procedure Assign_Values_To_Vertices;
!    --  Execute the assignment step of the algorithm. Keys is the current key
!    --  table. Vertices and Edges represent the random graph. G is the result of
!    --  the assignment step such that:
     --    h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
     function Sum
       (Word  : Word_Type;
        Table : Table_Id;
!       Opt   : Optimization) return Natural;
     --  For an optimization of CPU_Time return
     --    fk (w) = sum (for i in 1 .. length (w)) (Tk (i, w (i))) mod n
     --  For an optimization of Memory_Space return
*************** package body GNAT.Perfect_Hash_Generator
*** 312,327 ****
     -- Internal Table Management --
     -------------------------------
  
!    function  Allocate (N : Natural; S : Natural) return Table_Id;
!    --  procedure Deallocate (N : Natural; S : Natural);
  
     ----------
     -- Keys --
     ----------
  
!    Key_Size : constant := 1;
!    Keys     : Table_Id := No_Table;
!    NK       : Natural;
     --  NK : Number of Keys
  
     function Initial (K : Key_Id) return Word_Id;
--- 309,326 ----
     -- Internal Table Management --
     -------------------------------
  
!    function Allocate (N : Natural; S : Natural := 1) return Table_Id;
!    --  Allocate N * S ints from IT table
! 
!    procedure Free_Tmp_Tables;
!    --  Deallocate the tables used by the algorithm (but not the keys table)
  
     ----------
     -- Keys --
     ----------
  
!    Keys : Table_Id := No_Table;
!    NK   : Natural  := 0;
     --  NK : Number of Keys
  
     function Initial (K : Key_Id) return Word_Id;
*************** package body GNAT.Perfect_Hash_Generator
*** 330,393 ****
     function Reduced (K : Key_Id) return Word_Id;
     pragma Inline (Reduced);
  
!    function  Get_Key (F : Key_Id) return Key_Type;
!    procedure Set_Key (F : Key_Id; Item : Key_Type);
!    --  Comments needed here ???
  
     ------------------
     -- Char_Pos_Set --
     ------------------
  
-    Char_Pos_Size    : constant := 1;
     Char_Pos_Set     : Table_Id := No_Table;
     Char_Pos_Set_Len : Natural;
     --  Character Selected Position Set
  
     function  Get_Char_Pos (P : Natural) return Natural;
     procedure Set_Char_Pos (P : Natural; Item : Natural);
!    --  Comments needed here ???
  
     -------------------
     -- Used_Char_Set --
     -------------------
  
-    Used_Char_Size    : constant := 1;
     Used_Char_Set     : Table_Id := No_Table;
     Used_Char_Set_Len : Natural;
!    --  Used Character Set : Define a new character mapping. When all
!    --  the characters are not present in the keys, in order to reduce
!    --  the size of some tables, we redefine the character mapping.
  
     function  Get_Used_Char (C : Character) return Natural;
     procedure Set_Used_Char (C : Character; Item : Natural);
  
!    -------------------
!    -- Random Tables --
!    -------------------
  
!    Rand_Tab_Item_Size : constant := 1;
!    T1                 : Table_Id := No_Table;
!    T2                 : Table_Id := No_Table;
!    Rand_Tab_Len_1     : Natural;
!    Rand_Tab_Len_2     : Natural;
     --  T1  : Values table to compute F1
     --  T2  : Values table to compute F2
  
!    function  Get_Rand_Tab (T : Integer; X, Y : Natural) return Natural;
!    procedure Set_Rand_Tab (T : Integer; X, Y : Natural; Item : Natural);
  
!    ------------------
!    -- Random Graph --
!    ------------------
  
!    Graph_Item_Size : constant := 1;
!    G               : Table_Id := No_Table;
!    Graph_Len       : Natural;
!    --  G   : Values table to compute G
  
!    function  Get_Graph (F : Natural) return Integer;
!    procedure Set_Graph (F : Natural; Item : Integer);
!    --  Comments needed ???
  
     -----------
     -- Edges --
--- 329,391 ----
     function Reduced (K : Key_Id) return Word_Id;
     pragma Inline (Reduced);
  
!    function  Get_Key (N : Key_Id) return Key_Type;
!    procedure Set_Key (N : Key_Id; Item : Key_Type);
!    --  Get or Set Nth element of Keys table
  
     ------------------
     -- Char_Pos_Set --
     ------------------
  
     Char_Pos_Set     : Table_Id := No_Table;
     Char_Pos_Set_Len : Natural;
     --  Character Selected Position Set
  
     function  Get_Char_Pos (P : Natural) return Natural;
     procedure Set_Char_Pos (P : Natural; Item : Natural);
!    --  Get or Set the string position of the Pth selected character
  
     -------------------
     -- Used_Char_Set --
     -------------------
  
     Used_Char_Set     : Table_Id := No_Table;
     Used_Char_Set_Len : Natural;
!    --  Used Character Set : Define a new character mapping. When all the
!    --  characters are not present in the keys, in order to reduce the size
!    --  of some tables, we redefine the character mapping.
  
     function  Get_Used_Char (C : Character) return Natural;
     procedure Set_Used_Char (C : Character; Item : Natural);
  
!    ------------
!    -- Tables --
!    ------------
  
!    T1     : Table_Id := No_Table;
!    T2     : Table_Id := No_Table;
!    T1_Len : Natural;
!    T2_Len : Natural;
     --  T1  : Values table to compute F1
     --  T2  : Values table to compute F2
  
!    function  Get_Table (T : Integer; X, Y : Natural) return Natural;
!    procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural);
  
!    -----------
!    -- Graph --
!    -----------
  
!    G     : Table_Id := No_Table;
!    G_Len : Natural;
!    --  Values table to compute G
  
!    NT : Natural := Default_Tries;
!    --  Number of tries running the algorithm before raising an error
! 
!    function  Get_Graph (N : Natural) return Integer;
!    procedure Set_Graph (N : Natural; Item : Integer);
!    --  Get or Set Nth element of graph
  
     -----------
     -- Edges --
*************** package body GNAT.Perfect_Hash_Generator
*** 423,430 ****
     Opt : Optimization;
     --  Optimization mode (memory vs CPU)
  
!    MKL : Natural;
!    --  Maximum of all the word length
  
     S : Natural;
     --  Seed
--- 421,429 ----
     Opt : Optimization;
     --  Optimization mode (memory vs CPU)
  
!    Max_Key_Len : Natural := 0;
!    Min_Key_Len : Natural := Max_Word_Length;
!    --  Maximum and minimum of all the word length
  
     S : Natural;
     --  Seed
*************** package body GNAT.Perfect_Hash_Generator
*** 436,461 ****
     -- Acyclic --
     -------------
  
!    function Acyclic return Boolean
!    is
        Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
  
        function Traverse
!         (Edge  : Edge_Id;
!          Mark  : Vertex_Id)
!          return  Boolean;
!       --  Propagate Mark from X to Y. X is already marked. Mark Y and
!       --  propagate it to the edges of Y except the one representing
!       --  the same key. Return False when Y is marked with Mark.
  
        --------------
        -- Traverse --
        --------------
  
        function Traverse
!         (Edge  : Edge_Id;
!          Mark  : Vertex_Id)
!          return  Boolean
        is
           E : constant Edge_Type := Get_Edges (Edge);
           K : constant Key_Id    := E.Key;
--- 435,457 ----
     -- Acyclic --
     -------------
  
!    function Acyclic return Boolean is
        Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
  
        function Traverse
!         (Edge : Edge_Id;
!          Mark : Vertex_Id) return Boolean;
!       --  Propagate Mark from X to Y. X is already marked. Mark Y and propagate
!       --  it to the edges of Y except the one representing the same key. Return
!       --  False when Y is marked with Mark.
  
        --------------
        -- Traverse --
        --------------
  
        function Traverse
!         (Edge : Edge_Id;
!          Mark : Vertex_Id) return Boolean
        is
           E : constant Edge_Type := Get_Edges (Edge);
           K : constant Key_Id    := E.Key;
*************** package body GNAT.Perfect_Hash_Generator
*** 473,479 ****
  
              for J in V.First .. V.Last loop
  
!                --  Do not propagate to the edge representing the same key.
  
                 if Get_Edges (J).Key /= K
                   and then not Traverse (J, Mark)
--- 469,475 ----
  
              for J in V.First .. V.Last loop
  
!                --  Do not propagate to the edge representing the same key
  
                 if Get_Edges (J).Key /= K
                   and then not Traverse (J, Mark)
*************** package body GNAT.Perfect_Hash_Generator
*** 531,537 ****
  
     procedure Add (S : String) is
        Len : constant Natural := S'Length;
- 
     begin
        Line (Last + 1 .. Last + Len) := S;
        Last := Last + Len;
--- 527,532 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 541,549 ****
     -- Allocate --
     --------------
  
!    function  Allocate (N : Natural; S : Natural) return Table_Id is
        L : constant Integer := IT.Last;
- 
     begin
        IT.Set_Last (L + N * S);
        return L + 1;
--- 536,543 ----
     -- Allocate --
     --------------
  
!    function  Allocate (N : Natural; S : Natural := 1) return Table_Id is
        L : constant Integer := IT.Last;
     begin
        IT.Set_Last (L + N * S);
        return L + 1;
*************** package body GNAT.Perfect_Hash_Generator
*** 555,561 ****
  
     procedure Apply_Position_Selection is
     begin
!       WT.Set_Last (2 * NK - 1);
        for J in 0 .. NK - 1 loop
           declare
              I_Word : constant Word_Type := WT.Table (Initial (J));
--- 549,555 ----
  
     procedure Apply_Position_Selection is
     begin
!       WT.Set_Last (2 * NK);
        for J in 0 .. NK - 1 loop
           declare
              I_Word : constant Word_Type := WT.Table (Initial (J));
*************** package body GNAT.Perfect_Hash_Generator
*** 563,570 ****
              Index  : Natural   := I_Word'First - 1;
  
           begin
!             --  Select the characters of Word included in the
!             --  position selection.
  
              for C in 0 .. Char_Pos_Set_Len - 1 loop
                 exit when I_Word (Get_Char_Pos (C)) = ASCII.NUL;
--- 557,564 ----
              Index  : Natural   := I_Word'First - 1;
  
           begin
!             --  Select the characters of Word included in the position
!             --  selection.
  
              for C in 0 .. Char_Pos_Set_Len - 1 loop
                 exit when I_Word (Get_Char_Pos (C)) = ASCII.NUL;
*************** package body GNAT.Perfect_Hash_Generator
*** 580,635 ****
        end loop;
     end Apply_Position_Selection;
  
-    -------------
-    -- Compute --
-    -------------
- 
-    procedure Compute (Position : String := Default_Position) is
-    begin
-       Keys := Allocate (NK, Key_Size);
- 
-       if Verbose then
-          Put_Initial_Keys (Output, "Initial Key Table");
-       end if;
- 
-       if Position'Length /= 0 then
-          Parse_Position_Selection (Position);
-       else
-          Select_Char_Position;
-       end if;
- 
-       if Verbose then
-          Put_Int_Vector
-            (Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
-       end if;
- 
-       Apply_Position_Selection;
- 
-       if Verbose then
-          Put_Reduced_Keys (Output, "Reduced Keys Table");
-       end if;
- 
-       Select_Character_Set;
- 
-       if Verbose then
-          Put_Used_Char_Set (Output, "Character Position Table");
-       end if;
- 
-       --  Perform Czech's algorithm
- 
-       loop
-          Generate_Mapping_Tables (Opt, S);
-          Compute_Edges_And_Vertices (Opt);
- 
-          --  When graph is not empty (no self-loop from previous
-          --  operation) and not acyclic.
- 
-          exit when 0 < Edges_Len and then Acyclic;
-       end loop;
- 
-       Assign_Values_To_Vertices;
-    end Compute;
- 
     -------------------------------
     -- Assign_Values_To_Vertices --
     -------------------------------
--- 574,579 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 638,645 ****
        X  : Vertex_Id;
  
        procedure Assign (X : Vertex_Id);
!       --  Execute assignment on X's neighbors except the vertex that
!       --  we are coming from which is already assigned.
  
        ------------
        -- Assign --
--- 582,589 ----
        X  : Vertex_Id;
  
        procedure Assign (X : Vertex_Id);
!       --  Execute assignment on X's neighbors except the vertex that we are
!       --  coming from which is already assigned.
  
        ------------
        -- Assign --
*************** package body GNAT.Perfect_Hash_Generator
*** 649,655 ****
        is
           E : Edge_Type;
           V : constant Vertex_Type := Get_Vertices (X);
- 
        begin
           for J in V.First .. V.Last loop
              E := Get_Edges (J);
--- 593,598 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 667,677 ****
        --  be in the range 0 .. NK.
  
        if G = No_Table then
!          Graph_Len := NV;
!          G := Allocate (Graph_Len, Graph_Item_Size);
        end if;
  
!       for J in 0 .. Graph_Len - 1 loop
           Set_Graph (J, -1);
        end loop;
  
--- 610,620 ----
        --  be in the range 0 .. NK.
  
        if G = No_Table then
!          G_Len := NV;
!          G := Allocate (G_Len, 1);
        end if;
  
!       for J in 0 .. G_Len - 1 loop
           Set_Graph (J, -1);
        end loop;
  
*************** package body GNAT.Perfect_Hash_Generator
*** 684,700 ****
           end if;
        end loop;
  
!       for J in 0 .. Graph_Len - 1 loop
           if Get_Graph (J) = -1 then
              Set_Graph (J, 0);
           end if;
        end loop;
  
        if Verbose then
!          Put_Int_Vector (Output, "Assign Values To Vertices", G, Graph_Len);
        end if;
     end Assign_Values_To_Vertices;
  
     --------------------------------
     -- Compute_Edges_And_Vertices --
     --------------------------------
--- 627,706 ----
           end if;
        end loop;
  
!       for J in 0 .. G_Len - 1 loop
           if Get_Graph (J) = -1 then
              Set_Graph (J, 0);
           end if;
        end loop;
  
        if Verbose then
!          Put_Int_Vector (Output, "Assign Values To Vertices", G, G_Len);
        end if;
     end Assign_Values_To_Vertices;
  
+    -------------
+    -- Compute --
+    -------------
+ 
+    procedure Compute
+      (Position : String := Default_Position)
+    is
+       Success : Boolean := False;
+ 
+    begin
+       NV := Natural (K2V * Float (NK));
+ 
+       Keys := Allocate (NK);
+ 
+       if Verbose then
+          Put_Initial_Keys (Output, "Initial Key Table");
+       end if;
+ 
+       if Position'Length /= 0 then
+          Parse_Position_Selection (Position);
+       else
+          Select_Char_Position;
+       end if;
+ 
+       if Verbose then
+          Put_Int_Vector
+            (Output, "Char Position Set", Char_Pos_Set, Char_Pos_Set_Len);
+       end if;
+ 
+       Apply_Position_Selection;
+ 
+       if Verbose then
+          Put_Reduced_Keys (Output, "Reduced Keys Table");
+       end if;
+ 
+       Select_Character_Set;
+ 
+       if Verbose then
+          Put_Used_Char_Set (Output, "Character Position Table");
+       end if;
+ 
+       --  Perform Czech's algorithm
+ 
+       for J in 1 .. NT loop
+          Generate_Mapping_Tables (Opt, S);
+          Compute_Edges_And_Vertices (Opt);
+ 
+          --  When graph is not empty (no self-loop from previous operation) and
+          --  not acyclic.
+ 
+          if 0 < Edges_Len and then Acyclic then
+             Success := True;
+             exit;
+          end if;
+       end loop;
+ 
+       if not Success then
+          raise Too_Many_Tries;
+       end if;
+ 
+       Assign_Values_To_Vertices;
+    end Compute;
+ 
     --------------------------------
     -- Compute_Edges_And_Vertices --
     --------------------------------
*************** package body GNAT.Perfect_Hash_Generator
*** 711,725 ****
        function Lt (L, R : Natural) return Boolean;
        --  Subprograms needed for GNAT.Heap_Sort_A
  
-       ----------
-       -- Move --
-       ----------
- 
-       procedure Move (From : Natural; To : Natural) is
-       begin
-          Set_Edges (To, Get_Edges (From));
-       end Move;
- 
        --------
        -- Lt --
        --------
--- 717,722 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 727,742 ****
        function Lt (L, R : Natural) return Boolean is
           EL : constant Edge_Type := Get_Edges (L);
           ER : constant Edge_Type := Get_Edges (R);
- 
        begin
           return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y);
        end Lt;
  
     --  Start of processing for Compute_Edges_And_Vertices
  
     begin
!       --  We store edges from 1 to 2 * NK and leave
!       --  zero alone in order to use GNAT.Heap_Sort_A.
  
        Edges_Len := 2 * NK + 1;
  
--- 724,747 ----
        function Lt (L, R : Natural) return Boolean is
           EL : constant Edge_Type := Get_Edges (L);
           ER : constant Edge_Type := Get_Edges (R);
        begin
           return EL.X < ER.X or else (EL.X = ER.X and then EL.Y < ER.Y);
        end Lt;
  
+       ----------
+       -- Move --
+       ----------
+ 
+       procedure Move (From : Natural; To : Natural) is
+       begin
+          Set_Edges (To, Get_Edges (From));
+       end Move;
+ 
     --  Start of processing for Compute_Edges_And_Vertices
  
     begin
!       --  We store edges from 1 to 2 * NK and leave zero alone in order to use
!       --  GNAT.Heap_Sort_A.
  
        Edges_Len := 2 * NK + 1;
  
*************** package body GNAT.Perfect_Hash_Generator
*** 783,796 ****
        else
           if Verbose then
              Put_Edges      (Output, "Unsorted Edge Table");
!             Put_Int_Matrix (Output, "Function Table 1", T1);
!             Put_Int_Matrix (Output, "Function Table 2", T2);
           end if;
  
!          --  Enforce consistency between edges and keys. Construct
!          --  Vertices and compute the list of neighbors of a vertex
!          --  First .. Last as Edges is sorted by X and then Y. To
!          --  compute the neighbor list, sort the edges.
  
           Sort
             (Edges_Len - 1,
--- 788,803 ----
        else
           if Verbose then
              Put_Edges      (Output, "Unsorted Edge Table");
!             Put_Int_Matrix (Output, "Function Table 1", T1,
!                             T1_Len, T2_Len);
!             Put_Int_Matrix (Output, "Function Table 2", T2,
!                             T1_Len, T2_Len);
           end if;
  
!          --  Enforce consistency between edges and keys. Construct Vertices and
!          --  compute the list of neighbors of a vertex First .. Last as Edges
!          --  is sorted by X and then Y. To compute the neighbor list, sort the
!          --  edges.
  
           Sort
             (Edges_Len - 1,
*************** package body GNAT.Perfect_Hash_Generator
*** 799,806 ****
  
           if Verbose then
              Put_Edges      (Output, "Sorted Edge Table");
!             Put_Int_Matrix (Output, "Function Table 1", T1);
!             Put_Int_Matrix (Output, "Function Table 2", T2);
           end if;
  
           --  Edges valid range is 1 .. 2 * NK
--- 806,815 ----
  
           if Verbose then
              Put_Edges      (Output, "Sorted Edge Table");
!             Put_Int_Matrix (Output, "Function Table 1", T1,
!                             T1_Len, T2_Len);
!             Put_Int_Matrix (Output, "Function Table 2", T2,
!                             T1_Len, T2_Len);
           end if;
  
           --  Edges valid range is 1 .. 2 * NK
*************** package body GNAT.Perfect_Hash_Generator
*** 857,864 ****
           when Function_Table_1
             |  Function_Table_2 =>
              Item_Size := Type_Size (NV);
!             Length_1  := Rand_Tab_Len_1;
!             Length_2  := Rand_Tab_Len_2;
  
           when Graph_Table =>
              Item_Size := Type_Size (NK);
--- 866,873 ----
           when Function_Table_1
             |  Function_Table_2 =>
              Item_Size := Type_Size (NV);
!             Length_1  := T1_Len;
!             Length_2  := T2_Len;
  
           when Graph_Table =>
              Item_Size := Type_Size (NK);
*************** package body GNAT.Perfect_Hash_Generator
*** 873,883 ****
  
     procedure Finalize is
     begin
        WT.Release;
        IT.Release;
  
        Keys := No_Table;
-       NK   := 0;
  
        Char_Pos_Set     := No_Table;
        Char_Pos_Set_Len := 0;
--- 882,906 ----
  
     procedure Finalize is
     begin
+       Free_Tmp_Tables;
+ 
        WT.Release;
        IT.Release;
  
+       NK := 0;
+       Max_Key_Len := 0;
+       Min_Key_Len := Max_Word_Length;
+    end Finalize;
+ 
+    ---------------------
+    -- Free_Tmp_Tables --
+    ---------------------
+ 
+    procedure Free_Tmp_Tables is
+    begin
+       IT.Init;
+ 
        Keys := No_Table;
  
        Char_Pos_Set     := No_Table;
        Char_Pos_Set_Len := 0;
*************** package body GNAT.Perfect_Hash_Generator
*** 888,921 ****
        T1 := No_Table;
        T2 := No_Table;
  
!       Rand_Tab_Len_1 := 0;
!       Rand_Tab_Len_2 := 0;
  
!       G         := No_Table;
!       Graph_Len := 0;
  
        Edges     := No_Table;
        Edges_Len := 0;
  
!       Vertices     := No_Table;
!       NV           := 0;
!    end Finalize;
  
     ----------------------------
     -- Generate_Mapping_Table --
     ----------------------------
  
     procedure Generate_Mapping_Table
!      (T  : Integer;
!       L1 : Natural;
!       L2 : Natural;
!       S  : in out Natural)
     is
     begin
        for J in 0 .. L1 - 1 loop
           for K in 0 .. L2 - 1 loop
!             Random (S);
!             Set_Rand_Tab (T, J, K, S mod NV);
           end loop;
        end loop;
     end Generate_Mapping_Table;
--- 911,944 ----
        T1 := No_Table;
        T2 := No_Table;
  
!       T1_Len := 0;
!       T2_Len := 0;
  
!       G     := No_Table;
!       G_Len := 0;
  
        Edges     := No_Table;
        Edges_Len := 0;
  
!       Vertices := No_Table;
!       NV       := 0;
!    end Free_Tmp_Tables;
  
     ----------------------------
     -- Generate_Mapping_Table --
     ----------------------------
  
     procedure Generate_Mapping_Table
!      (Tab  : Integer;
!       L1   : Natural;
!       L2   : Natural;
!       Seed : in out Natural)
     is
     begin
        for J in 0 .. L1 - 1 loop
           for K in 0 .. L2 - 1 loop
!             Random (Seed);
!             Set_Table (Tab, J, K, Seed mod NV);
           end loop;
        end loop;
     end Generate_Mapping_Table;
*************** package body GNAT.Perfect_Hash_Generator
*** 925,936 ****
     -----------------------------
  
     procedure Generate_Mapping_Tables
!      (Opt : Optimization;
!       S   : in out Natural)
     is
     begin
!       --  If T1 and T2 are already allocated no need to do it
!       --  twice. Reuse them as their size has not changes.
  
        if T1 = No_Table and then T2 = No_Table then
           declare
--- 948,959 ----
     -----------------------------
  
     procedure Generate_Mapping_Tables
!      (Opt  : Optimization;
!       Seed : in out Natural)
     is
     begin
!       --  If T1 and T2 are already allocated no need to do it twice. Reuse them
!       --  as their size has not changed.
  
        if T1 = No_Table and then T2 = No_Table then
           declare
*************** package body GNAT.Perfect_Hash_Generator
*** 948,969 ****
                 end loop;
              end if;
  
!             Rand_Tab_Len_1 := Char_Pos_Set_Len;
!             Rand_Tab_Len_2 := Used_Char_Last + 1;
!             T1 := Allocate (Rand_Tab_Len_1 * Rand_Tab_Len_2,
!                             Rand_Tab_Item_Size);
!             T2 := Allocate (Rand_Tab_Len_1 * Rand_Tab_Len_2,
!                             Rand_Tab_Item_Size);
           end;
        end if;
  
!       Generate_Mapping_Table (T1, Rand_Tab_Len_1, Rand_Tab_Len_2, S);
!       Generate_Mapping_Table (T2, Rand_Tab_Len_1, Rand_Tab_Len_2, S);
  
        if Verbose then
           Put_Used_Char_Set (Output, "Used Character Set");
!          Put_Int_Matrix (Output, "Function Table 1", T1);
!          Put_Int_Matrix (Output, "Function Table 2", T2);
        end if;
     end Generate_Mapping_Tables;
  
--- 971,992 ----
                 end loop;
              end if;
  
!             T1_Len := Char_Pos_Set_Len;
!             T2_Len := Used_Char_Last + 1;
!             T1 := Allocate (T1_Len * T2_Len);
!             T2 := Allocate (T1_Len * T2_Len);
           end;
        end if;
  
!       Generate_Mapping_Table (T1, T1_Len, T2_Len, Seed);
!       Generate_Mapping_Table (T2, T1_Len, T2_Len, Seed);
  
        if Verbose then
           Put_Used_Char_Set (Output, "Used Character Set");
!          Put_Int_Matrix (Output, "Function Table 1", T1,
!                         T1_Len, T2_Len);
!          Put_Int_Matrix (Output, "Function Table 2", T2,
!                         T1_Len, T2_Len);
        end if;
     end Generate_Mapping_Tables;
  
*************** package body GNAT.Perfect_Hash_Generator
*** 973,979 ****
  
     function Get_Char_Pos (P : Natural) return Natural is
        N : constant Natural := Char_Pos_Set + P;
- 
     begin
        return IT.Table (N);
     end Get_Char_Pos;
--- 996,1001 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 985,991 ****
     function Get_Edges (F : Natural) return Edge_Type is
        N : constant Natural := Edges + (F * Edge_Size);
        E : Edge_Type;
- 
     begin
        E.X   := IT.Table (N);
        E.Y   := IT.Table (N + 1);
--- 1007,1012 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 997,1042 ****
     -- Get_Graph --
     ---------------
  
!    function Get_Graph (F : Natural) return Integer is
!       N : constant Natural := G + F * Graph_Item_Size;
! 
     begin
!       return IT.Table (N);
     end Get_Graph;
  
     -------------
     -- Get_Key --
     -------------
  
!    function Get_Key (F : Key_Id) return Key_Type is
!       N : constant Natural := Keys + F * Key_Size;
        K : Key_Type;
- 
     begin
!       K.Edge := IT.Table (N);
        return K;
     end Get_Key;
  
!    ------------------
!    -- Get_Rand_Tab --
!    ------------------
! 
!    function Get_Rand_Tab (T : Integer; X, Y : Natural) return Natural is
!       N : constant Natural :=
!             T + ((Y * Rand_Tab_Len_1) + X) * Rand_Tab_Item_Size;
  
     begin
        return IT.Table (N);
!    end Get_Rand_Tab;
  
     -------------------
     -- Get_Used_Char --
     -------------------
  
     function Get_Used_Char (C : Character) return Natural is
!       N : constant Natural :=
!             Used_Char_Set + Character'Pos (C) * Used_Char_Size;
! 
     begin
        return IT.Table (N);
     end Get_Used_Char;
--- 1018,1055 ----
     -- Get_Graph --
     ---------------
  
!    function Get_Graph (N : Natural) return Integer is
     begin
!       return IT.Table (G + N);
     end Get_Graph;
  
     -------------
     -- Get_Key --
     -------------
  
!    function Get_Key (N : Key_Id) return Key_Type is
        K : Key_Type;
     begin
!       K.Edge := IT.Table (Keys + N);
        return K;
     end Get_Key;
  
!    ---------------
!    -- Get_Table --
!    ---------------
  
+    function Get_Table (T : Integer; X, Y : Natural) return Natural is
+       N : constant Natural := T + (Y * T1_Len) + X;
     begin
        return IT.Table (N);
!    end Get_Table;
  
     -------------------
     -- Get_Used_Char --
     -------------------
  
     function Get_Used_Char (C : Character) return Natural is
!       N : constant Natural := Used_Char_Set + Character'Pos (C);
     begin
        return IT.Table (N);
     end Get_Used_Char;
*************** package body GNAT.Perfect_Hash_Generator
*** 1048,1054 ****
     function Get_Vertices (F : Natural) return Vertex_Type is
        N : constant Natural := Vertices + (F * Vertex_Size);
        V : Vertex_Type;
- 
     begin
        V.First := IT.Table (N);
        V.Last  := IT.Table (N + 1);
--- 1061,1066 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 1135,1156 ****
     procedure Initialize
       (Seed   : Natural;
        K_To_V : Float        := Default_K_To_V;
!       Optim  : Optimization := CPU_Time)
     is
     begin
!       WT.Init;
!       IT.Init;
!       S   := Seed;
  
!       Keys := No_Table;
!       NK   := 0;
  
!       Char_Pos_Set     := No_Table;
!       Char_Pos_Set_Len := 0;
  
!       K2V := K_To_V;
!       Opt := Optim;
!       MKL := 0;
     end Initialize;
  
     ------------
--- 1147,1170 ----
     procedure Initialize
       (Seed   : Natural;
        K_To_V : Float        := Default_K_To_V;
!       Optim  : Optimization := CPU_Time;
!       Tries  : Positive     := Default_Tries)
     is
     begin
!       --  Free previous tables (the settings may have changed between two runs)
  
!       Free_Tmp_Tables;
  
!       if K_To_V <= 2.0 then
!          Put (Output, "K to V ratio cannot be lower than 2.0");
!          New_Line (Output);
!          raise Program_Error;
!       end if;
  
!       S    := Seed;
!       K2V  := K_To_V;
!       Opt  := Optim;
!       NT   := Tries;
     end Initialize;
  
     ------------
*************** package body GNAT.Perfect_Hash_Generator
*** 1170,1177 ****
        NK := NK + 1;
        NV := Natural (Float (NK) * K2V);
  
!       if MKL < Len then
!          MKL := Len;
        end if;
     end Insert;
  
--- 1184,1202 ----
        NK := NK + 1;
        NV := Natural (Float (NK) * K2V);
  
!       --  Do not accept a value of K2V too close to 2.0 such that once rounded
!       --  up, NV = 2 * NK because the algorithm would not converge.
! 
!       if NV <= 2 * NK then
!          NV := 2 * NK + 1;
!       end if;
! 
!       if Max_Key_Len < Len then
!          Max_Key_Len := Len;
!       end if;
! 
!       if Len < Min_Key_Len then
!          Min_Key_Len := Len;
        end if;
     end Insert;
  
*************** package body GNAT.Perfect_Hash_Generator
*** 1179,1189 ****
     -- New_Line --
     --------------
  
!    procedure New_Line (F : File_Descriptor) is
!       EOL : constant Character := ASCII.LF;
! 
     begin
!       if Write (F, EOL'Address, 1) /= 1 then
           raise Program_Error;
        end if;
     end New_Line;
--- 1204,1212 ----
     -- New_Line --
     --------------
  
!    procedure New_Line (File : File_Descriptor) is
     begin
!       if Write (File, EOL'Address, 1) /= 1 then
           raise Program_Error;
        end if;
     end New_Line;
*************** package body GNAT.Perfect_Hash_Generator
*** 1195,1201 ****
     procedure Parse_Position_Selection (Argument : String) is
        N : Natural          := Argument'First;
        L : constant Natural := Argument'Last;
!       M : constant Natural := MKL;
  
        T : array (1 .. M) of Boolean := (others => False);
  
--- 1218,1224 ----
     procedure Parse_Position_Selection (Argument : String) is
        N : Natural          := Argument'First;
        L : constant Natural := Argument'Last;
!       M : constant Natural := Max_Key_Len;
  
        T : array (1 .. M) of Boolean := (others => False);
  
*************** package body GNAT.Perfect_Hash_Generator
*** 1206,1213 ****
        -- Parse_Index --
        -----------------
  
!       function Parse_Index return Natural
!       is
           C : Character := Argument (N);
           V : Natural   := 0;
  
--- 1229,1235 ----
        -- Parse_Index --
        -----------------
  
!       function Parse_Index return Natural is
           C : Character := Argument (N);
           V : Natural   := 0;
  
*************** package body GNAT.Perfect_Hash_Generator
*** 1235,1247 ****
     --  Start of processing for Parse_Position_Selection
  
     begin
-       Char_Pos_Set_Len := 2 * NK;
  
        --  Empty specification means all the positions
  
        if L < N then
           Char_Pos_Set_Len := M;
!          Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size);
  
           for C in 0 .. Char_Pos_Set_Len - 1 loop
              Set_Char_Pos (C, C + 1);
--- 1257,1268 ----
     --  Start of processing for Parse_Position_Selection
  
     begin
  
        --  Empty specification means all the positions
  
        if L < N then
           Char_Pos_Set_Len := M;
!          Char_Pos_Set := Allocate (Char_Pos_Set_Len);
  
           for C in 0 .. Char_Pos_Set_Len - 1 loop
              Set_Char_Pos (C, C + 1);
*************** package body GNAT.Perfect_Hash_Generator
*** 1292,1298 ****
           --  Fill position selection
  
           Char_Pos_Set_Len := N;
!          Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size);
  
           N := 0;
           for J in T'Range loop
--- 1313,1319 ----
           --  Fill position selection
  
           Char_Pos_Set_Len := N;
!          Char_Pos_Set := Allocate (Char_Pos_Set_Len);
  
           N := 0;
           for J in T'Range loop
*************** package body GNAT.Perfect_Hash_Generator
*** 1312,1345 ****
        File     : File_Descriptor;
  
        Status : Boolean;
!       --  For call to Close;
  
!       function Type_Img (L : Natural) return String;
!       --  Return the larger unsigned type T such that T'Last < L
  
        function Range_Img (F, L : Natural; T : String := "") return String;
        --  Return string "[T range ]F .. L"
  
!       function Array_Img (N, T, R1 : String; R2 : String := "") return String;
!       --  Return string "N : constant array (R1[, R2]) of T;"
! 
!       --------------
!       -- Type_Img --
!       --------------
  
!       function Type_Img (L : Natural) return String is
!          S : constant String := Image (Type_Size (L));
!          U : String  := "Unsigned_  ";
!          N : Natural := 9;
  
        begin
!          for J in S'Range loop
!             N := N + 1;
!             U (N) := S (J);
!          end loop;
  
!          return U (1 .. N);
!       end Type_Img;
  
        ---------------
        -- Range_Img --
--- 1333,1374 ----
        File     : File_Descriptor;
  
        Status : Boolean;
!       --  For call to Close
  
!       function Array_Img (N, T, R1 : String; R2 : String := "") return String;
!       --  Return string "N : constant array (R1[, R2]) of T;"
  
        function Range_Img (F, L : Natural; T : String := "") return String;
        --  Return string "[T range ]F .. L"
  
!       function Type_Img (L : Natural) return String;
!       --  Return the larger unsigned type T such that T'Last < L
  
!       ---------------
!       -- Array_Img --
!       ---------------
  
+       function Array_Img
+         (N, T, R1 : String;
+          R2       : String := "") return String
+       is
        begin
!          Last := 0;
!          Add ("   ");
!          Add (N);
!          Add (" : constant array (");
!          Add (R1);
  
!          if R2 /= "" then
!             Add (", ");
!             Add (R2);
!          end if;
! 
!          Add (") of ");
!          Add (T);
!          Add (" :=");
!          return Line (1 .. Last);
!       end Array_Img;
  
        ---------------
        -- Range_Img --
*************** package body GNAT.Perfect_Hash_Generator
*** 1371,1402 ****
           return RI (1 .. Len);
        end Range_Img;
  
!       ---------------
!       -- Array_Img --
!       ---------------
  
!       function Array_Img
!         (N, T, R1 : String;
!          R2       : String := "")
!          return     String
!       is
!       begin
!          Last := 0;
!          Add ("   ");
!          Add (N);
!          Add (" : constant array (");
!          Add (R1);
  
!          if R2 /= "" then
!             Add (", ");
!             Add (R2);
!          end if;
  
!          Add (") of ");
!          Add (T);
!          Add (" :=");
!          return Line (1 .. Last);
!       end Array_Img;
  
        F : Natural;
        L : Natural;
--- 1400,1422 ----
           return RI (1 .. Len);
        end Range_Img;
  
!       --------------
!       -- Type_Img --
!       --------------
  
!       function Type_Img (L : Natural) return String is
!          S : constant String := Image (Type_Size (L));
!          U : String  := "Unsigned_  ";
!          N : Natural := 9;
  
!       begin
!          for J in S'Range loop
!             N := N + 1;
!             U (N) := S (J);
!          end loop;
  
!          return U (1 .. N);
!       end Type_Img;
  
        F : Natural;
        L : Natural;
*************** package body GNAT.Perfect_Hash_Generator
*** 1460,1466 ****
  
           for J in Character'Range loop
              P := Get_Used_Char (J);
!             Put (File, Image (P), 0, 0, 0, F, L, Character'Pos (J));
           end loop;
  
           New_Line (File);
--- 1480,1486 ----
  
           for J in Character'Range loop
              P := Get_Used_Char (J);
!             Put (File, Image (P), 1, 0, 1, F, L, Character'Pos (J));
           end loop;
  
           New_Line (File);
*************** package body GNAT.Perfect_Hash_Generator
*** 1473,1479 ****
        New_Line (File);
  
        for J in F .. L loop
!          Put (File, Image (Get_Char_Pos (J)), 0, 0, 0, F, L, J);
        end loop;
  
        New_Line (File);
--- 1493,1499 ----
        New_Line (File);
  
        for J in F .. L loop
!          Put (File, Image (Get_Char_Pos (J)), 1, 0, 1, F, L, J);
        end loop;
  
        New_Line (File);
*************** package body GNAT.Perfect_Hash_Generator
*** 1482,1498 ****
           Put_Int_Matrix
             (File,
              Array_Img ("T1", Type_Img (NV),
!                        Range_Img (0, Rand_Tab_Len_1 - 1),
!                        Range_Img (0, Rand_Tab_Len_2 - 1,
!                                   Type_Img (256))),
!             T1);
  
        else
           Put_Int_Matrix
             (File,
              Array_Img ("T1", Type_Img (NV),
!                        Range_Img (0, Rand_Tab_Len_1 - 1)),
!             T1);
        end if;
  
        New_Line (File);
--- 1502,1517 ----
           Put_Int_Matrix
             (File,
              Array_Img ("T1", Type_Img (NV),
!                        Range_Img (0, T1_Len - 1),
!                        Range_Img (0, T2_Len - 1, Type_Img (256))),
!             T1, T1_Len, T2_Len);
  
        else
           Put_Int_Matrix
             (File,
              Array_Img ("T1", Type_Img (NV),
!                        Range_Img (0, T1_Len - 1)),
!             T1, T1_Len, 0);
        end if;
  
        New_Line (File);
*************** package body GNAT.Perfect_Hash_Generator
*** 1501,1517 ****
           Put_Int_Matrix
             (File,
              Array_Img ("T2", Type_Img (NV),
!                        Range_Img (0, Rand_Tab_Len_1 - 1),
!                        Range_Img (0, Rand_Tab_Len_2 - 1,
!                                   Type_Img (256))),
!             T2);
  
        else
           Put_Int_Matrix
             (File,
              Array_Img ("T2", Type_Img (NV),
!                        Range_Img (0, Rand_Tab_Len_1 - 1)),
!             T2);
        end if;
  
        New_Line (File);
--- 1520,1535 ----
           Put_Int_Matrix
             (File,
              Array_Img ("T2", Type_Img (NV),
!                        Range_Img (0, T1_Len - 1),
!                        Range_Img (0, T2_Len - 1, Type_Img (256))),
!             T2, T1_Len, T2_Len);
  
        else
           Put_Int_Matrix
             (File,
              Array_Img ("T2", Type_Img (NV),
!                        Range_Img (0, T1_Len - 1)),
!             T2, T1_Len, 0);
        end if;
  
        New_Line (File);
*************** package body GNAT.Perfect_Hash_Generator
*** 1519,1526 ****
        Put_Int_Vector
          (File,
           Array_Img ("G", Type_Img (NK),
!                     Range_Img (0, Graph_Len - 1)),
!          G, Graph_Len);
        New_Line (File);
  
        Put      (File, "   function Hash (S : String) return Natural is");
--- 1537,1544 ----
        Put_Int_Vector
          (File,
           Array_Img ("G", Type_Img (NK),
!                     Range_Img (0, G_Len - 1)),
!          G, G_Len);
        New_Line (File);
  
        Put      (File, "   function Hash (S : String) return Natural is");
*************** package body GNAT.Perfect_Hash_Generator
*** 1621,1631 ****
     -- Put --
     ---------
  
!    procedure Put (F : File_Descriptor; S : String) is
!       Len : constant Natural := S'Length;
  
     begin
!       if Write (F, S'Address, Len) /= Len then
           raise Program_Error;
        end if;
     end Put;
--- 1639,1649 ----
     -- Put --
     ---------
  
!    procedure Put (File : File_Descriptor; Str : String) is
!       Len : constant Natural := Str'Length;
  
     begin
!       if Write (File, Str'Address, Len) /= Len then
           raise Program_Error;
        end if;
     end Put;
*************** package body GNAT.Perfect_Hash_Generator
*** 1647,1652 ****
--- 1665,1671 ----
        Len : constant Natural := S'Length;
  
        procedure Flush;
+       --  Write current line, followed by LF
  
        -----------
        -- Flush --
*************** package body GNAT.Perfect_Hash_Generator
*** 1674,1682 ****
           Line (Last + 1 .. Last + 5) := "     ";
           Last := Last + 5;
  
!          if F1 /= L1 then
              if C1 = F1 and then C2 = F2 then
                 Add ('(');
              else
                 Add (' ');
              end if;
--- 1693,1704 ----
           Line (Last + 1 .. Last + 5) := "     ";
           Last := Last + 5;
  
!          if F1 <= L1 then
              if C1 = F1 and then C2 = F2 then
                 Add ('(');
+                if F1 = L1 then
+                   Add ("0 .. 0 => ");
+                end if;
              else
                 Add (' ');
              end if;
*************** package body GNAT.Perfect_Hash_Generator
*** 1685,1690 ****
--- 1707,1715 ----
  
        if C2 = F2 then
           Add ('(');
+          if F2 = L2 then
+             Add ("0 .. 0 => ");
+          end if;
        else
           Add (' ');
        end if;
*************** package body GNAT.Perfect_Hash_Generator
*** 1695,1701 ****
        if C2 = L2 then
           Add (')');
  
!          if F1 = L1 then
              Add (';');
              Flush;
           elsif C1 /= L1 then
--- 1720,1726 ----
        if C2 = L2 then
           Add (')');
  
!          if F1 > L1 then
              Add (';');
              Flush;
           elsif C1 /= L1 then
*************** package body GNAT.Perfect_Hash_Generator
*** 1712,1767 ****
        end if;
     end Put;
  
!    -----------------------
!    -- Put_Used_Char_Set --
!    -----------------------
  
!    procedure Put_Used_Char_Set
       (File  : File_Descriptor;
        Title : String)
     is
!       F : constant Natural := Character'Pos (Character'First);
!       L : constant Natural := Character'Pos (Character'Last);
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       for J in Character'Range loop
!          Put
!            (File, Image (Get_Used_Char (J)), 0, 0, 0, F, L, Character'Pos (J));
        end loop;
!    end Put_Used_Char_Set;
  
!    ----------
!    -- Put --
!    ----------
  
     procedure Put_Int_Matrix
       (File   : File_Descriptor;
        Title  : String;
!       Table  : Integer)
     is
!       F1 : constant Natural := 0;
!       L1 : constant Natural := Rand_Tab_Len_1 - 1;
!       F2 : constant Natural := 0;
!       L2 : constant Natural := Rand_Tab_Len_2 - 1;
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       if L2 = F2 then
           for J in F1 .. L1 loop
!             Put (File,
!                  Image (Get_Rand_Tab (Table, J, F2)), 0, 0, 0, F1, L1, J);
           end loop;
  
        else
           for J in F1 .. L1 loop
              for K in F2 .. L2 loop
!                Put (File,
!                     Image (Get_Rand_Tab (Table, J, K)), F1, L1, J, F2, L2, K);
              end loop;
           end loop;
        end if;
--- 1737,1827 ----
        end if;
     end Put;
  
!    ---------------
!    -- Put_Edges --
!    ---------------
  
!    procedure Put_Edges
       (File  : File_Descriptor;
        Title : String)
     is
!       E  : Edge_Type;
!       F1 : constant Natural := 1;
!       L1 : constant Natural := Edges_Len - 1;
!       M  : constant Natural := Max / 5;
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       --  Edges valid range is 1 .. Edge_Len - 1
! 
!       for J in F1 .. L1 loop
!          E := Get_Edges (J);
!          Put (File, Image (J, M),     F1, L1, J, 1, 4, 1);
!          Put (File, Image (E.X, M),   F1, L1, J, 1, 4, 2);
!          Put (File, Image (E.Y, M),   F1, L1, J, 1, 4, 3);
!          Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
        end loop;
!    end Put_Edges;
  
!    ----------------------
!    -- Put_Initial_Keys --
!    ----------------------
! 
!    procedure Put_Initial_Keys
!      (File  : File_Descriptor;
!       Title : String)
!    is
!       F1 : constant Natural := 0;
!       L1 : constant Natural := NK - 1;
!       M  : constant Natural := Max / 5;
!       K  : Key_Type;
! 
!    begin
!       Put (File, Title);
!       New_Line (File);
! 
!       for J in F1 .. L1 loop
!          K := Get_Key (J);
!          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
!          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
!          Put (File, WT.Table (Initial (J)), F1, L1, J, 1, 3, 3);
!       end loop;
!    end Put_Initial_Keys;
! 
!    --------------------
!    -- Put_Int_Matrix --
!    --------------------
  
     procedure Put_Int_Matrix
       (File   : File_Descriptor;
        Title  : String;
!       Table  : Integer;
!       Len_1  : Natural;
!       Len_2  : Natural)
     is
!       F1 : constant Integer := 0;
!       L1 : constant Integer := Len_1 - 1;
!       F2 : constant Integer := 0;
!       L2 : constant Integer := Len_2 - 1;
!       I  : Natural;
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       if Len_2 = 0 then
           for J in F1 .. L1 loop
!             I := IT.Table (Table + J);
!             Put (File, Image (I), 1, 0, 1, F1, L1, J);
           end loop;
  
        else
           for J in F1 .. L1 loop
              for K in F2 .. L2 loop
!                I := IT.Table (Table + J + K * Len_1);
!                Put (File, Image (I), F1, L1, J, F2, L2, K);
              end loop;
           end loop;
        end if;
*************** package body GNAT.Perfect_Hash_Generator
*** 1774,1780 ****
     procedure Put_Int_Vector
       (File   : File_Descriptor;
        Title  : String;
!       Root   : Integer;
        Length : Natural)
     is
        F2 : constant Natural := 0;
--- 1834,1840 ----
     procedure Put_Int_Vector
       (File   : File_Descriptor;
        Title  : String;
!       Vector : Integer;
        Length : Natural)
     is
        F2 : constant Natural := 0;
*************** package body GNAT.Perfect_Hash_Generator
*** 1785,1827 ****
        New_Line (File);
  
        for J in F2 .. L2 loop
!          Put (File, Image (IT.Table (Root + J)), 0, 0, 0, F2, L2, J);
        end loop;
     end Put_Int_Vector;
  
!    ---------------
!    -- Put_Edges --
!    ---------------
! 
!    procedure Put_Edges
!      (File  : File_Descriptor;
!       Title : String)
!    is
!       E  : Edge_Type;
!       F1 : constant Natural := 1;
!       L1 : constant Natural := Edges_Len - 1;
!       M  : constant Natural := Max / 5;
! 
!    begin
!       Put (File, Title);
!       New_Line (File);
! 
!       --  Edges valid range is 1 .. Edge_Len - 1
! 
!       for J in F1 .. L1 loop
!          E := Get_Edges (J);
!          Put (File, Image (J, M),     F1, L1, J, 1, 4, 1);
!          Put (File, Image (E.X, M),   F1, L1, J, 1, 4, 2);
!          Put (File, Image (E.Y, M),   F1, L1, J, 1, 4, 3);
!          Put (File, Image (E.Key, M), F1, L1, J, 1, 4, 4);
!       end loop;
!    end Put_Edges;
! 
!    ---------------------------
!    -- Put_Initial_Keys --
!    ---------------------------
  
!    procedure Put_Initial_Keys
       (File  : File_Descriptor;
        Title : String)
     is
--- 1845,1859 ----
        New_Line (File);
  
        for J in F2 .. L2 loop
!          Put (File, Image (IT.Table (Vector + J)), 1, 0, 1, F2, L2, J);
        end loop;
     end Put_Int_Vector;
  
!    ----------------------
!    -- Put_Reduced_Keys --
!    ----------------------
  
!    procedure Put_Reduced_Keys
       (File  : File_Descriptor;
        Title : String)
     is
*************** package body GNAT.Perfect_Hash_Generator
*** 1838,1871 ****
           K := Get_Key (J);
           Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
           Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
!          Put (File, WT.Table (Initial (J)), F1, L1, J, 1, 3, 3);
        end loop;
!    end Put_Initial_Keys;
  
!    ---------------------------
!    -- Put_Reduced_Keys --
!    ---------------------------
  
!    procedure Put_Reduced_Keys
       (File  : File_Descriptor;
        Title : String)
     is
!       F1 : constant Natural := 0;
!       L1 : constant Natural := NK - 1;
!       M  : constant Natural := Max / 5;
!       K  : Key_Type;
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       for J in F1 .. L1 loop
!          K := Get_Key (J);
!          Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
!          Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
!          Put (File, WT.Table (Reduced (J)), F1, L1, J, 1, 3, 3);
        end loop;
!    end Put_Reduced_Keys;
  
     ----------------------
     -- Put_Vertex_Table --
--- 1870,1899 ----
           K := Get_Key (J);
           Put (File, Image (J, M),           F1, L1, J, 1, 3, 1);
           Put (File, Image (K.Edge, M),      F1, L1, J, 1, 3, 2);
!          Put (File, WT.Table (Reduced (J)), F1, L1, J, 1, 3, 3);
        end loop;
!    end Put_Reduced_Keys;
  
!    -----------------------
!    -- Put_Used_Char_Set --
!    -----------------------
  
!    procedure Put_Used_Char_Set
       (File  : File_Descriptor;
        Title : String)
     is
!       F : constant Natural := Character'Pos (Character'First);
!       L : constant Natural := Character'Pos (Character'Last);
  
     begin
        Put (File, Title);
        New_Line (File);
  
!       for J in Character'Range loop
!          Put
!            (File, Image (Get_Used_Char (J)), 1, 0, 1, F, L, Character'Pos (J));
        end loop;
!    end Put_Used_Char_Set;
  
     ----------------------
     -- Put_Vertex_Table --
*************** package body GNAT.Perfect_Hash_Generator
*** 1898,1905 ****
  
     procedure Random (Seed : in out Natural)
     is
!       --  Park & Miller Standard Minimal using Schrage's algorithm to
!       --  avoid overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
  
        R : Natural;
        Q : Natural;
--- 1926,1933 ----
  
     procedure Random (Seed : in out Natural)
     is
!       --  Park & Miller Standard Minimal using Schrage's algorithm to avoid
!       --  overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
  
        R : Natural;
        Q : Natural;
*************** package body GNAT.Perfect_Hash_Generator
*** 1923,1962 ****
  
     function Reduced (K : Key_Id) return Word_Id is
     begin
!       return K + NK;
     end Reduced;
  
     --------------------------
-    -- Select_Character_Set --
-    --------------------------
- 
-    procedure Select_Character_Set
-    is
-       Last : Natural := 0;
-       Used : array (Character) of Boolean := (others => False);
- 
-    begin
-       for J in 0 .. NK - 1 loop
-          for K in 1 .. Max_Word_Length loop
-             exit when WT.Table (Initial (J))(K) = ASCII.NUL;
-             Used (WT.Table (Initial (J))(K)) := True;
-          end loop;
-       end loop;
- 
-       Used_Char_Set_Len := 256;
-       Used_Char_Set := Allocate (Used_Char_Set_Len, Used_Char_Size);
- 
-       for J in Used'Range loop
-          if Used (J) then
-             Set_Used_Char (J, Last);
-             Last := Last + 1;
-          else
-             Set_Used_Char (J, 0);
-          end if;
-       end loop;
-    end Select_Character_Set;
- 
-    --------------------------
     -- Select_Char_Position --
     --------------------------
  
--- 1951,1960 ----
  
     function Reduced (K : Key_Id) return Word_Id is
     begin
!       return K + NK + 1;
     end Reduced;
  
     --------------------------
     -- Select_Char_Position --
     --------------------------
  
*************** package body GNAT.Perfect_Hash_Generator
*** 1968,1988 ****
          (Table : in out Vertex_Table_Type;
           Last  : in out Natural;
           Pos   : in Natural);
!       --  Build a list of keys subsets that are identical with the
!       --  current position selection plus Pos. Once this routine is
!       --  called, reduced words are sorted by subsets and each item
!       --  (First, Last) in Sets defines the range of identical keys.
  
!       function Count_Identical_Keys
!         (Table  : Vertex_Table_Type;
!          Last   : Natural;
!          Pos    : Natural)
!          return   Natural;
!       --  For each subset in Sets, count the number of identical keys
!       --  if we add Pos to the current position selection.
  
!       Sel_Position : IT.Table_Type (1 .. MKL);
        Last_Sel_Pos : Natural := 0;
  
        -------------------------------
        -- Build_Identical_Keys_Sets --
--- 1966,1986 ----
          (Table : in out Vertex_Table_Type;
           Last  : in out Natural;
           Pos   : in Natural);
!       --  Build a list of keys subsets that are identical with the current
!       --  position selection plus Pos. Once this routine is called, reduced
!       --  words are sorted by subsets and each item (First, Last) in Sets
!       --  defines the range of identical keys.
  
!       function Count_Different_Keys
!         (Table : Vertex_Table_Type;
!          Last  : Natural;
!          Pos   : Natural) return Natural;
!       --  For each subset in Sets, count the number of different keys if we add
!       --  Pos to the current position selection.
  
!       Sel_Position : IT.Table_Type (1 .. Max_Key_Len);
        Last_Sel_Pos : Natural := 0;
+       Max_Sel_Pos  : Natural := 0;
  
        -------------------------------
        -- Build_Identical_Keys_Sets --
*************** package body GNAT.Perfect_Hash_Generator
*** 2001,2123 ****
           L : Integer;
           --  First and last words of a subset
  
!       begin
!          Last := 0;
  
!          --  For each subset in S, extract the new subsets we have by
!          --  adding C in the position selection.
  
!          for J in S'Range loop
!             declare
!                Offset : Natural;
!                --  GNAT.Heap_Sort assumes that the first array index
!                --  is 1. Offset defines the translation to operate.
  
!                procedure Move (From : Natural; To : Natural);
!                function Lt (L, R : Natural) return Boolean;
!                --  Subprograms needed by GNAT.Heap_Sort_A
  
!                ----------
!                -- Move --
!                ----------
  
!                procedure Move (From : Natural; To : Natural) is
!                   Target, Source : Natural;
  
!                begin
!                   if From = 0 then
!                      Source := 0;
!                      Target := Offset + To;
!                   elsif To = 0 then
!                      Source := Offset + From;
!                      Target := 0;
!                   else
!                      Source := Offset + From;
!                      Target := Offset + To;
!                   end if;
  
!                   WT.Table (Reduced (Target)) := WT.Table (Reduced (Source));
!                end Move;
  
!                --------
!                -- Lt --
!                --------
  
!                function Lt (L, R : Natural) return Boolean is
!                   C     : constant Natural := Pos;
!                   Left  : Natural;
!                   Right : Natural;
  
!                begin
!                   if L = 0 then
!                      Left  := 0;
!                      Right := Offset + R;
!                   elsif R = 0 then
!                      Left  := Offset + L;
!                      Right := 0;
!                   else
!                      Left  := Offset + L;
!                      Right := Offset + R;
!                   end if;
  
!                   return WT.Table (Reduced (Left))(C)
!                        < WT.Table (Reduced (Right))(C);
!                end Lt;
  
!             --  Start of processing for Build_Identical_Key_Sets
  
!             begin
!                Offset := S (J).First - 1;
                 Sort
                   (S (J).Last - S (J).First + 1,
                    Move'Unrestricted_Access,
                    Lt'Unrestricted_Access);
  
!                F := -1;
!                L := -1;
!                for N in S (J).First .. S (J).Last - 1 loop
  
!                   --  Two contiguous words are identical
  
!                   if WT.Table (Reduced (N))(C) =
!                      WT.Table (Reduced (N + 1))(C)
!                   then
!                      --  This is the first word of the subset
  
!                      if F = -1 then
!                         F := N;
!                      end if;
  
                       L := N + 1;
  
!                      --  This is the last word of the subset
  
!                   elsif F /= -1 then
                       Last := Last + 1;
                       Table (Last) := (F, L);
!                      F := -1;
                    end if;
                 end loop;
! 
!                --  This is the last word of the subset and of the set
! 
!                if F /= -1 then
!                   Last := Last + 1;
!                   Table (Last) := (F, L);
!                end if;
!             end;
           end loop;
        end Build_Identical_Keys_Sets;
  
        --------------------------
!       -- Count_Identical_Keys --
        --------------------------
  
!       function Count_Identical_Keys
!         (Table  : Vertex_Table_Type;
!          Last   : Natural;
!          Pos    : Natural)
!          return   Natural
        is
           N : array (Character) of Natural;
           C : Character;
--- 1999,2120 ----
           L : Integer;
           --  First and last words of a subset
  
!          Offset : Natural;
!          --  GNAT.Heap_Sort assumes that the first array index is 1. Offset
!          --  defines the translation to operate.
  
!          function Lt (L, R : Natural) return Boolean;
!          procedure Move (From : Natural; To : Natural);
!          --  Subprograms needed by GNAT.Heap_Sort_A
  
!          --------
!          -- Lt --
!          --------
  
!          function Lt (L, R : Natural) return Boolean is
!             C     : constant Natural := Pos;
!             Left  : Natural;
!             Right : Natural;
  
!          begin
!             if L = 0 then
!                Left  := Reduced (0) - 1;
!                Right := Offset + R;
!             elsif R = 0 then
!                Left  := Offset + L;
!                Right := Reduced (0) - 1;
!             else
!                Left  := Offset + L;
!                Right := Offset + R;
!             end if;
  
!             return WT.Table (Left)(C) < WT.Table (Right)(C);
!          end Lt;
  
!          ----------
!          -- Move --
!          ----------
  
!          procedure Move (From : Natural; To : Natural) is
!             Target, Source : Natural;
  
!          begin
!             if From = 0 then
!                Source := Reduced (0) - 1;
!                Target := Offset + To;
!             elsif To = 0 then
!                Source := Offset + From;
!                Target := Reduced (0) - 1;
!             else
!                Source := Offset + From;
!                Target := Offset + To;
!             end if;
  
!             WT.Table (Target) := WT.Table (Source);
!          end Move;
  
!          --  Start of processing for Build_Identical_Key_Sets
  
!       begin
!          Last := 0;
  
!          --  For each subset in S, extract the new subsets we have by adding C
!          --  in the position selection.
  
!          for J in S'Range loop
!             if S (J).First = S (J).Last then
!                F := S (J).First;
!                L := S (J).Last;
!                Last := Last + 1;
!                Table (Last) := (F, L);
! 
!             else
!                Offset := Reduced (S (J).First) - 1;
                 Sort
                   (S (J).Last - S (J).First + 1,
                    Move'Unrestricted_Access,
                    Lt'Unrestricted_Access);
  
!                F := S (J).First;
!                L := F;
!                for N in S (J).First .. S (J).Last loop
  
!                   --  For the last item, close the last subset
  
!                   if N = S (J).Last then
!                      Last := Last + 1;
!                      Table (Last) := (F, N);
  
!                   --  Two contiguous words are identical when they have the
!                   --  same Cth character.
  
+                   elsif WT.Table (Reduced (N))(C) =
+                         WT.Table (Reduced (N + 1))(C)
+                   then
                       L := N + 1;
  
!                   --  Find a new subset of identical keys. Store the current
!                   --  one and create a new subset.
  
!                   else
                       Last := Last + 1;
                       Table (Last) := (F, L);
!                      F := N + 1;
!                      L := F;
                    end if;
                 end loop;
!             end if;
           end loop;
        end Build_Identical_Keys_Sets;
  
        --------------------------
!       -- Count_Different_Keys --
        --------------------------
  
!       function Count_Different_Keys
!         (Table : Vertex_Table_Type;
!          Last  : Natural;
!          Pos   : Natural) return Natural
        is
           N : array (Character) of Natural;
           C : Character;
*************** package body GNAT.Perfect_Hash_Generator
*** 2125,2133 ****
  
        begin
           --  For each subset, count the number of words that are still
!          --  identical when we include Sel_Position (Last_Sel_Pos) in
!          --  the position selection. Only focus on this position as the
!          --  other positions already produce identical keys.
  
           for S in 1 .. Last loop
  
--- 2122,2130 ----
  
        begin
           --  For each subset, count the number of words that are still
!          --  different when we include Pos in the position selection. Only
!          --  focus on this position as the other positions already produce
!          --  identical keys.
  
           for S in 1 .. Last loop
  
*************** package body GNAT.Perfect_Hash_Generator
*** 2139,2206 ****
                 N (C) := N (C) + 1;
              end loop;
  
!             --  Add to the total when there are two identical keys
  
              for J in N'Range loop
!                if N (J) > 1 then
!                   T := T + N (J);
                 end if;
              end loop;
           end loop;
  
           return T;
!       end Count_Identical_Keys;
  
     --  Start of processing for Select_Char_Position
  
     begin
!       for C in Sel_Position'Range loop
!          Sel_Position (C) := C;
!       end loop;
! 
!       --  Initialization of Words
! 
!       WT.Set_Last (2 * NK - 1);
  
        for K in 0 .. NK - 1 loop
!          WT.Table (Reduced (K) + 1) := WT.Table (Initial (K));
        end loop;
  
        declare
!          Collisions           : Natural;
!          Min_Collisions       : Natural := NK;
!          Old_Collisions       : Natural;
!          Min_Coll_Sel_Pos     : Natural := 0; -- init to kill warning
!          Min_Coll_Sel_Pos_Idx : Natural := 0; -- init to kill warning
           Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK);
           Same_Keys_Sets_Last  : Natural := 1;
  
        begin
!          Same_Keys_Sets_Table (1) := (1, NK);
  
           loop
!             --  Preserve minimum identical keys and check later on
!             --  that this value is strictly decrementing. Otherwise,
!             --  it means that two keys are stricly identical.
  
!             Old_Collisions := Min_Collisions;
  
!             --  Find which position reduces the most of collisions
  
!             for J in Last_Sel_Pos + 1 .. Sel_Position'Last loop
!                Collisions := Count_Identical_Keys
                   (Same_Keys_Sets_Table,
                    Same_Keys_Sets_Last,
                    Sel_Position (J));
  
!                if Collisions < Min_Collisions then
!                   Min_Collisions       := Collisions;
!                   Min_Coll_Sel_Pos     := Sel_Position (J);
!                   Min_Coll_Sel_Pos_Idx := J;
                 end if;
              end loop;
  
!             if Old_Collisions = Min_Collisions then
                 Raise_Exception
                   (Program_Error'Identity, "some keys are identical");
              end if;
--- 2136,2220 ----
                 N (C) := N (C) + 1;
              end loop;
  
!             --  Update the number of different keys. Each character used
!             --  denotes a different key.
  
              for J in N'Range loop
!                if N (J) > 0 then
!                   T := T + 1;
                 end if;
              end loop;
           end loop;
  
           return T;
!       end Count_Different_Keys;
  
     --  Start of processing for Select_Char_Position
  
     begin
!       --  Initialize the reduced words set
  
+       WT.Set_Last (2 * NK);
        for K in 0 .. NK - 1 loop
!          WT.Table (Reduced (K)) := WT.Table (Initial (K));
        end loop;
  
        declare
!          Differences          : Natural;
!          Max_Differences      : Natural := 0;
!          Old_Differences      : Natural;
!          Max_Diff_Sel_Pos     : Natural := 0; -- init to kill warning
!          Max_Diff_Sel_Pos_Idx : Natural := 0; -- init to kill warning
           Same_Keys_Sets_Table : Vertex_Table_Type (1 .. NK);
           Same_Keys_Sets_Last  : Natural := 1;
  
        begin
!          for C in Sel_Position'Range loop
!             Sel_Position (C) := C;
!          end loop;
! 
!          Same_Keys_Sets_Table (1) := (0, NK - 1);
  
           loop
!             --  Preserve maximum number of different keys and check later on
!             --  that this value is strictly incrementing. Otherwise, it means
!             --  that two keys are stricly identical.
  
!             Old_Differences := Max_Differences;
  
!             --  The first position should not exceed the minimum key length.
!             --  Otherwise, we may end up with an empty word once reduced.
  
!             if Last_Sel_Pos = 0 then
!                Max_Sel_Pos := Min_Key_Len;
!             else
!                Max_Sel_Pos := Max_Key_Len;
!             end if;
! 
!             --  Find which position increases more the number of differences
! 
!             for J in Last_Sel_Pos + 1 .. Max_Sel_Pos loop
!                Differences := Count_Different_Keys
                   (Same_Keys_Sets_Table,
                    Same_Keys_Sets_Last,
                    Sel_Position (J));
  
!                if Verbose then
!                   Put (Output,
!                        "Selecting position" & Sel_Position (J)'Img &
!                          " results in" & Differences'Img &
!                          " differences");
!                   New_Line (Output);
!                end if;
! 
!                if Differences > Max_Differences then
!                   Max_Differences      := Differences;
!                   Max_Diff_Sel_Pos     := Sel_Position (J);
!                   Max_Diff_Sel_Pos_Idx := J;
                 end if;
              end loop;
  
!             if Old_Differences = Max_Differences then
                 Raise_Exception
                   (Program_Error'Identity, "some keys are identical");
              end if;
*************** package body GNAT.Perfect_Hash_Generator
*** 2208,2250 ****
              --  Insert selected position and sort Sel_Position table
  
              Last_Sel_Pos := Last_Sel_Pos + 1;
!             Sel_Position (Last_Sel_Pos + 1 .. Min_Coll_Sel_Pos_Idx) :=
!               Sel_Position (Last_Sel_Pos .. Min_Coll_Sel_Pos_Idx - 1);
!             Sel_Position (Last_Sel_Pos) := Min_Coll_Sel_Pos;
  
              for P in 1 .. Last_Sel_Pos - 1 loop
!                if Min_Coll_Sel_Pos < Sel_Position (P) then
                    Sel_Position (P + 1 .. Last_Sel_Pos) :=
                      Sel_Position (P .. Last_Sel_Pos - 1);
!                   Sel_Position (P) := Min_Coll_Sel_Pos;
                    exit;
                 end if;
              end loop;
  
!             exit when Min_Collisions = 0;
  
              Build_Identical_Keys_Sets
                (Same_Keys_Sets_Table,
                 Same_Keys_Sets_Last,
!                Min_Coll_Sel_Pos);
           end loop;
        end;
  
        Char_Pos_Set_Len := Last_Sel_Pos;
!       Char_Pos_Set := Allocate (Char_Pos_Set_Len, Char_Pos_Size);
  
        for C in 1 .. Last_Sel_Pos loop
           Set_Char_Pos (C - 1, Sel_Position (C));
        end loop;
     end Select_Char_Position;
  
     ------------------
     -- Set_Char_Pos --
     ------------------
  
     procedure Set_Char_Pos (P : Natural; Item : Natural) is
        N : constant Natural := Char_Pos_Set + P;
- 
     begin
        IT.Table (N) := Item;
     end Set_Char_Pos;
--- 2222,2316 ----
              --  Insert selected position and sort Sel_Position table
  
              Last_Sel_Pos := Last_Sel_Pos + 1;
!             Sel_Position (Last_Sel_Pos + 1 .. Max_Diff_Sel_Pos_Idx) :=
!               Sel_Position (Last_Sel_Pos .. Max_Diff_Sel_Pos_Idx - 1);
!             Sel_Position (Last_Sel_Pos) := Max_Diff_Sel_Pos;
  
              for P in 1 .. Last_Sel_Pos - 1 loop
!                if Max_Diff_Sel_Pos < Sel_Position (P) then
                    Sel_Position (P + 1 .. Last_Sel_Pos) :=
                      Sel_Position (P .. Last_Sel_Pos - 1);
!                   Sel_Position (P) := Max_Diff_Sel_Pos;
                    exit;
                 end if;
              end loop;
  
!             exit when Max_Differences = NK;
  
              Build_Identical_Keys_Sets
                (Same_Keys_Sets_Table,
                 Same_Keys_Sets_Last,
!                Max_Diff_Sel_Pos);
! 
!             if Verbose then
!                Put (Output,
!                     "Selecting position" & Max_Diff_Sel_Pos'Img &
!                       " results in" & Max_Differences'Img &
!                       " differences");
!                New_Line (Output);
!                Put (Output, "--");
!                New_Line (Output);
!                for J in 1 .. Same_Keys_Sets_Last loop
!                   for K in
!                     Same_Keys_Sets_Table (J).First ..
!                     Same_Keys_Sets_Table (J).Last
!                   loop
!                      Put (Output, WT.Table (Reduced (K)));
!                      New_Line (Output);
!                   end loop;
!                   Put (Output, "--");
!                   New_Line (Output);
!                end loop;
!             end if;
           end loop;
        end;
  
        Char_Pos_Set_Len := Last_Sel_Pos;
!       Char_Pos_Set := Allocate (Char_Pos_Set_Len);
  
        for C in 1 .. Last_Sel_Pos loop
           Set_Char_Pos (C - 1, Sel_Position (C));
        end loop;
     end Select_Char_Position;
  
+    --------------------------
+    -- Select_Character_Set --
+    --------------------------
+ 
+    procedure Select_Character_Set
+    is
+       Last : Natural := 0;
+       Used : array (Character) of Boolean := (others => False);
+       Char : Character;
+ 
+    begin
+       for J in 0 .. NK - 1 loop
+          for K in 0 .. Char_Pos_Set_Len - 1 loop
+             Char := WT.Table (Initial (J))(Get_Char_Pos (K));
+             exit when Char = ASCII.NUL;
+             Used (Char) := True;
+          end loop;
+       end loop;
+ 
+       Used_Char_Set_Len := 256;
+       Used_Char_Set := Allocate (Used_Char_Set_Len);
+ 
+       for J in Used'Range loop
+          if Used (J) then
+             Set_Used_Char (J, Last);
+             Last := Last + 1;
+          else
+             Set_Used_Char (J, 0);
+          end if;
+       end loop;
+    end Select_Character_Set;
+ 
     ------------------
     -- Set_Char_Pos --
     ------------------
  
     procedure Set_Char_Pos (P : Natural; Item : Natural) is
        N : constant Natural := Char_Pos_Set + P;
     begin
        IT.Table (N) := Item;
     end Set_Char_Pos;
*************** package body GNAT.Perfect_Hash_Generator
*** 2255,2261 ****
  
     procedure Set_Edges (F : Natural; Item : Edge_Type) is
        N : constant Natural := Edges + (F * Edge_Size);
- 
     begin
        IT.Table (N)     := Item.X;
        IT.Table (N + 1) := Item.Y;
--- 2321,2326 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 2266,2309 ****
     -- Set_Graph --
     ---------------
  
!    procedure Set_Graph (F : Natural; Item : Integer) is
!       N : constant Natural := G + (F * Graph_Item_Size);
! 
     begin
!       IT.Table (N) := Item;
     end Set_Graph;
  
     -------------
     -- Set_Key --
     -------------
  
!    procedure Set_Key (F : Key_Id; Item : Key_Type) is
!       N : constant Natural := Keys + F * Key_Size;
! 
     begin
!       IT.Table (N) := Item.Edge;
     end Set_Key;
  
!    ------------------
!    -- Set_Rand_Tab --
!    ------------------
! 
!    procedure Set_Rand_Tab (T : Integer; X, Y : Natural; Item : Natural) is
!       N : constant Natural :=
!             T + ((Y * Rand_Tab_Len_1) + X) * Rand_Tab_Item_Size;
  
     begin
        IT.Table (N) := Item;
!    end Set_Rand_Tab;
  
     -------------------
     -- Set_Used_Char --
     -------------------
  
     procedure Set_Used_Char (C : Character; Item : Natural) is
!       N : constant Natural :=
!             Used_Char_Set + Character'Pos (C) * Used_Char_Size;
! 
     begin
        IT.Table (N) := Item;
     end Set_Used_Char;
--- 2331,2366 ----
     -- Set_Graph --
     ---------------
  
!    procedure Set_Graph (N : Natural; Item : Integer) is
     begin
!       IT.Table (G + N) := Item;
     end Set_Graph;
  
     -------------
     -- Set_Key --
     -------------
  
!    procedure Set_Key (N : Key_Id; Item : Key_Type) is
     begin
!       IT.Table (Keys + N) := Item.Edge;
     end Set_Key;
  
!    ---------------
!    -- Set_Table --
!    ---------------
  
+    procedure Set_Table (T : Integer; X, Y : Natural; Item : Natural) is
+       N : constant Natural := T + ((Y * T1_Len) + X);
     begin
        IT.Table (N) := Item;
!    end Set_Table;
  
     -------------------
     -- Set_Used_Char --
     -------------------
  
     procedure Set_Used_Char (C : Character; Item : Natural) is
!       N : constant Natural := Used_Char_Set + Character'Pos (C);
     begin
        IT.Table (N) := Item;
     end Set_Used_Char;
*************** package body GNAT.Perfect_Hash_Generator
*** 2314,2320 ****
  
     procedure Set_Vertices (F : Natural; Item : Vertex_Type) is
        N : constant Natural := Vertices + (F * Vertex_Size);
- 
     begin
        IT.Table (N)     := Item.First;
        IT.Table (N + 1) := Item.Last;
--- 2371,2376 ----
*************** package body GNAT.Perfect_Hash_Generator
*** 2327,2350 ****
     function Sum
       (Word  : Word_Type;
        Table : Table_Id;
!       Opt   : Optimization)
!       return  Natural
     is
        S : Natural := 0;
        R : Natural;
  
     begin
        if Opt = CPU_Time then
!          for J in 0 .. Rand_Tab_Len_1 - 1 loop
              exit when Word (J + 1) = ASCII.NUL;
!             R := Get_Rand_Tab (Table, J, Get_Used_Char (Word (J + 1)));
              S := (S + R) mod NV;
           end loop;
  
        else
!          for J in 0 .. Rand_Tab_Len_1 - 1 loop
              exit when Word (J + 1) = ASCII.NUL;
!             R := Get_Rand_Tab (Table, J, 0);
              S := (S + R * Character'Pos (Word (J + 1))) mod NV;
           end loop;
        end if;
--- 2383,2405 ----
     function Sum
       (Word  : Word_Type;
        Table : Table_Id;
!       Opt   : Optimization) return Natural
     is
        S : Natural := 0;
        R : Natural;
  
     begin
        if Opt = CPU_Time then
!          for J in 0 .. T1_Len - 1 loop
              exit when Word (J + 1) = ASCII.NUL;
!             R := Get_Table (Table, J, Get_Used_Char (Word (J + 1)));
              S := (S + R) mod NV;
           end loop;
  
        else
!          for J in 0 .. T1_Len - 1 loop
              exit when Word (J + 1) = ASCII.NUL;
!             R := Get_Table (Table, J, 0);
              S := (S + R * Character'Pos (Word (J + 1))) mod NV;
           end loop;
        end if;
*************** package body GNAT.Perfect_Hash_Generator
*** 2373,2381 ****
  
     function Value
       (Name : Table_Name;
!       J   : Natural;
!       K    : Natural := 0)
!       return Natural
     is
     begin
        case Name is
--- 2428,2435 ----
  
     function Value
       (Name : Table_Name;
!       J    : Natural;
!       K    : Natural := 0) return Natural
     is
     begin
        case Name is
*************** package body GNAT.Perfect_Hash_Generator
*** 2386,2395 ****
              return Get_Used_Char (Character'Val (J));
  
           when Function_Table_1 =>
!             return Get_Rand_Tab (T1, J, K);
  
           when  Function_Table_2 =>
!             return Get_Rand_Tab (T2, J, K);
  
           when Graph_Table =>
              return Get_Graph (J);
--- 2440,2449 ----
              return Get_Used_Char (Character'Val (J));
  
           when Function_Table_1 =>
!             return Get_Table (T1, J, K);
  
           when  Function_Table_2 =>
!             return Get_Table (T2, J, K);
  
           when Graph_Table =>
              return Get_Graph (J);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-pehage.ads gcc-4.1.0/gcc/ada/g-pehage.ads
*** gcc-4.0.2/gcc/ada/g-pehage.ads	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/g-pehage.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,152 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides a generator of static minimal perfect hash
! --  functions. To understand what a perfect hash function is, we
! --  define several notions. These definitions are inspired from the
! --  following paper:
  
! --    Zbigniew J. Czech, George Havas, and Bohdan S. Majewski ``An
! --    Optimal Algorithm for Generating Minimal Perfect Hash Functions'',
! --    Information Processing Letters, 43(1992) pp.257-264, Oct.1992
  
! --  Let W be a set of m words. A hash function h is a function that
! --  maps the set of words W into some given interval of integers
! --  [0, k-1], where k is an integer, usually k >= m. h (w) where w
! --  is a word computes an address or an integer from I for the
! --  storage or the retrieval of that item. The storage area used to
! --  store items is known as a hash table. Words for which the same
! --  address is computed are called synonyms. Due to the existence
! --  of synonyms a situation called collision may arise in which two
! --  items w1 and w2 have the same address. Several schemes for
! --  resolving known. A perfect hash function is an injection from
! --  the word set W to the integer interval I with k >= m. If k = m,
! --  then h is a minimal perfect hash function. A hash function is
! --  order preserving if it puts entries into the hash table in a
! --  prespecified order.
  
  --  A minimal perfect hash function is defined by two properties:
  
! --    Since no collisions occur each item can be retrieved from the
! --    table in *one* probe. This represents the "perfect" property.
  
! --    The hash table size corresponds to the exact size of W and
! --    *no larger*. This represents the "minimal" property.
  
! --  The functions generated by this package require the key set to
! --  be known in advance (they are "static" hash functions).
! --  The hash functions are also order preservering. If w2 is inserted
! --  after w1 in the generator, then f (w1) < f (w2). These hashing
! --  functions are convenient for use with realtime applications.
  
  package GNAT.Perfect_Hash_Generators is
  
     Default_K_To_V : constant Float  := 2.05;
!    --  Default ratio for the algorithm. When K is the number of keys,
!    --  V = (K_To_V) * K is the size of the main table of the hash function.
  
     Default_Pkg_Name : constant String := "Perfect_Hash";
!    --  Default package name in which the hash function is defined.
  
     Default_Position : constant String := "";
!    --  The generator allows selection of the character positions used
!    --  in the hash function. By default, all positions are selected.
  
     type Optimization is (Memory_Space, CPU_Time);
     Default_Optimization : constant Optimization := CPU_Time;
!    --  Optimize either the memory space or the execution time.
  
     Verbose : Boolean := False;
!    --  Comment required ???
  
     procedure Initialize
       (Seed   : Natural;
        K_To_V : Float        := Default_K_To_V;
!       Optim  : Optimization := CPU_Time);
!    --  Initialize the generator and its internal structures. Set the
!    --  ratio of vertices over keys in the random graphs. This value
!    --  has to be greater than 2.0 in order for the algorithm to succeed.
  
     procedure Finalize;
!    --  Deallocate the internal structures.
  
     procedure Insert (Value : String);
!    --  Insert a new key in the table.
  
     procedure Compute (Position : String := Default_Position);
!    --  Compute the hash function. Position allows to define a
!    --  selection of character positions used in the keywords hash
!    --  function. Positions can be separated by commas and range like
!    --  x-y may be used. Character '$' represents the final character
!    --  of a key. With an empty position, the generator automatically
!    --  produces positions to reduce the memory usage.
  
     procedure Produce (Pkg_Name  : String := Default_Pkg_Name);
!    --  Generate the hash function package Pkg_Name. This package
!    --  includes the minimal perfect Hash function.
  
!    --  The routines and structures defined below allow producing the
!    --  hash function using a different way from the procedure above.
!    --  The procedure Define returns the lengths of an internal table
!    --  and its item type size. The function Value returns the value of
!    --  each item in the table.
  
     --  The hash function has the following form:
  
     --             h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
!    --  G is a function based on a graph table [0,n-1] -> [0,m-1]. m is
!    --  the number of keys. n is an internally computed value and it
!    --  can be obtained as the length of vector G.
  
!    --  F1 and F2 are two functions based on two function tables T1 and
!    --  T2. Their definition depends on the chosen optimization mode.
  
!    --  Only some character positions are used in the keys because they
!    --  are significant. They are listed in a character position table
!    --  (P in the pseudo-code below). For instance, in {"jan", "feb",
!    --  "mar", "apr", "jun", "jul", "aug", "sep", "oct", "nov", "dec"},
!    --  only positions 2 and 3 are significant (the first character can
!    --  be ignored). In this example, P = {2, 3}
  
     --  When Optimization is CPU_Time, the first dimension of T1 and T2
!    --  corresponds to the character position in the key and the second
!    --  to the character set. As all the character set is not used, we
!    --  define a used character table which associates a distinct index
!    --  to each used character (unused characters are mapped to
!    --  zero). In this case, the second dimension of T1 and T2 is
!    --  reduced to the used character set (C in the pseudo-code
!    --  below). Therefore, the hash function has the following:
  
     --    function Hash (S : String) return Natural is
     --       F      : constant Natural := S'First - 1;
--- 31,163 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides a generator of static minimal perfect hash functions.
! --  To understand what a perfect hash function is, we define several notions.
! --  These definitions are inspired from the following paper:
  
! --    Zbigniew J. Czech, George Havas, and Bohdan S. Majewski ``An Optimal
! --    Algorithm for Generating Minimal Perfect Hash Functions'', Information
! --    Processing Letters, 43(1992) pp.257-264, Oct.1992
  
! --  Let W be a set of m words. A hash function h is a function that maps the
! --  set of words W into some given interval of integers [0, k-1], where k is an
! --  integer, usually k >= m. h (w) where is a word computes an address or an
! --  integer from I for the storage or the retrieval of that item. The storage
! --  area used to store items is known as a hash table. Words for which the same
! --  address is computed are called synonyms. Due to the existence of synonyms a
! --  situation called collision may arise in which two items w1 and w2 have the
! --  same address. Several schemes for resolving known. A perfect hash function
! --  is an injection from the word set W to the integer interval I with k >= m.
! --  If k = m, then h is a minimal perfect hash function. A hash function is
! --  order preserving if it puts entries into the hash table in prespecified
! --  order.
  
  --  A minimal perfect hash function is defined by two properties:
  
! --    Since no collisions occur each item can be retrieved from the table in
! --    *one* probe. This represents the "perfect" property.
  
! --    The hash table size corresponds to the exact size of W and *no larger*.
! --    This represents the "minimal" property.
  
! --  The functions generated by this package require the key set to be known in
! --  advance (they are "static" hash functions). The hash functions are also
! --  order preservering. If w2 is inserted after w1 in the generator, then (w1)
! --  < f (w2). These hashing functions are convenient for use with realtime
! --  applications.
  
  package GNAT.Perfect_Hash_Generators is
  
     Default_K_To_V : constant Float  := 2.05;
!    --  Default ratio for the algorithm. When K is the number of keys, V =
!    --  (K_To_V) * K is the size of the main table of the hash function. To
!    --  converge, the algorithm requires K_To_V to be stricly greater than 2.0.
  
     Default_Pkg_Name : constant String := "Perfect_Hash";
!    --  Default package name in which the hash function is defined
  
     Default_Position : constant String := "";
!    --  The generator allows selection of the character positions used in the
!    --  hash function. By default, all positions are selected.
! 
!    Default_Tries : constant Positive := 20;
!    --  This algorithm may not succeed to find a possible mapping on the first
!    --  try and may have to iterate a number of times. This constant bounds the
!    --  number of tries.
  
     type Optimization is (Memory_Space, CPU_Time);
     Default_Optimization : constant Optimization := CPU_Time;
!    --  Optimize either the memory space or the execution time
  
     Verbose : Boolean := False;
!    --  Output the status of the algorithm. For instance, the tables, the random
!    --  graph (edges, vertices) and selected char positions are output between
!    --  two iterations.
  
     procedure Initialize
       (Seed   : Natural;
        K_To_V : Float        := Default_K_To_V;
!       Optim  : Optimization := CPU_Time;
!       Tries  : Positive     := Default_Tries);
!    --  Initialize the generator and its internal structures. Set the ratio of
!    --  vertices over keys in the random graphs. This value has to be greater
!    --  than 2.0 in order for the algorithm to succeed. The key set is not
!    --  modified (in particular when it is already set). For instance, it is
!    --  possible to run several times the generator with different settings on
!    --  the same key set.
  
     procedure Finalize;
!    --  Deallocate the internal structures and the key table
  
     procedure Insert (Value : String);
!    --  Insert a new key in the table
! 
!    Too_Many_Tries : exception;
!    --  Raised after Tries unsuccessfull runs
  
     procedure Compute (Position : String := Default_Position);
!    --  Compute the hash function. Position allows to define selection of
!    --  character positions used in the keywords hash function. Positions can be
!    --  separated by commas and range like x-y may be used. Character '$'
!    --  represents the final character of a key. With an empty position, the
!    --  generator automatically produces positions to reduce the memory usage.
!    --  Raise Too_Many_Tries in case that the algorithm does not succeed in less
!    --  than Tries attempts (see Initialize).
  
     procedure Produce (Pkg_Name  : String := Default_Pkg_Name);
!    --  Generate the hash function package Pkg_Name. This package includes the
!    --  minimal perfect Hash function.
  
!    --  The routines and structures defined below allow producing the hash
!    --  function using a different way from the procedure above. The procedure
!    --  Define returns the lengths of an internal table and its item type size.
!    --  The function Value returns the value of each item in the table.
  
     --  The hash function has the following form:
  
     --             h (w) = (g (f1 (w)) + g (f2 (w))) mod m
  
!    --  G is a function based on a graph table [0,n-1] -> [0,m-1]. m is the
!    --  number of keys. n is an internally computed value and it can be obtained
!    --  as the length of vector G.
  
!    --  F1 and F2 are two functions based on two function tables T1 and T2.
!    --  Their definition depends on the chosen optimization mode.
  
!    --  Only some character positions are used in the keys because they are
!    --  significant. They are listed in a character position table (P in the
!    --  pseudo-code below). For instance, in {"jan", "feb", "mar", "apr", "jun",
!    --  "jul", "aug", "sep", "oct", "nov", "dec"}, only positions 2 and 3 are
!    --  significant (the first character can be ignored). In this example, P =
!    --  {2, 3}
  
     --  When Optimization is CPU_Time, the first dimension of T1 and T2
!    --  corresponds to the character position in the key and the second to the
!    --  character set. As all the character set is not used, we define a used
!    --  character table which associates a distinct index to each used character
!    --  (unused characters are mapped to zero). In this case, the second
!    --  dimension of T1 and T2 is reduced to the used character set (C in the
!    --  pseudo-code below). Therefore, the hash function has the following:
  
     --    function Hash (S : String) return Natural is
     --       F      : constant Natural := S'First - 1;
*************** package GNAT.Perfect_Hash_Generators is
*** 165,175 ****
     --       return (Natural (G (F1)) + Natural (G (F2))) mod <m>;
     --    end Hash;
  
!    --  When Optimization is Memory_Space, the first dimension of T1
!    --  and T2 corresponds to the character position in the key and the
!    --  second dimension is ignored. T1 and T2 are no longer matrices
!    --  but vectors. Therefore, the used character table is not
!    --  available. The hash function has the following form:
  
     --     function Hash (S : String) return Natural is
     --        F      : constant Natural := S'First - 1;
--- 176,186 ----
     --       return (Natural (G (F1)) + Natural (G (F2))) mod <m>;
     --    end Hash;
  
!    --  When Optimization is Memory_Space, the first dimension of T1 and T2
!    --  corresponds to the character position in the key and the second
!    --  dimension is ignored. T1 and T2 are no longer matrices but vectors.
!    --  Therefore, the used character table is not available. The hash function
!    --  has the following form:
  
     --     function Hash (S : String) return Natural is
     --        F      : constant Natural := S'First - 1;
*************** package GNAT.Perfect_Hash_Generators is
*** 200,216 ****
        Item_Size : out Natural;
        Length_1  : out Natural;
        Length_2  : out Natural);
!    --  Return the definition of the table Name. This includes the
!    --  length of dimensions 1 and 2 and the size of an unsigned
!    --  integer item. When Length_2 is zero, the table has only one
!    --  dimension. All the ranges start from zero.
  
     function Value
       (Name : Table_Name;
        J    : Natural;
!       K    : Natural := 0)
!       return Natural;
!    --  Return the value of the component (I, J) of the table
!    --  Name. When the table has only one dimension, J is ignored.
  
  end GNAT.Perfect_Hash_Generators;
--- 211,226 ----
        Item_Size : out Natural;
        Length_1  : out Natural;
        Length_2  : out Natural);
!    --  Return the definition of the table Name. This includes the length of
!    --  dimensions 1 and 2 and the size of an unsigned integer item. When
!    --  Length_2 is zero, the table has only one dimension. All the ranges start
!    --  from zero.
  
     function Value
       (Name : Table_Name;
        J    : Natural;
!       K    : Natural := 0) return Natural;
!    --  Return the value of the component (I, J) of the table Name. When the
!    --  table has only one dimension, J is ignored.
  
  end GNAT.Perfect_Hash_Generators;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regexp.adb gcc-4.1.0/gcc/ada/g-regexp.adb
*** gcc-4.0.2/gcc/ada/g-regexp.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/g-regexp.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1999-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Regexp is
*** 180,186 ****
          (M     : String;
           Index : Integer);
        pragma No_Return (Raise_Exception);
!       --  Raise an exception, indicating an error at character Index in S.
  
        --------------------
        -- Create_Mapping --
--- 180,186 ----
          (M     : String;
           Index : Integer);
        pragma No_Return (Raise_Exception);
!       --  Raise an exception, indicating an error at character Index in S
  
        --------------------
        -- Create_Mapping --
*************** package body GNAT.Regexp is
*** 330,336 ****
                    if not Glob then
                       if J = S'First then
                          Raise_Exception
!                           ("'*', '+', '?' and '|' operators can not be in "
                             & "first position in regular expression", J);
                       end if;
                    end if;
--- 330,336 ----
                    if not Glob then
                       if J = S'First then
                          Raise_Exception
!                           ("'*', '+', '?' and '|' operators cannot be in "
                             & "first position in regular expression", J);
                       end if;
                    end if;
*************** package body GNAT.Regexp is
*** 343,349 ****
                          --  and cannot be found at the beginning of the line
  
                          Raise_Exception
!                           ("'*', '+', '?' and '|' operators can not be in "
                             & "first position in regular expression", J);
                       end if;
  
--- 343,349 ----
                          --  and cannot be found at the beginning of the line
  
                          Raise_Exception
!                           ("'*', '+', '?' and '|' operators cannot be in "
                             & "first position in regular expression", J);
                       end if;
  
*************** package body GNAT.Regexp is
*** 389,395 ****
           procedure Add_Empty_Char
             (State    : State_Index;
              To_State : State_Index);
!          --  Add a empty-character transition from State to To_State.
  
           procedure Create_Repetition
             (Repetition : Character;
--- 389,395 ----
           procedure Add_Empty_Char
             (State    : State_Index;
              To_State : State_Index);
!          --  Add a empty-character transition from State to To_State
  
           procedure Create_Repetition
             (Repetition : Character;
*************** package body GNAT.Regexp is
*** 461,467 ****
              End_Index   : Integer)
              return        Integer;
           --  Returns the index of the last character of the next sub-expression
!          --  in Simple. Index can not be greater than End_Index
  
           --------------------
           -- Add_Empty_Char --
--- 461,467 ----
              End_Index   : Integer)
              return        Integer;
           --  Returns the index of the last character of the next sub-expression
!          --  in Simple. Index cannot be greater than End_Index.
  
           --------------------
           -- Add_Empty_Char --
*************** package body GNAT.Regexp is
*** 829,835 ****
           procedure Add_Empty_Char
             (State    : State_Index;
              To_State : State_Index);
!          --  Add a empty-character transition from State to To_State.
  
           procedure Create_Simple
             (Start_Index : Integer;
--- 829,835 ----
           procedure Add_Empty_Char
             (State    : State_Index;
              To_State : State_Index);
!          --  Add a empty-character transition from State to To_State
  
           procedure Create_Simple
             (Start_Index : Integer;
*************** package body GNAT.Regexp is
*** 1088,1095 ****
          (First_Table : Regexp_Array_Access;
           Num_States  : State_Index;
           Start_State : State_Index;
!          End_State   : State_Index)
!          return        Regexp
        is
           pragma Warnings (Off, Num_States);
  
--- 1088,1094 ----
          (First_Table : Regexp_Array_Access;
           Num_States  : State_Index;
           Start_State : State_Index;
!          End_State   : State_Index) return Regexp
        is
           pragma Warnings (Off, Num_States);
  
*************** package body GNAT.Regexp is
*** 1301,1308 ****
     function Get
       (Table  : Regexp_Array_Access;
        State  : State_Index;
!       Column : Column_Index)
!       return   State_Index
     is
     begin
        if State <= Table'Last (1)
--- 1300,1306 ----
     function Get
       (Table  : Regexp_Array_Access;
        State  : State_Index;
!       Column : Column_Index) return State_Index
     is
     begin
        if State <= Table'Last (1)
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regexp.ads gcc-4.1.0/gcc/ada/g-regexp.ads
*** gcc-4.0.2/gcc/ada/g-regexp.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-regexp.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1998-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Regexp is
*** 131,138 ****
     function Compile
       (Pattern        : String;
        Glob           : Boolean := False;
!       Case_Sensitive : Boolean := True)
!       return           Regexp;
     --  Compiles a regular expression S. If the syntax of the given
     --  expression is invalid (does not match above grammar, Error_In_Regexp
     --  is raised. If Glob is True, the pattern is considered as a 'globbing
--- 131,137 ----
     function Compile
       (Pattern        : String;
        Glob           : Boolean := False;
!       Case_Sensitive : Boolean := True) return Regexp;
     --  Compiles a regular expression S. If the syntax of the given
     --  expression is invalid (does not match above grammar, Error_In_Regexp
     --  is raised. If Glob is True, the pattern is considered as a 'globbing
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regist.adb gcc-4.1.0/gcc/ada/g-regist.adb
*** gcc-4.0.2/gcc/ada/g-regist.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-regist.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Registry is
*** 81,94 ****
  
     function RegDeleteKey
       (Key      : HKEY;
!       lpSubKey : Address)
!       return     LONG;
     pragma Import (Stdcall, RegDeleteKey, "RegDeleteKeyA");
  
     function RegDeleteValue
       (Key         : HKEY;
!       lpValueName : Address)
!       return        LONG;
     pragma Import (Stdcall, RegDeleteValue, "RegDeleteValueA");
  
     function RegEnumValue
--- 81,92 ----
  
     function RegDeleteKey
       (Key      : HKEY;
!       lpSubKey : Address) return LONG;
     pragma Import (Stdcall, RegDeleteKey, "RegDeleteKeyA");
  
     function RegDeleteValue
       (Key         : HKEY;
!       lpValueName : Address) return LONG;
     pragma Import (Stdcall, RegDeleteValue, "RegDeleteValueA");
  
     function RegEnumValue
*************** package body GNAT.Registry is
*** 99,106 ****
        lpReserved    : LPDWORD;
        lpType        : LPDWORD;
        lpData        : Address;
!       lpcbData      : LPDWORD)
!       return          LONG;
     pragma Import (Stdcall, RegEnumValue, "RegEnumValueA");
  
     function RegOpenKeyEx
--- 97,103 ----
        lpReserved    : LPDWORD;
        lpType        : LPDWORD;
        lpData        : Address;
!       lpcbData      : LPDWORD) return LONG;
     pragma Import (Stdcall, RegEnumValue, "RegEnumValueA");
  
     function RegOpenKeyEx
*************** package body GNAT.Registry is
*** 108,115 ****
        lpSubKey   : Address;
        ulOptions  : DWORD;
        samDesired : REGSAM;
!       phkResult  : PHKEY)
!       return       LONG;
     pragma Import (Stdcall, RegOpenKeyEx, "RegOpenKeyExA");
  
     function RegQueryValueEx
--- 105,111 ----
        lpSubKey   : Address;
        ulOptions  : DWORD;
        samDesired : REGSAM;
!       phkResult  : PHKEY) return LONG;
     pragma Import (Stdcall, RegOpenKeyEx, "RegOpenKeyExA");
  
     function RegQueryValueEx
*************** package body GNAT.Registry is
*** 118,125 ****
        lpReserved  : LPDWORD;
        lpType      : LPDWORD;
        lpData      : Address;
!       lpcbData    : LPDWORD)
!       return        LONG;
     pragma Import (Stdcall, RegQueryValueEx, "RegQueryValueExA");
  
     function RegSetValueEx
--- 114,120 ----
        lpReserved  : LPDWORD;
        lpType      : LPDWORD;
        lpData      : Address;
!       lpcbData    : LPDWORD) return LONG;
     pragma Import (Stdcall, RegQueryValueEx, "RegQueryValueExA");
  
     function RegSetValueEx
*************** package body GNAT.Registry is
*** 128,142 ****
        Reserved    : DWORD;
        dwType      : DWORD;
        lpData      : Address;
!       cbData      : DWORD)
!       return        LONG;
     pragma Import (Stdcall, RegSetValueEx, "RegSetValueExA");
  
     ---------------------
     -- Local Constants --
     ---------------------
  
!    Max_Key_Size   : constant := 1_024;
     --  Maximum number of characters for a registry key
  
     Max_Value_Size : constant := 2_048;
--- 123,136 ----
        Reserved    : DWORD;
        dwType      : DWORD;
        lpData      : Address;
!       cbData      : DWORD) return LONG;
     pragma Import (Stdcall, RegSetValueEx, "RegSetValueExA");
  
     ---------------------
     -- Local Constants --
     ---------------------
  
!    Max_Key_Size : constant := 1_024;
     --  Maximum number of characters for a registry key
  
     Max_Value_Size : constant := 2_048;
*************** package body GNAT.Registry is
*** 147,153 ****
     -----------------------
  
     function To_C_Mode (Mode : Key_Mode) return REGSAM;
!    --  Returns the Win32 mode value for the Key_Mode value.
  
     procedure Check_Result (Result : LONG; Message : String);
     --  Checks value Result and raise the exception Registry_Error if it is not
--- 141,147 ----
     -----------------------
  
     function To_C_Mode (Mode : Key_Mode) return REGSAM;
!    --  Returns the Win32 mode value for the Key_Mode value
  
     procedure Check_Result (Result : LONG; Message : String);
     --  Checks value Result and raise the exception Registry_Error if it is not
*************** package body GNAT.Registry is
*** 188,195 ****
     function Create_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Write)
!       return     HKEY
     is
        use type REGSAM;
        use type DWORD;
--- 182,188 ----
     function Create_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Write) return HKEY
     is
        use type REGSAM;
        use type DWORD;
*************** package body GNAT.Registry is
*** 318,325 ****
  
     function Key_Exists
       (From_Key : HKEY;
!       Sub_Key  : String)
!       return     Boolean
     is
        New_Key : HKEY;
  
--- 311,317 ----
  
     function Key_Exists
       (From_Key : HKEY;
!       Sub_Key  : String) return Boolean
     is
        New_Key : HKEY;
  
*************** package body GNAT.Registry is
*** 346,353 ****
     function Open_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Only)
!       return     HKEY
     is
        use type REGSAM;
  
--- 338,344 ----
     function Open_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Only) return HKEY
     is
        use type REGSAM;
  
*************** package body GNAT.Registry is
*** 376,383 ****
     function Query_Value
       (From_Key : HKEY;
        Sub_Key  : String;
!       Expand   : Boolean := False)
!       return     String
     is
        use GNAT.Directory_Operations;
        use type LONG;
--- 367,373 ----
     function Query_Value
       (From_Key : HKEY;
        Sub_Key  : String;
!       Expand   : Boolean := False) return String
     is
        use GNAT.Directory_Operations;
        use type LONG;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regist.ads gcc-4.1.0/gcc/ada/g-regist.ads
*** gcc-4.0.2/gcc/ada/g-regist.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-regist.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Registry is
*** 57,63 ****
     HKEY_PERFORMANCE_DATA : constant HKEY;
  
     type Key_Mode is (Read_Only, Read_Write);
!    --  Access mode for the registry key.
  
     Registry_Error : exception;
     --  Registry_Error is raises by all routines below if a problem occurs
--- 57,63 ----
     HKEY_PERFORMANCE_DATA : constant HKEY;
  
     type Key_Mode is (Read_Only, Read_Write);
!    --  Access mode for the registry key
  
     Registry_Error : exception;
     --  Registry_Error is raises by all routines below if a problem occurs
*************** package GNAT.Registry is
*** 66,73 ****
     function Create_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Write)
!       return     HKEY;
     --  Open or create a key (named Sub_Key) in the Windows registry database.
     --  The key will be created under key From_Key. It returns the key handle.
     --  From_Key must be a valid handle to an already opened key or one of
--- 66,72 ----
     function Create_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Write) return HKEY;
     --  Open or create a key (named Sub_Key) in the Windows registry database.
     --  The key will be created under key From_Key. It returns the key handle.
     --  From_Key must be a valid handle to an already opened key or one of
*************** package GNAT.Registry is
*** 76,111 ****
     function Open_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Only)
!       return     HKEY;
     --  Return a registry key handle for key named Sub_Key opened under key
     --  From_Key. It is possible to open a key at any level in the registry
     --  tree in a single call to Open_Key.
  
     procedure Close_Key (Key : HKEY);
!    --  Close registry key handle. All resources used by Key are released.
  
     function Key_Exists (From_Key : HKEY; Sub_Key : String) return Boolean;
!    --  Returns True if Sub_Key is defined under From_Key in the registry.
  
     function Query_Value
       (From_Key : HKEY;
        Sub_Key  : String;
!       Expand   : Boolean := False)
!       return     String;
     --  Returns the registry key's value associated with Sub_Key in From_Key
     --  registry key. If Expand is set to True and the Sub_Key is a
     --  REG_EXPAND_SZ the returned value will have the %name% variables
     --  replaced by the corresponding environment variable value.
  
     procedure Set_Value (From_Key : HKEY; Sub_Key : String; Value : String);
!    --  Add the pair (Sub_Key, Value) into From_Key registry key.
  
     procedure Delete_Key (From_Key : HKEY; Sub_Key : String);
!    --  Remove Sub_Key from the registry key From_Key.
  
     procedure Delete_Value (From_Key : HKEY; Sub_Key : String);
!    --  Remove the named value Sub_Key from the registry key From_Key.
  
     generic
        with procedure Action
--- 75,108 ----
     function Open_Key
       (From_Key : HKEY;
        Sub_Key  : String;
!       Mode     : Key_Mode := Read_Only) return HKEY;
     --  Return a registry key handle for key named Sub_Key opened under key
     --  From_Key. It is possible to open a key at any level in the registry
     --  tree in a single call to Open_Key.
  
     procedure Close_Key (Key : HKEY);
!    --  Close registry key handle. All resources used by Key are released
  
     function Key_Exists (From_Key : HKEY; Sub_Key : String) return Boolean;
!    --  Returns True if Sub_Key is defined under From_Key in the registry
  
     function Query_Value
       (From_Key : HKEY;
        Sub_Key  : String;
!       Expand   : Boolean := False) return String;
     --  Returns the registry key's value associated with Sub_Key in From_Key
     --  registry key. If Expand is set to True and the Sub_Key is a
     --  REG_EXPAND_SZ the returned value will have the %name% variables
     --  replaced by the corresponding environment variable value.
  
     procedure Set_Value (From_Key : HKEY; Sub_Key : String; Value : String);
!    --  Add the pair (Sub_Key, Value) into From_Key registry key
  
     procedure Delete_Key (From_Key : HKEY; Sub_Key : String);
!    --  Remove Sub_Key from the registry key From_Key
  
     procedure Delete_Value (From_Key : HKEY; Sub_Key : String);
!    --  Remove the named value Sub_Key from the registry key From_Key
  
     generic
        with procedure Action
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regpat.adb gcc-4.1.0/gcc/ada/g-regpat.adb
*** gcc-4.0.2/gcc/ada/g-regpat.adb	Wed Dec  8 11:46:58 2004
--- gcc-4.1.0/gcc/ada/g-regpat.adb	Tue Nov 15 13:59:42 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                                                                          --
  --               Copyright (C) 1986 by University of Toronto.               --
! --           Copyright (C) 1996-2004 Ada Core Technologies, 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                                                                          --
  --               Copyright (C) 1986 by University of Toronto.               --
! --                      Copyright (C) 1999-2005, AdaCore                    --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Regpat is
*** 129,135 ****
        --  Complex loops
  
        CURLYX,     -- 2num node Match this complex thing {n,m} times
!       --                       The nums are coded on two characters each.
  
        WHILEM,     -- no        Do curly processing and see if rest matches
  
--- 129,135 ----
        --  Complex loops
  
        CURLYX,     -- 2num node Match this complex thing {n,m} times
!       --                       The nums are coded on two characters each
  
        WHILEM,     -- no        Do curly processing and see if rest matches
  
*************** package body GNAT.Regpat is
*** 233,247 ****
     procedure Set_In_Class
       (Bitmap : in out Character_Class;
        C      : Character);
!    --  Set the entry to True for C in the class Bitmap.
  
     function Get_From_Class
       (Bitmap : Character_Class;
        C      : Character) return Boolean;
!    --  Return True if the entry is set for C in the class Bitmap.
  
     procedure Reset_Class (Bitmap : out Character_Class);
!    --  Clear all the entries in the class Bitmap.
  
     pragma Inline (Set_In_Class);
     pragma Inline (Get_From_Class);
--- 233,247 ----
     procedure Set_In_Class
       (Bitmap : in out Character_Class;
        C      : Character);
!    --  Set the entry to True for C in the class Bitmap
  
     function Get_From_Class
       (Bitmap : Character_Class;
        C      : Character) return Boolean;
!    --  Return True if the entry is set for C in the class Bitmap
  
     procedure Reset_Class (Bitmap : out Character_Class);
!    --  Clear all the entries in the class Bitmap
  
     pragma Inline (Set_In_Class);
     pragma Inline (Get_From_Class);
*************** package body GNAT.Regpat is
*** 282,288 ****
     function Get_Next_Offset
       (Program : Program_Data;
        IP      : Pointer) return Pointer;
!    --  Get the offset field of a node. Used by Get_Next.
  
     function Get_Next
       (Program : Program_Data;
--- 282,288 ----
     function Get_Next_Offset
       (Program : Program_Data;
        IP      : Pointer) return Pointer;
!    --  Get the offset field of a node. Used by Get_Next
  
     function Get_Next
       (Program : Program_Data;
*************** package body GNAT.Regpat is
*** 295,301 ****
     function Read_Natural
       (Program : Program_Data;
        IP      : Pointer) return Natural;
!    --  Return the 2-byte natural coded at position IP.
  
     --  All of the subprograms above are tiny and should be inlined
  
--- 295,301 ----
     function Read_Natural
       (Program : Program_Data;
        IP      : Pointer) return Natural;
!    --  Return the 2-byte natural coded at position IP
  
     --  All of the subprograms above are tiny and should be inlined
  
*************** package body GNAT.Regpat is
*** 389,398 ****
        --  Return value is the location of new opcode, ie old Emit_Ptr.
  
        procedure Emit_Natural (IP : Pointer; N : Natural);
!       --  Split N on two characters at position IP.
  
        procedure Emit_Class (Bitmap : Character_Class);
!       --  Emits a character class.
  
        procedure Case_Emit (C : Character);
        --  Emit C, after converting is to lower-case if the regular
--- 389,398 ----
        --  Return value is the location of new opcode, ie old Emit_Ptr.
  
        procedure Emit_Natural (IP : Pointer; N : Natural);
!       --  Split N on two characters at position IP
  
        procedure Emit_Class (Bitmap : Character_Class);
!       --  Emits a character class
  
        procedure Case_Emit (C : Character);
        --  Emit C, after converting is to lower-case if the regular
*************** package body GNAT.Regpat is
*** 454,460 ****
        function  Next_Instruction (P : Pointer) return Pointer;
        --  Dig the "next" pointer out of a node
  
!       procedure Fail (M : in String);
        pragma No_Return (Fail);
        --  Fail with a diagnostic message, if possible
  
--- 454,460 ----
        function  Next_Instruction (P : Pointer) return Pointer;
        --  Dig the "next" pointer out of a node
  
!       procedure Fail (M : String);
        pragma No_Return (Fail);
        --  Fail with a diagnostic message, if possible
  
*************** package body GNAT.Regpat is
*** 572,580 ****
        -- Fail --
        ----------
  
!       procedure Fail (M : in String) is
        begin
!          raise Expression_Error;
        end Fail;
  
        -------------------------
--- 572,580 ----
        -- Fail --
        ----------
  
!       procedure Fail (M : String) is
        begin
!          raise Expression_Error with M;
        end Fail;
  
        -------------------------
*************** package body GNAT.Regpat is
*** 845,851 ****
        --  makes it hard to avoid.
  
        procedure Parse
!         (Parenthesized  : in Boolean;
           Flags          : out Expression_Flags;
           IP             : out Pointer)
        is
--- 845,851 ----
        --  makes it hard to avoid.
  
        procedure Parse
!         (Parenthesized  : Boolean;
           Flags          : out Expression_Flags;
           IP             : out Pointer)
        is
*************** package body GNAT.Regpat is
*** 1206,1212 ****
              Parse_Pos := Parse_Pos + 1;
           end if;
  
!          --  First character can be ] or -, without closing the class.
  
           if Parse_Pos <= Parse_End
             and then (Expression (Parse_Pos) = ']'
--- 1206,1212 ----
              Parse_Pos := Parse_Pos + 1;
           end if;
  
!          --  First character can be ] or - without closing the class
  
           if Parse_Pos <= Parse_End
             and then (Expression (Parse_Pos) = ']'
*************** package body GNAT.Regpat is
*** 2389,2395 ****
  
        type Natural_Array is array (Match_Count range <>) of Natural;
        Matches_Tmp : Natural_Array (Matches_Full'Range);
!       --  Save the opening position of parenthesis.
  
        Last_Paren  : Natural := 0;
        --  Last parenthesis seen
--- 2389,2395 ----
  
        type Natural_Array is array (Match_Count range <>) of Natural;
        Matches_Tmp : Natural_Array (Matches_Full'Range);
!       --  Save the opening position of parenthesis
  
        Last_Paren  : Natural := 0;
        --  Last parenthesis seen
*************** package body GNAT.Regpat is
*** 2414,2420 ****
        --  operators for complex expressions.
  
        Current_Curly : Current_Curly_Access := null;
!       --  The curly currently being processed.
  
        -----------------------
        -- Local Subprograms --
--- 2414,2420 ----
        --  operators for complex expressions.
  
        Current_Curly : Current_Curly_Access := null;
!       --  The curly currently being processed
  
        -----------------------
        -- Local Subprograms --
*************** package body GNAT.Regpat is
*** 2430,2436 ****
        --  It only matches on things of length 1.
        --  Starting from Input_Pos, it matches at most Max CURLY.
  
!       function Try (Pos : in Positive) return Boolean;
        --  Try to match at specific point
  
        function Match (IP : Pointer) return Boolean;
--- 2430,2436 ----
        --  It only matches on things of length 1.
        --  Starting from Input_Pos, it matches at most Max CURLY.
  
!       function Try (Pos : Positive) return Boolean;
        --  Try to match at specific point
  
        function Match (IP : Pointer) return Boolean;
*************** package body GNAT.Regpat is
*** 2465,2471 ****
        pragma Inline (Index);
        pragma Inline (Repeat);
  
!       --  These are two complex functions, but used only once.
  
        pragma Inline (Match_Whilem);
        pragma Inline (Match_Simple_Operator);
--- 2465,2471 ----
        pragma Inline (Index);
        pragma Inline (Repeat);
  
!       --  These are two complex functions, but used only once
  
        pragma Inline (Match_Whilem);
        pragma Inline (Match_Simple_Operator);
*************** package body GNAT.Regpat is
*** 3002,3011 ****
           Ln : Natural                       := 0;
  
           Lastloc : constant Natural := Cc.Lastloc;
!          --  Detection of 0-len.
  
        begin
!          --  If degenerate scan matches "", assume scan done.
  
           if Input_Pos = Cc.Lastloc
             and then N >= Cc.Min
--- 3002,3011 ----
           Ln : Natural                       := 0;
  
           Lastloc : constant Natural := Cc.Lastloc;
!          --  Detection of 0-len
  
        begin
!          --  If degenerate scan matches "", assume scan done
  
           if Input_Pos = Cc.Lastloc
             and then N >= Cc.Min
*************** package body GNAT.Regpat is
*** 3031,3037 ****
              return False;
           end if;
  
!          --  First, just match a string of min scans.
  
           if N < Cc.Min then
              Cc.Cur := N;
--- 3031,3037 ----
              return False;
           end if;
  
!          --  First, just match a string of min scans
  
           if N < Cc.Min then
              Cc.Cur := N;
*************** package body GNAT.Regpat is
*** 3046,3052 ****
              return False;
           end if;
  
!          --  Prefer next over scan for minimal matching.
  
           if not Cc.Greedy then
              Current_Curly := Cc.Old_Cc;
--- 3046,3052 ----
              return False;
           end if;
  
!          --  Prefer next over scan for minimal matching
  
           if not Cc.Greedy then
              Current_Curly := Cc.Old_Cc;
*************** package body GNAT.Regpat is
*** 3240,3246 ****
        -- Try --
        ---------
  
!       function Try (Pos : in Positive) return Boolean is
        begin
           Input_Pos  := Pos;
           Last_Paren := 0;
--- 3240,3246 ----
        -- Try --
        ---------
  
!       function Try (Pos : Positive) return Boolean is
        begin
           Input_Pos  := Pos;
           Last_Paren := 0;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-regpat.ads gcc-4.1.0/gcc/ada/g-regpat.ads
*** gcc-4.0.2/gcc/ada/g-regpat.ads	Wed May  5 10:09:54 2004
--- gcc-4.1.0/gcc/ada/g-regpat.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                                                                          --
  --               Copyright (C) 1986 by University of Toronto.               --
! --           Copyright (C) 1996-2004 Ada Core Technologies, 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- --
--- 7,13 ----
  --                                 S p e c                                  --
  --                                                                          --
  --               Copyright (C) 1986 by University of Toronto.               --
! --                     Copyright (C) 1996-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 68,74 ****
  --       extensions that provide full (type 0) computational capabilities.
  
  package GNAT.Regpat is
! pragma Preelaborate (Regpat);
  
     --  The grammar is the following:
  
--- 68,74 ----
  --       extensions that provide full (type 0) computational capabilities.
  
  package GNAT.Regpat is
!    pragma Preelaborate;
  
     --  The grammar is the following:
  
*************** pragma Preelaborate (Regpat);
*** 206,212 ****
     --  first version the regular expression has in fact to be compiled twice
     --  (first to compute the size, then to generate the byte code).
  
!    --  Note also that you can not use the function version of Compile if you
     --  specify the size of the Pattern_Matcher, since the discriminants will
     --  most probably be different and you will get a Constraint_Error
  
--- 206,212 ----
     --  first version the regular expression has in fact to be compiled twice
     --  (first to compute the size, then to generate the byte code).
  
!    --  Note also that you cannot use the function version of Compile if you
     --  specify the size of the Pattern_Matcher, since the discriminants will
     --  most probably be different and you will get a Constraint_Error
  
*************** pragma Preelaborate (Regpat);
*** 219,225 ****
     --  Several versions of the Match subprogram are provided, with different
     --  parameters and return results.
  
!    --  See the description under each of these subprograms.
  
     --  Here is a short example showing how to get the substring matched by
     --  the first parenthesis pair.
--- 219,225 ----
     --  Several versions of the Match subprogram are provided, with different
     --  parameters and return results.
  
!    --  See the description under each of these subprograms
  
     --  Here is a short example showing how to get the substring matched by
     --  the first parenthesis pair.
*************** pragma Preelaborate (Regpat);
*** 291,310 ****
     ---------------
  
     Expression_Error : exception;
!    --  This exception is raised when trying to compile an invalid
!    --  regular expression. All subprograms taking an expression
!    --  as parameter may raise Expression_Error.
  
     Max_Paren_Count : constant := 255;
!    --  Maximum number of parenthesis in a regular expression.
!    --  This is limited by the size of a Character, as found in the
!    --  byte-compiled version of regular expressions.
  
     Max_Curly_Repeat : constant := 32767;
!    --  Maximum number of repetition for the curly operator.
!    --  The digits in the {n}, {n,} and {n,m } operators can not be higher
!    --  than this constant, since they have to fit on two characters in the
!    --  byte-compiled version of regular expressions.
  
     Max_Program_Size : constant := 2**15 - 1;
     --  Maximum size that can be allocated for a program
--- 291,310 ----
     ---------------
  
     Expression_Error : exception;
!    --  This exception is raised when trying to compile an invalid regular
!    --  expression. All subprograms taking an expression as parameter may raise
!    --  Expression_Error.
  
     Max_Paren_Count : constant := 255;
!    --  Maximum number of parenthesis in a regular expression. This is limited
!    --  by the size of a Character, as found in the byte-compiled version of
!    --  regular expressions.
  
     Max_Curly_Repeat : constant := 32767;
!    --  Maximum number of repetition for the curly operator. The digits in the
!    --  {n}, {n,} and {n,m } operators cannot be higher than this constant,
!    --  since they have to fit on two characters in the byte-compiled version of
!    --  regular expressions.
  
     Max_Program_Size : constant := 2**15 - 1;
     --  Maximum size that can be allocated for a program
*************** pragma Preelaborate (Regpat);
*** 318,327 ****
     --  and the programmer need not be concerned about it. There are two
     --  exceptions to this. First in the calls to Match, it is possible to
     --  specify a non-zero size that is known to be large enough. This can
!    --  slightly increase the efficiency by avoiding a copy. Second, in the
!    --  case of calling compile, it is possible using the procedural form
!    --  of Compile to use a single Pattern_Matcher variable for several
!    --  different expressions by setting its size sufficiently large.
  
     Auto_Size : constant := 0;
     --  Used in calls to Match to indicate that the Size should be set to
--- 318,327 ----
     --  and the programmer need not be concerned about it. There are two
     --  exceptions to this. First in the calls to Match, it is possible to
     --  specify a non-zero size that is known to be large enough. This can
!    --  slightly increase the efficiency by avoiding a copy. Second, in the case
!    --  of calling compile, it is possible using the procedural form of Compile
!    --  to use a single Pattern_Matcher variable for several different
!    --  expressions by setting its size sufficiently large.
  
     Auto_Size : constant := 0;
     --  Used in calls to Match to indicate that the Size should be set to
*************** pragma Preelaborate (Regpat);
*** 362,394 ****
     end record;
  
     type Match_Array is array (Match_Count range <>) of Match_Location;
!    --  The substring matching a given pair of parenthesis.
!    --  Index 0 is the whole substring that matched the full regular
!    --  expression.
     --
!    --  For instance, if your regular expression is something like:
!    --  "a(b*)(c+)", then Match_Array(1) will be the indexes of the
!    --  substring that matched "b*" and Match_Array(2) will be the substring
!    --  that matched "c+".
     --
!    --  The number of parenthesis groups that can be retrieved is unlimited,
!    --  and all the Match subprograms below can use a Match_Array of any size.
!    --  Indexes that do not have any matching parenthesis are set to
!    --  No_Match.
  
     No_Match : constant Match_Location := (First => 0, Last => 0);
!    --  The No_Match constant is (0, 0) to differentiate between
!    --  matching a null string at position 1, which uses (1, 0)
!    --  and no match at all.
  
     ---------------------------------
     -- Pattern_Matcher Compilation --
     ---------------------------------
  
!    --  The subprograms here are used to precompile regular expressions
!    --  for use in subsequent Match calls. Precompilation improves
!    --  efficiency if the same regular expression is to be used in
!    --  more than one Match call.
  
     type Pattern_Matcher (Size : Program_Size) is private;
     --  Type used to represent a regular expression compiled into byte code
--- 362,389 ----
     end record;
  
     type Match_Array is array (Match_Count range <>) of Match_Location;
!    --  The substring matching a given pair of parenthesis. Index 0 is the whole
!    --  substring that matched the full regular expression.
     --
!    --  For instance, if your regular expression is something like: "a(b*)(c+)",
!    --  then Match_Array(1) will be the indexes of the substring that matched
!    --  "b*" and Match_Array(2) will be the substring that matched "c+".
     --
!    --  The number of parenthesis groups that can be retrieved is unlimited, and
!    --  all the Match subprograms below can use a Match_Array of any size.
!    --  Indexes that do not have any matching parenthesis are set to No_Match.
  
     No_Match : constant Match_Location := (First => 0, Last => 0);
!    --  The No_Match constant is (0, 0) to differentiate between matching a null
!    --  string at position 1, which uses (1, 0) and no match at all.
  
     ---------------------------------
     -- Pattern_Matcher Compilation --
     ---------------------------------
  
!    --  The subprograms here are used to precompile regular expressions for use
!    --  in subsequent Match calls. Precompilation improves efficiency if the
!    --  same regular expression is to be used in more than one Match call.
  
     type Pattern_Matcher (Size : Program_Size) is private;
     --  Type used to represent a regular expression compiled into byte code
*************** pragma Preelaborate (Regpat);
*** 419,439 ****
        Flags           : Regexp_Flags := No_Flags);
     --  Compile a regular expression into into internal code
  
!    --  This procedure is significantly faster than the Compile function
!    --  since it avoids the extra step of precomputing the required size.
     --
     --  However, it requires the user to provide a Pattern_Matcher variable
     --  whose size is preset to a large enough value. One advantage of this
     --  approach, in addition to the improved efficiency, is that the same
     --  Pattern_Matcher variable can be used to hold the compiled code for
!    --  several different regular expressions by setting a size that is
!    --  large enough to accomodate all possibilities.
     --
!    --  In this version of the procedure call, the actual required code
!    --  size is returned. Also if Matcher.Size is zero on entry, then the
!    --  resulting code is not stored. A call with Matcher.Size set to Auto_Size
!    --  can thus be used to determine the space required for compiling the
!    --  given regular expression.
     --
     --  This function raises Storage_Error if Matcher is too small to hold
     --  the resulting code (i.e. Matcher.Size has too small a value).
--- 414,434 ----
        Flags           : Regexp_Flags := No_Flags);
     --  Compile a regular expression into into internal code
  
!    --  This procedure is significantly faster than the Compile function since
!    --  it avoids the extra step of precomputing the required size.
     --
     --  However, it requires the user to provide a Pattern_Matcher variable
     --  whose size is preset to a large enough value. One advantage of this
     --  approach, in addition to the improved efficiency, is that the same
     --  Pattern_Matcher variable can be used to hold the compiled code for
!    --  several different regular expressions by setting a size that is large
!    --  enough to accomodate all possibilities.
     --
!    --  In this version of the procedure call, the actual required code size is
!    --  returned. Also if Matcher.Size is zero on entry, then the resulting code
!    --  is not stored. A call with Matcher.Size set to Auto_Size can thus be
!    --  used to determine the space required for compiling the given regular
!    --  expression.
     --
     --  This function raises Storage_Error if Matcher is too small to hold
     --  the resulting code (i.e. Matcher.Size has too small a value).
*************** pragma Preelaborate (Regpat);
*** 448,455 ****
       (Matcher    : out Pattern_Matcher;
        Expression : String;
        Flags      : Regexp_Flags := No_Flags);
!    --  Same procedure as above, expect it does not return the final
!    --  program size, and Matcher.Size cannot be Auto_Size.
  
     function Paren_Count (Regexp : Pattern_Matcher) return Match_Count;
     pragma Inline (Paren_Count);
--- 443,450 ----
       (Matcher    : out Pattern_Matcher;
        Expression : String;
        Flags      : Regexp_Flags := No_Flags);
! --     --  Same procedure as above, expect it does not return the final
! --     --  program size, and Matcher.Size cannot be Auto_Size.
  
     function Paren_Count (Regexp : Pattern_Matcher) return Match_Count;
     pragma Inline (Paren_Count);
*************** pragma Preelaborate (Regpat);
*** 524,530 ****
     --    Expression_Error is raised if the given expression is not a legal
     --    regular expression.
  
- 
     procedure Match
       (Expression : String;
        Data       : String;
--- 519,524 ----
*************** pragma Preelaborate (Regpat);
*** 577,583 ****
        Data       : String;
        Data_First : Integer  := -1;
        Data_Last  : Positive := Positive'Last) return Boolean;
!    --  Return True if Data matches using the given pattern matcher.
  
     pragma Inline (Match);
     --  All except the last one below
--- 571,577 ----
        Data       : String;
        Data_First : Integer  := -1;
        Data_Last  : Positive := Positive'Last) return Boolean;
!    --  Return True if Data matches using the given pattern matcher
  
     pragma Inline (Match);
     --  All except the last one below
*************** pragma Preelaborate (Regpat);
*** 591,597 ****
     --  Match Data using the given pattern matcher and store result in Matches.
     --  The expression matches if Matches (0) /= No_Match.
     --
!    --  At most Matches'Length parenthesis are returned.
  
     -----------
     -- Debug --
--- 585,591 ----
     --  Match Data using the given pattern matcher and store result in Matches.
     --  The expression matches if Matches (0) /= No_Match.
     --
!    --  At most Matches'Length parenthesis are returned
  
     -----------
     -- Debug --
*************** private
*** 616,641 ****
  
     Program_First : constant := 1;
  
!    --  The "internal use only" fields in regexp are present to pass
!    --  info from compile to execute that permits the execute phase
!    --  to run lots faster on simple cases.  They are:
  
     --     First              character that must begin a match or ASCII.Nul
     --     Anchored           true iff match must start at beginning of line
     --     Must_Have          pointer to string that match must include or null
     --     Must_Have_Length   length of Must_Have string
  
!    --  First and Anchored permit very fast decisions on suitable
!    --  starting points for a match, cutting down the work a lot.
!    --  Must_Have permits fast rejection of lines that cannot possibly
!    --  match.
  
!    --  The Must_Have tests are costly enough that Optimize
!    --  supplies a Must_Have only if the r.e. contains something potentially
!    --  expensive (at present, the only such thing detected is * or +
!    --  at the start of the r.e., which can involve a lot of backup).
!    --  The length is supplied because the test in Execute needs it
!    --  and Optimize is computing it anyway.
  
     --  The initialization is meant to fail-safe in case the user of this
     --  package tries to use an uninitialized matcher. This takes advantage
--- 610,633 ----
  
     Program_First : constant := 1;
  
!    --  The "internal use only" fields in regexp are present to pass info from
!    --  compile to execute that permits the execute phase to run lots faster on
!    --  simple cases. They are:
  
     --     First              character that must begin a match or ASCII.Nul
     --     Anchored           true iff match must start at beginning of line
     --     Must_Have          pointer to string that match must include or null
     --     Must_Have_Length   length of Must_Have string
  
!    --  First and Anchored permit very fast decisions on suitable starting
!    --  points for a match, cutting down the work a lot. Must_Have permits fast
!    --  rejection of lines that cannot possibly match.
  
!    --  The Must_Have tests are costly enough that Optimize supplies a Must_Have
!    --  only if the r.e. contains something potentially expensive (at present,
!    --  the only such thing detected is * or at the start of the r.e., which can
!    --  involve a lot of backup). The length is supplied because the test in
!    --  Execute needs it and Optimize is computing it anyway.
  
     --  The initialization is meant to fail-safe in case the user of this
     --  package tries to use an uninitialized matcher. This takes advantage
diff -Nrcpad gcc-4.0.2/gcc/ada/g-semaph.adb gcc-4.1.0/gcc/ada/g-semaph.adb
*** gcc-4.0.2/gcc/ada/g-semaph.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-semaph.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-semaph.ads gcc-4.1.0/gcc/ada/g-semaph.ads
*** gcc-4.0.2/gcc/ada/g-semaph.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-semaph.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;
*** 40,46 ****
  package GNAT.Semaphores is
  
     Default_Ceiling : constant System.Priority := System.Default_Priority;
!    --  A convenient value for the priority discriminants that follow.
  
     ------------------------
     -- Counting_Semaphore --
--- 40,46 ----
  package GNAT.Semaphores is
  
     Default_Ceiling : constant System.Priority := System.Default_Priority;
!    --  A convenient value for the priority discriminants that follow
  
     ------------------------
     -- Counting_Semaphore --
*************** package GNAT.Semaphores is
*** 52,70 ****
        --  value of this counter is set by clients via the discriminant.
  
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object.
!       --  If the Real-Time Systems Annex is not in use this value
!       --  is not important.
     is
        pragma Priority (Ceiling);
  
        entry Seize;
!       --  Blocks caller until/unless the semaphore's internal counter
!       --  is greater than zero.
!       --  Decrements the semaphore's internal counter when executed.
  
        procedure Release;
!       --  Increments the semaphore's internal counter.
  
     private
        Count : Natural := Initial_Value;
--- 52,69 ----
        --  value of this counter is set by clients via the discriminant.
  
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object. If the
!       --  Real-Time Systems Annex is not in use this value is not important.
     is
        pragma Priority (Ceiling);
  
        entry Seize;
!       --  Blocks caller until/unless the semaphore's internal counter is
!       --  greater than zero. Decrements the semaphore's internal counter when
!       --  executed.
  
        procedure Release;
!       --  Increments the semaphore's internal counter
  
     private
        Count : Natural := Initial_Value;
*************** package GNAT.Semaphores is
*** 75,97 ****
     ----------------------
  
     protected type Binary_Semaphore
!       (Initially_Available : Boolean;
!       --  Binary semaphores are either available or not; there is no
!       --  internal count involved.  The discriminant value determines
!       --  whether the individual object is initially available.
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object.
!       --  If the Real-Time Systems Annex is not in use
!       --  this value is not important.
     is
        pragma Priority (Ceiling);
  
        entry Seize;
!       --  Blocks the caller unless/until semaphore is available.
!       --  After execution the semaphore is no longer available.
  
        procedure Release;
!       --  Makes the semaphore available.
  
     private
        Available : Boolean := Initially_Available;
--- 74,96 ----
     ----------------------
  
     protected type Binary_Semaphore
!      (Initially_Available : Boolean;
!       --  Binary semaphores are either available or not; there is no internal
!       --  count involved. The discriminant value determines whether the
!       --  individual object is initially available.
! 
        Ceiling : System.Priority)
!       --  Users must specify the ceiling priority for the object. If the
!       --  Real-Time Systems Annex is not in use this value is not important.
     is
        pragma Priority (Ceiling);
  
        entry Seize;
!       --  Blocks the caller unless/until semaphore is available. After
!       --  execution the semaphore is no longer available.
  
        procedure Release;
!       --  Makes the semaphore available
  
     private
        Available : Boolean := Initially_Available;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-sestin.ads gcc-4.1.0/gcc/ada/g-sestin.ads
*** gcc-4.0.2/gcc/ada/g-sestin.ads	Mon Jan  5 15:20:42 2004
--- gcc-4.1.0/gcc/ada/g-sestin.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --            G N A T . S E C O N D A R Y _ S T A C K _ I N F O             --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2004 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --            G N A T . S E C O N D A R Y _ S T A C K _ I N F O             --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                      Copyright (C) 2004-2005 AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-signal.adb gcc-4.1.0/gcc/ada/g-signal.adb
*** gcc-4.0.2/gcc/ada/g-signal.adb	Thu Oct 30 11:50:12 2003
--- gcc-4.1.0/gcc/ada/g-signal.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         G N A T . S I G N A L S                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         G N A T . S I G N A L S                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Signals is
*** 50,59 ****
     -- Is_Blocked --
     ----------------
  
!    function Is_Blocked
!      (Signal : Ada.Interrupts.Interrupt_ID)
!       return Boolean
!    is
     begin
        return SI.Is_Blocked (SI.Interrupt_ID (Signal));
     end Is_Blocked;
--- 50,56 ----
     -- Is_Blocked --
     ----------------
  
!    function Is_Blocked (Signal : Ada.Interrupts.Interrupt_ID) return Boolean is
     begin
        return SI.Is_Blocked (SI.Interrupt_ID (Signal));
     end Is_Blocked;
*************** package body GNAT.Signals is
*** 68,71 ****
     end Unblock_Signal;
  
  end GNAT.Signals;
- 
--- 65,67 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-signal.ads gcc-4.1.0/gcc/ada/g-signal.ads
*** gcc-4.0.2/gcc/ada/g-signal.ads	Thu Oct 30 11:50:12 2003
--- gcc-4.1.0/gcc/ada/g-signal.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         G N A T . S I G N A L S                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         G N A T . S I G N A L S                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Ada.Interrupts;
- 
  --  This package provides operations for querying and setting the blocked
  --  status of signals.
  
--- 31,36 ----
*************** with Ada.Interrupts;
*** 40,45 ****
--- 38,45 ----
  --  corresponds to software signals on the target, and where System.Interrupts
  --  provides the ability to block and unblock signals.
  
+ with Ada.Interrupts;
+ 
  package GNAT.Signals is
  
     procedure Block_Signal (Signal : Ada.Interrupts.Interrupt_ID);
*************** package GNAT.Signals is
*** 48,55 ****
     procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID);
     --  Unblock "Signal" at the process level
  
!    function Is_Blocked (Signal : Ada.Interrupts.Interrupt_ID)
!                        return Boolean;
     --  "Signal" blocked at the process level?
  
  end GNAT.Signals;
--- 48,54 ----
     procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID);
     --  Unblock "Signal" at the process level
  
!    function Is_Blocked (Signal : Ada.Interrupts.Interrupt_ID) return Boolean;
     --  "Signal" blocked at the process level?
  
  end GNAT.Signals;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-aix.ads gcc-4.1.0/gcc/ada/g-soccon-aix.ads
*** gcc-4.0.2/gcc/ada/g-soccon-aix.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-aix.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for AIX
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for powerpc-ibm-aix5.3.0.0
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           24; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=           67; --  Address already in use
!    EADDRNOTAVAIL      : constant :=           68; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=           66; --  Addr family not supported
!    EALREADY           : constant :=           56; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=           72; --  Connection aborted
!    ECONNREFUSED       : constant :=           79; --  Connection refused
!    ECONNRESET         : constant :=           73; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           58; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=           80; --  Host is down
!    EHOSTUNREACH       : constant :=           81; --  No route to host
!    EINPROGRESS        : constant :=           55; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=           75; --  Socket already connected
!    ELOOP              : constant :=           85; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           59; --  Message too long
!    ENAMETOOLONG       : constant :=           86; --  Name too long
!    ENETDOWN           : constant :=           69; --  Network is down
!    ENETRESET          : constant :=           71; --  Disconn. on network reset
!    ENETUNREACH        : constant :=           70; --  Network is unreachable
!    ENOBUFS            : constant :=           74; --  No buffer space available
!    ENOPROTOOPT        : constant :=           61; --  Protocol not available
!    ENOTCONN           : constant :=           76; --  Socket not connected
!    ENOTSOCK           : constant :=           57; --  Operation on non socket
!    EOPNOTSUPP         : constant :=           64; --  Operation not supported
!    EPFNOSUPPORT       : constant :=           65; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=           62; --  Unknown protocol
!    EPROTOTYPE         : constant :=           60; --  Unknown protocol type
!    ESHUTDOWN          : constant :=           77; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=           63; --  Socket type not supported
!    ETIMEDOUT          : constant :=           78; --  Connection timed out
!    ETOOMANYREFS       : constant :=          115; --  Too many references
!    EWOULDBLOCK        : constant :=           11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           13; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           11; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          24; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           1; --  Stream socket
!    SOCK_DGRAM         : constant :=           2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=          67; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          68; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          66; --  Addr family not supported
!    EALREADY           : constant :=          56; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          72; --  Connection aborted
!    ECONNREFUSED       : constant :=          79; --  Connection refused
!    ECONNRESET         : constant :=          73; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          58; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=          80; --  Host is down
!    EHOSTUNREACH       : constant :=          81; --  No route to host
!    EINPROGRESS        : constant :=          55; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=          75; --  Socket already connected
!    ELOOP              : constant :=          85; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=          59; --  Message too long
!    ENAMETOOLONG       : constant :=          86; --  Name too long
!    ENETDOWN           : constant :=          69; --  Network is down
!    ENETRESET          : constant :=          71; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          70; --  Network is unreachable
!    ENOBUFS            : constant :=          74; --  No buffer space available
!    ENOPROTOOPT        : constant :=          61; --  Protocol not available
!    ENOTCONN           : constant :=          76; --  Socket not connected
!    ENOTSOCK           : constant :=          57; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          64; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          65; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          62; --  Unknown protocol
!    EPROTOTYPE         : constant :=          60; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          77; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          63; --  Socket type not supported
!    ETIMEDOUT          : constant :=          78; --  Connection timed out
!    ETOOMANYREFS       : constant :=         115; --  Too many references
!    EWOULDBLOCK        : constant :=          11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=          16; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-darwin.ads gcc-4.1.0/gcc/ada/g-soccon-darwin.ads
*** gcc-4.0.2/gcc/ada/g-soccon-darwin.ads	Mon Jan  3 15:34:18 2005
--- gcc-4.1.0/gcc/ada/g-soccon-darwin.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Sockets.Constants is
*** 148,163 ****
     --------------------
  
     TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
-    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
-    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
     SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
     SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
     SO_LINGER          : constant :=         128; --  Defer close to flush data
-    SO_ERROR           : constant :=        4103; --  Get/clear error status
     SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
     IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
     IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 148,181 ----
     --------------------
  
     TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
     SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
     SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
     SO_LINGER          : constant :=         128; --  Defer close to flush data
     SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
     IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
     IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=  2147483647; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
+    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-freebsd.ads gcc-4.1.0/gcc/ada/g-soccon-freebsd.ads
*** gcc-4.0.2/gcc/ada/g-soccon-freebsd.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-freebsd.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for i386 FreeBSD
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for i386-unknown-freebsd5.2.1
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           28; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=           48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=           49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=           47; --  Addr family not supported
!    EALREADY           : constant :=           37; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=           53; --  Connection aborted
!    ECONNREFUSED       : constant :=           61; --  Connection refused
!    ECONNRESET         : constant :=           54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           39; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=           64; --  Host is down
!    EHOSTUNREACH       : constant :=           65; --  No route to host
!    EINPROGRESS        : constant :=           36; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=           56; --  Socket already connected
!    ELOOP              : constant :=           62; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           40; --  Message too long
!    ENAMETOOLONG       : constant :=           63; --  Name too long
!    ENETDOWN           : constant :=           50; --  Network is down
!    ENETRESET          : constant :=           52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=           51; --  Network is unreachable
!    ENOBUFS            : constant :=           55; --  No buffer space available
!    ENOPROTOOPT        : constant :=           42; --  Protocol not available
!    ENOTCONN           : constant :=           57; --  Socket not connected
!    ENOTSOCK           : constant :=           38; --  Operation on non socket
!    EOPNOTSUPP         : constant :=           45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=           46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=           43; --  Unknown protocol
!    EPROTOTYPE         : constant :=           41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=           58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=           44; --  Socket type not supported
!    ETIMEDOUT          : constant :=           60; --  Connection timed out
!    ETOOMANYREFS       : constant :=           59; --  Too many references
!    EWOULDBLOCK        : constant :=           35; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           13; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           11; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          28; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           1; --  Stream socket
!    SOCK_DGRAM         : constant :=           2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=          48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          47; --  Addr family not supported
!    EALREADY           : constant :=          37; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          53; --  Connection aborted
!    ECONNREFUSED       : constant :=          61; --  Connection refused
!    ECONNRESET         : constant :=          54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          39; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=          64; --  Host is down
!    EHOSTUNREACH       : constant :=          65; --  No route to host
!    EINPROGRESS        : constant :=          36; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=          56; --  Socket already connected
!    ELOOP              : constant :=          62; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=          40; --  Message too long
!    ENAMETOOLONG       : constant :=          63; --  Name too long
!    ENETDOWN           : constant :=          50; --  Network is down
!    ENETRESET          : constant :=          52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          51; --  Network is unreachable
!    ENOBUFS            : constant :=          55; --  No buffer space available
!    ENOPROTOOPT        : constant :=          42; --  Protocol not available
!    ENOTCONN           : constant :=          57; --  Socket not connected
!    ENOTSOCK           : constant :=          38; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          43; --  Unknown protocol
!    EPROTOTYPE         : constant :=          41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          44; --  Socket type not supported
!    ETIMEDOUT          : constant :=          60; --  Connection timed out
!    ETOOMANYREFS       : constant :=          59; --  Too many references
!    EWOULDBLOCK        : constant :=          35; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=        1024; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-hpux-ia64.ads gcc-4.1.0/gcc/ada/g-soccon-hpux-ia64.ads
*** gcc-4.0.2/gcc/ada/g-soccon-hpux-ia64.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-hpux-ia64.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for ia64-hp-hpux11.23
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=           2; --  IPv4 address family
+    AF_INET6           : constant :=          22; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=           1; --  Stream socket
+    SOCK_DGRAM         : constant :=           2; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=          13; --  Permission denied
+    EADDRINUSE         : constant :=         226; --  Address already in use
+    EADDRNOTAVAIL      : constant :=         227; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=         225; --  Addr family not supported
+    EALREADY           : constant :=         244; --  Operation in progress
+    EBADF              : constant :=           9; --  Bad file descriptor
+    ECONNABORTED       : constant :=         231; --  Connection aborted
+    ECONNREFUSED       : constant :=         239; --  Connection refused
+    ECONNRESET         : constant :=         232; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=         217; --  Destination addr required
+    EFAULT             : constant :=          14; --  Bad address
+    EHOSTDOWN          : constant :=         241; --  Host is down
+    EHOSTUNREACH       : constant :=         242; --  No route to host
+    EINPROGRESS        : constant :=         245; --  Operation now in progress
+    EINTR              : constant :=           4; --  Interrupted system call
+    EINVAL             : constant :=          22; --  Invalid argument
+    EIO                : constant :=           5; --  Input output error
+    EISCONN            : constant :=         234; --  Socket already connected
+    ELOOP              : constant :=         249; --  Too many symbolic lynks
+    EMFILE             : constant :=          24; --  Too many open files
+    EMSGSIZE           : constant :=         218; --  Message too long
+    ENAMETOOLONG       : constant :=         248; --  Name too long
+    ENETDOWN           : constant :=         228; --  Network is down
+    ENETRESET          : constant :=         230; --  Disconn. on network reset
+    ENETUNREACH        : constant :=         229; --  Network is unreachable
+    ENOBUFS            : constant :=         233; --  No buffer space available
+    ENOPROTOOPT        : constant :=         220; --  Protocol not available
+    ENOTCONN           : constant :=         235; --  Socket not connected
+    ENOTSOCK           : constant :=         216; --  Operation on non socket
+    EOPNOTSUPP         : constant :=         223; --  Operation not supported
+    EPFNOSUPPORT       : constant :=         224; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=         221; --  Unknown protocol
+    EPROTOTYPE         : constant :=         219; --  Unknown protocol type
+    ESHUTDOWN          : constant :=         236; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=         222; --  Socket type not supported
+    ETIMEDOUT          : constant :=         238; --  Connection timed out
+    ETOOMANYREFS       : constant :=         237; --  Too many references
+    EWOULDBLOCK        : constant :=         246; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
+    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
+    NO_DATA            : constant :=           4; --  No data record for name
+    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
+    FIONREAD           : constant :=  1074030207; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=           0; --  No more recv
+    SHUT_WR            : constant :=           1; --  No more send
+    SHUT_RDWR          : constant :=           2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=       65535; --  Options for socket level
+    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=          17; --  UDP
+    IPPROTO_TCP        : constant :=           6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=           1; --  Process out-of-band data
+    MSG_PEEK           : constant :=           2; --  Peek at incoming data
+    MSG_EOR            : constant :=           8; --  Send end of record
+    MSG_WAITALL        : constant :=          64; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant :=           0;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=         128; --  Defer close to flush data
+    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
+    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
+    SO_ERROR           : constant :=        4103; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=           2; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=           3; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=           4; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=           5; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=           6; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=          16; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=           8; --  tv_sec
+    SIZEOF_tv_usec     : constant :=           8; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-hpux.ads gcc-4.1.0/gcc/ada/g-soccon-hpux.ads
*** gcc-4.0.2/gcc/ada/g-soccon-hpux.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-hpux.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for HP/UX
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for hppa1.1-hp-hpux11.00
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           26; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=          226; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          227; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          225; --  Addr family not supported
!    EALREADY           : constant :=          244; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          231; --  Connection aborted
!    ECONNREFUSED       : constant :=          239; --  Connection refused
!    ECONNRESET         : constant :=          232; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          217; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=          241; --  Host is down
!    EHOSTUNREACH       : constant :=          242; --  No route to host
!    EINPROGRESS        : constant :=          245; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=          234; --  Socket already connected
!    ELOOP              : constant :=          249; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=          218; --  Message too long
!    ENAMETOOLONG       : constant :=          248; --  Name too long
!    ENETDOWN           : constant :=          228; --  Network is down
!    ENETRESET          : constant :=          230; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          229; --  Network is unreachable
!    ENOBUFS            : constant :=          233; --  No buffer space available
!    ENOPROTOOPT        : constant :=          220; --  Protocol not available
!    ENOTCONN           : constant :=          235; --  Socket not connected
!    ENOTSOCK           : constant :=          216; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          223; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          224; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          221; --  Unknown protocol
!    EPROTOTYPE         : constant :=          219; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          236; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          222; --  Socket type not supported
!    ETIMEDOUT          : constant :=          238; --  Connection timed out
!    ETOOMANYREFS       : constant :=          237; --  Too many references
!    EWOULDBLOCK        : constant :=          246; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=            5; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=            6; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=            3; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=            4; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          -1; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           1; --  Stream socket
!    SOCK_DGRAM         : constant :=           2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=         226; --  Address already in use
!    EADDRNOTAVAIL      : constant :=         227; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=         225; --  Addr family not supported
!    EALREADY           : constant :=         244; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=         231; --  Connection aborted
!    ECONNREFUSED       : constant :=         239; --  Connection refused
!    ECONNRESET         : constant :=         232; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=         217; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=         241; --  Host is down
!    EHOSTUNREACH       : constant :=         242; --  No route to host
!    EINPROGRESS        : constant :=         245; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=         234; --  Socket already connected
!    ELOOP              : constant :=         249; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=         218; --  Message too long
!    ENAMETOOLONG       : constant :=         248; --  Name too long
!    ENETDOWN           : constant :=         228; --  Network is down
!    ENETRESET          : constant :=         230; --  Disconn. on network reset
!    ENETUNREACH        : constant :=         229; --  Network is unreachable
!    ENOBUFS            : constant :=         233; --  No buffer space available
!    ENOPROTOOPT        : constant :=         220; --  Protocol not available
!    ENOTCONN           : constant :=         235; --  Socket not connected
!    ENOTSOCK           : constant :=         216; --  Operation on non socket
!    EOPNOTSUPP         : constant :=         223; --  Operation not supported
!    EPFNOSUPPORT       : constant :=         224; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=         221; --  Unknown protocol
!    EPROTOTYPE         : constant :=         219; --  Unknown protocol type
!    ESHUTDOWN          : constant :=         236; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=         222; --  Socket type not supported
!    ETIMEDOUT          : constant :=         238; --  Connection timed out
!    ETOOMANYREFS       : constant :=         237; --  Too many references
!    EWOULDBLOCK        : constant :=         246; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           2; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=           3; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           4; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=           5; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           6; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=          16; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-interix.ads gcc-4.1.0/gcc/ada/g-soccon-interix.ads
*** gcc-4.0.2/gcc/ada/g-soccon-interix.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-interix.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-irix.ads gcc-4.1.0/gcc/ada/g-soccon-irix.ads
*** gcc-4.0.2/gcc/ada/g-soccon-irix.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-irix.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for SGI
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for mips-sgi-irix6.5
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           24; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            2; --  Stream socket
!    SOCK_DGRAM         : constant :=            1; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=          125; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          126; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          124; --  Addr family not supported
!    EALREADY           : constant :=          149; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          130; --  Connection aborted
!    ECONNREFUSED       : constant :=          146; --  Connection refused
!    ECONNRESET         : constant :=          131; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           96; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=          147; --  Host is down
!    EHOSTUNREACH       : constant :=          148; --  No route to host
!    EINPROGRESS        : constant :=          150; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=          133; --  Socket already connected
!    ELOOP              : constant :=           90; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           97; --  Message too long
!    ENAMETOOLONG       : constant :=           78; --  Name too long
!    ENETDOWN           : constant :=          127; --  Network is down
!    ENETRESET          : constant :=          129; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          128; --  Network is unreachable
!    ENOBUFS            : constant :=          132; --  No buffer space available
!    ENOPROTOOPT        : constant :=           99; --  Protocol not available
!    ENOTCONN           : constant :=          134; --  Socket not connected
!    ENOTSOCK           : constant :=           95; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          122; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          123; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          120; --  Unknown protocol
!    EPROTOTYPE         : constant :=           98; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          143; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          121; --  Socket type not supported
!    ETIMEDOUT          : constant :=          145; --  Connection timed out
!    ETOOMANYREFS       : constant :=          144; --  Too many references
!    EWOULDBLOCK        : constant :=           11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           23; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           24; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           21; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           22; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          24; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           2; --  Stream socket
!    SOCK_DGRAM         : constant :=           1; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=         125; --  Address already in use
!    EADDRNOTAVAIL      : constant :=         126; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=         124; --  Addr family not supported
!    EALREADY           : constant :=         149; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=         130; --  Connection aborted
!    ECONNREFUSED       : constant :=         146; --  Connection refused
!    ECONNRESET         : constant :=         131; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          96; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=         147; --  Host is down
!    EHOSTUNREACH       : constant :=         148; --  No route to host
!    EINPROGRESS        : constant :=         150; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=         133; --  Socket already connected
!    ELOOP              : constant :=          90; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=          97; --  Message too long
!    ENAMETOOLONG       : constant :=          78; --  Name too long
!    ENETDOWN           : constant :=         127; --  Network is down
!    ENETRESET          : constant :=         129; --  Disconn. on network reset
!    ENETUNREACH        : constant :=         128; --  Network is unreachable
!    ENOBUFS            : constant :=         132; --  No buffer space available
!    ENOPROTOOPT        : constant :=          99; --  Protocol not available
!    ENOTCONN           : constant :=         134; --  Socket not connected
!    ENOTSOCK           : constant :=          95; --  Operation on non socket
!    EOPNOTSUPP         : constant :=         122; --  Operation not supported
!    EPFNOSUPPORT       : constant :=         123; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=         120; --  Unknown protocol
!    EPROTOTYPE         : constant :=          98; --  Unknown protocol type
!    ESHUTDOWN          : constant :=         143; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=         121; --  Socket type not supported
!    ETIMEDOUT          : constant :=         145; --  Connection timed out
!    ETOOMANYREFS       : constant :=         144; --  Too many references
!    EWOULDBLOCK        : constant :=          11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=          20; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          21; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          22; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          23; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          24; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=  2147483647; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-linux-64.ads gcc-4.1.0/gcc/ada/g-soccon-linux-64.ads
*** gcc-4.0.2/gcc/ada/g-soccon-linux-64.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-linux-64.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for ia64-hp-linux-gnu
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=            2; --  IPv4 address family
+    AF_INET6           : constant :=           10; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=            1; --  Stream socket
+    SOCK_DGRAM         : constant :=            2; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=           13; --  Permission denied
+    EADDRINUSE         : constant :=           98; --  Address already in use
+    EADDRNOTAVAIL      : constant :=           99; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=           97; --  Addr family not supported
+    EALREADY           : constant :=          114; --  Operation in progress
+    EBADF              : constant :=            9; --  Bad file descriptor
+    ECONNABORTED       : constant :=          103; --  Connection aborted
+    ECONNREFUSED       : constant :=          111; --  Connection refused
+    ECONNRESET         : constant :=          104; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=           89; --  Destination addr required
+    EFAULT             : constant :=           14; --  Bad address
+    EHOSTDOWN          : constant :=          112; --  Host is down
+    EHOSTUNREACH       : constant :=          113; --  No route to host
+    EINPROGRESS        : constant :=          115; --  Operation now in progress
+    EINTR              : constant :=            4; --  Interrupted system call
+    EINVAL             : constant :=           22; --  Invalid argument
+    EIO                : constant :=            5; --  Input output error
+    EISCONN            : constant :=          106; --  Socket already connected
+    ELOOP              : constant :=           40; --  Too many symbolic lynks
+    EMFILE             : constant :=           24; --  Too many open files
+    EMSGSIZE           : constant :=           90; --  Message too long
+    ENAMETOOLONG       : constant :=           36; --  Name too long
+    ENETDOWN           : constant :=          100; --  Network is down
+    ENETRESET          : constant :=          102; --  Disconn. on network reset
+    ENETUNREACH        : constant :=          101; --  Network is unreachable
+    ENOBUFS            : constant :=          105; --  No buffer space available
+    ENOPROTOOPT        : constant :=           92; --  Protocol not available
+    ENOTCONN           : constant :=          107; --  Socket not connected
+    ENOTSOCK           : constant :=           88; --  Operation on non socket
+    EOPNOTSUPP         : constant :=           95; --  Operation not supported
+    EPFNOSUPPORT       : constant :=           96; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=           93; --  Unknown protocol
+    EPROTOTYPE         : constant :=           91; --  Unknown protocol type
+    ESHUTDOWN          : constant :=          108; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=           94; --  Socket type not supported
+    ETIMEDOUT          : constant :=          110; --  Connection timed out
+    ETOOMANYREFS       : constant :=          109; --  Too many references
+    EWOULDBLOCK        : constant :=           11; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
+    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
+    NO_DATA            : constant :=            4; --  No data record for name
+    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant :=        21537; --  Set/clear non-blocking io
+    FIONREAD           : constant :=        21531; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=            0; --  No more recv
+    SHUT_WR            : constant :=            1; --  No more send
+    SHUT_RDWR          : constant :=            2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=            1; --  Options for socket level
+    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=           17; --  UDP
+    IPPROTO_TCP        : constant :=            6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=            1; --  Process out-of-band data
+    MSG_PEEK           : constant :=            2; --  Peek at incoming data
+    MSG_EOR            : constant :=          128; --  Send end of record
+    MSG_WAITALL        : constant :=          256; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=        16384; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant := MSG_NOSIGNAL;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=            2; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=            9; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=           13; --  Defer close to flush data
+    SO_BROADCAST       : constant :=            6; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=            7; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=            8; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=           21; --  Emission timeout
+    SO_RCVTIMEO        : constant :=           20; --  Reception timeout
+    SO_ERROR           : constant :=            4; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=           32; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=           33; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=           34; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=           35; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=           36; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=   2147483647; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=            8; --  tv_sec
+    SIZEOF_tv_usec     : constant :=            8; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-linux-ppc.ads gcc-4.1.0/gcc/ada/g-soccon-linux-ppc.ads
*** gcc-4.0.2/gcc/ada/g-soccon-linux-ppc.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-linux-ppc.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for powerpc-linux
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=            2; --  IPv4 address family
+    AF_INET6           : constant :=           10; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=            1; --  Stream socket
+    SOCK_DGRAM         : constant :=            2; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=           13; --  Permission denied
+    EADDRINUSE         : constant :=           98; --  Address already in use
+    EADDRNOTAVAIL      : constant :=           99; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=           97; --  Addr family not supported
+    EALREADY           : constant :=          114; --  Operation in progress
+    EBADF              : constant :=            9; --  Bad file descriptor
+    ECONNABORTED       : constant :=          103; --  Connection aborted
+    ECONNREFUSED       : constant :=          111; --  Connection refused
+    ECONNRESET         : constant :=          104; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=           89; --  Destination addr required
+    EFAULT             : constant :=           14; --  Bad address
+    EHOSTDOWN          : constant :=          112; --  Host is down
+    EHOSTUNREACH       : constant :=          113; --  No route to host
+    EINPROGRESS        : constant :=          115; --  Operation now in progress
+    EINTR              : constant :=            4; --  Interrupted system call
+    EINVAL             : constant :=           22; --  Invalid argument
+    EIO                : constant :=            5; --  Input output error
+    EISCONN            : constant :=          106; --  Socket already connected
+    ELOOP              : constant :=           40; --  Too many symbolic lynks
+    EMFILE             : constant :=           24; --  Too many open files
+    EMSGSIZE           : constant :=           90; --  Message too long
+    ENAMETOOLONG       : constant :=           36; --  Name too long
+    ENETDOWN           : constant :=          100; --  Network is down
+    ENETRESET          : constant :=          102; --  Disconn. on network reset
+    ENETUNREACH        : constant :=          101; --  Network is unreachable
+    ENOBUFS            : constant :=          105; --  No buffer space available
+    ENOPROTOOPT        : constant :=           92; --  Protocol not available
+    ENOTCONN           : constant :=          107; --  Socket not connected
+    ENOTSOCK           : constant :=           88; --  Operation on non socket
+    EOPNOTSUPP         : constant :=           95; --  Operation not supported
+    EPFNOSUPPORT       : constant :=           96; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=           93; --  Unknown protocol
+    EPROTOTYPE         : constant :=           91; --  Unknown protocol type
+    ESHUTDOWN          : constant :=          108; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=           94; --  Socket type not supported
+    ETIMEDOUT          : constant :=          110; --  Connection timed out
+    ETOOMANYREFS       : constant :=          109; --  Too many references
+    EWOULDBLOCK        : constant :=           11; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
+    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
+    NO_DATA            : constant :=            4; --  No data record for name
+    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
+    FIONREAD           : constant :=   1074030207; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=            0; --  No more recv
+    SHUT_WR            : constant :=            1; --  No more send
+    SHUT_RDWR          : constant :=            2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=            1; --  Options for socket level
+    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=           17; --  UDP
+    IPPROTO_TCP        : constant :=            6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=            1; --  Process out-of-band data
+    MSG_PEEK           : constant :=            2; --  Peek at incoming data
+    MSG_EOR            : constant :=          128; --  Send end of record
+    MSG_WAITALL        : constant :=          256; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=        16384; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant := MSG_NOSIGNAL;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=            2; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=            9; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=           13; --  Defer close to flush data
+    SO_BROADCAST       : constant :=            6; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=            7; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=            8; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=           19; --  Emission timeout
+    SO_RCVTIMEO        : constant :=           18; --  Reception timeout
+    SO_ERROR           : constant :=            4; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=           32; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=           33; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=           34; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=           35; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=           36; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=   2147483647; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=            4; --  tv_sec
+    SIZEOF_tv_usec     : constant :=            4; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-linux-x86.ads gcc-4.1.0/gcc/ada/g-soccon-linux-x86.ads
*** gcc-4.0.2/gcc/ada/g-soccon-linux-x86.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-linux-x86.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for i686-pc-linux-gnu
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=            2; --  IPv4 address family
+    AF_INET6           : constant :=           10; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=            1; --  Stream socket
+    SOCK_DGRAM         : constant :=            2; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=           13; --  Permission denied
+    EADDRINUSE         : constant :=           98; --  Address already in use
+    EADDRNOTAVAIL      : constant :=           99; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=           97; --  Addr family not supported
+    EALREADY           : constant :=          114; --  Operation in progress
+    EBADF              : constant :=            9; --  Bad file descriptor
+    ECONNABORTED       : constant :=          103; --  Connection aborted
+    ECONNREFUSED       : constant :=          111; --  Connection refused
+    ECONNRESET         : constant :=          104; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=           89; --  Destination addr required
+    EFAULT             : constant :=           14; --  Bad address
+    EHOSTDOWN          : constant :=          112; --  Host is down
+    EHOSTUNREACH       : constant :=          113; --  No route to host
+    EINPROGRESS        : constant :=          115; --  Operation now in progress
+    EINTR              : constant :=            4; --  Interrupted system call
+    EINVAL             : constant :=           22; --  Invalid argument
+    EIO                : constant :=            5; --  Input output error
+    EISCONN            : constant :=          106; --  Socket already connected
+    ELOOP              : constant :=           40; --  Too many symbolic lynks
+    EMFILE             : constant :=           24; --  Too many open files
+    EMSGSIZE           : constant :=           90; --  Message too long
+    ENAMETOOLONG       : constant :=           36; --  Name too long
+    ENETDOWN           : constant :=          100; --  Network is down
+    ENETRESET          : constant :=          102; --  Disconn. on network reset
+    ENETUNREACH        : constant :=          101; --  Network is unreachable
+    ENOBUFS            : constant :=          105; --  No buffer space available
+    ENOPROTOOPT        : constant :=           92; --  Protocol not available
+    ENOTCONN           : constant :=          107; --  Socket not connected
+    ENOTSOCK           : constant :=           88; --  Operation on non socket
+    EOPNOTSUPP         : constant :=           95; --  Operation not supported
+    EPFNOSUPPORT       : constant :=           96; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=           93; --  Unknown protocol
+    EPROTOTYPE         : constant :=           91; --  Unknown protocol type
+    ESHUTDOWN          : constant :=          108; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=           94; --  Socket type not supported
+    ETIMEDOUT          : constant :=          110; --  Connection timed out
+    ETOOMANYREFS       : constant :=          109; --  Too many references
+    EWOULDBLOCK        : constant :=           11; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
+    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
+    NO_DATA            : constant :=            4; --  No data record for name
+    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant :=        21537; --  Set/clear non-blocking io
+    FIONREAD           : constant :=        21531; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=            0; --  No more recv
+    SHUT_WR            : constant :=            1; --  No more send
+    SHUT_RDWR          : constant :=            2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=            1; --  Options for socket level
+    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=           17; --  UDP
+    IPPROTO_TCP        : constant :=            6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=            1; --  Process out-of-band data
+    MSG_PEEK           : constant :=            2; --  Peek at incoming data
+    MSG_EOR            : constant :=          128; --  Send end of record
+    MSG_WAITALL        : constant :=          256; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=        16384; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant := MSG_NOSIGNAL;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=            2; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=            9; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=           13; --  Defer close to flush data
+    SO_BROADCAST       : constant :=            6; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=            7; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=            8; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=           21; --  Emission timeout
+    SO_RCVTIMEO        : constant :=           20; --  Reception timeout
+    SO_ERROR           : constant :=            4; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=           32; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=           33; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=           34; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=           35; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=           36; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=   2147483647; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=            4; --  tv_sec
+    SIZEOF_tv_usec     : constant :=            4; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-mingw.ads gcc-4.1.0/gcc/ada/g-soccon-mingw.ads
*** gcc-4.0.2/gcc/ada/g-soccon-mingw.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-mingw.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for MINGW32 NT
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for pentium-mingw32msv
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=            3; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=        10013; --  Permission denied
!    EADDRINUSE         : constant :=        10048; --  Address already in use
!    EADDRNOTAVAIL      : constant :=        10049; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=        10047; --  Addr family not supported
!    EALREADY           : constant :=        10037; --  Operation in progress
!    EBADF              : constant :=        10009; --  Bad file descriptor
!    ECONNABORTED       : constant :=        10053; --  Connection aborted
!    ECONNREFUSED       : constant :=        10061; --  Connection refused
!    ECONNRESET         : constant :=        10054; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=        10039; --  Destination addr required
!    EFAULT             : constant :=        10014; --  Bad address
!    EHOSTDOWN          : constant :=        10064; --  Host is down
!    EHOSTUNREACH       : constant :=        10065; --  No route to host
!    EINPROGRESS        : constant :=        10036; --  Operation now in progress
!    EINTR              : constant :=        10004; --  Interrupted system call
!    EINVAL             : constant :=        10022; --  Invalid argument
!    EIO                : constant :=        10101; --  Input output error
!    EISCONN            : constant :=        10056; --  Socket already connected
!    ELOOP              : constant :=        10062; --  Too many symbolic lynks
!    EMFILE             : constant :=        10024; --  Too many open files
!    EMSGSIZE           : constant :=        10040; --  Message too long
!    ENAMETOOLONG       : constant :=        10063; --  Name too long
!    ENETDOWN           : constant :=        10050; --  Network is down
!    ENETRESET          : constant :=        10052; --  Disconn. on network reset
!    ENETUNREACH        : constant :=        10051; --  Network is unreachable
!    ENOBUFS            : constant :=        10055; --  No buffer space available
!    ENOPROTOOPT        : constant :=        10042; --  Protocol not available
!    ENOTCONN           : constant :=        10057; --  Socket not connected
!    ENOTSOCK           : constant :=        10038; --  Operation on non socket
!    EOPNOTSUPP         : constant :=        10045; --  Operation not supported
!    EPFNOSUPPORT       : constant :=        10046; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=        10043; --  Unknown protocol
!    EPROTOTYPE         : constant :=        10041; --  Unknown protocol type
!    ESHUTDOWN          : constant :=        10058; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=        10044; --  Socket type not supported
!    ETIMEDOUT          : constant :=        10060; --  Connection timed out
!    ETOOMANYREFS       : constant :=        10059; --  Too many references
!    EWOULDBLOCK        : constant :=        10035; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=        11001; --  Unknown host
!    TRY_AGAIN          : constant :=        11002; --  Host name lookup failure
!    NO_DATA            : constant :=        11004; --  No data record for name
!    NO_RECOVERY        : constant :=        11003; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=           -1; --  Send end of record
!    MSG_WAITALL        : constant :=           -1; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=            5; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=            6; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=            3; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=            4; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          23; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           1; --  Stream socket
!    SOCK_DGRAM         : constant :=           2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=       10013; --  Permission denied
!    EADDRINUSE         : constant :=       10048; --  Address already in use
!    EADDRNOTAVAIL      : constant :=       10049; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=       10047; --  Addr family not supported
!    EALREADY           : constant :=       10037; --  Operation in progress
!    EBADF              : constant :=       10009; --  Bad file descriptor
!    ECONNABORTED       : constant :=       10053; --  Connection aborted
!    ECONNREFUSED       : constant :=       10061; --  Connection refused
!    ECONNRESET         : constant :=       10054; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=       10039; --  Destination addr required
!    EFAULT             : constant :=       10014; --  Bad address
!    EHOSTDOWN          : constant :=       10064; --  Host is down
!    EHOSTUNREACH       : constant :=       10065; --  No route to host
!    EINPROGRESS        : constant :=       10036; --  Operation now in progress
!    EINTR              : constant :=       10004; --  Interrupted system call
!    EINVAL             : constant :=       10022; --  Invalid argument
!    EIO                : constant :=       10101; --  Input output error
!    EISCONN            : constant :=       10056; --  Socket already connected
!    ELOOP              : constant :=       10062; --  Too many symbolic lynks
!    EMFILE             : constant :=       10024; --  Too many open files
!    EMSGSIZE           : constant :=       10040; --  Message too long
!    ENAMETOOLONG       : constant :=       10063; --  Name too long
!    ENETDOWN           : constant :=       10050; --  Network is down
!    ENETRESET          : constant :=       10052; --  Disconn. on network reset
!    ENETUNREACH        : constant :=       10051; --  Network is unreachable
!    ENOBUFS            : constant :=       10055; --  No buffer space available
!    ENOPROTOOPT        : constant :=       10042; --  Protocol not available
!    ENOTCONN           : constant :=       10057; --  Socket not connected
!    ENOTSOCK           : constant :=       10038; --  Operation on non socket
!    EOPNOTSUPP         : constant :=       10045; --  Operation not supported
!    EPFNOSUPPORT       : constant :=       10046; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=       10043; --  Unknown protocol
!    EPROTOTYPE         : constant :=       10041; --  Unknown protocol type
!    ESHUTDOWN          : constant :=       10058; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=       10044; --  Socket type not supported
!    ETIMEDOUT          : constant :=       10060; --  Connection timed out
!    ETOOMANYREFS       : constant :=       10059; --  Too many references
!    EWOULDBLOCK        : constant :=       10035; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=       11001; --  Unknown host
!    TRY_AGAIN          : constant :=       11002; --  Host name lookup failure
!    NO_DATA            : constant :=       11004; --  No data record for name
!    NO_RECOVERY        : constant :=       11003; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=          -1; --  Send end of record
!    MSG_WAITALL        : constant :=          -1; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=  2147483647; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-solaris-64.ads gcc-4.1.0/gcc/ada/g-soccon-solaris-64.ads
*** gcc-4.0.2/gcc/ada/g-soccon-solaris-64.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-solaris-64.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for sparc-sun-solaris2.8/64
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=           2; --  IPv4 address family
+    AF_INET6           : constant :=          26; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=           2; --  Stream socket
+    SOCK_DGRAM         : constant :=           1; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=          13; --  Permission denied
+    EADDRINUSE         : constant :=         125; --  Address already in use
+    EADDRNOTAVAIL      : constant :=         126; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=         124; --  Addr family not supported
+    EALREADY           : constant :=         149; --  Operation in progress
+    EBADF              : constant :=           9; --  Bad file descriptor
+    ECONNABORTED       : constant :=         130; --  Connection aborted
+    ECONNREFUSED       : constant :=         146; --  Connection refused
+    ECONNRESET         : constant :=         131; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=          96; --  Destination addr required
+    EFAULT             : constant :=          14; --  Bad address
+    EHOSTDOWN          : constant :=         147; --  Host is down
+    EHOSTUNREACH       : constant :=         148; --  No route to host
+    EINPROGRESS        : constant :=         150; --  Operation now in progress
+    EINTR              : constant :=           4; --  Interrupted system call
+    EINVAL             : constant :=          22; --  Invalid argument
+    EIO                : constant :=           5; --  Input output error
+    EISCONN            : constant :=         133; --  Socket already connected
+    ELOOP              : constant :=          90; --  Too many symbolic lynks
+    EMFILE             : constant :=          24; --  Too many open files
+    EMSGSIZE           : constant :=          97; --  Message too long
+    ENAMETOOLONG       : constant :=          78; --  Name too long
+    ENETDOWN           : constant :=         127; --  Network is down
+    ENETRESET          : constant :=         129; --  Disconn. on network reset
+    ENETUNREACH        : constant :=         128; --  Network is unreachable
+    ENOBUFS            : constant :=         132; --  No buffer space available
+    ENOPROTOOPT        : constant :=          99; --  Protocol not available
+    ENOTCONN           : constant :=         134; --  Socket not connected
+    ENOTSOCK           : constant :=          95; --  Operation on non socket
+    EOPNOTSUPP         : constant :=         122; --  Operation not supported
+    EPFNOSUPPORT       : constant :=         123; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=         120; --  Unknown protocol
+    EPROTOTYPE         : constant :=          98; --  Unknown protocol type
+    ESHUTDOWN          : constant :=         143; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=         121; --  Socket type not supported
+    ETIMEDOUT          : constant :=         145; --  Connection timed out
+    ETOOMANYREFS       : constant :=         144; --  Too many references
+    EWOULDBLOCK        : constant :=          11; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
+    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
+    NO_DATA            : constant :=           4; --  No data record for name
+    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
+    FIONREAD           : constant :=  1074030207; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=           0; --  No more recv
+    SHUT_WR            : constant :=           1; --  No more send
+    SHUT_RDWR          : constant :=           2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=       65535; --  Options for socket level
+    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=          17; --  UDP
+    IPPROTO_TCP        : constant :=           6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=           1; --  Process out-of-band data
+    MSG_PEEK           : constant :=           2; --  Peek at incoming data
+    MSG_EOR            : constant :=           8; --  Send end of record
+    MSG_WAITALL        : constant :=          64; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant :=           0;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=         128; --  Defer close to flush data
+    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
+    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
+    SO_ERROR           : constant :=        4103; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=          16; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=          17; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=          18; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=          19; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=          20; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=          16; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=           8; --  tv_sec
+    SIZEOF_tv_usec     : constant :=           8; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-solaris.ads gcc-4.1.0/gcc/ada/g-soccon-solaris.ads
*** gcc-4.0.2/gcc/ada/g-soccon-solaris.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-solaris.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for Solaris
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for sparc-sun-solaris2.8
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           26; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            2; --  Stream socket
!    SOCK_DGRAM         : constant :=            1; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=          125; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          126; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          124; --  Addr family not supported
!    EALREADY           : constant :=          149; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          130; --  Connection aborted
!    ECONNREFUSED       : constant :=          146; --  Connection refused
!    ECONNRESET         : constant :=          131; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           96; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=          147; --  Host is down
!    EHOSTUNREACH       : constant :=          148; --  No route to host
!    EINPROGRESS        : constant :=          150; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=          133; --  Socket already connected
!    ELOOP              : constant :=           90; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           97; --  Message too long
!    ENAMETOOLONG       : constant :=           78; --  Name too long
!    ENETDOWN           : constant :=          127; --  Network is down
!    ENETRESET          : constant :=          129; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          128; --  Network is unreachable
!    ENOBUFS            : constant :=          132; --  No buffer space available
!    ENOPROTOOPT        : constant :=           99; --  Protocol not available
!    ENOTCONN           : constant :=          134; --  Socket not connected
!    ENOTSOCK           : constant :=           95; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          122; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          123; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          120; --  Unknown protocol
!    EPROTOTYPE         : constant :=           98; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          143; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          121; --  Socket type not supported
!    ETIMEDOUT          : constant :=          145; --  Connection timed out
!    ETOOMANYREFS       : constant :=          144; --  Too many references
!    EWOULDBLOCK        : constant :=           11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           19; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           20; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           17; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           18; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          26; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           2; --  Stream socket
!    SOCK_DGRAM         : constant :=           1; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=         125; --  Address already in use
!    EADDRNOTAVAIL      : constant :=         126; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=         124; --  Addr family not supported
!    EALREADY           : constant :=         149; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=         130; --  Connection aborted
!    ECONNREFUSED       : constant :=         146; --  Connection refused
!    ECONNRESET         : constant :=         131; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          96; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=         147; --  Host is down
!    EHOSTUNREACH       : constant :=         148; --  No route to host
!    EINPROGRESS        : constant :=         150; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=         133; --  Socket already connected
!    ELOOP              : constant :=          90; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=          97; --  Message too long
!    ENAMETOOLONG       : constant :=          78; --  Name too long
!    ENETDOWN           : constant :=         127; --  Network is down
!    ENETRESET          : constant :=         129; --  Disconn. on network reset
!    ENETUNREACH        : constant :=         128; --  Network is unreachable
!    ENOBUFS            : constant :=         132; --  No buffer space available
!    ENOPROTOOPT        : constant :=          99; --  Protocol not available
!    ENOTCONN           : constant :=         134; --  Socket not connected
!    ENOTSOCK           : constant :=          95; --  Operation on non socket
!    EOPNOTSUPP         : constant :=         122; --  Operation not supported
!    EPFNOSUPPORT       : constant :=         123; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=         120; --  Unknown protocol
!    EPROTOTYPE         : constant :=          98; --  Unknown protocol type
!    ESHUTDOWN          : constant :=         143; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=         121; --  Socket type not supported
!    ETIMEDOUT          : constant :=         145; --  Connection timed out
!    ETOOMANYREFS       : constant :=         144; --  Too many references
!    EWOULDBLOCK        : constant :=          11; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=          16; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          17; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          18; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          19; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          20; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=          16; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-tru64.ads gcc-4.1.0/gcc/ada/g-soccon-tru64.ads
*** gcc-4.0.2/gcc/ada/g-soccon-tru64.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-tru64.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for OSF
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for alphaev56-dec-osf5.1
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           26; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=           48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=           49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=           47; --  Addr family not supported
!    EALREADY           : constant :=           37; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=           53; --  Connection aborted
!    ECONNREFUSED       : constant :=           61; --  Connection refused
!    ECONNRESET         : constant :=           54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           39; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=           64; --  Host is down
!    EHOSTUNREACH       : constant :=           65; --  No route to host
!    EINPROGRESS        : constant :=           36; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=           56; --  Socket already connected
!    ELOOP              : constant :=           62; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           40; --  Message too long
!    ENAMETOOLONG       : constant :=           63; --  Name too long
!    ENETDOWN           : constant :=           50; --  Network is down
!    ENETRESET          : constant :=           52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=           51; --  Network is unreachable
!    ENOBUFS            : constant :=           55; --  No buffer space available
!    ENOPROTOOPT        : constant :=           42; --  Protocol not available
!    ENOTCONN           : constant :=           57; --  Socket not connected
!    ENOTSOCK           : constant :=           38; --  Operation on non socket
!    EOPNOTSUPP         : constant :=           45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=           46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=           43; --  Unknown protocol
!    EPROTOTYPE         : constant :=           41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=           58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=           44; --  Socket type not supported
!    ETIMEDOUT          : constant :=           60; --  Connection timed out
!    ETOOMANYREFS       : constant :=           59; --  Too many references
!    EWOULDBLOCK        : constant :=           35; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=   1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           13; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           11; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,181 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=           2; --  IPv4 address family
!    AF_INET6           : constant :=          26; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=           1; --  Stream socket
!    SOCK_DGRAM         : constant :=           2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=          13; --  Permission denied
!    EADDRINUSE         : constant :=          48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=          49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=          47; --  Addr family not supported
!    EALREADY           : constant :=          37; --  Operation in progress
!    EBADF              : constant :=           9; --  Bad file descriptor
!    ECONNABORTED       : constant :=          53; --  Connection aborted
!    ECONNREFUSED       : constant :=          61; --  Connection refused
!    ECONNRESET         : constant :=          54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=          39; --  Destination addr required
!    EFAULT             : constant :=          14; --  Bad address
!    EHOSTDOWN          : constant :=          64; --  Host is down
!    EHOSTUNREACH       : constant :=          65; --  No route to host
!    EINPROGRESS        : constant :=          36; --  Operation now in progress
!    EINTR              : constant :=           4; --  Interrupted system call
!    EINVAL             : constant :=          22; --  Invalid argument
!    EIO                : constant :=           5; --  Input output error
!    EISCONN            : constant :=          56; --  Socket already connected
!    ELOOP              : constant :=          62; --  Too many symbolic lynks
!    EMFILE             : constant :=          24; --  Too many open files
!    EMSGSIZE           : constant :=          40; --  Message too long
!    ENAMETOOLONG       : constant :=          63; --  Name too long
!    ENETDOWN           : constant :=          50; --  Network is down
!    ENETRESET          : constant :=          52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=          51; --  Network is unreachable
!    ENOBUFS            : constant :=          55; --  No buffer space available
!    ENOPROTOOPT        : constant :=          42; --  Protocol not available
!    ENOTCONN           : constant :=          57; --  Socket not connected
!    ENOTSOCK           : constant :=          38; --  Operation on non socket
!    EOPNOTSUPP         : constant :=          45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=          46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=          43; --  Unknown protocol
!    EPROTOTYPE         : constant :=          41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=          58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=          44; --  Socket type not supported
!    ETIMEDOUT          : constant :=          60; --  Connection timed out
!    ETOOMANYREFS       : constant :=          59; --  Too many references
!    EWOULDBLOCK        : constant :=          35; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
!    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
!    NO_DATA            : constant :=           4; --  No data record for name
!    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
!    FIONREAD           : constant :=  1074030207; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=           0; --  No more recv
!    SHUT_WR            : constant :=           1; --  No more send
!    SHUT_RDWR          : constant :=           2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=       65535; --  Options for socket level
!    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=          17; --  UDP
!    IPPROTO_TCP        : constant :=           6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=           1; --  Process out-of-band data
!    MSG_PEEK           : constant :=           2; --  Peek at incoming data
!    MSG_EOR            : constant :=           8; --  Send end of record
!    MSG_WAITALL        : constant :=          64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=           0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=         128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
!    SO_ERROR           : constant :=        4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant :=        1024; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-unixware.ads gcc-4.1.0/gcc/ada/g-soccon-unixware.ads
*** gcc-4.0.2/gcc/ada/g-soccon-unixware.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-unixware.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-vms.adb gcc-4.1.0/gcc/ada/g-soccon-vms.adb
*** gcc-4.0.2/gcc/ada/g-soccon-vms.adb	Mon Oct  4 14:49:35 2004
--- gcc-4.1.0/gcc/ada/g-soccon-vms.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,160 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT COMPILER COMPONENTS                         --
- --                                                                          --
- --               G N A T . S O C K E T S . C O N S T A N T S                --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- --          Copyright (C) 2000-2004 Free Software Foundation, Inc.          --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This package provides target dependent definitions of constant for use
- --  by the GNAT.Sockets package (g-socket.ads). This package should not be
- --  directly with'ed by an applications program.
- 
- --  This is the version for Alpha/VMS
- 
- package GNAT.Sockets.Constants is
- 
-    --------------
-    -- Families --
-    --------------
- 
-    AF_INET            : constant :=            2; --  IPv4 address family
-    AF_INET6           : constant :=           26; --  IPv6 address family
- 
-    -----------
-    -- Modes --
-    -----------
- 
-    SOCK_STREAM        : constant :=            1; --  Stream socket
-    SOCK_DGRAM         : constant :=            2; --  Datagram socket
- 
-    -------------------
-    -- Socket errors --
-    -------------------
- 
-    EACCES             : constant :=           13; --  Permission denied
-    EADDRINUSE         : constant :=           48; --  Address already in use
-    EADDRNOTAVAIL      : constant :=           49; --  Cannot assign address
-    EAFNOSUPPORT       : constant :=           47; --  Addr family not supported
-    EALREADY           : constant :=           37; --  Operation in progress
-    EBADF              : constant :=            9; --  Bad file descriptor
-    ECONNABORTED       : constant :=           53; --  Connection aborted
-    ECONNREFUSED       : constant :=           61; --  Connection refused
-    ECONNRESET         : constant :=           54; --  Connection reset by peer
-    EDESTADDRREQ       : constant :=           39; --  Destination addr required
-    EFAULT             : constant :=           45; --  Bad address
-    EHOSTDOWN          : constant :=           64; --  Host is down
-    EHOSTUNREACH       : constant :=           65; --  No route to host
-    EINPROGRESS        : constant :=           36; --  Operation now in progress
-    EINTR              : constant :=            4; --  Interrupted system call
-    EINVAL             : constant :=           22; --  Invalid argument
-    EIO                : constant :=            5; --  Input output error
-    EISCONN            : constant :=           56; --  Socket already connected
-    ELOOP              : constant :=           62; --  Too many symbolic lynks
-    EMFILE             : constant :=           24; --  Too many open files
-    EMSGSIZE           : constant :=           40; --  Message too long
-    ENAMETOOLONG       : constant :=           63; --  Name too long
-    ENETDOWN           : constant :=           50; --  Network is down
-    ENETRESET          : constant :=           52; --  Disconn. on network reset
-    ENETUNREACH        : constant :=           51; --  Network is unreachable
-    ENOBUFS            : constant :=           55; --  No buffer space available
-    ENOPROTOOPT        : constant :=           42; --  Protocol not available
-    ENOTCONN           : constant :=           57; --  Socket not connected
-    ENOTSOCK           : constant :=           38; --  Operation on non socket
-    EOPNOTSUPP         : constant :=           95; --  Operation not supported
-    EPFNOSUPPORT       : constant :=           46; --  Unknown protocol family
-    EPROTONOSUPPORT    : constant :=           43; --  Unknown protocol
-    EPROTOTYPE         : constant :=           41; --  Unknown protocol type
-    ESHUTDOWN          : constant :=           58; --  Cannot send once shutdown
-    ESOCKTNOSUPPORT    : constant :=           44; --  Socket type not supported
-    ETIMEDOUT          : constant :=           60; --  Connection timed out
-    ETOOMANYREFS       : constant :=           59; --  Too many references
-    EWOULDBLOCK        : constant :=           35; --  Operation would block
- 
-    -----------------
-    -- Host errors --
-    -----------------
- 
-    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
-    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
-    NO_DATA            : constant :=            4; --  No data record for name
-    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
- 
-    -------------------
-    -- Control flags --
-    -------------------
- 
-    FIONBIO            : constant :=  -2147195266; --  Set/clear non-blocking io
-    FIONREAD           : constant :=   1074030207; --  How many bytes to read
- 
-    --------------------
-    -- Shutdown modes --
-    --------------------
- 
-    SHUT_RD            : constant :=            0; --  No more recv
-    SHUT_WR            : constant :=            1; --  No more send
-    SHUT_RDWR          : constant :=            2; --  No more recv/send
- 
-    ---------------------
-    -- Protocol levels --
-    ---------------------
- 
-    SOL_SOCKET         : constant :=     16#FFFF#; --  Options for socket level
-    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
-    IPPROTO_UDP        : constant :=           17; --  UDP
-    IPPROTO_TCP        : constant :=            6; --  TCP
- 
-    -------------------
-    -- Request flags --
-    -------------------
- 
-    MSG_OOB            : constant :=            1; --  Process out-of-band data
-    MSG_PEEK           : constant :=            2; --  Peek at incoming data
-    MSG_EOR            : constant :=            8; --  Send end of record
-    MSG_WAITALL        : constant :=           64; --  Wait for full reception
-    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
-    MSG_Forced_Flags   : constant :=            0;
- 
-    --------------------
-    -- Socket options --
-    --------------------
- 
-    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
-    SO_SNDBUF          : constant :=     16#1001#; --  Set/get send buffer size
-    SO_RCVBUF          : constant :=     16#1002#; --  Set/get recv buffer size
-    SO_REUSEADDR       : constant :=     16#0004#; --  Bind reuse local address
-    SO_KEEPALIVE       : constant :=     16#0008#; --  Enable keep-alive msgs
-    SO_LINGER          : constant :=     16#0080#; --  Defer close to flush data
-    SO_ERROR           : constant :=     16#1007#; --  Get/clear error status
-    SO_BROADCAST       : constant :=     16#0020#; --  Can send broadcast msgs
-    IP_ADD_MEMBERSHIP  : constant :=           12; --  Join a multicast group
-    IP_DROP_MEMBERSHIP : constant :=           13; --  Leave a multicast group
-    IP_MULTICAST_TTL   : constant :=           10; --  Set/get multicast TTL
-    IP_MULTICAST_LOOP  : constant :=           11; --  Set/get mcast loopback
- 
- end GNAT.Sockets.Constants;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-vms.ads gcc-4.1.0/gcc/ada/g-soccon-vms.ads
*** gcc-4.0.2/gcc/ada/g-soccon-vms.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-soccon-vms.ads	Tue Nov 15 13:50:37 2005
***************
*** 0 ****
--- 1,181 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               G N A T . S O C K E T S . C O N S T A N T S                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides target dependent definitions of constant for use
+ --  by the GNAT.Sockets package (g-socket.ads). This package should not be
+ --  directly with'ed by an applications program.
+ 
+ --  This is the version for OpenVMS
+ --  This file is generated automatically, do not modify it by hand! Instead,
+ --  make changes to gen-soccon.c and re-run it on each target.
+ 
+ package GNAT.Sockets.Constants is
+ 
+    --------------
+    -- Families --
+    --------------
+ 
+    AF_INET            : constant :=           2; --  IPv4 address family
+    AF_INET6           : constant :=          26; --  IPv6 address family
+ 
+    -----------
+    -- Modes --
+    -----------
+ 
+    SOCK_STREAM        : constant :=           1; --  Stream socket
+    SOCK_DGRAM         : constant :=           2; --  Datagram socket
+ 
+    -------------------
+    -- Socket errors --
+    -------------------
+ 
+    EACCES             : constant :=          13; --  Permission denied
+    EADDRINUSE         : constant :=          48; --  Address already in use
+    EADDRNOTAVAIL      : constant :=          49; --  Cannot assign address
+    EAFNOSUPPORT       : constant :=          47; --  Addr family not supported
+    EALREADY           : constant :=          37; --  Operation in progress
+    EBADF              : constant :=           9; --  Bad file descriptor
+    ECONNABORTED       : constant :=          53; --  Connection aborted
+    ECONNREFUSED       : constant :=          61; --  Connection refused
+    ECONNRESET         : constant :=          54; --  Connection reset by peer
+    EDESTADDRREQ       : constant :=          39; --  Destination addr required
+    EFAULT             : constant :=          14; --  Bad address
+    EHOSTDOWN          : constant :=          64; --  Host is down
+    EHOSTUNREACH       : constant :=          65; --  No route to host
+    EINPROGRESS        : constant :=          36; --  Operation now in progress
+    EINTR              : constant :=           4; --  Interrupted system call
+    EINVAL             : constant :=          22; --  Invalid argument
+    EIO                : constant :=           5; --  Input output error
+    EISCONN            : constant :=          56; --  Socket already connected
+    ELOOP              : constant :=          62; --  Too many symbolic lynks
+    EMFILE             : constant :=          24; --  Too many open files
+    EMSGSIZE           : constant :=          40; --  Message too long
+    ENAMETOOLONG       : constant :=          63; --  Name too long
+    ENETDOWN           : constant :=          50; --  Network is down
+    ENETRESET          : constant :=          52; --  Disconn. on network reset
+    ENETUNREACH        : constant :=          51; --  Network is unreachable
+    ENOBUFS            : constant :=          55; --  No buffer space available
+    ENOPROTOOPT        : constant :=          42; --  Protocol not available
+    ENOTCONN           : constant :=          57; --  Socket not connected
+    ENOTSOCK           : constant :=          38; --  Operation on non socket
+    EOPNOTSUPP         : constant :=          45; --  Operation not supported
+    EPFNOSUPPORT       : constant :=          46; --  Unknown protocol family
+    EPROTONOSUPPORT    : constant :=          43; --  Unknown protocol
+    EPROTOTYPE         : constant :=          41; --  Unknown protocol type
+    ESHUTDOWN          : constant :=          58; --  Cannot send once shutdown
+    ESOCKTNOSUPPORT    : constant :=          44; --  Socket type not supported
+    ETIMEDOUT          : constant :=          60; --  Connection timed out
+    ETOOMANYREFS       : constant :=          59; --  Too many references
+    EWOULDBLOCK        : constant :=          35; --  Operation would block
+ 
+    -----------------
+    -- Host errors --
+    -----------------
+ 
+    HOST_NOT_FOUND     : constant :=           1; --  Unknown host
+    TRY_AGAIN          : constant :=           2; --  Host name lookup failure
+    NO_DATA            : constant :=           4; --  No data record for name
+    NO_RECOVERY        : constant :=           3; --  Non recoverable errors
+ 
+    -------------------
+    -- Control flags --
+    -------------------
+ 
+    FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
+    FIONREAD           : constant :=  1074030207; --  How many bytes to read
+ 
+    --------------------
+    -- Shutdown modes --
+    --------------------
+ 
+    SHUT_RD            : constant :=           0; --  No more recv
+    SHUT_WR            : constant :=           1; --  No more send
+    SHUT_RDWR          : constant :=           2; --  No more recv/send
+ 
+    ---------------------
+    -- Protocol levels --
+    ---------------------
+ 
+    SOL_SOCKET         : constant :=       65535; --  Options for socket level
+    IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
+    IPPROTO_UDP        : constant :=          17; --  UDP
+    IPPROTO_TCP        : constant :=           6; --  TCP
+ 
+    -------------------
+    -- Request flags --
+    -------------------
+ 
+    MSG_OOB            : constant :=           1; --  Process out-of-band data
+    MSG_PEEK           : constant :=           2; --  Peek at incoming data
+    MSG_EOR            : constant :=           8; --  Send end of record
+    MSG_WAITALL        : constant :=          64; --  Wait for full reception
+    MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
+    MSG_Forced_Flags   : constant :=           0;
+    --  Flags set on all send(2) calls
+ 
+    --------------------
+    -- Socket options --
+    --------------------
+ 
+    TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
+    SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
+    SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
+    SO_LINGER          : constant :=         128; --  Defer close to flush data
+    SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
+    SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
+    SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
+    SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
+    SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
+    SO_ERROR           : constant :=        4103; --  Get/clear error status
+    IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
+    IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
+    IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=        1024; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=           4; --  tv_sec
+    SIZEOF_tv_usec     : constant :=           4; --  tv_usec
+ 
+ end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon-vxworks.ads gcc-4.1.0/gcc/ada/g-soccon-vxworks.ads
*** gcc-4.0.2/gcc/ada/g-soccon-vxworks.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon-vxworks.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for VxWorks
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,43 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for powerpc-wrs-vxworks
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 44,161 ****
     -- Families --
     --------------
  
!    AF_INET            : constant :=            2; --  IPv4 address family
!    AF_INET6           : constant :=           -1; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=            1; --  Stream socket
!    SOCK_DGRAM         : constant :=            2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=           13; --  Permission denied
!    EADDRINUSE         : constant :=           48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=           49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=           47; --  Addr family not supported
!    EALREADY           : constant :=           69; --  Operation in progress
!    EBADF              : constant :=            9; --  Bad file descriptor
!    ECONNABORTED       : constant :=           53; --  Connection aborted
!    ECONNREFUSED       : constant :=           61; --  Connection refused
!    ECONNRESET         : constant :=           54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=           40; --  Destination addr required
!    EFAULT             : constant :=           14; --  Bad address
!    EHOSTDOWN          : constant :=           67; --  Host is down
!    EHOSTUNREACH       : constant :=           65; --  No route to host
!    EINPROGRESS        : constant :=           68; --  Operation now in progress
!    EINTR              : constant :=            4; --  Interrupted system call
!    EINVAL             : constant :=           22; --  Invalid argument
!    EIO                : constant :=            5; --  Input output error
!    EISCONN            : constant :=           56; --  Socket already connected
!    ELOOP              : constant :=           64; --  Too many symbolic lynks
!    EMFILE             : constant :=           24; --  Too many open files
!    EMSGSIZE           : constant :=           36; --  Message too long
!    ENAMETOOLONG       : constant :=           26; --  Name too long
!    ENETDOWN           : constant :=           62; --  Network is down
!    ENETRESET          : constant :=           52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=           51; --  Network is unreachable
!    ENOBUFS            : constant :=           55; --  No buffer space available
!    ENOPROTOOPT        : constant :=           42; --  Protocol not available
!    ENOTCONN           : constant :=           57; --  Socket not connected
!    ENOTSOCK           : constant :=           50; --  Operation on non socket
!    EOPNOTSUPP         : constant :=           45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=           46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=           43; --  Unknown protocol
!    EPROTOTYPE         : constant :=           41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=           58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=           44; --  Socket type not supported
!    ETIMEDOUT          : constant :=           60; --  Connection timed out
!    ETOOMANYREFS       : constant :=           59; --  Too many references
!    EWOULDBLOCK        : constant :=           70; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=            1; --  Unknown host
!    TRY_AGAIN          : constant :=            2; --  Host name lookup failure
!    NO_DATA            : constant :=            4; --  No data record for name
!    NO_RECOVERY        : constant :=            3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=           16; --  Set/clear non-blocking io
!    FIONREAD           : constant :=            1; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=            0; --  No more recv
!    SHUT_WR            : constant :=            1; --  No more send
!    SHUT_RDWR          : constant :=            2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=        65535; --  Options for socket level
!    IPPROTO_IP         : constant :=            0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=           17; --  UDP
!    IPPROTO_TCP        : constant :=            6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=            1; --  Process out-of-band data
!    MSG_PEEK           : constant :=            2; --  Peek at incoming data
!    MSG_EOR            : constant :=            8; --  Send end of record
!    MSG_WAITALL        : constant :=           64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=           -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=            0;
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
!    SO_SNDBUF          : constant :=         4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=         4098; --  Set/get recv buffer size
!    SO_REUSEADDR       : constant :=            4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=            8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=          128; --  Defer close to flush data
!    SO_ERROR           : constant :=         4103; --  Get/clear error status
!    SO_BROADCAST       : constant :=           32; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           13; --  Leave a multicast group
!    IP_MULTICAST_TTL   : constant :=           10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=           11; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 45,191 ----
     -- Families --
     --------------
  
!    AF_INET            : constant :=          2; --  IPv4 address family
!    AF_INET6           : constant :=         -1; --  IPv6 address family
  
     -----------
     -- Modes --
     -----------
  
!    SOCK_STREAM        : constant :=          1; --  Stream socket
!    SOCK_DGRAM         : constant :=          2; --  Datagram socket
  
     -------------------
     -- Socket errors --
     -------------------
  
!    EACCES             : constant :=         13; --  Permission denied
!    EADDRINUSE         : constant :=         48; --  Address already in use
!    EADDRNOTAVAIL      : constant :=         49; --  Cannot assign address
!    EAFNOSUPPORT       : constant :=         47; --  Addr family not supported
!    EALREADY           : constant :=         69; --  Operation in progress
!    EBADF              : constant :=          9; --  Bad file descriptor
!    ECONNABORTED       : constant :=         53; --  Connection aborted
!    ECONNREFUSED       : constant :=         61; --  Connection refused
!    ECONNRESET         : constant :=         54; --  Connection reset by peer
!    EDESTADDRREQ       : constant :=         40; --  Destination addr required
!    EFAULT             : constant :=         14; --  Bad address
!    EHOSTDOWN          : constant :=         67; --  Host is down
!    EHOSTUNREACH       : constant :=         65; --  No route to host
!    EINPROGRESS        : constant :=         68; --  Operation now in progress
!    EINTR              : constant :=          4; --  Interrupted system call
!    EINVAL             : constant :=         22; --  Invalid argument
!    EIO                : constant :=          5; --  Input output error
!    EISCONN            : constant :=         56; --  Socket already connected
!    ELOOP              : constant :=         64; --  Too many symbolic lynks
!    EMFILE             : constant :=         24; --  Too many open files
!    EMSGSIZE           : constant :=         36; --  Message too long
!    ENAMETOOLONG       : constant :=         26; --  Name too long
!    ENETDOWN           : constant :=         62; --  Network is down
!    ENETRESET          : constant :=         52; --  Disconn. on network reset
!    ENETUNREACH        : constant :=         51; --  Network is unreachable
!    ENOBUFS            : constant :=         55; --  No buffer space available
!    ENOPROTOOPT        : constant :=         42; --  Protocol not available
!    ENOTCONN           : constant :=         57; --  Socket not connected
!    ENOTSOCK           : constant :=         50; --  Operation on non socket
!    EOPNOTSUPP         : constant :=         45; --  Operation not supported
!    EPFNOSUPPORT       : constant :=         46; --  Unknown protocol family
!    EPROTONOSUPPORT    : constant :=         43; --  Unknown protocol
!    EPROTOTYPE         : constant :=         41; --  Unknown protocol type
!    ESHUTDOWN          : constant :=         58; --  Cannot send once shutdown
!    ESOCKTNOSUPPORT    : constant :=         44; --  Socket type not supported
!    ETIMEDOUT          : constant :=         60; --  Connection timed out
!    ETOOMANYREFS       : constant :=         59; --  Too many references
!    EWOULDBLOCK        : constant :=         70; --  Operation would block
  
     -----------------
     -- Host errors --
     -----------------
  
!    HOST_NOT_FOUND     : constant :=          1; --  Unknown host
!    TRY_AGAIN          : constant :=          2; --  Host name lookup failure
!    NO_DATA            : constant :=          4; --  No data record for name
!    NO_RECOVERY        : constant :=          3; --  Non recoverable errors
  
     -------------------
     -- Control flags --
     -------------------
  
!    FIONBIO            : constant :=         16; --  Set/clear non-blocking io
!    FIONREAD           : constant :=          1; --  How many bytes to read
  
     --------------------
     -- Shutdown modes --
     --------------------
  
!    SHUT_RD            : constant :=          0; --  No more recv
!    SHUT_WR            : constant :=          1; --  No more send
!    SHUT_RDWR          : constant :=          2; --  No more recv/send
  
     ---------------------
     -- Protocol levels --
     ---------------------
  
!    SOL_SOCKET         : constant :=      65535; --  Options for socket level
!    IPPROTO_IP         : constant :=          0; --  Dummy protocol for IP
!    IPPROTO_UDP        : constant :=         17; --  UDP
!    IPPROTO_TCP        : constant :=          6; --  TCP
  
     -------------------
     -- Request flags --
     -------------------
  
!    MSG_OOB            : constant :=          1; --  Process out-of-band data
!    MSG_PEEK           : constant :=          2; --  Peek at incoming data
!    MSG_EOR            : constant :=          8; --  Send end of record
!    MSG_WAITALL        : constant :=         64; --  Wait for full reception
!    MSG_NOSIGNAL       : constant :=         -1; --  No SIGPIPE on send
!    MSG_Forced_Flags   : constant :=          0;
!    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
!    TCP_NODELAY        : constant :=          1; --  Do not coalesce packets
!    SO_REUSEADDR       : constant :=          4; --  Bind reuse local address
!    SO_KEEPALIVE       : constant :=          8; --  Enable keep-alive msgs
!    SO_LINGER          : constant :=        128; --  Defer close to flush data
!    SO_BROADCAST       : constant :=         32; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=       4097; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=       4098; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=       4101; --  Emission timeout
!    SO_RCVTIMEO        : constant :=       4102; --  Reception timeout
!    SO_ERROR           : constant :=       4103; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=          9; --  Set/get mcast interface
!    IP_MULTICAST_TTL   : constant :=         10; --  Set/get multicast TTL
!    IP_MULTICAST_LOOP  : constant :=         11; --  Set/get mcast loopback
!    IP_ADD_MEMBERSHIP  : constant :=         12; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=         13; --  Leave a multicast group
! 
!    -------------------
!    -- System limits --
!    -------------------
! 
!    IOV_MAX            : constant := 2147483647; --  Maximum writev iovcnt
! 
!    ----------------------
!    -- Type definitions --
!    ----------------------
! 
!    --  Sizes (in bytes) of the components of struct timeval
! 
!    SIZEOF_tv_sec      : constant :=          4; --  tv_sec
!    SIZEOF_tv_usec     : constant :=          4; --  tv_usec
! 
!    --------------------------------
!    -- VxWorks-specific constants --
!    --------------------------------
! 
!    --  These constants may be used only within the VxWorks version of
!    --  GNAT.Sockets.Thin.
! 
!    OK                 : constant :=          0; --  VxWorks generic success
!    ERROR              : constant :=         -1; --  VxWorks generic error
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soccon.ads gcc-4.1.0/gcc/ada/g-soccon.ads
*** gcc-4.0.2/gcc/ada/g-soccon.ads	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/g-soccon.ads	Tue Nov 15 15:02:26 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  This is the version for GNU/Linux
! --  Do not edit this file by hand, instead edit and re-run gen-soccon.c
  
  package GNAT.Sockets.Constants is
  
--- 35,46 ----
  --  by the GNAT.Sockets package (g-socket.ads). This package should not be
  --  directly with'ed by an applications program.
  
! --  WARNING! This file is a default version that must be replaced for
! --  each platform.
! --  The values below were computed from a i686-pc-linux-gnu environment.
! 
! --  This file is generated automatically, do not modify it by hand! Instead,
! --  make changes to gen-soccon.c and re-run it on each target.
  
  package GNAT.Sockets.Constants is
  
*************** package GNAT.Sockets.Constants is
*** 140,161 ****
     MSG_WAITALL        : constant :=          256; --  Wait for full reception
     MSG_NOSIGNAL       : constant :=        16384; --  No SIGPIPE on send
     MSG_Forced_Flags   : constant := MSG_NOSIGNAL;
  
     --------------------
     -- Socket options --
     --------------------
  
     TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
-    SO_SNDBUF          : constant :=            7; --  Set/get send buffer size
-    SO_RCVBUF          : constant :=            8; --  Set/get recv buffer size
     SO_REUSEADDR       : constant :=            2; --  Bind reuse local address
     SO_KEEPALIVE       : constant :=            9; --  Enable keep-alive msgs
     SO_LINGER          : constant :=           13; --  Defer close to flush data
-    SO_ERROR           : constant :=            4; --  Get/clear error status
     SO_BROADCAST       : constant :=            6; --  Can send broadcast msgs
!    IP_ADD_MEMBERSHIP  : constant :=           35; --  Join a multicast group
!    IP_DROP_MEMBERSHIP : constant :=           36; --  Leave a multicast group
     IP_MULTICAST_TTL   : constant :=           33; --  Set/get multicast TTL
     IP_MULTICAST_LOOP  : constant :=           34; --  Set/get mcast loopback
  
  end GNAT.Sockets.Constants;
--- 144,184 ----
     MSG_WAITALL        : constant :=          256; --  Wait for full reception
     MSG_NOSIGNAL       : constant :=        16384; --  No SIGPIPE on send
     MSG_Forced_Flags   : constant := MSG_NOSIGNAL;
+    --  Flags set on all send(2) calls
  
     --------------------
     -- Socket options --
     --------------------
  
     TCP_NODELAY        : constant :=            1; --  Do not coalesce packets
     SO_REUSEADDR       : constant :=            2; --  Bind reuse local address
     SO_KEEPALIVE       : constant :=            9; --  Enable keep-alive msgs
     SO_LINGER          : constant :=           13; --  Defer close to flush data
     SO_BROADCAST       : constant :=            6; --  Can send broadcast msgs
!    SO_SNDBUF          : constant :=            7; --  Set/get send buffer size
!    SO_RCVBUF          : constant :=            8; --  Set/get recv buffer size
!    SO_SNDTIMEO        : constant :=           21; --  Emission timeout
!    SO_RCVTIMEO        : constant :=           20; --  Reception timeout
!    SO_ERROR           : constant :=            4; --  Get/clear error status
!    IP_MULTICAST_IF    : constant :=           32; --  Set/get mcast interface
     IP_MULTICAST_TTL   : constant :=           33; --  Set/get multicast TTL
     IP_MULTICAST_LOOP  : constant :=           34; --  Set/get mcast loopback
+    IP_ADD_MEMBERSHIP  : constant :=           35; --  Join a multicast group
+    IP_DROP_MEMBERSHIP : constant :=           36; --  Leave a multicast group
+ 
+    -------------------
+    -- System limits --
+    -------------------
+ 
+    IOV_MAX            : constant :=   2147483647; --  Maximum writev iovcnt
+ 
+    ----------------------
+    -- Type definitions --
+    ----------------------
+ 
+    --  Sizes (in bytes) of the components of struct timeval
+ 
+    SIZEOF_tv_sec      : constant :=            4; --  tv_sec
+    SIZEOF_tv_usec     : constant :=            4; --  tv_usec
  
  end GNAT.Sockets.Constants;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socket.adb gcc-4.1.0/gcc/ada/g-socket.adb
*** gcc-4.0.2/gcc/ada/g-socket.adb	Wed Oct 27 12:27:15 2004
--- gcc-4.1.0/gcc/ada/g-socket.adb	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Unchecked_Conversion;
*** 37,43 ****
  
  with Interfaces.C.Strings;
  
- with GNAT.OS_Lib;                use GNAT.OS_Lib;
  with GNAT.Sockets.Constants;
  with GNAT.Sockets.Thin;          use GNAT.Sockets.Thin;
  with GNAT.Task_Lock;
--- 37,42 ----
*************** package body GNAT.Sockets is
*** 93,100 ****
        No_Delay        => Constants.TCP_NODELAY,
        Add_Membership  => Constants.IP_ADD_MEMBERSHIP,
        Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
        Multicast_TTL   => Constants.IP_MULTICAST_TTL,
!       Multicast_Loop  => Constants.IP_MULTICAST_LOOP);
  
     Flags : constant array (0 .. 3) of C.int :=
              (0 => Constants.MSG_OOB,     --  Process_Out_Of_Band_Data
--- 92,102 ----
        No_Delay        => Constants.TCP_NODELAY,
        Add_Membership  => Constants.IP_ADD_MEMBERSHIP,
        Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
+       Multicast_If    => Constants.IP_MULTICAST_IF,
        Multicast_TTL   => Constants.IP_MULTICAST_TTL,
!       Multicast_Loop  => Constants.IP_MULTICAST_LOOP,
!       Send_Timeout    => Constants.SO_SNDTIMEO,
!       Receive_Timeout => Constants.SO_RCVTIMEO);
  
     Flags : constant array (0 .. 3) of C.int :=
              (0 => Constants.MSG_OOB,     --  Process_Out_Of_Band_Data
*************** package body GNAT.Sockets is
*** 111,116 ****
--- 113,121 ----
     function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
     function To_Int     is new Ada.Unchecked_Conversion (In_Addr, C.int);
  
+    function Err_Code_Image (E : Integer) return String;
+    --  Return the value of E surrounded with brackets
+ 
     -----------------------
     -- Local subprograms --
     -----------------------
*************** package body GNAT.Sockets is
*** 118,125 ****
     function Resolve_Error
       (Error_Value : Integer;
        From_Errno  : Boolean := True) return Error_Type;
!    --  Associate an enumeration value (error_type) to en error value
!    --  (errno). From_Errno prevents from mixing h_errno with errno.
  
     function To_Name   (N  : String) return Name_Type;
     function To_String (HN : Name_Type) return String;
--- 123,130 ----
     function Resolve_Error
       (Error_Value : Integer;
        From_Errno  : Boolean := True) return Error_Type;
!    --  Associate an enumeration value (error_type) to en error value (errno).
!    --  From_Errno prevents from mixing h_errno with errno.
  
     function To_Name   (N  : String) return Name_Type;
     function To_String (HN : Name_Type) return String;
*************** package body GNAT.Sockets is
*** 144,157 ****
     function Image
       (Val :  Inet_Addr_VN_Type;
        Hex :  Boolean := False) return String;
!    --  Output an array of inet address components either in
!    --  hexadecimal or in decimal mode.
  
     function Is_IP_Address (Name : String) return Boolean;
!    --  Return true when Name is an IP address in standard dot notation.
  
     function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr;
!    function To_Inet_Addr (Addr : In_Addr) return Inet_Addr_Type;
     --  Conversion functions
  
     function To_Host_Entry (E : Hostent) return Host_Entry_Type;
--- 149,163 ----
     function Image
       (Val :  Inet_Addr_VN_Type;
        Hex :  Boolean := False) return String;
!    --  Output an array of inet address components in hex or decimal mode
  
     function Is_IP_Address (Name : String) return Boolean;
!    --  Return true when Name is an IP address in standard dot notation
  
     function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr;
!    procedure To_Inet_Addr
!      (Addr   : In_Addr;
!       Result : out Inet_Addr_Type);
     --  Conversion functions
  
     function To_Host_Entry (E : Hostent) return Host_Entry_Type;
*************** package body GNAT.Sockets is
*** 160,175 ****
     function To_Service_Entry (E : Servent) return Service_Entry_Type;
     --  Conversion function
  
!    function To_Timeval (Val : Selector_Duration) return Timeval;
     --  Separate Val in seconds and microseconds
  
     procedure Raise_Socket_Error (Error : Integer);
!    --  Raise Socket_Error with an exception message describing
!    --  the error code.
  
!    procedure Raise_Host_Error (Error : Integer);
!    --  Raise Host_Error exception with message describing error code
!    --  (note hstrerror seems to be obsolete).
  
     procedure Narrow (Item : in out Socket_Set_Type);
     --  Update Last as it may be greater than the real last socket
--- 166,185 ----
     function To_Service_Entry (E : Servent) return Service_Entry_Type;
     --  Conversion function
  
!    function To_Timeval (Val : Timeval_Duration) return Timeval;
     --  Separate Val in seconds and microseconds
  
+    function To_Duration (Val : Timeval) return Timeval_Duration;
+    --  Reconstruct a Duration value from a Timeval record (seconds and
+    --  microseconds).
+ 
     procedure Raise_Socket_Error (Error : Integer);
!    --  Raise Socket_Error with an exception message describing the error code
!    --  from errno.
  
!    procedure Raise_Host_Error (H_Error : Integer);
!    --  Raise Host_Error exception with message describing error code (note
!    --  hstrerror seems to be obsolete) from h_errno.
  
     procedure Narrow (Item : in out Socket_Set_Type);
     --  Update Last as it may be greater than the real last socket
*************** package body GNAT.Sockets is
*** 261,267 ****
  
        Socket := Socket_Type (Res);
  
!       Address.Addr := To_Inet_Addr (Sin.Sin_Addr);
        Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
     end Accept_Socket;
  
--- 271,277 ----
  
        Socket := Socket_Type (Res);
  
!       To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
        Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
     end Accept_Socket;
  
*************** package body GNAT.Sockets is
*** 385,390 ****
--- 395,401 ----
     is
        Res  : C.int;
        Last : C.int;
+       RSig : Socket_Type renames Selector.R_Sig_Socket;
        RSet : Socket_Set_Type;
        WSet : Socket_Set_Type;
        ESet : Socket_Set_Type;
*************** package body GNAT.Sockets is
*** 392,494 ****
        TPtr : Timeval_Access;
  
     begin
!       Status := Completed;
  
!       --  No timeout or Forever is indicated by a null timeval pointer
  
!       if Timeout = Forever then
!          TPtr := null;
!       else
!          TVal := To_Timeval (Timeout);
!          TPtr := TVal'Unchecked_Access;
!       end if;
  
!       --  Copy R_Socket_Set in RSet and add read signalling socket
  
!       RSet := (Set  => New_Socket_Set (R_Socket_Set.Set),
!                Last => R_Socket_Set.Last);
!       Set (RSet, Selector.R_Sig_Socket);
  
!       --  Copy W_Socket_Set in WSet
  
!       WSet := (Set  => New_Socket_Set (W_Socket_Set.Set),
!                Last => W_Socket_Set.Last);
  
!       --  Copy E_Socket_Set in ESet
  
!       ESet := (Set  => New_Socket_Set (E_Socket_Set.Set),
!                Last => E_Socket_Set.Last);
  
!       Last := C.int'Max (C.int'Max (C.int (RSet.Last),
!                                     C.int (WSet.Last)),
!                                     C.int (ESet.Last));
  
!       Res :=
!         C_Select
!          (Last + 1,
!           RSet.Set,
!           WSet.Set,
!           ESet.Set,
!           TPtr);
  
!       if Res = Failure then
!          Raise_Socket_Error (Socket_Errno);
!       end if;
  
!       --  If Select was resumed because of read signalling socket,
!       --  read this data and remove socket from set.
  
!       if Is_Set (RSet, Selector.R_Sig_Socket) then
!          Clear (RSet, Selector.R_Sig_Socket);
  
!          declare
!             Buf : Character;
  
!          begin
!             Res := C_Recv (C.int (Selector.R_Sig_Socket), Buf'Address, 1, 0);
  
!             if Res = Failure then
!                Raise_Socket_Error (Socket_Errno);
!             end if;
!          end;
  
!          Status := Aborted;
  
!       elsif Res = 0 then
!          Status := Expired;
!       end if;
  
!       --  Update RSet, WSet and ESet in regard to their new socket
!       --  sets.
  
!       Narrow (RSet);
!       Narrow (WSet);
!       Narrow (ESet);
  
!       --  Reset RSet as it should be if R_Sig_Socket was not added
  
!       if Is_Empty (RSet) then
!          Empty (RSet);
!       end if;
  
!       if Is_Empty (WSet) then
!          Empty (WSet);
!       end if;
  
!       if Is_Empty (ESet) then
!          Empty (ESet);
!       end if;
  
!       --  Deliver RSet, WSet and ESet
  
!       Empty (R_Socket_Set);
!       R_Socket_Set := RSet;
  
!       Empty (W_Socket_Set);
!       W_Socket_Set := WSet;
  
!       Empty (E_Socket_Set);
!       E_Socket_Set := ESet;
     end Check_Selector;
  
     -----------
--- 403,518 ----
        TPtr : Timeval_Access;
  
     begin
!       begin
!          Status := Completed;
  
!          --  No timeout or Forever is indicated by a null timeval pointer
  
!          if Timeout = Forever then
!             TPtr := null;
!          else
!             TVal := To_Timeval (Timeout);
!             TPtr := TVal'Unchecked_Access;
!          end if;
  
!          --  Copy R_Socket_Set in RSet and add read signalling socket
  
!          RSet := (Set  => New_Socket_Set (R_Socket_Set.Set),
!                   Last => R_Socket_Set.Last);
!          Set (RSet, RSig);
  
!          --  Copy W_Socket_Set in WSet
  
!          WSet := (Set  => New_Socket_Set (W_Socket_Set.Set),
!                   Last => W_Socket_Set.Last);
  
!          --  Copy E_Socket_Set in ESet
  
!          ESet := (Set  => New_Socket_Set (E_Socket_Set.Set),
!                   Last => E_Socket_Set.Last);
  
!          Last := C.int'Max (C.int'Max (C.int (RSet.Last),
!                                        C.int (WSet.Last)),
!                                        C.int (ESet.Last));
  
!          Res :=
!            C_Select
!             (Last + 1,
!              RSet.Set,
!              WSet.Set,
!              ESet.Set,
!              TPtr);
  
!          if Res = Failure then
!             Raise_Socket_Error (Socket_Errno);
!          end if;
  
!          --  If Select was resumed because of read signalling socket, read this
!          --  data and remove socket from set.
  
!          if Is_Set (RSet, RSig) then
!             Clear (RSet, RSig);
  
!             declare
!                Buf : Character;
  
!             begin
!                Res := C_Recv (C.int (RSig), Buf'Address, 1, 0);
  
!                if Res = Failure then
!                   Raise_Socket_Error (Socket_Errno);
!                end if;
!             end;
  
!             Status := Aborted;
  
!          elsif Res = 0 then
!             Status := Expired;
!          end if;
  
!          --  Update RSet, WSet and ESet in regard to their new socket sets
  
!          Narrow (RSet);
!          Narrow (WSet);
!          Narrow (ESet);
  
!          --  Reset RSet as it should be if R_Sig_Socket was not added
  
!          if Is_Empty (RSet) then
!             Empty (RSet);
!          end if;
  
!          if Is_Empty (WSet) then
!             Empty (WSet);
!          end if;
  
!          if Is_Empty (ESet) then
!             Empty (ESet);
!          end if;
  
!          --  Deliver RSet, WSet and ESet
  
!          Empty (R_Socket_Set);
!          R_Socket_Set := RSet;
  
!          Empty (W_Socket_Set);
!          W_Socket_Set := WSet;
  
!          Empty (E_Socket_Set);
!          E_Socket_Set := ESet;
! 
!       exception
! 
!          when Socket_Error =>
! 
!             --  The local socket sets must be emptied before propagating
!             --  Socket_Error so the associated storage is freed.
! 
!             Empty (RSet);
!             Empty (WSet);
!             Empty (ESet);
!             raise;
!       end;
     end Check_Selector;
  
     -----------
*************** package body GNAT.Sockets is
*** 500,506 ****
        Socket : Socket_Type)
     is
        Last : aliased C.int := C.int (Item.Last);
- 
     begin
        if Item.Last /= No_Socket then
           Remove_Socket_From_Set (Item.Set, C.int (Socket));
--- 524,529 ----
*************** package body GNAT.Sockets is
*** 513,526 ****
     -- Close_Selector --
     --------------------
  
-    --  Comments needed below ???
-    --  Why are exceptions ignored ???
- 
     procedure Close_Selector (Selector : in out Selector_Type) is
     begin
        begin
           Close_Socket (Selector.R_Sig_Socket);
- 
        exception
           when Socket_Error =>
              null;
--- 536,553 ----
     -- Close_Selector --
     --------------------
  
     procedure Close_Selector (Selector : in out Selector_Type) is
     begin
+ 
+       --  Close the signalling sockets used internally for the implementation
+       --  of Abort_Selector. Exceptions are ignored because these sockets
+       --  are implementation artefacts of no interest to the user, and
+       --  there is little that can be done if either Close_Socket call fails
+       --  (which theoretically should not happen anyway). We also want to try
+       --  to perform the second Close_Socket even if the first one failed.
+ 
        begin
           Close_Socket (Selector.R_Sig_Socket);
        exception
           when Socket_Error =>
              null;
*************** package body GNAT.Sockets is
*** 528,534 ****
  
        begin
           Close_Socket (Selector.W_Sig_Socket);
- 
        exception
           when Socket_Error =>
              null;
--- 555,560 ----
*************** package body GNAT.Sockets is
*** 617,623 ****
  
           when N_Bytes_To_Read =>
              Request.Size := Natural (Arg);
- 
        end case;
     end Control_Socket;
  
--- 643,648 ----
*************** package body GNAT.Sockets is
*** 651,673 ****
        Err : Integer;
  
     begin
!       --  We open two signalling sockets. One of them is used to
!       --  send data to the other, which is included in a C_Select
!       --  socket set. The communication is used to force the call
!       --  to C_Select to complete, and the waiting task to resume
!       --  its execution.
  
        --  Create a listening socket
  
        S0 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
        if S0 = Failure then
           Raise_Socket_Error (Socket_Errno);
        end if;
  
!       --  Sin is already correctly initialized. Bind the socket to any
!       --  unused port.
  
        Res := C_Bind (S0, Sin'Address, Len);
        if Res = Failure then
           Err := Socket_Errno;
           Res := C_Close (S0);
--- 676,704 ----
        Err : Integer;
  
     begin
!       --  We open two signalling sockets. One of them is used to send data to
!       --  the other, which is included in a C_Select socket set. The
!       --  communication is used to force the call to C_Select to complete, and
!       --  the waiting task to resume its execution.
  
        --  Create a listening socket
  
        S0 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
+ 
        if S0 = Failure then
           Raise_Socket_Error (Socket_Errno);
        end if;
  
!       --  Bind the socket to any unused port on localhost
! 
!       Sin.Sin_Addr.S_B1 := 127;
!       Sin.Sin_Addr.S_B2 := 0;
!       Sin.Sin_Addr.S_B3 := 0;
!       Sin.Sin_Addr.S_B4 := 1;
!       Sin.Sin_Port := 0;
  
        Res := C_Bind (S0, Sin'Address, Len);
+ 
        if Res = Failure then
           Err := Socket_Errno;
           Res := C_Close (S0);
*************** package body GNAT.Sockets is
*** 684,690 ****
           Raise_Socket_Error (Err);
        end if;
  
!       Res := C_Listen (S0, 2);
  
        if Res = Failure then
           Err := Socket_Errno;
--- 715,724 ----
           Raise_Socket_Error (Err);
        end if;
  
!       --  Set backlog to 1 to guarantee that exactly one call to connect(2)
!       --  can succeed.
! 
!       Res := C_Listen (S0, 1);
  
        if Res = Failure then
           Err := Socket_Errno;
*************** package body GNAT.Sockets is
*** 700,712 ****
           Raise_Socket_Error (Err);
        end if;
  
-       --  Use INADDR_LOOPBACK
- 
-       Sin.Sin_Addr.S_B1 := 127;
-       Sin.Sin_Addr.S_B2 := 0;
-       Sin.Sin_Addr.S_B3 := 0;
-       Sin.Sin_Addr.S_B4 := 1;
- 
        --  Do a connect and accept the connection
  
        Res := C_Connect (S1, Sin'Address, Len);
--- 734,739 ----
*************** package body GNAT.Sockets is
*** 718,723 ****
--- 745,754 ----
           Raise_Socket_Error (Err);
        end if;
  
+       --  Since the call to connect(2) has suceeded and the backlog limit on
+       --  the listening socket is 1, we know that there is now exactly one
+       --  pending connection on S0, which is the one from S1.
+ 
        S2 := C_Accept (S0, Sin'Address, Len'Access);
  
        if S2 = Failure then
*************** package body GNAT.Sockets is
*** 772,777 ****
--- 803,819 ----
        Item.Last := No_Socket;
     end Empty;
  
+    --------------------
+    -- Err_Code_Image --
+    --------------------
+ 
+    function Err_Code_Image (E : Integer) return String is
+       Msg : String := E'Img & "] ";
+    begin
+       Msg (Msg'First) := '[';
+       return Msg;
+    end Err_Code_Image;
+ 
     --------------
     -- Finalize --
     --------------
*************** package body GNAT.Sockets is
*** 816,825 ****
     begin
        if Stream = null then
           raise Socket_Error;
- 
        elsif Stream.all in Datagram_Socket_Stream_Type then
           return Datagram_Socket_Stream_Type (Stream.all).From;
- 
        else
           return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
        end if;
--- 858,865 ----
*************** package body GNAT.Sockets is
*** 847,853 ****
        Res := C_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET);
  
        if Res = null then
!          Err := Socket_Errno;
           Task_Lock.Unlock;
           Raise_Host_Error (Err);
        end if;
--- 887,893 ----
        Res := C_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET);
  
        if Res = null then
!          Err := Host_Errno;
           Task_Lock.Unlock;
           Raise_Host_Error (Err);
        end if;
*************** package body GNAT.Sockets is
*** 886,892 ****
        Res := C_Gethostbyname (HN);
  
        if Res = null then
!          Err := Socket_Errno;
           Task_Lock.Unlock;
           Raise_Host_Error (Err);
        end if;
--- 926,932 ----
        Res := C_Gethostbyname (HN);
  
        if Res = null then
!          Err := Host_Errno;
           Task_Lock.Unlock;
           Raise_Host_Error (Err);
        end if;
*************** package body GNAT.Sockets is
*** 895,901 ****
  
        declare
           HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
- 
        begin
           Task_Lock.Unlock;
           return HE;
--- 935,940 ----
*************** package body GNAT.Sockets is
*** 916,922 ****
           Raise_Socket_Error (Socket_Errno);
        end if;
  
!       Res.Addr := To_Inet_Addr (Sin.Sin_Addr);
        Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
  
        return Res;
--- 955,961 ----
           Raise_Socket_Error (Socket_Errno);
        end if;
  
!       To_Inet_Addr (Sin.Sin_Addr, Res.Addr);
        Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
  
        return Res;
*************** package body GNAT.Sockets is
*** 1009,1015 ****
     begin
        Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
        if Res /= Failure then
!          Addr.Addr := To_Inet_Addr (Sin.Sin_Addr);
           Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
        end if;
  
--- 1048,1054 ----
     begin
        Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
        if Res /= Failure then
!          To_Inet_Addr (Sin.Sin_Addr, Addr.Addr);
           Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
        end if;
  
*************** package body GNAT.Sockets is
*** 1030,1035 ****
--- 1069,1075 ----
        V8  : aliased Two_Int;
        V4  : aliased C.int;
        V1  : aliased C.unsigned_char;
+       VT  : aliased Timeval;
        Len : aliased C.int;
        Add : System.Address;
        Res : C.int;
*************** package body GNAT.Sockets is
*** 1048,1057 ****
--- 1088,1103 ----
                No_Delay        |
                Send_Buffer     |
                Receive_Buffer  |
+               Multicast_If    |
                Error           =>
              Len := V4'Size / 8;
              Add := V4'Address;
  
+          when Send_Timeout    |
+               Receive_Timeout =>
+             Len := VT'Size / 8;
+             Add := VT'Address;
+ 
           when Linger          |
                Add_Membership  |
                Drop_Membership =>
*************** package body GNAT.Sockets is
*** 1091,1098 ****
  
           when Add_Membership  |
                Drop_Membership =>
!             Opt.Multicast_Address := To_Inet_Addr (To_In_Addr (V8 (V8'First)));
!             Opt.Local_Interface   := To_Inet_Addr (To_In_Addr (V8 (V8'Last)));
  
           when Multicast_TTL   =>
              Opt.Time_To_Live := Integer (V1);
--- 1137,1147 ----
  
           when Add_Membership  |
                Drop_Membership =>
!             To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address);
!             To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface);
! 
!          when Multicast_If    =>
!             To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
  
           when Multicast_TTL   =>
              Opt.Time_To_Live := Integer (V1);
*************** package body GNAT.Sockets is
*** 1100,1105 ****
--- 1149,1158 ----
           when Multicast_Loop  =>
              Opt.Enabled := (V1 /= 0);
  
+          when Send_Timeout    |
+               Receive_Timeout =>
+             Opt.Timeout := To_Duration (VT);
+ 
        end case;
  
        return Opt;
*************** package body GNAT.Sockets is
*** 1151,1157 ****
        procedure Img10 (V : Inet_Addr_Comp_Type) is
           Img : constant String := V'Img;
           Len : constant Natural := Img'Length - 1;
- 
        begin
           Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
           Length := Length + Len;
--- 1204,1209 ----
*************** package body GNAT.Sockets is
*** 1232,1251 ****
     function Inet_Addr (Image : String) return Inet_Addr_Type is
        use Interfaces.C.Strings;
  
!       Img : chars_ptr := New_String (Image);
!       Res : C.int;
!       Err : Integer;
  
     begin
        Res := C_Inet_Addr (Img);
-       Err := Errno;
        Free (Img);
  
        if Res = Failure then
!          Raise_Socket_Error (Err);
        end if;
  
!       return To_Inet_Addr (To_In_Addr (Res));
     end Inet_Addr;
  
     ----------------
--- 1284,1318 ----
     function Inet_Addr (Image : String) return Inet_Addr_Type is
        use Interfaces.C.Strings;
  
!       Img    : chars_ptr;
!       Res    : C.int;
!       Result : Inet_Addr_Type;
  
     begin
+       --  Special case for the all-ones broadcast address: this address
+       --  has the same in_addr_t value as Failure, and thus cannot be
+       --  properly returned by inet_addr(3).
+ 
+       if Image = "255.255.255.255" then
+          return Broadcast_Inet_Addr;
+ 
+       --  Special case for an empty Image as on some platforms (e.g. Windows)
+       --  calling Inet_Addr("") will not return an error.
+ 
+       elsif Image = "" then
+          Raise_Socket_Error (Constants.EINVAL);
+       end if;
+ 
+       Img := New_String (Image);
        Res := C_Inet_Addr (Img);
        Free (Img);
  
        if Res = Failure then
!          Raise_Socket_Error (Constants.EINVAL);
        end if;
  
!       To_Inet_Addr (To_In_Addr (Res), Result);
!       return Result;
     end Inet_Addr;
  
     ----------------
*************** package body GNAT.Sockets is
*** 1368,1379 ****
     -- Raise_Host_Error --
     ----------------------
  
!    procedure Raise_Host_Error (Error : Integer) is
  
        function Host_Error_Message return String;
!       --  We do not use a C function like strerror because hstrerror
!       --  that would correspond seems to be obsolete. Return
!       --  appropriate string for error value.
  
        ------------------------
        -- Host_Error_Message --
--- 1435,1445 ----
     -- Raise_Host_Error --
     ----------------------
  
!    procedure Raise_Host_Error (H_Error : Integer) is
  
        function Host_Error_Message return String;
!       --  We do not use a C function like strerror because hstrerror that would
!       --  correspond is obsolete. Return appropriate string for error value.
  
        ------------------------
        -- Host_Error_Message --
*************** package body GNAT.Sockets is
*** 1381,1387 ****
  
        function Host_Error_Message return String is
        begin
!          case Error is
              when Constants.HOST_NOT_FOUND => return "Host not found";
              when Constants.TRY_AGAIN      => return "Try again";
              when Constants.NO_RECOVERY    => return "No recovery";
--- 1447,1453 ----
  
        function Host_Error_Message return String is
        begin
!          case H_Error is
              when Constants.HOST_NOT_FOUND => return "Host not found";
              when Constants.TRY_AGAIN      => return "Try again";
              when Constants.NO_RECOVERY    => return "No recovery";
*************** package body GNAT.Sockets is
*** 1393,1399 ****
     --  Start of processing for Raise_Host_Error
  
     begin
!       Ada.Exceptions.Raise_Exception (Host_Error'Identity, Host_Error_Message);
     end Raise_Host_Error;
  
     ------------------------
--- 1459,1467 ----
     --  Start of processing for Raise_Host_Error
  
     begin
!       Ada.Exceptions.Raise_Exception (Host_Error'Identity,
!         Err_Code_Image (H_Error)
!         & Host_Error_Message);
     end Raise_Host_Error;
  
     ------------------------
*************** package body GNAT.Sockets is
*** 1402,1427 ****
  
     procedure Raise_Socket_Error (Error : Integer) is
        use type C.Strings.chars_ptr;
- 
-       function Image (E : Integer) return String;
- 
-       -----------
-       -- Image --
-       -----------
- 
-       function Image (E : Integer) return String is
-          Msg : String := E'Img & "] ";
-       begin
-          Msg (Msg'First) := '[';
-          return Msg;
-       end Image;
- 
-    --  Start of processing for Raise_Socket_Error
- 
     begin
!       Ada.Exceptions.Raise_Exception
!         (Socket_Error'Identity,
!          Image (Error) & C.Strings.Value (Socket_Error_Message (Error)));
     end Raise_Socket_Error;
  
     ----------
--- 1470,1479 ----
  
     procedure Raise_Socket_Error (Error : Integer) is
        use type C.Strings.chars_ptr;
     begin
!       Ada.Exceptions.Raise_Exception (Socket_Error'Identity,
!         Err_Code_Image (Error)
!         & C.Strings.Value (Socket_Error_Message (Error)));
     end Raise_Socket_Error;
  
     ----------
*************** package body GNAT.Sockets is
*** 1447,1454 ****
  
           Last  := Index;
  
!          --  Exit when all or zero data received. Zero means that
!          --  the socket peer is closed.
  
           exit when Index < First or else Index = Max;
  
--- 1499,1506 ----
  
           Last  := Index;
  
!          --  Exit when all or zero data received. Zero means that the socket
!          --  peer is closed.
  
           exit when Index < First or else Index = Max;
  
*************** package body GNAT.Sockets is
*** 1474,1481 ****
           Receive_Socket (Stream.Socket, Item (First .. Max), Index);
           Last  := Index;
  
!          --  Exit when all or zero data received. Zero means that
!          --  the socket peer is closed.
  
           exit when Index < First or else Index = Max;
  
--- 1526,1533 ----
           Receive_Socket (Stream.Socket, Item (First .. Max), Index);
           Last  := Index;
  
!          --  Exit when all or zero data received. Zero means that the socket
!          --  peer is closed.
  
           exit when Index < First or else Index = Max;
  
*************** package body GNAT.Sockets is
*** 1544,1550 ****
  
        Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
  
!       From.Addr := To_Inet_Addr (Sin.Sin_Addr);
        From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
     end Receive_Socket;
  
--- 1596,1602 ----
  
        Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
  
!       To_Inet_Addr (Sin.Sin_Addr, From.Addr);
        From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
     end Receive_Socket;
  
*************** package body GNAT.Sockets is
*** 1628,1638 ****
     is
        Id    : constant Exception_Id := Exception_Identity (Occurrence);
        Msg   : constant String       := Exception_Message (Occurrence);
!       First : Natural               := Msg'First;
        Last  : Natural;
        Val   : Integer;
  
     begin
        while First <= Msg'Last
          and then Msg (First) not in '0' .. '9'
        loop
--- 1680,1691 ----
     is
        Id    : constant Exception_Id := Exception_Identity (Occurrence);
        Msg   : constant String       := Exception_Message (Occurrence);
!       First : Natural;
        Last  : Natural;
        Val   : Integer;
  
     begin
+       First := Msg'First;
        while First <= Msg'Last
          and then Msg (First) not in '0' .. '9'
        loop
*************** package body GNAT.Sockets is
*** 1644,1650 ****
        end if;
  
        Last := First;
- 
        while Last < Msg'Last
          and then Msg (Last + 1) in '0' .. '9'
        loop
--- 1697,1702 ----
*************** package body GNAT.Sockets is
*** 1765,1784 ****
        Vector : Vector_Type;
        Count  : out Ada.Streams.Stream_Element_Count)
     is
!       Res : C.int;
  
     begin
!       Res :=
!         C_Writev
!           (C.int (Socket),
!            Vector (Vector'First)'Address,
!            Vector'Length);
  
!       if Res = Failure then
!          Raise_Socket_Error (Socket_Errno);
!       end if;
  
!       Count := Ada.Streams.Stream_Element_Count (Res);
     end Send_Vector;
  
     ---------
--- 1817,1855 ----
        Vector : Vector_Type;
        Count  : out Ada.Streams.Stream_Element_Count)
     is
!       Res            : C.int;
!       Iov_Count      : C.int;
!       This_Iov_Count : C.int;
  
     begin
!       Count := 0;
!       Iov_Count := 0;
!       while Iov_Count < Vector'Length loop
  
!          pragma Warnings (Off);
!          --  Following test may be compile time known on some targets
  
!          if Vector'Length - Iov_Count > Constants.IOV_MAX then
!             This_Iov_Count := Constants.IOV_MAX;
!          else
!             This_Iov_Count := Vector'Length - Iov_Count;
!          end if;
! 
!          pragma Warnings (On);
! 
!          Res :=
!            C_Writev
!              (C.int (Socket),
!               Vector (Vector'First + Integer (Iov_Count))'Address,
!               This_Iov_Count);
! 
!          if Res = Failure then
!             Raise_Socket_Error (Socket_Errno);
!          end if;
! 
!          Count := Count + Ada.Streams.Stream_Element_Count (Res);
!          Iov_Count := Iov_Count + This_Iov_Count;
!       end loop;
     end Send_Vector;
  
     ---------
*************** package body GNAT.Sockets is
*** 1824,1830 ****
        V8  : aliased Two_Int;
        V4  : aliased C.int;
        V1  : aliased C.unsigned_char;
!       Len : aliased C.int;
        Add : System.Address := Null_Address;
        Res : C.int;
  
--- 1895,1902 ----
        V8  : aliased Two_Int;
        V4  : aliased C.int;
        V1  : aliased C.unsigned_char;
!       VT  : aliased Timeval;
!       Len : C.int;
        Add : System.Address := Null_Address;
        Res : C.int;
  
*************** package body GNAT.Sockets is
*** 1862,1867 ****
--- 1934,1944 ----
              Len := V8'Size / 8;
              Add := V8'Address;
  
+          when Multicast_If    =>
+             V4  := To_Int (To_In_Addr (Option.Outgoing_If));
+             Len := V4'Size / 8;
+             Add := V4'Address;
+ 
           when Multicast_TTL   =>
              V1  := C.unsigned_char (Option.Time_To_Live);
              Len := V1'Size / 8;
*************** package body GNAT.Sockets is
*** 1872,1877 ****
--- 1949,1960 ----
              Len := V1'Size / 8;
              Add := V1'Address;
  
+          when Send_Timeout    |
+               Receive_Timeout =>
+             VT  := To_Timeval (Option.Timeout);
+             Len := VT'Size / 8;
+             Add := VT'Address;
+ 
        end case;
  
        Res := C_Setsockopt
*************** package body GNAT.Sockets is
*** 1954,1960 ****
  
     function Stream (Socket : Socket_Type) return Stream_Access is
        S : Stream_Socket_Stream_Access;
- 
     begin
        S := new Stream_Socket_Stream_Type;
        S.Socket := Socket;
--- 2037,2042 ----
*************** package body GNAT.Sockets is
*** 1970,1975 ****
--- 2052,2066 ----
        return Integer (Socket);
     end To_C;
  
+    -----------------
+    -- To_Duration --
+    -----------------
+ 
+    function To_Duration (Val : Timeval) return Timeval_Duration is
+    begin
+       return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6;
+    end To_Duration;
+ 
     -------------------
     -- To_Host_Entry --
     -------------------
*************** package body GNAT.Sockets is
*** 1982,1994 ****
  
        Aliases : constant Chars_Ptr_Array :=
                    Chars_Ptr_Pointers.Value (E.H_Aliases);
!       --  H_Aliases points to a list of name aliases. The list is
!       --  terminated by a NULL pointer.
  
        Addresses : constant In_Addr_Access_Array :=
                      In_Addr_Access_Pointers.Value (E.H_Addr_List);
!       --  H_Addr_List points to a list of binary addresses (in network
!       --  byte order). The list is terminated by a NULL pointer.
        --
        --  H_Length is not used because it is currently only set to 4.
        --  H_Addrtype is always AF_INET
--- 2073,2085 ----
  
        Aliases : constant Chars_Ptr_Array :=
                    Chars_Ptr_Pointers.Value (E.H_Aliases);
!       --  H_Aliases points to a list of name aliases. The list is terminated by
!       --  a NULL pointer.
  
        Addresses : constant In_Addr_Access_Array :=
                      In_Addr_Access_Pointers.Value (E.H_Addr_List);
!       --  H_Addr_List points to a list of binary addresses (in network byte
!       --  order). The list is terminated by a NULL pointer.
        --
        --  H_Length is not used because it is currently only set to 4.
        --  H_Addrtype is always AF_INET
*************** package body GNAT.Sockets is
*** 2016,2023 ****
        Source := Addresses'First;
        Target := Result.Addresses'First;
        while Target <= Result.Addresses_Length loop
!          Result.Addresses (Target) :=
!            To_Inet_Addr (Addresses (Source).all);
           Source := Source + 1;
           Target := Target + 1;
        end loop;
--- 2107,2113 ----
        Source := Addresses'First;
        Target := Result.Addresses'First;
        while Target <= Result.Addresses_Length loop
!          To_Inet_Addr (Addresses (Source).all, Result.Addresses (Target));
           Source := Source + 1;
           Target := Target + 1;
        end loop;
*************** package body GNAT.Sockets is
*** 2045,2060 ****
     -- To_Inet_Addr --
     ------------------
  
!    function To_Inet_Addr
!      (Addr : In_Addr) return Inet_Addr_Type
!    is
!       Result : Inet_Addr_Type;
     begin
        Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
        Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
        Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
        Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
-       return Result;
     end To_Inet_Addr;
  
     ------------
--- 2135,2148 ----
     -- To_Inet_Addr --
     ------------------
  
!    procedure To_Inet_Addr
!      (Addr   : In_Addr;
!       Result : out Inet_Addr_Type) is
     begin
        Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
        Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
        Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
        Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
     end To_Inet_Addr;
  
     ------------
*************** package body GNAT.Sockets is
*** 2074,2079 ****
--- 2162,2168 ----
              if Flags (J) = -1 then
                 Raise_Socket_Error (Constants.EOPNOTSUPP);
              end if;
+ 
              Result := Result + Flags (J);
           end if;
  
*************** package body GNAT.Sockets is
*** 2150,2174 ****
     -- To_Timeval --
     ----------------
  
!    function To_Timeval (Val : Selector_Duration) return Timeval is
!       S  : Timeval_Unit;
!       MS : Timeval_Unit;
  
     begin
        --  If zero, set result as zero (otherwise it gets rounded down to -1)
  
        if Val = 0.0 then
           S  := 0;
!          MS := 0;
  
        --  Normal case where we do round down
  
        else
!          S  := Timeval_Unit (Val - 0.5);
!          MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S)));
        end if;
  
!       return (S, MS);
     end To_Timeval;
  
     -----------
--- 2239,2263 ----
     -- To_Timeval --
     ----------------
  
!    function To_Timeval (Val : Timeval_Duration) return Timeval is
!       S  : time_t;
!       uS : suseconds_t;
  
     begin
        --  If zero, set result as zero (otherwise it gets rounded down to -1)
  
        if Val = 0.0 then
           S  := 0;
!          uS := 0;
  
        --  Normal case where we do round down
  
        else
!          S  := time_t (Val - 0.5);
!          uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)));
        end if;
  
!       return (S, uS);
     end To_Timeval;
  
     -----------
*************** package body GNAT.Sockets is
*** 2191,2198 ****
              Index,
              Stream.To);
  
!          --  Exit when all or zero data sent. Zero means that the
!          --  socket has been closed by peer.
  
           exit when Index < First or else Index = Max;
  
--- 2280,2287 ----
              Index,
              Stream.To);
  
!          --  Exit when all or zero data sent. Zero means that the socket has
!          --  been closed by peer.
  
           exit when Index < First or else Index = Max;
  
*************** package body GNAT.Sockets is
*** 2220,2227 ****
        loop
           Send_Socket (Stream.Socket, Item (First .. Max), Index);
  
!          --  Exit when all or zero data sent. Zero means that the
!          --  socket has been closed by peer.
  
           exit when Index < First or else Index = Max;
  
--- 2309,2316 ----
        loop
           Send_Socket (Stream.Socket, Item (First .. Max), Index);
  
!          --  Exit when all or zero data sent. Zero means that the socket has
!          --  been closed by peer.
  
           exit when Index < First or else Index = Max;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socket.ads gcc-4.1.0/gcc/ada/g-socket.ads
*** gcc-4.0.2/gcc/ada/g-socket.ads	Thu Feb 10 13:57:01 2005
--- gcc-4.1.0/gcc/ada/g-socket.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Sockets is
*** 433,440 ****
     --  treated like a wildcard enabling all addresses. No_Inet_Addr provides a
     --  special value to denote uninitialized inet addresses.
  
!    Any_Inet_Addr : constant Inet_Addr_Type;
!    No_Inet_Addr  : constant Inet_Addr_Type;
  
     type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record
        Addr : Inet_Addr_Type (Family);
--- 433,441 ----
     --  treated like a wildcard enabling all addresses. No_Inet_Addr provides a
     --  special value to denote uninitialized inet addresses.
  
!    Any_Inet_Addr       : constant Inet_Addr_Type;
!    No_Inet_Addr        : constant Inet_Addr_Type;
!    Broadcast_Inet_Addr : constant Inet_Addr_Type;
  
     type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record
        Addr : Inet_Addr_Type (Family);
*************** package GNAT.Sockets is
*** 488,494 ****
     Host_Error : exception;
     --  Exception raised by the two following procedures. Once raised, its
     --  message contains a string describing the error code. This exception is
!    --  raised when an host entry can not be retrieved.
  
     function Get_Host_By_Address
       (Address : Inet_Addr_Type;
--- 489,495 ----
     Host_Error : exception;
     --  Exception raised by the two following procedures. Once raised, its
     --  message contains a string describing the error code. This exception is
!    --  raised when an host entry cannot be retrieved.
  
     function Get_Host_By_Address
       (Address : Inet_Addr_Type;
*************** package GNAT.Sockets is
*** 594,599 ****
--- 595,610 ----
        Unknown_Server_Error,
        Cannot_Resolve_Error);
  
+    --  Timeval_Duration is a subtype of Standard.Duration because the full
+    --  range of Standard.Duration cannot be represented in the equivalent C
+    --  structure. Moreover, negative values are not allowed to avoid system
+    --  incompatibilities.
+ 
+    Immediate : constant := 0.0;
+    Forever   : constant := Duration (Integer'Last) * 1.0;
+ 
+    subtype Timeval_Duration is Duration range Immediate .. Forever;
+ 
     --  Get_Socket_Options and Set_Socket_Options manipulate options associated
     --  with a socket. Options may exist at multiple protocol levels in the
     --  communication stack. Socket_Level is the uppermost socket level.
*************** package GNAT.Sockets is
*** 609,626 ****
     --  a boolean to enable or disable this option.
  
     type Option_Name is (
!      Keep_Alive,      -- Enable sending of keep-alive messages
!      Reuse_Address,   -- Allow bind to reuse local address
!      Broadcast,       -- Enable datagram sockets to recv/send broadcast packets
!      Send_Buffer,     -- Set/get the maximum socket send buffer in bytes
!      Receive_Buffer,  -- Set/get the maximum socket recv buffer in bytes
!      Linger,          -- Shutdown wait for msg to be sent or timeout occur
!      Error,           -- Get and clear the pending socket error
!      No_Delay,        -- Do not delay send to coalesce packets (TCP_NODELAY)
!      Add_Membership,  -- Join a multicast group
!      Drop_Membership, -- Leave a multicast group
!      Multicast_TTL,   -- Indicate the time-to-live of sent multicast packets
!      Multicast_Loop); -- Sent multicast packets are looped to the local socket
  
     type Option_Type (Name : Option_Name := Keep_Alive) is record
        case Name is
--- 620,640 ----
     --  a boolean to enable or disable this option.
  
     type Option_Name is (
!      Keep_Alive,       -- Enable sending of keep-alive messages
!      Reuse_Address,    -- Allow bind to reuse local address
!      Broadcast,        -- Enable datagram sockets to recv/send broadcasts
!      Send_Buffer,      -- Set/get the maximum socket send buffer in bytes
!      Receive_Buffer,   -- Set/get the maximum socket recv buffer in bytes
!      Linger,           -- Shutdown wait for msg to be sent or timeout occur
!      Error,            -- Get and clear the pending socket error
!      No_Delay,         -- Do not delay send to coalesce packets (TCP_NODELAY)
!      Add_Membership,   -- Join a multicast group
!      Drop_Membership,  -- Leave a multicast group
!      Multicast_If,     -- Set default outgoing interface for multicast packets
!      Multicast_TTL,    -- Indicate the time-to-live of sent multicast packets
!      Multicast_Loop,   -- Sent multicast packets are looped to local socket
!      Send_Timeout,     -- Set timeout value for output
!      Receive_Timeout); -- Set timeout value for input
  
     type Option_Type (Name : Option_Name := Keep_Alive) is record
        case Name is
*************** package GNAT.Sockets is
*** 651,659 ****
--- 665,680 ----
              Multicast_Address : Inet_Addr_Type;
              Local_Interface   : Inet_Addr_Type;
  
+          when Multicast_If    =>
+             Outgoing_If : Inet_Addr_Type;
+ 
           when Multicast_TTL   =>
              Time_To_Live : Natural;
  
+          when Send_Timeout |
+               Receive_Timeout =>
+             Timeout : Timeval_Duration;
+ 
        end case;
     end record;
  
*************** package GNAT.Sockets is
*** 912,926 ****
     procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type);
     --  Insert Socket into Item
  
!    --  C select() waits for a number of file descriptors to change status.
!    --  Usually, three independent sets of descriptors are watched (read, write
!    --  and exception). A timeout gives an upper bound on the amount of time
!    --  elapsed before select returns. This function blocks until an event
!    --  occurs. On some platforms, C select can block the full process.
     --
     --  Check_Selector provides the very same behaviour. The only difference is
     --  that it does not watch for exception events. Note that on some
!    --  platforms it is kept process blocking in purpose. The timeout parameter
     --  allows the user to have the behaviour he wants. Abort_Selector allows
     --  to abort safely a Check_Selector that is blocked forever. A special
     --  file descriptor is opened by Create_Selector and included in each call
--- 933,948 ----
     procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type);
     --  Insert Socket into Item
  
!    --  The select(2) system call waits for events to occur on any of a set of
!    --  file descriptors. Usually, three independent sets of descriptors are
!    --  watched (read, write  and exception). A timeout gives an upper bound
!    --  on the amount of time elapsed before select returns. This function
!    --  blocks until an event occurs. On some platforms, the select(2) system
!    --  can block the full process (not just the calling thread).
     --
     --  Check_Selector provides the very same behaviour. The only difference is
     --  that it does not watch for exception events. Note that on some
!    --  platforms it is kept process blocking on purpose. The timeout parameter
     --  allows the user to have the behaviour he wants. Abort_Selector allows
     --  to abort safely a Check_Selector that is blocked forever. A special
     --  file descriptor is opened by Create_Selector and included in each call
*************** package GNAT.Sockets is
*** 933,947 ****
     type Selector_Type is limited private;
     type Selector_Access is access all Selector_Type;
  
!    --  Selector_Duration is a subtype of Standard.Duration because the full
!    --  range of Standard.Duration cannot be represented in the equivalent C
!    --  structure. Moreover, negative values are not allowed to avoid system
!    --  incompatibilities.
! 
!    Immediate : constant := 0.0;
!    Forever   : constant := Duration (Integer'Last) * 1.0;
! 
!    subtype Selector_Duration is Duration range Immediate .. Forever;
  
     procedure Create_Selector (Selector : out Selector_Type);
     --  Create a new selector
--- 955,961 ----
     type Selector_Type is limited private;
     type Selector_Access is access all Selector_Type;
  
!    subtype Selector_Duration is Timeval_Duration;
  
     procedure Create_Selector (Selector : out Selector_Type);
     --  Create a new selector
*************** package GNAT.Sockets is
*** 958,973 ****
        Status       : out Selector_Status;
        Timeout      : Selector_Duration := Forever);
     --  Return when one Socket in R_Socket_Set has some data to be read or if
!    --  one Socket in W_Socket_Set is ready to receive some data. In these
     --  cases Status is set to Completed and sockets that are ready are set in
     --  R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was
     --  ready after a Timeout expiration. Status is set to Aborted if an abort
     --  signal has been received while checking socket status. As this
     --  procedure returns when Timeout occurs, it is a design choice to keep
     --  this procedure process blocking. Note that a Timeout of 0.0 returns
!    --  immediately. Also note that two different objects must be passed as
!    --  R_Socket_Set and W_Socket_Set (even if they contain the same set of
!    --  Sockets), or some event will be lost.
  
     procedure Check_Selector
       (Selector     : in out Selector_Type;
--- 972,990 ----
        Status       : out Selector_Status;
        Timeout      : Selector_Duration := Forever);
     --  Return when one Socket in R_Socket_Set has some data to be read or if
!    --  one Socket in W_Socket_Set is ready to transmit some data. In these
     --  cases Status is set to Completed and sockets that are ready are set in
     --  R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was
     --  ready after a Timeout expiration. Status is set to Aborted if an abort
     --  signal has been received while checking socket status. As this
     --  procedure returns when Timeout occurs, it is a design choice to keep
     --  this procedure process blocking. Note that a Timeout of 0.0 returns
!    --  immediately. Also note that two different Socket_Set_Type objects must
!    --  be passed as R_Socket_Set and W_Socket_Set (even if they denote the
!    --  same set of Sockets), or some event may be lost.
!    --  Socket_Error is raised when the select(2) system call returns an
!    --  error condition, or when a read error occurs on the signalling socket
!    --  used for the implementation of Abort_Selector.
  
     procedure Check_Selector
       (Selector     : in out Selector_Type;
*************** private
*** 1027,1036 ****
     Any_Port : constant Port_Type := 0;
     No_Port  : constant Port_Type := 0;
  
!    Any_Inet_Addr : constant Inet_Addr_Type := (Family_Inet, (others => 0));
!    No_Inet_Addr  : constant Inet_Addr_Type := (Family_Inet, (others => 0));
  
!    No_Sock_Addr  : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0);
  
     Max_Name_Length : constant := 64;
     --  The constant MAXHOSTNAMELEN is usually set to 64
--- 1044,1057 ----
     Any_Port : constant Port_Type := 0;
     No_Port  : constant Port_Type := 0;
  
!    Any_Inet_Addr       : constant Inet_Addr_Type :=
!                            (Family_Inet, (others => 0));
!    No_Inet_Addr        : constant Inet_Addr_Type :=
!                            (Family_Inet, (others => 0));
!    Broadcast_Inet_Addr : constant Inet_Addr_Type :=
!                            (Family_Inet, (others => 255));
  
!    No_Sock_Addr : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0);
  
     Max_Name_Length : constant := 64;
     --  The constant MAXHOSTNAMELEN is usually set to 64
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-mingw.adb gcc-4.1.0/gcc/ada/g-socthi-mingw.adb
*** gcc-4.0.2/gcc/ada/g-socthi-mingw.adb	Wed Oct 27 12:27:15 2004
--- gcc-4.1.0/gcc/ada/g-socthi-mingw.adb	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  layer for use by the GNAT.Sockets package (g-socket.ads). This package
  --  should not be directly with'ed by an applications program.
  
! --  This version is for NT.
  
  with GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
  with Interfaces.C.Strings;   use Interfaces.C.Strings;
--- 35,41 ----
  --  layer for use by the GNAT.Sockets package (g-socket.ads). This package
  --  should not be directly with'ed by an applications program.
  
! --  This version is for NT
  
  with GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
  with Interfaces.C.Strings;   use Interfaces.C.Strings;
*************** package body GNAT.Sockets.Thin is
*** 59,66 ****
     function Standard_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
     pragma Import (Stdcall, Standard_Connect, "connect");
  
     function Standard_Select
--- 59,65 ----
     function Standard_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int;
     pragma Import (Stdcall, Standard_Connect, "connect");
  
     function Standard_Select
*************** package body GNAT.Sockets.Thin is
*** 68,75 ****
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access)
!       return      C.int;
     pragma Import (Stdcall, Standard_Select, "select");
  
     type Error_Type is
--- 67,73 ----
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access) return C.int;
     pragma Import (Stdcall, Standard_Select, "select");
  
     type Error_Type is
*************** package body GNAT.Sockets.Thin is
*** 239,246 ****
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int
     is
        Res : C.int;
  
--- 237,243 ----
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int
     is
        Res : C.int;
  
*************** package body GNAT.Sockets.Thin is
*** 263,270 ****
     function C_Readv
       (Socket : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return  C.int
     is
        Res : C.int;
        Count : C.int := 0;
--- 260,266 ----
     function C_Readv
       (Socket : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int
     is
        Res : C.int;
        Count : C.int := 0;
*************** package body GNAT.Sockets.Thin is
*** 299,306 ****
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access)
!       return      C.int
     is
        pragma Warnings (Off, Exceptfds);
  
--- 295,301 ----
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access) return C.int
     is
        pragma Warnings (Off, Exceptfds);
  
*************** package body GNAT.Sockets.Thin is
*** 409,414 ****
--- 404,434 ----
        return Res;
     end C_Select;
  
+    -----------------
+    -- C_Inet_Addr --
+    -----------------
+ 
+    function C_Inet_Addr
+      (Cp : C.Strings.chars_ptr) return C.int
+    is
+       use type C.unsigned_long;
+ 
+       function Internal_Inet_Addr
+         (Cp : C.Strings.chars_ptr) return C.unsigned_long;
+       pragma Import (Stdcall, Internal_Inet_Addr, "inet_addr");
+ 
+       Res : C.unsigned_long;
+    begin
+       Res := Internal_Inet_Addr (Cp);
+ 
+       if Res = C.unsigned_long'Last then
+          --  This value is returned in case of error
+          return -1;
+       else
+          return C.int (Internal_Inet_Addr (Cp));
+       end if;
+    end C_Inet_Addr;
+ 
     --------------
     -- C_Writev --
     --------------
*************** package body GNAT.Sockets.Thin is
*** 416,423 ****
     function C_Writev
       (Socket : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return   C.int
     is
        Res : C.int;
        Count : C.int := 0;
--- 436,442 ----
     function C_Writev
       (Socket : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int
     is
        Res : C.int;
        Count : C.int := 0;
*************** package body GNAT.Sockets.Thin is
*** 528,538 ****
     --------------------------
  
     function Socket_Error_Message
!      (Errno : Integer)
!      return  C.Strings.chars_ptr
     is
-       use GNAT.Sockets.Constants;
- 
     begin
        case Errno is
           when EINTR =>           return Error_Messages (N_EINTR);
--- 547,554 ----
     --------------------------
  
     function Socket_Error_Message
!      (Errno : Integer) return C.Strings.chars_ptr
     is
     begin
        case Errno is
           when EINTR =>           return Error_Messages (N_EINTR);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-mingw.ads gcc-4.1.0/gcc/ada/g-socthi-mingw.ads
*** gcc-4.0.2/gcc/ada/g-socthi-mingw.ads	Thu Nov 25 16:14:01 2004
--- gcc-4.1.0/gcc/ada/g-socthi-mingw.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Sockets.Thin is
*** 49,80 ****
     package C renames Interfaces.C;
  
     use type C.int;
!    --  So that we can declare the Failure constant below.
  
     Success : constant C.int :=  0;
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer;
!    --  Returns last socket error number.
  
     procedure Set_Socket_Errno (Errno : Integer);
!    --  Set last socket error number.
  
     function Socket_Error_Message
!      (Errno : Integer)
!       return  C.Strings.chars_ptr;
     --  Returns the error message string for the error number Errno. If
     --  Errno is not known it returns "Unknown system error".
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type Timeval_Unit is new C.long;
!    pragma Convention (C, Timeval_Unit);
  
     type Timeval is record
!       Tv_Sec  : Timeval_Unit;
!       Tv_Usec : Timeval_Unit;
     end record;
     pragma Convention (C, Timeval);
  
--- 49,92 ----
     package C renames Interfaces.C;
  
     use type C.int;
!    --  So that we can declare the Failure constant below
  
     Success : constant C.int :=  0;
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer;
!    --  Returns last socket error number
  
     procedure Set_Socket_Errno (Errno : Integer);
!    --  Set last socket error number
  
     function Socket_Error_Message
!      (Errno : Integer) return C.Strings.chars_ptr;
     --  Returns the error message string for the error number Errno. If
     --  Errno is not known it returns "Unknown system error".
  
+    function Host_Errno return Integer;
+    pragma Import (C, Host_Errno, "__gnat_get_h_errno");
+    --  Returns last host error number
+ 
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type time_t is
!      range -(2 ** (8 * Constants.SIZEOF_tv_sec - 1))
!           .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
!    for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
!    pragma Convention (C, time_t);
! 
!    type suseconds_t is
!      range -(2 ** (8 * Constants.SIZEOF_tv_usec - 1))
!           .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
!    for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
!    pragma Convention (C, suseconds_t);
  
     type Timeval is record
!       Tv_Sec  : time_t;
!       Tv_Usec : suseconds_t;
     end record;
     pragma Convention (C, Timeval);
  
*************** package GNAT.Sockets.Thin is
*** 335,341 ****
  
     procedure Free_Socket_Set
       (Set : Fd_Set_Access);
!    --  Free system-dependent socket set.
  
     procedure Get_Socket_From_Set
       (Set    : Fd_Set_Access;
--- 347,353 ----
  
     procedure Free_Socket_Set
       (Set : Fd_Set_Access);
!    --  Free system-dependent socket set
  
     procedure Get_Socket_From_Set
       (Set    : Fd_Set_Access;
*************** private
*** 395,401 ****
     pragma Import (Stdcall, C_Getservbyport, "getservbyport");
     pragma Import (Stdcall, C_Getsockname, "getsockname");
     pragma Import (Stdcall, C_Getsockopt, "getsockopt");
-    pragma Import (Stdcall, C_Inet_Addr, "inet_addr");
     pragma Import (Stdcall, C_Ioctl, "ioctlsocket");
     pragma Import (Stdcall, C_Listen, "listen");
     pragma Import (Stdcall, C_Recv, "recv");
--- 407,412 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-vms.adb gcc-4.1.0/gcc/ada/g-socthi-vms.adb
*** gcc-4.0.2/gcc/ada/g-socthi-vms.adb	Wed Oct 27 12:27:15 2004
--- gcc-4.1.0/gcc/ada/g-socthi-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Temporary version for Alpha/VMS.
  
  with GNAT.OS_Lib; use GNAT.OS_Lib;
  with GNAT.Task_Lock;
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Temporary version for Alpha/VMS
  
  with GNAT.OS_Lib; use GNAT.OS_Lib;
  with GNAT.Task_Lock;
*************** with Interfaces.C; use Interfaces.C;
*** 40,47 ****
  
  package body GNAT.Sockets.Thin is
  
!    Non_Blocking_Sockets : constant Fd_Set_Access
!      := New_Socket_Set (No_Socket_Set);
     --  When this package is initialized with Process_Blocking_IO set
     --  to True, sockets are set in non-blocking mode to avoid blocking
     --  the whole process when a thread wants to perform a blocking IO
--- 40,47 ----
  
  package body GNAT.Sockets.Thin is
  
!    Non_Blocking_Sockets : constant Fd_Set_Access :=
!                             New_Socket_Set (No_Socket_Set);
     --  When this package is initialized with Process_Blocking_IO set
     --  to True, sockets are set in non-blocking mode to avoid blocking
     --  the whole process when a thread wants to perform a blocking IO
*************** package body GNAT.Sockets.Thin is
*** 59,65 ****
     Thread_Blocking_IO : Boolean := True;
  
     Unknown_System_Error : constant C.Strings.chars_ptr :=
!      C.Strings.New_String ("Unknown system error");
  
     function Syscall_Accept
       (S       : C.int;
--- 59,65 ----
     Thread_Blocking_IO : Boolean := True;
  
     Unknown_System_Error : constant C.Strings.chars_ptr :=
!                             C.Strings.New_String ("Unknown system error");
  
     function Syscall_Accept
       (S       : C.int;
*************** package body GNAT.Sockets.Thin is
*** 99,106 ****
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int)
!       return  C.int;
     pragma Import (C, Syscall_Send, "send");
  
     function Syscall_Sendto
--- 99,105 ----
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int) return C.int;
     pragma Import (C, Syscall_Send, "send");
  
     function Syscall_Sendto
*************** package body GNAT.Sockets.Thin is
*** 109,116 ****
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int)
!       return  C.int;
     pragma Import (C, Syscall_Sendto, "sendto");
  
     function Syscall_Socket
--- 108,114 ----
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int) return C.int;
     pragma Import (C, Syscall_Sendto, "sendto");
  
     function Syscall_Socket
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-vms.ads gcc-4.1.0/gcc/ada/g-socthi-vms.ads
*** gcc-4.0.2/gcc/ada/g-socthi-vms.ads	Thu Nov 25 16:14:01 2004
--- gcc-4.1.0/gcc/ada/g-socthi-vms.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  layer for use by the GNAT.Sockets package (g-socket.ads). This package
  --  should not be directly with'ed by an applications program.
  
! --  This is the Alpha/VMS version.
  
  with Interfaces.C.Pointers;
  
--- 35,41 ----
  --  layer for use by the GNAT.Sockets package (g-socket.ads). This package
  --  should not be directly with'ed by an applications program.
  
! --  This is the Alpha/VMS version
  
  with Interfaces.C.Pointers;
  
*************** package GNAT.Sockets.Thin is
*** 58,78 ****
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number.
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
     --  Returns the error message string for the error number Errno. If
     --  Errno is not known it returns "Unknown system error".
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type Timeval_Unit is new C.int;
!    pragma Convention (C, Timeval_Unit);
  
     type Timeval is record
!       Tv_Sec  : Timeval_Unit;
!       Tv_Usec : Timeval_Unit;
     end record;
     pragma Convention (C, Timeval);
  
--- 58,91 ----
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
     --  Returns the error message string for the error number Errno. If
     --  Errno is not known it returns "Unknown system error".
  
+    function Host_Errno return Integer;
+    pragma Import (C, Host_Errno, "__gnat_get_h_errno");
+    --  Returns last host error number
+ 
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type time_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
!    for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
!    pragma Convention (C, time_t);
! 
!    type suseconds_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
!    for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
!    pragma Convention (C, suseconds_t);
  
     type Timeval is record
!       Tv_Sec  : time_t;
!       Tv_Usec : suseconds_t;
     end record;
     pragma Convention (C, Timeval);
  
*************** package GNAT.Sockets.Thin is
*** 197,290 ****
     function C_Accept
       (S       : C.int;
        Addr    : System.Address;
!       Addrlen : access C.int)
!       return    C.int;
  
     function C_Bind
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Close
!      (Fd   : C.int)
!       return C.int;
  
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Gethostbyaddr
       (Addr : System.Address;
        Len  : C.int;
!       Typ  : C.int)
!       return Hostent_Access;
  
     function C_Gethostbyname
!      (Name : C.char_array)
!       return Hostent_Access;
  
     function C_Gethostname
       (Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Getpeername
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int)
!       return    C.int;
  
     function C_Getservbyname
       (Name  : C.char_array;
!       Proto : C.char_array)
!       return Servent_Access;
  
     function C_Getservbyport
       (Port  : C.int;
!       Proto : C.char_array)
!       return Servent_Access;
  
     function C_Getsockname
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int)
!       return    C.int;
  
     function C_Getsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : access C.int)
!       return    C.int;
  
     function C_Inet_Addr
!      (Cp   : C.Strings.chars_ptr)
!       return C.int;
  
     function C_Ioctl
       (S    : C.int;
        Req  : C.int;
!       Arg  : Int_Access)
!       return C.int;
  
     function C_Listen (S, Backlog : C.int) return C.int;
  
     function C_Readv
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return   C.int;
  
     function C_Recv
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int)
!       return  C.int;
  
     function C_Recvfrom
       (S       : C.int;
--- 210,287 ----
     function C_Accept
       (S       : C.int;
        Addr    : System.Address;
!       Addrlen : access C.int) return C.int;
  
     function C_Bind
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Close
!      (Fd : C.int) return C.int;
  
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Gethostbyaddr
       (Addr : System.Address;
        Len  : C.int;
!       Typ  : C.int) return Hostent_Access;
  
     function C_Gethostbyname
!      (Name : C.char_array) return Hostent_Access;
  
     function C_Gethostname
       (Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Getpeername
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int) return C.int;
  
     function C_Getservbyname
       (Name  : C.char_array;
!       Proto : C.char_array) return Servent_Access;
  
     function C_Getservbyport
       (Port  : C.int;
!       Proto : C.char_array) return Servent_Access;
  
     function C_Getsockname
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int) return C.int;
  
     function C_Getsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : access C.int) return C.int;
  
     function C_Inet_Addr
!      (Cp   : C.Strings.chars_ptr) return C.int;
  
     function C_Ioctl
       (S    : C.int;
        Req  : C.int;
!       Arg  : Int_Access) return C.int;
  
     function C_Listen (S, Backlog : C.int) return C.int;
  
     function C_Readv
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int;
  
     function C_Recv
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int) return C.int;
  
     function C_Recvfrom
       (S       : C.int;
*************** package GNAT.Sockets.Thin is
*** 292,314 ****
        Len     : C.int;
        Flags   : C.int;
        From    : Sockaddr_In_Access;
!       Fromlen : access C.int)
!       return    C.int;
  
     function C_Select
       (Nfds      : C.int;
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access)
!       return      C.int;
  
     function C_Send
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int)
!       return  C.int;
  
     function C_Sendto
       (S     : C.int;
--- 289,308 ----
        Len     : C.int;
        Flags   : C.int;
        From    : Sockaddr_In_Access;
!       Fromlen : access C.int) return C.int;
  
     function C_Select
       (Nfds      : C.int;
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access) return C.int;
  
     function C_Send
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int) return C.int;
  
     function C_Sendto
       (S     : C.int;
*************** package GNAT.Sockets.Thin is
*** 316,360 ****
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int)
!       return  C.int;
  
     function C_Setsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : C.int)
!       return    C.int;
  
     function C_Shutdown
       (S    : C.int;
!       How  : C.int)
!       return C.int;
  
     function C_Socket
       (Domain   : C.int;
        Typ      : C.int;
!       Protocol : C.int)
!       return     C.int;
  
     function C_Strerror
!      (Errnum : C.int)
!       return   C.Strings.chars_ptr;
  
     function C_System
!      (Command : System.Address)
!       return    C.int;
  
     function C_Writev
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return   C.int;
  
     procedure Free_Socket_Set
!      (Set    : Fd_Set_Access);
!    --  Free system-dependent socket set.
  
     procedure Get_Socket_From_Set
       (Set    : Fd_Set_Access;
--- 310,347 ----
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int) return C.int;
  
     function C_Setsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : C.int) return C.int;
  
     function C_Shutdown
       (S    : C.int;
!       How  : C.int) return C.int;
  
     function C_Socket
       (Domain   : C.int;
        Typ      : C.int;
!       Protocol : C.int) return C.int;
  
     function C_Strerror
!      (Errnum : C.int) return C.Strings.chars_ptr;
  
     function C_System
!      (Command : System.Address) return C.int;
  
     function C_Writev
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int;
  
     procedure Free_Socket_Set
!      (Set : Fd_Set_Access);
!    --  Free system-dependent socket set
  
     procedure Get_Socket_From_Set
       (Set    : Fd_Set_Access;
*************** package GNAT.Sockets.Thin is
*** 369,375 ****
     procedure Insert_Socket_In_Set
       (Set    : Fd_Set_Access;
        Socket : C.int);
!    --  Insert socket in the socket set.
  
     function  Is_Socket_In_Set
       (Set    : Fd_Set_Access;
--- 356,362 ----
     procedure Insert_Socket_In_Set
       (Set    : Fd_Set_Access;
        Socket : C.int);
!    --  Insert socket in the socket set
  
     function  Is_Socket_In_Set
       (Set    : Fd_Set_Access;
*************** package GNAT.Sockets.Thin is
*** 387,394 ****
     --  set back to the real largest socket in the socket set.
  
     function  New_Socket_Set
!      (Set    : Fd_Set_Access)
!      return   Fd_Set_Access;
     --  Allocate a new socket set which is a system-dependent structure
     --  and initialize by copying Set if it is non-null, by making it
     --  empty otherwise.
--- 374,380 ----
     --  set back to the real largest socket in the socket set.
  
     function  New_Socket_Set
!      (Set : Fd_Set_Access) return Fd_Set_Access;
     --  Allocate a new socket set which is a system-dependent structure
     --  and initialize by copying Set if it is non-null, by making it
     --  empty otherwise.
*************** package GNAT.Sockets.Thin is
*** 396,402 ****
     procedure Remove_Socket_From_Set
       (Set    : Fd_Set_Access;
        Socket : C.int);
!    --  Remove socket from the socket set.
  
     procedure Finalize;
     procedure Initialize (Process_Blocking_IO : Boolean);
--- 382,388 ----
     procedure Remove_Socket_From_Set
       (Set    : Fd_Set_Access;
        Socket : C.int);
!    --  Remove socket from the socket set
  
     procedure Finalize;
     procedure Initialize (Process_Blocking_IO : Boolean);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-vxworks.adb gcc-4.1.0/gcc/ada/g-socthi-vxworks.adb
*** gcc-4.0.2/gcc/ada/g-socthi-vxworks.adb	Mon Aug  9 12:24:10 2004
--- gcc-4.1.0/gcc/ada/g-socthi-vxworks.adb	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Sockets.Thin is
*** 267,280 ****
        function To_Pointer is
          new Unchecked_Conversion (System.Address, int_Access);
  
!       procedure VxWorks_Gethostbyaddr
!         (Addr : C.int; Buf : out C.char_array);
!       pragma Import (C, VxWorks_Gethostbyaddr, "hostGetByAddr");
  
!       Host_Name : C.char_array (1 .. Max_Name_Length);
  
     begin
!       VxWorks_Gethostbyaddr (To_Pointer (Addr).all, Host_Name);
  
        In_Addr_Access_Ptr.all.all := To_In_Addr (To_Pointer (Addr).all);
        Local_Hostent.all.H_Name := C.Strings.New_Char_Array (Host_Name);
--- 267,285 ----
        function To_Pointer is
          new Unchecked_Conversion (System.Address, int_Access);
  
!       function VxWorks_hostGetByAddr
!         (Addr : C.int; Buf : System.Address) return C.int;
!       pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
  
!       Host_Name : aliased C.char_array (1 .. Max_Name_Length);
  
     begin
!       if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
!                                 Host_Name (Host_Name'First)'Address)
!            /= Constants.OK
!       then
!          return null;
!       end if;
  
        In_Addr_Access_Ptr.all.all := To_In_Addr (To_Pointer (Addr).all);
        Local_Hostent.all.H_Name := C.Strings.New_Char_Array (Host_Name);
*************** package body GNAT.Sockets.Thin is
*** 289,302 ****
     function C_Gethostbyname
       (Name : C.char_array) return Hostent_Access
     is
!       function VxWorks_Gethostbyname
          (Name : C.char_array) return C.int;
!       pragma Import (C, VxWorks_Gethostbyname, "hostGetByName");
  
        Addr : C.int;
  
     begin
!       Addr := VxWorks_Gethostbyname (Name);
  
        In_Addr_Access_Ptr.all.all := To_In_Addr (Addr);
        Local_Hostent.all.H_Name := C.Strings.New_Char_Array (To_C (Host_Name));
--- 294,310 ----
     function C_Gethostbyname
       (Name : C.char_array) return Hostent_Access
     is
!       function VxWorks_hostGetByName
          (Name : C.char_array) return C.int;
!       pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
  
        Addr : C.int;
  
     begin
!       Addr := VxWorks_hostGetByName (Name);
!       if Addr /= Constants.OK then
!          return null;
!       end if;
  
        In_Addr_Access_Ptr.all.all := To_In_Addr (Addr);
        Local_Hostent.all.H_Name := C.Strings.New_Char_Array (To_C (Host_Name));
*************** package body GNAT.Sockets.Thin is
*** 515,521 ****
  
     function Non_Blocking_Socket (S : C.int) return Boolean is
        R : Boolean;
- 
     begin
        Task_Lock.Lock;
        R := (Is_Socket_In_Set (Non_Blocking_Sockets, S) /= 0);
--- 523,528 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi-vxworks.ads gcc-4.1.0/gcc/ada/g-socthi-vxworks.ads
*** gcc-4.0.2/gcc/ada/g-socthi-vxworks.ads	Wed Oct 27 12:27:15 2004
--- gcc-4.1.0/gcc/ada/g-socthi-vxworks.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Sockets.Thin is
*** 57,77 ****
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number.
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
!    --  Returns the error message string for the error number Errno. If
!    --  Errno is not known it returns "Unknown system error".
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type Timeval_Unit is new C.int;
!    pragma Convention (C, Timeval_Unit);
  
     type Timeval is record
!       Tv_Sec  : Timeval_Unit;
!       Tv_Usec : Timeval_Unit;
     end record;
     pragma Convention (C, Timeval);
  
--- 57,90 ----
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
!    --  Returns the error message string for the error number Errno. If Errno is
!    --  not known it returns "Unknown system error".
! 
!    function Host_Errno return Integer;
!    pragma Import (C, Host_Errno, "__gnat_get_h_errno");
!    --  Returns last host error number
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type time_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
!    for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
!    pragma Convention (C, time_t);
! 
!    type suseconds_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
!    for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
!    pragma Convention (C, suseconds_t);
  
     type Timeval is record
!       Tv_Sec  : time_t;
!       Tv_Usec : suseconds_t;
     end record;
     pragma Convention (C, Timeval);
  
*************** package GNAT.Sockets.Thin is
*** 145,169 ****
       (Sin : Sockaddr_In_Access;
        Len : C.int);
     pragma Inline (Set_Length);
!    --  Set Sin.Sin_Length to Len.
  
     procedure Set_Family
       (Sin     : Sockaddr_In_Access;
        Family  : C.int);
     pragma Inline (Set_Family);
!    --  Set Sin.Sin_Family to Family.
  
     procedure Set_Port
       (Sin     : Sockaddr_In_Access;
        Port    : C.unsigned_short);
     pragma Inline (Set_Port);
!    --  Set Sin.Sin_Port to Port.
  
     procedure Set_Address
       (Sin        : Sockaddr_In_Access;
        Address    : In_Addr);
     pragma Inline (Set_Address);
!    --  Set Sin.Sin_Addr to Address.
  
     type Hostent is record
        H_Name      : C.Strings.chars_ptr;
--- 158,182 ----
       (Sin : Sockaddr_In_Access;
        Len : C.int);
     pragma Inline (Set_Length);
!    --  Set Sin.Sin_Length to Len
  
     procedure Set_Family
       (Sin     : Sockaddr_In_Access;
        Family  : C.int);
     pragma Inline (Set_Family);
!    --  Set Sin.Sin_Family to Family
  
     procedure Set_Port
       (Sin     : Sockaddr_In_Access;
        Port    : C.unsigned_short);
     pragma Inline (Set_Port);
!    --  Set Sin.Sin_Port to Port
  
     procedure Set_Address
       (Sin        : Sockaddr_In_Access;
        Address    : In_Addr);
     pragma Inline (Set_Address);
!    --  Set Sin.Sin_Addr to Address
  
     type Hostent is record
        H_Name      : C.Strings.chars_ptr;
*************** package GNAT.Sockets.Thin is
*** 199,292 ****
     function C_Accept
       (S       : C.int;
        Addr    : System.Address;
!       Addrlen : access C.int)
!       return    C.int;
  
     function C_Bind
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Close
!      (Fd   : C.int)
!       return C.int;
  
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Gethostbyaddr
       (Addr : System.Address;
        Len  : C.int;
!       Typ  : C.int)
!       return Hostent_Access;
  
     function C_Gethostbyname
!      (Name : C.char_array)
!       return Hostent_Access;
  
     function C_Gethostname
       (Name    : System.Address;
!       Namelen : C.int)
!       return    C.int;
  
     function C_Getpeername
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int)
!       return    C.int;
  
     function C_Getservbyname
       (Name  : C.char_array;
!       Proto : C.char_array)
!       return Servent_Access;
  
     function C_Getservbyport
       (Port  : C.int;
!       Proto : C.char_array)
!       return Servent_Access;
  
     function C_Getsockname
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int)
!       return    C.int;
  
     function C_Getsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : access C.int)
!       return    C.int;
  
     function C_Inet_Addr
!      (Cp   : C.Strings.chars_ptr)
!       return C.int;
  
     function C_Ioctl
!      (S    : C.int;
!       Req  : C.int;
!       Arg  : Int_Access)
!       return C.int;
  
     function C_Listen (S, Backlog : C.int) return C.int;
  
     function C_Readv
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return   C.int;
  
     function C_Recv
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int)
!       return  C.int;
  
     function C_Recvfrom
       (S       : C.int;
--- 212,289 ----
     function C_Accept
       (S       : C.int;
        Addr    : System.Address;
!       Addrlen : access C.int) return C.int;
  
     function C_Bind
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Close
!      (Fd : C.int) return C.int;
  
     function C_Connect
       (S       : C.int;
        Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Gethostbyaddr
       (Addr : System.Address;
        Len  : C.int;
!       Typ  : C.int) return Hostent_Access;
  
     function C_Gethostbyname
!      (Name : C.char_array) return Hostent_Access;
  
     function C_Gethostname
       (Name    : System.Address;
!       Namelen : C.int) return C.int;
  
     function C_Getpeername
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int) return C.int;
  
     function C_Getservbyname
       (Name  : C.char_array;
!       Proto : C.char_array) return Servent_Access;
  
     function C_Getservbyport
       (Port  : C.int;
!       Proto : C.char_array) return Servent_Access;
  
     function C_Getsockname
       (S       : C.int;
        Name    : System.Address;
!       Namelen : access C.int) return C.int;
  
     function C_Getsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : access C.int) return C.int;
  
     function C_Inet_Addr
!      (Cp : C.Strings.chars_ptr) return C.int;
  
     function C_Ioctl
!      (S   : C.int;
!       Req : C.int;
!       Arg : Int_Access) return C.int;
  
     function C_Listen (S, Backlog : C.int) return C.int;
  
     function C_Readv
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int;
  
     function C_Recv
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int) return C.int;
  
     function C_Recvfrom
       (S       : C.int;
*************** package GNAT.Sockets.Thin is
*** 294,316 ****
        Len     : C.int;
        Flags   : C.int;
        From    : Sockaddr_In_Access;
!       Fromlen : access C.int)
!       return    C.int;
  
     function C_Select
       (Nfds      : C.int;
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access)
!       return      C.int;
  
     function C_Send
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int)
!       return  C.int;
  
     function C_Sendto
       (S     : C.int;
--- 291,310 ----
        Len     : C.int;
        Flags   : C.int;
        From    : Sockaddr_In_Access;
!       Fromlen : access C.int) return C.int;
  
     function C_Select
       (Nfds      : C.int;
        Readfds   : Fd_Set_Access;
        Writefds  : Fd_Set_Access;
        Exceptfds : Fd_Set_Access;
!       Timeout   : Timeval_Access) return C.int;
  
     function C_Send
       (S     : C.int;
        Msg   : System.Address;
        Len   : C.int;
!       Flags : C.int) return C.int;
  
     function C_Sendto
       (S     : C.int;
*************** package GNAT.Sockets.Thin is
*** 318,361 ****
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int)
!       return  C.int;
  
     function C_Setsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : C.int)
!       return    C.int;
  
     function C_Shutdown
!      (S    : C.int;
!       How  : C.int)
!       return C.int;
  
     function C_Socket
       (Domain   : C.int;
        Typ      : C.int;
!       Protocol : C.int)
!       return     C.int;
  
     function C_Strerror
!      (Errnum : C.int)
!       return   C.Strings.chars_ptr;
  
     function C_System
!      (Command : System.Address)
!       return    C.int;
  
     function C_Writev
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int)
!       return   C.int;
  
     procedure Free_Socket_Set
!      (Set    : Fd_Set_Access);
     --  Free system-dependent socket set
  
     procedure Get_Socket_From_Set
--- 312,348 ----
        Len   : C.int;
        Flags : C.int;
        To    : Sockaddr_In_Access;
!       Tolen : C.int) return C.int;
  
     function C_Setsockopt
       (S       : C.int;
        Level   : C.int;
        Optname : C.int;
        Optval  : System.Address;
!       Optlen  : C.int) return C.int;
  
     function C_Shutdown
!      (S   : C.int;
!       How : C.int) return C.int;
  
     function C_Socket
       (Domain   : C.int;
        Typ      : C.int;
!       Protocol : C.int) return C.int;
  
     function C_Strerror
!      (Errnum : C.int) return C.Strings.chars_ptr;
  
     function C_System
!      (Command : System.Address) return C.int;
  
     function C_Writev
       (Fd     : C.int;
        Iov    : System.Address;
!       Iovcnt : C.int) return C.int;
  
     procedure Free_Socket_Set
!      (Set : Fd_Set_Access);
     --  Free system-dependent socket set
  
     procedure Get_Socket_From_Set
*************** package GNAT.Sockets.Thin is
*** 389,396 ****
     --  set back to the real largest socket in the socket set.
  
     function  New_Socket_Set
!      (Set    : Fd_Set_Access)
!      return   Fd_Set_Access;
     --  Allocate a new socket set which is a system-dependent structure
     --  and initialize by copying Set if it is non-null, by making it
     --  empty otherwise.
--- 376,382 ----
     --  set back to the real largest socket in the socket set.
  
     function  New_Socket_Set
!      (Set : Fd_Set_Access) return Fd_Set_Access;
     --  Allocate a new socket set which is a system-dependent structure
     --  and initialize by copying Set if it is non-null, by making it
     --  empty otherwise.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi.adb gcc-4.1.0/gcc/ada/g-socthi.adb
*** gcc-4.0.2/gcc/ada/g-socthi.adb	Mon Oct  4 14:49:35 2004
--- gcc-4.1.0/gcc/ada/g-socthi.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Sockets.Thin is
*** 127,133 ****
     procedure Disable_SIGPIPE (S : C.int);
     pragma Import (C, Disable_SIGPIPE, "__gnat_disable_sigpipe");
  
!    function  Non_Blocking_Socket (S : C.int) return Boolean;
     procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
  
     --------------
--- 127,133 ----
     procedure Disable_SIGPIPE (S : C.int);
     pragma Import (C, Disable_SIGPIPE, "__gnat_disable_sigpipe");
  
!    function Non_Blocking_Socket (S : C.int) return Boolean;
     procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
  
     --------------
*************** package body GNAT.Sockets.Thin is
*** 503,509 ****
  
        if C_Msg = C.Strings.Null_Ptr then
           return Unknown_System_Error;
- 
        else
           return C_Msg;
        end if;
--- 503,508 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-socthi.ads gcc-4.1.0/gcc/ada/g-socthi.ads
*** gcc-4.0.2/gcc/ada/g-socthi.ads	Wed Oct 27 12:27:16 2004
--- gcc-4.1.0/gcc/ada/g-socthi.ads	Tue Nov 15 13:50:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Sockets.Thin is
*** 59,79 ****
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number.
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
!    --  Returns the error message string for the error number Errno. If
!    --  Errno is not known it returns "Unknown system error".
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type Timeval_Unit is new C.int;
!    pragma Convention (C, Timeval_Unit);
  
     type Timeval is record
!       Tv_Sec  : Timeval_Unit;
!       Tv_Usec : Timeval_Unit;
     end record;
     pragma Convention (C, Timeval);
  
--- 59,92 ----
     Failure : constant C.int := -1;
  
     function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
!    --  Returns last socket error number
  
     function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
!    --  Returns the error message string for the error number Errno. If Errno is
!    --  not known it returns "Unknown system error".
! 
!    function Host_Errno return Integer;
!    pragma Import (C, Host_Errno, "__gnat_get_h_errno");
!    --  Returns last host error number
  
     subtype Fd_Set_Access is System.Address;
     No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
  
!    type time_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_sec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1;
!    for time_t'Size use 8 * Constants.SIZEOF_tv_sec;
!    pragma Convention (C, time_t);
! 
!    type suseconds_t is
!      range -2 ** (8 * Constants.SIZEOF_tv_usec - 1)
!          .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1;
!    for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec;
!    pragma Convention (C, suseconds_t);
  
     type Timeval is record
!       Tv_Sec  : time_t;
!       Tv_Usec : suseconds_t;
     end record;
     pragma Convention (C, Timeval);
  
*************** package GNAT.Sockets.Thin is
*** 357,373 ****
     procedure Last_Socket_In_Set
       (Set    : Fd_Set_Access;
        Last   : Int_Access);
!    --  Find the largest socket in the socket set. This is needed for
!    --  select(). When Last_Socket_In_Set is called, parameter Last is
!    --  a maximum value of the largest socket. This hint is used to
!    --  avoid scanning very large socket sets. After the call, Last is
!    --  set back to the real largest socket in the socket set.
  
     function  New_Socket_Set
       (Set : Fd_Set_Access) return Fd_Set_Access;
!    --  Allocate a new socket set which is a system-dependent structure
!    --  and initialize by copying Set if it is non-null, by making it
!    --  empty otherwise.
  
     procedure Remove_Socket_From_Set
       (Set    : Fd_Set_Access;
--- 370,386 ----
     procedure Last_Socket_In_Set
       (Set    : Fd_Set_Access;
        Last   : Int_Access);
!    --  Find the largest socket in the socket set. This is needed for select().
!    --  When Last_Socket_In_Set is called, parameter Last is a maximum value of
!    --  the largest socket. This hint is used to avoid scanning very large
!    --  socket sets. After the call, Last is set back to the real largest socket
!    --  in the socket set.
  
     function  New_Socket_Set
       (Set : Fd_Set_Access) return Fd_Set_Access;
!    --  Allocate a new socket set which is a system-dependent structure and
!    --  initialize by copying Set if it is non-null, by making it empty
!    --  otherwise.
  
     procedure Remove_Socket_From_Set
       (Set    : Fd_Set_Access;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soliop-mingw.ads gcc-4.1.0/gcc/ada/g-soliop-mingw.ads
*** gcc-4.0.2/gcc/ada/g-soliop-mingw.ads	Fri May 14 10:01:59 2004
--- gcc-4.1.0/gcc/ada/g-soliop-mingw.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2001-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  
  --  This is the Windows/NT version of this package
  
- 
  package GNAT.Sockets.Linker_Options is
  private
     pragma Linker_Options ("-lwsock32");
--- 36,41 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soliop-solaris.ads gcc-4.1.0/gcc/ada/g-soliop-solaris.ads
*** gcc-4.0.2/gcc/ada/g-soliop-solaris.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/g-soliop-solaris.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2001-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soliop-unixware.ads gcc-4.1.0/gcc/ada/g-soliop-unixware.ads
*** gcc-4.0.2/gcc/ada/g-soliop-unixware.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/g-soliop-unixware.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2002-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-soliop.ads gcc-4.1.0/gcc/ada/g-soliop.ads
*** gcc-4.0.2/gcc/ada/g-soliop.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-soliop.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2001-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-souinf.ads gcc-4.1.0/gcc/ada/g-souinf.ads
*** gcc-4.0.2/gcc/ada/g-souinf.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-souinf.ads	Mon Sep  5 07:54:01 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     G N A T . S O U R C E _ I N F O                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2000 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     G N A T . S O U R C E _ I N F O                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,53 ****
  --  the name of the source file in which the exception is handled.
  
  package GNAT.Source_Info is
! pragma Pure (Source_Info);
  
     function File return String;
     --  Return the name of the current file, not including the path information.
     --  The result is considered to be a static string constant.
  
     function Line return Positive;
!    --  Return the current input line number. The result is considered
!    --  to be a static expression.
  
     function Source_Location return String;
     --  Return a string literal of the form "name:line", where name is the
--- 39,53 ----
  --  the name of the source file in which the exception is handled.
  
  package GNAT.Source_Info is
!    pragma Pure;
  
     function File return String;
     --  Return the name of the current file, not including the path information.
     --  The result is considered to be a static string constant.
  
     function Line return Positive;
!    --  Return the current input line number. The result is considered to be a
!    --  static expression.
  
     function Source_Location return String;
     --  Return a string literal of the form "name:line", where name is the
*************** pragma Pure (Source_Info);
*** 61,72 ****
     --  Return the name of the current subprogram, package, task, entry or
     --  protected subprogram. The string is in exactly the form used for the
     --  declaration of the entity (casing and encoding conventions), and is
!    --  considered to be a static string constant.
     --
!    --  Note: if this function is used at the outer level of a generic
!    --  package, the string returned will be the name of the instance,
!    --  not the generic package itself. This is useful in identifying
!    --  and logging information from within generic templates.
  
  private
     pragma Import (Intrinsic, File);
--- 61,74 ----
     --  Return the name of the current subprogram, package, task, entry or
     --  protected subprogram. The string is in exactly the form used for the
     --  declaration of the entity (casing and encoding conventions), and is
!    --  considered to be a static string constant. The name is fully qualified
!    --  using periods where possible (this is not always possible, notably in
!    --  the case of entities appearing in unnamed block statements.)
     --
!    --  Note: if this function is used at the outer level of a generic package,
!    --  the string returned will be the name of the instance, not the generic
!    --  package itself. This is useful in identifying and logging information
!    --  from within generic templates.
  
  private
     pragma Import (Intrinsic, File);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-speche.adb gcc-4.1.0/gcc/ada/g-speche.adb
*** gcc-4.0.2/gcc/ada/g-speche.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-speche.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 G N A T . S P E L L I N G _ C H E C K E R                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1998-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 G N A T . S P E L L I N G _ C H E C K E R                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-speche.ads gcc-4.1.0/gcc/ada/g-speche.ads
*** gcc-4.0.2/gcc/ada/g-speche.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-speche.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 G N A T . S P E L L I N G _ C H E C K E R                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 1998 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 G N A T . S P E L L I N G _ C H E C K E R                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  This package provides a utility routine for checking for bad spellings
  
  package GNAT.Spelling_Checker is
! pragma Pure (Spelling_Checker);
  
     function Is_Bad_Spelling_Of
       (Found  : String;
--- 36,42 ----
  --  This package provides a utility routine for checking for bad spellings
  
  package GNAT.Spelling_Checker is
!    pragma Pure;
  
     function Is_Bad_Spelling_Of
       (Found  : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-spipat.adb gcc-4.1.0/gcc/ada/g-spipat.adb
*** gcc-4.0.2/gcc/ada/g-spipat.adb	Mon Oct  4 14:59:42 2004
--- gcc-4.1.0/gcc/ada/g-spipat.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1998-2004, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  we use the one stack approach developed in the SPITBOL implementation.
  
  with Ada.Exceptions;            use Ada.Exceptions;
- with Ada.Strings.Maps;          use Ada.Strings.Maps;
  with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
  
  with GNAT.Debug_Utilities;      use GNAT.Debug_Utilities;
--- 37,42 ----
*************** package body GNAT.Spitbol.Patterns is
*** 218,224 ****
     type PE (Pcode : Pattern_Code) is record
  
        Index : IndexT;
!       --  Serial index number of pattern element within pattern.
  
        Pthen : PE_Ptr;
        --  Successor element, to be matched after this one
--- 217,223 ----
     type PE (Pcode : Pattern_Code) is record
  
        Index : IndexT;
!       --  Serial index number of pattern element within pattern
  
        Pthen : PE_Ptr;
        --  Successor element, to be matched after this one
*************** package body GNAT.Spitbol.Patterns is
*** 734,740 ****
        --  pointer to Y node, which is the PC_Arb_Y node that matches one
        --  extra character and restacks itself.
  
!       --  The PC_Arb_X node is numbered 2, and the PC_Arb_Y node is 1.
  
        -------------------------
        -- Arbno (simple case) --
--- 733,739 ----
        --  pointer to Y node, which is the PC_Arb_Y node that matches one
        --  extra character and restacks itself.
  
!       --  The PC_Arb_X node is numbered 2, and the PC_Arb_Y node is 1
  
        -------------------------
        -- Arbno (simple case) --
*************** package body GNAT.Spitbol.Patterns is
*** 1239,1245 ****
  
     function Is_In (C : Character; Str : String) return Boolean;
     pragma Inline (Is_In);
!    --  Determines if the character C is in string Str.
  
     procedure Logic_Error;
     --  Called to raise Program_Error with an appropriate message if an
--- 1238,1244 ----
  
     function Is_In (C : Character; Str : String) return Boolean;
     pragma Inline (Is_In);
!    --  Determines if the character C is in string Str
  
     procedure Logic_Error;
     --  Called to raise Program_Error with an appropriate message if an
*************** package body GNAT.Spitbol.Patterns is
*** 1670,1676 ****
     --    | Y |---->
     --    +---+
  
!    --  The PC_Arb_X element is numbered 2, and the PC_Arb_Y element is 1.
  
     function Arb return Pattern is
        Y : constant PE_Ptr := new PE'(PC_Arb_Y, 1, EOP);
--- 1669,1675 ----
     --    | Y |---->
     --    +---+
  
!    --  The PC_Arb_X element is numbered 2, and the PC_Arb_Y element is 1
  
     function Arb return Pattern is
        Y : constant PE_Ptr := new PE'(PC_Arb_Y, 1, EOP);
*************** package body GNAT.Spitbol.Patterns is
*** 2028,2034 ****
              --  References to elements in P, indexed by Index field
  
              Copy : Ref_Array (1 .. P.Index);
!             --  Holds copies of elements of P, indexed by Index field.
  
              E : PE_Ptr;
  
--- 2027,2033 ----
              --  References to elements in P, indexed by Index field
  
              Copy : Ref_Array (1 .. P.Index);
!             --  Holds copies of elements of P, indexed by Index field
  
              E : PE_Ptr;
  
*************** package body GNAT.Spitbol.Patterns is
*** 2090,2096 ****
        E : PE_Ptr;
  
        procedure Write_Node_Id (E : PE_Ptr);
!       --  Writes out a string identifying the given pattern element.
  
        procedure Write_Node_Id (E : PE_Ptr) is
        begin
--- 2089,2095 ----
        E : PE_Ptr;
  
        procedure Write_Node_Id (E : PE_Ptr);
!       --  Writes out a string identifying the given pattern element
  
        procedure Write_Node_Id (E : PE_Ptr) is
        begin
*************** package body GNAT.Spitbol.Patterns is
*** 2428,2434 ****
              when PC_Alt => Alt : declare
  
                 Elmts_In_L : constant IndexT := E.Pthen.Index - E.Alt.Index;
!                --  Number of elements in left pattern of alternation.
  
                 Lowest_In_L : constant IndexT := E.Index - Elmts_In_L;
                 --  Number of lowest index in elements of left pattern
--- 2427,2433 ----
              when PC_Alt => Alt : declare
  
                 Elmts_In_L : constant IndexT := E.Pthen.Index - E.Alt.Index;
!                --  Number of elements in left pattern of alternation
  
                 Lowest_In_L : constant IndexT := E.Index - Elmts_In_L;
                 --  Number of lowest index in elements of left pattern
*************** package body GNAT.Spitbol.Patterns is
*** 2802,2817 ****
  
     function Match
       (Subject : VString;
!       Pat     : Pattern)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        return Start /= 0;
--- 2801,2820 ----
  
     function Match
       (Subject : VString;
!       Pat     : Pattern) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        return Start /= 0;
*************** package body GNAT.Spitbol.Patterns is
*** 2819,2826 ****
  
     function Match
       (Subject : String;
!       Pat     : Pattern)
!       return    Boolean
     is
        Start, Stop : Natural;
        subtype String1 is String (1 .. Subject'Length);
--- 2822,2828 ----
  
     function Match
       (Subject : String;
!       Pat     : Pattern) return Boolean
     is
        Start, Stop : Natural;
        subtype String1 is String (1 .. Subject'Length);
*************** package body GNAT.Spitbol.Patterns is
*** 2838,2861 ****
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : VString)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
           return False;
        else
           Replace_Slice
!            (Subject'Unrestricted_Access.all,
!             Start, Stop, Get_String (Replace).all);
           return True;
        end if;
     end Match;
--- 2840,2867 ----
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : VString) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
           return False;
        else
+          Get_String (Replace, S, L);
           Replace_Slice
!            (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L));
           return True;
        end if;
     end Match;
*************** package body GNAT.Spitbol.Patterns is
*** 2863,2878 ****
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : String)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
--- 2869,2888 ----
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : String) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
*************** package body GNAT.Spitbol.Patterns is
*** 2888,2902 ****
       (Subject : VString;
        Pat     : Pattern)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
- 
     end Match;
  
     procedure Match
--- 2898,2916 ----
       (Subject : VString;
        Pat     : Pattern)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
     end Match;
  
     procedure Match
*************** package body GNAT.Spitbol.Patterns is
*** 2918,2934 ****
        Pat     : Pattern;
        Replace : VString)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start /= 0 then
!          Replace_Slice (Subject, Start, Stop, Get_String (Replace).all);
        end if;
     end Match;
  
--- 2932,2954 ----
        Pat     : Pattern;
        Replace : VString)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start /= 0 then
!          Get_String (Replace, S, L);
!          Replace_Slice (Subject, Start, Stop, S (1 .. L));
        end if;
     end Match;
  
*************** package body GNAT.Spitbol.Patterns is
*** 2937,2949 ****
        Pat     : Pattern;
        Replace : String)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start /= 0 then
--- 2957,2974 ----
        Pat     : Pattern;
        Replace : String)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start /= 0 then
*************** package body GNAT.Spitbol.Patterns is
*** 2953,2976 ****
  
     function Match
       (Subject : VString;
!       Pat     : PString)
!       return    Boolean
     is
!       Pat_Len : constant Natural       := Pat'Length;
!       Sub_Len : constant Natural       := Length (Subject);
!       Sub_Str : constant String_Access := Get_String (Subject);
  
     begin
        if Anchored_Mode then
!          if Pat_Len > Sub_Len then
              return False;
           else
!             return Pat = Sub_Str.all (1 .. Pat_Len);
           end if;
  
        else
!          for J in 1 .. Sub_Len - Pat_Len + 1 loop
!             if Pat = Sub_Str.all (J .. J + (Pat_Len - 1)) then
                 return True;
              end if;
           end loop;
--- 2978,3002 ----
  
     function Match
       (Subject : VString;
!       Pat     : PString) return Boolean
     is
!       Pat_Len : constant Natural := Pat'Length;
!       S       : String_Access;
!       L       : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Anchored_Mode then
!          if Pat_Len > L then
              return False;
           else
!             return Pat = S (1 .. Pat_Len);
           end if;
  
        else
!          for J in 1 .. L - Pat_Len + 1 loop
!             if Pat = S (J .. J + (Pat_Len - 1)) then
                 return True;
              end if;
           end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 2981,2988 ****
  
     function Match
       (Subject : String;
!       Pat     : PString)
!       return    Boolean
     is
        Pat_Len : constant Natural := Pat'Length;
        Sub_Len : constant Natural := Subject'Length;
--- 3007,3013 ----
  
     function Match
       (Subject : String;
!       Pat     : PString) return Boolean
     is
        Pat_Len : constant Natural := Pat'Length;
        Sub_Len : constant Natural := Subject'Length;
*************** package body GNAT.Spitbol.Patterns is
*** 3010,3033 ****
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : VString)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start = 0 then
           return False;
        else
           Replace_Slice
!            (Subject'Unrestricted_Access.all,
!             Start, Stop, Get_String (Replace).all);
           return True;
        end if;
     end Match;
--- 3035,3062 ----
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : VString) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start = 0 then
           return False;
        else
+          Get_String (Replace, S, L);
           Replace_Slice
!            (Subject'Unrestricted_Access.all, Start, Stop, S (1 .. L));
           return True;
        end if;
     end Match;
*************** package body GNAT.Spitbol.Patterns is
*** 3035,3050 ****
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : String)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start = 0 then
--- 3064,3083 ----
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : String) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start = 0 then
*************** package body GNAT.Spitbol.Patterns is
*** 3060,3072 ****
       (Subject : VString;
        Pat     : PString)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        end if;
     end Match;
  
--- 3093,3110 ----
       (Subject : VString;
        Pat     : PString)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        end if;
     end Match;
  
*************** package body GNAT.Spitbol.Patterns is
*** 3090,3106 ****
        Pat     : PString;
        Replace : VString)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start /= 0 then
!          Replace_Slice (Subject, Start, Stop, Get_String (Replace).all);
        end if;
     end Match;
  
--- 3128,3150 ----
        Pat     : PString;
        Replace : VString)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start /= 0 then
!          Get_String (Replace, S, L);
!          Replace_Slice (Subject, Start, Stop, S (1 .. L));
        end if;
     end Match;
  
*************** package body GNAT.Spitbol.Patterns is
*** 3109,3121 ****
        Pat     : PString;
        Replace : String)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start /= 0 then
--- 3153,3170 ----
        Pat     : PString;
        Replace : String)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        else
!          XMatch  (S (1 .. L), S_To_PE (Pat), 0, Start, Stop);
        end if;
  
        if Start /= 0 then
*************** package body GNAT.Spitbol.Patterns is
*** 3126,3141 ****
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Result  : Match_Result_Var)
!       return    Boolean
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
--- 3175,3194 ----
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Result  : Match_Result_Var) return Boolean
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
*************** package body GNAT.Spitbol.Patterns is
*** 3155,3172 ****
        Pat     : Pattern;
        Result  : out Match_Result)
     is
!       Start, Stop : Natural;
  
     begin
        if Debug_Mode then
!          XMatchD (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (Get_String (Subject).all, Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
           Result.Var := null;
- 
        else
           Result.Var   := Subject'Unrestricted_Access;
           Result.Start := Start;
--- 3208,3229 ----
        Pat     : Pattern;
        Result  : out Match_Result)
     is
!       Start : Natural;
!       Stop  : Natural;
!       S     : String_Access;
!       L     : Natural;
  
     begin
+       Get_String (Subject, S, L);
+ 
        if Debug_Mode then
!          XMatchD (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        else
!          XMatch  (S (1 .. L), Pat.P, Pat.Stk, Start, Stop);
        end if;
  
        if Start = 0 then
           Result.Var := null;
        else
           Result.Var   := Subject'Unrestricted_Access;
           Result.Start := Start;
*************** package body GNAT.Spitbol.Patterns is
*** 3302,3314 ****
       (Result  : in out Match_Result;
        Replace : VString)
     is
     begin
        if Result.Var /= null then
!          Replace_Slice
!            (Result.Var.all,
!             Result.Start,
!             Result.Stop,
!             Get_String (Replace).all);
           Result.Var := null;
        end if;
     end Replace;
--- 3359,3372 ----
       (Result  : in out Match_Result;
        Replace : VString)
     is
+       S : String_Access;
+       L : Natural;
+ 
     begin
+       Get_String (Replace, S, L);
+ 
        if Result.Var /= null then
!          Replace_Slice (Result.Var.all, Result.Start, Result.Stop, S (1 .. L));
           Result.Var := null;
        end if;
     end Replace;
*************** package body GNAT.Spitbol.Patterns is
*** 3487,3493 ****
  
     function Str_BF (A : Boolean_Func) return String is
        function To_A is new Unchecked_Conversion (Boolean_Func, Address);
- 
     begin
        return "BF(" & Image (To_A (A)) & ')';
     end Str_BF;
--- 3545,3550 ----
*************** package body GNAT.Spitbol.Patterns is
*** 3507,3513 ****
  
     function Str_NF (A : Natural_Func) return String is
        function To_A is new Unchecked_Conversion (Natural_Func, Address);
- 
     begin
        return "NF(" & Image (To_A (A)) & ')';
     end Str_NF;
--- 3564,3569 ----
*************** package body GNAT.Spitbol.Patterns is
*** 3536,3542 ****
  
     function Str_VF (A : VString_Func) return String is
        function To_A is new Unchecked_Conversion (VString_Func, Address);
- 
     begin
        return "VF(" & Image (To_A (A)) & ')';
     end Str_VF;
--- 3592,3597 ----
*************** package body GNAT.Spitbol.Patterns is
*** 3623,3629 ****
        --  failure and popping a "real" cursor value from the stack.
  
        PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
!       --  Dummy pattern element used in the unanchored case.
  
        Stack : Stack_Type;
        --  The pattern matching failure stack for this call to Match
--- 3678,3684 ----
        --  failure and popping a "real" cursor value from the stack.
  
        PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
!       --  Dummy pattern element used in the unanchored case
  
        Stack : Stack_Type;
        --  The pattern matching failure stack for this call to Match
*************** package body GNAT.Spitbol.Patterns is
*** 3897,3908 ****
           --  Any (string function case)
  
           when PC_Any_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 3952,3966 ----
           --  Any (string function case)
  
           when PC_Any_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 3914,3924 ****
           --  Any (string pointer case)
  
           when PC_Any_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 3972,3986 ----
           --  Any (string pointer case)
  
           when PC_Any_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 3998,4004 ****
           when PC_Assign =>
              goto Fail;
  
!          --  Assign immediate. This node performs the actual assignment.
  
           when PC_Assign_Imm =>
              Set_String
--- 4060,4066 ----
           when PC_Assign =>
              goto Fail;
  
!          --  Assign immediate. This node performs the actual assignment
  
           when PC_Assign_Imm =>
              Set_String
*************** package body GNAT.Spitbol.Patterns is
*** 4077,4088 ****
           --  Break (string function case)
  
           when PC_Break_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 4139,4153 ----
           --  Break (string function case)
  
           when PC_Break_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 4095,4105 ****
           --  Break (string pointer case)
  
           when PC_Break_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 4160,4174 ----
           --  Break (string pointer case)
  
           when PC_Break_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 4138,4149 ****
           --  BreakX (string function case)
  
           when PC_BreakX_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 4207,4221 ----
           --  BreakX (string function case)
  
           when PC_BreakX_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 4156,4166 ****
           --  BreakX (string pointer case)
  
           when PC_BreakX_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 4228,4242 ----
           --  BreakX (string pointer case)
  
           when PC_BreakX_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 4298,4310 ****
           --  NotAny (string function case)
  
           when PC_NotAny_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 4374,4389 ----
           --  NotAny (string function case)
  
           when PC_NotAny_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 4316,4327 ****
           --  NotAny (string pointer case)
  
           when PC_NotAny_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 4395,4410 ----
           --  NotAny (string pointer case)
  
           when PC_NotAny_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 4355,4366 ****
           --  NSpan (string function case)
  
           when PC_NSpan_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              loop
                 Cursor := Cursor + 1;
              end loop;
--- 4438,4452 ----
           --  NSpan (string function case)
  
           when PC_NSpan_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              loop
                 Cursor := Cursor + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 4371,4381 ****
           --  NSpan (string pointer case)
  
           when PC_NSpan_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              loop
                 Cursor := Cursor + 1;
              end loop;
--- 4457,4471 ----
           --  NSpan (string pointer case)
  
           when PC_NSpan_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              loop
                 Cursor := Cursor + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 4591,4603 ****
           --  Span (string function case)
  
           when PC_Span_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
!             P   : Natural := Cursor;
  
           begin
              while P < Length
!               and then Is_In (Subject (P + 1), Str.all)
              loop
                 P := P + 1;
              end loop;
--- 4681,4697 ----
           --  Span (string function case)
  
           when PC_Span_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
!             P : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
+             P := Cursor;
              while P < Length
!               and then Is_In (Subject (P + 1), S (1 .. L))
              loop
                 P := P + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 4613,4624 ****
           --  Span (string pointer case)
  
           when PC_Span_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
!             P   : Natural := Cursor;
  
           begin
              while P < Length
!               and then Is_In (Subject (P + 1), Str.all)
              loop
                 P := P + 1;
              end loop;
--- 4707,4723 ----
           --  Span (string pointer case)
  
           when PC_Span_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
!             P : Natural;
  
           begin
+             Get_String (U, S, L);
+ 
+             P := Cursor;
              while P < Length
!               and then Is_In (Subject (P + 1), S (1 .. L))
              loop
                 P := P + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 4710,4724 ****
           --  String (function case)
  
           when PC_String_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
!             Len : constant Natural       := Str'Length;
  
           begin
!             if (Length - Cursor) >= Len
!               and then Str.all = Subject (Cursor + 1 .. Cursor + Len)
              then
!                Cursor := Cursor + Len;
                 goto Succeed;
              else
                 goto Fail;
--- 4809,4825 ----
           --  String (function case)
  
           when PC_String_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
! 
!             if (Length - Cursor) >= L
!               and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
              then
!                Cursor := Cursor + L;
                 goto Succeed;
              else
                 goto Fail;
*************** package body GNAT.Spitbol.Patterns is
*** 4728,4741 ****
           --  String (pointer case)
  
           when PC_String_VP => declare
!             S   : constant String_Access := Get_String (Node.VP.all);
!             Len : constant Natural       := S'Length;
  
           begin
!             if (Length - Cursor) >= Len
!               and then S.all = Subject (Cursor + 1 .. Cursor + Len)
              then
!                Cursor := Cursor + Len;
                 goto Succeed;
              else
                 goto Fail;
--- 4829,4845 ----
           --  String (pointer case)
  
           when PC_String_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
! 
!             if (Length - Cursor) >= L
!               and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
              then
!                Cursor := Cursor + L;
                 goto Succeed;
              else
                 goto Fail;
*************** package body GNAT.Spitbol.Patterns is
*** 4871,4877 ****
        --  failure and popping a "real" cursor value from the stack.
  
        PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
!       --  Dummy pattern element used in the unanchored case.
  
        Region_Level : Natural := 0;
        --  Keeps track of recursive region level. This is used only for
--- 4975,4981 ----
        --  failure and popping a "real" cursor value from the stack.
  
        PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
!       --  Dummy pattern element used in the unanchored case
  
        Region_Level : Natural := 0;
        --  Keeps track of recursive region level. This is used only for
*************** package body GNAT.Spitbol.Patterns is
*** 4901,4907 ****
        --  successful match.
  
        procedure Dout (Str : String);
!       --  Output string to standard error with bars indicating region level.
  
        procedure Dout (Str : String; A : Character);
        --  Calls Dout with the string S ('A')
--- 5005,5011 ----
        --  successful match.
  
        procedure Dout (Str : String);
!       --  Output string to standard error with bars indicating region level
  
        procedure Dout (Str : String; A : Character);
        --  Calls Dout with the string S ('A')
*************** package body GNAT.Spitbol.Patterns is
*** 5251,5264 ****
           --  Any (string function case)
  
           when PC_Any_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
!             Dout (Img (Node) & "matching Any", Str.all);
  
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 5355,5371 ----
           --  Any (string function case)
  
           when PC_Any_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
! 
!             Dout (Img (Node) & "matching Any", S (1 .. L));
  
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 5270,5282 ****
           --  Any (string pointer case)
  
           when PC_Any_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
!             Dout (Img (Node) & "matching Any", Str.all);
  
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 5377,5392 ----
           --  Any (string pointer case)
  
           when PC_Any_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching Any", S (1 .. L));
  
              if Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 5366,5372 ****
              Dout (Img (Node) & "deferred assign/write cancelled");
              goto Fail;
  
!          --  Assign immediate. This node performs the actual assignment.
  
           when PC_Assign_Imm =>
              Dout
--- 5476,5482 ----
              Dout (Img (Node) & "deferred assign/write cancelled");
              goto Fail;
  
!          --  Assign immediate. This node performs the actual assignment
  
           when PC_Assign_Imm =>
              Dout
*************** package body GNAT.Spitbol.Patterns is
*** 5454,5467 ****
           --  Break (string function case)
  
           when PC_Break_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
!             Dout (Img (Node) & "matching Break", Str.all);
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 5564,5579 ----
           --  Break (string function case)
  
           when PC_Break_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching Break", S (1 .. L));
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 5474,5486 ****
           --  Break (string pointer case)
  
           when PC_Break_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
!             Dout (Img (Node) & "matching Break", Str.all);
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 5586,5601 ----
           --  Break (string pointer case)
  
           when PC_Break_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching Break", S (1 .. L));
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 5523,5536 ****
           --  BreakX (string function case)
  
           when PC_BreakX_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
!             Dout (Img (Node) & "matching BreakX", Str.all);
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 5638,5653 ----
           --  BreakX (string function case)
  
           when PC_BreakX_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching BreakX", S (1 .. L));
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 5543,5555 ****
           --  BreakX (string pointer case)
  
           when PC_BreakX_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
!             Dout (Img (Node) & "matching BreakX", Str.all);
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), Str.all) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
--- 5660,5675 ----
           --  BreakX (string pointer case)
  
           when PC_BreakX_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching BreakX", S (1 .. L));
  
              while Cursor < Length loop
!                if Is_In (Subject (Cursor + 1), S (1 .. L)) then
                    goto Succeed;
                 else
                    Cursor := Cursor + 1;
*************** package body GNAT.Spitbol.Patterns is
*** 5565,5571 ****
  
           when PC_BreakX_X =>
              Dout (Img (Node) & "extending BreakX");
- 
              Cursor := Cursor + 1;
              goto Succeed;
  
--- 5685,5690 ----
*************** package body GNAT.Spitbol.Patterns is
*** 5708,5722 ****
           --  NotAny (string function case)
  
           when PC_NotAny_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
!             Dout (Img (Node) & "matching NotAny", Str.all);
  
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 5827,5843 ----
           --  NotAny (string function case)
  
           when PC_NotAny_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching NotAny", S (1 .. L));
  
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 5728,5741 ****
           --  NotAny (string pointer case)
  
           when PC_NotAny_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
!             Dout (Img (Node) & "matching NotAny", Str.all);
  
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), Str.all)
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
--- 5849,5865 ----
           --  NotAny (string pointer case)
  
           when PC_NotAny_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching NotAny", S (1 .. L));
  
              if Cursor < Length
                and then
!                 not Is_In (Subject (Cursor + 1), S (1 .. L))
              then
                 Cursor := Cursor + 1;
                 goto Succeed;
*************** package body GNAT.Spitbol.Patterns is
*** 5773,5786 ****
           --  NSpan (string function case)
  
           when PC_NSpan_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
  
           begin
!             Dout (Img (Node) & "matching NSpan", Str.all);
  
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              loop
                 Cursor := Cursor + 1;
              end loop;
--- 5897,5912 ----
           --  NSpan (string function case)
  
           when PC_NSpan_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching NSpan", S (1 .. L));
  
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              loop
                 Cursor := Cursor + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 5791,5803 ****
           --  NSpan (string pointer case)
  
           when PC_NSpan_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
  
           begin
!             Dout (Img (Node) & "matching NSpan", Str.all);
  
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), Str.all)
              loop
                 Cursor := Cursor + 1;
              end loop;
--- 5917,5932 ----
           --  NSpan (string pointer case)
  
           when PC_NSpan_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching NSpan", S (1 .. L));
  
              while Cursor < Length
!               and then Is_In (Subject (Cursor + 1), S (1 .. L))
              loop
                 Cursor := Cursor + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 6044,6058 ****
           --  Span (string function case)
  
           when PC_Span_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
!             P   : Natural := Cursor;
  
           begin
!             Dout (Img (Node) & "matching Span", Str.all);
  
              while P < Length
!               and then Is_In (Subject (P + 1), Str.all)
              loop
                 P := P + 1;
              end loop;
--- 6173,6190 ----
           --  Span (string function case)
  
           when PC_Span_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
!             P : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching Span", S (1 .. L));
  
+             P := Cursor;
              while P < Length
!               and then Is_In (Subject (P + 1), S (1 .. L))
              loop
                 P := P + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 6068,6081 ****
           --  Span (string pointer case)
  
           when PC_Span_VP => declare
!             Str : constant String_Access := Get_String (Node.VP.all);
!             P   : Natural := Cursor;
  
           begin
!             Dout (Img (Node) & "matching Span", Str.all);
  
              while P < Length
!               and then Is_In (Subject (P + 1), Str.all)
              loop
                 P := P + 1;
              end loop;
--- 6200,6217 ----
           --  Span (string pointer case)
  
           when PC_Span_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
!             P : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching Span", S (1 .. L));
  
+             P := Cursor;
              while P < Length
!               and then Is_In (Subject (P + 1), S (1 .. L))
              loop
                 P := P + 1;
              end loop;
*************** package body GNAT.Spitbol.Patterns is
*** 6179,6195 ****
           --  String (function case)
  
           when PC_String_VF => declare
!             U   : constant VString       := Node.VF.all;
!             Str : constant String_Access := Get_String (U);
!             Len : constant Natural       := Str'Length;
  
           begin
!             Dout (Img (Node) & "matching " & Image (Str.all));
  
!             if (Length - Cursor) >= Len
!               and then Str.all = Subject (Cursor + 1 .. Cursor + Len)
              then
!                Cursor := Cursor + Len;
                 goto Succeed;
              else
                 goto Fail;
--- 6315,6332 ----
           --  String (function case)
  
           when PC_String_VF => declare
!             U : constant VString := Node.VF.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching " & Image (S (1 .. L)));
  
!             if (Length - Cursor) >= L
!               and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
              then
!                Cursor := Cursor + L;
                 goto Succeed;
              else
                 goto Fail;
*************** package body GNAT.Spitbol.Patterns is
*** 6199,6216 ****
           --  String (vstring pointer case)
  
           when PC_String_VP => declare
!             S   : constant String_Access := Get_String (Node.VP.all);
!             Len : constant Natural :=
!                     Ada.Strings.Unbounded.Length (Node.VP.all);
  
           begin
!             Dout
!               (Img (Node) & "matching " & Image (S.all));
  
!             if (Length - Cursor) >= Len
!               and then S.all = Subject (Cursor + 1 .. Cursor + Len)
              then
!                Cursor := Cursor + Len;
                 goto Succeed;
              else
                 goto Fail;
--- 6336,6353 ----
           --  String (vstring pointer case)
  
           when PC_String_VP => declare
!             U : constant VString := Node.VP.all;
!             S : String_Access;
!             L : Natural;
  
           begin
!             Get_String (U, S, L);
!             Dout (Img (Node) & "matching " & Image (S (1 .. L)));
  
!             if (Length - Cursor) >= L
!               and then S (1 .. L) = Subject (Cursor + 1 .. Cursor + L)
              then
!                Cursor := Cursor + L;
                 goto Succeed;
              else
                 goto Fail;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-spipat.ads gcc-4.1.0/gcc/ada/g-spipat.ads
*** gcc-4.0.2/gcc/ada/g-spipat.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-spipat.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1997-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 65,76 ****
  --       language is modeled on context free grammars, with context sensitive
  --       extensions that provide full (type 0) computational capabilities.
  
- with Ada.Finalization; use Ada.Finalization;
  with Ada.Strings.Maps; use Ada.Strings.Maps;
  with Ada.Text_IO;      use Ada.Text_IO;
  
  package GNAT.Spitbol.Patterns is
! pragma Elaborate_Body (Patterns);
  
     -------------------------------
     -- Pattern Matching Tutorial --
--- 65,75 ----
  --       language is modeled on context free grammars, with context sensitive
  --       extensions that provide full (type 0) computational capabilities.
  
  with Ada.Strings.Maps; use Ada.Strings.Maps;
  with Ada.Text_IO;      use Ada.Text_IO;
  
  package GNAT.Spitbol.Patterns is
!    pragma Elaborate_Body;
  
     -------------------------------
     -- Pattern Matching Tutorial --
*************** pragma Elaborate_Body (Patterns);
*** 631,637 ****
     --          Abort        Cancel
     --          Rem          Rest
  
!    --    where we have clashes with Ada reserved names.
  
     --    Ada requires the use of 'Access to refer to functions used in the
     --    pattern match, and often the use of 'Unrestricted_Access may be
--- 630,636 ----
     --          Abort        Cancel
     --          Rem          Rest
  
!    --    where we have clashes with Ada reserved names
  
     --    Ada requires the use of 'Access to refer to functions used in the
     --    pattern match, and often the use of 'Unrestricted_Access may be
*************** pragma Elaborate_Body (Patterns);
*** 704,710 ****
     function "&"  (L : PChar;   R : Pattern) return Pattern;
     function "&"  (L : Pattern; R : PChar)   return Pattern;
  
!    --  Pattern concatenation. Matches L followed by R.
  
     function "or" (L : Pattern; R : Pattern) return Pattern;
     function "or" (L : PString; R : Pattern) return Pattern;
--- 703,709 ----
     function "&"  (L : PChar;   R : Pattern) return Pattern;
     function "&"  (L : Pattern; R : PChar)   return Pattern;
  
!    --  Pattern concatenation. Matches L followed by R
  
     function "or" (L : Pattern; R : Pattern) return Pattern;
     function "or" (L : PString; R : Pattern) return Pattern;
*************** pragma Elaborate_Body (Patterns);
*** 820,826 ****
     --  Constructs a pattern that immediately aborts the entire match
  
     function Fail                                            return Pattern;
!    --  Constructs a pattern that always fails.
  
     function Fence                                           return Pattern;
     --  Constructs a pattern that matches null on the first attempt, and then
--- 819,825 ----
     --  Constructs a pattern that immediately aborts the entire match
  
     function Fail                                            return Pattern;
!    --  Constructs a pattern that always fails
  
     function Fence                                           return Pattern;
     --  Constructs a pattern that matches null on the first attempt, and then
*************** pragma Elaborate_Body (Patterns);
*** 953,975 ****
  
     function Match
       (Subject : VString;
!       Pat     : Pattern)
!       return    Boolean;
  
     function Match
       (Subject : VString;
!       Pat     : PString)
!       return    Boolean;
  
     function Match
       (Subject : String;
!       Pat     : Pattern)
!       return    Boolean;
  
     function Match
       (Subject : String;
!       Pat     : PString)
!       return    Boolean;
  
     --  Replacement functions. The subject is matched against the pattern.
     --  Any immediate or deferred assignments or writes are executed, and
--- 952,970 ----
  
     function Match
       (Subject : VString;
!       Pat     : Pattern) return Boolean;
  
     function Match
       (Subject : VString;
!       Pat     : PString) return Boolean;
  
     function Match
       (Subject : String;
!       Pat     : Pattern) return Boolean;
  
     function Match
       (Subject : String;
!       Pat     : PString) return Boolean;
  
     --  Replacement functions. The subject is matched against the pattern.
     --  Any immediate or deferred assignments or writes are executed, and
*************** pragma Elaborate_Body (Patterns);
*** 980,1005 ****
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : VString)
!       return    Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : VString)
!       return    Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : String)
!       return    Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : String)
!       return    Boolean;
  
     --  Simple match procedures. The subject is matched against the pattern.
     --  Any immediate or deferred assignments or writes are executed. No
--- 975,996 ----
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : VString) return Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : VString) return Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Replace : String) return Boolean;
  
     function Match
       (Subject : VString_Var;
        Pat     : PString;
!       Replace : String) return Boolean;
  
     --  Simple match procedures. The subject is matched against the pattern.
     --  Any immediate or deferred assignments or writes are executed. No
*************** pragma Elaborate_Body (Patterns);
*** 1063,1070 ****
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Result  : Match_Result_Var)
!       return    Boolean;
  
     procedure Match
       (Subject : in out VString;
--- 1054,1060 ----
     function Match
       (Subject : VString_Var;
        Pat     : Pattern;
!       Result  : Match_Result_Var) return Boolean;
  
     procedure Match
       (Subject : in out VString;
*************** pragma Elaborate_Body (Patterns);
*** 1104,1115 ****
     --  except that instead of setting the value of a variable, the matched
     --  substring is written to the appropriate file. This can be useful in
     --  following the progress of a match without generating the full amount
- 
     --  of information obtained by setting Debug_Mode to True.
  
     Terminal : constant File_Access := Standard_Error;
     Output   : constant File_Access := Standard_Output;
!    --  Two handy synonyms for use with the above pattern write operations.
  
     --  Finally we have some routines that are useful for determining what
     --  patterns are in use, particularly if they are constructed dynamically.
--- 1094,1104 ----
     --  except that instead of setting the value of a variable, the matched
     --  substring is written to the appropriate file. This can be useful in
     --  following the progress of a match without generating the full amount
     --  of information obtained by setting Debug_Mode to True.
  
     Terminal : constant File_Access := Standard_Error;
     Output   : constant File_Access := Standard_Output;
!    --  Two handy synonyms for use with the above pattern write operations
  
     --  Finally we have some routines that are useful for determining what
     --  patterns are in use, particularly if they are constructed dynamically.
*************** private
*** 1158,1164 ****
        --  Maximum number of stack entries required for matching this
        --  pattern. See description of pattern history stack in body.
  
!       P   : PE_Ptr := null;
        --  Pointer to initial pattern element for pattern
     end record;
  
--- 1147,1153 ----
        --  Maximum number of stack entries required for matching this
        --  pattern. See description of pattern history stack in body.
  
!       P : PE_Ptr := null;
        --  Pointer to initial pattern element for pattern
     end record;
  
*************** private
*** 1168,1186 ****
     --  Adjust routine used to copy pattern objects
  
     procedure Finalize (Object : in out Pattern);
!    --  Finalization routine used to release storage allocated for a pattern.
  
     type VString_Ptr is access all VString;
  
     type Match_Result is record
!       Var   : VString_Ptr;
!       --  Pointer to subject string. Set to null if match failed.
  
        Start : Natural := 1;
        --  Starting index position (1's origin) of matched section of
        --  subject string. Only valid if Var is non-null.
  
!       Stop  : Natural := 0;
        --  Ending index position (1's origin) of matched section of
        --  subject string. Only valid if Var is non-null.
  
--- 1157,1175 ----
     --  Adjust routine used to copy pattern objects
  
     procedure Finalize (Object : in out Pattern);
!    --  Finalization routine used to release storage allocated for a pattern
  
     type VString_Ptr is access all VString;
  
     type Match_Result is record
!       Var : VString_Ptr;
!       --  Pointer to subject string. Set to null if match failed
  
        Start : Natural := 1;
        --  Starting index position (1's origin) of matched section of
        --  subject string. Only valid if Var is non-null.
  
!       Stop : Natural := 0;
        --  Ending index position (1's origin) of matched section of
        --  subject string. Only valid if Var is non-null.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/g-spitbo.adb gcc-4.1.0/gcc/ada/g-spitbo.adb
*** gcc-4.0.2/gcc/ada/g-spitbo.adb	Tue Jan 13 11:51:33 2004
--- gcc-4.1.0/gcc/ada/g-spitbo.adb	Tue Nov 15 13:59:50 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1998-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Spitbol is
*** 79,88 ****
     ----------
  
     function Lpad
!      (Str  : VString;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString
     is
     begin
        if Length (Str) >= Len then
--- 79,87 ----
     ----------
  
     function Lpad
!      (Str : VString;
!       Len : Natural;
!       Pad : Character := ' ') return VString
     is
     begin
        if Length (Str) >= Len then
*************** package body GNAT.Spitbol is
*** 93,102 ****
     end Lpad;
  
     function Lpad
!      (Str  : String;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString
     is
     begin
        if Str'Length >= Len then
--- 92,100 ----
     end Lpad;
  
     function Lpad
!      (Str : String;
!       Len : Natural;
!       Pad : Character := ' ') return VString
     is
     begin
        if Str'Length >= Len then
*************** package body GNAT.Spitbol is
*** 135,142 ****
     -------
  
     function N (Str : VString) return Integer is
     begin
!       return Integer'Value (Get_String (Str).all);
     end N;
  
     --------------------
--- 133,143 ----
     -------
  
     function N (Str : VString) return Integer is
+       S : String_Access;
+       L : Natural;
     begin
!       Get_String (Str, S, L);
!       return Integer'Value (S (1 .. L));
     end N;
  
     --------------------
*************** package body GNAT.Spitbol is
*** 144,159 ****
     --------------------
  
     function Reverse_String (Str : VString) return VString is
!       Len    : constant Natural       := Length (Str);
!       Chars  : constant String_Access := Get_String (Str);
!       Result : String (1 .. Len);
  
     begin
!       for J in 1 .. Len loop
!          Result (J) := Chars (Len + 1 - J);
!       end loop;
  
!       return V (Result);
     end Reverse_String;
  
     function Reverse_String (Str : String) return VString is
--- 145,166 ----
     --------------------
  
     function Reverse_String (Str : VString) return VString is
!       S : String_Access;
!       L : Natural;
  
     begin
!       Get_String (Str, S, L);
  
!       declare
!          Result : String (1 .. L);
! 
!       begin
!          for J in 1 .. L loop
!             Result (J) := S (L + 1 - J);
!          end loop;
! 
!          return V (Result);
!       end;
     end Reverse_String;
  
     function Reverse_String (Str : String) return VString is
*************** package body GNAT.Spitbol is
*** 168,183 ****
     end Reverse_String;
  
     procedure Reverse_String (Str : in out VString) is
!       Len    : constant Natural := Length (Str);
!       Chars  : constant String_Access := Get_String (Str);
!       Temp   : Character;
  
     begin
!       for J in 1 .. Len / 2 loop
!          Temp := Chars (J);
!          Chars (J) := Chars (Len + 1 - J);
!          Chars (Len + 1 - J) := Temp;
!       end loop;
     end Reverse_String;
  
     ----------
--- 175,196 ----
     end Reverse_String;
  
     procedure Reverse_String (Str : in out VString) is
!       S : String_Access;
!       L : Natural;
  
     begin
!       Get_String (Str, S, L);
! 
!       declare
!          Result : String (1 .. L);
! 
!       begin
!          for J in 1 .. L loop
!             Result (J) := S (L + 1 - J);
!          end loop;
! 
!          Set_String (Str, Result);
!       end;
     end Reverse_String;
  
     ----------
*************** package body GNAT.Spitbol is
*** 185,194 ****
     ----------
  
     function Rpad
!      (Str  : VString;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString
     is
     begin
        if Length (Str) >= Len then
--- 198,206 ----
     ----------
  
     function Rpad
!      (Str : VString;
!       Len : Natural;
!       Pad : Character := ' ') return VString
     is
     begin
        if Length (Str) >= Len then
*************** package body GNAT.Spitbol is
*** 199,208 ****
     end Rpad;
  
     function Rpad
!      (Str  : String;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString
     is
     begin
        if Str'Length >= Len then
--- 211,219 ----
     end Rpad;
  
     function Rpad
!      (Str : String;
!       Len : Natural;
!       Pad : Character := ' ') return VString
     is
     begin
        if Str'Length >= Len then
*************** package body GNAT.Spitbol is
*** 269,302 ****
     function Substr
       (Str   : VString;
        Start : Positive;
!       Len   : Natural)
!       return  VString
     is
     begin
!       if Start > Length (Str) then
!          raise Index_Error;
  
!       elsif Start + Len - 1 > Length (Str) then
           raise Length_Error;
- 
        else
!          return V (Get_String (Str).all (Start .. Start + Len - 1));
        end if;
     end Substr;
  
     function Substr
       (Str   : String;
        Start : Positive;
!       Len   : Natural)
!       return  VString
     is
     begin
        if Start > Str'Length then
           raise Index_Error;
- 
        elsif Start + Len > Str'Length then
           raise Length_Error;
- 
        else
           return
             V (Str (Str'First + Start - 1 .. Str'First + Start + Len - 2));
--- 280,312 ----
     function Substr
       (Str   : VString;
        Start : Positive;
!       Len   : Natural) return VString
     is
+       S : String_Access;
+       L : Natural;
+ 
     begin
!       Get_String (Str, S, L);
  
!       if Start > L then
!          raise Index_Error;
!       elsif Start + Len - 1 > L then
           raise Length_Error;
        else
!          return V (S (Start .. Start + Len - 1));
        end if;
     end Substr;
  
     function Substr
       (Str   : String;
        Start : Positive;
!       Len   : Natural) return VString
     is
     begin
        if Start > Str'Length then
           raise Index_Error;
        elsif Start + Len > Str'Length then
           raise Length_Error;
        else
           return
             V (Str (Str'First + Start - 1 .. Str'First + Start + Len - 2));
*************** package body GNAT.Spitbol is
*** 446,453 ****
        end Delete;
  
        procedure Delete (T : in out Table; Name  : VString) is
        begin
!          Delete (T, Get_String (Name).all);
        end Delete;
  
        procedure Delete (T : in out Table; Name  : String) is
--- 456,466 ----
        end Delete;
  
        procedure Delete (T : in out Table; Name  : VString) is
+          S : String_Access;
+          L : Natural;
        begin
!          Get_String (Name, S, L);
!          Delete (T, S (1 .. L));
        end Delete;
  
        procedure Delete (T : in out Table; Name  : String) is
*************** package body GNAT.Spitbol is
*** 569,576 ****
        end Get;
  
        function Get (T : Table; Name : VString) return Value_Type is
        begin
!          return Get (T, Get_String (Name).all);
        end Get;
  
        function Get (T : Table; Name : String) return Value_Type is
--- 582,592 ----
        end Get;
  
        function Get (T : Table; Name : VString) return Value_Type is
+          S : String_Access;
+          L : Natural;
        begin
!          Get_String (Name, S, L);
!          return Get (T, S (1 .. L));
        end Get;
  
        function Get (T : Table; Name : String) return Value_Type is
*************** package body GNAT.Spitbol is
*** 606,612 ****
  
        begin
           for J in Str'Range loop
!             Result := Rotate_Left (Result, 1) +
                        Unsigned_32 (Character'Pos (Str (J)));
           end loop;
  
--- 622,628 ----
  
        begin
           for J in Str'Range loop
!             Result := Rotate_Left (Result, 3) +
                        Unsigned_32 (Character'Pos (Str (J)));
           end loop;
  
*************** package body GNAT.Spitbol is
*** 623,630 ****
        end Present;
  
        function Present (T : Table; Name : VString) return Boolean is
        begin
!          return Present (T, Get_String (Name).all);
        end Present;
  
        function Present (T : Table; Name : String) return Boolean is
--- 639,649 ----
        end Present;
  
        function Present (T : Table; Name : VString) return Boolean is
+          S : String_Access;
+          L : Natural;
        begin
!          Get_String (Name, S, L);
!          return Present (T, S (1 .. L));
        end Present;
  
        function Present (T : Table; Name : String) return Boolean is
*************** package body GNAT.Spitbol is
*** 656,663 ****
        ---------
  
        procedure Set (T : in out Table; Name : VString; Value : Value_Type) is
        begin
!          Set (T, Get_String (Name).all, Value);
        end Set;
  
        procedure Set (T : in out Table; Name : Character; Value : Value_Type) is
--- 675,685 ----
        ---------
  
        procedure Set (T : in out Table; Name : VString; Value : Value_Type) is
+          S : String_Access;
+          L : Natural;
        begin
!          Get_String (Name, S, L);
!          Set (T, S (1 .. L), Value);
        end Set;
  
        procedure Set (T : in out Table; Name : Character; Value : Value_Type) is
diff -Nrcpad gcc-4.0.2/gcc/ada/g-spitbo.ads gcc-4.1.0/gcc/ada/g-spitbo.ads
*** gcc-4.0.2/gcc/ada/g-spitbo.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-spitbo.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1997-1999 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Strings.Unbounded; use Ada.Stri
*** 44,50 ****
  with Interfaces;            use Interfaces;
  
  package GNAT.Spitbol is
! pragma Preelaborate (Spitbol);
  
     --  The Spitbol package relies heavily on the Unbounded_String package,
     --  using the synonym VString for variable length string. The following
--- 44,50 ----
  with Interfaces;            use Interfaces;
  
  package GNAT.Spitbol is
!    pragma Preelaborate;
  
     --  The Spitbol package relies heavily on the Unbounded_String package,
     --  using the synonym VString for variable length string. The following
*************** pragma Preelaborate (Spitbol);
*** 120,134 ****
     --  Equivalent to Character'Val (Num)
  
     function Lpad
!      (Str  : VString;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString;
     function Lpad
!      (Str  : String;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString;
     --  If the length of Str is greater than or equal to Len, then Str is
     --  returned unchanged. Otherwise, The value returned is obtained by
     --  concatenating Length (Str) - Len instances of the Pad character to
--- 120,132 ----
     --  Equivalent to Character'Val (Num)
  
     function Lpad
!      (Str : VString;
!       Len : Natural;
!       Pad : Character := ' ') return VString;
     function Lpad
!      (Str : String;
!       Len : Natural;
!       Pad : Character := ' ') return VString;
     --  If the length of Str is greater than or equal to Len, then Str is
     --  returned unchanged. Otherwise, The value returned is obtained by
     --  concatenating Length (Str) - Len instances of the Pad character to
*************** pragma Preelaborate (Spitbol);
*** 151,165 ****
     --  result overwrites the input argument Str.
  
     function Rpad
!      (Str  : VString;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString;
     function Rpad
!      (Str  : String;
!       Len  : Natural;
!       Pad  : Character := ' ')
!       return VString;
     --  If the length of Str is greater than or equal to Len, then Str is
     --  returned unchanged. Otherwise, The value returned is obtained by
     --  concatenating Length (Str) - Len instances of the Pad character to
--- 149,161 ----
     --  result overwrites the input argument Str.
  
     function Rpad
!      (Str : VString;
!       Len : Natural;
!       Pad : Character := ' ') return VString;
     function Rpad
!      (Str : String;
!       Len : Natural;
!       Pad : Character := ' ') return VString;
     --  If the length of Str is greater than or equal to Len, then Str is
     --  returned unchanged. Otherwise, The value returned is obtained by
     --  concatenating Length (Str) - Len instances of the Pad character to
*************** pragma Preelaborate (Spitbol);
*** 178,190 ****
     function Substr
       (Str   : VString;
        Start : Positive;
!       Len   : Natural)
!       return  VString;
     function Substr
       (Str   : String;
        Start : Positive;
!       Len   : Natural)
!       return  VString;
     --  Returns the substring starting at the given character position (which
     --  is always counted from the start of the string, regardless of bounds,
     --  e.g. 2 means starting with the second character of the string), and
--- 174,184 ----
     function Substr
       (Str   : VString;
        Start : Positive;
!       Len   : Natural) return  VString;
     function Substr
       (Str   : String;
        Start : Positive;
!       Len   : Natural) return  VString;
     --  Returns the substring starting at the given character position (which
     --  is always counted from the start of the string, regardless of bounds,
     --  e.g. 2 means starting with the second character of the string), and
*************** pragma Preelaborate (Spitbol);
*** 237,243 ****
        --  Any non-limited type can be used as the value type in the table
  
        Null_Value : Value_Type;
!       --  Value used to represent a value that is not present in the table.
  
        with function Img (A : Value_Type) return String;
        --  Used to provide image of value in Dump procedure
--- 231,237 ----
        --  Any non-limited type can be used as the value type in the table
  
        Null_Value : Value_Type;
!       --  Value used to represent a value that is not present in the table
  
        with function Img (A : Value_Type) return String;
        --  Used to provide image of value in Dump procedure
diff -Nrcpad gcc-4.0.2/gcc/ada/g-sptabo.ads gcc-4.1.0/gcc/ada/g-sptabo.ads
*** gcc-4.0.2/gcc/ada/g-sptabo.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-sptabo.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1997-1998 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-sptain.ads gcc-4.1.0/gcc/ada/g-sptain.ads
*** gcc-4.0.2/gcc/ada/g-sptain.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-sptain.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1997-1998 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-sptavs.ads gcc-4.1.0/gcc/ada/g-sptavs.ads
*** gcc-4.0.2/gcc/ada/g-sptavs.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-sptavs.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1997-1998 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-string.adb gcc-4.1.0/gcc/ada/g-string.adb
*** gcc-4.0.2/gcc/ada/g-string.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-string.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-string.ads gcc-4.1.0/gcc/ada/g-string.ads
*** gcc-4.0.2/gcc/ada/g-string.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-string.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,41 ****
--- 36,42 ----
  with Unchecked_Deallocation;
  
  package GNAT.Strings is
+    pragma Preelaborate;
  
     type String_Access is access all String;
     --  General purpose string access type. Note that the caller is
diff -Nrcpad gcc-4.0.2/gcc/ada/g-strspl.ads gcc-4.1.0/gcc/ada/g-strspl.ads
*** gcc-4.0.2/gcc/ada/g-strspl.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-strspl.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-table.adb gcc-4.1.0/gcc/ada/g-table.adb
*** gcc-4.0.2/gcc/ada/g-table.adb	Fri Mar  5 10:58:56 2004
--- gcc-4.1.0/gcc/ada/g-table.adb	Mon Sep  5 08:07:00 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
! --                            G N A T .  T A B L E                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1998-2004 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
! --                            G N A T . T A B L E                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Table is
*** 49,55 ****
     --  ensures that we initially allocate the table.
  
     Last_Val : Integer;
!    --  Current value of Last.
  
     -----------------------
     -- Local Subprograms --
--- 49,55 ----
     --  ensures that we initially allocate the table.
  
     Last_Val : Integer;
!    --  Current value of Last
  
     -----------------------
     -- Local Subprograms --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-table.ads gcc-4.1.0/gcc/ada/g-table.ads
*** gcc-4.0.2/gcc/ada/g-table.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-table.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                            G N A T . T A B L E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1998-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                            G N A T . T A B L E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 56,62 ****
     Table_Increment : Natural;
  
  package GNAT.Table is
! pragma Elaborate_Body (Table);
  
     --  Table_Component_Type and Table_Index_Type specify the type of the
     --  array, Table_Low_Bound is the lower bound. Index_type must be an
--- 56,62 ----
     Table_Increment : Natural;
  
  package GNAT.Table is
!    pragma Elaborate_Body;
  
     --  Table_Component_Type and Table_Index_Type specify the type of the
     --  array, Table_Low_Bound is the lower bound. Index_type must be an
diff -Nrcpad gcc-4.0.2/gcc/ada/g-tasloc.adb gcc-4.1.0/gcc/ada/g-tasloc.adb
*** gcc-4.0.2/gcc/ada/g-tasloc.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-tasloc.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1997-1999 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-tasloc.ads gcc-4.1.0/gcc/ada/g-tasloc.ads
*** gcc-4.0.2/gcc/ada/g-tasloc.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-tasloc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1998-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  --  they have no effect (they do NOT cause the tasking runtime to be loaded).
  
  package GNAT.Task_Lock is
! pragma Elaborate_Body (Task_Lock);
  
     procedure Lock;
     pragma Inline (Lock);
--- 42,48 ----
  --  they have no effect (they do NOT cause the tasking runtime to be loaded).
  
  package GNAT.Task_Lock is
!    pragma Elaborate_Body;
  
     procedure Lock;
     pragma Inline (Lock);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-thread.adb gcc-4.1.0/gcc/ada/g-thread.adb
*** gcc-4.0.2/gcc/ada/g-thread.adb	Mon May 17 13:20:43 2004
--- gcc-4.1.0/gcc/ada/g-thread.adb	Mon Sep  5 07:50:46 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         G N A T . T H R E A D S                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1998-2004 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         G N A T . T H R E A D S                          --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Threads is
*** 163,169 ****
     ----------------
  
     procedure Get_Thread (Id : Address; Thread : Address) is
-       use System.OS_Interface;
        Thr : constant Thread_Id_Ptr := To_Thread (Thread);
     begin
        Thr.all := Task_Primitives.Operations.Get_Thread_Id (To_Id (Id));
--- 163,168 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-thread.ads gcc-4.1.0/gcc/ada/g-thread.ads
*** gcc-4.0.2/gcc/ada/g-thread.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-thread.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                         G N A T . T H R E A D S                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1998-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                         G N A T . T H R E A D S                          --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-traceb.adb gcc-4.1.0/gcc/ada/g-traceb.adb
*** gcc-4.0.2/gcc/ada/g-traceb.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-traceb.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1999-2000 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                      Copyright (C) 1999-2005, AdaCore                    --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-traceb.ads gcc-4.1.0/gcc/ada/g-traceb.ads
*** gcc-4.0.2/gcc/ada/g-traceb.ads	Mon Jun 28 14:36:57 2004
--- gcc-4.1.0/gcc/ada/g-traceb.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1999-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package GNAT.Traceback is
*** 78,84 ****
     --  Code location used in building tracebacks
  
     subtype Tracebacks_Array is Ada.Exceptions.Traceback.Tracebacks_Array;
!    --  Traceback array used to hold a generated traceback list.
  
     ----------------
     -- Call_Chain --
--- 78,84 ----
     --  Code location used in building tracebacks
  
     subtype Tracebacks_Array is Ada.Exceptions.Traceback.Tracebacks_Array;
!    --  Traceback array used to hold a generated traceback list
  
     ----------------
     -- Call_Chain --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-trasym-vms-alpha.adb gcc-4.1.0/gcc/ada/g-trasym-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/g-trasym-vms-alpha.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-trasym-vms-alpha.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,282 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --             G N A T . T R A C E B A C K . S Y M B O L I C                --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --           Copyright (C) 1999-2005, Free Software Foundation, Inc.        --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  Run-time symbolic traceback support for Alpha/VMS
+ 
+ with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+ with Interfaces.C;
+ with System;
+ with System.Aux_DEC;
+ with System.Soft_Links;
+ with System.Traceback_Entries;
+ 
+ package body GNAT.Traceback.Symbolic is
+ 
+    pragma Warnings (Off);
+    pragma Linker_Options ("--for-linker=sys$library:trace.exe");
+ 
+    use Interfaces.C;
+    use System;
+    use System.Aux_DEC;
+    use System.Traceback_Entries;
+ 
+    subtype User_Arg_Type is Unsigned_Longword;
+    subtype Cond_Value_Type is Unsigned_Longword;
+ 
+    type ASCIC is record
+       Count : unsigned_char;
+       Data  : char_array (1 .. 255);
+    end record;
+    pragma Convention (C, ASCIC);
+ 
+    for ASCIC use record
+       Count at 0 range 0 .. 7;
+       Data  at 1 range 0 .. 8 * 255 - 1;
+    end record;
+    for ASCIC'Size use 8 * 256;
+ 
+    function Fetch_ASCIC is new Fetch_From_Address (ASCIC);
+ 
+    procedure Symbolize
+      (Status         : out Cond_Value_Type;
+       Current_PC     : in Address;
+       Adjusted_PC    : in Address;
+       Current_FP     : in Address;
+       Current_R26    : in Address;
+       Image_Name     : out Address;
+       Module_Name    : out Address;
+       Routine_Name   : out Address;
+       Line_Number    : out Integer;
+       Relative_PC    : out Address;
+       Absolute_PC    : out Address;
+       PC_Is_Valid    : out Long_Integer;
+       User_Act_Proc  : Address           := Address'Null_Parameter;
+       User_Arg_Value : User_Arg_Type     := User_Arg_Type'Null_Parameter);
+ 
+    pragma Interface (External, Symbolize);
+ 
+    pragma Import_Valued_Procedure
+      (Symbolize, "TBK$SYMBOLIZE",
+       (Cond_Value_Type, Address, Address, Address, Address,
+        Address, Address, Address, Integer,
+        Address, Address, Long_Integer,
+        Address, User_Arg_Type),
+       (Value, Value, Value, Value, Value,
+        Reference, Reference, Reference, Reference,
+        Reference, Reference, Reference,
+        Value, Value),
+        User_Act_Proc);
+ 
+    function Decode_Ada_Name (Encoded_Name : String) return String;
+    --  Decodes an Ada identifier name. Removes leading "_ada_" and trailing
+    --  __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.'
+ 
+    ---------------------
+    -- Decode_Ada_Name --
+    ---------------------
+ 
+    function Decode_Ada_Name (Encoded_Name : String) return String is
+       Decoded_Name : String (1 .. Encoded_Name'Length);
+       Pos          : Integer := Encoded_Name'First;
+       Last         : Integer := Encoded_Name'Last;
+       DPos         : Integer := 1;
+ 
+    begin
+       if Pos > Last then
+          return "";
+       end if;
+ 
+       --  Skip leading _ada_
+ 
+       if Encoded_Name'Length > 4
+         and then Encoded_Name (Pos .. Pos + 4) = "_ada_"
+       then
+          Pos := Pos + 5;
+       end if;
+ 
+       --  Skip trailing __{DIGIT}+ or ${DIGIT}+
+ 
+       if Encoded_Name (Last) in '0' .. '9' then
+          for J in reverse Pos + 2 .. Last - 1 loop
+             case Encoded_Name (J) is
+                when '0' .. '9' =>
+                   null;
+                when '$' =>
+                   Last := J - 1;
+                   exit;
+                when '_' =>
+                   if Encoded_Name (J - 1) = '_' then
+                      Last := J - 2;
+                   end if;
+                   exit;
+                when others =>
+                   exit;
+             end case;
+          end loop;
+       end if;
+ 
+       --  Now just copy encoded name to decoded name, converting "__" to '.'
+ 
+       while Pos <= Last loop
+          if Encoded_Name (Pos) = '_' and then Encoded_Name (Pos + 1) = '_'
+            and then Pos /= Encoded_Name'First
+          then
+             Decoded_Name (DPos) := '.';
+             Pos := Pos + 2;
+ 
+          else
+             Decoded_Name (DPos) := Encoded_Name (Pos);
+             Pos := Pos + 1;
+          end if;
+ 
+          DPos := DPos + 1;
+       end loop;
+ 
+       return Decoded_Name (1 .. DPos - 1);
+    end Decode_Ada_Name;
+ 
+    ------------------------
+    -- Symbolic_Traceback --
+    ------------------------
+ 
+    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
+       Status            : Cond_Value_Type;
+       Image_Name        : ASCIC;
+       Image_Name_Addr   : Address;
+       Module_Name       : ASCIC;
+       Module_Name_Addr  : Address;
+       Routine_Name      : ASCIC;
+       Routine_Name_Addr : Address;
+       Line_Number       : Integer;
+       Relative_PC       : Address;
+       Absolute_PC       : Address;
+       PC_Is_Valid       : Long_Integer;
+       Return_Address    : Address;
+       Res               : String (1 .. 256 * Traceback'Length);
+       Len               : Integer;
+ 
+    begin
+       if Traceback'Length > 0 then
+          Len := 0;
+ 
+          --  Since image computation is not thread-safe we need task lockout
+ 
+          System.Soft_Links.Lock_Task.all;
+ 
+          for J in Traceback'Range loop
+             if J = Traceback'Last then
+                Return_Address := Address_Zero;
+             else
+                Return_Address := PC_For (Traceback (J + 1));
+             end if;
+ 
+             Symbolize
+               (Status,
+                PC_For (Traceback (J)),
+                PC_For (Traceback (J)),
+                PV_For (Traceback (J)),
+                Return_Address,
+                Image_Name_Addr,
+                Module_Name_Addr,
+                Routine_Name_Addr,
+                Line_Number,
+                Relative_PC,
+                Absolute_PC,
+                PC_Is_Valid);
+ 
+             Image_Name   := Fetch_ASCIC (Image_Name_Addr);
+             Module_Name  := Fetch_ASCIC (Module_Name_Addr);
+             Routine_Name := Fetch_ASCIC (Routine_Name_Addr);
+ 
+             declare
+                First : Integer := Len + 1;
+                Last  : Integer := First + 80 - 1;
+                Pos   : Integer;
+                Routine_Name_D : String := Decode_Ada_Name
+                  (To_Ada
+                     (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
+                      False));
+ 
+             begin
+                Res (First .. Last) := (others => ' ');
+ 
+                Res (First .. First + Integer (Image_Name.Count) - 1) :=
+                  To_Ada
+                   (Image_Name.Data (1 .. size_t (Image_Name.Count)),
+                    False);
+ 
+                Res (First + 10 ..
+                     First + 10 + Integer (Module_Name.Count) - 1) :=
+                  To_Ada
+                   (Module_Name.Data (1 .. size_t (Module_Name.Count)),
+                    False);
+ 
+                Res (First + 30 ..
+                     First + 30 + Routine_Name_D'Length - 1) :=
+                  Routine_Name_D;
+ 
+                --  If routine name doesn't fit 20 characters, output
+                --  the line number on next line at 50th position
+ 
+                if Routine_Name_D'Length > 20 then
+                   Pos := First + 30 + Routine_Name_D'Length;
+                   Res (Pos) := ASCII.LF;
+                   Last := Pos + 80;
+                   Res (Pos + 1 .. Last) := (others => ' ');
+                   Pos := Pos + 51;
+                else
+                   Pos := First + 50;
+                end if;
+ 
+                Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
+                  Integer'Image (Line_Number);
+ 
+                Res (Last) := ASCII.LF;
+                Len := Last;
+             end;
+          end loop;
+ 
+          System.Soft_Links.Unlock_Task.all;
+          return Res (1 .. Len);
+ 
+       else
+          return "";
+       end if;
+    end Symbolic_Traceback;
+ 
+    function Symbolic_Traceback (E : Exception_Occurrence) return String is
+    begin
+       return Symbolic_Traceback (Tracebacks (E));
+    end Symbolic_Traceback;
+ 
+ end GNAT.Traceback.Symbolic;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-trasym-vms-ia64.adb gcc-4.1.0/gcc/ada/g-trasym-vms-ia64.adb
*** gcc-4.0.2/gcc/ada/g-trasym-vms-ia64.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/g-trasym-vms-ia64.adb	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,270 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT RUN-TIME COMPONENTS                         --
+ --                                                                          --
+ --             G N A T . T R A C E B A C K . S Y M B O L I C                --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --            Copyright (C) 2005, Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  Run-time symbolic traceback support for IA64/VMS
+ 
+ with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+ with Interfaces.C;
+ with System;
+ with System.Aux_DEC;
+ with System.Soft_Links;
+ with System.Traceback_Entries;
+ 
+ package body GNAT.Traceback.Symbolic is
+ 
+    pragma Warnings (Off);
+    pragma Linker_Options ("--for-linker=sys$library:trace.exe");
+ 
+    use Interfaces.C;
+    use System;
+    use System.Aux_DEC;
+    use System.Traceback_Entries;
+ 
+    subtype User_Arg_Type is Unsigned_Longword;
+    subtype Cond_Value_Type is Unsigned_Longword;
+ 
+    type ASCIC is record
+       Count : unsigned_char;
+       Data  : char_array (1 .. 255);
+    end record;
+    pragma Convention (C, ASCIC);
+ 
+    for ASCIC use record
+       Count at 0 range 0 .. 7;
+       Data  at 1 range 0 .. 8 * 255 - 1;
+    end record;
+    for ASCIC'Size use 8 * 256;
+ 
+    function Fetch_ASCIC is new Fetch_From_Address (ASCIC);
+ 
+    procedure Symbolize
+      (Status         : out Cond_Value_Type;
+       Current_PC     : in Address;
+       Filename_Name  : out Address;
+       Library_Name   : out Address;
+       Record_Number  : out Integer;
+       Image_Name     : out Address;
+       Module_Name    : out Address;
+       Routine_Name   : out Address;
+       Line_Number    : out Integer;
+       Relative_PC    : out Address);
+ 
+    pragma Interface (External, Symbolize);
+ 
+    pragma Import_Valued_Procedure
+      (Symbolize, "TBK$I64_SYMBOLIZE",
+       (Cond_Value_Type, Address,
+        Address, Address, Integer,
+        Address, Address, Address, Integer,
+        Address),
+       (Value, Value,
+        Reference, Reference, Reference,
+        Reference, Reference, Reference, Reference,
+        Reference));
+ 
+    function Decode_Ada_Name (Encoded_Name : String) return String;
+    --  Decodes an Ada identifier name. Removes leading "_ada_" and trailing
+    --  __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.'
+ 
+    ---------------------
+    -- Decode_Ada_Name --
+    ---------------------
+ 
+    function Decode_Ada_Name (Encoded_Name : String) return String is
+       Decoded_Name : String (1 .. Encoded_Name'Length);
+       Pos          : Integer := Encoded_Name'First;
+       Last         : Integer := Encoded_Name'Last;
+       DPos         : Integer := 1;
+ 
+    begin
+       if Pos > Last then
+          return "";
+       end if;
+ 
+       --  Skip leading _ada_
+ 
+       if Encoded_Name'Length > 4
+         and then Encoded_Name (Pos .. Pos + 4) = "_ada_"
+       then
+          Pos := Pos + 5;
+       end if;
+ 
+       --  Skip trailing __{DIGIT}+ or ${DIGIT}+
+ 
+       if Encoded_Name (Last) in '0' .. '9' then
+          for J in reverse Pos + 2 .. Last - 1 loop
+             case Encoded_Name (J) is
+                when '0' .. '9' =>
+                   null;
+                when '$' =>
+                   Last := J - 1;
+                   exit;
+                when '_' =>
+                   if Encoded_Name (J - 1) = '_' then
+                      Last := J - 2;
+                   end if;
+                   exit;
+                when others =>
+                   exit;
+             end case;
+          end loop;
+       end if;
+ 
+       --  Now just copy encoded name to decoded name, converting "__" to '.'
+ 
+       while Pos <= Last loop
+          if Encoded_Name (Pos) = '_' and then Encoded_Name (Pos + 1) = '_'
+            and then Pos /= Encoded_Name'First
+          then
+             Decoded_Name (DPos) := '.';
+             Pos := Pos + 2;
+ 
+          else
+             Decoded_Name (DPos) := Encoded_Name (Pos);
+             Pos := Pos + 1;
+          end if;
+ 
+          DPos := DPos + 1;
+       end loop;
+ 
+       return Decoded_Name (1 .. DPos - 1);
+    end Decode_Ada_Name;
+ 
+    ------------------------
+    -- Symbolic_Traceback --
+    ------------------------
+ 
+    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
+       Status             : Cond_Value_Type;
+       Filename_Name_Addr : Address;
+       Library_Name_Addr  : Address;
+       Record_Number      : Integer;
+       Image_Name         : ASCIC;
+       Image_Name_Addr    : Address;
+       Module_Name        : ASCIC;
+       Module_Name_Addr   : Address;
+       Routine_Name       : ASCIC;
+       Routine_Name_Addr  : Address;
+       Line_Number        : Integer;
+       Relative_PC        : Address;
+       Res                : String (1 .. 256 * Traceback'Length);
+       Len                : Integer;
+ 
+    begin
+       if Traceback'Length > 0 then
+          Len := 0;
+ 
+          --  Since image computation is not thread-safe we need task lockout
+ 
+          System.Soft_Links.Lock_Task.all;
+ 
+          for J in Traceback'Range loop
+ 
+             Symbolize
+               (Status,
+                PC_For (Traceback (J)),
+                Filename_Name_Addr,
+                Library_Name_Addr,
+                Record_Number,
+                Image_Name_Addr,
+                Module_Name_Addr,
+                Routine_Name_Addr,
+                Line_Number,
+                Relative_PC);
+ 
+             Image_Name   := Fetch_ASCIC (Image_Name_Addr);
+             Module_Name  := Fetch_ASCIC (Module_Name_Addr);
+             Routine_Name := Fetch_ASCIC (Routine_Name_Addr);
+ 
+             declare
+                First : Integer := Len + 1;
+                Last  : Integer := First + 80 - 1;
+                Pos   : Integer;
+                Routine_Name_D : String := Decode_Ada_Name
+                  (To_Ada
+                     (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
+                      False));
+ 
+             begin
+                Res (First .. Last) := (others => ' ');
+ 
+                Res (First .. First + Integer (Image_Name.Count) - 1) :=
+                  To_Ada
+                   (Image_Name.Data (1 .. size_t (Image_Name.Count)),
+                    False);
+ 
+                Res (First + 10 ..
+                     First + 10 + Integer (Module_Name.Count) - 1) :=
+                  To_Ada
+                   (Module_Name.Data (1 .. size_t (Module_Name.Count)),
+                    False);
+ 
+                Res (First + 30 ..
+                     First + 30 + Routine_Name_D'Length - 1) :=
+                  Routine_Name_D;
+ 
+                --  If routine name doesn't fit 20 characters, output
+                --  the line number on next line at 50th position
+ 
+                if Routine_Name_D'Length > 20 then
+                   Pos := First + 30 + Routine_Name_D'Length;
+                   Res (Pos) := ASCII.LF;
+                   Last := Pos + 80;
+                   Res (Pos + 1 .. Last) := (others => ' ');
+                   Pos := Pos + 51;
+                else
+                   Pos := First + 50;
+                end if;
+ 
+                Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
+                  Integer'Image (Line_Number);
+ 
+                Res (Last) := ASCII.LF;
+                Len := Last;
+             end;
+          end loop;
+ 
+          System.Soft_Links.Unlock_Task.all;
+          return Res (1 .. Len);
+ 
+       else
+          return "";
+       end if;
+    end Symbolic_Traceback;
+ 
+    function Symbolic_Traceback (E : Exception_Occurrence) return String is
+    begin
+       return Symbolic_Traceback (Tracebacks (E));
+    end Symbolic_Traceback;
+ 
+ end GNAT.Traceback.Symbolic;
diff -Nrcpad gcc-4.0.2/gcc/ada/g-trasym-vms.adb gcc-4.1.0/gcc/ada/g-trasym-vms.adb
*** gcc-4.0.2/gcc/ada/g-trasym-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/g-trasym-vms.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,282 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUN-TIME COMPONENTS                         --
- --                                                                          --
- --             G N A T . T R A C E B A C K . S Y M B O L I C                --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --           Copyright (C) 1999-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- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  Run-time symbolic traceback support for VMS
- 
- with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
- with Interfaces.C;
- with System;
- with System.Aux_DEC;
- with System.Soft_Links;
- with System.Traceback_Entries;
- 
- package body GNAT.Traceback.Symbolic is
- 
-    pragma Warnings (Off);
-    pragma Linker_Options ("--for-linker=sys$library:trace.exe");
- 
-    use Interfaces.C;
-    use System;
-    use System.Aux_DEC;
-    use System.Traceback_Entries;
- 
-    subtype User_Arg_Type is Unsigned_Longword;
-    subtype Cond_Value_Type is Unsigned_Longword;
- 
-    type ASCIC is record
-       Count : unsigned_char;
-       Data  : char_array (1 .. 255);
-    end record;
-    pragma Convention (C, ASCIC);
- 
-    for ASCIC use record
-       Count at 0 range 0 .. 7;
-       Data  at 1 range 0 .. 8 * 255 - 1;
-    end record;
-    for ASCIC'Size use 8 * 256;
- 
-    function Fetch_ASCIC is new Fetch_From_Address (ASCIC);
- 
-    procedure Symbolize
-      (Status         : out Cond_Value_Type;
-       Current_PC     : in Address;
-       Adjusted_PC    : in Address;
-       Current_FP     : in Address;
-       Current_R26    : in Address;
-       Image_Name     : out Address;
-       Module_Name    : out Address;
-       Routine_Name   : out Address;
-       Line_Number    : out Integer;
-       Relative_PC    : out Address;
-       Absolute_PC    : out Address;
-       PC_Is_Valid    : out Long_Integer;
-       User_Act_Proc  : Address           := Address'Null_Parameter;
-       User_Arg_Value : User_Arg_Type     := User_Arg_Type'Null_Parameter);
- 
-    pragma Interface (External, Symbolize);
- 
-    pragma Import_Valued_Procedure
-      (Symbolize, "TBK$SYMBOLIZE",
-       (Cond_Value_Type, Address, Address, Address, Address,
-        Address, Address, Address, Integer,
-        Address, Address, Long_Integer,
-        Address, User_Arg_Type),
-       (Value, Value, Value, Value, Value,
-        Reference, Reference, Reference, Reference,
-        Reference, Reference, Reference,
-        Value, Value),
-        User_Act_Proc);
- 
-    function Decode_Ada_Name (Encoded_Name : String) return String;
-    --  Decodes an Ada identifier name. Removes leading "_ada_" and trailing
-    --  __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.'
- 
-    ---------------------
-    -- Decode_Ada_Name --
-    ---------------------
- 
-    function Decode_Ada_Name (Encoded_Name : String) return String is
-       Decoded_Name : String (1 .. Encoded_Name'Length);
-       Pos          : Integer := Encoded_Name'First;
-       Last         : Integer := Encoded_Name'Last;
-       DPos         : Integer := 1;
- 
-    begin
-       if Pos > Last then
-          return "";
-       end if;
- 
-       --  Skip leading _ada_
- 
-       if Encoded_Name'Length > 4
-         and then Encoded_Name (Pos .. Pos + 4) = "_ada_"
-       then
-          Pos := Pos + 5;
-       end if;
- 
-       --  Skip trailing __{DIGIT}+ or ${DIGIT}+
- 
-       if Encoded_Name (Last) in '0' .. '9' then
-          for J in reverse Pos + 2 .. Last - 1 loop
-             case Encoded_Name (J) is
-                when '0' .. '9' =>
-                   null;
-                when '$' =>
-                   Last := J - 1;
-                   exit;
-                when '_' =>
-                   if Encoded_Name (J - 1) = '_' then
-                      Last := J - 2;
-                   end if;
-                   exit;
-                when others =>
-                   exit;
-             end case;
-          end loop;
-       end if;
- 
-       --  Now just copy encoded name to decoded name, converting "__" to '.'
- 
-       while Pos <= Last loop
-          if Encoded_Name (Pos) = '_' and then Encoded_Name (Pos + 1) = '_'
-            and then Pos /= Encoded_Name'First
-          then
-             Decoded_Name (DPos) := '.';
-             Pos := Pos + 2;
- 
-          else
-             Decoded_Name (DPos) := Encoded_Name (Pos);
-             Pos := Pos + 1;
-          end if;
- 
-          DPos := DPos + 1;
-       end loop;
- 
-       return Decoded_Name (1 .. DPos - 1);
-    end Decode_Ada_Name;
- 
-    ------------------------
-    -- Symbolic_Traceback --
-    ------------------------
- 
-    function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
-       Status            : Cond_Value_Type;
-       Image_Name        : ASCIC;
-       Image_Name_Addr   : Address;
-       Module_Name       : ASCIC;
-       Module_Name_Addr  : Address;
-       Routine_Name      : ASCIC;
-       Routine_Name_Addr : Address;
-       Line_Number       : Integer;
-       Relative_PC       : Address;
-       Absolute_PC       : Address;
-       PC_Is_Valid       : Long_Integer;
-       Return_Address    : Address;
-       Res               : String (1 .. 256 * Traceback'Length);
-       Len               : Integer;
- 
-    begin
-       if Traceback'Length > 0 then
-          Len := 0;
- 
-          --  Since image computation is not thread-safe we need task lockout
- 
-          System.Soft_Links.Lock_Task.all;
- 
-          for J in Traceback'Range loop
-             if J = Traceback'Last then
-                Return_Address := Address_Zero;
-             else
-                Return_Address := PC_For (Traceback (J + 1));
-             end if;
- 
-             Symbolize
-               (Status,
-                PC_For (Traceback (J)),
-                PC_For (Traceback (J)),
-                PV_For (Traceback (J)),
-                Return_Address,
-                Image_Name_Addr,
-                Module_Name_Addr,
-                Routine_Name_Addr,
-                Line_Number,
-                Relative_PC,
-                Absolute_PC,
-                PC_Is_Valid);
- 
-             Image_Name   := Fetch_ASCIC (Image_Name_Addr);
-             Module_Name  := Fetch_ASCIC (Module_Name_Addr);
-             Routine_Name := Fetch_ASCIC (Routine_Name_Addr);
- 
-             declare
-                First : Integer := Len + 1;
-                Last  : Integer := First + 80 - 1;
-                Pos   : Integer;
-                Routine_Name_D : String := Decode_Ada_Name
-                  (To_Ada
-                     (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
-                      False));
- 
-             begin
-                Res (First .. Last) := (others => ' ');
- 
-                Res (First .. First + Integer (Image_Name.Count) - 1) :=
-                  To_Ada
-                   (Image_Name.Data (1 .. size_t (Image_Name.Count)),
-                    False);
- 
-                Res (First + 10 ..
-                     First + 10 + Integer (Module_Name.Count) - 1) :=
-                  To_Ada
-                   (Module_Name.Data (1 .. size_t (Module_Name.Count)),
-                    False);
- 
-                Res (First + 30 ..
-                     First + 30 + Routine_Name_D'Length - 1) :=
-                  Routine_Name_D;
- 
-                --  If routine name doesn't fit 20 characters, output
-                --  the line number on next line at 50th position
- 
-                if Routine_Name_D'Length > 20 then
-                   Pos := First + 30 + Routine_Name_D'Length;
-                   Res (Pos) := ASCII.LF;
-                   Last := Pos + 80;
-                   Res (Pos + 1 .. Last) := (others => ' ');
-                   Pos := Pos + 51;
-                else
-                   Pos := First + 50;
-                end if;
- 
-                Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
-                  Integer'Image (Line_Number);
- 
-                Res (Last) := ASCII.LF;
-                Len := Last;
-             end;
-          end loop;
- 
-          System.Soft_Links.Unlock_Task.all;
-          return Res (1 .. Len);
- 
-       else
-          return "";
-       end if;
-    end Symbolic_Traceback;
- 
-    function Symbolic_Traceback (E : Exception_Occurrence) return String is
-    begin
-       return Symbolic_Traceback (Tracebacks (E));
-    end Symbolic_Traceback;
- 
- end GNAT.Traceback.Symbolic;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/g-trasym.adb gcc-4.1.0/gcc/ada/g-trasym.adb
*** gcc-4.0.2/gcc/ada/g-trasym.adb	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-trasym.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.Traceback.Symbolic is
*** 50,59 ****
  
     function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
        procedure convert_addresses
!         (addrs    : System.Address;
!          n_addr   : Integer;
!          buf      : System.Address;
!          len      : System.Address);
        pragma Import (C, convert_addresses, "convert_addresses");
        --  This is the procedure version of the Ada aware addr2line that will
        --  use argv[0] as the executable containing the debug information.
--- 50,59 ----
  
     function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
        procedure convert_addresses
!         (addrs  : System.Address;
!          n_addr : Integer;
!          buf    : System.Address;
!          len    : System.Address);
        pragma Import (C, convert_addresses, "convert_addresses");
        --  This is the procedure version of the Ada aware addr2line that will
        --  use argv[0] as the executable containing the debug information.
diff -Nrcpad gcc-4.0.2/gcc/ada/g-trasym.ads gcc-4.1.0/gcc/ada/g-trasym.ads
*** gcc-4.0.2/gcc/ada/g-trasym.ads	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/g-trasym.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1999-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,40 ****
  
  --  Run-time symbolic traceback support
  
! --  Note: this is only available on selected targets. Currently it is
! --  supported on Sparc/Solaris, GNU/Linux, Windows NT, HP-UX, VMS and Tru64.
  
  --  The routines provided in this package assume that your application has
  --  been compiled with debugging information turned on, since this information
--- 33,40 ----
  
  --  Run-time symbolic traceback support
  
! --  Note: this is only available on selected targets. Current targets are:
! --  Sparc/Solaris, GNU/Linux, SGI/IRIX, Windows NT, HP-UX, VMS, Tru64.
  
  --  The routines provided in this package assume that your application has
  --  been compiled with debugging information turned on, since this information
***************
*** 62,68 ****
  with Ada.Exceptions; use Ada.Exceptions;
  
  package GNAT.Traceback.Symbolic is
! pragma Elaborate_Body (Traceback.Symbolic);
  
     ------------------------
     -- Symbolic_Traceback --
--- 62,68 ----
  with Ada.Exceptions; use Ada.Exceptions;
  
  package GNAT.Traceback.Symbolic is
!    pragma Elaborate_Body;
  
     ------------------------
     -- Symbolic_Traceback --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-utf_32.adb gcc-4.1.0/gcc/ada/g-utf_32.adb
*** gcc-4.0.2/gcc/ada/g-utf_32.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/g-utf_32.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . U T F _ 3 2                           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . U T F _ 3 2                           --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body GNAT.UTF_32 is
*** 50,55 ****
--- 50,3653 ----
  
     type UTF_32_Ranges is array (Positive range <>) of UTF_32_Range;
  
+    --  The following array includes ranges for all codes with defined unicode
+    --  categories (a group of characters is in the same range if and only if
+    --  they share the same category, indicated in the comment).
+ 
+    --  Note that we do not try to take care of FFFE/FFFF cases in this table
+ 
+    Unicode_Ranges : constant UTF_32_Ranges := (
+      (16#00000#, 16#0001F#),  -- (Cc)  <control> .. <control>
+      (16#00020#, 16#00020#),  -- (Zs)  SPACE .. SPACE
+      (16#00021#, 16#00023#),  -- (Po)  EXCLAMATION MARK .. NUMBER SIGN
+      (16#00024#, 16#00024#),  -- (Sc)  DOLLAR SIGN .. DOLLAR SIGN
+      (16#00025#, 16#00027#),  -- (Po)  PERCENT SIGN .. APOSTROPHE
+      (16#00028#, 16#00028#),  -- (Ps)  LEFT PARENTHESIS .. LEFT PARENTHESIS
+      (16#00029#, 16#00029#),  -- (Pe)  RIGHT PARENTHESIS .. RIGHT PARENTHESIS
+      (16#0002A#, 16#0002A#),  -- (Po)  ASTERISK .. ASTERISK
+      (16#0002B#, 16#0002B#),  -- (Sm)  PLUS SIGN .. PLUS SIGN
+      (16#0002C#, 16#0002C#),  -- (Po)  COMMA .. COMMA
+      (16#0002D#, 16#0002D#),  -- (Pd)  HYPHEN-MINUS .. HYPHEN-MINUS
+      (16#0002E#, 16#0002F#),  -- (Po)  FULL STOP .. SOLIDUS
+      (16#00030#, 16#00039#),  -- (Nd)  DIGIT ZERO .. DIGIT NINE
+      (16#0003A#, 16#0003B#),  -- (Po)  COLON .. SEMICOLON
+      (16#0003C#, 16#0003E#),  -- (Sm)  LESS-THAN SIGN .. GREATER-THAN SIGN
+      (16#0003F#, 16#00040#),  -- (Po)  QUESTION MARK .. COMMERCIAL AT
+      (16#00041#, 16#0005A#),  -- (Lu)  LATIN CAPITAL LETTER A .. LATIN CAPITAL LETTER Z
+      (16#0005B#, 16#0005B#),  -- (Ps)  LEFT SQUARE BRACKET .. LEFT SQUARE BRACKET
+      (16#0005C#, 16#0005C#),  -- (Po)  REVERSE SOLIDUS .. REVERSE SOLIDUS
+      (16#0005D#, 16#0005D#),  -- (Pe)  RIGHT SQUARE BRACKET .. RIGHT SQUARE BRACKET
+      (16#0005E#, 16#0005E#),  -- (Sk)  CIRCUMFLEX ACCENT .. CIRCUMFLEX ACCENT
+      (16#0005F#, 16#0005F#),  -- (Pc)  LOW LINE .. LOW LINE
+      (16#00060#, 16#00060#),  -- (Sk)  GRAVE ACCENT .. GRAVE ACCENT
+      (16#00061#, 16#0007A#),  -- (Ll)  LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
+      (16#0007B#, 16#0007B#),  -- (Ps)  LEFT CURLY BRACKET .. LEFT CURLY BRACKET
+      (16#0007C#, 16#0007C#),  -- (Sm)  VERTICAL LINE .. VERTICAL LINE
+      (16#0007D#, 16#0007D#),  -- (Pe)  RIGHT CURLY BRACKET .. RIGHT CURLY BRACKET
+      (16#0007E#, 16#0007E#),  -- (Sm)  TILDE .. TILDE
+      (16#0007F#, 16#0009F#),  -- (Cc)  <control> .. <control>
+      (16#000A0#, 16#000A0#),  -- (Zs)  NO-BREAK SPACE .. NO-BREAK SPACE
+      (16#000A1#, 16#000A1#),  -- (Po)  INVERTED EXCLAMATION MARK .. INVERTED EXCLAMATION MARK
+      (16#000A2#, 16#000A5#),  -- (Sc)  CENT SIGN .. YEN SIGN
+      (16#000A6#, 16#000A7#),  -- (So)  BROKEN BAR .. SECTION SIGN
+      (16#000A8#, 16#000A8#),  -- (Sk)  DIAERESIS .. DIAERESIS
+      (16#000A9#, 16#000A9#),  -- (So)  COPYRIGHT SIGN .. COPYRIGHT SIGN
+      (16#000AA#, 16#000AA#),  -- (Ll)  FEMININE ORDINAL INDICATOR .. FEMININE ORDINAL INDICATOR
+      (16#000AB#, 16#000AB#),  -- (Pi)  LEFT-POINTING DOUBLE ANGLE QUOTATION MARK .. LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+      (16#000AC#, 16#000AC#),  -- (Sm)  NOT SIGN .. NOT SIGN
+      (16#000AD#, 16#000AD#),  -- (Cf)  SOFT HYPHEN .. SOFT HYPHEN
+      (16#000AE#, 16#000AE#),  -- (So)  REGISTERED SIGN .. REGISTERED SIGN
+      (16#000AF#, 16#000AF#),  -- (Sk)  MACRON .. MACRON
+      (16#000B0#, 16#000B0#),  -- (So)  DEGREE SIGN .. DEGREE SIGN
+      (16#000B1#, 16#000B1#),  -- (Sm)  PLUS-MINUS SIGN .. PLUS-MINUS SIGN
+      (16#000B2#, 16#000B3#),  -- (No)  SUPERSCRIPT TWO .. SUPERSCRIPT THREE
+      (16#000B4#, 16#000B4#),  -- (Sk)  ACUTE ACCENT .. ACUTE ACCENT
+      (16#000B5#, 16#000B5#),  -- (Ll)  MICRO SIGN .. MICRO SIGN
+      (16#000B6#, 16#000B6#),  -- (So)  PILCROW SIGN .. PILCROW SIGN
+      (16#000B7#, 16#000B7#),  -- (Po)  MIDDLE DOT .. MIDDLE DOT
+      (16#000B8#, 16#000B8#),  -- (Sk)  CEDILLA .. CEDILLA
+      (16#000B9#, 16#000B9#),  -- (No)  SUPERSCRIPT ONE .. SUPERSCRIPT ONE
+      (16#000BA#, 16#000BA#),  -- (Ll)  MASCULINE ORDINAL INDICATOR .. MASCULINE ORDINAL INDICATOR
+      (16#000BB#, 16#000BB#),  -- (Pf)  RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK .. RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+      (16#000BC#, 16#000BE#),  -- (No)  VULGAR FRACTION ONE QUARTER .. VULGAR FRACTION THREE QUARTERS
+      (16#000BF#, 16#000BF#),  -- (Po)  INVERTED QUESTION MARK .. INVERTED QUESTION MARK
+      (16#000C0#, 16#000D6#),  -- (Lu)  LATIN CAPITAL LETTER A WITH GRAVE .. LATIN CAPITAL LETTER O WITH DIAERESIS
+      (16#000D7#, 16#000D7#),  -- (Sm)  MULTIPLICATION SIGN .. MULTIPLICATION SIGN
+      (16#000D8#, 16#000DE#),  -- (Lu)  LATIN CAPITAL LETTER O WITH STROKE .. LATIN CAPITAL LETTER THORN
+      (16#000DF#, 16#000F6#),  -- (Ll)  LATIN SMALL LETTER SHARP S .. LATIN SMALL LETTER O WITH DIAERESIS
+      (16#000F7#, 16#000F7#),  -- (Sm)  DIVISION SIGN .. DIVISION SIGN
+      (16#000F8#, 16#000FF#),  -- (Ll)  LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER Y WITH DIAERESIS
+      (16#00100#, 16#00100#),  -- (Lu)  LATIN CAPITAL LETTER A WITH MACRON .. LATIN CAPITAL LETTER A WITH MACRON
+      (16#00101#, 16#00101#),  -- (Ll)  LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON
+      (16#00102#, 16#00102#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE .. LATIN CAPITAL LETTER A WITH BREVE
+      (16#00103#, 16#00103#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE
+      (16#00104#, 16#00104#),  -- (Lu)  LATIN CAPITAL LETTER A WITH OGONEK .. LATIN CAPITAL LETTER A WITH OGONEK
+      (16#00105#, 16#00105#),  -- (Ll)  LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK
+      (16#00106#, 16#00106#),  -- (Lu)  LATIN CAPITAL LETTER C WITH ACUTE .. LATIN CAPITAL LETTER C WITH ACUTE
+      (16#00107#, 16#00107#),  -- (Ll)  LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE
+      (16#00108#, 16#00108#),  -- (Lu)  LATIN CAPITAL LETTER C WITH CIRCUMFLEX .. LATIN CAPITAL LETTER C WITH CIRCUMFLEX
+      (16#00109#, 16#00109#),  -- (Ll)  LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX
+      (16#0010A#, 16#0010A#),  -- (Lu)  LATIN CAPITAL LETTER C WITH DOT ABOVE .. LATIN CAPITAL LETTER C WITH DOT ABOVE
+      (16#0010B#, 16#0010B#),  -- (Ll)  LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE
+      (16#0010C#, 16#0010C#),  -- (Lu)  LATIN CAPITAL LETTER C WITH CARON .. LATIN CAPITAL LETTER C WITH CARON
+      (16#0010D#, 16#0010D#),  -- (Ll)  LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON
+      (16#0010E#, 16#0010E#),  -- (Lu)  LATIN CAPITAL LETTER D WITH CARON .. LATIN CAPITAL LETTER D WITH CARON
+      (16#0010F#, 16#0010F#),  -- (Ll)  LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON
+      (16#00110#, 16#00110#),  -- (Lu)  LATIN CAPITAL LETTER D WITH STROKE .. LATIN CAPITAL LETTER D WITH STROKE
+      (16#00111#, 16#00111#),  -- (Ll)  LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE
+      (16#00112#, 16#00112#),  -- (Lu)  LATIN CAPITAL LETTER E WITH MACRON .. LATIN CAPITAL LETTER E WITH MACRON
+      (16#00113#, 16#00113#),  -- (Ll)  LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON
+      (16#00114#, 16#00114#),  -- (Lu)  LATIN CAPITAL LETTER E WITH BREVE .. LATIN CAPITAL LETTER E WITH BREVE
+      (16#00115#, 16#00115#),  -- (Ll)  LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE
+      (16#00116#, 16#00116#),  -- (Lu)  LATIN CAPITAL LETTER E WITH DOT ABOVE .. LATIN CAPITAL LETTER E WITH DOT ABOVE
+      (16#00117#, 16#00117#),  -- (Ll)  LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE
+      (16#00118#, 16#00118#),  -- (Lu)  LATIN CAPITAL LETTER E WITH OGONEK .. LATIN CAPITAL LETTER E WITH OGONEK
+      (16#00119#, 16#00119#),  -- (Ll)  LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK
+      (16#0011A#, 16#0011A#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CARON .. LATIN CAPITAL LETTER E WITH CARON
+      (16#0011B#, 16#0011B#),  -- (Ll)  LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON
+      (16#0011C#, 16#0011C#),  -- (Lu)  LATIN CAPITAL LETTER G WITH CIRCUMFLEX .. LATIN CAPITAL LETTER G WITH CIRCUMFLEX
+      (16#0011D#, 16#0011D#),  -- (Ll)  LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX
+      (16#0011E#, 16#0011E#),  -- (Lu)  LATIN CAPITAL LETTER G WITH BREVE .. LATIN CAPITAL LETTER G WITH BREVE
+      (16#0011F#, 16#0011F#),  -- (Ll)  LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE
+      (16#00120#, 16#00120#),  -- (Lu)  LATIN CAPITAL LETTER G WITH DOT ABOVE .. LATIN CAPITAL LETTER G WITH DOT ABOVE
+      (16#00121#, 16#00121#),  -- (Ll)  LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE
+      (16#00122#, 16#00122#),  -- (Lu)  LATIN CAPITAL LETTER G WITH CEDILLA .. LATIN CAPITAL LETTER G WITH CEDILLA
+      (16#00123#, 16#00123#),  -- (Ll)  LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA
+      (16#00124#, 16#00124#),  -- (Lu)  LATIN CAPITAL LETTER H WITH CIRCUMFLEX .. LATIN CAPITAL LETTER H WITH CIRCUMFLEX
+      (16#00125#, 16#00125#),  -- (Ll)  LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX
+      (16#00126#, 16#00126#),  -- (Lu)  LATIN CAPITAL LETTER H WITH STROKE .. LATIN CAPITAL LETTER H WITH STROKE
+      (16#00127#, 16#00127#),  -- (Ll)  LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE
+      (16#00128#, 16#00128#),  -- (Lu)  LATIN CAPITAL LETTER I WITH TILDE .. LATIN CAPITAL LETTER I WITH TILDE
+      (16#00129#, 16#00129#),  -- (Ll)  LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE
+      (16#0012A#, 16#0012A#),  -- (Lu)  LATIN CAPITAL LETTER I WITH MACRON .. LATIN CAPITAL LETTER I WITH MACRON
+      (16#0012B#, 16#0012B#),  -- (Ll)  LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON
+      (16#0012C#, 16#0012C#),  -- (Lu)  LATIN CAPITAL LETTER I WITH BREVE .. LATIN CAPITAL LETTER I WITH BREVE
+      (16#0012D#, 16#0012D#),  -- (Ll)  LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE
+      (16#0012E#, 16#0012E#),  -- (Lu)  LATIN CAPITAL LETTER I WITH OGONEK .. LATIN CAPITAL LETTER I WITH OGONEK
+      (16#0012F#, 16#0012F#),  -- (Ll)  LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK
+      (16#00130#, 16#00130#),  -- (Lu)  LATIN CAPITAL LETTER I WITH DOT ABOVE .. LATIN CAPITAL LETTER I WITH DOT ABOVE
+      (16#00131#, 16#00131#),  -- (Ll)  LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I
+      (16#00132#, 16#00132#),  -- (Lu)  LATIN CAPITAL LIGATURE IJ .. LATIN CAPITAL LIGATURE IJ
+      (16#00133#, 16#00133#),  -- (Ll)  LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ
+      (16#00134#, 16#00134#),  -- (Lu)  LATIN CAPITAL LETTER J WITH CIRCUMFLEX .. LATIN CAPITAL LETTER J WITH CIRCUMFLEX
+      (16#00135#, 16#00135#),  -- (Ll)  LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX
+      (16#00136#, 16#00136#),  -- (Lu)  LATIN CAPITAL LETTER K WITH CEDILLA .. LATIN CAPITAL LETTER K WITH CEDILLA
+      (16#00137#, 16#00138#),  -- (Ll)  LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER KRA
+      (16#00139#, 16#00139#),  -- (Lu)  LATIN CAPITAL LETTER L WITH ACUTE .. LATIN CAPITAL LETTER L WITH ACUTE
+      (16#0013A#, 16#0013A#),  -- (Ll)  LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE
+      (16#0013B#, 16#0013B#),  -- (Lu)  LATIN CAPITAL LETTER L WITH CEDILLA .. LATIN CAPITAL LETTER L WITH CEDILLA
+      (16#0013C#, 16#0013C#),  -- (Ll)  LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA
+      (16#0013D#, 16#0013D#),  -- (Lu)  LATIN CAPITAL LETTER L WITH CARON .. LATIN CAPITAL LETTER L WITH CARON
+      (16#0013E#, 16#0013E#),  -- (Ll)  LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON
+      (16#0013F#, 16#0013F#),  -- (Lu)  LATIN CAPITAL LETTER L WITH MIDDLE DOT .. LATIN CAPITAL LETTER L WITH MIDDLE DOT
+      (16#00140#, 16#00140#),  -- (Ll)  LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT
+      (16#00141#, 16#00141#),  -- (Lu)  LATIN CAPITAL LETTER L WITH STROKE .. LATIN CAPITAL LETTER L WITH STROKE
+      (16#00142#, 16#00142#),  -- (Ll)  LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE
+      (16#00143#, 16#00143#),  -- (Lu)  LATIN CAPITAL LETTER N WITH ACUTE .. LATIN CAPITAL LETTER N WITH ACUTE
+      (16#00144#, 16#00144#),  -- (Ll)  LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE
+      (16#00145#, 16#00145#),  -- (Lu)  LATIN CAPITAL LETTER N WITH CEDILLA .. LATIN CAPITAL LETTER N WITH CEDILLA
+      (16#00146#, 16#00146#),  -- (Ll)  LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA
+      (16#00147#, 16#00147#),  -- (Lu)  LATIN CAPITAL LETTER N WITH CARON .. LATIN CAPITAL LETTER N WITH CARON
+      (16#00148#, 16#00149#),  -- (Ll)  LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
+      (16#0014A#, 16#0014A#),  -- (Lu)  LATIN CAPITAL LETTER ENG .. LATIN CAPITAL LETTER ENG
+      (16#0014B#, 16#0014B#),  -- (Ll)  LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG
+      (16#0014C#, 16#0014C#),  -- (Lu)  LATIN CAPITAL LETTER O WITH MACRON .. LATIN CAPITAL LETTER O WITH MACRON
+      (16#0014D#, 16#0014D#),  -- (Ll)  LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON
+      (16#0014E#, 16#0014E#),  -- (Lu)  LATIN CAPITAL LETTER O WITH BREVE .. LATIN CAPITAL LETTER O WITH BREVE
+      (16#0014F#, 16#0014F#),  -- (Ll)  LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE
+      (16#00150#, 16#00150#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DOUBLE ACUTE .. LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+      (16#00151#, 16#00151#),  -- (Ll)  LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE
+      (16#00152#, 16#00152#),  -- (Lu)  LATIN CAPITAL LIGATURE OE .. LATIN CAPITAL LIGATURE OE
+      (16#00153#, 16#00153#),  -- (Ll)  LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE
+      (16#00154#, 16#00154#),  -- (Lu)  LATIN CAPITAL LETTER R WITH ACUTE .. LATIN CAPITAL LETTER R WITH ACUTE
+      (16#00155#, 16#00155#),  -- (Ll)  LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE
+      (16#00156#, 16#00156#),  -- (Lu)  LATIN CAPITAL LETTER R WITH CEDILLA .. LATIN CAPITAL LETTER R WITH CEDILLA
+      (16#00157#, 16#00157#),  -- (Ll)  LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA
+      (16#00158#, 16#00158#),  -- (Lu)  LATIN CAPITAL LETTER R WITH CARON .. LATIN CAPITAL LETTER R WITH CARON
+      (16#00159#, 16#00159#),  -- (Ll)  LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON
+      (16#0015A#, 16#0015A#),  -- (Lu)  LATIN CAPITAL LETTER S WITH ACUTE .. LATIN CAPITAL LETTER S WITH ACUTE
+      (16#0015B#, 16#0015B#),  -- (Ll)  LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE
+      (16#0015C#, 16#0015C#),  -- (Lu)  LATIN CAPITAL LETTER S WITH CIRCUMFLEX .. LATIN CAPITAL LETTER S WITH CIRCUMFLEX
+      (16#0015D#, 16#0015D#),  -- (Ll)  LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX
+      (16#0015E#, 16#0015E#),  -- (Lu)  LATIN CAPITAL LETTER S WITH CEDILLA .. LATIN CAPITAL LETTER S WITH CEDILLA
+      (16#0015F#, 16#0015F#),  -- (Ll)  LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA
+      (16#00160#, 16#00160#),  -- (Lu)  LATIN CAPITAL LETTER S WITH CARON .. LATIN CAPITAL LETTER S WITH CARON
+      (16#00161#, 16#00161#),  -- (Ll)  LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON
+      (16#00162#, 16#00162#),  -- (Lu)  LATIN CAPITAL LETTER T WITH CEDILLA .. LATIN CAPITAL LETTER T WITH CEDILLA
+      (16#00163#, 16#00163#),  -- (Ll)  LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA
+      (16#00164#, 16#00164#),  -- (Lu)  LATIN CAPITAL LETTER T WITH CARON .. LATIN CAPITAL LETTER T WITH CARON
+      (16#00165#, 16#00165#),  -- (Ll)  LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON
+      (16#00166#, 16#00166#),  -- (Lu)  LATIN CAPITAL LETTER T WITH STROKE .. LATIN CAPITAL LETTER T WITH STROKE
+      (16#00167#, 16#00167#),  -- (Ll)  LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE
+      (16#00168#, 16#00168#),  -- (Lu)  LATIN CAPITAL LETTER U WITH TILDE .. LATIN CAPITAL LETTER U WITH TILDE
+      (16#00169#, 16#00169#),  -- (Ll)  LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE
+      (16#0016A#, 16#0016A#),  -- (Lu)  LATIN CAPITAL LETTER U WITH MACRON .. LATIN CAPITAL LETTER U WITH MACRON
+      (16#0016B#, 16#0016B#),  -- (Ll)  LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON
+      (16#0016C#, 16#0016C#),  -- (Lu)  LATIN CAPITAL LETTER U WITH BREVE .. LATIN CAPITAL LETTER U WITH BREVE
+      (16#0016D#, 16#0016D#),  -- (Ll)  LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE
+      (16#0016E#, 16#0016E#),  -- (Lu)  LATIN CAPITAL LETTER U WITH RING ABOVE .. LATIN CAPITAL LETTER U WITH RING ABOVE
+      (16#0016F#, 16#0016F#),  -- (Ll)  LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE
+      (16#00170#, 16#00170#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DOUBLE ACUTE .. LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+      (16#00171#, 16#00171#),  -- (Ll)  LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE
+      (16#00172#, 16#00172#),  -- (Lu)  LATIN CAPITAL LETTER U WITH OGONEK .. LATIN CAPITAL LETTER U WITH OGONEK
+      (16#00173#, 16#00173#),  -- (Ll)  LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK
+      (16#00174#, 16#00174#),  -- (Lu)  LATIN CAPITAL LETTER W WITH CIRCUMFLEX .. LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+      (16#00175#, 16#00175#),  -- (Ll)  LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX
+      (16#00176#, 16#00176#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH CIRCUMFLEX .. LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+      (16#00177#, 16#00177#),  -- (Ll)  LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX
+      (16#00178#, 16#00179#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH DIAERESIS .. LATIN CAPITAL LETTER Z WITH ACUTE
+      (16#0017A#, 16#0017A#),  -- (Ll)  LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE
+      (16#0017B#, 16#0017B#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH DOT ABOVE .. LATIN CAPITAL LETTER Z WITH DOT ABOVE
+      (16#0017C#, 16#0017C#),  -- (Ll)  LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE
+      (16#0017D#, 16#0017D#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH CARON .. LATIN CAPITAL LETTER Z WITH CARON
+      (16#0017E#, 16#00180#),  -- (Ll)  LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER B WITH STROKE
+      (16#00181#, 16#00182#),  -- (Lu)  LATIN CAPITAL LETTER B WITH HOOK .. LATIN CAPITAL LETTER B WITH TOPBAR
+      (16#00183#, 16#00183#),  -- (Ll)  LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR
+      (16#00184#, 16#00184#),  -- (Lu)  LATIN CAPITAL LETTER TONE SIX .. LATIN CAPITAL LETTER TONE SIX
+      (16#00185#, 16#00185#),  -- (Ll)  LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX
+      (16#00186#, 16#00187#),  -- (Lu)  LATIN CAPITAL LETTER OPEN O .. LATIN CAPITAL LETTER C WITH HOOK
+      (16#00188#, 16#00188#),  -- (Ll)  LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK
+      (16#00189#, 16#0018B#),  -- (Lu)  LATIN CAPITAL LETTER AFRICAN D .. LATIN CAPITAL LETTER D WITH TOPBAR
+      (16#0018C#, 16#0018D#),  -- (Ll)  LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER TURNED DELTA
+      (16#0018E#, 16#00191#),  -- (Lu)  LATIN CAPITAL LETTER REVERSED E .. LATIN CAPITAL LETTER F WITH HOOK
+      (16#00192#, 16#00192#),  -- (Ll)  LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK
+      (16#00193#, 16#00194#),  -- (Lu)  LATIN CAPITAL LETTER G WITH HOOK .. LATIN CAPITAL LETTER GAMMA
+      (16#00195#, 16#00195#),  -- (Ll)  LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV
+      (16#00196#, 16#00198#),  -- (Lu)  LATIN CAPITAL LETTER IOTA .. LATIN CAPITAL LETTER K WITH HOOK
+      (16#00199#, 16#0019B#),  -- (Ll)  LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER LAMBDA WITH STROKE
+      (16#0019C#, 16#0019D#),  -- (Lu)  LATIN CAPITAL LETTER TURNED M .. LATIN CAPITAL LETTER N WITH LEFT HOOK
+      (16#0019E#, 16#0019E#),  -- (Ll)  LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG
+      (16#0019F#, 16#001A0#),  -- (Lu)  LATIN CAPITAL LETTER O WITH MIDDLE TILDE .. LATIN CAPITAL LETTER O WITH HORN
+      (16#001A1#, 16#001A1#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN
+      (16#001A2#, 16#001A2#),  -- (Lu)  LATIN CAPITAL LETTER OI .. LATIN CAPITAL LETTER OI
+      (16#001A3#, 16#001A3#),  -- (Ll)  LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI
+      (16#001A4#, 16#001A4#),  -- (Lu)  LATIN CAPITAL LETTER P WITH HOOK .. LATIN CAPITAL LETTER P WITH HOOK
+      (16#001A5#, 16#001A5#),  -- (Ll)  LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK
+      (16#001A6#, 16#001A7#),  -- (Lu)  LATIN LETTER YR .. LATIN CAPITAL LETTER TONE TWO
+      (16#001A8#, 16#001A8#),  -- (Ll)  LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO
+      (16#001A9#, 16#001A9#),  -- (Lu)  LATIN CAPITAL LETTER ESH .. LATIN CAPITAL LETTER ESH
+      (16#001AA#, 16#001AB#),  -- (Ll)  LATIN LETTER REVERSED ESH LOOP .. LATIN SMALL LETTER T WITH PALATAL HOOK
+      (16#001AC#, 16#001AC#),  -- (Lu)  LATIN CAPITAL LETTER T WITH HOOK .. LATIN CAPITAL LETTER T WITH HOOK
+      (16#001AD#, 16#001AD#),  -- (Ll)  LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK
+      (16#001AE#, 16#001AF#),  -- (Lu)  LATIN CAPITAL LETTER T WITH RETROFLEX HOOK .. LATIN CAPITAL LETTER U WITH HORN
+      (16#001B0#, 16#001B0#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN
+      (16#001B1#, 16#001B3#),  -- (Lu)  LATIN CAPITAL LETTER UPSILON .. LATIN CAPITAL LETTER Y WITH HOOK
+      (16#001B4#, 16#001B4#),  -- (Ll)  LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK
+      (16#001B5#, 16#001B5#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH STROKE .. LATIN CAPITAL LETTER Z WITH STROKE
+      (16#001B6#, 16#001B6#),  -- (Ll)  LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE
+      (16#001B7#, 16#001B8#),  -- (Lu)  LATIN CAPITAL LETTER EZH .. LATIN CAPITAL LETTER EZH REVERSED
+      (16#001B9#, 16#001BA#),  -- (Ll)  LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH WITH TAIL
+      (16#001BB#, 16#001BB#),  -- (Lo)  LATIN LETTER TWO WITH STROKE .. LATIN LETTER TWO WITH STROKE
+      (16#001BC#, 16#001BC#),  -- (Lu)  LATIN CAPITAL LETTER TONE FIVE .. LATIN CAPITAL LETTER TONE FIVE
+      (16#001BD#, 16#001BF#),  -- (Ll)  LATIN SMALL LETTER TONE FIVE .. LATIN LETTER WYNN
+      (16#001C0#, 16#001C3#),  -- (Lo)  LATIN LETTER DENTAL CLICK .. LATIN LETTER RETROFLEX CLICK
+      (16#001C4#, 16#001C4#),  -- (Lu)  LATIN CAPITAL LETTER DZ WITH CARON .. LATIN CAPITAL LETTER DZ WITH CARON
+      (16#001C5#, 16#001C5#),  -- (Lt)  LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
+      (16#001C6#, 16#001C6#),  -- (Ll)  LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON
+      (16#001C7#, 16#001C7#),  -- (Lu)  LATIN CAPITAL LETTER LJ .. LATIN CAPITAL LETTER LJ
+      (16#001C8#, 16#001C8#),  -- (Lt)  LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J
+      (16#001C9#, 16#001C9#),  -- (Ll)  LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ
+      (16#001CA#, 16#001CA#),  -- (Lu)  LATIN CAPITAL LETTER NJ .. LATIN CAPITAL LETTER NJ
+      (16#001CB#, 16#001CB#),  -- (Lt)  LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J
+      (16#001CC#, 16#001CC#),  -- (Ll)  LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ
+      (16#001CD#, 16#001CD#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CARON .. LATIN CAPITAL LETTER A WITH CARON
+      (16#001CE#, 16#001CE#),  -- (Ll)  LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON
+      (16#001CF#, 16#001CF#),  -- (Lu)  LATIN CAPITAL LETTER I WITH CARON .. LATIN CAPITAL LETTER I WITH CARON
+      (16#001D0#, 16#001D0#),  -- (Ll)  LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON
+      (16#001D1#, 16#001D1#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CARON .. LATIN CAPITAL LETTER O WITH CARON
+      (16#001D2#, 16#001D2#),  -- (Ll)  LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON
+      (16#001D3#, 16#001D3#),  -- (Lu)  LATIN CAPITAL LETTER U WITH CARON .. LATIN CAPITAL LETTER U WITH CARON
+      (16#001D4#, 16#001D4#),  -- (Ll)  LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON
+      (16#001D5#, 16#001D5#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON
+      (16#001D6#, 16#001D6#),  -- (Ll)  LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON
+      (16#001D7#, 16#001D7#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE .. LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE
+      (16#001D8#, 16#001D8#),  -- (Ll)  LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE
+      (16#001D9#, 16#001D9#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON .. LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON
+      (16#001DA#, 16#001DA#),  -- (Ll)  LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON
+      (16#001DB#, 16#001DB#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE .. LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE
+      (16#001DC#, 16#001DD#),  -- (Ll)  LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER TURNED E
+      (16#001DE#, 16#001DE#),  -- (Lu)  LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON
+      (16#001DF#, 16#001DF#),  -- (Ll)  LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON
+      (16#001E0#, 16#001E0#),  -- (Lu)  LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON .. LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON
+      (16#001E1#, 16#001E1#),  -- (Ll)  LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON
+      (16#001E2#, 16#001E2#),  -- (Lu)  LATIN CAPITAL LETTER AE WITH MACRON .. LATIN CAPITAL LETTER AE WITH MACRON
+      (16#001E3#, 16#001E3#),  -- (Ll)  LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON
+      (16#001E4#, 16#001E4#),  -- (Lu)  LATIN CAPITAL LETTER G WITH STROKE .. LATIN CAPITAL LETTER G WITH STROKE
+      (16#001E5#, 16#001E5#),  -- (Ll)  LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE
+      (16#001E6#, 16#001E6#),  -- (Lu)  LATIN CAPITAL LETTER G WITH CARON .. LATIN CAPITAL LETTER G WITH CARON
+      (16#001E7#, 16#001E7#),  -- (Ll)  LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON
+      (16#001E8#, 16#001E8#),  -- (Lu)  LATIN CAPITAL LETTER K WITH CARON .. LATIN CAPITAL LETTER K WITH CARON
+      (16#001E9#, 16#001E9#),  -- (Ll)  LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON
+      (16#001EA#, 16#001EA#),  -- (Lu)  LATIN CAPITAL LETTER O WITH OGONEK .. LATIN CAPITAL LETTER O WITH OGONEK
+      (16#001EB#, 16#001EB#),  -- (Ll)  LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK
+      (16#001EC#, 16#001EC#),  -- (Lu)  LATIN CAPITAL LETTER O WITH OGONEK AND MACRON .. LATIN CAPITAL LETTER O WITH OGONEK AND MACRON
+      (16#001ED#, 16#001ED#),  -- (Ll)  LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON
+      (16#001EE#, 16#001EE#),  -- (Lu)  LATIN CAPITAL LETTER EZH WITH CARON .. LATIN CAPITAL LETTER EZH WITH CARON
+      (16#001EF#, 16#001F0#),  -- (Ll)  LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER J WITH CARON
+      (16#001F1#, 16#001F1#),  -- (Lu)  LATIN CAPITAL LETTER DZ .. LATIN CAPITAL LETTER DZ
+      (16#001F2#, 16#001F2#),  -- (Lt)  LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z
+      (16#001F3#, 16#001F3#),  -- (Ll)  LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ
+      (16#001F4#, 16#001F4#),  -- (Lu)  LATIN CAPITAL LETTER G WITH ACUTE .. LATIN CAPITAL LETTER G WITH ACUTE
+      (16#001F5#, 16#001F5#),  -- (Ll)  LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE
+      (16#001F6#, 16#001F8#),  -- (Lu)  LATIN CAPITAL LETTER HWAIR .. LATIN CAPITAL LETTER N WITH GRAVE
+      (16#001F9#, 16#001F9#),  -- (Ll)  LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE
+      (16#001FA#, 16#001FA#),  -- (Lu)  LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE .. LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE
+      (16#001FB#, 16#001FB#),  -- (Ll)  LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE
+      (16#001FC#, 16#001FC#),  -- (Lu)  LATIN CAPITAL LETTER AE WITH ACUTE .. LATIN CAPITAL LETTER AE WITH ACUTE
+      (16#001FD#, 16#001FD#),  -- (Ll)  LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE
+      (16#001FE#, 16#001FE#),  -- (Lu)  LATIN CAPITAL LETTER O WITH STROKE AND ACUTE .. LATIN CAPITAL LETTER O WITH STROKE AND ACUTE
+      (16#001FF#, 16#001FF#),  -- (Ll)  LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE
+      (16#00200#, 16#00200#),  -- (Lu)  LATIN CAPITAL LETTER A WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER A WITH DOUBLE GRAVE
+      (16#00201#, 16#00201#),  -- (Ll)  LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE
+      (16#00202#, 16#00202#),  -- (Lu)  LATIN CAPITAL LETTER A WITH INVERTED BREVE .. LATIN CAPITAL LETTER A WITH INVERTED BREVE
+      (16#00203#, 16#00203#),  -- (Ll)  LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE
+      (16#00204#, 16#00204#),  -- (Lu)  LATIN CAPITAL LETTER E WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER E WITH DOUBLE GRAVE
+      (16#00205#, 16#00205#),  -- (Ll)  LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE
+      (16#00206#, 16#00206#),  -- (Lu)  LATIN CAPITAL LETTER E WITH INVERTED BREVE .. LATIN CAPITAL LETTER E WITH INVERTED BREVE
+      (16#00207#, 16#00207#),  -- (Ll)  LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE
+      (16#00208#, 16#00208#),  -- (Lu)  LATIN CAPITAL LETTER I WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER I WITH DOUBLE GRAVE
+      (16#00209#, 16#00209#),  -- (Ll)  LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE
+      (16#0020A#, 16#0020A#),  -- (Lu)  LATIN CAPITAL LETTER I WITH INVERTED BREVE .. LATIN CAPITAL LETTER I WITH INVERTED BREVE
+      (16#0020B#, 16#0020B#),  -- (Ll)  LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE
+      (16#0020C#, 16#0020C#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER O WITH DOUBLE GRAVE
+      (16#0020D#, 16#0020D#),  -- (Ll)  LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE
+      (16#0020E#, 16#0020E#),  -- (Lu)  LATIN CAPITAL LETTER O WITH INVERTED BREVE .. LATIN CAPITAL LETTER O WITH INVERTED BREVE
+      (16#0020F#, 16#0020F#),  -- (Ll)  LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE
+      (16#00210#, 16#00210#),  -- (Lu)  LATIN CAPITAL LETTER R WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER R WITH DOUBLE GRAVE
+      (16#00211#, 16#00211#),  -- (Ll)  LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE
+      (16#00212#, 16#00212#),  -- (Lu)  LATIN CAPITAL LETTER R WITH INVERTED BREVE .. LATIN CAPITAL LETTER R WITH INVERTED BREVE
+      (16#00213#, 16#00213#),  -- (Ll)  LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE
+      (16#00214#, 16#00214#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER U WITH DOUBLE GRAVE
+      (16#00215#, 16#00215#),  -- (Ll)  LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE
+      (16#00216#, 16#00216#),  -- (Lu)  LATIN CAPITAL LETTER U WITH INVERTED BREVE .. LATIN CAPITAL LETTER U WITH INVERTED BREVE
+      (16#00217#, 16#00217#),  -- (Ll)  LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE
+      (16#00218#, 16#00218#),  -- (Lu)  LATIN CAPITAL LETTER S WITH COMMA BELOW .. LATIN CAPITAL LETTER S WITH COMMA BELOW
+      (16#00219#, 16#00219#),  -- (Ll)  LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW
+      (16#0021A#, 16#0021A#),  -- (Lu)  LATIN CAPITAL LETTER T WITH COMMA BELOW .. LATIN CAPITAL LETTER T WITH COMMA BELOW
+      (16#0021B#, 16#0021B#),  -- (Ll)  LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW
+      (16#0021C#, 16#0021C#),  -- (Lu)  LATIN CAPITAL LETTER YOGH .. LATIN CAPITAL LETTER YOGH
+      (16#0021D#, 16#0021D#),  -- (Ll)  LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH
+      (16#0021E#, 16#0021E#),  -- (Lu)  LATIN CAPITAL LETTER H WITH CARON .. LATIN CAPITAL LETTER H WITH CARON
+      (16#0021F#, 16#0021F#),  -- (Ll)  LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON
+      (16#00220#, 16#00220#),  -- (Lu)  LATIN CAPITAL LETTER N WITH LONG RIGHT LEG .. LATIN CAPITAL LETTER N WITH LONG RIGHT LEG
+      (16#00221#, 16#00221#),  -- (Ll)  LATIN SMALL LETTER D WITH CURL .. LATIN SMALL LETTER D WITH CURL
+      (16#00222#, 16#00222#),  -- (Lu)  LATIN CAPITAL LETTER OU .. LATIN CAPITAL LETTER OU
+      (16#00223#, 16#00223#),  -- (Ll)  LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU
+      (16#00224#, 16#00224#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH HOOK .. LATIN CAPITAL LETTER Z WITH HOOK
+      (16#00225#, 16#00225#),  -- (Ll)  LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK
+      (16#00226#, 16#00226#),  -- (Lu)  LATIN CAPITAL LETTER A WITH DOT ABOVE .. LATIN CAPITAL LETTER A WITH DOT ABOVE
+      (16#00227#, 16#00227#),  -- (Ll)  LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE
+      (16#00228#, 16#00228#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CEDILLA .. LATIN CAPITAL LETTER E WITH CEDILLA
+      (16#00229#, 16#00229#),  -- (Ll)  LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA
+      (16#0022A#, 16#0022A#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON
+      (16#0022B#, 16#0022B#),  -- (Ll)  LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON
+      (16#0022C#, 16#0022C#),  -- (Lu)  LATIN CAPITAL LETTER O WITH TILDE AND MACRON .. LATIN CAPITAL LETTER O WITH TILDE AND MACRON
+      (16#0022D#, 16#0022D#),  -- (Ll)  LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON
+      (16#0022E#, 16#0022E#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DOT ABOVE .. LATIN CAPITAL LETTER O WITH DOT ABOVE
+      (16#0022F#, 16#0022F#),  -- (Ll)  LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE
+      (16#00230#, 16#00230#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON .. LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON
+      (16#00231#, 16#00231#),  -- (Ll)  LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON
+      (16#00232#, 16#00232#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH MACRON .. LATIN CAPITAL LETTER Y WITH MACRON
+      (16#00233#, 16#00236#),  -- (Ll)  LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER T WITH CURL
+      (16#00250#, 16#002AF#),  -- (Ll)  LATIN SMALL LETTER TURNED A .. LATIN SMALL LETTER TURNED H WITH FISHHOOK AND TAIL
+      (16#002B0#, 16#002C1#),  -- (Lm)  MODIFIER LETTER SMALL H .. MODIFIER LETTER REVERSED GLOTTAL STOP
+      (16#002C2#, 16#002C5#),  -- (Sk)  MODIFIER LETTER LEFT ARROWHEAD .. MODIFIER LETTER DOWN ARROWHEAD
+      (16#002C6#, 16#002D1#),  -- (Lm)  MODIFIER LETTER CIRCUMFLEX ACCENT .. MODIFIER LETTER HALF TRIANGULAR COLON
+      (16#002D2#, 16#002DF#),  -- (Sk)  MODIFIER LETTER CENTRED RIGHT HALF RING .. MODIFIER LETTER CROSS ACCENT
+      (16#002E0#, 16#002E4#),  -- (Lm)  MODIFIER LETTER SMALL GAMMA .. MODIFIER LETTER SMALL REVERSED GLOTTAL STOP
+      (16#002E5#, 16#002ED#),  -- (Sk)  MODIFIER LETTER EXTRA-HIGH TONE BAR .. MODIFIER LETTER UNASPIRATED
+      (16#002EE#, 16#002EE#),  -- (Lm)  MODIFIER LETTER DOUBLE APOSTROPHE .. MODIFIER LETTER DOUBLE APOSTROPHE
+      (16#002EF#, 16#002FF#),  -- (Sk)  MODIFIER LETTER LOW DOWN ARROWHEAD .. MODIFIER LETTER LOW LEFT ARROW
+      (16#00300#, 16#00357#),  -- (Mn)  COMBINING GRAVE ACCENT .. COMBINING RIGHT HALF RING ABOVE
+      (16#0035D#, 16#0036F#),  -- (Mn)  COMBINING DOUBLE BREVE .. COMBINING LATIN SMALL LETTER X
+      (16#00374#, 16#00375#),  -- (Sk)  GREEK NUMERAL SIGN .. GREEK LOWER NUMERAL SIGN
+      (16#0037A#, 16#0037A#),  -- (Lm)  GREEK YPOGEGRAMMENI .. GREEK YPOGEGRAMMENI
+      (16#0037E#, 16#0037E#),  -- (Po)  GREEK QUESTION MARK .. GREEK QUESTION MARK
+      (16#00384#, 16#00385#),  -- (Sk)  GREEK TONOS .. GREEK DIALYTIKA TONOS
+      (16#00386#, 16#00386#),  -- (Lu)  GREEK CAPITAL LETTER ALPHA WITH TONOS .. GREEK CAPITAL LETTER ALPHA WITH TONOS
+      (16#00387#, 16#00387#),  -- (Po)  GREEK ANO TELEIA .. GREEK ANO TELEIA
+      (16#00388#, 16#0038A#),  -- (Lu)  GREEK CAPITAL LETTER EPSILON WITH TONOS .. GREEK CAPITAL LETTER IOTA WITH TONOS
+      (16#0038C#, 16#0038C#),  -- (Lu)  GREEK CAPITAL LETTER OMICRON WITH TONOS .. GREEK CAPITAL LETTER OMICRON WITH TONOS
+      (16#0038E#, 16#0038F#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH TONOS .. GREEK CAPITAL LETTER OMEGA WITH TONOS
+      (16#00390#, 16#00390#),  -- (Ll)  GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+      (16#00391#, 16#003A1#),  -- (Lu)  GREEK CAPITAL LETTER ALPHA .. GREEK CAPITAL LETTER RHO
+      (16#003A3#, 16#003AB#),  -- (Lu)  GREEK CAPITAL LETTER SIGMA .. GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+      (16#003AC#, 16#003CE#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS
+      (16#003D0#, 16#003D1#),  -- (Ll)  GREEK BETA SYMBOL .. GREEK THETA SYMBOL
+      (16#003D2#, 16#003D4#),  -- (Lu)  GREEK UPSILON WITH HOOK SYMBOL .. GREEK UPSILON WITH DIAERESIS AND HOOK SYMBOL
+      (16#003D5#, 16#003D7#),  -- (Ll)  GREEK PHI SYMBOL .. GREEK KAI SYMBOL
+      (16#003D8#, 16#003D8#),  -- (Lu)  GREEK LETTER ARCHAIC KOPPA .. GREEK LETTER ARCHAIC KOPPA
+      (16#003D9#, 16#003D9#),  -- (Ll)  GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA
+      (16#003DA#, 16#003DA#),  -- (Lu)  GREEK LETTER STIGMA .. GREEK LETTER STIGMA
+      (16#003DB#, 16#003DB#),  -- (Ll)  GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA
+      (16#003DC#, 16#003DC#),  -- (Lu)  GREEK LETTER DIGAMMA .. GREEK LETTER DIGAMMA
+      (16#003DD#, 16#003DD#),  -- (Ll)  GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA
+      (16#003DE#, 16#003DE#),  -- (Lu)  GREEK LETTER KOPPA .. GREEK LETTER KOPPA
+      (16#003DF#, 16#003DF#),  -- (Ll)  GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA
+      (16#003E0#, 16#003E0#),  -- (Lu)  GREEK LETTER SAMPI .. GREEK LETTER SAMPI
+      (16#003E1#, 16#003E1#),  -- (Ll)  GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI
+      (16#003E2#, 16#003E2#),  -- (Lu)  COPTIC CAPITAL LETTER SHEI .. COPTIC CAPITAL LETTER SHEI
+      (16#003E3#, 16#003E3#),  -- (Ll)  COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI
+      (16#003E4#, 16#003E4#),  -- (Lu)  COPTIC CAPITAL LETTER FEI .. COPTIC CAPITAL LETTER FEI
+      (16#003E5#, 16#003E5#),  -- (Ll)  COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI
+      (16#003E6#, 16#003E6#),  -- (Lu)  COPTIC CAPITAL LETTER KHEI .. COPTIC CAPITAL LETTER KHEI
+      (16#003E7#, 16#003E7#),  -- (Ll)  COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI
+      (16#003E8#, 16#003E8#),  -- (Lu)  COPTIC CAPITAL LETTER HORI .. COPTIC CAPITAL LETTER HORI
+      (16#003E9#, 16#003E9#),  -- (Ll)  COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI
+      (16#003EA#, 16#003EA#),  -- (Lu)  COPTIC CAPITAL LETTER GANGIA .. COPTIC CAPITAL LETTER GANGIA
+      (16#003EB#, 16#003EB#),  -- (Ll)  COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA
+      (16#003EC#, 16#003EC#),  -- (Lu)  COPTIC CAPITAL LETTER SHIMA .. COPTIC CAPITAL LETTER SHIMA
+      (16#003ED#, 16#003ED#),  -- (Ll)  COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA
+      (16#003EE#, 16#003EE#),  -- (Lu)  COPTIC CAPITAL LETTER DEI .. COPTIC CAPITAL LETTER DEI
+      (16#003EF#, 16#003F3#),  -- (Ll)  COPTIC SMALL LETTER DEI .. GREEK LETTER YOT
+      (16#003F4#, 16#003F4#),  -- (Lu)  GREEK CAPITAL THETA SYMBOL .. GREEK CAPITAL THETA SYMBOL
+      (16#003F5#, 16#003F5#),  -- (Ll)  GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL
+      (16#003F6#, 16#003F6#),  -- (Sm)  GREEK REVERSED LUNATE EPSILON SYMBOL .. GREEK REVERSED LUNATE EPSILON SYMBOL
+      (16#003F7#, 16#003F7#),  -- (Lu)  GREEK CAPITAL LETTER SHO .. GREEK CAPITAL LETTER SHO
+      (16#003F8#, 16#003F8#),  -- (Ll)  GREEK SMALL LETTER SHO .. GREEK SMALL LETTER SHO
+      (16#003F9#, 16#003FA#),  -- (Lu)  GREEK CAPITAL LUNATE SIGMA SYMBOL .. GREEK CAPITAL LETTER SAN
+      (16#003FB#, 16#003FB#),  -- (Ll)  GREEK SMALL LETTER SAN .. GREEK SMALL LETTER SAN
+      (16#00400#, 16#0042F#),  -- (Lu)  CYRILLIC CAPITAL LETTER IE WITH GRAVE .. CYRILLIC CAPITAL LETTER YA
+      (16#00430#, 16#0045F#),  -- (Ll)  CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER DZHE
+      (16#00460#, 16#00460#),  -- (Lu)  CYRILLIC CAPITAL LETTER OMEGA .. CYRILLIC CAPITAL LETTER OMEGA
+      (16#00461#, 16#00461#),  -- (Ll)  CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA
+      (16#00462#, 16#00462#),  -- (Lu)  CYRILLIC CAPITAL LETTER YAT .. CYRILLIC CAPITAL LETTER YAT
+      (16#00463#, 16#00463#),  -- (Ll)  CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT
+      (16#00464#, 16#00464#),  -- (Lu)  CYRILLIC CAPITAL LETTER IOTIFIED E .. CYRILLIC CAPITAL LETTER IOTIFIED E
+      (16#00465#, 16#00465#),  -- (Ll)  CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E
+      (16#00466#, 16#00466#),  -- (Lu)  CYRILLIC CAPITAL LETTER LITTLE YUS .. CYRILLIC CAPITAL LETTER LITTLE YUS
+      (16#00467#, 16#00467#),  -- (Ll)  CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS
+      (16#00468#, 16#00468#),  -- (Lu)  CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS .. CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS
+      (16#00469#, 16#00469#),  -- (Ll)  CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS
+      (16#0046A#, 16#0046A#),  -- (Lu)  CYRILLIC CAPITAL LETTER BIG YUS .. CYRILLIC CAPITAL LETTER BIG YUS
+      (16#0046B#, 16#0046B#),  -- (Ll)  CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS
+      (16#0046C#, 16#0046C#),  -- (Lu)  CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS .. CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS
+      (16#0046D#, 16#0046D#),  -- (Ll)  CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS
+      (16#0046E#, 16#0046E#),  -- (Lu)  CYRILLIC CAPITAL LETTER KSI .. CYRILLIC CAPITAL LETTER KSI
+      (16#0046F#, 16#0046F#),  -- (Ll)  CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI
+      (16#00470#, 16#00470#),  -- (Lu)  CYRILLIC CAPITAL LETTER PSI .. CYRILLIC CAPITAL LETTER PSI
+      (16#00471#, 16#00471#),  -- (Ll)  CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI
+      (16#00472#, 16#00472#),  -- (Lu)  CYRILLIC CAPITAL LETTER FITA .. CYRILLIC CAPITAL LETTER FITA
+      (16#00473#, 16#00473#),  -- (Ll)  CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA
+      (16#00474#, 16#00474#),  -- (Lu)  CYRILLIC CAPITAL LETTER IZHITSA .. CYRILLIC CAPITAL LETTER IZHITSA
+      (16#00475#, 16#00475#),  -- (Ll)  CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA
+      (16#00476#, 16#00476#),  -- (Lu)  CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
+      (16#00477#, 16#00477#),  -- (Ll)  CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
+      (16#00478#, 16#00478#),  -- (Lu)  CYRILLIC CAPITAL LETTER UK .. CYRILLIC CAPITAL LETTER UK
+      (16#00479#, 16#00479#),  -- (Ll)  CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK
+      (16#0047A#, 16#0047A#),  -- (Lu)  CYRILLIC CAPITAL LETTER ROUND OMEGA .. CYRILLIC CAPITAL LETTER ROUND OMEGA
+      (16#0047B#, 16#0047B#),  -- (Ll)  CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA
+      (16#0047C#, 16#0047C#),  -- (Lu)  CYRILLIC CAPITAL LETTER OMEGA WITH TITLO .. CYRILLIC CAPITAL LETTER OMEGA WITH TITLO
+      (16#0047D#, 16#0047D#),  -- (Ll)  CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO
+      (16#0047E#, 16#0047E#),  -- (Lu)  CYRILLIC CAPITAL LETTER OT .. CYRILLIC CAPITAL LETTER OT
+      (16#0047F#, 16#0047F#),  -- (Ll)  CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT
+      (16#00480#, 16#00480#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOPPA .. CYRILLIC CAPITAL LETTER KOPPA
+      (16#00481#, 16#00481#),  -- (Ll)  CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA
+      (16#00482#, 16#00482#),  -- (So)  CYRILLIC THOUSANDS SIGN .. CYRILLIC THOUSANDS SIGN
+      (16#00483#, 16#00486#),  -- (Mn)  COMBINING CYRILLIC TITLO .. COMBINING CYRILLIC PSILI PNEUMATA
+      (16#00488#, 16#00489#),  -- (Me)  COMBINING CYRILLIC HUNDRED THOUSANDS SIGN .. COMBINING CYRILLIC MILLIONS SIGN
+      (16#0048A#, 16#0048A#),  -- (Lu)  CYRILLIC CAPITAL LETTER SHORT I WITH TAIL .. CYRILLIC CAPITAL LETTER SHORT I WITH TAIL
+      (16#0048B#, 16#0048B#),  -- (Ll)  CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL
+      (16#0048C#, 16#0048C#),  -- (Lu)  CYRILLIC CAPITAL LETTER SEMISOFT SIGN .. CYRILLIC CAPITAL LETTER SEMISOFT SIGN
+      (16#0048D#, 16#0048D#),  -- (Ll)  CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN
+      (16#0048E#, 16#0048E#),  -- (Lu)  CYRILLIC CAPITAL LETTER ER WITH TICK .. CYRILLIC CAPITAL LETTER ER WITH TICK
+      (16#0048F#, 16#0048F#),  -- (Ll)  CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK
+      (16#00490#, 16#00490#),  -- (Lu)  CYRILLIC CAPITAL LETTER GHE WITH UPTURN .. CYRILLIC CAPITAL LETTER GHE WITH UPTURN
+      (16#00491#, 16#00491#),  -- (Ll)  CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN
+      (16#00492#, 16#00492#),  -- (Lu)  CYRILLIC CAPITAL LETTER GHE WITH STROKE .. CYRILLIC CAPITAL LETTER GHE WITH STROKE
+      (16#00493#, 16#00493#),  -- (Ll)  CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE
+      (16#00494#, 16#00494#),  -- (Lu)  CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK
+      (16#00495#, 16#00495#),  -- (Ll)  CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK
+      (16#00496#, 16#00496#),  -- (Lu)  CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER
+      (16#00497#, 16#00497#),  -- (Ll)  CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER
+      (16#00498#, 16#00498#),  -- (Lu)  CYRILLIC CAPITAL LETTER ZE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ZE WITH DESCENDER
+      (16#00499#, 16#00499#),  -- (Ll)  CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER
+      (16#0049A#, 16#0049A#),  -- (Lu)  CYRILLIC CAPITAL LETTER KA WITH DESCENDER .. CYRILLIC CAPITAL LETTER KA WITH DESCENDER
+      (16#0049B#, 16#0049B#),  -- (Ll)  CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER
+      (16#0049C#, 16#0049C#),  -- (Lu)  CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE .. CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE
+      (16#0049D#, 16#0049D#),  -- (Ll)  CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE
+      (16#0049E#, 16#0049E#),  -- (Lu)  CYRILLIC CAPITAL LETTER KA WITH STROKE .. CYRILLIC CAPITAL LETTER KA WITH STROKE
+      (16#0049F#, 16#0049F#),  -- (Ll)  CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE
+      (16#004A0#, 16#004A0#),  -- (Lu)  CYRILLIC CAPITAL LETTER BASHKIR KA .. CYRILLIC CAPITAL LETTER BASHKIR KA
+      (16#004A1#, 16#004A1#),  -- (Ll)  CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA
+      (16#004A2#, 16#004A2#),  -- (Lu)  CYRILLIC CAPITAL LETTER EN WITH DESCENDER .. CYRILLIC CAPITAL LETTER EN WITH DESCENDER
+      (16#004A3#, 16#004A3#),  -- (Ll)  CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER
+      (16#004A4#, 16#004A4#),  -- (Lu)  CYRILLIC CAPITAL LIGATURE EN GHE .. CYRILLIC CAPITAL LIGATURE EN GHE
+      (16#004A5#, 16#004A5#),  -- (Ll)  CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE
+      (16#004A6#, 16#004A6#),  -- (Lu)  CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK .. CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK
+      (16#004A7#, 16#004A7#),  -- (Ll)  CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK
+      (16#004A8#, 16#004A8#),  -- (Lu)  CYRILLIC CAPITAL LETTER ABKHASIAN HA .. CYRILLIC CAPITAL LETTER ABKHASIAN HA
+      (16#004A9#, 16#004A9#),  -- (Ll)  CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA
+      (16#004AA#, 16#004AA#),  -- (Lu)  CYRILLIC CAPITAL LETTER ES WITH DESCENDER .. CYRILLIC CAPITAL LETTER ES WITH DESCENDER
+      (16#004AB#, 16#004AB#),  -- (Ll)  CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER
+      (16#004AC#, 16#004AC#),  -- (Lu)  CYRILLIC CAPITAL LETTER TE WITH DESCENDER .. CYRILLIC CAPITAL LETTER TE WITH DESCENDER
+      (16#004AD#, 16#004AD#),  -- (Ll)  CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER
+      (16#004AE#, 16#004AE#),  -- (Lu)  CYRILLIC CAPITAL LETTER STRAIGHT U .. CYRILLIC CAPITAL LETTER STRAIGHT U
+      (16#004AF#, 16#004AF#),  -- (Ll)  CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U
+      (16#004B0#, 16#004B0#),  -- (Lu)  CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE .. CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE
+      (16#004B1#, 16#004B1#),  -- (Ll)  CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE
+      (16#004B2#, 16#004B2#),  -- (Lu)  CYRILLIC CAPITAL LETTER HA WITH DESCENDER .. CYRILLIC CAPITAL LETTER HA WITH DESCENDER
+      (16#004B3#, 16#004B3#),  -- (Ll)  CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER
+      (16#004B4#, 16#004B4#),  -- (Lu)  CYRILLIC CAPITAL LIGATURE TE TSE .. CYRILLIC CAPITAL LIGATURE TE TSE
+      (16#004B5#, 16#004B5#),  -- (Ll)  CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE
+      (16#004B6#, 16#004B6#),  -- (Lu)  CYRILLIC CAPITAL LETTER CHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER CHE WITH DESCENDER
+      (16#004B7#, 16#004B7#),  -- (Ll)  CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER
+      (16#004B8#, 16#004B8#),  -- (Lu)  CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE
+      (16#004B9#, 16#004B9#),  -- (Ll)  CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE
+      (16#004BA#, 16#004BA#),  -- (Lu)  CYRILLIC CAPITAL LETTER SHHA .. CYRILLIC CAPITAL LETTER SHHA
+      (16#004BB#, 16#004BB#),  -- (Ll)  CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA
+      (16#004BC#, 16#004BC#),  -- (Lu)  CYRILLIC CAPITAL LETTER ABKHASIAN CHE .. CYRILLIC CAPITAL LETTER ABKHASIAN CHE
+      (16#004BD#, 16#004BD#),  -- (Ll)  CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE
+      (16#004BE#, 16#004BE#),  -- (Lu)  CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER
+      (16#004BF#, 16#004BF#),  -- (Ll)  CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER
+      (16#004C0#, 16#004C1#),  -- (Lu)  CYRILLIC LETTER PALOCHKA .. CYRILLIC CAPITAL LETTER ZHE WITH BREVE
+      (16#004C2#, 16#004C2#),  -- (Ll)  CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE
+      (16#004C3#, 16#004C3#),  -- (Lu)  CYRILLIC CAPITAL LETTER KA WITH HOOK .. CYRILLIC CAPITAL LETTER KA WITH HOOK
+      (16#004C4#, 16#004C4#),  -- (Ll)  CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK
+      (16#004C5#, 16#004C5#),  -- (Lu)  CYRILLIC CAPITAL LETTER EL WITH TAIL .. CYRILLIC CAPITAL LETTER EL WITH TAIL
+      (16#004C6#, 16#004C6#),  -- (Ll)  CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL
+      (16#004C7#, 16#004C7#),  -- (Lu)  CYRILLIC CAPITAL LETTER EN WITH HOOK .. CYRILLIC CAPITAL LETTER EN WITH HOOK
+      (16#004C8#, 16#004C8#),  -- (Ll)  CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK
+      (16#004C9#, 16#004C9#),  -- (Lu)  CYRILLIC CAPITAL LETTER EN WITH TAIL .. CYRILLIC CAPITAL LETTER EN WITH TAIL
+      (16#004CA#, 16#004CA#),  -- (Ll)  CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL
+      (16#004CB#, 16#004CB#),  -- (Lu)  CYRILLIC CAPITAL LETTER KHAKASSIAN CHE .. CYRILLIC CAPITAL LETTER KHAKASSIAN CHE
+      (16#004CC#, 16#004CC#),  -- (Ll)  CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE
+      (16#004CD#, 16#004CD#),  -- (Lu)  CYRILLIC CAPITAL LETTER EM WITH TAIL .. CYRILLIC CAPITAL LETTER EM WITH TAIL
+      (16#004CE#, 16#004CE#),  -- (Ll)  CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL
+      (16#004D0#, 16#004D0#),  -- (Lu)  CYRILLIC CAPITAL LETTER A WITH BREVE .. CYRILLIC CAPITAL LETTER A WITH BREVE
+      (16#004D1#, 16#004D1#),  -- (Ll)  CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE
+      (16#004D2#, 16#004D2#),  -- (Lu)  CYRILLIC CAPITAL LETTER A WITH DIAERESIS .. CYRILLIC CAPITAL LETTER A WITH DIAERESIS
+      (16#004D3#, 16#004D3#),  -- (Ll)  CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS
+      (16#004D4#, 16#004D4#),  -- (Lu)  CYRILLIC CAPITAL LIGATURE A IE .. CYRILLIC CAPITAL LIGATURE A IE
+      (16#004D5#, 16#004D5#),  -- (Ll)  CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE
+      (16#004D6#, 16#004D6#),  -- (Lu)  CYRILLIC CAPITAL LETTER IE WITH BREVE .. CYRILLIC CAPITAL LETTER IE WITH BREVE
+      (16#004D7#, 16#004D7#),  -- (Ll)  CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE
+      (16#004D8#, 16#004D8#),  -- (Lu)  CYRILLIC CAPITAL LETTER SCHWA .. CYRILLIC CAPITAL LETTER SCHWA
+      (16#004D9#, 16#004D9#),  -- (Ll)  CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA
+      (16#004DA#, 16#004DA#),  -- (Lu)  CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS .. CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS
+      (16#004DB#, 16#004DB#),  -- (Ll)  CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS
+      (16#004DC#, 16#004DC#),  -- (Lu)  CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS
+      (16#004DD#, 16#004DD#),  -- (Ll)  CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS
+      (16#004DE#, 16#004DE#),  -- (Lu)  CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS
+      (16#004DF#, 16#004DF#),  -- (Ll)  CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS
+      (16#004E0#, 16#004E0#),  -- (Lu)  CYRILLIC CAPITAL LETTER ABKHASIAN DZE .. CYRILLIC CAPITAL LETTER ABKHASIAN DZE
+      (16#004E1#, 16#004E1#),  -- (Ll)  CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE
+      (16#004E2#, 16#004E2#),  -- (Lu)  CYRILLIC CAPITAL LETTER I WITH MACRON .. CYRILLIC CAPITAL LETTER I WITH MACRON
+      (16#004E3#, 16#004E3#),  -- (Ll)  CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON
+      (16#004E4#, 16#004E4#),  -- (Lu)  CYRILLIC CAPITAL LETTER I WITH DIAERESIS .. CYRILLIC CAPITAL LETTER I WITH DIAERESIS
+      (16#004E5#, 16#004E5#),  -- (Ll)  CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS
+      (16#004E6#, 16#004E6#),  -- (Lu)  CYRILLIC CAPITAL LETTER O WITH DIAERESIS .. CYRILLIC CAPITAL LETTER O WITH DIAERESIS
+      (16#004E7#, 16#004E7#),  -- (Ll)  CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS
+      (16#004E8#, 16#004E8#),  -- (Lu)  CYRILLIC CAPITAL LETTER BARRED O .. CYRILLIC CAPITAL LETTER BARRED O
+      (16#004E9#, 16#004E9#),  -- (Ll)  CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O
+      (16#004EA#, 16#004EA#),  -- (Lu)  CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS .. CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS
+      (16#004EB#, 16#004EB#),  -- (Ll)  CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS
+      (16#004EC#, 16#004EC#),  -- (Lu)  CYRILLIC CAPITAL LETTER E WITH DIAERESIS .. CYRILLIC CAPITAL LETTER E WITH DIAERESIS
+      (16#004ED#, 16#004ED#),  -- (Ll)  CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS
+      (16#004EE#, 16#004EE#),  -- (Lu)  CYRILLIC CAPITAL LETTER U WITH MACRON .. CYRILLIC CAPITAL LETTER U WITH MACRON
+      (16#004EF#, 16#004EF#),  -- (Ll)  CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON
+      (16#004F0#, 16#004F0#),  -- (Lu)  CYRILLIC CAPITAL LETTER U WITH DIAERESIS .. CYRILLIC CAPITAL LETTER U WITH DIAERESIS
+      (16#004F1#, 16#004F1#),  -- (Ll)  CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS
+      (16#004F2#, 16#004F2#),  -- (Lu)  CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE .. CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE
+      (16#004F3#, 16#004F3#),  -- (Ll)  CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE
+      (16#004F4#, 16#004F4#),  -- (Lu)  CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS
+      (16#004F5#, 16#004F5#),  -- (Ll)  CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS
+      (16#004F8#, 16#004F8#),  -- (Lu)  CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS .. CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS
+      (16#004F9#, 16#004F9#),  -- (Ll)  CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS
+      (16#00500#, 16#00500#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI DE .. CYRILLIC CAPITAL LETTER KOMI DE
+      (16#00501#, 16#00501#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE
+      (16#00502#, 16#00502#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI DJE .. CYRILLIC CAPITAL LETTER KOMI DJE
+      (16#00503#, 16#00503#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE
+      (16#00504#, 16#00504#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI ZJE .. CYRILLIC CAPITAL LETTER KOMI ZJE
+      (16#00505#, 16#00505#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE
+      (16#00506#, 16#00506#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI DZJE .. CYRILLIC CAPITAL LETTER KOMI DZJE
+      (16#00507#, 16#00507#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE
+      (16#00508#, 16#00508#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI LJE .. CYRILLIC CAPITAL LETTER KOMI LJE
+      (16#00509#, 16#00509#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE
+      (16#0050A#, 16#0050A#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI NJE .. CYRILLIC CAPITAL LETTER KOMI NJE
+      (16#0050B#, 16#0050B#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE
+      (16#0050C#, 16#0050C#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI SJE .. CYRILLIC CAPITAL LETTER KOMI SJE
+      (16#0050D#, 16#0050D#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE
+      (16#0050E#, 16#0050E#),  -- (Lu)  CYRILLIC CAPITAL LETTER KOMI TJE .. CYRILLIC CAPITAL LETTER KOMI TJE
+      (16#0050F#, 16#0050F#),  -- (Ll)  CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE
+      (16#00531#, 16#00556#),  -- (Lu)  ARMENIAN CAPITAL LETTER AYB .. ARMENIAN CAPITAL LETTER FEH
+      (16#00559#, 16#00559#),  -- (Lm)  ARMENIAN MODIFIER LETTER LEFT HALF RING .. ARMENIAN MODIFIER LETTER LEFT HALF RING
+      (16#0055A#, 16#0055F#),  -- (Po)  ARMENIAN APOSTROPHE .. ARMENIAN ABBREVIATION MARK
+      (16#00561#, 16#00587#),  -- (Ll)  ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LIGATURE ECH YIWN
+      (16#00589#, 16#00589#),  -- (Po)  ARMENIAN FULL STOP .. ARMENIAN FULL STOP
+      (16#0058A#, 16#0058A#),  -- (Pd)  ARMENIAN HYPHEN .. ARMENIAN HYPHEN
+      (16#00591#, 16#005A1#),  -- (Mn)  HEBREW ACCENT ETNAHTA .. HEBREW ACCENT PAZER
+      (16#005A3#, 16#005B9#),  -- (Mn)  HEBREW ACCENT MUNAH .. HEBREW POINT HOLAM
+      (16#005BB#, 16#005BD#),  -- (Mn)  HEBREW POINT QUBUTS .. HEBREW POINT METEG
+      (16#005BE#, 16#005BE#),  -- (Po)  HEBREW PUNCTUATION MAQAF .. HEBREW PUNCTUATION MAQAF
+      (16#005BF#, 16#005BF#),  -- (Mn)  HEBREW POINT RAFE .. HEBREW POINT RAFE
+      (16#005C0#, 16#005C0#),  -- (Po)  HEBREW PUNCTUATION PASEQ .. HEBREW PUNCTUATION PASEQ
+      (16#005C1#, 16#005C2#),  -- (Mn)  HEBREW POINT SHIN DOT .. HEBREW POINT SIN DOT
+      (16#005C3#, 16#005C3#),  -- (Po)  HEBREW PUNCTUATION SOF PASUQ .. HEBREW PUNCTUATION SOF PASUQ
+      (16#005C4#, 16#005C4#),  -- (Mn)  HEBREW MARK UPPER DOT .. HEBREW MARK UPPER DOT
+      (16#005D0#, 16#005EA#),  -- (Lo)  HEBREW LETTER ALEF .. HEBREW LETTER TAV
+      (16#005F0#, 16#005F2#),  -- (Lo)  HEBREW LIGATURE YIDDISH DOUBLE VAV .. HEBREW LIGATURE YIDDISH DOUBLE YOD
+      (16#005F3#, 16#005F4#),  -- (Po)  HEBREW PUNCTUATION GERESH .. HEBREW PUNCTUATION GERSHAYIM
+      (16#00600#, 16#00603#),  -- (Cf)  ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA
+      (16#0060C#, 16#0060D#),  -- (Po)  ARABIC COMMA .. ARABIC DATE SEPARATOR
+      (16#0060E#, 16#0060F#),  -- (So)  ARABIC POETIC VERSE SIGN .. ARABIC SIGN MISRA
+      (16#00610#, 16#00615#),  -- (Mn)  ARABIC SIGN SALLALLAHOU ALAYHE WASSALLAM .. ARABIC SMALL HIGH TAH
+      (16#0061B#, 16#0061B#),  -- (Po)  ARABIC SEMICOLON .. ARABIC SEMICOLON
+      (16#0061F#, 16#0061F#),  -- (Po)  ARABIC QUESTION MARK .. ARABIC QUESTION MARK
+      (16#00621#, 16#0063A#),  -- (Lo)  ARABIC LETTER HAMZA .. ARABIC LETTER GHAIN
+      (16#00640#, 16#00640#),  -- (Lm)  ARABIC TATWEEL .. ARABIC TATWEEL
+      (16#00641#, 16#0064A#),  -- (Lo)  ARABIC LETTER FEH .. ARABIC LETTER YEH
+      (16#0064B#, 16#00658#),  -- (Mn)  ARABIC FATHATAN .. ARABIC MARK NOON GHUNNA
+      (16#00660#, 16#00669#),  -- (Nd)  ARABIC-INDIC DIGIT ZERO .. ARABIC-INDIC DIGIT NINE
+      (16#0066A#, 16#0066D#),  -- (Po)  ARABIC PERCENT SIGN .. ARABIC FIVE POINTED STAR
+      (16#0066E#, 16#0066F#),  -- (Lo)  ARABIC LETTER DOTLESS BEH .. ARABIC LETTER DOTLESS QAF
+      (16#00670#, 16#00670#),  -- (Mn)  ARABIC LETTER SUPERSCRIPT ALEF .. ARABIC LETTER SUPERSCRIPT ALEF
+      (16#00671#, 16#006D3#),  -- (Lo)  ARABIC LETTER ALEF WASLA .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE
+      (16#006D4#, 16#006D4#),  -- (Po)  ARABIC FULL STOP .. ARABIC FULL STOP
+      (16#006D5#, 16#006D5#),  -- (Lo)  ARABIC LETTER AE .. ARABIC LETTER AE
+      (16#006D6#, 16#006DC#),  -- (Mn)  ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA .. ARABIC SMALL HIGH SEEN
+      (16#006DD#, 16#006DD#),  -- (Cf)  ARABIC END OF AYAH .. ARABIC END OF AYAH
+      (16#006DE#, 16#006DE#),  -- (Me)  ARABIC START OF RUB EL HIZB .. ARABIC START OF RUB EL HIZB
+      (16#006DF#, 16#006E4#),  -- (Mn)  ARABIC SMALL HIGH ROUNDED ZERO .. ARABIC SMALL HIGH MADDA
+      (16#006E5#, 16#006E6#),  -- (Lm)  ARABIC SMALL WAW .. ARABIC SMALL YEH
+      (16#006E7#, 16#006E8#),  -- (Mn)  ARABIC SMALL HIGH YEH .. ARABIC SMALL HIGH NOON
+      (16#006E9#, 16#006E9#),  -- (So)  ARABIC PLACE OF SAJDAH .. ARABIC PLACE OF SAJDAH
+      (16#006EA#, 16#006ED#),  -- (Mn)  ARABIC EMPTY CENTRE LOW STOP .. ARABIC SMALL LOW MEEM
+      (16#006EE#, 16#006EF#),  -- (Lo)  ARABIC LETTER DAL WITH INVERTED V .. ARABIC LETTER REH WITH INVERTED V
+      (16#006F0#, 16#006F9#),  -- (Nd)  EXTENDED ARABIC-INDIC DIGIT ZERO .. EXTENDED ARABIC-INDIC DIGIT NINE
+      (16#006FA#, 16#006FC#),  -- (Lo)  ARABIC LETTER SHEEN WITH DOT BELOW .. ARABIC LETTER GHAIN WITH DOT BELOW
+      (16#006FD#, 16#006FE#),  -- (So)  ARABIC SIGN SINDHI AMPERSAND .. ARABIC SIGN SINDHI POSTPOSITION MEN
+      (16#006FF#, 16#006FF#),  -- (Lo)  ARABIC LETTER HEH WITH INVERTED V .. ARABIC LETTER HEH WITH INVERTED V
+      (16#00700#, 16#0070D#),  -- (Po)  SYRIAC END OF PARAGRAPH .. SYRIAC HARKLEAN ASTERISCUS
+      (16#0070F#, 16#0070F#),  -- (Cf)  SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK
+      (16#00710#, 16#00710#),  -- (Lo)  SYRIAC LETTER ALAPH .. SYRIAC LETTER ALAPH
+      (16#00711#, 16#00711#),  -- (Mn)  SYRIAC LETTER SUPERSCRIPT ALAPH .. SYRIAC LETTER SUPERSCRIPT ALAPH
+      (16#00712#, 16#0072F#),  -- (Lo)  SYRIAC LETTER BETH .. SYRIAC LETTER PERSIAN DHALATH
+      (16#00730#, 16#0074A#),  -- (Mn)  SYRIAC PTHAHA ABOVE .. SYRIAC BARREKH
+      (16#0074D#, 16#0074F#),  -- (Lo)  SYRIAC LETTER SOGDIAN ZHAIN .. SYRIAC LETTER SOGDIAN FE
+      (16#00780#, 16#007A5#),  -- (Lo)  THAANA LETTER HAA .. THAANA LETTER WAAVU
+      (16#007A6#, 16#007B0#),  -- (Mn)  THAANA ABAFILI .. THAANA SUKUN
+      (16#007B1#, 16#007B1#),  -- (Lo)  THAANA LETTER NAA .. THAANA LETTER NAA
+      (16#00901#, 16#00902#),  -- (Mn)  DEVANAGARI SIGN CANDRABINDU .. DEVANAGARI SIGN ANUSVARA
+      (16#00903#, 16#00903#),  -- (Mc)  DEVANAGARI SIGN VISARGA .. DEVANAGARI SIGN VISARGA
+      (16#00904#, 16#00939#),  -- (Lo)  DEVANAGARI LETTER SHORT A .. DEVANAGARI LETTER HA
+      (16#0093C#, 16#0093C#),  -- (Mn)  DEVANAGARI SIGN NUKTA .. DEVANAGARI SIGN NUKTA
+      (16#0093D#, 16#0093D#),  -- (Lo)  DEVANAGARI SIGN AVAGRAHA .. DEVANAGARI SIGN AVAGRAHA
+      (16#0093E#, 16#00940#),  -- (Mc)  DEVANAGARI VOWEL SIGN AA .. DEVANAGARI VOWEL SIGN II
+      (16#00941#, 16#00948#),  -- (Mn)  DEVANAGARI VOWEL SIGN U .. DEVANAGARI VOWEL SIGN AI
+      (16#00949#, 16#0094C#),  -- (Mc)  DEVANAGARI VOWEL SIGN CANDRA O .. DEVANAGARI VOWEL SIGN AU
+      (16#0094D#, 16#0094D#),  -- (Mn)  DEVANAGARI SIGN VIRAMA .. DEVANAGARI SIGN VIRAMA
+      (16#00950#, 16#00950#),  -- (Lo)  DEVANAGARI OM .. DEVANAGARI OM
+      (16#00951#, 16#00954#),  -- (Mn)  DEVANAGARI STRESS SIGN UDATTA .. DEVANAGARI ACUTE ACCENT
+      (16#00958#, 16#00961#),  -- (Lo)  DEVANAGARI LETTER QA .. DEVANAGARI LETTER VOCALIC LL
+      (16#00962#, 16#00963#),  -- (Mn)  DEVANAGARI VOWEL SIGN VOCALIC L .. DEVANAGARI VOWEL SIGN VOCALIC LL
+      (16#00964#, 16#00965#),  -- (Po)  DEVANAGARI DANDA .. DEVANAGARI DOUBLE DANDA
+      (16#00966#, 16#0096F#),  -- (Nd)  DEVANAGARI DIGIT ZERO .. DEVANAGARI DIGIT NINE
+      (16#00970#, 16#00970#),  -- (Po)  DEVANAGARI ABBREVIATION SIGN .. DEVANAGARI ABBREVIATION SIGN
+      (16#00981#, 16#00981#),  -- (Mn)  BENGALI SIGN CANDRABINDU .. BENGALI SIGN CANDRABINDU
+      (16#00982#, 16#00983#),  -- (Mc)  BENGALI SIGN ANUSVARA .. BENGALI SIGN VISARGA
+      (16#00985#, 16#0098C#),  -- (Lo)  BENGALI LETTER A .. BENGALI LETTER VOCALIC L
+      (16#0098F#, 16#00990#),  -- (Lo)  BENGALI LETTER E .. BENGALI LETTER AI
+      (16#00993#, 16#009A8#),  -- (Lo)  BENGALI LETTER O .. BENGALI LETTER NA
+      (16#009AA#, 16#009B0#),  -- (Lo)  BENGALI LETTER PA .. BENGALI LETTER RA
+      (16#009B2#, 16#009B2#),  -- (Lo)  BENGALI LETTER LA .. BENGALI LETTER LA
+      (16#009B6#, 16#009B9#),  -- (Lo)  BENGALI LETTER SHA .. BENGALI LETTER HA
+      (16#009BC#, 16#009BC#),  -- (Mn)  BENGALI SIGN NUKTA .. BENGALI SIGN NUKTA
+      (16#009BD#, 16#009BD#),  -- (Lo)  BENGALI SIGN AVAGRAHA .. BENGALI SIGN AVAGRAHA
+      (16#009BE#, 16#009C0#),  -- (Mc)  BENGALI VOWEL SIGN AA .. BENGALI VOWEL SIGN II
+      (16#009C1#, 16#009C4#),  -- (Mn)  BENGALI VOWEL SIGN U .. BENGALI VOWEL SIGN VOCALIC RR
+      (16#009C7#, 16#009C8#),  -- (Mc)  BENGALI VOWEL SIGN E .. BENGALI VOWEL SIGN AI
+      (16#009CB#, 16#009CC#),  -- (Mc)  BENGALI VOWEL SIGN O .. BENGALI VOWEL SIGN AU
+      (16#009CD#, 16#009CD#),  -- (Mn)  BENGALI SIGN VIRAMA .. BENGALI SIGN VIRAMA
+      (16#009D7#, 16#009D7#),  -- (Mc)  BENGALI AU LENGTH MARK .. BENGALI AU LENGTH MARK
+      (16#009DC#, 16#009DD#),  -- (Lo)  BENGALI LETTER RRA .. BENGALI LETTER RHA
+      (16#009DF#, 16#009E1#),  -- (Lo)  BENGALI LETTER YYA .. BENGALI LETTER VOCALIC LL
+      (16#009E2#, 16#009E3#),  -- (Mn)  BENGALI VOWEL SIGN VOCALIC L .. BENGALI VOWEL SIGN VOCALIC LL
+      (16#009E6#, 16#009EF#),  -- (Nd)  BENGALI DIGIT ZERO .. BENGALI DIGIT NINE
+      (16#009F0#, 16#009F1#),  -- (Lo)  BENGALI LETTER RA WITH MIDDLE DIAGONAL .. BENGALI LETTER RA WITH LOWER DIAGONAL
+      (16#009F2#, 16#009F3#),  -- (Sc)  BENGALI RUPEE MARK .. BENGALI RUPEE SIGN
+      (16#009F4#, 16#009F9#),  -- (No)  BENGALI CURRENCY NUMERATOR ONE .. BENGALI CURRENCY DENOMINATOR SIXTEEN
+      (16#009FA#, 16#009FA#),  -- (So)  BENGALI ISSHAR .. BENGALI ISSHAR
+      (16#00A01#, 16#00A02#),  -- (Mn)  GURMUKHI SIGN ADAK BINDI .. GURMUKHI SIGN BINDI
+      (16#00A03#, 16#00A03#),  -- (Mc)  GURMUKHI SIGN VISARGA .. GURMUKHI SIGN VISARGA
+      (16#00A05#, 16#00A0A#),  -- (Lo)  GURMUKHI LETTER A .. GURMUKHI LETTER UU
+      (16#00A0F#, 16#00A10#),  -- (Lo)  GURMUKHI LETTER EE .. GURMUKHI LETTER AI
+      (16#00A13#, 16#00A28#),  -- (Lo)  GURMUKHI LETTER OO .. GURMUKHI LETTER NA
+      (16#00A2A#, 16#00A30#),  -- (Lo)  GURMUKHI LETTER PA .. GURMUKHI LETTER RA
+      (16#00A32#, 16#00A33#),  -- (Lo)  GURMUKHI LETTER LA .. GURMUKHI LETTER LLA
+      (16#00A35#, 16#00A36#),  -- (Lo)  GURMUKHI LETTER VA .. GURMUKHI LETTER SHA
+      (16#00A38#, 16#00A39#),  -- (Lo)  GURMUKHI LETTER SA .. GURMUKHI LETTER HA
+      (16#00A3C#, 16#00A3C#),  -- (Mn)  GURMUKHI SIGN NUKTA .. GURMUKHI SIGN NUKTA
+      (16#00A3E#, 16#00A40#),  -- (Mc)  GURMUKHI VOWEL SIGN AA .. GURMUKHI VOWEL SIGN II
+      (16#00A41#, 16#00A42#),  -- (Mn)  GURMUKHI VOWEL SIGN U .. GURMUKHI VOWEL SIGN UU
+      (16#00A47#, 16#00A48#),  -- (Mn)  GURMUKHI VOWEL SIGN EE .. GURMUKHI VOWEL SIGN AI
+      (16#00A4B#, 16#00A4D#),  -- (Mn)  GURMUKHI VOWEL SIGN OO .. GURMUKHI SIGN VIRAMA
+      (16#00A59#, 16#00A5C#),  -- (Lo)  GURMUKHI LETTER KHHA .. GURMUKHI LETTER RRA
+      (16#00A5E#, 16#00A5E#),  -- (Lo)  GURMUKHI LETTER FA .. GURMUKHI LETTER FA
+      (16#00A66#, 16#00A6F#),  -- (Nd)  GURMUKHI DIGIT ZERO .. GURMUKHI DIGIT NINE
+      (16#00A70#, 16#00A71#),  -- (Mn)  GURMUKHI TIPPI .. GURMUKHI ADDAK
+      (16#00A72#, 16#00A74#),  -- (Lo)  GURMUKHI IRI .. GURMUKHI EK ONKAR
+      (16#00A81#, 16#00A82#),  -- (Mn)  GUJARATI SIGN CANDRABINDU .. GUJARATI SIGN ANUSVARA
+      (16#00A83#, 16#00A83#),  -- (Mc)  GUJARATI SIGN VISARGA .. GUJARATI SIGN VISARGA
+      (16#00A85#, 16#00A8D#),  -- (Lo)  GUJARATI LETTER A .. GUJARATI VOWEL CANDRA E
+      (16#00A8F#, 16#00A91#),  -- (Lo)  GUJARATI LETTER E .. GUJARATI VOWEL CANDRA O
+      (16#00A93#, 16#00AA8#),  -- (Lo)  GUJARATI LETTER O .. GUJARATI LETTER NA
+      (16#00AAA#, 16#00AB0#),  -- (Lo)  GUJARATI LETTER PA .. GUJARATI LETTER RA
+      (16#00AB2#, 16#00AB3#),  -- (Lo)  GUJARATI LETTER LA .. GUJARATI LETTER LLA
+      (16#00AB5#, 16#00AB9#),  -- (Lo)  GUJARATI LETTER VA .. GUJARATI LETTER HA
+      (16#00ABC#, 16#00ABC#),  -- (Mn)  GUJARATI SIGN NUKTA .. GUJARATI SIGN NUKTA
+      (16#00ABD#, 16#00ABD#),  -- (Lo)  GUJARATI SIGN AVAGRAHA .. GUJARATI SIGN AVAGRAHA
+      (16#00ABE#, 16#00AC0#),  -- (Mc)  GUJARATI VOWEL SIGN AA .. GUJARATI VOWEL SIGN II
+      (16#00AC1#, 16#00AC5#),  -- (Mn)  GUJARATI VOWEL SIGN U .. GUJARATI VOWEL SIGN CANDRA E
+      (16#00AC7#, 16#00AC8#),  -- (Mn)  GUJARATI VOWEL SIGN E .. GUJARATI VOWEL SIGN AI
+      (16#00AC9#, 16#00AC9#),  -- (Mc)  GUJARATI VOWEL SIGN CANDRA O .. GUJARATI VOWEL SIGN CANDRA O
+      (16#00ACB#, 16#00ACC#),  -- (Mc)  GUJARATI VOWEL SIGN O .. GUJARATI VOWEL SIGN AU
+      (16#00ACD#, 16#00ACD#),  -- (Mn)  GUJARATI SIGN VIRAMA .. GUJARATI SIGN VIRAMA
+      (16#00AD0#, 16#00AD0#),  -- (Lo)  GUJARATI OM .. GUJARATI OM
+      (16#00AE0#, 16#00AE1#),  -- (Lo)  GUJARATI LETTER VOCALIC RR .. GUJARATI LETTER VOCALIC LL
+      (16#00AE2#, 16#00AE3#),  -- (Mn)  GUJARATI VOWEL SIGN VOCALIC L .. GUJARATI VOWEL SIGN VOCALIC LL
+      (16#00AE6#, 16#00AEF#),  -- (Nd)  GUJARATI DIGIT ZERO .. GUJARATI DIGIT NINE
+      (16#00AF1#, 16#00AF1#),  -- (Sc)  GUJARATI RUPEE SIGN .. GUJARATI RUPEE SIGN
+      (16#00B01#, 16#00B01#),  -- (Mn)  ORIYA SIGN CANDRABINDU .. ORIYA SIGN CANDRABINDU
+      (16#00B02#, 16#00B03#),  -- (Mc)  ORIYA SIGN ANUSVARA .. ORIYA SIGN VISARGA
+      (16#00B05#, 16#00B0C#),  -- (Lo)  ORIYA LETTER A .. ORIYA LETTER VOCALIC L
+      (16#00B0F#, 16#00B10#),  -- (Lo)  ORIYA LETTER E .. ORIYA LETTER AI
+      (16#00B13#, 16#00B28#),  -- (Lo)  ORIYA LETTER O .. ORIYA LETTER NA
+      (16#00B2A#, 16#00B30#),  -- (Lo)  ORIYA LETTER PA .. ORIYA LETTER RA
+      (16#00B32#, 16#00B33#),  -- (Lo)  ORIYA LETTER LA .. ORIYA LETTER LLA
+      (16#00B35#, 16#00B39#),  -- (Lo)  ORIYA LETTER VA .. ORIYA LETTER HA
+      (16#00B3C#, 16#00B3C#),  -- (Mn)  ORIYA SIGN NUKTA .. ORIYA SIGN NUKTA
+      (16#00B3D#, 16#00B3D#),  -- (Lo)  ORIYA SIGN AVAGRAHA .. ORIYA SIGN AVAGRAHA
+      (16#00B3E#, 16#00B3E#),  -- (Mc)  ORIYA VOWEL SIGN AA .. ORIYA VOWEL SIGN AA
+      (16#00B3F#, 16#00B3F#),  -- (Mn)  ORIYA VOWEL SIGN I .. ORIYA VOWEL SIGN I
+      (16#00B40#, 16#00B40#),  -- (Mc)  ORIYA VOWEL SIGN II .. ORIYA VOWEL SIGN II
+      (16#00B41#, 16#00B43#),  -- (Mn)  ORIYA VOWEL SIGN U .. ORIYA VOWEL SIGN VOCALIC R
+      (16#00B47#, 16#00B48#),  -- (Mc)  ORIYA VOWEL SIGN E .. ORIYA VOWEL SIGN AI
+      (16#00B4B#, 16#00B4C#),  -- (Mc)  ORIYA VOWEL SIGN O .. ORIYA VOWEL SIGN AU
+      (16#00B4D#, 16#00B4D#),  -- (Mn)  ORIYA SIGN VIRAMA .. ORIYA SIGN VIRAMA
+      (16#00B56#, 16#00B56#),  -- (Mn)  ORIYA AI LENGTH MARK .. ORIYA AI LENGTH MARK
+      (16#00B57#, 16#00B57#),  -- (Mc)  ORIYA AU LENGTH MARK .. ORIYA AU LENGTH MARK
+      (16#00B5C#, 16#00B5D#),  -- (Lo)  ORIYA LETTER RRA .. ORIYA LETTER RHA
+      (16#00B5F#, 16#00B61#),  -- (Lo)  ORIYA LETTER YYA .. ORIYA LETTER VOCALIC LL
+      (16#00B66#, 16#00B6F#),  -- (Nd)  ORIYA DIGIT ZERO .. ORIYA DIGIT NINE
+      (16#00B70#, 16#00B70#),  -- (So)  ORIYA ISSHAR .. ORIYA ISSHAR
+      (16#00B71#, 16#00B71#),  -- (Lo)  ORIYA LETTER WA .. ORIYA LETTER WA
+      (16#00B82#, 16#00B82#),  -- (Mn)  TAMIL SIGN ANUSVARA .. TAMIL SIGN ANUSVARA
+      (16#00B83#, 16#00B83#),  -- (Lo)  TAMIL SIGN VISARGA .. TAMIL SIGN VISARGA
+      (16#00B85#, 16#00B8A#),  -- (Lo)  TAMIL LETTER A .. TAMIL LETTER UU
+      (16#00B8E#, 16#00B90#),  -- (Lo)  TAMIL LETTER E .. TAMIL LETTER AI
+      (16#00B92#, 16#00B95#),  -- (Lo)  TAMIL LETTER O .. TAMIL LETTER KA
+      (16#00B99#, 16#00B9A#),  -- (Lo)  TAMIL LETTER NGA .. TAMIL LETTER CA
+      (16#00B9C#, 16#00B9C#),  -- (Lo)  TAMIL LETTER JA .. TAMIL LETTER JA
+      (16#00B9E#, 16#00B9F#),  -- (Lo)  TAMIL LETTER NYA .. TAMIL LETTER TTA
+      (16#00BA3#, 16#00BA4#),  -- (Lo)  TAMIL LETTER NNA .. TAMIL LETTER TA
+      (16#00BA8#, 16#00BAA#),  -- (Lo)  TAMIL LETTER NA .. TAMIL LETTER PA
+      (16#00BAE#, 16#00BB5#),  -- (Lo)  TAMIL LETTER MA .. TAMIL LETTER VA
+      (16#00BB7#, 16#00BB9#),  -- (Lo)  TAMIL LETTER SSA .. TAMIL LETTER HA
+      (16#00BBE#, 16#00BBF#),  -- (Mc)  TAMIL VOWEL SIGN AA .. TAMIL VOWEL SIGN I
+      (16#00BC0#, 16#00BC0#),  -- (Mn)  TAMIL VOWEL SIGN II .. TAMIL VOWEL SIGN II
+      (16#00BC1#, 16#00BC2#),  -- (Mc)  TAMIL VOWEL SIGN U .. TAMIL VOWEL SIGN UU
+      (16#00BC6#, 16#00BC8#),  -- (Mc)  TAMIL VOWEL SIGN E .. TAMIL VOWEL SIGN AI
+      (16#00BCA#, 16#00BCC#),  -- (Mc)  TAMIL VOWEL SIGN O .. TAMIL VOWEL SIGN AU
+      (16#00BCD#, 16#00BCD#),  -- (Mn)  TAMIL SIGN VIRAMA .. TAMIL SIGN VIRAMA
+      (16#00BD7#, 16#00BD7#),  -- (Mc)  TAMIL AU LENGTH MARK .. TAMIL AU LENGTH MARK
+      (16#00BE7#, 16#00BEF#),  -- (Nd)  TAMIL DIGIT ONE .. TAMIL DIGIT NINE
+      (16#00BF0#, 16#00BF2#),  -- (No)  TAMIL NUMBER TEN .. TAMIL NUMBER ONE THOUSAND
+      (16#00BF3#, 16#00BF8#),  -- (So)  TAMIL DAY SIGN .. TAMIL AS ABOVE SIGN
+      (16#00BF9#, 16#00BF9#),  -- (Sc)  TAMIL RUPEE SIGN .. TAMIL RUPEE SIGN
+      (16#00BFA#, 16#00BFA#),  -- (So)  TAMIL NUMBER SIGN .. TAMIL NUMBER SIGN
+      (16#00C01#, 16#00C03#),  -- (Mc)  TELUGU SIGN CANDRABINDU .. TELUGU SIGN VISARGA
+      (16#00C05#, 16#00C0C#),  -- (Lo)  TELUGU LETTER A .. TELUGU LETTER VOCALIC L
+      (16#00C0E#, 16#00C10#),  -- (Lo)  TELUGU LETTER E .. TELUGU LETTER AI
+      (16#00C12#, 16#00C28#),  -- (Lo)  TELUGU LETTER O .. TELUGU LETTER NA
+      (16#00C2A#, 16#00C33#),  -- (Lo)  TELUGU LETTER PA .. TELUGU LETTER LLA
+      (16#00C35#, 16#00C39#),  -- (Lo)  TELUGU LETTER VA .. TELUGU LETTER HA
+      (16#00C3E#, 16#00C40#),  -- (Mn)  TELUGU VOWEL SIGN AA .. TELUGU VOWEL SIGN II
+      (16#00C41#, 16#00C44#),  -- (Mc)  TELUGU VOWEL SIGN U .. TELUGU VOWEL SIGN VOCALIC RR
+      (16#00C46#, 16#00C48#),  -- (Mn)  TELUGU VOWEL SIGN E .. TELUGU VOWEL SIGN AI
+      (16#00C4A#, 16#00C4D#),  -- (Mn)  TELUGU VOWEL SIGN O .. TELUGU SIGN VIRAMA
+      (16#00C55#, 16#00C56#),  -- (Mn)  TELUGU LENGTH MARK .. TELUGU AI LENGTH MARK
+      (16#00C60#, 16#00C61#),  -- (Lo)  TELUGU LETTER VOCALIC RR .. TELUGU LETTER VOCALIC LL
+      (16#00C66#, 16#00C6F#),  -- (Nd)  TELUGU DIGIT ZERO .. TELUGU DIGIT NINE
+      (16#00C82#, 16#00C83#),  -- (Mc)  KANNADA SIGN ANUSVARA .. KANNADA SIGN VISARGA
+      (16#00C85#, 16#00C8C#),  -- (Lo)  KANNADA LETTER A .. KANNADA LETTER VOCALIC L
+      (16#00C8E#, 16#00C90#),  -- (Lo)  KANNADA LETTER E .. KANNADA LETTER AI
+      (16#00C92#, 16#00CA8#),  -- (Lo)  KANNADA LETTER O .. KANNADA LETTER NA
+      (16#00CAA#, 16#00CB3#),  -- (Lo)  KANNADA LETTER PA .. KANNADA LETTER LLA
+      (16#00CB5#, 16#00CB9#),  -- (Lo)  KANNADA LETTER VA .. KANNADA LETTER HA
+      (16#00CBC#, 16#00CBC#),  -- (Mn)  KANNADA SIGN NUKTA .. KANNADA SIGN NUKTA
+      (16#00CBD#, 16#00CBD#),  -- (Lo)  KANNADA SIGN AVAGRAHA .. KANNADA SIGN AVAGRAHA
+      (16#00CBE#, 16#00CBE#),  -- (Mc)  KANNADA VOWEL SIGN AA .. KANNADA VOWEL SIGN AA
+      (16#00CBF#, 16#00CBF#),  -- (Mn)  KANNADA VOWEL SIGN I .. KANNADA VOWEL SIGN I
+      (16#00CC0#, 16#00CC4#),  -- (Mc)  KANNADA VOWEL SIGN II .. KANNADA VOWEL SIGN VOCALIC RR
+      (16#00CC6#, 16#00CC6#),  -- (Mn)  KANNADA VOWEL SIGN E .. KANNADA VOWEL SIGN E
+      (16#00CC7#, 16#00CC8#),  -- (Mc)  KANNADA VOWEL SIGN EE .. KANNADA VOWEL SIGN AI
+      (16#00CCA#, 16#00CCB#),  -- (Mc)  KANNADA VOWEL SIGN O .. KANNADA VOWEL SIGN OO
+      (16#00CCC#, 16#00CCD#),  -- (Mn)  KANNADA VOWEL SIGN AU .. KANNADA SIGN VIRAMA
+      (16#00CD5#, 16#00CD6#),  -- (Mc)  KANNADA LENGTH MARK .. KANNADA AI LENGTH MARK
+      (16#00CDE#, 16#00CDE#),  -- (Lo)  KANNADA LETTER FA .. KANNADA LETTER FA
+      (16#00CE0#, 16#00CE1#),  -- (Lo)  KANNADA LETTER VOCALIC RR .. KANNADA LETTER VOCALIC LL
+      (16#00CE6#, 16#00CEF#),  -- (Nd)  KANNADA DIGIT ZERO .. KANNADA DIGIT NINE
+      (16#00D02#, 16#00D03#),  -- (Mc)  MALAYALAM SIGN ANUSVARA .. MALAYALAM SIGN VISARGA
+      (16#00D05#, 16#00D0C#),  -- (Lo)  MALAYALAM LETTER A .. MALAYALAM LETTER VOCALIC L
+      (16#00D0E#, 16#00D10#),  -- (Lo)  MALAYALAM LETTER E .. MALAYALAM LETTER AI
+      (16#00D12#, 16#00D28#),  -- (Lo)  MALAYALAM LETTER O .. MALAYALAM LETTER NA
+      (16#00D2A#, 16#00D39#),  -- (Lo)  MALAYALAM LETTER PA .. MALAYALAM LETTER HA
+      (16#00D3E#, 16#00D40#),  -- (Mc)  MALAYALAM VOWEL SIGN AA .. MALAYALAM VOWEL SIGN II
+      (16#00D41#, 16#00D43#),  -- (Mn)  MALAYALAM VOWEL SIGN U .. MALAYALAM VOWEL SIGN VOCALIC R
+      (16#00D46#, 16#00D48#),  -- (Mc)  MALAYALAM VOWEL SIGN E .. MALAYALAM VOWEL SIGN AI
+      (16#00D4A#, 16#00D4C#),  -- (Mc)  MALAYALAM VOWEL SIGN O .. MALAYALAM VOWEL SIGN AU
+      (16#00D4D#, 16#00D4D#),  -- (Mn)  MALAYALAM SIGN VIRAMA .. MALAYALAM SIGN VIRAMA
+      (16#00D57#, 16#00D57#),  -- (Mc)  MALAYALAM AU LENGTH MARK .. MALAYALAM AU LENGTH MARK
+      (16#00D60#, 16#00D61#),  -- (Lo)  MALAYALAM LETTER VOCALIC RR .. MALAYALAM LETTER VOCALIC LL
+      (16#00D66#, 16#00D6F#),  -- (Nd)  MALAYALAM DIGIT ZERO .. MALAYALAM DIGIT NINE
+      (16#00D82#, 16#00D83#),  -- (Mc)  SINHALA SIGN ANUSVARAYA .. SINHALA SIGN VISARGAYA
+      (16#00D85#, 16#00D96#),  -- (Lo)  SINHALA LETTER AYANNA .. SINHALA LETTER AUYANNA
+      (16#00D9A#, 16#00DB1#),  -- (Lo)  SINHALA LETTER ALPAPRAANA KAYANNA .. SINHALA LETTER DANTAJA NAYANNA
+      (16#00DB3#, 16#00DBB#),  -- (Lo)  SINHALA LETTER SANYAKA DAYANNA .. SINHALA LETTER RAYANNA
+      (16#00DBD#, 16#00DBD#),  -- (Lo)  SINHALA LETTER DANTAJA LAYANNA .. SINHALA LETTER DANTAJA LAYANNA
+      (16#00DC0#, 16#00DC6#),  -- (Lo)  SINHALA LETTER VAYANNA .. SINHALA LETTER FAYANNA
+      (16#00DCA#, 16#00DCA#),  -- (Mn)  SINHALA SIGN AL-LAKUNA .. SINHALA SIGN AL-LAKUNA
+      (16#00DCF#, 16#00DD1#),  -- (Mc)  SINHALA VOWEL SIGN AELA-PILLA .. SINHALA VOWEL SIGN DIGA AEDA-PILLA
+      (16#00DD2#, 16#00DD4#),  -- (Mn)  SINHALA VOWEL SIGN KETTI IS-PILLA .. SINHALA VOWEL SIGN KETTI PAA-PILLA
+      (16#00DD6#, 16#00DD6#),  -- (Mn)  SINHALA VOWEL SIGN DIGA PAA-PILLA .. SINHALA VOWEL SIGN DIGA PAA-PILLA
+      (16#00DD8#, 16#00DDF#),  -- (Mc)  SINHALA VOWEL SIGN GAETTA-PILLA .. SINHALA VOWEL SIGN GAYANUKITTA
+      (16#00DF2#, 16#00DF3#),  -- (Mc)  SINHALA VOWEL SIGN DIGA GAETTA-PILLA .. SINHALA VOWEL SIGN DIGA GAYANUKITTA
+      (16#00DF4#, 16#00DF4#),  -- (Po)  SINHALA PUNCTUATION KUNDDALIYA .. SINHALA PUNCTUATION KUNDDALIYA
+      (16#00E01#, 16#00E30#),  -- (Lo)  THAI CHARACTER KO KAI .. THAI CHARACTER SARA A
+      (16#00E31#, 16#00E31#),  -- (Mn)  THAI CHARACTER MAI HAN-AKAT .. THAI CHARACTER MAI HAN-AKAT
+      (16#00E32#, 16#00E33#),  -- (Lo)  THAI CHARACTER SARA AA .. THAI CHARACTER SARA AM
+      (16#00E34#, 16#00E3A#),  -- (Mn)  THAI CHARACTER SARA I .. THAI CHARACTER PHINTHU
+      (16#00E3F#, 16#00E3F#),  -- (Sc)  THAI CURRENCY SYMBOL BAHT .. THAI CURRENCY SYMBOL BAHT
+      (16#00E40#, 16#00E45#),  -- (Lo)  THAI CHARACTER SARA E .. THAI CHARACTER LAKKHANGYAO
+      (16#00E46#, 16#00E46#),  -- (Lm)  THAI CHARACTER MAIYAMOK .. THAI CHARACTER MAIYAMOK
+      (16#00E47#, 16#00E4E#),  -- (Mn)  THAI CHARACTER MAITAIKHU .. THAI CHARACTER YAMAKKAN
+      (16#00E4F#, 16#00E4F#),  -- (Po)  THAI CHARACTER FONGMAN .. THAI CHARACTER FONGMAN
+      (16#00E50#, 16#00E59#),  -- (Nd)  THAI DIGIT ZERO .. THAI DIGIT NINE
+      (16#00E5A#, 16#00E5B#),  -- (Po)  THAI CHARACTER ANGKHANKHU .. THAI CHARACTER KHOMUT
+      (16#00E81#, 16#00E82#),  -- (Lo)  LAO LETTER KO .. LAO LETTER KHO SUNG
+      (16#00E84#, 16#00E84#),  -- (Lo)  LAO LETTER KHO TAM .. LAO LETTER KHO TAM
+      (16#00E87#, 16#00E88#),  -- (Lo)  LAO LETTER NGO .. LAO LETTER CO
+      (16#00E8A#, 16#00E8A#),  -- (Lo)  LAO LETTER SO TAM .. LAO LETTER SO TAM
+      (16#00E8D#, 16#00E8D#),  -- (Lo)  LAO LETTER NYO .. LAO LETTER NYO
+      (16#00E94#, 16#00E97#),  -- (Lo)  LAO LETTER DO .. LAO LETTER THO TAM
+      (16#00E99#, 16#00E9F#),  -- (Lo)  LAO LETTER NO .. LAO LETTER FO SUNG
+      (16#00EA1#, 16#00EA3#),  -- (Lo)  LAO LETTER MO .. LAO LETTER LO LING
+      (16#00EA5#, 16#00EA5#),  -- (Lo)  LAO LETTER LO LOOT .. LAO LETTER LO LOOT
+      (16#00EA7#, 16#00EA7#),  -- (Lo)  LAO LETTER WO .. LAO LETTER WO
+      (16#00EAA#, 16#00EAB#),  -- (Lo)  LAO LETTER SO SUNG .. LAO LETTER HO SUNG
+      (16#00EAD#, 16#00EB0#),  -- (Lo)  LAO LETTER O .. LAO VOWEL SIGN A
+      (16#00EB1#, 16#00EB1#),  -- (Mn)  LAO VOWEL SIGN MAI KAN .. LAO VOWEL SIGN MAI KAN
+      (16#00EB2#, 16#00EB3#),  -- (Lo)  LAO VOWEL SIGN AA .. LAO VOWEL SIGN AM
+      (16#00EB4#, 16#00EB9#),  -- (Mn)  LAO VOWEL SIGN I .. LAO VOWEL SIGN UU
+      (16#00EBB#, 16#00EBC#),  -- (Mn)  LAO VOWEL SIGN MAI KON .. LAO SEMIVOWEL SIGN LO
+      (16#00EBD#, 16#00EBD#),  -- (Lo)  LAO SEMIVOWEL SIGN NYO .. LAO SEMIVOWEL SIGN NYO
+      (16#00EC0#, 16#00EC4#),  -- (Lo)  LAO VOWEL SIGN E .. LAO VOWEL SIGN AI
+      (16#00EC6#, 16#00EC6#),  -- (Lm)  LAO KO LA .. LAO KO LA
+      (16#00EC8#, 16#00ECD#),  -- (Mn)  LAO TONE MAI EK .. LAO NIGGAHITA
+      (16#00ED0#, 16#00ED9#),  -- (Nd)  LAO DIGIT ZERO .. LAO DIGIT NINE
+      (16#00EDC#, 16#00EDD#),  -- (Lo)  LAO HO NO .. LAO HO MO
+      (16#00F00#, 16#00F00#),  -- (Lo)  TIBETAN SYLLABLE OM .. TIBETAN SYLLABLE OM
+      (16#00F01#, 16#00F03#),  -- (So)  TIBETAN MARK GTER YIG MGO TRUNCATED A .. TIBETAN MARK GTER YIG MGO -UM GTER TSHEG MA
+      (16#00F04#, 16#00F12#),  -- (Po)  TIBETAN MARK INITIAL YIG MGO MDUN MA .. TIBETAN MARK RGYA GRAM SHAD
+      (16#00F13#, 16#00F17#),  -- (So)  TIBETAN MARK CARET -DZUD RTAGS ME LONG CAN .. TIBETAN ASTROLOGICAL SIGN SGRA GCAN -CHAR RTAGS
+      (16#00F18#, 16#00F19#),  -- (Mn)  TIBETAN ASTROLOGICAL SIGN -KHYUD PA .. TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS
+      (16#00F1A#, 16#00F1F#),  -- (So)  TIBETAN SIGN RDEL DKAR GCIG .. TIBETAN SIGN RDEL DKAR RDEL NAG
+      (16#00F20#, 16#00F29#),  -- (Nd)  TIBETAN DIGIT ZERO .. TIBETAN DIGIT NINE
+      (16#00F2A#, 16#00F33#),  -- (No)  TIBETAN DIGIT HALF ONE .. TIBETAN DIGIT HALF ZERO
+      (16#00F34#, 16#00F34#),  -- (So)  TIBETAN MARK BSDUS RTAGS .. TIBETAN MARK BSDUS RTAGS
+      (16#00F35#, 16#00F35#),  -- (Mn)  TIBETAN MARK NGAS BZUNG NYI ZLA .. TIBETAN MARK NGAS BZUNG NYI ZLA
+      (16#00F36#, 16#00F36#),  -- (So)  TIBETAN MARK CARET -DZUD RTAGS BZHI MIG CAN .. TIBETAN MARK CARET -DZUD RTAGS BZHI MIG CAN
+      (16#00F37#, 16#00F37#),  -- (Mn)  TIBETAN MARK NGAS BZUNG SGOR RTAGS .. TIBETAN MARK NGAS BZUNG SGOR RTAGS
+      (16#00F38#, 16#00F38#),  -- (So)  TIBETAN MARK CHE MGO .. TIBETAN MARK CHE MGO
+      (16#00F39#, 16#00F39#),  -- (Mn)  TIBETAN MARK TSA -PHRU .. TIBETAN MARK TSA -PHRU
+      (16#00F3A#, 16#00F3A#),  -- (Ps)  TIBETAN MARK GUG RTAGS GYON .. TIBETAN MARK GUG RTAGS GYON
+      (16#00F3B#, 16#00F3B#),  -- (Pe)  TIBETAN MARK GUG RTAGS GYAS .. TIBETAN MARK GUG RTAGS GYAS
+      (16#00F3C#, 16#00F3C#),  -- (Ps)  TIBETAN MARK ANG KHANG GYON .. TIBETAN MARK ANG KHANG GYON
+      (16#00F3D#, 16#00F3D#),  -- (Pe)  TIBETAN MARK ANG KHANG GYAS .. TIBETAN MARK ANG KHANG GYAS
+      (16#00F3E#, 16#00F3F#),  -- (Mc)  TIBETAN SIGN YAR TSHES .. TIBETAN SIGN MAR TSHES
+      (16#00F40#, 16#00F47#),  -- (Lo)  TIBETAN LETTER KA .. TIBETAN LETTER JA
+      (16#00F49#, 16#00F6A#),  -- (Lo)  TIBETAN LETTER NYA .. TIBETAN LETTER FIXED-FORM RA
+      (16#00F71#, 16#00F7E#),  -- (Mn)  TIBETAN VOWEL SIGN AA .. TIBETAN SIGN RJES SU NGA RO
+      (16#00F7F#, 16#00F7F#),  -- (Mc)  TIBETAN SIGN RNAM BCAD .. TIBETAN SIGN RNAM BCAD
+      (16#00F80#, 16#00F84#),  -- (Mn)  TIBETAN VOWEL SIGN REVERSED I .. TIBETAN MARK HALANTA
+      (16#00F85#, 16#00F85#),  -- (Po)  TIBETAN MARK PALUTA .. TIBETAN MARK PALUTA
+      (16#00F86#, 16#00F87#),  -- (Mn)  TIBETAN SIGN LCI RTAGS .. TIBETAN SIGN YANG RTAGS
+      (16#00F88#, 16#00F8B#),  -- (Lo)  TIBETAN SIGN LCE TSA CAN .. TIBETAN SIGN GRU MED RGYINGS
+      (16#00F90#, 16#00F97#),  -- (Mn)  TIBETAN SUBJOINED LETTER KA .. TIBETAN SUBJOINED LETTER JA
+      (16#00F99#, 16#00FBC#),  -- (Mn)  TIBETAN SUBJOINED LETTER NYA .. TIBETAN SUBJOINED LETTER FIXED-FORM RA
+      (16#00FBE#, 16#00FC5#),  -- (So)  TIBETAN KU RU KHA .. TIBETAN SYMBOL RDO RJE
+      (16#00FC6#, 16#00FC6#),  -- (Mn)  TIBETAN SYMBOL PADMA GDAN .. TIBETAN SYMBOL PADMA GDAN
+      (16#00FC7#, 16#00FCC#),  -- (So)  TIBETAN SYMBOL RDO RJE RGYA GRAM .. TIBETAN SYMBOL NOR BU BZHI -KHYIL
+      (16#00FCF#, 16#00FCF#),  -- (So)  TIBETAN SIGN RDEL NAG GSUM .. TIBETAN SIGN RDEL NAG GSUM
+      (16#01000#, 16#01021#),  -- (Lo)  MYANMAR LETTER KA .. MYANMAR LETTER A
+      (16#01023#, 16#01027#),  -- (Lo)  MYANMAR LETTER I .. MYANMAR LETTER E
+      (16#01029#, 16#0102A#),  -- (Lo)  MYANMAR LETTER O .. MYANMAR LETTER AU
+      (16#0102C#, 16#0102C#),  -- (Mc)  MYANMAR VOWEL SIGN AA .. MYANMAR VOWEL SIGN AA
+      (16#0102D#, 16#01030#),  -- (Mn)  MYANMAR VOWEL SIGN I .. MYANMAR VOWEL SIGN UU
+      (16#01031#, 16#01031#),  -- (Mc)  MYANMAR VOWEL SIGN E .. MYANMAR VOWEL SIGN E
+      (16#01032#, 16#01032#),  -- (Mn)  MYANMAR VOWEL SIGN AI .. MYANMAR VOWEL SIGN AI
+      (16#01036#, 16#01037#),  -- (Mn)  MYANMAR SIGN ANUSVARA .. MYANMAR SIGN DOT BELOW
+      (16#01038#, 16#01038#),  -- (Mc)  MYANMAR SIGN VISARGA .. MYANMAR SIGN VISARGA
+      (16#01039#, 16#01039#),  -- (Mn)  MYANMAR SIGN VIRAMA .. MYANMAR SIGN VIRAMA
+      (16#01040#, 16#01049#),  -- (Nd)  MYANMAR DIGIT ZERO .. MYANMAR DIGIT NINE
+      (16#0104A#, 16#0104F#),  -- (Po)  MYANMAR SIGN LITTLE SECTION .. MYANMAR SYMBOL GENITIVE
+      (16#01050#, 16#01055#),  -- (Lo)  MYANMAR LETTER SHA .. MYANMAR LETTER VOCALIC LL
+      (16#01056#, 16#01057#),  -- (Mc)  MYANMAR VOWEL SIGN VOCALIC R .. MYANMAR VOWEL SIGN VOCALIC RR
+      (16#01058#, 16#01059#),  -- (Mn)  MYANMAR VOWEL SIGN VOCALIC L .. MYANMAR VOWEL SIGN VOCALIC LL
+      (16#010A0#, 16#010C5#),  -- (Lu)  GEORGIAN CAPITAL LETTER AN .. GEORGIAN CAPITAL LETTER HOE
+      (16#010D0#, 16#010F8#),  -- (Lo)  GEORGIAN LETTER AN .. GEORGIAN LETTER ELIFI
+      (16#010FB#, 16#010FB#),  -- (Po)  GEORGIAN PARAGRAPH SEPARATOR .. GEORGIAN PARAGRAPH SEPARATOR
+      (16#01100#, 16#01159#),  -- (Lo)  HANGUL CHOSEONG KIYEOK .. HANGUL CHOSEONG YEORINHIEUH
+      (16#0115F#, 16#011A2#),  -- (Lo)  HANGUL CHOSEONG FILLER .. HANGUL JUNGSEONG SSANGARAEA
+      (16#011A8#, 16#011F9#),  -- (Lo)  HANGUL JONGSEONG KIYEOK .. HANGUL JONGSEONG YEORINHIEUH
+      (16#01200#, 16#01206#),  -- (Lo)  ETHIOPIC SYLLABLE HA .. ETHIOPIC SYLLABLE HO
+      (16#01208#, 16#01246#),  -- (Lo)  ETHIOPIC SYLLABLE LA .. ETHIOPIC SYLLABLE QO
+      (16#01248#, 16#01248#),  -- (Lo)  ETHIOPIC SYLLABLE QWA .. ETHIOPIC SYLLABLE QWA
+      (16#0124A#, 16#0124D#),  -- (Lo)  ETHIOPIC SYLLABLE QWI .. ETHIOPIC SYLLABLE QWE
+      (16#01250#, 16#01256#),  -- (Lo)  ETHIOPIC SYLLABLE QHA .. ETHIOPIC SYLLABLE QHO
+      (16#01258#, 16#01258#),  -- (Lo)  ETHIOPIC SYLLABLE QHWA .. ETHIOPIC SYLLABLE QHWA
+      (16#0125A#, 16#0125D#),  -- (Lo)  ETHIOPIC SYLLABLE QHWI .. ETHIOPIC SYLLABLE QHWE
+      (16#01260#, 16#01286#),  -- (Lo)  ETHIOPIC SYLLABLE BA .. ETHIOPIC SYLLABLE XO
+      (16#01288#, 16#01288#),  -- (Lo)  ETHIOPIC SYLLABLE XWA .. ETHIOPIC SYLLABLE XWA
+      (16#0128A#, 16#0128D#),  -- (Lo)  ETHIOPIC SYLLABLE XWI .. ETHIOPIC SYLLABLE XWE
+      (16#01290#, 16#012AE#),  -- (Lo)  ETHIOPIC SYLLABLE NA .. ETHIOPIC SYLLABLE KO
+      (16#012B0#, 16#012B0#),  -- (Lo)  ETHIOPIC SYLLABLE KWA .. ETHIOPIC SYLLABLE KWA
+      (16#012B2#, 16#012B5#),  -- (Lo)  ETHIOPIC SYLLABLE KWI .. ETHIOPIC SYLLABLE KWE
+      (16#012B8#, 16#012BE#),  -- (Lo)  ETHIOPIC SYLLABLE KXA .. ETHIOPIC SYLLABLE KXO
+      (16#012C0#, 16#012C0#),  -- (Lo)  ETHIOPIC SYLLABLE KXWA .. ETHIOPIC SYLLABLE KXWA
+      (16#012C2#, 16#012C5#),  -- (Lo)  ETHIOPIC SYLLABLE KXWI .. ETHIOPIC SYLLABLE KXWE
+      (16#012C8#, 16#012CE#),  -- (Lo)  ETHIOPIC SYLLABLE WA .. ETHIOPIC SYLLABLE WO
+      (16#012D0#, 16#012D6#),  -- (Lo)  ETHIOPIC SYLLABLE PHARYNGEAL A .. ETHIOPIC SYLLABLE PHARYNGEAL O
+      (16#012D8#, 16#012EE#),  -- (Lo)  ETHIOPIC SYLLABLE ZA .. ETHIOPIC SYLLABLE YO
+      (16#012F0#, 16#0130E#),  -- (Lo)  ETHIOPIC SYLLABLE DA .. ETHIOPIC SYLLABLE GO
+      (16#01310#, 16#01310#),  -- (Lo)  ETHIOPIC SYLLABLE GWA .. ETHIOPIC SYLLABLE GWA
+      (16#01312#, 16#01315#),  -- (Lo)  ETHIOPIC SYLLABLE GWI .. ETHIOPIC SYLLABLE GWE
+      (16#01318#, 16#0131E#),  -- (Lo)  ETHIOPIC SYLLABLE GGA .. ETHIOPIC SYLLABLE GGO
+      (16#01320#, 16#01346#),  -- (Lo)  ETHIOPIC SYLLABLE THA .. ETHIOPIC SYLLABLE TZO
+      (16#01348#, 16#0135A#),  -- (Lo)  ETHIOPIC SYLLABLE FA .. ETHIOPIC SYLLABLE FYA
+      (16#01361#, 16#01368#),  -- (Po)  ETHIOPIC WORDSPACE .. ETHIOPIC PARAGRAPH SEPARATOR
+      (16#01369#, 16#01371#),  -- (Nd)  ETHIOPIC DIGIT ONE .. ETHIOPIC DIGIT NINE
+      (16#01372#, 16#0137C#),  -- (No)  ETHIOPIC NUMBER TEN .. ETHIOPIC NUMBER TEN THOUSAND
+      (16#013A0#, 16#013F4#),  -- (Lo)  CHEROKEE LETTER A .. CHEROKEE LETTER YV
+      (16#01401#, 16#0166C#),  -- (Lo)  CANADIAN SYLLABICS E .. CANADIAN SYLLABICS CARRIER TTSA
+      (16#0166D#, 16#0166E#),  -- (Po)  CANADIAN SYLLABICS CHI SIGN .. CANADIAN SYLLABICS FULL STOP
+      (16#0166F#, 16#01676#),  -- (Lo)  CANADIAN SYLLABICS QAI .. CANADIAN SYLLABICS NNGAA
+      (16#01680#, 16#01680#),  -- (Zs)  OGHAM SPACE MARK .. OGHAM SPACE MARK
+      (16#01681#, 16#0169A#),  -- (Lo)  OGHAM LETTER BEITH .. OGHAM LETTER PEITH
+      (16#0169B#, 16#0169B#),  -- (Ps)  OGHAM FEATHER MARK .. OGHAM FEATHER MARK
+      (16#0169C#, 16#0169C#),  -- (Pe)  OGHAM REVERSED FEATHER MARK .. OGHAM REVERSED FEATHER MARK
+      (16#016A0#, 16#016EA#),  -- (Lo)  RUNIC LETTER FEHU FEOH FE F .. RUNIC LETTER X
+      (16#016EB#, 16#016ED#),  -- (Po)  RUNIC SINGLE PUNCTUATION .. RUNIC CROSS PUNCTUATION
+      (16#016EE#, 16#016F0#),  -- (Nl)  RUNIC ARLAUG SYMBOL .. RUNIC BELGTHOR SYMBOL
+      (16#01700#, 16#0170C#),  -- (Lo)  TAGALOG LETTER A .. TAGALOG LETTER YA
+      (16#0170E#, 16#01711#),  -- (Lo)  TAGALOG LETTER LA .. TAGALOG LETTER HA
+      (16#01712#, 16#01714#),  -- (Mn)  TAGALOG VOWEL SIGN I .. TAGALOG SIGN VIRAMA
+      (16#01720#, 16#01731#),  -- (Lo)  HANUNOO LETTER A .. HANUNOO LETTER HA
+      (16#01732#, 16#01734#),  -- (Mn)  HANUNOO VOWEL SIGN I .. HANUNOO SIGN PAMUDPOD
+      (16#01735#, 16#01736#),  -- (Po)  PHILIPPINE SINGLE PUNCTUATION .. PHILIPPINE DOUBLE PUNCTUATION
+      (16#01740#, 16#01751#),  -- (Lo)  BUHID LETTER A .. BUHID LETTER HA
+      (16#01752#, 16#01753#),  -- (Mn)  BUHID VOWEL SIGN I .. BUHID VOWEL SIGN U
+      (16#01760#, 16#0176C#),  -- (Lo)  TAGBANWA LETTER A .. TAGBANWA LETTER YA
+      (16#0176E#, 16#01770#),  -- (Lo)  TAGBANWA LETTER LA .. TAGBANWA LETTER SA
+      (16#01772#, 16#01773#),  -- (Mn)  TAGBANWA VOWEL SIGN I .. TAGBANWA VOWEL SIGN U
+      (16#01780#, 16#017B3#),  -- (Lo)  KHMER LETTER KA .. KHMER INDEPENDENT VOWEL QAU
+      (16#017B4#, 16#017B5#),  -- (Cf)  KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA
+      (16#017B6#, 16#017B6#),  -- (Mc)  KHMER VOWEL SIGN AA .. KHMER VOWEL SIGN AA
+      (16#017B7#, 16#017BD#),  -- (Mn)  KHMER VOWEL SIGN I .. KHMER VOWEL SIGN UA
+      (16#017BE#, 16#017C5#),  -- (Mc)  KHMER VOWEL SIGN OE .. KHMER VOWEL SIGN AU
+      (16#017C6#, 16#017C6#),  -- (Mn)  KHMER SIGN NIKAHIT .. KHMER SIGN NIKAHIT
+      (16#017C7#, 16#017C8#),  -- (Mc)  KHMER SIGN REAHMUK .. KHMER SIGN YUUKALEAPINTU
+      (16#017C9#, 16#017D3#),  -- (Mn)  KHMER SIGN MUUSIKATOAN .. KHMER SIGN BATHAMASAT
+      (16#017D4#, 16#017D6#),  -- (Po)  KHMER SIGN KHAN .. KHMER SIGN CAMNUC PII KUUH
+      (16#017D7#, 16#017D7#),  -- (Lm)  KHMER SIGN LEK TOO .. KHMER SIGN LEK TOO
+      (16#017D8#, 16#017DA#),  -- (Po)  KHMER SIGN BEYYAL .. KHMER SIGN KOOMUUT
+      (16#017DB#, 16#017DB#),  -- (Sc)  KHMER CURRENCY SYMBOL RIEL .. KHMER CURRENCY SYMBOL RIEL
+      (16#017DC#, 16#017DC#),  -- (Lo)  KHMER SIGN AVAKRAHASANYA .. KHMER SIGN AVAKRAHASANYA
+      (16#017DD#, 16#017DD#),  -- (Mn)  KHMER SIGN ATTHACAN .. KHMER SIGN ATTHACAN
+      (16#017E0#, 16#017E9#),  -- (Nd)  KHMER DIGIT ZERO .. KHMER DIGIT NINE
+      (16#017F0#, 16#017F9#),  -- (No)  KHMER SYMBOL LEK ATTAK SON .. KHMER SYMBOL LEK ATTAK PRAM-BUON
+      (16#01800#, 16#01805#),  -- (Po)  MONGOLIAN BIRGA .. MONGOLIAN FOUR DOTS
+      (16#01806#, 16#01806#),  -- (Pd)  MONGOLIAN TODO SOFT HYPHEN .. MONGOLIAN TODO SOFT HYPHEN
+      (16#01807#, 16#0180A#),  -- (Po)  MONGOLIAN SIBE SYLLABLE BOUNDARY MARKER .. MONGOLIAN NIRUGU
+      (16#0180B#, 16#0180D#),  -- (Mn)  MONGOLIAN FREE VARIATION SELECTOR ONE .. MONGOLIAN FREE VARIATION SELECTOR THREE
+      (16#0180E#, 16#0180E#),  -- (Zs)  MONGOLIAN VOWEL SEPARATOR .. MONGOLIAN VOWEL SEPARATOR
+      (16#01810#, 16#01819#),  -- (Nd)  MONGOLIAN DIGIT ZERO .. MONGOLIAN DIGIT NINE
+      (16#01820#, 16#01842#),  -- (Lo)  MONGOLIAN LETTER A .. MONGOLIAN LETTER CHI
+      (16#01843#, 16#01843#),  -- (Lm)  MONGOLIAN LETTER TODO LONG VOWEL SIGN .. MONGOLIAN LETTER TODO LONG VOWEL SIGN
+      (16#01844#, 16#01877#),  -- (Lo)  MONGOLIAN LETTER TODO E .. MONGOLIAN LETTER MANCHU ZHA
+      (16#01880#, 16#018A8#),  -- (Lo)  MONGOLIAN LETTER ALI GALI ANUSVARA ONE .. MONGOLIAN LETTER MANCHU ALI GALI BHA
+      (16#018A9#, 16#018A9#),  -- (Mn)  MONGOLIAN LETTER ALI GALI DAGALGA .. MONGOLIAN LETTER ALI GALI DAGALGA
+      (16#01900#, 16#0191C#),  -- (Lo)  LIMBU VOWEL-CARRIER LETTER .. LIMBU LETTER HA
+      (16#01920#, 16#01922#),  -- (Mn)  LIMBU VOWEL SIGN A .. LIMBU VOWEL SIGN U
+      (16#01923#, 16#01926#),  -- (Mc)  LIMBU VOWEL SIGN EE .. LIMBU VOWEL SIGN AU
+      (16#01927#, 16#01928#),  -- (Mn)  LIMBU VOWEL SIGN E .. LIMBU VOWEL SIGN O
+      (16#01929#, 16#0192B#),  -- (Mc)  LIMBU SUBJOINED LETTER YA .. LIMBU SUBJOINED LETTER WA
+      (16#01930#, 16#01931#),  -- (Mc)  LIMBU SMALL LETTER KA .. LIMBU SMALL LETTER NGA
+      (16#01932#, 16#01932#),  -- (Mn)  LIMBU SMALL LETTER ANUSVARA .. LIMBU SMALL LETTER ANUSVARA
+      (16#01933#, 16#01938#),  -- (Mc)  LIMBU SMALL LETTER TA .. LIMBU SMALL LETTER LA
+      (16#01939#, 16#0193B#),  -- (Mn)  LIMBU SIGN MUKPHRENG .. LIMBU SIGN SA-I
+      (16#01940#, 16#01940#),  -- (So)  LIMBU SIGN LOO .. LIMBU SIGN LOO
+      (16#01944#, 16#01945#),  -- (Po)  LIMBU EXCLAMATION MARK .. LIMBU QUESTION MARK
+      (16#01946#, 16#0194F#),  -- (Nd)  LIMBU DIGIT ZERO .. LIMBU DIGIT NINE
+      (16#01950#, 16#0196D#),  -- (Lo)  TAI LE LETTER KA .. TAI LE LETTER AI
+      (16#01970#, 16#01974#),  -- (Lo)  TAI LE LETTER TONE-2 .. TAI LE LETTER TONE-6
+      (16#019E0#, 16#019FF#),  -- (So)  KHMER SYMBOL PATHAMASAT .. KHMER SYMBOL DAP-PRAM ROC
+      (16#01D00#, 16#01D2B#),  -- (Ll)  LATIN LETTER SMALL CAPITAL A .. CYRILLIC LETTER SMALL CAPITAL EL
+      (16#01D2C#, 16#01D61#),  -- (Lm)  MODIFIER LETTER CAPITAL A .. MODIFIER LETTER SMALL CHI
+      (16#01D62#, 16#01D6B#),  -- (Ll)  LATIN SUBSCRIPT SMALL LETTER I .. LATIN SMALL LETTER UE
+      (16#01E00#, 16#01E00#),  -- (Lu)  LATIN CAPITAL LETTER A WITH RING BELOW .. LATIN CAPITAL LETTER A WITH RING BELOW
+      (16#01E01#, 16#01E01#),  -- (Ll)  LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW
+      (16#01E02#, 16#01E02#),  -- (Lu)  LATIN CAPITAL LETTER B WITH DOT ABOVE .. LATIN CAPITAL LETTER B WITH DOT ABOVE
+      (16#01E03#, 16#01E03#),  -- (Ll)  LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE
+      (16#01E04#, 16#01E04#),  -- (Lu)  LATIN CAPITAL LETTER B WITH DOT BELOW .. LATIN CAPITAL LETTER B WITH DOT BELOW
+      (16#01E05#, 16#01E05#),  -- (Ll)  LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW
+      (16#01E06#, 16#01E06#),  -- (Lu)  LATIN CAPITAL LETTER B WITH LINE BELOW .. LATIN CAPITAL LETTER B WITH LINE BELOW
+      (16#01E07#, 16#01E07#),  -- (Ll)  LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW
+      (16#01E08#, 16#01E08#),  -- (Lu)  LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE .. LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE
+      (16#01E09#, 16#01E09#),  -- (Ll)  LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE
+      (16#01E0A#, 16#01E0A#),  -- (Lu)  LATIN CAPITAL LETTER D WITH DOT ABOVE .. LATIN CAPITAL LETTER D WITH DOT ABOVE
+      (16#01E0B#, 16#01E0B#),  -- (Ll)  LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE
+      (16#01E0C#, 16#01E0C#),  -- (Lu)  LATIN CAPITAL LETTER D WITH DOT BELOW .. LATIN CAPITAL LETTER D WITH DOT BELOW
+      (16#01E0D#, 16#01E0D#),  -- (Ll)  LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW
+      (16#01E0E#, 16#01E0E#),  -- (Lu)  LATIN CAPITAL LETTER D WITH LINE BELOW .. LATIN CAPITAL LETTER D WITH LINE BELOW
+      (16#01E0F#, 16#01E0F#),  -- (Ll)  LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW
+      (16#01E10#, 16#01E10#),  -- (Lu)  LATIN CAPITAL LETTER D WITH CEDILLA .. LATIN CAPITAL LETTER D WITH CEDILLA
+      (16#01E11#, 16#01E11#),  -- (Ll)  LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA
+      (16#01E12#, 16#01E12#),  -- (Lu)  LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW
+      (16#01E13#, 16#01E13#),  -- (Ll)  LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW
+      (16#01E14#, 16#01E14#),  -- (Lu)  LATIN CAPITAL LETTER E WITH MACRON AND GRAVE .. LATIN CAPITAL LETTER E WITH MACRON AND GRAVE
+      (16#01E15#, 16#01E15#),  -- (Ll)  LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE
+      (16#01E16#, 16#01E16#),  -- (Lu)  LATIN CAPITAL LETTER E WITH MACRON AND ACUTE .. LATIN CAPITAL LETTER E WITH MACRON AND ACUTE
+      (16#01E17#, 16#01E17#),  -- (Ll)  LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE
+      (16#01E18#, 16#01E18#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW
+      (16#01E19#, 16#01E19#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW
+      (16#01E1A#, 16#01E1A#),  -- (Lu)  LATIN CAPITAL LETTER E WITH TILDE BELOW .. LATIN CAPITAL LETTER E WITH TILDE BELOW
+      (16#01E1B#, 16#01E1B#),  -- (Ll)  LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW
+      (16#01E1C#, 16#01E1C#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE .. LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE
+      (16#01E1D#, 16#01E1D#),  -- (Ll)  LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE
+      (16#01E1E#, 16#01E1E#),  -- (Lu)  LATIN CAPITAL LETTER F WITH DOT ABOVE .. LATIN CAPITAL LETTER F WITH DOT ABOVE
+      (16#01E1F#, 16#01E1F#),  -- (Ll)  LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE
+      (16#01E20#, 16#01E20#),  -- (Lu)  LATIN CAPITAL LETTER G WITH MACRON .. LATIN CAPITAL LETTER G WITH MACRON
+      (16#01E21#, 16#01E21#),  -- (Ll)  LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON
+      (16#01E22#, 16#01E22#),  -- (Lu)  LATIN CAPITAL LETTER H WITH DOT ABOVE .. LATIN CAPITAL LETTER H WITH DOT ABOVE
+      (16#01E23#, 16#01E23#),  -- (Ll)  LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE
+      (16#01E24#, 16#01E24#),  -- (Lu)  LATIN CAPITAL LETTER H WITH DOT BELOW .. LATIN CAPITAL LETTER H WITH DOT BELOW
+      (16#01E25#, 16#01E25#),  -- (Ll)  LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW
+      (16#01E26#, 16#01E26#),  -- (Lu)  LATIN CAPITAL LETTER H WITH DIAERESIS .. LATIN CAPITAL LETTER H WITH DIAERESIS
+      (16#01E27#, 16#01E27#),  -- (Ll)  LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS
+      (16#01E28#, 16#01E28#),  -- (Lu)  LATIN CAPITAL LETTER H WITH CEDILLA .. LATIN CAPITAL LETTER H WITH CEDILLA
+      (16#01E29#, 16#01E29#),  -- (Ll)  LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA
+      (16#01E2A#, 16#01E2A#),  -- (Lu)  LATIN CAPITAL LETTER H WITH BREVE BELOW .. LATIN CAPITAL LETTER H WITH BREVE BELOW
+      (16#01E2B#, 16#01E2B#),  -- (Ll)  LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW
+      (16#01E2C#, 16#01E2C#),  -- (Lu)  LATIN CAPITAL LETTER I WITH TILDE BELOW .. LATIN CAPITAL LETTER I WITH TILDE BELOW
+      (16#01E2D#, 16#01E2D#),  -- (Ll)  LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW
+      (16#01E2E#, 16#01E2E#),  -- (Lu)  LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE .. LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE
+      (16#01E2F#, 16#01E2F#),  -- (Ll)  LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE
+      (16#01E30#, 16#01E30#),  -- (Lu)  LATIN CAPITAL LETTER K WITH ACUTE .. LATIN CAPITAL LETTER K WITH ACUTE
+      (16#01E31#, 16#01E31#),  -- (Ll)  LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE
+      (16#01E32#, 16#01E32#),  -- (Lu)  LATIN CAPITAL LETTER K WITH DOT BELOW .. LATIN CAPITAL LETTER K WITH DOT BELOW
+      (16#01E33#, 16#01E33#),  -- (Ll)  LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW
+      (16#01E34#, 16#01E34#),  -- (Lu)  LATIN CAPITAL LETTER K WITH LINE BELOW .. LATIN CAPITAL LETTER K WITH LINE BELOW
+      (16#01E35#, 16#01E35#),  -- (Ll)  LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW
+      (16#01E36#, 16#01E36#),  -- (Lu)  LATIN CAPITAL LETTER L WITH DOT BELOW .. LATIN CAPITAL LETTER L WITH DOT BELOW
+      (16#01E37#, 16#01E37#),  -- (Ll)  LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW
+      (16#01E38#, 16#01E38#),  -- (Lu)  LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON .. LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON
+      (16#01E39#, 16#01E39#),  -- (Ll)  LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON
+      (16#01E3A#, 16#01E3A#),  -- (Lu)  LATIN CAPITAL LETTER L WITH LINE BELOW .. LATIN CAPITAL LETTER L WITH LINE BELOW
+      (16#01E3B#, 16#01E3B#),  -- (Ll)  LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW
+      (16#01E3C#, 16#01E3C#),  -- (Lu)  LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW
+      (16#01E3D#, 16#01E3D#),  -- (Ll)  LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW
+      (16#01E3E#, 16#01E3E#),  -- (Lu)  LATIN CAPITAL LETTER M WITH ACUTE .. LATIN CAPITAL LETTER M WITH ACUTE
+      (16#01E3F#, 16#01E3F#),  -- (Ll)  LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE
+      (16#01E40#, 16#01E40#),  -- (Lu)  LATIN CAPITAL LETTER M WITH DOT ABOVE .. LATIN CAPITAL LETTER M WITH DOT ABOVE
+      (16#01E41#, 16#01E41#),  -- (Ll)  LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE
+      (16#01E42#, 16#01E42#),  -- (Lu)  LATIN CAPITAL LETTER M WITH DOT BELOW .. LATIN CAPITAL LETTER M WITH DOT BELOW
+      (16#01E43#, 16#01E43#),  -- (Ll)  LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW
+      (16#01E44#, 16#01E44#),  -- (Lu)  LATIN CAPITAL LETTER N WITH DOT ABOVE .. LATIN CAPITAL LETTER N WITH DOT ABOVE
+      (16#01E45#, 16#01E45#),  -- (Ll)  LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE
+      (16#01E46#, 16#01E46#),  -- (Lu)  LATIN CAPITAL LETTER N WITH DOT BELOW .. LATIN CAPITAL LETTER N WITH DOT BELOW
+      (16#01E47#, 16#01E47#),  -- (Ll)  LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW
+      (16#01E48#, 16#01E48#),  -- (Lu)  LATIN CAPITAL LETTER N WITH LINE BELOW .. LATIN CAPITAL LETTER N WITH LINE BELOW
+      (16#01E49#, 16#01E49#),  -- (Ll)  LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW
+      (16#01E4A#, 16#01E4A#),  -- (Lu)  LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW
+      (16#01E4B#, 16#01E4B#),  -- (Ll)  LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW
+      (16#01E4C#, 16#01E4C#),  -- (Lu)  LATIN CAPITAL LETTER O WITH TILDE AND ACUTE .. LATIN CAPITAL LETTER O WITH TILDE AND ACUTE
+      (16#01E4D#, 16#01E4D#),  -- (Ll)  LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE
+      (16#01E4E#, 16#01E4E#),  -- (Lu)  LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS .. LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS
+      (16#01E4F#, 16#01E4F#),  -- (Ll)  LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS
+      (16#01E50#, 16#01E50#),  -- (Lu)  LATIN CAPITAL LETTER O WITH MACRON AND GRAVE .. LATIN CAPITAL LETTER O WITH MACRON AND GRAVE
+      (16#01E51#, 16#01E51#),  -- (Ll)  LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE
+      (16#01E52#, 16#01E52#),  -- (Lu)  LATIN CAPITAL LETTER O WITH MACRON AND ACUTE .. LATIN CAPITAL LETTER O WITH MACRON AND ACUTE
+      (16#01E53#, 16#01E53#),  -- (Ll)  LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE
+      (16#01E54#, 16#01E54#),  -- (Lu)  LATIN CAPITAL LETTER P WITH ACUTE .. LATIN CAPITAL LETTER P WITH ACUTE
+      (16#01E55#, 16#01E55#),  -- (Ll)  LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE
+      (16#01E56#, 16#01E56#),  -- (Lu)  LATIN CAPITAL LETTER P WITH DOT ABOVE .. LATIN CAPITAL LETTER P WITH DOT ABOVE
+      (16#01E57#, 16#01E57#),  -- (Ll)  LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE
+      (16#01E58#, 16#01E58#),  -- (Lu)  LATIN CAPITAL LETTER R WITH DOT ABOVE .. LATIN CAPITAL LETTER R WITH DOT ABOVE
+      (16#01E59#, 16#01E59#),  -- (Ll)  LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE
+      (16#01E5A#, 16#01E5A#),  -- (Lu)  LATIN CAPITAL LETTER R WITH DOT BELOW .. LATIN CAPITAL LETTER R WITH DOT BELOW
+      (16#01E5B#, 16#01E5B#),  -- (Ll)  LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW
+      (16#01E5C#, 16#01E5C#),  -- (Lu)  LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON .. LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON
+      (16#01E5D#, 16#01E5D#),  -- (Ll)  LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON
+      (16#01E5E#, 16#01E5E#),  -- (Lu)  LATIN CAPITAL LETTER R WITH LINE BELOW .. LATIN CAPITAL LETTER R WITH LINE BELOW
+      (16#01E5F#, 16#01E5F#),  -- (Ll)  LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW
+      (16#01E60#, 16#01E60#),  -- (Lu)  LATIN CAPITAL LETTER S WITH DOT ABOVE .. LATIN CAPITAL LETTER S WITH DOT ABOVE
+      (16#01E61#, 16#01E61#),  -- (Ll)  LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE
+      (16#01E62#, 16#01E62#),  -- (Lu)  LATIN CAPITAL LETTER S WITH DOT BELOW .. LATIN CAPITAL LETTER S WITH DOT BELOW
+      (16#01E63#, 16#01E63#),  -- (Ll)  LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW
+      (16#01E64#, 16#01E64#),  -- (Lu)  LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE
+      (16#01E65#, 16#01E65#),  -- (Ll)  LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE
+      (16#01E66#, 16#01E66#),  -- (Lu)  LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE
+      (16#01E67#, 16#01E67#),  -- (Ll)  LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE
+      (16#01E68#, 16#01E68#),  -- (Lu)  LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE
+      (16#01E69#, 16#01E69#),  -- (Ll)  LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE
+      (16#01E6A#, 16#01E6A#),  -- (Lu)  LATIN CAPITAL LETTER T WITH DOT ABOVE .. LATIN CAPITAL LETTER T WITH DOT ABOVE
+      (16#01E6B#, 16#01E6B#),  -- (Ll)  LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE
+      (16#01E6C#, 16#01E6C#),  -- (Lu)  LATIN CAPITAL LETTER T WITH DOT BELOW .. LATIN CAPITAL LETTER T WITH DOT BELOW
+      (16#01E6D#, 16#01E6D#),  -- (Ll)  LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW
+      (16#01E6E#, 16#01E6E#),  -- (Lu)  LATIN CAPITAL LETTER T WITH LINE BELOW .. LATIN CAPITAL LETTER T WITH LINE BELOW
+      (16#01E6F#, 16#01E6F#),  -- (Ll)  LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW
+      (16#01E70#, 16#01E70#),  -- (Lu)  LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW
+      (16#01E71#, 16#01E71#),  -- (Ll)  LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW
+      (16#01E72#, 16#01E72#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DIAERESIS BELOW .. LATIN CAPITAL LETTER U WITH DIAERESIS BELOW
+      (16#01E73#, 16#01E73#),  -- (Ll)  LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW
+      (16#01E74#, 16#01E74#),  -- (Lu)  LATIN CAPITAL LETTER U WITH TILDE BELOW .. LATIN CAPITAL LETTER U WITH TILDE BELOW
+      (16#01E75#, 16#01E75#),  -- (Ll)  LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW
+      (16#01E76#, 16#01E76#),  -- (Lu)  LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW
+      (16#01E77#, 16#01E77#),  -- (Ll)  LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW
+      (16#01E78#, 16#01E78#),  -- (Lu)  LATIN CAPITAL LETTER U WITH TILDE AND ACUTE .. LATIN CAPITAL LETTER U WITH TILDE AND ACUTE
+      (16#01E79#, 16#01E79#),  -- (Ll)  LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE
+      (16#01E7A#, 16#01E7A#),  -- (Lu)  LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS .. LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS
+      (16#01E7B#, 16#01E7B#),  -- (Ll)  LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS
+      (16#01E7C#, 16#01E7C#),  -- (Lu)  LATIN CAPITAL LETTER V WITH TILDE .. LATIN CAPITAL LETTER V WITH TILDE
+      (16#01E7D#, 16#01E7D#),  -- (Ll)  LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE
+      (16#01E7E#, 16#01E7E#),  -- (Lu)  LATIN CAPITAL LETTER V WITH DOT BELOW .. LATIN CAPITAL LETTER V WITH DOT BELOW
+      (16#01E7F#, 16#01E7F#),  -- (Ll)  LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW
+      (16#01E80#, 16#01E80#),  -- (Lu)  LATIN CAPITAL LETTER W WITH GRAVE .. LATIN CAPITAL LETTER W WITH GRAVE
+      (16#01E81#, 16#01E81#),  -- (Ll)  LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE
+      (16#01E82#, 16#01E82#),  -- (Lu)  LATIN CAPITAL LETTER W WITH ACUTE .. LATIN CAPITAL LETTER W WITH ACUTE
+      (16#01E83#, 16#01E83#),  -- (Ll)  LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE
+      (16#01E84#, 16#01E84#),  -- (Lu)  LATIN CAPITAL LETTER W WITH DIAERESIS .. LATIN CAPITAL LETTER W WITH DIAERESIS
+      (16#01E85#, 16#01E85#),  -- (Ll)  LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS
+      (16#01E86#, 16#01E86#),  -- (Lu)  LATIN CAPITAL LETTER W WITH DOT ABOVE .. LATIN CAPITAL LETTER W WITH DOT ABOVE
+      (16#01E87#, 16#01E87#),  -- (Ll)  LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE
+      (16#01E88#, 16#01E88#),  -- (Lu)  LATIN CAPITAL LETTER W WITH DOT BELOW .. LATIN CAPITAL LETTER W WITH DOT BELOW
+      (16#01E89#, 16#01E89#),  -- (Ll)  LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW
+      (16#01E8A#, 16#01E8A#),  -- (Lu)  LATIN CAPITAL LETTER X WITH DOT ABOVE .. LATIN CAPITAL LETTER X WITH DOT ABOVE
+      (16#01E8B#, 16#01E8B#),  -- (Ll)  LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE
+      (16#01E8C#, 16#01E8C#),  -- (Lu)  LATIN CAPITAL LETTER X WITH DIAERESIS .. LATIN CAPITAL LETTER X WITH DIAERESIS
+      (16#01E8D#, 16#01E8D#),  -- (Ll)  LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS
+      (16#01E8E#, 16#01E8E#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH DOT ABOVE .. LATIN CAPITAL LETTER Y WITH DOT ABOVE
+      (16#01E8F#, 16#01E8F#),  -- (Ll)  LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE
+      (16#01E90#, 16#01E90#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH CIRCUMFLEX .. LATIN CAPITAL LETTER Z WITH CIRCUMFLEX
+      (16#01E91#, 16#01E91#),  -- (Ll)  LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX
+      (16#01E92#, 16#01E92#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH DOT BELOW .. LATIN CAPITAL LETTER Z WITH DOT BELOW
+      (16#01E93#, 16#01E93#),  -- (Ll)  LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW
+      (16#01E94#, 16#01E94#),  -- (Lu)  LATIN CAPITAL LETTER Z WITH LINE BELOW .. LATIN CAPITAL LETTER Z WITH LINE BELOW
+      (16#01E95#, 16#01E9B#),  -- (Ll)  LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER LONG S WITH DOT ABOVE
+      (16#01EA0#, 16#01EA0#),  -- (Lu)  LATIN CAPITAL LETTER A WITH DOT BELOW .. LATIN CAPITAL LETTER A WITH DOT BELOW
+      (16#01EA1#, 16#01EA1#),  -- (Ll)  LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW
+      (16#01EA2#, 16#01EA2#),  -- (Lu)  LATIN CAPITAL LETTER A WITH HOOK ABOVE .. LATIN CAPITAL LETTER A WITH HOOK ABOVE
+      (16#01EA3#, 16#01EA3#),  -- (Ll)  LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE
+      (16#01EA4#, 16#01EA4#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+      (16#01EA5#, 16#01EA5#),  -- (Ll)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+      (16#01EA6#, 16#01EA6#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+      (16#01EA7#, 16#01EA7#),  -- (Ll)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+      (16#01EA8#, 16#01EA8#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01EA9#, 16#01EA9#),  -- (Ll)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01EAA#, 16#01EAA#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+      (16#01EAB#, 16#01EAB#),  -- (Ll)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+      (16#01EAC#, 16#01EAC#),  -- (Lu)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+      (16#01EAD#, 16#01EAD#),  -- (Ll)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+      (16#01EAE#, 16#01EAE#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE AND ACUTE .. LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+      (16#01EAF#, 16#01EAF#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE
+      (16#01EB0#, 16#01EB0#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE AND GRAVE .. LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+      (16#01EB1#, 16#01EB1#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE
+      (16#01EB2#, 16#01EB2#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
+      (16#01EB3#, 16#01EB3#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+      (16#01EB4#, 16#01EB4#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE AND TILDE .. LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+      (16#01EB5#, 16#01EB5#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE
+      (16#01EB6#, 16#01EB6#),  -- (Lu)  LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW .. LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+      (16#01EB7#, 16#01EB7#),  -- (Ll)  LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+      (16#01EB8#, 16#01EB8#),  -- (Lu)  LATIN CAPITAL LETTER E WITH DOT BELOW .. LATIN CAPITAL LETTER E WITH DOT BELOW
+      (16#01EB9#, 16#01EB9#),  -- (Ll)  LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW
+      (16#01EBA#, 16#01EBA#),  -- (Lu)  LATIN CAPITAL LETTER E WITH HOOK ABOVE .. LATIN CAPITAL LETTER E WITH HOOK ABOVE
+      (16#01EBB#, 16#01EBB#),  -- (Ll)  LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE
+      (16#01EBC#, 16#01EBC#),  -- (Lu)  LATIN CAPITAL LETTER E WITH TILDE .. LATIN CAPITAL LETTER E WITH TILDE
+      (16#01EBD#, 16#01EBD#),  -- (Ll)  LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE
+      (16#01EBE#, 16#01EBE#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+      (16#01EBF#, 16#01EBF#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+      (16#01EC0#, 16#01EC0#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+      (16#01EC1#, 16#01EC1#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+      (16#01EC2#, 16#01EC2#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01EC3#, 16#01EC3#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01EC4#, 16#01EC4#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+      (16#01EC5#, 16#01EC5#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+      (16#01EC6#, 16#01EC6#),  -- (Lu)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+      (16#01EC7#, 16#01EC7#),  -- (Ll)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+      (16#01EC8#, 16#01EC8#),  -- (Lu)  LATIN CAPITAL LETTER I WITH HOOK ABOVE .. LATIN CAPITAL LETTER I WITH HOOK ABOVE
+      (16#01EC9#, 16#01EC9#),  -- (Ll)  LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE
+      (16#01ECA#, 16#01ECA#),  -- (Lu)  LATIN CAPITAL LETTER I WITH DOT BELOW .. LATIN CAPITAL LETTER I WITH DOT BELOW
+      (16#01ECB#, 16#01ECB#),  -- (Ll)  LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW
+      (16#01ECC#, 16#01ECC#),  -- (Lu)  LATIN CAPITAL LETTER O WITH DOT BELOW .. LATIN CAPITAL LETTER O WITH DOT BELOW
+      (16#01ECD#, 16#01ECD#),  -- (Ll)  LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW
+      (16#01ECE#, 16#01ECE#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HOOK ABOVE .. LATIN CAPITAL LETTER O WITH HOOK ABOVE
+      (16#01ECF#, 16#01ECF#),  -- (Ll)  LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE
+      (16#01ED0#, 16#01ED0#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+      (16#01ED1#, 16#01ED1#),  -- (Ll)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+      (16#01ED2#, 16#01ED2#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+      (16#01ED3#, 16#01ED3#),  -- (Ll)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+      (16#01ED4#, 16#01ED4#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01ED5#, 16#01ED5#),  -- (Ll)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+      (16#01ED6#, 16#01ED6#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+      (16#01ED7#, 16#01ED7#),  -- (Ll)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+      (16#01ED8#, 16#01ED8#),  -- (Lu)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+      (16#01ED9#, 16#01ED9#),  -- (Ll)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+      (16#01EDA#, 16#01EDA#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HORN AND ACUTE .. LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+      (16#01EDB#, 16#01EDB#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE
+      (16#01EDC#, 16#01EDC#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HORN AND GRAVE .. LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+      (16#01EDD#, 16#01EDD#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE
+      (16#01EDE#, 16#01EDE#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE .. LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
+      (16#01EDF#, 16#01EDF#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+      (16#01EE0#, 16#01EE0#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HORN AND TILDE .. LATIN CAPITAL LETTER O WITH HORN AND TILDE
+      (16#01EE1#, 16#01EE1#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE
+      (16#01EE2#, 16#01EE2#),  -- (Lu)  LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW .. LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW
+      (16#01EE3#, 16#01EE3#),  -- (Ll)  LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW
+      (16#01EE4#, 16#01EE4#),  -- (Lu)  LATIN CAPITAL LETTER U WITH DOT BELOW .. LATIN CAPITAL LETTER U WITH DOT BELOW
+      (16#01EE5#, 16#01EE5#),  -- (Ll)  LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW
+      (16#01EE6#, 16#01EE6#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HOOK ABOVE .. LATIN CAPITAL LETTER U WITH HOOK ABOVE
+      (16#01EE7#, 16#01EE7#),  -- (Ll)  LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE
+      (16#01EE8#, 16#01EE8#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HORN AND ACUTE .. LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+      (16#01EE9#, 16#01EE9#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE
+      (16#01EEA#, 16#01EEA#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HORN AND GRAVE .. LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+      (16#01EEB#, 16#01EEB#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE
+      (16#01EEC#, 16#01EEC#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE .. LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
+      (16#01EED#, 16#01EED#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+      (16#01EEE#, 16#01EEE#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HORN AND TILDE .. LATIN CAPITAL LETTER U WITH HORN AND TILDE
+      (16#01EEF#, 16#01EEF#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE
+      (16#01EF0#, 16#01EF0#),  -- (Lu)  LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW .. LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW
+      (16#01EF1#, 16#01EF1#),  -- (Ll)  LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW
+      (16#01EF2#, 16#01EF2#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH GRAVE .. LATIN CAPITAL LETTER Y WITH GRAVE
+      (16#01EF3#, 16#01EF3#),  -- (Ll)  LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE
+      (16#01EF4#, 16#01EF4#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH DOT BELOW .. LATIN CAPITAL LETTER Y WITH DOT BELOW
+      (16#01EF5#, 16#01EF5#),  -- (Ll)  LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW
+      (16#01EF6#, 16#01EF6#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH HOOK ABOVE .. LATIN CAPITAL LETTER Y WITH HOOK ABOVE
+      (16#01EF7#, 16#01EF7#),  -- (Ll)  LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE
+      (16#01EF8#, 16#01EF8#),  -- (Lu)  LATIN CAPITAL LETTER Y WITH TILDE .. LATIN CAPITAL LETTER Y WITH TILDE
+      (16#01EF9#, 16#01EF9#),  -- (Ll)  LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE
+      (16#01F00#, 16#01F07#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI
+      (16#01F08#, 16#01F0F#),  -- (Lu)  GREEK CAPITAL LETTER ALPHA WITH PSILI .. GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI
+      (16#01F10#, 16#01F15#),  -- (Ll)  GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA
+      (16#01F18#, 16#01F1D#),  -- (Lu)  GREEK CAPITAL LETTER EPSILON WITH PSILI .. GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA
+      (16#01F20#, 16#01F27#),  -- (Ll)  GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI
+      (16#01F28#, 16#01F2F#),  -- (Lu)  GREEK CAPITAL LETTER ETA WITH PSILI .. GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI
+      (16#01F30#, 16#01F37#),  -- (Ll)  GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI
+      (16#01F38#, 16#01F3F#),  -- (Lu)  GREEK CAPITAL LETTER IOTA WITH PSILI .. GREEK CAPITAL LETTER IOTA WITH DASIA AND PERISPOMENI
+      (16#01F40#, 16#01F45#),  -- (Ll)  GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA
+      (16#01F48#, 16#01F4D#),  -- (Lu)  GREEK CAPITAL LETTER OMICRON WITH PSILI .. GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA
+      (16#01F50#, 16#01F57#),  -- (Ll)  GREEK SMALL LETTER UPSILON WITH PSILI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI
+      (16#01F59#, 16#01F59#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH DASIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA
+      (16#01F5B#, 16#01F5B#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA
+      (16#01F5D#, 16#01F5D#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA
+      (16#01F5F#, 16#01F5F#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI
+      (16#01F60#, 16#01F67#),  -- (Ll)  GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI
+      (16#01F68#, 16#01F6F#),  -- (Lu)  GREEK CAPITAL LETTER OMEGA WITH PSILI .. GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI
+      (16#01F70#, 16#01F7D#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA
+      (16#01F80#, 16#01F87#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      (16#01F88#, 16#01F8F#),  -- (Lt)  GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      (16#01F90#, 16#01F97#),  -- (Ll)  GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      (16#01F98#, 16#01F9F#),  -- (Lt)  GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      (16#01FA0#, 16#01FA7#),  -- (Ll)  GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      (16#01FA8#, 16#01FAF#),  -- (Lt)  GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      (16#01FB0#, 16#01FB4#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
+      (16#01FB6#, 16#01FB7#),  -- (Ll)  GREEK SMALL LETTER ALPHA WITH PERISPOMENI .. GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
+      (16#01FB8#, 16#01FBB#),  -- (Lu)  GREEK CAPITAL LETTER ALPHA WITH VRACHY .. GREEK CAPITAL LETTER ALPHA WITH OXIA
+      (16#01FBC#, 16#01FBC#),  -- (Lt)  GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
+      (16#01FBD#, 16#01FBD#),  -- (Sk)  GREEK KORONIS .. GREEK KORONIS
+      (16#01FBE#, 16#01FBE#),  -- (Ll)  GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI
+      (16#01FBF#, 16#01FC1#),  -- (Sk)  GREEK PSILI .. GREEK DIALYTIKA AND PERISPOMENI
+      (16#01FC2#, 16#01FC4#),  -- (Ll)  GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
+      (16#01FC6#, 16#01FC7#),  -- (Ll)  GREEK SMALL LETTER ETA WITH PERISPOMENI .. GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
+      (16#01FC8#, 16#01FCB#),  -- (Lu)  GREEK CAPITAL LETTER EPSILON WITH VARIA .. GREEK CAPITAL LETTER ETA WITH OXIA
+      (16#01FCC#, 16#01FCC#),  -- (Lt)  GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
+      (16#01FCD#, 16#01FCF#),  -- (Sk)  GREEK PSILI AND VARIA .. GREEK PSILI AND PERISPOMENI
+      (16#01FD0#, 16#01FD3#),  -- (Ll)  GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
+      (16#01FD6#, 16#01FD7#),  -- (Ll)  GREEK SMALL LETTER IOTA WITH PERISPOMENI .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
+      (16#01FD8#, 16#01FDB#),  -- (Lu)  GREEK CAPITAL LETTER IOTA WITH VRACHY .. GREEK CAPITAL LETTER IOTA WITH OXIA
+      (16#01FDD#, 16#01FDF#),  -- (Sk)  GREEK DASIA AND VARIA .. GREEK DASIA AND PERISPOMENI
+      (16#01FE0#, 16#01FE7#),  -- (Ll)  GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
+      (16#01FE8#, 16#01FEC#),  -- (Lu)  GREEK CAPITAL LETTER UPSILON WITH VRACHY .. GREEK CAPITAL LETTER RHO WITH DASIA
+      (16#01FED#, 16#01FEF#),  -- (Sk)  GREEK DIALYTIKA AND VARIA .. GREEK VARIA
+      (16#01FF2#, 16#01FF4#),  -- (Ll)  GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
+      (16#01FF6#, 16#01FF7#),  -- (Ll)  GREEK SMALL LETTER OMEGA WITH PERISPOMENI .. GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
+      (16#01FF8#, 16#01FFB#),  -- (Lu)  GREEK CAPITAL LETTER OMICRON WITH VARIA .. GREEK CAPITAL LETTER OMEGA WITH OXIA
+      (16#01FFC#, 16#01FFC#),  -- (Lt)  GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
+      (16#01FFD#, 16#01FFE#),  -- (Sk)  GREEK OXIA .. GREEK DASIA
+      (16#02000#, 16#0200B#),  -- (Zs)  EN QUAD .. ZERO WIDTH SPACE
+      (16#0200C#, 16#0200F#),  -- (Cf)  ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK
+      (16#02010#, 16#02015#),  -- (Pd)  HYPHEN .. HORIZONTAL BAR
+      (16#02016#, 16#02017#),  -- (Po)  DOUBLE VERTICAL LINE .. DOUBLE LOW LINE
+      (16#02018#, 16#02018#),  -- (Pi)  LEFT SINGLE QUOTATION MARK .. LEFT SINGLE QUOTATION MARK
+      (16#02019#, 16#02019#),  -- (Pf)  RIGHT SINGLE QUOTATION MARK .. RIGHT SINGLE QUOTATION MARK
+      (16#0201A#, 16#0201A#),  -- (Ps)  SINGLE LOW-9 QUOTATION MARK .. SINGLE LOW-9 QUOTATION MARK
+      (16#0201B#, 16#0201C#),  -- (Pi)  SINGLE HIGH-REVERSED-9 QUOTATION MARK .. LEFT DOUBLE QUOTATION MARK
+      (16#0201D#, 16#0201D#),  -- (Pf)  RIGHT DOUBLE QUOTATION MARK .. RIGHT DOUBLE QUOTATION MARK
+      (16#0201E#, 16#0201E#),  -- (Ps)  DOUBLE LOW-9 QUOTATION MARK .. DOUBLE LOW-9 QUOTATION MARK
+      (16#0201F#, 16#0201F#),  -- (Pi)  DOUBLE HIGH-REVERSED-9 QUOTATION MARK .. DOUBLE HIGH-REVERSED-9 QUOTATION MARK
+      (16#02020#, 16#02027#),  -- (Po)  DAGGER .. HYPHENATION POINT
+      (16#02028#, 16#02028#),  -- (Zl)  LINE SEPARATOR .. LINE SEPARATOR
+      (16#02029#, 16#02029#),  -- (Zp)  PARAGRAPH SEPARATOR .. PARAGRAPH SEPARATOR
+      (16#0202A#, 16#0202E#),  -- (Cf)  LEFT-TO-RIGHT EMBEDDING .. RIGHT-TO-LEFT OVERRIDE
+      (16#0202F#, 16#0202F#),  -- (Zs)  NARROW NO-BREAK SPACE .. NARROW NO-BREAK SPACE
+      (16#02030#, 16#02038#),  -- (Po)  PER MILLE SIGN .. CARET
+      (16#02039#, 16#02039#),  -- (Pi)  SINGLE LEFT-POINTING ANGLE QUOTATION MARK .. SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+      (16#0203A#, 16#0203A#),  -- (Pf)  SINGLE RIGHT-POINTING ANGLE QUOTATION MARK .. SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+      (16#0203B#, 16#0203E#),  -- (Po)  REFERENCE MARK .. OVERLINE
+      (16#0203F#, 16#02040#),  -- (Pc)  UNDERTIE .. CHARACTER TIE
+      (16#02041#, 16#02043#),  -- (Po)  CARET INSERTION POINT .. HYPHEN BULLET
+      (16#02044#, 16#02044#),  -- (Sm)  FRACTION SLASH .. FRACTION SLASH
+      (16#02045#, 16#02045#),  -- (Ps)  LEFT SQUARE BRACKET WITH QUILL .. LEFT SQUARE BRACKET WITH QUILL
+      (16#02046#, 16#02046#),  -- (Pe)  RIGHT SQUARE BRACKET WITH QUILL .. RIGHT SQUARE BRACKET WITH QUILL
+      (16#02047#, 16#02051#),  -- (Po)  DOUBLE QUESTION MARK .. TWO ASTERISKS ALIGNED VERTICALLY
+      (16#02052#, 16#02052#),  -- (Sm)  COMMERCIAL MINUS SIGN .. COMMERCIAL MINUS SIGN
+      (16#02053#, 16#02053#),  -- (Po)  SWUNG DASH .. SWUNG DASH
+      (16#02054#, 16#02054#),  -- (Pc)  INVERTED UNDERTIE .. INVERTED UNDERTIE
+      (16#02057#, 16#02057#),  -- (Po)  QUADRUPLE PRIME .. QUADRUPLE PRIME
+      (16#0205F#, 16#0205F#),  -- (Zs)  MEDIUM MATHEMATICAL SPACE .. MEDIUM MATHEMATICAL SPACE
+      (16#02060#, 16#02063#),  -- (Cf)  WORD JOINER .. INVISIBLE SEPARATOR
+      (16#0206A#, 16#0206F#),  -- (Cf)  INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES
+      (16#02070#, 16#02070#),  -- (No)  SUPERSCRIPT ZERO .. SUPERSCRIPT ZERO
+      (16#02071#, 16#02071#),  -- (Ll)  SUPERSCRIPT LATIN SMALL LETTER I .. SUPERSCRIPT LATIN SMALL LETTER I
+      (16#02074#, 16#02079#),  -- (No)  SUPERSCRIPT FOUR .. SUPERSCRIPT NINE
+      (16#0207A#, 16#0207C#),  -- (Sm)  SUPERSCRIPT PLUS SIGN .. SUPERSCRIPT EQUALS SIGN
+      (16#0207D#, 16#0207D#),  -- (Ps)  SUPERSCRIPT LEFT PARENTHESIS .. SUPERSCRIPT LEFT PARENTHESIS
+      (16#0207E#, 16#0207E#),  -- (Pe)  SUPERSCRIPT RIGHT PARENTHESIS .. SUPERSCRIPT RIGHT PARENTHESIS
+      (16#0207F#, 16#0207F#),  -- (Ll)  SUPERSCRIPT LATIN SMALL LETTER N .. SUPERSCRIPT LATIN SMALL LETTER N
+      (16#02080#, 16#02089#),  -- (No)  SUBSCRIPT ZERO .. SUBSCRIPT NINE
+      (16#0208A#, 16#0208C#),  -- (Sm)  SUBSCRIPT PLUS SIGN .. SUBSCRIPT EQUALS SIGN
+      (16#0208D#, 16#0208D#),  -- (Ps)  SUBSCRIPT LEFT PARENTHESIS .. SUBSCRIPT LEFT PARENTHESIS
+      (16#0208E#, 16#0208E#),  -- (Pe)  SUBSCRIPT RIGHT PARENTHESIS .. SUBSCRIPT RIGHT PARENTHESIS
+      (16#020A0#, 16#020B1#),  -- (Sc)  EURO-CURRENCY SIGN .. PESO SIGN
+      (16#020D0#, 16#020DC#),  -- (Mn)  COMBINING LEFT HARPOON ABOVE .. COMBINING FOUR DOTS ABOVE
+      (16#020DD#, 16#020E0#),  -- (Me)  COMBINING ENCLOSING CIRCLE .. COMBINING ENCLOSING CIRCLE BACKSLASH
+      (16#020E1#, 16#020E1#),  -- (Mn)  COMBINING LEFT RIGHT ARROW ABOVE .. COMBINING LEFT RIGHT ARROW ABOVE
+      (16#020E2#, 16#020E4#),  -- (Me)  COMBINING ENCLOSING SCREEN .. COMBINING ENCLOSING UPWARD POINTING TRIANGLE
+      (16#020E5#, 16#020EA#),  -- (Mn)  COMBINING REVERSE SOLIDUS OVERLAY .. COMBINING LEFTWARDS ARROW OVERLAY
+      (16#02100#, 16#02101#),  -- (So)  ACCOUNT OF .. ADDRESSED TO THE SUBJECT
+      (16#02102#, 16#02102#),  -- (Lu)  DOUBLE-STRUCK CAPITAL C .. DOUBLE-STRUCK CAPITAL C
+      (16#02103#, 16#02106#),  -- (So)  DEGREE CELSIUS .. CADA UNA
+      (16#02107#, 16#02107#),  -- (Lu)  EULER CONSTANT .. EULER CONSTANT
+      (16#02108#, 16#02109#),  -- (So)  SCRUPLE .. DEGREE FAHRENHEIT
+      (16#0210A#, 16#0210A#),  -- (Ll)  SCRIPT SMALL G .. SCRIPT SMALL G
+      (16#0210B#, 16#0210D#),  -- (Lu)  SCRIPT CAPITAL H .. DOUBLE-STRUCK CAPITAL H
+      (16#0210E#, 16#0210F#),  -- (Ll)  PLANCK CONSTANT .. PLANCK CONSTANT OVER TWO PI
+      (16#02110#, 16#02112#),  -- (Lu)  SCRIPT CAPITAL I .. SCRIPT CAPITAL L
+      (16#02113#, 16#02113#),  -- (Ll)  SCRIPT SMALL L .. SCRIPT SMALL L
+      (16#02114#, 16#02114#),  -- (So)  L B BAR SYMBOL .. L B BAR SYMBOL
+      (16#02115#, 16#02115#),  -- (Lu)  DOUBLE-STRUCK CAPITAL N .. DOUBLE-STRUCK CAPITAL N
+      (16#02116#, 16#02118#),  -- (So)  NUMERO SIGN .. SCRIPT CAPITAL P
+      (16#02119#, 16#0211D#),  -- (Lu)  DOUBLE-STRUCK CAPITAL P .. DOUBLE-STRUCK CAPITAL R
+      (16#0211E#, 16#02123#),  -- (So)  PRESCRIPTION TAKE .. VERSICLE
+      (16#02124#, 16#02124#),  -- (Lu)  DOUBLE-STRUCK CAPITAL Z .. DOUBLE-STRUCK CAPITAL Z
+      (16#02125#, 16#02125#),  -- (So)  OUNCE SIGN .. OUNCE SIGN
+      (16#02126#, 16#02126#),  -- (Lu)  OHM SIGN .. OHM SIGN
+      (16#02127#, 16#02127#),  -- (So)  INVERTED OHM SIGN .. INVERTED OHM SIGN
+      (16#02128#, 16#02128#),  -- (Lu)  BLACK-LETTER CAPITAL Z .. BLACK-LETTER CAPITAL Z
+      (16#02129#, 16#02129#),  -- (So)  TURNED GREEK SMALL LETTER IOTA .. TURNED GREEK SMALL LETTER IOTA
+      (16#0212A#, 16#0212D#),  -- (Lu)  KELVIN SIGN .. BLACK-LETTER CAPITAL C
+      (16#0212E#, 16#0212E#),  -- (So)  ESTIMATED SYMBOL .. ESTIMATED SYMBOL
+      (16#0212F#, 16#0212F#),  -- (Ll)  SCRIPT SMALL E .. SCRIPT SMALL E
+      (16#02130#, 16#02131#),  -- (Lu)  SCRIPT CAPITAL E .. SCRIPT CAPITAL F
+      (16#02132#, 16#02132#),  -- (So)  TURNED CAPITAL F .. TURNED CAPITAL F
+      (16#02133#, 16#02133#),  -- (Lu)  SCRIPT CAPITAL M .. SCRIPT CAPITAL M
+      (16#02134#, 16#02134#),  -- (Ll)  SCRIPT SMALL O .. SCRIPT SMALL O
+      (16#02135#, 16#02138#),  -- (Lo)  ALEF SYMBOL .. DALET SYMBOL
+      (16#02139#, 16#02139#),  -- (Ll)  INFORMATION SOURCE .. INFORMATION SOURCE
+      (16#0213A#, 16#0213B#),  -- (So)  ROTATED CAPITAL Q .. FACSIMILE SIGN
+      (16#0213D#, 16#0213D#),  -- (Ll)  DOUBLE-STRUCK SMALL GAMMA .. DOUBLE-STRUCK SMALL GAMMA
+      (16#0213E#, 16#0213F#),  -- (Lu)  DOUBLE-STRUCK CAPITAL GAMMA .. DOUBLE-STRUCK CAPITAL PI
+      (16#02140#, 16#02144#),  -- (Sm)  DOUBLE-STRUCK N-ARY SUMMATION .. TURNED SANS-SERIF CAPITAL Y
+      (16#02145#, 16#02145#),  -- (Lu)  DOUBLE-STRUCK ITALIC CAPITAL D .. DOUBLE-STRUCK ITALIC CAPITAL D
+      (16#02146#, 16#02149#),  -- (Ll)  DOUBLE-STRUCK ITALIC SMALL D .. DOUBLE-STRUCK ITALIC SMALL J
+      (16#0214A#, 16#0214A#),  -- (So)  PROPERTY LINE .. PROPERTY LINE
+      (16#0214B#, 16#0214B#),  -- (Sm)  TURNED AMPERSAND .. TURNED AMPERSAND
+      (16#02153#, 16#0215F#),  -- (No)  VULGAR FRACTION ONE THIRD .. FRACTION NUMERATOR ONE
+      (16#02160#, 16#02183#),  -- (Nl)  ROMAN NUMERAL ONE .. ROMAN NUMERAL REVERSED ONE HUNDRED
+      (16#02190#, 16#02194#),  -- (Sm)  LEFTWARDS ARROW .. LEFT RIGHT ARROW
+      (16#02195#, 16#02199#),  -- (So)  UP DOWN ARROW .. SOUTH WEST ARROW
+      (16#0219A#, 16#0219B#),  -- (Sm)  LEFTWARDS ARROW WITH STROKE .. RIGHTWARDS ARROW WITH STROKE
+      (16#0219C#, 16#0219F#),  -- (So)  LEFTWARDS WAVE ARROW .. UPWARDS TWO HEADED ARROW
+      (16#021A0#, 16#021A0#),  -- (Sm)  RIGHTWARDS TWO HEADED ARROW .. RIGHTWARDS TWO HEADED ARROW
+      (16#021A1#, 16#021A2#),  -- (So)  DOWNWARDS TWO HEADED ARROW .. LEFTWARDS ARROW WITH TAIL
+      (16#021A3#, 16#021A3#),  -- (Sm)  RIGHTWARDS ARROW WITH TAIL .. RIGHTWARDS ARROW WITH TAIL
+      (16#021A4#, 16#021A5#),  -- (So)  LEFTWARDS ARROW FROM BAR .. UPWARDS ARROW FROM BAR
+      (16#021A6#, 16#021A6#),  -- (Sm)  RIGHTWARDS ARROW FROM BAR .. RIGHTWARDS ARROW FROM BAR
+      (16#021A7#, 16#021AD#),  -- (So)  DOWNWARDS ARROW FROM BAR .. LEFT RIGHT WAVE ARROW
+      (16#021AE#, 16#021AE#),  -- (Sm)  LEFT RIGHT ARROW WITH STROKE .. LEFT RIGHT ARROW WITH STROKE
+      (16#021AF#, 16#021CD#),  -- (So)  DOWNWARDS ZIGZAG ARROW .. LEFTWARDS DOUBLE ARROW WITH STROKE
+      (16#021CE#, 16#021CF#),  -- (Sm)  LEFT RIGHT DOUBLE ARROW WITH STROKE .. RIGHTWARDS DOUBLE ARROW WITH STROKE
+      (16#021D0#, 16#021D1#),  -- (So)  LEFTWARDS DOUBLE ARROW .. UPWARDS DOUBLE ARROW
+      (16#021D2#, 16#021D2#),  -- (Sm)  RIGHTWARDS DOUBLE ARROW .. RIGHTWARDS DOUBLE ARROW
+      (16#021D3#, 16#021D3#),  -- (So)  DOWNWARDS DOUBLE ARROW .. DOWNWARDS DOUBLE ARROW
+      (16#021D4#, 16#021D4#),  -- (Sm)  LEFT RIGHT DOUBLE ARROW .. LEFT RIGHT DOUBLE ARROW
+      (16#021D5#, 16#021F3#),  -- (So)  UP DOWN DOUBLE ARROW .. UP DOWN WHITE ARROW
+      (16#021F4#, 16#022FF#),  -- (Sm)  RIGHT ARROW WITH SMALL CIRCLE .. Z NOTATION BAG MEMBERSHIP
+      (16#02300#, 16#02307#),  -- (So)  DIAMETER SIGN .. WAVY LINE
+      (16#02308#, 16#0230B#),  -- (Sm)  LEFT CEILING .. RIGHT FLOOR
+      (16#0230C#, 16#0231F#),  -- (So)  BOTTOM RIGHT CROP .. BOTTOM RIGHT CORNER
+      (16#02320#, 16#02321#),  -- (Sm)  TOP HALF INTEGRAL .. BOTTOM HALF INTEGRAL
+      (16#02322#, 16#02328#),  -- (So)  FROWN .. KEYBOARD
+      (16#02329#, 16#02329#),  -- (Ps)  LEFT-POINTING ANGLE BRACKET .. LEFT-POINTING ANGLE BRACKET
+      (16#0232A#, 16#0232A#),  -- (Pe)  RIGHT-POINTING ANGLE BRACKET .. RIGHT-POINTING ANGLE BRACKET
+      (16#0232B#, 16#0237B#),  -- (So)  ERASE TO THE LEFT .. NOT CHECK MARK
+      (16#0237C#, 16#0237C#),  -- (Sm)  RIGHT ANGLE WITH DOWNWARDS ZIGZAG ARROW .. RIGHT ANGLE WITH DOWNWARDS ZIGZAG ARROW
+      (16#0237D#, 16#0239A#),  -- (So)  SHOULDERED OPEN BOX .. CLEAR SCREEN SYMBOL
+      (16#0239B#, 16#023B3#),  -- (Sm)  LEFT PARENTHESIS UPPER HOOK .. SUMMATION BOTTOM
+      (16#023B4#, 16#023B4#),  -- (Ps)  TOP SQUARE BRACKET .. TOP SQUARE BRACKET
+      (16#023B5#, 16#023B5#),  -- (Pe)  BOTTOM SQUARE BRACKET .. BOTTOM SQUARE BRACKET
+      (16#023B6#, 16#023B6#),  -- (Po)  BOTTOM SQUARE BRACKET OVER TOP SQUARE BRACKET .. BOTTOM SQUARE BRACKET OVER TOP SQUARE BRACKET
+      (16#023B7#, 16#023D0#),  -- (So)  RADICAL SYMBOL BOTTOM .. VERTICAL LINE EXTENSION
+      (16#02400#, 16#02426#),  -- (So)  SYMBOL FOR NULL .. SYMBOL FOR SUBSTITUTE FORM TWO
+      (16#02440#, 16#0244A#),  -- (So)  OCR HOOK .. OCR DOUBLE BACKSLASH
+      (16#02460#, 16#0249B#),  -- (No)  CIRCLED DIGIT ONE .. NUMBER TWENTY FULL STOP
+      (16#0249C#, 16#024E9#),  -- (So)  PARENTHESIZED LATIN SMALL LETTER A .. CIRCLED LATIN SMALL LETTER Z
+      (16#024EA#, 16#024FF#),  -- (No)  CIRCLED DIGIT ZERO .. NEGATIVE CIRCLED DIGIT ZERO
+      (16#02500#, 16#025B6#),  -- (So)  BOX DRAWINGS LIGHT HORIZONTAL .. BLACK RIGHT-POINTING TRIANGLE
+      (16#025B7#, 16#025B7#),  -- (Sm)  WHITE RIGHT-POINTING TRIANGLE .. WHITE RIGHT-POINTING TRIANGLE
+      (16#025B8#, 16#025C0#),  -- (So)  BLACK RIGHT-POINTING SMALL TRIANGLE .. BLACK LEFT-POINTING TRIANGLE
+      (16#025C1#, 16#025C1#),  -- (Sm)  WHITE LEFT-POINTING TRIANGLE .. WHITE LEFT-POINTING TRIANGLE
+      (16#025C2#, 16#025F7#),  -- (So)  BLACK LEFT-POINTING SMALL TRIANGLE .. WHITE CIRCLE WITH UPPER RIGHT QUADRANT
+      (16#025F8#, 16#025FF#),  -- (Sm)  UPPER LEFT TRIANGLE .. LOWER RIGHT TRIANGLE
+      (16#02600#, 16#02617#),  -- (So)  BLACK SUN WITH RAYS .. BLACK SHOGI PIECE
+      (16#02619#, 16#0266E#),  -- (So)  REVERSED ROTATED FLORAL HEART BULLET .. MUSIC NATURAL SIGN
+      (16#0266F#, 16#0266F#),  -- (Sm)  MUSIC SHARP SIGN .. MUSIC SHARP SIGN
+      (16#02670#, 16#0267D#),  -- (So)  WEST SYRIAC CROSS .. PARTIALLY-RECYCLED PAPER SYMBOL
+      (16#02680#, 16#02691#),  -- (So)  DIE FACE-1 .. BLACK FLAG
+      (16#026A0#, 16#026A1#),  -- (So)  WARNING SIGN .. HIGH VOLTAGE SIGN
+      (16#02701#, 16#02704#),  -- (So)  UPPER BLADE SCISSORS .. WHITE SCISSORS
+      (16#02706#, 16#02709#),  -- (So)  TELEPHONE LOCATION SIGN .. ENVELOPE
+      (16#0270C#, 16#02727#),  -- (So)  VICTORY HAND .. WHITE FOUR POINTED STAR
+      (16#02729#, 16#0274B#),  -- (So)  STRESS OUTLINED WHITE STAR .. HEAVY EIGHT TEARDROP-SPOKED PROPELLER ASTERISK
+      (16#0274D#, 16#0274D#),  -- (So)  SHADOWED WHITE CIRCLE .. SHADOWED WHITE CIRCLE
+      (16#0274F#, 16#02752#),  -- (So)  LOWER RIGHT DROP-SHADOWED WHITE SQUARE .. UPPER RIGHT SHADOWED WHITE SQUARE
+      (16#02756#, 16#02756#),  -- (So)  BLACK DIAMOND MINUS WHITE X .. BLACK DIAMOND MINUS WHITE X
+      (16#02758#, 16#0275E#),  -- (So)  LIGHT VERTICAL BAR .. HEAVY DOUBLE COMMA QUOTATION MARK ORNAMENT
+      (16#02761#, 16#02767#),  -- (So)  CURVED STEM PARAGRAPH SIGN ORNAMENT .. ROTATED FLORAL HEART BULLET
+      (16#02768#, 16#02768#),  -- (Ps)  MEDIUM LEFT PARENTHESIS ORNAMENT .. MEDIUM LEFT PARENTHESIS ORNAMENT
+      (16#02769#, 16#02769#),  -- (Pe)  MEDIUM RIGHT PARENTHESIS ORNAMENT .. MEDIUM RIGHT PARENTHESIS ORNAMENT
+      (16#0276A#, 16#0276A#),  -- (Ps)  MEDIUM FLATTENED LEFT PARENTHESIS ORNAMENT .. MEDIUM FLATTENED LEFT PARENTHESIS ORNAMENT
+      (16#0276B#, 16#0276B#),  -- (Pe)  MEDIUM FLATTENED RIGHT PARENTHESIS ORNAMENT .. MEDIUM FLATTENED RIGHT PARENTHESIS ORNAMENT
+      (16#0276C#, 16#0276C#),  -- (Ps)  MEDIUM LEFT-POINTING ANGLE BRACKET ORNAMENT .. MEDIUM LEFT-POINTING ANGLE BRACKET ORNAMENT
+      (16#0276D#, 16#0276D#),  -- (Pe)  MEDIUM RIGHT-POINTING ANGLE BRACKET ORNAMENT .. MEDIUM RIGHT-POINTING ANGLE BRACKET ORNAMENT
+      (16#0276E#, 16#0276E#),  -- (Ps)  HEAVY LEFT-POINTING ANGLE QUOTATION MARK ORNAMENT .. HEAVY LEFT-POINTING ANGLE QUOTATION MARK ORNAMENT
+      (16#0276F#, 16#0276F#),  -- (Pe)  HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT .. HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT
+      (16#02770#, 16#02770#),  -- (Ps)  HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT .. HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT
+      (16#02771#, 16#02771#),  -- (Pe)  HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT .. HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT
+      (16#02772#, 16#02772#),  -- (Ps)  LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT .. LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT
+      (16#02773#, 16#02773#),  -- (Pe)  LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT .. LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT
+      (16#02774#, 16#02774#),  -- (Ps)  MEDIUM LEFT CURLY BRACKET ORNAMENT .. MEDIUM LEFT CURLY BRACKET ORNAMENT
+      (16#02775#, 16#02775#),  -- (Pe)  MEDIUM RIGHT CURLY BRACKET ORNAMENT .. MEDIUM RIGHT CURLY BRACKET ORNAMENT
+      (16#02776#, 16#02793#),  -- (No)  DINGBAT NEGATIVE CIRCLED DIGIT ONE .. DINGBAT NEGATIVE CIRCLED SANS-SERIF NUMBER TEN
+      (16#02794#, 16#02794#),  -- (So)  HEAVY WIDE-HEADED RIGHTWARDS ARROW .. HEAVY WIDE-HEADED RIGHTWARDS ARROW
+      (16#02798#, 16#027AF#),  -- (So)  HEAVY SOUTH EAST ARROW .. NOTCHED LOWER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW
+      (16#027B1#, 16#027BE#),  -- (So)  NOTCHED UPPER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW .. OPEN-OUTLINED RIGHTWARDS ARROW
+      (16#027D0#, 16#027E5#),  -- (Sm)  WHITE DIAMOND WITH CENTRED DOT .. WHITE SQUARE WITH RIGHTWARDS TICK
+      (16#027E6#, 16#027E6#),  -- (Ps)  MATHEMATICAL LEFT WHITE SQUARE BRACKET .. MATHEMATICAL LEFT WHITE SQUARE BRACKET
+      (16#027E7#, 16#027E7#),  -- (Pe)  MATHEMATICAL RIGHT WHITE SQUARE BRACKET .. MATHEMATICAL RIGHT WHITE SQUARE BRACKET
+      (16#027E8#, 16#027E8#),  -- (Ps)  MATHEMATICAL LEFT ANGLE BRACKET .. MATHEMATICAL LEFT ANGLE BRACKET
+      (16#027E9#, 16#027E9#),  -- (Pe)  MATHEMATICAL RIGHT ANGLE BRACKET .. MATHEMATICAL RIGHT ANGLE BRACKET
+      (16#027EA#, 16#027EA#),  -- (Ps)  MATHEMATICAL LEFT DOUBLE ANGLE BRACKET .. MATHEMATICAL LEFT DOUBLE ANGLE BRACKET
+      (16#027EB#, 16#027EB#),  -- (Pe)  MATHEMATICAL RIGHT DOUBLE ANGLE BRACKET .. MATHEMATICAL RIGHT DOUBLE ANGLE BRACKET
+      (16#027F0#, 16#027FF#),  -- (Sm)  UPWARDS QUADRUPLE ARROW .. LONG RIGHTWARDS SQUIGGLE ARROW
+      (16#02800#, 16#028FF#),  -- (So)  BRAILLE PATTERN BLANK .. BRAILLE PATTERN DOTS-12345678
+      (16#02900#, 16#02982#),  -- (Sm)  RIGHTWARDS TWO-HEADED ARROW WITH VERTICAL STROKE .. Z NOTATION TYPE COLON
+      (16#02983#, 16#02983#),  -- (Ps)  LEFT WHITE CURLY BRACKET .. LEFT WHITE CURLY BRACKET
+      (16#02984#, 16#02984#),  -- (Pe)  RIGHT WHITE CURLY BRACKET .. RIGHT WHITE CURLY BRACKET
+      (16#02985#, 16#02985#),  -- (Ps)  LEFT WHITE PARENTHESIS .. LEFT WHITE PARENTHESIS
+      (16#02986#, 16#02986#),  -- (Pe)  RIGHT WHITE PARENTHESIS .. RIGHT WHITE PARENTHESIS
+      (16#02987#, 16#02987#),  -- (Ps)  Z NOTATION LEFT IMAGE BRACKET .. Z NOTATION LEFT IMAGE BRACKET
+      (16#02988#, 16#02988#),  -- (Pe)  Z NOTATION RIGHT IMAGE BRACKET .. Z NOTATION RIGHT IMAGE BRACKET
+      (16#02989#, 16#02989#),  -- (Ps)  Z NOTATION LEFT BINDING BRACKET .. Z NOTATION LEFT BINDING BRACKET
+      (16#0298A#, 16#0298A#),  -- (Pe)  Z NOTATION RIGHT BINDING BRACKET .. Z NOTATION RIGHT BINDING BRACKET
+      (16#0298B#, 16#0298B#),  -- (Ps)  LEFT SQUARE BRACKET WITH UNDERBAR .. LEFT SQUARE BRACKET WITH UNDERBAR
+      (16#0298C#, 16#0298C#),  -- (Pe)  RIGHT SQUARE BRACKET WITH UNDERBAR .. RIGHT SQUARE BRACKET WITH UNDERBAR
+      (16#0298D#, 16#0298D#),  -- (Ps)  LEFT SQUARE BRACKET WITH TICK IN TOP CORNER .. LEFT SQUARE BRACKET WITH TICK IN TOP CORNER
+      (16#0298E#, 16#0298E#),  -- (Pe)  RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER .. RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER
+      (16#0298F#, 16#0298F#),  -- (Ps)  LEFT SQUARE BRACKET WITH TICK IN BOTTOM CORNER .. LEFT SQUARE BRACKET WITH TICK IN BOTTOM CORNER
+      (16#02990#, 16#02990#),  -- (Pe)  RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER .. RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER
+      (16#02991#, 16#02991#),  -- (Ps)  LEFT ANGLE BRACKET WITH DOT .. LEFT ANGLE BRACKET WITH DOT
+      (16#02992#, 16#02992#),  -- (Pe)  RIGHT ANGLE BRACKET WITH DOT .. RIGHT ANGLE BRACKET WITH DOT
+      (16#02993#, 16#02993#),  -- (Ps)  LEFT ARC LESS-THAN BRACKET .. LEFT ARC LESS-THAN BRACKET
+      (16#02994#, 16#02994#),  -- (Pe)  RIGHT ARC GREATER-THAN BRACKET .. RIGHT ARC GREATER-THAN BRACKET
+      (16#02995#, 16#02995#),  -- (Ps)  DOUBLE LEFT ARC GREATER-THAN BRACKET .. DOUBLE LEFT ARC GREATER-THAN BRACKET
+      (16#02996#, 16#02996#),  -- (Pe)  DOUBLE RIGHT ARC LESS-THAN BRACKET .. DOUBLE RIGHT ARC LESS-THAN BRACKET
+      (16#02997#, 16#02997#),  -- (Ps)  LEFT BLACK TORTOISE SHELL BRACKET .. LEFT BLACK TORTOISE SHELL BRACKET
+      (16#02998#, 16#02998#),  -- (Pe)  RIGHT BLACK TORTOISE SHELL BRACKET .. RIGHT BLACK TORTOISE SHELL BRACKET
+      (16#02999#, 16#029D7#),  -- (Sm)  DOTTED FENCE .. BLACK HOURGLASS
+      (16#029D8#, 16#029D8#),  -- (Ps)  LEFT WIGGLY FENCE .. LEFT WIGGLY FENCE
+      (16#029D9#, 16#029D9#),  -- (Pe)  RIGHT WIGGLY FENCE .. RIGHT WIGGLY FENCE
+      (16#029DA#, 16#029DA#),  -- (Ps)  LEFT DOUBLE WIGGLY FENCE .. LEFT DOUBLE WIGGLY FENCE
+      (16#029DB#, 16#029DB#),  -- (Pe)  RIGHT DOUBLE WIGGLY FENCE .. RIGHT DOUBLE WIGGLY FENCE
+      (16#029DC#, 16#029FB#),  -- (Sm)  INCOMPLETE INFINITY .. TRIPLE PLUS
+      (16#029FC#, 16#029FC#),  -- (Ps)  LEFT-POINTING CURVED ANGLE BRACKET .. LEFT-POINTING CURVED ANGLE BRACKET
+      (16#029FD#, 16#029FD#),  -- (Pe)  RIGHT-POINTING CURVED ANGLE BRACKET .. RIGHT-POINTING CURVED ANGLE BRACKET
+      (16#029FE#, 16#02AFF#),  -- (Sm)  TINY .. N-ARY WHITE VERTICAL BAR
+      (16#02B00#, 16#02B0D#),  -- (So)  NORTH EAST WHITE ARROW .. UP DOWN BLACK ARROW
+      (16#02E80#, 16#02E99#),  -- (So)  CJK RADICAL REPEAT .. CJK RADICAL RAP
+      (16#02E9B#, 16#02EF3#),  -- (So)  CJK RADICAL CHOKE .. CJK RADICAL C-SIMPLIFIED TURTLE
+      (16#02F00#, 16#02FD5#),  -- (So)  KANGXI RADICAL ONE .. KANGXI RADICAL FLUTE
+      (16#02FF0#, 16#02FFB#),  -- (So)  IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT .. IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID
+      (16#03000#, 16#03000#),  -- (Zs)  IDEOGRAPHIC SPACE .. IDEOGRAPHIC SPACE
+      (16#03001#, 16#03003#),  -- (Po)  IDEOGRAPHIC COMMA .. DITTO MARK
+      (16#03004#, 16#03004#),  -- (So)  JAPANESE INDUSTRIAL STANDARD SYMBOL .. JAPANESE INDUSTRIAL STANDARD SYMBOL
+      (16#03005#, 16#03005#),  -- (Lm)  IDEOGRAPHIC ITERATION MARK .. IDEOGRAPHIC ITERATION MARK
+      (16#03006#, 16#03006#),  -- (Lo)  IDEOGRAPHIC CLOSING MARK .. IDEOGRAPHIC CLOSING MARK
+      (16#03007#, 16#03007#),  -- (Nl)  IDEOGRAPHIC NUMBER ZERO .. IDEOGRAPHIC NUMBER ZERO
+      (16#03008#, 16#03008#),  -- (Ps)  LEFT ANGLE BRACKET .. LEFT ANGLE BRACKET
+      (16#03009#, 16#03009#),  -- (Pe)  RIGHT ANGLE BRACKET .. RIGHT ANGLE BRACKET
+      (16#0300A#, 16#0300A#),  -- (Ps)  LEFT DOUBLE ANGLE BRACKET .. LEFT DOUBLE ANGLE BRACKET
+      (16#0300B#, 16#0300B#),  -- (Pe)  RIGHT DOUBLE ANGLE BRACKET .. RIGHT DOUBLE ANGLE BRACKET
+      (16#0300C#, 16#0300C#),  -- (Ps)  LEFT CORNER BRACKET .. LEFT CORNER BRACKET
+      (16#0300D#, 16#0300D#),  -- (Pe)  RIGHT CORNER BRACKET .. RIGHT CORNER BRACKET
+      (16#0300E#, 16#0300E#),  -- (Ps)  LEFT WHITE CORNER BRACKET .. LEFT WHITE CORNER BRACKET
+      (16#0300F#, 16#0300F#),  -- (Pe)  RIGHT WHITE CORNER BRACKET .. RIGHT WHITE CORNER BRACKET
+      (16#03010#, 16#03010#),  -- (Ps)  LEFT BLACK LENTICULAR BRACKET .. LEFT BLACK LENTICULAR BRACKET
+      (16#03011#, 16#03011#),  -- (Pe)  RIGHT BLACK LENTICULAR BRACKET .. RIGHT BLACK LENTICULAR BRACKET
+      (16#03012#, 16#03013#),  -- (So)  POSTAL MARK .. GETA MARK
+      (16#03014#, 16#03014#),  -- (Ps)  LEFT TORTOISE SHELL BRACKET .. LEFT TORTOISE SHELL BRACKET
+      (16#03015#, 16#03015#),  -- (Pe)  RIGHT TORTOISE SHELL BRACKET .. RIGHT TORTOISE SHELL BRACKET
+      (16#03016#, 16#03016#),  -- (Ps)  LEFT WHITE LENTICULAR BRACKET .. LEFT WHITE LENTICULAR BRACKET
+      (16#03017#, 16#03017#),  -- (Pe)  RIGHT WHITE LENTICULAR BRACKET .. RIGHT WHITE LENTICULAR BRACKET
+      (16#03018#, 16#03018#),  -- (Ps)  LEFT WHITE TORTOISE SHELL BRACKET .. LEFT WHITE TORTOISE SHELL BRACKET
+      (16#03019#, 16#03019#),  -- (Pe)  RIGHT WHITE TORTOISE SHELL BRACKET .. RIGHT WHITE TORTOISE SHELL BRACKET
+      (16#0301A#, 16#0301A#),  -- (Ps)  LEFT WHITE SQUARE BRACKET .. LEFT WHITE SQUARE BRACKET
+      (16#0301B#, 16#0301B#),  -- (Pe)  RIGHT WHITE SQUARE BRACKET .. RIGHT WHITE SQUARE BRACKET
+      (16#0301C#, 16#0301C#),  -- (Pd)  WAVE DASH .. WAVE DASH
+      (16#0301D#, 16#0301D#),  -- (Ps)  REVERSED DOUBLE PRIME QUOTATION MARK .. REVERSED DOUBLE PRIME QUOTATION MARK
+      (16#0301E#, 16#0301F#),  -- (Pe)  DOUBLE PRIME QUOTATION MARK .. LOW DOUBLE PRIME QUOTATION MARK
+      (16#03020#, 16#03020#),  -- (So)  POSTAL MARK FACE .. POSTAL MARK FACE
+      (16#03021#, 16#03029#),  -- (Nl)  HANGZHOU NUMERAL ONE .. HANGZHOU NUMERAL NINE
+      (16#0302A#, 16#0302F#),  -- (Mn)  IDEOGRAPHIC LEVEL TONE MARK .. HANGUL DOUBLE DOT TONE MARK
+      (16#03030#, 16#03030#),  -- (Pd)  WAVY DASH .. WAVY DASH
+      (16#03031#, 16#03035#),  -- (Lm)  VERTICAL KANA REPEAT MARK .. VERTICAL KANA REPEAT MARK LOWER HALF
+      (16#03036#, 16#03037#),  -- (So)  CIRCLED POSTAL MARK .. IDEOGRAPHIC TELEGRAPH LINE FEED SEPARATOR SYMBOL
+      (16#03038#, 16#0303A#),  -- (Nl)  HANGZHOU NUMERAL TEN .. HANGZHOU NUMERAL THIRTY
+      (16#0303B#, 16#0303B#),  -- (Lm)  VERTICAL IDEOGRAPHIC ITERATION MARK .. VERTICAL IDEOGRAPHIC ITERATION MARK
+      (16#0303C#, 16#0303C#),  -- (Lo)  MASU MARK .. MASU MARK
+      (16#0303D#, 16#0303D#),  -- (Po)  PART ALTERNATION MARK .. PART ALTERNATION MARK
+      (16#0303E#, 16#0303F#),  -- (So)  IDEOGRAPHIC VARIATION INDICATOR .. IDEOGRAPHIC HALF FILL SPACE
+      (16#03041#, 16#03096#),  -- (Lo)  HIRAGANA LETTER SMALL A .. HIRAGANA LETTER SMALL KE
+      (16#03099#, 16#0309A#),  -- (Mn)  COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK .. COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+      (16#0309B#, 16#0309C#),  -- (Sk)  KATAKANA-HIRAGANA VOICED SOUND MARK .. KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+      (16#0309D#, 16#0309E#),  -- (Lm)  HIRAGANA ITERATION MARK .. HIRAGANA VOICED ITERATION MARK
+      (16#0309F#, 16#0309F#),  -- (Lo)  HIRAGANA DIGRAPH YORI .. HIRAGANA DIGRAPH YORI
+      (16#030A0#, 16#030A0#),  -- (Pd)  KATAKANA-HIRAGANA DOUBLE HYPHEN .. KATAKANA-HIRAGANA DOUBLE HYPHEN
+      (16#030A1#, 16#030FA#),  -- (Lo)  KATAKANA LETTER SMALL A .. KATAKANA LETTER VO
+      (16#030FB#, 16#030FB#),  -- (Pc)  KATAKANA MIDDLE DOT .. KATAKANA MIDDLE DOT
+      (16#030FC#, 16#030FE#),  -- (Lm)  KATAKANA-HIRAGANA PROLONGED SOUND MARK .. KATAKANA VOICED ITERATION MARK
+      (16#030FF#, 16#030FF#),  -- (Lo)  KATAKANA DIGRAPH KOTO .. KATAKANA DIGRAPH KOTO
+      (16#03105#, 16#0312C#),  -- (Lo)  BOPOMOFO LETTER B .. BOPOMOFO LETTER GN
+      (16#03131#, 16#0318E#),  -- (Lo)  HANGUL LETTER KIYEOK .. HANGUL LETTER ARAEAE
+      (16#03190#, 16#03191#),  -- (So)  IDEOGRAPHIC ANNOTATION LINKING MARK .. IDEOGRAPHIC ANNOTATION REVERSE MARK
+      (16#03192#, 16#03195#),  -- (No)  IDEOGRAPHIC ANNOTATION ONE MARK .. IDEOGRAPHIC ANNOTATION FOUR MARK
+      (16#03196#, 16#0319F#),  -- (So)  IDEOGRAPHIC ANNOTATION TOP MARK .. IDEOGRAPHIC ANNOTATION MAN MARK
+      (16#031A0#, 16#031B7#),  -- (Lo)  BOPOMOFO LETTER BU .. BOPOMOFO FINAL LETTER H
+      (16#031F0#, 16#031FF#),  -- (Lo)  KATAKANA LETTER SMALL KU .. KATAKANA LETTER SMALL RO
+      (16#03200#, 16#0321E#),  -- (So)  PARENTHESIZED HANGUL KIYEOK .. PARENTHESIZED KOREAN CHARACTER O HU
+      (16#03220#, 16#03229#),  -- (No)  PARENTHESIZED IDEOGRAPH ONE .. PARENTHESIZED IDEOGRAPH TEN
+      (16#0322A#, 16#03243#),  -- (So)  PARENTHESIZED IDEOGRAPH MOON .. PARENTHESIZED IDEOGRAPH REACH
+      (16#03250#, 16#03250#),  -- (So)  PARTNERSHIP SIGN .. PARTNERSHIP SIGN
+      (16#03251#, 16#0325F#),  -- (No)  CIRCLED NUMBER TWENTY ONE .. CIRCLED NUMBER THIRTY FIVE
+      (16#03260#, 16#0327D#),  -- (So)  CIRCLED HANGUL KIYEOK .. CIRCLED KOREAN CHARACTER JUEUI
+      (16#0327F#, 16#0327F#),  -- (So)  KOREAN STANDARD SYMBOL .. KOREAN STANDARD SYMBOL
+      (16#03280#, 16#03289#),  -- (No)  CIRCLED IDEOGRAPH ONE .. CIRCLED IDEOGRAPH TEN
+      (16#0328A#, 16#032B0#),  -- (So)  CIRCLED IDEOGRAPH MOON .. CIRCLED IDEOGRAPH NIGHT
+      (16#032B1#, 16#032BF#),  -- (No)  CIRCLED NUMBER THIRTY SIX .. CIRCLED NUMBER FIFTY
+      (16#032C0#, 16#032FE#),  -- (So)  IDEOGRAPHIC TELEGRAPH SYMBOL FOR JANUARY .. CIRCLED KATAKANA WO
+      (16#03300#, 16#033FF#),  -- (So)  SQUARE APAATO .. SQUARE GAL
+      (16#03400#, 16#04DB5#),  -- (Lo)  <CJK Ideograph Extension A, First> .. <CJK Ideograph Extension A, Last>
+      (16#04DC0#, 16#04DFF#),  -- (So)  HEXAGRAM FOR THE CREATIVE HEAVEN .. HEXAGRAM FOR BEFORE COMPLETION
+      (16#04E00#, 16#09FA5#),  -- (Lo)  <CJK Ideograph, First> .. <CJK Ideograph, Last>
+      (16#0A000#, 16#0A48C#),  -- (Lo)  YI SYLLABLE IT .. YI SYLLABLE YYR
+      (16#0A490#, 16#0A4C6#),  -- (So)  YI RADICAL QOT .. YI RADICAL KE
+      (16#0AC00#, 16#0D7A3#),  -- (Lo)  <Hangul Syllable, First> .. <Hangul Syllable, Last>
+      (16#0D800#, 16#0F8FF#),  -- (Cs)  <Non Private Use High Surrogate, First> .. <Private Use, Last>
+      (16#0F900#, 16#0FA2D#),  -- (Lo)  CJK COMPATIBILITY IDEOGRAPH-F900 .. CJK COMPATIBILITY IDEOGRAPH-FA2D
+      (16#0FA30#, 16#0FA6A#),  -- (Lo)  CJK COMPATIBILITY IDEOGRAPH-FA30 .. CJK COMPATIBILITY IDEOGRAPH-FA6A
+      (16#0FB00#, 16#0FB06#),  -- (Ll)  LATIN SMALL LIGATURE FF .. LATIN SMALL LIGATURE ST
+      (16#0FB13#, 16#0FB17#),  -- (Ll)  ARMENIAN SMALL LIGATURE MEN NOW .. ARMENIAN SMALL LIGATURE MEN XEH
+      (16#0FB1D#, 16#0FB1D#),  -- (Lo)  HEBREW LETTER YOD WITH HIRIQ .. HEBREW LETTER YOD WITH HIRIQ
+      (16#0FB1E#, 16#0FB1E#),  -- (Mn)  HEBREW POINT JUDEO-SPANISH VARIKA .. HEBREW POINT JUDEO-SPANISH VARIKA
+      (16#0FB1F#, 16#0FB28#),  -- (Lo)  HEBREW LIGATURE YIDDISH YOD YOD PATAH .. HEBREW LETTER WIDE TAV
+      (16#0FB29#, 16#0FB29#),  -- (Sm)  HEBREW LETTER ALTERNATIVE PLUS SIGN .. HEBREW LETTER ALTERNATIVE PLUS SIGN
+      (16#0FB2A#, 16#0FB36#),  -- (Lo)  HEBREW LETTER SHIN WITH SHIN DOT .. HEBREW LETTER ZAYIN WITH DAGESH
+      (16#0FB38#, 16#0FB3C#),  -- (Lo)  HEBREW LETTER TET WITH DAGESH .. HEBREW LETTER LAMED WITH DAGESH
+      (16#0FB3E#, 16#0FB3E#),  -- (Lo)  HEBREW LETTER MEM WITH DAGESH .. HEBREW LETTER MEM WITH DAGESH
+      (16#0FB40#, 16#0FB41#),  -- (Lo)  HEBREW LETTER NUN WITH DAGESH .. HEBREW LETTER SAMEKH WITH DAGESH
+      (16#0FB43#, 16#0FB44#),  -- (Lo)  HEBREW LETTER FINAL PE WITH DAGESH .. HEBREW LETTER PE WITH DAGESH
+      (16#0FB46#, 16#0FBB1#),  -- (Lo)  HEBREW LETTER TSADI WITH DAGESH .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM
+      (16#0FBD3#, 16#0FD3D#),  -- (Lo)  ARABIC LETTER NG ISOLATED FORM .. ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM
+      (16#0FD3E#, 16#0FD3E#),  -- (Ps)  ORNATE LEFT PARENTHESIS .. ORNATE LEFT PARENTHESIS
+      (16#0FD3F#, 16#0FD3F#),  -- (Pe)  ORNATE RIGHT PARENTHESIS .. ORNATE RIGHT PARENTHESIS
+      (16#0FD50#, 16#0FD8F#),  -- (Lo)  ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM .. ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM
+      (16#0FD92#, 16#0FDC7#),  -- (Lo)  ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM .. ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM
+      (16#0FDF0#, 16#0FDFB#),  -- (Lo)  ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM .. ARABIC LIGATURE JALLAJALALOUHOU
+      (16#0FDFC#, 16#0FDFC#),  -- (Sc)  RIAL SIGN .. RIAL SIGN
+      (16#0FDFD#, 16#0FDFD#),  -- (So)  ARABIC LIGATURE BISMILLAH AR-RAHMAN AR-RAHEEM .. ARABIC LIGATURE BISMILLAH AR-RAHMAN AR-RAHEEM
+      (16#0FE00#, 16#0FE0F#),  -- (Mn)  VARIATION SELECTOR-1 .. VARIATION SELECTOR-16
+      (16#0FE20#, 16#0FE23#),  -- (Mn)  COMBINING LIGATURE LEFT HALF .. COMBINING DOUBLE TILDE RIGHT HALF
+      (16#0FE30#, 16#0FE30#),  -- (Po)  PRESENTATION FORM FOR VERTICAL TWO DOT LEADER .. PRESENTATION FORM FOR VERTICAL TWO DOT LEADER
+      (16#0FE31#, 16#0FE32#),  -- (Pd)  PRESENTATION FORM FOR VERTICAL EM DASH .. PRESENTATION FORM FOR VERTICAL EN DASH
+      (16#0FE33#, 16#0FE34#),  -- (Pc)  PRESENTATION FORM FOR VERTICAL LOW LINE .. PRESENTATION FORM FOR VERTICAL WAVY LOW LINE
+      (16#0FE35#, 16#0FE35#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS .. PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS
+      (16#0FE36#, 16#0FE36#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS .. PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS
+      (16#0FE37#, 16#0FE37#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET
+      (16#0FE38#, 16#0FE38#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET
+      (16#0FE39#, 16#0FE39#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT TORTOISE SHELL BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT TORTOISE SHELL BRACKET
+      (16#0FE3A#, 16#0FE3A#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT TORTOISE SHELL BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT TORTOISE SHELL BRACKET
+      (16#0FE3B#, 16#0FE3B#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT BLACK LENTICULAR BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT BLACK LENTICULAR BRACKET
+      (16#0FE3C#, 16#0FE3C#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT BLACK LENTICULAR BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT BLACK LENTICULAR BRACKET
+      (16#0FE3D#, 16#0FE3D#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT DOUBLE ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT DOUBLE ANGLE BRACKET
+      (16#0FE3E#, 16#0FE3E#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT DOUBLE ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT DOUBLE ANGLE BRACKET
+      (16#0FE3F#, 16#0FE3F#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT ANGLE BRACKET
+      (16#0FE40#, 16#0FE40#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT ANGLE BRACKET
+      (16#0FE41#, 16#0FE41#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT CORNER BRACKET
+      (16#0FE42#, 16#0FE42#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT CORNER BRACKET
+      (16#0FE43#, 16#0FE43#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT WHITE CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT WHITE CORNER BRACKET
+      (16#0FE44#, 16#0FE44#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT WHITE CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT WHITE CORNER BRACKET
+      (16#0FE45#, 16#0FE46#),  -- (Po)  SESAME DOT .. WHITE SESAME DOT
+      (16#0FE47#, 16#0FE47#),  -- (Ps)  PRESENTATION FORM FOR VERTICAL LEFT SQUARE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT SQUARE BRACKET
+      (16#0FE48#, 16#0FE48#),  -- (Pe)  PRESENTATION FORM FOR VERTICAL RIGHT SQUARE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT SQUARE BRACKET
+      (16#0FE49#, 16#0FE4C#),  -- (Po)  DASHED OVERLINE .. DOUBLE WAVY OVERLINE
+      (16#0FE4D#, 16#0FE4F#),  -- (Pc)  DASHED LOW LINE .. WAVY LOW LINE
+      (16#0FE50#, 16#0FE52#),  -- (Po)  SMALL COMMA .. SMALL FULL STOP
+      (16#0FE54#, 16#0FE57#),  -- (Po)  SMALL SEMICOLON .. SMALL EXCLAMATION MARK
+      (16#0FE58#, 16#0FE58#),  -- (Pd)  SMALL EM DASH .. SMALL EM DASH
+      (16#0FE59#, 16#0FE59#),  -- (Ps)  SMALL LEFT PARENTHESIS .. SMALL LEFT PARENTHESIS
+      (16#0FE5A#, 16#0FE5A#),  -- (Pe)  SMALL RIGHT PARENTHESIS .. SMALL RIGHT PARENTHESIS
+      (16#0FE5B#, 16#0FE5B#),  -- (Ps)  SMALL LEFT CURLY BRACKET .. SMALL LEFT CURLY BRACKET
+      (16#0FE5C#, 16#0FE5C#),  -- (Pe)  SMALL RIGHT CURLY BRACKET .. SMALL RIGHT CURLY BRACKET
+      (16#0FE5D#, 16#0FE5D#),  -- (Ps)  SMALL LEFT TORTOISE SHELL BRACKET .. SMALL LEFT TORTOISE SHELL BRACKET
+      (16#0FE5E#, 16#0FE5E#),  -- (Pe)  SMALL RIGHT TORTOISE SHELL BRACKET .. SMALL RIGHT TORTOISE SHELL BRACKET
+      (16#0FE5F#, 16#0FE61#),  -- (Po)  SMALL NUMBER SIGN .. SMALL ASTERISK
+      (16#0FE62#, 16#0FE62#),  -- (Sm)  SMALL PLUS SIGN .. SMALL PLUS SIGN
+      (16#0FE63#, 16#0FE63#),  -- (Pd)  SMALL HYPHEN-MINUS .. SMALL HYPHEN-MINUS
+      (16#0FE64#, 16#0FE66#),  -- (Sm)  SMALL LESS-THAN SIGN .. SMALL EQUALS SIGN
+      (16#0FE68#, 16#0FE68#),  -- (Po)  SMALL REVERSE SOLIDUS .. SMALL REVERSE SOLIDUS
+      (16#0FE69#, 16#0FE69#),  -- (Sc)  SMALL DOLLAR SIGN .. SMALL DOLLAR SIGN
+      (16#0FE6A#, 16#0FE6B#),  -- (Po)  SMALL PERCENT SIGN .. SMALL COMMERCIAL AT
+      (16#0FE70#, 16#0FE74#),  -- (Lo)  ARABIC FATHATAN ISOLATED FORM .. ARABIC KASRATAN ISOLATED FORM
+      (16#0FE76#, 16#0FEFC#),  -- (Lo)  ARABIC FATHA ISOLATED FORM .. ARABIC LIGATURE LAM WITH ALEF FINAL FORM
+      (16#0FEFF#, 16#0FEFF#),  -- (Cf)  ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE
+      (16#0FF01#, 16#0FF03#),  -- (Po)  FULLWIDTH EXCLAMATION MARK .. FULLWIDTH NUMBER SIGN
+      (16#0FF04#, 16#0FF04#),  -- (Sc)  FULLWIDTH DOLLAR SIGN .. FULLWIDTH DOLLAR SIGN
+      (16#0FF05#, 16#0FF07#),  -- (Po)  FULLWIDTH PERCENT SIGN .. FULLWIDTH APOSTROPHE
+      (16#0FF08#, 16#0FF08#),  -- (Ps)  FULLWIDTH LEFT PARENTHESIS .. FULLWIDTH LEFT PARENTHESIS
+      (16#0FF09#, 16#0FF09#),  -- (Pe)  FULLWIDTH RIGHT PARENTHESIS .. FULLWIDTH RIGHT PARENTHESIS
+      (16#0FF0A#, 16#0FF0A#),  -- (Po)  FULLWIDTH ASTERISK .. FULLWIDTH ASTERISK
+      (16#0FF0B#, 16#0FF0B#),  -- (Sm)  FULLWIDTH PLUS SIGN .. FULLWIDTH PLUS SIGN
+      (16#0FF0C#, 16#0FF0C#),  -- (Po)  FULLWIDTH COMMA .. FULLWIDTH COMMA
+      (16#0FF0D#, 16#0FF0D#),  -- (Pd)  FULLWIDTH HYPHEN-MINUS .. FULLWIDTH HYPHEN-MINUS
+      (16#0FF0E#, 16#0FF0F#),  -- (Po)  FULLWIDTH FULL STOP .. FULLWIDTH SOLIDUS
+      (16#0FF10#, 16#0FF19#),  -- (Nd)  FULLWIDTH DIGIT ZERO .. FULLWIDTH DIGIT NINE
+      (16#0FF1A#, 16#0FF1B#),  -- (Po)  FULLWIDTH COLON .. FULLWIDTH SEMICOLON
+      (16#0FF1C#, 16#0FF1E#),  -- (Sm)  FULLWIDTH LESS-THAN SIGN .. FULLWIDTH GREATER-THAN SIGN
+      (16#0FF1F#, 16#0FF20#),  -- (Po)  FULLWIDTH QUESTION MARK .. FULLWIDTH COMMERCIAL AT
+      (16#0FF21#, 16#0FF3A#),  -- (Lu)  FULLWIDTH LATIN CAPITAL LETTER A .. FULLWIDTH LATIN CAPITAL LETTER Z
+      (16#0FF3B#, 16#0FF3B#),  -- (Ps)  FULLWIDTH LEFT SQUARE BRACKET .. FULLWIDTH LEFT SQUARE BRACKET
+      (16#0FF3C#, 16#0FF3C#),  -- (Po)  FULLWIDTH REVERSE SOLIDUS .. FULLWIDTH REVERSE SOLIDUS
+      (16#0FF3D#, 16#0FF3D#),  -- (Pe)  FULLWIDTH RIGHT SQUARE BRACKET .. FULLWIDTH RIGHT SQUARE BRACKET
+      (16#0FF3E#, 16#0FF3E#),  -- (Sk)  FULLWIDTH CIRCUMFLEX ACCENT .. FULLWIDTH CIRCUMFLEX ACCENT
+      (16#0FF3F#, 16#0FF3F#),  -- (Pc)  FULLWIDTH LOW LINE .. FULLWIDTH LOW LINE
+      (16#0FF40#, 16#0FF40#),  -- (Sk)  FULLWIDTH GRAVE ACCENT .. FULLWIDTH GRAVE ACCENT
+      (16#0FF41#, 16#0FF5A#),  -- (Ll)  FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
+      (16#0FF5B#, 16#0FF5B#),  -- (Ps)  FULLWIDTH LEFT CURLY BRACKET .. FULLWIDTH LEFT CURLY BRACKET
+      (16#0FF5C#, 16#0FF5C#),  -- (Sm)  FULLWIDTH VERTICAL LINE .. FULLWIDTH VERTICAL LINE
+      (16#0FF5D#, 16#0FF5D#),  -- (Pe)  FULLWIDTH RIGHT CURLY BRACKET .. FULLWIDTH RIGHT CURLY BRACKET
+      (16#0FF5E#, 16#0FF5E#),  -- (Sm)  FULLWIDTH TILDE .. FULLWIDTH TILDE
+      (16#0FF5F#, 16#0FF5F#),  -- (Ps)  FULLWIDTH LEFT WHITE PARENTHESIS .. FULLWIDTH LEFT WHITE PARENTHESIS
+      (16#0FF60#, 16#0FF60#),  -- (Pe)  FULLWIDTH RIGHT WHITE PARENTHESIS .. FULLWIDTH RIGHT WHITE PARENTHESIS
+      (16#0FF61#, 16#0FF61#),  -- (Po)  HALFWIDTH IDEOGRAPHIC FULL STOP .. HALFWIDTH IDEOGRAPHIC FULL STOP
+      (16#0FF62#, 16#0FF62#),  -- (Ps)  HALFWIDTH LEFT CORNER BRACKET .. HALFWIDTH LEFT CORNER BRACKET
+      (16#0FF63#, 16#0FF63#),  -- (Pe)  HALFWIDTH RIGHT CORNER BRACKET .. HALFWIDTH RIGHT CORNER BRACKET
+      (16#0FF64#, 16#0FF64#),  -- (Po)  HALFWIDTH IDEOGRAPHIC COMMA .. HALFWIDTH IDEOGRAPHIC COMMA
+      (16#0FF65#, 16#0FF65#),  -- (Pc)  HALFWIDTH KATAKANA MIDDLE DOT .. HALFWIDTH KATAKANA MIDDLE DOT
+      (16#0FF66#, 16#0FF6F#),  -- (Lo)  HALFWIDTH KATAKANA LETTER WO .. HALFWIDTH KATAKANA LETTER SMALL TU
+      (16#0FF70#, 16#0FF70#),  -- (Lm)  HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK .. HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK
+      (16#0FF71#, 16#0FF9D#),  -- (Lo)  HALFWIDTH KATAKANA LETTER A .. HALFWIDTH KATAKANA LETTER N
+      (16#0FF9E#, 16#0FF9F#),  -- (Lm)  HALFWIDTH KATAKANA VOICED SOUND MARK .. HALFWIDTH KATAKANA SEMI-VOICED SOUND MARK
+      (16#0FFA0#, 16#0FFBE#),  -- (Lo)  HALFWIDTH HANGUL FILLER .. HALFWIDTH HANGUL LETTER HIEUH
+      (16#0FFC2#, 16#0FFC7#),  -- (Lo)  HALFWIDTH HANGUL LETTER A .. HALFWIDTH HANGUL LETTER E
+      (16#0FFCA#, 16#0FFCF#),  -- (Lo)  HALFWIDTH HANGUL LETTER YEO .. HALFWIDTH HANGUL LETTER OE
+      (16#0FFD2#, 16#0FFD7#),  -- (Lo)  HALFWIDTH HANGUL LETTER YO .. HALFWIDTH HANGUL LETTER YU
+      (16#0FFDA#, 16#0FFDC#),  -- (Lo)  HALFWIDTH HANGUL LETTER EU .. HALFWIDTH HANGUL LETTER I
+      (16#0FFE0#, 16#0FFE1#),  -- (Sc)  FULLWIDTH CENT SIGN .. FULLWIDTH POUND SIGN
+      (16#0FFE2#, 16#0FFE2#),  -- (Sm)  FULLWIDTH NOT SIGN .. FULLWIDTH NOT SIGN
+      (16#0FFE3#, 16#0FFE3#),  -- (Sk)  FULLWIDTH MACRON .. FULLWIDTH MACRON
+      (16#0FFE4#, 16#0FFE4#),  -- (So)  FULLWIDTH BROKEN BAR .. FULLWIDTH BROKEN BAR
+      (16#0FFE5#, 16#0FFE6#),  -- (Sc)  FULLWIDTH YEN SIGN .. FULLWIDTH WON SIGN
+      (16#0FFE8#, 16#0FFE8#),  -- (So)  HALFWIDTH FORMS LIGHT VERTICAL .. HALFWIDTH FORMS LIGHT VERTICAL
+      (16#0FFE9#, 16#0FFEC#),  -- (Sm)  HALFWIDTH LEFTWARDS ARROW .. HALFWIDTH DOWNWARDS ARROW
+      (16#0FFED#, 16#0FFEE#),  -- (So)  HALFWIDTH BLACK SQUARE .. HALFWIDTH WHITE CIRCLE
+      (16#0FFF9#, 16#0FFFB#),  -- (Cf)  INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR
+      (16#0FFFC#, 16#0FFFD#),  -- (So)  OBJECT REPLACEMENT CHARACTER .. REPLACEMENT CHARACTER
+      (16#10000#, 16#1000B#),  -- (Lo)  LINEAR B SYLLABLE B008 A .. LINEAR B SYLLABLE B046 JE
+      (16#1000D#, 16#10026#),  -- (Lo)  LINEAR B SYLLABLE B036 JO .. LINEAR B SYLLABLE B032 QO
+      (16#10028#, 16#1003A#),  -- (Lo)  LINEAR B SYLLABLE B060 RA .. LINEAR B SYLLABLE B042 WO
+      (16#1003C#, 16#1003D#),  -- (Lo)  LINEAR B SYLLABLE B017 ZA .. LINEAR B SYLLABLE B074 ZE
+      (16#1003F#, 16#1004D#),  -- (Lo)  LINEAR B SYLLABLE B020 ZO .. LINEAR B SYLLABLE B091 TWO
+      (16#10050#, 16#1005D#),  -- (Lo)  LINEAR B SYMBOL B018 .. LINEAR B SYMBOL B089
+      (16#10080#, 16#100FA#),  -- (Lo)  LINEAR B IDEOGRAM B100 MAN .. LINEAR B IDEOGRAM VESSEL B305
+      (16#10100#, 16#10101#),  -- (Po)  AEGEAN WORD SEPARATOR LINE .. AEGEAN WORD SEPARATOR DOT
+      (16#10102#, 16#10102#),  -- (So)  AEGEAN CHECK MARK .. AEGEAN CHECK MARK
+      (16#10107#, 16#10133#),  -- (No)  AEGEAN NUMBER ONE .. AEGEAN NUMBER NINETY THOUSAND
+      (16#10137#, 16#1013F#),  -- (So)  AEGEAN WEIGHT BASE UNIT .. AEGEAN MEASURE THIRD SUBUNIT
+      (16#10300#, 16#1031E#),  -- (Lo)  OLD ITALIC LETTER A .. OLD ITALIC LETTER UU
+      (16#10320#, 16#10323#),  -- (No)  OLD ITALIC NUMERAL ONE .. OLD ITALIC NUMERAL FIFTY
+      (16#10330#, 16#10349#),  -- (Lo)  GOTHIC LETTER AHSA .. GOTHIC LETTER OTHAL
+      (16#1034A#, 16#1034A#),  -- (Nl)  GOTHIC LETTER NINE HUNDRED .. GOTHIC LETTER NINE HUNDRED
+      (16#10380#, 16#1039D#),  -- (Lo)  UGARITIC LETTER ALPA .. UGARITIC LETTER SSU
+      (16#1039F#, 16#1039F#),  -- (Po)  UGARITIC WORD DIVIDER .. UGARITIC WORD DIVIDER
+      (16#10400#, 16#10427#),  -- (Lu)  DESERET CAPITAL LETTER LONG I .. DESERET CAPITAL LETTER EW
+      (16#10428#, 16#1044F#),  -- (Ll)  DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER EW
+      (16#10450#, 16#1049D#),  -- (Lo)  SHAVIAN LETTER PEEP .. OSMANYA LETTER OO
+      (16#104A0#, 16#104A9#),  -- (Nd)  OSMANYA DIGIT ZERO .. OSMANYA DIGIT NINE
+      (16#10800#, 16#10805#),  -- (Lo)  CYPRIOT SYLLABLE A .. CYPRIOT SYLLABLE JA
+      (16#10808#, 16#10808#),  -- (Lo)  CYPRIOT SYLLABLE JO .. CYPRIOT SYLLABLE JO
+      (16#1080A#, 16#10835#),  -- (Lo)  CYPRIOT SYLLABLE KA .. CYPRIOT SYLLABLE WO
+      (16#10837#, 16#10838#),  -- (Lo)  CYPRIOT SYLLABLE XA .. CYPRIOT SYLLABLE XE
+      (16#1083C#, 16#1083C#),  -- (Lo)  CYPRIOT SYLLABLE ZA .. CYPRIOT SYLLABLE ZA
+      (16#1083F#, 16#1083F#),  -- (Lo)  CYPRIOT SYLLABLE ZO .. CYPRIOT SYLLABLE ZO
+      (16#1D000#, 16#1D0F5#),  -- (So)  BYZANTINE MUSICAL SYMBOL PSILI .. BYZANTINE MUSICAL SYMBOL GORGON NEO KATO
+      (16#1D100#, 16#1D126#),  -- (So)  MUSICAL SYMBOL SINGLE BARLINE .. MUSICAL SYMBOL DRUM CLEF-2
+      (16#1D12A#, 16#1D164#),  -- (So)  MUSICAL SYMBOL DOUBLE SHARP .. MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH NOTE
+      (16#1D165#, 16#1D166#),  -- (Mc)  MUSICAL SYMBOL COMBINING STEM .. MUSICAL SYMBOL COMBINING SPRECHGESANG STEM
+      (16#1D167#, 16#1D169#),  -- (Mn)  MUSICAL SYMBOL COMBINING TREMOLO-1 .. MUSICAL SYMBOL COMBINING TREMOLO-3
+      (16#1D16A#, 16#1D16C#),  -- (So)  MUSICAL SYMBOL FINGERED TREMOLO-1 .. MUSICAL SYMBOL FINGERED TREMOLO-3
+      (16#1D16D#, 16#1D172#),  -- (Mc)  MUSICAL SYMBOL COMBINING AUGMENTATION DOT .. MUSICAL SYMBOL COMBINING FLAG-5
+      (16#1D173#, 16#1D17A#),  -- (Cf)  MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE
+      (16#1D17B#, 16#1D182#),  -- (Mn)  MUSICAL SYMBOL COMBINING ACCENT .. MUSICAL SYMBOL COMBINING LOURE
+      (16#1D183#, 16#1D184#),  -- (So)  MUSICAL SYMBOL ARPEGGIATO UP .. MUSICAL SYMBOL ARPEGGIATO DOWN
+      (16#1D185#, 16#1D18B#),  -- (Mn)  MUSICAL SYMBOL COMBINING DOIT .. MUSICAL SYMBOL COMBINING TRIPLE TONGUE
+      (16#1D18C#, 16#1D1A9#),  -- (So)  MUSICAL SYMBOL RINFORZANDO .. MUSICAL SYMBOL DEGREE SLASH
+      (16#1D1AA#, 16#1D1AD#),  -- (Mn)  MUSICAL SYMBOL COMBINING DOWN BOW .. MUSICAL SYMBOL COMBINING SNAP PIZZICATO
+      (16#1D1AE#, 16#1D1DD#),  -- (So)  MUSICAL SYMBOL PEDAL MARK .. MUSICAL SYMBOL PES SUBPUNCTIS
+      (16#1D300#, 16#1D356#),  -- (So)  MONOGRAM FOR EARTH .. TETRAGRAM FOR FOSTERING
+      (16#1D400#, 16#1D419#),  -- (Lu)  MATHEMATICAL BOLD CAPITAL A .. MATHEMATICAL BOLD CAPITAL Z
+      (16#1D41A#, 16#1D433#),  -- (Ll)  MATHEMATICAL BOLD SMALL A .. MATHEMATICAL BOLD SMALL Z
+      (16#1D434#, 16#1D44D#),  -- (Lu)  MATHEMATICAL ITALIC CAPITAL A .. MATHEMATICAL ITALIC CAPITAL Z
+      (16#1D44E#, 16#1D454#),  -- (Ll)  MATHEMATICAL ITALIC SMALL A .. MATHEMATICAL ITALIC SMALL G
+      (16#1D456#, 16#1D467#),  -- (Ll)  MATHEMATICAL ITALIC SMALL I .. MATHEMATICAL ITALIC SMALL Z
+      (16#1D468#, 16#1D481#),  -- (Lu)  MATHEMATICAL BOLD ITALIC CAPITAL A .. MATHEMATICAL BOLD ITALIC CAPITAL Z
+      (16#1D482#, 16#1D49B#),  -- (Ll)  MATHEMATICAL BOLD ITALIC SMALL A .. MATHEMATICAL BOLD ITALIC SMALL Z
+      (16#1D49C#, 16#1D49C#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL A .. MATHEMATICAL SCRIPT CAPITAL A
+      (16#1D49E#, 16#1D49F#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL C .. MATHEMATICAL SCRIPT CAPITAL D
+      (16#1D4A2#, 16#1D4A2#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL G .. MATHEMATICAL SCRIPT CAPITAL G
+      (16#1D4A5#, 16#1D4A6#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL J .. MATHEMATICAL SCRIPT CAPITAL K
+      (16#1D4A9#, 16#1D4AC#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL N .. MATHEMATICAL SCRIPT CAPITAL Q
+      (16#1D4AE#, 16#1D4B5#),  -- (Lu)  MATHEMATICAL SCRIPT CAPITAL S .. MATHEMATICAL SCRIPT CAPITAL Z
+      (16#1D4B6#, 16#1D4B9#),  -- (Ll)  MATHEMATICAL SCRIPT SMALL A .. MATHEMATICAL SCRIPT SMALL D
+      (16#1D4BB#, 16#1D4BB#),  -- (Ll)  MATHEMATICAL SCRIPT SMALL F .. MATHEMATICAL SCRIPT SMALL F
+      (16#1D4BD#, 16#1D4C3#),  -- (Ll)  MATHEMATICAL SCRIPT SMALL H .. MATHEMATICAL SCRIPT SMALL N
+      (16#1D4C5#, 16#1D4CF#),  -- (Ll)  MATHEMATICAL SCRIPT SMALL P .. MATHEMATICAL SCRIPT SMALL Z
+      (16#1D4D0#, 16#1D4E9#),  -- (Lu)  MATHEMATICAL BOLD SCRIPT CAPITAL A .. MATHEMATICAL BOLD SCRIPT CAPITAL Z
+      (16#1D4EA#, 16#1D503#),  -- (Ll)  MATHEMATICAL BOLD SCRIPT SMALL A .. MATHEMATICAL BOLD SCRIPT SMALL Z
+      (16#1D504#, 16#1D505#),  -- (Lu)  MATHEMATICAL FRAKTUR CAPITAL A .. MATHEMATICAL FRAKTUR CAPITAL B
+      (16#1D507#, 16#1D50A#),  -- (Lu)  MATHEMATICAL FRAKTUR CAPITAL D .. MATHEMATICAL FRAKTUR CAPITAL G
+      (16#1D50D#, 16#1D514#),  -- (Lu)  MATHEMATICAL FRAKTUR CAPITAL J .. MATHEMATICAL FRAKTUR CAPITAL Q
+      (16#1D516#, 16#1D51C#),  -- (Lu)  MATHEMATICAL FRAKTUR CAPITAL S .. MATHEMATICAL FRAKTUR CAPITAL Y
+      (16#1D51E#, 16#1D537#),  -- (Ll)  MATHEMATICAL FRAKTUR SMALL A .. MATHEMATICAL FRAKTUR SMALL Z
+      (16#1D538#, 16#1D539#),  -- (Lu)  MATHEMATICAL DOUBLE-STRUCK CAPITAL A .. MATHEMATICAL DOUBLE-STRUCK CAPITAL B
+      (16#1D53B#, 16#1D53E#),  -- (Lu)  MATHEMATICAL DOUBLE-STRUCK CAPITAL D .. MATHEMATICAL DOUBLE-STRUCK CAPITAL G
+      (16#1D540#, 16#1D544#),  -- (Lu)  MATHEMATICAL DOUBLE-STRUCK CAPITAL I .. MATHEMATICAL DOUBLE-STRUCK CAPITAL M
+      (16#1D546#, 16#1D546#),  -- (Lu)  MATHEMATICAL DOUBLE-STRUCK CAPITAL O .. MATHEMATICAL DOUBLE-STRUCK CAPITAL O
+      (16#1D54A#, 16#1D550#),  -- (Lu)  MATHEMATICAL DOUBLE-STRUCK CAPITAL S .. MATHEMATICAL DOUBLE-STRUCK CAPITAL Y
+      (16#1D552#, 16#1D56B#),  -- (Ll)  MATHEMATICAL DOUBLE-STRUCK SMALL A .. MATHEMATICAL DOUBLE-STRUCK SMALL Z
+      (16#1D56C#, 16#1D585#),  -- (Lu)  MATHEMATICAL BOLD FRAKTUR CAPITAL A .. MATHEMATICAL BOLD FRAKTUR CAPITAL Z
+      (16#1D586#, 16#1D59F#),  -- (Ll)  MATHEMATICAL BOLD FRAKTUR SMALL A .. MATHEMATICAL BOLD FRAKTUR SMALL Z
+      (16#1D5A0#, 16#1D5B9#),  -- (Lu)  MATHEMATICAL SANS-SERIF CAPITAL A .. MATHEMATICAL SANS-SERIF CAPITAL Z
+      (16#1D5BA#, 16#1D5D3#),  -- (Ll)  MATHEMATICAL SANS-SERIF SMALL A .. MATHEMATICAL SANS-SERIF SMALL Z
+      (16#1D5D4#, 16#1D5ED#),  -- (Lu)  MATHEMATICAL SANS-SERIF BOLD CAPITAL A .. MATHEMATICAL SANS-SERIF BOLD CAPITAL Z
+      (16#1D5EE#, 16#1D607#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD SMALL A .. MATHEMATICAL SANS-SERIF BOLD SMALL Z
+      (16#1D608#, 16#1D621#),  -- (Lu)  MATHEMATICAL SANS-SERIF ITALIC CAPITAL A .. MATHEMATICAL SANS-SERIF ITALIC CAPITAL Z
+      (16#1D622#, 16#1D63B#),  -- (Ll)  MATHEMATICAL SANS-SERIF ITALIC SMALL A .. MATHEMATICAL SANS-SERIF ITALIC SMALL Z
+      (16#1D63C#, 16#1D655#),  -- (Lu)  MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL A .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL Z
+      (16#1D656#, 16#1D66F#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL A .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL Z
+      (16#1D670#, 16#1D689#),  -- (Lu)  MATHEMATICAL MONOSPACE CAPITAL A .. MATHEMATICAL MONOSPACE CAPITAL Z
+      (16#1D68A#, 16#1D6A3#),  -- (Ll)  MATHEMATICAL MONOSPACE SMALL A .. MATHEMATICAL MONOSPACE SMALL Z
+      (16#1D6A8#, 16#1D6C0#),  -- (Lu)  MATHEMATICAL BOLD CAPITAL ALPHA .. MATHEMATICAL BOLD CAPITAL OMEGA
+      (16#1D6C1#, 16#1D6C1#),  -- (Sm)  MATHEMATICAL BOLD NABLA .. MATHEMATICAL BOLD NABLA
+      (16#1D6C2#, 16#1D6DA#),  -- (Ll)  MATHEMATICAL BOLD SMALL ALPHA .. MATHEMATICAL BOLD SMALL OMEGA
+      (16#1D6DB#, 16#1D6DB#),  -- (Sm)  MATHEMATICAL BOLD PARTIAL DIFFERENTIAL .. MATHEMATICAL BOLD PARTIAL DIFFERENTIAL
+      (16#1D6DC#, 16#1D6E1#),  -- (Ll)  MATHEMATICAL BOLD EPSILON SYMBOL .. MATHEMATICAL BOLD PI SYMBOL
+      (16#1D6E2#, 16#1D6FA#),  -- (Lu)  MATHEMATICAL ITALIC CAPITAL ALPHA .. MATHEMATICAL ITALIC CAPITAL OMEGA
+      (16#1D6FB#, 16#1D6FB#),  -- (Sm)  MATHEMATICAL ITALIC NABLA .. MATHEMATICAL ITALIC NABLA
+      (16#1D6FC#, 16#1D714#),  -- (Ll)  MATHEMATICAL ITALIC SMALL ALPHA .. MATHEMATICAL ITALIC SMALL OMEGA
+      (16#1D715#, 16#1D715#),  -- (Sm)  MATHEMATICAL ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL ITALIC PARTIAL DIFFERENTIAL
+      (16#1D716#, 16#1D71B#),  -- (Ll)  MATHEMATICAL ITALIC EPSILON SYMBOL .. MATHEMATICAL ITALIC PI SYMBOL
+      (16#1D71C#, 16#1D734#),  -- (Lu)  MATHEMATICAL BOLD ITALIC CAPITAL ALPHA .. MATHEMATICAL BOLD ITALIC CAPITAL OMEGA
+      (16#1D735#, 16#1D735#),  -- (Sm)  MATHEMATICAL BOLD ITALIC NABLA .. MATHEMATICAL BOLD ITALIC NABLA
+      (16#1D736#, 16#1D74E#),  -- (Ll)  MATHEMATICAL BOLD ITALIC SMALL ALPHA .. MATHEMATICAL BOLD ITALIC SMALL OMEGA
+      (16#1D74F#, 16#1D74F#),  -- (Sm)  MATHEMATICAL BOLD ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL BOLD ITALIC PARTIAL DIFFERENTIAL
+      (16#1D750#, 16#1D755#),  -- (Ll)  MATHEMATICAL BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL BOLD ITALIC PI SYMBOL
+      (16#1D756#, 16#1D76E#),  -- (Lu)  MATHEMATICAL SANS-SERIF BOLD CAPITAL ALPHA .. MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA
+      (16#1D76F#, 16#1D76F#),  -- (Sm)  MATHEMATICAL SANS-SERIF BOLD NABLA .. MATHEMATICAL SANS-SERIF BOLD NABLA
+      (16#1D770#, 16#1D788#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA
+      (16#1D789#, 16#1D789#),  -- (Sm)  MATHEMATICAL SANS-SERIF BOLD PARTIAL DIFFERENTIAL .. MATHEMATICAL SANS-SERIF BOLD PARTIAL DIFFERENTIAL
+      (16#1D78A#, 16#1D78F#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD PI SYMBOL
+      (16#1D790#, 16#1D7A8#),  -- (Lu)  MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA
+      (16#1D7A9#, 16#1D7A9#),  -- (Sm)  MATHEMATICAL SANS-SERIF BOLD ITALIC NABLA .. MATHEMATICAL SANS-SERIF BOLD ITALIC NABLA
+      (16#1D7AA#, 16#1D7C2#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA
+      (16#1D7C3#, 16#1D7C3#),  -- (Sm)  MATHEMATICAL SANS-SERIF BOLD ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PARTIAL DIFFERENTIAL
+      (16#1D7C4#, 16#1D7C9#),  -- (Ll)  MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL
+      (16#1D7CE#, 16#1D7FF#),  -- (Nd)  MATHEMATICAL BOLD DIGIT ZERO .. MATHEMATICAL MONOSPACE DIGIT NINE
+      (16#20000#, 16#2A6D6#),  -- (Lo)  <CJK Ideograph Extension B, First> .. <CJK Ideograph Extension B, Last>
+      (16#2F800#, 16#2FA1D#),  -- (Lo)  CJK COMPATIBILITY IDEOGRAPH-2F800 .. CJK COMPATIBILITY IDEOGRAPH-2FA1D
+      (16#E0001#, 16#E0001#),  -- (Cf)  LANGUAGE TAG .. LANGUAGE TAG
+      (16#E0020#, 16#E007F#),  -- (Cf)  TAG SPACE .. CANCEL TAG
+      (16#E0100#, 16#E01EF#),  -- (Mn)  VARIATION SELECTOR-17 .. VARIATION SELECTOR-256
+      (16#F0000#, 16#FFFFD#),  -- (Co)  <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last>
+      (16#100000#, 16#10FFFD#));  -- (Co)  <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last>
+ 
+    --  The following array is parallel to the Unicode_Ranges table above. For
+    --  each entry in the Unicode_Ranges table, there is a corresponding entry
+    --  in the following table indicating the corresponding unicode category.
+ 
+    Unicode_Categories : constant array (Unicode_Ranges'Range) of Category := (
+      Cc,  -- (16#00000#, 16#0001F#)  <control> .. <control>
+      Zs,  -- (16#00020#, 16#00020#)  SPACE .. SPACE
+      Po,  -- (16#00021#, 16#00023#)  EXCLAMATION MARK .. NUMBER SIGN
+      Sc,  -- (16#00024#, 16#00024#)  DOLLAR SIGN .. DOLLAR SIGN
+      Po,  -- (16#00025#, 16#00027#)  PERCENT SIGN .. APOSTROPHE
+      Ps,  -- (16#00028#, 16#00028#)  LEFT PARENTHESIS .. LEFT PARENTHESIS
+      Pe,  -- (16#00029#, 16#00029#)  RIGHT PARENTHESIS .. RIGHT PARENTHESIS
+      Po,  -- (16#0002A#, 16#0002A#)  ASTERISK .. ASTERISK
+      Sm,  -- (16#0002B#, 16#0002B#)  PLUS SIGN .. PLUS SIGN
+      Po,  -- (16#0002C#, 16#0002C#)  COMMA .. COMMA
+      Pd,  -- (16#0002D#, 16#0002D#)  HYPHEN-MINUS .. HYPHEN-MINUS
+      Po,  -- (16#0002E#, 16#0002F#)  FULL STOP .. SOLIDUS
+      Nd,  -- (16#00030#, 16#00039#)  DIGIT ZERO .. DIGIT NINE
+      Po,  -- (16#0003A#, 16#0003B#)  COLON .. SEMICOLON
+      Sm,  -- (16#0003C#, 16#0003E#)  LESS-THAN SIGN .. GREATER-THAN SIGN
+      Po,  -- (16#0003F#, 16#00040#)  QUESTION MARK .. COMMERCIAL AT
+      Lu,  -- (16#00041#, 16#0005A#)  LATIN CAPITAL LETTER A .. LATIN CAPITAL LETTER Z
+      Ps,  -- (16#0005B#, 16#0005B#)  LEFT SQUARE BRACKET .. LEFT SQUARE BRACKET
+      Po,  -- (16#0005C#, 16#0005C#)  REVERSE SOLIDUS .. REVERSE SOLIDUS
+      Pe,  -- (16#0005D#, 16#0005D#)  RIGHT SQUARE BRACKET .. RIGHT SQUARE BRACKET
+      Sk,  -- (16#0005E#, 16#0005E#)  CIRCUMFLEX ACCENT .. CIRCUMFLEX ACCENT
+      Pc,  -- (16#0005F#, 16#0005F#)  LOW LINE .. LOW LINE
+      Sk,  -- (16#00060#, 16#00060#)  GRAVE ACCENT .. GRAVE ACCENT
+      Ll,  -- (16#00061#, 16#0007A#)  LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
+      Ps,  -- (16#0007B#, 16#0007B#)  LEFT CURLY BRACKET .. LEFT CURLY BRACKET
+      Sm,  -- (16#0007C#, 16#0007C#)  VERTICAL LINE .. VERTICAL LINE
+      Pe,  -- (16#0007D#, 16#0007D#)  RIGHT CURLY BRACKET .. RIGHT CURLY BRACKET
+      Sm,  -- (16#0007E#, 16#0007E#)  TILDE .. TILDE
+      Cc,  -- (16#0007F#, 16#0009F#)  <control> .. <control>
+      Zs,  -- (16#000A0#, 16#000A0#)  NO-BREAK SPACE .. NO-BREAK SPACE
+      Po,  -- (16#000A1#, 16#000A1#)  INVERTED EXCLAMATION MARK .. INVERTED EXCLAMATION MARK
+      Sc,  -- (16#000A2#, 16#000A5#)  CENT SIGN .. YEN SIGN
+      So,  -- (16#000A6#, 16#000A7#)  BROKEN BAR .. SECTION SIGN
+      Sk,  -- (16#000A8#, 16#000A8#)  DIAERESIS .. DIAERESIS
+      So,  -- (16#000A9#, 16#000A9#)  COPYRIGHT SIGN .. COPYRIGHT SIGN
+      Ll,  -- (16#000AA#, 16#000AA#)  FEMININE ORDINAL INDICATOR .. FEMININE ORDINAL INDICATOR
+      Pi,  -- (16#000AB#, 16#000AB#)  LEFT-POINTING DOUBLE ANGLE QUOTATION MARK .. LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+      Sm,  -- (16#000AC#, 16#000AC#)  NOT SIGN .. NOT SIGN
+      Cf,  -- (16#000AD#, 16#000AD#)  SOFT HYPHEN .. SOFT HYPHEN
+      So,  -- (16#000AE#, 16#000AE#)  REGISTERED SIGN .. REGISTERED SIGN
+      Sk,  -- (16#000AF#, 16#000AF#)  MACRON .. MACRON
+      So,  -- (16#000B0#, 16#000B0#)  DEGREE SIGN .. DEGREE SIGN
+      Sm,  -- (16#000B1#, 16#000B1#)  PLUS-MINUS SIGN .. PLUS-MINUS SIGN
+      No,  -- (16#000B2#, 16#000B3#)  SUPERSCRIPT TWO .. SUPERSCRIPT THREE
+      Sk,  -- (16#000B4#, 16#000B4#)  ACUTE ACCENT .. ACUTE ACCENT
+      Ll,  -- (16#000B5#, 16#000B5#)  MICRO SIGN .. MICRO SIGN
+      So,  -- (16#000B6#, 16#000B6#)  PILCROW SIGN .. PILCROW SIGN
+      Po,  -- (16#000B7#, 16#000B7#)  MIDDLE DOT .. MIDDLE DOT
+      Sk,  -- (16#000B8#, 16#000B8#)  CEDILLA .. CEDILLA
+      No,  -- (16#000B9#, 16#000B9#)  SUPERSCRIPT ONE .. SUPERSCRIPT ONE
+      Ll,  -- (16#000BA#, 16#000BA#)  MASCULINE ORDINAL INDICATOR .. MASCULINE ORDINAL INDICATOR
+      Pf,  -- (16#000BB#, 16#000BB#)  RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK .. RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+      No,  -- (16#000BC#, 16#000BE#)  VULGAR FRACTION ONE QUARTER .. VULGAR FRACTION THREE QUARTERS
+      Po,  -- (16#000BF#, 16#000BF#)  INVERTED QUESTION MARK .. INVERTED QUESTION MARK
+      Lu,  -- (16#000C0#, 16#000D6#)  LATIN CAPITAL LETTER A WITH GRAVE .. LATIN CAPITAL LETTER O WITH DIAERESIS
+      Sm,  -- (16#000D7#, 16#000D7#)  MULTIPLICATION SIGN .. MULTIPLICATION SIGN
+      Lu,  -- (16#000D8#, 16#000DE#)  LATIN CAPITAL LETTER O WITH STROKE .. LATIN CAPITAL LETTER THORN
+      Ll,  -- (16#000DF#, 16#000F6#)  LATIN SMALL LETTER SHARP S .. LATIN SMALL LETTER O WITH DIAERESIS
+      Sm,  -- (16#000F7#, 16#000F7#)  DIVISION SIGN .. DIVISION SIGN
+      Ll,  -- (16#000F8#, 16#000FF#)  LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER Y WITH DIAERESIS
+      Lu,  -- (16#00100#, 16#00100#)  LATIN CAPITAL LETTER A WITH MACRON .. LATIN CAPITAL LETTER A WITH MACRON
+      Ll,  -- (16#00101#, 16#00101#)  LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON
+      Lu,  -- (16#00102#, 16#00102#)  LATIN CAPITAL LETTER A WITH BREVE .. LATIN CAPITAL LETTER A WITH BREVE
+      Ll,  -- (16#00103#, 16#00103#)  LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE
+      Lu,  -- (16#00104#, 16#00104#)  LATIN CAPITAL LETTER A WITH OGONEK .. LATIN CAPITAL LETTER A WITH OGONEK
+      Ll,  -- (16#00105#, 16#00105#)  LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK
+      Lu,  -- (16#00106#, 16#00106#)  LATIN CAPITAL LETTER C WITH ACUTE .. LATIN CAPITAL LETTER C WITH ACUTE
+      Ll,  -- (16#00107#, 16#00107#)  LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE
+      Lu,  -- (16#00108#, 16#00108#)  LATIN CAPITAL LETTER C WITH CIRCUMFLEX .. LATIN CAPITAL LETTER C WITH CIRCUMFLEX
+      Ll,  -- (16#00109#, 16#00109#)  LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX
+      Lu,  -- (16#0010A#, 16#0010A#)  LATIN CAPITAL LETTER C WITH DOT ABOVE .. LATIN CAPITAL LETTER C WITH DOT ABOVE
+      Ll,  -- (16#0010B#, 16#0010B#)  LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE
+      Lu,  -- (16#0010C#, 16#0010C#)  LATIN CAPITAL LETTER C WITH CARON .. LATIN CAPITAL LETTER C WITH CARON
+      Ll,  -- (16#0010D#, 16#0010D#)  LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON
+      Lu,  -- (16#0010E#, 16#0010E#)  LATIN CAPITAL LETTER D WITH CARON .. LATIN CAPITAL LETTER D WITH CARON
+      Ll,  -- (16#0010F#, 16#0010F#)  LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON
+      Lu,  -- (16#00110#, 16#00110#)  LATIN CAPITAL LETTER D WITH STROKE .. LATIN CAPITAL LETTER D WITH STROKE
+      Ll,  -- (16#00111#, 16#00111#)  LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE
+      Lu,  -- (16#00112#, 16#00112#)  LATIN CAPITAL LETTER E WITH MACRON .. LATIN CAPITAL LETTER E WITH MACRON
+      Ll,  -- (16#00113#, 16#00113#)  LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON
+      Lu,  -- (16#00114#, 16#00114#)  LATIN CAPITAL LETTER E WITH BREVE .. LATIN CAPITAL LETTER E WITH BREVE
+      Ll,  -- (16#00115#, 16#00115#)  LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE
+      Lu,  -- (16#00116#, 16#00116#)  LATIN CAPITAL LETTER E WITH DOT ABOVE .. LATIN CAPITAL LETTER E WITH DOT ABOVE
+      Ll,  -- (16#00117#, 16#00117#)  LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE
+      Lu,  -- (16#00118#, 16#00118#)  LATIN CAPITAL LETTER E WITH OGONEK .. LATIN CAPITAL LETTER E WITH OGONEK
+      Ll,  -- (16#00119#, 16#00119#)  LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK
+      Lu,  -- (16#0011A#, 16#0011A#)  LATIN CAPITAL LETTER E WITH CARON .. LATIN CAPITAL LETTER E WITH CARON
+      Ll,  -- (16#0011B#, 16#0011B#)  LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON
+      Lu,  -- (16#0011C#, 16#0011C#)  LATIN CAPITAL LETTER G WITH CIRCUMFLEX .. LATIN CAPITAL LETTER G WITH CIRCUMFLEX
+      Ll,  -- (16#0011D#, 16#0011D#)  LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX
+      Lu,  -- (16#0011E#, 16#0011E#)  LATIN CAPITAL LETTER G WITH BREVE .. LATIN CAPITAL LETTER G WITH BREVE
+      Ll,  -- (16#0011F#, 16#0011F#)  LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE
+      Lu,  -- (16#00120#, 16#00120#)  LATIN CAPITAL LETTER G WITH DOT ABOVE .. LATIN CAPITAL LETTER G WITH DOT ABOVE
+      Ll,  -- (16#00121#, 16#00121#)  LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE
+      Lu,  -- (16#00122#, 16#00122#)  LATIN CAPITAL LETTER G WITH CEDILLA .. LATIN CAPITAL LETTER G WITH CEDILLA
+      Ll,  -- (16#00123#, 16#00123#)  LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA
+      Lu,  -- (16#00124#, 16#00124#)  LATIN CAPITAL LETTER H WITH CIRCUMFLEX .. LATIN CAPITAL LETTER H WITH CIRCUMFLEX
+      Ll,  -- (16#00125#, 16#00125#)  LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX
+      Lu,  -- (16#00126#, 16#00126#)  LATIN CAPITAL LETTER H WITH STROKE .. LATIN CAPITAL LETTER H WITH STROKE
+      Ll,  -- (16#00127#, 16#00127#)  LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE
+      Lu,  -- (16#00128#, 16#00128#)  LATIN CAPITAL LETTER I WITH TILDE .. LATIN CAPITAL LETTER I WITH TILDE
+      Ll,  -- (16#00129#, 16#00129#)  LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE
+      Lu,  -- (16#0012A#, 16#0012A#)  LATIN CAPITAL LETTER I WITH MACRON .. LATIN CAPITAL LETTER I WITH MACRON
+      Ll,  -- (16#0012B#, 16#0012B#)  LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON
+      Lu,  -- (16#0012C#, 16#0012C#)  LATIN CAPITAL LETTER I WITH BREVE .. LATIN CAPITAL LETTER I WITH BREVE
+      Ll,  -- (16#0012D#, 16#0012D#)  LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE
+      Lu,  -- (16#0012E#, 16#0012E#)  LATIN CAPITAL LETTER I WITH OGONEK .. LATIN CAPITAL LETTER I WITH OGONEK
+      Ll,  -- (16#0012F#, 16#0012F#)  LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK
+      Lu,  -- (16#00130#, 16#00130#)  LATIN CAPITAL LETTER I WITH DOT ABOVE .. LATIN CAPITAL LETTER I WITH DOT ABOVE
+      Ll,  -- (16#00131#, 16#00131#)  LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I
+      Lu,  -- (16#00132#, 16#00132#)  LATIN CAPITAL LIGATURE IJ .. LATIN CAPITAL LIGATURE IJ
+      Ll,  -- (16#00133#, 16#00133#)  LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ
+      Lu,  -- (16#00134#, 16#00134#)  LATIN CAPITAL LETTER J WITH CIRCUMFLEX .. LATIN CAPITAL LETTER J WITH CIRCUMFLEX
+      Ll,  -- (16#00135#, 16#00135#)  LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX
+      Lu,  -- (16#00136#, 16#00136#)  LATIN CAPITAL LETTER K WITH CEDILLA .. LATIN CAPITAL LETTER K WITH CEDILLA
+      Ll,  -- (16#00137#, 16#00138#)  LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER KRA
+      Lu,  -- (16#00139#, 16#00139#)  LATIN CAPITAL LETTER L WITH ACUTE .. LATIN CAPITAL LETTER L WITH ACUTE
+      Ll,  -- (16#0013A#, 16#0013A#)  LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE
+      Lu,  -- (16#0013B#, 16#0013B#)  LATIN CAPITAL LETTER L WITH CEDILLA .. LATIN CAPITAL LETTER L WITH CEDILLA
+      Ll,  -- (16#0013C#, 16#0013C#)  LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA
+      Lu,  -- (16#0013D#, 16#0013D#)  LATIN CAPITAL LETTER L WITH CARON .. LATIN CAPITAL LETTER L WITH CARON
+      Ll,  -- (16#0013E#, 16#0013E#)  LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON
+      Lu,  -- (16#0013F#, 16#0013F#)  LATIN CAPITAL LETTER L WITH MIDDLE DOT .. LATIN CAPITAL LETTER L WITH MIDDLE DOT
+      Ll,  -- (16#00140#, 16#00140#)  LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT
+      Lu,  -- (16#00141#, 16#00141#)  LATIN CAPITAL LETTER L WITH STROKE .. LATIN CAPITAL LETTER L WITH STROKE
+      Ll,  -- (16#00142#, 16#00142#)  LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE
+      Lu,  -- (16#00143#, 16#00143#)  LATIN CAPITAL LETTER N WITH ACUTE .. LATIN CAPITAL LETTER N WITH ACUTE
+      Ll,  -- (16#00144#, 16#00144#)  LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE
+      Lu,  -- (16#00145#, 16#00145#)  LATIN CAPITAL LETTER N WITH CEDILLA .. LATIN CAPITAL LETTER N WITH CEDILLA
+      Ll,  -- (16#00146#, 16#00146#)  LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA
+      Lu,  -- (16#00147#, 16#00147#)  LATIN CAPITAL LETTER N WITH CARON .. LATIN CAPITAL LETTER N WITH CARON
+      Ll,  -- (16#00148#, 16#00149#)  LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
+      Lu,  -- (16#0014A#, 16#0014A#)  LATIN CAPITAL LETTER ENG .. LATIN CAPITAL LETTER ENG
+      Ll,  -- (16#0014B#, 16#0014B#)  LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG
+      Lu,  -- (16#0014C#, 16#0014C#)  LATIN CAPITAL LETTER O WITH MACRON .. LATIN CAPITAL LETTER O WITH MACRON
+      Ll,  -- (16#0014D#, 16#0014D#)  LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON
+      Lu,  -- (16#0014E#, 16#0014E#)  LATIN CAPITAL LETTER O WITH BREVE .. LATIN CAPITAL LETTER O WITH BREVE
+      Ll,  -- (16#0014F#, 16#0014F#)  LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE
+      Lu,  -- (16#00150#, 16#00150#)  LATIN CAPITAL LETTER O WITH DOUBLE ACUTE .. LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+      Ll,  -- (16#00151#, 16#00151#)  LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE
+      Lu,  -- (16#00152#, 16#00152#)  LATIN CAPITAL LIGATURE OE .. LATIN CAPITAL LIGATURE OE
+      Ll,  -- (16#00153#, 16#00153#)  LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE
+      Lu,  -- (16#00154#, 16#00154#)  LATIN CAPITAL LETTER R WITH ACUTE .. LATIN CAPITAL LETTER R WITH ACUTE
+      Ll,  -- (16#00155#, 16#00155#)  LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE
+      Lu,  -- (16#00156#, 16#00156#)  LATIN CAPITAL LETTER R WITH CEDILLA .. LATIN CAPITAL LETTER R WITH CEDILLA
+      Ll,  -- (16#00157#, 16#00157#)  LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA
+      Lu,  -- (16#00158#, 16#00158#)  LATIN CAPITAL LETTER R WITH CARON .. LATIN CAPITAL LETTER R WITH CARON
+      Ll,  -- (16#00159#, 16#00159#)  LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON
+      Lu,  -- (16#0015A#, 16#0015A#)  LATIN CAPITAL LETTER S WITH ACUTE .. LATIN CAPITAL LETTER S WITH ACUTE
+      Ll,  -- (16#0015B#, 16#0015B#)  LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE
+      Lu,  -- (16#0015C#, 16#0015C#)  LATIN CAPITAL LETTER S WITH CIRCUMFLEX .. LATIN CAPITAL LETTER S WITH CIRCUMFLEX
+      Ll,  -- (16#0015D#, 16#0015D#)  LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX
+      Lu,  -- (16#0015E#, 16#0015E#)  LATIN CAPITAL LETTER S WITH CEDILLA .. LATIN CAPITAL LETTER S WITH CEDILLA
+      Ll,  -- (16#0015F#, 16#0015F#)  LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA
+      Lu,  -- (16#00160#, 16#00160#)  LATIN CAPITAL LETTER S WITH CARON .. LATIN CAPITAL LETTER S WITH CARON
+      Ll,  -- (16#00161#, 16#00161#)  LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON
+      Lu,  -- (16#00162#, 16#00162#)  LATIN CAPITAL LETTER T WITH CEDILLA .. LATIN CAPITAL LETTER T WITH CEDILLA
+      Ll,  -- (16#00163#, 16#00163#)  LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA
+      Lu,  -- (16#00164#, 16#00164#)  LATIN CAPITAL LETTER T WITH CARON .. LATIN CAPITAL LETTER T WITH CARON
+      Ll,  -- (16#00165#, 16#00165#)  LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON
+      Lu,  -- (16#00166#, 16#00166#)  LATIN CAPITAL LETTER T WITH STROKE .. LATIN CAPITAL LETTER T WITH STROKE
+      Ll,  -- (16#00167#, 16#00167#)  LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE
+      Lu,  -- (16#00168#, 16#00168#)  LATIN CAPITAL LETTER U WITH TILDE .. LATIN CAPITAL LETTER U WITH TILDE
+      Ll,  -- (16#00169#, 16#00169#)  LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE
+      Lu,  -- (16#0016A#, 16#0016A#)  LATIN CAPITAL LETTER U WITH MACRON .. LATIN CAPITAL LETTER U WITH MACRON
+      Ll,  -- (16#0016B#, 16#0016B#)  LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON
+      Lu,  -- (16#0016C#, 16#0016C#)  LATIN CAPITAL LETTER U WITH BREVE .. LATIN CAPITAL LETTER U WITH BREVE
+      Ll,  -- (16#0016D#, 16#0016D#)  LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE
+      Lu,  -- (16#0016E#, 16#0016E#)  LATIN CAPITAL LETTER U WITH RING ABOVE .. LATIN CAPITAL LETTER U WITH RING ABOVE
+      Ll,  -- (16#0016F#, 16#0016F#)  LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE
+      Lu,  -- (16#00170#, 16#00170#)  LATIN CAPITAL LETTER U WITH DOUBLE ACUTE .. LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+      Ll,  -- (16#00171#, 16#00171#)  LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE
+      Lu,  -- (16#00172#, 16#00172#)  LATIN CAPITAL LETTER U WITH OGONEK .. LATIN CAPITAL LETTER U WITH OGONEK
+      Ll,  -- (16#00173#, 16#00173#)  LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK
+      Lu,  -- (16#00174#, 16#00174#)  LATIN CAPITAL LETTER W WITH CIRCUMFLEX .. LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+      Ll,  -- (16#00175#, 16#00175#)  LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX
+      Lu,  -- (16#00176#, 16#00176#)  LATIN CAPITAL LETTER Y WITH CIRCUMFLEX .. LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+      Ll,  -- (16#00177#, 16#00177#)  LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX
+      Lu,  -- (16#00178#, 16#00179#)  LATIN CAPITAL LETTER Y WITH DIAERESIS .. LATIN CAPITAL LETTER Z WITH ACUTE
+      Ll,  -- (16#0017A#, 16#0017A#)  LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE
+      Lu,  -- (16#0017B#, 16#0017B#)  LATIN CAPITAL LETTER Z WITH DOT ABOVE .. LATIN CAPITAL LETTER Z WITH DOT ABOVE
+      Ll,  -- (16#0017C#, 16#0017C#)  LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE
+      Lu,  -- (16#0017D#, 16#0017D#)  LATIN CAPITAL LETTER Z WITH CARON .. LATIN CAPITAL LETTER Z WITH CARON
+      Ll,  -- (16#0017E#, 16#00180#)  LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER B WITH STROKE
+      Lu,  -- (16#00181#, 16#00182#)  LATIN CAPITAL LETTER B WITH HOOK .. LATIN CAPITAL LETTER B WITH TOPBAR
+      Ll,  -- (16#00183#, 16#00183#)  LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR
+      Lu,  -- (16#00184#, 16#00184#)  LATIN CAPITAL LETTER TONE SIX .. LATIN CAPITAL LETTER TONE SIX
+      Ll,  -- (16#00185#, 16#00185#)  LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX
+      Lu,  -- (16#00186#, 16#00187#)  LATIN CAPITAL LETTER OPEN O .. LATIN CAPITAL LETTER C WITH HOOK
+      Ll,  -- (16#00188#, 16#00188#)  LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK
+      Lu,  -- (16#00189#, 16#0018B#)  LATIN CAPITAL LETTER AFRICAN D .. LATIN CAPITAL LETTER D WITH TOPBAR
+      Ll,  -- (16#0018C#, 16#0018D#)  LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER TURNED DELTA
+      Lu,  -- (16#0018E#, 16#00191#)  LATIN CAPITAL LETTER REVERSED E .. LATIN CAPITAL LETTER F WITH HOOK
+      Ll,  -- (16#00192#, 16#00192#)  LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK
+      Lu,  -- (16#00193#, 16#00194#)  LATIN CAPITAL LETTER G WITH HOOK .. LATIN CAPITAL LETTER GAMMA
+      Ll,  -- (16#00195#, 16#00195#)  LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV
+      Lu,  -- (16#00196#, 16#00198#)  LATIN CAPITAL LETTER IOTA .. LATIN CAPITAL LETTER K WITH HOOK
+      Ll,  -- (16#00199#, 16#0019B#)  LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER LAMBDA WITH STROKE
+      Lu,  -- (16#0019C#, 16#0019D#)  LATIN CAPITAL LETTER TURNED M .. LATIN CAPITAL LETTER N WITH LEFT HOOK
+      Ll,  -- (16#0019E#, 16#0019E#)  LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG
+      Lu,  -- (16#0019F#, 16#001A0#)  LATIN CAPITAL LETTER O WITH MIDDLE TILDE .. LATIN CAPITAL LETTER O WITH HORN
+      Ll,  -- (16#001A1#, 16#001A1#)  LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN
+      Lu,  -- (16#001A2#, 16#001A2#)  LATIN CAPITAL LETTER OI .. LATIN CAPITAL LETTER OI
+      Ll,  -- (16#001A3#, 16#001A3#)  LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI
+      Lu,  -- (16#001A4#, 16#001A4#)  LATIN CAPITAL LETTER P WITH HOOK .. LATIN CAPITAL LETTER P WITH HOOK
+      Ll,  -- (16#001A5#, 16#001A5#)  LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK
+      Lu,  -- (16#001A6#, 16#001A7#)  LATIN LETTER YR .. LATIN CAPITAL LETTER TONE TWO
+      Ll,  -- (16#001A8#, 16#001A8#)  LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO
+      Lu,  -- (16#001A9#, 16#001A9#)  LATIN CAPITAL LETTER ESH .. LATIN CAPITAL LETTER ESH
+      Ll,  -- (16#001AA#, 16#001AB#)  LATIN LETTER REVERSED ESH LOOP .. LATIN SMALL LETTER T WITH PALATAL HOOK
+      Lu,  -- (16#001AC#, 16#001AC#)  LATIN CAPITAL LETTER T WITH HOOK .. LATIN CAPITAL LETTER T WITH HOOK
+      Ll,  -- (16#001AD#, 16#001AD#)  LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK
+      Lu,  -- (16#001AE#, 16#001AF#)  LATIN CAPITAL LETTER T WITH RETROFLEX HOOK .. LATIN CAPITAL LETTER U WITH HORN
+      Ll,  -- (16#001B0#, 16#001B0#)  LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN
+      Lu,  -- (16#001B1#, 16#001B3#)  LATIN CAPITAL LETTER UPSILON .. LATIN CAPITAL LETTER Y WITH HOOK
+      Ll,  -- (16#001B4#, 16#001B4#)  LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK
+      Lu,  -- (16#001B5#, 16#001B5#)  LATIN CAPITAL LETTER Z WITH STROKE .. LATIN CAPITAL LETTER Z WITH STROKE
+      Ll,  -- (16#001B6#, 16#001B6#)  LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE
+      Lu,  -- (16#001B7#, 16#001B8#)  LATIN CAPITAL LETTER EZH .. LATIN CAPITAL LETTER EZH REVERSED
+      Ll,  -- (16#001B9#, 16#001BA#)  LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH WITH TAIL
+      Lo,  -- (16#001BB#, 16#001BB#)  LATIN LETTER TWO WITH STROKE .. LATIN LETTER TWO WITH STROKE
+      Lu,  -- (16#001BC#, 16#001BC#)  LATIN CAPITAL LETTER TONE FIVE .. LATIN CAPITAL LETTER TONE FIVE
+      Ll,  -- (16#001BD#, 16#001BF#)  LATIN SMALL LETTER TONE FIVE .. LATIN LETTER WYNN
+      Lo,  -- (16#001C0#, 16#001C3#)  LATIN LETTER DENTAL CLICK .. LATIN LETTER RETROFLEX CLICK
+      Lu,  -- (16#001C4#, 16#001C4#)  LATIN CAPITAL LETTER DZ WITH CARON .. LATIN CAPITAL LETTER DZ WITH CARON
+      Lt,  -- (16#001C5#, 16#001C5#)  LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
+      Ll,  -- (16#001C6#, 16#001C6#)  LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON
+      Lu,  -- (16#001C7#, 16#001C7#)  LATIN CAPITAL LETTER LJ .. LATIN CAPITAL LETTER LJ
+      Lt,  -- (16#001C8#, 16#001C8#)  LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J
+      Ll,  -- (16#001C9#, 16#001C9#)  LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ
+      Lu,  -- (16#001CA#, 16#001CA#)  LATIN CAPITAL LETTER NJ .. LATIN CAPITAL LETTER NJ
+      Lt,  -- (16#001CB#, 16#001CB#)  LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J
+      Ll,  -- (16#001CC#, 16#001CC#)  LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ
+      Lu,  -- (16#001CD#, 16#001CD#)  LATIN CAPITAL LETTER A WITH CARON .. LATIN CAPITAL LETTER A WITH CARON
+      Ll,  -- (16#001CE#, 16#001CE#)  LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON
+      Lu,  -- (16#001CF#, 16#001CF#)  LATIN CAPITAL LETTER I WITH CARON .. LATIN CAPITAL LETTER I WITH CARON
+      Ll,  -- (16#001D0#, 16#001D0#)  LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON
+      Lu,  -- (16#001D1#, 16#001D1#)  LATIN CAPITAL LETTER O WITH CARON .. LATIN CAPITAL LETTER O WITH CARON
+      Ll,  -- (16#001D2#, 16#001D2#)  LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON
+      Lu,  -- (16#001D3#, 16#001D3#)  LATIN CAPITAL LETTER U WITH CARON .. LATIN CAPITAL LETTER U WITH CARON
+      Ll,  -- (16#001D4#, 16#001D4#)  LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON
+      Lu,  -- (16#001D5#, 16#001D5#)  LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON
+      Ll,  -- (16#001D6#, 16#001D6#)  LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON
+      Lu,  -- (16#001D7#, 16#001D7#)  LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE .. LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE
+      Ll,  -- (16#001D8#, 16#001D8#)  LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE
+      Lu,  -- (16#001D9#, 16#001D9#)  LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON .. LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON
+      Ll,  -- (16#001DA#, 16#001DA#)  LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON
+      Lu,  -- (16#001DB#, 16#001DB#)  LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE .. LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE
+      Ll,  -- (16#001DC#, 16#001DD#)  LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER TURNED E
+      Lu,  -- (16#001DE#, 16#001DE#)  LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON
+      Ll,  -- (16#001DF#, 16#001DF#)  LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON
+      Lu,  -- (16#001E0#, 16#001E0#)  LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON .. LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON
+      Ll,  -- (16#001E1#, 16#001E1#)  LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON
+      Lu,  -- (16#001E2#, 16#001E2#)  LATIN CAPITAL LETTER AE WITH MACRON .. LATIN CAPITAL LETTER AE WITH MACRON
+      Ll,  -- (16#001E3#, 16#001E3#)  LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON
+      Lu,  -- (16#001E4#, 16#001E4#)  LATIN CAPITAL LETTER G WITH STROKE .. LATIN CAPITAL LETTER G WITH STROKE
+      Ll,  -- (16#001E5#, 16#001E5#)  LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE
+      Lu,  -- (16#001E6#, 16#001E6#)  LATIN CAPITAL LETTER G WITH CARON .. LATIN CAPITAL LETTER G WITH CARON
+      Ll,  -- (16#001E7#, 16#001E7#)  LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON
+      Lu,  -- (16#001E8#, 16#001E8#)  LATIN CAPITAL LETTER K WITH CARON .. LATIN CAPITAL LETTER K WITH CARON
+      Ll,  -- (16#001E9#, 16#001E9#)  LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON
+      Lu,  -- (16#001EA#, 16#001EA#)  LATIN CAPITAL LETTER O WITH OGONEK .. LATIN CAPITAL LETTER O WITH OGONEK
+      Ll,  -- (16#001EB#, 16#001EB#)  LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK
+      Lu,  -- (16#001EC#, 16#001EC#)  LATIN CAPITAL LETTER O WITH OGONEK AND MACRON .. LATIN CAPITAL LETTER O WITH OGONEK AND MACRON
+      Ll,  -- (16#001ED#, 16#001ED#)  LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON
+      Lu,  -- (16#001EE#, 16#001EE#)  LATIN CAPITAL LETTER EZH WITH CARON .. LATIN CAPITAL LETTER EZH WITH CARON
+      Ll,  -- (16#001EF#, 16#001F0#)  LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER J WITH CARON
+      Lu,  -- (16#001F1#, 16#001F1#)  LATIN CAPITAL LETTER DZ .. LATIN CAPITAL LETTER DZ
+      Lt,  -- (16#001F2#, 16#001F2#)  LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z
+      Ll,  -- (16#001F3#, 16#001F3#)  LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ
+      Lu,  -- (16#001F4#, 16#001F4#)  LATIN CAPITAL LETTER G WITH ACUTE .. LATIN CAPITAL LETTER G WITH ACUTE
+      Ll,  -- (16#001F5#, 16#001F5#)  LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE
+      Lu,  -- (16#001F6#, 16#001F8#)  LATIN CAPITAL LETTER HWAIR .. LATIN CAPITAL LETTER N WITH GRAVE
+      Ll,  -- (16#001F9#, 16#001F9#)  LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE
+      Lu,  -- (16#001FA#, 16#001FA#)  LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE .. LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE
+      Ll,  -- (16#001FB#, 16#001FB#)  LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE
+      Lu,  -- (16#001FC#, 16#001FC#)  LATIN CAPITAL LETTER AE WITH ACUTE .. LATIN CAPITAL LETTER AE WITH ACUTE
+      Ll,  -- (16#001FD#, 16#001FD#)  LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE
+      Lu,  -- (16#001FE#, 16#001FE#)  LATIN CAPITAL LETTER O WITH STROKE AND ACUTE .. LATIN CAPITAL LETTER O WITH STROKE AND ACUTE
+      Ll,  -- (16#001FF#, 16#001FF#)  LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE
+      Lu,  -- (16#00200#, 16#00200#)  LATIN CAPITAL LETTER A WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER A WITH DOUBLE GRAVE
+      Ll,  -- (16#00201#, 16#00201#)  LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE
+      Lu,  -- (16#00202#, 16#00202#)  LATIN CAPITAL LETTER A WITH INVERTED BREVE .. LATIN CAPITAL LETTER A WITH INVERTED BREVE
+      Ll,  -- (16#00203#, 16#00203#)  LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE
+      Lu,  -- (16#00204#, 16#00204#)  LATIN CAPITAL LETTER E WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER E WITH DOUBLE GRAVE
+      Ll,  -- (16#00205#, 16#00205#)  LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE
+      Lu,  -- (16#00206#, 16#00206#)  LATIN CAPITAL LETTER E WITH INVERTED BREVE .. LATIN CAPITAL LETTER E WITH INVERTED BREVE
+      Ll,  -- (16#00207#, 16#00207#)  LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE
+      Lu,  -- (16#00208#, 16#00208#)  LATIN CAPITAL LETTER I WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER I WITH DOUBLE GRAVE
+      Ll,  -- (16#00209#, 16#00209#)  LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE
+      Lu,  -- (16#0020A#, 16#0020A#)  LATIN CAPITAL LETTER I WITH INVERTED BREVE .. LATIN CAPITAL LETTER I WITH INVERTED BREVE
+      Ll,  -- (16#0020B#, 16#0020B#)  LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE
+      Lu,  -- (16#0020C#, 16#0020C#)  LATIN CAPITAL LETTER O WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER O WITH DOUBLE GRAVE
+      Ll,  -- (16#0020D#, 16#0020D#)  LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE
+      Lu,  -- (16#0020E#, 16#0020E#)  LATIN CAPITAL LETTER O WITH INVERTED BREVE .. LATIN CAPITAL LETTER O WITH INVERTED BREVE
+      Ll,  -- (16#0020F#, 16#0020F#)  LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE
+      Lu,  -- (16#00210#, 16#00210#)  LATIN CAPITAL LETTER R WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER R WITH DOUBLE GRAVE
+      Ll,  -- (16#00211#, 16#00211#)  LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE
+      Lu,  -- (16#00212#, 16#00212#)  LATIN CAPITAL LETTER R WITH INVERTED BREVE .. LATIN CAPITAL LETTER R WITH INVERTED BREVE
+      Ll,  -- (16#00213#, 16#00213#)  LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE
+      Lu,  -- (16#00214#, 16#00214#)  LATIN CAPITAL LETTER U WITH DOUBLE GRAVE .. LATIN CAPITAL LETTER U WITH DOUBLE GRAVE
+      Ll,  -- (16#00215#, 16#00215#)  LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE
+      Lu,  -- (16#00216#, 16#00216#)  LATIN CAPITAL LETTER U WITH INVERTED BREVE .. LATIN CAPITAL LETTER U WITH INVERTED BREVE
+      Ll,  -- (16#00217#, 16#00217#)  LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE
+      Lu,  -- (16#00218#, 16#00218#)  LATIN CAPITAL LETTER S WITH COMMA BELOW .. LATIN CAPITAL LETTER S WITH COMMA BELOW
+      Ll,  -- (16#00219#, 16#00219#)  LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW
+      Lu,  -- (16#0021A#, 16#0021A#)  LATIN CAPITAL LETTER T WITH COMMA BELOW .. LATIN CAPITAL LETTER T WITH COMMA BELOW
+      Ll,  -- (16#0021B#, 16#0021B#)  LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW
+      Lu,  -- (16#0021C#, 16#0021C#)  LATIN CAPITAL LETTER YOGH .. LATIN CAPITAL LETTER YOGH
+      Ll,  -- (16#0021D#, 16#0021D#)  LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH
+      Lu,  -- (16#0021E#, 16#0021E#)  LATIN CAPITAL LETTER H WITH CARON .. LATIN CAPITAL LETTER H WITH CARON
+      Ll,  -- (16#0021F#, 16#0021F#)  LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON
+      Lu,  -- (16#00220#, 16#00220#)  LATIN CAPITAL LETTER N WITH LONG RIGHT LEG .. LATIN CAPITAL LETTER N WITH LONG RIGHT LEG
+      Ll,  -- (16#00221#, 16#00221#)  LATIN SMALL LETTER D WITH CURL .. LATIN SMALL LETTER D WITH CURL
+      Lu,  -- (16#00222#, 16#00222#)  LATIN CAPITAL LETTER OU .. LATIN CAPITAL LETTER OU
+      Ll,  -- (16#00223#, 16#00223#)  LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU
+      Lu,  -- (16#00224#, 16#00224#)  LATIN CAPITAL LETTER Z WITH HOOK .. LATIN CAPITAL LETTER Z WITH HOOK
+      Ll,  -- (16#00225#, 16#00225#)  LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK
+      Lu,  -- (16#00226#, 16#00226#)  LATIN CAPITAL LETTER A WITH DOT ABOVE .. LATIN CAPITAL LETTER A WITH DOT ABOVE
+      Ll,  -- (16#00227#, 16#00227#)  LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE
+      Lu,  -- (16#00228#, 16#00228#)  LATIN CAPITAL LETTER E WITH CEDILLA .. LATIN CAPITAL LETTER E WITH CEDILLA
+      Ll,  -- (16#00229#, 16#00229#)  LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA
+      Lu,  -- (16#0022A#, 16#0022A#)  LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON .. LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON
+      Ll,  -- (16#0022B#, 16#0022B#)  LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON
+      Lu,  -- (16#0022C#, 16#0022C#)  LATIN CAPITAL LETTER O WITH TILDE AND MACRON .. LATIN CAPITAL LETTER O WITH TILDE AND MACRON
+      Ll,  -- (16#0022D#, 16#0022D#)  LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON
+      Lu,  -- (16#0022E#, 16#0022E#)  LATIN CAPITAL LETTER O WITH DOT ABOVE .. LATIN CAPITAL LETTER O WITH DOT ABOVE
+      Ll,  -- (16#0022F#, 16#0022F#)  LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE
+      Lu,  -- (16#00230#, 16#00230#)  LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON .. LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON
+      Ll,  -- (16#00231#, 16#00231#)  LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON
+      Lu,  -- (16#00232#, 16#00232#)  LATIN CAPITAL LETTER Y WITH MACRON .. LATIN CAPITAL LETTER Y WITH MACRON
+      Ll,  -- (16#00233#, 16#00236#)  LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER T WITH CURL
+      Ll,  -- (16#00250#, 16#002AF#)  LATIN SMALL LETTER TURNED A .. LATIN SMALL LETTER TURNED H WITH FISHHOOK AND TAIL
+      Lm,  -- (16#002B0#, 16#002C1#)  MODIFIER LETTER SMALL H .. MODIFIER LETTER REVERSED GLOTTAL STOP
+      Sk,  -- (16#002C2#, 16#002C5#)  MODIFIER LETTER LEFT ARROWHEAD .. MODIFIER LETTER DOWN ARROWHEAD
+      Lm,  -- (16#002C6#, 16#002D1#)  MODIFIER LETTER CIRCUMFLEX ACCENT .. MODIFIER LETTER HALF TRIANGULAR COLON
+      Sk,  -- (16#002D2#, 16#002DF#)  MODIFIER LETTER CENTRED RIGHT HALF RING .. MODIFIER LETTER CROSS ACCENT
+      Lm,  -- (16#002E0#, 16#002E4#)  MODIFIER LETTER SMALL GAMMA .. MODIFIER LETTER SMALL REVERSED GLOTTAL STOP
+      Sk,  -- (16#002E5#, 16#002ED#)  MODIFIER LETTER EXTRA-HIGH TONE BAR .. MODIFIER LETTER UNASPIRATED
+      Lm,  -- (16#002EE#, 16#002EE#)  MODIFIER LETTER DOUBLE APOSTROPHE .. MODIFIER LETTER DOUBLE APOSTROPHE
+      Sk,  -- (16#002EF#, 16#002FF#)  MODIFIER LETTER LOW DOWN ARROWHEAD .. MODIFIER LETTER LOW LEFT ARROW
+      Mn,  -- (16#00300#, 16#00357#)  COMBINING GRAVE ACCENT .. COMBINING RIGHT HALF RING ABOVE
+      Mn,  -- (16#0035D#, 16#0036F#)  COMBINING DOUBLE BREVE .. COMBINING LATIN SMALL LETTER X
+      Sk,  -- (16#00374#, 16#00375#)  GREEK NUMERAL SIGN .. GREEK LOWER NUMERAL SIGN
+      Lm,  -- (16#0037A#, 16#0037A#)  GREEK YPOGEGRAMMENI .. GREEK YPOGEGRAMMENI
+      Po,  -- (16#0037E#, 16#0037E#)  GREEK QUESTION MARK .. GREEK QUESTION MARK
+      Sk,  -- (16#00384#, 16#00385#)  GREEK TONOS .. GREEK DIALYTIKA TONOS
+      Lu,  -- (16#00386#, 16#00386#)  GREEK CAPITAL LETTER ALPHA WITH TONOS .. GREEK CAPITAL LETTER ALPHA WITH TONOS
+      Po,  -- (16#00387#, 16#00387#)  GREEK ANO TELEIA .. GREEK ANO TELEIA
+      Lu,  -- (16#00388#, 16#0038A#)  GREEK CAPITAL LETTER EPSILON WITH TONOS .. GREEK CAPITAL LETTER IOTA WITH TONOS
+      Lu,  -- (16#0038C#, 16#0038C#)  GREEK CAPITAL LETTER OMICRON WITH TONOS .. GREEK CAPITAL LETTER OMICRON WITH TONOS
+      Lu,  -- (16#0038E#, 16#0038F#)  GREEK CAPITAL LETTER UPSILON WITH TONOS .. GREEK CAPITAL LETTER OMEGA WITH TONOS
+      Ll,  -- (16#00390#, 16#00390#)  GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+      Lu,  -- (16#00391#, 16#003A1#)  GREEK CAPITAL LETTER ALPHA .. GREEK CAPITAL LETTER RHO
+      Lu,  -- (16#003A3#, 16#003AB#)  GREEK CAPITAL LETTER SIGMA .. GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+      Ll,  -- (16#003AC#, 16#003CE#)  GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS
+      Ll,  -- (16#003D0#, 16#003D1#)  GREEK BETA SYMBOL .. GREEK THETA SYMBOL
+      Lu,  -- (16#003D2#, 16#003D4#)  GREEK UPSILON WITH HOOK SYMBOL .. GREEK UPSILON WITH DIAERESIS AND HOOK SYMBOL
+      Ll,  -- (16#003D5#, 16#003D7#)  GREEK PHI SYMBOL .. GREEK KAI SYMBOL
+      Lu,  -- (16#003D8#, 16#003D8#)  GREEK LETTER ARCHAIC KOPPA .. GREEK LETTER ARCHAIC KOPPA
+      Ll,  -- (16#003D9#, 16#003D9#)  GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA
+      Lu,  -- (16#003DA#, 16#003DA#)  GREEK LETTER STIGMA .. GREEK LETTER STIGMA
+      Ll,  -- (16#003DB#, 16#003DB#)  GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA
+      Lu,  -- (16#003DC#, 16#003DC#)  GREEK LETTER DIGAMMA .. GREEK LETTER DIGAMMA
+      Ll,  -- (16#003DD#, 16#003DD#)  GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA
+      Lu,  -- (16#003DE#, 16#003DE#)  GREEK LETTER KOPPA .. GREEK LETTER KOPPA
+      Ll,  -- (16#003DF#, 16#003DF#)  GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA
+      Lu,  -- (16#003E0#, 16#003E0#)  GREEK LETTER SAMPI .. GREEK LETTER SAMPI
+      Ll,  -- (16#003E1#, 16#003E1#)  GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI
+      Lu,  -- (16#003E2#, 16#003E2#)  COPTIC CAPITAL LETTER SHEI .. COPTIC CAPITAL LETTER SHEI
+      Ll,  -- (16#003E3#, 16#003E3#)  COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI
+      Lu,  -- (16#003E4#, 16#003E4#)  COPTIC CAPITAL LETTER FEI .. COPTIC CAPITAL LETTER FEI
+      Ll,  -- (16#003E5#, 16#003E5#)  COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI
+      Lu,  -- (16#003E6#, 16#003E6#)  COPTIC CAPITAL LETTER KHEI .. COPTIC CAPITAL LETTER KHEI
+      Ll,  -- (16#003E7#, 16#003E7#)  COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI
+      Lu,  -- (16#003E8#, 16#003E8#)  COPTIC CAPITAL LETTER HORI .. COPTIC CAPITAL LETTER HORI
+      Ll,  -- (16#003E9#, 16#003E9#)  COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI
+      Lu,  -- (16#003EA#, 16#003EA#)  COPTIC CAPITAL LETTER GANGIA .. COPTIC CAPITAL LETTER GANGIA
+      Ll,  -- (16#003EB#, 16#003EB#)  COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA
+      Lu,  -- (16#003EC#, 16#003EC#)  COPTIC CAPITAL LETTER SHIMA .. COPTIC CAPITAL LETTER SHIMA
+      Ll,  -- (16#003ED#, 16#003ED#)  COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA
+      Lu,  -- (16#003EE#, 16#003EE#)  COPTIC CAPITAL LETTER DEI .. COPTIC CAPITAL LETTER DEI
+      Ll,  -- (16#003EF#, 16#003F3#)  COPTIC SMALL LETTER DEI .. GREEK LETTER YOT
+      Lu,  -- (16#003F4#, 16#003F4#)  GREEK CAPITAL THETA SYMBOL .. GREEK CAPITAL THETA SYMBOL
+      Ll,  -- (16#003F5#, 16#003F5#)  GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL
+      Sm,  -- (16#003F6#, 16#003F6#)  GREEK REVERSED LUNATE EPSILON SYMBOL .. GREEK REVERSED LUNATE EPSILON SYMBOL
+      Lu,  -- (16#003F7#, 16#003F7#)  GREEK CAPITAL LETTER SHO .. GREEK CAPITAL LETTER SHO
+      Ll,  -- (16#003F8#, 16#003F8#)  GREEK SMALL LETTER SHO .. GREEK SMALL LETTER SHO
+      Lu,  -- (16#003F9#, 16#003FA#)  GREEK CAPITAL LUNATE SIGMA SYMBOL .. GREEK CAPITAL LETTER SAN
+      Ll,  -- (16#003FB#, 16#003FB#)  GREEK SMALL LETTER SAN .. GREEK SMALL LETTER SAN
+      Lu,  -- (16#00400#, 16#0042F#)  CYRILLIC CAPITAL LETTER IE WITH GRAVE .. CYRILLIC CAPITAL LETTER YA
+      Ll,  -- (16#00430#, 16#0045F#)  CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER DZHE
+      Lu,  -- (16#00460#, 16#00460#)  CYRILLIC CAPITAL LETTER OMEGA .. CYRILLIC CAPITAL LETTER OMEGA
+      Ll,  -- (16#00461#, 16#00461#)  CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA
+      Lu,  -- (16#00462#, 16#00462#)  CYRILLIC CAPITAL LETTER YAT .. CYRILLIC CAPITAL LETTER YAT
+      Ll,  -- (16#00463#, 16#00463#)  CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT
+      Lu,  -- (16#00464#, 16#00464#)  CYRILLIC CAPITAL LETTER IOTIFIED E .. CYRILLIC CAPITAL LETTER IOTIFIED E
+      Ll,  -- (16#00465#, 16#00465#)  CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E
+      Lu,  -- (16#00466#, 16#00466#)  CYRILLIC CAPITAL LETTER LITTLE YUS .. CYRILLIC CAPITAL LETTER LITTLE YUS
+      Ll,  -- (16#00467#, 16#00467#)  CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS
+      Lu,  -- (16#00468#, 16#00468#)  CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS .. CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS
+      Ll,  -- (16#00469#, 16#00469#)  CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS
+      Lu,  -- (16#0046A#, 16#0046A#)  CYRILLIC CAPITAL LETTER BIG YUS .. CYRILLIC CAPITAL LETTER BIG YUS
+      Ll,  -- (16#0046B#, 16#0046B#)  CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS
+      Lu,  -- (16#0046C#, 16#0046C#)  CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS .. CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS
+      Ll,  -- (16#0046D#, 16#0046D#)  CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS
+      Lu,  -- (16#0046E#, 16#0046E#)  CYRILLIC CAPITAL LETTER KSI .. CYRILLIC CAPITAL LETTER KSI
+      Ll,  -- (16#0046F#, 16#0046F#)  CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI
+      Lu,  -- (16#00470#, 16#00470#)  CYRILLIC CAPITAL LETTER PSI .. CYRILLIC CAPITAL LETTER PSI
+      Ll,  -- (16#00471#, 16#00471#)  CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI
+      Lu,  -- (16#00472#, 16#00472#)  CYRILLIC CAPITAL LETTER FITA .. CYRILLIC CAPITAL LETTER FITA
+      Ll,  -- (16#00473#, 16#00473#)  CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA
+      Lu,  -- (16#00474#, 16#00474#)  CYRILLIC CAPITAL LETTER IZHITSA .. CYRILLIC CAPITAL LETTER IZHITSA
+      Ll,  -- (16#00475#, 16#00475#)  CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA
+      Lu,  -- (16#00476#, 16#00476#)  CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
+      Ll,  -- (16#00477#, 16#00477#)  CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
+      Lu,  -- (16#00478#, 16#00478#)  CYRILLIC CAPITAL LETTER UK .. CYRILLIC CAPITAL LETTER UK
+      Ll,  -- (16#00479#, 16#00479#)  CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK
+      Lu,  -- (16#0047A#, 16#0047A#)  CYRILLIC CAPITAL LETTER ROUND OMEGA .. CYRILLIC CAPITAL LETTER ROUND OMEGA
+      Ll,  -- (16#0047B#, 16#0047B#)  CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA
+      Lu,  -- (16#0047C#, 16#0047C#)  CYRILLIC CAPITAL LETTER OMEGA WITH TITLO .. CYRILLIC CAPITAL LETTER OMEGA WITH TITLO
+      Ll,  -- (16#0047D#, 16#0047D#)  CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO
+      Lu,  -- (16#0047E#, 16#0047E#)  CYRILLIC CAPITAL LETTER OT .. CYRILLIC CAPITAL LETTER OT
+      Ll,  -- (16#0047F#, 16#0047F#)  CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT
+      Lu,  -- (16#00480#, 16#00480#)  CYRILLIC CAPITAL LETTER KOPPA .. CYRILLIC CAPITAL LETTER KOPPA
+      Ll,  -- (16#00481#, 16#00481#)  CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA
+      So,  -- (16#00482#, 16#00482#)  CYRILLIC THOUSANDS SIGN .. CYRILLIC THOUSANDS SIGN
+      Mn,  -- (16#00483#, 16#00486#)  COMBINING CYRILLIC TITLO .. COMBINING CYRILLIC PSILI PNEUMATA
+      Me,  -- (16#00488#, 16#00489#)  COMBINING CYRILLIC HUNDRED THOUSANDS SIGN .. COMBINING CYRILLIC MILLIONS SIGN
+      Lu,  -- (16#0048A#, 16#0048A#)  CYRILLIC CAPITAL LETTER SHORT I WITH TAIL .. CYRILLIC CAPITAL LETTER SHORT I WITH TAIL
+      Ll,  -- (16#0048B#, 16#0048B#)  CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL
+      Lu,  -- (16#0048C#, 16#0048C#)  CYRILLIC CAPITAL LETTER SEMISOFT SIGN .. CYRILLIC CAPITAL LETTER SEMISOFT SIGN
+      Ll,  -- (16#0048D#, 16#0048D#)  CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN
+      Lu,  -- (16#0048E#, 16#0048E#)  CYRILLIC CAPITAL LETTER ER WITH TICK .. CYRILLIC CAPITAL LETTER ER WITH TICK
+      Ll,  -- (16#0048F#, 16#0048F#)  CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK
+      Lu,  -- (16#00490#, 16#00490#)  CYRILLIC CAPITAL LETTER GHE WITH UPTURN .. CYRILLIC CAPITAL LETTER GHE WITH UPTURN
+      Ll,  -- (16#00491#, 16#00491#)  CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN
+      Lu,  -- (16#00492#, 16#00492#)  CYRILLIC CAPITAL LETTER GHE WITH STROKE .. CYRILLIC CAPITAL LETTER GHE WITH STROKE
+      Ll,  -- (16#00493#, 16#00493#)  CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE
+      Lu,  -- (16#00494#, 16#00494#)  CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK
+      Ll,  -- (16#00495#, 16#00495#)  CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK
+      Lu,  -- (16#00496#, 16#00496#)  CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER
+      Ll,  -- (16#00497#, 16#00497#)  CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER
+      Lu,  -- (16#00498#, 16#00498#)  CYRILLIC CAPITAL LETTER ZE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ZE WITH DESCENDER
+      Ll,  -- (16#00499#, 16#00499#)  CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER
+      Lu,  -- (16#0049A#, 16#0049A#)  CYRILLIC CAPITAL LETTER KA WITH DESCENDER .. CYRILLIC CAPITAL LETTER KA WITH DESCENDER
+      Ll,  -- (16#0049B#, 16#0049B#)  CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER
+      Lu,  -- (16#0049C#, 16#0049C#)  CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE .. CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE
+      Ll,  -- (16#0049D#, 16#0049D#)  CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE
+      Lu,  -- (16#0049E#, 16#0049E#)  CYRILLIC CAPITAL LETTER KA WITH STROKE .. CYRILLIC CAPITAL LETTER KA WITH STROKE
+      Ll,  -- (16#0049F#, 16#0049F#)  CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE
+      Lu,  -- (16#004A0#, 16#004A0#)  CYRILLIC CAPITAL LETTER BASHKIR KA .. CYRILLIC CAPITAL LETTER BASHKIR KA
+      Ll,  -- (16#004A1#, 16#004A1#)  CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA
+      Lu,  -- (16#004A2#, 16#004A2#)  CYRILLIC CAPITAL LETTER EN WITH DESCENDER .. CYRILLIC CAPITAL LETTER EN WITH DESCENDER
+      Ll,  -- (16#004A3#, 16#004A3#)  CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER
+      Lu,  -- (16#004A4#, 16#004A4#)  CYRILLIC CAPITAL LIGATURE EN GHE .. CYRILLIC CAPITAL LIGATURE EN GHE
+      Ll,  -- (16#004A5#, 16#004A5#)  CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE
+      Lu,  -- (16#004A6#, 16#004A6#)  CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK .. CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK
+      Ll,  -- (16#004A7#, 16#004A7#)  CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK
+      Lu,  -- (16#004A8#, 16#004A8#)  CYRILLIC CAPITAL LETTER ABKHASIAN HA .. CYRILLIC CAPITAL LETTER ABKHASIAN HA
+      Ll,  -- (16#004A9#, 16#004A9#)  CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA
+      Lu,  -- (16#004AA#, 16#004AA#)  CYRILLIC CAPITAL LETTER ES WITH DESCENDER .. CYRILLIC CAPITAL LETTER ES WITH DESCENDER
+      Ll,  -- (16#004AB#, 16#004AB#)  CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER
+      Lu,  -- (16#004AC#, 16#004AC#)  CYRILLIC CAPITAL LETTER TE WITH DESCENDER .. CYRILLIC CAPITAL LETTER TE WITH DESCENDER
+      Ll,  -- (16#004AD#, 16#004AD#)  CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER
+      Lu,  -- (16#004AE#, 16#004AE#)  CYRILLIC CAPITAL LETTER STRAIGHT U .. CYRILLIC CAPITAL LETTER STRAIGHT U
+      Ll,  -- (16#004AF#, 16#004AF#)  CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U
+      Lu,  -- (16#004B0#, 16#004B0#)  CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE .. CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE
+      Ll,  -- (16#004B1#, 16#004B1#)  CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE
+      Lu,  -- (16#004B2#, 16#004B2#)  CYRILLIC CAPITAL LETTER HA WITH DESCENDER .. CYRILLIC CAPITAL LETTER HA WITH DESCENDER
+      Ll,  -- (16#004B3#, 16#004B3#)  CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER
+      Lu,  -- (16#004B4#, 16#004B4#)  CYRILLIC CAPITAL LIGATURE TE TSE .. CYRILLIC CAPITAL LIGATURE TE TSE
+      Ll,  -- (16#004B5#, 16#004B5#)  CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE
+      Lu,  -- (16#004B6#, 16#004B6#)  CYRILLIC CAPITAL LETTER CHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER CHE WITH DESCENDER
+      Ll,  -- (16#004B7#, 16#004B7#)  CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER
+      Lu,  -- (16#004B8#, 16#004B8#)  CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE
+      Ll,  -- (16#004B9#, 16#004B9#)  CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE
+      Lu,  -- (16#004BA#, 16#004BA#)  CYRILLIC CAPITAL LETTER SHHA .. CYRILLIC CAPITAL LETTER SHHA
+      Ll,  -- (16#004BB#, 16#004BB#)  CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA
+      Lu,  -- (16#004BC#, 16#004BC#)  CYRILLIC CAPITAL LETTER ABKHASIAN CHE .. CYRILLIC CAPITAL LETTER ABKHASIAN CHE
+      Ll,  -- (16#004BD#, 16#004BD#)  CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE
+      Lu,  -- (16#004BE#, 16#004BE#)  CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER
+      Ll,  -- (16#004BF#, 16#004BF#)  CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER
+      Lu,  -- (16#004C0#, 16#004C1#)  CYRILLIC LETTER PALOCHKA .. CYRILLIC CAPITAL LETTER ZHE WITH BREVE
+      Ll,  -- (16#004C2#, 16#004C2#)  CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE
+      Lu,  -- (16#004C3#, 16#004C3#)  CYRILLIC CAPITAL LETTER KA WITH HOOK .. CYRILLIC CAPITAL LETTER KA WITH HOOK
+      Ll,  -- (16#004C4#, 16#004C4#)  CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK
+      Lu,  -- (16#004C5#, 16#004C5#)  CYRILLIC CAPITAL LETTER EL WITH TAIL .. CYRILLIC CAPITAL LETTER EL WITH TAIL
+      Ll,  -- (16#004C6#, 16#004C6#)  CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL
+      Lu,  -- (16#004C7#, 16#004C7#)  CYRILLIC CAPITAL LETTER EN WITH HOOK .. CYRILLIC CAPITAL LETTER EN WITH HOOK
+      Ll,  -- (16#004C8#, 16#004C8#)  CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK
+      Lu,  -- (16#004C9#, 16#004C9#)  CYRILLIC CAPITAL LETTER EN WITH TAIL .. CYRILLIC CAPITAL LETTER EN WITH TAIL
+      Ll,  -- (16#004CA#, 16#004CA#)  CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL
+      Lu,  -- (16#004CB#, 16#004CB#)  CYRILLIC CAPITAL LETTER KHAKASSIAN CHE .. CYRILLIC CAPITAL LETTER KHAKASSIAN CHE
+      Ll,  -- (16#004CC#, 16#004CC#)  CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE
+      Lu,  -- (16#004CD#, 16#004CD#)  CYRILLIC CAPITAL LETTER EM WITH TAIL .. CYRILLIC CAPITAL LETTER EM WITH TAIL
+      Ll,  -- (16#004CE#, 16#004CE#)  CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL
+      Lu,  -- (16#004D0#, 16#004D0#)  CYRILLIC CAPITAL LETTER A WITH BREVE .. CYRILLIC CAPITAL LETTER A WITH BREVE
+      Ll,  -- (16#004D1#, 16#004D1#)  CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE
+      Lu,  -- (16#004D2#, 16#004D2#)  CYRILLIC CAPITAL LETTER A WITH DIAERESIS .. CYRILLIC CAPITAL LETTER A WITH DIAERESIS
+      Ll,  -- (16#004D3#, 16#004D3#)  CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS
+      Lu,  -- (16#004D4#, 16#004D4#)  CYRILLIC CAPITAL LIGATURE A IE .. CYRILLIC CAPITAL LIGATURE A IE
+      Ll,  -- (16#004D5#, 16#004D5#)  CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE
+      Lu,  -- (16#004D6#, 16#004D6#)  CYRILLIC CAPITAL LETTER IE WITH BREVE .. CYRILLIC CAPITAL LETTER IE WITH BREVE
+      Ll,  -- (16#004D7#, 16#004D7#)  CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE
+      Lu,  -- (16#004D8#, 16#004D8#)  CYRILLIC CAPITAL LETTER SCHWA .. CYRILLIC CAPITAL LETTER SCHWA
+      Ll,  -- (16#004D9#, 16#004D9#)  CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA
+      Lu,  -- (16#004DA#, 16#004DA#)  CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS .. CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS
+      Ll,  -- (16#004DB#, 16#004DB#)  CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS
+      Lu,  -- (16#004DC#, 16#004DC#)  CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS
+      Ll,  -- (16#004DD#, 16#004DD#)  CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS
+      Lu,  -- (16#004DE#, 16#004DE#)  CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS
+      Ll,  -- (16#004DF#, 16#004DF#)  CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS
+      Lu,  -- (16#004E0#, 16#004E0#)  CYRILLIC CAPITAL LETTER ABKHASIAN DZE .. CYRILLIC CAPITAL LETTER ABKHASIAN DZE
+      Ll,  -- (16#004E1#, 16#004E1#)  CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE
+      Lu,  -- (16#004E2#, 16#004E2#)  CYRILLIC CAPITAL LETTER I WITH MACRON .. CYRILLIC CAPITAL LETTER I WITH MACRON
+      Ll,  -- (16#004E3#, 16#004E3#)  CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON
+      Lu,  -- (16#004E4#, 16#004E4#)  CYRILLIC CAPITAL LETTER I WITH DIAERESIS .. CYRILLIC CAPITAL LETTER I WITH DIAERESIS
+      Ll,  -- (16#004E5#, 16#004E5#)  CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS
+      Lu,  -- (16#004E6#, 16#004E6#)  CYRILLIC CAPITAL LETTER O WITH DIAERESIS .. CYRILLIC CAPITAL LETTER O WITH DIAERESIS
+      Ll,  -- (16#004E7#, 16#004E7#)  CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS
+      Lu,  -- (16#004E8#, 16#004E8#)  CYRILLIC CAPITAL LETTER BARRED O .. CYRILLIC CAPITAL LETTER BARRED O
+      Ll,  -- (16#004E9#, 16#004E9#)  CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O
+      Lu,  -- (16#004EA#, 16#004EA#)  CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS .. CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS
+      Ll,  -- (16#004EB#, 16#004EB#)  CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS
+      Lu,  -- (16#004EC#, 16#004EC#)  CYRILLIC CAPITAL LETTER E WITH DIAERESIS .. CYRILLIC CAPITAL LETTER E WITH DIAERESIS
+      Ll,  -- (16#004ED#, 16#004ED#)  CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS
+      Lu,  -- (16#004EE#, 16#004EE#)  CYRILLIC CAPITAL LETTER U WITH MACRON .. CYRILLIC CAPITAL LETTER U WITH MACRON
+      Ll,  -- (16#004EF#, 16#004EF#)  CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON
+      Lu,  -- (16#004F0#, 16#004F0#)  CYRILLIC CAPITAL LETTER U WITH DIAERESIS .. CYRILLIC CAPITAL LETTER U WITH DIAERESIS
+      Ll,  -- (16#004F1#, 16#004F1#)  CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS
+      Lu,  -- (16#004F2#, 16#004F2#)  CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE .. CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE
+      Ll,  -- (16#004F3#, 16#004F3#)  CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE
+      Lu,  -- (16#004F4#, 16#004F4#)  CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS .. CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS
+      Ll,  -- (16#004F5#, 16#004F5#)  CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS
+      Lu,  -- (16#004F8#, 16#004F8#)  CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS .. CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS
+      Ll,  -- (16#004F9#, 16#004F9#)  CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS
+      Lu,  -- (16#00500#, 16#00500#)  CYRILLIC CAPITAL LETTER KOMI DE .. CYRILLIC CAPITAL LETTER KOMI DE
+      Ll,  -- (16#00501#, 16#00501#)  CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE
+      Lu,  -- (16#00502#, 16#00502#)  CYRILLIC CAPITAL LETTER KOMI DJE .. CYRILLIC CAPITAL LETTER KOMI DJE
+      Ll,  -- (16#00503#, 16#00503#)  CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE
+      Lu,  -- (16#00504#, 16#00504#)  CYRILLIC CAPITAL LETTER KOMI ZJE .. CYRILLIC CAPITAL LETTER KOMI ZJE
+      Ll,  -- (16#00505#, 16#00505#)  CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE
+      Lu,  -- (16#00506#, 16#00506#)  CYRILLIC CAPITAL LETTER KOMI DZJE .. CYRILLIC CAPITAL LETTER KOMI DZJE
+      Ll,  -- (16#00507#, 16#00507#)  CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE
+      Lu,  -- (16#00508#, 16#00508#)  CYRILLIC CAPITAL LETTER KOMI LJE .. CYRILLIC CAPITAL LETTER KOMI LJE
+      Ll,  -- (16#00509#, 16#00509#)  CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE
+      Lu,  -- (16#0050A#, 16#0050A#)  CYRILLIC CAPITAL LETTER KOMI NJE .. CYRILLIC CAPITAL LETTER KOMI NJE
+      Ll,  -- (16#0050B#, 16#0050B#)  CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE
+      Lu,  -- (16#0050C#, 16#0050C#)  CYRILLIC CAPITAL LETTER KOMI SJE .. CYRILLIC CAPITAL LETTER KOMI SJE
+      Ll,  -- (16#0050D#, 16#0050D#)  CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE
+      Lu,  -- (16#0050E#, 16#0050E#)  CYRILLIC CAPITAL LETTER KOMI TJE .. CYRILLIC CAPITAL LETTER KOMI TJE
+      Ll,  -- (16#0050F#, 16#0050F#)  CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE
+      Lu,  -- (16#00531#, 16#00556#)  ARMENIAN CAPITAL LETTER AYB .. ARMENIAN CAPITAL LETTER FEH
+      Lm,  -- (16#00559#, 16#00559#)  ARMENIAN MODIFIER LETTER LEFT HALF RING .. ARMENIAN MODIFIER LETTER LEFT HALF RING
+      Po,  -- (16#0055A#, 16#0055F#)  ARMENIAN APOSTROPHE .. ARMENIAN ABBREVIATION MARK
+      Ll,  -- (16#00561#, 16#00587#)  ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LIGATURE ECH YIWN
+      Po,  -- (16#00589#, 16#00589#)  ARMENIAN FULL STOP .. ARMENIAN FULL STOP
+      Pd,  -- (16#0058A#, 16#0058A#)  ARMENIAN HYPHEN .. ARMENIAN HYPHEN
+      Mn,  -- (16#00591#, 16#005A1#)  HEBREW ACCENT ETNAHTA .. HEBREW ACCENT PAZER
+      Mn,  -- (16#005A3#, 16#005B9#)  HEBREW ACCENT MUNAH .. HEBREW POINT HOLAM
+      Mn,  -- (16#005BB#, 16#005BD#)  HEBREW POINT QUBUTS .. HEBREW POINT METEG
+      Po,  -- (16#005BE#, 16#005BE#)  HEBREW PUNCTUATION MAQAF .. HEBREW PUNCTUATION MAQAF
+      Mn,  -- (16#005BF#, 16#005BF#)  HEBREW POINT RAFE .. HEBREW POINT RAFE
+      Po,  -- (16#005C0#, 16#005C0#)  HEBREW PUNCTUATION PASEQ .. HEBREW PUNCTUATION PASEQ
+      Mn,  -- (16#005C1#, 16#005C2#)  HEBREW POINT SHIN DOT .. HEBREW POINT SIN DOT
+      Po,  -- (16#005C3#, 16#005C3#)  HEBREW PUNCTUATION SOF PASUQ .. HEBREW PUNCTUATION SOF PASUQ
+      Mn,  -- (16#005C4#, 16#005C4#)  HEBREW MARK UPPER DOT .. HEBREW MARK UPPER DOT
+      Lo,  -- (16#005D0#, 16#005EA#)  HEBREW LETTER ALEF .. HEBREW LETTER TAV
+      Lo,  -- (16#005F0#, 16#005F2#)  HEBREW LIGATURE YIDDISH DOUBLE VAV .. HEBREW LIGATURE YIDDISH DOUBLE YOD
+      Po,  -- (16#005F3#, 16#005F4#)  HEBREW PUNCTUATION GERESH .. HEBREW PUNCTUATION GERSHAYIM
+      Cf,  -- (16#00600#, 16#00603#)  ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA
+      Po,  -- (16#0060C#, 16#0060D#)  ARABIC COMMA .. ARABIC DATE SEPARATOR
+      So,  -- (16#0060E#, 16#0060F#)  ARABIC POETIC VERSE SIGN .. ARABIC SIGN MISRA
+      Mn,  -- (16#00610#, 16#00615#)  ARABIC SIGN SALLALLAHOU ALAYHE WASSALLAM .. ARABIC SMALL HIGH TAH
+      Po,  -- (16#0061B#, 16#0061B#)  ARABIC SEMICOLON .. ARABIC SEMICOLON
+      Po,  -- (16#0061F#, 16#0061F#)  ARABIC QUESTION MARK .. ARABIC QUESTION MARK
+      Lo,  -- (16#00621#, 16#0063A#)  ARABIC LETTER HAMZA .. ARABIC LETTER GHAIN
+      Lm,  -- (16#00640#, 16#00640#)  ARABIC TATWEEL .. ARABIC TATWEEL
+      Lo,  -- (16#00641#, 16#0064A#)  ARABIC LETTER FEH .. ARABIC LETTER YEH
+      Mn,  -- (16#0064B#, 16#00658#)  ARABIC FATHATAN .. ARABIC MARK NOON GHUNNA
+      Nd,  -- (16#00660#, 16#00669#)  ARABIC-INDIC DIGIT ZERO .. ARABIC-INDIC DIGIT NINE
+      Po,  -- (16#0066A#, 16#0066D#)  ARABIC PERCENT SIGN .. ARABIC FIVE POINTED STAR
+      Lo,  -- (16#0066E#, 16#0066F#)  ARABIC LETTER DOTLESS BEH .. ARABIC LETTER DOTLESS QAF
+      Mn,  -- (16#00670#, 16#00670#)  ARABIC LETTER SUPERSCRIPT ALEF .. ARABIC LETTER SUPERSCRIPT ALEF
+      Lo,  -- (16#00671#, 16#006D3#)  ARABIC LETTER ALEF WASLA .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE
+      Po,  -- (16#006D4#, 16#006D4#)  ARABIC FULL STOP .. ARABIC FULL STOP
+      Lo,  -- (16#006D5#, 16#006D5#)  ARABIC LETTER AE .. ARABIC LETTER AE
+      Mn,  -- (16#006D6#, 16#006DC#)  ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA .. ARABIC SMALL HIGH SEEN
+      Cf,  -- (16#006DD#, 16#006DD#)  ARABIC END OF AYAH .. ARABIC END OF AYAH
+      Me,  -- (16#006DE#, 16#006DE#)  ARABIC START OF RUB EL HIZB .. ARABIC START OF RUB EL HIZB
+      Mn,  -- (16#006DF#, 16#006E4#)  ARABIC SMALL HIGH ROUNDED ZERO .. ARABIC SMALL HIGH MADDA
+      Lm,  -- (16#006E5#, 16#006E6#)  ARABIC SMALL WAW .. ARABIC SMALL YEH
+      Mn,  -- (16#006E7#, 16#006E8#)  ARABIC SMALL HIGH YEH .. ARABIC SMALL HIGH NOON
+      So,  -- (16#006E9#, 16#006E9#)  ARABIC PLACE OF SAJDAH .. ARABIC PLACE OF SAJDAH
+      Mn,  -- (16#006EA#, 16#006ED#)  ARABIC EMPTY CENTRE LOW STOP .. ARABIC SMALL LOW MEEM
+      Lo,  -- (16#006EE#, 16#006EF#)  ARABIC LETTER DAL WITH INVERTED V .. ARABIC LETTER REH WITH INVERTED V
+      Nd,  -- (16#006F0#, 16#006F9#)  EXTENDED ARABIC-INDIC DIGIT ZERO .. EXTENDED ARABIC-INDIC DIGIT NINE
+      Lo,  -- (16#006FA#, 16#006FC#)  ARABIC LETTER SHEEN WITH DOT BELOW .. ARABIC LETTER GHAIN WITH DOT BELOW
+      So,  -- (16#006FD#, 16#006FE#)  ARABIC SIGN SINDHI AMPERSAND .. ARABIC SIGN SINDHI POSTPOSITION MEN
+      Lo,  -- (16#006FF#, 16#006FF#)  ARABIC LETTER HEH WITH INVERTED V .. ARABIC LETTER HEH WITH INVERTED V
+      Po,  -- (16#00700#, 16#0070D#)  SYRIAC END OF PARAGRAPH .. SYRIAC HARKLEAN ASTERISCUS
+      Cf,  -- (16#0070F#, 16#0070F#)  SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK
+      Lo,  -- (16#00710#, 16#00710#)  SYRIAC LETTER ALAPH .. SYRIAC LETTER ALAPH
+      Mn,  -- (16#00711#, 16#00711#)  SYRIAC LETTER SUPERSCRIPT ALAPH .. SYRIAC LETTER SUPERSCRIPT ALAPH
+      Lo,  -- (16#00712#, 16#0072F#)  SYRIAC LETTER BETH .. SYRIAC LETTER PERSIAN DHALATH
+      Mn,  -- (16#00730#, 16#0074A#)  SYRIAC PTHAHA ABOVE .. SYRIAC BARREKH
+      Lo,  -- (16#0074D#, 16#0074F#)  SYRIAC LETTER SOGDIAN ZHAIN .. SYRIAC LETTER SOGDIAN FE
+      Lo,  -- (16#00780#, 16#007A5#)  THAANA LETTER HAA .. THAANA LETTER WAAVU
+      Mn,  -- (16#007A6#, 16#007B0#)  THAANA ABAFILI .. THAANA SUKUN
+      Lo,  -- (16#007B1#, 16#007B1#)  THAANA LETTER NAA .. THAANA LETTER NAA
+      Mn,  -- (16#00901#, 16#00902#)  DEVANAGARI SIGN CANDRABINDU .. DEVANAGARI SIGN ANUSVARA
+      Mc,  -- (16#00903#, 16#00903#)  DEVANAGARI SIGN VISARGA .. DEVANAGARI SIGN VISARGA
+      Lo,  -- (16#00904#, 16#00939#)  DEVANAGARI LETTER SHORT A .. DEVANAGARI LETTER HA
+      Mn,  -- (16#0093C#, 16#0093C#)  DEVANAGARI SIGN NUKTA .. DEVANAGARI SIGN NUKTA
+      Lo,  -- (16#0093D#, 16#0093D#)  DEVANAGARI SIGN AVAGRAHA .. DEVANAGARI SIGN AVAGRAHA
+      Mc,  -- (16#0093E#, 16#00940#)  DEVANAGARI VOWEL SIGN AA .. DEVANAGARI VOWEL SIGN II
+      Mn,  -- (16#00941#, 16#00948#)  DEVANAGARI VOWEL SIGN U .. DEVANAGARI VOWEL SIGN AI
+      Mc,  -- (16#00949#, 16#0094C#)  DEVANAGARI VOWEL SIGN CANDRA O .. DEVANAGARI VOWEL SIGN AU
+      Mn,  -- (16#0094D#, 16#0094D#)  DEVANAGARI SIGN VIRAMA .. DEVANAGARI SIGN VIRAMA
+      Lo,  -- (16#00950#, 16#00950#)  DEVANAGARI OM .. DEVANAGARI OM
+      Mn,  -- (16#00951#, 16#00954#)  DEVANAGARI STRESS SIGN UDATTA .. DEVANAGARI ACUTE ACCENT
+      Lo,  -- (16#00958#, 16#00961#)  DEVANAGARI LETTER QA .. DEVANAGARI LETTER VOCALIC LL
+      Mn,  -- (16#00962#, 16#00963#)  DEVANAGARI VOWEL SIGN VOCALIC L .. DEVANAGARI VOWEL SIGN VOCALIC LL
+      Po,  -- (16#00964#, 16#00965#)  DEVANAGARI DANDA .. DEVANAGARI DOUBLE DANDA
+      Nd,  -- (16#00966#, 16#0096F#)  DEVANAGARI DIGIT ZERO .. DEVANAGARI DIGIT NINE
+      Po,  -- (16#00970#, 16#00970#)  DEVANAGARI ABBREVIATION SIGN .. DEVANAGARI ABBREVIATION SIGN
+      Mn,  -- (16#00981#, 16#00981#)  BENGALI SIGN CANDRABINDU .. BENGALI SIGN CANDRABINDU
+      Mc,  -- (16#00982#, 16#00983#)  BENGALI SIGN ANUSVARA .. BENGALI SIGN VISARGA
+      Lo,  -- (16#00985#, 16#0098C#)  BENGALI LETTER A .. BENGALI LETTER VOCALIC L
+      Lo,  -- (16#0098F#, 16#00990#)  BENGALI LETTER E .. BENGALI LETTER AI
+      Lo,  -- (16#00993#, 16#009A8#)  BENGALI LETTER O .. BENGALI LETTER NA
+      Lo,  -- (16#009AA#, 16#009B0#)  BENGALI LETTER PA .. BENGALI LETTER RA
+      Lo,  -- (16#009B2#, 16#009B2#)  BENGALI LETTER LA .. BENGALI LETTER LA
+      Lo,  -- (16#009B6#, 16#009B9#)  BENGALI LETTER SHA .. BENGALI LETTER HA
+      Mn,  -- (16#009BC#, 16#009BC#)  BENGALI SIGN NUKTA .. BENGALI SIGN NUKTA
+      Lo,  -- (16#009BD#, 16#009BD#)  BENGALI SIGN AVAGRAHA .. BENGALI SIGN AVAGRAHA
+      Mc,  -- (16#009BE#, 16#009C0#)  BENGALI VOWEL SIGN AA .. BENGALI VOWEL SIGN II
+      Mn,  -- (16#009C1#, 16#009C4#)  BENGALI VOWEL SIGN U .. BENGALI VOWEL SIGN VOCALIC RR
+      Mc,  -- (16#009C7#, 16#009C8#)  BENGALI VOWEL SIGN E .. BENGALI VOWEL SIGN AI
+      Mc,  -- (16#009CB#, 16#009CC#)  BENGALI VOWEL SIGN O .. BENGALI VOWEL SIGN AU
+      Mn,  -- (16#009CD#, 16#009CD#)  BENGALI SIGN VIRAMA .. BENGALI SIGN VIRAMA
+      Mc,  -- (16#009D7#, 16#009D7#)  BENGALI AU LENGTH MARK .. BENGALI AU LENGTH MARK
+      Lo,  -- (16#009DC#, 16#009DD#)  BENGALI LETTER RRA .. BENGALI LETTER RHA
+      Lo,  -- (16#009DF#, 16#009E1#)  BENGALI LETTER YYA .. BENGALI LETTER VOCALIC LL
+      Mn,  -- (16#009E2#, 16#009E3#)  BENGALI VOWEL SIGN VOCALIC L .. BENGALI VOWEL SIGN VOCALIC LL
+      Nd,  -- (16#009E6#, 16#009EF#)  BENGALI DIGIT ZERO .. BENGALI DIGIT NINE
+      Lo,  -- (16#009F0#, 16#009F1#)  BENGALI LETTER RA WITH MIDDLE DIAGONAL .. BENGALI LETTER RA WITH LOWER DIAGONAL
+      Sc,  -- (16#009F2#, 16#009F3#)  BENGALI RUPEE MARK .. BENGALI RUPEE SIGN
+      No,  -- (16#009F4#, 16#009F9#)  BENGALI CURRENCY NUMERATOR ONE .. BENGALI CURRENCY DENOMINATOR SIXTEEN
+      So,  -- (16#009FA#, 16#009FA#)  BENGALI ISSHAR .. BENGALI ISSHAR
+      Mn,  -- (16#00A01#, 16#00A02#)  GURMUKHI SIGN ADAK BINDI .. GURMUKHI SIGN BINDI
+      Mc,  -- (16#00A03#, 16#00A03#)  GURMUKHI SIGN VISARGA .. GURMUKHI SIGN VISARGA
+      Lo,  -- (16#00A05#, 16#00A0A#)  GURMUKHI LETTER A .. GURMUKHI LETTER UU
+      Lo,  -- (16#00A0F#, 16#00A10#)  GURMUKHI LETTER EE .. GURMUKHI LETTER AI
+      Lo,  -- (16#00A13#, 16#00A28#)  GURMUKHI LETTER OO .. GURMUKHI LETTER NA
+      Lo,  -- (16#00A2A#, 16#00A30#)  GURMUKHI LETTER PA .. GURMUKHI LETTER RA
+      Lo,  -- (16#00A32#, 16#00A33#)  GURMUKHI LETTER LA .. GURMUKHI LETTER LLA
+      Lo,  -- (16#00A35#, 16#00A36#)  GURMUKHI LETTER VA .. GURMUKHI LETTER SHA
+      Lo,  -- (16#00A38#, 16#00A39#)  GURMUKHI LETTER SA .. GURMUKHI LETTER HA
+      Mn,  -- (16#00A3C#, 16#00A3C#)  GURMUKHI SIGN NUKTA .. GURMUKHI SIGN NUKTA
+      Mc,  -- (16#00A3E#, 16#00A40#)  GURMUKHI VOWEL SIGN AA .. GURMUKHI VOWEL SIGN II
+      Mn,  -- (16#00A41#, 16#00A42#)  GURMUKHI VOWEL SIGN U .. GURMUKHI VOWEL SIGN UU
+      Mn,  -- (16#00A47#, 16#00A48#)  GURMUKHI VOWEL SIGN EE .. GURMUKHI VOWEL SIGN AI
+      Mn,  -- (16#00A4B#, 16#00A4D#)  GURMUKHI VOWEL SIGN OO .. GURMUKHI SIGN VIRAMA
+      Lo,  -- (16#00A59#, 16#00A5C#)  GURMUKHI LETTER KHHA .. GURMUKHI LETTER RRA
+      Lo,  -- (16#00A5E#, 16#00A5E#)  GURMUKHI LETTER FA .. GURMUKHI LETTER FA
+      Nd,  -- (16#00A66#, 16#00A6F#)  GURMUKHI DIGIT ZERO .. GURMUKHI DIGIT NINE
+      Mn,  -- (16#00A70#, 16#00A71#)  GURMUKHI TIPPI .. GURMUKHI ADDAK
+      Lo,  -- (16#00A72#, 16#00A74#)  GURMUKHI IRI .. GURMUKHI EK ONKAR
+      Mn,  -- (16#00A81#, 16#00A82#)  GUJARATI SIGN CANDRABINDU .. GUJARATI SIGN ANUSVARA
+      Mc,  -- (16#00A83#, 16#00A83#)  GUJARATI SIGN VISARGA .. GUJARATI SIGN VISARGA
+      Lo,  -- (16#00A85#, 16#00A8D#)  GUJARATI LETTER A .. GUJARATI VOWEL CANDRA E
+      Lo,  -- (16#00A8F#, 16#00A91#)  GUJARATI LETTER E .. GUJARATI VOWEL CANDRA O
+      Lo,  -- (16#00A93#, 16#00AA8#)  GUJARATI LETTER O .. GUJARATI LETTER NA
+      Lo,  -- (16#00AAA#, 16#00AB0#)  GUJARATI LETTER PA .. GUJARATI LETTER RA
+      Lo,  -- (16#00AB2#, 16#00AB3#)  GUJARATI LETTER LA .. GUJARATI LETTER LLA
+      Lo,  -- (16#00AB5#, 16#00AB9#)  GUJARATI LETTER VA .. GUJARATI LETTER HA
+      Mn,  -- (16#00ABC#, 16#00ABC#)  GUJARATI SIGN NUKTA .. GUJARATI SIGN NUKTA
+      Lo,  -- (16#00ABD#, 16#00ABD#)  GUJARATI SIGN AVAGRAHA .. GUJARATI SIGN AVAGRAHA
+      Mc,  -- (16#00ABE#, 16#00AC0#)  GUJARATI VOWEL SIGN AA .. GUJARATI VOWEL SIGN II
+      Mn,  -- (16#00AC1#, 16#00AC5#)  GUJARATI VOWEL SIGN U .. GUJARATI VOWEL SIGN CANDRA E
+      Mn,  -- (16#00AC7#, 16#00AC8#)  GUJARATI VOWEL SIGN E .. GUJARATI VOWEL SIGN AI
+      Mc,  -- (16#00AC9#, 16#00AC9#)  GUJARATI VOWEL SIGN CANDRA O .. GUJARATI VOWEL SIGN CANDRA O
+      Mc,  -- (16#00ACB#, 16#00ACC#)  GUJARATI VOWEL SIGN O .. GUJARATI VOWEL SIGN AU
+      Mn,  -- (16#00ACD#, 16#00ACD#)  GUJARATI SIGN VIRAMA .. GUJARATI SIGN VIRAMA
+      Lo,  -- (16#00AD0#, 16#00AD0#)  GUJARATI OM .. GUJARATI OM
+      Lo,  -- (16#00AE0#, 16#00AE1#)  GUJARATI LETTER VOCALIC RR .. GUJARATI LETTER VOCALIC LL
+      Mn,  -- (16#00AE2#, 16#00AE3#)  GUJARATI VOWEL SIGN VOCALIC L .. GUJARATI VOWEL SIGN VOCALIC LL
+      Nd,  -- (16#00AE6#, 16#00AEF#)  GUJARATI DIGIT ZERO .. GUJARATI DIGIT NINE
+      Sc,  -- (16#00AF1#, 16#00AF1#)  GUJARATI RUPEE SIGN .. GUJARATI RUPEE SIGN
+      Mn,  -- (16#00B01#, 16#00B01#)  ORIYA SIGN CANDRABINDU .. ORIYA SIGN CANDRABINDU
+      Mc,  -- (16#00B02#, 16#00B03#)  ORIYA SIGN ANUSVARA .. ORIYA SIGN VISARGA
+      Lo,  -- (16#00B05#, 16#00B0C#)  ORIYA LETTER A .. ORIYA LETTER VOCALIC L
+      Lo,  -- (16#00B0F#, 16#00B10#)  ORIYA LETTER E .. ORIYA LETTER AI
+      Lo,  -- (16#00B13#, 16#00B28#)  ORIYA LETTER O .. ORIYA LETTER NA
+      Lo,  -- (16#00B2A#, 16#00B30#)  ORIYA LETTER PA .. ORIYA LETTER RA
+      Lo,  -- (16#00B32#, 16#00B33#)  ORIYA LETTER LA .. ORIYA LETTER LLA
+      Lo,  -- (16#00B35#, 16#00B39#)  ORIYA LETTER VA .. ORIYA LETTER HA
+      Mn,  -- (16#00B3C#, 16#00B3C#)  ORIYA SIGN NUKTA .. ORIYA SIGN NUKTA
+      Lo,  -- (16#00B3D#, 16#00B3D#)  ORIYA SIGN AVAGRAHA .. ORIYA SIGN AVAGRAHA
+      Mc,  -- (16#00B3E#, 16#00B3E#)  ORIYA VOWEL SIGN AA .. ORIYA VOWEL SIGN AA
+      Mn,  -- (16#00B3F#, 16#00B3F#)  ORIYA VOWEL SIGN I .. ORIYA VOWEL SIGN I
+      Mc,  -- (16#00B40#, 16#00B40#)  ORIYA VOWEL SIGN II .. ORIYA VOWEL SIGN II
+      Mn,  -- (16#00B41#, 16#00B43#)  ORIYA VOWEL SIGN U .. ORIYA VOWEL SIGN VOCALIC R
+      Mc,  -- (16#00B47#, 16#00B48#)  ORIYA VOWEL SIGN E .. ORIYA VOWEL SIGN AI
+      Mc,  -- (16#00B4B#, 16#00B4C#)  ORIYA VOWEL SIGN O .. ORIYA VOWEL SIGN AU
+      Mn,  -- (16#00B4D#, 16#00B4D#)  ORIYA SIGN VIRAMA .. ORIYA SIGN VIRAMA
+      Mn,  -- (16#00B56#, 16#00B56#)  ORIYA AI LENGTH MARK .. ORIYA AI LENGTH MARK
+      Mc,  -- (16#00B57#, 16#00B57#)  ORIYA AU LENGTH MARK .. ORIYA AU LENGTH MARK
+      Lo,  -- (16#00B5C#, 16#00B5D#)  ORIYA LETTER RRA .. ORIYA LETTER RHA
+      Lo,  -- (16#00B5F#, 16#00B61#)  ORIYA LETTER YYA .. ORIYA LETTER VOCALIC LL
+      Nd,  -- (16#00B66#, 16#00B6F#)  ORIYA DIGIT ZERO .. ORIYA DIGIT NINE
+      So,  -- (16#00B70#, 16#00B70#)  ORIYA ISSHAR .. ORIYA ISSHAR
+      Lo,  -- (16#00B71#, 16#00B71#)  ORIYA LETTER WA .. ORIYA LETTER WA
+      Mn,  -- (16#00B82#, 16#00B82#)  TAMIL SIGN ANUSVARA .. TAMIL SIGN ANUSVARA
+      Lo,  -- (16#00B83#, 16#00B83#)  TAMIL SIGN VISARGA .. TAMIL SIGN VISARGA
+      Lo,  -- (16#00B85#, 16#00B8A#)  TAMIL LETTER A .. TAMIL LETTER UU
+      Lo,  -- (16#00B8E#, 16#00B90#)  TAMIL LETTER E .. TAMIL LETTER AI
+      Lo,  -- (16#00B92#, 16#00B95#)  TAMIL LETTER O .. TAMIL LETTER KA
+      Lo,  -- (16#00B99#, 16#00B9A#)  TAMIL LETTER NGA .. TAMIL LETTER CA
+      Lo,  -- (16#00B9C#, 16#00B9C#)  TAMIL LETTER JA .. TAMIL LETTER JA
+      Lo,  -- (16#00B9E#, 16#00B9F#)  TAMIL LETTER NYA .. TAMIL LETTER TTA
+      Lo,  -- (16#00BA3#, 16#00BA4#)  TAMIL LETTER NNA .. TAMIL LETTER TA
+      Lo,  -- (16#00BA8#, 16#00BAA#)  TAMIL LETTER NA .. TAMIL LETTER PA
+      Lo,  -- (16#00BAE#, 16#00BB5#)  TAMIL LETTER MA .. TAMIL LETTER VA
+      Lo,  -- (16#00BB7#, 16#00BB9#)  TAMIL LETTER SSA .. TAMIL LETTER HA
+      Mc,  -- (16#00BBE#, 16#00BBF#)  TAMIL VOWEL SIGN AA .. TAMIL VOWEL SIGN I
+      Mn,  -- (16#00BC0#, 16#00BC0#)  TAMIL VOWEL SIGN II .. TAMIL VOWEL SIGN II
+      Mc,  -- (16#00BC1#, 16#00BC2#)  TAMIL VOWEL SIGN U .. TAMIL VOWEL SIGN UU
+      Mc,  -- (16#00BC6#, 16#00BC8#)  TAMIL VOWEL SIGN E .. TAMIL VOWEL SIGN AI
+      Mc,  -- (16#00BCA#, 16#00BCC#)  TAMIL VOWEL SIGN O .. TAMIL VOWEL SIGN AU
+      Mn,  -- (16#00BCD#, 16#00BCD#)  TAMIL SIGN VIRAMA .. TAMIL SIGN VIRAMA
+      Mc,  -- (16#00BD7#, 16#00BD7#)  TAMIL AU LENGTH MARK .. TAMIL AU LENGTH MARK
+      Nd,  -- (16#00BE7#, 16#00BEF#)  TAMIL DIGIT ONE .. TAMIL DIGIT NINE
+      No,  -- (16#00BF0#, 16#00BF2#)  TAMIL NUMBER TEN .. TAMIL NUMBER ONE THOUSAND
+      So,  -- (16#00BF3#, 16#00BF8#)  TAMIL DAY SIGN .. TAMIL AS ABOVE SIGN
+      Sc,  -- (16#00BF9#, 16#00BF9#)  TAMIL RUPEE SIGN .. TAMIL RUPEE SIGN
+      So,  -- (16#00BFA#, 16#00BFA#)  TAMIL NUMBER SIGN .. TAMIL NUMBER SIGN
+      Mc,  -- (16#00C01#, 16#00C03#)  TELUGU SIGN CANDRABINDU .. TELUGU SIGN VISARGA
+      Lo,  -- (16#00C05#, 16#00C0C#)  TELUGU LETTER A .. TELUGU LETTER VOCALIC L
+      Lo,  -- (16#00C0E#, 16#00C10#)  TELUGU LETTER E .. TELUGU LETTER AI
+      Lo,  -- (16#00C12#, 16#00C28#)  TELUGU LETTER O .. TELUGU LETTER NA
+      Lo,  -- (16#00C2A#, 16#00C33#)  TELUGU LETTER PA .. TELUGU LETTER LLA
+      Lo,  -- (16#00C35#, 16#00C39#)  TELUGU LETTER VA .. TELUGU LETTER HA
+      Mn,  -- (16#00C3E#, 16#00C40#)  TELUGU VOWEL SIGN AA .. TELUGU VOWEL SIGN II
+      Mc,  -- (16#00C41#, 16#00C44#)  TELUGU VOWEL SIGN U .. TELUGU VOWEL SIGN VOCALIC RR
+      Mn,  -- (16#00C46#, 16#00C48#)  TELUGU VOWEL SIGN E .. TELUGU VOWEL SIGN AI
+      Mn,  -- (16#00C4A#, 16#00C4D#)  TELUGU VOWEL SIGN O .. TELUGU SIGN VIRAMA
+      Mn,  -- (16#00C55#, 16#00C56#)  TELUGU LENGTH MARK .. TELUGU AI LENGTH MARK
+      Lo,  -- (16#00C60#, 16#00C61#)  TELUGU LETTER VOCALIC RR .. TELUGU LETTER VOCALIC LL
+      Nd,  -- (16#00C66#, 16#00C6F#)  TELUGU DIGIT ZERO .. TELUGU DIGIT NINE
+      Mc,  -- (16#00C82#, 16#00C83#)  KANNADA SIGN ANUSVARA .. KANNADA SIGN VISARGA
+      Lo,  -- (16#00C85#, 16#00C8C#)  KANNADA LETTER A .. KANNADA LETTER VOCALIC L
+      Lo,  -- (16#00C8E#, 16#00C90#)  KANNADA LETTER E .. KANNADA LETTER AI
+      Lo,  -- (16#00C92#, 16#00CA8#)  KANNADA LETTER O .. KANNADA LETTER NA
+      Lo,  -- (16#00CAA#, 16#00CB3#)  KANNADA LETTER PA .. KANNADA LETTER LLA
+      Lo,  -- (16#00CB5#, 16#00CB9#)  KANNADA LETTER VA .. KANNADA LETTER HA
+      Mn,  -- (16#00CBC#, 16#00CBC#)  KANNADA SIGN NUKTA .. KANNADA SIGN NUKTA
+      Lo,  -- (16#00CBD#, 16#00CBD#)  KANNADA SIGN AVAGRAHA .. KANNADA SIGN AVAGRAHA
+      Mc,  -- (16#00CBE#, 16#00CBE#)  KANNADA VOWEL SIGN AA .. KANNADA VOWEL SIGN AA
+      Mn,  -- (16#00CBF#, 16#00CBF#)  KANNADA VOWEL SIGN I .. KANNADA VOWEL SIGN I
+      Mc,  -- (16#00CC0#, 16#00CC4#)  KANNADA VOWEL SIGN II .. KANNADA VOWEL SIGN VOCALIC RR
+      Mn,  -- (16#00CC6#, 16#00CC6#)  KANNADA VOWEL SIGN E .. KANNADA VOWEL SIGN E
+      Mc,  -- (16#00CC7#, 16#00CC8#)  KANNADA VOWEL SIGN EE .. KANNADA VOWEL SIGN AI
+      Mc,  -- (16#00CCA#, 16#00CCB#)  KANNADA VOWEL SIGN O .. KANNADA VOWEL SIGN OO
+      Mn,  -- (16#00CCC#, 16#00CCD#)  KANNADA VOWEL SIGN AU .. KANNADA SIGN VIRAMA
+      Mc,  -- (16#00CD5#, 16#00CD6#)  KANNADA LENGTH MARK .. KANNADA AI LENGTH MARK
+      Lo,  -- (16#00CDE#, 16#00CDE#)  KANNADA LETTER FA .. KANNADA LETTER FA
+      Lo,  -- (16#00CE0#, 16#00CE1#)  KANNADA LETTER VOCALIC RR .. KANNADA LETTER VOCALIC LL
+      Nd,  -- (16#00CE6#, 16#00CEF#)  KANNADA DIGIT ZERO .. KANNADA DIGIT NINE
+      Mc,  -- (16#00D02#, 16#00D03#)  MALAYALAM SIGN ANUSVARA .. MALAYALAM SIGN VISARGA
+      Lo,  -- (16#00D05#, 16#00D0C#)  MALAYALAM LETTER A .. MALAYALAM LETTER VOCALIC L
+      Lo,  -- (16#00D0E#, 16#00D10#)  MALAYALAM LETTER E .. MALAYALAM LETTER AI
+      Lo,  -- (16#00D12#, 16#00D28#)  MALAYALAM LETTER O .. MALAYALAM LETTER NA
+      Lo,  -- (16#00D2A#, 16#00D39#)  MALAYALAM LETTER PA .. MALAYALAM LETTER HA
+      Mc,  -- (16#00D3E#, 16#00D40#)  MALAYALAM VOWEL SIGN AA .. MALAYALAM VOWEL SIGN II
+      Mn,  -- (16#00D41#, 16#00D43#)  MALAYALAM VOWEL SIGN U .. MALAYALAM VOWEL SIGN VOCALIC R
+      Mc,  -- (16#00D46#, 16#00D48#)  MALAYALAM VOWEL SIGN E .. MALAYALAM VOWEL SIGN AI
+      Mc,  -- (16#00D4A#, 16#00D4C#)  MALAYALAM VOWEL SIGN O .. MALAYALAM VOWEL SIGN AU
+      Mn,  -- (16#00D4D#, 16#00D4D#)  MALAYALAM SIGN VIRAMA .. MALAYALAM SIGN VIRAMA
+      Mc,  -- (16#00D57#, 16#00D57#)  MALAYALAM AU LENGTH MARK .. MALAYALAM AU LENGTH MARK
+      Lo,  -- (16#00D60#, 16#00D61#)  MALAYALAM LETTER VOCALIC RR .. MALAYALAM LETTER VOCALIC LL
+      Nd,  -- (16#00D66#, 16#00D6F#)  MALAYALAM DIGIT ZERO .. MALAYALAM DIGIT NINE
+      Mc,  -- (16#00D82#, 16#00D83#)  SINHALA SIGN ANUSVARAYA .. SINHALA SIGN VISARGAYA
+      Lo,  -- (16#00D85#, 16#00D96#)  SINHALA LETTER AYANNA .. SINHALA LETTER AUYANNA
+      Lo,  -- (16#00D9A#, 16#00DB1#)  SINHALA LETTER ALPAPRAANA KAYANNA .. SINHALA LETTER DANTAJA NAYANNA
+      Lo,  -- (16#00DB3#, 16#00DBB#)  SINHALA LETTER SANYAKA DAYANNA .. SINHALA LETTER RAYANNA
+      Lo,  -- (16#00DBD#, 16#00DBD#)  SINHALA LETTER DANTAJA LAYANNA .. SINHALA LETTER DANTAJA LAYANNA
+      Lo,  -- (16#00DC0#, 16#00DC6#)  SINHALA LETTER VAYANNA .. SINHALA LETTER FAYANNA
+      Mn,  -- (16#00DCA#, 16#00DCA#)  SINHALA SIGN AL-LAKUNA .. SINHALA SIGN AL-LAKUNA
+      Mc,  -- (16#00DCF#, 16#00DD1#)  SINHALA VOWEL SIGN AELA-PILLA .. SINHALA VOWEL SIGN DIGA AEDA-PILLA
+      Mn,  -- (16#00DD2#, 16#00DD4#)  SINHALA VOWEL SIGN KETTI IS-PILLA .. SINHALA VOWEL SIGN KETTI PAA-PILLA
+      Mn,  -- (16#00DD6#, 16#00DD6#)  SINHALA VOWEL SIGN DIGA PAA-PILLA .. SINHALA VOWEL SIGN DIGA PAA-PILLA
+      Mc,  -- (16#00DD8#, 16#00DDF#)  SINHALA VOWEL SIGN GAETTA-PILLA .. SINHALA VOWEL SIGN GAYANUKITTA
+      Mc,  -- (16#00DF2#, 16#00DF3#)  SINHALA VOWEL SIGN DIGA GAETTA-PILLA .. SINHALA VOWEL SIGN DIGA GAYANUKITTA
+      Po,  -- (16#00DF4#, 16#00DF4#)  SINHALA PUNCTUATION KUNDDALIYA .. SINHALA PUNCTUATION KUNDDALIYA
+      Lo,  -- (16#00E01#, 16#00E30#)  THAI CHARACTER KO KAI .. THAI CHARACTER SARA A
+      Mn,  -- (16#00E31#, 16#00E31#)  THAI CHARACTER MAI HAN-AKAT .. THAI CHARACTER MAI HAN-AKAT
+      Lo,  -- (16#00E32#, 16#00E33#)  THAI CHARACTER SARA AA .. THAI CHARACTER SARA AM
+      Mn,  -- (16#00E34#, 16#00E3A#)  THAI CHARACTER SARA I .. THAI CHARACTER PHINTHU
+      Sc,  -- (16#00E3F#, 16#00E3F#)  THAI CURRENCY SYMBOL BAHT .. THAI CURRENCY SYMBOL BAHT
+      Lo,  -- (16#00E40#, 16#00E45#)  THAI CHARACTER SARA E .. THAI CHARACTER LAKKHANGYAO
+      Lm,  -- (16#00E46#, 16#00E46#)  THAI CHARACTER MAIYAMOK .. THAI CHARACTER MAIYAMOK
+      Mn,  -- (16#00E47#, 16#00E4E#)  THAI CHARACTER MAITAIKHU .. THAI CHARACTER YAMAKKAN
+      Po,  -- (16#00E4F#, 16#00E4F#)  THAI CHARACTER FONGMAN .. THAI CHARACTER FONGMAN
+      Nd,  -- (16#00E50#, 16#00E59#)  THAI DIGIT ZERO .. THAI DIGIT NINE
+      Po,  -- (16#00E5A#, 16#00E5B#)  THAI CHARACTER ANGKHANKHU .. THAI CHARACTER KHOMUT
+      Lo,  -- (16#00E81#, 16#00E82#)  LAO LETTER KO .. LAO LETTER KHO SUNG
+      Lo,  -- (16#00E84#, 16#00E84#)  LAO LETTER KHO TAM .. LAO LETTER KHO TAM
+      Lo,  -- (16#00E87#, 16#00E88#)  LAO LETTER NGO .. LAO LETTER CO
+      Lo,  -- (16#00E8A#, 16#00E8A#)  LAO LETTER SO TAM .. LAO LETTER SO TAM
+      Lo,  -- (16#00E8D#, 16#00E8D#)  LAO LETTER NYO .. LAO LETTER NYO
+      Lo,  -- (16#00E94#, 16#00E97#)  LAO LETTER DO .. LAO LETTER THO TAM
+      Lo,  -- (16#00E99#, 16#00E9F#)  LAO LETTER NO .. LAO LETTER FO SUNG
+      Lo,  -- (16#00EA1#, 16#00EA3#)  LAO LETTER MO .. LAO LETTER LO LING
+      Lo,  -- (16#00EA5#, 16#00EA5#)  LAO LETTER LO LOOT .. LAO LETTER LO LOOT
+      Lo,  -- (16#00EA7#, 16#00EA7#)  LAO LETTER WO .. LAO LETTER WO
+      Lo,  -- (16#00EAA#, 16#00EAB#)  LAO LETTER SO SUNG .. LAO LETTER HO SUNG
+      Lo,  -- (16#00EAD#, 16#00EB0#)  LAO LETTER O .. LAO VOWEL SIGN A
+      Mn,  -- (16#00EB1#, 16#00EB1#)  LAO VOWEL SIGN MAI KAN .. LAO VOWEL SIGN MAI KAN
+      Lo,  -- (16#00EB2#, 16#00EB3#)  LAO VOWEL SIGN AA .. LAO VOWEL SIGN AM
+      Mn,  -- (16#00EB4#, 16#00EB9#)  LAO VOWEL SIGN I .. LAO VOWEL SIGN UU
+      Mn,  -- (16#00EBB#, 16#00EBC#)  LAO VOWEL SIGN MAI KON .. LAO SEMIVOWEL SIGN LO
+      Lo,  -- (16#00EBD#, 16#00EBD#)  LAO SEMIVOWEL SIGN NYO .. LAO SEMIVOWEL SIGN NYO
+      Lo,  -- (16#00EC0#, 16#00EC4#)  LAO VOWEL SIGN E .. LAO VOWEL SIGN AI
+      Lm,  -- (16#00EC6#, 16#00EC6#)  LAO KO LA .. LAO KO LA
+      Mn,  -- (16#00EC8#, 16#00ECD#)  LAO TONE MAI EK .. LAO NIGGAHITA
+      Nd,  -- (16#00ED0#, 16#00ED9#)  LAO DIGIT ZERO .. LAO DIGIT NINE
+      Lo,  -- (16#00EDC#, 16#00EDD#)  LAO HO NO .. LAO HO MO
+      Lo,  -- (16#00F00#, 16#00F00#)  TIBETAN SYLLABLE OM .. TIBETAN SYLLABLE OM
+      So,  -- (16#00F01#, 16#00F03#)  TIBETAN MARK GTER YIG MGO TRUNCATED A .. TIBETAN MARK GTER YIG MGO -UM GTER TSHEG MA
+      Po,  -- (16#00F04#, 16#00F12#)  TIBETAN MARK INITIAL YIG MGO MDUN MA .. TIBETAN MARK RGYA GRAM SHAD
+      So,  -- (16#00F13#, 16#00F17#)  TIBETAN MARK CARET -DZUD RTAGS ME LONG CAN .. TIBETAN ASTROLOGICAL SIGN SGRA GCAN -CHAR RTAGS
+      Mn,  -- (16#00F18#, 16#00F19#)  TIBETAN ASTROLOGICAL SIGN -KHYUD PA .. TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS
+      So,  -- (16#00F1A#, 16#00F1F#)  TIBETAN SIGN RDEL DKAR GCIG .. TIBETAN SIGN RDEL DKAR RDEL NAG
+      Nd,  -- (16#00F20#, 16#00F29#)  TIBETAN DIGIT ZERO .. TIBETAN DIGIT NINE
+      No,  -- (16#00F2A#, 16#00F33#)  TIBETAN DIGIT HALF ONE .. TIBETAN DIGIT HALF ZERO
+      So,  -- (16#00F34#, 16#00F34#)  TIBETAN MARK BSDUS RTAGS .. TIBETAN MARK BSDUS RTAGS
+      Mn,  -- (16#00F35#, 16#00F35#)  TIBETAN MARK NGAS BZUNG NYI ZLA .. TIBETAN MARK NGAS BZUNG NYI ZLA
+      So,  -- (16#00F36#, 16#00F36#)  TIBETAN MARK CARET -DZUD RTAGS BZHI MIG CAN .. TIBETAN MARK CARET -DZUD RTAGS BZHI MIG CAN
+      Mn,  -- (16#00F37#, 16#00F37#)  TIBETAN MARK NGAS BZUNG SGOR RTAGS .. TIBETAN MARK NGAS BZUNG SGOR RTAGS
+      So,  -- (16#00F38#, 16#00F38#)  TIBETAN MARK CHE MGO .. TIBETAN MARK CHE MGO
+      Mn,  -- (16#00F39#, 16#00F39#)  TIBETAN MARK TSA -PHRU .. TIBETAN MARK TSA -PHRU
+      Ps,  -- (16#00F3A#, 16#00F3A#)  TIBETAN MARK GUG RTAGS GYON .. TIBETAN MARK GUG RTAGS GYON
+      Pe,  -- (16#00F3B#, 16#00F3B#)  TIBETAN MARK GUG RTAGS GYAS .. TIBETAN MARK GUG RTAGS GYAS
+      Ps,  -- (16#00F3C#, 16#00F3C#)  TIBETAN MARK ANG KHANG GYON .. TIBETAN MARK ANG KHANG GYON
+      Pe,  -- (16#00F3D#, 16#00F3D#)  TIBETAN MARK ANG KHANG GYAS .. TIBETAN MARK ANG KHANG GYAS
+      Mc,  -- (16#00F3E#, 16#00F3F#)  TIBETAN SIGN YAR TSHES .. TIBETAN SIGN MAR TSHES
+      Lo,  -- (16#00F40#, 16#00F47#)  TIBETAN LETTER KA .. TIBETAN LETTER JA
+      Lo,  -- (16#00F49#, 16#00F6A#)  TIBETAN LETTER NYA .. TIBETAN LETTER FIXED-FORM RA
+      Mn,  -- (16#00F71#, 16#00F7E#)  TIBETAN VOWEL SIGN AA .. TIBETAN SIGN RJES SU NGA RO
+      Mc,  -- (16#00F7F#, 16#00F7F#)  TIBETAN SIGN RNAM BCAD .. TIBETAN SIGN RNAM BCAD
+      Mn,  -- (16#00F80#, 16#00F84#)  TIBETAN VOWEL SIGN REVERSED I .. TIBETAN MARK HALANTA
+      Po,  -- (16#00F85#, 16#00F85#)  TIBETAN MARK PALUTA .. TIBETAN MARK PALUTA
+      Mn,  -- (16#00F86#, 16#00F87#)  TIBETAN SIGN LCI RTAGS .. TIBETAN SIGN YANG RTAGS
+      Lo,  -- (16#00F88#, 16#00F8B#)  TIBETAN SIGN LCE TSA CAN .. TIBETAN SIGN GRU MED RGYINGS
+      Mn,  -- (16#00F90#, 16#00F97#)  TIBETAN SUBJOINED LETTER KA .. TIBETAN SUBJOINED LETTER JA
+      Mn,  -- (16#00F99#, 16#00FBC#)  TIBETAN SUBJOINED LETTER NYA .. TIBETAN SUBJOINED LETTER FIXED-FORM RA
+      So,  -- (16#00FBE#, 16#00FC5#)  TIBETAN KU RU KHA .. TIBETAN SYMBOL RDO RJE
+      Mn,  -- (16#00FC6#, 16#00FC6#)  TIBETAN SYMBOL PADMA GDAN .. TIBETAN SYMBOL PADMA GDAN
+      So,  -- (16#00FC7#, 16#00FCC#)  TIBETAN SYMBOL RDO RJE RGYA GRAM .. TIBETAN SYMBOL NOR BU BZHI -KHYIL
+      So,  -- (16#00FCF#, 16#00FCF#)  TIBETAN SIGN RDEL NAG GSUM .. TIBETAN SIGN RDEL NAG GSUM
+      Lo,  -- (16#01000#, 16#01021#)  MYANMAR LETTER KA .. MYANMAR LETTER A
+      Lo,  -- (16#01023#, 16#01027#)  MYANMAR LETTER I .. MYANMAR LETTER E
+      Lo,  -- (16#01029#, 16#0102A#)  MYANMAR LETTER O .. MYANMAR LETTER AU
+      Mc,  -- (16#0102C#, 16#0102C#)  MYANMAR VOWEL SIGN AA .. MYANMAR VOWEL SIGN AA
+      Mn,  -- (16#0102D#, 16#01030#)  MYANMAR VOWEL SIGN I .. MYANMAR VOWEL SIGN UU
+      Mc,  -- (16#01031#, 16#01031#)  MYANMAR VOWEL SIGN E .. MYANMAR VOWEL SIGN E
+      Mn,  -- (16#01032#, 16#01032#)  MYANMAR VOWEL SIGN AI .. MYANMAR VOWEL SIGN AI
+      Mn,  -- (16#01036#, 16#01037#)  MYANMAR SIGN ANUSVARA .. MYANMAR SIGN DOT BELOW
+      Mc,  -- (16#01038#, 16#01038#)  MYANMAR SIGN VISARGA .. MYANMAR SIGN VISARGA
+      Mn,  -- (16#01039#, 16#01039#)  MYANMAR SIGN VIRAMA .. MYANMAR SIGN VIRAMA
+      Nd,  -- (16#01040#, 16#01049#)  MYANMAR DIGIT ZERO .. MYANMAR DIGIT NINE
+      Po,  -- (16#0104A#, 16#0104F#)  MYANMAR SIGN LITTLE SECTION .. MYANMAR SYMBOL GENITIVE
+      Lo,  -- (16#01050#, 16#01055#)  MYANMAR LETTER SHA .. MYANMAR LETTER VOCALIC LL
+      Mc,  -- (16#01056#, 16#01057#)  MYANMAR VOWEL SIGN VOCALIC R .. MYANMAR VOWEL SIGN VOCALIC RR
+      Mn,  -- (16#01058#, 16#01059#)  MYANMAR VOWEL SIGN VOCALIC L .. MYANMAR VOWEL SIGN VOCALIC LL
+      Lu,  -- (16#010A0#, 16#010C5#)  GEORGIAN CAPITAL LETTER AN .. GEORGIAN CAPITAL LETTER HOE
+      Lo,  -- (16#010D0#, 16#010F8#)  GEORGIAN LETTER AN .. GEORGIAN LETTER ELIFI
+      Po,  -- (16#010FB#, 16#010FB#)  GEORGIAN PARAGRAPH SEPARATOR .. GEORGIAN PARAGRAPH SEPARATOR
+      Lo,  -- (16#01100#, 16#01159#)  HANGUL CHOSEONG KIYEOK .. HANGUL CHOSEONG YEORINHIEUH
+      Lo,  -- (16#0115F#, 16#011A2#)  HANGUL CHOSEONG FILLER .. HANGUL JUNGSEONG SSANGARAEA
+      Lo,  -- (16#011A8#, 16#011F9#)  HANGUL JONGSEONG KIYEOK .. HANGUL JONGSEONG YEORINHIEUH
+      Lo,  -- (16#01200#, 16#01206#)  ETHIOPIC SYLLABLE HA .. ETHIOPIC SYLLABLE HO
+      Lo,  -- (16#01208#, 16#01246#)  ETHIOPIC SYLLABLE LA .. ETHIOPIC SYLLABLE QO
+      Lo,  -- (16#01248#, 16#01248#)  ETHIOPIC SYLLABLE QWA .. ETHIOPIC SYLLABLE QWA
+      Lo,  -- (16#0124A#, 16#0124D#)  ETHIOPIC SYLLABLE QWI .. ETHIOPIC SYLLABLE QWE
+      Lo,  -- (16#01250#, 16#01256#)  ETHIOPIC SYLLABLE QHA .. ETHIOPIC SYLLABLE QHO
+      Lo,  -- (16#01258#, 16#01258#)  ETHIOPIC SYLLABLE QHWA .. ETHIOPIC SYLLABLE QHWA
+      Lo,  -- (16#0125A#, 16#0125D#)  ETHIOPIC SYLLABLE QHWI .. ETHIOPIC SYLLABLE QHWE
+      Lo,  -- (16#01260#, 16#01286#)  ETHIOPIC SYLLABLE BA .. ETHIOPIC SYLLABLE XO
+      Lo,  -- (16#01288#, 16#01288#)  ETHIOPIC SYLLABLE XWA .. ETHIOPIC SYLLABLE XWA
+      Lo,  -- (16#0128A#, 16#0128D#)  ETHIOPIC SYLLABLE XWI .. ETHIOPIC SYLLABLE XWE
+      Lo,  -- (16#01290#, 16#012AE#)  ETHIOPIC SYLLABLE NA .. ETHIOPIC SYLLABLE KO
+      Lo,  -- (16#012B0#, 16#012B0#)  ETHIOPIC SYLLABLE KWA .. ETHIOPIC SYLLABLE KWA
+      Lo,  -- (16#012B2#, 16#012B5#)  ETHIOPIC SYLLABLE KWI .. ETHIOPIC SYLLABLE KWE
+      Lo,  -- (16#012B8#, 16#012BE#)  ETHIOPIC SYLLABLE KXA .. ETHIOPIC SYLLABLE KXO
+      Lo,  -- (16#012C0#, 16#012C0#)  ETHIOPIC SYLLABLE KXWA .. ETHIOPIC SYLLABLE KXWA
+      Lo,  -- (16#012C2#, 16#012C5#)  ETHIOPIC SYLLABLE KXWI .. ETHIOPIC SYLLABLE KXWE
+      Lo,  -- (16#012C8#, 16#012CE#)  ETHIOPIC SYLLABLE WA .. ETHIOPIC SYLLABLE WO
+      Lo,  -- (16#012D0#, 16#012D6#)  ETHIOPIC SYLLABLE PHARYNGEAL A .. ETHIOPIC SYLLABLE PHARYNGEAL O
+      Lo,  -- (16#012D8#, 16#012EE#)  ETHIOPIC SYLLABLE ZA .. ETHIOPIC SYLLABLE YO
+      Lo,  -- (16#012F0#, 16#0130E#)  ETHIOPIC SYLLABLE DA .. ETHIOPIC SYLLABLE GO
+      Lo,  -- (16#01310#, 16#01310#)  ETHIOPIC SYLLABLE GWA .. ETHIOPIC SYLLABLE GWA
+      Lo,  -- (16#01312#, 16#01315#)  ETHIOPIC SYLLABLE GWI .. ETHIOPIC SYLLABLE GWE
+      Lo,  -- (16#01318#, 16#0131E#)  ETHIOPIC SYLLABLE GGA .. ETHIOPIC SYLLABLE GGO
+      Lo,  -- (16#01320#, 16#01346#)  ETHIOPIC SYLLABLE THA .. ETHIOPIC SYLLABLE TZO
+      Lo,  -- (16#01348#, 16#0135A#)  ETHIOPIC SYLLABLE FA .. ETHIOPIC SYLLABLE FYA
+      Po,  -- (16#01361#, 16#01368#)  ETHIOPIC WORDSPACE .. ETHIOPIC PARAGRAPH SEPARATOR
+      Nd,  -- (16#01369#, 16#01371#)  ETHIOPIC DIGIT ONE .. ETHIOPIC DIGIT NINE
+      No,  -- (16#01372#, 16#0137C#)  ETHIOPIC NUMBER TEN .. ETHIOPIC NUMBER TEN THOUSAND
+      Lo,  -- (16#013A0#, 16#013F4#)  CHEROKEE LETTER A .. CHEROKEE LETTER YV
+      Lo,  -- (16#01401#, 16#0166C#)  CANADIAN SYLLABICS E .. CANADIAN SYLLABICS CARRIER TTSA
+      Po,  -- (16#0166D#, 16#0166E#)  CANADIAN SYLLABICS CHI SIGN .. CANADIAN SYLLABICS FULL STOP
+      Lo,  -- (16#0166F#, 16#01676#)  CANADIAN SYLLABICS QAI .. CANADIAN SYLLABICS NNGAA
+      Zs,  -- (16#01680#, 16#01680#)  OGHAM SPACE MARK .. OGHAM SPACE MARK
+      Lo,  -- (16#01681#, 16#0169A#)  OGHAM LETTER BEITH .. OGHAM LETTER PEITH
+      Ps,  -- (16#0169B#, 16#0169B#)  OGHAM FEATHER MARK .. OGHAM FEATHER MARK
+      Pe,  -- (16#0169C#, 16#0169C#)  OGHAM REVERSED FEATHER MARK .. OGHAM REVERSED FEATHER MARK
+      Lo,  -- (16#016A0#, 16#016EA#)  RUNIC LETTER FEHU FEOH FE F .. RUNIC LETTER X
+      Po,  -- (16#016EB#, 16#016ED#)  RUNIC SINGLE PUNCTUATION .. RUNIC CROSS PUNCTUATION
+      Nl,  -- (16#016EE#, 16#016F0#)  RUNIC ARLAUG SYMBOL .. RUNIC BELGTHOR SYMBOL
+      Lo,  -- (16#01700#, 16#0170C#)  TAGALOG LETTER A .. TAGALOG LETTER YA
+      Lo,  -- (16#0170E#, 16#01711#)  TAGALOG LETTER LA .. TAGALOG LETTER HA
+      Mn,  -- (16#01712#, 16#01714#)  TAGALOG VOWEL SIGN I .. TAGALOG SIGN VIRAMA
+      Lo,  -- (16#01720#, 16#01731#)  HANUNOO LETTER A .. HANUNOO LETTER HA
+      Mn,  -- (16#01732#, 16#01734#)  HANUNOO VOWEL SIGN I .. HANUNOO SIGN PAMUDPOD
+      Po,  -- (16#01735#, 16#01736#)  PHILIPPINE SINGLE PUNCTUATION .. PHILIPPINE DOUBLE PUNCTUATION
+      Lo,  -- (16#01740#, 16#01751#)  BUHID LETTER A .. BUHID LETTER HA
+      Mn,  -- (16#01752#, 16#01753#)  BUHID VOWEL SIGN I .. BUHID VOWEL SIGN U
+      Lo,  -- (16#01760#, 16#0176C#)  TAGBANWA LETTER A .. TAGBANWA LETTER YA
+      Lo,  -- (16#0176E#, 16#01770#)  TAGBANWA LETTER LA .. TAGBANWA LETTER SA
+      Mn,  -- (16#01772#, 16#01773#)  TAGBANWA VOWEL SIGN I .. TAGBANWA VOWEL SIGN U
+      Lo,  -- (16#01780#, 16#017B3#)  KHMER LETTER KA .. KHMER INDEPENDENT VOWEL QAU
+      Cf,  -- (16#017B4#, 16#017B5#)  KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA
+      Mc,  -- (16#017B6#, 16#017B6#)  KHMER VOWEL SIGN AA .. KHMER VOWEL SIGN AA
+      Mn,  -- (16#017B7#, 16#017BD#)  KHMER VOWEL SIGN I .. KHMER VOWEL SIGN UA
+      Mc,  -- (16#017BE#, 16#017C5#)  KHMER VOWEL SIGN OE .. KHMER VOWEL SIGN AU
+      Mn,  -- (16#017C6#, 16#017C6#)  KHMER SIGN NIKAHIT .. KHMER SIGN NIKAHIT
+      Mc,  -- (16#017C7#, 16#017C8#)  KHMER SIGN REAHMUK .. KHMER SIGN YUUKALEAPINTU
+      Mn,  -- (16#017C9#, 16#017D3#)  KHMER SIGN MUUSIKATOAN .. KHMER SIGN BATHAMASAT
+      Po,  -- (16#017D4#, 16#017D6#)  KHMER SIGN KHAN .. KHMER SIGN CAMNUC PII KUUH
+      Lm,  -- (16#017D7#, 16#017D7#)  KHMER SIGN LEK TOO .. KHMER SIGN LEK TOO
+      Po,  -- (16#017D8#, 16#017DA#)  KHMER SIGN BEYYAL .. KHMER SIGN KOOMUUT
+      Sc,  -- (16#017DB#, 16#017DB#)  KHMER CURRENCY SYMBOL RIEL .. KHMER CURRENCY SYMBOL RIEL
+      Lo,  -- (16#017DC#, 16#017DC#)  KHMER SIGN AVAKRAHASANYA .. KHMER SIGN AVAKRAHASANYA
+      Mn,  -- (16#017DD#, 16#017DD#)  KHMER SIGN ATTHACAN .. KHMER SIGN ATTHACAN
+      Nd,  -- (16#017E0#, 16#017E9#)  KHMER DIGIT ZERO .. KHMER DIGIT NINE
+      No,  -- (16#017F0#, 16#017F9#)  KHMER SYMBOL LEK ATTAK SON .. KHMER SYMBOL LEK ATTAK PRAM-BUON
+      Po,  -- (16#01800#, 16#01805#)  MONGOLIAN BIRGA .. MONGOLIAN FOUR DOTS
+      Pd,  -- (16#01806#, 16#01806#)  MONGOLIAN TODO SOFT HYPHEN .. MONGOLIAN TODO SOFT HYPHEN
+      Po,  -- (16#01807#, 16#0180A#)  MONGOLIAN SIBE SYLLABLE BOUNDARY MARKER .. MONGOLIAN NIRUGU
+      Mn,  -- (16#0180B#, 16#0180D#)  MONGOLIAN FREE VARIATION SELECTOR ONE .. MONGOLIAN FREE VARIATION SELECTOR THREE
+      Zs,  -- (16#0180E#, 16#0180E#)  MONGOLIAN VOWEL SEPARATOR .. MONGOLIAN VOWEL SEPARATOR
+      Nd,  -- (16#01810#, 16#01819#)  MONGOLIAN DIGIT ZERO .. MONGOLIAN DIGIT NINE
+      Lo,  -- (16#01820#, 16#01842#)  MONGOLIAN LETTER A .. MONGOLIAN LETTER CHI
+      Lm,  -- (16#01843#, 16#01843#)  MONGOLIAN LETTER TODO LONG VOWEL SIGN .. MONGOLIAN LETTER TODO LONG VOWEL SIGN
+      Lo,  -- (16#01844#, 16#01877#)  MONGOLIAN LETTER TODO E .. MONGOLIAN LETTER MANCHU ZHA
+      Lo,  -- (16#01880#, 16#018A8#)  MONGOLIAN LETTER ALI GALI ANUSVARA ONE .. MONGOLIAN LETTER MANCHU ALI GALI BHA
+      Mn,  -- (16#018A9#, 16#018A9#)  MONGOLIAN LETTER ALI GALI DAGALGA .. MONGOLIAN LETTER ALI GALI DAGALGA
+      Lo,  -- (16#01900#, 16#0191C#)  LIMBU VOWEL-CARRIER LETTER .. LIMBU LETTER HA
+      Mn,  -- (16#01920#, 16#01922#)  LIMBU VOWEL SIGN A .. LIMBU VOWEL SIGN U
+      Mc,  -- (16#01923#, 16#01926#)  LIMBU VOWEL SIGN EE .. LIMBU VOWEL SIGN AU
+      Mn,  -- (16#01927#, 16#01928#)  LIMBU VOWEL SIGN E .. LIMBU VOWEL SIGN O
+      Mc,  -- (16#01929#, 16#0192B#)  LIMBU SUBJOINED LETTER YA .. LIMBU SUBJOINED LETTER WA
+      Mc,  -- (16#01930#, 16#01931#)  LIMBU SMALL LETTER KA .. LIMBU SMALL LETTER NGA
+      Mn,  -- (16#01932#, 16#01932#)  LIMBU SMALL LETTER ANUSVARA .. LIMBU SMALL LETTER ANUSVARA
+      Mc,  -- (16#01933#, 16#01938#)  LIMBU SMALL LETTER TA .. LIMBU SMALL LETTER LA
+      Mn,  -- (16#01939#, 16#0193B#)  LIMBU SIGN MUKPHRENG .. LIMBU SIGN SA-I
+      So,  -- (16#01940#, 16#01940#)  LIMBU SIGN LOO .. LIMBU SIGN LOO
+      Po,  -- (16#01944#, 16#01945#)  LIMBU EXCLAMATION MARK .. LIMBU QUESTION MARK
+      Nd,  -- (16#01946#, 16#0194F#)  LIMBU DIGIT ZERO .. LIMBU DIGIT NINE
+      Lo,  -- (16#01950#, 16#0196D#)  TAI LE LETTER KA .. TAI LE LETTER AI
+      Lo,  -- (16#01970#, 16#01974#)  TAI LE LETTER TONE-2 .. TAI LE LETTER TONE-6
+      So,  -- (16#019E0#, 16#019FF#)  KHMER SYMBOL PATHAMASAT .. KHMER SYMBOL DAP-PRAM ROC
+      Ll,  -- (16#01D00#, 16#01D2B#)  LATIN LETTER SMALL CAPITAL A .. CYRILLIC LETTER SMALL CAPITAL EL
+      Lm,  -- (16#01D2C#, 16#01D61#)  MODIFIER LETTER CAPITAL A .. MODIFIER LETTER SMALL CHI
+      Ll,  -- (16#01D62#, 16#01D6B#)  LATIN SUBSCRIPT SMALL LETTER I .. LATIN SMALL LETTER UE
+      Lu,  -- (16#01E00#, 16#01E00#)  LATIN CAPITAL LETTER A WITH RING BELOW .. LATIN CAPITAL LETTER A WITH RING BELOW
+      Ll,  -- (16#01E01#, 16#01E01#)  LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW
+      Lu,  -- (16#01E02#, 16#01E02#)  LATIN CAPITAL LETTER B WITH DOT ABOVE .. LATIN CAPITAL LETTER B WITH DOT ABOVE
+      Ll,  -- (16#01E03#, 16#01E03#)  LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE
+      Lu,  -- (16#01E04#, 16#01E04#)  LATIN CAPITAL LETTER B WITH DOT BELOW .. LATIN CAPITAL LETTER B WITH DOT BELOW
+      Ll,  -- (16#01E05#, 16#01E05#)  LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW
+      Lu,  -- (16#01E06#, 16#01E06#)  LATIN CAPITAL LETTER B WITH LINE BELOW .. LATIN CAPITAL LETTER B WITH LINE BELOW
+      Ll,  -- (16#01E07#, 16#01E07#)  LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW
+      Lu,  -- (16#01E08#, 16#01E08#)  LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE .. LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE
+      Ll,  -- (16#01E09#, 16#01E09#)  LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE
+      Lu,  -- (16#01E0A#, 16#01E0A#)  LATIN CAPITAL LETTER D WITH DOT ABOVE .. LATIN CAPITAL LETTER D WITH DOT ABOVE
+      Ll,  -- (16#01E0B#, 16#01E0B#)  LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE
+      Lu,  -- (16#01E0C#, 16#01E0C#)  LATIN CAPITAL LETTER D WITH DOT BELOW .. LATIN CAPITAL LETTER D WITH DOT BELOW
+      Ll,  -- (16#01E0D#, 16#01E0D#)  LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW
+      Lu,  -- (16#01E0E#, 16#01E0E#)  LATIN CAPITAL LETTER D WITH LINE BELOW .. LATIN CAPITAL LETTER D WITH LINE BELOW
+      Ll,  -- (16#01E0F#, 16#01E0F#)  LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW
+      Lu,  -- (16#01E10#, 16#01E10#)  LATIN CAPITAL LETTER D WITH CEDILLA .. LATIN CAPITAL LETTER D WITH CEDILLA
+      Ll,  -- (16#01E11#, 16#01E11#)  LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA
+      Lu,  -- (16#01E12#, 16#01E12#)  LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E13#, 16#01E13#)  LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E14#, 16#01E14#)  LATIN CAPITAL LETTER E WITH MACRON AND GRAVE .. LATIN CAPITAL LETTER E WITH MACRON AND GRAVE
+      Ll,  -- (16#01E15#, 16#01E15#)  LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE
+      Lu,  -- (16#01E16#, 16#01E16#)  LATIN CAPITAL LETTER E WITH MACRON AND ACUTE .. LATIN CAPITAL LETTER E WITH MACRON AND ACUTE
+      Ll,  -- (16#01E17#, 16#01E17#)  LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE
+      Lu,  -- (16#01E18#, 16#01E18#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E19#, 16#01E19#)  LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E1A#, 16#01E1A#)  LATIN CAPITAL LETTER E WITH TILDE BELOW .. LATIN CAPITAL LETTER E WITH TILDE BELOW
+      Ll,  -- (16#01E1B#, 16#01E1B#)  LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW
+      Lu,  -- (16#01E1C#, 16#01E1C#)  LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE .. LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE
+      Ll,  -- (16#01E1D#, 16#01E1D#)  LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE
+      Lu,  -- (16#01E1E#, 16#01E1E#)  LATIN CAPITAL LETTER F WITH DOT ABOVE .. LATIN CAPITAL LETTER F WITH DOT ABOVE
+      Ll,  -- (16#01E1F#, 16#01E1F#)  LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE
+      Lu,  -- (16#01E20#, 16#01E20#)  LATIN CAPITAL LETTER G WITH MACRON .. LATIN CAPITAL LETTER G WITH MACRON
+      Ll,  -- (16#01E21#, 16#01E21#)  LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON
+      Lu,  -- (16#01E22#, 16#01E22#)  LATIN CAPITAL LETTER H WITH DOT ABOVE .. LATIN CAPITAL LETTER H WITH DOT ABOVE
+      Ll,  -- (16#01E23#, 16#01E23#)  LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE
+      Lu,  -- (16#01E24#, 16#01E24#)  LATIN CAPITAL LETTER H WITH DOT BELOW .. LATIN CAPITAL LETTER H WITH DOT BELOW
+      Ll,  -- (16#01E25#, 16#01E25#)  LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW
+      Lu,  -- (16#01E26#, 16#01E26#)  LATIN CAPITAL LETTER H WITH DIAERESIS .. LATIN CAPITAL LETTER H WITH DIAERESIS
+      Ll,  -- (16#01E27#, 16#01E27#)  LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS
+      Lu,  -- (16#01E28#, 16#01E28#)  LATIN CAPITAL LETTER H WITH CEDILLA .. LATIN CAPITAL LETTER H WITH CEDILLA
+      Ll,  -- (16#01E29#, 16#01E29#)  LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA
+      Lu,  -- (16#01E2A#, 16#01E2A#)  LATIN CAPITAL LETTER H WITH BREVE BELOW .. LATIN CAPITAL LETTER H WITH BREVE BELOW
+      Ll,  -- (16#01E2B#, 16#01E2B#)  LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW
+      Lu,  -- (16#01E2C#, 16#01E2C#)  LATIN CAPITAL LETTER I WITH TILDE BELOW .. LATIN CAPITAL LETTER I WITH TILDE BELOW
+      Ll,  -- (16#01E2D#, 16#01E2D#)  LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW
+      Lu,  -- (16#01E2E#, 16#01E2E#)  LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE .. LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE
+      Ll,  -- (16#01E2F#, 16#01E2F#)  LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE
+      Lu,  -- (16#01E30#, 16#01E30#)  LATIN CAPITAL LETTER K WITH ACUTE .. LATIN CAPITAL LETTER K WITH ACUTE
+      Ll,  -- (16#01E31#, 16#01E31#)  LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE
+      Lu,  -- (16#01E32#, 16#01E32#)  LATIN CAPITAL LETTER K WITH DOT BELOW .. LATIN CAPITAL LETTER K WITH DOT BELOW
+      Ll,  -- (16#01E33#, 16#01E33#)  LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW
+      Lu,  -- (16#01E34#, 16#01E34#)  LATIN CAPITAL LETTER K WITH LINE BELOW .. LATIN CAPITAL LETTER K WITH LINE BELOW
+      Ll,  -- (16#01E35#, 16#01E35#)  LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW
+      Lu,  -- (16#01E36#, 16#01E36#)  LATIN CAPITAL LETTER L WITH DOT BELOW .. LATIN CAPITAL LETTER L WITH DOT BELOW
+      Ll,  -- (16#01E37#, 16#01E37#)  LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW
+      Lu,  -- (16#01E38#, 16#01E38#)  LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON .. LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON
+      Ll,  -- (16#01E39#, 16#01E39#)  LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON
+      Lu,  -- (16#01E3A#, 16#01E3A#)  LATIN CAPITAL LETTER L WITH LINE BELOW .. LATIN CAPITAL LETTER L WITH LINE BELOW
+      Ll,  -- (16#01E3B#, 16#01E3B#)  LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW
+      Lu,  -- (16#01E3C#, 16#01E3C#)  LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E3D#, 16#01E3D#)  LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E3E#, 16#01E3E#)  LATIN CAPITAL LETTER M WITH ACUTE .. LATIN CAPITAL LETTER M WITH ACUTE
+      Ll,  -- (16#01E3F#, 16#01E3F#)  LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE
+      Lu,  -- (16#01E40#, 16#01E40#)  LATIN CAPITAL LETTER M WITH DOT ABOVE .. LATIN CAPITAL LETTER M WITH DOT ABOVE
+      Ll,  -- (16#01E41#, 16#01E41#)  LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE
+      Lu,  -- (16#01E42#, 16#01E42#)  LATIN CAPITAL LETTER M WITH DOT BELOW .. LATIN CAPITAL LETTER M WITH DOT BELOW
+      Ll,  -- (16#01E43#, 16#01E43#)  LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW
+      Lu,  -- (16#01E44#, 16#01E44#)  LATIN CAPITAL LETTER N WITH DOT ABOVE .. LATIN CAPITAL LETTER N WITH DOT ABOVE
+      Ll,  -- (16#01E45#, 16#01E45#)  LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE
+      Lu,  -- (16#01E46#, 16#01E46#)  LATIN CAPITAL LETTER N WITH DOT BELOW .. LATIN CAPITAL LETTER N WITH DOT BELOW
+      Ll,  -- (16#01E47#, 16#01E47#)  LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW
+      Lu,  -- (16#01E48#, 16#01E48#)  LATIN CAPITAL LETTER N WITH LINE BELOW .. LATIN CAPITAL LETTER N WITH LINE BELOW
+      Ll,  -- (16#01E49#, 16#01E49#)  LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW
+      Lu,  -- (16#01E4A#, 16#01E4A#)  LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E4B#, 16#01E4B#)  LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E4C#, 16#01E4C#)  LATIN CAPITAL LETTER O WITH TILDE AND ACUTE .. LATIN CAPITAL LETTER O WITH TILDE AND ACUTE
+      Ll,  -- (16#01E4D#, 16#01E4D#)  LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE
+      Lu,  -- (16#01E4E#, 16#01E4E#)  LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS .. LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS
+      Ll,  -- (16#01E4F#, 16#01E4F#)  LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS
+      Lu,  -- (16#01E50#, 16#01E50#)  LATIN CAPITAL LETTER O WITH MACRON AND GRAVE .. LATIN CAPITAL LETTER O WITH MACRON AND GRAVE
+      Ll,  -- (16#01E51#, 16#01E51#)  LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE
+      Lu,  -- (16#01E52#, 16#01E52#)  LATIN CAPITAL LETTER O WITH MACRON AND ACUTE .. LATIN CAPITAL LETTER O WITH MACRON AND ACUTE
+      Ll,  -- (16#01E53#, 16#01E53#)  LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE
+      Lu,  -- (16#01E54#, 16#01E54#)  LATIN CAPITAL LETTER P WITH ACUTE .. LATIN CAPITAL LETTER P WITH ACUTE
+      Ll,  -- (16#01E55#, 16#01E55#)  LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE
+      Lu,  -- (16#01E56#, 16#01E56#)  LATIN CAPITAL LETTER P WITH DOT ABOVE .. LATIN CAPITAL LETTER P WITH DOT ABOVE
+      Ll,  -- (16#01E57#, 16#01E57#)  LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE
+      Lu,  -- (16#01E58#, 16#01E58#)  LATIN CAPITAL LETTER R WITH DOT ABOVE .. LATIN CAPITAL LETTER R WITH DOT ABOVE
+      Ll,  -- (16#01E59#, 16#01E59#)  LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE
+      Lu,  -- (16#01E5A#, 16#01E5A#)  LATIN CAPITAL LETTER R WITH DOT BELOW .. LATIN CAPITAL LETTER R WITH DOT BELOW
+      Ll,  -- (16#01E5B#, 16#01E5B#)  LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW
+      Lu,  -- (16#01E5C#, 16#01E5C#)  LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON .. LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON
+      Ll,  -- (16#01E5D#, 16#01E5D#)  LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON
+      Lu,  -- (16#01E5E#, 16#01E5E#)  LATIN CAPITAL LETTER R WITH LINE BELOW .. LATIN CAPITAL LETTER R WITH LINE BELOW
+      Ll,  -- (16#01E5F#, 16#01E5F#)  LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW
+      Lu,  -- (16#01E60#, 16#01E60#)  LATIN CAPITAL LETTER S WITH DOT ABOVE .. LATIN CAPITAL LETTER S WITH DOT ABOVE
+      Ll,  -- (16#01E61#, 16#01E61#)  LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE
+      Lu,  -- (16#01E62#, 16#01E62#)  LATIN CAPITAL LETTER S WITH DOT BELOW .. LATIN CAPITAL LETTER S WITH DOT BELOW
+      Ll,  -- (16#01E63#, 16#01E63#)  LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW
+      Lu,  -- (16#01E64#, 16#01E64#)  LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE
+      Ll,  -- (16#01E65#, 16#01E65#)  LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE
+      Lu,  -- (16#01E66#, 16#01E66#)  LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE
+      Ll,  -- (16#01E67#, 16#01E67#)  LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE
+      Lu,  -- (16#01E68#, 16#01E68#)  LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE
+      Ll,  -- (16#01E69#, 16#01E69#)  LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE
+      Lu,  -- (16#01E6A#, 16#01E6A#)  LATIN CAPITAL LETTER T WITH DOT ABOVE .. LATIN CAPITAL LETTER T WITH DOT ABOVE
+      Ll,  -- (16#01E6B#, 16#01E6B#)  LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE
+      Lu,  -- (16#01E6C#, 16#01E6C#)  LATIN CAPITAL LETTER T WITH DOT BELOW .. LATIN CAPITAL LETTER T WITH DOT BELOW
+      Ll,  -- (16#01E6D#, 16#01E6D#)  LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW
+      Lu,  -- (16#01E6E#, 16#01E6E#)  LATIN CAPITAL LETTER T WITH LINE BELOW .. LATIN CAPITAL LETTER T WITH LINE BELOW
+      Ll,  -- (16#01E6F#, 16#01E6F#)  LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW
+      Lu,  -- (16#01E70#, 16#01E70#)  LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E71#, 16#01E71#)  LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E72#, 16#01E72#)  LATIN CAPITAL LETTER U WITH DIAERESIS BELOW .. LATIN CAPITAL LETTER U WITH DIAERESIS BELOW
+      Ll,  -- (16#01E73#, 16#01E73#)  LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW
+      Lu,  -- (16#01E74#, 16#01E74#)  LATIN CAPITAL LETTER U WITH TILDE BELOW .. LATIN CAPITAL LETTER U WITH TILDE BELOW
+      Ll,  -- (16#01E75#, 16#01E75#)  LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW
+      Lu,  -- (16#01E76#, 16#01E76#)  LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW .. LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW
+      Ll,  -- (16#01E77#, 16#01E77#)  LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW
+      Lu,  -- (16#01E78#, 16#01E78#)  LATIN CAPITAL LETTER U WITH TILDE AND ACUTE .. LATIN CAPITAL LETTER U WITH TILDE AND ACUTE
+      Ll,  -- (16#01E79#, 16#01E79#)  LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE
+      Lu,  -- (16#01E7A#, 16#01E7A#)  LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS .. LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS
+      Ll,  -- (16#01E7B#, 16#01E7B#)  LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS
+      Lu,  -- (16#01E7C#, 16#01E7C#)  LATIN CAPITAL LETTER V WITH TILDE .. LATIN CAPITAL LETTER V WITH TILDE
+      Ll,  -- (16#01E7D#, 16#01E7D#)  LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE
+      Lu,  -- (16#01E7E#, 16#01E7E#)  LATIN CAPITAL LETTER V WITH DOT BELOW .. LATIN CAPITAL LETTER V WITH DOT BELOW
+      Ll,  -- (16#01E7F#, 16#01E7F#)  LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW
+      Lu,  -- (16#01E80#, 16#01E80#)  LATIN CAPITAL LETTER W WITH GRAVE .. LATIN CAPITAL LETTER W WITH GRAVE
+      Ll,  -- (16#01E81#, 16#01E81#)  LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE
+      Lu,  -- (16#01E82#, 16#01E82#)  LATIN CAPITAL LETTER W WITH ACUTE .. LATIN CAPITAL LETTER W WITH ACUTE
+      Ll,  -- (16#01E83#, 16#01E83#)  LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE
+      Lu,  -- (16#01E84#, 16#01E84#)  LATIN CAPITAL LETTER W WITH DIAERESIS .. LATIN CAPITAL LETTER W WITH DIAERESIS
+      Ll,  -- (16#01E85#, 16#01E85#)  LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS
+      Lu,  -- (16#01E86#, 16#01E86#)  LATIN CAPITAL LETTER W WITH DOT ABOVE .. LATIN CAPITAL LETTER W WITH DOT ABOVE
+      Ll,  -- (16#01E87#, 16#01E87#)  LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE
+      Lu,  -- (16#01E88#, 16#01E88#)  LATIN CAPITAL LETTER W WITH DOT BELOW .. LATIN CAPITAL LETTER W WITH DOT BELOW
+      Ll,  -- (16#01E89#, 16#01E89#)  LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW
+      Lu,  -- (16#01E8A#, 16#01E8A#)  LATIN CAPITAL LETTER X WITH DOT ABOVE .. LATIN CAPITAL LETTER X WITH DOT ABOVE
+      Ll,  -- (16#01E8B#, 16#01E8B#)  LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE
+      Lu,  -- (16#01E8C#, 16#01E8C#)  LATIN CAPITAL LETTER X WITH DIAERESIS .. LATIN CAPITAL LETTER X WITH DIAERESIS
+      Ll,  -- (16#01E8D#, 16#01E8D#)  LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS
+      Lu,  -- (16#01E8E#, 16#01E8E#)  LATIN CAPITAL LETTER Y WITH DOT ABOVE .. LATIN CAPITAL LETTER Y WITH DOT ABOVE
+      Ll,  -- (16#01E8F#, 16#01E8F#)  LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE
+      Lu,  -- (16#01E90#, 16#01E90#)  LATIN CAPITAL LETTER Z WITH CIRCUMFLEX .. LATIN CAPITAL LETTER Z WITH CIRCUMFLEX
+      Ll,  -- (16#01E91#, 16#01E91#)  LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX
+      Lu,  -- (16#01E92#, 16#01E92#)  LATIN CAPITAL LETTER Z WITH DOT BELOW .. LATIN CAPITAL LETTER Z WITH DOT BELOW
+      Ll,  -- (16#01E93#, 16#01E93#)  LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW
+      Lu,  -- (16#01E94#, 16#01E94#)  LATIN CAPITAL LETTER Z WITH LINE BELOW .. LATIN CAPITAL LETTER Z WITH LINE BELOW
+      Ll,  -- (16#01E95#, 16#01E9B#)  LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER LONG S WITH DOT ABOVE
+      Lu,  -- (16#01EA0#, 16#01EA0#)  LATIN CAPITAL LETTER A WITH DOT BELOW .. LATIN CAPITAL LETTER A WITH DOT BELOW
+      Ll,  -- (16#01EA1#, 16#01EA1#)  LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW
+      Lu,  -- (16#01EA2#, 16#01EA2#)  LATIN CAPITAL LETTER A WITH HOOK ABOVE .. LATIN CAPITAL LETTER A WITH HOOK ABOVE
+      Ll,  -- (16#01EA3#, 16#01EA3#)  LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE
+      Lu,  -- (16#01EA4#, 16#01EA4#)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+      Ll,  -- (16#01EA5#, 16#01EA5#)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+      Lu,  -- (16#01EA6#, 16#01EA6#)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+      Ll,  -- (16#01EA7#, 16#01EA7#)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+      Lu,  -- (16#01EA8#, 16#01EA8#)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+      Ll,  -- (16#01EA9#, 16#01EA9#)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+      Lu,  -- (16#01EAA#, 16#01EAA#)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+      Ll,  -- (16#01EAB#, 16#01EAB#)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+      Lu,  -- (16#01EAC#, 16#01EAC#)  LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+      Ll,  -- (16#01EAD#, 16#01EAD#)  LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+      Lu,  -- (16#01EAE#, 16#01EAE#)  LATIN CAPITAL LETTER A WITH BREVE AND ACUTE .. LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+      Ll,  -- (16#01EAF#, 16#01EAF#)  LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE
+      Lu,  -- (16#01EB0#, 16#01EB0#)  LATIN CAPITAL LETTER A WITH BREVE AND GRAVE .. LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+      Ll,  -- (16#01EB1#, 16#01EB1#)  LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE
+      Lu,  -- (16#01EB2#, 16#01EB2#)  LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
+      Ll,  -- (16#01EB3#, 16#01EB3#)  LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+      Lu,  -- (16#01EB4#, 16#01EB4#)  LATIN CAPITAL LETTER A WITH BREVE AND TILDE .. LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+      Ll,  -- (16#01EB5#, 16#01EB5#)  LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE
+      Lu,  -- (16#01EB6#, 16#01EB6#)  LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW .. LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+      Ll,  -- (16#01EB7#, 16#01EB7#)  LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+      Lu,  -- (16#01EB8#, 16#01EB8#)  LATIN CAPITAL LETTER E WITH DOT BELOW .. LATIN CAPITAL LETTER E WITH DOT BELOW
+      Ll,  -- (16#01EB9#, 16#01EB9#)  LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW
+      Lu,  -- (16#01EBA#, 16#01EBA#)  LATIN CAPITAL LETTER E WITH HOOK ABOVE .. LATIN CAPITAL LETTER E WITH HOOK ABOVE
+      Ll,  -- (16#01EBB#, 16#01EBB#)  LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE
+      Lu,  -- (16#01EBC#, 16#01EBC#)  LATIN CAPITAL LETTER E WITH TILDE .. LATIN CAPITAL LETTER E WITH TILDE
+      Ll,  -- (16#01EBD#, 16#01EBD#)  LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE
+      Lu,  -- (16#01EBE#, 16#01EBE#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+      Ll,  -- (16#01EBF#, 16#01EBF#)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+      Lu,  -- (16#01EC0#, 16#01EC0#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+      Ll,  -- (16#01EC1#, 16#01EC1#)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+      Lu,  -- (16#01EC2#, 16#01EC2#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+      Ll,  -- (16#01EC3#, 16#01EC3#)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+      Lu,  -- (16#01EC4#, 16#01EC4#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+      Ll,  -- (16#01EC5#, 16#01EC5#)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+      Lu,  -- (16#01EC6#, 16#01EC6#)  LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+      Ll,  -- (16#01EC7#, 16#01EC7#)  LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+      Lu,  -- (16#01EC8#, 16#01EC8#)  LATIN CAPITAL LETTER I WITH HOOK ABOVE .. LATIN CAPITAL LETTER I WITH HOOK ABOVE
+      Ll,  -- (16#01EC9#, 16#01EC9#)  LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE
+      Lu,  -- (16#01ECA#, 16#01ECA#)  LATIN CAPITAL LETTER I WITH DOT BELOW .. LATIN CAPITAL LETTER I WITH DOT BELOW
+      Ll,  -- (16#01ECB#, 16#01ECB#)  LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW
+      Lu,  -- (16#01ECC#, 16#01ECC#)  LATIN CAPITAL LETTER O WITH DOT BELOW .. LATIN CAPITAL LETTER O WITH DOT BELOW
+      Ll,  -- (16#01ECD#, 16#01ECD#)  LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW
+      Lu,  -- (16#01ECE#, 16#01ECE#)  LATIN CAPITAL LETTER O WITH HOOK ABOVE .. LATIN CAPITAL LETTER O WITH HOOK ABOVE
+      Ll,  -- (16#01ECF#, 16#01ECF#)  LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE
+      Lu,  -- (16#01ED0#, 16#01ED0#)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+      Ll,  -- (16#01ED1#, 16#01ED1#)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+      Lu,  -- (16#01ED2#, 16#01ED2#)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+      Ll,  -- (16#01ED3#, 16#01ED3#)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+      Lu,  -- (16#01ED4#, 16#01ED4#)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+      Ll,  -- (16#01ED5#, 16#01ED5#)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+      Lu,  -- (16#01ED6#, 16#01ED6#)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+      Ll,  -- (16#01ED7#, 16#01ED7#)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+      Lu,  -- (16#01ED8#, 16#01ED8#)  LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+      Ll,  -- (16#01ED9#, 16#01ED9#)  LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+      Lu,  -- (16#01EDA#, 16#01EDA#)  LATIN CAPITAL LETTER O WITH HORN AND ACUTE .. LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+      Ll,  -- (16#01EDB#, 16#01EDB#)  LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE
+      Lu,  -- (16#01EDC#, 16#01EDC#)  LATIN CAPITAL LETTER O WITH HORN AND GRAVE .. LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+      Ll,  -- (16#01EDD#, 16#01EDD#)  LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE
+      Lu,  -- (16#01EDE#, 16#01EDE#)  LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE .. LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
+      Ll,  -- (16#01EDF#, 16#01EDF#)  LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+      Lu,  -- (16#01EE0#, 16#01EE0#)  LATIN CAPITAL LETTER O WITH HORN AND TILDE .. LATIN CAPITAL LETTER O WITH HORN AND TILDE
+      Ll,  -- (16#01EE1#, 16#01EE1#)  LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE
+      Lu,  -- (16#01EE2#, 16#01EE2#)  LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW .. LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW
+      Ll,  -- (16#01EE3#, 16#01EE3#)  LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW
+      Lu,  -- (16#01EE4#, 16#01EE4#)  LATIN CAPITAL LETTER U WITH DOT BELOW .. LATIN CAPITAL LETTER U WITH DOT BELOW
+      Ll,  -- (16#01EE5#, 16#01EE5#)  LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW
+      Lu,  -- (16#01EE6#, 16#01EE6#)  LATIN CAPITAL LETTER U WITH HOOK ABOVE .. LATIN CAPITAL LETTER U WITH HOOK ABOVE
+      Ll,  -- (16#01EE7#, 16#01EE7#)  LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE
+      Lu,  -- (16#01EE8#, 16#01EE8#)  LATIN CAPITAL LETTER U WITH HORN AND ACUTE .. LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+      Ll,  -- (16#01EE9#, 16#01EE9#)  LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE
+      Lu,  -- (16#01EEA#, 16#01EEA#)  LATIN CAPITAL LETTER U WITH HORN AND GRAVE .. LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+      Ll,  -- (16#01EEB#, 16#01EEB#)  LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE
+      Lu,  -- (16#01EEC#, 16#01EEC#)  LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE .. LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
+      Ll,  -- (16#01EED#, 16#01EED#)  LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+      Lu,  -- (16#01EEE#, 16#01EEE#)  LATIN CAPITAL LETTER U WITH HORN AND TILDE .. LATIN CAPITAL LETTER U WITH HORN AND TILDE
+      Ll,  -- (16#01EEF#, 16#01EEF#)  LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE
+      Lu,  -- (16#01EF0#, 16#01EF0#)  LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW .. LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW
+      Ll,  -- (16#01EF1#, 16#01EF1#)  LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW
+      Lu,  -- (16#01EF2#, 16#01EF2#)  LATIN CAPITAL LETTER Y WITH GRAVE .. LATIN CAPITAL LETTER Y WITH GRAVE
+      Ll,  -- (16#01EF3#, 16#01EF3#)  LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE
+      Lu,  -- (16#01EF4#, 16#01EF4#)  LATIN CAPITAL LETTER Y WITH DOT BELOW .. LATIN CAPITAL LETTER Y WITH DOT BELOW
+      Ll,  -- (16#01EF5#, 16#01EF5#)  LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW
+      Lu,  -- (16#01EF6#, 16#01EF6#)  LATIN CAPITAL LETTER Y WITH HOOK ABOVE .. LATIN CAPITAL LETTER Y WITH HOOK ABOVE
+      Ll,  -- (16#01EF7#, 16#01EF7#)  LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE
+      Lu,  -- (16#01EF8#, 16#01EF8#)  LATIN CAPITAL LETTER Y WITH TILDE .. LATIN CAPITAL LETTER Y WITH TILDE
+      Ll,  -- (16#01EF9#, 16#01EF9#)  LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE
+      Ll,  -- (16#01F00#, 16#01F07#)  GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI
+      Lu,  -- (16#01F08#, 16#01F0F#)  GREEK CAPITAL LETTER ALPHA WITH PSILI .. GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI
+      Ll,  -- (16#01F10#, 16#01F15#)  GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA
+      Lu,  -- (16#01F18#, 16#01F1D#)  GREEK CAPITAL LETTER EPSILON WITH PSILI .. GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA
+      Ll,  -- (16#01F20#, 16#01F27#)  GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI
+      Lu,  -- (16#01F28#, 16#01F2F#)  GREEK CAPITAL LETTER ETA WITH PSILI .. GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI
+      Ll,  -- (16#01F30#, 16#01F37#)  GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI
+      Lu,  -- (16#01F38#, 16#01F3F#)  GREEK CAPITAL LETTER IOTA WITH PSILI .. GREEK CAPITAL LETTER IOTA WITH DASIA AND PERISPOMENI
+      Ll,  -- (16#01F40#, 16#01F45#)  GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA
+      Lu,  -- (16#01F48#, 16#01F4D#)  GREEK CAPITAL LETTER OMICRON WITH PSILI .. GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA
+      Ll,  -- (16#01F50#, 16#01F57#)  GREEK SMALL LETTER UPSILON WITH PSILI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI
+      Lu,  -- (16#01F59#, 16#01F59#)  GREEK CAPITAL LETTER UPSILON WITH DASIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA
+      Lu,  -- (16#01F5B#, 16#01F5B#)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA
+      Lu,  -- (16#01F5D#, 16#01F5D#)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA
+      Lu,  -- (16#01F5F#, 16#01F5F#)  GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI
+      Ll,  -- (16#01F60#, 16#01F67#)  GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI
+      Lu,  -- (16#01F68#, 16#01F6F#)  GREEK CAPITAL LETTER OMEGA WITH PSILI .. GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI
+      Ll,  -- (16#01F70#, 16#01F7D#)  GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA
+      Ll,  -- (16#01F80#, 16#01F87#)  GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      Lt,  -- (16#01F88#, 16#01F8F#)  GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      Ll,  -- (16#01F90#, 16#01F97#)  GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      Lt,  -- (16#01F98#, 16#01F9F#)  GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      Ll,  -- (16#01FA0#, 16#01FA7#)  GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
+      Lt,  -- (16#01FA8#, 16#01FAF#)  GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI .. GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
+      Ll,  -- (16#01FB0#, 16#01FB4#)  GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
+      Ll,  -- (16#01FB6#, 16#01FB7#)  GREEK SMALL LETTER ALPHA WITH PERISPOMENI .. GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
+      Lu,  -- (16#01FB8#, 16#01FBB#)  GREEK CAPITAL LETTER ALPHA WITH VRACHY .. GREEK CAPITAL LETTER ALPHA WITH OXIA
+      Lt,  -- (16#01FBC#, 16#01FBC#)  GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
+      Sk,  -- (16#01FBD#, 16#01FBD#)  GREEK KORONIS .. GREEK KORONIS
+      Ll,  -- (16#01FBE#, 16#01FBE#)  GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI
+      Sk,  -- (16#01FBF#, 16#01FC1#)  GREEK PSILI .. GREEK DIALYTIKA AND PERISPOMENI
+      Ll,  -- (16#01FC2#, 16#01FC4#)  GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
+      Ll,  -- (16#01FC6#, 16#01FC7#)  GREEK SMALL LETTER ETA WITH PERISPOMENI .. GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
+      Lu,  -- (16#01FC8#, 16#01FCB#)  GREEK CAPITAL LETTER EPSILON WITH VARIA .. GREEK CAPITAL LETTER ETA WITH OXIA
+      Lt,  -- (16#01FCC#, 16#01FCC#)  GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
+      Sk,  -- (16#01FCD#, 16#01FCF#)  GREEK PSILI AND VARIA .. GREEK PSILI AND PERISPOMENI
+      Ll,  -- (16#01FD0#, 16#01FD3#)  GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
+      Ll,  -- (16#01FD6#, 16#01FD7#)  GREEK SMALL LETTER IOTA WITH PERISPOMENI .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
+      Lu,  -- (16#01FD8#, 16#01FDB#)  GREEK CAPITAL LETTER IOTA WITH VRACHY .. GREEK CAPITAL LETTER IOTA WITH OXIA
+      Sk,  -- (16#01FDD#, 16#01FDF#)  GREEK DASIA AND VARIA .. GREEK DASIA AND PERISPOMENI
+      Ll,  -- (16#01FE0#, 16#01FE7#)  GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
+      Lu,  -- (16#01FE8#, 16#01FEC#)  GREEK CAPITAL LETTER UPSILON WITH VRACHY .. GREEK CAPITAL LETTER RHO WITH DASIA
+      Sk,  -- (16#01FED#, 16#01FEF#)  GREEK DIALYTIKA AND VARIA .. GREEK VARIA
+      Ll,  -- (16#01FF2#, 16#01FF4#)  GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
+      Ll,  -- (16#01FF6#, 16#01FF7#)  GREEK SMALL LETTER OMEGA WITH PERISPOMENI .. GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
+      Lu,  -- (16#01FF8#, 16#01FFB#)  GREEK CAPITAL LETTER OMICRON WITH VARIA .. GREEK CAPITAL LETTER OMEGA WITH OXIA
+      Lt,  -- (16#01FFC#, 16#01FFC#)  GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI .. GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
+      Sk,  -- (16#01FFD#, 16#01FFE#)  GREEK OXIA .. GREEK DASIA
+      Zs,  -- (16#02000#, 16#0200B#)  EN QUAD .. ZERO WIDTH SPACE
+      Cf,  -- (16#0200C#, 16#0200F#)  ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK
+      Pd,  -- (16#02010#, 16#02015#)  HYPHEN .. HORIZONTAL BAR
+      Po,  -- (16#02016#, 16#02017#)  DOUBLE VERTICAL LINE .. DOUBLE LOW LINE
+      Pi,  -- (16#02018#, 16#02018#)  LEFT SINGLE QUOTATION MARK .. LEFT SINGLE QUOTATION MARK
+      Pf,  -- (16#02019#, 16#02019#)  RIGHT SINGLE QUOTATION MARK .. RIGHT SINGLE QUOTATION MARK
+      Ps,  -- (16#0201A#, 16#0201A#)  SINGLE LOW-9 QUOTATION MARK .. SINGLE LOW-9 QUOTATION MARK
+      Pi,  -- (16#0201B#, 16#0201C#)  SINGLE HIGH-REVERSED-9 QUOTATION MARK .. LEFT DOUBLE QUOTATION MARK
+      Pf,  -- (16#0201D#, 16#0201D#)  RIGHT DOUBLE QUOTATION MARK .. RIGHT DOUBLE QUOTATION MARK
+      Ps,  -- (16#0201E#, 16#0201E#)  DOUBLE LOW-9 QUOTATION MARK .. DOUBLE LOW-9 QUOTATION MARK
+      Pi,  -- (16#0201F#, 16#0201F#)  DOUBLE HIGH-REVERSED-9 QUOTATION MARK .. DOUBLE HIGH-REVERSED-9 QUOTATION MARK
+      Po,  -- (16#02020#, 16#02027#)  DAGGER .. HYPHENATION POINT
+      Zl,  -- (16#02028#, 16#02028#)  LINE SEPARATOR .. LINE SEPARATOR
+      Zp,  -- (16#02029#, 16#02029#)  PARAGRAPH SEPARATOR .. PARAGRAPH SEPARATOR
+      Cf,  -- (16#0202A#, 16#0202E#)  LEFT-TO-RIGHT EMBEDDING .. RIGHT-TO-LEFT OVERRIDE
+      Zs,  -- (16#0202F#, 16#0202F#)  NARROW NO-BREAK SPACE .. NARROW NO-BREAK SPACE
+      Po,  -- (16#02030#, 16#02038#)  PER MILLE SIGN .. CARET
+      Pi,  -- (16#02039#, 16#02039#)  SINGLE LEFT-POINTING ANGLE QUOTATION MARK .. SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+      Pf,  -- (16#0203A#, 16#0203A#)  SINGLE RIGHT-POINTING ANGLE QUOTATION MARK .. SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+      Po,  -- (16#0203B#, 16#0203E#)  REFERENCE MARK .. OVERLINE
+      Pc,  -- (16#0203F#, 16#02040#)  UNDERTIE .. CHARACTER TIE
+      Po,  -- (16#02041#, 16#02043#)  CARET INSERTION POINT .. HYPHEN BULLET
+      Sm,  -- (16#02044#, 16#02044#)  FRACTION SLASH .. FRACTION SLASH
+      Ps,  -- (16#02045#, 16#02045#)  LEFT SQUARE BRACKET WITH QUILL .. LEFT SQUARE BRACKET WITH QUILL
+      Pe,  -- (16#02046#, 16#02046#)  RIGHT SQUARE BRACKET WITH QUILL .. RIGHT SQUARE BRACKET WITH QUILL
+      Po,  -- (16#02047#, 16#02051#)  DOUBLE QUESTION MARK .. TWO ASTERISKS ALIGNED VERTICALLY
+      Sm,  -- (16#02052#, 16#02052#)  COMMERCIAL MINUS SIGN .. COMMERCIAL MINUS SIGN
+      Po,  -- (16#02053#, 16#02053#)  SWUNG DASH .. SWUNG DASH
+      Pc,  -- (16#02054#, 16#02054#)  INVERTED UNDERTIE .. INVERTED UNDERTIE
+      Po,  -- (16#02057#, 16#02057#)  QUADRUPLE PRIME .. QUADRUPLE PRIME
+      Zs,  -- (16#0205F#, 16#0205F#)  MEDIUM MATHEMATICAL SPACE .. MEDIUM MATHEMATICAL SPACE
+      Cf,  -- (16#02060#, 16#02063#)  WORD JOINER .. INVISIBLE SEPARATOR
+      Cf,  -- (16#0206A#, 16#0206F#)  INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES
+      No,  -- (16#02070#, 16#02070#)  SUPERSCRIPT ZERO .. SUPERSCRIPT ZERO
+      Ll,  -- (16#02071#, 16#02071#)  SUPERSCRIPT LATIN SMALL LETTER I .. SUPERSCRIPT LATIN SMALL LETTER I
+      No,  -- (16#02074#, 16#02079#)  SUPERSCRIPT FOUR .. SUPERSCRIPT NINE
+      Sm,  -- (16#0207A#, 16#0207C#)  SUPERSCRIPT PLUS SIGN .. SUPERSCRIPT EQUALS SIGN
+      Ps,  -- (16#0207D#, 16#0207D#)  SUPERSCRIPT LEFT PARENTHESIS .. SUPERSCRIPT LEFT PARENTHESIS
+      Pe,  -- (16#0207E#, 16#0207E#)  SUPERSCRIPT RIGHT PARENTHESIS .. SUPERSCRIPT RIGHT PARENTHESIS
+      Ll,  -- (16#0207F#, 16#0207F#)  SUPERSCRIPT LATIN SMALL LETTER N .. SUPERSCRIPT LATIN SMALL LETTER N
+      No,  -- (16#02080#, 16#02089#)  SUBSCRIPT ZERO .. SUBSCRIPT NINE
+      Sm,  -- (16#0208A#, 16#0208C#)  SUBSCRIPT PLUS SIGN .. SUBSCRIPT EQUALS SIGN
+      Ps,  -- (16#0208D#, 16#0208D#)  SUBSCRIPT LEFT PARENTHESIS .. SUBSCRIPT LEFT PARENTHESIS
+      Pe,  -- (16#0208E#, 16#0208E#)  SUBSCRIPT RIGHT PARENTHESIS .. SUBSCRIPT RIGHT PARENTHESIS
+      Sc,  -- (16#020A0#, 16#020B1#)  EURO-CURRENCY SIGN .. PESO SIGN
+      Mn,  -- (16#020D0#, 16#020DC#)  COMBINING LEFT HARPOON ABOVE .. COMBINING FOUR DOTS ABOVE
+      Me,  -- (16#020DD#, 16#020E0#)  COMBINING ENCLOSING CIRCLE .. COMBINING ENCLOSING CIRCLE BACKSLASH
+      Mn,  -- (16#020E1#, 16#020E1#)  COMBINING LEFT RIGHT ARROW ABOVE .. COMBINING LEFT RIGHT ARROW ABOVE
+      Me,  -- (16#020E2#, 16#020E4#)  COMBINING ENCLOSING SCREEN .. COMBINING ENCLOSING UPWARD POINTING TRIANGLE
+      Mn,  -- (16#020E5#, 16#020EA#)  COMBINING REVERSE SOLIDUS OVERLAY .. COMBINING LEFTWARDS ARROW OVERLAY
+      So,  -- (16#02100#, 16#02101#)  ACCOUNT OF .. ADDRESSED TO THE SUBJECT
+      Lu,  -- (16#02102#, 16#02102#)  DOUBLE-STRUCK CAPITAL C .. DOUBLE-STRUCK CAPITAL C
+      So,  -- (16#02103#, 16#02106#)  DEGREE CELSIUS .. CADA UNA
+      Lu,  -- (16#02107#, 16#02107#)  EULER CONSTANT .. EULER CONSTANT
+      So,  -- (16#02108#, 16#02109#)  SCRUPLE .. DEGREE FAHRENHEIT
+      Ll,  -- (16#0210A#, 16#0210A#)  SCRIPT SMALL G .. SCRIPT SMALL G
+      Lu,  -- (16#0210B#, 16#0210D#)  SCRIPT CAPITAL H .. DOUBLE-STRUCK CAPITAL H
+      Ll,  -- (16#0210E#, 16#0210F#)  PLANCK CONSTANT .. PLANCK CONSTANT OVER TWO PI
+      Lu,  -- (16#02110#, 16#02112#)  SCRIPT CAPITAL I .. SCRIPT CAPITAL L
+      Ll,  -- (16#02113#, 16#02113#)  SCRIPT SMALL L .. SCRIPT SMALL L
+      So,  -- (16#02114#, 16#02114#)  L B BAR SYMBOL .. L B BAR SYMBOL
+      Lu,  -- (16#02115#, 16#02115#)  DOUBLE-STRUCK CAPITAL N .. DOUBLE-STRUCK CAPITAL N
+      So,  -- (16#02116#, 16#02118#)  NUMERO SIGN .. SCRIPT CAPITAL P
+      Lu,  -- (16#02119#, 16#0211D#)  DOUBLE-STRUCK CAPITAL P .. DOUBLE-STRUCK CAPITAL R
+      So,  -- (16#0211E#, 16#02123#)  PRESCRIPTION TAKE .. VERSICLE
+      Lu,  -- (16#02124#, 16#02124#)  DOUBLE-STRUCK CAPITAL Z .. DOUBLE-STRUCK CAPITAL Z
+      So,  -- (16#02125#, 16#02125#)  OUNCE SIGN .. OUNCE SIGN
+      Lu,  -- (16#02126#, 16#02126#)  OHM SIGN .. OHM SIGN
+      So,  -- (16#02127#, 16#02127#)  INVERTED OHM SIGN .. INVERTED OHM SIGN
+      Lu,  -- (16#02128#, 16#02128#)  BLACK-LETTER CAPITAL Z .. BLACK-LETTER CAPITAL Z
+      So,  -- (16#02129#, 16#02129#)  TURNED GREEK SMALL LETTER IOTA .. TURNED GREEK SMALL LETTER IOTA
+      Lu,  -- (16#0212A#, 16#0212D#)  KELVIN SIGN .. BLACK-LETTER CAPITAL C
+      So,  -- (16#0212E#, 16#0212E#)  ESTIMATED SYMBOL .. ESTIMATED SYMBOL
+      Ll,  -- (16#0212F#, 16#0212F#)  SCRIPT SMALL E .. SCRIPT SMALL E
+      Lu,  -- (16#02130#, 16#02131#)  SCRIPT CAPITAL E .. SCRIPT CAPITAL F
+      So,  -- (16#02132#, 16#02132#)  TURNED CAPITAL F .. TURNED CAPITAL F
+      Lu,  -- (16#02133#, 16#02133#)  SCRIPT CAPITAL M .. SCRIPT CAPITAL M
+      Ll,  -- (16#02134#, 16#02134#)  SCRIPT SMALL O .. SCRIPT SMALL O
+      Lo,  -- (16#02135#, 16#02138#)  ALEF SYMBOL .. DALET SYMBOL
+      Ll,  -- (16#02139#, 16#02139#)  INFORMATION SOURCE .. INFORMATION SOURCE
+      So,  -- (16#0213A#, 16#0213B#)  ROTATED CAPITAL Q .. FACSIMILE SIGN
+      Ll,  -- (16#0213D#, 16#0213D#)  DOUBLE-STRUCK SMALL GAMMA .. DOUBLE-STRUCK SMALL GAMMA
+      Lu,  -- (16#0213E#, 16#0213F#)  DOUBLE-STRUCK CAPITAL GAMMA .. DOUBLE-STRUCK CAPITAL PI
+      Sm,  -- (16#02140#, 16#02144#)  DOUBLE-STRUCK N-ARY SUMMATION .. TURNED SANS-SERIF CAPITAL Y
+      Lu,  -- (16#02145#, 16#02145#)  DOUBLE-STRUCK ITALIC CAPITAL D .. DOUBLE-STRUCK ITALIC CAPITAL D
+      Ll,  -- (16#02146#, 16#02149#)  DOUBLE-STRUCK ITALIC SMALL D .. DOUBLE-STRUCK ITALIC SMALL J
+      So,  -- (16#0214A#, 16#0214A#)  PROPERTY LINE .. PROPERTY LINE
+      Sm,  -- (16#0214B#, 16#0214B#)  TURNED AMPERSAND .. TURNED AMPERSAND
+      No,  -- (16#02153#, 16#0215F#)  VULGAR FRACTION ONE THIRD .. FRACTION NUMERATOR ONE
+      Nl,  -- (16#02160#, 16#02183#)  ROMAN NUMERAL ONE .. ROMAN NUMERAL REVERSED ONE HUNDRED
+      Sm,  -- (16#02190#, 16#02194#)  LEFTWARDS ARROW .. LEFT RIGHT ARROW
+      So,  -- (16#02195#, 16#02199#)  UP DOWN ARROW .. SOUTH WEST ARROW
+      Sm,  -- (16#0219A#, 16#0219B#)  LEFTWARDS ARROW WITH STROKE .. RIGHTWARDS ARROW WITH STROKE
+      So,  -- (16#0219C#, 16#0219F#)  LEFTWARDS WAVE ARROW .. UPWARDS TWO HEADED ARROW
+      Sm,  -- (16#021A0#, 16#021A0#)  RIGHTWARDS TWO HEADED ARROW .. RIGHTWARDS TWO HEADED ARROW
+      So,  -- (16#021A1#, 16#021A2#)  DOWNWARDS TWO HEADED ARROW .. LEFTWARDS ARROW WITH TAIL
+      Sm,  -- (16#021A3#, 16#021A3#)  RIGHTWARDS ARROW WITH TAIL .. RIGHTWARDS ARROW WITH TAIL
+      So,  -- (16#021A4#, 16#021A5#)  LEFTWARDS ARROW FROM BAR .. UPWARDS ARROW FROM BAR
+      Sm,  -- (16#021A6#, 16#021A6#)  RIGHTWARDS ARROW FROM BAR .. RIGHTWARDS ARROW FROM BAR
+      So,  -- (16#021A7#, 16#021AD#)  DOWNWARDS ARROW FROM BAR .. LEFT RIGHT WAVE ARROW
+      Sm,  -- (16#021AE#, 16#021AE#)  LEFT RIGHT ARROW WITH STROKE .. LEFT RIGHT ARROW WITH STROKE
+      So,  -- (16#021AF#, 16#021CD#)  DOWNWARDS ZIGZAG ARROW .. LEFTWARDS DOUBLE ARROW WITH STROKE
+      Sm,  -- (16#021CE#, 16#021CF#)  LEFT RIGHT DOUBLE ARROW WITH STROKE .. RIGHTWARDS DOUBLE ARROW WITH STROKE
+      So,  -- (16#021D0#, 16#021D1#)  LEFTWARDS DOUBLE ARROW .. UPWARDS DOUBLE ARROW
+      Sm,  -- (16#021D2#, 16#021D2#)  RIGHTWARDS DOUBLE ARROW .. RIGHTWARDS DOUBLE ARROW
+      So,  -- (16#021D3#, 16#021D3#)  DOWNWARDS DOUBLE ARROW .. DOWNWARDS DOUBLE ARROW
+      Sm,  -- (16#021D4#, 16#021D4#)  LEFT RIGHT DOUBLE ARROW .. LEFT RIGHT DOUBLE ARROW
+      So,  -- (16#021D5#, 16#021F3#)  UP DOWN DOUBLE ARROW .. UP DOWN WHITE ARROW
+      Sm,  -- (16#021F4#, 16#022FF#)  RIGHT ARROW WITH SMALL CIRCLE .. Z NOTATION BAG MEMBERSHIP
+      So,  -- (16#02300#, 16#02307#)  DIAMETER SIGN .. WAVY LINE
+      Sm,  -- (16#02308#, 16#0230B#)  LEFT CEILING .. RIGHT FLOOR
+      So,  -- (16#0230C#, 16#0231F#)  BOTTOM RIGHT CROP .. BOTTOM RIGHT CORNER
+      Sm,  -- (16#02320#, 16#02321#)  TOP HALF INTEGRAL .. BOTTOM HALF INTEGRAL
+      So,  -- (16#02322#, 16#02328#)  FROWN .. KEYBOARD
+      Ps,  -- (16#02329#, 16#02329#)  LEFT-POINTING ANGLE BRACKET .. LEFT-POINTING ANGLE BRACKET
+      Pe,  -- (16#0232A#, 16#0232A#)  RIGHT-POINTING ANGLE BRACKET .. RIGHT-POINTING ANGLE BRACKET
+      So,  -- (16#0232B#, 16#0237B#)  ERASE TO THE LEFT .. NOT CHECK MARK
+      Sm,  -- (16#0237C#, 16#0237C#)  RIGHT ANGLE WITH DOWNWARDS ZIGZAG ARROW .. RIGHT ANGLE WITH DOWNWARDS ZIGZAG ARROW
+      So,  -- (16#0237D#, 16#0239A#)  SHOULDERED OPEN BOX .. CLEAR SCREEN SYMBOL
+      Sm,  -- (16#0239B#, 16#023B3#)  LEFT PARENTHESIS UPPER HOOK .. SUMMATION BOTTOM
+      Ps,  -- (16#023B4#, 16#023B4#)  TOP SQUARE BRACKET .. TOP SQUARE BRACKET
+      Pe,  -- (16#023B5#, 16#023B5#)  BOTTOM SQUARE BRACKET .. BOTTOM SQUARE BRACKET
+      Po,  -- (16#023B6#, 16#023B6#)  BOTTOM SQUARE BRACKET OVER TOP SQUARE BRACKET .. BOTTOM SQUARE BRACKET OVER TOP SQUARE BRACKET
+      So,  -- (16#023B7#, 16#023D0#)  RADICAL SYMBOL BOTTOM .. VERTICAL LINE EXTENSION
+      So,  -- (16#02400#, 16#02426#)  SYMBOL FOR NULL .. SYMBOL FOR SUBSTITUTE FORM TWO
+      So,  -- (16#02440#, 16#0244A#)  OCR HOOK .. OCR DOUBLE BACKSLASH
+      No,  -- (16#02460#, 16#0249B#)  CIRCLED DIGIT ONE .. NUMBER TWENTY FULL STOP
+      So,  -- (16#0249C#, 16#024E9#)  PARENTHESIZED LATIN SMALL LETTER A .. CIRCLED LATIN SMALL LETTER Z
+      No,  -- (16#024EA#, 16#024FF#)  CIRCLED DIGIT ZERO .. NEGATIVE CIRCLED DIGIT ZERO
+      So,  -- (16#02500#, 16#025B6#)  BOX DRAWINGS LIGHT HORIZONTAL .. BLACK RIGHT-POINTING TRIANGLE
+      Sm,  -- (16#025B7#, 16#025B7#)  WHITE RIGHT-POINTING TRIANGLE .. WHITE RIGHT-POINTING TRIANGLE
+      So,  -- (16#025B8#, 16#025C0#)  BLACK RIGHT-POINTING SMALL TRIANGLE .. BLACK LEFT-POINTING TRIANGLE
+      Sm,  -- (16#025C1#, 16#025C1#)  WHITE LEFT-POINTING TRIANGLE .. WHITE LEFT-POINTING TRIANGLE
+      So,  -- (16#025C2#, 16#025F7#)  BLACK LEFT-POINTING SMALL TRIANGLE .. WHITE CIRCLE WITH UPPER RIGHT QUADRANT
+      Sm,  -- (16#025F8#, 16#025FF#)  UPPER LEFT TRIANGLE .. LOWER RIGHT TRIANGLE
+      So,  -- (16#02600#, 16#02617#)  BLACK SUN WITH RAYS .. BLACK SHOGI PIECE
+      So,  -- (16#02619#, 16#0266E#)  REVERSED ROTATED FLORAL HEART BULLET .. MUSIC NATURAL SIGN
+      Sm,  -- (16#0266F#, 16#0266F#)  MUSIC SHARP SIGN .. MUSIC SHARP SIGN
+      So,  -- (16#02670#, 16#0267D#)  WEST SYRIAC CROSS .. PARTIALLY-RECYCLED PAPER SYMBOL
+      So,  -- (16#02680#, 16#02691#)  DIE FACE-1 .. BLACK FLAG
+      So,  -- (16#026A0#, 16#026A1#)  WARNING SIGN .. HIGH VOLTAGE SIGN
+      So,  -- (16#02701#, 16#02704#)  UPPER BLADE SCISSORS .. WHITE SCISSORS
+      So,  -- (16#02706#, 16#02709#)  TELEPHONE LOCATION SIGN .. ENVELOPE
+      So,  -- (16#0270C#, 16#02727#)  VICTORY HAND .. WHITE FOUR POINTED STAR
+      So,  -- (16#02729#, 16#0274B#)  STRESS OUTLINED WHITE STAR .. HEAVY EIGHT TEARDROP-SPOKED PROPELLER ASTERISK
+      So,  -- (16#0274D#, 16#0274D#)  SHADOWED WHITE CIRCLE .. SHADOWED WHITE CIRCLE
+      So,  -- (16#0274F#, 16#02752#)  LOWER RIGHT DROP-SHADOWED WHITE SQUARE .. UPPER RIGHT SHADOWED WHITE SQUARE
+      So,  -- (16#02756#, 16#02756#)  BLACK DIAMOND MINUS WHITE X .. BLACK DIAMOND MINUS WHITE X
+      So,  -- (16#02758#, 16#0275E#)  LIGHT VERTICAL BAR .. HEAVY DOUBLE COMMA QUOTATION MARK ORNAMENT
+      So,  -- (16#02761#, 16#02767#)  CURVED STEM PARAGRAPH SIGN ORNAMENT .. ROTATED FLORAL HEART BULLET
+      Ps,  -- (16#02768#, 16#02768#)  MEDIUM LEFT PARENTHESIS ORNAMENT .. MEDIUM LEFT PARENTHESIS ORNAMENT
+      Pe,  -- (16#02769#, 16#02769#)  MEDIUM RIGHT PARENTHESIS ORNAMENT .. MEDIUM RIGHT PARENTHESIS ORNAMENT
+      Ps,  -- (16#0276A#, 16#0276A#)  MEDIUM FLATTENED LEFT PARENTHESIS ORNAMENT .. MEDIUM FLATTENED LEFT PARENTHESIS ORNAMENT
+      Pe,  -- (16#0276B#, 16#0276B#)  MEDIUM FLATTENED RIGHT PARENTHESIS ORNAMENT .. MEDIUM FLATTENED RIGHT PARENTHESIS ORNAMENT
+      Ps,  -- (16#0276C#, 16#0276C#)  MEDIUM LEFT-POINTING ANGLE BRACKET ORNAMENT .. MEDIUM LEFT-POINTING ANGLE BRACKET ORNAMENT
+      Pe,  -- (16#0276D#, 16#0276D#)  MEDIUM RIGHT-POINTING ANGLE BRACKET ORNAMENT .. MEDIUM RIGHT-POINTING ANGLE BRACKET ORNAMENT
+      Ps,  -- (16#0276E#, 16#0276E#)  HEAVY LEFT-POINTING ANGLE QUOTATION MARK ORNAMENT .. HEAVY LEFT-POINTING ANGLE QUOTATION MARK ORNAMENT
+      Pe,  -- (16#0276F#, 16#0276F#)  HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT .. HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT
+      Ps,  -- (16#02770#, 16#02770#)  HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT .. HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT
+      Pe,  -- (16#02771#, 16#02771#)  HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT .. HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT
+      Ps,  -- (16#02772#, 16#02772#)  LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT .. LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT
+      Pe,  -- (16#02773#, 16#02773#)  LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT .. LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT
+      Ps,  -- (16#02774#, 16#02774#)  MEDIUM LEFT CURLY BRACKET ORNAMENT .. MEDIUM LEFT CURLY BRACKET ORNAMENT
+      Pe,  -- (16#02775#, 16#02775#)  MEDIUM RIGHT CURLY BRACKET ORNAMENT .. MEDIUM RIGHT CURLY BRACKET ORNAMENT
+      No,  -- (16#02776#, 16#02793#)  DINGBAT NEGATIVE CIRCLED DIGIT ONE .. DINGBAT NEGATIVE CIRCLED SANS-SERIF NUMBER TEN
+      So,  -- (16#02794#, 16#02794#)  HEAVY WIDE-HEADED RIGHTWARDS ARROW .. HEAVY WIDE-HEADED RIGHTWARDS ARROW
+      So,  -- (16#02798#, 16#027AF#)  HEAVY SOUTH EAST ARROW .. NOTCHED LOWER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW
+      So,  -- (16#027B1#, 16#027BE#)  NOTCHED UPPER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW .. OPEN-OUTLINED RIGHTWARDS ARROW
+      Sm,  -- (16#027D0#, 16#027E5#)  WHITE DIAMOND WITH CENTRED DOT .. WHITE SQUARE WITH RIGHTWARDS TICK
+      Ps,  -- (16#027E6#, 16#027E6#)  MATHEMATICAL LEFT WHITE SQUARE BRACKET .. MATHEMATICAL LEFT WHITE SQUARE BRACKET
+      Pe,  -- (16#027E7#, 16#027E7#)  MATHEMATICAL RIGHT WHITE SQUARE BRACKET .. MATHEMATICAL RIGHT WHITE SQUARE BRACKET
+      Ps,  -- (16#027E8#, 16#027E8#)  MATHEMATICAL LEFT ANGLE BRACKET .. MATHEMATICAL LEFT ANGLE BRACKET
+      Pe,  -- (16#027E9#, 16#027E9#)  MATHEMATICAL RIGHT ANGLE BRACKET .. MATHEMATICAL RIGHT ANGLE BRACKET
+      Ps,  -- (16#027EA#, 16#027EA#)  MATHEMATICAL LEFT DOUBLE ANGLE BRACKET .. MATHEMATICAL LEFT DOUBLE ANGLE BRACKET
+      Pe,  -- (16#027EB#, 16#027EB#)  MATHEMATICAL RIGHT DOUBLE ANGLE BRACKET .. MATHEMATICAL RIGHT DOUBLE ANGLE BRACKET
+      Sm,  -- (16#027F0#, 16#027FF#)  UPWARDS QUADRUPLE ARROW .. LONG RIGHTWARDS SQUIGGLE ARROW
+      So,  -- (16#02800#, 16#028FF#)  BRAILLE PATTERN BLANK .. BRAILLE PATTERN DOTS-12345678
+      Sm,  -- (16#02900#, 16#02982#)  RIGHTWARDS TWO-HEADED ARROW WITH VERTICAL STROKE .. Z NOTATION TYPE COLON
+      Ps,  -- (16#02983#, 16#02983#)  LEFT WHITE CURLY BRACKET .. LEFT WHITE CURLY BRACKET
+      Pe,  -- (16#02984#, 16#02984#)  RIGHT WHITE CURLY BRACKET .. RIGHT WHITE CURLY BRACKET
+      Ps,  -- (16#02985#, 16#02985#)  LEFT WHITE PARENTHESIS .. LEFT WHITE PARENTHESIS
+      Pe,  -- (16#02986#, 16#02986#)  RIGHT WHITE PARENTHESIS .. RIGHT WHITE PARENTHESIS
+      Ps,  -- (16#02987#, 16#02987#)  Z NOTATION LEFT IMAGE BRACKET .. Z NOTATION LEFT IMAGE BRACKET
+      Pe,  -- (16#02988#, 16#02988#)  Z NOTATION RIGHT IMAGE BRACKET .. Z NOTATION RIGHT IMAGE BRACKET
+      Ps,  -- (16#02989#, 16#02989#)  Z NOTATION LEFT BINDING BRACKET .. Z NOTATION LEFT BINDING BRACKET
+      Pe,  -- (16#0298A#, 16#0298A#)  Z NOTATION RIGHT BINDING BRACKET .. Z NOTATION RIGHT BINDING BRACKET
+      Ps,  -- (16#0298B#, 16#0298B#)  LEFT SQUARE BRACKET WITH UNDERBAR .. LEFT SQUARE BRACKET WITH UNDERBAR
+      Pe,  -- (16#0298C#, 16#0298C#)  RIGHT SQUARE BRACKET WITH UNDERBAR .. RIGHT SQUARE BRACKET WITH UNDERBAR
+      Ps,  -- (16#0298D#, 16#0298D#)  LEFT SQUARE BRACKET WITH TICK IN TOP CORNER .. LEFT SQUARE BRACKET WITH TICK IN TOP CORNER
+      Pe,  -- (16#0298E#, 16#0298E#)  RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER .. RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER
+      Ps,  -- (16#0298F#, 16#0298F#)  LEFT SQUARE BRACKET WITH TICK IN BOTTOM CORNER .. LEFT SQUARE BRACKET WITH TICK IN BOTTOM CORNER
+      Pe,  -- (16#02990#, 16#02990#)  RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER .. RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER
+      Ps,  -- (16#02991#, 16#02991#)  LEFT ANGLE BRACKET WITH DOT .. LEFT ANGLE BRACKET WITH DOT
+      Pe,  -- (16#02992#, 16#02992#)  RIGHT ANGLE BRACKET WITH DOT .. RIGHT ANGLE BRACKET WITH DOT
+      Ps,  -- (16#02993#, 16#02993#)  LEFT ARC LESS-THAN BRACKET .. LEFT ARC LESS-THAN BRACKET
+      Pe,  -- (16#02994#, 16#02994#)  RIGHT ARC GREATER-THAN BRACKET .. RIGHT ARC GREATER-THAN BRACKET
+      Ps,  -- (16#02995#, 16#02995#)  DOUBLE LEFT ARC GREATER-THAN BRACKET .. DOUBLE LEFT ARC GREATER-THAN BRACKET
+      Pe,  -- (16#02996#, 16#02996#)  DOUBLE RIGHT ARC LESS-THAN BRACKET .. DOUBLE RIGHT ARC LESS-THAN BRACKET
+      Ps,  -- (16#02997#, 16#02997#)  LEFT BLACK TORTOISE SHELL BRACKET .. LEFT BLACK TORTOISE SHELL BRACKET
+      Pe,  -- (16#02998#, 16#02998#)  RIGHT BLACK TORTOISE SHELL BRACKET .. RIGHT BLACK TORTOISE SHELL BRACKET
+      Sm,  -- (16#02999#, 16#029D7#)  DOTTED FENCE .. BLACK HOURGLASS
+      Ps,  -- (16#029D8#, 16#029D8#)  LEFT WIGGLY FENCE .. LEFT WIGGLY FENCE
+      Pe,  -- (16#029D9#, 16#029D9#)  RIGHT WIGGLY FENCE .. RIGHT WIGGLY FENCE
+      Ps,  -- (16#029DA#, 16#029DA#)  LEFT DOUBLE WIGGLY FENCE .. LEFT DOUBLE WIGGLY FENCE
+      Pe,  -- (16#029DB#, 16#029DB#)  RIGHT DOUBLE WIGGLY FENCE .. RIGHT DOUBLE WIGGLY FENCE
+      Sm,  -- (16#029DC#, 16#029FB#)  INCOMPLETE INFINITY .. TRIPLE PLUS
+      Ps,  -- (16#029FC#, 16#029FC#)  LEFT-POINTING CURVED ANGLE BRACKET .. LEFT-POINTING CURVED ANGLE BRACKET
+      Pe,  -- (16#029FD#, 16#029FD#)  RIGHT-POINTING CURVED ANGLE BRACKET .. RIGHT-POINTING CURVED ANGLE BRACKET
+      Sm,  -- (16#029FE#, 16#02AFF#)  TINY .. N-ARY WHITE VERTICAL BAR
+      So,  -- (16#02B00#, 16#02B0D#)  NORTH EAST WHITE ARROW .. UP DOWN BLACK ARROW
+      So,  -- (16#02E80#, 16#02E99#)  CJK RADICAL REPEAT .. CJK RADICAL RAP
+      So,  -- (16#02E9B#, 16#02EF3#)  CJK RADICAL CHOKE .. CJK RADICAL C-SIMPLIFIED TURTLE
+      So,  -- (16#02F00#, 16#02FD5#)  KANGXI RADICAL ONE .. KANGXI RADICAL FLUTE
+      So,  -- (16#02FF0#, 16#02FFB#)  IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT .. IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID
+      Zs,  -- (16#03000#, 16#03000#)  IDEOGRAPHIC SPACE .. IDEOGRAPHIC SPACE
+      Po,  -- (16#03001#, 16#03003#)  IDEOGRAPHIC COMMA .. DITTO MARK
+      So,  -- (16#03004#, 16#03004#)  JAPANESE INDUSTRIAL STANDARD SYMBOL .. JAPANESE INDUSTRIAL STANDARD SYMBOL
+      Lm,  -- (16#03005#, 16#03005#)  IDEOGRAPHIC ITERATION MARK .. IDEOGRAPHIC ITERATION MARK
+      Lo,  -- (16#03006#, 16#03006#)  IDEOGRAPHIC CLOSING MARK .. IDEOGRAPHIC CLOSING MARK
+      Nl,  -- (16#03007#, 16#03007#)  IDEOGRAPHIC NUMBER ZERO .. IDEOGRAPHIC NUMBER ZERO
+      Ps,  -- (16#03008#, 16#03008#)  LEFT ANGLE BRACKET .. LEFT ANGLE BRACKET
+      Pe,  -- (16#03009#, 16#03009#)  RIGHT ANGLE BRACKET .. RIGHT ANGLE BRACKET
+      Ps,  -- (16#0300A#, 16#0300A#)  LEFT DOUBLE ANGLE BRACKET .. LEFT DOUBLE ANGLE BRACKET
+      Pe,  -- (16#0300B#, 16#0300B#)  RIGHT DOUBLE ANGLE BRACKET .. RIGHT DOUBLE ANGLE BRACKET
+      Ps,  -- (16#0300C#, 16#0300C#)  LEFT CORNER BRACKET .. LEFT CORNER BRACKET
+      Pe,  -- (16#0300D#, 16#0300D#)  RIGHT CORNER BRACKET .. RIGHT CORNER BRACKET
+      Ps,  -- (16#0300E#, 16#0300E#)  LEFT WHITE CORNER BRACKET .. LEFT WHITE CORNER BRACKET
+      Pe,  -- (16#0300F#, 16#0300F#)  RIGHT WHITE CORNER BRACKET .. RIGHT WHITE CORNER BRACKET
+      Ps,  -- (16#03010#, 16#03010#)  LEFT BLACK LENTICULAR BRACKET .. LEFT BLACK LENTICULAR BRACKET
+      Pe,  -- (16#03011#, 16#03011#)  RIGHT BLACK LENTICULAR BRACKET .. RIGHT BLACK LENTICULAR BRACKET
+      So,  -- (16#03012#, 16#03013#)  POSTAL MARK .. GETA MARK
+      Ps,  -- (16#03014#, 16#03014#)  LEFT TORTOISE SHELL BRACKET .. LEFT TORTOISE SHELL BRACKET
+      Pe,  -- (16#03015#, 16#03015#)  RIGHT TORTOISE SHELL BRACKET .. RIGHT TORTOISE SHELL BRACKET
+      Ps,  -- (16#03016#, 16#03016#)  LEFT WHITE LENTICULAR BRACKET .. LEFT WHITE LENTICULAR BRACKET
+      Pe,  -- (16#03017#, 16#03017#)  RIGHT WHITE LENTICULAR BRACKET .. RIGHT WHITE LENTICULAR BRACKET
+      Ps,  -- (16#03018#, 16#03018#)  LEFT WHITE TORTOISE SHELL BRACKET .. LEFT WHITE TORTOISE SHELL BRACKET
+      Pe,  -- (16#03019#, 16#03019#)  RIGHT WHITE TORTOISE SHELL BRACKET .. RIGHT WHITE TORTOISE SHELL BRACKET
+      Ps,  -- (16#0301A#, 16#0301A#)  LEFT WHITE SQUARE BRACKET .. LEFT WHITE SQUARE BRACKET
+      Pe,  -- (16#0301B#, 16#0301B#)  RIGHT WHITE SQUARE BRACKET .. RIGHT WHITE SQUARE BRACKET
+      Pd,  -- (16#0301C#, 16#0301C#)  WAVE DASH .. WAVE DASH
+      Ps,  -- (16#0301D#, 16#0301D#)  REVERSED DOUBLE PRIME QUOTATION MARK .. REVERSED DOUBLE PRIME QUOTATION MARK
+      Pe,  -- (16#0301E#, 16#0301F#)  DOUBLE PRIME QUOTATION MARK .. LOW DOUBLE PRIME QUOTATION MARK
+      So,  -- (16#03020#, 16#03020#)  POSTAL MARK FACE .. POSTAL MARK FACE
+      Nl,  -- (16#03021#, 16#03029#)  HANGZHOU NUMERAL ONE .. HANGZHOU NUMERAL NINE
+      Mn,  -- (16#0302A#, 16#0302F#)  IDEOGRAPHIC LEVEL TONE MARK .. HANGUL DOUBLE DOT TONE MARK
+      Pd,  -- (16#03030#, 16#03030#)  WAVY DASH .. WAVY DASH
+      Lm,  -- (16#03031#, 16#03035#)  VERTICAL KANA REPEAT MARK .. VERTICAL KANA REPEAT MARK LOWER HALF
+      So,  -- (16#03036#, 16#03037#)  CIRCLED POSTAL MARK .. IDEOGRAPHIC TELEGRAPH LINE FEED SEPARATOR SYMBOL
+      Nl,  -- (16#03038#, 16#0303A#)  HANGZHOU NUMERAL TEN .. HANGZHOU NUMERAL THIRTY
+      Lm,  -- (16#0303B#, 16#0303B#)  VERTICAL IDEOGRAPHIC ITERATION MARK .. VERTICAL IDEOGRAPHIC ITERATION MARK
+      Lo,  -- (16#0303C#, 16#0303C#)  MASU MARK .. MASU MARK
+      Po,  -- (16#0303D#, 16#0303D#)  PART ALTERNATION MARK .. PART ALTERNATION MARK
+      So,  -- (16#0303E#, 16#0303F#)  IDEOGRAPHIC VARIATION INDICATOR .. IDEOGRAPHIC HALF FILL SPACE
+      Lo,  -- (16#03041#, 16#03096#)  HIRAGANA LETTER SMALL A .. HIRAGANA LETTER SMALL KE
+      Mn,  -- (16#03099#, 16#0309A#)  COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK .. COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+      Sk,  -- (16#0309B#, 16#0309C#)  KATAKANA-HIRAGANA VOICED SOUND MARK .. KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
+      Lm,  -- (16#0309D#, 16#0309E#)  HIRAGANA ITERATION MARK .. HIRAGANA VOICED ITERATION MARK
+      Lo,  -- (16#0309F#, 16#0309F#)  HIRAGANA DIGRAPH YORI .. HIRAGANA DIGRAPH YORI
+      Pd,  -- (16#030A0#, 16#030A0#)  KATAKANA-HIRAGANA DOUBLE HYPHEN .. KATAKANA-HIRAGANA DOUBLE HYPHEN
+      Lo,  -- (16#030A1#, 16#030FA#)  KATAKANA LETTER SMALL A .. KATAKANA LETTER VO
+      Pc,  -- (16#030FB#, 16#030FB#)  KATAKANA MIDDLE DOT .. KATAKANA MIDDLE DOT
+      Lm,  -- (16#030FC#, 16#030FE#)  KATAKANA-HIRAGANA PROLONGED SOUND MARK .. KATAKANA VOICED ITERATION MARK
+      Lo,  -- (16#030FF#, 16#030FF#)  KATAKANA DIGRAPH KOTO .. KATAKANA DIGRAPH KOTO
+      Lo,  -- (16#03105#, 16#0312C#)  BOPOMOFO LETTER B .. BOPOMOFO LETTER GN
+      Lo,  -- (16#03131#, 16#0318E#)  HANGUL LETTER KIYEOK .. HANGUL LETTER ARAEAE
+      So,  -- (16#03190#, 16#03191#)  IDEOGRAPHIC ANNOTATION LINKING MARK .. IDEOGRAPHIC ANNOTATION REVERSE MARK
+      No,  -- (16#03192#, 16#03195#)  IDEOGRAPHIC ANNOTATION ONE MARK .. IDEOGRAPHIC ANNOTATION FOUR MARK
+      So,  -- (16#03196#, 16#0319F#)  IDEOGRAPHIC ANNOTATION TOP MARK .. IDEOGRAPHIC ANNOTATION MAN MARK
+      Lo,  -- (16#031A0#, 16#031B7#)  BOPOMOFO LETTER BU .. BOPOMOFO FINAL LETTER H
+      Lo,  -- (16#031F0#, 16#031FF#)  KATAKANA LETTER SMALL KU .. KATAKANA LETTER SMALL RO
+      So,  -- (16#03200#, 16#0321E#)  PARENTHESIZED HANGUL KIYEOK .. PARENTHESIZED KOREAN CHARACTER O HU
+      No,  -- (16#03220#, 16#03229#)  PARENTHESIZED IDEOGRAPH ONE .. PARENTHESIZED IDEOGRAPH TEN
+      So,  -- (16#0322A#, 16#03243#)  PARENTHESIZED IDEOGRAPH MOON .. PARENTHESIZED IDEOGRAPH REACH
+      So,  -- (16#03250#, 16#03250#)  PARTNERSHIP SIGN .. PARTNERSHIP SIGN
+      No,  -- (16#03251#, 16#0325F#)  CIRCLED NUMBER TWENTY ONE .. CIRCLED NUMBER THIRTY FIVE
+      So,  -- (16#03260#, 16#0327D#)  CIRCLED HANGUL KIYEOK .. CIRCLED KOREAN CHARACTER JUEUI
+      So,  -- (16#0327F#, 16#0327F#)  KOREAN STANDARD SYMBOL .. KOREAN STANDARD SYMBOL
+      No,  -- (16#03280#, 16#03289#)  CIRCLED IDEOGRAPH ONE .. CIRCLED IDEOGRAPH TEN
+      So,  -- (16#0328A#, 16#032B0#)  CIRCLED IDEOGRAPH MOON .. CIRCLED IDEOGRAPH NIGHT
+      No,  -- (16#032B1#, 16#032BF#)  CIRCLED NUMBER THIRTY SIX .. CIRCLED NUMBER FIFTY
+      So,  -- (16#032C0#, 16#032FE#)  IDEOGRAPHIC TELEGRAPH SYMBOL FOR JANUARY .. CIRCLED KATAKANA WO
+      So,  -- (16#03300#, 16#033FF#)  SQUARE APAATO .. SQUARE GAL
+      Lo,  -- (16#03400#, 16#04DB5#)  <CJK Ideograph Extension A, First> .. <CJK Ideograph Extension A, Last>
+      So,  -- (16#04DC0#, 16#04DFF#)  HEXAGRAM FOR THE CREATIVE HEAVEN .. HEXAGRAM FOR BEFORE COMPLETION
+      Lo,  -- (16#04E00#, 16#09FA5#)  <CJK Ideograph, First> .. <CJK Ideograph, Last>
+      Lo,  -- (16#0A000#, 16#0A48C#)  YI SYLLABLE IT .. YI SYLLABLE YYR
+      So,  -- (16#0A490#, 16#0A4C6#)  YI RADICAL QOT .. YI RADICAL KE
+      Lo,  -- (16#0AC00#, 16#0D7A3#)  <Hangul Syllable, First> .. <Hangul Syllable, Last>
+      Cs,  -- (16#0D800#, 16#0F8FF#)  <Non Private Use High Surrogate, First> .. <Private Use, Last>
+      Lo,  -- (16#0F900#, 16#0FA2D#)  CJK COMPATIBILITY IDEOGRAPH-F900 .. CJK COMPATIBILITY IDEOGRAPH-FA2D
+      Lo,  -- (16#0FA30#, 16#0FA6A#)  CJK COMPATIBILITY IDEOGRAPH-FA30 .. CJK COMPATIBILITY IDEOGRAPH-FA6A
+      Ll,  -- (16#0FB00#, 16#0FB06#)  LATIN SMALL LIGATURE FF .. LATIN SMALL LIGATURE ST
+      Ll,  -- (16#0FB13#, 16#0FB17#)  ARMENIAN SMALL LIGATURE MEN NOW .. ARMENIAN SMALL LIGATURE MEN XEH
+      Lo,  -- (16#0FB1D#, 16#0FB1D#)  HEBREW LETTER YOD WITH HIRIQ .. HEBREW LETTER YOD WITH HIRIQ
+      Mn,  -- (16#0FB1E#, 16#0FB1E#)  HEBREW POINT JUDEO-SPANISH VARIKA .. HEBREW POINT JUDEO-SPANISH VARIKA
+      Lo,  -- (16#0FB1F#, 16#0FB28#)  HEBREW LIGATURE YIDDISH YOD YOD PATAH .. HEBREW LETTER WIDE TAV
+      Sm,  -- (16#0FB29#, 16#0FB29#)  HEBREW LETTER ALTERNATIVE PLUS SIGN .. HEBREW LETTER ALTERNATIVE PLUS SIGN
+      Lo,  -- (16#0FB2A#, 16#0FB36#)  HEBREW LETTER SHIN WITH SHIN DOT .. HEBREW LETTER ZAYIN WITH DAGESH
+      Lo,  -- (16#0FB38#, 16#0FB3C#)  HEBREW LETTER TET WITH DAGESH .. HEBREW LETTER LAMED WITH DAGESH
+      Lo,  -- (16#0FB3E#, 16#0FB3E#)  HEBREW LETTER MEM WITH DAGESH .. HEBREW LETTER MEM WITH DAGESH
+      Lo,  -- (16#0FB40#, 16#0FB41#)  HEBREW LETTER NUN WITH DAGESH .. HEBREW LETTER SAMEKH WITH DAGESH
+      Lo,  -- (16#0FB43#, 16#0FB44#)  HEBREW LETTER FINAL PE WITH DAGESH .. HEBREW LETTER PE WITH DAGESH
+      Lo,  -- (16#0FB46#, 16#0FBB1#)  HEBREW LETTER TSADI WITH DAGESH .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM
+      Lo,  -- (16#0FBD3#, 16#0FD3D#)  ARABIC LETTER NG ISOLATED FORM .. ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM
+      Ps,  -- (16#0FD3E#, 16#0FD3E#)  ORNATE LEFT PARENTHESIS .. ORNATE LEFT PARENTHESIS
+      Pe,  -- (16#0FD3F#, 16#0FD3F#)  ORNATE RIGHT PARENTHESIS .. ORNATE RIGHT PARENTHESIS
+      Lo,  -- (16#0FD50#, 16#0FD8F#)  ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM .. ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM
+      Lo,  -- (16#0FD92#, 16#0FDC7#)  ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM .. ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM
+      Lo,  -- (16#0FDF0#, 16#0FDFB#)  ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM .. ARABIC LIGATURE JALLAJALALOUHOU
+      Sc,  -- (16#0FDFC#, 16#0FDFC#)  RIAL SIGN .. RIAL SIGN
+      So,  -- (16#0FDFD#, 16#0FDFD#)  ARABIC LIGATURE BISMILLAH AR-RAHMAN AR-RAHEEM .. ARABIC LIGATURE BISMILLAH AR-RAHMAN AR-RAHEEM
+      Mn,  -- (16#0FE00#, 16#0FE0F#)  VARIATION SELECTOR-1 .. VARIATION SELECTOR-16
+      Mn,  -- (16#0FE20#, 16#0FE23#)  COMBINING LIGATURE LEFT HALF .. COMBINING DOUBLE TILDE RIGHT HALF
+      Po,  -- (16#0FE30#, 16#0FE30#)  PRESENTATION FORM FOR VERTICAL TWO DOT LEADER .. PRESENTATION FORM FOR VERTICAL TWO DOT LEADER
+      Pd,  -- (16#0FE31#, 16#0FE32#)  PRESENTATION FORM FOR VERTICAL EM DASH .. PRESENTATION FORM FOR VERTICAL EN DASH
+      Pc,  -- (16#0FE33#, 16#0FE34#)  PRESENTATION FORM FOR VERTICAL LOW LINE .. PRESENTATION FORM FOR VERTICAL WAVY LOW LINE
+      Ps,  -- (16#0FE35#, 16#0FE35#)  PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS .. PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS
+      Pe,  -- (16#0FE36#, 16#0FE36#)  PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS .. PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS
+      Ps,  -- (16#0FE37#, 16#0FE37#)  PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET
+      Pe,  -- (16#0FE38#, 16#0FE38#)  PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET
+      Ps,  -- (16#0FE39#, 16#0FE39#)  PRESENTATION FORM FOR VERTICAL LEFT TORTOISE SHELL BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT TORTOISE SHELL BRACKET
+      Pe,  -- (16#0FE3A#, 16#0FE3A#)  PRESENTATION FORM FOR VERTICAL RIGHT TORTOISE SHELL BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT TORTOISE SHELL BRACKET
+      Ps,  -- (16#0FE3B#, 16#0FE3B#)  PRESENTATION FORM FOR VERTICAL LEFT BLACK LENTICULAR BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT BLACK LENTICULAR BRACKET
+      Pe,  -- (16#0FE3C#, 16#0FE3C#)  PRESENTATION FORM FOR VERTICAL RIGHT BLACK LENTICULAR BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT BLACK LENTICULAR BRACKET
+      Ps,  -- (16#0FE3D#, 16#0FE3D#)  PRESENTATION FORM FOR VERTICAL LEFT DOUBLE ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT DOUBLE ANGLE BRACKET
+      Pe,  -- (16#0FE3E#, 16#0FE3E#)  PRESENTATION FORM FOR VERTICAL RIGHT DOUBLE ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT DOUBLE ANGLE BRACKET
+      Ps,  -- (16#0FE3F#, 16#0FE3F#)  PRESENTATION FORM FOR VERTICAL LEFT ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT ANGLE BRACKET
+      Pe,  -- (16#0FE40#, 16#0FE40#)  PRESENTATION FORM FOR VERTICAL RIGHT ANGLE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT ANGLE BRACKET
+      Ps,  -- (16#0FE41#, 16#0FE41#)  PRESENTATION FORM FOR VERTICAL LEFT CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT CORNER BRACKET
+      Pe,  -- (16#0FE42#, 16#0FE42#)  PRESENTATION FORM FOR VERTICAL RIGHT CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT CORNER BRACKET
+      Ps,  -- (16#0FE43#, 16#0FE43#)  PRESENTATION FORM FOR VERTICAL LEFT WHITE CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT WHITE CORNER BRACKET
+      Pe,  -- (16#0FE44#, 16#0FE44#)  PRESENTATION FORM FOR VERTICAL RIGHT WHITE CORNER BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT WHITE CORNER BRACKET
+      Po,  -- (16#0FE45#, 16#0FE46#)  SESAME DOT .. WHITE SESAME DOT
+      Ps,  -- (16#0FE47#, 16#0FE47#)  PRESENTATION FORM FOR VERTICAL LEFT SQUARE BRACKET .. PRESENTATION FORM FOR VERTICAL LEFT SQUARE BRACKET
+      Pe,  -- (16#0FE48#, 16#0FE48#)  PRESENTATION FORM FOR VERTICAL RIGHT SQUARE BRACKET .. PRESENTATION FORM FOR VERTICAL RIGHT SQUARE BRACKET
+      Po,  -- (16#0FE49#, 16#0FE4C#)  DASHED OVERLINE .. DOUBLE WAVY OVERLINE
+      Pc,  -- (16#0FE4D#, 16#0FE4F#)  DASHED LOW LINE .. WAVY LOW LINE
+      Po,  -- (16#0FE50#, 16#0FE52#)  SMALL COMMA .. SMALL FULL STOP
+      Po,  -- (16#0FE54#, 16#0FE57#)  SMALL SEMICOLON .. SMALL EXCLAMATION MARK
+      Pd,  -- (16#0FE58#, 16#0FE58#)  SMALL EM DASH .. SMALL EM DASH
+      Ps,  -- (16#0FE59#, 16#0FE59#)  SMALL LEFT PARENTHESIS .. SMALL LEFT PARENTHESIS
+      Pe,  -- (16#0FE5A#, 16#0FE5A#)  SMALL RIGHT PARENTHESIS .. SMALL RIGHT PARENTHESIS
+      Ps,  -- (16#0FE5B#, 16#0FE5B#)  SMALL LEFT CURLY BRACKET .. SMALL LEFT CURLY BRACKET
+      Pe,  -- (16#0FE5C#, 16#0FE5C#)  SMALL RIGHT CURLY BRACKET .. SMALL RIGHT CURLY BRACKET
+      Ps,  -- (16#0FE5D#, 16#0FE5D#)  SMALL LEFT TORTOISE SHELL BRACKET .. SMALL LEFT TORTOISE SHELL BRACKET
+      Pe,  -- (16#0FE5E#, 16#0FE5E#)  SMALL RIGHT TORTOISE SHELL BRACKET .. SMALL RIGHT TORTOISE SHELL BRACKET
+      Po,  -- (16#0FE5F#, 16#0FE61#)  SMALL NUMBER SIGN .. SMALL ASTERISK
+      Sm,  -- (16#0FE62#, 16#0FE62#)  SMALL PLUS SIGN .. SMALL PLUS SIGN
+      Pd,  -- (16#0FE63#, 16#0FE63#)  SMALL HYPHEN-MINUS .. SMALL HYPHEN-MINUS
+      Sm,  -- (16#0FE64#, 16#0FE66#)  SMALL LESS-THAN SIGN .. SMALL EQUALS SIGN
+      Po,  -- (16#0FE68#, 16#0FE68#)  SMALL REVERSE SOLIDUS .. SMALL REVERSE SOLIDUS
+      Sc,  -- (16#0FE69#, 16#0FE69#)  SMALL DOLLAR SIGN .. SMALL DOLLAR SIGN
+      Po,  -- (16#0FE6A#, 16#0FE6B#)  SMALL PERCENT SIGN .. SMALL COMMERCIAL AT
+      Lo,  -- (16#0FE70#, 16#0FE74#)  ARABIC FATHATAN ISOLATED FORM .. ARABIC KASRATAN ISOLATED FORM
+      Lo,  -- (16#0FE76#, 16#0FEFC#)  ARABIC FATHA ISOLATED FORM .. ARABIC LIGATURE LAM WITH ALEF FINAL FORM
+      Cf,  -- (16#0FEFF#, 16#0FEFF#)  ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE
+      Po,  -- (16#0FF01#, 16#0FF03#)  FULLWIDTH EXCLAMATION MARK .. FULLWIDTH NUMBER SIGN
+      Sc,  -- (16#0FF04#, 16#0FF04#)  FULLWIDTH DOLLAR SIGN .. FULLWIDTH DOLLAR SIGN
+      Po,  -- (16#0FF05#, 16#0FF07#)  FULLWIDTH PERCENT SIGN .. FULLWIDTH APOSTROPHE
+      Ps,  -- (16#0FF08#, 16#0FF08#)  FULLWIDTH LEFT PARENTHESIS .. FULLWIDTH LEFT PARENTHESIS
+      Pe,  -- (16#0FF09#, 16#0FF09#)  FULLWIDTH RIGHT PARENTHESIS .. FULLWIDTH RIGHT PARENTHESIS
+      Po,  -- (16#0FF0A#, 16#0FF0A#)  FULLWIDTH ASTERISK .. FULLWIDTH ASTERISK
+      Sm,  -- (16#0FF0B#, 16#0FF0B#)  FULLWIDTH PLUS SIGN .. FULLWIDTH PLUS SIGN
+      Po,  -- (16#0FF0C#, 16#0FF0C#)  FULLWIDTH COMMA .. FULLWIDTH COMMA
+      Pd,  -- (16#0FF0D#, 16#0FF0D#)  FULLWIDTH HYPHEN-MINUS .. FULLWIDTH HYPHEN-MINUS
+      Po,  -- (16#0FF0E#, 16#0FF0F#)  FULLWIDTH FULL STOP .. FULLWIDTH SOLIDUS
+      Nd,  -- (16#0FF10#, 16#0FF19#)  FULLWIDTH DIGIT ZERO .. FULLWIDTH DIGIT NINE
+      Po,  -- (16#0FF1A#, 16#0FF1B#)  FULLWIDTH COLON .. FULLWIDTH SEMICOLON
+      Sm,  -- (16#0FF1C#, 16#0FF1E#)  FULLWIDTH LESS-THAN SIGN .. FULLWIDTH GREATER-THAN SIGN
+      Po,  -- (16#0FF1F#, 16#0FF20#)  FULLWIDTH QUESTION MARK .. FULLWIDTH COMMERCIAL AT
+      Lu,  -- (16#0FF21#, 16#0FF3A#)  FULLWIDTH LATIN CAPITAL LETTER A .. FULLWIDTH LATIN CAPITAL LETTER Z
+      Ps,  -- (16#0FF3B#, 16#0FF3B#)  FULLWIDTH LEFT SQUARE BRACKET .. FULLWIDTH LEFT SQUARE BRACKET
+      Po,  -- (16#0FF3C#, 16#0FF3C#)  FULLWIDTH REVERSE SOLIDUS .. FULLWIDTH REVERSE SOLIDUS
+      Pe,  -- (16#0FF3D#, 16#0FF3D#)  FULLWIDTH RIGHT SQUARE BRACKET .. FULLWIDTH RIGHT SQUARE BRACKET
+      Sk,  -- (16#0FF3E#, 16#0FF3E#)  FULLWIDTH CIRCUMFLEX ACCENT .. FULLWIDTH CIRCUMFLEX ACCENT
+      Pc,  -- (16#0FF3F#, 16#0FF3F#)  FULLWIDTH LOW LINE .. FULLWIDTH LOW LINE
+      Sk,  -- (16#0FF40#, 16#0FF40#)  FULLWIDTH GRAVE ACCENT .. FULLWIDTH GRAVE ACCENT
+      Ll,  -- (16#0FF41#, 16#0FF5A#)  FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
+      Ps,  -- (16#0FF5B#, 16#0FF5B#)  FULLWIDTH LEFT CURLY BRACKET .. FULLWIDTH LEFT CURLY BRACKET
+      Sm,  -- (16#0FF5C#, 16#0FF5C#)  FULLWIDTH VERTICAL LINE .. FULLWIDTH VERTICAL LINE
+      Pe,  -- (16#0FF5D#, 16#0FF5D#)  FULLWIDTH RIGHT CURLY BRACKET .. FULLWIDTH RIGHT CURLY BRACKET
+      Sm,  -- (16#0FF5E#, 16#0FF5E#)  FULLWIDTH TILDE .. FULLWIDTH TILDE
+      Ps,  -- (16#0FF5F#, 16#0FF5F#)  FULLWIDTH LEFT WHITE PARENTHESIS .. FULLWIDTH LEFT WHITE PARENTHESIS
+      Pe,  -- (16#0FF60#, 16#0FF60#)  FULLWIDTH RIGHT WHITE PARENTHESIS .. FULLWIDTH RIGHT WHITE PARENTHESIS
+      Po,  -- (16#0FF61#, 16#0FF61#)  HALFWIDTH IDEOGRAPHIC FULL STOP .. HALFWIDTH IDEOGRAPHIC FULL STOP
+      Ps,  -- (16#0FF62#, 16#0FF62#)  HALFWIDTH LEFT CORNER BRACKET .. HALFWIDTH LEFT CORNER BRACKET
+      Pe,  -- (16#0FF63#, 16#0FF63#)  HALFWIDTH RIGHT CORNER BRACKET .. HALFWIDTH RIGHT CORNER BRACKET
+      Po,  -- (16#0FF64#, 16#0FF64#)  HALFWIDTH IDEOGRAPHIC COMMA .. HALFWIDTH IDEOGRAPHIC COMMA
+      Pc,  -- (16#0FF65#, 16#0FF65#)  HALFWIDTH KATAKANA MIDDLE DOT .. HALFWIDTH KATAKANA MIDDLE DOT
+      Lo,  -- (16#0FF66#, 16#0FF6F#)  HALFWIDTH KATAKANA LETTER WO .. HALFWIDTH KATAKANA LETTER SMALL TU
+      Lm,  -- (16#0FF70#, 16#0FF70#)  HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK .. HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK
+      Lo,  -- (16#0FF71#, 16#0FF9D#)  HALFWIDTH KATAKANA LETTER A .. HALFWIDTH KATAKANA LETTER N
+      Lm,  -- (16#0FF9E#, 16#0FF9F#)  HALFWIDTH KATAKANA VOICED SOUND MARK .. HALFWIDTH KATAKANA SEMI-VOICED SOUND MARK
+      Lo,  -- (16#0FFA0#, 16#0FFBE#)  HALFWIDTH HANGUL FILLER .. HALFWIDTH HANGUL LETTER HIEUH
+      Lo,  -- (16#0FFC2#, 16#0FFC7#)  HALFWIDTH HANGUL LETTER A .. HALFWIDTH HANGUL LETTER E
+      Lo,  -- (16#0FFCA#, 16#0FFCF#)  HALFWIDTH HANGUL LETTER YEO .. HALFWIDTH HANGUL LETTER OE
+      Lo,  -- (16#0FFD2#, 16#0FFD7#)  HALFWIDTH HANGUL LETTER YO .. HALFWIDTH HANGUL LETTER YU
+      Lo,  -- (16#0FFDA#, 16#0FFDC#)  HALFWIDTH HANGUL LETTER EU .. HALFWIDTH HANGUL LETTER I
+      Sc,  -- (16#0FFE0#, 16#0FFE1#)  FULLWIDTH CENT SIGN .. FULLWIDTH POUND SIGN
+      Sm,  -- (16#0FFE2#, 16#0FFE2#)  FULLWIDTH NOT SIGN .. FULLWIDTH NOT SIGN
+      Sk,  -- (16#0FFE3#, 16#0FFE3#)  FULLWIDTH MACRON .. FULLWIDTH MACRON
+      So,  -- (16#0FFE4#, 16#0FFE4#)  FULLWIDTH BROKEN BAR .. FULLWIDTH BROKEN BAR
+      Sc,  -- (16#0FFE5#, 16#0FFE6#)  FULLWIDTH YEN SIGN .. FULLWIDTH WON SIGN
+      So,  -- (16#0FFE8#, 16#0FFE8#)  HALFWIDTH FORMS LIGHT VERTICAL .. HALFWIDTH FORMS LIGHT VERTICAL
+      Sm,  -- (16#0FFE9#, 16#0FFEC#)  HALFWIDTH LEFTWARDS ARROW .. HALFWIDTH DOWNWARDS ARROW
+      So,  -- (16#0FFED#, 16#0FFEE#)  HALFWIDTH BLACK SQUARE .. HALFWIDTH WHITE CIRCLE
+      Cf,  -- (16#0FFF9#, 16#0FFFB#)  INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR
+      So,  -- (16#0FFFC#, 16#0FFFD#)  OBJECT REPLACEMENT CHARACTER .. REPLACEMENT CHARACTER
+      Lo,  -- (16#10000#, 16#1000B#)  LINEAR B SYLLABLE B008 A .. LINEAR B SYLLABLE B046 JE
+      Lo,  -- (16#1000D#, 16#10026#)  LINEAR B SYLLABLE B036 JO .. LINEAR B SYLLABLE B032 QO
+      Lo,  -- (16#10028#, 16#1003A#)  LINEAR B SYLLABLE B060 RA .. LINEAR B SYLLABLE B042 WO
+      Lo,  -- (16#1003C#, 16#1003D#)  LINEAR B SYLLABLE B017 ZA .. LINEAR B SYLLABLE B074 ZE
+      Lo,  -- (16#1003F#, 16#1004D#)  LINEAR B SYLLABLE B020 ZO .. LINEAR B SYLLABLE B091 TWO
+      Lo,  -- (16#10050#, 16#1005D#)  LINEAR B SYMBOL B018 .. LINEAR B SYMBOL B089
+      Lo,  -- (16#10080#, 16#100FA#)  LINEAR B IDEOGRAM B100 MAN .. LINEAR B IDEOGRAM VESSEL B305
+      Po,  -- (16#10100#, 16#10101#)  AEGEAN WORD SEPARATOR LINE .. AEGEAN WORD SEPARATOR DOT
+      So,  -- (16#10102#, 16#10102#)  AEGEAN CHECK MARK .. AEGEAN CHECK MARK
+      No,  -- (16#10107#, 16#10133#)  AEGEAN NUMBER ONE .. AEGEAN NUMBER NINETY THOUSAND
+      So,  -- (16#10137#, 16#1013F#)  AEGEAN WEIGHT BASE UNIT .. AEGEAN MEASURE THIRD SUBUNIT
+      Lo,  -- (16#10300#, 16#1031E#)  OLD ITALIC LETTER A .. OLD ITALIC LETTER UU
+      No,  -- (16#10320#, 16#10323#)  OLD ITALIC NUMERAL ONE .. OLD ITALIC NUMERAL FIFTY
+      Lo,  -- (16#10330#, 16#10349#)  GOTHIC LETTER AHSA .. GOTHIC LETTER OTHAL
+      Nl,  -- (16#1034A#, 16#1034A#)  GOTHIC LETTER NINE HUNDRED .. GOTHIC LETTER NINE HUNDRED
+      Lo,  -- (16#10380#, 16#1039D#)  UGARITIC LETTER ALPA .. UGARITIC LETTER SSU
+      Po,  -- (16#1039F#, 16#1039F#)  UGARITIC WORD DIVIDER .. UGARITIC WORD DIVIDER
+      Lu,  -- (16#10400#, 16#10427#)  DESERET CAPITAL LETTER LONG I .. DESERET CAPITAL LETTER EW
+      Ll,  -- (16#10428#, 16#1044F#)  DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER EW
+      Lo,  -- (16#10450#, 16#1049D#)  SHAVIAN LETTER PEEP .. OSMANYA LETTER OO
+      Nd,  -- (16#104A0#, 16#104A9#)  OSMANYA DIGIT ZERO .. OSMANYA DIGIT NINE
+      Lo,  -- (16#10800#, 16#10805#)  CYPRIOT SYLLABLE A .. CYPRIOT SYLLABLE JA
+      Lo,  -- (16#10808#, 16#10808#)  CYPRIOT SYLLABLE JO .. CYPRIOT SYLLABLE JO
+      Lo,  -- (16#1080A#, 16#10835#)  CYPRIOT SYLLABLE KA .. CYPRIOT SYLLABLE WO
+      Lo,  -- (16#10837#, 16#10838#)  CYPRIOT SYLLABLE XA .. CYPRIOT SYLLABLE XE
+      Lo,  -- (16#1083C#, 16#1083C#)  CYPRIOT SYLLABLE ZA .. CYPRIOT SYLLABLE ZA
+      Lo,  -- (16#1083F#, 16#1083F#)  CYPRIOT SYLLABLE ZO .. CYPRIOT SYLLABLE ZO
+      So,  -- (16#1D000#, 16#1D0F5#)  BYZANTINE MUSICAL SYMBOL PSILI .. BYZANTINE MUSICAL SYMBOL GORGON NEO KATO
+      So,  -- (16#1D100#, 16#1D126#)  MUSICAL SYMBOL SINGLE BARLINE .. MUSICAL SYMBOL DRUM CLEF-2
+      So,  -- (16#1D12A#, 16#1D164#)  MUSICAL SYMBOL DOUBLE SHARP .. MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH NOTE
+      Mc,  -- (16#1D165#, 16#1D166#)  MUSICAL SYMBOL COMBINING STEM .. MUSICAL SYMBOL COMBINING SPRECHGESANG STEM
+      Mn,  -- (16#1D167#, 16#1D169#)  MUSICAL SYMBOL COMBINING TREMOLO-1 .. MUSICAL SYMBOL COMBINING TREMOLO-3
+      So,  -- (16#1D16A#, 16#1D16C#)  MUSICAL SYMBOL FINGERED TREMOLO-1 .. MUSICAL SYMBOL FINGERED TREMOLO-3
+      Mc,  -- (16#1D16D#, 16#1D172#)  MUSICAL SYMBOL COMBINING AUGMENTATION DOT .. MUSICAL SYMBOL COMBINING FLAG-5
+      Cf,  -- (16#1D173#, 16#1D17A#)  MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE
+      Mn,  -- (16#1D17B#, 16#1D182#)  MUSICAL SYMBOL COMBINING ACCENT .. MUSICAL SYMBOL COMBINING LOURE
+      So,  -- (16#1D183#, 16#1D184#)  MUSICAL SYMBOL ARPEGGIATO UP .. MUSICAL SYMBOL ARPEGGIATO DOWN
+      Mn,  -- (16#1D185#, 16#1D18B#)  MUSICAL SYMBOL COMBINING DOIT .. MUSICAL SYMBOL COMBINING TRIPLE TONGUE
+      So,  -- (16#1D18C#, 16#1D1A9#)  MUSICAL SYMBOL RINFORZANDO .. MUSICAL SYMBOL DEGREE SLASH
+      Mn,  -- (16#1D1AA#, 16#1D1AD#)  MUSICAL SYMBOL COMBINING DOWN BOW .. MUSICAL SYMBOL COMBINING SNAP PIZZICATO
+      So,  -- (16#1D1AE#, 16#1D1DD#)  MUSICAL SYMBOL PEDAL MARK .. MUSICAL SYMBOL PES SUBPUNCTIS
+      So,  -- (16#1D300#, 16#1D356#)  MONOGRAM FOR EARTH .. TETRAGRAM FOR FOSTERING
+      Lu,  -- (16#1D400#, 16#1D419#)  MATHEMATICAL BOLD CAPITAL A .. MATHEMATICAL BOLD CAPITAL Z
+      Ll,  -- (16#1D41A#, 16#1D433#)  MATHEMATICAL BOLD SMALL A .. MATHEMATICAL BOLD SMALL Z
+      Lu,  -- (16#1D434#, 16#1D44D#)  MATHEMATICAL ITALIC CAPITAL A .. MATHEMATICAL ITALIC CAPITAL Z
+      Ll,  -- (16#1D44E#, 16#1D454#)  MATHEMATICAL ITALIC SMALL A .. MATHEMATICAL ITALIC SMALL G
+      Ll,  -- (16#1D456#, 16#1D467#)  MATHEMATICAL ITALIC SMALL I .. MATHEMATICAL ITALIC SMALL Z
+      Lu,  -- (16#1D468#, 16#1D481#)  MATHEMATICAL BOLD ITALIC CAPITAL A .. MATHEMATICAL BOLD ITALIC CAPITAL Z
+      Ll,  -- (16#1D482#, 16#1D49B#)  MATHEMATICAL BOLD ITALIC SMALL A .. MATHEMATICAL BOLD ITALIC SMALL Z
+      Lu,  -- (16#1D49C#, 16#1D49C#)  MATHEMATICAL SCRIPT CAPITAL A .. MATHEMATICAL SCRIPT CAPITAL A
+      Lu,  -- (16#1D49E#, 16#1D49F#)  MATHEMATICAL SCRIPT CAPITAL C .. MATHEMATICAL SCRIPT CAPITAL D
+      Lu,  -- (16#1D4A2#, 16#1D4A2#)  MATHEMATICAL SCRIPT CAPITAL G .. MATHEMATICAL SCRIPT CAPITAL G
+      Lu,  -- (16#1D4A5#, 16#1D4A6#)  MATHEMATICAL SCRIPT CAPITAL J .. MATHEMATICAL SCRIPT CAPITAL K
+      Lu,  -- (16#1D4A9#, 16#1D4AC#)  MATHEMATICAL SCRIPT CAPITAL N .. MATHEMATICAL SCRIPT CAPITAL Q
+      Lu,  -- (16#1D4AE#, 16#1D4B5#)  MATHEMATICAL SCRIPT CAPITAL S .. MATHEMATICAL SCRIPT CAPITAL Z
+      Ll,  -- (16#1D4B6#, 16#1D4B9#)  MATHEMATICAL SCRIPT SMALL A .. MATHEMATICAL SCRIPT SMALL D
+      Ll,  -- (16#1D4BB#, 16#1D4BB#)  MATHEMATICAL SCRIPT SMALL F .. MATHEMATICAL SCRIPT SMALL F
+      Ll,  -- (16#1D4BD#, 16#1D4C3#)  MATHEMATICAL SCRIPT SMALL H .. MATHEMATICAL SCRIPT SMALL N
+      Ll,  -- (16#1D4C5#, 16#1D4CF#)  MATHEMATICAL SCRIPT SMALL P .. MATHEMATICAL SCRIPT SMALL Z
+      Lu,  -- (16#1D4D0#, 16#1D4E9#)  MATHEMATICAL BOLD SCRIPT CAPITAL A .. MATHEMATICAL BOLD SCRIPT CAPITAL Z
+      Ll,  -- (16#1D4EA#, 16#1D503#)  MATHEMATICAL BOLD SCRIPT SMALL A .. MATHEMATICAL BOLD SCRIPT SMALL Z
+      Lu,  -- (16#1D504#, 16#1D505#)  MATHEMATICAL FRAKTUR CAPITAL A .. MATHEMATICAL FRAKTUR CAPITAL B
+      Lu,  -- (16#1D507#, 16#1D50A#)  MATHEMATICAL FRAKTUR CAPITAL D .. MATHEMATICAL FRAKTUR CAPITAL G
+      Lu,  -- (16#1D50D#, 16#1D514#)  MATHEMATICAL FRAKTUR CAPITAL J .. MATHEMATICAL FRAKTUR CAPITAL Q
+      Lu,  -- (16#1D516#, 16#1D51C#)  MATHEMATICAL FRAKTUR CAPITAL S .. MATHEMATICAL FRAKTUR CAPITAL Y
+      Ll,  -- (16#1D51E#, 16#1D537#)  MATHEMATICAL FRAKTUR SMALL A .. MATHEMATICAL FRAKTUR SMALL Z
+      Lu,  -- (16#1D538#, 16#1D539#)  MATHEMATICAL DOUBLE-STRUCK CAPITAL A .. MATHEMATICAL DOUBLE-STRUCK CAPITAL B
+      Lu,  -- (16#1D53B#, 16#1D53E#)  MATHEMATICAL DOUBLE-STRUCK CAPITAL D .. MATHEMATICAL DOUBLE-STRUCK CAPITAL G
+      Lu,  -- (16#1D540#, 16#1D544#)  MATHEMATICAL DOUBLE-STRUCK CAPITAL I .. MATHEMATICAL DOUBLE-STRUCK CAPITAL M
+      Lu,  -- (16#1D546#, 16#1D546#)  MATHEMATICAL DOUBLE-STRUCK CAPITAL O .. MATHEMATICAL DOUBLE-STRUCK CAPITAL O
+      Lu,  -- (16#1D54A#, 16#1D550#)  MATHEMATICAL DOUBLE-STRUCK CAPITAL S .. MATHEMATICAL DOUBLE-STRUCK CAPITAL Y
+      Ll,  -- (16#1D552#, 16#1D56B#)  MATHEMATICAL DOUBLE-STRUCK SMALL A .. MATHEMATICAL DOUBLE-STRUCK SMALL Z
+      Lu,  -- (16#1D56C#, 16#1D585#)  MATHEMATICAL BOLD FRAKTUR CAPITAL A .. MATHEMATICAL BOLD FRAKTUR CAPITAL Z
+      Ll,  -- (16#1D586#, 16#1D59F#)  MATHEMATICAL BOLD FRAKTUR SMALL A .. MATHEMATICAL BOLD FRAKTUR SMALL Z
+      Lu,  -- (16#1D5A0#, 16#1D5B9#)  MATHEMATICAL SANS-SERIF CAPITAL A .. MATHEMATICAL SANS-SERIF CAPITAL Z
+      Ll,  -- (16#1D5BA#, 16#1D5D3#)  MATHEMATICAL SANS-SERIF SMALL A .. MATHEMATICAL SANS-SERIF SMALL Z
+      Lu,  -- (16#1D5D4#, 16#1D5ED#)  MATHEMATICAL SANS-SERIF BOLD CAPITAL A .. MATHEMATICAL SANS-SERIF BOLD CAPITAL Z
+      Ll,  -- (16#1D5EE#, 16#1D607#)  MATHEMATICAL SANS-SERIF BOLD SMALL A .. MATHEMATICAL SANS-SERIF BOLD SMALL Z
+      Lu,  -- (16#1D608#, 16#1D621#)  MATHEMATICAL SANS-SERIF ITALIC CAPITAL A .. MATHEMATICAL SANS-SERIF ITALIC CAPITAL Z
+      Ll,  -- (16#1D622#, 16#1D63B#)  MATHEMATICAL SANS-SERIF ITALIC SMALL A .. MATHEMATICAL SANS-SERIF ITALIC SMALL Z
+      Lu,  -- (16#1D63C#, 16#1D655#)  MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL A .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL Z
+      Ll,  -- (16#1D656#, 16#1D66F#)  MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL A .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL Z
+      Lu,  -- (16#1D670#, 16#1D689#)  MATHEMATICAL MONOSPACE CAPITAL A .. MATHEMATICAL MONOSPACE CAPITAL Z
+      Ll,  -- (16#1D68A#, 16#1D6A3#)  MATHEMATICAL MONOSPACE SMALL A .. MATHEMATICAL MONOSPACE SMALL Z
+      Lu,  -- (16#1D6A8#, 16#1D6C0#)  MATHEMATICAL BOLD CAPITAL ALPHA .. MATHEMATICAL BOLD CAPITAL OMEGA
+      Sm,  -- (16#1D6C1#, 16#1D6C1#)  MATHEMATICAL BOLD NABLA .. MATHEMATICAL BOLD NABLA
+      Ll,  -- (16#1D6C2#, 16#1D6DA#)  MATHEMATICAL BOLD SMALL ALPHA .. MATHEMATICAL BOLD SMALL OMEGA
+      Sm,  -- (16#1D6DB#, 16#1D6DB#)  MATHEMATICAL BOLD PARTIAL DIFFERENTIAL .. MATHEMATICAL BOLD PARTIAL DIFFERENTIAL
+      Ll,  -- (16#1D6DC#, 16#1D6E1#)  MATHEMATICAL BOLD EPSILON SYMBOL .. MATHEMATICAL BOLD PI SYMBOL
+      Lu,  -- (16#1D6E2#, 16#1D6FA#)  MATHEMATICAL ITALIC CAPITAL ALPHA .. MATHEMATICAL ITALIC CAPITAL OMEGA
+      Sm,  -- (16#1D6FB#, 16#1D6FB#)  MATHEMATICAL ITALIC NABLA .. MATHEMATICAL ITALIC NABLA
+      Ll,  -- (16#1D6FC#, 16#1D714#)  MATHEMATICAL ITALIC SMALL ALPHA .. MATHEMATICAL ITALIC SMALL OMEGA
+      Sm,  -- (16#1D715#, 16#1D715#)  MATHEMATICAL ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL ITALIC PARTIAL DIFFERENTIAL
+      Ll,  -- (16#1D716#, 16#1D71B#)  MATHEMATICAL ITALIC EPSILON SYMBOL .. MATHEMATICAL ITALIC PI SYMBOL
+      Lu,  -- (16#1D71C#, 16#1D734#)  MATHEMATICAL BOLD ITALIC CAPITAL ALPHA .. MATHEMATICAL BOLD ITALIC CAPITAL OMEGA
+      Sm,  -- (16#1D735#, 16#1D735#)  MATHEMATICAL BOLD ITALIC NABLA .. MATHEMATICAL BOLD ITALIC NABLA
+      Ll,  -- (16#1D736#, 16#1D74E#)  MATHEMATICAL BOLD ITALIC SMALL ALPHA .. MATHEMATICAL BOLD ITALIC SMALL OMEGA
+      Sm,  -- (16#1D74F#, 16#1D74F#)  MATHEMATICAL BOLD ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL BOLD ITALIC PARTIAL DIFFERENTIAL
+      Ll,  -- (16#1D750#, 16#1D755#)  MATHEMATICAL BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL BOLD ITALIC PI SYMBOL
+      Lu,  -- (16#1D756#, 16#1D76E#)  MATHEMATICAL SANS-SERIF BOLD CAPITAL ALPHA .. MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA
+      Sm,  -- (16#1D76F#, 16#1D76F#)  MATHEMATICAL SANS-SERIF BOLD NABLA .. MATHEMATICAL SANS-SERIF BOLD NABLA
+      Ll,  -- (16#1D770#, 16#1D788#)  MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA
+      Sm,  -- (16#1D789#, 16#1D789#)  MATHEMATICAL SANS-SERIF BOLD PARTIAL DIFFERENTIAL .. MATHEMATICAL SANS-SERIF BOLD PARTIAL DIFFERENTIAL
+      Ll,  -- (16#1D78A#, 16#1D78F#)  MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD PI SYMBOL
+      Lu,  -- (16#1D790#, 16#1D7A8#)  MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA
+      Sm,  -- (16#1D7A9#, 16#1D7A9#)  MATHEMATICAL SANS-SERIF BOLD ITALIC NABLA .. MATHEMATICAL SANS-SERIF BOLD ITALIC NABLA
+      Ll,  -- (16#1D7AA#, 16#1D7C2#)  MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA
+      Sm,  -- (16#1D7C3#, 16#1D7C3#)  MATHEMATICAL SANS-SERIF BOLD ITALIC PARTIAL DIFFERENTIAL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PARTIAL DIFFERENTIAL
+      Ll,  -- (16#1D7C4#, 16#1D7C9#)  MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL
+      Nd,  -- (16#1D7CE#, 16#1D7FF#)  MATHEMATICAL BOLD DIGIT ZERO .. MATHEMATICAL MONOSPACE DIGIT NINE
+      Lo,  -- (16#20000#, 16#2A6D6#)  <CJK Ideograph Extension B, First> .. <CJK Ideograph Extension B, Last>
+      Lo,  -- (16#2F800#, 16#2FA1D#)  CJK COMPATIBILITY IDEOGRAPH-2F800 .. CJK COMPATIBILITY IDEOGRAPH-2FA1D
+      Cf,  -- (16#E0001#, 16#E0001#)  LANGUAGE TAG .. LANGUAGE TAG
+      Cf,  -- (16#E0020#, 16#E007F#)  TAG SPACE .. CANCEL TAG
+      Mn,  -- (16#E0100#, 16#E01EF#)  VARIATION SELECTOR-17 .. VARIATION SELECTOR-256
+      Co,  -- (16#F0000#, 16#FFFFD#)  <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last>
+      Co); -- (16#100000#, 16#10FFFD#)  <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last>
+ 
     --  The following array includes all characters considered digits, i.e.
     --  all characters from the Unicode table with categories:
  
*************** package body GNAT.UTF_32 is
*** 605,637 ****
     --    Other, Control (Cc)
     --    Other, Private Use (Co)
     --    Other, Surrogate (Cs)
-    --    Other, Format (Cf)
     --    Separator, Line (Zl)
     --    Separator, Paragraph (Zp)
  
!    --  In addition, the characters FFFE and FFFF are excluded. Note that the
!    --  defined Ada category of format effector is subsumed by the above set
!    --  of Unicode categories.
  
     UTF_32_Non_Graphic : constant UTF_32_Ranges := (
       (16#00000#, 16#0001F#),  -- <control> .. <control>
       (16#0007F#, 16#0009F#),  -- <control> .. <control>
!      (16#000AD#, 16#000AD#),  -- SOFT HYPHEN .. SOFT HYPHEN
!      (16#00600#, 16#00603#),  -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA
!      (16#006DD#, 16#006DD#),  -- ARABIC END OF AYAH .. ARABIC END OF AYAH
!      (16#0070F#, 16#0070F#),  -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK
!      (16#017B4#, 16#017B5#),  -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA
!      (16#0200C#, 16#0200F#),  -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK
!      (16#02028#, 16#0202E#),  -- LINE SEPARATOR .. RIGHT-TO-LEFT OVERRIDE
!      (16#02060#, 16#02063#),  -- WORD JOINER .. INVISIBLE SEPARATOR
!      (16#0206A#, 16#0206F#),  -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES
!      (16#0D800#, 16#0F8FF#),  -- <Non Private Use High Surrogate, First> .. <Private Use, Last>
!      (16#0FEFF#, 16#0FEFF#),  -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE
!      (16#0FFF9#, 16#0FFFB#),  -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR
!      (16#0FFFE#, 16#0FFFF#),  -- excluded code positions
!      (16#1D173#, 16#1D17A#),  -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE
!      (16#E0001#, 16#E0001#),  -- LANGUAGE TAG .. LANGUAGE TAG
!      (16#E0020#, 16#E007F#),  -- TAG SPACE .. CANCEL TAG
       (16#F0000#, 16#FFFFD#),  -- <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last>
       (16#100000#, 16#10FFFD#)); -- <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last>
  
--- 4203,4232 ----
     --    Other, Control (Cc)
     --    Other, Private Use (Co)
     --    Other, Surrogate (Cs)
     --    Separator, Line (Zl)
     --    Separator, Paragraph (Zp)
  
!    --  Note that characters with relative positions FFFE and FFFF in their
!    --  planes are not included in this table (we really don't want to add
!    --  32K entries for this purpose). Instead we handle these positions in
!    --  a completely different manner.
! 
!    --  Note: unassigned characters (category Cn) are deliberately NOT included
!    --  in the set of non-graphics, since the idea is that if any of these are
!    --  defined in the future, we don't want to have to modify the standard.
! 
!    --  Note that Other, Format (Cf) is also quite deliberately not included
!    --  in the list of categories above. This means that these characters can
!    --  be included in character and string literals.
  
     UTF_32_Non_Graphic : constant UTF_32_Ranges := (
       (16#00000#, 16#0001F#),  -- <control> .. <control>
       (16#0007F#, 16#0009F#),  -- <control> .. <control>
!      (16#02028#, 16#02029#),  -- LINE SEPARATOR .. PARAGRAPH SEPARATOR
!      (16#0D800#, 16#0DB7F#),  -- <Non Private Use High Surrogate, First> .. <Non Private Use High Surrogate, Last>
!      (16#0DB80#, 16#0DBFF#),  -- <Private Use High Surrogate, First> .. <Private Use High Surrogate, Last>
!      (16#0DC00#, 16#0DFFF#),  -- <Low_Surrogate, First> .. <Low Surrogate, Last>
!      (16#0E000#, 16#0F8FF#),  -- <Private Use, First> .. <Private Use, Last>
       (16#F0000#, 16#FFFFD#),  -- <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last>
       (16#100000#, 16#10FFFD#)); -- <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last>
  
*************** package body GNAT.UTF_32 is
*** 1064,1070 ****
       (16#0FF41#, 16#0FF5A#),  -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
       (16#10428#, 16#1044D#)); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG
  
!    Upper_Case_Adjust : constant array (Lower_Case_Letters'Range) of UTF_32 := (
         -32,  -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
         743,  -- MICRO SIGN .. MICRO SIGN
         -32,  -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS
--- 4659,4666 ----
       (16#0FF41#, 16#0FF5A#),  -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
       (16#10428#, 16#1044D#)); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG
  
!    Upper_Case_Adjust : constant array (Lower_Case_Letters'Range)
!      of UTF_32'Base := (
         -32,  -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
         743,  -- MICRO SIGN .. MICRO SIGN
         -32,  -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS
*************** package body GNAT.UTF_32 is
*** 1495,1500 ****
--- 5091,5122 ----
     --  and returns the index of the matching range in R if U matches one of the
     --  ranges. If U matches none of the ranges, returns zero.
  
+    ------------------
+    -- Get_Category --
+    ------------------
+ 
+    function Get_Category (U : UTF_32) return Category is
+    begin
+       --  Deal with FFFE/FFFF cases
+ 
+       if U mod 2#1_0000# >= 16#FFFE# then
+          return Fe;
+ 
+       --  Otherwise search table
+ 
+       else
+          declare
+             Index : constant Integer := Range_Search (U, Unicode_Ranges);
+          begin
+             if Index = 0 then
+                return Cn;
+             else
+                return Unicode_Categories (Index);
+             end if;
+          end;
+       end if;
+    end Get_Category;
+ 
     ---------------------
     -- Is_UTF_32_Digit --
     ---------------------
*************** package body GNAT.UTF_32 is
*** 1504,1510 ****
        return Range_Search (U, UTF_32_Digits) /= 0;
     end Is_UTF_32_Digit;
  
!    ----------------------
     -- Is_UTF_32_Letter --
     ----------------------
  
--- 5126,5137 ----
        return Range_Search (U, UTF_32_Digits) /= 0;
     end Is_UTF_32_Digit;
  
!    function Is_UTF_32_Digit (C : Category) return Boolean is
!    begin
!       return C = Nd;
!    end Is_UTF_32_Digit;
! 
!     ----------------------
     -- Is_UTF_32_Letter --
     ----------------------
  
*************** package body GNAT.UTF_32 is
*** 1513,1518 ****
--- 5140,5159 ----
        return Range_Search (U, UTF_32_Letters) /= 0;
     end Is_UTF_32_Letter;
  
+    Letter : constant array (Category) of Boolean :=
+                    (Lu => True,
+                     Ll => True,
+                     Lt => True,
+                     Lm => True,
+                     Lo => True,
+                     Nl => True,
+                     others => False);
+ 
+    function Is_UTF_32_Letter (C : Category) return Boolean is
+    begin
+       return Letter (C);
+    end Is_UTF_32_Letter;
+ 
     -------------------------------
     -- Is_UTF_32_Line_Terminator --
     -------------------------------
*************** package body GNAT.UTF_32 is
*** 1533,1545 ****
        return Range_Search (U, UTF_32_Marks) /= 0;
     end Is_UTF_32_Mark;
  
     ---------------------------
     -- Is_UTF_32_Non_Graphic --
     ---------------------------
  
     function Is_UTF_32_Non_Graphic (U : UTF_32) return Boolean is
     begin
!       return Range_Search (U, UTF_32_Non_Graphic) /= 0;
     end Is_UTF_32_Non_Graphic;
  
     ---------------------
--- 5174,5214 ----
        return Range_Search (U, UTF_32_Marks) /= 0;
     end Is_UTF_32_Mark;
  
+    function Is_UTF_32_Mark (C : Category) return Boolean is
+    begin
+       return C = Mn or else C = Mc;
+    end Is_UTF_32_Mark;
+ 
     ---------------------------
     -- Is_UTF_32_Non_Graphic --
     ---------------------------
  
     function Is_UTF_32_Non_Graphic (U : UTF_32) return Boolean is
     begin
!       --  We have to deal with FFFE/FFFF specially
! 
!       if U mod 16#1_0000# >= 16#FFFE# then
!          return True;
! 
!       --  Otherwise we can use the table
! 
!       else
!          return Range_Search (U, UTF_32_Non_Graphic) /= 0;
!       end if;
!    end Is_UTF_32_Non_Graphic;
! 
!    Non_Graphic : constant array (Category) of Boolean :=
!                    (Cc => True,
!                     Co => True,
!                     Cs => True,
!                     Zl => True,
!                     Zp => True,
!                     Fe => True,
!                     others => False);
! 
!    function Is_UTF_32_Non_Graphic (C : Category) return Boolean is
!    begin
!       return Non_Graphic (C);
     end Is_UTF_32_Non_Graphic;
  
     ---------------------
*************** package body GNAT.UTF_32 is
*** 1551,1556 ****
--- 5220,5230 ----
        return Range_Search (U, UTF_32_Other_Format) /= 0;
     end Is_UTF_32_Other;
  
+    function Is_UTF_32_Other (C : Category) return Boolean is
+    begin
+       return C = Cf;
+    end Is_UTF_32_Other;
+ 
     ---------------------------
     -- Is_UTF_32_Punctuation --
     ---------------------------
*************** package body GNAT.UTF_32 is
*** 1560,1565 ****
--- 5234,5244 ----
        return Range_Search (U, UTF_32_Punctuation) /= 0;
     end Is_UTF_32_Punctuation;
  
+    function Is_UTF_32_Punctuation (C : Category) return Boolean is
+    begin
+       return C = Pc;
+    end Is_UTF_32_Punctuation;
+ 
     ---------------------
     -- Is_UTF_32_Space --
     ---------------------
*************** package body GNAT.UTF_32 is
*** 1569,1574 ****
--- 5248,5258 ----
        return Range_Search (U, UTF_32_Spaces) /= 0;
     end Is_UTF_32_Space;
  
+    function Is_UTF_32_Space (C : Category) return Boolean is
+    begin
+       return C = Zs;
+    end Is_UTF_32_Space;
+ 
     ------------------
     -- Range_Search --
     ------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/g-utf_32.ads gcc-4.1.0/gcc/ada/g-utf_32.ads
*** gcc-4.0.2/gcc/ada/g-utf_32.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/g-utf_32.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          G N A T . U T F _ 3 2                           --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          G N A T . U T F _ 3 2                           --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,56 ****
  --  itself, and we want to be able to compile the compiler with old versions
  --  of GNAT that did not implement Wide_Wide_Character.
  
! --  This package is not available directly for use in application programs,
! --  but it serves as the basis for GNAT.Wide_Case_Utilities and
! --  GNAT.Wide_Wide_Case_Utilities, which can be used directly.
  
  package GNAT.UTF_32 is
  
!    type UTF_32 is mod 2 ** 32;
!    --  The actual allowed range is 16#00_0000# .. 16#01_FFFF#
  
!    function Is_UTF_32_Letter (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Letter);
!    --  Returns true iff U is a letter that can be used to start an identifier.
!    --  This means that it is in one of the following categories:
     --    Letter, Uppercase (Lu)
     --    Letter, Lowercase (Ll)
     --    Letter, Titlecase (Lt)
--- 38,107 ----
  --  itself, and we want to be able to compile the compiler with old versions
  --  of GNAT that did not implement Wide_Wide_Character.
  
! --  This package is available directly for use in application programs,
! --  and also serves as the basis for Ada.Wide_Wide_Characters.Unicode and
! --  Ada.Wide_Characters.Unicode, which can also be used directly.
  
  package GNAT.UTF_32 is
  
!    type UTF_32 is range 0 .. 16#7FFF_FFFF#;
!    --  So far, the only defined character codes are in 0 .. 16#01_FFFF#
  
!    --  The following type defines the categories from the unicode definitions.
!    --  The one addition we make is Fe, which represents the characters FFFE
!    --  and FFFF in any of the planes.
! 
!    type Category is (
!      Cc,   --  Other, Control
!      Cf,   --  Other, Format
!      Cn,   --  Other, Not Assigned
!      Co,   --  Other, Private Use
!      Cs,   --  Other, Surrogate
!      Ll,   --  Letter, Lowercase
!      Lm,   --  Letter, Modifier
!      Lo,   --  Letter, Other
!      Lt,   --  Letter, Titlecase
!      Lu,   --  Letter, Uppercase
!      Mc,   --  Mark, Spacing Combining
!      Me,   --  Mark, Enclosing
!      Mn,   --  Mark, Nonspacing
!      Nd,   --  Number, Decimal Digit
!      Nl,   --  Number, Letter
!      No,   --  Number, Other
!      Pc,   --  Punctuation, Connector
!      Pd,   --  Punctuation, Dash
!      Pe,   --  Punctuation, Close
!      Pf,   --  Punctuation, Final quote
!      Pi,   --  Punctuation, Initial quote
!      Po,   --  Punctuation, Other
!      Ps,   --  Punctuation, Open
!      Sc,   --  Symbol, Currency
!      Sk,   --  Symbol, Modifier
!      Sm,   --  Symbol, Math
!      So,   --  Symbol, Other
!      Zl,   --  Separator, Line
!      Zp,   --  Separator, Paragraph
!      Zs,   --  Separator, Space
!      Fe);  --  relative position FFFE/FFFF in any plane
! 
!    function Get_Category (U : UTF_32) return Category;
!    --  Given a UTF32 code, returns corresponding Category, or Cn if
!    --  the code does not have an assigned unicode category.
! 
!    --  The following functions perform category tests corresponding to lexical
!    --  classes defined in the Ada standard. There are two interfaces for each
!    --  function. The second takes a Category (e.g. returned by Get_Category).
!    --  The first takes a UTF_32 code. The form taking the UTF_32 code is
!    --  typically more efficient than calling Get_Category, but if several
!    --  different tests are to be performed on the same code, it is more
!    --  efficient to use Get_Category to get the category, then test the
!    --  resulting category.
! 
!    function Is_UTF_32_Letter (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Letter (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Letter);
!    --  Returns true iff U is a letter that can be used to start an identifier,
!    --  or if C is one of the corresponding categories, which are the following:
     --    Letter, Uppercase (Lu)
     --    Letter, Lowercase (Ll)
     --    Letter, Titlecase (Lt)
*************** package GNAT.UTF_32 is
*** 58,118 ****
     --    Letter, Other     (Lo)
     --    Number, Letter    (Nl)
  
!    function Is_UTF_32_Digit (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Digit);
     --  Returns true iff U is a digit that can be used to extend an identifer,
!    --  which means it is in one of the following categories:
     --    Number, Decimal_Digit (Nd)
  
!    function Is_UTF_32_Line_Terminator (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Line_Terminator);
     --  Returns true iff U is an allowed line terminator for source programs,
!    --  which means it is in one of the following categories:
!    --    Separator, Line (Zl)
!    --    Separator, Paragraph (Zp)
!    --  or that it is a conventional line terminator (CR, LF, VT, FF)
  
!    function Is_UTF_32_Mark (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Mark);
!    --  Returns true iff U is a mark character which can be used to extend
!    --  an identifier. This means it is in one of the following categories:
     --    Mark, Non-Spacing (Mn)
     --    Mark, Spacing Combining (Mc)
  
!    function Is_UTF_32_Other (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Other);
     --  Returns true iff U is an other format character, which means that it
     --  can be used to extend an identifier, but is ignored for the purposes of
!    --  matching of identiers. This means that it is in one of the following
!    --  categories:
     --    Other, Format (Cf)
  
!    function Is_UTF_32_Punctuation (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Punctuation);
     --  Returns true iff U is a punctuation character that can be used to
!    --  separate pices of an identifier. This means that it is in one of the
!    --  following categories:
     --    Punctuation, Connector (Pc)
  
!    function Is_UTF_32_Space (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Space);
!    --  Returns true iff U is considered a space to be ignored, which means
!    --  that it is in one of the following categories:
     --    Separator, Space (Zs)
  
!    function Is_UTF_32_Non_Graphic (U : UTF_32) return Boolean;
     pragma Inline (Is_UTF_32_Non_Graphic);
!    --  Returns true iff U is considered to be a non-graphic character,
!    --  which means that it is in one of the following categories:
     --    Other, Control (Cc)
     --    Other, Private Use (Co)
     --    Other, Surrogate (Cs)
-    --    Other, Format (Cf)
     --    Separator, Line (Zl)
     --    Separator, Paragraph (Zp)
     --
     --  Note that the Ada category format effector is subsumed by the above
     --  list of Unicode categories.
  
     function UTF_32_To_Upper_Case (U : UTF_32) return UTF_32;
     pragma Inline (UTF_32_To_Upper_Case);
--- 109,190 ----
     --    Letter, Other     (Lo)
     --    Number, Letter    (Nl)
  
!    function Is_UTF_32_Digit (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Digit (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Digit);
     --  Returns true iff U is a digit that can be used to extend an identifer,
!    --  or if C is one of the corresponding categories, which are the following:
     --    Number, Decimal_Digit (Nd)
  
!    function Is_UTF_32_Line_Terminator (U : UTF_32)   return Boolean;
     pragma Inline (Is_UTF_32_Line_Terminator);
     --  Returns true iff U is an allowed line terminator for source programs,
!    --  if U is in the category Zp (Separator, Paragaph), or Zs (Separator,
!    --  Line), or if U is a conventional line terminator (CR, LF, VT, FF).
!    --  There is no category version for this function, since the set of
!    --  characters does not correspond to a set of Unicode categories.
  
!    function Is_UTF_32_Mark (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Mark (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Mark);
!    --  Returns true iff U is a mark character which can be used to extend an
!    --  identifier, or if C is one of the corresponding categories, which are
!    --  the following:
     --    Mark, Non-Spacing (Mn)
     --    Mark, Spacing Combining (Mc)
  
!    function Is_UTF_32_Other (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Other (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Other);
     --  Returns true iff U is an other format character, which means that it
     --  can be used to extend an identifier, but is ignored for the purposes of
!    --  matching of identiers, or if C is one of the corresponding categories,
!    --  which are the following:
     --    Other, Format (Cf)
  
!    function Is_UTF_32_Punctuation (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Punctuation (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Punctuation);
     --  Returns true iff U is a punctuation character that can be used to
!    --  separate pices of an identifier, or if C is one of the corresponding
!    --  categories, which are the following:
     --    Punctuation, Connector (Pc)
  
!    function Is_UTF_32_Space (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Space (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Space);
!    --  Returns true iff U is considered a space to be ignored, or if C is one
!    --  of the corresponding categories, which are the following:
     --    Separator, Space (Zs)
  
!    function Is_UTF_32_Non_Graphic (U : UTF_32)   return Boolean;
!    function Is_UTF_32_Non_Graphic (C : Category) return Boolean;
     pragma Inline (Is_UTF_32_Non_Graphic);
!    --  Returns true iff U is considered to be a non-graphic character, or if C
!    --  is one of the corresponding categories, which are the following:
     --    Other, Control (Cc)
     --    Other, Private Use (Co)
     --    Other, Surrogate (Cs)
     --    Separator, Line (Zl)
     --    Separator, Paragraph (Zp)
+    --    FFFE or FFFF positions in any plane (Fe)
     --
     --  Note that the Ada category format effector is subsumed by the above
     --  list of Unicode categories.
+    --
+    --  Note that Other, Unassiged (Cn) is quite deliberately not included
+    --  in the list of categories above. This means that should any of these
+    --  code positions be defined in future with graphic characters they will
+    --  be allowed without a need to change implementations or the standard.
+    --
+    --  Note that Other, Format (Cf) is also quite deliberately not included
+    --  in the list of categories above. This means that these characters can
+    --  be included in character and string literals.
+ 
+    --  The following function is used to fold to upper case, as required by
+    --  the Ada 2005 standard rules for identifier case folding. Two
+    --  identifiers are equivalent if they are identical after folding all
+    --  letters to upper case using this routine.
  
     function UTF_32_To_Upper_Case (U : UTF_32) return UTF_32;
     pragma Inline (UTF_32_To_Upper_Case);
diff -Nrcpad gcc-4.0.2/gcc/ada/g-wistsp.ads gcc-4.1.0/gcc/ada/g-wistsp.ads
*** gcc-4.0.2/gcc/ada/g-wistsp.ads	Tue Oct 21 13:42:05 2003
--- gcc-4.1.0/gcc/ada/g-wistsp.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/g-zstspl.ads gcc-4.1.0/gcc/ada/g-zstspl.ads
*** gcc-4.0.2/gcc/ada/g-zstspl.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/g-zstspl.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/gen-soccon.c gcc-4.1.0/gcc/ada/gen-soccon.c
*** gcc-4.0.2/gcc/ada/gen-soccon.c	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/gen-soccon.c	Tue Nov 15 13:50:37 2005
***************
*** 1,37 ****
! /*****************************************************************************
! **                                                                          **
! **                          GNAT SYSTEM UTILITIES                           **
! **                                                                          **
! **                           G E N - S O C C O N                            **
! **                                                                          **
! **              Copyright (C) 2004 Free Software Foundation, Inc.           **
! **                                                                          **
! ** GNAT is free software;  you can  redistribute it  and/or modify it under **
! ** terms of the  GNU General Public License as published  by the Free Soft- **
! ** ware  Foundation;  either version 2,  or (at your option) any later ver- **
! ** sion.  GNAT is distributed in the hope that it will be useful, but WITH- **
! ** OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY **
! ** or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License **
! ** for  more details.  You should have  received  a copy of the GNU General **
! ** Public License  distributed with GNAT;  see file COPYING.  If not, write **
! ** to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, **
! ** MA 02111-1307, USA.                                                      **
! **                                                                          **
! ** GNAT was originally developed  by the GNAT team at  New York University. **
! ** Extensive contributions were provided by Ada Core Technologies Inc.      **
! **                                                                          **
! ******************************************************************************/
  
  /* This program generates g-soccon.ads */
  
  #include <stdio.h>
  #include <string.h>
  
! #include "socket.h"
! #include <netinet/in.h>
! #include <netinet/tcp.h>
! #include <sys/filio.h>
! #include <netdb.h>
  
  struct line {
    char *text;
--- 1,49 ----
! /****************************************************************************
!  *                                                                          *
!  *                          GNAT SYSTEM UTILITIES                           *
!  *                                                                          *
!  *                           G E N - S O C C O N                            *
!  *                                                                          *
!  *          Copyright (C) 2004-2005, Free Software Foundation, Inc.         *
!  *                                                                          *
!  * GNAT is free software;  you can  redistribute it  and/or modify it under *
!  * terms of the  GNU General Public License as published  by the Free Soft- *
!  * ware  Foundation;  either version 2,  or (at your option) any later ver- *
!  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
!  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
!  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
!  * for  more details.  You should have  received  a copy of the GNU General *
!  * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
!  *                                                                          *
!  * GNAT was originally developed  by the GNAT team at  New York University. *
!  * Extensive contributions were provided by Ada Core Technologies Inc.      *
!  *                                                                          *
!  ****************************************************************************/
  
  /* This program generates g-soccon.ads */
  
+ /* To build using DEC C:
+   CC/DEFINE="TARGET=""OpenVMS""" gen-soccon
+   LINK gen-soccon
+   RUN gen-soccon
+ */
+ 
+ #ifndef TARGET
+ # error Please define TARGET
+ #endif
+ 
+ #include <stdlib.h>
  #include <stdio.h>
  #include <string.h>
+ #include <limits.h>
  
! #ifdef __MINGW32__
! #include <fcntl.h>
! #endif
! 
! #include "gsocket.h"
  
  struct line {
    char *text;
*************** struct line *first = NULL, *last = NULL;
*** 48,55 ****
  #define _NL TXT("")
  /* Empty line */
  
! #define itoad(n) itoa ("%d", n)
! #define itoax(n) itoa ("16#%08x#", n)
  
  #define CND(name,comment) add_line(#name, itoad (name), comment);
  /* Constant (decimal) */
--- 60,67 ----
  #define _NL TXT("")
  /* Empty line */
  
! #define itoad(n) f_itoa ("%d", (n))
! #define itoax(n) f_itoa ("16#%08x#", (n))
  
  #define CND(name,comment) add_line(#name, itoad (name), comment);
  /* Constant (decimal) */
*************** struct line *first = NULL, *last = NULL;
*** 60,74 ****
  #define CN_(name,comment) add_line(#name, name, comment);
  /* Constant (generic) */
  
  void output (void);
  /* Generate output spec */
  
! char *itoa (char *, int);
  /* int to string */
  
  void add_line (char *, char*, char*);
  
! void main (void) {
  
  TXT("------------------------------------------------------------------------------")
  TXT("--                                                                          --")
--- 72,94 ----
  #define CN_(name,comment) add_line(#name, name, comment);
  /* Constant (generic) */
  
+ #define STR(p) STR1(p)
+ #define STR1(p) #p
+ 
  void output (void);
  /* Generate output spec */
  
! char *f_itoa (char *, int);
  /* int to string */
  
  void add_line (char *, char*, char*);
  
! #ifdef __MINGW32__
! unsigned int _CRT_fmode = _O_BINARY;
! #endif
! 
! int
! main (void) {
  
  TXT("------------------------------------------------------------------------------")
  TXT("--                                                                          --")
*************** TXT("--               G N A T . S O C K 
*** 78,84 ****
  TXT("--                                                                          --")
  TXT("--                                 S p e c                                  --")
  TXT("--                                                                          --")
! TXT("--          Copyright (C) 2000-2004 Free Software Foundation, Inc.          --")
  TXT("--                                                                          --")
  TXT("-- GNAT is free software;  you can  redistribute it  and/or modify it under --")
  TXT("-- terms of the  GNU General Public License as published  by the Free Soft- --")
--- 98,104 ----
  TXT("--                                                                          --")
  TXT("--                                 S p e c                                  --")
  TXT("--                                                                          --")
! TXT("--          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --")
  TXT("--                                                                          --")
  TXT("-- GNAT is free software;  you can  redistribute it  and/or modify it under --")
  TXT("-- terms of the  GNU General Public License as published  by the Free Soft- --")
*************** TXT("-- OUT ANY WARRANTY;  without even 
*** 88,95 ****
  TXT("-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --")
  TXT("-- for  more details.  You should have  received  a copy of the GNU General --")
  TXT("-- Public License  distributed with GNAT;  see file COPYING.  If not, write --")
! TXT("-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --")
! TXT("-- MA 02111-1307, USA.                                                      --")
  TXT("--                                                                          --")
  TXT("-- As a special exception,  if other files  instantiate  generics from this --")
  TXT("-- unit, or you link  this unit with other files  to produce an executable, --")
--- 108,115 ----
  TXT("-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --")
  TXT("-- for  more details.  You should have  received  a copy of the GNU General --")
  TXT("-- Public License  distributed with GNAT;  see file COPYING.  If not, write --")
! TXT("-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --")
! TXT("-- Boston, MA 02110-1301, USA.                                              --")
  TXT("--                                                                          --")
  TXT("-- As a special exception,  if other files  instantiate  generics from this --")
  TXT("-- unit, or you link  this unit with other files  to produce an executable, --")
*************** _NL
*** 371,382 ****
  #ifndef FIONBIO
  #define FIONBIO -1
  #endif
! CNX(FIONBIO, "Set/clear non-blocking io")
  
  #ifndef FIONREAD
  #define FIONREAD -1
  #endif
! CNX(FIONREAD, "How many bytes to read")
  _NL
  TXT("   --------------------")
  TXT("   -- Shutdown modes --")
--- 391,402 ----
  #ifndef FIONBIO
  #define FIONBIO -1
  #endif
! CND(FIONBIO, "Set/clear non-blocking io")
  
  #ifndef FIONREAD
  #define FIONREAD -1
  #endif
! CND(FIONREAD, "How many bytes to read")
  _NL
  TXT("   --------------------")
  TXT("   -- Shutdown modes --")
*************** _NL
*** 472,487 ****
  #endif
  CND(TCP_NODELAY, "Do not coalesce packets")
  
- #ifndef SO_SNDBUF
- #define SO_SNDBUF -1
- #endif
- CND(SO_SNDBUF, "Set/get send buffer size")
- 
- #ifndef SO_RCVBUF
- #define SO_RCVBUF -1
- #endif
- CND(SO_RCVBUF, "Set/get recv buffer size")
- 
  #ifndef SO_REUSEADDR
  #define SO_REUSEADDR -1
  #endif
--- 492,497 ----
*************** CND(SO_KEEPALIVE, "Enable keep-alive msg
*** 497,511 ****
  #endif
  CND(SO_LINGER, "Defer close to flush data")
  
  #ifndef SO_ERROR
  #define SO_ERROR -1
  #endif
  CND(SO_ERROR, "Get/clear error status")
  
! #ifndef SO_BROADCAST
! #define SO_BROADCAST -1
  #endif
! CND(SO_BROADCAST, "Can send broadcast msgs")
  
  #ifndef IP_ADD_MEMBERSHIP
  #define IP_ADD_MEMBERSHIP -1
--- 507,556 ----
  #endif
  CND(SO_LINGER, "Defer close to flush data")
  
+ #ifndef SO_BROADCAST
+ #define SO_BROADCAST -1
+ #endif
+ CND(SO_BROADCAST, "Can send broadcast msgs")
+ 
+ #ifndef SO_SNDBUF
+ #define SO_SNDBUF -1
+ #endif
+ CND(SO_SNDBUF, "Set/get send buffer size")
+ 
+ #ifndef SO_RCVBUF
+ #define SO_RCVBUF -1
+ #endif
+ CND(SO_RCVBUF, "Set/get recv buffer size")
+ 
+ #ifndef SO_SNDTIMEO
+ #define SO_SNDTIMEO -1
+ #endif
+ CND(SO_SNDTIMEO, "Emission timeout")
+ 
+ #ifndef SO_RCVTIMEO
+ #define SO_RCVTIMEO -1
+ #endif
+ CND(SO_RCVTIMEO, "Reception timeout")
+ 
  #ifndef SO_ERROR
  #define SO_ERROR -1
  #endif
  CND(SO_ERROR, "Get/clear error status")
  
! #ifndef IP_MULTICAST_IF
! #define IP_MULTICAST_IF -1
  #endif
! CND(IP_MULTICAST_IF, "Set/get mcast interface")
! 
! #ifndef IP_MULTICAST_TTL
! #define IP_MULTICAST_TTL -1
! #endif
! CND(IP_MULTICAST_TTL, "Set/get multicast TTL")
! 
! #ifndef IP_MULTICAST_LOOP
! #define IP_MULTICAST_LOOP -1
! #endif
! CND(IP_MULTICAST_LOOP, "Set/get mcast loopback")
  
  #ifndef IP_ADD_MEMBERSHIP
  #define IP_ADD_MEMBERSHIP -1
*************** CND(IP_ADD_MEMBERSHIP, "Join a multicast
*** 517,535 ****
  #endif
  CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
  
! #ifndef IP_MULTICAST_TTL
! #define IP_MULTICAST_TTL -1
  #endif
! CND(IP_MULTICAST_TTL, "Set/get multicast TTL")
  
! #ifndef IP_MULTICAST_LOOP
! #define IP_MULTICAST_LOOP -1
  #endif
! CND(IP_MULTICAST_LOOP, "Set/get mcast loopback")
  _NL
  TXT("end GNAT.Sockets.Constants;")
  
! output ();
  }
  
  void
--- 562,613 ----
  #endif
  CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
  
! _NL
! TXT("   -------------------")
! TXT("   -- System limits --")
! TXT("   -------------------")
! _NL
! 
! #ifndef IOV_MAX
! #define IOV_MAX INT_MAX
  #endif
! CND(IOV_MAX, "Maximum writev iovcnt")
  
! _NL
! TXT("   ----------------------")
! TXT("   -- Type definitions --")
! TXT("   ----------------------")
! _NL
! 
! {
!   struct timeval tv;
! TXT("   --  Sizes (in bytes) of the components of struct timeval")
! _NL
! #define SIZEOF_tv_sec (sizeof tv.tv_sec)
! CND(SIZEOF_tv_sec, "tv_sec")
! #define SIZEOF_tv_usec (sizeof tv.tv_usec)
! CND(SIZEOF_tv_usec, "tv_usec")
! }
! 
! #ifdef __vxworks
! _NL
! TXT("   --------------------------------")
! TXT("   -- VxWorks-specific constants --")
! TXT("   --------------------------------")
! _NL
! TXT("   --  These constants may be used only within the VxWorks version of")
! TXT("   --  GNAT.Sockets.Thin.")
! _NL
! 
! CND(OK,    "VxWorks generic success")
! CND(ERROR, "VxWorks generic error")
  #endif
! 
  _NL
  TXT("end GNAT.Sockets.Constants;")
  
!   output ();
!   return 0;
  }
  
  void
*************** output (void) {
*** 563,576 ****
  }
  
  char *
! itoa (char *fmt, int n) {
!   char buf[32];
    sprintf (buf, fmt, n);
!   return strdup (buf);
  }
  
! void add_line (char *_text, char *_value, char *_comment) {
    struct line *l = (struct line *) malloc (sizeof (struct line));
    l->text = _text;
    l->value = _value;
    l->comment = _comment;
--- 641,659 ----
  }
  
  char *
! f_itoa (char *fmt, int n) {
!   char buf[32], *ret;
    sprintf (buf, fmt, n);
!   ret = malloc (strlen (buf) + 1);
!   if (ret != NULL)
!     strcpy (ret, buf);
!   return ret;
  }
  
! void
! add_line (char *_text, char *_value, char *_comment) {
    struct line *l = (struct line *) malloc (sizeof (struct line));
+ 
    l->text = _text;
    l->value = _value;
    l->comment = _comment;
diff -Nrcpad gcc-4.0.2/gcc/ada/get_targ.adb gcc-4.1.0/gcc/ada/get_targ.adb
*** gcc-4.0.2/gcc/ada/get_targ.adb	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/get_targ.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/get_targ.ads gcc-4.1.0/gcc/ada/get_targ.ads
*** gcc-4.0.2/gcc/ada/get_targ.ads	Mon Apr 19 15:19:58 2004
--- gcc-4.1.0/gcc/ada/get_targ.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 40,46 ****
  with Types; use Types;
  
  package Get_Targ is
! pragma Preelaborate (Get_Targ);
  
     function Get_Bits_Per_Unit return Pos;
     pragma Import (C, Get_Bits_Per_Unit, "get_target_bits_per_unit");
--- 40,46 ----
  with Types; use Types;
  
  package Get_Targ is
!    pragma Preelaborate;
  
     function Get_Bits_Per_Unit return Pos;
     pragma Import (C, Get_Bits_Per_Unit, "get_target_bits_per_unit");
diff -Nrcpad gcc-4.0.2/gcc/ada/gigi.h gcc-4.1.0/gcc/ada/gigi.h
*** gcc-4.0.2/gcc/ada/gigi.h	Thu Mar 17 19:53:06 2005
--- gcc-4.1.0/gcc/ada/gigi.h	Tue Nov 15 13:53:22 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 30,59 ****
   *                                                                          *
   ****************************************************************************/
  
  /* The largest alignment, in bits, that is needed for using the widest
     move instruction.  */
  extern unsigned int largest_move_alignment;
  
- /* Declare all functions and types used by gigi.  */
- 
  /* Compute the alignment of the largest mode that can be used for copying
     objects.  */
  extern void gnat_compute_largest_alignment (void);
  
- /* Routine called by gcc for emitting a stack check. GNU_EXPR is the
-    expression that contains the last address on the stack to check. */
- extern tree emit_stack_check (tree);
- 
  /* GNU_TYPE is a type. Determine if it should be passed by reference by
     default.  */
! extern bool default_pass_by_ref (tree);
  
  /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type
     if it should be passed by reference.  */
! extern bool must_pass_by_ref (tree);
! 
! /* Elaboration routines for the front end.  */
! extern void elab_all_gnat (void);
  
  /* Initialize DUMMY_NODE_TABLE.  */
  extern void init_dummy_type (void);
--- 30,52 ----
   *                                                                          *
   ****************************************************************************/
  
+ /* Declare all functions and types used by gigi.  */
+ 
  /* The largest alignment, in bits, that is needed for using the widest
     move instruction.  */
  extern unsigned int largest_move_alignment;
  
  /* Compute the alignment of the largest mode that can be used for copying
     objects.  */
  extern void gnat_compute_largest_alignment (void);
  
  /* GNU_TYPE is a type. Determine if it should be passed by reference by
     default.  */
! extern bool default_pass_by_ref (tree gnu_type);
  
  /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type
     if it should be passed by reference.  */
! extern bool must_pass_by_ref (tree gnu_type);
  
  /* Initialize DUMMY_NODE_TABLE.  */
  extern void init_dummy_type (void);
*************** extern void init_dummy_type (void);
*** 73,122 ****
     was not created previously.  The value of 1 is normally used for a non-zero
     DEFINITION, but a value of 2 is used in special circumstances, defined in
     the code.  */
! extern tree gnat_to_gnu_entity (Entity_Id, tree, int);
  
  /* Similar, but if the returned value is a COMPONENT_REF, return the
     FIELD_DECL.  */
! extern tree gnat_to_gnu_field_decl (Entity_Id);
  
  /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
     GCC type corresponding to that entity.  GNAT_ENTITY is assumed to
     refer to an Ada type.  */
! extern tree gnat_to_gnu_type (Entity_Id);
  
  /* Add GNU_STMT to the current BLOCK_STMT node.  */
! extern void add_stmt (tree);
  
  /* Similar, but set the location of GNU_STMT to that of GNAT_NODE.  */
! extern void add_stmt_with_node (tree, Node_Id);
  
  /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK.  */
  extern void set_block_for_group (tree);
  
  /* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
!    Get SLOC from Entity_Id.  */
! extern void add_decl_expr (tree, Entity_Id);
  
  /* Given GNAT_ENTITY, elaborate all expressions that are required to
     be elaborated at the point of its definition, but do nothing else.  */
! extern void elaborate_entity (Entity_Id);
  
  /* Mark GNAT_ENTITY as going out of scope at this point.  Recursively mark
     any entities on its entity chain similarly.  */
! extern void mark_out_of_scope (Entity_Id);
  
  /* Make a dummy type corresponding to GNAT_TYPE.  */
! extern tree make_dummy_type (Entity_Id);
  
  /* Get the unpadded version of a GNAT type.  */
! extern tree get_unpadded_type (Entity_Id);
  
  /* Called when we need to protect a variable object using a save_expr.  */
! extern tree maybe_variable (tree);
  
  /* Create a record type that contains a field of TYPE with a starting bit
     position so that it is aligned to ALIGN bits and is SIZE bytes long.  */
! extern tree make_aligning_type (tree, int, tree);
  
  /* Ensure that TYPE has SIZE and ALIGN.  Make and return a new padded type
     if needed.  We have already verified that SIZE and TYPE are large enough.
--- 66,116 ----
     was not created previously.  The value of 1 is normally used for a non-zero
     DEFINITION, but a value of 2 is used in special circumstances, defined in
     the code.  */
! extern tree gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
!                                 int definition);
  
  /* Similar, but if the returned value is a COMPONENT_REF, return the
     FIELD_DECL.  */
! extern tree gnat_to_gnu_field_decl (Entity_Id gnat_entity);
  
  /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
     GCC type corresponding to that entity.  GNAT_ENTITY is assumed to
     refer to an Ada type.  */
! extern tree gnat_to_gnu_type (Entity_Id gnat_entity);
  
  /* Add GNU_STMT to the current BLOCK_STMT node.  */
! extern void add_stmt (tree gnu_stmt);
  
  /* Similar, but set the location of GNU_STMT to that of GNAT_NODE.  */
! extern void add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node);
  
  /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK.  */
  extern void set_block_for_group (tree);
  
  /* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
!    Get SLOC from GNAT_ENTITY.  */
! extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity);
  
  /* Given GNAT_ENTITY, elaborate all expressions that are required to
     be elaborated at the point of its definition, but do nothing else.  */
! extern void elaborate_entity (Entity_Id gnat_entity);
  
  /* Mark GNAT_ENTITY as going out of scope at this point.  Recursively mark
     any entities on its entity chain similarly.  */
! extern void mark_out_of_scope (Entity_Id gnat_entity);
  
  /* Make a dummy type corresponding to GNAT_TYPE.  */
! extern tree make_dummy_type (Entity_Id gnat_type);
  
  /* Get the unpadded version of a GNAT type.  */
! extern tree get_unpadded_type (Entity_Id gnat_entity);
  
  /* Called when we need to protect a variable object using a save_expr.  */
! extern tree maybe_variable (tree gnu_operand);
  
  /* Create a record type that contains a field of TYPE with a starting bit
     position so that it is aligned to ALIGN bits and is SIZE bytes long.  */
! extern tree make_aligning_type (tree type, int align, tree size);
  
  /* Ensure that TYPE has SIZE and ALIGN.  Make and return a new padded type
     if needed.  We have already verified that SIZE and TYPE are large enough.
*************** extern tree make_aligning_type (tree, in
*** 131,166 ****
     SAME_RM_SIZE is true if the RM_Size of the resulting type is to be
     set to its TYPE_SIZE; otherwise, it's set to the RM_Size of the original
     type.  */
! extern tree maybe_pad_type (tree, tree, unsigned int, Entity_Id,
! 			    const char *, bool, bool, bool);
  
  /* Given a GNU tree and a GNAT list of choices, generate an expression to test
     the value passed against the list of choices.  */
! extern tree choices_to_gnu (tree, Node_Id);
  
  /* Given a type T, a FIELD_DECL F, and a replacement value R,
     return a new type with all size expressions that contain F
     updated by replacing F with R.  This is identical to GCC's
     substitute_in_type except that it knows about TYPE_INDEX_TYPE.  */
! extern tree gnat_substitute_in_type (tree, tree, tree);
  
  /* Return the "RM size" of GNU_TYPE.  This is the actual number of bits
     needed to represent the object.  */
! extern tree rm_size (tree);
  
! /* Given GNU_ID, an IDENTIFIER_NODE containing a name and SUFFIX, a
     string, return a new IDENTIFIER_NODE that is the concatenation of
     the name in GNU_ID and SUFFIX.  */
! extern tree concat_id_with_name (tree, const char *);
  
  /* Return the name to be used for GNAT_ENTITY.  If a type, create a
     fully-qualified name, possibly with type information encoding.
     Otherwise, return the name.  */
! extern tree get_entity_name (Entity_Id);
  
  /* Return a name for GNAT_ENTITY concatenated with two underscores and
     SUFFIX.  */
! extern tree create_concat_name (Entity_Id, const char *);
  
  /* If true, then gigi is being called on an analyzed but unexpanded tree, and
     the only purpose of the call is to properly annotate types with
--- 125,162 ----
     SAME_RM_SIZE is true if the RM_Size of the resulting type is to be
     set to its TYPE_SIZE; otherwise, it's set to the RM_Size of the original
     type.  */
! extern tree maybe_pad_type (tree type, tree size, unsigned int align,
!                             Entity_Id gnat_entity, const char *name_trailer,
! 			    bool is_user_type, bool definition,
!                             bool same_rm_size);
  
  /* Given a GNU tree and a GNAT list of choices, generate an expression to test
     the value passed against the list of choices.  */
! extern tree choices_to_gnu (tree operand, Node_Id choices);
  
  /* Given a type T, a FIELD_DECL F, and a replacement value R,
     return a new type with all size expressions that contain F
     updated by replacing F with R.  This is identical to GCC's
     substitute_in_type except that it knows about TYPE_INDEX_TYPE.  */
! extern tree gnat_substitute_in_type (tree t, tree f, tree r);
  
  /* Return the "RM size" of GNU_TYPE.  This is the actual number of bits
     needed to represent the object.  */
! extern tree rm_size (tree gnu_type);
  
! /* Given GNU_ID, an IDENTIFIER_NODE containing a name, and SUFFIX, a
     string, return a new IDENTIFIER_NODE that is the concatenation of
     the name in GNU_ID and SUFFIX.  */
! extern tree concat_id_with_name (tree gnu_id, const char *suffix);
  
  /* Return the name to be used for GNAT_ENTITY.  If a type, create a
     fully-qualified name, possibly with type information encoding.
     Otherwise, return the name.  */
! extern tree get_entity_name (Entity_Id gnat_entity);
  
  /* Return a name for GNAT_ENTITY concatenated with two underscores and
     SUFFIX.  */
! extern tree create_concat_name (Entity_Id gnat_entity, const char *suffix);
  
  /* If true, then gigi is being called on an analyzed but unexpanded tree, and
     the only purpose of the call is to properly annotate types with
*************** extern bool type_annotate_only;
*** 171,206 ****
  extern const char *ref_filename;
  
  /* This is the main program of the back-end.  It sets up all the table
!    structures and then generates code.  */
  
! extern void gigi (Node_Id, int, int, struct Node *, Node_Id *, Node_Id *,
! 		  struct Elist_Header *, struct Elmt_Item *,
! 		  struct String_Entry *, Char_Code *, struct List_Header *,
! 		  Int, char *, Entity_Id, Entity_Id, Entity_Id, Int);
  
  /* GNAT_NODE is the root of some GNAT tree.  Return the root of the
     GCC tree corresponding to that GNAT tree.  Normally, no code is generated;
     we just return an equivalent tree which is used elsewhere to generate
     code.  */
! extern tree gnat_to_gnu (Node_Id);
  
  /* GNU_STMT is a statement.  We generate code for that statement.  */
! extern void gnat_expand_stmt (tree);
  
! extern int gnat_gimplify_expr (tree *, tree *, tree *);
  
  /* Do the processing for the declaration of a GNAT_ENTITY, a type.  If
     a separate Freeze node exists, delay the bulk of the processing.  Otherwise
!    make a GCC type for GNAT_ENTITY and set up the correspondance.  */
! 
! extern void process_type (Entity_Id);
  
  /* Convert Sloc into *LOCUS (a location_t).  Return true if this Sloc
     corresponds to a source code location and false if it doesn't.  In the
     latter case, we don't update *LOCUS.  We also set the Gigi global variable
     REF_FILENAME to the reference file name as given by sinput (i.e no
     directory).  */
! extern bool Sloc_to_locus (Source_Ptr, location_t *);
  
  /* Post an error message.  MSG is the error message, properly annotated.
     NODE is the node at which to post the error and the node to use for the
--- 167,214 ----
  extern const char *ref_filename;
  
  /* This is the main program of the back-end.  It sets up all the table
!    structures and then generates code.
  
!    ??? Needs parameter descriptions  */
! 
! extern void gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
!                   struct Node *nodes_ptr, Node_Id *next_node_ptr,
!                   Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr,
!                   struct Elmt_Item *elmts_ptr,
!                   struct String_Entry *strings_ptr,
!                   Char_Code *strings_chars_ptr,
!                   struct List_Header *list_headers_ptr,
! 		  Int number_units ATTRIBUTE_UNUSED,
!                   char *file_info_ptr ATTRIBUTE_UNUSED,
!                   Entity_Id standard_integer,
!                   Entity_Id standard_long_long_float,
!                   Entity_Id standard_exception_type,
!                   Int gigi_operating_mode);
  
  /* GNAT_NODE is the root of some GNAT tree.  Return the root of the
     GCC tree corresponding to that GNAT tree.  Normally, no code is generated;
     we just return an equivalent tree which is used elsewhere to generate
     code.  */
! extern tree gnat_to_gnu (Node_Id gnat_node);
  
  /* GNU_STMT is a statement.  We generate code for that statement.  */
! extern void gnat_expand_stmt (tree gnu_stmt);
  
! /* ??? missing documentation */
! extern int gnat_gimplify_expr (tree *expr_p, tree *pre_p,
!                                tree *post_p ATTRIBUTE_UNUSED);
  
  /* Do the processing for the declaration of a GNAT_ENTITY, a type.  If
     a separate Freeze node exists, delay the bulk of the processing.  Otherwise
!    make a GCC type for GNAT_ENTITY and set up the correspondence.  */
! extern void process_type (Entity_Id gnat_entity);
  
  /* Convert Sloc into *LOCUS (a location_t).  Return true if this Sloc
     corresponds to a source code location and false if it doesn't.  In the
     latter case, we don't update *LOCUS.  We also set the Gigi global variable
     REF_FILENAME to the reference file name as given by sinput (i.e no
     directory).  */
! extern bool Sloc_to_locus (Source_Ptr Sloc, location_t *locus);
  
  /* Post an error message.  MSG is the error message, properly annotated.
     NODE is the node at which to post the error and the node to use for the
*************** extern void post_error (const char *, No
*** 209,236 ****
  
  /* Similar, but NODE is the node at which to post the error and ENT
     is the node to use for the "&" substitution.  */
! extern void post_error_ne (const char *, Node_Id, Entity_Id);
  
  /* Similar, but NODE is the node at which to post the error, ENT is the node
     to use for the "&" substitution, and N is the number to use for the ^.  */
! extern void post_error_ne_num (const char *, Node_Id, Entity_Id, int);
  
  /* Similar to post_error_ne_num, but T is a GCC tree representing the number
     to write.  If the tree represents a constant that fits within a
     host integer, the text inside curly brackets in MSG will be output
     (presumably including a '^').  Otherwise that text will not be output
     and the text inside square brackets will be output instead.  */
! extern void post_error_ne_tree (const char *, Node_Id, Entity_Id, tree);
  
  /* Similar to post_error_ne_tree, except that NUM is a second
     integer to write in the message.  */
! extern void post_error_ne_tree_2 (const char *, Node_Id, Entity_Id, tree, int);
! 
! /* Set the node for a second '&' in the error message.  */
! extern void set_second_error_entity (Entity_Id);
  
  /* Protect EXP from multiple evaluation.  This may make a SAVE_EXPR.  */
! extern tree protect_multiple_eval (tree);
  
  /* Initialize the table that maps GNAT codes to GCC codes for simple
     binary and unary operations.  */
--- 217,244 ----
  
  /* Similar, but NODE is the node at which to post the error and ENT
     is the node to use for the "&" substitution.  */
! extern void post_error_ne (const char *msg, Node_Id node, Entity_Id ent);
  
  /* Similar, but NODE is the node at which to post the error, ENT is the node
     to use for the "&" substitution, and N is the number to use for the ^.  */
! extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
!                                int n);
  
  /* Similar to post_error_ne_num, but T is a GCC tree representing the number
     to write.  If the tree represents a constant that fits within a
     host integer, the text inside curly brackets in MSG will be output
     (presumably including a '^').  Otherwise that text will not be output
     and the text inside square brackets will be output instead.  */
! extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
!                                 tree t);
  
  /* Similar to post_error_ne_tree, except that NUM is a second
     integer to write in the message.  */
! extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
!                                   tree t, int num);
  
  /* Protect EXP from multiple evaluation.  This may make a SAVE_EXPR.  */
! extern tree protect_multiple_eval (tree exp);
  
  /* Initialize the table that maps GNAT codes to GCC codes for simple
     binary and unary operations.  */
*************** extern void init_code_table (void);
*** 240,249 ****
     called.  */
  extern Node_Id error_gnat_node;
  
! /* This is equivalent to stabilize_reference in GCC's tree.c, but we know
!    how to handle our new nodes and we take an extra argument that says
!    whether to force evaluation of everything.  */
! extern tree gnat_stabilize_reference (tree, bool);
  
  /* Highest number in the front-end node table.  */
  extern int max_gnat_nodes;
--- 248,269 ----
     called.  */
  extern Node_Id error_gnat_node;
  
! /* This is equivalent to stabilize_reference in GCC's tree.c, but we know how
!    to handle our new nodes and we take extra arguments.
! 
!    FORCE says whether to force evaluation of everything,
! 
!    SUCCESS we set to true unless we walk through something we don't
!    know how to stabilize, or through something which is not an lvalue
!    and LVALUES_ONLY is true, in which cases we set to false.  */
! extern tree maybe_stabilize_reference (tree ref, bool force, bool lvalues_only,
! 				       bool *success);
! 
! /* Wrapper around maybe_stabilize_reference, for common uses without
!    lvalue restrictions and without need to examine the success
!    indication.  */
! 
! extern tree gnat_stabilize_reference (tree ref, bool force);
  
  /* Highest number in the front-end node table.  */
  extern int max_gnat_nodes;
*************** extern int force_global;
*** 293,300 ****
  
  /* Data structures used to represent attributes.  */
  
! enum attr_type {ATTR_MACHINE_ATTRIBUTE, ATTR_LINK_ALIAS,
! 		ATTR_LINK_SECTION, ATTR_WEAK_EXTERNAL};
  
  struct attrib
  {
--- 313,327 ----
  
  /* Data structures used to represent attributes.  */
  
! enum attr_type
! {
!   ATTR_MACHINE_ATTRIBUTE,
!   ATTR_LINK_ALIAS,
!   ATTR_LINK_SECTION,
!   ATTR_LINK_CONSTRUCTOR,
!   ATTR_LINK_DESTRUCTOR,
!   ATTR_WEAK_EXTERNAL
! };
  
  struct attrib
  {
*************** enum standard_datatypes
*** 351,356 ****
--- 378,386 ----
  extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
  extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
  
+ extern GTY(()) tree static_ctors;
+ extern GTY(()) tree static_dtors;
+ 
  #define longest_float_type_node gnat_std_decls[(int) ADT_longest_float_type]
  #define void_type_decl_node gnat_std_decls[(int) ADT_void_type_decl]
  #define except_type_node gnat_std_decls[(int) ADT_except_type]
*************** extern void gnat_poplevel (void);
*** 385,394 ****
  
  /* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
     and point FNDECL to this BLOCK.  */
! extern void set_current_block_context (tree);
  
  /* Set the jmpbuf_decl for the current binding level to DECL.  */
! extern void set_block_jmpbuf_decl (tree);
  
  /* Get the setjmp_decl, if any, for the current binding level.  */
  extern tree get_block_jmpbuf_decl (void);
--- 415,424 ----
  
  /* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
     and point FNDECL to this BLOCK.  */
! extern void set_current_block_context (tree fndecl);
  
  /* Set the jmpbuf_decl for the current binding level to DECL.  */
! extern void set_block_jmpbuf_decl (tree decl);
  
  /* Get the setjmp_decl, if any, for the current binding level.  */
  extern tree get_block_jmpbuf_decl (void);
*************** extern tree get_block_jmpbuf_decl (void)
*** 396,437 ****
  /* Insert BLOCK at the end of the list of subblocks of the
     current binding level.  This is used when a BIND_EXPR is expanded,
     to handle the BLOCK node inside the BIND_EXPR.  */
! extern void insert_block (tree);
  
  /* Records a ..._DECL node DECL as belonging to the current lexical scope
!    and uses GNAT_ENTITY for location information.  */
! extern void gnat_pushdecl (tree, Entity_Id);
  
  extern void gnat_init_stmt_group (void);
  extern void gnat_init_decl_processing (void);
! extern void init_gigi_decls (tree, tree);
  extern void gnat_init_gcc_eh (void);
  
  /* Return an integer type with the number of bits of precision given by
     PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
     it is a signed type.  */
! extern tree gnat_type_for_size (unsigned, int);
  
  /* Return a data type that has machine mode MODE.  UNSIGNEDP selects
     an unsigned type; otherwise a signed type is returned.  */
! extern tree gnat_type_for_mode (enum machine_mode, int);
  
  /* Return the unsigned version of a TYPE_NODE, a scalar type.  */
! extern tree gnat_unsigned_type (tree);
  
  /* Return the signed version of a TYPE_NODE, a scalar type.  */
! extern tree gnat_signed_type (tree);
  
  /* Return a type the same as TYPE except unsigned or signed according to
     UNSIGNEDP.  */
! extern tree gnat_signed_or_unsigned_type (int, tree);
  
  /* Create an expression whose value is that of EXPR,
     converted to type TYPE.  The TREE_TYPE of the value
     is always TYPE.  This function implements all reasonable
     conversions; callers should filter out those that are
     not permitted by the language being compiled.  */
! extern tree convert (tree, tree);
  
  /* Routines created solely for the tree translator's sake. Their prototypes
     can be changed as desired.  */
--- 426,467 ----
  /* Insert BLOCK at the end of the list of subblocks of the
     current binding level.  This is used when a BIND_EXPR is expanded,
     to handle the BLOCK node inside the BIND_EXPR.  */
! extern void insert_block (tree block);
  
  /* Records a ..._DECL node DECL as belonging to the current lexical scope
!    and uses GNAT_NODE for location information.  */
! extern void gnat_pushdecl (tree decl, Node_Id gnat_node);
  
  extern void gnat_init_stmt_group (void);
  extern void gnat_init_decl_processing (void);
! extern void init_gigi_decls (tree long_long_float_type, tree exception_type);
  extern void gnat_init_gcc_eh (void);
  
  /* Return an integer type with the number of bits of precision given by
     PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
     it is a signed type.  */
! extern tree gnat_type_for_size (unsigned precision, int unsignedp);
  
  /* Return a data type that has machine mode MODE.  UNSIGNEDP selects
     an unsigned type; otherwise a signed type is returned.  */
! extern tree gnat_type_for_mode (enum machine_mode mode, int unsignedp);
  
  /* Return the unsigned version of a TYPE_NODE, a scalar type.  */
! extern tree gnat_unsigned_type (tree type_node);
  
  /* Return the signed version of a TYPE_NODE, a scalar type.  */
! extern tree gnat_signed_type (tree type_node);
  
  /* Return a type the same as TYPE except unsigned or signed according to
     UNSIGNEDP.  */
! extern tree gnat_signed_or_unsigned_type (int unsignedp, tree type);
  
  /* Create an expression whose value is that of EXPR,
     converted to type TYPE.  The TREE_TYPE of the value
     is always TYPE.  This function implements all reasonable
     conversions; callers should filter out those that are
     not permitted by the language being compiled.  */
! extern tree convert (tree type, tree expr);
  
  /* Routines created solely for the tree translator's sake. Their prototypes
     can be changed as desired.  */
*************** extern tree convert (tree, tree);
*** 441,455 ****
     GNAT_ENTITY. Such gnu tree node is always an ..._DECL node.
     If NO_CHECK is nonzero, the latter check is suppressed.
     If GNU_DECL is zero, a previous association is to be reset.  */
! extern void save_gnu_tree (Entity_Id, tree, bool);
  
  /* GNAT_ENTITY is a GNAT tree node for a defining identifier.
     Return the ..._DECL node that was associated with it.  If there is no tree
     node associated with GNAT_ENTITY, abort.  */
! extern tree get_gnu_tree (Entity_Id);
  
  /* Return nonzero if a GCC tree has been associated with GNAT_ENTITY.  */
! extern bool present_gnu_tree (Entity_Id);
  
  /* Initialize tables for above routines.  */
  extern void init_gnat_to_gnu (void);
--- 471,486 ----
     GNAT_ENTITY. Such gnu tree node is always an ..._DECL node.
     If NO_CHECK is nonzero, the latter check is suppressed.
     If GNU_DECL is zero, a previous association is to be reset.  */
! extern void save_gnu_tree (Entity_Id gnat_entity, tree gnu_decl,
!                            bool no_check);
  
  /* GNAT_ENTITY is a GNAT tree node for a defining identifier.
     Return the ..._DECL node that was associated with it.  If there is no tree
     node associated with GNAT_ENTITY, abort.  */
! extern tree get_gnu_tree (Entity_Id gnat_entity);
  
  /* Return nonzero if a GCC tree has been associated with GNAT_ENTITY.  */
! extern bool present_gnu_tree (Entity_Id gnat_entity);
  
  /* Initialize tables for above routines.  */
  extern void init_gnat_to_gnu (void);
*************** extern void init_gnat_to_gnu (void);
*** 460,466 ****
     layout_type but merely set the size and alignment ourselves.
     If DEFER_DEBUG is true, do not call the debugging routines
     on this type; it will be done later. */
! extern void finish_record_type (tree, tree, bool, bool);
  
  /* Returns a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
     subprogram. If it is void_type_node, then we are dealing with a procedure,
--- 491,501 ----
     layout_type but merely set the size and alignment ourselves.
     If DEFER_DEBUG is true, do not call the debugging routines
     on this type; it will be done later. */
! extern void finish_record_type (tree record_type, tree fieldlist,
!                                 bool has_rep, bool defer_debug);
! 
! /*  Output the debug information associated to a record type.  */
! extern void write_record_type_debug_info (tree);
  
  /* Returns a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
     subprogram. If it is void_type_node, then we are dealing with a procedure,
*************** extern void finish_record_type (tree, tr
*** 473,486 ****
     depressed stack pointer.  RETURNS_BY_TARGET_PTR is true if the function
     is to be passed (as its first parameter) the address of the place to copy
     its result.  */
! extern tree create_subprog_type (tree, tree, tree, bool, bool, bool, bool);
  
  /* Return a copy of TYPE, but safe to modify in any way.  */
! extern tree copy_type (tree);
  
  /* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
     TYPE_INDEX_TYPE is INDEX.  */
! extern tree create_index_type (tree, tree, tree);
  
  /* Return a TYPE_DECL node. TYPE_NAME gives the name of the type (a character
     string) and TYPE is a ..._TYPE node giving its data type.
--- 508,524 ----
     depressed stack pointer.  RETURNS_BY_TARGET_PTR is true if the function
     is to be passed (as its first parameter) the address of the place to copy
     its result.  */
! extern tree create_subprog_type (tree return_type, tree param_decl_list,
!                                  tree cico_list, bool returns_unconstrained,
!                                  bool returns_by_ref, bool returns_with_dsp,
!                                  bool returns_by_target_ptr);
  
  /* Return a copy of TYPE, but safe to modify in any way.  */
! extern tree copy_type (tree type);
  
  /* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
     TYPE_INDEX_TYPE is INDEX.  */
! extern tree create_index_type (tree min, tree max, tree index);
  
  /* Return a TYPE_DECL node. TYPE_NAME gives the name of the type (a character
     string) and TYPE is a ..._TYPE node giving its data type.
*************** extern tree create_index_type (tree, tre
*** 488,495 ****
     by the compiler.  DEBUG_INFO_P is true if we need to write debugging
     information about this type.  GNAT_NODE is used for the position of
     the decl.  */
! extern tree create_type_decl (tree, tree, struct attrib *, bool, bool,
! 			      Node_Id);
  
  /* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable.
     ASM_NAME is its assembler name (if provided).  TYPE is
--- 526,535 ----
     by the compiler.  DEBUG_INFO_P is true if we need to write debugging
     information about this type.  GNAT_NODE is used for the position of
     the decl.  */
! extern tree create_type_decl (tree type_name, tree type,
!                               struct attrib *attr_list,
!                               bool artificial_p, bool debug_info_p,
! 			      Node_Id gnat_node);
  
  /* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable.
     ASM_NAME is its assembler name (if provided).  TYPE is
*************** extern tree create_type_decl (tree, tree
*** 508,518 ****
     it indicates whether to always allocate storage to the variable.
  
     GNAT_NODE is used for the position of the decl.  */
! extern tree create_var_decl (tree, tree, tree, tree, bool, bool, bool, bool,
! 			     struct attrib *, Node_Id);
  
  /* Given a DECL and ATTR_LIST, apply the listed attributes.  */
! extern void process_attributes (tree, struct attrib *);
  
  /* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
     type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
--- 548,561 ----
     it indicates whether to always allocate storage to the variable.
  
     GNAT_NODE is used for the position of the decl.  */
! extern tree create_var_decl (tree var_name, tree asm_name, tree type,
!                              tree var_init, bool const_flag,
!                              bool public_flag, bool extern_flag,
!                              bool static_flag,
! 			     struct attrib *attr_list, Node_Id gnat_node);
  
  /* Given a DECL and ATTR_LIST, apply the listed attributes.  */
! extern void process_attributes (tree decl, struct attrib *attr_list);
  
  /* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
     type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
*************** extern void process_attributes (tree, st
*** 520,532 ****
     it is the specified size for this field.  If POS is nonzero, it is the bit
     position.  If ADDRESSABLE is nonzero, it means we are allowed to take
     the address of this field for aliasing purposes.  */
! extern tree create_field_decl (tree, tree, tree, int, tree, tree, int);
  
  /* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
     PARAM_TYPE is its type.  READONLY is true if the parameter is
     readonly (either an IN parameter or an address of a pass-by-ref
     parameter). */
! extern tree create_param_decl (tree, tree, bool);
  
  /* Returns a FUNCTION_DECL node.  SUBPROG_NAME is the name of the subprogram,
     ASM_NAME is its assembler name, SUBPROG_TYPE is its type (a FUNCTION_TYPE
--- 563,578 ----
     it is the specified size for this field.  If POS is nonzero, it is the bit
     position.  If ADDRESSABLE is nonzero, it means we are allowed to take
     the address of this field for aliasing purposes.  */
! extern tree create_field_decl (tree field_name, tree field_type,
!                                tree record_type, int packed, tree size,
!                                tree pos, int addressable);
  
  /* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
     PARAM_TYPE is its type.  READONLY is true if the parameter is
     readonly (either an IN parameter or an address of a pass-by-ref
     parameter). */
! extern tree create_param_decl (tree param_name, tree param_type,
!                                bool readonly);
  
  /* Returns a FUNCTION_DECL node.  SUBPROG_NAME is the name of the subprogram,
     ASM_NAME is its assembler name, SUBPROG_TYPE is its type (a FUNCTION_TYPE
*************** extern tree create_param_decl (tree, tre
*** 535,560 ****
  
     INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
     appropriate fields in the FUNCTION_DECL.  GNAT_NODE gives the location.  */
! extern tree create_subprog_decl (tree, tree, tree, tree, bool, bool, bool,
! 				 struct attrib *, Node_Id);
  
  /* Returns a LABEL_DECL node for LABEL_NAME.  */
! extern tree create_label_decl (tree);
  
  /* Set up the framework for generating code for SUBPROG_DECL, a subprogram
     body. This routine needs to be invoked before processing the declarations
     appearing in the subprogram.  */
! extern void begin_subprog_body (tree);
  
  /* Finish the definition of the current subprogram and compile it all the way
     to assembler language output.  BODY is the tree corresponding to
     the subprogram.  */
! extern void end_subprog_body (tree);
  
  /* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
     EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs.
     Return a constructor for the template.  */
! extern tree build_template (tree, tree, tree);
  
  /* Build a VMS descriptor from a Mechanism_Type, which must specify
     a descriptor type, and the GCC type of an object.  Each FIELD_DECL
--- 581,609 ----
  
     INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
     appropriate fields in the FUNCTION_DECL.  GNAT_NODE gives the location.  */
! extern tree create_subprog_decl (tree subprog_name, tree asm_name,
!                                  tree subprog_type, tree param_decl_list,
!                                  bool inlinee_flag, bool public_flag,
!                                  bool extern_flag,
! 				 struct attrib *attr_list, Node_Id gnat_node);
  
  /* Returns a LABEL_DECL node for LABEL_NAME.  */
! extern tree create_label_decl (tree label_name);
  
  /* Set up the framework for generating code for SUBPROG_DECL, a subprogram
     body. This routine needs to be invoked before processing the declarations
     appearing in the subprogram.  */
! extern void begin_subprog_body (tree subprog_decl);
  
  /* Finish the definition of the current subprogram and compile it all the way
     to assembler language output.  BODY is the tree corresponding to
     the subprogram.  */
! extern void end_subprog_body (tree body);
  
  /* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
     EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs.
     Return a constructor for the template.  */
! extern tree build_template (tree template_type, tree array_type, tree expr);
  
  /* Build a VMS descriptor from a Mechanism_Type, which must specify
     a descriptor type, and the GCC type of an object.  Each FIELD_DECL
*************** extern tree build_template (tree, tree, 
*** 563,569 ****
     to print out an error message if the mechanism cannot be applied to
     an object of that type and also for the name.  */
  
! extern tree build_vms_descriptor (tree, Mechanism_Type, Entity_Id);
  
  /* Build a type to be used to represent an aliased object whose nominal
     type is an unconstrained array.  This consists of a RECORD_TYPE containing
--- 612,619 ----
     to print out an error message if the mechanism cannot be applied to
     an object of that type and also for the name.  */
  
! extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
!                                   Entity_Id gnat_entity);
  
  /* Build a type to be used to represent an aliased object whose nominal
     type is an unconstrained array.  This consists of a RECORD_TYPE containing
*************** extern tree build_vms_descriptor (tree, 
*** 571,664 ****
     ARRAY_TYPE.  If ARRAY_TYPE is that of the unconstrained array, this
     is used to represent an arbitrary unconstrained object.  Use NAME
     as the name of the record.  */
! extern tree build_unc_object_type (tree, tree, tree);
  
  /* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE.  In
     the normal case this is just two adjustments, but we have more to do
     if NEW is an UNCONSTRAINED_ARRAY_TYPE.  */
! extern void update_pointer_to (tree, tree);
  
  /* EXP is an expression for the size of an object.  If this size contains
     discriminant references, replace them with the maximum (if MAX_P) or
     minimum (if !MAX_P) possible value of the discriminant.  */
! extern tree max_size (tree, bool);
  
  /* Remove all conversions that are done in EXP.  This includes converting
     from a padded type or to a left-justified modular type.  If TRUE_ADDRESS
     is true, always return the address of the containing object even if
     the address is not bit-aligned.  */
! extern tree remove_conversions (tree, bool);
  
  /* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that
     refers to the underlying array.  If its type has TYPE_CONTAINS_TEMPLATE_P,
     likewise return an expression pointing to the underlying array.  */
! extern tree maybe_unconstrained_array (tree);
  
! /* Return an expression that does an unchecked converstion of EXPR to TYPE.
     If NOTRUNC_P is true, truncation operations should be suppressed.  */
! extern tree unchecked_convert (tree, tree, bool);
  
  /* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
     operation.
  
     This preparation consists of taking the ordinary
!    representation of an expression expr and producing a valid tree
!    boolean expression describing whether expr is nonzero.  We could
     simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
     but we optimize comparisons, &&, ||, and !.
  
     The resulting type should always be the same as the input type.
     This function is simpler than the corresponding C version since
     the only possible operands will be things of Boolean type.  */
! extern tree gnat_truthvalue_conversion (tree);
  
  /* Return the base type of TYPE.  */
! extern tree get_base_type (tree);
  
  /* Likewise, but only return types known at Ada source.  */
! extern tree get_ada_base_type (tree);
  
  /* EXP is a GCC tree representing an address.  See if we can find how
     strictly the object at that address is aligned.   Return that alignment
     strictly the object at that address is aligned.   Return that alignment
     in bits.  If we don't know anything about the alignment, return 0.  */
! extern unsigned int known_alignment (tree);
  
  /* Make a binary operation of kind OP_CODE.  RESULT_TYPE is the type
     desired for the result.  Usually the operation is to be performed
     in that type.  For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
     in which case the type to be used will be derived from the operands.  */
! extern tree build_binary_op (enum tree_code, tree, tree, tree);
  
  /* Similar, but make unary operation.   */
! extern tree build_unary_op (enum tree_code, tree, tree);
  
  /* Similar, but for COND_EXPR.  */
! extern tree build_cond_expr (tree, tree, tree, tree);
  
  /* Build a CALL_EXPR to call FUNDECL with one argument, ARG.  Return
     the CALL_EXPR.  */
! extern tree build_call_1_expr (tree, tree);
  
  /* Build a CALL_EXPR to call FUNDECL with two argument, ARG1 & ARG2.  Return
     the CALL_EXPR.  */
! extern tree build_call_2_expr (tree, tree, tree);
  
  /* Likewise to call FUNDECL with no arguments.  */
! extern tree build_call_0_expr (tree);
  
  /* Call a function that raises an exception and pass the line number and file
     name, if requested.  MSG says which exception function to call.  */
! extern tree build_call_raise (int);
  
  /* Return a CONSTRUCTOR of TYPE whose list is LIST.  This is not the
     same as build_constructor in the language-independent tree.c.  */
! extern tree gnat_build_constructor (tree, tree);
  
  /* Return a COMPONENT_REF to access a field that is given by COMPONENT,
     an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
     for the field, or both.  Don't fold the result if NO_FOLD_P.  */
! extern tree build_component_ref (tree, tree, tree, bool);
  
  /* Build a GCC tree to call an allocation or deallocation function.
     If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,
--- 621,727 ----
     ARRAY_TYPE.  If ARRAY_TYPE is that of the unconstrained array, this
     is used to represent an arbitrary unconstrained object.  Use NAME
     as the name of the record.  */
! extern tree build_unc_object_type (tree template_type, tree object_type,
!                                    tree name);
! 
! /* Same as build_unc_object_type, but taking a thin or fat pointer type
!    instead of the template type. */
! extern tree build_unc_object_type_from_ptr (tree thin_fat_ptr_type,
! 					    tree object_type, tree name);
  
  /* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE.  In
     the normal case this is just two adjustments, but we have more to do
     if NEW is an UNCONSTRAINED_ARRAY_TYPE.  */
! extern void update_pointer_to (tree old_type, tree new_type);
  
  /* EXP is an expression for the size of an object.  If this size contains
     discriminant references, replace them with the maximum (if MAX_P) or
     minimum (if !MAX_P) possible value of the discriminant.  */
! extern tree max_size (tree exp, bool max_p);
  
  /* Remove all conversions that are done in EXP.  This includes converting
     from a padded type or to a left-justified modular type.  If TRUE_ADDRESS
     is true, always return the address of the containing object even if
     the address is not bit-aligned.  */
! extern tree remove_conversions (tree exp, bool true_address);
  
  /* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that
     refers to the underlying array.  If its type has TYPE_CONTAINS_TEMPLATE_P,
     likewise return an expression pointing to the underlying array.  */
! extern tree maybe_unconstrained_array (tree exp);
  
! /* Return an expression that does an unchecked conversion of EXPR to TYPE.
     If NOTRUNC_P is true, truncation operations should be suppressed.  */
! extern tree unchecked_convert (tree type, tree expr, bool notrunc_p);
  
  /* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
     operation.
  
     This preparation consists of taking the ordinary
!    representation of an expression EXPR and producing a valid tree
!    boolean expression describing whether EXPR is nonzero.  We could
     simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
     but we optimize comparisons, &&, ||, and !.
  
     The resulting type should always be the same as the input type.
     This function is simpler than the corresponding C version since
     the only possible operands will be things of Boolean type.  */
! extern tree gnat_truthvalue_conversion (tree expr);
  
  /* Return the base type of TYPE.  */
! extern tree get_base_type (tree type);
  
  /* Likewise, but only return types known at Ada source.  */
! extern tree get_ada_base_type (tree type);
  
  /* EXP is a GCC tree representing an address.  See if we can find how
     strictly the object at that address is aligned.   Return that alignment
     strictly the object at that address is aligned.   Return that alignment
     in bits.  If we don't know anything about the alignment, return 0.  */
! extern unsigned int known_alignment (tree exp);
  
  /* Make a binary operation of kind OP_CODE.  RESULT_TYPE is the type
     desired for the result.  Usually the operation is to be performed
     in that type.  For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
     in which case the type to be used will be derived from the operands.  */
! extern tree build_binary_op (enum tree_code op_code, tree retult_type,
!                              tree left_operand, tree right_operand);
  
  /* Similar, but make unary operation.   */
! extern tree build_unary_op (enum tree_code op_code, tree result_type,
!                             tree operand);
  
  /* Similar, but for COND_EXPR.  */
! extern tree build_cond_expr (tree result_type, tree condition_operand,
!                              tree true_operand, tree false_operand);
! 
! /* Similar, but for RETURN_EXPR.  */
! extern tree build_return_expr (tree result_decl, tree ret_val);
  
  /* Build a CALL_EXPR to call FUNDECL with one argument, ARG.  Return
     the CALL_EXPR.  */
! extern tree build_call_1_expr (tree fundecl, tree arg);
  
  /* Build a CALL_EXPR to call FUNDECL with two argument, ARG1 & ARG2.  Return
     the CALL_EXPR.  */
! extern tree build_call_2_expr (tree fundecl, tree arg1, tree arg2);
  
  /* Likewise to call FUNDECL with no arguments.  */
! extern tree build_call_0_expr (tree fundecl);
  
  /* Call a function that raises an exception and pass the line number and file
     name, if requested.  MSG says which exception function to call.  */
! extern tree build_call_raise (int msg);
  
  /* Return a CONSTRUCTOR of TYPE whose list is LIST.  This is not the
     same as build_constructor in the language-independent tree.c.  */
! extern tree gnat_build_constructor (tree type, tree list);
  
  /* Return a COMPONENT_REF to access a field that is given by COMPONENT,
     an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
     for the field, or both.  Don't fold the result if NO_FOLD_P.  */
! extern tree build_component_ref (tree record_variable, tree component,
!                                  tree field, bool no_fold_p);
  
  /* Build a GCC tree to call an allocation or deallocation function.
     If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,
*************** extern tree build_component_ref (tree, t
*** 667,700 ****
     GNU_SIZE is the size of the object and ALIGN is the alignment.
     GNAT_PROC, if present is a procedure to call and GNAT_POOL is the
     storage pool to use.  If not preset, malloc and free will be used.  */
! extern tree build_call_alloc_dealloc (tree, tree, unsigned int, Entity_Id,
! 				      Entity_Id, Node_Id);
  
  /* Build a GCC tree to correspond to allocating an object of TYPE whose
     initial value if INIT, if INIT is nonzero.  Convert the expression to
     RESULT_TYPE, which must be some type of pointer.  Return the tree.
     GNAT_PROC and GNAT_POOL optionally give the procedure to call and
     the storage pool to use.  GNAT_NODE is used to provide an error
!    location for restriction violations messages.  */
! extern tree build_allocator (tree, tree, tree, Entity_Id, Entity_Id, Node_Id);
  
  /* Fill in a VMS descriptor for EXPR and return a constructor for it.
     GNAT_FORMAL is how we find the descriptor record.  */
  
! extern tree fill_vms_descriptor (tree, Entity_Id);
  
  /* Indicate that we need to make the address of EXPR_NODE and it therefore
     should not be allocated in a register.  Return true if successful.  */
! extern bool gnat_mark_addressable (tree);
  
  /* Implementation of the builtin_function langhook.  */
! extern tree builtin_function (const char *, tree, int, enum built_in_class,
! 			      const char *, tree);
  
  /* Search the chain of currently reachable declarations for a builtin
     FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE).
     Return the first node found, if any, or NULL_TREE otherwise.  */
! extern tree builtin_decl_for (tree);
  
  /* This function is called by the front end to enumerate all the supported
     modes for the machine.  We pass a function which is called back with
--- 730,770 ----
     GNU_SIZE is the size of the object and ALIGN is the alignment.
     GNAT_PROC, if present is a procedure to call and GNAT_POOL is the
     storage pool to use.  If not preset, malloc and free will be used.  */
! extern tree build_call_alloc_dealloc (tree gnu_obj, tree gnu_size,
!                                       unsigned align, Entity_Id gnat_proc,
! 				      Entity_Id gnat_pool, Node_Id gnat_node);
  
  /* Build a GCC tree to correspond to allocating an object of TYPE whose
     initial value if INIT, if INIT is nonzero.  Convert the expression to
     RESULT_TYPE, which must be some type of pointer.  Return the tree.
     GNAT_PROC and GNAT_POOL optionally give the procedure to call and
     the storage pool to use.  GNAT_NODE is used to provide an error
!    location for restriction violations messages.  If IGNORE_INIT_TYPE is
!    true, ignore the type of INIT for the purpose of determining the size;
!    this will cause the maximum size to be allocated if TYPE is of
!    self-referential size.  */
! extern tree build_allocator (tree type, tree init, tree result_type,
!                              Entity_Id gnat_proc, Entity_Id gnat_pool,
!                              Node_Id gnat_node, bool);
  
  /* Fill in a VMS descriptor for EXPR and return a constructor for it.
     GNAT_FORMAL is how we find the descriptor record.  */
  
! extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal);
  
  /* Indicate that we need to make the address of EXPR_NODE and it therefore
     should not be allocated in a register.  Return true if successful.  */
! extern bool gnat_mark_addressable (tree expr_node);
  
  /* Implementation of the builtin_function langhook.  */
! extern tree builtin_function (const char *name, tree type, int function_code,
!                               enum built_in_class class,
! 			      const char *library_name, tree attrs);
  
  /* Search the chain of currently reachable declarations for a builtin
     FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE).
     Return the first node found, if any, or NULL_TREE otherwise.  */
! extern tree builtin_decl_for (tree name ATTRIBUTE_UNUSED);
  
  /* This function is called by the front end to enumerate all the supported
     modes for the machine.  We pass a function which is called back with
*************** extern void enumerate_modes (void (*f) (
*** 712,719 ****
  
  /* These are temporary function to deal with recent GCC changes related to
     FP type sizes and precisions.  */
! extern int fp_prec_to_size (int);
! extern int fp_size_to_prec (int);
  
  /* These functions return the basic data type sizes and related parameters
     about the target machine.  */
--- 782,789 ----
  
  /* These are temporary function to deal with recent GCC changes related to
     FP type sizes and precisions.  */
! extern int fp_prec_to_size (int prec);
! extern int fp_size_to_prec (int size);
  
  /* These functions return the basic data type sizes and related parameters
     about the target machine.  */
diff -Nrcpad gcc-4.0.2/gcc/ada/gmem.c gcc-4.1.0/gcc/ada/gmem.c
*** gcc-4.0.2/gcc/ada/gmem.c	Fri Oct 31 01:08:42 2003
--- gcc-4.1.0/gcc/ada/gmem.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** gmem_read_backtrace (void)
*** 83,89 ****
  }
  
  /* initialize gmem feature from the dumpname file. It returns 1 if the
!    dumpname has beed generated by GMEM (instrumented malloc/free) and 0 if not
     (i.e. probably a GDB generated file).
  */
  
--- 83,89 ----
  }
  
  /* initialize gmem feature from the dumpname file. It returns 1 if the
!    dumpname has been generated by GMEM (instrumented malloc/free) and 0 if not
     (i.e. probably a GDB generated file).
  */
  
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat-style.texi gcc-4.1.0/gcc/ada/gnat-style.texi
*** gcc-4.0.2/gcc/ada/gnat-style.texi	Wed Sep  1 11:51:52 2004
--- gcc-4.1.0/gcc/ada/gnat-style.texi	Tue Nov 15 14:05:45 2005
***************
*** 5,13 ****
  @c                                                                            o
  @c                           GNAT DOCUMENTATION                               o
  @c                                                                            o
! @c                      G N A T   C O D I N G   S T Y L E                     o
  @c                                                                            o
! @c          Copyright (C) 1992-2004 Ada Core Technologies, Inc.               o
  @c                                                                            o
  @c  GNAT is free software;  you can  redistribute it  and/or modify it under  o
  @c  terms of the  GNU General Public License as published  by the Free Soft-  o
--- 5,13 ----
  @c                                                                            o
  @c                           GNAT DOCUMENTATION                               o
  @c                                                                            o
! @c                     G N A T   C O D I N G   S T Y L E                      o
  @c                                                                            o
! @c                     Copyright (C) 1992-2005, AdaCore                       o
  @c                                                                            o
  @c  GNAT is free software;  you can  redistribute it  and/or modify it under  o
  @c  terms of the  GNU General Public License as published  by the Free Soft-  o
***************
*** 17,24 ****
  @c  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License  o
  @c  for  more details.  You should have  received  a copy of the GNU General  o
  @c  Public License  distributed with GNAT;  see file COPYING.  If not, write  o
! @c  to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston,  o
! @c  MA 02111-1307, USA.                                                       o
  @c                                                                            o
  @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
  
--- 17,24 ----
  @c  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License  o
  @c  for  more details.  You should have  received  a copy of the GNU General  o
  @c  Public License  distributed with GNAT;  see file COPYING.  If not, write  o
! @c  to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor,  o
! @c  Boston, MA 02110-1301, USA.                                               o
  @c                                                                            o
  @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
  
***************
*** 52,58 ****
  @page
  @vskip 0pt plus 1filll
  
! Copyright @copyright{} 1995-2003, Free Software Foundation
  
  Permission is granted to copy, distribute and/or modify this document
  under the terms of the GNU Free Documentation License, Version 1.1
--- 52,58 ----
  @page
  @vskip 0pt plus 1filll
  
! Copyright @copyright{} 1995-2005, Free Software Foundation
  
  Permission is granted to copy, distribute and/or modify this document
  under the terms of the GNU Free Documentation License, Version 1.1
*************** the first letter of the comment).
*** 262,268 ****
  When declarations are commented with ``hanging'' comments, i.e.@:
  comments after the declaration, there is no blank line before the
  comment, and if it is absolutely necessary to have blank lines within
! the comments these blank lines @emph{do} have a @code{--} (unlike the
  normal rule, which is to use entirely blank lines for separating
  comment paragraphs).  The comment starts at same level of indentation
  as code it is commenting.
--- 262,269 ----
  When declarations are commented with ``hanging'' comments, i.e.@:
  comments after the declaration, there is no blank line before the
  comment, and if it is absolutely necessary to have blank lines within
! the comments, e.g. to make paragraph separations within a single comment,
! these blank lines @emph{do} have a @code{--} (unlike the
  normal rule, which is to use entirely blank lines for separating
  comment paragraphs).  The comment starts at same level of indentation
  as code it is commenting.
*************** sufficient, as comments.
*** 332,338 ****
  @node    Declarations and Types, Expressions and Names, Lexical Elements,Top
  @section Declarations and Types
  @c  -------------------------------------------------------------------------
! @cindex Declarationa and Types
  
  @itemize @bullet
  @item
--- 333,339 ----
  @node    Declarations and Types, Expressions and Names, Lexical Elements,Top
  @section Declarations and Types
  @c  -------------------------------------------------------------------------
! @cindex Declarations and Types
  
  @itemize @bullet
  @item
*************** unique, to prevent name clashes when the
*** 814,819 ****
--- 815,834 ----
  @item
  After the file header comment, the context clause and unit specification
  should be the first thing in a @syntax{program_unit}.
+ 
+ @item
+ Preelaborate, Pure and Elaborate_Body pragmas should be added right after the
+ package name, indented an extra level and using the parameterless form:
+ 
+ @smallexample @c adanocomment
+ @group
+       package Preelaborate_Package is
+          pragma Preelaborate;
+          ...
+       end Preelaborate_Package;
+ @end group
+ @end smallexample
+ 
  @end itemize
  
  @c  -------------------------------------------------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat.ads gcc-4.1.0/gcc/ada/gnat.ads
*** gcc-4.0.2/gcc/ada/gnat.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnat.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                                 G N A T                                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                                 G N A T                                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1992-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,39 ****
  --  This is the parent package for a library of useful units provided with GNAT
  
  package GNAT is
! pragma Pure (GNAT);
  
  end GNAT;
--- 34,39 ----
  --  This is the parent package for a library of useful units provided with GNAT
  
  package GNAT is
!    pragma Pure;
  
  end GNAT;
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat1drv.adb gcc-4.1.0/gcc/ada/gnat1drv.adb
*** gcc-4.0.2/gcc/ada/gnat1drv.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/gnat1drv.adb	Mon Sep  5 07:46:59 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** begin
*** 203,229 ****
  
        if Targparm.ZCX_By_Default_On_Target then
           if Targparm.GCC_ZCX_Support_On_Target then
!             Exception_Mechanism := Back_End_ZCX_Exceptions;
!          else
!             Exception_Mechanism := Front_End_ZCX_Exceptions;
!          end if;
!       end if;
! 
!       --  We take the command line exception mechanism into account
! 
!       if Opt.Zero_Cost_Exceptions_Set then
!          if Opt.Zero_Cost_Exceptions_Val = False then
!             Exception_Mechanism := Front_End_Setjmp_Longjmp_Exceptions;
! 
!          elsif Debug_Flag_XX then
!             Exception_Mechanism := Front_End_ZCX_Exceptions;
! 
!          elsif Targparm.GCC_ZCX_Support_On_Target then
!             Exception_Mechanism := Back_End_ZCX_Exceptions;
! 
!          elsif Targparm.Front_End_ZCX_Support_On_Target then
!             Exception_Mechanism := Front_End_ZCX_Exceptions;
! 
           else
              Osint.Fail
                ("Zero Cost Exceptions not supported on this target");
--- 203,209 ----
  
        if Targparm.ZCX_By_Default_On_Target then
           if Targparm.GCC_ZCX_Support_On_Target then
!             Exception_Mechanism := Back_End_Exceptions;
           else
              Osint.Fail
                ("Zero Cost Exceptions not supported on this target");
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat1drv.ads gcc-4.1.0/gcc/ada/gnat1drv.ads
*** gcc-4.0.2/gcc/ada/gnat1drv.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnat1drv.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat_rm.texi gcc-4.1.0/gcc/ada/gnat_rm.texi
*** gcc-4.0.2/gcc/ada/gnat_rm.texi	Thu Feb 10 13:57:20 2005
--- gcc-4.1.0/gcc/ada/gnat_rm.texi	Wed Nov 16 09:06:33 2005
***************
*** 8,14 ****
  @c                                                                            o
  @c                              G N A T _ RM                                  o
  @c                                                                            o
! @c              Copyright (C) 1995-2004 Free Software Foundation              o
  @c                                                                            o
  @c                                                                            o
  @c  GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).    o
--- 8,14 ----
  @c                                                                            o
  @c                              G N A T _ RM                                  o
  @c                                                                            o
! @c              Copyright (C) 1995-2005 Free Software Foundation              o
  @c                                                                            o
  @c                                                                            o
  @c  GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).    o
*************** GNAT, The GNU Ada 95 Compiler@*
*** 69,75 ****
  GCC version @value{version-GCC}@*
  
  @noindent
! Ada Core Technologies, Inc.
  
  @menu
  * About This Guide::
--- 69,75 ----
  GCC version @value{version-GCC}@*
  
  @noindent
! AdaCore
  
  @menu
  * About This Guide::
*************** Implementation Defined Pragmas
*** 102,107 ****
--- 102,108 ----
  * Pragma Abort_Defer::
  * Pragma Ada_83::
  * Pragma Ada_95::
+ * Pragma Ada_05::
  * Pragma Annotate::
  * Pragma Assert::
  * Pragma Ast_Entry::
*************** Implementation Defined Pragmas
*** 117,122 ****
--- 118,124 ----
  * Pragma CPP_Virtual::
  * Pragma CPP_Vtable::
  * Pragma Debug::
+ * Pragma Debug_Policy::
  * Pragma Detect_Blocking::
  * Pragma Elaboration_Checks::
  * Pragma Eliminate::
*************** Implementation Defined Pragmas
*** 148,161 ****
--- 150,167 ----
  * Pragma License::
  * Pragma Link_With::
  * Pragma Linker_Alias::
+ * Pragma Linker_Constructor::
+ * Pragma Linker_Destructor::
  * Pragma Linker_Section::
  * Pragma Long_Float::
  * Pragma Machine_Attribute::
  * Pragma Main_Storage::
  * Pragma No_Return::
+ * Pragma No_Strict_Aliasing ::
  * Pragma Normalize_Scalars::
  * Pragma Obsolescent::
  * Pragma Passive::
+ * Pragma Persistent_BSS::
  * Pragma Polling::
  * Pragma Profile (Ravenscar)::
  * Pragma Profile (Restricted)::
*************** Implementation of Specific Ada Features
*** 393,398 ****
--- 399,405 ----
  * GNAT Implementation of Shared Passive Packages::
  * Code Generation for Array Aggregates::
  * The Size of Discriminated Records with Default Discriminants::
+ * Strict Conformance to the Ada 95 Reference Manual::
  
  Project File Reference
  
*************** of project files.
*** 520,526 ****
  @ref{Obsolescent Features} documents implementation dependent features,
  including pragmas and attributes, which are considered obsolescent, since
  there are other preferred ways of achieving the same results. These
! obsolescent forms are retained for backwards compatibilty.
  
  @end itemize
  
--- 527,533 ----
  @ref{Obsolescent Features} documents implementation dependent features,
  including pragmas and attributes, which are considered obsolescent, since
  there are other preferred ways of achieving the same results. These
! obsolescent forms are retained for backwards compatibility.
  
  @end itemize
  
*************** consideration, the use of these pragmas 
*** 629,634 ****
--- 636,642 ----
  * Pragma Abort_Defer::
  * Pragma Ada_83::
  * Pragma Ada_95::
+ * Pragma Ada_05::
  * Pragma Annotate::
  * Pragma Assert::
  * Pragma Ast_Entry::
*************** consideration, the use of these pragmas 
*** 644,649 ****
--- 652,658 ----
  * Pragma CPP_Virtual::
  * Pragma CPP_Vtable::
  * Pragma Debug::
+ * Pragma Debug_Policy::
  * Pragma Detect_Blocking::
  * Pragma Elaboration_Checks::
  * Pragma Eliminate::
*************** consideration, the use of these pragmas 
*** 675,688 ****
--- 684,701 ----
  * Pragma License::
  * Pragma Link_With::
  * Pragma Linker_Alias::
+ * Pragma Linker_Constructor::
+ * Pragma Linker_Destructor::
  * Pragma Linker_Section::
  * Pragma Long_Float::
  * Pragma Machine_Attribute::
  * Pragma Main_Storage::
  * Pragma No_Return::
+ * Pragma No_Strict_Aliasing::
  * Pragma Normalize_Scalars::
  * Pragma Obsolescent::
  * Pragma Passive::
+ * Pragma Persistent_BSS::
  * Pragma Polling::
  * Pragma Profile (Ravenscar)::
  * Pragma Profile (Restricted)::
*************** contexts.  This pragma is useful when wr
*** 781,786 ****
--- 794,817 ----
  itself uses Ada 95 features, but which is intended to be usable from
  either Ada 83 or Ada 95 programs.
  
+ @node Pragma Ada_05
+ @unnumberedsec Pragma Ada_05
+ @findex Ada_05
+ @noindent
+ Syntax:
+ @smallexample @c ada
+ pragma Ada_05;
+ @end smallexample
+ 
+ @noindent
+ A configuration pragma that establishes Ada 2005 mode for the unit to which
+ it applies, regardless of the mode set by the command line switches.
+ This mode is set automatically for the @code{Ada} and @code{System}
+ packages and their children, so you need not specify it in these
+ contexts.  This pragma is useful when writing a reusable component that
+ itself uses Ada 2005 features, but which is intended to be usable from
+ either Ada 83 or Ada 95 programs.
+ 
  @node Pragma Annotate
  @unnumberedsec Pragma Annotate
  @findex Annotate
*************** Syntax:
*** 958,964 ****
  
  @smallexample @c ada
  pragma Common_Object (
!      [Internal =>] LOCAL_NAME,
    [, [External =>] EXTERNAL_SYMBOL]
    [, [Size     =>] EXTERNAL_SYMBOL] );
  
--- 989,995 ----
  
  @smallexample @c ada
  pragma Common_Object (
!      [Internal =>] local_NAME,
    [, [External =>] EXTERNAL_SYMBOL]
    [, [Size     =>] EXTERNAL_SYMBOL] );
  
*************** EXTERNAL_SYMBOL ::=
*** 971,977 ****
  This pragma enables the shared use of variables stored in overlaid
  linker areas corresponding to the use of @code{COMMON}
  in Fortran.  The single
! object @var{local_name} is assigned to the area designated by
  the @var{External} argument.
  You may define a record to correspond to a series
  of fields.  The @var{size} argument
--- 1002,1008 ----
  This pragma enables the shared use of variables stored in overlaid
  linker areas corresponding to the use of @code{COMMON}
  in Fortran.  The single
! object @var{local_NAME} is assigned to the area designated by
  the @var{External} argument.
  You may define a record to correspond to a series
  of fields.  The @var{size} argument
*************** Syntax:
*** 1016,1022 ****
  
  @smallexample @c ada
  pragma Complex_Representation
!         ([Entity =>] LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 1047,1053 ----
  
  @smallexample @c ada
  pragma Complex_Representation
!         ([Entity =>] local_NAME);
  @end smallexample
  
  @noindent
*************** Syntax:
*** 1040,1046 ****
  @smallexample @c ada
  pragma Component_Alignment (
       [Form =>] ALIGNMENT_CHOICE
!   [, [Name =>] type_LOCAL_NAME]);
  
  ALIGNMENT_CHOICE ::=
    Component_Size
--- 1071,1077 ----
  @smallexample @c ada
  pragma Component_Alignment (
       [Form =>] ALIGNMENT_CHOICE
!   [, [Name =>] type_local_NAME]);
  
  ALIGNMENT_CHOICE ::=
    Component_Size
*************** alignment).
*** 1087,1093 ****
  @end table
  
  @noindent
! If the @code{Name} parameter is present, @var{type_local_name} must
  refer to a local record or array type, and the specified alignment
  choice applies to the specified type.  The use of
  @code{Component_Alignment} together with a pragma @code{Pack} causes the
--- 1118,1124 ----
  @end table
  
  @noindent
! If the @code{Name} parameter is present, @var{type_local_NAME} must
  refer to a local record or array type, and the specified alignment
  choice applies to the specified type.  The use of
  @code{Component_Alignment} together with a pragma @code{Pack} causes the
*************** would be used system-wide.
*** 1151,1157 ****
  Syntax:
  
  @smallexample @c ada
! pragma CPP_Class ([Entity =>] LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 1182,1188 ----
  Syntax:
  
  @smallexample @c ada
! pragma CPP_Class ([Entity =>] local_NAME);
  @end smallexample
  
  @noindent
*************** See @ref{Interfacing to C++} for related
*** 1182,1188 ****
  Syntax:
  
  @smallexample @c ada
! pragma CPP_Constructor ([Entity =>] LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 1213,1219 ----
  Syntax:
  
  @smallexample @c ada
! pragma CPP_Constructor ([Entity =>] local_NAME);
  @end smallexample
  
  @noindent
*************** PROCEDURE_CALL_WITHOUT_SEMICOLON ::=
*** 1336,1347 ****
  The argument has the syntactic form of an expression, meeting the
  syntactic requirements for pragmas.
  
! If assertions are not enabled on the command line, this pragma has no
! effect.  If asserts are enabled, the semantics of the pragma is exactly
  equivalent to the procedure call statement corresponding to the argument
  with a terminating semicolon.  Pragmas are permitted in sequences of
  declarations, so you can use pragma @code{Debug} to intersperse calls to
! debug procedures in the middle of declarations.
  
  @node Pragma Detect_Blocking
  @unnumberedsec Pragma Detect_Blocking
--- 1367,1411 ----
  The argument has the syntactic form of an expression, meeting the
  syntactic requirements for pragmas.
  
! If debug pragmas are not enabled, this pragma has no
! effect.  If debug pragmas are enabled, the semantics of the pragma is exactly
  equivalent to the procedure call statement corresponding to the argument
  with a terminating semicolon.  Pragmas are permitted in sequences of
  declarations, so you can use pragma @code{Debug} to intersperse calls to
! debug procedures in the middle of declarations.  Debug pragmas can be
! enabled either by use of the command line switch @code{-gnata} or by use
! of the configuration pragma @code{Debug_Policy}.
! 
! 
! @node Pragma Debug_Policy
! @unnumberedsec Pragma Debug_Policy
! @findex Debug_Policy
! @noindent
! Syntax:
! 
! @smallexample @c ada
! pragma Debug_Policy (CHECK | IGNORE);
! @end smallexample
! 
! @noindent
! If the argument is @code{CHECK}, then pragma @code{DEBUG} is enabled.
! If the argument is @code{IGNORE}, then pragma @code{DEBUG} is ignored.
! This pragma overrides the effect of the @code{-gnata} switch on the
! command line.
! 
! If debug pragmas are not enabled, this pragma has no
! effect.  If debug pragmas are enabled, the semantics of the pragma is exactly
! equivalent to the procedure call statement corresponding to the argument
! with a terminating semicolon.  Pragmas are permitted in sequences of
! declarations, so you can use pragma @code{Debug} to intersperse calls to
! debug procedures in the middle of declarations.  Debug pragmas can be
! enabled either by use of the command line switch @code{-gnata} or by use
! of the configuration pragma @code{Debug_Policy}.
! 
! 
! 
! 
! 
  
  @node Pragma Detect_Blocking
  @unnumberedsec Pragma Detect_Blocking
*************** Syntax:
*** 1513,1519 ****
  
  @smallexample @c ada
  pragma Export_Exception (
!      [Internal =>] LOCAL_NAME,
    [, [External =>] EXTERNAL_SYMBOL,]
    [, [Form     =>] Ada | VMS]
    [, [Code     =>] static_integer_EXPRESSION]);
--- 1577,1583 ----
  
  @smallexample @c ada
  pragma Export_Exception (
!      [Internal =>] local_NAME,
    [, [External =>] EXTERNAL_SYMBOL,]
    [, [Form     =>] Ada | VMS]
    [, [Code     =>] static_integer_EXPRESSION]);
*************** Syntax:
*** 1542,1548 ****
  
  @smallexample @c ada
  pragma Export_Function (
!      [Internal         =>] LOCAL_NAME,
    [, [External         =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types  =>] PARAMETER_TYPES]
    [, [Result_Type      =>] result_SUBTYPE_MARK]
--- 1606,1612 ----
  
  @smallexample @c ada
  pragma Export_Function (
!      [Internal         =>] local_NAME,
    [, [External         =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types  =>] PARAMETER_TYPES]
    [, [Result_Type      =>] result_SUBTYPE_MARK]
*************** Syntax:
*** 1618,1624 ****
  
  @smallexample @c ada
  pragma Export_Object
!       [Internal =>] LOCAL_NAME,
     [, [External =>] EXTERNAL_SYMBOL]
     [, [Size     =>] EXTERNAL_SYMBOL]
  
--- 1682,1688 ----
  
  @smallexample @c ada
  pragma Export_Object
!       [Internal =>] local_NAME,
     [, [External =>] EXTERNAL_SYMBOL]
     [, [Size     =>] EXTERNAL_SYMBOL]
  
*************** Syntax:
*** 1643,1649 ****
  
  @smallexample @c ada
  pragma Export_Procedure (
!      [Internal        =>] LOCAL_NAME
    [, [External        =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types =>] PARAMETER_TYPES]
    [, [Mechanism       =>] MECHANISM]);
--- 1707,1713 ----
  
  @smallexample @c ada
  pragma Export_Procedure (
!      [Internal        =>] local_NAME
    [, [External        =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types =>] PARAMETER_TYPES]
    [, [Mechanism       =>] MECHANISM]);
*************** Syntax:
*** 1723,1729 ****
  
  @smallexample @c ada
  pragma Export_Valued_Procedure (
!      [Internal        =>] LOCAL_NAME
    [, [External        =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types =>] PARAMETER_TYPES]
    [, [Mechanism       =>] MECHANISM]);
--- 1787,1793 ----
  
  @smallexample @c ada
  pragma Export_Valued_Procedure (
!      [Internal        =>] local_NAME
    [, [External        =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types =>] PARAMETER_TYPES]
    [, [Mechanism       =>] MECHANISM]);
*************** MECHANISM_NAME ::=
*** 1755,1761 ****
  
  @noindent
  This pragma is identical to @code{Export_Procedure} except that the
! first parameter of @var{local_name}, which must be present, must be of
  mode @code{OUT}, and externally the subprogram is treated as a function
  with this parameter as the result of the function.  GNAT provides for
  this capability to allow the use of @code{OUT} and @code{IN OUT}
--- 1819,1825 ----
  
  @noindent
  This pragma is identical to @code{Export_Procedure} except that the
! first parameter of @var{local_NAME}, which must be present, must be of
  mode @code{OUT}, and externally the subprogram is treated as a function
  with this parameter as the result of the function.  GNAT provides for
  this capability to allow the use of @code{OUT} and @code{IN OUT}
*************** to enforce the upper casing of all exter
*** 1937,1943 ****
  Syntax:
  
  @smallexample @c ada
! pragma Finalize_Storage_Only (first_subtype_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 2001,2007 ----
  Syntax:
  
  @smallexample @c ada
! pragma Finalize_Storage_Only (first_subtype_local_NAME);
  @end smallexample
  
  @noindent
*************** execution, hence the name.
*** 1955,1967 ****
  Syntax:
  
  @smallexample @c ada
! pragma Float_Representation (FLOAT_REP);
  
  FLOAT_REP ::= VAX_Float | IEEE_Float
  @end smallexample
  
  @noindent
! This pragma
  allows control over the internal representation chosen for the predefined
  floating point types declared in the packages @code{Standard} and
  @code{System}. On all systems other than OpenVMS, the argument must
--- 2019,2031 ----
  Syntax:
  
  @smallexample @c ada
! pragma Float_Representation (FLOAT_REP[, float_type_LOCAL_NAME]);
  
  FLOAT_REP ::= VAX_Float | IEEE_Float
  @end smallexample
  
  @noindent
! In the one argument form, this pragma is a configuration pragma which
  allows control over the internal representation chosen for the predefined
  floating point types declared in the packages @code{Standard} and
  @code{System}. On all systems other than OpenVMS, the argument must
*************** the standard runtime libraries be recomp
*** 1972,1977 ****
--- 2036,2059 ----
  description of the @code{GNAT LIBRARY} command in the OpenVMS version
  of the GNAT Users Guide for details on the use of this command.
  
+ The two argument form specifies the representation to be used for
+ the specified floating-point type. On all systems other than OpenVMS,
+ the argument must
+ be @code{IEEE_Float} and the pragma has no effect. On OpenVMS, the
+ argument may be @code{VAX_Float} to specify the use of the VAX float
+ format, as follows:
+ 
+ @itemize @bullet
+ @item
+ For digits values up to 6, F float format will be used.
+ @item
+ For digits values from 7 to 9, G float format will be used.
+ @item
+ For digits values from 10 to 15, F float format will be used.
+ @item
+ Digits values above 15 are not allowed.
+ @end itemize
+ 
  @node Pragma Ident
  @unnumberedsec Pragma Ident
  @findex Ident
*************** Syntax:
*** 2004,2010 ****
  
  @smallexample @c ada
  pragma Import_Exception (
!      [Internal =>] LOCAL_NAME,
    [, [External =>] EXTERNAL_SYMBOL,]
    [, [Form     =>] Ada | VMS]
    [, [Code     =>] static_integer_EXPRESSION]);
--- 2086,2092 ----
  
  @smallexample @c ada
  pragma Import_Exception (
!      [Internal =>] local_NAME,
    [, [External =>] EXTERNAL_SYMBOL,]
    [, [Form     =>] Ada | VMS]
    [, [Code     =>] static_integer_EXPRESSION]);
*************** Syntax:
*** 2031,2037 ****
  
  @smallexample @c ada
  pragma Import_Function (
!      [Internal                 =>] LOCAL_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Result_Type              =>] SUBTYPE_MARK]
--- 2113,2119 ----
  
  @smallexample @c ada
  pragma Import_Function (
!      [Internal                 =>] local_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Result_Type              =>] SUBTYPE_MARK]
*************** Syntax:
*** 2113,2119 ****
  
  @smallexample @c ada
  pragma Import_Object
!      [Internal =>] LOCAL_NAME,
    [, [External =>] EXTERNAL_SYMBOL],
    [, [Size     =>] EXTERNAL_SYMBOL]);
  
--- 2195,2201 ----
  
  @smallexample @c ada
  pragma Import_Object
!      [Internal =>] local_NAME,
    [, [External =>] EXTERNAL_SYMBOL],
    [, [Size     =>] EXTERNAL_SYMBOL]);
  
*************** Syntax:
*** 2139,2145 ****
  
  @smallexample @c ada
  pragma Import_Procedure (
!      [Internal                 =>] LOCAL_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Mechanism                =>] MECHANISM]
--- 2221,2227 ----
  
  @smallexample @c ada
  pragma Import_Procedure (
!      [Internal                 =>] local_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Mechanism                =>] MECHANISM]
*************** Syntax:
*** 2185,2191 ****
  
  @smallexample @c ada
  pragma Import_Valued_Procedure (
!      [Internal                 =>] LOCAL_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Mechanism                =>] MECHANISM]
--- 2267,2273 ----
  
  @smallexample @c ada
  pragma Import_Valued_Procedure (
!      [Internal                 =>] local_NAME,
    [, [External                 =>] EXTERNAL_SYMBOL]
    [, [Parameter_Types          =>] PARAMETER_TYPES]
    [, [Mechanism                =>] MECHANISM]
*************** CLASS_NAME ::= ubs | ubsb | uba | s | sb
*** 2220,2226 ****
  
  @noindent
  This pragma is identical to @code{Import_Procedure} except that the
! first parameter of @var{local_name}, which must be present, must be of
  mode @code{OUT}, and externally the subprogram is treated as a function
  with this parameter as the result of the function.  The purpose of this
  capability is to allow the use of @code{OUT} and @code{IN OUT}
--- 2302,2308 ----
  
  @noindent
  This pragma is identical to @code{Import_Procedure} except that the
! first parameter of @var{local_NAME}, which must be present, must be of
  mode @code{OUT}, and externally the subprogram is treated as a function
  with this parameter as the result of the function.  The purpose of this
  capability is to allow the use of @code{OUT} and @code{IN OUT}
*************** Syntax:
*** 2336,2342 ****
  @smallexample @c ada
  pragma Interface (
       [Convention    =>] convention_identifier,
!      [Entity =>] local_name
    [, [External_Name =>] static_string_expression],
    [, [Link_Name     =>] static_string_expression]);
  @end smallexample
--- 2418,2424 ----
  @smallexample @c ada
  pragma Interface (
       [Convention    =>] convention_identifier,
!      [Entity =>] local_NAME
    [, [External_Name =>] static_string_expression],
    [, [Link_Name     =>] static_string_expression]);
  @end smallexample
*************** Syntax:
*** 2357,2363 ****
  
  @smallexample @c ada
  pragma Interface_Name (
!      [Entity        =>] LOCAL_NAME
    [, [External_Name =>] static_string_EXPRESSION]
    [, [Link_Name     =>] static_string_EXPRESSION]);
  @end smallexample
--- 2439,2445 ----
  
  @smallexample @c ada
  pragma Interface_Name (
!      [Entity        =>] local_NAME
    [, [External_Name =>] static_string_EXPRESSION]
    [, [Link_Name     =>] static_string_EXPRESSION]);
  @end smallexample
*************** least one of @var{External_Name} or @var
*** 2375,2381 ****
  Syntax:
  
  @smallexample @c ada
! pragma Interrupt_Handler (procedure_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 2457,2463 ----
  Syntax:
  
  @smallexample @c ada
! pragma Interrupt_Handler (procedure_local_NAME);
  @end smallexample
  
  @noindent
*************** and in the case of the signal used to im
*** 2471,2481 ****
  Syntax:
  
  @smallexample @c ada
! pragma Keep_Names ([On =>] enumeration_first_subtype_LOCAL_NAME);
  @end smallexample
  
  @noindent
! The @var{LOCAL_NAME} argument
  must refer to an enumeration first subtype
  in the current declarative part. The effect is to retain the enumeration
  literal names for use by @code{Image} and @code{Value} even if a global
--- 2553,2563 ----
  Syntax:
  
  @smallexample @c ada
! pragma Keep_Names ([On =>] enumeration_first_subtype_local_NAME);
  @end smallexample
  
  @noindent
! The @var{local_NAME} argument
  must refer to an enumeration first subtype
  in the current declarative part. The effect is to retain the enumeration
  literal names for use by @code{Image} and @code{Value} even if a global
*************** therefore cannot be @code{with}'ed by a 
*** 2516,2523 ****
  This is used for a unit licensed under the GNAT modified GPL that includes
  a special exception paragraph that specifically permits the inclusion of
  the unit in programs without requiring the entire program to be released
! under the GPL@.  This is the license used for the GNAT run-time which ensures
! that the run-time can be used freely in any program without GPL concerns.
  
  @item Restricted
  This is used for a unit that is restricted in that it is not permitted to
--- 2598,2604 ----
  This is used for a unit licensed under the GNAT modified GPL that includes
  a special exception paragraph that specifically permits the inclusion of
  the unit in programs without requiring the entire program to be released
! under the GPL@.
  
  @item Restricted
  This is used for a unit that is restricted in that it is not permitted to
*************** Syntax:
*** 2614,2626 ****
  
  @smallexample @c ada
  pragma Linker_Alias (
!   [Entity =>] LOCAL_NAME
!   [Alias  =>] static_string_EXPRESSION);
  @end smallexample
  
  @noindent
! This pragma establishes a linker alias for the given named entity.  For
! further details on the exact effect, consult the GCC manual.
  
  @node Pragma Linker_Section
  @unnumberedsec Pragma Linker_Section
--- 2695,2785 ----
  
  @smallexample @c ada
  pragma Linker_Alias (
!   [Entity =>] local_NAME
!   [Target =>] static_string_EXPRESSION);
  @end smallexample
  
  @noindent
! @var{local_NAME} must refer to an object that is declared at the library
! level. This pragma establishes the given entity as a linker alias for the
! given target. It is equivalent to @code{__attribute__((alias))} in GNU C
! and causes @var{local_NAME} to be emitted as an alias for the symbol
! @var{static_string_EXPRESSION} in the object file, that is to say no space
! is reserved for @var{local_NAME} by the assembler and it will be resolved
! to the same address as @var{static_string_EXPRESSION} by the linker.
! 
! The actual linker name for the target must be used (e.g. the fully
! encoded name with qualification in Ada, or the mangled name in C++),
! or it must be declared using the C convention with @code{pragma Import}
! or @code{pragma Export}.
! 
! Not all target machines support this pragma. On some of them it is accepted
! only if @code{pragma Weak_External} has been applied to @var{local_NAME}.
! 
! @smallexample @c ada
! --  Example of the use of pragma Linker_Alias
! 
! package p is
!   i : Integer := 1;
!   pragma Export (C, i);
! 
!   new_name_for_i : Integer;
!   pragma Linker_Alias (new_name_for_i, "i");
! end p;
! @end smallexample
! 
! @node Pragma Linker_Constructor
! @unnumberedsec Pragma Linker_Constructor
! @findex Linker_Constructor
! @noindent
! Syntax:
! 
! @smallexample @c ada
! pragma Linker_Constructor (procedure_LOCAL_NAME);
! @end smallexample
! 
! @noindent
! @var{procedure_local_NAME} must refer to a parameterless procedure that
! is declared at the library level. A procedure to which this pragma is
! applied will be treated as an initialization routine by the linker.
! It is equivalent to @code{__attribute__((constructor))} in GNU C and
! causes @var{procedure_LOCAL_NAME} to be invoked before the entry point
! of the executable is called (or immediately after the shared library is
! loaded if the procedure is linked in a shared library), in particular
! before the Ada run-time environment is set up.
! 
! Because of these specific contexts, the set of operations such a procedure
! can perform is very limited and the type of objects it can manipulate is
! essentially restricted to the elementary types. In particular, it must only
! contain code to which pragma Restrictions (No_Elaboration_Code) applies.
! 
! This pragma is used by GNAT to implement auto-initialization of shared Stand
! Alone Libraries, which provides a related capability without the restrictions
! listed above. Where possible, the use of Stand Alone Libraries is preferable
! to the use of this pragma.
! 
! @node Pragma Linker_Destructor
! @unnumberedsec Pragma Linker_Destructor
! @findex Linker_Destructor
! @noindent
! Syntax:
! 
! @smallexample @c ada
! pragma Linker_Destructor (procedure_LOCAL_NAME);
! @end smallexample
! 
! @noindent
! @var{procedure_local_NAME} must refer to a parameterless procedure that
! is declared at the library level. A procedure to which this pragma is
! applied will be treated as a finalization routine by the linker.
! It is equivalent to @code{__attribute__((destructor))} in GNU C and
! causes @var{procedure_LOCAL_NAME} to be invoked after the entry point
! of the executable has exited (or immediately before the shared library
! is unloaded if the procedure is linked in a shared library), in particular
! after the Ada run-time environment is shut down.
! 
! See @code{pragma Linker_Constructor} for the set of restrictions that apply
! because of these specific contexts.
  
  @node Pragma Linker_Section
  @unnumberedsec Pragma Linker_Section
*************** Syntax:
*** 2630,2642 ****
  
  @smallexample @c ada
  pragma Linker_Section (
!   [Entity  =>] LOCAL_NAME
    [Section =>] static_string_EXPRESSION);
  @end smallexample
  
  @noindent
! This pragma specifies the name of the linker section for the given entity.
! For further details on the exact effect, consult the GCC manual.
  
  @node Pragma Long_Float
  @unnumberedsec Pragma Long_Float
--- 2789,2834 ----
  
  @smallexample @c ada
  pragma Linker_Section (
!   [Entity  =>] local_NAME
    [Section =>] static_string_EXPRESSION);
  @end smallexample
  
  @noindent
! @var{local_NAME} must refer to an object that is declared at the library
! level. This pragma specifies the name of the linker section for the given
! entity. It is equivalent to @code{__attribute__((section))} in GNU C and
! causes @var{local_NAME} to be placed in the @var{static_string_EXPRESSION}
! section of the executable (assuming the linker doesn't rename the section).
! 
! The compiler normally places library-level objects in standard sections
! depending on their type: procedures and functions generally go in the
! @code{.text} section, initialized variables in the @code{.data} section
! and uninitialized variables in the @code{.bss} section.
! 
! Other, special sections may exist on given target machines to map special
! hardware, for example I/O ports or flash memory. This pragma is a means to
! defer the final layout of the executable to the linker, thus fully working
! at the symbolic level with the compiler.
! 
! Some file formats do not support arbitrary sections so not all target
! machines support this pragma. The use of this pragma may cause a program
! execution to be erroneous if it is used to place an entity into an
! inappropriate section (e.g. a modified variable into the @code{.text}
! section). See also @code{pragma Persistent_BSS}.
! 
! @smallexample @c ada
! --  Example of the use of pragma Linker_Section
! 
! package IO_Card is
!   Port_A : Integer;
!   pragma Volatile (Port_A);
!   pragma Linker_Section (Port_A, ".bss.port_a");
! 
!   Port_B : Integer;
!   pragma Volatile (Port_B);
!   pragma Linker_Section (Port_B, ".bss.port_b");
! end IO_Card;
! @end smallexample
  
  @node Pragma Long_Float
  @unnumberedsec Pragma Long_Float
*************** Syntax:
*** 2671,2689 ****
  @smallexample @c ada
  pragma Machine_Attribute (
    [Attribute_Name =>] string_EXPRESSION,
!   [Entity         =>] LOCAL_NAME);
  @end smallexample
  
  @noindent
! Machine dependent attributes can be specified for types and/or
! declarations.  Currently only subprogram entities are supported.  This
! pragma is semantically equivalent to
  @code{__attribute__((@var{string_expression}))} in GNU C,
  where @code{@var{string_expression}} is
! recognized by the GNU C macros @code{VALID_MACHINE_TYPE_ATTRIBUTE} and
! @code{VALID_MACHINE_DECL_ATTRIBUTE} which are defined in the
! configuration header file @file{tm.h} for each machine.  See the GCC
! manual for further information.
  
  @node Pragma Main_Storage
  @unnumberedsec Pragma Main_Storage
--- 2863,2880 ----
  @smallexample @c ada
  pragma Machine_Attribute (
    [Attribute_Name =>] string_EXPRESSION,
!   [Entity         =>] local_NAME);
  @end smallexample
  
  @noindent
! Machine-dependent attributes can be specified for types and/or
! declarations.  This pragma is semantically equivalent to
  @code{__attribute__((@var{string_expression}))} in GNU C,
  where @code{@var{string_expression}} is
! recognized by the target macro @code{TARGET_ATTRIBUTE_TABLE} which is
! defined for each machine.  See the GCC manual for further information.
! It is not possible to specify attributes defined by other languages,
! only attributes defined by the machine the code is intended to run on.
  
  @node Pragma Main_Storage
  @unnumberedsec Pragma Main_Storage
*************** also has no effect in DEC Ada 83 for Ope
*** 2714,2720 ****
  Syntax:
  
  @smallexample @c ada
! pragma No_Return (procedure_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 2905,2911 ----
  Syntax:
  
  @smallexample @c ada
! pragma No_Return (procedure_local_NAME);
  @end smallexample
  
  @noindent
*************** Another use of this pragma is to suppres
*** 2729,2734 ****
--- 2920,2945 ----
  missing returns in functions, where the last statement of a function
  statement sequence is a call to such a procedure.
  
+ @node Pragma No_Strict_Aliasing
+ @unnumberedsec Pragma No_Strict_Aliasing
+ @findex No_Strict_Aliasing
+ @noindent
+ Syntax:
+ 
+ @smallexample @c ada
+ pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)];
+ @end smallexample
+ 
+ @noindent
+ @var{type_LOCAL_NAME} must refer to an access type
+ declaration in the current declarative part.  The effect is to inhibit
+ strict aliasing optimization for the given type.  The form with no
+ arguments is a configuration pragma which applies to all access types
+ declared in units to which the pragma applies. For a detailed
+ description of the strict aliasing optimization, and the situations
+ in which it must be suppressed, see section
+ ``Optimization and Strict Aliasing'' in the @value{EDITION} User's Guide.
+ 
  @node Pragma Normalize_Scalars
  @unnumberedsec Pragma Normalize_Scalars
  @findex Normalize_Scalars
*************** will always generate an invalid value if
*** 2813,2833 ****
  Syntax:
  
  @smallexample @c ada
! pragma Obsolescent [(static_string_EXPRESSION)];
  @end smallexample
  
  @noindent
! This pragma must occur immediately following a subprogram
! declaration. It indicates that the associated function or procedure
  is considered obsolescent and should not be used. Typically this is
  used when an API must be modified by eventually removing or modifying
  existing subprograms. The pragma can be used at an intermediate stage
  when the subprogram is still present, but will be removed later.
  
! The effect of this pragma is to output a warning message that the
  subprogram is obsolescent if the appropriate warning option in the
  compiler is activated. If a parameter is present, then a second
  warning message is given containing this text.
  
  @node Pragma Passive
  @unnumberedsec Pragma Passive
--- 3024,3061 ----
  Syntax:
  
  @smallexample @c ada
! pragma Obsolescent [(static_string_EXPRESSION [,Ada_05])];
  @end smallexample
  
  @noindent
! This pragma can occur immediately following a subprogram
! declaration and indicates that the associated function or procedure
  is considered obsolescent and should not be used. Typically this is
  used when an API must be modified by eventually removing or modifying
  existing subprograms. The pragma can be used at an intermediate stage
  when the subprogram is still present, but will be removed later.
  
! The effect of this pragma is to output a warning message on
! a call to a program thus marked that the
  subprogram is obsolescent if the appropriate warning option in the
  compiler is activated. If a parameter is present, then a second
  warning message is given containing this text.
+ In addition, a call to such a program is considered a violation of
+ pragma Restrictions (No_Obsolescent_Features).
+ 
+ This pragma can also be used as a program unit pragma for a package,
+ in which case it indicates that the entire package is considered
+ obsolescent. In this case a client @code{with}'ing such a package
+ violates the restriction, and the @code{with} statement is
+ flagged with warnings if the warning option is set.
+ 
+ If the optional second parameter is present (which must be exactly
+ the identifier Ada_05, no other argument is allowed), then the
+ indication of obsolescence applies only when compiling in Ada 2005
+ mode. This is primarily intended for dealing with the situations
+ in the predefined library where subprograms or packages
+ have become defined as obsolescent in Ada 2005
+ (e.g. in Ada.Characters.Handling), but may be used anywhere.
  
  @node Pragma Passive
  @unnumberedsec Pragma Passive
*************** desired.  If the argument @code{No} is p
*** 2850,2855 ****
--- 3078,3114 ----
  optimized.  GNAT does not attempt to optimize any tasks in this manner
  (since protected objects are available in place of passive tasks).
  
+ @node Pragma Persistent_BSS
+ @unnumberedsec Pragma Persistent_BSS
+ @findex Persistent_BSS
+ @noindent
+ Syntax:
+ 
+ @smallexample @c ada
+ pragma Persistent_BSS [local_NAME]
+ @end smallexample
+ 
+ @noindent
+ This pragma allows selected objects to be placed in the @code{.persistent_bss}
+ section. On some targets the linker and loader provide for special
+ treatment of this section, allowing a program to be reloaded without
+ affecting the contents of this data (hence the name persistent).
+ 
+ There are two forms of usage. If an argument is given, it must be the
+ local name of a library level object, with no explicit initialization
+ and whose type is potentially persistent. If no argument is given, then
+ the pragma is a configuration pragma, and applies to all library level
+ objects with no explicit initialization of potentially persistent types.
+ 
+ A potentially persistent type is a scalar type, or a non-tagged,
+ non-discriminated record, all of whose components have no explicit
+ initialization and are themselves of a potentially persistent type,
+ or an array, all of whose constraints are static, and whose component
+ type is potentially persistent.
+ 
+ If this pragma is used on a target where this feature is not supported,
+ then the pragma will be ignored. See also @code{pragma Linker_Section}.
+ 
  @node Pragma Polling
  @unnumberedsec Pragma Polling
  @findex Polling
*************** limited set of tasking functionality per
*** 3078,3084 ****
  Syntax:
  
  @smallexample @c ada
! pragma Propagate_Exceptions (subprogram_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 3337,3343 ----
  Syntax:
  
  @smallexample @c ada
! pragma Propagate_Exceptions (subprogram_local_NAME);
  @end smallexample
  
  @noindent
*************** Syntax:
*** 3118,3124 ****
  
  @smallexample @c ada
  pragma Psect_Object (
!      [Internal =>] LOCAL_NAME,
    [, [External =>] EXTERNAL_SYMBOL]
    [, [Size     =>] EXTERNAL_SYMBOL]);
  
--- 3377,3383 ----
  
  @smallexample @c ada
  pragma Psect_Object (
!      [Internal =>] local_NAME,
    [, [External =>] EXTERNAL_SYMBOL]
    [, [Size     =>] EXTERNAL_SYMBOL]);
  
*************** This pragma is identical in effect to pr
*** 3137,3143 ****
  Syntax:
  
  @smallexample @c ada
! pragma Pure_Function ([Entity =>] function_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 3396,3402 ----
  Syntax:
  
  @smallexample @c ada
! pragma Pure_Function ([Entity =>] function_local_NAME);
  @end smallexample
  
  @noindent
*************** Syntax:
*** 3311,3317 ****
  
  @smallexample @c ada
  pragma Stream_Convert (
!   [Entity =>] type_LOCAL_NAME,
    [Read   =>] function_NAME,
    [Write  =>] function_NAME);
  @end smallexample
--- 3570,3576 ----
  
  @smallexample @c ada
  pragma Stream_Convert (
!   [Entity =>] type_local_NAME,
    [Read   =>] function_NAME,
    [Write  =>] function_NAME);
  @end smallexample
*************** Syntax:
*** 3385,3391 ****
  
  @smallexample @c ada
  pragma Style_Checks (string_LITERAL | ALL_CHECKS |
!                      On | Off [, LOCAL_NAME]);
  @end smallexample
  
  @noindent
--- 3644,3650 ----
  
  @smallexample @c ada
  pragma Style_Checks (string_LITERAL | ALL_CHECKS |
!                      On | Off [, local_NAME]);
  @end smallexample
  
  @noindent
*************** Syntax:
*** 3606,3612 ****
  
  @smallexample @c ada
  pragma Task_Storage (
!   [Task_Type =>] LOCAL_NAME,
    [Top_Guard =>] static_integer_EXPRESSION);
  @end smallexample
  
--- 3865,3871 ----
  
  @smallexample @c ada
  pragma Task_Storage (
!   [Task_Type =>] local_NAME,
    [Top_Guard =>] static_integer_EXPRESSION);
  @end smallexample
  
*************** Syntax:
*** 3625,3631 ****
  
  @smallexample @c ada
  pragma Thread_Body (
!   [Entity =>] LOCAL_NAME,
   [[Secondary_Stack_Size =>] static_integer_EXPRESSION)];
  @end smallexample
  
--- 3884,3890 ----
  
  @smallexample @c ada
  pragma Thread_Body (
!   [Entity =>] local_NAME,
   [[Secondary_Stack_Size =>] static_integer_EXPRESSION)];
  @end smallexample
  
*************** following the normal rules for procedure
*** 3710,3716 ****
  Syntax:
  
  @smallexample @c ada
! pragma Unchecked_Union (first_subtype_LOCAL_NAME);
  @end smallexample
  
  @noindent
--- 3969,3975 ----
  Syntax:
  
  @smallexample @c ada
! pragma Unchecked_Union (first_subtype_local_NAME);
  @end smallexample
  
  @noindent
*************** compilations of units where universal ad
*** 3825,3831 ****
  Syntax:
  
  @smallexample @c ada
! pragma Unreferenced (local_Name @{, local_Name@});
  @end smallexample
  
  @noindent
--- 4084,4090 ----
  Syntax:
  
  @smallexample @c ada
! pragma Unreferenced (local_NAME @{, local_NAME@});
  @end smallexample
  
  @noindent
*************** and that this is deliberate. It can also
*** 3843,3849 ****
  objects declared only for their initialization or finalization side
  effects.
  
! If @code{local_Name} identifies more than one matching homonym in the
  current scope, then the entity most recently declared is the one to which
  the pragma applies.
  
--- 4102,4108 ----
  objects declared only for their initialization or finalization side
  effects.
  
! If @code{local_NAME} identifies more than one matching homonym in the
  current scope, then the entity most recently declared is the one to which
  the pragma applies.
  
*************** The left hand side of an assignment does
*** 3851,3856 ****
--- 4110,4121 ----
  purpose of this pragma. Thus it is fine to assign to an entity for which
  pragma Unreferenced is given.
  
+ Note that if a warning is desired for all calls to a given subprogram,
+ regardless of whether they occur in the same unit as the subprogram
+ declaration, then this pragma should not be used (calls from another
+ unit would not be flagged); pragma Obsolescent can be used instead
+ for this purpose, see @xref{Pragma Obsolescent}.
+ 
  @node Pragma Unreserve_All_Interrupts
  @unnumberedsec Pragma Unreserve_All_Interrupts
  @findex Unreserve_All_Interrupts
*************** Dec Ada 83.
*** 4013,4019 ****
  Syntax:
  
  @smallexample @c ada
! pragma Warnings (On | Off [, LOCAL_NAME]);
  @end smallexample
  
  @noindent
--- 4278,4285 ----
  Syntax:
  
  @smallexample @c ada
! pragma Warnings (On | Off [, local_NAME]);
! pragma Warnings (static_string_EXPRESSION);
  @end smallexample
  
  @noindent
*************** setting of the command line switches.
*** 4026,4036 ****
  
  The form with a single argument is a configuration pragma.
  
! If the @var{local_name} parameter is present, warnings are suppressed for
  the specified entity.  This suppression is effective from the point where
  it occurs till the end of the extended scope of the variable (similar to
  the scope of @code{Suppress}).
  
  @node Pragma Weak_External
  @unnumberedsec Pragma Weak_External
  @findex Weak_External
--- 4292,4362 ----
  
  The form with a single argument is a configuration pragma.
  
! If the @var{local_NAME} parameter is present, warnings are suppressed for
  the specified entity.  This suppression is effective from the point where
  it occurs till the end of the extended scope of the variable (similar to
  the scope of @code{Suppress}).
  
+ The form with a static_string_EXPRESSION argument provides more precise
+ control over which warnings are active. The string is a list of letters
+ specifying which warnings are to be activated and which deactivated. The
+ code for these letters is the same as the string used in the command
+ line switch controlling warnings. The following is a brief summary. For
+ full details see the GNAT Users Guide:
+ 
+ @smallexample
+ a   turn on all optional warnings (except d,h,l)
+ A   turn off all optional warnings
+ b   turn on warnings for bad fixed value (not multiple of small)
+ B   turn off warnings for bad fixed value (not multiple of small)
+ c   turn on warnings for constant conditional
+ C   turn off warnings for constant conditional
+ d   turn on warnings for implicit dereference
+ D   turn off warnings for implicit dereference
+ e   treat all warnings as errors
+ f   turn on warnings for unreferenced formal
+ F   turn off warnings for unreferenced formal
+ g   turn on warnings for unrecognized pragma
+ G   turn off warnings for unrecognized pragma
+ h   turn on warnings for hiding variable
+ H   turn off warnings for hiding variable
+ i   turn on warnings for implementation unit
+ I   turn off warnings for implementation unit
+ j   turn on warnings for obsolescent (annex J) feature
+ J   turn off warnings for obsolescent (annex J) feature
+ k   turn on warnings on constant variable
+ K   turn off warnings on constant variable
+ l   turn on warnings for missing elaboration pragma
+ L   turn off warnings for missing elaboration pragma
+ m   turn on warnings for variable assigned but not read
+ M   turn off warnings for variable assigned but not read
+ n   normal warning mode (cancels s/e)
+ o   turn on warnings for address clause overlay
+ O   turn off warnings for address clause overlay
+ p   turn on warnings for ineffective pragma Inline
+ P   turn off warnings for ineffective pragma Inline
+ r   turn on warnings for redundant construct
+ R   turn off warnings for redundant construct
+ s   suppress all warnings
+ u   turn on warnings for unused entity
+ U   turn off warnings for unused entity
+ v   turn on warnings for unassigned variable
+ V   turn off warnings for unassigned variable
+ x   turn on warnings for export/import
+ X   turn off warnings for export/import
+ y   turn on warnings for Ada 2005 incompatibility
+ Y   turn off warnings for Ada 2005 incompatibility
+ z   turn on size/align warnings for unchecked conversion
+ Z   turn off size/align warnings for unchecked conversion
+ @end smallexample
+ 
+ @noindent
+ The specified warnings will be in effect until the end of the program
+ or another pragma Warnings is encountered. The effect of the pragma is
+ cumulative. Initially the set of warnings is the standard default set
+ as possibly modified by compiler switches. Then each pragma Warning
+ modifies this set of warnings as specified.
+ 
  @node Pragma Weak_External
  @unnumberedsec Pragma Weak_External
  @findex Weak_External
*************** the scope of @code{Suppress}).
*** 4038,4050 ****
  Syntax:
  
  @smallexample @c ada
! pragma Weak_External ([Entity =>] LOCAL_NAME);
  @end smallexample
  
  @noindent
! This pragma specifies that the given entity should be marked as a weak
! external (one that does not have to be resolved) for the linker.  For
! further details, consult the GCC manual.
  
  @node Implementation Defined Attributes
  @chapter Implementation Defined Attributes
--- 4364,4412 ----
  Syntax:
  
  @smallexample @c ada
! pragma Weak_External ([Entity =>] local_NAME);
  @end smallexample
  
  @noindent
! @var{local_NAME} must refer to an object that is declared at the library
! level. This pragma specifies that the given entity should be marked as a
! weak symbol for the linker. It is equivalent to @code{__attribute__((weak))}
! in GNU C and causes @var{local_NAME} to be emitted as a weak symbol instead
! of a regular symbol, that is to say a symbol that does not have to be
! resolved by the linker if used in conjunction with a pragma Import.
! 
! When a weak symbol is not resolved by the linker, its address is set to
! zero. This is useful in writing interfaces to external modules that may
! or may not be linked in the final executable, for example depending on
! configuration settings.
! 
! If a program references at run time an entity to which this pragma has been
! applied, and the corresponding symbol was not resolved at link time, then
! the execution of the program is erroneous. It is not erroneous to take the
! Address of such an entity, for example to guard potential references,
! as shown in the example below.
! 
! Some file formats do not support weak symbols so not all target machines
! support this pragma.
! 
! @smallexample @c ada
! --  Example of the use of pragma Weak_External
! 
! package External_Module is
!   key : Integer;
!   pragma Import (C, key);
!   pragma Weak_External (key);
!   function Present return boolean;
! end External_Module;
! 
! with System; use System;
! package body External_Module is
!   function Present return boolean is
!   begin
!     return key'Address /= System.Null_Address;
!   end Present;
! end External_Module;
! @end smallexample
  
  @node Implementation Defined Attributes
  @chapter Implementation Defined Attributes
*************** subprogram yields a value that can be ca
*** 4798,4804 ****
  is in scope (normal Ada 95 accessibility rules restrict this usage).
  
  It is possible to use @code{Unrestricted_Access} for any type, but care
! must be excercised if it is used to create pointers to unconstrained
  objects. In this case, the resulting pointer has the same scope as the
  context of the attribute, and may not be returned to some enclosing
  scope. For instance, a function cannot use @code{Unrestricted_Access}
--- 5160,5166 ----
  is in scope (normal Ada 95 accessibility rules restrict this usage).
  
  It is possible to use @code{Unrestricted_Access} for any type, but care
! must be exercised if it is used to create pointers to unconstrained
  objects. In this case, the resulting pointer has the same scope as the
  context of the attribute, and may not be returned to some enclosing
  scope. For instance, a function cannot use @code{Unrestricted_Access}
*************** representation item for a given entity i
*** 5136,5159 ****
  the representation item is a name that statically denotes a constant
  declared before the entity.
  @end cartouche
! Followed.  GNAT does not support non-static expressions in representation
! clauses unless they are constants declared before the entity.  For
! example:
  
  @smallexample @c ada
! X : Some_Type;
! for X'Address use To_address (16#2000#);
  @end smallexample
  
- @noindent
- will be rejected, since the To_Address expression is non-static.  Instead
- write:
- 
- @smallexample @c ada
- X_Address : constant Address : = To_Address (16#2000#);
- X         : Some_Type;
- for X'Address use X_Address;
- @end smallexample
  
  @sp 1
  @cartouche
--- 5498,5515 ----
  the representation item is a name that statically denotes a constant
  declared before the entity.
  @end cartouche
! Followed.  In fact, GNAT goes beyond the recommended level of support
! by allowing nonstatic expressions in some representation clauses even
! without the need to declare constants initialized with the values of
! such expressions.
! For example:
  
  @smallexample @c ada
!   X : Integer;
!   Y : Float;
!   for Y'Address use X'Address;>>
  @end smallexample
  
  
  @sp 1
  @cartouche
*************** but for which no elaboration code is gen
*** 7186,7195 ****
  the case that preelaborable units will meet the restrictions, with
  the exception of large aggregates initialized with an others_clause,
  and exception declarations (which generate calls to a run-time
! registry procedure).  Note that this restriction is enforced on
  a unit by unit basis, it need not be obeyed consistently
  throughout a partition.
  
  @item No_Entry_Queue
  @findex No_Entry_Queue
  This restriction is a declaration that any protected entry compiled in
--- 7542,7569 ----
  the case that preelaborable units will meet the restrictions, with
  the exception of large aggregates initialized with an others_clause,
  and exception declarations (which generate calls to a run-time
! registry procedure).  This restriction is enforced on
  a unit by unit basis, it need not be obeyed consistently
  throughout a partition.
  
+ It is not possible to precisely document
+ the constructs which are compatible with this restriction, since,
+ unlike most other restrictions, this is not a restriction on the
+ source code, but a restriction on the generated object code. For
+ example, if the source contains a declaration:
+ 
+ @smallexample
+    Val : constant Integer := X;
+ @end smallexample
+ 
+ @noindent
+ where X is not a static constant, it may be possible, depending
+ on complex optimization circuitry, for the compiler to figure
+ out the value of X at compile time, in which case this initialization
+ can be done by the loader, and requires no initialization code. It
+ is not possible to document the precise conditions under which the
+ optimizer can figure this out.
+ 
  @item No_Entry_Queue
  @findex No_Entry_Queue
  This restriction is a declaration that any protected entry compiled in
*************** overflow situations, when the @code{Mach
*** 7982,7990 ****
  result type is @code{False}.  See G.2.1(13).
  @end cartouche
  @noindent
! Infinite and Nan values are produced as dictated by the IEEE
  floating-point standard.
  
  @sp 1
  @cartouche
  @noindent
--- 8356,8370 ----
  result type is @code{False}.  See G.2.1(13).
  @end cartouche
  @noindent
! Infinite and NaN values are produced as dictated by the IEEE
  floating-point standard.
  
+ Note that on machines that are not fully compliant with the IEEE
+ floating-point standard, such as Alpha, the @option{-mieee} compiler flag
+ must be used for achieving IEEE confirming behavior (although at the cost
+ of a significant performance penalty), so infinite and NaN values are
+ properly generated.
+ 
  @sp 1
  @cartouche
  @noindent
*************** Only @code{Size} may be specified for su
*** 8953,8959 ****
  @cindex Component_Size Clause
  
  @noindent
! Normally, the value specified in a component clause must be consistent
  with the subtype of the array component with regard to size and alignment.
  In other words, the value specified must be at least equal to the size
  of this subtype, and must be a multiple of the alignment value.
--- 9333,9339 ----
  @cindex Component_Size Clause
  
  @noindent
! Normally, the value specified in a component size clause must be consistent
  with the subtype of the array component with regard to size and alignment.
  In other words, the value specified must be at least equal to the size
  of this subtype, and must be a multiple of the alignment value.
*************** then the resulting array has a length of
*** 8975,8980 ****
--- 9355,9364 ----
  Of course access to the components of such an array is considerably
  less efficient than if the natural component size of 32 is used.
  
+ Note that there is no point in giving both a component size clause
+ and a pragma Pack for the same array type. if such duplicate
+ clauses are given, the pragma Pack will be ignored.
+ 
  @node Bit_Order Clauses
  @section Bit_Order Clauses
  @cindex Bit_Order Clause
*************** thus the same lack of restriction applie
*** 9553,9567 ****
  then a component clause for a component of type R may start on any
  specified bit boundary, and may specify a value of 49 bits or greater.
  
! Packed bit arrays that are longer than 64 bits must always be placed
! on a storage unit (byte) boundary. Any component clause that does not
  meet this requirement will be rejected.
  
! The rules for other types are different for GNAT 3 and GNAT 5 versions
! (based on GCC 2 and GCC 3 respectively). In GNAT 5, larger components
! (other than packed arrays)
! may also be placed on arbitrary boundaries, so for example, the following
! is permitted:
  
  @smallexample @c ada
     type R is array (1 .. 10) of Boolean;
--- 9937,9970 ----
  then a component clause for a component of type R may start on any
  specified bit boundary, and may specify a value of 49 bits or greater.
  
! For packed bit arrays that are longer than 64 bits, there are two
! cases. If the component size is a power of 2 (1,2,4,8,16,32 bits),
! including the important case of single bits or boolean values, then
! there are no limitations on placement of such components, and they
! may start and end at arbitrary bit boundaries.
! 
! If the component size is not a power of 2 (e.g. 3 or 5), then
! an array of this type longer than 64 bits must always be placed on
! on a storage unit (byte) boundary and occupy an integral number
! of storage units (bytes). Any component clause that does not
  meet this requirement will be rejected.
  
! Any aliased component, or component of an aliased type, must
! have its normal alignment and size. A component clause that
! does not meet this requirement will be rejected.
! 
! The tag field of a tagged type always occupies an address sized field at
! the start of the record.  No component clause may attempt to overlay this
! tag. When a tagged type appears as a component, the tag field must have
! proper alignment
! 
! In the case of a record extension T1, of a type T, no component clause applied
! to the type T1 can specify a storage location that would overlap the first
! T'Size bytes of the record.
! 
! For all other component types, including non-bit-packed arrays,
! the component can be placed at an arbitrary bit boundary,
! so for example, the following is permitted:
  
  @smallexample @c ada
     type R is array (1 .. 10) of Boolean;
*************** is permitted:
*** 9581,9603 ****
  @end smallexample
  
  @noindent
  In GNAT 3, there are more severe restrictions on larger components.
  For non-primitive types, including packed arrays with a size greater than
  64 bits, component clauses must respect the alignment requirement of the
  type, in particular, always starting on a byte boundary, and the length
  must be a multiple of the storage unit.
  
- The following rules regarding tagged types are enforced in both GNAT 3 and
- GNAT 5:
- 
- The tag field of a tagged type always occupies an address sized field at
- the start of the record.  No component clause may attempt to overlay this
- tag.
- 
- In the case of a record extension T1, of a type T, no component clause applied
- to the type T1 can specify a storage location that would overlap the first
- T'Size bytes of the record.
- 
  @node Enumeration Clauses
  @section Enumeration Clauses
  
--- 9984,9996 ----
  @end smallexample
  
  @noindent
+ Note: the above rules apply to recent releases of GNAT 5.
  In GNAT 3, there are more severe restrictions on larger components.
  For non-primitive types, including packed arrays with a size greater than
  64 bits, component clauses must respect the alignment requirement of the
  type, in particular, always starting on a byte boundary, and the length
  must be a multiple of the storage unit.
  
  @node Enumeration Clauses
  @section Enumeration Clauses
  
*************** purposes the description in the Ada 95
*** 10097,10104 ****
  reference manual, or appropriate Ada
  text book, will be sufficient for making use of these facilities.
  
! In the case of the input-output facilities, @xref{The Implementation of
! Standard I/O}, gives details on exactly how GNAT interfaces to the
  file system.  For the remaining packages, the Ada 95 reference manual
  should be sufficient.  The following is a list of the packages included,
  together with a brief description of the functionality that is provided.
--- 10490,10498 ----
  reference manual, or appropriate Ada
  text book, will be sufficient for making use of these facilities.
  
! In the case of the input-output facilities,
! @xref{The Implementation of Standard I/O},
! gives details on exactly how GNAT interfaces to the
  file system.  For the remaining packages, the Ada 95 reference manual
  should be sufficient.  The following is a list of the packages included,
  together with a brief description of the functionality that is provided.
*************** All input/output operations use @code{fr
*** 10677,10686 ****
  @end itemize
  
  @noindent
! There is no internal buffering of any kind at the Ada library level.  The
! only buffering is that provided at the system level in the
! implementation of the C library routines that support streams.  This
! facilitates shared use of these streams by mixed language programs.
  
  @node FORM Strings
  @section FORM Strings
--- 11071,11086 ----
  @end itemize
  
  @noindent
! There is no internal buffering of any kind at the Ada library level. The only
! buffering is that provided at the system level in the implementation of the
! library routines that support streams. This facilitates shared use of these
! streams by mixed language programs. Note though that system level buffering is
! explictly enabled at elaboration of the standard I/O packages and that can have
! an impact on mixed language programs, in particular those using I/O before
! calling the Ada elaboration routine (e.g. adainit). It is recommended to call
! the Ada elaboration routine before performing any I/O or when impractical, flush
! the common I/O streams and in particular Standard_Output before elaborating the
! Ada code.
  
  @node FORM Strings
  @section FORM Strings
*************** of GNAT, and will generate a warning mes
*** 11810,11815 ****
--- 12210,12216 ----
  * GNAT.Spitbol.Table_VString (g-sptavs.ads)::
  * GNAT.Strings (g-string.ads)::
  * GNAT.String_Split (g-strspl.ads)::
+ * GNAT.UTF_32 (g-utf_32.ads)::
  * GNAT.Table (g-table.ads)::
  * GNAT.Task_Lock (g-tasloc.ads)::
  * GNAT.Threads (g-thread.ads)::
*************** collisions occur and each item can be re
*** 12498,12504 ****
  probe (perfect property). The hash table size corresponds to the exact
  size of the key set and no larger (minimal property). The key set has to
  be know in advance (static property). The hash functions are also order
! preservering. If w2 is inserted after w1 in the generator, their
  hashcode are in the same order. These hashing functions are very
  convenient for use with realtime applications.
  
--- 12899,12905 ----
  probe (perfect property). The hash table size corresponds to the exact
  size of the key set and no larger (minimal property). The key set has to
  be know in advance (static property). The hash functions are also order
! preserving. If w2 is inserted after w1 in the generator, their
  hashcode are in the same order. These hashing functions are very
  convenient for use with realtime applications.
  
*************** a string wherever the separators appear,
*** 12670,12675 ****
--- 13071,13092 ----
  to the resulting slices. This package is instantiated from
  @code{GNAT.Array_Split}.
  
+ @node GNAT.UTF_32 (g-utf_32.ads)
+ @section @code{GNAT.UTF_32} (@file{g-table.ads})
+ @cindex @code{GNAT.UTF_32} (@file{g-table.ads})
+ @cindex Wide character codes
+ 
+ @noindent
+ This is a package intended to be used in conjunction with the
+ @code{Wide_Character} type in Ada 95 and the
+ @code{Wide_Wide_Character} type in Ada 2005 (available
+ in @code{GNAT} in Ada 2005 mode). This package contains
+ Unicode categorization routines, as well as lexical
+ categorization routines corresponding to the Ada 2005
+ lexical rules for identifiers and strings, and also a
+ lower case to upper case fold routine corresponding to
+ the Ada 2005 rules for identifier equivalence.
+ 
  @node GNAT.Table (g-table.ads)
  @section @code{GNAT.Table} (@file{g-table.ads})
  @cindex @code{GNAT.Table} (@file{g-table.ads})
*************** Provides facilities for creating and des
*** 12709,12715 ****
  These threads are known to the GNAT run-time system.  These subprograms are
  exported C-convention procedures intended to be called from foreign code.
  By using these primitives rather than directly calling operating systems
! routines, compatibility with the Ada tasking runt-time is provided.
  
  @node GNAT.Traceback (g-traceb.ads)
  @section @code{GNAT.Traceback} (@file{g-traceb.ads})
--- 13126,13132 ----
  These threads are known to the GNAT run-time system.  These subprograms are
  exported C-convention procedures intended to be called from foreign code.
  By using these primitives rather than directly calling operating systems
! routines, compatibility with the Ada tasking run-time is provided.
  
  @node GNAT.Traceback (g-traceb.ads)
  @section @code{GNAT.Traceback} (@file{g-traceb.ads})
*************** example see the body of @code{GNAT.Table
*** 12899,12905 ****
  @node System.Partition_Interface (s-parint.ads)
  @section @code{System.Partition_Interface} (@file{s-parint.ads})
  @cindex @code{System.Partition_Interface} (@file{s-parint.ads})
! @cindex Partition intefacing functions
  
  @noindent
  This package provides facilities for partition interfacing.  It
--- 13316,13322 ----
  @node System.Partition_Interface (s-parint.ads)
  @section @code{System.Partition_Interface} (@file{s-parint.ads})
  @cindex @code{System.Partition_Interface} (@file{s-parint.ads})
! @cindex Partition interfacing functions
  
  @noindent
  This package provides facilities for partition interfacing.  It
*************** inter-operability between Ada tagged typ
*** 13063,13075 ****
  See @ref{Implementation Defined Pragmas}, for more details.
  
  @table @code
! @item pragma CPP_Class ([Entity =>] @var{local_name})
  The argument denotes an entity in the current declarative region that is
  declared as a tagged or untagged record type.  It indicates that the type
  corresponds to an externally declared C++ class type, and is to be laid
  out the same way that C++ would lay out the type.
  
! @item pragma CPP_Constructor ([Entity =>] @var{local_name})
  This pragma identifies an imported function (imported in the usual way
  with pragma @code{Import}) as corresponding to a C++ constructor.
  
--- 13480,13492 ----
  See @ref{Implementation Defined Pragmas}, for more details.
  
  @table @code
! @item pragma CPP_Class ([Entity =>] @var{local_NAME})
  The argument denotes an entity in the current declarative region that is
  declared as a tagged or untagged record type.  It indicates that the type
  corresponds to an externally declared C++ class type, and is to be laid
  out the same way that C++ would lay out the type.
  
! @item pragma CPP_Constructor ([Entity =>] @var{local_NAME})
  This pragma identifies an imported function (imported in the usual way
  with pragma @code{Import}) as corresponding to a C++ constructor.
  
*************** facilities.
*** 13161,13166 ****
--- 13578,13584 ----
  * GNAT Implementation of Shared Passive Packages::
  * Code Generation for Array Aggregates::
  * The Size of Discriminated Records with Default Discriminants::
+ * Strict Conformance to the Ada 95 Reference Manual::
  @end menu
  
  @node Machine Code Insertions
*************** aliasing all views of the object (which 
*** 13794,13800 ****
--- 14212,14244 ----
  say) must be consistent, so it is imperative that the object, once created,
  remain invariant.
  
+ @node Strict Conformance to the Ada 95 Reference Manual
+ @section Strict Conformance to the Ada 95 Reference Manual
+ 
+ @noindent
+ The dynamic semantics defined by the Ada 95 Reference Manual impose a set of
+ run-time checks to be generated. By default, the GNAT compiler will insert many
+ run-time checks into the compiled code, including most of those required by the
+ Ada 95 Reference Manual. However, there are three checks that are not enabled
+ in the default mode for efficiency reasons: arithmetic overflow checking for
+ integer operations (including division by zero), checks for access before
+ elaboration on subprogram calls, and stack overflow checking (most operating
+ systems do not perform this check by default).
+ 
+ Strict conformance to the Ada 95 Reference Manual can be achieved by adding
+ three compiler options for overflow checking for integer operations
+ (@option{-gnato}), dynamic checks for access-before-elaboration on subprogram
+ calls and generic instantiations (@option{-gnatE}), and stack overflow
+ checking (@option{-fstack-check}).
  
+ Note that the result of a floating point arithmetic operation in overflow and
+ invalid situations, when the @code{Machine_Overflows} attribute of the result
+ type is @code{False}, is to generate IEEE NaN and infinite values. This is the
+ case for machines compliant with the IEEE floating-point standard, but on
+ machines that are not fully compliant with this standard, such as Alpha, the
+ @option{-mieee} compiler flag must be used for achieving IEEE confirming
+ behavior (although at the cost of a significant performance penalty), so
+ infinite and and NaN values are properly generated.
  
  
  @node Project File Reference
*************** for building shared libraries.
*** 14112,14118 ****
  Expression must be a path name. The attribute defines the
  directory in which the sources of the interfaces of a Stand-alone Library will
  be copied.  The directory must exist, must be distinct from the project's
! object directory and source directories, and must be writable.
  
  @item  Main
  Expression must be a list of strings that are legal file names.
--- 14556,14610 ----
  Expression must be a path name. The attribute defines the
  directory in which the sources of the interfaces of a Stand-alone Library will
  be copied.  The directory must exist, must be distinct from the project's
! object directory and source directories of all project in the project tree,
! and must be writable.
! 
! @item  Library_Src_Dir
! Expression must be a path name. The attribute defines the
! directory in which the ALI files of a Library will
! be copied.  The directory must exist, must be distinct from the project's
! object directory and source directoriesof all project in the project tree,
! and must be writable.
! 
! @item  Library_Symbol_File
! Expression must be a single string. Its value is the single file name of a
! symbol file to be created when building a stand-alone library when the
! symbol policy is either "compliant", "controlled" or "restricted",
! on platforms that support symbol control, such as VMS.
! 
! @item   Library_Reference_Symbol_File
! Expression must be a single string. Its value is the single file name of a
! reference symbol file that is read when the symbol policy is either
! "compliant" or "controlled", on platforms that support symbol control,
! such as VMS, when building a stand-alone library.
! 
! @item  Library_Symbol_Policy
! Expression must be a single string. Its case-insensitive value can only be
! "autonomous", "default", "compliant", "controlled" or "restricted".
! 
! This attribute is not taken into account on all platforms. It controls the
! policy for exported symbols and, on some platforms (like VMS) that have the
! notions of major and minor IDs built in the library files, it controls
! the setting of these IDs.
! 
! "autonomous" or "default": exported symbols are not controlled.
! 
! "compliant": if attribute Library_Reference_Symbol_File is not defined, then
! it is equivalent to policy "autonomous". If there are exported symbols in
! the reference symbol file that are not in the object files of the interfaces,
! the major ID of the library is increased. If there are symbols in the
! object files of the interfaces that are not in the reference symbol file,
! these symbols are put at the end of the list in the newly created symbol file
! and the minor ID is increased.
! 
! "controlled": the attribute Library_Reference_Symbol_File must be difined.
! The library will fail to build if the exported symbols in the object files of
! the interfaces do not match exactly the symbol in the symbol file.
! 
! "restricted": The attribute Library_Symbol_File must be defined. The library
! will fail to build if there are symbols in the symbol file that are not in
! the exported symbols of the object files of the interfaces. Additional symbols
! in the object files are not added to the symbol file.
  
  @item  Main
  Expression must be a list of strings that are legal file names.
*************** command, one or several executables are 
*** 14124,14129 ****
--- 14616,14627 ----
  If the gnatmake command does not include explicit file names, the executables
  that are built correspond to the files specified by this attribute.
  
+ @item  Externally_Built
+ Expression must be a single string. Its value must be either "true" of "false",
+ case-insensitive. The default is "false". When the value of this attribute is
+ "true", no attempt is made to compile the sources or to build the library,
+ when the project is a library project.
+ 
  @item Main_Language
  This is a simple attribute. Its value is a string that specifies the
  language of the main program.
*************** This is an associative array attribute. 
*** 14381,14407 ****
  domain is a set of language names. Its range is a string list that
  specifies the compilation options to be used when compiling a component
  written in that language, for which no file-specific switches have been
! specified..
  
  @item  Switches
  This is an associative array attribute. Its domain is
  a set of file names. Its range is a string list that specifies the
  compilation options to be used when compiling the named file. If a file
  is not specified in the Switches attribute, it is compiled with the
! settings specified by Default_Switches.
  
  @item  Local_Configuration_Pragmas.
  This is a simple attribute, whose
  value is a path name that designates a file containing configuration pragmas
  to be used for all invocations of the compiler for immediate sources of the
  project.
- 
- @item Executable
- This is an associative array attribute. Its domain is
- a set of main source file names. Its range is a simple string that specifies
- the executable file name to be used when linking the specified main source.
- If a main source is not specified in the Executable attribute, the executable
- file name is deducted from the main source file name.
  @end table
  
  @subsection package Builder
--- 14879,14898 ----
  domain is a set of language names. Its range is a string list that
  specifies the compilation options to be used when compiling a component
  written in that language, for which no file-specific switches have been
! specified.
  
  @item  Switches
  This is an associative array attribute. Its domain is
  a set of file names. Its range is a string list that specifies the
  compilation options to be used when compiling the named file. If a file
  is not specified in the Switches attribute, it is compiled with the
! options specified by Default_Switches of its language, if defined.
  
  @item  Local_Configuration_Pragmas.
  This is a simple attribute, whose
  value is a path name that designates a file containing configuration pragmas
  to be used for all invocations of the compiler for immediate sources of the
  project.
  @end table
  
  @subsection package Builder
*************** following attributes apply to package @c
*** 14413,14422 ****
  
  @table @code
  @item Default_Switches
! As above.
  
  @item Switches
! As above.
  
  @item Global_Configuration_Pragmas
  This is a simple attribute, whose
--- 14904,14921 ----
  
  @table @code
  @item Default_Switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when building a main
! written in that language, for which no file-specific switches have been
! specified.
  
  @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when building the named main file. If a main file
! is not specified in the Switches attribute, it is built with the
! options specified by Default_Switches of its language, if defined.
  
  @item Global_Configuration_Pragmas
  This is a simple attribute, whose
*************** value is a path name that designates a f
*** 14424,14437 ****
  to be used in every build of an executable. If both local and global
  configuration pragmas are specified, a compilation makes use of both sets.
  
  @item Executable
! This is an associative array attribute, defined over
! compilation unit names. The image is a string that is the name of the
! executable file corresponding to the main source file index.
  This attribute has no effect if its value is the empty string.
  
  @item Executable_Suffix
! This is a simple attribute whose value is a suffix to be added to
  the executables that don't have an attribute Executable specified.
  @end table
  
--- 14923,14939 ----
  to be used in every build of an executable. If both local and global
  configuration pragmas are specified, a compilation makes use of both sets.
  
+ 
  @item Executable
! This is an associative array attribute. Its domain is
! a set of main source file names. Its range is a simple string that specifies
! the executable file name to be used when linking the specified main source.
! If a main source is not specified in the Executable attribute, the executable
! file name is deducted from the main source file name.
  This attribute has no effect if its value is the empty string.
  
  @item Executable_Suffix
! This is a simple attribute whose value is the suffix to be added to
  the executables that don't have an attribute Executable specified.
  @end table
  
*************** The following attributes apply to packag
*** 14444,14450 ****
  
  @table @code
  @item Switches
! As above.
  @end table
  
  @subsection package Binder
--- 14946,14953 ----
  
  @table @code
  @item Switches
! This is a single attribute with a string list value. Each non empty string
! in the list is an option when invoking @code{gnatls}.
  @end table
  
  @subsection package Binder
*************** The following attributes apply to packag
*** 14456,14464 ****
  
  @table @code
  @item     Default_Switches
! As above.
! @item     Switches
! As above.
  @end table
  
  @subsection package Linker
--- 14959,14976 ----
  
  @table @code
  @item     Default_Switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when binding a main
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when binding the named main file. If a main file
! is not specified in the Switches attribute, it is boundt with the
! options specified by Default_Switches of its language, if defined.
  @end table
  
  @subsection package Linker
*************** The following attributes apply to packag
*** 14470,14478 ****
  
  @table @code
  @item     Default_Switches
! As above
! @item     Switches
! As above.
  @end table
  
  @subsection package Cross_Reference
--- 14982,15005 ----
  
  @table @code
  @item     Default_Switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when linking a main
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when linking the named main file. If a main file
! is not specified in the Switches attribute, it is linked with the
! options specified by Default_Switches of its language, if defined.
! 
! @item  Linker_Options
! This is a string list attribute. Its value specifies additional options that
! be givent to the linker when linking an executable. This attribute is not
! used in the main project, only in projects imported directly or indirectly.
! 
  @end table
  
  @subsection package Cross_Reference
*************** The following attributes apply to packag
*** 14485,14493 ****
  
  @table @code
  @item     Default_Switches
! As above.
! @item     Switches
! As above.
  @end table
  
  @subsection package   Finder
--- 15012,15030 ----
  
  @table @code
  @item     Default_Switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatxref} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatxref} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatxref} will
! be called with the options specified by Default_Switches of its language,
! if defined.
  @end table
  
  @subsection package   Finder
*************** The following attributes apply to packag
*** 14499,14507 ****
  
  @table @code
  @item     Default_Switches
! As above.
! @item     Switches
! As above.
  @end table
  
  @subsection package Pretty_Printer
--- 15036,15054 ----
  
  @table @code
  @item     Default_Switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatfind} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatfind} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatfind} will
! be called with the options specified by Default_Switches of its language,
! if defined.
  @end table
  
  @subsection package Pretty_Printer
*************** The following attributes apply to packag
*** 14514,14522 ****
  
  @table @code
  @item     Default_switches
! As above.
! @item     Switches
! As above.
  @end table
  
  @subsection  package IDE
--- 15061,15154 ----
  
  @table @code
  @item     Default_switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatpp} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatpp} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatpp} will
! be called with the options specified by Default_Switches of its language,
! if defined.
! @end table
! 
! @subsection package gnatstub
! 
! @noindent
! The attributes of package @code{gnatstub}
! specify the tool options to be used
! when invoking the tool @command{gnatstub}.
! The following attributes apply to package @code{gnatstub}:
! 
! @table @code
! @item     Default_switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatstub} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatstub} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatpp} will
! be called with the options specified by Default_Switches of its language,
! if defined.
! @end table
! 
! @subsection package Eliminate
! 
! @noindent
! The attributes of package @code{Eliminate}
! specify the tool options to be used
! when invoking the tool @command{gnatelim}.
! The following attributes apply to package @code{Eliminate}:
! 
! @table @code
! @item     Default_switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatelim} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatelim} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatelim} will
! be called with the options specified by Default_Switches of its language,
! if defined.
! @end table
! 
! @subsection package Metrics
! 
! @noindent
! The attributes of package @code{Metrics}
! specify the tool options to be used
! when invoking the tool @command{gnatmetric}.
! The following attributes apply to package @code{Metrics}:
! 
! @table @code
! @item     Default_switches
! This is an associative array attribute. Its
! domain is a set of language names. Its range is a string list that
! specifies options to be used when calling @command{gnatmetric} on a source
! written in that language, for which no file-specific switches have been
! specified.
! 
! @item Switches
! This is an associative array attribute. Its domain is
! a set of file names. Its range is a string list that specifies
! options to be used when calling @command{gnatmetric} on the named main source.
! If a source is not specified in the Switches attribute, @command{gnatmetric}
! will be called with the options specified by Default_Switches of its language,
! if defined.
  @end table
  
  @subsection  package IDE
*************** of the @command{gnatls} utility to be us
*** 14563,14569 ****
  predefined path; e.g., @code{"gnatls"}, @code{"powerpc-wrs-vxworks-gnatls"}.
  
  @item VCS_Kind
! This is a simple atribute. Is value is a string used to specify the
  Version Control System (VCS) to be used for this project, e.g CVS, RCS
  ClearCase or Perforce.
  
--- 15195,15201 ----
  predefined path; e.g., @code{"gnatls"}, @code{"powerpc-wrs-vxworks-gnatls"}.
  
  @item VCS_Kind
! This is a simple attribute. Its value is a string used to specify the
  Version Control System (VCS) to be used for this project, e.g CVS, RCS
  ClearCase or Perforce.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/gnat_ugn.texi gcc-4.1.0/gcc/ada/gnat_ugn.texi
*** gcc-4.0.2/gcc/ada/gnat_ugn.texi	Thu Feb 10 13:57:20 2005
--- gcc-4.1.0/gcc/ada/gnat_ugn.texi	Wed Nov 16 09:04:50 2005
***************
*** 7,13 ****
  @c                                                                            o
  @c                             G N A T _ U G N                                o
  @c                                                                            o
! @c          Copyright (C) 1992-2005 Ada Core Technologies, Inc.               o
  @c                                                                            o
  @c  GNAT is free software;  you can  redistribute it  and/or modify it under  o
  @c  terms of the  GNU General Public License as published  by the Free Soft-  o
--- 7,13 ----
  @c                                                                            o
  @c                             G N A T _ U G N                                o
  @c                                                                            o
! @c                     Copyright (C) 1992-2005, AdaCore                       o
  @c                                                                            o
  @c  GNAT is free software;  you can  redistribute it  and/or modify it under  o
  @c  terms of the  GNU General Public License as published  by the Free Soft-  o
***************
*** 17,24 ****
  @c  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License  o
  @c  for  more details.  You should have  received  a copy of the GNU General  o
  @c  Public License  distributed with GNAT;  see file COPYING.  If not, write  o
! @c  to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston,  o
! @c  MA 02111-1307, USA.                                                       o
  @c                                                                            o
  @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
  
--- 17,24 ----
  @c  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License  o
  @c  for  more details.  You should have  received  a copy of the GNU General  o
  @c  Public License  distributed with GNAT;  see file COPYING.  If not, write  o
! @c  to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor,  o
! @c  Boston, MA 02110-1301, USA.                                               o
  @c                                                                            o
  @c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
  
*************** AdaCore@*
*** 195,201 ****
  * Other Utility Programs::
  * Running and Debugging Ada Programs::
  @ifset vms
! * Compatibility with DEC Ada::
  @end ifset
  * Platform-Specific Information for the Run-Time Libraries::
  * Example of Binder Output File::
--- 195,201 ----
  * Other Utility Programs::
  * Running and Debugging Ada Programs::
  @ifset vms
! * Compatibility with HP Ada::
  @end ifset
  * Platform-Specific Information for the Run-Time Libraries::
  * Example of Binder Output File::
*************** Switches for gcc
*** 275,281 ****
  * Stack Overflow Checking::
  * Using gcc for Syntax Checking::
  * Using gcc for Semantic Checking::
! * Compiling Ada 83 Programs::
  * Character Set Control::
  * File Naming Control::
  * Subprogram Inlining Control::
--- 275,281 ----
  * Stack Overflow Checking::
  * Using gcc for Syntax Checking::
  * Using gcc for Semantic Checking::
! * Compiling Different Versions of Ada::
  * Character Set Control::
  * File Naming Control::
  * Subprogram Inlining Control::
*************** Performance Considerations
*** 331,336 ****
--- 331,337 ----
  * Optimization Levels::
  * Debugging Optimized Code::
  * Inlining of Subprograms::
+ * Other Optimization Switches::
  * Optimization and Strict Aliasing::
  @ifset vms
  * Coverage Analysis::
*************** GNAT Project Manager
*** 377,383 ****
  * Variables from Imported Projects::
  * Naming Schemes::
  * Library Projects::
- * Using Third-Party Libraries through Projects::
  * Stand-alone Library Projects::
  * Switches Related to Project Files::
  * Tools Supporting Project Files::
--- 378,383 ----
*************** Cleaning Up Using gnatclean
*** 434,440 ****
  
  * Running gnatclean::
  * Switches for gnatclean::
! * Examples of gnatclean Usage::
  
  @ifclear vms
  
--- 434,440 ----
  
  * Running gnatclean::
  * Switches for gnatclean::
! @c * Examples of gnatclean Usage::
  
  @ifclear vms
  
*************** Running and Debugging Ada Programs
*** 508,514 ****
  @end ifset
  
  @ifset vms
! Compatibility with DEC Ada
  
  * Ada 95 Compatibility::
  * Differences in the Definition of Package System::
--- 508,514 ----
  @end ifset
  
  @ifset vms
! Compatibility with HP Ada
  
  * Ada 95 Compatibility::
  * Differences in the Definition of Package System::
*************** Compatibility with DEC Ada
*** 516,522 ****
  * The Package STANDARD::
  * The Package SYSTEM::
  * Tasking and Task-Related Features::
! * Implementation of Tasks in DEC Ada for OpenVMS Alpha Systems::
  * Pragmas and Pragma-Related Features::
  * Library of Predefined Units::
  * Bindings::
--- 516,522 ----
  * The Package STANDARD::
  * The Package SYSTEM::
  * Tasking and Task-Related Features::
! * Implementation of Tasks in HP Ada for OpenVMS Alpha Systems::
  * Pragmas and Pragma-Related Features::
  * Library of Predefined Units::
  * Bindings::
*************** Compatibility with DEC Ada
*** 526,532 ****
  * Program Compilation and Library Management::
  * Input-Output::
  * Implementation Limits::
- * Tools::
  
  Language-Related Features
  
--- 526,531 ----
*************** Language-Related Features
*** 538,544 ****
  * Address Clauses::
  * Other Representation Clauses::
  
! Implementation of Tasks in DEC Ada for OpenVMS Alpha Systems
  
  * Assigning Task IDs::
  * Task IDs and Delays::
--- 537,543 ----
  * Address Clauses::
  * Other Representation Clauses::
  
! Implementation of Tasks in HP Ada for OpenVMS Alpha Systems
  
  * Assigning Task IDs::
  * Task IDs and Delays::
*************** Inline Assembler
*** 599,611 ****
  * Input Variables in Inline Assembler::
  * Inlining Inline Assembler Code::
  * Other Asm Functionality::
- * A Complete Example::
  
  Compatibility and Porting Guide
  
  * Compatibility with Ada 83::
  * Implementation-dependent characteristics::
! * Compatibility with DEC Ada 83::
  * Compatibility with Other Ada 95 Systems::
  * Representation Clauses::
  @ifset vms
--- 598,609 ----
  * Input Variables in Inline Assembler::
  * Inlining Inline Assembler Code::
  * Other Asm Functionality::
  
  Compatibility and Porting Guide
  
  * Compatibility with Ada 83::
  * Implementation-dependent characteristics::
! * Compatibility with HP Ada 83::
  * Compatibility with Other Ada 95 Systems::
  * Representation Clauses::
  @ifset vms
*************** Ada programs.
*** 799,808 ****
  
  @ifset vms
  @item
! @ref{Compatibility with DEC Ada}, details the compatibility of GNAT with
! DEC Ada 83 @footnote{``DEC Ada'' refers to the legacy product originally
  developed by Digital Equipment Corporation and currently supported by HP.}
! for OpenVMS Alpha.
  @end ifset
  
  @item
--- 797,808 ----
  
  @ifset vms
  @item
! @ref{Compatibility with HP Ada}, details the compatibility of GNAT with
! HP Ada 83 @footnote{``HP Ada'' refers to the legacy product originally
  developed by Digital Equipment Corporation and currently supported by HP.}
! for OpenVMS Alpha. This product was formerly known as DEC Ada, and for
! historical compatibility reasons, the relevant libraries still use the
! DEC prefix.
  @end ifset
  
  @item
*************** $ gnatmake hello.adb
*** 1096,1108 ****
  The result is an executable program called @file{hello}, which can be
  run by entering:
  
- @c The following should be removed (BMB 2001-01-23)
- @c @smallexample
- @c $ ^./hello^$ RUN HELLO^
- @c @end smallexample
- 
  @smallexample
! $ hello
  @end smallexample
  
  @noindent
--- 1096,1103 ----
  The result is an executable program called @file{hello}, which can be
  run by entering:
  
  @smallexample
! $ ^hello^RUN HELLO^
  @end smallexample
  
  @noindent
*************** The build procedure for this application
*** 2867,2873 ****
  example's.  First, compile the foreign language files to generate object
  files:
  @smallexample
! gcc -c main.c
  @end smallexample
  
  @item
--- 2862,2868 ----
  example's.  First, compile the foreign language files to generate object
  files:
  @smallexample
! ^gcc -c main.c^gcc -c main.c^
  @end smallexample
  
  @item
*************** involving variant records, access parame
*** 2921,2927 ****
  are unlikely to be able to be passed.
  
  Note that in the case of GNAT running
! on a platform that supports DEC Ada 83, a higher degree of compatibility
  can be guaranteed, and in particular records are layed out in an identical
  manner in the two compilers. Note also that if output from two different
  compilers is mixed, the program is responsible for dealing with elaboration
--- 2916,2922 ----
  are unlikely to be able to be passed.
  
  Note that in the case of GNAT running
! on a platform that supports HP Ada 83, a higher degree of compatibility
  can be guaranteed, and in particular records are layed out in an identical
  manner in the two compilers. Note also that if output from two different
  compilers is mixed, the program is responsible for dealing with elaboration
*************** elaboration of the GNAT components. Cons
*** 2932,2939 ****
  Ada compiler for further details on elaboration.
  
  However, it is not possible to mix the tasking run time of GNAT and
! DEC Ada 83, All the tasking operations must either be entirely within
! GNAT compiled sections of the program, or entirely within DEC Ada 83
  compiled sections of the program.
  
  @cindex Interfacing to Assembly
--- 2927,2934 ----
  Ada compiler for further details on elaboration.
  
  However, it is not possible to mix the tasking run time of GNAT and
! HP Ada 83, All the tasking operations must either be entirely within
! GNAT compiled sections of the program, or entirely within HP Ada 83
  compiled sections of the program.
  
  @cindex Interfacing to Assembly
*************** in section B.3 of the Ada 95 Reference M
*** 2964,2970 ****
  
  @findex C varargs function
  @cindex Intefacing to C varargs function
! @cindex varargs function intefacs
  @item C varargs function
  In C, @code{varargs} allows a function to take a variable number of
  arguments. There is no direct equivalent in this to Ada. One
--- 2959,2965 ----
  
  @findex C varargs function
  @cindex Intefacing to C varargs function
! @cindex varargs function interfaces
  @item C varargs function
  In C, @code{varargs} allows a function to take a variable number of
  arguments. There is no direct equivalent in this to Ada. One
*************** implemented as a single machine instruct
*** 3054,3072 ****
  @findex Stdcall
  @cindex Convention Stdcall
  @item Stdcall
! This is relevant only to NT/Win95 implementations of GNAT,
! and specifies that the Stdcall calling sequence will be used, as defined
! by the NT API.
  
  @findex DLL
  @cindex Convention DLL
  @item DLL
! This is equivalent to Stdcall.
  
  @findex Win32
  @cindex Convention Win32
  @item Win32
! This is equivalent to Stdcall.
  @end ifset
  
  @findex Stubbed
--- 3049,3069 ----
  @findex Stdcall
  @cindex Convention Stdcall
  @item Stdcall
! This is relevant only to Windows XP/2000/NT/95 implementations of GNAT,
! and specifies that the @code{Stdcall} calling sequence will be used,
! as defined by the NT API. Nevertheless, to ease building
! cross-platform bindings this convention will be handled as a @code{C} calling
! convention on non Windows platforms.
  
  @findex DLL
  @cindex Convention DLL
  @item DLL
! This is equivalent to @code{Stdcall}.
  
  @findex Win32
  @cindex Convention Win32
  @item Win32
! This is equivalent to @code{Stdcall}.
  @end ifset
  
  @findex Stubbed
*************** $ gnatlink -v -v ada_unit file1.o file2.
*** 3204,3211 ****
  @item
  Using a non-GNU C++ compiler: The commands previously described can be
  used to insure that the C++ linker is used. Nonetheless, you need to add
! the path to libgcc explicitly, since some libraries needed by GNAT are
! located in this directory:
  
  @smallexample
  $ cat ./my_script
--- 3201,3211 ----
  @item
  Using a non-GNU C++ compiler: The commands previously described can be
  used to insure that the C++ linker is used. Nonetheless, you need to add
! a few more parameters to the link command line, depending on the exception
! mechanism used.
! 
! If the @code{setjmp/longjmp} exception mechanism is used, only the paths
! to the libgcc libraries are required:
  
  @smallexample
  $ cat ./my_script
*************** $ gnatlink ada_unit file1.o file2.o --LI
*** 3216,3221 ****
--- 3216,3239 ----
  
  Where CC is the name of the non-GNU C++ compiler.
  
+ If the @code{zero cost} exception mechanism is used, and the platform
+ supports automatic registration of exception tables (e.g. Solaris or IRIX),
+ paths to more objects are required:
+ 
+ @smallexample
+ $ cat ./my_script
+ #!/bin/sh
+ CC `gcc -print-file-name=crtbegin.o` $* \
+ `gcc -print-file-name=libgcc.a` `gcc -print-file-name=libgcc_eh.a` \
+ `gcc -print-file-name=crtend.o`
+ $ gnatlink ada_unit file1.o file2.o --LINK=./my_script
+ @end smallexample
+ 
+ If the @code{zero cost} exception mechanism is used, and the platform
+ doesn't support automatic registration of exception tables (e.g. HP-UX,
+ Tru64 or AIX), the simple approach described above will not work and
+ a pre-linking phase using GNAT will be necessary.
+ 
  @end enumerate
  
  @node A Simple Example
*************** compilation process. These switches are 
*** 3622,3627 ****
--- 3640,3651 ----
  First we briefly list all the switches, in alphabetical order, then we
  describe the switches in more detail in functionally grouped sections.
  
+ More switches exist for GCC than those documented here, especially
+ for specific targets. However, their use is not recommended as
+ they may change code generation in ways that are incompatible with
+ the Ada run-time library, or can cause inconsistencies between
+ compilation units.
+ 
  @menu
  * Output and Error Message Control::
  * Warning Message Control::
*************** describe the switches in more detail in 
*** 3632,3638 ****
  * Stack Overflow Checking::
  * Using gcc for Syntax Checking::
  * Using gcc for Semantic Checking::
! * Compiling Ada 83 Programs::
  * Character Set Control::
  * File Naming Control::
  * Subprogram Inlining Control::
--- 3656,3662 ----
  * Stack Overflow Checking::
  * Using gcc for Syntax Checking::
  * Using gcc for Semantic Checking::
! * Compiling Different Versions of Ada::
  * Character Set Control::
  * File Naming Control::
  * Subprogram Inlining Control::
*************** of objects of different types. See
*** 3695,3700 ****
--- 3719,3737 ----
  Activates stack checking.
  See @ref{Stack Overflow Checking} for details of the use of this option.
  
+ @item -fstack-usage
+ @cindex @option{-fstack-usage} (@command{gcc})
+ Makes the compiler output stack usage information for the program, on a
+ per-function basis.  The description of the format is to be found in
+ the GCC documentation.
+ 
+ @item -fcallgraph-info
+ @cindex @option{-fcallgraph-info} (@command{gcc})
+ Makes the compiler output callgraph information for the program, on a
+ per-file basis.  The information is generated in the VCG format.  It can
+ be decorated with additional, per-node information if other debugging
+ options are enabled (only works with -fstack-usage as of this writing).
+ 
  @item ^-g^/DEBUG^
  @cindex @option{^-g^/DEBUG^} (@command{gcc})
  Generate debugging information. This information is stored in the object
*************** where it can be read by the debugger. Yo
*** 3706,3715 ****
  @cindex @option{-gnat83} (@command{gcc})
  Enforce Ada 83 restrictions.
  
  @item -gnata
  @cindex @option{-gnata} (@command{gcc})
  Assertions enabled. @code{Pragma Assert} and @code{pragma Debug} to be
! activated.
  
  @item -gnatA
  @cindex @option{-gnatA} (@command{gcc})
--- 3743,3761 ----
  @cindex @option{-gnat83} (@command{gcc})
  Enforce Ada 83 restrictions.
  
+ @item -gnat95
+ @cindex @option{-gnat95} (@command{gcc})
+ Enforce Ada 95 restrictions.
+ 
+ @item -gnat05
+ @cindex @option{-gnat05} (@command{gcc})
+ Allow full Ada 2005 features.
+ 
  @item -gnata
  @cindex @option{-gnata} (@command{gcc})
  Assertions enabled. @code{Pragma Assert} and @code{pragma Debug} to be
! activated. Note that these pragmas can also be controlled using the
! configuration pragmas @code{Assertion_Policy} and @code{Debug_Policy}.
  
  @item -gnatA
  @cindex @option{-gnatA} (@command{gcc})
*************** Limit file names to @var{n} (1-999) char
*** 3822,3837 ****
  @cindex @option{-gnatl} (@command{gcc})
  Output full source listing with embedded error messages.
  
- @item -gnatL
- @cindex @option{-gnatL} (@command{gcc})
- Use the longjmp/setjmp method for exception handling
- 
  @item -gnatm=@var{n}
  @cindex @option{-gnatm} (@command{gcc})
  Limit number of detected error or warning messages to @var{n}
  where @var{n} is in the range 1..999_999. The default setting if
  no switch is given is 9999. Compilation is terminated if this
! limit is exceeded.
  
  @item -gnatn
  @cindex @option{-gnatn} (@command{gcc})
--- 3868,3879 ----
  @cindex @option{-gnatl} (@command{gcc})
  Output full source listing with embedded error messages.
  
  @item -gnatm=@var{n}
  @cindex @option{-gnatm} (@command{gcc})
  Limit number of detected error or warning messages to @var{n}
  where @var{n} is in the range 1..999_999. The default setting if
  no switch is given is 9999. Compilation is terminated if this
! limit is exceeded. The equal sign here is optional.
  
  @item -gnatn
  @cindex @option{-gnatn} (@command{gcc})
*************** Distribution stub generation and compila
*** 3952,3960 ****
  to be generated and compiled).
  @end ifset
  
- @item -gnatZ
- Use the zero cost method for exception handling
- 
  @item ^-I^/SEARCH=^@var{dir}
  @cindex @option{^-I^/SEARCH^} (@command{gcc})
  @cindex RTL
--- 3994,3999 ----
*************** No optimization, the default setting if 
*** 4009,4024 ****
  
  @item n = 1
  Normal optimization, the default if you specify @option{-O} without
! an operand.
  
  @item n = 2
! Extensive optimization
  
- @item n = 3
- Extensive optimization with automatic inlining of subprograms not
- specified by pragma @code{Inline}. This applies only to
- inlining within a unit. For details on control of inlining
- see @ref{Subprogram Inlining Control}.
  @end table
  @end ifclear
  
--- 4048,4060 ----
  
  @item n = 1
  Normal optimization, the default if you specify @option{-O} without
! an operand. A good compromise between code quality and compilation
! time.
  
  @item n = 2
! Extensive optimization, may improve execution time, possibly at the cost of
! substantially increased compilation time.
  
  @end table
  @end ifclear
  
*************** Perform some optimizations, but omit one
*** 4049,4059 ****
  @item   DEVELOPMENT
  Same as @code{SOME}.
  
- @item   INLINING
- Full optimization, and also attempt automatic inlining of small
- subprograms within a unit even when pragma @code{Inline}
- is not specified (@pxref{Inlining of Subprograms}).
- 
  @item   UNROLL_LOOPS
  Try to unroll loops. This keyword may be specified together with
  any keyword above other than @code{NONE}. Loop unrolling
--- 4085,4090 ----
*************** Execute @var{ver} version of the compile
*** 4100,4105 ****
--- 4131,4143 ----
  version, not the GNAT version.
  @end ifclear
  
+ @item ^-w^NO_BACK_END_WARNINGS^
+ @cindex @option{-w} (@command{gcc})
+ Turn off warnings generated by the back end of the compiler. Use of
+ this switch also causes the default for front end warnings to be set
+ to suppress (as though @option{-gnatws} had appeared at the start of
+ the options.
+ 
  @end table
  
  @ifclear vms
*************** file) as well as the verbose
*** 4265,4271 ****
  format message or full listing (which as usual is written to
  @file{stdout} (the standard output file).
  
! @item -gnatm^^=^@var{n}
  @cindex @option{-gnatm} (@command{gcc})
  @ifclear vms
  The @code{m} stands for maximum.
--- 4303,4309 ----
  format message or full listing (which as usual is written to
  @file{stdout} (the standard output file).
  
! @item -gnatm=@var{n}
  @cindex @option{-gnatm} (@command{gcc})
  @ifclear vms
  The @code{m} stands for maximum.
*************** fatal error: maximum errors reached
*** 4281,4286 ****
--- 4319,4328 ----
  compilation abandoned
  @end smallexample
  
+ @noindent
+ Note that the equal sign is optional, so the switches
+ @option{-gnatm2} and @option{-gnatm=2} are equivalent.
+ 
  @item -gnatf
  @cindex @option{-gnatf} (@command{gcc})
  @cindex Error messages, suppressing
*************** This switch suppresses all optional warn
*** 4553,4558 ****
--- 4595,4620 ----
  in this section for details on optional warning messages that can be
  individually controlled.
  
+ @item -gnatwb
+ @emph{Activate warnings on bad fixed values.}
+ @cindex @option{-gnatwb} (@command{gcc})
+ @cindex Bad fixed values
+ @cindex Fixed-point Small value
+ @cindex Small value
+ This switch activates warnings for static fixed-point expressions whose
+ value is not an exact multiple of Small. Such values are implementation
+ dependent, since an implementation is free to choose either of the multiples
+ that surround the value. GNAT always chooses the closer one, but this is not
+ required behavior, and it is better to specify a value that is an exact
+ multiple, ensuring predictable execution. The default is that such warnings
+ are not generated.
+ 
+ @item -gnatwB
+ @emph{Suppress warnings on bad fixed values.}
+ @cindex @option{-gnatwB} (@command{gcc})
+ This switch suppresses warnings for static fixed-point expressions whose
+ value is not an exact multiple of Small.
+ 
  @item -gnatwc
  @emph{Activate warnings on conditionals.}
  @cindex @option{-gnatwc} (@command{gcc})
*************** not get issued for the use of boolean va
*** 4565,4570 ****
--- 4627,4639 ----
  values are known at compile time, since this is a standard technique
  for conditional compilation in Ada, and this would generate too many
  ``false positive'' warnings.
+ 
+ This warning option also activates a special test for comparisons using
+ the operators >= and <=. If the compiler can tell that only the equality
+ condition is posible, then it will warn that the > or < part of the test
+ is useless and that the operator could be replaced by =. An example would
+ be comparing a Natural variable <= 0.
+ 
  This warning can also be turned on using @option{-gnatwa}.
  
  @item -gnatwC
*************** such warnings are not generated.
*** 4687,4693 ****
  
  In addition to the above cases, warnings are also generated for
  GNAT features that have been provided in past versions but which
! have been superceded (typically by features in the new Ada standard).
  For example, @code{pragma Ravenscar} will be flagged since its
  function is replaced by @code{pragma Profile(Ravenscar)}.
  
--- 4756,4762 ----
  
  In addition to the above cases, warnings are also generated for
  GNAT features that have been provided in past versions but which
! have been superseded (typically by features in the new Ada standard).
  For example, @code{pragma Ravenscar} will be flagged since its
  function is replaced by @code{pragma Profile(Ravenscar)}.
  
*************** This switch disables warnings on variabl
*** 4717,4725 ****
  @cindex @option{-gnatwl} (@command{gcc})
  @cindex Elaboration, warnings
  This switch activates warnings on missing
! @code{pragma Elaborate_All} statements.
  See the section in this guide on elaboration checking for details on
! when such pragma should be used. Warnings are also generated if you
  are using the static mode of elaboration, and a @code{pragma Elaborate}
  is encountered. The default is that such warnings
  are not generated.
--- 4786,4794 ----
  @cindex @option{-gnatwl} (@command{gcc})
  @cindex Elaboration, warnings
  This switch activates warnings on missing
! @code{Elaborate_All} and @code{Elaborate} pragmas.
  See the section in this guide on elaboration checking for details on
! when such pragmas should be used. Warnings are also generated if you
  are using the static mode of elaboration, and a @code{pragma Elaborate}
  is encountered. The default is that such warnings
  are not generated.
*************** This warning is not automatically turned
*** 4728,4736 ****
  @item -gnatwL
  @emph{Suppress warnings for missing elaboration pragmas.}
  @cindex @option{-gnatwL} (@command{gcc})
! This switch suppresses warnings on missing pragma Elaborate_All statements.
  See the section in this guide on elaboration checking for details on
! when such pragma should be used.
  
  @item -gnatwm
  @emph{Activate warnings on modified but unreferenced variables.}
--- 4797,4805 ----
  @item -gnatwL
  @emph{Suppress warnings for missing elaboration pragmas.}
  @cindex @option{-gnatwL} (@command{gcc})
! This switch suppresses warnings on missing Elaborate and Elaborate_All pragmas.
  See the section in this guide on elaboration checking for details on
! when such pragmas should be used.
  
  @item -gnatwm
  @emph{Activate warnings on modified but unreferenced variables.}
*************** such warnings are generated.
*** 4877,4882 ****
--- 4946,4970 ----
  This switch suppresses warnings for access to variables which
  may not be properly initialized.
  
+ @item -gnatwy
+ @emph{Activate warnings for Ada 2005 compatibility issues.}
+ @cindex @option{-gnatwy} (@command{gcc})
+ @cindex Ada 2005 compatibility issues warnings
+ For the most part Ada 2005 is upwards compatible with Ada 95,
+ but there are some exceptions (for example the fact that
+ @code{interface} is now a reserved word in Ada 2005). This
+ switch activates several warnings to help in identifying
+ and correcting such incompatibilities. The default is that
+ these warnings are generated. Note that at one point Ada 2005
+ was called Ada 0Y, hence the choice of character.
+ 
+ @item -gnatwY
+ @emph{Disable warnings for Ada 2005 compatibility issues.}
+ @cindex @option{-gnatwY} (@command{gcc})
+ @cindex Ada 2005 compatibility issues warnings
+ This switch suppresses several warnings intended to help in identifying
+ incompatibilities between Ada 95 and Ada 2005.
+ 
  @item -gnatwx
  @emph{Activate warnings on Export/Import pragmas.}
  @cindex @option{-gnatwx} (@command{gcc})
*************** warnings about uninitialized variables.
*** 4925,4933 ****
  
  @item ^-w^/NO_BACK_END_WARNINGS^
  @cindex @option{-w}
! This switch suppresses warnings from the @option{^gcc^GCC^} back end. It may
! be used in conjunction with @option{-gnatws} to ensure that all warnings
! are suppressed during the entire compilation process.
  
  @end table
  
--- 5013,5023 ----
  
  @item ^-w^/NO_BACK_END_WARNINGS^
  @cindex @option{-w}
! This switch suppresses warnings from the @option{^gcc^GCC^} back end. The
! code generator detects a number of warning situations that are missed
! by the @option{GNAT} front end, and this switch can be used to suppress them.
! The use of this switch also sets the default front end warning mode to
! @option{-gnatws}, that is, front end warnings suppressed as well.
  
  @end table
  
*************** example:
*** 5327,5332 ****
--- 5417,5429 ----
  @end smallexample
  @end itemize
  
+ @item ^d^DOS_LINE_ENDINGS^
+ @emph{Check no DOS line terminators present.}
+ If the ^letter d^word DOS_LINE_ENDINGS^ appears in the string after
+ @option{-gnaty} then all lines must be terminated by a single ASCII.LF
+ character (in particular the DOS line terminator sequence CR/LF is not
+ allowed).
+ 
  @item ^e^END^
  @emph{Check end/exit labels.}
  If the ^letter e^word END^ appears in the string after @option{-gnaty} then
*************** If the ^letter m^word LINE_LENGTH^ appea
*** 5446,5455 ****
  then the length of source lines must not exceed 79 characters, including
  any trailing blanks. The value of 79 allows convenient display on an
  80 character wide device or window, allowing for possible special
! treatment of 80 character lines. Note that this count is of raw
  characters in the source text. This means that a tab character counts
! as one character in this count and a wide character sequence counts as
! several characters (however many are needed in the encoding).
  
  @item ^Mnnn^MAX_LENGTH=nnn^
  @emph{Set maximum line length.}
--- 5543,5552 ----
  then the length of source lines must not exceed 79 characters, including
  any trailing blanks. The value of 79 allows convenient display on an
  80 character wide device or window, allowing for possible special
! treatment of 80 character lines. Note that this count is of
  characters in the source text. This means that a tab character counts
! as one character in this count but a wide character sequence counts as
! a single character (however many bytes are needed in the encoding).
  
  @item ^Mnnn^MAX_LENGTH=nnn^
  @emph{Set maximum line length.}
*************** A unary plus or minus may not be followe
*** 5548,5553 ****
--- 5645,5656 ----
  A vertical bar must be surrounded by spaces.
  @end itemize
  
+ @item ^u^UNNECESSARY_BLANK_LINES^
+ @emph{Check unnecessary blank lines.}
+ Check for unnecessary blank lines. A blank line is considered
+ unnecessary if it appears at the end of the file, or if more than
+ one blank line occurs in sequence.
+ 
  @item ^x^XTRA_PARENS^
  @emph{Check extra parentheses.}
  Check for the use of an unnecessary extra level of parentheses (C-style)
*************** The switch
*** 5577,5590 ****
  @ifclear vms
  @option{-gnaty} on its own (that is not
  followed by any letters or digits),
! is equivalent to @code{gnaty3abcefhiklmprst}, that is all checking
! options enabled with the exception of -gnatyo,
  @end ifclear
  @ifset vms
  /STYLE_CHECKS=ALL_BUILTIN enables all checking options with
! the exception of ORDERED_SUBPROGRAMS,
  @end ifset
! with an indentation level of 3. This is the standard
  checking option that is used for the GNAT sources.
  
  The switch
--- 5680,5695 ----
  @ifclear vms
  @option{-gnaty} on its own (that is not
  followed by any letters or digits),
! is equivalent to @code{gnaty3abcefhiklmnprst}, that is all checking
! options enabled with the exception of @option{-gnatyo},
! @option{-gnatyd}, @option{-gnatyu}, and @option{-gnatyx}.
  @end ifclear
  @ifset vms
  /STYLE_CHECKS=ALL_BUILTIN enables all checking options with
! the exception of ORDERED_SUBPROGRAMS, UNNECESSARY_BLANK_LINES,
! XTRA_PARENS, and DOS_LINE_ENDINGS. In addition
  @end ifset
! an indentation level of 3 is set. This is similar to the standard
  checking option that is used for the GNAT sources.
  
  The switch
*************** clears any previously set style checks.
*** 5602,5616 ****
  @cindex Access before elaboration
  @cindex Checks, division by zero
  @cindex Checks, access before elaboration
  
  @noindent
  If you compile with the default options, GNAT will insert many run-time
  checks into the compiled code, including code that performs range
  checking against constraints, but not arithmetic overflow checking for
! integer operations (including division by zero) or checks for access
! before elaboration on subprogram calls. All other run-time checks, as
! required by the Ada 95 Reference Manual, are generated by default.
! The following @command{gcc} switches refine this default behavior:
  
  @table @option
  @c !sort!
--- 5707,5723 ----
  @cindex Access before elaboration
  @cindex Checks, division by zero
  @cindex Checks, access before elaboration
+ @cindex Checks, stack overflow checking
  
  @noindent
  If you compile with the default options, GNAT will insert many run-time
  checks into the compiled code, including code that performs range
  checking against constraints, but not arithmetic overflow checking for
! integer operations (including division by zero), checks for access
! before elaboration on subprogram calls, or stack overflow checking. All
! other run-time checks, as required by the Ada 95 Reference Manual, are
! generated by default. The following @command{gcc} switches refine this
! default behavior:
  
  @table @option
  @c !sort!
*************** Enables dynamic checks for access-before
*** 5718,5723 ****
--- 5825,5837 ----
  on subprogram calls and generic instantiations.
  For full details of the effect and use of this switch,
  @xref{Compiling Using gcc}.
+ 
+ @item -fstack-check
+ @cindex @option{-fstack-check} (@command{gcc})
+ @cindex Stack Overflow Checking
+ @cindex Checks, stack overflow checking
+ Activates stack overflow checking. For full details of the effect and use of
+ this switch see @ref{Stack Overflow Checking}.
  @end table
  
  @findex Unsuppress
*************** units that would not normally be compile
*** 5880,5890 ****
  and specifications where a separate body is present).
  @end table
  
! @node Compiling Ada 83 Programs
! @subsection Compiling Ada 83 Programs
  @table @option
! @cindex Ada 83 compatibility
! @item -gnat83
  @cindex @option{-gnat83} (@command{gcc})
  @cindex ACVC, Ada 83 tests
  
--- 5994,6013 ----
  and specifications where a separate body is present).
  @end table
  
! @node Compiling Different Versions of Ada
! @subsection Compiling Different Versions of Ada
  @table @option
! @cindex Compatibility with Ada 83
! @cindex Ada 83 mode
! @cindex Ada 95 mode
! @cindex Ada 2005 mode
! 
! GNAT is primarily an Ada 95 compiler, but the switches described in
! this section allow operation in Ada 83 compatibility mode, and also
! allow the use of a preliminary implementation of many of the expected
! new features in Ada 2005, the forthcoming new version of the standard.
! 
! @item -gnat83 (Ada 83 Compatibility Mode)
  @cindex @option{-gnat83} (@command{gcc})
  @cindex ACVC, Ada 83 tests
  
*************** means that a correct Ada 83 program is u
*** 5912,5917 ****
--- 6035,6081 ----
  program.
  For further information, please refer to @ref{Compatibility and Porting Guide}.
  
+ @item -gnat95 (Ada 95 mode)
+ @cindex @option{-gnat95} (@command{gcc})
+ 
+ @noindent
+ GNAT is primarily an Ada 95 compiler, and all current releases of GNAT Pro
+ compile in Ada 95 mode by default. Typically, Ada 95 is sufficiently upwards
+ compatible with Ada 83, that legacy Ada 83 programs may be compiled using
+ this default Ada95 mode without problems (see section above describing the
+ use of @option{-gnat83} to run in Ada 83 mode).
+ 
+ In Ada 95 mode, the use of Ada 2005 features will in general cause error
+ messages or warnings. Some specialized releases of GNAT (notably the GAP
+ academic version) operate in Ada 2005 mode by default (see section below
+ describing the use of @option{-gnat05} to run in Ada 2005 mode). For such
+ versions the @option{-gnat95} switch may be used to enforce Ada 95 mode.
+ This option also can be used to cancel the effect of a previous
+ @option{-gnat83} or @option{-gnat05} switch earlier in the command line.
+ 
+ 
+ @item -gnat05 (Ada 2005 mode)
+ @cindex @option{-gnat05} (@command{gcc})
+ 
+ @noindent
+ Although GNAT is primarily an Ada 95 compiler, it can be set to operate
+ in Ada 2005 mode using this option. Although the new standard has not
+ yet been issued (as of early 2005), many features have been discussed and
+ approved in ``Ada Issues'' (AI's). For the text of these AI's, see
+ @url{www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs}. Included with GNAT
+ releases is a file @file{features-ada0y} that describes the current set
+ of implemented Ada 2005 features.
+ 
+ If these features are used in Ada 95 mode (which is the normal default),
+ then error messages or warnings may be
+ generated, reflecting the fact that these new features are otherwise
+ unauthorized extensions to Ada 95. The use of the @option{-gnat05}
+ switch (or an equivalent pragma) causes these messages to be suppressed.
+ 
+ Note that some specialized releases of GNAT (notably the GAP academic
+ version) have Ada 2005 mode on by default, and in such environments,
+ the Ada 2005 features can be used freely without the use of switches.
+ 
  @end table
  
  @node Character Set Control
*************** If _FILE is added at the end of an optio
*** 6272,6277 ****
--- 6436,6444 ----
  then the output is to a file with the name @file{file_REP} where
  file is the name of the corresponding source file.
  @end ifset
+ Note that it is possible for record components to have zero size. In
+ this case, the component clause uses an obvious extension of permitted
+ Ada syntax, for example @code{at 0 range 0 .. -1}.
  
  @item -gnatS
  @cindex @option{-gnatS} (@command{gcc})
*************** speed up compilation, but means that the
*** 6300,6306 ****
  
  @noindent
  GNAT uses two methods for handling exceptions at run-time. The
! @code{longjmp/setjmp} method saves the context when entering
  a frame with an exception handler. Then when an exception is
  raised, the context can be restored immediately, without the
  need for tracing stack frames. This method provides very fast
--- 6467,6473 ----
  
  @noindent
  GNAT uses two methods for handling exceptions at run-time. The
! @code{setjmp/longjmp} method saves the context when entering
  a frame with an exception handler. Then when an exception is
  raised, the context can be restored immediately, without the
  need for tracing stack frames. This method provides very fast
*************** two exception handling methods is used.
*** 6327,6365 ****
  @table @option
  @c !sort!
  
! @item -gnatL
! @cindex @option{-gnatL} (@command{gcc})
! This switch causes the longjmp/setjmp approach to be used
  for exception handling. If this is the default mechanism for the
  target (see below), then this has no effect. If the default
  mechanism for the target is zero cost exceptions, then
! this switch can be used to modify this default, but it must be
! used for all units in the partition, including all run-time
! library units. One way to achieve this is to use the
! @option{-a} and @option{-f} switches for @command{gnatmake}.
  This option is rarely used. One case in which it may be
  advantageous is if you have an application where exception
  raising is common and the overall performance of the
  application is improved by favoring exception propagation.
  
! @item -gnatZ
! @cindex @option{-gnatZ} (@command{gcc})
  @cindex Zero Cost Exceptions
! This switch causes the zero cost approach to be sed
  for exception handling. If this is the default mechanism for the
  target (see below), then this has no effect. If the default
! mechanism for the target is longjmp/setjmp exceptions, then
! this switch can be used to modify this default, but it must be
! used for all units in the partition, including all run-time
! library units. One way to achieve this is to use the
! @option{-a} and @option{-f} switches for @command{gnatmake}.
  This option can only be used if the zero cost approach
  is available for the target in use (see below).
  @end table
  
  @noindent
! The @code{longjmp/setjmp} approach is available on all targets, but
! the @code{zero cost} approach is only available on selected targets.
  To determine whether zero cost exceptions can be used for a
  particular target, look at the private part of the file system.ads.
  Either @code{GCC_ZCX_Support} or @code{Front_End_ZCX_Support} must
--- 6494,6528 ----
  @table @option
  @c !sort!
  
! @item --RTS=sjlj
! @cindex @option{--RTS=sjlj} (@command{gnatmake})
! This switch causes the setjmp/longjmp run-time to be used
  for exception handling. If this is the default mechanism for the
  target (see below), then this has no effect. If the default
  mechanism for the target is zero cost exceptions, then
! this switch can be used to modify this default, and must be
! used for all units in the partition.
  This option is rarely used. One case in which it may be
  advantageous is if you have an application where exception
  raising is common and the overall performance of the
  application is improved by favoring exception propagation.
  
! @item --RTS=zcx
! @cindex @option{--RTS=zcx} (@command{gnatmake})
  @cindex Zero Cost Exceptions
! This switch causes the zero cost approach to be used
  for exception handling. If this is the default mechanism for the
  target (see below), then this has no effect. If the default
! mechanism for the target is setjmp/longjmp exceptions, then
! this switch can be used to modify this default, and must be
! used for all units in the partition.
  This option can only be used if the zero cost approach
  is available for the target in use (see below).
  @end table
  
  @noindent
! The @code{setjmp/longjmp} approach is available on all targets, while
! the @code{zero cost} approach is available on selected targets.
  To determine whether zero cost exceptions can be used for a
  particular target, look at the private part of the file system.ads.
  Either @code{GCC_ZCX_Support} or @code{Front_End_ZCX_Support} must
*************** Each directory named by an @option{^-I^/
*** 6630,6635 ****
--- 6793,6808 ----
  @command{gcc} command line, in the order given.
  
  @item
+ @findex ADA_PRJ_INCLUDE_FILE
+ Each of the directories listed in the text file whose name is given
+ by the @code{ADA_PRJ_INCLUDE_FILE} ^environment variable^logical name^.
+ 
+ @noindent
+ @code{ADA_PRJ_INCLUDE_FILE} is normally set by gnatmake or by the ^gnat^GNAT^
+ driver when project files are used. It should not normally be set
+ by other means.
+ 
+ @item
  @findex ADA_INCLUDE_PATH
  Each of the directories listed in the value of the
  @code{ADA_INCLUDE_PATH} ^environment variable^logical name^.
*************** Normally, define this value as a logical
*** 6643,6649 ****
  list of directory names.
  
  This variable can also be defined by means of an environment string
! (an argument to the DEC C exec* set of functions).
  
  Logical Name:
  @smallexample
--- 6816,6822 ----
  list of directory names.
  
  This variable can also be defined by means of an environment string
! (an argument to the HP C exec* set of functions).
  
  Logical Name:
  @smallexample
*************** DEFINE ADA_INCLUDE_PATH ANOTHER_PATH,FOO
*** 6654,6676 ****
  By default, the path includes GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  first, followed by the standard Ada 95
  libraries in GNU:[LIB.OPENVMS7_x.2_8_x.ADAINCLUDE].
! If this is not redefined, the user will obtain the DEC Ada 83 IO packages
  (Text_IO, Sequential_IO, etc)
  instead of the Ada95 packages. Thus, in order to get the Ada 95
  packages by default, ADA_INCLUDE_PATH must be redefined.
  @end ifset
  
  @item
- @findex ADA_PRJ_INCLUDE_FILE
- Each of the directories listed in the text file whose name is given
- by the @code{ADA_PRJ_INCLUDE_FILE} ^environment variable^logical name^.
- 
- @noindent
- @code{ADA_PRJ_INCLUDE_FILE} is normally set by gnatmake or by the ^gnat^GNAT^
- driver when project files are used. It should not normally be set
- by other means.
- 
- @item
  The content of the @file{ada_source_path} file which is part of the GNAT
  installation tree and is used to store standard libraries such as the
  GNAT Run Time Library (RTL) source files.
--- 6827,6839 ----
  By default, the path includes GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  first, followed by the standard Ada 95
  libraries in GNU:[LIB.OPENVMS7_x.2_8_x.ADAINCLUDE].
! If this is not redefined, the user will obtain the HP Ada 83 IO packages
  (Text_IO, Sequential_IO, etc)
  instead of the Ada95 packages. Thus, in order to get the Ada 95
  packages by default, ADA_INCLUDE_PATH must be redefined.
  @end ifset
  
  @item
  The content of the @file{ada_source_path} file which is part of the GNAT
  installation tree and is used to store standard libraries such as the
  GNAT Run Time Library (RTL) source files.
*************** The @var{xxx} ^string specified with the
*** 7083,7089 ****
  @itemize @bullet
  @item ``@option{^in^INVALID^}'' requesting an invalid value where possible
  @item ``@option{^lo^LOW^}'' for the lowest possible value
- possible, and the low
  @item ``@option{^hi^HIGH^}'' for the highest possible value
  @item ``@option{xx}'' for a value consisting of repeated bytes with the
  value 16#xx# (i.e. xx is a string of two hexadecimal digits).
--- 7246,7251 ----
*************** Normally it only makes sense to use the 
*** 7319,7325 ****
  switch if dynamic
  elaboration checking is used (@option{-gnatE} switch used for compilation).
  This is because in the default static elaboration mode, all necessary
! @code{Elaborate_All} pragmas are implicitly inserted.
  These implicit pragmas are still respected by the binder in
  @option{^-p^/PESSIMISTIC_ELABORATION^} mode, so a
  safe elaboration order is assured.
--- 7481,7487 ----
  switch if dynamic
  elaboration checking is used (@option{-gnatE} switch used for compilation).
  This is because in the default static elaboration mode, all necessary
! @code{Elaborate} and @code{Elaborate_All} pragmas are implicitly inserted.
  These implicit pragmas are still respected by the binder in
  @option{^-p^/PESSIMISTIC_ELABORATION^} mode, so a
  safe elaboration order is assured.
*************** switches on the @code{gnatbind}
*** 7546,7551 ****
--- 7708,7723 ----
  command line, in the order given.
  
  @item
+ @findex ADA_PRJ_OBJECTS_FILE
+ Each of the directories listed in the text file whose name is given
+ by the @code{ADA_PRJ_OBJECTS_FILE} ^environment variable^logical name^.
+ 
+ @noindent
+ @code{ADA_PRJ_OBJECTS_FILE} is normally set by gnatmake or by the ^gnat^GNAT^
+ driver when project files are used. It should not normally be set
+ by other means.
+ 
+ @item
  @findex ADA_OBJECTS_PATH
  Each of the directories listed in the value of the
  @code{ADA_OBJECTS_PATH} ^environment variable^logical name^.
*************** Normally, define this value as a logical
*** 7560,7566 ****
  list of directory names.
  
  This variable can also be defined by means of an environment string
! (an argument to the DEC C exec* set of functions).
  
  Logical Name:
  @smallexample
--- 7732,7738 ----
  list of directory names.
  
  This variable can also be defined by means of an environment string
! (an argument to the HP C exec* set of functions).
  
  Logical Name:
  @smallexample
*************** DEFINE ADA_OBJECTS_PATH ANOTHER_PATH,FOO
*** 7571,7593 ****
  By default, the path includes GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  first, followed by the standard Ada 95
  libraries in GNU:[LIB.OPENVMS7_x.2_8_x.ADALIB].
! If this is not redefined, the user will obtain the DEC Ada 83 IO packages
  (Text_IO, Sequential_IO, etc)
  instead of the Ada95 packages. Thus, in order to get the Ada 95
  packages by default, ADA_OBJECTS_PATH must be redefined.
  @end ifset
  
  @item
- @findex ADA_PRJ_OBJECTS_FILE
- Each of the directories listed in the text file whose name is given
- by the @code{ADA_PRJ_OBJECTS_FILE} ^environment variable^logical name^.
- 
- @noindent
- @code{ADA_PRJ_OBJECTS_FILE} is normally set by gnatmake or by the ^gnat^GNAT^
- driver when project files are used. It should not normally be set
- by other means.
- 
- @item
  The content of the @file{ada_object_path} file which is part of the GNAT
  installation tree and is used to store standard libraries such as the
  GNAT Run Time Library (RTL) unless the switch @option{-nostdlib} is
--- 7743,7755 ----
  By default, the path includes GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  first, followed by the standard Ada 95
  libraries in GNU:[LIB.OPENVMS7_x.2_8_x.ADALIB].
! If this is not redefined, the user will obtain the HP Ada 83 IO packages
  (Text_IO, Sequential_IO, etc)
  instead of the Ada95 packages. Thus, in order to get the Ada 95
  packages by default, ADA_OBJECTS_PATH must be redefined.
  @end ifset
  
  @item
  The content of the @file{ada_object_path} file which is part of the GNAT
  installation tree and is used to store standard libraries such as the
  GNAT Run Time Library (RTL) unless the switch @option{-nostdlib} is
*************** when multiple versions of the GNAT compi
*** 7875,7888 ****
  @cindex @option{--GCC=compiler_name} (@command{gnatlink})
  Program used for compiling the binder file. The default is
  @command{gcc}. You need to use quotes around @var{compiler_name} if
! @code{compiler_name} contains spaces or other separator characters. As
! an example @option{--GCC="foo -x -y"} will instruct @command{gnatlink} to use
! @code{foo -x -y} as your compiler. Note that switch @option{-c} is always
  inserted after your command name. Thus in the above example the compiler
  command that will be used by @command{gnatlink} will be @code{foo -c -x -y}.
! If several @option{--GCC=compiler_name} are used, only the last
! @var{compiler_name} is taken into account. However, all the additional
! switches are also taken into account. Thus,
  @option{--GCC="foo -x -y" --GCC="bar -z -t"} is equivalent to
  @option{--GCC="bar -x -y -z -t"}.
  
--- 8037,8052 ----
  @cindex @option{--GCC=compiler_name} (@command{gnatlink})
  Program used for compiling the binder file. The default is
  @command{gcc}. You need to use quotes around @var{compiler_name} if
! @code{compiler_name} contains spaces or other separator characters.
! As an example @option{--GCC="foo -x -y"} will instruct @command{gnatlink} to
! use @code{foo -x -y} as your compiler. Note that switch @option{-c} is always
  inserted after your command name. Thus in the above example the compiler
  command that will be used by @command{gnatlink} will be @code{foo -c -x -y}.
! A limitation of this syntax is that the name and path name of the executable
! itself must not include any embedded spaces. If several
! @option{--GCC=compiler_name} are used, only the last @var{compiler_name}
! is taken into account. However, all the additional switches are also taken
! into account. Thus,
  @option{--GCC="foo -x -y" --GCC="bar -z -t"} is equivalent to
  @option{--GCC="bar -x -y -z -t"}.
  
*************** Generate the executable file even if the
*** 7918,7925 ****
  
  @item /NOSTART_FILES
  Don't link in the object file containing the ``main'' transfer address.
! Used when linking with a foreign language main program compiled with a
! Digital compiler.
  
  @item /STATIC
  Prefer linking with object libraries over sharable images, even without
--- 8082,8089 ----
  
  @item /NOSTART_FILES
  Don't link in the object file containing the ``main'' transfer address.
! Used when linking with a foreign language main program compiled with an
! HP compiler.
  
  @item /STATIC
  Prefer linking with object libraries over sharable images, even without
*************** Program used for compiling. The default 
*** 8092,8103 ****
  quotes around @var{compiler_name} if @code{compiler_name} contains
  spaces or other separator characters. As an example @option{--GCC="foo -x
  -y"} will instruct @command{gnatmake} to use @code{foo -x -y} as your
! compiler. Note that switch @option{-c} is always inserted after your
! command name. Thus in the above example the compiler command that will
! be used by @command{gnatmake} will be @code{foo -c -x -y}.
! If several @option{--GCC=compiler_name} are used, only the last
! @var{compiler_name} is taken into account. However, all the additional
! switches are also taken into account. Thus,
  @option{--GCC="foo -x -y" --GCC="bar -z -t"} is equivalent to
  @option{--GCC="bar -x -y -z -t"}.
  
--- 8256,8268 ----
  quotes around @var{compiler_name} if @code{compiler_name} contains
  spaces or other separator characters. As an example @option{--GCC="foo -x
  -y"} will instruct @command{gnatmake} to use @code{foo -x -y} as your
! compiler. A limitation of this syntax is that the name and path name of
! the executable itself must not include any embedded spaces. Note that
! switch @option{-c} is always inserted after your command name. Thus in the
! above example the compiler command that will be used by @command{gnatmake}
! will be @code{foo -c -x -y}. If several @option{--GCC=compiler_name} are
! used, only the last @var{compiler_name} is taken into account. However,
! all the additional switches are also taken into account. Thus,
  @option{--GCC="foo -x -y" --GCC="bar -z -t"} is equivalent to
  @option{--GCC="bar -x -y -z -t"}.
  
*************** Program used for binding. The default is
*** 8107,8114 ****
  use quotes around @var{binder_name} if @var{binder_name} contains spaces
  or other separator characters. As an example @option{--GNATBIND="bar -x
  -y"} will instruct @command{gnatmake} to use @code{bar -x -y} as your
! binder. Binder switches that are normally appended by @command{gnatmake} to
! `@code{gnatbind}' are now appended to the end of @code{bar -x -y}.
  
  @item --GNATLINK=@var{linker_name}
  @cindex @option{--GNATLINK=linker_name} (@command{gnatmake})
--- 8272,8281 ----
  use quotes around @var{binder_name} if @var{binder_name} contains spaces
  or other separator characters. As an example @option{--GNATBIND="bar -x
  -y"} will instruct @command{gnatmake} to use @code{bar -x -y} as your
! binder. Binder switches that are normally appended by @command{gnatmake}
! to `@code{gnatbind}' are now appended to the end of @code{bar -x -y}.
! A limitation of this syntax is that the name and path name of the executable
! itself must not include any embedded spaces.
  
  @item --GNATLINK=@var{linker_name}
  @cindex @option{--GNATLINK=linker_name} (@command{gnatmake})
*************** or other separator characters. As an exa
*** 8118,8123 ****
--- 8285,8292 ----
  -y"} will instruct @command{gnatmake} to use @code{lan -x -y} as your
  linker. Linker switches that are normally appended by @command{gnatmake} to
  `@command{gnatlink}' are now appended to the end of @code{lan -x -y}.
+ A limitation of this syntax is that the name and path name of the executable
+ itself must not include any embedded spaces.
  
  @end ifclear
  
*************** if not up to date, and libraries are reb
*** 8368,8374 ****
  @item ^-v^/REASONS^
  @cindex @option{^-v^/REASONS^} (@command{gnatmake})
  Verbose. Display the reason for all recompilations @command{gnatmake}
! decides are necessary.
  
  @item ^-vP^/MESSAGES_PROJECT_FILE=^@emph{x}
  Indicate the verbosity of the parsing of GNAT project files.
--- 8537,8555 ----
  @item ^-v^/REASONS^
  @cindex @option{^-v^/REASONS^} (@command{gnatmake})
  Verbose. Display the reason for all recompilations @command{gnatmake}
! decides are necessary, with the highest verbosity level.
! 
! @item ^-vl^/LOW_VERBOSITY^
! @cindex @option{^-vl^/LOW_VERBOSITY^} (@command{gnatmake})
! Verbosity level Low. Display fewer lines than in verbosity Medium.
! 
! @item ^-vm^/MEDIUM_VERBOSITY^
! @cindex @option{^-vm^/MEDIUM_VERBOSITY^} (@command{gnatmake})
! Verbosity level Medium. Potentially display fewer lines than in verbosity High.
! 
! @item ^-vh^/HIGH_VERBOSITY^
! @cindex @option{^-vm^/HIGH_VERBOSITY^} (@command{gnatmake})
! Verbosity level High. Equivalent to ^-v^/REASONS^.
  
  @item ^-vP^/MESSAGES_PROJECT_FILE=^@emph{x}
  Indicate the verbosity of the parsing of GNAT project files.
*************** some guidelines on debugging optimized c
*** 8767,8773 ****
--- 8948,8956 ----
  * Optimization Levels::
  * Debugging Optimized Code::
  * Inlining of Subprograms::
+ * Other Optimization Switches::
  * Optimization and Strict Aliasing::
+ 
  @ifset vms
  * Coverage Analysis::
  @end ifset
*************** No optimization (the default);
*** 8875,8882 ****
  generates unoptimized code but has
  the fastest compilation time.
  
  @item ^-O1^/OPTIMIZE=SOME^
! Medium level optimization;
  optimizes reasonably well but does not
  degrade compilation time significantly.
  
--- 9058,9073 ----
  generates unoptimized code but has
  the fastest compilation time.
  
+ Note that many other compilers do fairly extensive optimization
+ even if "no optimization" is specified. When using gcc, it is
+ very unusual to use ^-O0^/OPTIMIZE=NONE^ for production if
+ execution time is of any concern, since ^-O0^/OPTIMIZE=NONE^
+ really does mean no optimization at all. This difference between
+ gcc and other compilers should be kept in mind when doing
+ performance comparisons.
+ 
  @item ^-O1^/OPTIMIZE=SOME^
! Moderate optimization;
  optimizes reasonably well but does not
  degrade compilation time significantly.
  
*************** that you should not automatically assume
*** 9165,9170 ****
--- 9356,9375 ----
  @option{-O2}, and indeed you should use @option{-O3} only if tests show that
  it actually improves performance.
  
+ @node Other Optimization Switches
+ @subsection Other Optimization Switches
+ @cindex Optimization Switches
+ 
+ Since @code{GNAT} uses the @code{gcc} back end, all the specialized
+ @code{gcc} optimization switches are potentially usable. These switches
+ have not been extensively tested with GNAT but can generally be expected
+ to work. Examples of switches in this category are
+ @option{-funroll-loops} and
+ the various target-specific @option{-m} options (in particular, it has been
+ observed that @option{-march=pentium4} can significantly improve performance
+ on appropriate machines). For full details of these switches, see the
+ @code{gcc} manual.
+ 
  @node Optimization and Strict Aliasing
  @subsection Optimization and Strict Aliasing
  @cindex Aliasing
*************** the compiler optimizer can "know" that t
*** 9209,9215 ****
  for all iterations of the loop and avoid the extra memory reference
  required to dereference it each time through the loop.
  
! This kind of optimziation, called strict aliasing analysis, is
  triggered by specifying an optimization level of @option{-O2} or
  higher and allows @code{GNAT} to generate more efficient code
  when access values are involved.
--- 9414,9420 ----
  for all iterations of the loop and avoid the extra memory reference
  required to dereference it each time through the loop.
  
! This kind of optimization, called strict aliasing analysis, is
  triggered by specifying an optimization level of @option{-O2} or
  higher and allows @code{GNAT} to generate more efficient code
  when access values are involved.
*************** unchecked conversion of access values.
*** 9385,9391 ****
  @subsection Coverage Analysis
  
  @noindent
! GNAT supports the Digital Performance Coverage Analyzer (PCA), which allows
  the user to determine the distribution of execution time across a program,
  @pxref{Profiling} for details of usage.
  @end ifset
--- 9590,9596 ----
  @subsection Coverage Analysis
  
  @noindent
! GNAT supports the HP Performance Coverage Analyzer (PCA), which allows
  the user to determine the distribution of execution time across a program,
  @pxref{Profiling} for details of usage.
  @end ifset
*************** recognized by @code{GNAT}:
*** 9966,9971 ****
--- 10171,10177 ----
  @smallexample
     Ada_83
     Ada_95
+    Ada_05
     C_Pass_By_Copy
     Component_Alignment
     Detect_Blocking
*************** recognized by @code{GNAT}:
*** 9973,9979 ****
     Elaboration_Checks
     Eliminate
     Extend_System
-    Extensions_Allowed
     External_Name_Casing
     Float_Representation
     Initialize_Scalars
--- 10179,10184 ----
*************** pragma Extend_System (Aux_DEC);
*** 10068,10074 ****
  @noindent
  In the presence of this pragma, GNAT adds to the definition of the
  predefined package SYSTEM all the additional types and subprograms that are
! defined in DEC Ada. See @ref{Compatibility with DEC Ada} for details.
  @end ifset
  
  @node Handling Arbitrary File Naming Conventions Using gnatname
--- 10273,10279 ----
  @noindent
  In the presence of this pragma, GNAT adds to the definition of the
  predefined package SYSTEM all the additional types and subprograms that are
! defined in HP Ada. See @ref{Compatibility with HP Ada} for details.
  @end ifset
  
  @node Handling Arbitrary File Naming Conventions Using gnatname
*************** are used in this example.
*** 10324,10330 ****
  * Variables from Imported Projects::
  * Naming Schemes::
  * Library Projects::
- * Using Third-Party Libraries through Projects::
  * Stand-alone Library Projects::
  * Switches Related to Project Files::
  * Tools Supporting Project Files::
--- 10529,10534 ----
*************** is equivalent to the @command{gnatmake} 
*** 10873,10878 ****
--- 11077,11083 ----
  
  @node Importing Other Projects
  @subsection Importing Other Projects
+ @cindex @code{ADA_PROJECT_PATH}
  
  @noindent
  A compilation unit in a source file in one project may depend on compilation
*************** The following attributes are defined on 
*** 11455,11466 ****
  @tab string
  @item @code{Locally_Removed_Files}
  @tab string list
- @item @code{Main}
- @tab string list
  @item @code{Languages}
  @tab string list
! @item @code{Main_Language}
! @tab string
  @item @code{Library_Dir}
  @tab string
  @item @code{Library_Name}
--- 11660,11669 ----
  @tab string
  @item @code{Locally_Removed_Files}
  @tab string list
  @item @code{Languages}
  @tab string list
! @item @code{Main}
! @tab string list
  @item @code{Library_Dir}
  @tab string
  @item @code{Library_Name}
*************** The following attributes are defined on 
*** 11475,11482 ****
--- 11678,11697 ----
  @tab string
  @item @code{Library_Options}
  @tab string list
+ @item @code{Library_Src_Dir}
+ @tab string
+ @item @code{Library_ALI_Dir}
+ @tab string
  @item @code{Library_GCC}
  @tab string
+ @item @code{Library_Symbol_File}
+ @tab string
+ @item @code{Library_Symbol_Policy}
+ @tab string
+ @item @code{Library_Reference_Symbol_File}
+ @tab string
+ @item @code{Externally_Built}
+ @tab string
  @end multitable
  
  @noindent
*************** define a package @code{Naming} (@pxref{N
*** 11907,11912 ****
--- 12122,12128 ----
  
  @node  Importing Projects
  @section Importing Projects
+ @cindex @code{ADA_PROJECT_PATH}
  
  @noindent
  An immediate source of a project P may depend on source files that
*************** use literal strings instead of names, an
*** 11930,11948 ****
  project files rather than packages.
  
  Each literal string is the file name or path name (absolute or relative) of a
! project file. If a string is simply a file name, with no path, then its
! location is determined by the @emph{project path}:
  
  @itemize @bullet
  @item
! If the ^environment variable^logical name^ @env{ADA_PROJECT_PATH} exists,
! then the project path includes all the directories in this
! ^environment variable^logical name^, plus the directory of the project file.
  
  @item
! If the ^environment variable^logical name^ @env{ADA_PROJECT_PATH} does not
! exist, then the project path contains only one directory, namely the one where
! the project file is located.
  @end itemize
  
  @noindent
--- 12146,12169 ----
  project files rather than packages.
  
  Each literal string is the file name or path name (absolute or relative) of a
! project file. If a string corresponds to a file name, with no path or a
! relative path, then its location is determined by the @emph{project path}. The
! latter can be queried using @code{gnatls -v}. It contains:
  
  @itemize @bullet
  @item
! In first position, the directory containing the current project file.
! @item
! In last position, the default project directory. This default project directory
! is part of the GNAT installation and is the standard place to install project
! files giving access to standard support libraries.
! @ifclear vms
! @ref{Installing a library}
! @end ifclear
  
  @item
! In between, all the directories referenced in the
! ^environment variable^logical name^ @env{ADA_PROJECT_PATH} if it exists.
  @end itemize
  
  @noindent
*************** If a relative pathname is used, as in
*** 11953,11961 ****
  @end smallexample
  
  @noindent
! then the path is relative to the directory where the importing project file is
! located. Any symbolic link will be fully resolved in the directory
! of the importing project file before the imported project file is examined.
  
  If the @code{with}'ed project file name does not have an extension,
  the default is @file{^.gpr^.GPR^}. If a file with this extension is not found,
--- 12174,12183 ----
  @end smallexample
  
  @noindent
! then the full path for the project is constructed by concatenating this
! relative path to those in the project path, in order, until a matching file is
! found. Any symbolic link will be fully resolved in the directory of the
! importing project file before the imported project file is examined.
  
  If the @code{with}'ed project file name does not have an extension,
  the default is @file{^.gpr^.GPR^}. If a file with this extension is not found,
*************** package models the Apex file naming rule
*** 12371,12377 ****
  @end ifclear
  
  @ifset vms
! For example, the following package models the DEC Ada file naming rules:
  
  @smallexample @c projectfile
  @group
--- 12593,12599 ----
  @end ifclear
  
  @ifset vms
! For example, the following package models the HP Ada file naming rules:
  
  @smallexample @c projectfile
  @group
*************** sensitive or insensitive depending on th
*** 12491,12512 ****
  
  To create a library project, you need to define in its project file
  two project-level attributes: @code{Library_Name} and @code{Library_Dir}.
! Additionally, you may define the library-related attributes
  @code{Library_Kind}, @code{Library_Version}, @code{Library_Interface},
  @code{Library_Auto_Init}, @code{Library_Options} and @code{Library_GCC}.
  
  The @code{Library_Name} attribute has a string value. There is no restriction
! on the name of a library. It is the responsability of the developer to
! choose a name that will be accepted by the platform. It is recommanded to
  choose names that could be Ada identifiers; such names are almost guaranteed
  to be acceptable on all platforms.
  
  The @code{Library_Dir} attribute has a string value that designates the path
  (absolute or relative) of the directory where the library will reside.
! It must designate an existing directory, and this directory must be
! different from the project's object directory. It also needs to be writable.
! The directory should only be used for one library; the reason is that all
! files contained in this directory may be deleted by the Project Manager.
  
  If both @code{Library_Name} and @code{Library_Dir} are specified and
  are legal, then the project file defines a library project.  The optional
--- 12713,12733 ----
  
  To create a library project, you need to define in its project file
  two project-level attributes: @code{Library_Name} and @code{Library_Dir}.
! Additionally, you may define other library-related attributes such as
  @code{Library_Kind}, @code{Library_Version}, @code{Library_Interface},
  @code{Library_Auto_Init}, @code{Library_Options} and @code{Library_GCC}.
  
  The @code{Library_Name} attribute has a string value. There is no restriction
! on the name of a library. It is the responsibility of the developer to
! choose a name that will be accepted by the platform. It is recommended to
  choose names that could be Ada identifiers; such names are almost guaranteed
  to be acceptable on all platforms.
  
  The @code{Library_Dir} attribute has a string value that designates the path
  (absolute or relative) of the directory where the library will reside.
! It must designate an existing directory, and this directory must be writable,
! different from the project's object directory and from any source directory
! in the project tree.
  
  If both @code{Library_Name} and @code{Library_Dir} are specified and
  are legal, then the project file defines a library project.  The optional
*************** be generated for the latter. For such ca
*** 12526,12531 ****
--- 12747,12759 ----
  two different project files, or a single one which uses external variables
  to indicate what kind of library should be build.
  
+ The @code{Library_ALI_Dir} attribute may be specified to indicate the
+ directory where the ALI files of the libriry will be copied. When it is
+ not specified, the ALI files are copied ti the directory specified in
+ attribute @code{Library_Dir}. The directory specified by @code{Library_ALI_Dir}
+ must be writable and different from the project's object directory and from
+ any source directory in the project tree.
+ 
  The @code{Library_Version} attribute has a string value whose interpretation
  is platform dependent. It has no effect on VMS and Windows. On Unix, it is
  used only for dynamic/relocatable libraries as the internal name of the
*************** if @file{a1.ads}, @file{a2.ads} or @file
*** 12578,12584 ****
  @code{"with L1;"}.
  
  To be sure that all the sources in the library associated with @code{L} are
! up to date, and that all the sources of parject @code{A} are also up to date,
  the following two commands needs to be used:
  
  @smallexample
--- 12806,12812 ----
  @code{"with L1;"}.
  
  To be sure that all the sources in the library associated with @code{L} are
! up to date, and that all the sources of project @code{A} are also up to date,
  the following two commands needs to be used:
  
  @smallexample
*************** All @file{ALI} files will also be copied
*** 12592,12657 ****
  library directory. To build executables, @command{gnatmake} will use the
  library rather than the individual object files.
  
! @c **********************************************
! @c * Using Third-Party Libraries through Projects
! @c **********************************************
! @node Using Third-Party Libraries through Projects
! @section Using Third-Party Libraries through Projects
! 
! Whether you are exporting your own library to make it available to
! clients, or you are using a library provided by a third party, it is
! convenient to have project files that automatically set the correct
! command line switches for the compiler and linker.
! 
! Such project files are very similar to the library project files;
! @xref{Library Projects}. The only difference is that you set the
! @code{Source_Dirs} and @code{Object_Dir} attribute so that they point to the
! directories where, respectively, the sources and the read-only ALI files have
! been installed.
! 
! If you need to interface with a set of libraries, as opposed to a
! single one, you need to create one library project for each of the
! libraries. In addition, a top-level project that imports all these
! library projects should be provided, so that the user of your library
! has a single @code{with} clause to add to his own projects.
! 
! For instance, let's assume you are providing two static libraries
! @file{liba.a} and @file{libb.a}. The user needs to link with
! both of these libraries. Each of these is associated with its
! own set of header files. Let's assume furthermore that all the
! header files for the two libraries have been installed in the same
! directory @file{headers}. The @file{ALI} files are found in the same
! @file{headers} directory.
! 
! In this case, you should provide the following three projects:
! 
! @smallexample @c projectfile
! @group
! with "liba", "libb";
! project My_Library is
!   for Source_Dirs use ("headers");
!   for Object_Dir  use "headers";
! end My_Library;
! @end group
! 
! @group
! project Liba is
!    for Source_Dirs use ();
!    for Library_Dir use "lib";
!    for Library_Name use "a";
!    for Library_Kind use "static";
! end Liba;
! @end group
! 
! @group
! project Libb is
!    for Source_Dirs use ();
!    for Library_Dir use "lib";
!    for Library_Name use "b";
!    for Library_Kind use "static";
! end Libb;
! @end group
! @end smallexample
  
  @c *******************************
  @c * Stand-alone Library Projects *
--- 12820,12830 ----
  library directory. To build executables, @command{gnatmake} will use the
  library rather than the individual object files.
  
! @ifclear vms
! It is also possible to create library project files for third-party libraries
! that are precompiled and cannot be compiled locally thanks to the
! @code{externally_built} attribute. (See @ref{Installing a library}).
! @end ifclear
  
  @c *******************************
  @c * Stand-alone Library Projects *
*************** with all the immediate sources of the sp
*** 13349,13354 ****
--- 13522,13538 ----
  of the project.
  
  @noindent
+ In addition, when GNAT PP, GNAT PRETTY or GNAT METRIC is used with
+ a project file, no source is specified on the command line and
+ switch ^-U^/ALL_PROJECTS^ is specified on the command line, then
+ the underlying tool (^gnatpp^gnatpp^ or
+ ^gnatmetric^gnatmetric^) is invoked for all sources of all projects,
+ not only for the immediate sources of the main project.
+ @ifclear vms
+ (-U stands for Universal or Union of the project files of the project tree)
+ @end ifclear
+ 
+ @noindent
  For each of the following commands, there is optionally a corresponding
  package in the main project.
  
*************** Align @code{:=} in assignment statements
*** 14641,14647 ****
  Align @code{=>} in associations
  
  @item ^-A5^/ALIGN=COMPONENT_CLAUSES^
! Align @code{at} keywords in the component clauses in record representation clauses
  @end table
  
  @noindent
--- 14825,14832 ----
  Align @code{=>} in associations
  
  @item ^-A5^/ALIGN=COMPONENT_CLAUSES^
! Align @code{at} keywords in the component clauses in record
! representation clauses
  @end table
  
  @noindent
*************** Compact layout
*** 14778,14788 ****
  @item ^-l3^/CONSTRUCT_LAYOUT=UNCOMPACT^
  Uncompact layout
  
! @item ^-notab^/NOTABS^
  All the VT characters are removed from the comment text. All the HT characters
  are expanded with the sequences of space characters to get to the next tab
  stops.
  
  @end table
  
  @ifclear vms
--- 14963,14979 ----
  @item ^-l3^/CONSTRUCT_LAYOUT=UNCOMPACT^
  Uncompact layout
  
! @cindex @option{^-N^/NOTABS^} (@command{gnatpp})
! @item ^-N^/NOTABS^
  All the VT characters are removed from the comment text. All the HT characters
  are expanded with the sequences of space characters to get to the next tab
  stops.
  
+ @cindex @option{^--no-separate-is^/NO_SEPARATE_IS^} (@command{gnatpp})
+ @item ^--no-separate-is^/NO_SEPARATE_IS^
+ Do not place the keyword @code{is} on a separate line in a subprogram body in
+ case if the specification occupies more then one line.
+ 
  @end table
  
  @ifclear vms
*************** already exists, it is overwritten.
*** 14940,14952 ****
  @cindex @option{^-rnb^/NO_BACKUP^} (@code{gnatpp})
  Replace the input source file with the reformatted output without
  creating any backup copy of the input source.
  @end table
  
  @noindent
  Options @option{^-pipe^/STANDARD_OUTPUT^},
  @option{^-o^/OUTPUT^} and
  @option{^-of^/FORCED_OUTPUT^} are allowed only if the call to gnatpp
! contains only one file to reformat
  
  @node Other gnatpp Switches
  @subsection Other @code{gnatpp} Switches
--- 15131,15161 ----
  @cindex @option{^-rnb^/NO_BACKUP^} (@code{gnatpp})
  Replace the input source file with the reformatted output without
  creating any backup copy of the input source.
+ 
+ @item ^--eol=@var{xxx}^/END_OF_LINE=@var{xxx}^
+ @cindex @option{^--eol^/END_OF_LINE^} (@code{gnatpp})
+ Specifies the format of the reformatted output file. The @var{xxx}
+ ^string specified with the switch^option^ may be either
+ @itemize @bullet
+ @item ``@option{^dos^DOS^}'' MS DOS style, lines end with CR LF characters
+ @item ``@option{^crlf^CRLF^}''
+ the same as @option{^crlf^CRLF^}
+ @item ``@option{^unix^UNIX^}'' UNIX style, lines end with LF character
+ @item ``@option{^lf^LF^}''
+ the same as @option{^unix^UNIX^}
+ @end itemize
+ 
  @end table
  
  @noindent
  Options @option{^-pipe^/STANDARD_OUTPUT^},
  @option{^-o^/OUTPUT^} and
  @option{^-of^/FORCED_OUTPUT^} are allowed only if the call to gnatpp
! contains only one file to reformat.
! Option
! @option{^--eol^/END_OF_LINE^}
! cannot be used together
! with @option{^-pipe^/STANDARD_OUTPUT^} option.
  
  @node Other gnatpp Switches
  @subsection Other @code{gnatpp} Switches
*************** a trace of the actions it takes to produ
*** 14972,14978 ****
  @item ^-w^/WARNINGS^
  @cindex @option{^-w^/WARNINGS^} (@code{gnatpp})
  Warning mode;
! @command{gnatpp} generates a warning whenever it can not provide
  a required layout in the result source.
  @end table
  
--- 15181,15187 ----
  @item ^-w^/WARNINGS^
  @cindex @option{^-w^/WARNINGS^} (@code{gnatpp})
  Warning mode;
! @command{gnatpp} generates a warning whenever it cannot provide
  a required layout in the result source.
  @end table
  
*************** affected cases include:
*** 15189,15195 ****
  @noindent
  In compact mode (when GNAT style layout or compact layout is set),
  the pretty printer uses one level of indentation instead
! of two. This is achived in the record definition and record representation
  clause cases by putting the @code{record} keyword on the same line as the
  start of the declaration or representation clause, and in the block and loop
  case by putting the block or loop header on the same line as the statement
--- 15398,15404 ----
  @noindent
  In compact mode (when GNAT style layout or compact layout is set),
  the pretty printer uses one level of indentation instead
! of two. This is achieved in the record definition and record representation
  clause cases by putting the @code{record} keyword on the same line as the
  start of the declaration or representation clause, and in the block and loop
  case by putting the block or loop header on the same line as the statement
*************** A casing schema is a string that has the
*** 15382,15397 ****
  
  @smallexample
  @cartouche
!   @var{casing_schema} ::= @var{identifier} | [*]@var{simple_identifier}[*]
  
    @var{simple_identifier} ::= @var{letter}@{@var{letter_or_digit}@}
  @end cartouche
  @end smallexample
  
  @noindent
! (The @code{[]} metanotation stands for an optional part;
! see @cite{Ada Reference Manual}, Section 2.3) for the definition of the
! @var{identifier} lexical element and the @var{letter_or_digit} category).
  
  The casing schema string can be followed by white space and/or an Ada-style
  comment; any amount of white space is allowed before the string.
--- 15591,15605 ----
  
  @smallexample
  @cartouche
!   @var{casing_schema} ::= @var{identifier} | *@var{simple_identifier}*
  
    @var{simple_identifier} ::= @var{letter}@{@var{letter_or_digit}@}
  @end cartouche
  @end smallexample
  
  @noindent
! (See @cite{Ada Reference Manual}, Section 2.3) for the definition of the
! @var{identifier} lexical element and the @var{letter_or_digit} category.)
  
  The casing schema string can be followed by white space and/or an Ada-style
  comment; any amount of white space is allowed before the string.
*************** if the whole name is in the dictionary, 
*** 15415,15436 ****
  the casing defined by the dictionary; no subwords are checked for this word
  
  @item
! for the first subword (that is, for the subword preceding the leftmost
! ``_''), @command{gnatpp} checks if the dictionary contains the corresponding
! string of the form @code{@var{simple_identifier}*}, and if it does, the
! casing of this @var{simple_identifier} is used for this subword
! 
! @item
! for the last subword (following the rightmost ``_'') @command{gnatpp}
! checks if the dictionary contains the corresponding string of the form
! @code{*@var{simple_identifier}}, and if it does, the casing of this
! @var{simple_identifier} is used for this subword
  
  @item
! for every intermediate subword (surrounded by two'_') @command{gnatpp} checks
! if the dictionary contains the corresponding string of the form
! @code{*@var{simple_identifier}*}, and if it does, the casing of this
! simple_identifier is used for this subword
  
  @item
  if more than one dictionary file is passed as @command{gnatpp} switches, each
--- 15623,15638 ----
  the casing defined by the dictionary; no subwords are checked for this word
  
  @item
! for every subword @command{gnatpp} checks if the dictionary contains the
! corresponding string of the form @code{*@var{simple_identifier}*},
! and if it does, the casing of this @var{simple_identifier} is used
! for this subword
  
  @item
! if the whole name does not contain any ``_'' inside, and if for this name
! the dictionary contains two entries - one of the form @var{identifier},
! and another - of the form *@var{simple_identifier}*, then the first one
! is applied to define the casing of this name
  
  @item
  if more than one dictionary file is passed as @command{gnatpp} switches, each
*************** And suppose we have two dictionaries:
*** 15466,15472 ****
  @i{dict1:}
     NAME1
     *NaMe3*
!    *NAME2
  @end cartouche
  
  @cartouche
--- 15668,15674 ----
  @i{dict1:}
     NAME1
     *NaMe3*
!    *Name1*
  @end cartouche
  
  @cartouche
*************** then we will get the following name casi
*** 15494,15504 ****
  @cartouche
  procedure Test is
     NAME1             : Integer := 1;
!    Name4_NAME3_NAME2 : integer := 2;
     Name2_NAME3_Name4 : Boolean;
     Name1_Var         : Float;
  begin
!    Name2_NAME3_Name4 := Name4_NAME3_NAME2 > NAME1;
  end Test;
  @end cartouche
  @end smallexample
--- 15696,15706 ----
  @cartouche
  procedure Test is
     NAME1             : Integer := 1;
!    Name4_NAME3_Name2 : Integer := 2;
     Name2_NAME3_Name4 : Boolean;
     Name1_Var         : Float;
  begin
!    Name2_NAME3_Name4 := Name4_NAME3_Name2 > NAME1;
  end Test;
  @end cartouche
  @end smallexample
*************** upon units in files located outside the 
*** 15528,15535 ****
  the source search path when invoking @command{gnatmetric}.
  If it depends semantically upon units that are contained
  in files with names that do not follow the GNAT file naming rules, you have to
! provide the configuration file describing the corresponding naming scheme; see
! the description of the @command{gnatmetric} switches below.
  Alternatively, you may use a project file and invoke @command{gnatmetric}
  through the @command{gnat} driver.
  
--- 15730,15737 ----
  the source search path when invoking @command{gnatmetric}.
  If it depends semantically upon units that are contained
  in files with names that do not follow the GNAT file naming rules, you have to
! provide the configuration file describing the corresponding naming scheme (see
! the description of the @command{gnatmetric} switches below.)
  Alternatively, you may use a project file and invoke @command{gnatmetric}
  through the @command{gnat} driver.
  
*************** an explicit list of files.
*** 15975,15981 ****
  @cindex @option{^-v^/VERBOSE^} (@code{gnatmetric})
  Verbose mode;
  @command{gnatmetric} generates version information and then
! a trace of sources being procesed.
  
  @item ^-dv^/DEBUG_OUTPUT^
  @cindex @option{^-dv^/DEBUG_OUTPUT^} (@code{gnatmetric})
--- 16177,16183 ----
  @cindex @option{^-v^/VERBOSE^} (@code{gnatmetric})
  Verbose mode;
  @command{gnatmetric} generates version information and then
! a trace of sources being processed.
  
  @item ^-dv^/DEBUG_OUTPUT^
  @cindex @option{^-dv^/DEBUG_OUTPUT^} (@code{gnatmetric})
*************** all upper case). Characters of the other
*** 16081,16087 ****
  @var{length} represents the length of the krunched name. The default
  when no argument is given is ^8^39^ characters. A length of zero stands for
  unlimited, in other words do not chop except for system files where the
! impled crunching length is always eight characters.
  
  @noindent
  The output is the krunched name. The output has an extension only if the
--- 16283,16289 ----
  @var{length} represents the length of the krunched name. The default
  when no argument is given is ^8^39^ characters. A length of zero stands for
  unlimited, in other words do not chop except for system files where the
! implied crunching length is always eight characters.
  
  @noindent
  The output is the krunched name. The output has an extension only if the
*************** by preprocessing to be retained in the o
*** 16268,16273 ****
--- 16470,16485 ----
  with the special string @code{"--! "}. This option will result in line numbers
  being preserved in the output file.
  
+ @item ^-C^/REPLACE_IN_COMMENTS^
+ @cindex @option{^-C^/REPLACE_IN_COMMENTS^} (@command{gnatprep})
+ Causes comments to be scanned. Normally comments are ignored by gnatprep.
+ If this option is specified, then comments are scanned and any $symbol
+ substitutions performed as in program text. This is particularly useful
+ when structured comments are used (e.g. when writing programs in the
+ SPARK dialect of Ada). Note that this switch is not available when
+ doing integrated preprocessing (it would be useless in this context
+ since comments are ignored by the compiler in any case).
+ 
  @item ^-Dsymbol=value^/ASSOCIATE="symbol=value"^
  @cindex @option{^-D^/ASSOCIATE^} (@command{gnatprep})
  Defines a new symbol, associated with value. If no value is given on the
*************** Source Search Path:
*** 16734,16740 ****
  Object Search Path:
     <Current_Directory>
     ../
!    /home/comar/local/lib/gcc-lib/mips-sni-sysv4/2.7.2/adalib/
  
  Project Search Path:
     <Current_Directory>
--- 16946,16952 ----
  Object Search Path:
     <Current_Directory>
     ../
!    /home/comar/local/lib/gcc-lib/x86-linux/3.4.3/adalib/
  
  Project Search Path:
     <Current_Directory>
*************** generated files and executable files.
*** 16831,16837 ****
  @menu
  * Running gnatclean::
  * Switches for gnatclean::
! * Examples of gnatclean Usage::
  @end menu
  
  @node Running gnatclean
--- 17043,17049 ----
  @menu
  * Running gnatclean::
  * Switches for gnatclean::
! @c * Examples of gnatclean Usage::
  @end menu
  
  @node Running gnatclean
*************** where @code{gnatclean} was invoked.
*** 16945,16952 ****
  
  @end table
  
! @node Examples of gnatclean Usage
! @section Examples of @code{gnatclean} Usage
  
  @ifclear vms
  @node GNAT and Libraries
--- 17157,17164 ----
  
  @end table
  
! @c @node Examples of gnatclean Usage
! @c @section Examples of @code{gnatclean} Usage
  
  @ifclear vms
  @node GNAT and Libraries
*************** the directive @option{-lxxx} at link tim
*** 17135,17140 ****
--- 17347,17353 ----
  
  @node Installing a library
  @subsection Installing a library
+ @cindex @code{ADA_PROJECT_PATH}
  
  @noindent
  If you use project files, library installation is part of the library build
*************** responsibility of the library provider t
*** 17174,17180 ****
  files and libraries in the directories mentioned in the project file. For
  convenience, the user's library project file should be installed in a location
  that will be searched automatically by the GNAT
! builder. These are the directories referenced in the @code{ADA_LIBRARY_PATH}
  environment variable (@pxref{Importing Projects}), and also the default GNAT
  library location that can be queried with @command{gnatls -v} and is usually of
  the form $gnat_install_root/lib/gnat.
--- 17387,17393 ----
  files and libraries in the directories mentioned in the project file. For
  convenience, the user's library project file should be installed in a location
  that will be searched automatically by the GNAT
! builder. These are the directories referenced in the @code{ADA_PROJECT_PATH}
  environment variable (@pxref{Importing Projects}), and also the default GNAT
  library location that can be queried with @command{gnatls -v} and is usually of
  the form $gnat_install_root/lib/gnat.
*************** third-party library @file{liba.a}:
*** 17247,17259 ****
  @smallexample @c projectfile
  @group
  project Liba is
!    for Source_Dirs use ();
     for Library_Dir use "lib";
     for Library_Name use "a";
     for Library_Kind use "static";
  end Liba;
  @end group
  @end smallexample
  
  @noindent
  In order to use an Ada library manually, you need to make sure that this
--- 17460,17476 ----
  @smallexample @c projectfile
  @group
  project Liba is
!    for Externally_Built use "true";
     for Library_Dir use "lib";
     for Library_Name use "a";
     for Library_Kind use "static";
  end Liba;
  @end group
  @end smallexample
+ This is an alternative to the use of @code{pragma Linker_Options}. It is
+ especially interesting in the context of systems with several interdependant
+ static libraries where finding a proper linker order is not easy and best be
+ left to the tools having visibility over project dependancy information.
  
  @noindent
  In order to use an Ada library manually, you need to make sure that this
*************** allocation and deallocation routines tha
*** 18139,18145 ****
  allows to obtain accurate dynamic memory usage history at a minimal cost to
  the execution speed. Note however, that @code{gnatmem} is not supported on
  all platforms (currently, it is supported on AIX, HP-UX, GNU/Linux x86,
! Solaris (sparc and x86) and Windows NT/2000/XP (x86).
  
  @noindent
  The @code{gnatmem} command has the form
--- 18356,18362 ----
  allows to obtain accurate dynamic memory usage history at a minimal cost to
  the execution speed. Note however, that @code{gnatmem} is not supported on
  all platforms (currently, it is supported on AIX, HP-UX, GNU/Linux x86,
! 32-bit Solaris (sparc and x86) and Windows NT/2000/XP (x86).
  
  @noindent
  The @code{gnatmem} command has the form
*************** $ perl gnathtml.pl [switches] files
*** 18941,18947 ****
  @findex LSE
  
  @noindent
! The GNAT distribution provides an Ada 95 template for the Digital Language
  Sensitive Editor (LSE), a component of DECset. In order to
  access it, invoke LSE with the qualifier /ENVIRONMENT=GNU:[LIB]ADA95.ENV.
  
--- 19158,19164 ----
  @findex LSE
  
  @noindent
! The GNAT distribution provides an Ada 95 template for the HP Language
  Sensitive Editor (LSE), a component of DECset. In order to
  access it, invoke LSE with the qualifier /ENVIRONMENT=GNU:[LIB]ADA95.ENV.
  
*************** access it, invoke LSE with the qualifier
*** 18950,18956 ****
  @findex PCA
  
  @noindent
! GNAT supports The Digital Performance Coverage Analyzer (PCA), a component
  of DECset. To use it proceed as outlined under ``HELP PCA'', except for running
  the collection phase with the /DEBUG qualifier.
  
--- 19167,19173 ----
  @findex PCA
  
  @noindent
! GNAT supports The HP Performance Coverage Analyzer (PCA), a component
  of DECset. To use it proceed as outlined under ``HELP PCA'', except for running
  the collection phase with the /DEBUG qualifier.
  
*************** end STB;
*** 20025,20047 ****
  @end smallexample
  
  @ifset vms
! @node Compatibility with DEC Ada
! @chapter Compatibility with DEC Ada
  @cindex Compatibility
  
  @noindent
! This section of the manual compares DEC Ada for OpenVMS Alpha and GNAT
  OpenVMS Alpha. GNAT achieves a high level of compatibility
! with DEC Ada, and it should generally be straightforward to port code
! from the DEC Ada environment to GNAT. However, there are a few language
  and implementation differences of which the user must be aware. These
  differences are discussed in this section. In
  addition, the operating environment and command structure for the
  compiler are different, and these differences are also discussed.
  
  Note that this discussion addresses specifically the implementation
! of Ada 83 for DIGITAL OpenVMS Alpha Systems. In cases where the implementation
! of DEC Ada differs between OpenVMS Alpha Systems and OpenVMS VAX Systems,
  GNAT always follows the Alpha implementation.
  
  @menu
--- 20242,20264 ----
  @end smallexample
  
  @ifset vms
! @node Compatibility with HP Ada
! @chapter Compatibility with HP Ada
  @cindex Compatibility
  
  @noindent
! This section of the manual compares HP Ada for OpenVMS Alpha and GNAT
  OpenVMS Alpha. GNAT achieves a high level of compatibility
! with HP Ada, and it should generally be straightforward to port code
! from the HP Ada environment to GNAT. However, there are a few language
  and implementation differences of which the user must be aware. These
  differences are discussed in this section. In
  addition, the operating environment and command structure for the
  compiler are different, and these differences are also discussed.
  
  Note that this discussion addresses specifically the implementation
! of Ada 83 for HP OpenVMS Alpha Systems. In cases where the implementation
! of HP Ada differs between OpenVMS Alpha Systems and OpenVMS VAX Systems,
  GNAT always follows the Alpha implementation.
  
  @menu
*************** GNAT always follows the Alpha implementa
*** 20051,20057 ****
  * The Package STANDARD::
  * The Package SYSTEM::
  * Tasking and Task-Related Features::
! * Implementation of Tasks in DEC Ada for OpenVMS Alpha Systems::
  * Pragmas and Pragma-Related Features::
  * Library of Predefined Units::
  * Bindings::
--- 20268,20274 ----
  * The Package STANDARD::
  * The Package SYSTEM::
  * Tasking and Task-Related Features::
! * Implementation of Tasks in HP Ada for OpenVMS Alpha Systems::
  * Pragmas and Pragma-Related Features::
  * Library of Predefined Units::
  * Bindings::
*************** GNAT always follows the Alpha implementa
*** 20061,20074 ****
  * Program Compilation and Library Management::
  * Input-Output::
  * Implementation Limits::
- * Tools::
  @end menu
  
  @node Ada 95 Compatibility
  @section Ada 95 Compatibility
  
  @noindent
! GNAT is an Ada 95 compiler, and DEC Ada is an Ada 83
  compiler. Ada 95 is almost completely upwards compatible
  with Ada 83, and therefore Ada 83 programs will compile
  and run under GNAT with
--- 20278,20290 ----
  * Program Compilation and Library Management::
  * Input-Output::
  * Implementation Limits::
  @end menu
  
  @node Ada 95 Compatibility
  @section Ada 95 Compatibility
  
  @noindent
! GNAT is an Ada 95 compiler, and HP Ada is an Ada 83
  compiler. Ada 95 is almost completely upwards compatible
  with Ada 83, and therefore Ada 83 programs will compile
  and run under GNAT with
*************** implementation-dependent declarations to
*** 20096,20103 ****
  GNAT does not take advantage of this permission, and the version of System
  provided by GNAT exactly matches that in the Ada 95 Reference Manual.
  
! However, DEC Ada adds an extensive set of declarations to package System,
! as fully documented in the DEC Ada manuals. To minimize changes required
  for programs that make use of these extensions, GNAT provides the pragma
  Extend_System for extending the definition of package System. By using:
  
--- 20312,20319 ----
  GNAT does not take advantage of this permission, and the version of System
  provided by GNAT exactly matches that in the Ada 95 Reference Manual.
  
! However, HP Ada adds an extensive set of declarations to package System,
! as fully documented in the HP Ada manuals. To minimize changes required
  for programs that make use of these extensions, GNAT provides the pragma
  Extend_System for extending the definition of package System. By using:
  
*************** related topics.
*** 20167,20178 ****
  @subsection Integer Types and Representations
  
  @noindent
! The set of predefined integer types is identical in DEC Ada and GNAT.
  Furthermore the representation of these integer types is also identical,
  including the capability of size clauses forcing biased representation.
  
  In addition,
! DEC Ada for OpenVMS Alpha systems has defined the
  following additional integer types in package System:
  
  @itemize @bullet
--- 20383,20394 ----
  @subsection Integer Types and Representations
  
  @noindent
! The set of predefined integer types is identical in HP Ada and GNAT.
  Furthermore the representation of these integer types is also identical,
  including the capability of size clauses forcing biased representation.
  
  In addition,
! HP Ada for OpenVMS Alpha systems has defined the
  following additional integer types in package System:
  
  @itemize @bullet
*************** standard Ada 95 package @code{Interfaces
*** 20199,20219 ****
  Alternatively, by use of the pragma
  @code{Extend_System}, identical
  declarations can be referenced directly in package @code{System}.
! On both GNAT and DEC Ada, the maximum integer size is 64 bits.
  
  @node Floating-Point Types and Representations
  @subsection Floating-Point Types and Representations
  @cindex Floating-Point types
  
  @noindent
! The set of predefined floating-point types is identical in DEC Ada and GNAT.
  Furthermore the representation of these floating-point
  types is also identical. One important difference is that the default
! representation for DEC Ada is VAX_Float, but the default representation
  for GNAT is IEEE.
  
  Specific types may be declared to be VAX_Float or IEEE, using the pragma
! @code{Float_Representation} as described in the DEC Ada documentation.
  For example, the declarations:
  
  @smallexample @c ada
--- 20415,20435 ----
  Alternatively, by use of the pragma
  @code{Extend_System}, identical
  declarations can be referenced directly in package @code{System}.
! On both GNAT and HP Ada, the maximum integer size is 64 bits.
  
  @node Floating-Point Types and Representations
  @subsection Floating-Point Types and Representations
  @cindex Floating-Point types
  
  @noindent
! The set of predefined floating-point types is identical in HP Ada and GNAT.
  Furthermore the representation of these floating-point
  types is also identical. One important difference is that the default
! representation for HP Ada is VAX_Float, but the default representation
  for GNAT is IEEE.
  
  Specific types may be declared to be VAX_Float or IEEE, using the pragma
! @code{Float_Representation} as described in the HP Ada documentation.
  For example, the declarations:
  
  @smallexample @c ada
*************** pragma Float_Representation (VAX_Float, 
*** 20229,20235 ****
  declare a type F_Float that will be represented in VAX_Float format.
  This set of declarations actually appears in System.Aux_DEC, which provides
  the full set of additional floating-point declarations provided in
! the DEC Ada version of package
  System. This and similar declarations may be accessed in a user program
  by using pragma @code{Extend_System}. The use of this
  pragma, and the related pragma @code{Long_Float} is described in further
--- 20445,20451 ----
  declare a type F_Float that will be represented in VAX_Float format.
  This set of declarations actually appears in System.Aux_DEC, which provides
  the full set of additional floating-point declarations provided in
! the HP Ada version of package
  System. This and similar declarations may be accessed in a user program
  by using pragma @code{Extend_System}. The use of this
  pragma, and the related pragma @code{Long_Float} is described in further
*************** detail in the following section.
*** 20239,20245 ****
  @subsection Pragmas Float_Representation and Long_Float
  
  @noindent
! DEC Ada provides the pragma @code{Float_Representation}, which
  acts as a program library switch to allow control over
  the internal representation chosen for the predefined
  floating-point types declared in the package @code{Standard}.
--- 20455,20461 ----
  @subsection Pragmas Float_Representation and Long_Float
  
  @noindent
! HP Ada provides the pragma @code{Float_Representation}, which
  acts as a program library switch to allow control over
  the internal representation chosen for the predefined
  floating-point types declared in the package @code{Standard}.
*************** types as follows:
*** 20260,20269 ****
  @itemize @bullet
  @item
  @code{VAX_Float} specifies that floating-point
! types are represented by default with the VAX hardware types
  F-floating, D-floating, G-floating. Note that the H-floating
! type is available only on DIGITAL Vax systems, and is not available
! in either DEC Ada or GNAT for Alpha systems.
  
  @item
  @code{IEEE_Float} specifies that floating-point
--- 20476,20485 ----
  @itemize @bullet
  @item
  @code{VAX_Float} specifies that floating-point
! types are represented by default with the VAX system hardware types
  F-floating, D-floating, G-floating. Note that the H-floating
! type was available only on Vax systems, and is not available
! in either HP Ada or GNAT for Alpha systems.
  
  @item
  @code{IEEE_Float} specifies that floating-point
*************** GNAT provides an identical implementatio
*** 20276,20285 ****
  @code{Float_Representation}, except that it functions as a
  configuration pragma, as defined by Ada 95. Note that the
  notion of configuration pragma corresponds closely to the
! DEC Ada notion of a program library switch.
  
  When no pragma is used in GNAT, the default is IEEE_Float, which is different
! from DEC Ada 83, where the default is VAX_Float. In addition, the
  predefined libraries in GNAT are built using IEEE_Float, so it is not
  advisable to change the format of numbers passed to standard library
  routines, and if necessary explicit type conversions may be needed.
--- 20492,20501 ----
  @code{Float_Representation}, except that it functions as a
  configuration pragma, as defined by Ada 95. Note that the
  notion of configuration pragma corresponds closely to the
! HP Ada notion of a program library switch.
  
  When no pragma is used in GNAT, the default is IEEE_Float, which is different
! from HP Ada 83, where the default is VAX_Float. In addition, the
  predefined libraries in GNAT are built using IEEE_Float, so it is not
  advisable to change the format of numbers passed to standard library
  routines, and if necessary explicit type conversions may be needed.
*************** and @i{directory} is the directory to be
*** 20313,20319 ****
  the new library.
  
  @noindent
! On OpenVMS systems, DEC Ada provides the pragma @code{Long_Float}
  to allow control over the internal representation chosen
  for the predefined type @code{Long_Float} and for floating-point
  type declarations with digits specified in the range 7 .. 15.
--- 20529,20535 ----
  the new library.
  
  @noindent
! On OpenVMS systems, HP Ada provides the pragma @code{Long_Float}
  to allow control over the internal representation chosen
  for the predefined type @code{Long_Float} and for floating-point
  type declarations with digits specified in the range 7 .. 15.
*************** pragma Long_Float (D_FLOAT | G_FLOAT);
*** 20329,20335 ****
  @subsection Fixed-Point Types and Representations
  
  @noindent
! On DEC Ada for OpenVMS Alpha systems, rounding is
  away from zero for both positive and negative numbers.
  Therefore, +0.5 rounds to 1 and -0.5 rounds to -1.
  
--- 20545,20551 ----
  @subsection Fixed-Point Types and Representations
  
  @noindent
! On HP Ada for OpenVMS Alpha systems, rounding is
  away from zero for both positive and negative numbers.
  Therefore, +0.5 rounds to 1 and -0.5 rounds to -1.
  
*************** fixed-point types are truncated.
*** 20342,20348 ****
  @subsection Record and Array Component Alignment
  
  @noindent
! On DEC Ada for OpenVMS Alpha, all non composite components
  are aligned on natural boundaries. For example, 1-byte
  components are aligned on byte boundaries, 2-byte
  components on 2-byte boundaries, 4-byte components on 4-byte
--- 20558,20564 ----
  @subsection Record and Array Component Alignment
  
  @noindent
! On HP Ada for OpenVMS Alpha, all non composite components
  are aligned on natural boundaries. For example, 1-byte
  components are aligned on byte boundaries, 2-byte
  components on 2-byte boundaries, 4-byte components on 4-byte
*************** byte boundaries, and so on. The OpenVMS 
*** 20350,20362 ****
  runs more efficiently with naturally aligned data.
  
  ON GNAT for OpenVMS Alpha, alignment rules are compatible
! with DEC Ada for OpenVMS Alpha.
  
  @node Address Clauses
  @subsection Address Clauses
  
  @noindent
! In DEC Ada and GNAT, address clauses are supported for
  objects and imported subprograms.
  The predefined type @code{System.Address} is a private type
  in both compilers, with the same representation (it is simply
--- 20566,20578 ----
  runs more efficiently with naturally aligned data.
  
  ON GNAT for OpenVMS Alpha, alignment rules are compatible
! with HP Ada for OpenVMS Alpha.
  
  @node Address Clauses
  @subsection Address Clauses
  
  @noindent
! In HP Ada and GNAT, address clauses are supported for
  objects and imported subprograms.
  The predefined type @code{System.Address} is a private type
  in both compilers, with the same representation (it is simply
*************** Note that code that with's both this ext
*** 20370,20379 ****
  and the package @code{System.Storage_Elements} should not @code{use}
  both packages, or ambiguities will result. In general it is better
  not to mix these two sets of facilities. The Ada 95 package was
! designed specifically to provide the kind of features that DEC Ada
  adds directly to package @code{System}.
  
! GNAT is compatible with DEC Ada in its handling of address
  clauses, except for some limitations in
  the form of address clauses for composite objects with
  initialization. Such address clauses are easily replaced
--- 20586,20595 ----
  and the package @code{System.Storage_Elements} should not @code{use}
  both packages, or ambiguities will result. In general it is better
  not to mix these two sets of facilities. The Ada 95 package was
! designed specifically to provide the kind of features that HP Ada
  adds directly to package @code{System}.
  
! GNAT is compatible with HP Ada in its handling of address
  clauses, except for some limitations in
  the form of address clauses for composite objects with
  initialization. Such address clauses are easily replaced
*************** on address specifications is found in th
*** 20416,20422 ****
  
  @noindent
  GNAT supports in a compatible manner all the representation
! clauses supported by DEC Ada. In addition, it
  supports representation clause forms that are new in Ada 95
  including COMPONENT_SIZE and SIZE clauses for objects.
  
--- 20632,20638 ----
  
  @noindent
  GNAT supports in a compatible manner all the representation
! clauses supported by HP Ada. In addition, it
  supports representation clause forms that are new in Ada 95
  including COMPONENT_SIZE and SIZE clauses for objects.
  
*************** including COMPONENT_SIZE and SIZE clause
*** 20424,20455 ****
  @section The Package STANDARD
  
  @noindent
! The package STANDARD, as implemented by DEC Ada, is fully
  described in the Reference Manual for the Ada Programming
! Language (ANSI/MIL-STD-1815A-1983) and in the DEC Ada
  Language Reference Manual. As implemented by GNAT, the
  package STANDARD is described in the Ada 95 Reference
  Manual.
  
! In addition, DEC Ada supports the Latin-1 character set in
  the type CHARACTER. GNAT supports the Latin-1 character set
  in the type CHARACTER and also Unicode (ISO 10646 BMP) in
  the type WIDE_CHARACTER.
  
  The floating-point types supported by GNAT are those
! supported by DEC Ada, but defaults are different, and are controlled by
  pragmas. See @ref{Floating-Point Types and Representations} for details.
  
  @node The Package SYSTEM
  @section The Package SYSTEM
  
  @noindent
! DEC Ada provides a system-specific version of the package
  SYSTEM for each platform on which the language ships.
  For the complete specification of the package SYSTEM, see
! Appendix F of the DEC Ada Language Reference Manual.
  
! On DEC Ada, the package SYSTEM includes the following conversion functions:
  @itemize @bullet
  @item TO_ADDRESS(INTEGER)
  
--- 20640,20671 ----
  @section The Package STANDARD
  
  @noindent
! The package STANDARD, as implemented by HP Ada, is fully
  described in the Reference Manual for the Ada Programming
! Language (ANSI/MIL-STD-1815A-1983) and in the HP Ada
  Language Reference Manual. As implemented by GNAT, the
  package STANDARD is described in the Ada 95 Reference
  Manual.
  
! In addition, HP Ada supports the Latin-1 character set in
  the type CHARACTER. GNAT supports the Latin-1 character set
  in the type CHARACTER and also Unicode (ISO 10646 BMP) in
  the type WIDE_CHARACTER.
  
  The floating-point types supported by GNAT are those
! supported by HP Ada, but defaults are different, and are controlled by
  pragmas. See @ref{Floating-Point Types and Representations} for details.
  
  @node The Package SYSTEM
  @section The Package SYSTEM
  
  @noindent
! HP Ada provides a system-specific version of the package
  SYSTEM for each platform on which the language ships.
  For the complete specification of the package SYSTEM, see
! Appendix F of the HP Ada Language Reference Manual.
  
! On HP Ada, the package SYSTEM includes the following conversion functions:
  @itemize @bullet
  @item TO_ADDRESS(INTEGER)
  
*************** On DEC Ada, the package SYSTEM includes 
*** 20469,20475 ****
  By default, GNAT supplies a version of SYSTEM that matches
  the definition given in the Ada 95 Reference Manual.
  This
! is a subset of the DIGITAL system definitions, which is as
  close as possible to the original definitions. The only difference
  is that the definition of SYSTEM_NAME is different:
  
--- 20685,20691 ----
  By default, GNAT supplies a version of SYSTEM that matches
  the definition given in the Ada 95 Reference Manual.
  This
! is a subset of the HP system definitions, which is as
  close as possible to the original definitions. The only difference
  is that the definition of SYSTEM_NAME is different:
  
*************** BIT_ORDER and DEFAULT_BIT_ORDER.
*** 20488,20494 ****
  
  However, the use of the following pragma causes GNAT
  to extend the definition of package SYSTEM so that it
! encompasses the full set of DIGITAL-specific extensions,
  including the functions listed above:
  
  @smallexample @c ada
--- 20704,20710 ----
  
  However, the use of the following pragma causes GNAT
  to extend the definition of package SYSTEM so that it
! encompasses the full set of HP-specific extensions,
  including the functions listed above:
  
  @smallexample @c ada
*************** The pragma Extend_System is a configurat
*** 20502,20509 ****
  is most conveniently placed in the @file{gnat.adc} file. See the
  GNAT Reference Manual for further details.
  
! DEC Ada does not allow the recompilation of the package
! SYSTEM. Instead DEC Ada provides several pragmas (SYSTEM_
  NAME, STORAGE_UNIT, and MEMORY_SIZE) to modify values in
  the package SYSTEM. On OpenVMS Alpha systems, the pragma
  SYSTEM_NAME takes the enumeration literal OPENVMS_AXP as
--- 20718,20725 ----
  is most conveniently placed in the @file{gnat.adc} file. See the
  GNAT Reference Manual for further details.
  
! HP Ada does not allow the recompilation of the package
! SYSTEM. Instead HP Ada provides several pragmas (SYSTEM_
  NAME, STORAGE_UNIT, and MEMORY_SIZE) to modify values in
  the package SYSTEM. On OpenVMS Alpha systems, the pragma
  SYSTEM_NAME takes the enumeration literal OPENVMS_AXP as
*************** pragma Extend_System (AUX_Dec);
*** 20525,20531 ****
  @end smallexample
  
  @noindent
! are virtually identical to those provided by the DEC Ada 83 package
  System. One important difference is that the name of the TO_ADDRESS
  function for type UNSIGNED_LONGWORD is changed to TO_ADDRESS_LONG.
  See the GNAT Reference manual for a discussion of why this change was
--- 20741,20747 ----
  @end smallexample
  
  @noindent
! are virtually identical to those provided by the HP Ada 83 package
  System. One important difference is that the name of the TO_ADDRESS
  function for type UNSIGNED_LONGWORD is changed to TO_ADDRESS_LONG.
  See the GNAT Reference manual for a discussion of why this change was
*************** necessary.
*** 20535,20541 ****
  The version of TO_ADDRESS taking a universal integer argument is in fact
  an extension to Ada 83 not strictly compatible with the reference manual.
  In GNAT, we are constrained to be exactly compatible with the standard,
! and this means we cannot provide this capability. In DEC Ada 83, the
  point of this definition is to deal with a call like:
  
  @smallexample @c ada
--- 20751,20757 ----
  The version of TO_ADDRESS taking a universal integer argument is in fact
  an extension to Ada 83 not strictly compatible with the reference manual.
  In GNAT, we are constrained to be exactly compatible with the standard,
! and this means we cannot provide this capability. In HP Ada 83, the
  point of this definition is to deal with a call like:
  
  @smallexample @c ada
*************** TO_ADDRESS (16#12777#);
*** 20545,20551 ****
  @noindent
  Normally, according to the Ada 83 standard, one would expect this to be
  ambiguous, since it matches both the INTEGER and UNSIGNED_LONGWORD forms
! of TO_ADDRESS. However, in DEC Ada 83, there is no ambiguity, since the
  definition using universal_integer takes precedence.
  
  In GNAT, since the version with universal_integer cannot be supplied, it is
--- 20761,20767 ----
  @noindent
  Normally, according to the Ada 83 standard, one would expect this to be
  ambiguous, since it matches both the INTEGER and UNSIGNED_LONGWORD forms
! of TO_ADDRESS. However, in HP Ada 83, there is no ambiguity, since the
  definition using universal_integer takes precedence.
  
  In GNAT, since the version with universal_integer cannot be supplied, it is
*************** change the name to TO_ADDRESS_LONG.
*** 20571,20605 ****
  
  @noindent
  The concepts relevant to a comparison of tasking on GNAT
! and on DEC Ada for OpenVMS Alpha systems are discussed in
  the following sections.
  
  For detailed information on concepts related to tasking in
! DEC Ada, see the DEC Ada Language Reference Manual and the
  relevant run-time reference manual.
  
! @node Implementation of Tasks in DEC Ada for OpenVMS Alpha Systems
! @section Implementation of Tasks in DEC Ada for OpenVMS Alpha Systems
  
  @noindent
  On OpenVMS Alpha systems, each Ada task (except a passive
  task) is implemented as a single stream of execution
  that is created and managed by the kernel. On these
! systems, DEC Ada tasking support is based on DECthreads,
  an implementation of the POSIX standard for threads.
  
! Although tasks are implemented as threads, all tasks in
! an Ada program are part of the same process. As a result,
! resources such as open files and virtual memory can be
! shared easily among tasks. Having all tasks in one process
! allows better integration with the programming environment
! (the shell and the debugger, for example).
! 
! Also, on OpenVMS Alpha systems, DEC Ada tasks and foreign
  code that calls DECthreads routines can be used together.
  The interaction between Ada tasks and DECthreads routines
  can have some benefits. For example when on OpenVMS Alpha,
! DEC Ada can call C code that is already threaded.
  GNAT on OpenVMS Alpha uses the facilities of DECthreads,
  and Ada tasks are mapped to threads.
  
--- 20787,20814 ----
  
  @noindent
  The concepts relevant to a comparison of tasking on GNAT
! and on HP Ada for OpenVMS Alpha systems are discussed in
  the following sections.
  
  For detailed information on concepts related to tasking in
! HP Ada, see the HP Ada Language Reference Manual and the
  relevant run-time reference manual.
  
! @node Implementation of Tasks in HP Ada for OpenVMS Alpha Systems
! @section Implementation of Tasks in HP Ada for OpenVMS Alpha Systems
  
  @noindent
  On OpenVMS Alpha systems, each Ada task (except a passive
  task) is implemented as a single stream of execution
  that is created and managed by the kernel. On these
! systems, HP Ada tasking support is based on DECthreads,
  an implementation of the POSIX standard for threads.
  
! Also, on OpenVMS Alpha systems, HP Ada tasks and foreign
  code that calls DECthreads routines can be used together.
  The interaction between Ada tasks and DECthreads routines
  can have some benefits. For example when on OpenVMS Alpha,
! HP Ada can call C code that is already threaded.
  GNAT on OpenVMS Alpha uses the facilities of DECthreads,
  and Ada tasks are mapped to threads.
  
*************** and Ada tasks are mapped to threads.
*** 20616,20622 ****
  @subsection Assigning Task IDs
  
  @noindent
! The DEC Ada Run-Time Library always assigns %TASK 1 to
  the environment task that executes the main program. On
  OpenVMS Alpha systems, %TASK 0 is often used for tasks
  that have been created but are not yet activated.
--- 20825,20831 ----
  @subsection Assigning Task IDs
  
  @noindent
! The HP Ada Run-Time Library always assigns %TASK 1 to
  the environment task that executes the main program. On
  OpenVMS Alpha systems, %TASK 0 is often used for tasks
  that have been created but are not yet activated.
*************** that have been created but are not yet a
*** 20624,20630 ****
  On OpenVMS Alpha systems, task IDs are assigned at
  activation. On GNAT systems, task IDs are also assigned at
  task creation but do not have the same form or values as
! task ID values in DEC Ada. There is no null task, and the
  environment task does not have a specific task ID value.
  
  @node Task IDs and Delays
--- 20833,20839 ----
  On OpenVMS Alpha systems, task IDs are assigned at
  activation. On GNAT systems, task IDs are also assigned at
  task creation but do not have the same form or values as
! task ID values in HP Ada. There is no null task, and the
  environment task does not have a specific task ID value.
  
  @node Task IDs and Delays
*************** GNAT supplies the following task-related
*** 20663,20680 ****
  @item  TASK_STORAGE
  
                GNAT implements pragma TASK_STORAGE in the same way as
!               DEC Ada.
!               Both DEC Ada and GNAT supply the pragmas PASSIVE,
                SUPPRESS, and VOLATILE.
  @end itemize
  @node Scheduling and Task Priority
  @subsection Scheduling and Task Priority
  
  @noindent
! DEC Ada implements the Ada language requirement that
  when two tasks are eligible for execution and they have
  different priorities, the lower priority task does not
! execute while the higher priority task is waiting. The DEC
  Ada Run-Time Library keeps a task running until either the
  task is suspended or a higher priority task becomes ready.
  
--- 20872,20889 ----
  @item  TASK_STORAGE
  
                GNAT implements pragma TASK_STORAGE in the same way as
!               HP Ada.
!               Both HP Ada and GNAT supply the pragmas PASSIVE,
                SUPPRESS, and VOLATILE.
  @end itemize
  @node Scheduling and Task Priority
  @subsection Scheduling and Task Priority
  
  @noindent
! HP Ada implements the Ada language requirement that
  when two tasks are eligible for execution and they have
  different priorities, the lower priority task does not
! execute while the higher priority task is waiting. The HP
  Ada Run-Time Library keeps a task running until either the
  task is suspended or a higher priority task becomes ready.
  
*************** at the processor. A task is run for a ce
*** 20684,20713 ****
  time and then placed at the rear of the ready queue for
  its priority level.
  
! DEC Ada provides the implementation-defined pragma TIME_SLICE,
  which can be used to enable or disable round-robin
  scheduling of tasks with the same priority.
! See the relevant DEC Ada run-time reference manual for
! information on using the pragmas to control DEC Ada task
  scheduling.
  
  GNAT follows the scheduling rules of Annex D (real-time
  Annex) of the Ada 95 Reference Manual. In general, this
! scheduling strategy is fully compatible with DEC Ada
  although it provides some additional constraints (as
  fully documented in Annex D).
  GNAT implements time slicing control in a manner compatible with
! DEC Ada 83, by means of the pragma Time_Slice, whose semantics are identical
! to the DEC Ada 83 pragma of the same name.
  Note that it is not possible to mix GNAT tasking and
! DEC Ada 83 tasking in the same program, since the two run times are
  not compatible.
  
  @node The Task Stack
  @subsection The Task Stack
  
  @noindent
! In DEC Ada, a task stack is allocated each time a
  non passive task is activated. As soon as the task is
  terminated, the storage for the task stack is deallocated.
  If you specify a size of zero (bytes) with T'STORAGE_SIZE,
--- 20893,20922 ----
  time and then placed at the rear of the ready queue for
  its priority level.
  
! HP Ada provides the implementation-defined pragma TIME_SLICE,
  which can be used to enable or disable round-robin
  scheduling of tasks with the same priority.
! See the relevant HP Ada run-time reference manual for
! information on using the pragmas to control HP Ada task
  scheduling.
  
  GNAT follows the scheduling rules of Annex D (real-time
  Annex) of the Ada 95 Reference Manual. In general, this
! scheduling strategy is fully compatible with HP Ada
  although it provides some additional constraints (as
  fully documented in Annex D).
  GNAT implements time slicing control in a manner compatible with
! HP Ada 83, by means of the pragma Time_Slice, whose semantics are identical
! to the HP Ada 83 pragma of the same name.
  Note that it is not possible to mix GNAT tasking and
! HP Ada 83 tasking in the same program, since the two run times are
  not compatible.
  
  @node The Task Stack
  @subsection The Task Stack
  
  @noindent
! In HP Ada, a task stack is allocated each time a
  non passive task is activated. As soon as the task is
  terminated, the storage for the task stack is deallocated.
  If you specify a size of zero (bytes) with T'STORAGE_SIZE,
*************** GNAT handles task stacks in a similar ma
*** 20720,20743 ****
  the Ada 95 rules, it provides the pragma STORAGE_SIZE as
  an alternative method for controlling the task stack size.
  The specification of the attribute T'STORAGE_SIZE is also
! supported in a manner compatible with DEC Ada.
  
  @node External Interrupts
  @subsection External Interrupts
  
  @noindent
! On DEC Ada, external interrupts can be associated with task entries.
! GNAT is compatible with DEC Ada in its handling of external interrupts.
  
  @node Pragmas and Pragma-Related Features
  @section Pragmas and Pragma-Related Features
  
  @noindent
! Both DEC Ada and GNAT supply all language-defined pragmas
  as specified by the Ada 83 standard. GNAT also supplies all
  language-defined pragmas specified in the Ada 95 Reference Manual.
  In addition, GNAT implements the implementation-defined pragmas
! from DEC Ada 83.
  
  @itemize @bullet
  @item  AST_ENTRY
--- 20929,20952 ----
  the Ada 95 rules, it provides the pragma STORAGE_SIZE as
  an alternative method for controlling the task stack size.
  The specification of the attribute T'STORAGE_SIZE is also
! supported in a manner compatible with HP Ada.
  
  @node External Interrupts
  @subsection External Interrupts
  
  @noindent
! On HP Ada, external interrupts can be associated with task entries.
! GNAT is compatible with HP Ada in its handling of external interrupts.
  
  @node Pragmas and Pragma-Related Features
  @section Pragmas and Pragma-Related Features
  
  @noindent
! Both HP Ada and GNAT supply all language-defined pragmas
  as specified by the Ada 83 standard. GNAT also supplies all
  language-defined pragmas specified in the Ada 95 Reference Manual.
  In addition, GNAT implements the implementation-defined pragmas
! from HP Ada 83.
  
  @itemize @bullet
  @item  AST_ENTRY
*************** recognized, but which have no
*** 20800,20806 ****
  effect in GNAT. The effect of @code{Passive} may be obtained by the
  use of protected objects in Ada 95. In GNAT, all generics are inlined.
  
! Unlike DEC Ada, the GNAT 'EXPORT_@i{subprogram}' pragmas require
  a separate subprogram specification which must appear before the
  subprogram body.
  
--- 21009,21015 ----
  effect in GNAT. The effect of @code{Passive} may be obtained by the
  use of protected objects in Ada 95. In GNAT, all generics are inlined.
  
! Unlike HP Ada, the GNAT 'EXPORT_@i{subprogram}' pragmas require
  a separate subprogram specification which must appear before the
  subprogram body.
  
*************** GNAT also supplies a number of implement
*** 20822,20827 ****
--- 21031,21038 ----
  
  @item  ADA_95
  
+ @item  ADA_05
+ 
  @item  ANNOTATE
  
  @item  ASSERT
*************** the GNAT Reference Manual.
*** 20875,20881 ****
  @subsection Restrictions on the Pragma INLINE
  
  @noindent
! DEC Ada applies the following restrictions to the pragma INLINE:
  @itemize @bullet
  @item  Parameters cannot be a task type.
  
--- 21086,21092 ----
  @subsection Restrictions on the Pragma INLINE
  
  @noindent
! HP Ada applies the following restrictions to the pragma INLINE:
  @itemize @bullet
  @item  Parameters cannot be a task type.
  
*************** be incapable of being inlined.
*** 20918,20924 ****
  
  @noindent
  The following lists and describes the restrictions on the
! pragma INTERFACE on DEC Ada and GNAT:
  @itemize @bullet
  @item  Languages accepted: Ada, Bliss, C, Fortran, Default.
  Default is the default on OpenVMS Alpha systems.
--- 21129,21135 ----
  
  @noindent
  The following lists and describes the restrictions on the
! pragma INTERFACE on HP Ada and GNAT:
  @itemize @bullet
  @item  Languages accepted: Ada, Bliss, C, Fortran, Default.
  Default is the default on OpenVMS Alpha systems.
*************** be a string, an array, or a record.
*** 20939,20952 ****
  @end itemize
  
  @noindent
! GNAT is entirely upwards compatible with DEC Ada, and in addition allows
  record parameters for all languages.
  
  @node  Restrictions on the Pragma SYSTEM_NAME
  @subsection  Restrictions on the Pragma SYSTEM_NAME
  
  @noindent
! For DEC Ada for OpenVMS Alpha, the enumeration literal
  for the type NAME is OPENVMS_AXP. In GNAT, the enumeration
  literal for the type NAME is SYSTEM_NAME_GNAT.
  
--- 21150,21163 ----
  @end itemize
  
  @noindent
! GNAT is entirely upwards compatible with HP Ada, and in addition allows
  record parameters for all languages.
  
  @node  Restrictions on the Pragma SYSTEM_NAME
  @subsection  Restrictions on the Pragma SYSTEM_NAME
  
  @noindent
! For HP Ada for OpenVMS Alpha, the enumeration literal
  for the type NAME is OPENVMS_AXP. In GNAT, the enumeration
  literal for the type NAME is SYSTEM_NAME_GNAT.
  
*************** literal for the type NAME is SYSTEM_NAME
*** 20955,20967 ****
  
  @noindent
  A library of predefined units is provided as part of the
! DEC Ada and GNAT implementations. DEC Ada does not provide
  the package MACHINE_CODE but instead recommends importing
  assembler code.
  
! The GNAT versions of the DEC Ada Run-Time Library (ADA$PREDEFINED:)
  units are taken from the OpenVMS Alpha version, not the OpenVMS VAX
! version. During GNAT installation, the DEC Ada Predefined
  Library units are copied into the GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  (aka DECLIB) directory and patched to remove Ada 95 incompatibilities
  and to make them interoperable with GNAT, @pxref{Changes to DECLIB}
--- 21166,21178 ----
  
  @noindent
  A library of predefined units is provided as part of the
! HP Ada and GNAT implementations. HP Ada does not provide
  the package MACHINE_CODE but instead recommends importing
  assembler code.
  
! The GNAT versions of the HP Ada Run-Time Library (ADA$PREDEFINED:)
  units are taken from the OpenVMS Alpha version, not the OpenVMS VAX
! version. During GNAT installation, the HP Ada Predefined
  Library units are copied into the GNU:[LIB.OPENVMS7_x.2_8_x.DECLIB]
  (aka DECLIB) directory and patched to remove Ada 95 incompatibilities
  and to make them interoperable with GNAT, @pxref{Changes to DECLIB}
*************** for example).
*** 20975,20983 ****
  
  However, it is possible to change the default so that the
  reverse is true, or even to mix them using child package
! notation. The DEC Ada 83 units are available as DEC.xxx where xxx
  is the package name, and the Ada units are available in the
! standard manner defined for Ada 95, that is to say as Ada.xxx. To
  change the default, set ADA_INCLUDE_PATH and ADA_OBJECTS_PATH
  appropriately. For example, to change the default to use the Ada95
  versions do:
--- 21186,21194 ----
  
  However, it is possible to change the default so that the
  reverse is true, or even to mix them using child package
! notation. The HP Ada 83 units are available as DEC.xxx where xxx
  is the package name, and the Ada units are available in the
! standard manner defined for Ada 95, that is to say as DEC.xxx. To
  change the default, set ADA_INCLUDE_PATH and ADA_OBJECTS_PATH
  appropriately. For example, to change the default to use the Ada95
  versions do:
*************** $ DEFINE ADA_OBJECTS_PATH GNU:[LIB.OPENV
*** 20997,21003 ****
  @subsection Changes to DECLIB
  
  @noindent
! The changes made to the DEC Ada predefined library for GNAT and Ada 95
  compatibility are minor and include the following:
  
  @itemize @bullet
--- 21208,21214 ----
  @subsection Changes to DECLIB
  
  @noindent
! The changes made to the HP Ada predefined library for GNAT and Ada 95
  compatibility are minor and include the following:
  
  @itemize @bullet
*************** None of the above changes is visible to 
*** 21022,21028 ****
  @section Bindings
  
  @noindent
! On OpenVMS Alpha, DEC Ada provides the following strongly-typed bindings:
  @itemize @bullet
  
  @item  Command Language Interpreter (CLI interface)
--- 21233,21239 ----
  @section Bindings
  
  @noindent
! On OpenVMS Alpha, HP Ada provides the following strongly-typed bindings:
  @itemize @bullet
  
  @item  Command Language Interpreter (CLI interface)
*************** On OpenVMS Alpha, DEC Ada provides the f
*** 21058,21067 ****
  @end itemize
  
  @noindent
! GNAT provides implementations of these DEC bindings in the DECLIB directory.
  
  The X/Motif bindings used to build DECLIB are whatever versions are in the
! DEC Ada @file{ADA$PREDEFINED} directory with extension @file{.ADC}.
  The build script will
  automatically add a pragma Linker_Options to packages @code{Xm}, @code{Xt},
  and @code{X_Lib}
--- 21269,21278 ----
  @end itemize
  
  @noindent
! GNAT provides implementations of these HP bindings in the DECLIB directory.
  
  The X/Motif bindings used to build DECLIB are whatever versions are in the
! HP Ada @file{ADA$PREDEFINED} directory with extension @file{.ADC}.
  The build script will
  automatically add a pragma Linker_Options to packages @code{Xm}, @code{Xt},
  and @code{X_Lib}
*************** default @file{ADA$PREDEFINED} versions.
*** 21084,21090 ****
  @subsection Shared Libraries and Options Files
  
  @noindent
! When using the DEC Ada
  predefined X and Motif bindings, the linking with their sharable images is
  done automatically by @command{GNAT LINK}.
  When using other X and Motif bindings, you need
--- 21295,21301 ----
  @subsection Shared Libraries and Options Files
  
  @noindent
! When using the HP Ada
  predefined X and Motif bindings, the linking with their sharable images is
  done automatically by @command{GNAT LINK}.
  When using other X and Motif bindings, you need
*************** libraries under VMS. The VMS Link comman
*** 21100,21106 ****
  @subsection Interfaces to C
  
  @noindent
! DEC Ada
  provides the following Ada types and operations:
  
  @itemize @bullet
--- 21311,21317 ----
  @subsection Interfaces to C
  
  @noindent
! HP Ada
  provides the following Ada types and operations:
  
  @itemize @bullet
*************** provides the following Ada types and ope
*** 21113,21119 ****
  
  @noindent
  Interfacing to C with GNAT, one can use the above approach
! described for DEC Ada or the facilities of Annex B of
  the Ada 95 Reference Manual (packages INTERFACES.C,
  INTERFACES.C.STRINGS and INTERFACES.C.POINTERS). For more
  information, see the section ``Interfacing to C'' in the
--- 21324,21330 ----
  
  @noindent
  Interfacing to C with GNAT, one can use the above approach
! described for HP Ada or the facilities of Annex B of
  the Ada 95 Reference Manual (packages INTERFACES.C,
  INTERFACES.C.STRINGS and INTERFACES.C.POINTERS). For more
  information, see the section ``Interfacing to C'' in the
*************** of Compaq C. The qualifier has no effect
*** 21129,21136 ****
  
  @noindent
  The following section discusses differences in the
! definition of main programs on DEC Ada and GNAT.
! On DEC Ada, main programs are defined to meet the
  following conditions:
  @itemize @bullet
  @item  Procedure with no formal parameters (returns 0 upon
--- 21340,21347 ----
  
  @noindent
  The following section discusses differences in the
! definition of main programs on HP Ada and GNAT.
! On HP Ada, main programs are defined to meet the
  following conditions:
  @itemize @bullet
  @item  Procedure with no formal parameters (returns 0 upon
*************** generic subprogram
*** 21166,21179 ****
  @section Implementation-Defined Attributes
  
  @noindent
! GNAT provides all DEC Ada implementation-defined
  attributes.
  
  @node Compiler and Run-Time Interfacing
  @section Compiler and Run-Time Interfacing
  
  @noindent
! DEC Ada provides the following ways to pass options to the linker
  (ACS LINK):
  @itemize @bullet
  @item  /WAIT and /SUBMIT qualifiers
--- 21377,21390 ----
  @section Implementation-Defined Attributes
  
  @noindent
! GNAT provides all HP Ada implementation-defined
  attributes.
  
  @node Compiler and Run-Time Interfacing
  @section Compiler and Run-Time Interfacing
  
  @noindent
! HP Ada provides the following ways to pass options to the linker
  (ACS LINK):
  @itemize @bullet
  @item  /WAIT and /SUBMIT qualifiers
*************** switches:
*** 21202,21209 ****
  @noindent
  For more information on these switches, see
  @ref{Switches for gnatlink}.
! In DEC Ada, the command-line switch @option{/OPTIMIZE} is available
! to control optimization. DEC Ada also supplies the
  following pragmas:
  @itemize @bullet
  @item  @code{OPTIMIZE}
--- 21413,21420 ----
  @noindent
  For more information on these switches, see
  @ref{Switches for gnatlink}.
! In HP Ada, the command-line switch @option{/OPTIMIZE} is available
! to control optimization. HP Ada also supplies the
  following pragmas:
  @itemize @bullet
  @item  @code{OPTIMIZE}
*************** following pragmas:
*** 21220,21243 ****
  @noindent
  In GNAT, optimization is controlled strictly by command
  line parameters, as described in the corresponding section of this guide.
! The DIGITAL pragmas for control of optimization are
  recognized but ignored.
  
! Note that in GNAT, the default is optimization off, whereas in DEC Ada 83,
  the default is that optimization is turned on.
  
  @node Program Compilation and Library Management
  @section Program Compilation and Library Management
  
  @noindent
! DEC Ada and GNAT provide a comparable set of commands to
! build programs. DEC Ada also provides a program library,
  which is a concept that does not exist on GNAT. Instead,
  GNAT provides directories of sources that are compiled as
  needed.
  
  The following table summarizes
! the DEC Ada commands and provides
  equivalent GNAT commands. In this table, some GNAT
  equivalents reflect the fact that GNAT does not use the
  concept of a program library. Instead, it uses a model
--- 21431,21454 ----
  @noindent
  In GNAT, optimization is controlled strictly by command
  line parameters, as described in the corresponding section of this guide.
! The HP pragmas for control of optimization are
  recognized but ignored.
  
! Note that in GNAT, the default is optimization off, whereas in HP Ada 83,
  the default is that optimization is turned on.
  
  @node Program Compilation and Library Management
  @section Program Compilation and Library Management
  
  @noindent
! HP Ada and GNAT provide a comparable set of commands to
! build programs. HP Ada also provides a program library,
  which is a concept that does not exist on GNAT. Instead,
  GNAT provides directories of sources that are compiled as
  needed.
  
  The following table summarizes
! the HP Ada commands and provides
  equivalent GNAT commands. In this table, some GNAT
  equivalents reflect the fact that GNAT does not use the
  concept of a program library. Instead, it uses a model
*************** in a manner consistent with other langua
*** 21246,21257 ****
  Fortran. Therefore, standard system file commands are used
  to manipulate these elements. Those GNAT commands are marked with
  an asterisk.
! Note that, unlike DEC Ada, none of the GNAT commands accepts wild cards.
  
  @need 1500
  @multitable @columnfractions .35 .65
  
! @item @emph{DEC Ada Command}
  @tab @emph{GNAT Equivalent / Description}
  
  @item @command{ADA}
--- 21457,21468 ----
  Fortran. Therefore, standard system file commands are used
  to manipulate these elements. Those GNAT commands are marked with
  an asterisk.
! Note that, unlike HP Ada, none of the GNAT commands accepts wild cards.
  
  @need 1500
  @multitable @columnfractions .35 .65
  
! @item @emph{HP Ada Command}
  @tab @emph{GNAT Equivalent / Description}
  
  @item @command{ADA}
*************** valid form.
*** 21416,21429 ****
  @section Input-Output
  
  @noindent
! On OpenVMS Alpha systems, DEC Ada uses OpenVMS Record
  Management Services (RMS) to perform operations on
  external files.
  
  @noindent
! DEC Ada and GNAT predefine an identical set of input-
  output packages. To make the use of the
! generic TEXT_IO operations more convenient, DEC Ada
  provides predefined library packages that instantiate the
  integer and floating-point operations for the predefined
  integer and floating-point types as shown in the following table.
--- 21627,21640 ----
  @section Input-Output
  
  @noindent
! On OpenVMS Alpha systems, HP Ada uses OpenVMS Record
  Management Services (RMS) to perform operations on
  external files.
  
  @noindent
! HP Ada and GNAT predefine an identical set of input-
  output packages. To make the use of the
! generic TEXT_IO operations more convenient, HP Ada
  provides predefined library packages that instantiate the
  integer and floating-point operations for the predefined
  integer and floating-point types as shown in the following table.
*************** integer and floating-point types as show
*** 21448,21456 ****
  @end multitable
  
  @noindent
! The DEC Ada predefined packages and their operations
  are implemented using OpenVMS Alpha files and input-
! output facilities. DEC Ada supports asynchronous input-
  output on OpenVMS Alpha. Familiarity with the following is
  recommended:
  @itemize @bullet
--- 21659,21667 ----
  @end multitable
  
  @noindent
! The HP Ada predefined packages and their operations
  are implemented using OpenVMS Alpha files and input-
! output facilities. HP Ada supports asynchronous input-
  output on OpenVMS Alpha. Familiarity with the following is
  recommended:
  @itemize @bullet
*************** recommended:
*** 21463,21472 ****
  
  @noindent
  GNAT provides I/O facilities that are completely
! compatible with DEC Ada. The distribution includes the
! standard DEC Ada versions of all I/O packages, operating
! in a manner compatible with DEC Ada. In particular, the
! following packages are by default the DEC Ada (Ada 83)
  versions of these packages rather than the renamings
  suggested in annex J of the Ada 95 Reference Manual:
  @itemize @bullet
--- 21674,21683 ----
  
  @noindent
  GNAT provides I/O facilities that are completely
! compatible with HP Ada. The distribution includes the
! standard HP Ada versions of all I/O packages, operating
! in a manner compatible with HP Ada. In particular, the
! following packages are by default the HP Ada (Ada 83)
  versions of these packages rather than the renamings
  suggested in annex J of the Ada 95 Reference Manual:
  @itemize @bullet
*************** suggested in annex J of the Ada 95 Refer
*** 21481,21487 ****
  The use of the standard Ada 95 syntax for child packages (for
  example, @code{ADA.TEXT_IO}) retrieves the Ada 95 versions of these
  packages, as defined in the Ada 95 Reference Manual.
! GNAT provides DIGITAL-compatible predefined instantiations
  of the @code{TEXT_IO} packages, and also
  provides the standard predefined instantiations required
  by the Ada 95 Reference Manual.
--- 21692,21698 ----
  The use of the standard Ada 95 syntax for child packages (for
  example, @code{ADA.TEXT_IO}) retrieves the Ada 95 versions of these
  packages, as defined in the Ada 95 Reference Manual.
! GNAT provides HP-compatible predefined instantiations
  of the @code{TEXT_IO} packages, and also
  provides the standard predefined instantiations required
  by the Ada 95 Reference Manual.
*************** This chapter covers the following:
*** 21519,21530 ****
  @section Implementation Limits
  
  @noindent
! The following table lists implementation limits for DEC Ada
  and GNAT systems.
  @multitable @columnfractions .60 .20 .20
  @sp 1
  @item  @emph{Compilation Parameter}
! @tab   @emph{DEC Ada}
  @tab   @emph{GNAT}
  @sp 1
  
--- 21730,21741 ----
  @section Implementation Limits
  
  @noindent
! The following table lists implementation limits for HP Ada
  and GNAT systems.
  @multitable @columnfractions .60 .20 .20
  @sp 1
  @item  @emph{Compilation Parameter}
! @tab   @emph{HP Ada}
  @tab   @emph{GNAT}
  @sp 1
  
*************** and GNAT systems.
*** 21602,21610 ****
  @tab   2**31-1
  @end multitable
  
- @node  Tools
- @section Tools
- 
  @end ifset
  
  @c **************************************
--- 21813,21818 ----
*************** this option) is required.
*** 21916,21934 ****
  The easiest way to build a 64bit application is to add
  @option{-m64 --RTS=m64} to the @command{gnatmake} flags.
  
! To debug these applications, dwarf-2 debug information is required, so you
! have to add @option{-gdwarf-2} to your gnatmake arguments.
! In addition, a special
! version of gdb, called @command{gdb64}, needs to be used.
  
  To summarize, building and debugging a ``Hello World'' program in 64-bit mode
  amounts to:
  
  @smallexample
!      $ gnatmake -m64 -gdwarf-2 --RTS=m64 hello.adb
       $ gdb64 hello
  @end smallexample
  
  @node IRIX-Specific Considerations
  @section IRIX-Specific Considerations
  @cindex IRIX thread library
--- 22124,22151 ----
  The easiest way to build a 64bit application is to add
  @option{-m64 --RTS=m64} to the @command{gnatmake} flags.
  
! To debug these applications, a special version of gdb called @command{gdb64}
! needs to be used.
  
  To summarize, building and debugging a ``Hello World'' program in 64-bit mode
  amounts to:
  
  @smallexample
!      $ gnatmake -m64 -g --RTS=m64 hello.adb
       $ gdb64 hello
  @end smallexample
  
+ In addition, the following capabilities are not supported when using the
+ @option{-m64} option:
+ 
+ @table @code
+ @item -fstack-check does not work together with -m64.
+ Any application combining these options crashes at startup time.
+ 
+ @item Call-chain backtrace computation does not work with -m64.
+ Thus the gnatbind switch -E is not supported.
+ @end table
+ 
  @node IRIX-Specific Considerations
  @section IRIX-Specific Considerations
  @cindex IRIX thread library
*************** later.
*** 23155,23166 ****
  
  The rule is simple. If a unit has elaboration code that can directly or
  indirectly make a call to a subprogram in a @code{with}'ed unit, or instantiate
! a generic unit in a @code{with}'ed unit,
  then if the @code{with}'ed unit does not have
  pragma @code{Pure} or @code{Preelaborate}, then the client should have
  a pragma @code{Elaborate_All}
  for the @code{with}'ed unit. By following this rule a client is
  assured that calls can be made without risk of an exception.
  If this rule is not followed, then a program may be in one of four
  states:
  
--- 23372,23390 ----
  
  The rule is simple. If a unit has elaboration code that can directly or
  indirectly make a call to a subprogram in a @code{with}'ed unit, or instantiate
! a generic package in a @code{with}'ed unit,
  then if the @code{with}'ed unit does not have
  pragma @code{Pure} or @code{Preelaborate}, then the client should have
  a pragma @code{Elaborate_All}
  for the @code{with}'ed unit. By following this rule a client is
  assured that calls can be made without risk of an exception.
+ 
+ For generic subprogram instantiations, the rule can be relaxed to
+ require only a pragma @code{Elaborate} since elaborating the body
+ of a subprogram cannot cause any transitive elaboration (we are
+ not calling the subprogram in this case, just elaborating its
+ declaration).
+ 
  If this rule is not followed, then a program may be in one of four
  states:
  
*************** may be true even if the rule is not foll
*** 23195,23204 ****
  @end table
  
  @noindent
! Note that one additional advantage of following our Elaborate_All rule
  is that the program continues to stay in the ideal (all orders OK) state
  even if maintenance
! changes some bodies of some subprograms. Conversely, if a program that does
  not follow this rule happens to be safe at some point, this state of affairs
  may deteriorate silently as a result of maintenance changes.
  
--- 23419,23429 ----
  @end table
  
  @noindent
! Note that one additional advantage of following our rules on the use
! of @code{Elaborate} and @code{Elaborate_All}
  is that the program continues to stay in the ideal (all orders OK) state
  even if maintenance
! changes some bodies of some units. Conversely, if a program that does
  not follow this rule happens to be safe at some point, this state of affairs
  may deteriorate silently as a result of maintenance changes.
  
*************** rule we previously described as the righ
*** 23548,23558 ****
  @itemize
  @item
  @emph{If a unit has elaboration code that can directly or indirectly make a
! call to a subprogram in a @code{with}'ed unit, or instantiate a generic unit
! in a @code{with}'ed unit, then if the @code{with}'ed unit
  does not have pragma @code{Pure} or
  @code{Preelaborate}, then the client should have an
! @code{Elaborate_All} for the @code{with}'ed unit.}
  @end itemize
  
  @noindent
--- 23773,23787 ----
  @itemize
  @item
  @emph{If a unit has elaboration code that can directly or indirectly make a
! call to a subprogram in a @code{with}'ed unit, or instantiate a generic
! package in a @code{with}'ed unit, then if the @code{with}'ed unit
  does not have pragma @code{Pure} or
  @code{Preelaborate}, then the client should have an
! @code{Elaborate_All} pragma for the @code{with}'ed unit.}
! 
! @emph{In the case of instantiating a generic subprogram, it is always
! sufficient to have only an @code{Elaborate} pragma for the
! @code{with}'ed unit.}
  @end itemize
  
  @noindent
*************** By following this rule a client is assur
*** 23560,23583 ****
  can be made without risk of an exception.
  
  In this mode GNAT traces all calls that are potentially made from
! elaboration code, and puts in any missing implicit @code{Elaborate_All}
! pragmas.
  The advantage of this approach is that no elaboration problems
  are possible if the binder can find an elaboration order that is
! consistent with these implicit @code{Elaborate_All} pragmas. The
  disadvantage of this approach is that no such order may exist.
  
! If the binder does not generate any diagnostics, then it means that it
! has found an elaboration order that is guaranteed to be safe. However,
! the binder may still be relying on implicitly generated
! @code{Elaborate_All} pragmas so portability to other compilers than
! GNAT is not guaranteed.
  
  If it is important to guarantee portability, then the compilations should
  use the
  @option{-gnatwl}
  (warn on elaboration problems) switch. This will cause warning messages
! to be generated indicating the missing @code{Elaborate_All} pragmas.
  Consider the following source program:
  
  @smallexample @c ada
--- 23789,23814 ----
  can be made without risk of an exception.
  
  In this mode GNAT traces all calls that are potentially made from
! elaboration code, and puts in any missing implicit @code{Elaborate}
! and @code{Elaborate_All} pragmas.
  The advantage of this approach is that no elaboration problems
  are possible if the binder can find an elaboration order that is
! consistent with these implicit @code{Elaborate} and
! @code{Elaborate_All} pragmas. The
  disadvantage of this approach is that no such order may exist.
  
! If the binder does not generate any diagnostics, then it means that it has
! found an elaboration order that is guaranteed to be safe. However, the binder
! may still be relying on implicitly generated @code{Elaborate} and
! @code{Elaborate_All} pragmas so portability to other compilers than GNAT is not
! guaranteed.
  
  If it is important to guarantee portability, then the compilations should
  use the
  @option{-gnatwl}
  (warn on elaboration problems) switch. This will cause warning messages
! to be generated indicating the missing @code{Elaborate} and
! @code{Elaborate_All} pragmas.
  Consider the following source program:
  
  @smallexample @c ada
*************** and these warnings can be used as a guid
*** 23622,23628 ****
  the missing pragmas. It is usually a bad idea to use this warning
  option during development. That's because it will warn you when
  you need to put in a pragma, but cannot warn you when it is time
! to take it out. So the use of pragma Elaborate_All may lead to
  unnecessary dependencies and even false circularities.
  
  This default mode is more restrictive than the Ada Reference
--- 23853,23859 ----
  the missing pragmas. It is usually a bad idea to use this warning
  option during development. That's because it will warn you when
  you need to put in a pragma, but cannot warn you when it is time
! to take it out. So the use of pragma @code{Elaborate_All} may lead to
  unnecessary dependencies and even false circularities.
  
  This default mode is more restrictive than the Ada Reference
*************** must be elaborated before itself, and th
*** 23830,23836 ****
  @end enumerate
  
  @noindent
! Indeed, if you add an explicit pragma Elaborate_All for @code{Utils} in
  the body of @code{Decls} you will get a true Ada Reference Manual
  circularity that makes the program illegal.
  
--- 24061,24067 ----
  @end enumerate
  
  @noindent
! Indeed, if you add an explicit pragma @code{Elaborate_All} for @code{Utils} in
  the body of @code{Decls} you will get a true Ada Reference Manual
  circularity that makes the program illegal.
  
*************** the case of complex legacy code.
*** 24171,24185 ****
  @item Perform dynamic checks
  If the compilations are done using the
  @option{-gnatE}
! (dynamic elaboration check) switch, then GNAT behaves in
! a quite different manner. Dynamic checks are generated for all calls
! that could possibly result in raising an exception. With this switch,
! the compiler does not generate implicit @code{Elaborate_All} pragmas.
! The behavior then is exactly as specified in the Ada 95 Reference Manual.
! The binder will generate an executable program that may or may not
! raise @code{Program_Error}, and then it is the programmer's job to ensure
! that it does not raise an exception. Note that it is important to
! compile all units with the switch, it cannot be used selectively.
  
  @item Suppress checks
  The drawback of dynamic checks is that they generate a
--- 24402,24416 ----
  @item Perform dynamic checks
  If the compilations are done using the
  @option{-gnatE}
! (dynamic elaboration check) switch, then GNAT behaves in a quite different
! manner. Dynamic checks are generated for all calls that could possibly result
! in raising an exception. With this switch, the compiler does not generate
! implicit @code{Elaborate} or @code{Elaborate_All} pragmas. The behavior then is
! exactly as specified in the Ada 95 Reference Manual. The binder will generate
! an executable program that may or may not raise @code{Program_Error}, and then
! it is the programmer's job to ensure that it does not raise an exception. Note
! that it is important to compile all units with the switch, it cannot be used
! selectively.
  
  @item Suppress checks
  The drawback of dynamic checks is that they generate a
*************** then you can use the configuration pragm
*** 24191,24205 ****
  example this pragma could be placed in the @file{gnat.adc} file.
  
  @item Suppress checks selectively
! When you know that certain calls in elaboration code cannot possibly
! lead to an elaboration error, and the binder nevertheless generates warnings
! on those calls and inserts Elaborate_All pragmas that lead to elaboration
! circularities, it is possible to remove those warnings locally and obtain
! a program that will bind. Clearly this can be unsafe, and it is the
! responsibility of the programmer to make sure that the resulting program has
! no elaboration anomalies. The pragma @code{Suppress (Elaboration_Check)} can
! be used with different granularity to suppress warnings and break
! elaboration circularities:
  
  @itemize @bullet
  @item
--- 24422,24436 ----
  example this pragma could be placed in the @file{gnat.adc} file.
  
  @item Suppress checks selectively
! When you know that certain calls or instantiations in elaboration code cannot
! possibly lead to an elaboration error, and the binder nevertheless complains
! about implicit @code{Elaborate} and @code{Elaborate_All} pragmas that lead to
! elaboration circularities, it is possible to remove those warnings locally and
! obtain a program that will bind. Clearly this can be unsafe, and it is the
! responsibility of the programmer to make sure that the resulting program has no
! elaboration anomalies. The pragma @code{Suppress (Elaboration_Check)} can be
! used with different granularity to suppress warnings and break elaboration
! circularities:
  
  @itemize @bullet
  @item
*************** raised by the use of access-to-subprogra
*** 24410,24417 ****
  the program is free of elaboration errors. If it is important that the
  program be portable, then use the
  @option{-gnatwl}
! switch to generate warnings about missing @code{Elaborate_All}
! pragmas, and supply the missing pragmas.
  
  If the program fails to bind using the default static elaboration
  handling, then you can fix the program to eliminate the binder
--- 24641,24648 ----
  the program is free of elaboration errors. If it is important that the
  program be portable, then use the
  @option{-gnatwl}
! switch to generate warnings about missing @code{Elaborate} or
! @code{Elaborate_All} pragmas, and supply the missing pragmas.
  
  If the program fails to bind using the default static elaboration
  handling, then you can fix the program to eliminate the binder
*************** It is of course quite unlikely that both
*** 24560,24566 ****
  it is up to you in a case like this to investigate the source of the
  difference, by looking at the two elaboration orders that are chosen,
  and figuring out which is correct, and then adding the necessary
! @code{Elaborate_All} pragmas to ensure the desired order.
  
  @node Inline Assembler
  @appendix Inline Assembler
--- 24791,24797 ----
  it is up to you in a case like this to investigate the source of the
  difference, by looking at the two elaboration orders that are chosen,
  and figuring out which is correct, and then adding the necessary
! @code{Elaborate} or @code{Elaborate_All} pragmas to ensure the desired order.
  
  @node Inline Assembler
  @appendix Inline Assembler
*************** and with assembly language programming.
*** 24600,24606 ****
  * Input Variables in Inline Assembler::
  * Inlining Inline Assembler Code::
  * Other Asm Functionality::
- * A Complete Example::
  @end menu
  
  @c ---------------------------------------------------------------------------
--- 24831,24836 ----
*************** optimizations, it will also disable othe
*** 25274,26174 ****
  important for efficiency. In general, you should set @code{Volatile}
  to @code{True} only if the compiler's optimizations have created
  problems.
- 
- @c ---------------------------------------------------------------------------
- @node A Complete Example
- @section A Complete Example
- 
- @noindent
- This section contains a complete program illustrating a realistic usage
- of GNAT's Inline Assembler capabilities.  It comprises a main procedure
- @code{Check_CPU} and a package @code{Intel_CPU}.
- The package declares a collection of functions that detect the properties
- of the 32-bit x86 processor that is running the program.
- The main procedure invokes these functions and displays the information.
- 
- The Intel_CPU package could be enhanced by adding functions to
- detect the type of x386 co-processor, the processor caching options and
- special operations such as the SIMD extensions.
- 
- Although the Intel_CPU package has been written for 32-bit Intel
- compatible CPUs, it is OS neutral. It has been tested on DOS,
- Windows/NT and GNU/Linux.
- 
- @menu
- * Check_CPU Procedure::
- * Intel_CPU Package Specification::
- * Intel_CPU Package Body::
- @end menu
- 
- @c ---------------------------------------------------------------------------
- @node Check_CPU Procedure
- @subsection @code{Check_CPU} Procedure
- @cindex Check_CPU procedure
- 
- @smallexample @c adanocomment
- ---------------------------------------------------------------------
- --                                                                 --
- --  Uses the Intel_CPU package to identify the CPU the program is  --
- --  running on, and some of the features it supports.              --
- --                                                                 --
- ---------------------------------------------------------------------
- 
- with Intel_CPU;                     --  Intel CPU detection functions
- with Ada.Text_IO;                   --  Standard text I/O
- with Ada.Command_Line;              --  To set the exit status
- 
- procedure Check_CPU is
- 
-    Type_Found : Boolean := False;
-    --  Flag to indicate that processor was identified
- 
-    Features   : Intel_CPU.Processor_Features;
-    --  The processor features
- 
-    Signature  : Intel_CPU.Processor_Signature;
-    --  The processor type signature
- 
- begin
- 
-    -----------------------------------
-    --  Display the program banner.  --
-    -----------------------------------
- 
-    Ada.Text_IO.Put_Line (Ada.Command_Line.Command_Name &
-                          ": check Intel CPU version and features, v1.0");
-    Ada.Text_IO.Put_Line ("distribute freely, but no warranty whatsoever");
-    Ada.Text_IO.New_Line;
- 
-    -----------------------------------------------------------------------
-    --  We can safely start with the assumption that we are on at least  --
-    --  a x386 processor. If the CPUID instruction is present, then we   --
-    --  have a later processor type.                                     --
-    -----------------------------------------------------------------------
- 
-    if Intel_CPU.Has_CPUID = False then
- 
-       --  No CPUID instruction, so we assume this is indeed a x386
-       --  processor. We can still check if it has a FP co-processor.
-       if Intel_CPU.Has_FPU then
-          Ada.Text_IO.Put_Line
-            ("x386-type processor with a FP co-processor");
-       else
-          Ada.Text_IO.Put_Line
-            ("x386-type processor without a FP co-processor");
-       end if;  --  check for FPU
- 
-       --  Program done
-       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
-       return;
- 
-    end if;  --  check for CPUID
- 
-    -----------------------------------------------------------------------
-    --  If CPUID is supported, check if this is a true Intel processor,  --
-    --  if it is not, display a warning.                                 --
-    -----------------------------------------------------------------------
- 
-    if Intel_CPU.Vendor_ID /= Intel_CPU.Intel_Processor then
-       Ada.Text_IO.Put_Line ("*** This is a Intel compatible processor");
-       Ada.Text_IO.Put_Line ("*** Some information may be incorrect");
-    end if;  --  check if Intel
- 
-    ----------------------------------------------------------------------
-    --  With the CPUID instruction present, we can assume at least a    --
-    --  x486 processor. If the CPUID support level is < 1 then we have  --
-    --  to leave it at that.                                            --
-    ----------------------------------------------------------------------
- 
-    if Intel_CPU.CPUID_Level < 1 then
- 
-       --  Ok, this is a x486 processor. we still can get the Vendor ID
-       Ada.Text_IO.Put_Line ("x486-type processor");
-       Ada.Text_IO.Put_Line ("Vendor ID is " & Intel_CPU.Vendor_ID);
- 
-       --  We can also check if there is a FPU present
-       if Intel_CPU.Has_FPU then
-          Ada.Text_IO.Put_Line ("Floating-Point support");
-       else
-          Ada.Text_IO.Put_Line ("No Floating-Point support");
-       end if;  --  check for FPU
- 
-       --  Program done
-       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
-       return;
- 
-    end if;  --  check CPUID level
- 
-    ---------------------------------------------------------------------
-    --  With a CPUID level of 1 we can use the processor signature to  --
-    --  determine it's exact type.                                     --
-    ---------------------------------------------------------------------
- 
-    Signature := Intel_CPU.Signature;
- 
-    ----------------------------------------------------------------------
-    --  Ok, now we go into a lot of messy comparisons to get the        --
-    --  processor type. For clarity, no attememt to try to optimize the --
-    --  comparisons has been made. Note that since Intel_CPU does not   --
-    --  support getting cache info, we cannot distinguish between P5    --
-    --  and Celeron types yet.                                          --
-    ----------------------------------------------------------------------
- 
-    --  x486SL
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0100# and
-      Signature.Model           = 2#0100# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("x486SL processor");
-    end if;
- 
-    --  x486DX2 Write-Back
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0100# and
-      Signature.Model           = 2#0111# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Write-Back Enhanced x486DX2 processor");
-    end if;
- 
-    --  x486DX4
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0100# and
-      Signature.Model           = 2#1000# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("x486DX4 processor");
-    end if;
- 
-    --  x486DX4 Overdrive
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0100# and
-      Signature.Model           = 2#1000# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("x486DX4 OverDrive processor");
-    end if;
- 
-    --  Pentium (60, 66)
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0001# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Pentium processor (60, 66)");
-    end if;
- 
-    --  Pentium (75, 90, 100, 120, 133, 150, 166, 200)
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0010# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium processor (75, 90, 100, 120, 133, 150, 166, 200)");
-    end if;
- 
-    --  Pentium OverDrive (60, 66)
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0001# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Pentium OverDrive processor (60, 66)");
-    end if;
- 
-    --  Pentium OverDrive (75, 90, 100, 120, 133, 150, 166, 200)
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0010# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium OverDrive cpu (75, 90, 100, 120, 133, 150, 166, 200)");
-    end if;
- 
-    --  Pentium OverDrive processor for x486 processor-based systems
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0011# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium OverDrive processor for x486 processor-based systems");
-    end if;
- 
-    --  Pentium processor with MMX technology (166, 200)
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0100# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium processor with MMX technology (166, 200)");
-    end if;
- 
-    --  Pentium OverDrive with MMX for Pentium (75, 90, 100, 120, 133)
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0101# and
-      Signature.Model           = 2#0100# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium OverDrive processor with MMX " &
-          "technology for Pentium processor (75, 90, 100, 120, 133)");
-    end if;
- 
-    --  Pentium Pro processor
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0110# and
-      Signature.Model           = 2#0001# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Pentium Pro processor");
-    end if;
- 
-    --  Pentium II processor, model 3
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0110# and
-      Signature.Model           = 2#0011# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Pentium II processor, model 3");
-    end if;
- 
-    --  Pentium II processor, model 5 or Celeron processor
-    if Signature.Processor_Type = 2#00#   and
-      Signature.Family          = 2#0110# and
-      Signature.Model           = 2#0101# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line
-         ("Pentium II processor, model 5 or Celeron processor");
-    end if;
- 
-    --  Pentium Pro OverDrive processor
-    if Signature.Processor_Type = 2#01#   and
-      Signature.Family          = 2#0110# and
-      Signature.Model           = 2#0011# then
-       Type_Found := True;
-       Ada.Text_IO.Put_Line ("Pentium Pro OverDrive processor");
-    end if;
- 
-    --  If no type recognized, we have an unknown. Display what
-    --  we _do_ know
-    if Type_Found = False then
-       Ada.Text_IO.Put_Line ("Unknown processor");
-    end if;
- 
-    -----------------------------------------
-    --  Display processor stepping level.  --
-    -----------------------------------------
- 
-    Ada.Text_IO.Put_Line ("Stepping level:" & Signature.Stepping'Img);
- 
-    ---------------------------------
-    --  Display vendor ID string.  --
-    ---------------------------------
- 
-    Ada.Text_IO.Put_Line ("Vendor ID: " & Intel_CPU.Vendor_ID);
- 
-    ------------------------------------
-    --  Get the processors features.  --
-    ------------------------------------
- 
-    Features := Intel_CPU.Features;
- 
-    -----------------------------
-    --  Check for a FPU unit.  --
-    -----------------------------
- 
-    if Features.FPU = True then
-       Ada.Text_IO.Put_Line ("Floating-Point unit available");
-    else
-       Ada.Text_IO.Put_Line ("no Floating-Point unit");
-    end if;  --  check for FPU
- 
-    --------------------------------
-    --  List processor features.  --
-    --------------------------------
- 
-    Ada.Text_IO.Put_Line ("Supported features: ");
- 
-    --  Virtual Mode Extension
-    if Features.VME = True then
-       Ada.Text_IO.Put_Line ("    VME    - Virtual Mode Extension");
-    end if;
- 
-    --  Debugging Extension
-    if Features.DE = True then
-       Ada.Text_IO.Put_Line ("    DE     - Debugging Extension");
-    end if;
- 
-    --  Page Size Extension
-    if Features.PSE = True then
-       Ada.Text_IO.Put_Line ("    PSE    - Page Size Extension");
-    end if;
- 
-    --  Time Stamp Counter
-    if Features.TSC = True then
-       Ada.Text_IO.Put_Line ("    TSC    - Time Stamp Counter");
-    end if;
- 
-    --  Model Specific Registers
-    if Features.MSR = True then
-       Ada.Text_IO.Put_Line ("    MSR    - Model Specific Registers");
-    end if;
- 
-    --  Physical Address Extension
-    if Features.PAE = True then
-       Ada.Text_IO.Put_Line ("    PAE    - Physical Address Extension");
-    end if;
- 
-    --  Machine Check Extension
-    if Features.MCE = True then
-       Ada.Text_IO.Put_Line ("    MCE    - Machine Check Extension");
-    end if;
- 
-    --  CMPXCHG8 instruction supported
-    if Features.CX8 = True then
-       Ada.Text_IO.Put_Line ("    CX8    - CMPXCHG8 instruction");
-    end if;
- 
-    --  on-chip APIC hardware support
-    if Features.APIC = True then
-       Ada.Text_IO.Put_Line ("    APIC   - on-chip APIC hardware support");
-    end if;
- 
-    --  Fast System Call
-    if Features.SEP = True then
-       Ada.Text_IO.Put_Line ("    SEP    - Fast System Call");
-    end if;
- 
-    --  Memory Type Range Registers
-    if Features.MTRR = True then
-       Ada.Text_IO.Put_Line ("    MTTR   - Memory Type Range Registers");
-    end if;
- 
-    --  Page Global Enable
-    if Features.PGE = True then
-       Ada.Text_IO.Put_Line ("    PGE    - Page Global Enable");
-    end if;
- 
-    --  Machine Check Architecture
-    if Features.MCA = True then
-       Ada.Text_IO.Put_Line ("    MCA    - Machine Check Architecture");
-    end if;
- 
-    --  Conditional Move Instruction Supported
-    if Features.CMOV = True then
-       Ada.Text_IO.Put_Line
-         ("    CMOV   - Conditional Move Instruction Supported");
-    end if;
- 
-    --  Page Attribute Table
-    if Features.PAT = True then
-       Ada.Text_IO.Put_Line ("    PAT    - Page Attribute Table");
-    end if;
- 
-    --  36-bit Page Size Extension
-    if Features.PSE_36 = True then
-       Ada.Text_IO.Put_Line ("    PSE_36 - 36-bit Page Size Extension");
-    end if;
- 
-    --  MMX technology supported
-    if Features.MMX = True then
-       Ada.Text_IO.Put_Line ("    MMX    - MMX technology supported");
-    end if;
- 
-    --  Fast FP Save and Restore
-    if Features.FXSR = True then
-       Ada.Text_IO.Put_Line ("    FXSR   - Fast FP Save and Restore");
-    end if;
- 
-    ---------------------
-    --  Program done.  --
-    ---------------------
- 
-    Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Success);
- 
- exception
- 
-    when others =>
-       Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
-       raise;
- 
- end Check_CPU;
- @end smallexample
- 
- @c ---------------------------------------------------------------------------
- @node Intel_CPU Package Specification
- @subsection @code{Intel_CPU} Package Specification
- @cindex Intel_CPU package specification
- 
- @smallexample @c adanocomment
- -------------------------------------------------------------------------
- --                                                                     --
- --  file: intel_cpu.ads                                                --
- --                                                                     --
- --           *********************************************             --
- --           * WARNING: for 32-bit Intel processors only *             --
- --           *********************************************             --
- --                                                                     --
- --  This package contains a number of subprograms that are useful in   --
- --  determining the Intel x86 CPU (and the features it supports) on    --
- --  which the program is running.                                      --
- --                                                                     --
- --  The package is based upon the information given in the Intel       --
- --  Application Note AP-485: "Intel Processor Identification and the   --
- --  CPUID Instruction" as of April 1998. This application note can be  --
- --  found on www.intel.com.                                            --
- --                                                                     --
- --  It currently deals with 32-bit processors only, will not detect    --
- --  features added after april 1998, and does not guarantee proper     --
- --  results on Intel-compatible processors.                            --
- --                                                                     --
- --  Cache info and x386 fpu type detection are not supported.          --
- --                                                                     --
- --  This package does not use any privileged instructions, so should   --
- --  work on any OS running on a 32-bit Intel processor.                --
- --                                                                     --
- -------------------------------------------------------------------------
- 
- with Interfaces;             use Interfaces;
- --  for using unsigned types
- 
- with System.Machine_Code;    use System.Machine_Code;
- --  for using inline assembler code
- 
- with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
- --  for inserting control characters
- 
- package Intel_CPU is
- 
-    ----------------------
-    --  Processor bits  --
-    ----------------------
- 
-    subtype Num_Bits is Natural range 0 .. 31;
-    --  the number of processor bits (32)
- 
-    --------------------------
-    --  Processor register  --
-    --------------------------
- 
-    --  define a processor register type for easy access to
-    --  the individual bits
- 
-    type Processor_Register is array (Num_Bits) of Boolean;
-    pragma Pack (Processor_Register);
-    for Processor_Register'Size use 32;
- 
-    -------------------------
-    --  Unsigned register  --
-    -------------------------
- 
-    --  define a processor register type for easy access to
-    --  the individual bytes
- 
-    type Unsigned_Register is
-       record
-          L1 : Unsigned_8;
-          H1 : Unsigned_8;
-          L2 : Unsigned_8;
-          H2 : Unsigned_8;
-       end record;
- 
-    for Unsigned_Register use
-       record
-          L1 at 0 range  0 ..  7;
-          H1 at 0 range  8 .. 15;
-          L2 at 0 range 16 .. 23;
-          H2 at 0 range 24 .. 31;
-       end record;
- 
-    for Unsigned_Register'Size use 32;
- 
-    ---------------------------------
-    --  Intel processor vendor ID  --
-    ---------------------------------
- 
-    Intel_Processor : constant String (1 .. 12) := "GenuineIntel";
-    --  indicates an Intel manufactured processor
- 
-    ------------------------------------
-    --  Processor signature register  --
-    ------------------------------------
- 
-    --  a register type to hold the processor signature
- 
-    type Processor_Signature is
-       record
-          Stepping       : Natural range 0 .. 15;
-          Model          : Natural range 0 .. 15;
-          Family         : Natural range 0 .. 15;
-          Processor_Type : Natural range 0 .. 3;
-          Reserved       : Natural range 0 .. 262143;
-       end record;
- 
-    for Processor_Signature use
-       record
-          Stepping       at 0 range  0 ..  3;
-          Model          at 0 range  4 ..  7;
-          Family         at 0 range  8 .. 11;
-          Processor_Type at 0 range 12 .. 13;
-          Reserved       at 0 range 14 .. 31;
-       end record;
- 
-    for Processor_Signature'Size use 32;
- 
-    -----------------------------------
-    --  Processor features register  --
-    -----------------------------------
- 
-    --  a processor register to hold the processor feature flags
- 
-    type Processor_Features is
-       record
-          FPU    : Boolean;                --  floating point unit on chip
-          VME    : Boolean;                --  virtual mode extension
-          DE     : Boolean;                --  debugging extension
-          PSE    : Boolean;                --  page size extension
-          TSC    : Boolean;                --  time stamp counter
-          MSR    : Boolean;                --  model specific registers
-          PAE    : Boolean;                --  physical address extension
-          MCE    : Boolean;                --  machine check extension
-          CX8    : Boolean;                --  cmpxchg8 instruction
-          APIC   : Boolean;                --  on-chip apic hardware
-          Res_1  : Boolean;                --  reserved for extensions
-          SEP    : Boolean;                --  fast system call
-          MTRR   : Boolean;                --  memory type range registers
-          PGE    : Boolean;                --  page global enable
-          MCA    : Boolean;                --  machine check architecture
-          CMOV   : Boolean;                --  conditional move supported
-          PAT    : Boolean;                --  page attribute table
-          PSE_36 : Boolean;                --  36-bit page size extension
-          Res_2  : Natural range 0 .. 31;  --  reserved for extensions
-          MMX    : Boolean;                --  MMX technology supported
-          FXSR   : Boolean;                --  fast FP save and restore
-          Res_3  : Natural range 0 .. 127; --  reserved for extensions
-       end record;
- 
-    for Processor_Features use
-       record
-          FPU    at 0 range  0 ..  0;
-          VME    at 0 range  1 ..  1;
-          DE     at 0 range  2 ..  2;
-          PSE    at 0 range  3 ..  3;
-          TSC    at 0 range  4 ..  4;
-          MSR    at 0 range  5 ..  5;
-          PAE    at 0 range  6 ..  6;
-          MCE    at 0 range  7 ..  7;
-          CX8    at 0 range  8 ..  8;
-          APIC   at 0 range  9 ..  9;
-          Res_1  at 0 range 10 .. 10;
-          SEP    at 0 range 11 .. 11;
-          MTRR   at 0 range 12 .. 12;
-          PGE    at 0 range 13 .. 13;
-          MCA    at 0 range 14 .. 14;
-          CMOV   at 0 range 15 .. 15;
-          PAT    at 0 range 16 .. 16;
-          PSE_36 at 0 range 17 .. 17;
-          Res_2  at 0 range 18 .. 22;
-          MMX    at 0 range 23 .. 23;
-          FXSR   at 0 range 24 .. 24;
-          Res_3  at 0 range 25 .. 31;
-       end record;
- 
-    for Processor_Features'Size use 32;
- 
-    -------------------
-    --  Subprograms  --
-    -------------------
- 
-    function Has_FPU return Boolean;
-    --  return True if a FPU is found
-    --  use only if CPUID is not supported
- 
-    function Has_CPUID return Boolean;
-    --  return True if the processor supports the CPUID instruction
- 
-    function CPUID_Level return Natural;
-    --  return the CPUID support level (0, 1 or 2)
-    --  can only be called if the CPUID instruction is supported
- 
-    function Vendor_ID return String;
-    --  return the processor vendor identification string
-    --  can only be called if the CPUID instruction is supported
- 
-    function Signature return Processor_Signature;
-    --  return the processor signature
-    --  can only be called if the CPUID instruction is supported
- 
-    function Features return Processor_Features;
-    --  return the processors features
-    --  can only be called if the CPUID instruction is supported
- 
- private
- 
-    ------------------------
-    --  EFLAGS bit names  --
-    ------------------------
- 
-    ID_Flag : constant Num_Bits := 21;
-    --  ID flag bit
- 
- end Intel_CPU;
- @end smallexample
- 
- @c ---------------------------------------------------------------------------
- @node Intel_CPU Package Body
- @subsection @code{Intel_CPU} Package Body
- @cindex Intel_CPU package body
- 
- @smallexample @c adanocomment
- package body Intel_CPU is
- 
-    ---------------------------
-    --  Detect FPU presence  --
-    ---------------------------
- 
-    --  There is a FPU present if we can set values to the FPU Status
-    --  and Control Words.
- 
-    function Has_FPU return Boolean is
- 
-       Register : Unsigned_16;
-       --  processor register to store a word
- 
-    begin
- 
-       --  check if we can change the status word
-       Asm (
- 
-            --  the assembler code
-            "finit"              & LF & HT &    --  reset status word
-            "movw $0x5A5A, %%ax" & LF & HT &    --  set value status word
-            "fnstsw %0"          & LF & HT &    --  save status word
-            "movw %%ax, %0",                    --  store status word
- 
-            --  output stored in Register
-            --  register must be a memory location
-            Outputs => Unsigned_16'Asm_output ("=m", Register),
- 
-            --  tell compiler that we used eax
-            Clobber => "eax");
- 
-       --  if the status word is zero, there is no FPU
-       if Register = 0 then
-          return False;   --  no status word
-       end if;  --  check status word value
- 
-       --  check if we can get the control word
-       Asm (
- 
-            --  the assembler code
-            "fnstcw %0",   --  save the control word
- 
-            --  output into Register
-            --  register must be a memory location
-            Outputs => Unsigned_16'Asm_output ("=m", Register));
- 
-       --  check the relevant bits
-       if (Register and 16#103F#) /= 16#003F# then
-          return False;   --  no control word
-       end if;  --  check control word value
- 
-       --  FPU found
-       return True;
- 
-    end Has_FPU;
- 
-    --------------------------------
-    --  Detect CPUID instruction  --
-    --------------------------------
- 
-    --  The processor supports the CPUID instruction if it is possible
-    --  to change the value of ID flag bit in the EFLAGS register.
- 
-    function Has_CPUID return Boolean is
- 
-       Original_Flags, Modified_Flags : Processor_Register;
-       --  EFLAG contents before and after changing the ID flag
- 
-    begin
- 
-       --  try flipping the ID flag in the EFLAGS register
-       Asm (
- 
-            --  the assembler code
-            "pushfl"               & LF & HT &     --  push EFLAGS on stack
-            "pop %%eax"            & LF & HT &     --  pop EFLAGS into eax
-            "movl %%eax, %0"       & LF & HT &     --  save EFLAGS content
-            "xor $0x200000, %%eax" & LF & HT &     --  flip ID flag
-            "push %%eax"           & LF & HT &     --  push EFLAGS on stack
-            "popfl"                & LF & HT &     --  load EFLAGS register
-            "pushfl"               & LF & HT &     --  push EFLAGS on stack
-            "pop %1",                              --  save EFLAGS content
- 
-            --  output values, may be anything
-            --  Original_Flags is %0
-            --  Modified_Flags is %1
-            Outputs =>
-               (Processor_Register'Asm_output ("=g", Original_Flags),
-                Processor_Register'Asm_output ("=g", Modified_Flags)),
- 
-            --  tell compiler eax is destroyed
-            Clobber => "eax");
- 
-       --  check if CPUID is supported
-       if Original_Flags(ID_Flag) /= Modified_Flags(ID_Flag) then
-          return True;   --  ID flag was modified
-       else
-          return False;  --  ID flag unchanged
-       end if;  --  check for CPUID
- 
-    end Has_CPUID;
- 
-    -------------------------------
-    --  Get CPUID support level  --
-    -------------------------------
- 
-    function CPUID_Level return Natural is
- 
-       Level : Unsigned_32;
-       --  returned support level
- 
-    begin
- 
-       --  execute CPUID, storing the results in the Level register
-       Asm (
- 
-            --  the assembler code
-            "cpuid",    --  execute CPUID
- 
-            --  zero is stored in eax
-            --  returning the support level in eax
-            Inputs => Unsigned_32'Asm_input ("a", 0),
- 
-            --  eax is stored in Level
-            Outputs => Unsigned_32'Asm_output ("=a", Level),
- 
-            --  tell compiler ebx, ecx and edx registers are destroyed
-            Clobber => "ebx, ecx, edx");
- 
-       --  return the support level
-       return Natural (Level);
- 
-    end CPUID_Level;
- 
-    --------------------------------
-    --  Get CPU Vendor ID String  --
-    --------------------------------
- 
-    --  The vendor ID string is returned in the ebx, ecx and edx register
-    --  after executing the CPUID instruction with eax set to zero.
-    --  In case of a true Intel processor the string returned is
-    --  "GenuineIntel"
- 
-    function Vendor_ID return String is
- 
-       Ebx, Ecx, Edx : Unsigned_Register;
-       --  registers containing the vendor ID string
- 
-       Vendor_ID : String (1 .. 12);
-       -- the vendor ID string
- 
-    begin
- 
-       --  execute CPUID, storing the results in the processor registers
-       Asm (
- 
-            --  the assembler code
-            "cpuid",    --  execute CPUID
- 
-            --  zero stored in eax
-            --  vendor ID string returned in ebx, ecx and edx
-            Inputs => Unsigned_32'Asm_input ("a", 0),
- 
-            --  ebx is stored in Ebx
-            --  ecx is stored in Ecx
-            --  edx is stored in Edx
-            Outputs => (Unsigned_Register'Asm_output ("=b", Ebx),
-                        Unsigned_Register'Asm_output ("=c", Ecx),
-                        Unsigned_Register'Asm_output ("=d", Edx)));
- 
-       --  now build the vendor ID string
-       Vendor_ID( 1) := Character'Val (Ebx.L1);
-       Vendor_ID( 2) := Character'Val (Ebx.H1);
-       Vendor_ID( 3) := Character'Val (Ebx.L2);
-       Vendor_ID( 4) := Character'Val (Ebx.H2);
-       Vendor_ID( 5) := Character'Val (Edx.L1);
-       Vendor_ID( 6) := Character'Val (Edx.H1);
-       Vendor_ID( 7) := Character'Val (Edx.L2);
-       Vendor_ID( 8) := Character'Val (Edx.H2);
-       Vendor_ID( 9) := Character'Val (Ecx.L1);
-       Vendor_ID(10) := Character'Val (Ecx.H1);
-       Vendor_ID(11) := Character'Val (Ecx.L2);
-       Vendor_ID(12) := Character'Val (Ecx.H2);
- 
-       --  return string
-       return Vendor_ID;
- 
-    end Vendor_ID;
- 
-    -------------------------------
-    --  Get processor signature  --
-    -------------------------------
- 
-    function Signature return Processor_Signature is
- 
-       Result : Processor_Signature;
-       --  processor signature returned
- 
-    begin
- 
-       --  execute CPUID, storing the results in the Result variable
-       Asm (
- 
-            --  the assembler code
-            "cpuid",    --  execute CPUID
- 
-            --  one is stored in eax
-            --  processor signature returned in eax
-            Inputs => Unsigned_32'Asm_input ("a", 1),
- 
-            --  eax is stored in Result
-            Outputs => Processor_Signature'Asm_output ("=a", Result),
- 
-            --  tell compiler that ebx, ecx and edx are also destroyed
-            Clobber => "ebx, ecx, edx");
- 
-       --  return processor signature
-       return Result;
- 
-    end Signature;
- 
-    ------------------------------
-    --  Get processor features  --
-    ------------------------------
- 
-    function Features return Processor_Features is
- 
-       Result : Processor_Features;
-       --  processor features returned
- 
-    begin
- 
-       --  execute CPUID, storing the results in the Result variable
-       Asm (
- 
-            --  the assembler code
-            "cpuid",    --  execute CPUID
- 
-            --  one stored in eax
-            --  processor features returned in edx
-            Inputs => Unsigned_32'Asm_input ("a", 1),
- 
-            --  edx is stored in Result
-            Outputs => Processor_Features'Asm_output ("=d", Result),
- 
-            --  tell compiler that ebx and ecx are also destroyed
-            Clobber => "ebx, ecx");
- 
-       --  return processor signature
-       return Result;
- 
-    end Features;
- 
- end Intel_CPU;
- @end smallexample
  @c END OF INLINE ASSEMBLER CHAPTER
  @c ===============================
  
--- 25504,25509 ----
*************** applications developed in other Ada envi
*** 26189,26195 ****
  * Implementation-dependent characteristics::
  * Compatibility with Other Ada 95 Systems::
  * Representation Clauses::
! * Compatibility with DEC Ada 83::
  @ifset vms
  * Transitioning from Alpha to Integrity OpenVMS::
  @end ifset
--- 25524,25530 ----
  * Implementation-dependent characteristics::
  * Compatibility with Other Ada 95 Systems::
  * Representation Clauses::
! * Compatibility with HP Ada 83::
  @ifset vms
  * Transitioning from Alpha to Integrity OpenVMS::
  @end ifset
*************** the item nearer to the declaration of th
*** 26256,26262 ****
  A particular case is that representation pragmas
  @ifset vms
  (including the
! extended DEC Ada 83 compatibility pragmas such as @code{Export_Procedure})
  @end ifset
  cannot be applied to a subprogram body.  If necessary, a separate subprogram
  declaration must be introduced to which the pragma can be applied.
--- 25591,25597 ----
  A particular case is that representation pragmas
  @ifset vms
  (including the
! extended HP Ada 83 compatibility pragmas such as @code{Export_Procedure})
  @end ifset
  cannot be applied to a subprogram body.  If necessary, a separate subprogram
  declaration must be introduced to which the pragma can be applied.
*************** new Ada 95 reserved words are treated si
*** 26367,26373 ****
  However,
  in practice, it is usually advisable to make the necessary modifications
  to the program to remove the need for using this switch.
! See @ref{Compiling Ada 83 Programs}.
  
  @item Support for removed Ada 83 pragmas and attributes
  A number of pragmas and attributes from Ada 83 have been removed from Ada 95,
--- 25702,25708 ----
  However,
  in practice, it is usually advisable to make the necessary modifications
  to the program to remove the need for using this switch.
! See @ref{Compiling Different Versions of Ada}.
  
  @item Support for removed Ada 83 pragmas and attributes
  A number of pragmas and attributes from Ada 83 have been removed from Ada 95,
*************** are described in the GNAT Reference Manu
*** 26409,26415 ****
  are specifically intended to correspond to other vendors' Ada 83 pragmas.
  For migrating from VADS, the pragma @code{Use_VADS_Size} may be useful.
  For
! compatibility with DEC Ada 83, GNAT supplies the pragmas
  @code{Extend_System}, @code{Ident}, @code{Inline_Generic},
  @code{Interface_Name}, @code{Passive}, @code{Suppress_All},
  and @code{Volatile}.
--- 25744,25750 ----
  are specifically intended to correspond to other vendors' Ada 83 pragmas.
  For migrating from VADS, the pragma @code{Use_VADS_Size} may be useful.
  For
! compatibility with HP Ada 83, GNAT supplies the pragmas
  @code{Extend_System}, @code{Ident}, @code{Inline_Generic},
  @code{Interface_Name}, @code{Passive}, @code{Suppress_All},
  and @code{Volatile}.
*************** implementation.  All GNAT-defined attrib
*** 26428,26434 ****
  @cite{GNAT Reference Manual}, and these include several that are specifically
  intended
  to correspond to other vendors' Ada 83 attributes.  For migrating from VADS,
! the attribute @code{VADS_Size} may be useful.  For compatibility with DEC
  Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and
  @code{Type_Class}.
  
--- 25763,25769 ----
  @cite{GNAT Reference Manual}, and these include several that are specifically
  intended
  to correspond to other vendors' Ada 83 attributes.  For migrating from VADS,
! the attribute @code{VADS_Size} may be useful.  For compatibility with HP
  Ada 83, GNAT supplies the attributes @code{Bit}, @code{Machine_Size} and
  @code{Type_Class}.
  
*************** Program_Error being raised due to an ``A
*** 26463,26469 ****
  to invoke a subprogram its body has been elaborated, or to instantiate a
  generic before the generic body has been elaborated.  By default GNAT
  attempts to choose a safe order (one that will not encounter access before
! elaboration problems) by implicitly inserting Elaborate_All pragmas where
  needed.  However, this can lead to the creation of elaboration circularities
  and a resulting rejection of the program by gnatbind.  This issue is
  thoroughly described in @ref{Elaboration Order Handling in GNAT}.
--- 25798,25805 ----
  to invoke a subprogram its body has been elaborated, or to instantiate a
  generic before the generic body has been elaborated.  By default GNAT
  attempts to choose a safe order (one that will not encounter access before
! elaboration problems) by implicitly inserting @code{Elaborate} or
! @code{Elaborate_All} pragmas where
  needed.  However, this can lead to the creation of elaboration circularities
  and a resulting rejection of the program by gnatbind.  This issue is
  thoroughly described in @ref{Elaboration Order Handling in GNAT}.
*************** is to use a component size clause for th
*** 26608,26643 ****
  or a record representation clause for an access field in a record.
  @end table
  
! @node Compatibility with DEC Ada 83
! @section Compatibility with DEC Ada 83
  
  @noindent
  The VMS version of GNAT fully implements all the pragmas and attributes
! provided by DEC Ada 83, as well as providing the standard DEC Ada 83
  libraries, including Starlet.  In addition, data layouts and parameter
  passing conventions are highly compatible.  This means that porting
! existing DEC Ada 83 code to GNAT in VMS systems should be easier than
  most other porting efforts.  The following are some of the most
! significant differences between GNAT and DEC Ada 83.
  
  @table @asis
  @item Default floating-point representation
! In GNAT, the default floating-point format is IEEE, whereas in DEC Ada 83,
  it is VMS format.  GNAT does implement the necessary pragmas
  (Long_Float, Float_Representation) for changing this default.
  
  @item System
  The package System in GNAT exactly corresponds to the definition in the
  Ada 95 reference manual, which means that it excludes many of the
! DEC Ada 83 extensions.  However, a separate package Aux_DEC is provided
  that contains the additional definitions, and a special pragma,
  Extend_System allows this package to be treated transparently as an
  extension of package System.
  
  @item To_Address
  The definitions provided by Aux_DEC are exactly compatible with those
! in the DEC Ada 83 version of System, with one exception.
! DEC Ada provides the following declarations:
  
  @smallexample @c ada
  TO_ADDRESS (INTEGER)
--- 25944,25979 ----
  or a record representation clause for an access field in a record.
  @end table
  
! @node Compatibility with HP Ada 83
! @section Compatibility with HP Ada 83
  
  @noindent
  The VMS version of GNAT fully implements all the pragmas and attributes
! provided by HP Ada 83, as well as providing the standard HP Ada 83
  libraries, including Starlet.  In addition, data layouts and parameter
  passing conventions are highly compatible.  This means that porting
! existing HP Ada 83 code to GNAT in VMS systems should be easier than
  most other porting efforts.  The following are some of the most
! significant differences between GNAT and HP Ada 83.
  
  @table @asis
  @item Default floating-point representation
! In GNAT, the default floating-point format is IEEE, whereas in HP Ada 83,
  it is VMS format.  GNAT does implement the necessary pragmas
  (Long_Float, Float_Representation) for changing this default.
  
  @item System
  The package System in GNAT exactly corresponds to the definition in the
  Ada 95 reference manual, which means that it excludes many of the
! HP Ada 83 extensions.  However, a separate package Aux_DEC is provided
  that contains the additional definitions, and a special pragma,
  Extend_System allows this package to be treated transparently as an
  extension of package System.
  
  @item To_Address
  The definitions provided by Aux_DEC are exactly compatible with those
! in the HP Ada 83 version of System, with one exception.
! HP Ada provides the following declarations:
  
  @smallexample @c ada
  TO_ADDRESS (INTEGER)
*************** TO_ADDRESS (universal_integer)
*** 26649,26655 ****
  The version of TO_ADDRESS taking a universal integer argument is in fact
  an extension to Ada 83 not strictly compatible with the reference manual.
  In GNAT, we are constrained to be exactly compatible with the standard,
! and this means we cannot provide this capability.  In DEC Ada 83, the
  point of this definition is to deal with a call like:
  
  @smallexample @c ada
--- 25985,25991 ----
  The version of TO_ADDRESS taking a universal integer argument is in fact
  an extension to Ada 83 not strictly compatible with the reference manual.
  In GNAT, we are constrained to be exactly compatible with the standard,
! and this means we cannot provide this capability.  In HP Ada 83, the
  point of this definition is to deal with a call like:
  
  @smallexample @c ada
*************** TO_ADDRESS (16#12777#);
*** 26659,26665 ****
  @noindent
  Normally, according to the Ada 83 standard, one would expect this to be
  ambiguous, since it matches both the INTEGER and UNSIGNED_LONGWORD forms
! of TO_ADDRESS@.  However, in DEC Ada 83, there is no ambiguity, since the
  definition using universal_integer takes precedence.
  
  In GNAT, since the version with universal_integer cannot be supplied, it is
--- 25995,26001 ----
  @noindent
  Normally, according to the Ada 83 standard, one would expect this to be
  ambiguous, since it matches both the INTEGER and UNSIGNED_LONGWORD forms
! of TO_ADDRESS@.  However, in HP Ada 83, there is no ambiguity, since the
  definition using universal_integer takes precedence.
  
  In GNAT, since the version with universal_integer cannot be supplied, it is
*************** which in GNAT is treated like any other 
*** 26688,26697 ****
  @end table
  
  For full details on these and other less significant compatibility issues,
! see appendix E of the Digital publication entitled @cite{DEC Ada, Technical
! Overview and Comparison on DIGITAL Platforms}.
  
! For GNAT running on other than VMS systems, all the DEC Ada 83 pragmas and
  attributes are recognized, although only a subset of them can sensibly
  be implemented.  The description of pragmas in this reference manual
  indicates whether or not they are applicable to non-VMS systems.
--- 26024,26033 ----
  @end table
  
  For full details on these and other less significant compatibility issues,
! see appendix E of the HP publication entitled @cite{HP Ada, Technical
! Overview and Comparison on HP Platforms}.
  
! For GNAT running on other than VMS systems, all the HP Ada 83 pragmas and
  attributes are recognized, although only a subset of them can sensibly
  be implemented.  The description of pragmas in this reference manual
  indicates whether or not they are applicable to non-VMS systems.
*************** environment to build your executable.
*** 27305,27310 ****
--- 26641,26647 ----
  @menu
  * C Calling Convention::
  * Stdcall Calling Convention::
+ * Win32 Calling Convention::
  * DLL Calling Convention::
  @end menu
  
*************** are available for Windows:
*** 27325,27330 ****
--- 26662,26670 ----
  @code{Stdcall} (Microsoft defined)
  
  @item
+ @code{Win32} (GNAT specific)
+ 
+ @item
  @code{DLL} (GNAT specific)
  @end itemize
  
*************** is missing, as in the above example, thi
*** 27367,27374 ****
  
  When importing a variable defined in C, you should always use the @code{C}
  calling convention unless the object containing the variable is part of a
! DLL (in which case you should use the @code{DLL} calling convention,
! @pxref{DLL Calling Convention}).
  
  @node Stdcall Calling Convention
  @subsection @code{Stdcall} Calling Convention
--- 26707,26714 ----
  
  When importing a variable defined in C, you should always use the @code{C}
  calling convention unless the object containing the variable is part of a
! DLL (in which case you should use the @code{Stdcall} calling
! convention, @pxref{Stdcall Calling Convention}).
  
  @node Stdcall Calling Convention
  @subsection @code{Stdcall} Calling Convention
*************** The @code{gnatdll} tool, which creates t
*** 27443,27456 ****
  to handle those cases (@pxref{Using gnatdll} for the description of
  the switches).
  
- @node DLL Calling Convention
- @subsection @code{DLL} Calling Convention
- 
  @noindent
! This convention, which is GNAT-specific, must be used when you want to
! import in Ada a variables defined in a DLL. For functions and procedures
! this convention is equivalent to the @code{Stdcall} convention. As an
! example, if a DLL contains a variable defined as:
  
  @smallexample
  int my_var;
--- 26783,26792 ----
  to handle those cases (@pxref{Using gnatdll} for the description of
  the switches).
  
  @noindent
! It is also possible to import variables defined in a DLL by using an
! import pragma for a variable. As an example, if a DLL contains a
! variable defined as:
  
  @smallexample
  int my_var;
*************** then, to access this variable from Ada y
*** 27462,27474 ****
  @smallexample @c ada
  @group
  My_Var : Interfaces.C.int;
! pragma Import (DLL, My_Var);
  @end group
  @end smallexample
  
! The remarks concerning the @code{External_Name} and @code{Link_Name}
! parameters given in the previous sections equally apply to the @code{DLL}
! calling convention.
  
  @node Introduction to Dynamic Link Libraries (DLLs)
  @section Introduction to Dynamic Link Libraries (DLLs)
--- 26798,26824 ----
  @smallexample @c ada
  @group
  My_Var : Interfaces.C.int;
! pragma Import (Stdcall, My_Var);
  @end group
  @end smallexample
  
! @noindent
! Note that to ease building cross-platform bindings this convention
! will be handled as a @code{C} calling convention on non Windows platforms.
! 
! @node Win32 Calling Convention
! @subsection @code{Win32} Calling Convention
! 
! @noindent
! This convention, which is GNAT-specific is fully equivalent to the
! @code{Stdcall} calling convention described above.
! 
! @node DLL Calling Convention
! @subsection @code{DLL} Calling Convention
! 
! @noindent
! This convention, which is GNAT-specific is fully equivalent to the
! @code{Stdcall} calling convention described above.
  
  @node Introduction to Dynamic Link Libraries (DLLs)
  @section Introduction to Dynamic Link Libraries (DLLs)
*************** end API;
*** 27653,27661 ****
  @end smallexample
  
  @noindent
! Note that a variable is @strong{always imported with a DLL convention}. A
! function can have @code{C}, @code{Stdcall} or @code{DLL} convention. For
! subprograms, the @code{DLL} convention is a synonym of @code{Stdcall}
  (@pxref{Windows Calling Conventions}).
  
  @node Creating an Import Library
--- 27003,27011 ----
  @end smallexample
  
  @noindent
! Note that a variable is
! @strong{always imported with a Stdcall convention}. A function
! can have @code{C} or @code{Stdcall} convention.
  (@pxref{Windows Calling Conventions}).
  
  @node Creating an Import Library
*************** There is nothing specific to Windows in 
*** 27918,27924 ****
  @end menu
  
  @noindent
! Note that it is prefered to use the built-in GNAT DLL support
  (@pxref{Building DLLs with GNAT}) or GNAT Project files
  (@pxref{Building DLLs with GNAT Project files}) to build DLLs.
  
--- 27268,27274 ----
  @end menu
  
  @noindent
! Note that it is preferred to use the built-in GNAT DLL support
  (@pxref{Building DLLs with GNAT}) or GNAT Project files
  (@pxref{Building DLLs with GNAT Project files}) to build DLLs.
  
*************** library (@pxref{Using gnatdll}).
*** 27964,27972 ****
  @end enumerate
  
  @noindent
! Note that a relocatable DLL stripped using the @code{strip} binutils
! tool will not be relocatable anymore. To build a DLL without debug
! information pass @code{-largs -s} to @code{gnatdll}.
  
  @node Limitations When Using Ada DLLs from Ada
  @subsection Limitations When Using Ada DLLs from Ada
--- 27314,27324 ----
  @end enumerate
  
  @noindent
! Note that a relocatable DLL stripped using the @code{strip}
! binutils tool will not be relocatable anymore. To build a DLL without
! debug information pass @code{-largs -s} to @code{gnatdll}. This
! restriction does not apply to a DLL built using a Library Project.
! @pxref{Library Projects}.
  
  @node Limitations When Using Ada DLLs from Ada
  @subsection Limitations When Using Ada DLLs from Ada
*************** Windows object handles, etc.
*** 27996,28005 ****
  Building a DLL is a way to encapsulate a set of services usable from any
  application. As a result, the Ada entities exported by a DLL should be
  exported with the @code{C} or @code{Stdcall} calling conventions to avoid
! any Ada name mangling. Please note that the @code{Stdcall} convention
! should only be used for subprograms, not for variables. As an example here
! is an Ada package @code{API}, spec and body, exporting two procedures, a
! function, and a variable:
  
  @smallexample @c ada
  @group
--- 27348,27356 ----
  Building a DLL is a way to encapsulate a set of services usable from any
  application. As a result, the Ada entities exported by a DLL should be
  exported with the @code{C} or @code{Stdcall} calling conventions to avoid
! any Ada name mangling. As an example here is an Ada package
! @code{API}, spec and body, exporting two procedures, a function, and a
! variable:
  
  @smallexample @c ada
  @group
*************** switch). Here are the step-by-step instr
*** 28690,28700 ****
  $ gdb -nw ada_main
  @end smallexample
  
! @item Break on the main procedure and run the program.
  
  @smallexample
! (gdb) break ada_main
! (gdb) run
  @end smallexample
  
  @noindent
--- 28041,28050 ----
  $ gdb -nw ada_main
  @end smallexample
  
! @item Start the program and stop at the beginning of the main procedure
  
  @smallexample
! (gdb) start
  @end smallexample
  
  @noindent
*************** possible to set a breakpoint in the DLL.
*** 28707,28713 ****
  
  @smallexample
  (gdb) break ada_dll
! (gdb) run
  @end smallexample
  
  @end enumerate
--- 28057,28063 ----
  
  @smallexample
  (gdb) break ada_dll
! (gdb) cont
  @end smallexample
  
  @end enumerate
*************** At this stage a breakpoint is set inside
*** 28717,28722 ****
--- 28067,28076 ----
  you can use the standard approach to debug the whole program
  (@pxref{Running and Debugging Ada Programs}).
  
+ @ignore
+ @c This used to work, probably because the DLLs were non-relocatable
+ @c keep this section around until the problem is sorted out.
+ 
  To break on the @code{DllMain} routine it is not possible to follow
  the procedure above. At the time the program stop on @code{ada_main}
  the @code{DllMain} routine as already been called. Either you can use
*************** the procedure below @pxref{Debugging the
*** 28726,28732 ****
  @item Launch @code{GDB} on the main program.
  
  @smallexample
! $ gdb -nw ada_main
  @end smallexample
  
  @item Load DLL symbols
--- 28080,28086 ----
  @item Launch @code{GDB} on the main program.
  
  @smallexample
! $ gdb ada_main
  @end smallexample
  
  @item Load DLL symbols
*************** on the proper line (break in @file{ada_d
*** 28752,28757 ****
--- 28106,28112 ----
  @end smallexample
  
  @end enumerate
+ @end ignore
  
  @node Program Built with Foreign Tools and DLL Built with GCC/GNAT
  @subsection Program Built with Foreign Tools and DLL Built with GCC/GNAT
*************** been built with debugging information (s
*** 28785,28818 ****
  
  @enumerate 1
  @item
! Launch the debugger on the DLL.
  
  @smallexample
! $ gdb -nw test.dll
  @end smallexample
  
! @item Set a breakpoint on a DLL subroutine.
  
  @smallexample
! (gdb) break ada_dll.adb:45
  @end smallexample
  
! Note that at this point it is not possible to break using the routine symbol
! directly as the program is not yet running. The solution is to break
! on the proper line (break in @file{ada_dll.adb} line 45).
  
  @item
! Specify the executable file to @code{GDB}.
  
  @smallexample
! (gdb) exec-file main.exe
  @end smallexample
  
  @item
! Run the program.
  
  @smallexample
! (gdb) run
  @end smallexample
  
  @noindent
--- 28140,28197 ----
  
  @enumerate 1
  @item
! Find out the executable starting address
  
  @smallexample
! $ objdump --file-header main.exe
  @end smallexample
  
! The starting address is reported on the last line. For example:
  
  @smallexample
! main.exe:     file format pei-i386
! architecture: i386, flags 0x0000010a:
! EXEC_P, HAS_DEBUG, D_PAGED
! start address 0x00401010
  @end smallexample
  
! @item
! Launch the debugger on the executable.
! 
! @smallexample
! $ gdb main.exe
! @end smallexample
  
  @item
! Set a breakpoint at the starting address, and launch the program.
  
  @smallexample
! $ (gdb) break *0x00401010
! $ (gdb) run
  @end smallexample
  
+ The program will stop at the given address.
+ 
  @item
! Set a breakpoint on a DLL subroutine.
  
  @smallexample
! (gdb) break ada_dll.adb:45
! @end smallexample
! 
! Or if you want to break using a symbol on the DLL, you need first to
! select the Ada language (language used by the DLL).
! 
! @smallexample
! (gdb) set language ada
! (gdb) break ada_dll
! @end smallexample
! 
! @item
! Continue the program.
! 
! @smallexample
! (gdb) cont
  @end smallexample
  
  @noindent
*************** that the process PID for @file{main.exe}
*** 28850,28856 ****
  @item Launch gdb.
  
  @smallexample
! $ gdb -nw
  @end smallexample
  
  @item Attach to the running process to be debugged.
--- 28229,28235 ----
  @item Launch gdb.
  
  @smallexample
! $ gdb
  @end smallexample
  
  @item Attach to the running process to be debugged.
*************** $ gdb -nw
*** 28874,28880 ****
  @item Continue process execution.
  
  @smallexample
! (gdb) continue
  @end smallexample
  
  @end enumerate
--- 28253,28259 ----
  @item Continue process execution.
  
  @smallexample
! (gdb) cont
  @end smallexample
  
  @end enumerate
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatbind.adb gcc-4.1.0/gcc/ada/gnatbind.adb
*** gcc-4.0.2/gcc/ada/gnatbind.adb	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/gnatbind.adb	Tue Nov 15 13:59:20 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatbind is
*** 75,80 ****
--- 75,84 ----
  
     Mapping_File : String_Ptr := null;
  
+    function Gnatbind_Supports_Auto_Init return Boolean;
+    --  Indicates if automatic initialization of elaboration procedure
+    --  through the constructor mechanism is possible on the platform.
+ 
     procedure List_Applicable_Restrictions;
     --  List restrictions that apply to this partition if option taken
  
*************** procedure Gnatbind is
*** 83,88 ****
--- 87,118 ----
     --  All the one character arguments are still handled by Switch. This
     --  routine handles -aO -aI and -I-.
  
+    function Is_Cross_Compiler return Boolean;
+    --  Returns True iff this is a cross-compiler
+ 
+    ---------------------------------
+    -- Gnatbind_Supports_Auto_Init --
+    ---------------------------------
+ 
+    function Gnatbind_Supports_Auto_Init return Boolean is
+       function gnat_binder_supports_auto_init return Integer;
+       pragma Import (C, gnat_binder_supports_auto_init,
+                      "__gnat_binder_supports_auto_init");
+    begin
+       return gnat_binder_supports_auto_init /= 0;
+    end Gnatbind_Supports_Auto_Init;
+ 
+    -----------------------
+    -- Is_Cross_Compiler --
+    -----------------------
+ 
+    function Is_Cross_Compiler return Boolean is
+       Cross_Compiler : Integer;
+       pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
+    begin
+       return Cross_Compiler = 1;
+    end Is_Cross_Compiler;
+ 
     ----------------------------------
     -- List_Applicable_Restrictions --
     ----------------------------------
*************** procedure Gnatbind is
*** 334,341 ****
           --  -Mname
  
           elsif Argv'Length >= 3 and then Argv (2) = 'M' then
!             Opt.Bind_Alternate_Main_Name := True;
!             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
  
           --  All other options are single character and are handled by
           --  Scan_Binder_Switches.
--- 364,375 ----
           --  -Mname
  
           elsif Argv'Length >= 3 and then Argv (2) = 'M' then
!             if Is_Cross_Compiler then
!                Opt.Bind_Alternate_Main_Name := True;
!                Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
!             else
!                Fail ("-M option only valid for a cross-compiler");
!             end if;
  
           --  All other options are single character and are handled by
           --  Scan_Binder_Switches.
*************** begin
*** 393,398 ****
--- 427,442 ----
        Next_Arg := Next_Arg + 1;
     end loop Scan_Args;
  
+    if Use_Pragma_Linker_Constructor then
+       if Bind_Main_Program then
+          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
+ 
+       elsif not Gnatbind_Supports_Auto_Init then
+          Fail ("automatic initialisation of elaboration " &
+                "not supported on this platform");
+       end if;
+    end if;
+ 
     --  Test for trailing -o switch
  
     if Opt.Output_File_Name_Present
*************** begin
*** 539,545 ****
              Id := Scan_ALI
                      (F             => Main_Lib_File,
                       T             => Text,
!                      Ignore_ED     => Force_RM_Elaboration_Order,
                       Err           => False,
                       Ignore_Errors => Debug_Flag_I);
           end;
--- 583,589 ----
              Id := Scan_ALI
                      (F             => Main_Lib_File,
                       T             => Text,
!                      Ignore_ED     => False,
                       Err           => False,
                       Ignore_Errors => Debug_Flag_I);
           end;
*************** begin
*** 584,590 ****
                Scan_ALI
                  (F             => Std_Lib_File,
                   T             => Text,
!                  Ignore_ED     => Force_RM_Elaboration_Order,
                   Err           => False,
                   Ignore_Errors => Debug_Flag_I);
           end;
--- 628,634 ----
                Scan_ALI
                  (F             => Std_Lib_File,
                   T             => Text,
!                  Ignore_ED     => False,
                   Err           => False,
                   Ignore_Errors => Debug_Flag_I);
           end;
*************** begin
*** 598,614 ****
           Read_ALI (Index);
        end loop;
  
-       --  Warn if -f switch used
- 
-       if Force_RM_Elaboration_Order then
-          Error_Msg
-            ("?-f is obsolescent and should not be used");
-          Error_Msg
-            ("?may result in missing run-time elaboration checks");
-          Error_Msg
-            ("?use -gnatE, pragma Suppress (Elaboration_Check) instead");
-       end if;
- 
        --  Quit if some file needs compiling
  
        if No_Object_Specified then
--- 642,647 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatbind.ads gcc-4.1.0/gcc/ada/gnatbind.ads
*** gcc-4.0.2/gcc/ada/gnatbind.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnatbind.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatbl.c gcc-4.1.0/gcc/ada/gnatbl.c
*** gcc-4.0.2/gcc/ada/gnatbl.c	Thu Feb 10 13:54:28 2005
--- gcc-4.1.0/gcc/ada/gnatbl.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatchop.adb gcc-4.1.0/gcc/ada/gnatchop.adb
*** gcc-4.0.2/gcc/ada/gnatchop.adb	Thu Feb 10 13:49:13 2005
--- gcc-4.1.0/gcc/ada/gnatchop.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1998-2005 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1998-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatchop is
*** 521,537 ****
  
     function Locate_Executable
       (Program_Name    : String;
!       Look_For_Prefix : Boolean := True)
!      return             String_Access
     is
!       Current_Command : constant String := Command_Name;
!       End_Of_Prefix   : Natural  := Current_Command'First - 1;
!       Start_Of_Prefix : Positive := Current_Command'First;
        Result          : String_Access;
  
     begin
  
        if Look_For_Prefix then
           --  Find Start_Of_Prefix
  
           for J in reverse Current_Command'Range loop
--- 521,539 ----
  
     function Locate_Executable
       (Program_Name    : String;
!       Look_For_Prefix : Boolean := True) return String_Access
     is
!       Current_Command : constant String := Normalize_Pathname (Command_Name);
!       End_Of_Prefix   : Natural;
!       Start_Of_Prefix : Positive;
        Result          : String_Access;
  
     begin
+       Start_Of_Prefix := Current_Command'First;
+       End_Of_Prefix   := Start_Of_Prefix - 1;
  
        if Look_For_Prefix then
+ 
           --  Find Start_Of_Prefix
  
           for J in reverse Current_Command'Range loop
*************** procedure Gnatchop is
*** 546,553 ****
  
           --  Find End_Of_Prefix
  
-          End_Of_Prefix := Start_Of_Prefix - 1;
- 
           for J in reverse Start_Of_Prefix .. Current_Command'Last loop
              if Current_Command (J) = '-' then
                 End_Of_Prefix := J;
--- 548,553 ----
*************** procedure Gnatchop is
*** 1163,1170 ****
                 Put (Standard_Error, "GNATCHOP ");
                 Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
                 Put_Line
!                  (Standard_Error,
!                   "Copyright 1998-2005, Ada Core Technologies Inc.");
  
              when 'w' =>
                 Overwrite_Files := True;
--- 1163,1169 ----
                 Put (Standard_Error, "GNATCHOP ");
                 Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
                 Put_Line
!                  (Standard_Error, "Copyright 1998-2005, AdaCore");
  
              when 'w' =>
                 Overwrite_Files := True;
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatclean.adb gcc-4.1.0/gcc/ada/gnatclean.adb
*** gcc-4.0.2/gcc/ada/gnatclean.adb	Tue Oct 21 13:42:07 2003
--- gcc-4.1.0/gcc/ada/gnatclean.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatcmd.adb gcc-4.1.0/gcc/ada/gnatcmd.adb
*** gcc-4.0.2/gcc/ada/gnatcmd.adb	Wed Dec  8 11:25:39 2004
--- gcc-4.1.0/gcc/ada/gnatcmd.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Opt;      use Opt;
*** 34,40 ****
  with Osint;    use Osint;
  with Output;
  with Prj;      use Prj;
- with Prj.Com;
  with Prj.Env;
  with Prj.Ext;  use Prj.Ext;
  with Prj.Pars;
--- 34,39 ----
*************** with Table;
*** 57,62 ****
--- 56,62 ----
  with VMS_Conv; use VMS_Conv;
  
  procedure GNATCmd is
+    Project_Tree      : constant Project_Tree_Ref := new Project_Tree_Data;
     Project_File      : String_Access;
     Project           : Prj.Project_Id;
     Current_Verbosity : Prj.Verbosity := Prj.Default;
*************** procedure GNATCmd is
*** 149,160 ****
--- 149,170 ----
     ----------------------------------
  
     The_Command : Command_Type;
+    --  The command specified in the invocation of the GNAT driver
  
     Command_Arg : Positive := 1;
+    --  The index of the command in the arguments of the GNAT driver
  
     My_Exit_Status : Exit_Status := Success;
+    --  The exit status of the spawned tool. Used to set the correct VMS
+    --  exit status.
  
     Current_Work_Dir : constant String := Get_Current_Dir;
+    --  The path of the working directory
+ 
+    All_Projects : Boolean := False;
+    --  Flag used for GNAT PRETTY and GNAT METRIC to indicate that
+    --  the underlying tool (gnatpp or gnatmetric) should be invoked for all
+    --  sources of all projects.
  
     -----------------------
     -- Local Subprograms --
*************** procedure GNATCmd is
*** 201,207 ****
     --  Display usage for platforms other than VMS
  
     procedure Process_Link;
!    --  Process GNAT LINK, when there is a project file specified.
  
     procedure Set_Library_For
       (Project             : Project_Id;
--- 211,217 ----
     --  Display usage for platforms other than VMS
  
     procedure Process_Link;
!    --  Process GNAT LINK, when there is a project file specified
  
     procedure Set_Library_For
       (Project             : Project_Id;
*************** procedure GNATCmd is
*** 244,250 ****
  
     procedure Check_Files is
        Add_Sources : Boolean := True;
!       Unit_Data   : Prj.Com.Unit_Data;
        Subunit     : Boolean := False;
  
     begin
--- 254,260 ----
  
     procedure Check_Files is
        Add_Sources : Boolean := True;
!       Unit_Data   : Prj.Unit_Data;
        Subunit     : Boolean := False;
  
     begin
*************** procedure GNATCmd is
*** 263,273 ****
        if Add_Sources then
           declare
              Current_Last : constant Integer := Last_Switches.Last;
-             use Prj.Com;
- 
           begin
!             for Unit in 1 .. Prj.Com.Units.Last loop
!                Unit_Data := Prj.Com.Units.Table (Unit);
  
                 --  For gnatls, we only need to put the library units,
                 --  body or spec, but not the subunits.
--- 273,283 ----
        if Add_Sources then
           declare
              Current_Last : constant Integer := Last_Switches.Last;
           begin
!             for Unit in Unit_Table.First ..
!                         Unit_Table.Last (Project_Tree.Units)
!             loop
!                Unit_Data := Project_Tree.Units.Table (Unit);
  
                 --  For gnatls, we only need to put the library units,
                 --  body or spec, but not the subunits.
*************** procedure GNATCmd is
*** 336,344 ****
  
                 else
                    --  For gnatpp and gnatmetric, put all sources
!                   --  of the project.
  
!                   for Kind in Prj.Com.Spec_Or_Body loop
  
                       --  Put only sources that belong to the main
                       --  project.
--- 346,354 ----
  
                 else
                    --  For gnatpp and gnatmetric, put all sources
!                   --  of the project, or of all projects if -U was specified.
  
!                   for Kind in Spec_Or_Body loop
  
                       --  Put only sources that belong to the main
                       --  project.
*************** procedure GNATCmd is
*** 425,436 ****
        Root_Project : Project_Id) return Boolean
     is
     begin
!       if Project = Root_Project then
           return True;
  
        elsif The_Command = Metric then
           declare
!             Data : Project_Data := Projects.Table (Root_Project);
  
           begin
              while Data.Extends /= No_Project loop
--- 435,450 ----
        Root_Project : Project_Id) return Boolean
     is
     begin
!       if Project = No_Project then
!          return False;
! 
!       elsif All_Projects or Project = Root_Project then
           return True;
  
        elsif The_Command = Metric then
           declare
!             Data : Project_Data :=
!                      Project_Tree.Projects.Table (Root_Project);
  
           begin
              while Data.Extends /= No_Project loop
*************** procedure GNATCmd is
*** 438,444 ****
                    return True;
                 end if;
  
!                Data := Projects.Table (Data.Extends);
              end loop;
           end;
        end if;
--- 452,458 ----
                    return True;
                 end if;
  
!                Data := Project_Tree.Projects.Table (Data.Extends);
              end loop;
           end;
        end if;
*************** procedure GNATCmd is
*** 464,470 ****
              end if;
           end loop;
  
!          Get_Name_String (Projects.Table
                              (Project).Exec_Directory);
  
           if Name_Buffer (Name_Len) /= Directory_Separator then
--- 478,484 ----
              end if;
           end loop;
  
!          Get_Name_String (Project_Tree.Projects.Table
                              (Project).Exec_Directory);
  
           if Name_Buffer (Name_Len) /= Directory_Separator then
*************** procedure GNATCmd is
*** 487,494 ****
     function Configuration_Pragmas_File return Name_Id is
     begin
        Prj.Env.Create_Config_Pragmas_File
!         (Project, Project, Include_Config_Files => False);
!       return Projects.Table (Project).Config_File_Name;
     end Configuration_Pragmas_File;
  
     ------------------------------
--- 501,508 ----
     function Configuration_Pragmas_File return Name_Id is
     begin
        Prj.Env.Create_Config_Pragmas_File
!         (Project, Project, Project_Tree, Include_Config_Files => False);
!       return Project_Tree.Projects.Table (Project).Config_File_Name;
     end Configuration_Pragmas_File;
  
     ------------------------------
*************** procedure GNATCmd is
*** 501,519 ****
     begin
        if not Keep_Temporary_Files then
           if Project /= No_Project then
!             for Prj in 1 .. Projects.Last loop
!                if Projects.Table (Prj).Config_File_Temp then
                    if Verbose_Mode then
                       Output.Write_Str ("Deleting temp configuration file """);
                       Output.Write_Str
                         (Get_Name_String
!                           (Projects.Table (Prj).Config_File_Name));
                       Output.Write_Line ("""");
                    end if;
  
                    Delete_File
                      (Name    => Get_Name_String
!                        (Projects.Table (Prj).Config_File_Name),
                       Success => Success);
                 end if;
              end loop;
--- 515,539 ----
     begin
        if not Keep_Temporary_Files then
           if Project /= No_Project then
!             for Prj in Project_Table.First ..
!                        Project_Table.Last (Project_Tree.Projects)
!             loop
!                if
!                  Project_Tree.Projects.Table (Prj).Config_File_Temp
!                then
                    if Verbose_Mode then
                       Output.Write_Str ("Deleting temp configuration file """);
                       Output.Write_Str
                         (Get_Name_String
!                           (Project_Tree.Projects.Table
!                              (Prj).Config_File_Name));
                       Output.Write_Line ("""");
                    end if;
  
                    Delete_File
                      (Name    => Get_Name_String
!                        (Project_Tree.Projects.Table
!                           (Prj).Config_File_Name),
                       Success => Success);
                 end if;
              end loop;
*************** procedure GNATCmd is
*** 568,574 ****
        --  Check if there are library project files
  
        if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
!          Set_Libraries (Project, There_Are_Libraries);
        end if;
  
        --  If there are, add the necessary additional switches
--- 588,594 ----
        --  Check if there are library project files
  
        if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
!          Set_Libraries (Project, Project_Tree, There_Are_Libraries);
        end if;
  
        --  If there are, add the necessary additional switches
*************** procedure GNATCmd is
*** 729,736 ****
                          declare
                             Dir : constant String :=
                                     Get_Name_String
!                                      (Projects.Table (Prj).
!                                               Object_Directory);
                          begin
                             if Is_Regular_File
                                  (Dir &
--- 749,756 ----
                          declare
                             Dir : constant String :=
                                     Get_Name_String
!                                      (Project_Tree.Projects.Table
!                                         (Prj).Object_Directory);
                          begin
                             if Is_Regular_File
                                  (Dir &
*************** procedure GNATCmd is
*** 754,760 ****
                          --  Go to the project being extended,
                          --  if any.
  
!                         Prj := Projects.Table (Prj).Extends;
                          exit Project_Loop when Prj = No_Project;
                       end loop Project_Loop;
                    end if;
--- 774,781 ----
                          --  Go to the project being extended,
                          --  if any.
  
!                         Prj :=
!                           Project_Tree.Projects.Table (Prj).Extends;
                          exit Project_Loop when Prj = No_Project;
                       end loop Project_Loop;
                    end if;
*************** procedure GNATCmd is
*** 811,817 ****
                    Last_Switches.Table (Last_Switches.Last) :=
                      new String'("-o");
                    Get_Name_String
!                     (Projects.Table (Project).Exec_Directory);
                    Last_Switches.Increment_Last;
                    Last_Switches.Table (Last_Switches.Last) :=
                      new String'(Name_Buffer (1 .. Name_Len) &
--- 832,839 ----
                    Last_Switches.Table (Last_Switches.Last) :=
                      new String'("-o");
                    Get_Name_String
!                     (Project_Tree.Projects.Table
!                        (Project).Exec_Directory);
                    Last_Switches.Increment_Last;
                    Last_Switches.Table (Last_Switches.Last) :=
                      new String'(Name_Buffer (1 .. Name_Len) &
*************** procedure GNATCmd is
*** 839,845 ****
     begin
        --  Case of library project
  
!       if Projects.Table (Project).Library then
           There_Are_Libraries := True;
  
           --  Add the -L switch
--- 861,867 ----
     begin
        --  Case of library project
  
!       if Project_Tree.Projects.Table (Project).Library then
           There_Are_Libraries := True;
  
           --  Add the -L switch
*************** procedure GNATCmd is
*** 848,854 ****
           Last_Switches.Table (Last_Switches.Last) :=
             new String'("-L" &
                         Get_Name_String
!                        (Projects.Table (Project).Library_Dir));
  
           --  Add the -l switch
  
--- 870,877 ----
           Last_Switches.Table (Last_Switches.Last) :=
             new String'("-L" &
                         Get_Name_String
!                          (Project_Tree.Projects.Table
!                             (Project).Library_Dir));
  
           --  Add the -l switch
  
*************** procedure GNATCmd is
*** 856,873 ****
           Last_Switches.Table (Last_Switches.Last) :=
             new String'("-l" &
                         Get_Name_String
!                        (Projects.Table (Project).Library_Name));
  
           --  Add the directory to table Library_Paths, to be processed later
           --  if library is not static and if Path_Option is not null.
  
!          if Projects.Table (Project).Library_Kind /= Static
             and then Path_Option /= null
           then
              Library_Paths.Increment_Last;
              Library_Paths.Table (Library_Paths.Last) :=
                new String'(Get_Name_String
!                             (Projects.Table (Project).Library_Dir));
           end if;
        end if;
     end Set_Library_For;
--- 879,899 ----
           Last_Switches.Table (Last_Switches.Last) :=
             new String'("-l" &
                         Get_Name_String
!                          (Project_Tree.Projects.Table
!                             (Project).Library_Name));
  
           --  Add the directory to table Library_Paths, to be processed later
           --  if library is not static and if Path_Option is not null.
  
!          if Project_Tree.Projects.Table (Project).Library_Kind /=
!               Static
             and then Path_Option /= null
           then
              Library_Paths.Increment_Last;
              Library_Paths.Table (Library_Paths.Last) :=
                new String'(Get_Name_String
!                             (Project_Tree.Projects.Table
!                                (Project).Library_Dir));
           end if;
        end if;
     end Set_Library_For;
*************** begin
*** 988,994 ****
  
     Snames.Initialize;
  
!    Prj.Initialize;
  
     Last_Switches.Init;
     Last_Switches.Set_Last (0);
--- 1014,1020 ----
  
     Snames.Initialize;
  
!    Prj.Initialize (Project_Tree);
  
     Last_Switches.Init;
     Last_Switches.Set_Last (0);
*************** begin
*** 1297,1302 ****
--- 1323,1329 ----
  
              Prj.Pars.Parse
                (Project           => Project,
+                In_Tree           => Project_Tree,
                 Project_File_Name => Project_File.all,
                 Packages_To_Check => All_Packages);
  
*************** begin
*** 1512,1517 ****
--- 1539,1551 ----
  
                       Remove_Switch (Arg_Num);
  
+                   elsif (The_Command = Pretty or else The_Command = Metric)
+                     and then Argv'Length = 2
+                     and then Argv (2) = 'U'
+                   then
+                      All_Projects := True;
+                      Remove_Switch (Arg_Num);
+ 
                    else
                       Arg_Num := Arg_Num + 1;
                    end if;
*************** begin
*** 1531,1536 ****
--- 1565,1571 ----
  
           Prj.Pars.Parse
             (Project           => Project,
+             In_Tree           => Project_Tree,
              Project_File_Name => Project_File.all,
              Packages_To_Check => Packages_To_Check);
  
*************** begin
*** 1543,1554 ****
  
           declare
              Data : constant Prj.Project_Data :=
!                      Prj.Projects.Table (Project);
  
              Pkg : constant Prj.Package_Id :=
                      Prj.Util.Value_Of
                        (Name        => Tool_Package_Name,
!                        In_Packages => Data.Decl.Packages);
  
              Element : Package_Element;
  
--- 1578,1590 ----
  
           declare
              Data : constant Prj.Project_Data :=
!                      Project_Tree.Projects.Table (Project);
  
              Pkg : constant Prj.Package_Id :=
                      Prj.Util.Value_Of
                        (Name        => Tool_Package_Name,
!                        In_Packages => Data.Decl.Packages,
!                        In_Tree     => Project_Tree);
  
              Element : Package_Element;
  
*************** begin
*** 1560,1566 ****
  
           begin
              if Pkg /= No_Package then
!                Element := Packages.Table (Pkg);
  
                 --  Packages Gnatls has a single attribute Switches, that is
                 --  not an associative array.
--- 1596,1602 ----
  
           begin
              if Pkg /= No_Package then
!                Element := Project_Tree.Packages.Table (Pkg);
  
                 --  Packages Gnatls has a single attribute Switches, that is
                 --  not an associative array.
*************** begin
*** 1569,1575 ****
                    The_Switches :=
                      Prj.Util.Value_Of
                      (Variable_Name => Snames.Name_Switches,
!                      In_Variables => Element.Decl.Attributes);
  
                 --  Packages Binder (for gnatbind), Cross_Reference (for
                 --  gnatxref), Linker (for gnatlink) Finder (for gnatfind),
--- 1605,1612 ----
                    The_Switches :=
                      Prj.Util.Value_Of
                      (Variable_Name => Snames.Name_Switches,
!                      In_Variables  => Element.Decl.Attributes,
!                      In_Tree       => Project_Tree);
  
                 --  Packages Binder (for gnatbind), Cross_Reference (for
                 --  gnatxref), Linker (for gnatlink) Finder (for gnatfind),
*************** begin
*** 1584,1595 ****
                    if The_Switches.Kind = Prj.Undefined then
                       Default_Switches_Array :=
                         Prj.Util.Value_Of
!                          (Name => Name_Default_Switches,
!                           In_Arrays => Element.Decl.Arrays);
                       The_Switches := Prj.Util.Value_Of
                         (Index     => Name_Ada,
                          Src_Index => 0,
!                         In_Array  => Default_Switches_Array);
                    end if;
                 end if;
  
--- 1621,1634 ----
                    if The_Switches.Kind = Prj.Undefined then
                       Default_Switches_Array :=
                         Prj.Util.Value_Of
!                          (Name      => Name_Default_Switches,
!                           In_Arrays => Element.Decl.Arrays,
!                           In_Tree   => Project_Tree);
                       The_Switches := Prj.Util.Value_Of
                         (Index     => Name_Ada,
                          Src_Index => 0,
!                         In_Array  => Default_Switches_Array,
!                         In_Tree   => Project_Tree);
                    end if;
                 end if;
  
*************** begin
*** 1616,1622 ****
                    when Prj.List =>
                       Current := The_Switches.Values;
                       while Current /= Prj.Nil_String loop
!                         The_String := String_Elements.Table (Current);
  
                          declare
                             Switch : constant String :=
--- 1655,1662 ----
                    when Prj.List =>
                       Current := The_Switches.Values;
                       while Current /= Prj.Nil_String loop
!                         The_String := Project_Tree.String_Elements.
!                                         Table (Current);
  
                          declare
                             Switch : constant String :=
*************** begin
*** 1642,1653 ****
           then
              Change_Dir
                (Get_Name_String
!                  (Projects.Table (Project).Object_Directory));
           end if;
  
           --  Set up the env vars for project path files
  
!          Prj.Env.Set_Ada_Paths (Project, Including_Libraries => False);
  
           --  For gnatstub, gnatmetric, gnatpp and gnatelim, create
           --  a configuration pragmas file, if necessary.
--- 1682,1695 ----
           then
              Change_Dir
                (Get_Name_String
!                  (Project_Tree.Projects.Table
!                     (Project).Object_Directory));
           end if;
  
           --  Set up the env vars for project path files
  
!          Prj.Env.Set_Ada_Paths
!            (Project, Project_Tree, Including_Libraries => False);
  
           --  For gnatstub, gnatmetric, gnatpp and gnatelim, create
           --  a configuration pragmas file, if necessary.
*************** begin
*** 1688,1693 ****
--- 1730,1736 ----
                       First_Switches.Increment_Last;
                       First_Switches.Table (First_Switches.Last)  :=
                         new String'("-C" & Get_Name_String (CP_File));
+ 
                    else
                       Add_To_Carg_Switches
                         (new String'("-gnatec=" & Get_Name_String (CP_File)));
*************** begin
*** 1714,1720 ****
                   (Last_Switches.Table (J), Current_Work_Dir);
              end loop;
  
!             Get_Name_String (Projects.Table (Project).Directory);
  
              declare
                 Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
--- 1757,1764 ----
                   (Last_Switches.Table (J), Current_Work_Dir);
              end loop;
  
!             Get_Name_String
!               (Project_Tree.Projects.Table (Project).Directory);
  
              declare
                 Project_Dir : constant String := Name_Buffer (1 .. Name_Len);
*************** begin
*** 1729,1735 ****
           elsif The_Command = Stub then
              declare
                 Data : constant Prj.Project_Data :=
!                         Prj.Projects.Table (Project);
                 File_Index : Integer := 0;
                 Dir_Index  : Integer := 0;
                 Last       : constant Integer := Last_Switches.Last;
--- 1773,1779 ----
           elsif The_Command = Stub then
              declare
                 Data : constant Prj.Project_Data :=
!                         Project_Tree.Projects.Table (Project);
                 File_Index : Integer := 0;
                 Dir_Index  : Integer := 0;
                 Last       : constant Integer := Last_Switches.Last;
*************** begin
*** 1815,1821 ****
              First_Switches.Table (1) :=
                new String'("-d=" &
                            Get_Name_String
!                             (Projects.Table (Project).Object_Directory));
           end if;
  
           --  For gnat pretty and gnat metric, if no file has been put on the
--- 1859,1866 ----
              First_Switches.Table (1) :=
                new String'("-d=" &
                            Get_Name_String
!                             (Project_Tree.Projects.Table
!                                (Project).Object_Directory));
           end if;
  
           --  For gnat pretty and gnat metric, if no file has been put on the
*************** begin
*** 1890,1901 ****
  
  exception
     when Error_Exit =>
!       Prj.Env.Delete_All_Path_Files;
        Delete_Temp_Config_Files;
        Set_Exit_Status (Failure);
  
     when Normal_Exit =>
!       Prj.Env.Delete_All_Path_Files;
        Delete_Temp_Config_Files;
  
        --  Since GNATCmd is normally called from DCL (the VMS shell),
--- 1935,1946 ----
  
  exception
     when Error_Exit =>
!       Prj.Env.Delete_All_Path_Files (Project_Tree);
        Delete_Temp_Config_Files;
        Set_Exit_Status (Failure);
  
     when Normal_Exit =>
!       Prj.Env.Delete_All_Path_Files (Project_Tree);
        Delete_Temp_Config_Files;
  
        --  Since GNATCmd is normally called from DCL (the VMS shell),
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatcmd.ads gcc-4.1.0/gcc/ada/gnatcmd.ads
*** gcc-4.0.2/gcc/ada/gnatcmd.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnatcmd.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatdll.adb gcc-4.1.0/gcc/ada/gnatdll.adb
*** gcc-4.0.2/gcc/ada/gnatdll.adb	Mon Oct  4 14:58:20 2004
--- gcc-4.1.0/gcc/ada/gnatdll.adb	Tue Nov 15 13:52:43 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatdll is
*** 63,69 ****
     --  build the DLL.
  
     Help : Boolean := False;
!    --  Help will be set to True the usage information is to be displayed.
  
     Version : constant String := Gnatvsn.Gnat_Version_String;
     --  Why should it be necessary to make a copy of this
--- 63,69 ----
     --  build the DLL.
  
     Help : Boolean := False;
!    --  Help will be set to True the usage information is to be displayed
  
     Version : constant String := Gnatvsn.Gnat_Version_String;
     --  Why should it be necessary to make a copy of this
*************** procedure Gnatdll is
*** 166,173 ****
  
     procedure Parse_Command_Line is
  
-       use GNAT.Command_Line;
- 
        procedure Add_File (Filename : in String);
        --  Add one file to the list of file to handle
  
--- 166,171 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatfind.adb gcc-4.1.0/gcc/ada/gnatfind.adb
*** gcc-4.0.2/gcc/ada/gnatfind.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/gnatfind.adb	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatfind is
*** 237,243 ****
     procedure Write_Usage is
     begin
        Put_Line ("GNATFIND " & Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1998-2005, Ada Core Technologies Inc.");
        Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] "
                  & "[file1 file2 ...]");
        New_Line;
--- 237,243 ----
     procedure Write_Usage is
     begin
        Put_Line ("GNATFIND " & Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1998-2005, AdaCore");
        Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] "
                  & "[file1 file2 ...]");
        New_Line;
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatkr.adb gcc-4.1.0/gcc/ada/gnatkr.adb
*** gcc-4.0.2/gcc/ada/gnatkr.adb	Fri Oct 24 14:39:55 2003
--- gcc-4.1.0/gcc/ada/gnatkr.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatkr.ads gcc-4.1.0/gcc/ada/gnatkr.ads
*** gcc-4.0.2/gcc/ada/gnatkr.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnatkr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatlbr.adb gcc-4.1.0/gcc/ada/gnatlbr.adb
*** gcc-4.0.2/gcc/ada/gnatlbr.adb	Thu Feb 10 13:49:14 2005
--- gcc-4.1.0/gcc/ada/gnatlbr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Program to create, set, or delete an alternate runtime library.
  
  --  Works by calling an appropriate target specific Makefile residing
  --  in the default library object (e.g. adalib) directory from the context
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Program to create, set, or delete an alternate runtime library
  
  --  Works by calling an appropriate target specific Makefile residing
  --  in the default library object (e.g. adalib) directory from the context
*************** begin
*** 222,228 ****
                 end;
              end loop;
  
!             --  "Make" an alternate sublibrary for each default sublibrary.
  
              for Dirs in 1 .. Object_Dirs loop
                 Make_Args (1) :=
--- 222,228 ----
                 end;
              end loop;
  
!             --  "Make" an alternate sublibrary for each default sublibrary
  
              for Dirs in 1 .. Object_Dirs loop
                 Make_Args (1) :=
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatlink.adb gcc-4.1.0/gcc/ada/gnatlink.adb
*** gcc-4.0.2/gcc/ada/gnatlink.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/gnatlink.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatlink.ads gcc-4.1.0/gcc/ada/gnatlink.ads
*** gcc-4.0.2/gcc/ada/gnatlink.ads	Thu Apr 24 17:54:04 2003
--- gcc-4.1.0/gcc/ada/gnatlink.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatls.adb gcc-4.1.0/gcc/ada/gnatls.adb
*** gcc-4.0.2/gcc/ada/gnatls.adb	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/gnatls.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatls.ads gcc-4.1.0/gcc/ada/gnatls.ads
*** gcc-4.0.2/gcc/ada/gnatls.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/gnatls.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatmake.adb gcc-4.1.0/gcc/ada/gnatmake.adb
*** gcc-4.0.2/gcc/ada/gnatmake.adb	Fri Oct 24 14:39:55 2003
--- gcc-4.1.0/gcc/ada/gnatmake.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatmake.ads gcc-4.1.0/gcc/ada/gnatmake.ads
*** gcc-4.0.2/gcc/ada/gnatmake.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/gnatmake.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,32 ****
  ------------------------------------------------------------------------------
  
  procedure Gnatmake;
! --  The driver for the gnatmake tool. This utility can be used to
! --  automatically (re)compile a set of ada sources by giving the name
! --  of the root compilation unit or the source file containing it.
! --  For more information on gnatmake (its precise usage, flags and algorithm)
! --  please refer to the body of gnatmake.
--- 25,31 ----
  ------------------------------------------------------------------------------
  
  procedure Gnatmake;
! --  The driver for the gnatmake tool. This utility can be used to automatically
! --  (re)compile a set of ada sources by giving the name of the root compilation
! --  unit or the source file containing it. For more information on gnatmake
! --  (its precise usage, flags and algorithm) please refer to the gnatmake body.
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatmem.adb gcc-4.1.0/gcc/ada/gnatmem.adb
*** gcc-4.0.2/gcc/ada/gnatmem.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/gnatmem.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1997-2005, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatmem is
*** 233,239 ****
        New_Line;
        Put ("GNATMEM ");
        Put_Line (Gnat_Version_String);
!       Put_Line ("Copyright 1997-2005 Free Software Foundation, Inc.");
        New_Line;
  
        Put_Line ("Usage: gnatmem switches [depth] exename");
--- 233,239 ----
        New_Line;
        Put ("GNATMEM ");
        Put_Line (Gnat_Version_String);
!       Put_Line ("Copyright 1997-2005, Free Software Foundation, Inc.");
        New_Line;
  
        Put_Line ("Usage: gnatmem switches [depth] exename");
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatname.adb gcc-4.1.0/gcc/ada/gnatname.adb
*** gcc-4.0.2/gcc/ada/gnatname.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/gnatname.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatname.ads gcc-4.1.0/gcc/ada/gnatname.ads
*** gcc-4.0.2/gcc/ada/gnatname.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/gnatname.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatprep.adb gcc-4.1.0/gcc/ada/gnatprep.adb
*** gcc-4.0.2/gcc/ada/gnatprep.adb	Fri Oct 24 14:39:55 2003
--- gcc-4.1.0/gcc/ada/gnatprep.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with GPrep;
*** 29,34 ****
--- 29,35 ----
  
  procedure GNATprep is
     pragma Ident (Gnatvsn.Gnat_Static_Version_String);
+ 
  begin
     --  Everything is done in GPrep
  
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatprep.ads gcc-4.1.0/gcc/ada/gnatprep.ads
*** gcc-4.0.2/gcc/ada/gnatprep.ads	Tue Oct 21 13:42:08 2003
--- gcc-4.1.0/gcc/ada/gnatprep.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 142,150 ****
  --     may be used on a preprocessor line, but other than that, no other
  --     tokens may appear on a preprocessor line.
  
! --     Any number of #elsif clauses can be present, including none at all.
  
! --     The #else is optional, as in Ada.
  
  --     The # marking the start of a preprocessor line must be the first
  --     non-blank character on the line, i.e. it must be preceded only by
--- 142,150 ----
  --     may be used on a preprocessor line, but other than that, no other
  --     tokens may appear on a preprocessor line.
  
! --     Any number of #elsif clauses can be present, including none at all
  
! --     The #else is optional, as in Ada
  
  --     The # marking the start of a preprocessor line must be the first
  --     non-blank character on the line, i.e. it must be preceded only by
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatsym.adb gcc-4.1.0/gcc/ada/gnatsym.adb
*** gcc-4.0.2/gcc/ada/gnatsym.adb	Wed Dec  8 11:46:29 2004
--- gcc-4.1.0/gcc/ada/gnatsym.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatsym is
*** 78,84 ****
     --  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,
--- 78,84 ----
     --  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,
*************** begin
*** 253,259 ****
              Write_Line ("""");
           end if;
  
!          Process (Object_Files.Table (Object_File).all, Success);
        end loop;
  
        --  Finalize the object file
--- 253,259 ----
              Write_Line ("""");
           end if;
  
!          Processing.Process (Object_Files.Table (Object_File).all, Success);
        end loop;
  
        --  Finalize the object file
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatvsn.adb gcc-4.1.0/gcc/ada/gnatvsn.adb
*** gcc-4.0.2/gcc/ada/gnatvsn.adb	Mon Nov 10 17:30:00 2003
--- gcc-4.1.0/gcc/ada/gnatvsn.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatvsn.ads gcc-4.1.0/gcc/ada/gnatvsn.ads
*** gcc-4.0.2/gcc/ada/gnatvsn.ads	Mon Oct 18 21:47:21 2004
--- gcc-4.1.0/gcc/ada/gnatvsn.ads	Tue Nov 15 13:59:02 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Gnatvsn is
*** 74,80 ****
     --  value should never be decreased in the future, but it would be
     --  OK to increase it if absolutely necessary.
  
!    Library_Version : constant String := "4.0";
     --  Library version. This value must be updated whenever any change to the
     --  compiler affects the library formats in such a way as to obsolete
     --  previously compiled library modules.
--- 74,80 ----
     --  value should never be decreased in the future, but it would be
     --  OK to increase it if absolutely necessary.
  
!    Library_Version : constant String := "4.1";
     --  Library version. This value must be updated whenever any change to the
     --  compiler affects the library formats in such a way as to obsolete
     --  previously compiled library modules.
diff -Nrcpad gcc-4.0.2/gcc/ada/gnatxref.adb gcc-4.1.0/gcc/ada/gnatxref.adb
*** gcc-4.0.2/gcc/ada/gnatxref.adb	Fri Nov 19 11:25:05 2004
--- gcc-4.1.0/gcc/ada/gnatxref.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1998-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Gnatxref is
*** 210,216 ****
     procedure Write_Usage is
     begin
        Put_Line ("GNATXREF " & Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1998-2004, Ada Core Technologies Inc.");
        Put_Line ("Usage: gnatxref [switches] file1 file2 ...");
        New_Line;
        Put_Line ("  file ... list of source files to xref, " &
--- 210,216 ----
     procedure Write_Usage is
     begin
        Put_Line ("GNATXREF " & Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1998-2005, AdaCore");
        Put_Line ("Usage: gnatxref [switches] file1 file2 ...");
        New_Line;
        Put_Line ("  file ... list of source files to xref, " &
diff -Nrcpad gcc-4.0.2/gcc/ada/gprep.adb gcc-4.1.0/gcc/ada/gprep.adb
*** gcc-4.0.2/gcc/ada/gprep.adb	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/gprep.adb	Tue Nov 15 13:59:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body GPrep is
*** 73,79 ****
     File_Name_Buffer_Initial_Size : constant := 50;
     File_Name_Buffer : String_Access :=
                          new String (1 .. File_Name_Buffer_Initial_Size);
!    --  A buffer to build output file names from input file names.
  
     -----------------
     -- Subprograms --
--- 73,79 ----
     File_Name_Buffer_Initial_Size : constant := 50;
     File_Name_Buffer : String_Access :=
                          new String (1 .. File_Name_Buffer_Initial_Size);
!    --  A buffer to build output file names from input file names
  
     -----------------
     -- Subprograms --
*************** package body GPrep is
*** 102,108 ****
     --  True if C is in 'a' .. 'z' or in 'A' .. 'Z'
  
     procedure Double_File_Name_Buffer;
!    --  Double the size of the file name buffer.
  
     procedure Preprocess_Infile_Name;
     --  When the specified output is a directory, preprocess the infile name
--- 102,108 ----
     --  True if C is in 'a' .. 'z' or in 'A' .. 'Z'
  
     procedure Double_File_Name_Buffer;
!    --  Double the size of the file name buffer
  
     procedure Preprocess_Infile_Name;
     --  When the specified output is a directory, preprocess the infile name
*************** package body GPrep is
*** 116,127 ****
     --  Process a -D switch on the command line
  
     procedure Put_Char_To_Outfile (C : Character);
!    --  Output one character to the output file.
!    --  Used to initialize the preprocessor.
  
     procedure New_EOL_To_Outfile;
!    --  Output a new line to the output file.
!    --  Used to initialize the preprocessor.
  
     procedure Scan_Command_Line;
     --  Scan the switches and the file names
--- 116,127 ----
     --  Process a -D switch on the command line
  
     procedure Put_Char_To_Outfile (C : Character);
!    --  Output one character to the output file. Used to initialize the
!    --  preprocessor.
  
     procedure New_EOL_To_Outfile;
!    --  Output a new line to the output file. Used to initialize the
!    --  preprocessor.
  
     procedure Scan_Command_Line;
     --  Scan the switches and the file names
*************** package body GPrep is
*** 137,143 ****
     begin
        if not Copyright_Displayed then
           Write_Line ("GNAT Preprocessor " & Gnatvsn.Gnat_Version_String);
!          Write_Line ("Copyright 1996-2004 Free Software Foundation, Inc.");
           Copyright_Displayed := True;
        end if;
     end Display_Copyright;
--- 137,143 ----
     begin
        if not Copyright_Displayed then
           Write_Line ("GNAT Preprocessor " & Gnatvsn.Gnat_Version_String);
!          Write_Line ("Copyright 1996-2005, Free Software Foundation, Inc.");
           Copyright_Displayed := True;
        end if;
     end Display_Copyright;
*************** package body GPrep is
*** 198,218 ****
        --  Test we had all the arguments needed
  
        if Infile_Name = No_Name then
           --  No input file specified, just output the usage and exit
  
           Usage;
           return;
  
        elsif Outfile_Name = No_Name then
           --  No output file specified, just output the usage and exit
  
           Usage;
           return;
        end if;
  
!       --  If a pragma Source_File_Name, we need to keep line numbers.
!       --  So, if the deleted lines are not put as comment, we must output them
!       --  as blank lines.
  
        if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
           Opt.Blank_Deleted_Lines := True;
--- 198,220 ----
        --  Test we had all the arguments needed
  
        if Infile_Name = No_Name then
+ 
           --  No input file specified, just output the usage and exit
  
           Usage;
           return;
  
        elsif Outfile_Name = No_Name then
+ 
           --  No output file specified, just output the usage and exit
  
           Usage;
           return;
        end if;
  
!       --  If a pragma Source_File_Name, we need to keep line numbers. So, if
!       --  the deleted lines are not put as comment, we must output them as
!       --  blank lines.
  
        if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then
           Opt.Blank_Deleted_Lines := True;
*************** package body GPrep is
*** 245,252 ****
           end;
        end if;
  
!       --  If there are errors in the definition file, output these errors
!       --  and exit.
  
        if Total_Errors_Detected > 0 then
           Errutil.Finalize (Source_Type => "definition");
--- 247,253 ----
           end;
        end if;
  
!       --  If there are errors in the definition file, output them and exit
  
        if Total_Errors_Detected > 0 then
           Errutil.Finalize (Source_Type => "definition");
*************** package body GPrep is
*** 281,287 ****
        --  rooted at the input directory.
  
        Process_Files;
- 
     end Gnatprep;
  
     ---------------------
--- 282,287 ----
*************** package body GPrep is
*** 312,318 ****
        null;
     end Obsolescent_Check;
  
- 
     ---------------
     -- Post_Scan --
     ---------------
--- 312,317 ----
*************** package body GPrep is
*** 328,334 ****
  
     procedure Preprocess_Infile_Name is
        Len    : Natural;
!       First  : Positive := 1;
        Last   : Natural;
        Symbol : Name_Id;
        Data   : Symbol_Data;
--- 327,333 ----
  
     procedure Preprocess_Infile_Name is
        Len    : Natural;
!       First  : Positive;
        Last   : Natural;
        Symbol : Name_Id;
        Data   : Symbol_Data;
*************** package body GPrep is
*** 347,352 ****
--- 346,352 ----
  
        --  Look for possible symbols in the file name
  
+       First := 1;
        while First < Len loop
  
           --  A symbol starts with a dollar sign followed by a letter
*************** package body GPrep is
*** 388,394 ****
  
                       declare
                          Sym_Len : constant Positive := Last - First + 1;
!                         Offset : constant Integer := Name_Len - Sym_Len;
                          New_Len : constant Natural := Len + Offset;
  
                       begin
--- 388,394 ----
  
                       declare
                          Sym_Len : constant Positive := Last - First + 1;
!                         Offset  : constant Integer := Name_Len - Sym_Len;
                          New_Len : constant Natural := Len + Offset;
  
                       begin
*************** package body GPrep is
*** 466,472 ****
        --  Outfile_Name.
  
        procedure Recursive_Process (In_Dir : String; Out_Dir : String);
!       --  Process recursively files in In_Dir. Results go to Out_Dir.
  
        ----------------------
        -- Process_One_File --
--- 466,472 ----
        --  Outfile_Name.
  
        procedure Recursive_Process (In_Dir : String; Out_Dir : String);
!       --  Process recursively files in In_Dir. Results go to Out_Dir
  
        ----------------------
        -- Process_One_File --
*************** package body GPrep is
*** 476,482 ****
           Infile : Source_File_Index;
  
        begin
!          --  Create the output file; fails if this does not work.
  
           begin
              Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
--- 476,482 ----
           Infile : Source_File_Index;
  
        begin
!          --  Create the output file (fails if this does not work)
  
           begin
              Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name));
*************** package body GPrep is
*** 522,529 ****
              Errutil.Finalize (Source_Type => "input");
           end if;
  
!          --  If we had some errors, delete the output file, and report
!          --  the errors.
  
           if Err_Vars.Total_Errors_Detected > 0 then
              if Outfile /= Standard_Output then
--- 522,528 ----
              Errutil.Finalize (Source_Type => "input");
           end if;
  
!          --  If we had some errors, delete the output file, and report them
  
           if Err_Vars.Total_Errors_Detected > 0 then
              if Outfile /= Standard_Output then
*************** package body GPrep is
*** 534,540 ****
  
              OS_Exit (0);
  
!          --  otherwise, close the output file, and we are done.
  
           elsif Outfile /= Standard_Output then
              Close (Text_Outfile);
--- 533,539 ----
  
              OS_Exit (0);
  
!          --  Otherwise, close the output file, and we are done
  
           elsif Outfile /= Standard_Output then
              Close (Text_Outfile);
*************** package body GPrep is
*** 565,570 ****
--- 564,571 ----
              Output_Directory := Out_Dir_Name;
           end Set_Directory_Names;
  
+       --  Start of processing for Recursive_Process
+ 
        begin
           --  Open the current input directory
  
*************** package body GPrep is
*** 646,653 ****
--- 647,657 ----
           end loop;
        end Recursive_Process;
  
+    --  Start of processing for Process_Files
+ 
     begin
        if Output_Directory = No_Name then
+ 
           --  If the output is not a directory, fail if the input is
           --  an existing directory, to avoid possible problems.
  
*************** package body GPrep is
*** 661,666 ****
--- 665,671 ----
           Process_One_File;
  
        elsif Input_Directory = No_Name then
+ 
           --  Get the output file name from the input file name, and process
           --  the single input file.
  
*************** package body GPrep is
*** 698,704 ****
  
        loop
           begin
!             Switch := GNAT.Command_Line.Getopt ("D: b c r s u v");
              case Switch is
  
                 when ASCII.NUL =>
--- 703,710 ----
  
        loop
           begin
!             Switch := GNAT.Command_Line.Getopt ("D: b c C r s u v");
! 
              case Switch is
  
                 when ASCII.NUL =>
*************** package body GPrep is
*** 714,719 ****
--- 720,728 ----
                 when 'c' =>
                    Opt.Comment_Deleted_Lines := True;
  
+                when 'C' =>
+                   Opt.Replace_In_Comments := True;
+ 
                 when 'r' =>
                    Source_Ref_Pragma := True;
  
*************** package body GPrep is
*** 781,786 ****
--- 790,796 ----
        Write_Line ("gnatprep switches:");
        Write_Line ("   -b  Replace preprocessor lines by blank lines");
        Write_Line ("   -c  Keep preprocessor lines as comments");
+       Write_Line ("   -C  Do symbol replacements within comments");
        Write_Line ("   -D  Associate symbol with value");
        Write_Line ("   -r  Generate Source_Reference pragma");
        Write_Line ("   -s  Print a sorted list of symbol names and values");
diff -Nrcpad gcc-4.0.2/gcc/ada/gprep.ads gcc-4.1.0/gcc/ada/gprep.ads
*** gcc-4.0.2/gcc/ada/gprep.ads	Tue Oct 21 13:42:08 2003
--- gcc-4.1.0/gcc/ada/gprep.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is the implementation of GNATPREP.
  
  package GPrep is
  
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is the implementation of GNATPREP
  
  package GPrep is
  
diff -Nrcpad gcc-4.0.2/gcc/ada/gprmake.adb gcc-4.1.0/gcc/ada/gprmake.adb
*** gcc-4.0.2/gcc/ada/gprmake.adb	Mon May  3 11:58:34 2004
--- gcc-4.1.0/gcc/ada/gprmake.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The driver for the gprmake tool.
  
  with Makegpr;
  
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The driver for the gprmake tool
  
  with Makegpr;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/gsocket.h gcc-4.1.0/gcc/ada/gsocket.h
*** gcc-4.0.2/gcc/ada/gsocket.h	Thu Jan 27 11:52:46 2005
--- gcc-4.1.0/gcc/ada/gsocket.h	Tue Nov 15 13:50:37 2005
***************
*** 2,12 ****
   *                                                                          *
   *                         GNAT COMPILER COMPONENTS                         *
   *                                                                          *
!  *                               S O C K E T                                *
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *            Copyright (C) 2004, 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- *
--- 2,12 ----
   *                                                                          *
   *                         GNAT COMPILER COMPONENTS                         *
   *                                                                          *
!  *                              G S O C K E T                               *
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *         Copyright (C) 2004-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 30,67 ****
   *                                                                          *
   ****************************************************************************/
  
! #ifdef __vxworks
! #include "vxWorks.h"
  #endif
  
! #ifdef IN_RTS
! #include "tconfig.h"
! #include "tsystem.h"
  
! #if defined (WINNT)
  #define FD_SETSIZE 1024
  #include <windows.h>
  
  #ifdef __MINGW32__
! #include "mingw32.h"
! #if STD_MINGW
! #include <winsock.h>
! #else
! #include <windows32/sockets.h>
  #endif
  #endif
  #endif
  
! #if defined (VMS)
! #define FD_SETSIZE 4096
! #include <sys/time.h>
  #endif
  
  #else
! #include "config.h"
! #include "system.h"
  #endif
  
  #if !(defined (VMS) || defined (__MINGW32__) || defined(__rtems__))
! # include <sys/socket.h>
  #endif
--- 30,148 ----
   *                                                                          *
   ****************************************************************************/
  
! #ifndef _XOPEN_SOURCE_EXTENDED
! #define _XOPEN_SOURCE_EXTENDED 1
! /* For HP-UX */
  #endif
  
! #ifndef BSD_COMP
! #define BSD_COMP 1
! /* For Solaris */
! #endif
  
! #ifndef _ALL_SOURCE
! #define _ALL_SOURCE 1
! /* For AIX */
! #endif
! 
! #ifndef _OSF_SOURCE
! #define _OSF_SOURCE 1
! /* For Tru64 */
! #endif
! 
! #include <limits.h>
! 
! #if defined(__vxworks)
! #include <vxWorks.h>
! #include <ioLib.h>
! #include <hostLib.h>
! #include <resolvLib.h>
! #define SHUT_RD		0
! #define SHUT_WR		1
! #define SHUT_RDWR	2
! 
! #elif defined (WINNT)
  #define FD_SETSIZE 1024
  #include <windows.h>
  
  #ifdef __MINGW32__
! #include <winsock2.h>
! #include <ws2tcpip.h>
! 
! #define EACCES		WSAEACCES
! #define EADDRINUSE	WSAEADDRINUSE
! #define EADDRNOTAVAIL	WSAEADDRNOTAVAIL
! #define EAFNOSUPPORT	WSAEAFNOSUPPORT
! #define EALREADY	WSAEALREADY
! #define EBADF		WSAEBADF
! #define ECONNABORTED	WSAECONNABORTED
! #define ECONNREFUSED	WSAECONNREFUSED
! #define ECONNRESET	WSAECONNRESET
! #define EDESTADDRREQ	WSAEDESTADDRREQ
! #define EFAULT		WSAEFAULT
! #define EHOSTDOWN	WSAEHOSTDOWN
! #define EHOSTUNREACH	WSAEHOSTUNREACH
! #define EINPROGRESS	WSAEINPROGRESS
! #define EINTR		WSAEINTR
! #define EINVAL		WSAEINVAL
! #define EIO		WSAEDISCON
! #define EISCONN		WSAEISCONN
! #define ELOOP		WSAELOOP
! #define EMFILE		WSAEMFILE
! #define EMSGSIZE	WSAEMSGSIZE
! #define ENAMETOOLONG	WSAENAMETOOLONG
! #define ENETDOWN	WSAENETDOWN
! #define ENETRESET	WSAENETRESET
! #define ENETUNREACH	WSAENETUNREACH
! #define ENOBUFS		WSAENOBUFS
! #define ENOPROTOOPT	WSAENOPROTOOPT
! #define ENOTCONN	WSAENOTCONN
! #define ENOTSOCK	WSAENOTSOCK
! #define EOPNOTSUPP	WSAEOPNOTSUPP
! #define EPFNOSUPPORT	WSAEPFNOSUPPORT
! #define EPROTONOSUPPORT	WSAEPROTONOSUPPORT
! #define ENOTSOCK	WSAENOTSOCK
! #define EOPNOTSUPP	WSAEOPNOTSUPP
! #define EPFNOSUPPORT	WSAEPFNOSUPPORT
! #define EPROTONOSUPPORT	WSAEPROTONOSUPPORT
! #define EPROTOTYPE	WSAEPROTOTYPE
! #define ESHUTDOWN	WSAESHUTDOWN
! #define ESOCKTNOSUPPORT	WSAESOCKTNOSUPPORT
! #define ETIMEDOUT	WSAETIMEDOUT
! #define ETOOMANYREFS	WSAETOOMANYREFS
! #define EWOULDBLOCK	WSAEWOULDBLOCK
! #define SHUT_RD		SD_RECEIVE
! #define SHUT_WR		SD_SEND
! #define SHUT_RDWR	SD_BOTH
! 
  #endif
+ 
+ #elif defined(VMS)
+ #define FD_SETSIZE 4096
+ #ifndef IN_RTS
+ /* These DEC C headers are not available when building with GCC */
+ #include <in.h>
+ #include <tcp.h>
+ #include <ioctl.h>
+ #include <netdb.h>
  #endif
+ 
  #endif
  
! #ifndef __MINGW32__
! #include <errno.h>
  #endif
  
+ #ifdef __vxworks
+ #include <sys/times.h>
  #else
! #include <sys/time.h>
  #endif
  
  #if !(defined (VMS) || defined (__MINGW32__) || defined(__rtems__))
! #include <sys/socket.h>
! #include <netinet/in.h>
! #include <netinet/tcp.h>
! #include <sys/ioctl.h>
! #include <netdb.h>
  #endif
diff -Nrcpad gcc-4.0.2/gcc/ada/hlo.adb gcc-4.1.0/gcc/ada/hlo.adb
*** gcc-4.0.2/gcc/ada/hlo.adb	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/hlo.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/hlo.ads gcc-4.1.0/gcc/ada/hlo.ads
*** gcc-4.0.2/gcc/ada/hlo.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/hlo.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/hostparm.ads gcc-4.1.0/gcc/ada/hostparm.ads
*** gcc-4.0.2/gcc/ada/hostparm.ads	Tue Oct 21 13:42:08 2003
--- gcc-4.1.0/gcc/ada/hostparm.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-c.adb gcc-4.1.0/gcc/ada/i-c.adb
*** gcc-4.0.2/gcc/ada/i-c.adb	Thu Feb 10 13:50:25 2005
--- gcc-4.1.0/gcc/ada/i-c.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Interfaces.C is
*** 504,510 ****
           --  char_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error.
  
           if Item'Length = 0 then
              raise Constraint_Error;
--- 504,511 ----
           --  char_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error. This is also the appropriate behavior in Ada 95,
!          --  since nothing else makes sense.
  
           if Item'Length = 0 then
              raise Constraint_Error;
*************** package body Interfaces.C is
*** 593,599 ****
           --  wchar_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error.
  
           if Item'Length = 0 then
              raise Constraint_Error;
--- 594,601 ----
           --  wchar_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error. This is also the appropriate behavior in Ada 95,
!          --  since nothing else makes sense.
  
           if Item'Length = 0 then
              raise Constraint_Error;
*************** package body Interfaces.C is
*** 680,686 ****
           --  char16_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error.
  
           if Item'Length = 0 then
              raise Constraint_Error;
--- 682,689 ----
           --  char16_array. The lower bound of this array is required to be zero
           --  (RM B.3(50)) but that is of course impossible given that size_t
           --  is unsigned. According to Ada 2005 AI-258, the result is to raise
!          --  Constraint_Error. This is also the appropriate behavior in Ada 95,
!          --  since nothing else makes sense.
  
           if Item'Length = 0 then
              raise Constraint_Error;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-c.ads gcc-4.1.0/gcc/ada/i-c.ads
*** gcc-4.0.2/gcc/ada/i-c.ads	Thu Feb 10 13:50:25 2005
--- gcc-4.1.0/gcc/ada/i-c.ads	Mon Sep  5 07:51:25 2005
***************
*** 16,22 ****
  with System.Parameters;
  
  package Interfaces.C is
! pragma Pure (C);
  
     --  Declaration's based on C's <limits.h>
  
--- 16,22 ----
  with System.Parameters;
  
  package Interfaces.C is
!    pragma Pure;
  
     --  Declaration's based on C's <limits.h>
  
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cexten.ads gcc-4.1.0/gcc/ada/i-cexten.ads
*** gcc-4.0.2/gcc/ada/i-cexten.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-cexten.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Interfaces.C.Extensions is
*** 247,251 ****
     type Signed_32 is range -2 ** 31 .. 2 ** 31 - 1;
     for Signed_32'Size use 32;
  
- 
  end Interfaces.C.Extensions;
--- 247,250 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cobol.adb gcc-4.1.0/gcc/ada/i-cobol.adb
*** gcc-4.0.2/gcc/ada/i-cobol.adb	Thu Feb 10 13:57:01 2005
--- gcc-4.1.0/gcc/ada/i-cobol.adb	Mon Sep  5 08:07:00 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,40 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The body of Interfaces.COBOL is implementation independent (i.e. the
! --  same version is used with all versions of GNAT). The specialization
! --  to a particular COBOL format is completely contained in the private
! --  part ot the spec.
  
  with Interfaces; use Interfaces;
  with System;     use System;
--- 31,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  The body of Interfaces.COBOL is implementation independent (i.e. the same
! --  version is used with all versions of GNAT). The specialization to a
! --  particular COBOL format is completely contained in the private part of
! --  the spec.
  
  with Interfaces; use Interfaces;
  with System;     use System;
*************** package body Interfaces.COBOL is
*** 76,83 ****
  
     function Binary_To_Decimal
       (Item   : Byte_Array;
!       Format : Binary_Format)
!       return   Integer_64;
     --  This function converts a numeric value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
--- 76,82 ----
  
     function Binary_To_Decimal
       (Item   : Byte_Array;
!       Format : Binary_Format) return Integer_64;
     --  This function converts a numeric value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
*************** package body Interfaces.COBOL is
*** 85,92 ****
  
     function Numeric_To_Decimal
       (Item   : Numeric;
!       Format : Display_Format)
!       return   Integer_64;
     --  This function converts a numeric value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
--- 84,90 ----
  
     function Numeric_To_Decimal
       (Item   : Numeric;
!       Format : Display_Format) return Integer_64;
     --  This function converts a numeric value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
*************** package body Interfaces.COBOL is
*** 94,101 ****
  
     function Packed_To_Decimal
       (Item   : Packed_Decimal;
!       Format : Packed_Format)
!       return   Integer_64;
     --  This function converts a packed value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
--- 92,98 ----
  
     function Packed_To_Decimal
       (Item   : Packed_Decimal;
!       Format : Packed_Format) return Integer_64;
     --  This function converts a packed value in the given format to its
     --  corresponding integer value. This is the non-generic implementation
     --  of Decimal_Conversions.To_Decimal. The generic routine does the
*************** package body Interfaces.COBOL is
*** 207,213 ****
     -- Numeric_To_Decimal --
     ------------------------
  
!    --  The following assumptions are made in the coding of this routine
  
     --    The range of COBOL_Digits is compact and the ten values
     --    represent the digits 0-9 in sequence
--- 204,210 ----
     -- Numeric_To_Decimal --
     ------------------------
  
!    --  The following assumptions are made in the coding of this routine:
  
     --    The range of COBOL_Digits is compact and the ten values
     --    represent the digits 0-9 in sequence
*************** package body Interfaces.COBOL is
*** 220,226 ****
  
     --    The COBOL_Minus_Digits set is disjoint from COBOL_Digits
  
!    --  These assumptions are true for all COBOL representations we know of.
  
     function Numeric_To_Decimal
       (Item   : Numeric;
--- 217,223 ----
  
     --    The COBOL_Minus_Digits set is disjoint from COBOL_Digits
  
!    --  These assumptions are true for all COBOL representations we know of
  
     function Numeric_To_Decimal
       (Item   : Numeric;
*************** package body Interfaces.COBOL is
*** 708,714 ****
        --  Note that the tests here are all compile time tests
  
        function Length (Format : Binary_Format) return Natural is
!          pragma Warnings (Off, Format);
        begin
           if Num'Digits <= 2 then
              return 1;
--- 705,711 ----
        --  Note that the tests here are all compile time tests
  
        function Length (Format : Binary_Format) return Natural is
!          pragma Unreferenced (Format);
        begin
           if Num'Digits <= 2 then
              return 1;
*************** package body Interfaces.COBOL is
*** 743,750 ****
        function Length
          (Format : Packed_Format) return Natural
        is
!          pragma Warnings (Off, Format);
! 
        begin
           case Packed_Representation is
              when IBM =>
--- 740,746 ----
        function Length
          (Format : Packed_Format) return Natural
        is
!          pragma Unreferenced (Format);
        begin
           case Packed_Representation is
              when IBM =>
*************** package body Interfaces.COBOL is
*** 847,860 ****
  
        function To_Decimal
          (Item   : Numeric;
!          Format : Display_Format)
!          return   Num
        is
           pragma Unsuppress (Range_Check);
  
        begin
           return Num'Fixed_Value (Numeric_To_Decimal (Item, Format));
- 
        exception
           when Constraint_Error =>
              raise Conversion_Error;
--- 843,854 ----
  
        function To_Decimal
          (Item   : Numeric;
!          Format : Display_Format) return Num
        is
           pragma Unsuppress (Range_Check);
  
        begin
           return Num'Fixed_Value (Numeric_To_Decimal (Item, Format));
        exception
           when Constraint_Error =>
              raise Conversion_Error;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cobol.ads gcc-4.1.0/gcc/ada/i-cobol.ads
*** gcc-4.0.2/gcc/ada/i-cobol.ads	Mon Feb  2 12:31:53 2004
--- gcc-4.1.0/gcc/ada/i-cobol.ads	Mon Sep  5 08:07:00 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                             (ASCII Version)                              --
  --                                                                          --
! --          Copyright (C) 1993-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                             (ASCII Version)                              --
  --                                                                          --
! --          Copyright (C) 1993-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Interfaces.COBOL is
*** 386,397 ****
  
        function Valid
          (Item   : Numeric;
!          Format : Display_Format)
!          return   Boolean;
  
        function Length
!         (Format : Display_Format)
!          return   Natural;
  
        function To_Decimal
          (Item   : Numeric;
--- 386,395 ----
  
        function Valid
          (Item   : Numeric;
!          Format : Display_Format) return Boolean;
  
        function Length
!         (Format : Display_Format) return Natural;
  
        function To_Decimal
          (Item   : Numeric;
*************** package Interfaces.COBOL is
*** 400,435 ****
  
        function To_Display
          (Item   : Num;
!          Format : Display_Format)
!          return   Numeric;
  
        --  Packed Formats: data values are represented as Packed_Decimal
  
        function Valid
          (Item   : Packed_Decimal;
!          Format : Packed_Format)
!          return   Boolean;
  
        function Length
!         (Format : Packed_Format)
!          return   Natural;
  
        function To_Decimal
          (Item   : Packed_Decimal;
!          Format : Packed_Format)
!          return   Num;
  
        function To_Packed
          (Item   : Num;
!          Format : Packed_Format)
!          return   Packed_Decimal;
  
        --  Binary Formats: external data values are represented as Byte_Array
  
        function Valid
          (Item   : Byte_Array;
!          Format : Binary_Format)
!          return   Boolean;
  
        function Length
          (Format : Binary_Format)
--- 398,427 ----
  
        function To_Display
          (Item   : Num;
!          Format : Display_Format) return Numeric;
  
        --  Packed Formats: data values are represented as Packed_Decimal
  
        function Valid
          (Item   : Packed_Decimal;
!          Format : Packed_Format) return Boolean;
  
        function Length
!         (Format : Packed_Format) return Natural;
  
        function To_Decimal
          (Item   : Packed_Decimal;
!          Format : Packed_Format) return Num;
  
        function To_Packed
          (Item   : Num;
!          Format : Packed_Format) return Packed_Decimal;
  
        --  Binary Formats: external data values are represented as Byte_Array
  
        function Valid
          (Item   : Byte_Array;
!          Format : Binary_Format) return Boolean;
  
        function Length
          (Format : Binary_Format)
*************** package Interfaces.COBOL is
*** 441,448 ****
  
        function To_Binary
          (Item   : Num;
!          Format : Binary_Format)
!          return   Byte_Array;
  
        --  Internal Binary formats: data values are of type Binary/Long_Binary
  
--- 433,439 ----
  
        function To_Binary
          (Item   : Num;
!          Format : Binary_Format) return Byte_Array;
  
        --  Internal Binary formats: data values are of type Binary/Long_Binary
  
*************** private
*** 517,530 ****
  
     type Packed_Format is (U, S);
  
!    Packed_Unsigned   : constant Packed_Format := U;
!    Packed_Signed     : constant Packed_Format := S;
  
     type Packed_Representation_Type is (IBM);
     --  Indicator for format used for packed decimal
  
     Packed_Representation : constant Packed_Representation_Type := IBM;
!    --  This version of the spec uses IBM internal format, as described above.
  
     -----------------------------
     -- Display Decimal Formats --
--- 508,521 ----
  
     type Packed_Format is (U, S);
  
!    Packed_Unsigned : constant Packed_Format := U;
!    Packed_Signed   : constant Packed_Format := S;
  
     type Packed_Representation_Type is (IBM);
     --  Indicator for format used for packed decimal
  
     Packed_Representation : constant Packed_Representation_Type := IBM;
!    --  This version of the spec uses IBM internal format, as described above
  
     -----------------------------
     -- Display Decimal Formats --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cpoint.adb gcc-4.1.0/gcc/ada/i-cpoint.adb
*** gcc-4.0.2/gcc/ada/i-cpoint.adb	Fri Mar  5 10:58:56 2004
--- gcc-4.1.0/gcc/ada/i-cpoint.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cpoint.ads gcc-4.1.0/gcc/ada/i-cpoint.ads
*** gcc-4.0.2/gcc/ada/i-cpoint.ads	Fri Mar  5 10:58:56 2004
--- gcc-4.1.0/gcc/ada/i-cpoint.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 42,48 ****
     Default_Terminator : Element;
  
  package Interfaces.C.Pointers is
! pragma Preelaborate (Pointers);
  
     type Pointer is access all Element;
  
--- 42,48 ----
     Default_Terminator : Element;
  
  package Interfaces.C.Pointers is
!    pragma Preelaborate;
  
     type Pointer is access all Element;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cpp-vms.adb gcc-4.1.0/gcc/ada/i-cpp-vms.adb
*** gcc-4.0.2/gcc/ada/i-cpp-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/i-cpp-vms.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,346 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUN-TIME COMPONENTS                         --
- --                                                                          --
- --                       I N T E R F A C E S . C P P                        --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --         Copyright (C) 2000-2004, Free Software Foundation, Inc.          --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is the OpenVMS/Alpha DEC C++ (cxx) version of this package
- 
- with Ada.Tags;                use Ada.Tags;
- with System;                  use System;
- with System.Storage_Elements; use System.Storage_Elements;
- with Unchecked_Conversion;
- 
- package body Interfaces.CPP is
- 
-    subtype Cstring is String (Positive);
-    type Cstring_Ptr is access all Cstring;
-    type Tag_Table is array (Natural range <>) of Vtable_Ptr;
-    pragma Suppress_Initialization (Tag_Table);
- 
-    type Type_Specific_Data is record
-       Idepth        : Natural;
-       Expanded_Name : Cstring_Ptr;
-       External_Tag  : Cstring_Ptr;
-       HT_Link       : Tag;
-       Ancestor_Tags : Tag_Table (Natural);
-    end record;
- 
-    type Vtable_Entry is record
-      Pfn    : System.Address;
-    end record;
- 
-    type Type_Specific_Data_Ptr is access all Type_Specific_Data;
-    type Vtable_Entry_Array is array (Positive range <>) of Vtable_Entry;
- 
-    type VTable is record
-       Prims_Ptr : Vtable_Entry_Array (Positive);
-       TSD       : Type_Specific_Data_Ptr;
-       --  Location of TSD is unknown so it got moved here to be out of the
-       --  way of Prims_Ptr. Find it later. ???
-    end record;
- 
-    --------------------------------------------------------
-    -- Unchecked Conversions for Tag, Vtable_Ptr, and TSD --
-    --------------------------------------------------------
- 
-    function To_Type_Specific_Data_Ptr is
-      new Unchecked_Conversion (Address, Type_Specific_Data_Ptr);
- 
-    function To_Address is
-      new Unchecked_Conversion (Type_Specific_Data_Ptr, Address);
- 
-    ---------------------------------------------
-    -- Unchecked Conversions for String Fields --
-    ---------------------------------------------
- 
-    function To_Cstring_Ptr is
-      new Unchecked_Conversion (Address, Cstring_Ptr);
- 
-    function To_Address is
-      new Unchecked_Conversion (Cstring_Ptr, Address);
- 
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    function Length (Str : Cstring_Ptr) return Natural;
-    --  Length of string represented by the given pointer (treating the
-    --  string as a C-style string, which is Nul terminated).
- 
-    --------------------
-    -- Displaced_This --
-    --------------------
- 
-    function Displaced_This
-     (Current_This : System.Address;
-      Vptr         : Vtable_Ptr;
-      Position     : Positive) return System.Address
-    is
-       pragma Warnings (Off, Vptr);
-       pragma Warnings (Off, Position);
-    begin
-       return Current_This;
-       --        + Storage_Offset (Vptr.Prims_Ptr (Position).Delta1);
-       --  why is above line commented out ???
-    end Displaced_This;
- 
-    -----------------------
-    -- CPP_CW_Membership --
-    -----------------------
- 
-    function CPP_CW_Membership
-      (Obj_Tag : Vtable_Ptr;
-       Typ_Tag : Vtable_Ptr) return Boolean
-    is
-       Pos : constant Integer := Obj_Tag.TSD.Idepth - Typ_Tag.TSD.Idepth;
-    begin
-       return Pos >= 0 and then Obj_Tag.TSD.Ancestor_Tags (Pos) = Typ_Tag;
-    end CPP_CW_Membership;
- 
-    ---------------------------
-    -- CPP_Get_Expanded_Name --
-    ---------------------------
- 
-    function CPP_Get_Expanded_Name (T : Vtable_Ptr) return Address is
-    begin
-       return To_Address (T.TSD.Expanded_Name);
-    end CPP_Get_Expanded_Name;
- 
-    --------------------------
-    -- CPP_Get_External_Tag --
-    --------------------------
- 
-    function CPP_Get_External_Tag (T : Vtable_Ptr) return Address is
-    begin
-       return To_Address (T.TSD.External_Tag);
-    end CPP_Get_External_Tag;
- 
-    -------------------------------
-    -- CPP_Get_Inheritance_Depth --
-    -------------------------------
- 
-    function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural is
-    begin
-       return T.TSD.Idepth;
-    end CPP_Get_Inheritance_Depth;
- 
-    -----------------------
-    -- CPP_Get_RC_Offset --
-    -----------------------
- 
-    function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset is
-       pragma Warnings (Off, T);
-    begin
-       return 0;
-    end CPP_Get_RC_Offset;
- 
-    -----------------------------
-    -- CPP_Get_Prim_Op_Address --
-    -----------------------------
- 
-    function CPP_Get_Prim_Op_Address
-      (T        : Vtable_Ptr;
-       Position : Positive) return Address
-    is
-    begin
-       return T.Prims_Ptr (Position).Pfn;
-    end CPP_Get_Prim_Op_Address;
- 
-    -------------------------------
-    -- CPP_Get_Remotely_Callable --
-    -------------------------------
- 
-    function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean is
-       pragma Warnings (Off, T);
-    begin
-       return True;
-    end CPP_Get_Remotely_Callable;
- 
-    -----------------
-    -- CPP_Get_TSD --
-    -----------------
- 
-    function CPP_Get_TSD  (T : Vtable_Ptr) return Address is
-    begin
-       return To_Address (T.TSD);
-    end CPP_Get_TSD;
- 
-    --------------------
-    -- CPP_Inherit_DT --
-    --------------------
- 
-    procedure CPP_Inherit_DT
-     (Old_T       : Vtable_Ptr;
-      New_T       : Vtable_Ptr;
-      Entry_Count : Natural)
-    is
-    begin
-       if Old_T /= null then
-          New_T.Prims_Ptr (1 .. Entry_Count) :=
-            Old_T.Prims_Ptr (1 .. Entry_Count);
-       end if;
-    end CPP_Inherit_DT;
- 
-    ---------------------
-    -- CPP_Inherit_TSD --
-    ---------------------
- 
-    procedure CPP_Inherit_TSD
-      (Old_TSD : Address;
-       New_Tag : Vtable_Ptr)
-    is
-       TSD : constant Type_Specific_Data_Ptr :=
-               To_Type_Specific_Data_Ptr (Old_TSD);
- 
-       New_TSD : Type_Specific_Data renames New_Tag.TSD.all;
- 
-    begin
-       if TSD /= null then
-          New_TSD.Idepth := TSD.Idepth + 1;
-          New_TSD.Ancestor_Tags (1 .. New_TSD.Idepth)
-            := TSD.Ancestor_Tags (0 .. TSD.Idepth);
-       else
-          New_TSD.Idepth := 0;
-       end if;
- 
-       New_TSD.Ancestor_Tags (0) := New_Tag;
-    end CPP_Inherit_TSD;
- 
-    ---------------------------
-    -- CPP_Set_Expanded_Name --
-    ---------------------------
- 
-    procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : Address) is
-    begin
-       T.TSD.Expanded_Name := To_Cstring_Ptr (Value);
-    end CPP_Set_Expanded_Name;
- 
-    --------------------------
-    -- CPP_Set_External_Tag --
-    --------------------------
- 
-    procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : Address) is
-    begin
-       T.TSD.External_Tag := To_Cstring_Ptr (Value);
-    end CPP_Set_External_Tag;
- 
-    -------------------------------
-    -- CPP_Set_Inheritance_Depth --
-    -------------------------------
- 
-    procedure CPP_Set_Inheritance_Depth
-      (T     : Vtable_Ptr;
-       Value : Natural)
-    is
-    begin
-       T.TSD.Idepth := Value;
-    end CPP_Set_Inheritance_Depth;
- 
-    -----------------------------
-    -- CPP_Set_Prim_Op_Address --
-    -----------------------------
- 
-    procedure CPP_Set_Prim_Op_Address
-      (T        : Vtable_Ptr;
-       Position : Positive;
-       Value    : Address)
-    is
-    begin
-       T.Prims_Ptr (Position).Pfn := Value;
-    end CPP_Set_Prim_Op_Address;
- 
-    -----------------------
-    -- CPP_Set_RC_Offset --
-    -----------------------
- 
-    procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset) is
-       pragma Warnings (Off, T);
-       pragma Warnings (Off, Value);
-    begin
-       null;
-    end CPP_Set_RC_Offset;
- 
-    -------------------------------
-    -- CPP_Set_Remotely_Callable --
-    -------------------------------
- 
-    procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean) is
-       pragma Warnings (Off, T);
-       pragma Warnings (Off, Value);
-    begin
-       null;
-    end CPP_Set_Remotely_Callable;
- 
-    -----------------
-    -- CPP_Set_TSD --
-    -----------------
- 
-    procedure CPP_Set_TSD (T : Vtable_Ptr; Value : Address) is
-    begin
-       T.TSD := To_Type_Specific_Data_Ptr (Value);
-    end CPP_Set_TSD;
- 
-    -------------------
-    -- Expanded_Name --
-    -------------------
- 
-    function Expanded_Name (T : Vtable_Ptr) return String is
-       Result : constant Cstring_Ptr := T.TSD.Expanded_Name;
-    begin
-       return Result (1 .. Length (Result));
-    end Expanded_Name;
- 
-    ------------------
-    -- External_Tag --
-    ------------------
- 
-    function External_Tag (T : Vtable_Ptr) return String is
-       Result : constant Cstring_Ptr := T.TSD.External_Tag;
-    begin
-       return Result (1 .. Length (Result));
-    end External_Tag;
- 
-    ------------
-    -- Length --
-    ------------
- 
-    function Length (Str : Cstring_Ptr) return Natural is
-       Len : Integer := 1;
- 
-    begin
-       while Str (Len) /= ASCII.Nul loop
-          Len := Len + 1;
-       end loop;
- 
-       return Len - 1;
-    end Length;
- 
- end Interfaces.CPP;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cpp.adb gcc-4.1.0/gcc/ada/i-cpp.adb
*** gcc-4.0.2/gcc/ada/i-cpp.adb	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/i-cpp.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,428 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Ada.Tags;                use Ada.Tags;
! with System;                  use System;
! with System.Storage_Elements; use System.Storage_Elements;
  
  package body Interfaces.CPP is
- 
- --  Structure of the Dispatch Table
- 
- --           +-----------------------+
- --           |     Offset_To_Top     |
- --           +-----------------------+
- --           | Typeinfo_Ptr/TSD_Ptr  |----> Type Specific Data
- --  Tag ---> +-----------------------+      +-------------------+
- --           |        table of       |      | inheritance depth |
- --           :     primitive ops     :      +-------------------+
- --           |        pointers       |      |   expanded name   |
- --           +-----------------------+      +-------------------+
- --                                          |   external tag    |
- --                                          +-------------------+
- --                                          |   Hash table link |
- --                                          +-------------------+
- --                                          | Remotely Callable |
- --                                          +-------------------+
- --                                          | Rec Ctrler offset |
- --                                          +-------------------+
- --                                          | table of          |
- --                                          :   ancestor        :
- --                                          |      tags         |
- --                                          +-------------------+
- 
-    --  The declarations below need (extensive) comments ???
- 
-    subtype Cstring is String (Positive);
-    type Cstring_Ptr is access all Cstring;
-    type Tag_Table is array (Natural range <>) of Vtable_Ptr;
-    pragma Suppress_Initialization (Tag_Table);
- 
-    type Type_Specific_Data is record
-       Idepth        : Natural;
-       Expanded_Name : Cstring_Ptr;
-       External_Tag  : Cstring_Ptr;
-       HT_Link       : Tag;
-       Ancestor_Tags : Tag_Table (Natural);
-    end record;
- 
-    type Vtable_Entry is record
-      Pfn : System.Address;
-    end record;
- 
-    type Vtable_Entry_Array is array (Positive range <>) of Vtable_Entry;
- 
-    type VTable is record
-       --  Offset_To_Top : Integer;
-       --  Typeinfo_Ptr  : System.Address; -- TSD is currently also here???
-       Prims_Ptr  : Vtable_Entry_Array (Positive);
-    end record;
-    --  Note: See comment in a-tags.adb explaining why the components
-    --        Offset_To_Top and Typeinfo_Ptr have been commented out.
-    --  -----------------------------------------------------------------------
-    --  The size of the Prims_Ptr array actually depends on the tagged type to
-    --  which it applies. For each tagged type, the expander computes the
-    --  actual array size, allocates the Dispatch_Table record accordingly, and
-    --  generates code that displaces the base of the record after the
-    --  Typeinfo_Ptr component. For this reason the first two components have
-    --  been commented in the previous declaration. The access to these
-    --  components is done by means of local functions.
- 
-    ---------------------------
-    -- Unchecked Conversions --
-    ---------------------------
- 
-    type Int_Ptr is access Integer;
- 
-    function To_Int_Ptr is
-       new Unchecked_Conversion (System.Address, Int_Ptr);
- 
-    function To_Cstring_Ptr is
-      new Unchecked_Conversion (Address, Cstring_Ptr);
- 
-    function To_Address is
-      new Unchecked_Conversion (Cstring_Ptr, Address);
- 
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    function Length (Str : Cstring_Ptr) return Natural;
-    --  Length of string represented by the given pointer (treating the string
-    --  as a C-style string, which is Nul terminated).
- 
-    function Offset_To_Top (T : Vtable_Ptr) return Integer;
-    --  Returns the current value of the offset_to_top component available in
-    --  the prologue of the dispatch table.
- 
-    function Typeinfo_Ptr (T : Vtable_Ptr) return System.Address;
-    --  Returns the current value of the typeinfo_ptr component available in
-    --  the prologue of the dispatch table.
- 
-    pragma Unreferenced (Offset_To_Top);
-    pragma Unreferenced (Typeinfo_Ptr);
-    --  These functions will be used for full compatibility with the C++ ABI
- 
-    -----------------------
-    -- CPP_CW_Membership --
-    -----------------------
- 
-    function CPP_CW_Membership
-      (Obj_Tag : Vtable_Ptr;
-       Typ_Tag : Vtable_Ptr) return Boolean
-    is
-       Pos : constant Integer := TSD (Obj_Tag).Idepth - TSD (Typ_Tag).Idepth;
-    begin
-       return Pos >= 0 and then TSD (Obj_Tag).Ancestor_Tags (Pos) = Typ_Tag;
-    end CPP_CW_Membership;
- 
-    ---------------------------
-    -- CPP_Get_Expanded_Name --
-    ---------------------------
- 
-    function CPP_Get_Expanded_Name (T : Vtable_Ptr) return Address is
-    begin
-       return To_Address (TSD (T).Expanded_Name);
-    end CPP_Get_Expanded_Name;
- 
-    --------------------------
-    -- CPP_Get_External_Tag --
-    --------------------------
- 
-    function CPP_Get_External_Tag (T : Vtable_Ptr) return Address is
-    begin
-       return To_Address (TSD (T).External_Tag);
-    end CPP_Get_External_Tag;
- 
-    -------------------------------
-    -- CPP_Get_Inheritance_Depth --
-    -------------------------------
- 
-    function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural is
-    begin
-       return TSD (T).Idepth;
-    end CPP_Get_Inheritance_Depth;
- 
-    -------------------------
-    -- CPP_Get_Prim_Op_Address --
-    -------------------------
- 
-    function CPP_Get_Prim_Op_Address
-      (T        : Vtable_Ptr;
-       Position : Positive) return Address
-    is
-    begin
-       return T.Prims_Ptr (Position).Pfn;
-    end CPP_Get_Prim_Op_Address;
- 
-    -----------------------
-    -- CPP_Get_RC_Offset --
-    -----------------------
- 
-    function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset is
-       pragma Warnings (Off, T);
-    begin
-       return 0;
-    end CPP_Get_RC_Offset;
- 
-    -------------------------------
-    -- CPP_Get_Remotely_Callable --
-    -------------------------------
- 
-    function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean is
-       pragma Warnings (Off, T);
-    begin
-       return True;
-    end CPP_Get_Remotely_Callable;
- 
-    -----------------
-    -- CPP_Get_TSD --
-    -----------------
- 
-    function CPP_Get_TSD  (T : Vtable_Ptr) return Address is
-       use type System.Storage_Elements.Storage_Offset;
-       TSD_Ptr : constant Addr_Ptr :=
-                   To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
-    begin
-       return TSD_Ptr.all;
-    end CPP_Get_TSD;
- 
-    --------------------
-    -- CPP_Inherit_DT --
-    --------------------
- 
-    procedure CPP_Inherit_DT
-     (Old_T   : Vtable_Ptr;
-      New_T   : Vtable_Ptr;
-      Entry_Count : Natural)
-    is
-    begin
-       if Old_T /= null then
-          New_T.Prims_Ptr (1 .. Entry_Count)
-            := Old_T.Prims_Ptr (1 .. Entry_Count);
-       end if;
-    end CPP_Inherit_DT;
- 
-    ---------------------
-    -- CPP_Inherit_TSD --
-    ---------------------
- 
-    procedure CPP_Inherit_TSD
-      (Old_TSD : Address;
-       New_Tag : Vtable_Ptr)
-    is
-       Old_TSD_Ptr : constant Type_Specific_Data_Ptr :=
-                       To_Type_Specific_Data_Ptr (Old_TSD);
- 
-       New_TSD_Ptr : constant Type_Specific_Data_Ptr :=
-                       TSD (New_Tag);
- 
-    begin
-       if Old_TSD_Ptr /= null then
-          New_TSD_Ptr.Idepth := Old_TSD_Ptr.Idepth + 1;
-          New_TSD_Ptr.Ancestor_Tags (1 .. New_TSD_Ptr.Idepth) :=
-            Old_TSD_Ptr.Ancestor_Tags (0 .. Old_TSD_Ptr.Idepth);
-       else
-          New_TSD_Ptr.Idepth := 0;
-       end if;
- 
-       New_TSD_Ptr.Ancestor_Tags (0) := New_Tag;
-    end CPP_Inherit_TSD;
- 
-    ---------------------------
-    -- CPP_Set_Expanded_Name --
-    ---------------------------
- 
-    procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : Address) is
-    begin
-       TSD (T).Expanded_Name := To_Cstring_Ptr (Value);
-    end CPP_Set_Expanded_Name;
- 
-    --------------------------
-    -- CPP_Set_External_Tag --
-    --------------------------
- 
-    procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : Address) is
-    begin
-       TSD (T).External_Tag := To_Cstring_Ptr (Value);
-    end CPP_Set_External_Tag;
- 
-    -------------------------------
-    -- CPP_Set_Inheritance_Depth --
-    -------------------------------
- 
-    procedure CPP_Set_Inheritance_Depth
-      (T     : Vtable_Ptr;
-       Value : Natural)
-    is
-    begin
-       TSD (T).Idepth := Value;
-    end CPP_Set_Inheritance_Depth;
- 
-    -----------------------------
-    -- CPP_Set_Prim_Op_Address --
-    -----------------------------
- 
-    procedure CPP_Set_Prim_Op_Address
-      (T        : Vtable_Ptr;
-       Position : Positive;
-       Value    : Address)
-    is
-    begin
-       T.Prims_Ptr (Position).Pfn := Value;
-    end CPP_Set_Prim_Op_Address;
- 
-    -----------------------
-    -- CPP_Set_RC_Offset --
-    -----------------------
- 
-    procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset) is
-       pragma Warnings (Off, T);
-       pragma Warnings (Off, Value);
-    begin
-       null;
-    end CPP_Set_RC_Offset;
- 
-    -------------------------------
-    -- CPP_Set_Remotely_Callable --
-    -------------------------------
- 
-    procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean) is
-       pragma Warnings (Off, T);
-       pragma Warnings (Off, Value);
-    begin
-       null;
-    end CPP_Set_Remotely_Callable;
- 
-    -----------------
-    -- CPP_Set_TSD --
-    -----------------
- 
-    procedure CPP_Set_TSD (T : Vtable_Ptr; Value : Address) is
-       use type System.Storage_Elements.Storage_Offset;
-       TSD_Ptr : constant Addr_Ptr :=
-                   To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
-    begin
-       TSD_Ptr.all := Value;
-    end CPP_Set_TSD;
- 
-    --------------------
-    -- Displaced_This --
-    --------------------
- 
-    function Displaced_This
-     (Current_This : System.Address;
-      Vptr         : Vtable_Ptr;
-      Position     : Positive)
-      return         System.Address
-    is
-       pragma Warnings (Off, Vptr);
-       pragma Warnings (Off, Position);
- 
-    begin
-       return Current_This;
- 
-       --  why is the following here commented out ???
-       --  + Storage_Offset (Vptr.Prims_Ptr (Position).Delta1);
-    end Displaced_This;
- 
-    -------------------
-    -- Expanded_Name --
-    -------------------
- 
-    function Expanded_Name (T : Vtable_Ptr) return String is
-       Result : constant Cstring_Ptr := TSD (T).Expanded_Name;
-    begin
-       return Result (1 .. Length (Result));
-    end Expanded_Name;
- 
-    ------------------
-    -- External_Tag --
-    ------------------
- 
-    function External_Tag (T : Vtable_Ptr) return String is
-       Result : constant Cstring_Ptr := TSD (T).External_Tag;
-    begin
-       return Result (1 .. Length (Result));
-    end External_Tag;
- 
-    ------------
-    -- Length --
-    ------------
- 
-    function Length (Str : Cstring_Ptr) return Natural is
-       Len : Integer := 1;
- 
-    begin
-       while Str (Len) /= ASCII.Nul loop
-          Len := Len + 1;
-       end loop;
- 
-       return Len - 1;
-    end Length;
- 
-    ------------------
-    -- Offset_To_Top --
-    ------------------
- 
-    function Offset_To_Top (T : Vtable_Ptr) return Integer is
-       use type System.Storage_Elements.Storage_Offset;
- 
-       TSD_Ptr : constant Int_Ptr
-         := To_Int_Ptr (To_Address (T) - CPP_DT_Prologue_Size);
-    begin
-       return TSD_Ptr.all;
-    end Offset_To_Top;
- 
-    ------------------
-    -- Typeinfo_Ptr --
-    ------------------
- 
-    function Typeinfo_Ptr (T : Vtable_Ptr) return System.Address is
-       use type System.Storage_Elements.Storage_Offset;
-       TSD_Ptr : constant Addr_Ptr :=
-                   To_Addr_Ptr (To_Address (T) - CPP_DT_Typeinfo_Ptr_Size);
-    begin
-       return TSD_Ptr.all;
-    end Typeinfo_Ptr;
- 
-    ---------
-    -- TSD --
-    ---------
- 
-    function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr is
-    begin
-       return To_Type_Specific_Data_Ptr (CPP_Get_TSD (T));
-    end TSD;
- 
  end Interfaces.CPP;
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Dummy body to deal with bootstrap issues (there used to be a real body)
  
  package body Interfaces.CPP is
  end Interfaces.CPP;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cpp.ads gcc-4.1.0/gcc/ada/i-cpp.ads
*** gcc-4.0.2/gcc/ada/i-cpp.ads	Thu Feb 10 13:50:44 2005
--- gcc-4.1.0/gcc/ada/i-cpp.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       I N T E R F A C E S . C P P                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       I N T E R F A C E S . C P P                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,222 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Definitions for interfacing to C++ classes
! 
! --  This package corresponds to Ada.Tags but applied to tagged types which are
! --  are imported from C++ and correspond exactly to a C++ Class. The code that
! --  the GNAT front end generates does not know about the structure of the C++
! --  dispatch table (Vtable) but always accesses it through the procedural
! --  interface defined in this package, thus the implementation of this package
! --  (the body) can be customized to another C++ compiler without any change in
! --  the compiler code itself as long as this procedural interface is respected.
! --  Note that Ada.Tags defines a very similar procedural interface to the
! --  regular Ada Dispatch Table.
  
! with System;
! with System.Storage_Elements;
! with Unchecked_Conversion;
  
  package Interfaces.CPP is
  
!    type Vtable_Ptr is private;
! 
!    function Expanded_Name (T : Vtable_Ptr) return String;
!    function External_Tag  (T : Vtable_Ptr) return String;
! 
! private
!    package S   renames System;
!    package SSE renames System.Storage_Elements;
! 
!    type Vtable;
!    type Vtable_Ptr is access all Vtable;
! 
!    type Type_Specific_Data;
!    type Type_Specific_Data_Ptr is access all Type_Specific_Data;
! 
!    --  These subprograms are in the private part. They are never accessed
!    --  directly except from compiler generated code, which has access to
!    --  private components of packages via the Rtsfind interface.
! 
!    procedure CPP_Set_Prim_Op_Address
!      (T        : Vtable_Ptr;
!       Position : Positive;
!       Value    : S.Address);
!    --  Given a pointer to a dispatch Table (T) and a position in the
!    --  dispatch Table put the address of the virtual function in it
!    --  (used for overriding)
! 
!    function CPP_Get_Prim_Op_Address
!      (T        : Vtable_Ptr;
!       Position : Positive)
!       return     S.Address;
!    --  Given a pointer to a dispatch Table (T) and a position in the DT
!    --  this function returns the address of the virtual function stored
!    --  in it (used for dispatching calls)
! 
!    procedure CPP_Set_Inheritance_Depth
!      (T     : Vtable_Ptr;
!       Value : Natural);
!    --  Given a pointer to a dispatch Table, stores the value representing
!    --  the depth in the inheritance tree. Used during elaboration of the
!    --  tagged type.
! 
!    function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural;
!    --  Given a pointer to a dispatch Table, retreives the value representing
!    --  the depth in the inheritance tree. Used for membership.
! 
!    procedure CPP_Set_TSD (T : Vtable_Ptr; Value : S.Address);
!    --  Given a pointer T to a dispatch Table, stores the address of the
!    --  record containing the Type Specific Data generated by GNAT
! 
!    function CPP_Get_TSD (T : Vtable_Ptr) return S.Address;
!    --  Given a pointer T to a dispatch Table, retreives the address of the
!    --  record containing the Type Specific Data generated by GNAT
! 
!    CPP_DT_Prologue_Size : constant SSE.Storage_Count :=
!                             SSE.Storage_Count
!                               (2 * (Standard'Address_Size / S.Storage_Unit));
!    --  Size of the first part of the dispatch table
! 
!    CPP_DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
!                             SSE.Storage_Count
!                               (Standard'Address_Size / System.Storage_Unit);
!    --  Size of the Typeinfo_Ptr field of the Dispatch Table.
! 
!    CPP_DT_Entry_Size : constant SSE.Storage_Count :=
!                          SSE.Storage_Count
!                            (1 * (Standard'Address_Size / S.Storage_Unit));
!    --  Size of each primitive operation entry in the Dispatch Table.
! 
!    CPP_TSD_Prologue_Size : constant SSE.Storage_Count :=
!                              SSE.Storage_Count
!                                (4 * (Standard'Address_Size / S.Storage_Unit));
!    --  Size of the first part of the type specific data
! 
!    CPP_TSD_Entry_Size : constant SSE.Storage_Count :=
!                           SSE.Storage_Count
!                             (1 * (Standard'Address_Size / S.Storage_Unit));
!    --  Size of each ancestor tag entry in the TSD
! 
!    procedure CPP_Inherit_DT
!     (Old_T       : Vtable_Ptr;
!      New_T       : Vtable_Ptr;
!      Entry_Count : Natural);
!    --  Entry point used to initialize the DT of a type knowing the
!    --  tag of the direct ancestor and the number of primitive ops that are
!    --  inherited (Entry_Count).
! 
!    procedure CPP_Inherit_TSD
!      (Old_TSD : S.Address;
!       New_Tag : Vtable_Ptr);
!    --  Entry point used to initialize the TSD of a type knowing the
!    --  TSD of the direct ancestor.
! 
!    function CPP_CW_Membership (Obj_Tag, Typ_Tag : Vtable_Ptr) return Boolean;
!    --  Given the tag of an object and the tag associated to a type, return
!    --  true if Obj is in Typ'Class.
! 
!    procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : S.Address);
!    --  Set the address of the string containing the external tag
!    --  in the Dispatch table
! 
!    function CPP_Get_External_Tag (T : Vtable_Ptr) return S.Address;
!    --  Retrieve the address of a null terminated string containing
!    --  the external name
! 
!    procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : S.Address);
!    --  Set the address of the string containing the expanded name
!    --  in the Dispatch table
! 
!    function CPP_Get_Expanded_Name (T : Vtable_Ptr) return S.Address;
!    --  Retrieve the address of a null terminated string containing
!    --  the expanded name
! 
!    procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean);
!    --  Since the notions of spec/body distinction and categorized packages
!    --  do not exist in C, this procedure will do nothing
! 
!    function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean;
!    --  This function will always return True for the reason explained above
! 
!    procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset);
!    --  Sets the Offset of the implicit record controller when the object
!    --  has controlled components. Set to O otherwise.
! 
!    function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset;
!    --  Return the Offset of the implicit record controller when the object
!    --  has controlled components. O otherwise.
! 
!    function Displaced_This
!     (Current_This : S.Address;
!      Vptr         : Vtable_Ptr;
!      Position     : Positive)
!      return         S.Address;
!    --  Compute the displacement on the "this" pointer in order to be
!    --  compatible with MI.
!    --  (used for virtual function calls)
! 
!    function TSD (T : Vtable_Ptr) return Type_Specific_Data_Ptr;
!    --  This function is conceptually equivalent to Get_TSD, but
!    --  returning a Type_Specific_Data_Ptr type (rather than an Address)
!    --  simplifies the implementation of the other subprograms.
! 
!    type Addr_Ptr is access System.Address;
! 
!    function To_Address is
!      new Unchecked_Conversion (Vtable_Ptr, System.Address);
  
!    function To_Addr_Ptr is
!       new Unchecked_Conversion (System.Address, Addr_Ptr);
  
!    function To_Type_Specific_Data_Ptr is
!      new Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
  
!    pragma Inline (CPP_Set_Prim_Op_Address);
!    pragma Inline (CPP_Get_Prim_Op_Address);
!    pragma Inline (CPP_Set_Inheritance_Depth);
!    pragma Inline (CPP_Get_Inheritance_Depth);
!    pragma Inline (CPP_Set_TSD);
!    pragma Inline (CPP_Get_TSD);
!    pragma Inline (CPP_Inherit_DT);
!    pragma Inline (CPP_CW_Membership);
!    pragma Inline (CPP_Set_External_Tag);
!    pragma Inline (CPP_Get_External_Tag);
!    pragma Inline (CPP_Set_Expanded_Name);
!    pragma Inline (CPP_Get_Expanded_Name);
!    pragma Inline (CPP_Set_Remotely_Callable);
!    pragma Inline (CPP_Get_Remotely_Callable);
!    pragma Inline (Displaced_This);
!    pragma Inline (TSD);
  
  end Interfaces.CPP;
--- 31,52 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Missing package comment ???
  
! with Ada.Tags;
  
  package Interfaces.CPP is
+    pragma Elaborate_Body;
+    --  We have a dummy body to deal with bootstrap path issues
  
!    subtype Vtable_Ptr is Ada.Tags.Tag;
  
!    --  These need commenting (this is not an RM package!)
  
!    function Expanded_Name (T : Vtable_Ptr) return String
!      renames Ada.Tags.Expanded_Name;
  
!    function External_Tag (T : Vtable_Ptr) return String
!      renames Ada.Tags.External_Tag;
  
  end Interfaces.CPP;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cstrea-vms.adb gcc-4.1.0/gcc/ada/i-cstrea-vms.adb
*** gcc-4.0.2/gcc/ada/i-cstrea-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/i-cstrea-vms.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version.
  
  with Unchecked_Conversion;
  package body Interfaces.C_Streams is
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version
  
  with Unchecked_Conversion;
  package body Interfaces.C_Streams is
*************** package body Interfaces.C_Streams is
*** 87,94 ****
        Ch : int;
  
     begin
!       --  This Fread goes with the Fwrite below.
!       --  The C library fread sometimes can't read fputc generated files.
  
        for C in 1 .. count loop
           for S in 1 .. size loop
--- 87,94 ----
        Ch : int;
  
     begin
!       --  This Fread goes with the Fwrite below. The C library fread sometimes
!       --  can't read fputc generated files.
  
        for C in 1 .. count loop
           for S in 1 .. size loop
*************** package body Interfaces.C_Streams is
*** 125,132 ****
        Ch : int;
  
     begin
!       --  This Fread goes with the Fwrite below.
!       --  The C library fread sometimes can't read fputc generated files.
  
        for C in 1 + index .. count + index loop
           for S in 1 .. size loop
--- 125,132 ----
        Ch : int;
  
     begin
!       --  This Fread goes with the Fwrite below. The C library fread sometimes
!       --  can't read fputc generated files.
  
        for C in 1 + index .. count + index loop
           for S in 1 .. size loop
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cstrea.adb gcc-4.1.0/gcc/ada/i-cstrea.adb
*** gcc-4.0.2/gcc/ada/i-cstrea.adb	Mon Jan  5 15:20:44 2004
--- gcc-4.1.0/gcc/ada/i-cstrea.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cstrea.ads gcc-4.1.0/gcc/ada/i-cstrea.ads
*** gcc-4.0.2/gcc/ada/i-cstrea.ads	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/i-cstrea.ads	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1995-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Interfaces.C_Streams is
*** 123,138 ****
       (buffer : voids;
        size   : size_t;
        count  : size_t;
!       stream : FILEs)
!       return   size_t;
  
     function fread
       (buffer : voids;
        index  : size_t;
        size   : size_t;
        count  : size_t;
!       stream : FILEs)
!       return   size_t;
     --  Same as normal fread, but has a parameter 'index' that indicates
     --  the starting index for the read within 'buffer' (which must be the
     --  address of the beginning of a whole array object with an assumed
--- 123,136 ----
       (buffer : voids;
        size   : size_t;
        count  : size_t;
!       stream : FILEs) return size_t;
  
     function fread
       (buffer : voids;
        index  : size_t;
        size   : size_t;
        count  : size_t;
!       stream : FILEs) return size_t;
     --  Same as normal fread, but has a parameter 'index' that indicates
     --  the starting index for the read within 'buffer' (which must be the
     --  address of the beginning of a whole array object with an assumed
*************** package Interfaces.C_Streams is
*** 198,208 ****
     --  functions.
  
     function file_exists (name : chars) return int;
!    --  Tests if given name corresponds to an existing file.
  
     function is_regular_file (handle : int) return int;
!    --  Tests if given handle is for a regular file (result 1) or for
!    --  a non-regular file (pipe or device, result 0).
  
     ---------------------------------
     -- Control of Text/Binary Mode --
--- 196,206 ----
     --  functions.
  
     function file_exists (name : chars) return int;
!    --  Tests if given name corresponds to an existing file
  
     function is_regular_file (handle : int) return int;
!    --  Tests if given handle is for a regular file (result 1) or for a
!    --  non-regular file (pipe or device, result 0).
  
     ---------------------------------
     -- Control of Text/Binary Mode --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cstrin.adb gcc-4.1.0/gcc/ada/i-cstrin.adb
*** gcc-4.0.2/gcc/ada/i-cstrin.adb	Mon Jan  3 15:38:35 2005
--- gcc-4.1.0/gcc/ada/i-cstrin.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Unchecked_Conversion;
*** 38,48 ****
  
  package body Interfaces.C.Strings is
  
!    --  Note that the type chars_ptr has a pragma No_Strict_Aliasing in
!    --  the spec, to prevent any assumptions about aliasing for values
!    --  of this type, since arbitrary addresses can be converted, and it
!    --  is quite likely that this type will in fact be used for aliasing
!    --  values of other types.
  
     function To_chars_ptr is
        new Unchecked_Conversion (Address, chars_ptr);
--- 38,47 ----
  
  package body Interfaces.C.Strings is
  
!    --  Note that the type chars_ptr has a pragma No_Strict_Aliasing in the
!    --  spec, to prevent any assumptions about aliasing for values of this type,
!    --  since arbitrary addresses can be converted, and it is quite likely that
!    --  this type will in fact be used for aliasing values of other types.
  
     function To_chars_ptr is
        new Unchecked_Conversion (Address, chars_ptr);
*************** package body Interfaces.C.Strings is
*** 116,122 ****
        Index := Position_Of_Nul (Into => Chars);
        Pointer := Memory_Alloc ((Index - Chars'First + 1));
  
!       --  If nul is present, transfer string up to and including it.
  
        if Index <= Chars'Last then
           Update (Item   => Pointer,
--- 115,121 ----
        Index := Position_Of_Nul (Into => Chars);
        Pointer := Memory_Alloc ((Index - Chars'First + 1));
  
!       --  If nul is present, transfer string up to and including nul
  
        if Index <= Chars'Last then
           Update (Item   => Pointer,
*************** package body Interfaces.C.Strings is
*** 322,329 ****
        Result : char_array (0 .. Length);
  
     begin
!       --  As per AI-00177, this is equivalent to
!       --          To_Ada (Value (Item, Length) & nul);
  
        if Item = Null_Ptr then
           raise Dereference_Error;
--- 321,329 ----
        Result : char_array (0 .. Length);
  
     begin
!       --  As per AI-00177, this is equivalent to:
! 
!       --    To_Ada (Value (Item, Length) & nul);
  
        if Item = Null_Ptr then
           raise Dereference_Error;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-cstrin.ads gcc-4.1.0/gcc/ada/i-cstrin.ads
*** gcc-4.0.2/gcc/ada/i-cstrin.ads	Fri Mar  5 10:58:56 2004
--- gcc-4.1.0/gcc/ada/i-cstrin.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1993-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  ------------------------------------------------------------------------------
  
  package Interfaces.C.Strings is
! pragma Preelaborate (Strings);
  
     type char_array_access is access all char_array;
  
--- 36,42 ----
  ------------------------------------------------------------------------------
  
  package Interfaces.C.Strings is
!    pragma Preelaborate;
  
     type char_array_access is access all char_array;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/i-fortra.adb gcc-4.1.0/gcc/ada/i-fortra.adb
*** gcc-4.0.2/gcc/ada/i-fortra.adb	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-fortra.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Interfaces.Fortran is
*** 39,52 ****
  
     --  Single character case
  
!    function To_Ada (Item : in Character_Set) return Character is
     begin
        return Character (Item);
     end To_Ada;
  
     --  String case (function returning converted result)
  
!    function To_Ada (Item : in Fortran_Character) return String is
        T : String (1 .. Item'Length);
  
     begin
--- 39,52 ----
  
     --  Single character case
  
!    function To_Ada (Item : Character_Set) return Character is
     begin
        return Character (Item);
     end To_Ada;
  
     --  String case (function returning converted result)
  
!    function To_Ada (Item : Fortran_Character) return String is
        T : String (1 .. Item'Length);
  
     begin
*************** package body Interfaces.Fortran is
*** 60,66 ****
     --  String case (procedure copying converted string to given buffer)
  
     procedure To_Ada
!      (Item   : in Fortran_Character;
        Target : out String;
        Last   : out Natural)
     is
--- 60,66 ----
     --  String case (procedure copying converted string to given buffer)
  
     procedure To_Ada
!      (Item   : Fortran_Character;
        Target : out String;
        Last   : out Natural)
     is
*************** package body Interfaces.Fortran is
*** 93,106 ****
  
     --  Character case
  
!    function To_Fortran (Item : in Character) return Character_Set is
     begin
        return Character_Set (Item);
     end To_Fortran;
  
     --  String case (function returning converted result)
  
!    function To_Fortran (Item : in String) return Fortran_Character is
        T : Fortran_Character (1 .. Item'Length);
  
     begin
--- 93,106 ----
  
     --  Character case
  
!    function To_Fortran (Item : Character) return Character_Set is
     begin
        return Character_Set (Item);
     end To_Fortran;
  
     --  String case (function returning converted result)
  
!    function To_Fortran (Item : String) return Fortran_Character is
        T : Fortran_Character (1 .. Item'Length);
  
     begin
*************** package body Interfaces.Fortran is
*** 114,120 ****
     --  String case (procedure copying converted string to given buffer)
  
     procedure To_Fortran
!      (Item   : in String;
        Target : out Fortran_Character;
        Last   : out Natural)
     is
--- 114,120 ----
     --  String case (procedure copying converted string to given buffer)
  
     procedure To_Fortran
!      (Item   : String;
        Target : out Fortran_Character;
        Last   : out Natural)
     is
diff -Nrcpad gcc-4.0.2/gcc/ada/i-fortra.ads gcc-4.1.0/gcc/ada/i-fortra.ads
*** gcc-4.0.2/gcc/ada/i-fortra.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-fortra.ads	Tue Nov 15 14:06:45 2005
*************** with Ada.Numerics.Generic_Complex_Types;
*** 17,23 ****
  pragma Elaborate_All (Ada.Numerics.Generic_Complex_Types);
  
  package Interfaces.Fortran is
! pragma Pure (Fortran);
  
     type Fortran_Integer  is new Integer;
     type Real             is new Float;
--- 17,23 ----
  pragma Elaborate_All (Ada.Numerics.Generic_Complex_Types);
  
  package Interfaces.Fortran is
!    pragma Pure;
  
     type Fortran_Integer  is new Integer;
     type Real             is new Float;
*************** pragma Pure (Fortran);
*** 45,63 ****
  
     type Fortran_Character is array (Positive range <>) of Character_Set;
  
!    function To_Fortran (Item : in Character)     return Character_Set;
!    function To_Ada     (Item : in Character_Set) return Character;
  
!    function To_Fortran (Item : in String)            return Fortran_Character;
!    function To_Ada     (Item : in Fortran_Character) return String;
  
     procedure To_Fortran
!      (Item   : in String;
        Target : out Fortran_Character;
        Last   : out Natural);
  
     procedure To_Ada
!      (Item   : in Fortran_Character;
        Target : out String;
        Last   : out Natural);
  
--- 45,63 ----
  
     type Fortran_Character is array (Positive range <>) of Character_Set;
  
!    function To_Fortran (Item : Character)     return Character_Set;
!    function To_Ada     (Item : Character_Set) return Character;
  
!    function To_Fortran (Item : String)            return Fortran_Character;
!    function To_Ada     (Item : Fortran_Character) return String;
  
     procedure To_Fortran
!      (Item   : String;
        Target : out Fortran_Character;
        Last   : out Natural);
  
     procedure To_Ada
!      (Item   : Fortran_Character;
        Target : out String;
        Last   : out Natural);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/i-os2err.ads gcc-4.1.0/gcc/ada/i-os2err.ads
*** gcc-4.0.2/gcc/ada/i-os2err.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-os2err.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --        Copyright (C) 1993,1994,1995 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- --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1993-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Definition of values for OS/2 error returns
  
  package Interfaces.OS2Lib.Errors is
! pragma Preelaborate (Errors);
  
     NO_ERROR                        : constant :=     0;
     ERROR_INVALID_FUNCTION          : constant :=     1;
--- 34,40 ----
  --  Definition of values for OS/2 error returns
  
  package Interfaces.OS2Lib.Errors is
!    pragma Preelaborate;
  
     NO_ERROR                        : constant :=     0;
     ERROR_INVALID_FUNCTION          : constant :=     1;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-os2lib.adb gcc-4.1.0/gcc/ada/i-os2lib.adb
*** gcc-4.0.2/gcc/ada/i-os2lib.adb	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-os2lib.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-os2lib.ads gcc-4.1.0/gcc/ada/i-os2lib.ads
*** gcc-4.0.2/gcc/ada/i-os2lib.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-os2lib.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-1997 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- --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Interfaces.C.Strings;
*** 49,55 ****
  with System;
  
  package Interfaces.OS2Lib is
! pragma Preelaborate (OS2Lib);
  
     package IC  renames Interfaces.C;
     package ICS renames Interfaces.C.Strings;
--- 49,55 ----
  with System;
  
  package Interfaces.OS2Lib is
!    pragma Preelaborate;
  
     package IC  renames Interfaces.C;
     package ICS renames Interfaces.C.Strings;
*************** pragma Preelaborate (OS2Lib);
*** 76,82 ****
     type ULONG   is new IC.unsigned_long;
     type PULONG  is access all ULONG;
  
!    --  Coprocessor stack register element.
  
     type FPREG is record
        losig             : ULONG;        --  Low 32-bits of the mantissa
--- 76,82 ----
     type ULONG   is new IC.unsigned_long;
     type PULONG  is access all ULONG;
  
!    --  Coprocessor stack register element
  
     type FPREG is record
        losig             : ULONG;        --  Low 32-bits of the mantissa
diff -Nrcpad gcc-4.0.2/gcc/ada/i-os2syn.ads gcc-4.1.0/gcc/ada/i-os2syn.ads
*** gcc-4.0.2/gcc/ada/i-os2syn.ads	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-os2syn.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-1998 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- --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  with Interfaces.OS2Lib.Threads;
  
  package Interfaces.OS2Lib.Synchronization is
! pragma Preelaborate (Synchronization);
  
     package IC  renames Interfaces.C;
     package IOT renames Interfaces.OS2Lib.Threads;
--- 34,40 ----
  with Interfaces.OS2Lib.Threads;
  
  package Interfaces.OS2Lib.Synchronization is
!    pragma Preelaborate;
  
     package IC  renames Interfaces.C;
     package IOT renames Interfaces.OS2Lib.Threads;
diff -Nrcpad gcc-4.0.2/gcc/ada/i-os2thr.ads gcc-4.1.0/gcc/ada/i-os2thr.ads
*** gcc-4.0.2/gcc/ada/i-os2thr.ads	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/i-os2thr.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1993-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  with Interfaces.C;
  
  package Interfaces.OS2Lib.Threads is
! pragma Preelaborate (Threads);
  
     package IC renames Interfaces.C;
  
--- 34,40 ----
  with Interfaces.C;
  
  package Interfaces.OS2Lib.Threads is
!    pragma Preelaborate;
  
     package IC renames Interfaces.C;
  
*************** pragma Preelaborate (Threads);
*** 91,97 ****
     function DosKillThread (Id : TID) return APIRET;
     pragma Import (C, DosKillThread, "DosKillThread");
  
- 
     DCWW_WAIT   : constant := 0;
     DCWW_NOWAIT : constant := 1;
     --  Values for "Option" parameter in DosWaitThread call
--- 91,96 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/i-pacdec.adb gcc-4.1.0/gcc/ada/i-pacdec.adb
*** gcc-4.0.2/gcc/ada/i-pacdec.adb	Thu Apr 24 17:54:05 2003
--- gcc-4.1.0/gcc/ada/i-pacdec.adb	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-pacdec.ads gcc-4.1.0/gcc/ada/i-pacdec.ads
*** gcc-4.0.2/gcc/ada/i-pacdec.ads	Tue Oct 21 13:42:08 2003
--- gcc-4.1.0/gcc/ada/i-pacdec.ads	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-vxwoio.adb gcc-4.1.0/gcc/ada/i-vxwoio.adb
*** gcc-4.0.2/gcc/ada/i-vxwoio.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/i-vxwoio.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 I N T E R F A C E S . V X W O R K S . I O                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --             Copyright (C) 2002, Free Software Foundation, Inc.           --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 I N T E R F A C E S . V X W O R K S . I O                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2002-2005, Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-vxwoio.ads gcc-4.1.0/gcc/ada/i-vxwoio.ads
*** gcc-4.0.2/gcc/ada/i-vxwoio.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/i-vxwoio.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 I N T E R F A C E S . V X W O R K S . I O                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --             Copyright (C) 2002, Free Software Foundation, Inc.           --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 I N T E R F A C E S . V X W O R K S . I O                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 2002-2005, Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/i-vxwork-x86.ads gcc-4.1.0/gcc/ada/i-vxwork-x86.ads
*** gcc-4.0.2/gcc/ada/i-vxwork-x86.ads	Mon Oct  4 15:01:52 2004
--- gcc-4.1.0/gcc/ada/i-vxwork-x86.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                      I N T E R F A C E S . V X W O R K S                 --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --             Copyright (C) 1999-2004 Ada Core Technologies, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                      I N T E R F A C E S . V X W O R K S                 --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 50,56 ****
  with System.VxWorks;
  
  package Interfaces.VxWorks is
!    pragma Preelaborate (VxWorks);
  
     ------------------------------------------------------------------------
     --  Here is a complete example that shows how to handle the Interrupt 0x33
--- 50,56 ----
  with System.VxWorks;
  
  package Interfaces.VxWorks is
!    pragma Preelaborate;
  
     ------------------------------------------------------------------------
     --  Here is a complete example that shows how to handle the Interrupt 0x33
*************** package Interfaces.VxWorks is
*** 137,142 ****
--- 137,146 ----
     --  user handler. The routine generates a wrapper around the user
     --  handler to save and restore context
  
+    function intContext return int;
+    --  Binding to the C routine intContext. This function returns 1 only
+    --  if the current execution state is in interrupt context.
+ 
     function intVecGet
       (Vector : Interrupt_Vector) return VOIDFUNCPTR;
     --  Binding to the C routine intVecGet. Use this to get the
*************** private
*** 200,205 ****
--- 204,210 ----
     --  Target-dependent floating point context type
  
     pragma Import (C, intConnect, "intConnect");
+    pragma Import (C, intContext, "intContext");
     pragma Import (C, intVecGet, "intVecGet");
     pragma Import (C, intVecSet, "intVecSet");
     pragma Import (C, intVecGet2, "intVecGet2");
diff -Nrcpad gcc-4.0.2/gcc/ada/i-vxwork.ads gcc-4.1.0/gcc/ada/i-vxwork.ads
*** gcc-4.0.2/gcc/ada/i-vxwork.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/i-vxwork.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                      I N T E R F A C E S . V X W O R K S                 --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --             Copyright (C) 1999-2003 Ada Core Technologies, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                      I N T E R F A C E S . V X W O R K S                 --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 48,54 ****
  with System.VxWorks;
  
  package Interfaces.VxWorks is
!    pragma Preelaborate (VxWorks);
  
     ------------------------------------------------------------------------
     --  Here is a complete example that shows how to handle the Interrupt 0x14
--- 48,54 ----
  with System.VxWorks;
  
  package Interfaces.VxWorks is
!    pragma Preelaborate;
  
     ------------------------------------------------------------------------
     --  Here is a complete example that shows how to handle the Interrupt 0x14
*************** package Interfaces.VxWorks is
*** 138,143 ****
--- 138,147 ----
     --  user handler. The routine generates a wrapper around the user
     --  handler to save and restore context
  
+    function intContext return int;
+    --  Binding to the C routine intContext. This function returns 1 only
+    --  if the current execution state is in interrupt context.
+ 
     function intVecGet
       (Vector : Interrupt_Vector) return VOIDFUNCPTR;
     --  Binding to the C routine intVecGet. Use this to get the
*************** private
*** 192,197 ****
--- 196,202 ----
     --  Target-dependent floating point context type
  
     pragma Import (C, intConnect, "intConnect");
+    pragma Import (C, intContext, "intContext");
     pragma Import (C, intVecGet, "intVecGet");
     pragma Import (C, intVecSet, "intVecSet");
     pragma Import (C, INUM_TO_IVEC, "__gnat_inum_to_ivec");
diff -Nrcpad gcc-4.0.2/gcc/ada/impunit.adb gcc-4.1.0/gcc/ada/impunit.adb
*** gcc-4.0.2/gcc/ada/impunit.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/impunit.adb	Tue Nov 15 13:58:42 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2000-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Impunit is
*** 157,162 ****
--- 157,169 ----
       "a-tiocst",    -- Ada.Text_IO.C_Streams
       "a-wtcstr",    -- Ada.Wide_Text_IO.C_Streams
  
+       --  Note: strictly the next two should be Ada 2005 units, but it seems
+       --  harmless (and useful) to make then available in Ada 95 mode, since
+       --  they only deal with Wide_Character, not Wide_Wide_Character.
+ 
+      "a-wichun",    -- Ada.Wide_Characters.Unicode
+      "a-widcha",    -- Ada.Wide_Characters
+ 
     ---------------------------
     -- GNAT Special IO Units --
     ---------------------------
*************** package body Impunit is
*** 250,255 ****
--- 257,263 ----
       "g-thread",    -- GNAT.Threads
       "g-traceb",    -- GNAT.Traceback
       "g-trasym",    -- GNAT.Traceback.Symbolic
+      "g-utf_32",    -- GNAT.UTF_32
       "g-wistsp",    -- GNAT.Wide_String_Split
  
     -----------------------------------------------------
*************** package body Impunit is
*** 325,353 ****
       "a-cgaaso",    -- Ada.Containers.Generic_Anonymous_Array_Sort
       "a-cgarso",    -- Ada.Containers.Generic_Array_Sort
       "a-cgcaso",    -- Ada.Containers.Generic_Constrained_Array_Sort
!      "a-chtgke",    -- Ada.Containers.Hash_Tables.Generic_Keys
!      "a-chtgop",    -- Ada.Containers.Hash_Tables.Generic_Operations
       "a-cidlli",    -- Ada.Containers.Indefinite_Doubly_Linked_Lists
       "a-cihama",    -- Ada.Containers.Indefinite_Hashed_Maps
       "a-cihase",    -- Ada.Containers.Indefinite_Hashed_Sets
       "a-ciorma",    -- Ada.Containers.Indefinite_Ordered_Maps
-      "a-ciormu",    -- Ada.Containers.Indefinite_Ordered_Multisets
       "a-ciorse",    -- Ada.Containers.Indefinite_Ordered_Sets
       "a-cohama",    -- Ada.Containers.Hashed_Maps
       "a-cohase",    -- Ada.Containers.Hashed_Sets
-      "a-cohata",    -- Ada.Containers.Hash_Tables
       "a-coinve",    -- Ada.Containers.Indefinite_Vectors
       "a-contai",    -- Ada.Containers
       "a-convec",    -- Ada.Containers.Vectors
       "a-coorma",    -- Ada.Containers.Ordered_Maps
-      "a-coormu",    -- Ada.Containers.Ordered_Multisets
       "a-coorse",    -- Ada.Containers.Ordered_Sets
-      "a-coprnu",    -- Ada.Containers.Prime_Numbers
-      "a-crbltr",    -- Ada.Containers.Red_Black_Trees
-      "a-crbtgk",    -- Ada.Containers.Red_Black_Trees.Generic_Keys
-      "a-crbtgo",    -- Ada.Containers.Red_Black_Trees.Generic_Operations
       "a-direct",    -- Ada.Directories
-      "a-rbtgso",    -- Ada.Containers.Red_Black_Trees.Generic_Set_Operations
       "a-secain",    -- Ada.Strings.Equal_Case_Insensitive
       "a-shcain",    -- Ada.Strings.Hash_Case_Insensitive
       "a-slcain",    -- Ada.Strings.Less_Case_Insensitive
--- 333,352 ----
       "a-cgaaso",    -- Ada.Containers.Generic_Anonymous_Array_Sort
       "a-cgarso",    -- Ada.Containers.Generic_Array_Sort
       "a-cgcaso",    -- Ada.Containers.Generic_Constrained_Array_Sort
!      "a-chacon",    -- Ada.Characters.Conversions
       "a-cidlli",    -- Ada.Containers.Indefinite_Doubly_Linked_Lists
       "a-cihama",    -- Ada.Containers.Indefinite_Hashed_Maps
       "a-cihase",    -- Ada.Containers.Indefinite_Hashed_Sets
       "a-ciorma",    -- Ada.Containers.Indefinite_Ordered_Maps
       "a-ciorse",    -- Ada.Containers.Indefinite_Ordered_Sets
       "a-cohama",    -- Ada.Containers.Hashed_Maps
       "a-cohase",    -- Ada.Containers.Hashed_Sets
       "a-coinve",    -- Ada.Containers.Indefinite_Vectors
       "a-contai",    -- Ada.Containers
       "a-convec",    -- Ada.Containers.Vectors
       "a-coorma",    -- Ada.Containers.Ordered_Maps
       "a-coorse",    -- Ada.Containers.Ordered_Sets
       "a-direct",    -- Ada.Directories
       "a-secain",    -- Ada.Strings.Equal_Case_Insensitive
       "a-shcain",    -- Ada.Strings.Hash_Case_Insensitive
       "a-slcain",    -- Ada.Strings.Less_Case_Insensitive
*************** package body Impunit is
*** 359,369 ****
       "a-stzhas",    -- Ada.Strings.Wide_Wide_Hash
       "a-stzmap",    -- Ada.Strings.Wide_Wide_Maps
       "a-stzunb",    -- Ada.Strings.Wide_Wide_Unbounded
!      "a-swunha",    -- Ada.Strings.Wide_Unbounded.Hash
       "a-szmzco",    -- Ada.Strings.Wide_Wide_Maps.Wide_Wide_Constants;
!      "a-szunha",    -- Ada.Strings.Wide_Wide_Unbounded.Hash
       "a-tiunio",    -- Ada.Text_IO.Unbounded_IO;
       "a-wwunio",    -- Ada.Wide_Text_IO.Wide_Unbounded_IO;
       "a-zttest",    -- Ada.Wide_Wide_Text_IO.Text_Streams
       "a-ztexio",    -- Ada.Wide_Wide_Text_IO
       "a-zzunio",    -- Ada.Wide_Wide_Text_IO.Wide_Wide_Unbounded_IO
--- 358,371 ----
       "a-stzhas",    -- Ada.Strings.Wide_Wide_Hash
       "a-stzmap",    -- Ada.Strings.Wide_Wide_Maps
       "a-stzunb",    -- Ada.Strings.Wide_Wide_Unbounded
!      "a-swuwha",    -- Ada.Strings.Wide_Unbounded.Wide_Hash
       "a-szmzco",    -- Ada.Strings.Wide_Wide_Maps.Wide_Wide_Constants;
!      "a-szuzha",    -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
!      "a-tgdico",    -- Ada.Tags.Generic_Dispatching_Constructor;
       "a-tiunio",    -- Ada.Text_IO.Unbounded_IO;
+      "a-wichun",    -- Ada.Wide_Characters.Unicode
       "a-wwunio",    -- Ada.Wide_Text_IO.Wide_Unbounded_IO;
+      "a-zchara",    -- Ada.Wide_Wide_Characters
       "a-zttest",    -- Ada.Wide_Wide_Text_IO.Text_Streams
       "a-ztexio",    -- Ada.Wide_Wide_Text_IO
       "a-zzunio",    -- Ada.Wide_Wide_Text_IO.Wide_Wide_Unbounded_IO
*************** package body Impunit is
*** 387,393 ****
--- 389,398 ----
  
       "a-chzla1",    -- Ada.Characters.Wide_Wide_Latin_1
       "a-chzla9",    -- Ada.Characters.Wide_Wide_Latin_9
+      "a-ciormu",    -- Ada.Containers.Indefinite_Ordered_Multisets
+      "a-coormu",    -- Ada.Containers.Ordered_Multisets
       "a-szuzti",    -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO
+      "a-zchuni",    -- Ada.Wide_Wide_Characters.Unicode
  
     ---------------------------
     -- GNAT Special IO Units --
diff -Nrcpad gcc-4.0.2/gcc/ada/impunit.ads gcc-4.1.0/gcc/ada/impunit.ads
*** gcc-4.0.2/gcc/ada/impunit.ads	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/impunit.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw-aix.adb gcc-4.1.0/gcc/ada/indepsw-aix.adb
*** gcc-4.0.2/gcc/ada/indepsw-aix.adb	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/indepsw-aix.adb	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw-gnu.adb gcc-4.1.0/gcc/ada/indepsw-gnu.adb
*** gcc-4.0.2/gcc/ada/indepsw-gnu.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/indepsw-gnu.adb	Mon Jul  4 13:28:28 2005
***************
*** 0 ****
--- 1,69 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                              I N D E P S W                               --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                              (GNU version)                               --
+ --                                                                          --
+ --            Copyright (C) 2005 Free Software Foundation, Inc.             --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This is the GNU ld version
+ 
+ package body Indepsw is
+ 
+    Map_Switch : aliased constant String := "-Wl,-Map,";
+ 
+    -------------
+    -- Convert --
+    -------------
+ 
+    procedure Convert
+      (Switch   : Switch_Kind;
+       Argument : String;
+       To       : out String_List_Access)
+    is
+    begin
+       case Switch is
+          when Map_File =>
+             To := new Argument_List'(1 => new String'(Map_Switch & Argument));
+       end case;
+    end Convert;
+ 
+    ------------------
+    -- Is_Supported --
+    ------------------
+ 
+    function Is_Supported (Switch : Switch_Kind) return Boolean is
+    begin
+       case Switch is
+          when Map_File =>
+             return True;
+       end case;
+    end Is_Supported;
+ 
+ end Indepsw;
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw-linux.adb gcc-4.1.0/gcc/ada/indepsw-linux.adb
*** gcc-4.0.2/gcc/ada/indepsw-linux.adb	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/indepsw-linux.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,69 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT COMPILER COMPONENTS                         --
- --                                                                          --
- --                              I N D E P S W                               --
- --                                                                          --
- --                                 B o d y                                  --
- --                            (GNU/Linux version)                           --
- --                                                                          --
- --            Copyright (C) 2004 Free Software Foundation, Inc.             --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is the GNU/Linux version
- 
- package body Indepsw is
- 
-    Map_Switch : aliased constant String := "-Wl,-Map,";
- 
-    -------------
-    -- Convert --
-    -------------
- 
-    procedure Convert
-      (Switch   : Switch_Kind;
-       Argument : String;
-       To       : out String_List_Access)
-    is
-    begin
-       case Switch is
-          when Map_File =>
-             To := new Argument_List'(1 => new String'(Map_Switch & Argument));
-       end case;
-    end Convert;
- 
-    ------------------
-    -- Is_Supported --
-    ------------------
- 
-    function Is_Supported (Switch : Switch_Kind) return Boolean is
-    begin
-       case Switch is
-          when Map_File =>
-             return True;
-       end case;
-    end Is_Supported;
- 
- end Indepsw;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw-mingw.adb gcc-4.1.0/gcc/ada/indepsw-mingw.adb
*** gcc-4.0.2/gcc/ada/indepsw-mingw.adb	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/indepsw-mingw.adb	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw.adb gcc-4.1.0/gcc/ada/indepsw.adb
*** gcc-4.0.2/gcc/ada/indepsw.adb	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/indepsw.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/indepsw.ads gcc-4.1.0/gcc/ada/indepsw.ads
*** gcc-4.0.2/gcc/ada/indepsw.ads	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/indepsw.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Indepsw is
*** 56,62 ****
     --  for the platform; in this case, To is set to null.
  
     function Is_Supported (Switch : Switch_Kind) return Boolean;
!    --  Return True for each independent switch supported by the platform.
  
  private
     --  Default warning messages when the switches are not supported by the
--- 56,62 ----
     --  for the platform; in this case, To is set to null.
  
     function Is_Supported (Switch : Switch_Kind) return Boolean;
!    --  Return True for each independent switch supported by the platform
  
  private
     --  Default warning messages when the switches are not supported by the
diff -Nrcpad gcc-4.0.2/gcc/ada/init.c gcc-4.1.0/gcc/ada/init.c
*** gcc-4.0.2/gcc/ada/init.c	Thu Feb 10 15:43:53 2005
--- gcc-4.1.0/gcc/ada/init.c	Tue Nov 15 14:00:00 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 39,47 ****
      installed by this file are used to handle resulting signals that come
      from these probes failing (i.e. touching protected pages) */
  
! /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb, and
!    5zinit.adb. All these files implement the required functionality for
!    different targets. */
  
  /* The following include is here to meet the published VxWorks requirement
     that the __vxworks header appear before any other include. */
--- 39,47 ----
      installed by this file are used to handle resulting signals that come
      from these probes failing (i.e. touching protected pages) */
  
! /* This file should be kept synchronized with 2sinit.ads, 2sinit.adb,
!    s-init-ae653-cert.adb and s-init-xi-sparc.adb. All these files implement
!    the required functionality for different targets. */
  
  /* The following include is here to meet the published VxWorks requirement
     that the __vxworks header appear before any other include. */
*************** extern void (*Lock_Task) (void);
*** 80,89 ****
  #define Unlock_Task system__soft_links__unlock_task
  extern void (*Unlock_Task) (void);
  
- #define Get_Machine_State_Addr \
-                       system__soft_links__get_machine_state_addr
- extern struct Machine_State *(*Get_Machine_State_Addr) (void);
- 
  #define Check_Abort_Status     \
                        system__soft_links__check_abort_status
  extern int (*Check_Abort_Status) (void);
--- 80,85 ----
*************** extern int (*Check_Abort_Status) (void);
*** 92,103 ****
                        ada__exceptions__raise_from_signal_handler
  extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
  
- #define Propagate_Signal_Exception \
-                       __gnat_propagate_sig_exc
- extern void Propagate_Signal_Exception (struct Machine_State *,
-                                         struct Exception_Data *,
-                                         const char *);
- 
  /* Copies of global values computed by the binder */
  int   __gl_main_priority            = -1;
  int   __gl_time_slice_val           = -1;
--- 88,93 ----
*************** int   __gl_detect_blocking          = 0;
*** 117,122 ****
--- 107,118 ----
     installed by a previous call to adainit */
  int  __gnat_handler_installed      = 0;
  
+ #ifndef IN_RTS
+ int __gnat_inside_elab_final_code = 0;
+ /* ??? This variable is obsolete since 2001-08-29 but is kept to allow
+    bootstrap from old GNAT versions (< 3.15). */
+ #endif
+ 
  /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
     is defined. If this is not set them a void implementation will be defined
     at the end of this unit. */
*************** __gnat_set_globals (int main_priority,
*** 256,270 ****
  #endif
  }
  
- /*********************/
- /* __gnat_initialize */
- /*********************/
- 
- /* __gnat_initialize is called at the start of execution of an Ada program
-    (the call is generated by the binder). The standard routine does nothing
-    at all; the intention is that this be replaced by system specific
-    code where initialization is required. */
- 
  /* Notes on the Zero Cost Exceptions scheme and its impact on the signal
     handlers implemented below :
  
--- 252,257 ----
*************** __gnat_set_globals (int main_priority,
*** 277,286 ****
     call chain. To evaluate if a handler applies at some point in this chain,
     the propagation engine needs to determine what region the corresponding
     call instruction pertains to. The return address may not be attached to the
!    same region as the call, so the unwinder unconditionally substracts "some"
     amount to the return addresses it gets to search the region tables. The
     exact amount is computed to ensure that the resulting address is inside the
!    call instruction, and is thus target dependant (think about delay slots for
     instance).
  
     When we raise an exception from a signal handler, e.g. to transform a
--- 264,273 ----
     call chain. To evaluate if a handler applies at some point in this chain,
     the propagation engine needs to determine what region the corresponding
     call instruction pertains to. The return address may not be attached to the
!    same region as the call, so the unwinder unconditionally subtracts "some"
     amount to the return addresses it gets to search the region tables. The
     exact amount is computed to ensure that the resulting address is inside the
!    call instruction, and is thus target dependent (think about delay slots for
     instance).
  
     When we raise an exception from a signal handler, e.g. to transform a
*************** __gnat_set_globals (int main_priority,
*** 291,297 ****
     as the faulting instruction address in the corresponding signal context
     pushed by the kernel. Leaving this address untouched may loose, because if
     the triggering instruction happens to be the very first of a region, the
!    later adjustements performed by the unwinder would yield an address outside
     that region. We need to compensate for those adjustments at some point,
     which we currently do in the GCC unwinding fallback macro.
  
--- 278,284 ----
     as the faulting instruction address in the corresponding signal context
     pushed by the kernel. Leaving this address untouched may loose, because if
     the triggering instruction happens to be the very first of a region, the
!    later adjustments performed by the unwinder would yield an address outside
     that region. We need to compensate for those adjustments at some point,
     which we currently do in the GCC unwinding fallback macro.
  
*************** __gnat_set_globals (int main_priority,
*** 310,318 ****
     of subtleties to account for.  See for instance the syscall(SYS_sigaction)
     story in libjava/include/i386-signal.h.  */
  
! /***********************************/
! /* __gnat_initialize (AIX Version) */
! /***********************************/
  
  #if defined (_AIX)
  
--- 297,305 ----
     of subtleties to account for.  See for instance the syscall(SYS_sigaction)
     story in libjava/include/i386-signal.h.  */
  
! /***************/
! /* AIX Section */
! /***************/
  
  #if defined (_AIX)
  
*************** __gnat_install_handler (void)
*** 402,455 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /***************************************/
! /* __gnat_initialize (RTEMS version) */
! /***************************************/
! 
! #elif defined(__rtems__)
! 
! extern void __gnat_install_handler (void);
! 
! /* For RTEMS, each bsp will provide a custom __gnat_install_handler (). */
! 
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
!    __gnat_install_handler ();
! }
! 
! /****************************************/
! /* __gnat_initialize (Dec Unix Version) */
! /****************************************/
! 
! #elif defined(__alpha__) && defined(__osf__) && ! defined(__alpha_vxworks)
  
! /* Note: it seems that __osf__ is defined for the Alpha VXWorks case. Not
!    clear that this is reasonable, but in any case we have to be sure to
!    exclude this case in the above test.  */
  
  #include <signal.h>
  #include <sys/siginfo.h>
  
  static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
  extern char *__gnat_get_code_loc (struct sigcontext *);
! extern void __gnat_enter_handler (struct sigcontext *, char *);
  extern size_t __gnat_machine_state_length (void);
  
- extern long exc_lookup_gp (char *);
- extern void exc_resume (struct sigcontext *);
- 
  static void
! __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
  {
    struct Exception_Data *exception;
    static int recurse = 0;
-   struct sigcontext *mstate;
    const char *msg;
  
    /* If this was an explicit signal from a "kill", just resignal it.  */
--- 389,414 ----
    __gnat_handler_installed = 1;
  }
  
! /*****************/
! /* Tru64 section */
! /*****************/
  
! #elif defined(__alpha__) && defined(__osf__)
  
  #include <signal.h>
  #include <sys/siginfo.h>
  
  static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
  extern char *__gnat_get_code_loc (struct sigcontext *);
! extern void __gnat_set_code_loc (struct sigcontext *, char *);
  extern size_t __gnat_machine_state_length (void);
  
  static void
! __gnat_error_handler
!   (int sig, siginfo_t *sip, struct sigcontext *context ATTRIBUTE_UNUSED)
  {
    struct Exception_Data *exception;
    static int recurse = 0;
    const char *msg;
  
    /* If this was an explicit signal from a "kill", just resignal it.  */
*************** __gnat_error_handler (int sig, siginfo_t
*** 507,516 ****
      }
  
    recurse = 0;
-   mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
-   if (mstate != 0)
-     *mstate = *context;
- 
    Raise_From_Signal_Handler (exception, (char *) msg);
  }
  
--- 466,471 ----
*************** __gnat_install_handler (void)
*** 542,553 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /* Routines called by 5amastop.adb.  */
  
  #define SC_GP 29
  
--- 497,503 ----
    __gnat_handler_installed = 1;
  }
  
! /* Routines called by s-mastop-tru64.adb.  */
  
  #define SC_GP 29
  
*************** __gnat_get_code_loc (struct sigcontext *
*** 558,591 ****
  }
  
  void
! __gnat_enter_handler ( struct sigcontext *context, char *pc)
  {
    context->sc_pc = (long) pc;
-   context->sc_regs[SC_GP] = exc_lookup_gp (pc);
-   exc_resume (context);
  }
  
  size_t
  __gnat_machine_state_length (void)
  {
    return sizeof (struct sigcontext);
  }
  
! /************************************/
! /* __gnat_initialize (HPUX Version) */
! /************************************/
  
! #elif defined (__hpux__)
  
  #include <signal.h>
  
! static void __gnat_error_handler (int);
  
  static void
! __gnat_error_handler (int sig)
  {
    struct Exception_Data *exception;
!   char *msg;
  
    switch (sig)
      {
--- 508,559 ----
  }
  
  void
! __gnat_set_code_loc (struct sigcontext *context, char *pc)
  {
    context->sc_pc = (long) pc;
  }
  
+ 
  size_t
  __gnat_machine_state_length (void)
  {
    return sizeof (struct sigcontext);
  }
  
! /********************/
! /* PA HP-UX section */
! /********************/
  
! #elif defined (__hppa__) && defined (__hpux__)
  
  #include <signal.h>
+ #include <sys/ucontext.h>
  
! static void
! __gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext);
! 
! /* __gnat_adjust_context_for_raise - see comments along with the default
!    version later in this file.  */
! 
! #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
! 
! void
! __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
! {
!   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
! 
!   if (UseWideRegs (mcontext))
!     mcontext->ss_wide.ss_32.ss_pcoq_head_lo ++;
!   else
!     mcontext->ss_narrow.ss_pcoq_head ++;
! }
  
  static void
! __gnat_error_handler
!   (int sig, siginfo_t *siginfo ATTRIBUTE_UNUSED, void *ucontext)
  {
    struct Exception_Data *exception;
!   const char *msg;
  
    switch (sig)
      {
*************** __gnat_error_handler (int sig)
*** 610,615 ****
--- 578,585 ----
        msg = "unhandled signal";
      }
  
+   __gnat_adjust_context_for_raise (sig, ucontext);
+ 
    Raise_From_Signal_Handler (exception, msg);
  }
  
*************** __gnat_install_handler (void)
*** 637,644 ****
  
    sigaltstack (&stack, NULL);
  
!   act.sa_handler = __gnat_error_handler;
!   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK;
    sigemptyset (&act.sa_mask);
  
    /* Do not install handlers if interrupt state is "System" */
--- 607,614 ----
  
    sigaltstack (&stack, NULL);
  
!   act.sa_sigaction = __gnat_error_handler;
!   act.sa_flags = SA_NODEFER | SA_RESTART | SA_ONSTACK | SA_SIGINFO;
    sigemptyset (&act.sa_mask);
  
    /* Do not install handlers if interrupt state is "System" */
*************** __gnat_install_handler (void)
*** 656,674 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /*****************************************/
! /* __gnat_initialize (GNU/Linux Version) */
! /*****************************************/
  
! #elif defined (linux) && defined (i386) && !defined (__RT__)
  
  #include <signal.h>
! #include <asm/sigcontext.h>
  
  /* GNU/Linux, which uses glibc, does not define NULL in included
     header files */
--- 626,642 ----
    __gnat_handler_installed = 1;
  }
  
! /*********************/
! /* GNU/Linux Section */
! /*********************/
  
! #elif defined (linux) && (defined (i386) || defined (__x86_64__) \
!                           || defined (__ia64__))
  
  #include <signal.h>
! 
! #define __USE_GNU 1 /* required to get REG_EIP/RIP from glibc's ucontext.h */
! #include <sys/ucontext.h>
  
  /* GNU/Linux, which uses glibc, does not define NULL in included
     header files */
*************** __gnat_initialize (void *eh ATTRIBUTE_UN
*** 677,711 ****
  #define NULL ((void *) 0)
  #endif
  
! struct Machine_State
  {
!   unsigned long eip;
!   unsigned long ebx;
!   unsigned long esp;
!   unsigned long ebp;
!   unsigned long esi;
!   unsigned long edi;
! };
  
! static void __gnat_error_handler (int);
  
  static void
! __gnat_error_handler (int sig)
  {
    struct Exception_Data *exception;
    const char *msg;
    static int recurse = 0;
  
-   struct sigcontext *info
-     = (struct sigcontext *) (((char *) &sig) + sizeof (int));
- 
-   /* The Linux kernel does not document how to get the machine state in a
-      signal handler, but in fact the necessary data is in a sigcontext_struct
-      value that is on the stack immediately above the signal number
-      parameter, and the above messing accesses this value on the stack. */
- 
-   struct Machine_State *mstate;
- 
    switch (sig)
      {
      case SIGSEGV:
--- 645,680 ----
  #define NULL ((void *) 0)
  #endif
  
! static void __gnat_error_handler (int, siginfo_t *siginfo, void *ucontext);
! 
! /* __gnat_adjust_context_for_raise - see comments along with the default
!    version later in this file.  */
! 
! #define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
! 
! void
! __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
  {
!   mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
  
! #if defined (i386)
!   mcontext->gregs[REG_EIP]++;
! #elif defined (__x86_64__)
!   mcontext->gregs[REG_RIP]++;
! #elif defined (__ia64__)
!   mcontext->sc_ip++;
! #endif
! }
  
  static void
! __gnat_error_handler (int sig,
!                       siginfo_t *siginfo ATTRIBUTE_UNUSED,
!                       void *ucontext)
  {
    struct Exception_Data *exception;
    const char *msg;
    static int recurse = 0;
  
    switch (sig)
      {
      case SIGSEGV:
*************** __gnat_error_handler (int sig)
*** 761,779 ****
        exception = &program_error;
        msg = "unhandled signal";
      }
  
!   mstate = (*Get_Machine_State_Addr) ();
!   if (mstate)
!     {
!       mstate->eip = info->eip;
!       mstate->ebx = info->ebx;
!       mstate->esp = info->esp_at_signal;
!       mstate->ebp = info->ebp;
!       mstate->esi = info->esi;
!       mstate->edi = info->edi;
!     }
  
-   recurse = 0;
    Raise_From_Signal_Handler (exception, msg);
  }
  
--- 730,744 ----
        exception = &program_error;
        msg = "unhandled signal";
      }
+   recurse = 0;
  
!   /* We adjust the interrupted context here (and not in the
!      MD_FALLBACK_FRAME_STATE_FOR macro) because recent versions of the Native
!      POSIX Thread Library (NPTL) are compiled with DWARF 2 unwind information,
!      and hence the later macro is never executed for signal frames. */
! 
!   __gnat_adjust_context_for_raise (sig, ucontext);
  
    Raise_From_Signal_Handler (exception, msg);
  }
  
*************** __gnat_install_handler (void)
*** 786,793 ****
       exceptions.  Make sure that the handler isn't interrupted by another
       signal that might cause a scheduling event! */
  
!   act.sa_handler = __gnat_error_handler;
!   act.sa_flags = SA_NODEFER | SA_RESTART;
    sigemptyset (&act.sa_mask);
  
    /* Do not install handlers if interrupt state is "System" */
--- 751,758 ----
       exceptions.  Make sure that the handler isn't interrupted by another
       signal that might cause a scheduling event! */
  
!   act.sa_sigaction = __gnat_error_handler;
!   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
    sigemptyset (&act.sa_mask);
  
    /* Do not install handlers if interrupt state is "System" */
*************** __gnat_install_handler (void)
*** 805,848 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /******************************************/
! /* __gnat_initialize (NT-mingw32 Version) */
! /******************************************/
! 
! #elif defined (__MINGW32__)
! #include <windows.h>
! 
! void
! __gnat_install_handler (void)
! {
! }
! 
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
!    /* Initialize floating-point coprocessor. This call is needed because
!       the MS libraries default to 64-bit precision instead of 80-bit
!       precision, and we require the full precision for proper operation,
!       given that we have set Max_Digits etc with this in mind */
!    __gnat_init_float ();
! 
!    /* Initialize a lock for a process handle list - see a-adaint.c for the
!       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
!    __gnat_plist_init();
! 
!    /* Install the Structured Exception handler.  */
!    if (eh)
!      __gnat_install_SEH_handler (eh);
! }
! 
! /***************************************/
! /* __gnat_initialize (Interix Version) */
! /***************************************/
  
  #elif defined (__INTERIX)
  
--- 770,778 ----
    __gnat_handler_installed = 1;
  }
  
! /*******************/
! /* Interix Section */
! /*******************/
  
  #elif defined (__INTERIX)
  
*************** static void
*** 854,860 ****
  __gnat_error_handler (int sig)
  {
    struct Exception_Data *exception;
!   char *msg;
  
    switch (sig)
      {
--- 784,790 ----
  __gnat_error_handler (int sig)
  {
    struct Exception_Data *exception;
!   const char *msg;
  
    switch (sig)
      {
*************** __gnat_install_handler (void)
*** 907,964 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
!    __gnat_init_float ();
! }
! 
! /**************************************/
! /* __gnat_initialize (LynxOS Version) */
! /**************************************/
! 
! #elif defined (__Lynx__)
! 
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
!    __gnat_init_float ();
! }
! 
! /*********************************/
! /* __gnat_install_handler (Lynx) */
! /*********************************/
! 
! void
! __gnat_install_handler (void)
! {
!   __gnat_handler_installed = 1;
! }
! 
! /****************************/
! /* __gnat_initialize (OS/2) */
! /****************************/
! 
! #elif defined (__EMX__) /* OS/2 dependent initialization */
! 
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /*********************************/
! /* __gnat_install_handler (OS/2) */
! /*********************************/
! 
! void
! __gnat_install_handler (void)
! {
!   __gnat_handler_installed = 1;
! }
! 
! /***********************************/
! /* __gnat_initialize (SGI Version) */
! /***********************************/
  
  #elif defined (sgi)
  
--- 837,845 ----
    __gnat_handler_installed = 1;
  }
  
! /****************/
! /* IRIX Section */
! /****************/
  
  #elif defined (sgi)
  
*************** __gnat_install_handler (void)
*** 973,983 ****
  #define SIGNAL_STACK_SIZE 4096
  #define SIGNAL_STACK_ALIGNMENT 64
  
- struct Machine_State
- {
-   sigcontext_t context;
- };
- 
  static void __gnat_error_handler (int, int, sigcontext_t *);
  
  /* We are not setting the SA_SIGINFO bit in the sigaction flags when
--- 854,859 ----
*************** static void __gnat_error_handler (int, i
*** 993,1001 ****
  */
  
  static void
! __gnat_error_handler (int sig, int code, sigcontext_t *sc)
  {
-   struct Machine_State  *mstate;
    struct Exception_Data *exception;
    const char *msg;
  
--- 869,876 ----
  */
  
  static void
! __gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
  {
    struct Exception_Data *exception;
    const char *msg;
  
*************** __gnat_error_handler (int sig, int code,
*** 1070,1079 ****
        msg = "unhandled signal";
      }
  
-   mstate = (*Get_Machine_State_Addr) ();
-   if (mstate != 0)
-     memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
- 
    Raise_From_Signal_Handler (exception, msg);
  }
  
--- 945,950 ----
*************** __gnat_install_handler (void)
*** 1108,1121 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /*************************************************/
! /* __gnat_initialize (Solaris and SunOS Version) */
! /*************************************************/
  
  #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
  
--- 979,987 ----
    __gnat_handler_installed = 1;
  }
  
! /*******************/
! /* Solaris Section */
! /*******************/
  
  #elif defined (sun) && defined (__SVR4) && !defined (__vxworks)
  
*************** __gnat_install_handler (void)
*** 1216,1232 ****
    __gnat_handler_installed = 1;
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
! 
! /***********************************/
! /* __gnat_initialize (VMS Version) */
! /***********************************/
  
  #elif defined (VMS)
  
  #ifdef __IA64
  #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
  #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
--- 1082,1095 ----
    __gnat_handler_installed = 1;
  }
  
! /***************/
! /* VMS Section */
! /***************/
  
  #elif defined (VMS)
  
+ long __gnat_error_handler (int *, void *);
+ 
  #ifdef __IA64
  #define lib_get_curr_invo_context LIB$I64_GET_CURR_INVO_CONTEXT
  #define lib_get_prev_invo_context LIB$I64_GET_PREV_INVO_CONTEXT
*************** extern long __gnat_error_prehandler (voi
*** 1246,1257 ****
--- 1109,1177 ----
  extern char *__gnat_error_prehandler_stack;   /* Alternate signal stack */
  #endif
  
+ /* Define macro symbols for the VMS conditions that become Ada exceptions.
+    Most of these are also defined in the header file ssdef.h which has not
+    yet been converted to be recognized by Gnu C. */
+ 
+ /* Defining these as macros, as opposed to external addresses, allows
+    them to be used in a case statement (below */
+ #define SS$_ACCVIO            12
+ #define SS$_HPARITH         1284
+ #define SS$_STKOVF          1364
+ #define SS$_RESIGNAL        2328
+ 
+ /* These codes are in standard message libraries */
+ extern int CMA$_EXIT_THREAD;
+ extern int SS$_DEBUG;
+ extern int SS$_INTDIV;
+ extern int LIB$_KEYNOTFOU;
+ extern int LIB$_ACTIMAGE;
+ extern int MTH$_FLOOVEMAT;       /* Some ACVC_21 CXA tests */
+ 
+ /* These codes are non standard, which is to say the author is
+    not sure if they are defined in the standard message libraries
+    so keep them as macros for now. */
+ #define RDB$_STREAM_EOF 20480426
+ #define FDL$_UNPRIKW 11829410
+ 
+ struct cond_except {
+   const int *cond;
+   const struct Exception_Data *except;
+ };
+ 
+ struct descriptor_s {unsigned short len, mbz; __char_ptr32 adr; };
+ 
  /* Conditions that don't have an Ada exception counterpart must raise
     Non_Ada_Error.  Since this is defined in s-auxdec, it should only be
     referenced by user programs, not the compiler or tools. Hence the
     #ifdef IN_RTS. */
  
  #ifdef IN_RTS
+ 
+ #define Status_Error ada__io_exceptions__status_error
+ extern struct Exception_Data Status_Error;
+ 
+ #define Mode_Error ada__io_exceptions__mode_error
+ extern struct Exception_Data Mode_Error;
+ 
+ #define Name_Error ada__io_exceptions__name_error
+ extern struct Exception_Data Name_Error;
+ 
+ #define Use_Error ada__io_exceptions__use_error
+ extern struct Exception_Data Use_Error;
+ 
+ #define Device_Error ada__io_exceptions__device_error
+ extern struct Exception_Data Device_Error;
+ 
+ #define End_Error ada__io_exceptions__end_error
+ extern struct Exception_Data End_Error;
+ 
+ #define Data_Error ada__io_exceptions__data_error
+ extern struct Exception_Data Data_Error;
+ 
+ #define Layout_Error ada__io_exceptions__layout_error
+ extern struct Exception_Data Layout_Error;
+ 
  #define Non_Ada_Error system__aux_dec__non_ada_error
  extern struct Exception_Data Non_Ada_Error;
  
*************** extern struct Exception_Data *Coded_Exce
*** 1260,1330 ****
  
  #define Base_Code_In system__vms_exception_table__base_code_in
  extern Exception_Code Base_Code_In (Exception_Code);
  #endif
  
! /* Define macro symbols for the VMS conditions that become Ada exceptions.
!    Most of these are also defined in the header file ssdef.h which has not
!    yet been converted to be recoginized by Gnu C. Some, which couldn't be
!    located, are assigned names based on the DEC test suite tests which
!    raise them. */
  
! #define SS$_ACCVIO            12
! #define SS$_DEBUG           1132
! #define SS$_INTDIV          1156
! #define SS$_HPARITH         1284
! #define SS$_STKOVF          1364
! #define SS$_RESIGNAL        2328
! #define MTH$_FLOOVEMAT   1475268       /* Some ACVC_21 CXA tests */
! #define SS$_CE24VRU      3253636       /* Write to unopened file */
! #define SS$_C980VTE      3246436       /* AST requests time slice */
! #define CMA$_EXIT_THREAD 4227492
! #define CMA$_EXCCOPLOS   4228108
! #define CMA$_ALERTED     4227460
  
! struct descriptor_s {unsigned short len, mbz; char *adr; };
  
! long __gnat_error_handler (int *, void *);
  
! long
! __gnat_error_handler (int *sigargs, void *mechargs)
  {
!   struct Exception_Data *exception = 0;
!   Exception_Code base_code;
  
!   char *msg = "";
!   char message[256];
!   long prvhnd;
!   struct descriptor_s msgdesc;
!   int msg_flag = 0x000f; /* 1 bit for each of the four message parts */
!   unsigned short outlen;
!   char curr_icb[544];
!   long curr_invo_handle;
!   long *mstate;
  
!   /* Resignaled condtions aren't effected by by pragma Import_Exception */
  
!   switch (sigargs[1])
!   {
  
!     case CMA$_EXIT_THREAD:
!       return SS$_RESIGNAL;
  
!     case SS$_DEBUG: /* Gdb attach, resignal to merge activate gdbstub. */
!       return SS$_RESIGNAL;
  
!     case 1409786: /* Nickerson bug #33 ??? */
!       return SS$_RESIGNAL;
  
!     case 1381050: /* Nickerson bug #33 ??? */
!       return SS$_RESIGNAL;
  
!     case 20480426: /* RDB-E-STREAM_EOF */
!       return SS$_RESIGNAL;
  
!     case 11829410: /* Resignalled as Use_Error for CE10VRC */
!       return SS$_RESIGNAL;
  
!   }
  
  #ifdef IN_RTS
    /* See if it's an imported exception. Beware that registered exceptions
--- 1180,1391 ----
  
  #define Base_Code_In system__vms_exception_table__base_code_in
  extern Exception_Code Base_Code_In (Exception_Code);
+ 
+ /* DEC Ada exceptions are not defined in a header file, so they
+    must be declared as external addresses */
+ 
+ extern int ADA$_PROGRAM_ERROR __attribute__ ((weak));
+ extern int ADA$_LOCK_ERROR __attribute__ ((weak));
+ extern int ADA$_EXISTENCE_ERROR __attribute__ ((weak));
+ extern int ADA$_KEY_ERROR __attribute__ ((weak));
+ extern int ADA$_KEYSIZERR __attribute__ ((weak));
+ extern int ADA$_STAOVF __attribute__ ((weak));
+ extern int ADA$_CONSTRAINT_ERRO __attribute__ ((weak));
+ extern int ADA$_IOSYSFAILED __attribute__ ((weak));
+ extern int ADA$_LAYOUT_ERROR __attribute__ ((weak));
+ extern int ADA$_STORAGE_ERROR __attribute__ ((weak));
+ extern int ADA$_DATA_ERROR __attribute__ ((weak));
+ extern int ADA$_DEVICE_ERROR __attribute__ ((weak));
+ extern int ADA$_END_ERROR __attribute__ ((weak));
+ extern int ADA$_MODE_ERROR __attribute__ ((weak));
+ extern int ADA$_NAME_ERROR __attribute__ ((weak));
+ extern int ADA$_STATUS_ERROR __attribute__ ((weak));
+ extern int ADA$_NOT_OPEN __attribute__ ((weak));
+ extern int ADA$_ALREADY_OPEN __attribute__ ((weak));
+ extern int ADA$_USE_ERROR __attribute__ ((weak));
+ extern int ADA$_UNSUPPORTED __attribute__ ((weak));
+ extern int ADA$_FAC_MODE_MISMAT __attribute__ ((weak));
+ extern int ADA$_ORG_MISMATCH __attribute__ ((weak));
+ extern int ADA$_RFM_MISMATCH __attribute__ ((weak));
+ extern int ADA$_RAT_MISMATCH __attribute__ ((weak));
+ extern int ADA$_MRS_MISMATCH __attribute__ ((weak));
+ extern int ADA$_MRN_MISMATCH __attribute__ ((weak));
+ extern int ADA$_KEY_MISMATCH __attribute__ ((weak));
+ extern int ADA$_MAXLINEXC __attribute__ ((weak));
+ extern int ADA$_LINEXCMRS __attribute__ ((weak));
+ 
+ /* DEC Ada specific conditions */
+ static const struct cond_except dec_ada_cond_except_table [] = {
+   {&ADA$_PROGRAM_ERROR,   &program_error},
+   {&ADA$_USE_ERROR,       &Use_Error},
+   {&ADA$_KEYSIZERR,       &program_error},
+   {&ADA$_STAOVF,          &storage_error},
+   {&ADA$_CONSTRAINT_ERRO, &constraint_error},
+   {&ADA$_IOSYSFAILED,     &Device_Error},
+   {&ADA$_LAYOUT_ERROR,    &Layout_Error},
+   {&ADA$_STORAGE_ERROR,   &storage_error},
+   {&ADA$_DATA_ERROR,      &Data_Error},
+   {&ADA$_DEVICE_ERROR,    &Device_Error},
+   {&ADA$_END_ERROR,       &End_Error},
+   {&ADA$_MODE_ERROR,      &Mode_Error},
+   {&ADA$_NAME_ERROR,      &Name_Error},
+   {&ADA$_STATUS_ERROR,    &Status_Error},
+   {&ADA$_NOT_OPEN,        &Use_Error},
+   {&ADA$_ALREADY_OPEN,    &Use_Error},
+   {&ADA$_USE_ERROR,       &Use_Error},
+   {&ADA$_UNSUPPORTED,     &Use_Error},
+   {&ADA$_FAC_MODE_MISMAT, &Use_Error},
+   {&ADA$_ORG_MISMATCH,    &Use_Error},
+   {&ADA$_RFM_MISMATCH,    &Use_Error},
+   {&ADA$_RAT_MISMATCH,    &Use_Error},
+   {&ADA$_MRS_MISMATCH,    &Use_Error},
+   {&ADA$_MRN_MISMATCH,    &Use_Error},
+   {&ADA$_KEY_MISMATCH,    &Use_Error},
+   {&ADA$_MAXLINEXC,       &constraint_error},
+   {&ADA$_LINEXCMRS,       &constraint_error},
+   {0,                     0}
+ };
+ 
+ #if 0
+    /* Already handled by a pragma Import_Exception
+       in Aux_IO_Exceptions */
+   {&ADA$_LOCK_ERROR,      &Lock_Error},
+   {&ADA$_EXISTENCE_ERROR, &Existence_Error},
+   {&ADA$_KEY_ERROR,       &Key_Error},
  #endif
  
! #endif /* IN_RTS */
  
! /* Non DEC Ada specific conditions. We could probably also put
!    SS$_HPARITH here and possibly SS$_ACCVIO, SS$_STKOVF. */
! static const struct cond_except cond_except_table [] = {
!   {&MTH$_FLOOVEMAT, &constraint_error},
!   {&SS$_INTDIV,     &constraint_error},
!   {0,               0}
! };
  
! /* To deal with VMS conditions and their mapping to Ada exceptions,
!    the __gnat_error_handler routine below is installed as an exception
!    vector having precedence over DEC frame handlers.  Some conditions
!    still need to be handled by such handlers, however, in which case
!    __gnat_error_handler needs to return SS$_RESIGNAL.  Consider for
!    instance the use of a third party library compiled with DECAda and
!    performing it's own exception handling internally.
  
!    To allow some user-level flexibility, which conditions should be
!    resignaled is controlled by a predicate function, provided with the
!    condition value and returning a boolean indication stating whether
!    this condition should be resignaled or not.
  
!    That predicate function is called indirectly, via a function pointer,
!    by __gnat_error_handler, and changing that pointer is allowed to the
!    the user code by way of the __gnat_set_resignal_predicate interface.
! 
!    The user level function may then implement what it likes, including
!    for instance the maintenance of a dynamic data structure if the set
!    of to be resignalled conditions has to change over the program's
!    lifetime.
! 
!    ??? This is not a perfect solution to deal with the possible
!    interactions between the GNAT and the DECAda exception handling
!    models and better (more general) schemes are studied.  This is so
!    just provided as a convenient workaround in the meantime, and
!    should be use with caution since the implementation has been kept
!    very simple.  */
! 
! typedef int
! resignal_predicate (int code);
! 
! const int *cond_resignal_table [] = {
!   &CMA$_EXIT_THREAD,
!   &SS$_DEBUG,
!   &LIB$_KEYNOTFOU,
!   &LIB$_ACTIMAGE,
!   (int *) RDB$_STREAM_EOF,
!   (int *) FDL$_UNPRIKW,
!   0
! };
! 
! /* Default GNAT predicate for resignaling conditions.  */
! 
! static int
! __gnat_default_resignal_p (int code)
  {
!   int i, iexcept;
  
!   for (i = 0, iexcept = 0;
!        cond_resignal_table [i] &&
!        !(iexcept = LIB$MATCH_COND (&code, &cond_resignal_table [i]));
!        i++);
  
!   return iexcept;
! }
  
! /* Static pointer to predicate that the __gnat_error_handler exception
!    vector invokes to determine if it should resignal a condition.  */
  
! static resignal_predicate * __gnat_resignal_p = __gnat_default_resignal_p;
  
! /* User interface to change the predicate pointer to PREDICATE. Reset to
!    the default if PREDICATE is null.  */
  
! void
! __gnat_set_resignal_predicate (resignal_predicate * predicate)
! {
!   if (predicate == 0)
!     __gnat_resignal_p = __gnat_default_resignal_p;
!   else
!     __gnat_resignal_p = predicate;
! }
  
! /* Should match System.Parameters.Default_Exception_Msg_Max_Length */
! #define Default_Exception_Msg_Max_Length 512
  
! /* Action routine for SYS$PUTMSG. There may be
!    multiple conditions, each with text to be appended to
!    MESSAGE and separated by line termination. */
  
! static int
! copy_msg (msgdesc, message)
!      struct descriptor_s *msgdesc;
!      char *message;
! {
!   int len = strlen (message);
!   int copy_len;
  
!   /* Check for buffer overflow and skip */
!   if (len > 0 && len <= Default_Exception_Msg_Max_Length - 3)
!     {
!       strcat (message, "\r\n");
!       len += 2;
!     }
! 
!   /* Check for buffer overflow and truncate if necessary */
!   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
! 	      msgdesc->len :
! 	      Default_Exception_Msg_Max_Length - 1 - len);
!   strncpy (&message [len], msgdesc->adr, copy_len);
!   message [len + copy_len] = 0;
! 
!   return 0;
! }
! 
! long
! __gnat_error_handler (int *sigargs, void *mechargs)
! {
!   struct Exception_Data *exception = 0;
!   Exception_Code base_code;
!   struct descriptor_s gnat_facility = {4,0,"GNAT"};
!   char message [Default_Exception_Msg_Max_Length];
! 
!   const char *msg = "";
!   char curr_icb[544];
!   long curr_invo_handle;
! 
!   /* Check for conditions to resignal which aren't effected by pragma
!      Import_Exception.  */
!   if (__gnat_resignal_p (sigargs [1]))
!     return SS$_RESIGNAL;
  
  #ifdef IN_RTS
    /* See if it's an imported exception. Beware that registered exceptions
*************** __gnat_error_handler (int *sigargs, void
*** 1334,1344 ****
  
    if (exception)
      {
!       msgdesc.len = 256;
!       msgdesc.mbz = 0;
!       msgdesc.adr = message;
!       SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
!       message[outlen] = 0;
        msg = message;
  
        exception->Name_Length = 19;
--- 1395,1406 ----
  
    if (exception)
      {
!       message [0] = 0;
! 
!       /* Subtract PC & PSL fields which messes with PUTMSG */
!       sigargs [0] -= 2;
!       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
!       sigargs [0] += 2;
        msg = message;
  
        exception->Name_Length = 19;
*************** __gnat_error_handler (int *sigargs, void
*** 1369,1379 ****
  	msg = "stack overflow";
  	break;
  
-       case SS$_INTDIV:
- 	exception = &constraint_error;
- 	msg = "division by zero";
- 	break;
- 
        case SS$_HPARITH:
  #ifndef IN_RTS
  	return SS$_RESIGNAL; /* toplev.c handles for compiler */
--- 1431,1436 ----
*************** __gnat_error_handler (int *sigargs, void
*** 1385,1431 ****
  #endif
  	break;
  
!       case MTH$_FLOOVEMAT:
! 	exception = &constraint_error;
! 	msg = "floating overflow in math library";
! 	break;
  
!       case SS$_CE24VRU:
! 	exception = &constraint_error;
! 	msg = "";
! 	break;
  
!       case SS$_C980VTE:
! 	exception = &program_error;
! 	msg = "";
! 	break;
  
!       default:
! #ifndef IN_RTS
! 	exception = &program_error;
  #else
! 	/* User programs expect Non_Ada_Error to be raised, reference
! 	   DEC Ada test CXCONDHAN. */
! 	exception = &Non_Ada_Error;
  #endif
! 	msgdesc.len = 256;
! 	msgdesc.mbz = 0;
! 	msgdesc.adr = message;
! 	SYS$GETMSG (sigargs[1], &outlen, &msgdesc, msg_flag, 0);
! 	message[outlen] = 0;
  	msg = message;
  	break;
        }
  
-   mstate = (long *) (*Get_Machine_State_Addr) ();
-   if (mstate != 0)
-     {
-       lib_get_curr_invo_context (&curr_icb);
-       lib_get_prev_invo_context (&curr_icb);
-       lib_get_prev_invo_context (&curr_icb);
-       curr_invo_handle = lib_get_invo_handle (&curr_icb);
-       *mstate = curr_invo_handle;
-     }
    Raise_From_Signal_Handler (exception, msg);
  }
  
--- 1442,1490 ----
  #endif
  	break;
  
!       default:
! #ifdef IN_RTS
! 	{
! 	  int i;
  
! 	  /* Scan the DEC Ada exception condition table for a match and fetch
! 	     the associated GNAT exception pointer */
! 	  for (i = 0;
! 	       dec_ada_cond_except_table [i].cond &&
! 	       !LIB$MATCH_COND (&sigargs [1],
! 			        &dec_ada_cond_except_table [i].cond);
! 	       i++);
! 	  exception = (struct Exception_Data *)
! 	    dec_ada_cond_except_table [i].except;
  
! 	  if (!exception)
! 	    {
! 	      /* Scan the VMS standard condition table for a match and fetch
! 		 the associated GNAT exception pointer */
! 	      for (i = 0;
! 		   cond_except_table [i].cond &&
! 		   !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
! 		   i++);
! 	      exception =(struct Exception_Data *) cond_except_table [i].except;
  
! 	      if (!exception)
! 		/* User programs expect Non_Ada_Error to be raised, reference
! 		   DEC Ada test CXCONDHAN. */
! 		exception = &Non_Ada_Error;
! 	    }
! 	}
  #else
! 	exception = &program_error;
  #endif
! 	message [0] = 0;
! 	/* Subtract PC & PSL fields which messes with PUTMSG */
! 	sigargs [0] -= 2;
! 	SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
! 	sigargs [0] += 2;
  	msg = message;
  	break;
        }
  
    Raise_From_Signal_Handler (exception, msg);
  }
  
*************** __gnat_install_handler (void)
*** 1443,1461 ****
    /* __gnat_error_prehandler is an assembly function.  */
    SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
  #else
!   SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
  #endif
-   __gnat_handler_installed = 1;
- }
  
! void
! __gnat_initialize(void *eh ATTRIBUTE_UNUSED)
! {
  }
  
! /*************************************************/
! /* __gnat_initialize (FreeBSD version) */
! /*************************************************/
  
  #elif defined (__FreeBSD__)
  
--- 1502,1521 ----
    /* __gnat_error_prehandler is an assembly function.  */
    SYS$SETEXV (1, __gnat_error_prehandler, 3, &prvhnd);
  #else
! #if defined (IN_RTS) && defined (__IA64)
!   if (getenv ("DBG$TDBG"))
!     printf ("DBG$TDBG defined, __gnat_error_handler not installed!\n");
!   else
! #endif
!     SYS$SETEXV (1, __gnat_error_handler, 3, &prvhnd);
  #endif
  
!   __gnat_handler_installed = 1;
  }
  
! /*******************/
! /* FreeBSD Section */
! /*******************/
  
  #elif defined (__FreeBSD__)
  
*************** __gnat_install_handler ()
*** 1518,1561 ****
    (void) sigaction (SIGFPE,  &act, NULL);
    (void) sigaction (SIGSEGV, &act, NULL);
    (void) sigaction (SIGBUS,  &act, NULL);
- }
- 
- void
- __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
- {
-    __gnat_install_handler ();
  
!    /* XXX - Initialize floating-point coprocessor. This call is
!       needed because FreeBSD defaults to 64-bit precision instead
!       of 80-bit precision?  We require the full precision for
!       proper operation, given that we have set Max_Digits etc
!       with this in mind */
!    __gnat_init_float ();
  }
  
! /***************************************/
! /* __gnat_initialize (VXWorks Version) */
! /***************************************/
  
  #elif defined(__vxworks)
  
  #include <signal.h>
  #include <taskLib.h>
  #include <intLib.h>
  #include <iv.h>
  
  #ifdef VTHREADS
  #include "private/vThreadsP.h"
  #endif
  
- extern int __gnat_inum_to_ivec (int);
  static void __gnat_error_handler (int, int, struct sigcontext *);
  void __gnat_map_signal (int);
  
! #ifndef __alpha_vxworks
  
  /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
!    on Alpha VxWorks */
  
  extern long getpid (void);
  
--- 1578,1626 ----
    (void) sigaction (SIGFPE,  &act, NULL);
    (void) sigaction (SIGSEGV, &act, NULL);
    (void) sigaction (SIGBUS,  &act, NULL);
  
!   __gnat_handler_installed = 1;
  }
  
! /*******************/
! /* VxWorks Section */
! /*******************/
  
  #elif defined(__vxworks)
  
  #include <signal.h>
  #include <taskLib.h>
+ 
+ #ifndef __RTP__
  #include <intLib.h>
  #include <iv.h>
+ #endif
  
  #ifdef VTHREADS
  #include "private/vThreadsP.h"
  #endif
  
  static void __gnat_error_handler (int, int, struct sigcontext *);
  void __gnat_map_signal (int);
  
! #ifndef __RTP__
! 
! /* Directly vectored Interrupt routines are not supported when using RTPs */
! 
! extern int __gnat_inum_to_ivec (int);
! 
! /* This is needed by the GNAT run time to handle Vxworks interrupts */
! int
! __gnat_inum_to_ivec (int num)
! {
!   return INUM_TO_IVEC (num);
! }
! #endif
! 
! #if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
  
  /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
!    on Alpha VxWorks and VxWorks 6.x (including RTPs). */
  
  extern long getpid (void);
  
*************** getpid (void)
*** 1566,1578 ****
  }
  #endif
  
- /* This is needed by the GNAT run time to handle Vxworks interrupts */
- int
- __gnat_inum_to_ivec (int num)
- {
-   return INUM_TO_IVEC (num);
- }
- 
  /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
     The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
  void
--- 1631,1636 ----
*************** __gnat_clear_exception_count (void)
*** 1585,1597 ****
  #endif
  }
  
! /* Exported to 5zintman.adb in order to handle different signal
     to exception mappings in different VxWorks versions */
  void
  __gnat_map_signal (int sig)
  {
    struct Exception_Data *exception;
!   char *msg;
  
    switch (sig)
      {
--- 1643,1655 ----
  #endif
  }
  
! /* Exported to s-intman-vxworks.adb in order to handle different signal
     to exception mappings in different VxWorks versions */
  void
  __gnat_map_signal (int sig)
  {
    struct Exception_Data *exception;
!   const char *msg;
  
    switch (sig)
      {
*************** __gnat_init_float (void)
*** 1690,1696 ****
    asm ("mtfsb0 26");
  #endif
  
!   /* Similarily for sparc64. Achieved by masking bits in the Trap Enable Mask
       field of the Floating-point Status Register (see the Sparc Architecture
       Manual Version 9, p 48).  */
  #if defined (sparc64)
--- 1748,1754 ----
    asm ("mtfsb0 26");
  #endif
  
!   /* Similarly for sparc64. Achieved by masking bits in the Trap Enable Mask
       field of the Floating-point Status Register (see the Sparc Architecture
       Manual Version 9, p 48).  */
  #if defined (sparc64)
*************** __gnat_init_float (void)
*** 1710,1778 ****
  #endif
  }
  
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
!   __gnat_init_float ();
! 
!   /* On targets where we might be using the ZCX scheme, we need to register
!      the frame tables.
! 
!      For applications loaded as a set of "modules", the crtstuff objects
!      linked in (crtbegin/end) are tailored to provide this service a-la C++
!      constructor fashion, typically triggered by the VxWorks loader.  This is
!      achieved by way of a special variable declaration in the crt object, the
!      name of which has been deduced by analyzing the output of the "munching"
!      step documented for C++.  The de-registration is handled symetrically,
!      a-la C++ destructor fashion and typically triggered by the dynamic
!      unloader.  Note that since the tables shall be registered against a
!      common datastructure, libgcc should be one of the modules (vs beeing
!      partially linked against all the others at build time) and shall be
!      loaded first.
! 
!      For applications linked with the kernel, the scheme above would lead to
!      duplicated symbols because the VxWorks kernel build "munches" by default.
!      To prevent those conflicts, we link against crtbegin/endS objects that
!      don't include the special variable and directly call the appropriate
!      function here. We'll never unload that, so there is no de-registration to
!      worry about.
! 
!      For whole applications loaded as a single module, we may use one scheme
!      or the other, except for the mixed Ada/C++ case in which the first scheme
!      would fail for the same reason as in the linked-with-kernel situation.
! 
!      We can differentiate by looking at the __module_has_ctors value provided
!      by each class of crt objects. As of today, selecting the crt set with the
!      ctors/dtors capabilities (first scheme above) is triggered by adding
!      "-dynamic" to the gcc *link* command line options. Selecting the other
!      set of crt objects is achieved by "-static" instead.
! 
!      This is a first approach, tightly synchronized with a number of GCC
!      configuration and crtstuff changes. We need to ensure that those changes
!      are there to activate this circuitry.  */
! 
! #if (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
!  {
!    /* The scheme described above is only useful for the actual ZCX case, and
!       we don't want any reference to the crt provided symbols otherwise.  We
!       may not link with any of the crt objects in the non-ZCX case, e.g. from
!       documented procedures instructing the use of -nostdlib, and references
!       to the ctors symbols here would just remain unsatisfied.
! 
!       We have no way to avoid those references in the right conditions in this
!       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
!       is then deferred to an Ada routine, which can do that based on a test
!       against a constant System flag value.  */
! 
!    extern void __gnat_vxw_setup_for_eh (void);
!    __gnat_vxw_setup_for_eh ();
!  }
! #endif
! }
! 
! /********************************/
! /* __gnat_initialize for NetBSD */
! /********************************/
  
  #elif defined(__NetBSD__)
  
--- 1768,1776 ----
  #endif
  }
  
! /******************/
! /* NetBSD Section */
! /******************/
  
  #elif defined(__NetBSD__)
  
*************** __gnat_install_handler(void)
*** 1833,1862 ****
    __gnat_handler_installed = 1;
  }
  
- void
- __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
- {
-   __gnat_install_handler ();
-   __gnat_init_float ();
- }
- 
  #else
  
! /* For all other versions of GNAT, the initialize routine and handler
!    installation do nothing */
! 
! /***************************************/
! /* __gnat_initialize (Default Version) */
! /***************************************/
! 
! void
! __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
! {
! }
  
! /********************************************/
! /* __gnat_install_handler (Default Version) */
! /********************************************/
  
  void
  __gnat_install_handler (void)
--- 1831,1843 ----
    __gnat_handler_installed = 1;
  }
  
  #else
  
! /* For all other versions of GNAT, the handler does nothing */
  
! /*******************/
! /* Default Section */
! /*******************/
  
  void
  __gnat_install_handler (void)
*************** __gnat_init_float (void)
*** 1901,1903 ****
--- 1882,1924 ----
  {
  }
  #endif
+ 
+ /***********************************/
+ /* __gnat_adjust_context_for_raise */
+ /***********************************/
+ 
+ #ifndef HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
+ 
+ /* All targets without a specific version will use an empty one */
+ 
+ /* UCONTEXT is a pointer to a context structure received by a signal handler
+    about to propagate an exception. Adjust it to compensate the fact that the
+    generic unwinder thinks the corresponding PC is a call return address.  */
+ 
+ void
+ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
+ 				 void *ucontext ATTRIBUTE_UNUSED)
+ {
+   /* The point is that the interrupted context PC typically is the address
+      that we should search an EH region for, which is different from the call
+      return address case. The target independent part of the GCC unwinder
+      don't differentiate the two situations, so we compensate here for the
+      adjustments it will blindly make.
+ 
+      signo is passed because on some targets for some signals the PC in
+      context points to the instruction after the faulting one, in which case
+      the unwinder adjustment is still desired.  */
+ 
+   /* On a number of targets, we have arranged for the adjustment to be
+      performed by the MD_FALLBACK_FRAME_STATE circuitry, so we don't provide a
+      specific instance of this routine.  The MD_FALLBACK doesn't have access
+      to the signal number, though, so the compensation is systematic there and
+      might be wrong in some cases.  */
+ 
+   /* Having the compensation wrong leads to potential failures.  A very
+      typical case is what happens when there is no compensation and a signal
+      triggers for the first instruction in a region : the unwinder adjustment
+      has it search in the wrong EH region.  */
+ }
+ 
+ #endif
diff -Nrcpad gcc-4.0.2/gcc/ada/initialize.c gcc-4.1.0/gcc/ada/initialize.c
*** gcc-4.0.2/gcc/ada/initialize.c	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/initialize.c	Sat Feb  4 01:12:46 2006
***************
*** 0 ****
--- 1,201 ----
+ /****************************************************************************
+  *                                                                          *
+  *                         GNAT COMPILER COMPONENTS                         *
+  *                                                                          *
+  *                           I N I T I A L I Z E                            *
+  *                                                                          *
+  *                          C Implementation File                           *
+  *                                                                          *
+  *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
+  *                                                                          *
+  * GNAT is free software;  you can  redistribute it  and/or modify it under *
+  * terms of the  GNU General Public License as published  by the Free Soft- *
+  * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+  * for  more details.  You should have  received  a copy of the GNU General *
+  * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
+  * Boston, MA 02110-1301, USA.                                              *
+  *                                                                          *
+  * As a  special  exception,  if you  link  this file  with other  files to *
+  * produce an executable,  this file does not by itself cause the resulting *
+  * executable to be covered by the GNU General Public License. This except- *
+  * ion does not  however invalidate  any other reasons  why the  executable *
+  * file might be covered by the  GNU Public License.                        *
+  *                                                                          *
+  * GNAT was originally developed  by the GNAT team at  New York University. *
+  * Extensive contributions were provided by Ada Core Technologies Inc.      *
+  *                                                                          *
+  ****************************************************************************/
+ 
+ /*  This unit provides default implementation for __gnat_initialize ()
+     which is called before the elaboration of the partition. It is provided
+     in a separate file/object so that users can replace it easily.
+     The default implementation should be null on most targets. */
+ 
+ /* The following include is here to meet the published VxWorks requirement
+    that the __vxworks header appear before any other include. */
+ #ifdef __vxworks
+ #include "vxWorks.h"
+ #endif
+ 
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+ #else
+ #include "config.h"
+ #include "system.h"
+ #endif
+ 
+ #include "raise.h"
+ 
+ /******************************************/
+ /* __gnat_initialize (NT-mingw32 Version) */
+ /******************************************/
+ 
+ #if defined (__MINGW32__)
+ #include <windows.h>
+ 
+ extern void __gnat_init_float (void);
+ extern void __gnat_plist_init (void);
+ extern void __gnat_install_SEH_handler (void *);
+ 
+ void
+ __gnat_initialize (void *eh)
+ {
+    /* Initialize floating-point coprocessor. This call is needed because
+       the MS libraries default to 64-bit precision instead of 80-bit
+       precision, and we require the full precision for proper operation,
+       given that we have set Max_Digits etc with this in mind */
+    __gnat_init_float ();
+ 
+    /* Initialize a lock for a process handle list - see adaint.c for the
+       implementation of __gnat_portable_no_block_spawn, __gnat_portable_wait */
+    __gnat_plist_init();
+ 
+    /* Note that we do not activate this for the compiler itself to avoid a
+       bootstrap path problem.  Older version of gnatbind will generate a call
+       to __gnat_initialize() without argument. Therefore we cannot use eh in
+       this case.  It will be possible to remove the following #ifdef at some
+       point.  */
+ #ifdef IN_RTS
+    /* Install the Structured Exception handler.  */
+    if (eh)
+      __gnat_install_SEH_handler (eh);
+ #endif
+ }
+ 
+ /******************************************/
+ /* __gnat_initialize (init_float version) */
+ /******************************************/
+ 
+ #elif defined (__INTERIX) || defined (__Lynx__) || \
+       defined (__FreeBSD__) || defined(__NetBSD__)
+ 
+ extern void __gnat_init_float (void);
+ 
+ void
+ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
+ {
+    __gnat_init_float ();
+ }
+ 
+ /***************************************/
+ /* __gnat_initialize (VxWorks Version) */
+ /***************************************/
+ 
+ #elif defined(__vxworks)
+ 
+ extern void __gnat_init_float (void);
+ 
+ void
+ __gnat_initialize (void *eh)
+ {
+   __gnat_init_float ();
+ 
+   /* On targets where we might be using the ZCX scheme, we need to register
+      the frame tables.
+ 
+      For applications loaded as a set of "modules", the crtstuff objects
+      linked in (crtbegin/end) are tailored to provide this service a-la C++
+      constructor fashion, typically triggered by the VxWorks loader.  This is
+      achieved by way of a special variable declaration in the crt object, the
+      name of which has been deduced by analyzing the output of the "munching"
+      step documented for C++.  The de-registration is handled symmetrically,
+      a-la C++ destructor fashion and typically triggered by the dynamic
+      unloader.  Note that since the tables shall be registered against a
+      common datastructure, libgcc should be one of the modules (vs beeing
+      partially linked against all the others at build time) and shall be
+      loaded first.
+ 
+      For applications linked with the kernel, the scheme above would lead to
+      duplicated symbols because the VxWorks kernel build "munches" by default.
+      To prevent those conflicts, we link against crtbegin/endS objects that
+      don't include the special variable and directly call the appropriate
+      function here. We'll never unload that, so there is no de-registration to
+      worry about.
+ 
+      For whole applications loaded as a single module, we may use one scheme
+      or the other, except for the mixed Ada/C++ case in which the first scheme
+      would fail for the same reason as in the linked-with-kernel situation.
+ 
+      We can differentiate by looking at the __module_has_ctors value provided
+      by each class of crt objects. As of today, selecting the crt set with the
+      ctors/dtors capabilities (first scheme above) is triggered by adding
+      "-dynamic" to the gcc *link* command line options. Selecting the other
+      set of crt objects is achieved by "-static" instead.
+ 
+      This is a first approach, tightly synchronized with a number of GCC
+      configuration and crtstuff changes. We need to ensure that those changes
+      are there to activate this circuitry.  */
+ 
+ #if (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
+  {
+    /* The scheme described above is only useful for the actual ZCX case, and
+       we don't want any reference to the crt provided symbols otherwise.  We
+       may not link with any of the crt objects in the non-ZCX case, e.g. from
+       documented procedures instructing the use of -nostdlib, and references
+       to the ctors symbols here would just remain unsatisfied.
+ 
+       We have no way to avoid those references in the right conditions in this
+       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
+       is then deferred to an Ada routine, which can do that based on a test
+       against a constant System flag value.  */
+ 
+    extern void __gnat_vxw_setup_for_eh (void);
+    __gnat_vxw_setup_for_eh ();
+  }
+ #endif
+ }
+ 
+ #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))
+ 
+ /************************************************/
+ /* __gnat_initialize (PA-RISC HP-UX 10 Version) */
+ /************************************************/
+ 
+ extern void __main (void);
+ 
+ void
+ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
+ {
+   __main ();
+ }
+ 
+ #else
+ 
+ /* For all other versions of GNAT, the initialize routine and handler
+    installation do nothing */
+ 
+ /***************************************/
+ /* __gnat_initialize (Default Version) */
+ /***************************************/
+ 
+ void
+ __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
+ {
+ }
+ 
+ #endif
diff -Nrcpad gcc-4.0.2/gcc/ada/inline.adb gcc-4.1.0/gcc/ada/inline.adb
*** gcc-4.0.2/gcc/ada/inline.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/inline.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Einfo;    use Einfo;
*** 29,35 ****
  with Elists;   use Elists;
  with Errout;   use Errout;
  with Exp_Ch7;  use Exp_Ch7;
- with Exp_Ch11; use Exp_Ch11;
  with Exp_Tss;  use Exp_Tss;
  with Fname;    use Fname;
  with Fname.UF; use Fname.UF;
--- 29,34 ----
*************** package body Inline is
*** 89,95 ****
     type Subp_Index is new Nat;
     No_Subp : constant Subp_Index := 0;
  
!    --  The subprogram entities are hashed into the Inlined table.
  
     Num_Hash_Headers : constant := 512;
  
--- 88,94 ----
     type Subp_Index is new Nat;
     No_Subp : constant Subp_Index := 0;
  
!    --  The subprogram entities are hashed into the Inlined table
  
     Num_Hash_Headers : constant := 512;
  
*************** package body Inline is
*** 183,192 ****
     To_Clean : Elist_Id;
  
     procedure Add_Scope_To_Clean (Inst : Entity_Id);
!    --  Build set of scopes on which cleanup actions must be performed.
  
     procedure Cleanup_Scopes;
!    --  Complete cleanup actions on scopes that need it.
  
     --------------
     -- Add_Call --
--- 182,191 ----
     To_Clean : Elist_Id;
  
     procedure Add_Scope_To_Clean (Inst : Entity_Id);
!    --  Build set of scopes on which cleanup actions must be performed
  
     procedure Cleanup_Scopes;
!    --  Complete cleanup actions on scopes that need it
  
     --------------
     -- Add_Call --
*************** package body Inline is
*** 216,222 ****
              J := Successors.Table (J).Next;
           end loop;
  
!          --  On exit, make a successor entry for P2.
  
           Successors.Increment_Last;
           Successors.Table (Successors.Last).Subp := P2;
--- 215,221 ----
              J := Successors.Table (J).Next;
           end loop;
  
!          --  On exit, make a successor entry for P2
  
           Successors.Increment_Last;
           Successors.Table (Successors.Last).Subp := P2;
*************** package body Inline is
*** 506,512 ****
        J     : Subp_Index;
  
        procedure New_Entry;
!       --  Initialize entry in Inlined table.
  
        procedure New_Entry is
        begin
--- 505,511 ----
        J     : Subp_Index;
  
        procedure New_Entry;
!       --  Initialize entry in Inlined table
  
        procedure New_Entry is
        begin
*************** package body Inline is
*** 693,699 ****
              then
                 Error_Msg_N
                   ("& cannot be inlined?", Inlined.Table (Index).Name);
!                --  A warning on the first one might be sufficient.
              end if;
           end loop;
  
--- 692,699 ----
              then
                 Error_Msg_N
                   ("& cannot be inlined?", Inlined.Table (Index).Name);
! 
!                --  A warning on the first one might be sufficient ???
              end if;
           end loop;
  
*************** package body Inline is
*** 986,1014 ****
             and then not Is_Generic_Unit (Main_Unit_Entity)
           then
              Cleanup_Scopes;
- 
-             --  Also generate subprogram descriptors that were delayed
- 
-             for J in Pending_Descriptor.First .. Pending_Descriptor.Last loop
-                declare
-                   Ent : constant Entity_Id := Pending_Descriptor.Table (J);
- 
-                begin
-                   if Is_Subprogram (Ent) then
-                      Generate_Subprogram_Descriptor_For_Subprogram
-                        (Get_Subprogram_Body (Ent), Ent);
- 
-                   elsif Ekind (Ent) = E_Package then
-                      Generate_Subprogram_Descriptor_For_Package
-                        (Parent (Declaration_Node (Ent)), Ent);
- 
-                   elsif Ekind (Ent) = E_Package_Body then
-                      Generate_Subprogram_Descriptor_For_Package
-                        (Declaration_Node (Ent), Ent);
-                   end if;
-                end;
-             end loop;
- 
           elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
              End_Generic;
           end if;
--- 986,991 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/inline.ads gcc-4.1.0/gcc/ada/inline.ads
*** gcc-4.0.2/gcc/ada/inline.ads	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/inline.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/interfac-vms.ads gcc-4.1.0/gcc/ada/interfac-vms.ads
*** gcc-4.0.2/gcc/ada/interfac-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/interfac-vms.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,49 ****
  --  floating-point formats are available.
  
  package Interfaces is
! pragma Pure (Interfaces);
  
     type Integer_8  is range -2 **  7 .. 2 **  7 - 1;
     for Integer_8'Size use  8;
--- 43,49 ----
  --  floating-point formats are available.
  
  package Interfaces is
!    pragma Pure;
  
     type Integer_8  is range -2 **  7 .. 2 **  7 - 1;
     for Integer_8'Size use  8;
*************** pragma Pure (Interfaces);
*** 71,173 ****
  
     function Shift_Left
       (Value  : Unsigned_8;
!       Amount : Natural)
!      return    Unsigned_8;
  
     function Shift_Right
       (Value  : Unsigned_8;
!       Amount : Natural)
!       return   Unsigned_8;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_8;
!       Amount : Natural)
!       return   Unsigned_8;
  
     function Rotate_Left
       (Value  : Unsigned_8;
!       Amount : Natural)
!       return   Unsigned_8;
  
     function Rotate_Right
       (Value  : Unsigned_8;
!       Amount : Natural)
!       return   Unsigned_8;
  
     function Shift_Left
       (Value  : Unsigned_16;
!       Amount : Natural)
!      return    Unsigned_16;
  
     function Shift_Right
       (Value  : Unsigned_16;
!       Amount : Natural)
!       return   Unsigned_16;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_16;
!       Amount : Natural)
!       return   Unsigned_16;
  
     function Rotate_Left
       (Value  : Unsigned_16;
!       Amount : Natural)
!       return   Unsigned_16;
  
     function Rotate_Right
       (Value  : Unsigned_16;
!       Amount : Natural)
!       return   Unsigned_16;
  
     function Shift_Left
       (Value  : Unsigned_32;
!       Amount : Natural)
!      return    Unsigned_32;
  
     function Shift_Right
       (Value  : Unsigned_32;
!       Amount : Natural)
!       return   Unsigned_32;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_32;
!       Amount : Natural)
!       return   Unsigned_32;
  
     function Rotate_Left
       (Value  : Unsigned_32;
!       Amount : Natural)
!       return   Unsigned_32;
  
     function Rotate_Right
       (Value  : Unsigned_32;
!       Amount : Natural)
!       return   Unsigned_32;
  
     function Shift_Left
       (Value  : Unsigned_64;
!       Amount : Natural)
!      return    Unsigned_64;
  
     function Shift_Right
       (Value  : Unsigned_64;
!       Amount : Natural)
!       return   Unsigned_64;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_64;
!       Amount : Natural)
!       return   Unsigned_64;
  
     function Rotate_Left
       (Value  : Unsigned_64;
!       Amount : Natural)
!       return   Unsigned_64;
  
     function Rotate_Right
       (Value  : Unsigned_64;
!       Amount : Natural)
!       return   Unsigned_64;
  
     pragma Import (Intrinsic, Shift_Left);
     pragma Import (Intrinsic, Shift_Right);
--- 71,153 ----
  
     function Shift_Left
       (Value  : Unsigned_8;
!       Amount : Natural) return Unsigned_8;
  
     function Shift_Right
       (Value  : Unsigned_8;
!       Amount : Natural) return Unsigned_8;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_8;
!       Amount : Natural) return Unsigned_8;
  
     function Rotate_Left
       (Value  : Unsigned_8;
!       Amount : Natural) return Unsigned_8;
  
     function Rotate_Right
       (Value  : Unsigned_8;
!       Amount : Natural) return Unsigned_8;
  
     function Shift_Left
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Shift_Right
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Rotate_Left
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Rotate_Right
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Shift_Left
       (Value  : Unsigned_32;
!       Amount : Natural) return Unsigned_32;
  
     function Shift_Right
       (Value  : Unsigned_32;
!       Amount : Natural) return Unsigned_32;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_32;
!       Amount : Natural) return Unsigned_32;
  
     function Rotate_Left
       (Value  : Unsigned_32;
!       Amount : Natural) return Unsigned_32;
  
     function Rotate_Right
       (Value  : Unsigned_32;
!       Amount : Natural) return Unsigned_32;
  
     function Shift_Left
       (Value  : Unsigned_64;
!       Amount : Natural) return Unsigned_64;
  
     function Shift_Right
       (Value  : Unsigned_64;
!       Amount : Natural) return Unsigned_64;
  
     function Shift_Right_Arithmetic
       (Value  : Unsigned_64;
!       Amount : Natural) return Unsigned_64;
  
     function Rotate_Left
       (Value  : Unsigned_64;
!       Amount : Natural) return Unsigned_64;
  
     function Rotate_Right
       (Value  : Unsigned_64;
!       Amount : Natural) return Unsigned_64;
  
     pragma Import (Intrinsic, Shift_Left);
     pragma Import (Intrinsic, Shift_Right);
*************** pragma Pure (Interfaces);
*** 178,183 ****
--- 158,164 ----
     --  Floating point types. We use the digits value to define the IEEE
     --  forms, otherwise a configuration pragma specifying VAX float can
     --  default the digits to an illegal value for IEEE.
+ 
     --  Note: it is harmless, and explicitly permitted, to include additional
     --  types in interfaces, so it is not wrong to have IEEE_Extended_Float
     --  defined even if the extended format is not available.
diff -Nrcpad gcc-4.0.2/gcc/ada/interfac.ads gcc-4.1.0/gcc/ada/interfac.ads
*** gcc-4.0.2/gcc/ada/interfac.ads	Wed Dec  8 11:49:38 2004
--- gcc-4.1.0/gcc/ada/interfac.ads	Tue Nov 15 14:00:09 2005
***************
*** 6,16 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the implementation dependent additions to thie file.     --
  --                                                                          --
  -- 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- --
--- 6,16 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
! -- apply solely to the implementation dependent sections of this file.      --
  --                                                                          --
  -- 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- --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,47 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- --  Assumes integer sizes of 8, 16, 32 and 64 are available, and that the
- --  floating-point formats are IEEE compatible.
- 
- --  Note: There is a specialized version of this package for OpenVMS.
- 
  package Interfaces is
! pragma Pure (Interfaces);
  
     type Integer_8  is range -2 **  7 .. 2 **  7 - 1;
     for Integer_8'Size use  8;
--- 35,42 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package Interfaces is
!    pragma Pure;
  
     type Integer_8  is range -2 **  7 .. 2 **  7 - 1;
     for Integer_8'Size use  8;
*************** pragma Pure (Interfaces);
*** 89,95 ****
  
     function Shift_Left
       (Value  : Unsigned_16;
!       Amount : Natural) return    Unsigned_16;
  
     function Shift_Right
       (Value  : Unsigned_16;
--- 84,90 ----
  
     function Shift_Left
       (Value  : Unsigned_16;
!       Amount : Natural) return Unsigned_16;
  
     function Shift_Right
       (Value  : Unsigned_16;
*************** pragma Pure (Interfaces);
*** 153,168 ****
     pragma Import (Intrinsic, Rotate_Left);
     pragma Import (Intrinsic, Rotate_Right);
  
!    --  Floating point types. We assume that we are on an IEEE machine, and
!    --  that the types Short_Float and Long_Float in Standard refer to the
!    --  32-bit short and 64-bit long IEEE forms. Furthermore, if there is
!    --  an extended float, we assume that it is available as Long_Long_Float.
     --  Note: it is harmless, and explicitly permitted, to include additional
     --  types in interfaces, so it is not wrong to have IEEE_Extended_Float
     --  defined even if the extended format is not available.
  
-    type IEEE_Float_32       is new Short_Float;
-    type IEEE_Float_64       is new Long_Float;
     type IEEE_Extended_Float is new Long_Long_Float;
  
  end Interfaces;
--- 148,173 ----
     pragma Import (Intrinsic, Rotate_Left);
     pragma Import (Intrinsic, Rotate_Right);
  
!    --  IEEE Floating point types. Note that the form of these definitions
!    --  ensures that the work on VMS, even if the standard library is compiled
!    --  using a Float_Representation pragma for Vax_Float.
! 
!    pragma Warnings (Off);
!    --  Turn off warnings for targets not providing IEEE floating-point types
! 
!    type IEEE_Float_32 is digits 6;
!    pragma Float_Representation (IEEE_Float, IEEE_Float_32);
! 
!    type IEEE_Float_64 is digits 15;
!    pragma Float_Representation (IEEE_Float, IEEE_Float_64);
! 
!    --  If there is an IEEE extended float available on the machine, we assume
!    --  that it is available as Long_Long_Float.
! 
     --  Note: it is harmless, and explicitly permitted, to include additional
     --  types in interfaces, so it is not wrong to have IEEE_Extended_Float
     --  defined even if the extended format is not available.
  
     type IEEE_Extended_Float is new Long_Long_Float;
  
  end Interfaces;
diff -Nrcpad gcc-4.0.2/gcc/ada/ioexcept.ads gcc-4.1.0/gcc/ada/ioexcept.ads
*** gcc-4.0.2/gcc/ada/ioexcept.ads	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/ioexcept.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        I O _ E X C E P T I O N S                         --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        I O _ E X C E P T I O N S                         --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/itypes.adb gcc-4.1.0/gcc/ada/itypes.adb
*** gcc-4.0.2/gcc/ada/itypes.adb	Wed Oct 29 10:26:14 2003
--- gcc-4.1.0/gcc/ada/itypes.adb	Mon Sep  5 07:54:48 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,34 ****
  ------------------------------------------------------------------------------
  
  with Atree;    use Atree;
- with Einfo;    use Einfo;
  with Opt;      use Opt;
  with Sem;      use Sem;
- with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
  with Stand;    use Stand;
  
--- 25,32 ----
*************** package body Itypes is
*** 74,77 ****
--- 72,111 ----
        return Typ;
     end Create_Itype;
  
+    ---------------------------------
+    -- Create_Null_Excluding_Itype --
+    ---------------------------------
+ 
+    function Create_Null_Excluding_Itype
+       (T           : Entity_Id;
+        Related_Nod : Node_Id;
+        Scope_Id    : Entity_Id := Current_Scope) return Entity_Id
+    is
+       I_Typ        : Entity_Id;
+ 
+    begin
+       pragma Assert (Is_Access_Type (T));
+ 
+       I_Typ := Create_Itype (Ekind       => E_Access_Subtype,
+                              Related_Nod => Related_Nod,
+                              Scope_Id    => Scope_Id);
+ 
+       Set_Directly_Designated_Type (I_Typ,
+          Directly_Designated_Type (T));
+       Set_Etype              (I_Typ, T);
+       Init_Size_Align        (I_Typ);
+       Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
+       Set_Is_Public          (I_Typ, Is_Public (T));
+       Set_From_With_Type     (I_Typ, From_With_Type (T));
+       Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
+       Set_Is_Generic_Type    (I_Typ, Is_Generic_Type (T));
+       Set_Is_Volatile        (I_Typ, Is_Volatile (T));
+       Set_Treat_As_Volatile  (I_Typ, Treat_As_Volatile (T));
+       Set_Is_Atomic          (I_Typ, Is_Atomic (T));
+       Set_Is_Ada_2005        (I_Typ, Is_Ada_2005 (T));
+       Set_Can_Never_Be_Null  (I_Typ);
+ 
+       return I_Typ;
+    end Create_Null_Excluding_Itype;
+ 
  end Itypes;
diff -Nrcpad gcc-4.0.2/gcc/ada/itypes.ads gcc-4.1.0/gcc/ada/itypes.ads
*** gcc-4.0.2/gcc/ada/itypes.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/itypes.ads	Mon Sep  5 07:54:48 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Itypes is
*** 110,113 ****
--- 110,141 ----
     --  The Scope_Id parameter specifies the scope of the created type, and
     --  is normally the Current_Scope as shown, but can be set otherwise.
  
+    ---------------------------------
+    -- Create_Null_Excluding_Itype --
+    ---------------------------------
+ 
+    function Create_Null_Excluding_Itype
+       (T           : Entity_Id;
+        Related_Nod : Node_Id;
+        Scope_Id    : Entity_Id := Current_Scope) return Entity_Id;
+    --  Ada 2005 (AI-231): T is an access type and this subprogram creates and
+    --  returns an internal access-subtype declaration of T that has the null
+    --  exclusion attribute set to True.
+    --
+    --  Usage of null-excluding itypes
+    --  ------------------------------
+    --
+    --      type T1 is access ...
+    --      type T2 is not null T1;
+    --
+    --      type Rec is record
+    --         Comp : not null T1;
+    --      end record;
+    --
+    --      type Arr is array (...) of not null T1;
+    --
+    --  Instead of associating the not-null attribute with the defining ids of
+    --  these declarations, we generate an internal subtype declaration of T1
+    --  that has the null exclusion attribute set to true.
+ 
  end Itypes;
diff -Nrcpad gcc-4.0.2/gcc/ada/krunch.adb gcc-4.1.0/gcc/ada/krunch.adb
*** gcc-4.0.2/gcc/ada/krunch.adb	Thu Feb 10 13:50:27 2005
--- gcc-4.1.0/gcc/ada/krunch.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/krunch.ads gcc-4.1.0/gcc/ada/krunch.ads
*** gcc-4.0.2/gcc/ada/krunch.ads	Thu Feb 10 13:50:27 2005
--- gcc-4.1.0/gcc/ada/krunch.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/lang-specs.h gcc-4.1.0/gcc/ada/lang-specs.h
*** gcc-4.0.2/gcc/ada/lang-specs.h	Wed Dec  8 11:25:14 2004
--- gcc-4.1.0/gcc/ada/lang-specs.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/lang.opt gcc-4.1.0/gcc/ada/lang.opt
*** gcc-4.0.2/gcc/ada/lang.opt	Thu Mar 17 15:06:47 2005
--- gcc-4.1.0/gcc/ada/lang.opt	Fri Jul  1 01:29:17 2005
***************
*** 15,24 ****
  ; 
  ; You should have received a copy of the GNU General Public License
  ; along with GCC; see the file COPYING.  If not, write to the Free
! ; Software Foundation, 59 Temple Place - Suite 330, Boston, MA
! ; 02111-1307, USA.
  
! ; See c.opt for a description of this file's format.
  
  ; Please try to keep this file in ASCII collating order.
  
--- 15,24 ----
  ; 
  ; You should have received a copy of the GNU General Public License
  ; along with GCC; see the file COPYING.  If not, write to the Free
! ; Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
! ; 02110-1301, USA.
  
! ; See the GCC internals manual for a description of this file's format.
  
  ; Please try to keep this file in ASCII collating order.
  
*************** Ada
*** 59,69 ****
--- 59,74 ----
  
  fRTS=
  Ada Joined RejectNegative
+ ; Selects the runtime
  
  gant
  Ada Joined Undocumented
  ; Catches typos
  
+ gnatO
+ Ada Separate
+ ; Sets name of output ALI file (internal switch)
+ 
  gnat
  Ada Joined
  -gnat<options>	Specify options to GNAT
diff -Nrcpad gcc-4.0.2/gcc/ada/layout.adb gcc-4.1.0/gcc/ada/layout.adb
*** gcc-4.0.2/gcc/ada/layout.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/layout.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Layout is
*** 950,956 ****
        --  is the expression so far (which will be the body of the function).
  
        Size : Val_Type;
!       --  Value of size computed so far. See comments above.
  
        Vtyp : Entity_Id := Empty;
        --  Variant record type for the formal parameter of the
--- 950,956 ----
        --  is the expression so far (which will be the body of the function).
  
        Size : Val_Type;
!       --  Value of size computed so far. See comments above
  
        Vtyp : Entity_Id := Empty;
        --  Variant record type for the formal parameter of the
*************** package body Layout is
*** 993,1004 ****
                 Decl := Parent (Parent (Entity (N)));
                 Size := (Discrim, Size.Nod);
                 Vtyp := Defining_Identifier (Decl);
- 
-                --  Ensure that we get a private type's full type
- 
-                if Present (Underlying_Type (Vtyp)) then
-                   Vtyp := Underlying_Type (Vtyp);
-                end if;
              end if;
  
              Typ := Etype (N);
--- 993,998 ----
*************** package body Layout is
*** 1029,1036 ****
  
        --  Calculate proper type for insertions
  
!       if Is_Record_Type (Scope (E)) then
!          Insert_Typ := Scope (E);
        else
           Insert_Typ := E;
        end if;
--- 1023,1030 ----
  
        --  Calculate proper type for insertions
  
!       if Is_Record_Type (Underlying_Type (Scope (E))) then
!          Insert_Typ := Underlying_Type (Scope (E));
        else
           Insert_Typ := E;
        end if;
*************** package body Layout is
*** 2362,2368 ****
  
           if Is_Discrete_Type (E) then
  
!             --  If the RM_Size is not set, then here is where we set it.
  
              --  Note: an RM_Size of zero looks like not set here, but this
              --  is a rare case, and we can simply reset it without any harm.
--- 2356,2362 ----
  
           if Is_Discrete_Type (E) then
  
!             --  If the RM_Size is not set, then here is where we set it
  
              --  Note: an RM_Size of zero looks like not set here, but this
              --  is a rare case, and we can simply reset it without any harm.
*************** package body Layout is
*** 2951,2956 ****
--- 2945,2952 ----
  
        Decl : Node_Id;
  
+       Vtype_Primary_View : Entity_Id;
+ 
        function Check_Node_V_Ref (N : Node_Id) return Traverse_Result;
        --  Function used to check one node for reference to V
  
*************** package body Layout is
*** 2992,2997 ****
--- 2988,3008 ----
        if Has_V_Ref (Expr) = Abandon then
  
           pragma Assert (Present (Vtype));
+ 
+          --  Check whether Vtype is a view of a private type and ensure that
+          --  we use the primary view of the type (which is denoted by its
+          --  Etype, whether it's the type's partial or full view entity).
+          --  This is needed to make sure that we use the same (primary) view
+          --  of the type for all V formals, whether the current view of the
+          --  type is the partial or full view, so that types will always
+          --  match on calls from one size function to another.
+ 
+          if  Has_Private_Declaration (Vtype) then
+             Vtype_Primary_View := Etype (Vtype);
+          else
+             Vtype_Primary_View := Vtype;
+          end if;
+ 
           Set_Is_Discrim_SO_Function (K);
  
           Decl :=
*************** package body Layout is
*** 3005,3012 ****
                         Defining_Identifier =>
                           Make_Defining_Identifier (Loc, Chars => Vname),
                         Parameter_Type      =>
!                          New_Occurrence_Of (Vtype, Loc))),
!                    Subtype_Mark =>
                       New_Occurrence_Of (Standard_Unsigned, Loc)),
  
               Declarations => Empty_List,
--- 3016,3023 ----
                         Defining_Identifier =>
                           Make_Defining_Identifier (Loc, Chars => Vname),
                         Parameter_Type      =>
!                          New_Occurrence_Of (Vtype_Primary_View, Loc))),
!                    Result_Definition =>
                       New_Occurrence_Of (Standard_Unsigned, Loc)),
  
               Declarations => Empty_List,
*************** package body Layout is
*** 3028,3034 ****
                 Make_Function_Specification (Loc,
                   Defining_Unit_Name => K,
                     Parameter_Specifications => Empty_List,
!                    Subtype_Mark => New_Occurrence_Of (Standard_Unsigned, Loc)),
  
               Declarations => Empty_List,
  
--- 3039,3046 ----
                 Make_Function_Specification (Loc,
                   Defining_Unit_Name => K,
                     Parameter_Specifications => Empty_List,
!                    Result_Definition =>
!                      New_Occurrence_Of (Standard_Unsigned, Loc)),
  
               Declarations => Empty_List,
  
diff -Nrcpad gcc-4.0.2/gcc/ada/layout.ads gcc-4.1.0/gcc/ada/layout.ads
*** gcc-4.0.2/gcc/ada/layout.ads	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/layout.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-list.adb gcc-4.1.0/gcc/ada/lib-list.adb
*** gcc-4.0.2/gcc/ada/lib-list.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/lib-list.adb	Mon Sep  5 07:50:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Output; use Output;
- 
  separate (Lib)
  procedure List (File_Names_Only : Boolean := False) is
  
--- 31,36 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-load.adb gcc-4.1.0/gcc/ada/lib-load.adb
*** gcc-4.0.2/gcc/ada/lib-load.adb	Mon Jun  7 14:16:20 2004
--- gcc-4.1.0/gcc/ada/lib-load.adb	Mon Sep  5 07:53:24 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Osint;    use Osint;
*** 38,43 ****
--- 38,44 ----
  with Osint.C;  use Osint.C;
  with Output;   use Output;
  with Par;
+ with Restrict; use Restrict;
  with Scn;      use Scn;
  with Sinfo;    use Sinfo;
  with Sinput;   use Sinput;
*************** package body Lib.Load is
*** 52,57 ****
--- 53,63 ----
     -- Local Subprograms --
     -----------------------
  
+    function From_Limited_With_Chain (Lim : Boolean) return Boolean;
+    --  Check whether a possible circular dependence includes units that
+    --  have been loaded through limited_with clauses, in which case there
+    --  is no real circularity.
+ 
     function Spec_Is_Irrelevant
       (Spec_Unit : Unit_Number_Type;
        Body_Unit : Unit_Number_Type) return Boolean;
*************** package body Lib.Load is
*** 164,169 ****
--- 170,199 ----
        return Unum;
     end Create_Dummy_Package_Unit;
  
+    -----------------------------
+    -- From_Limited_With_Chain --
+    -----------------------------
+ 
+    function From_Limited_With_Chain (Lim : Boolean) return Boolean is
+    begin
+       --  True if the current load operation is through a limited_with clause
+ 
+       if Lim then
+          return True;
+ 
+       --  Examine the Load_Stack to locate any previous Limited_with clause
+ 
+       elsif Load_Stack.Last - 1 > Load_Stack.First then
+          for U in Load_Stack.First .. Load_Stack.Last - 1 loop
+             if Load_Stack.Table (U).From_Limited_With then
+                return True;
+             end if;
+          end loop;
+       end if;
+ 
+       return False;
+    end From_Limited_With_Chain;
+ 
     ----------------
     -- Initialize --
     ----------------
*************** package body Lib.Load is
*** 192,198 ****
  
     begin
        Load_Stack.Increment_Last;
!       Load_Stack.Table (Load_Stack.Last) := Main_Unit;
  
        --  Initialize unit table entry for Main_Unit. Note that we don't know
        --  the unit name yet, that gets filled in when the parser parses the
--- 222,228 ----
  
     begin
        Load_Stack.Increment_Last;
!       Load_Stack.Table (Load_Stack.Last) := (Main_Unit, False);
  
        --  Initialize unit table entry for Main_Unit. Note that we don't know
        --  the unit name yet, that gets filled in when the parser parses the
*************** package body Lib.Load is
*** 236,247 ****
     ---------------
  
     function Load_Unit
!      (Load_Name  : Unit_Name_Type;
!       Required   : Boolean;
!       Error_Node : Node_Id;
!       Subunit    : Boolean;
!       Corr_Body  : Unit_Number_Type := No_Unit;
!       Renamings  : Boolean          := False) return Unit_Number_Type
     is
        Calling_Unit : Unit_Number_Type;
        Uname_Actual : Unit_Name_Type;
--- 266,278 ----
     ---------------
  
     function Load_Unit
!      (Load_Name         : Unit_Name_Type;
!       Required          : Boolean;
!       Error_Node        : Node_Id;
!       Subunit           : Boolean;
!       Corr_Body         : Unit_Number_Type := No_Unit;
!       Renamings         : Boolean          := False;
!       From_Limited_With : Boolean          := False) return Unit_Number_Type
     is
        Calling_Unit : Unit_Number_Type;
        Uname_Actual : Unit_Name_Type;
*************** package body Lib.Load is
*** 463,472 ****
           end loop;
        end if;
  
!       --  If we are proceeding with load, then make load stack entry
  
        Load_Stack.Increment_Last;
!       Load_Stack.Table (Load_Stack.Last) := Unum;
  
        --  Case of entry already in table
  
--- 494,504 ----
           end loop;
        end if;
  
!       --  If we are proceeding with load, then make load stack entry,
!       --  and indicate the kind of with_clause responsible for the load.
  
        Load_Stack.Increment_Last;
!       Load_Stack.Table (Load_Stack.Last) := (Unum, From_Limited_With);
  
        --  Case of entry already in table
  
*************** package body Lib.Load is
*** 487,493 ****
                         or else Acts_As_Spec (Units.Table (Unum).Cunit))
             and then (Nkind (Error_Node) /= N_With_Clause
                         or else not Limited_Present (Error_Node))
! 
           then
              if Debug_Flag_L then
                 Write_Str ("  circular dependency encountered");
--- 519,525 ----
                         or else Acts_As_Spec (Units.Table (Unum).Cunit))
             and then (Nkind (Error_Node) /= N_With_Clause
                         or else not Limited_Present (Error_Node))
!            and then not From_Limited_With_Chain (From_Limited_With)
           then
              if Debug_Flag_L then
                 Write_Str ("  circular dependency encountered");
*************** package body Lib.Load is
*** 561,567 ****
                 Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
                 Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
                 Initialize_Scanner (Unum, Source_Index (Unum));
!                Discard_List (Par (Configuration_Pragmas => False));
                 Multiple_Unit_Index := Save_Index;
                 Set_Loading (Unum, False);
              end;
--- 593,600 ----
                 Multiple_Unit_Index := Get_Unit_Index (Uname_Actual);
                 Units.Table (Unum).Munit_Index := Multiple_Unit_Index;
                 Initialize_Scanner (Unum, Source_Index (Unum));
!                Discard_List (Par (Configuration_Pragmas => False,
!                                   From_Limited_With     => From_Limited_With));
                 Multiple_Unit_Index := Save_Index;
                 Set_Loading (Unum, False);
              end;
*************** package body Lib.Load is
*** 606,613 ****
              --  Generate message if unit required
  
              if Required and then Present (Error_Node) then
- 
                 if Is_Predefined_File_Name (Fname) then
                    Error_Msg_Name_1 := Uname_Actual;
                    Error_Msg
                      ("% is not a predefined library unit", Load_Msg_Sloc);
--- 639,660 ----
              --  Generate message if unit required
  
              if Required and then Present (Error_Node) then
                 if Is_Predefined_File_Name (Fname) then
+ 
+                   --  This is a predefined library unit which is not present
+                   --  in the run time. If a predefined unit is not available
+                   --  it may very likely be the case that there is also pragma
+                   --  Restriction forbidding its usage. This is typically the
+                   --  case when building a configurable run time, where the
+                   --  usage of certain run-time units units is restricted by
+                   --  means of both the corresponding pragma Restriction (such
+                   --  as No_Calendar), and by not including the unit. Hence,
+                   --  we check whether this predefined unit is forbidden, so
+                   --  that the message about the restriction violation is
+                   --  generated, if needed.
+ 
+                   Check_Restricted_Unit (Load_Name, Error_Node);
+ 
                    Error_Msg_Name_1 := Uname_Actual;
                    Error_Msg
                      ("% is not a predefined library unit", Load_Msg_Sloc);
*************** package body Lib.Load is
*** 716,723 ****
  
        if Load_Stack.Last - 1 > Load_Stack.First then
           for U in Load_Stack.First .. Load_Stack.Last - 1 loop
!             Error_Msg_Unit_1 := Unit_Name (Load_Stack.Table (U));
!             Error_Msg_Unit_2 := Unit_Name (Load_Stack.Table (U + 1));
              Error_Msg ("$ depends on $!", Load_Msg_Sloc);
           end loop;
        end if;
--- 763,772 ----
  
        if Load_Stack.Last - 1 > Load_Stack.First then
           for U in Load_Stack.First .. Load_Stack.Last - 1 loop
!             Error_Msg_Unit_1 :=
!               Unit_Name (Load_Stack.Table (U).Unit_Number);
!             Error_Msg_Unit_2 :=
!               Unit_Name (Load_Stack.Table (U + 1).Unit_Number);
              Error_Msg ("$ depends on $!", Load_Msg_Sloc);
           end loop;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-load.ads gcc-4.1.0/gcc/ada/lib-load.ads
*** gcc-4.0.2/gcc/ada/lib-load.ads	Mon Feb  9 14:56:04 2004
--- gcc-4.1.0/gcc/ada/lib-load.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Lib.Load is
*** 104,115 ****
     --  and then closed on return.
  
     function Load_Unit
!      (Load_Name  : Unit_Name_Type;
!       Required   : Boolean;
!       Error_Node : Node_Id;
!       Subunit    : Boolean;
!       Corr_Body  : Unit_Number_Type := No_Unit;
!       Renamings  : Boolean          := False) return Unit_Number_Type;
     --  This function loads and parses the unit specified by Load_Name (or
     --  returns the unit number for the previously constructed units table
     --  entry if this is not the first call for this unit). Required indicates
--- 104,116 ----
     --  and then closed on return.
  
     function Load_Unit
!      (Load_Name         : Unit_Name_Type;
!       Required          : Boolean;
!       Error_Node        : Node_Id;
!       Subunit           : Boolean;
!       Corr_Body         : Unit_Number_Type := No_Unit;
!       Renamings         : Boolean          := False;
!       From_Limited_With : Boolean          := False) return Unit_Number_Type;
     --  This function loads and parses the unit specified by Load_Name (or
     --  returns the unit number for the previously constructed units table
     --  entry if this is not the first call for this unit). Required indicates
*************** package Lib.Load is
*** 147,152 ****
--- 148,157 ----
     --  described in the documentation of this unit. If this parameter is
     --  set to True, then Load_Name may not be the real unit name and it
     --  is necessary to load parents to find the real name.
+    --
+    --  From_Limited_With is True if we are loading a unit X found in a
+    --  limited-with clause, or some unit in the context of X. It is used to
+    --  avoid the check on circular dependency (Ada 2005, AI-50217)
  
     function Create_Dummy_Package_Unit
       (With_Node : Node_Id;
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-sort.adb gcc-4.1.0/gcc/ada/lib-sort.adb
*** gcc-4.0.2/gcc/ada/lib-sort.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/lib-sort.adb	Mon Sep  5 08:07:00 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** procedure Sort (Tbl : in out Unit_Ref_Ta
*** 43,52 ****
     --  even though we have to copy Tbl back and forth.
  
     function Lt_Uname (C1, C2 : Natural) return Boolean;
!    --  Comparison routine for comparing Unames. Needed by the sorting routine.
  
     procedure Move_Uname (From : Natural; To : Natural);
!    --  Move routine needed by the sorting routine below.
  
     --------------
     -- Lt_Uname --
--- 43,52 ----
     --  even though we have to copy Tbl back and forth.
  
     function Lt_Uname (C1, C2 : Natural) return Boolean;
!    --  Comparison routine for comparing Unames. Needed by the sorting routine
  
     procedure Move_Uname (From : Natural; To : Natural);
!    --  Move routine needed by the sorting routine below
  
     --------------
     -- Lt_Uname --
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-util.adb gcc-4.1.0/gcc/ada/lib-util.adb
*** gcc-4.0.2/gcc/ada/lib-util.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/lib-util.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-util.ads gcc-4.1.0/gcc/ada/lib-util.ads
*** gcc-4.0.2/gcc/ada/lib-util.ads	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/lib-util.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-writ.adb gcc-4.1.0/gcc/ada/lib-writ.adb
*** gcc-4.0.2/gcc/ada/lib-writ.adb	Mon Jan  3 15:32:16 2005
--- gcc-4.1.0/gcc/ada/lib-writ.adb	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Stringt;  use Stringt;
*** 49,55 ****
  with Tbuild;   use Tbuild;
  with Uname;    use Uname;
  
! with System.WCh_Con; use System.WCh_Con;
  
  package body Lib.Writ is
  
--- 49,56 ----
  with Tbuild;   use Tbuild;
  with Uname;    use Uname;
  
! with System.Case_Util; use System.Case_Util;
! with System.WCh_Con;   use System.WCh_Con;
  
  package body Lib.Writ is
  
*************** package body Lib.Writ is
*** 181,186 ****
--- 182,190 ----
        --  Array of flags to show which units have pragma Elaborate All set
  
        Elab_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
+       --  Array of flags to show which units have Elaborate_Desirable set
+ 
+       Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
        --  Array of flags to show which units have Elaborate_All_Desirable set
  
        Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
*************** package body Lib.Writ is
*** 228,238 ****
           Item := First (Context_Items (Cunit));
           while Present (Item) loop
  
              --  Ada 2005 (AI-50217): limited with_clauses do not create
              --  dependencies
  
              if Nkind (Item) = N_With_Clause
!                and then not (Limited_Present (Item))
              then
                 Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
                 With_Flags (Unum) := True;
--- 232,244 ----
           Item := First (Context_Items (Cunit));
           while Present (Item) loop
  
+             --  Process with clause
+ 
              --  Ada 2005 (AI-50217): limited with_clauses do not create
              --  dependencies
  
              if Nkind (Item) = N_With_Clause
!               and then not (Limited_Present (Item))
              then
                 Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
                 With_Flags (Unum) := True;
*************** package body Lib.Writ is
*** 245,251 ****
                    Elab_All_Flags (Unum) := True;
                 end if;
  
!                if Elaborate_All_Desirable (Cunit_Entity (Unum)) then
                    Elab_Des_Flags (Unum) := True;
                 end if;
              end if;
--- 251,261 ----
                    Elab_All_Flags (Unum) := True;
                 end if;
  
!                if Elaborate_All_Desirable (Item) then
!                   Elab_All_Des_Flags (Unum) := True;
!                end if;
! 
!                if Elaborate_Desirable (Item) then
                    Elab_Des_Flags (Unum) := True;
                 end if;
              end if;
*************** package body Lib.Writ is
*** 494,503 ****
           --  Generate with lines, first those that are directly with'ed
  
           for J in With_Flags'Range loop
!             With_Flags (J) := False;
!             Elab_Flags (J) := False;
!             Elab_All_Flags (J) := False;
!             Elab_Des_Flags (J) := False;
           end loop;
  
           Collect_Withs (Unode);
--- 504,514 ----
           --  Generate with lines, first those that are directly with'ed
  
           for J in With_Flags'Range loop
!             With_Flags         (J) := False;
!             Elab_Flags         (J) := False;
!             Elab_All_Flags     (J) := False;
!             Elab_Des_Flags     (J) := False;
!             Elab_All_Des_Flags (J) := False;
           end loop;
  
           Collect_Withs (Unode);
*************** package body Lib.Writ is
*** 684,694 ****
--- 695,723 ----
                   or else (Ada_Version = Ada_83
                             and then Full_Source_Name (Body_Fname) /= No_File)
                 then
+                   --  Ensure that on platforms where the file names are not
+                   --  case sensitive, the recorded file name is in lower case.
+ 
+                   if not File_Names_Case_Sensitive then
+                      Get_Name_String (Body_Fname);
+                      To_Lower (Name_Buffer (1 .. Name_Len));
+                      Body_Fname := Name_Find;
+                   end if;
+ 
                    Write_Info_Name (Body_Fname);
                    Write_Info_Tab (49);
                    Write_Info_Name
                      (Lib_File_Name (Body_Fname, Body_Index));
                 else
+                   --  Ensure that on platforms where the file names are not
+                   --  case sensitive, the recorded file name is in lower case.
+ 
+                   if not File_Names_Case_Sensitive then
+                      Get_Name_String (Fname);
+                      To_Lower (Name_Buffer (1 .. Name_Len));
+                      Fname := Name_Find;
+                   end if;
+ 
                    Write_Info_Name (Fname);
                    Write_Info_Tab (49);
                    Write_Info_Name
*************** package body Lib.Writ is
*** 706,711 ****
--- 735,744 ----
                 if Elab_Des_Flags (Unum) then
                    Write_Info_Str ("  ED");
                 end if;
+ 
+                if Elab_All_Des_Flags (Unum) then
+                   Write_Info_Str ("  AD");
+                end if;
              end if;
  
              Write_Info_EOL;
*************** package body Lib.Writ is
*** 799,810 ****
  
        begin
           if Nkind (U) = N_Subprogram_Body
!            or else (Nkind (U) = N_Package_Body
!                       and then
!                         (Nkind (Original_Node (U)) = N_Function_Instantiation
!                            or else
!                          Nkind (Original_Node (U)) =
!                                                   N_Procedure_Instantiation))
           then
              --  If the unit is a subprogram instance, the entity for the
              --  subprogram is the alias of the visible entity, which is the
--- 832,841 ----
  
        begin
           if Nkind (U) = N_Subprogram_Body
!            or else
!              (Nkind (U) = N_Package_Body
!                and then
!                  Nkind (Original_Node (U)) in N_Subprogram_Instantiation)
           then
              --  If the unit is a subprogram instance, the entity for the
              --  subprogram is the alias of the visible entity, which is the
*************** package body Lib.Writ is
*** 830,836 ****
                       Nam : Node_Id := Defining_Unit_Name (S);
  
                    begin
!                      --  If it is a child unit, get its simple name.
  
                       if Nkind (Nam) = N_Defining_Program_Unit_Name then
                          Nam := Defining_Identifier (Nam);
--- 861,867 ----
                       Nam : Node_Id := Defining_Unit_Name (S);
  
                    begin
!                      --  If it is a child unit, get its simple name
  
                       if Nkind (Nam) = N_Defining_Program_Unit_Name then
                          Nam := Defining_Identifier (Nam);
*************** package body Lib.Writ is
*** 922,932 ****
           Write_Info_Str (" UA");
        end if;
  
!       if Exception_Mechanism /= Front_End_Setjmp_Longjmp_Exceptions then
!          if Unit_Exception_Table_Present then
!             Write_Info_Str (" UX");
!          end if;
! 
           Write_Info_Str (" ZX");
        end if;
  
--- 953,959 ----
           Write_Info_Str (" UA");
        end if;
  
!       if Exception_Mechanism = Back_End_Exceptions then
           Write_Info_Str (" ZX");
        end if;
  
*************** package body Lib.Writ is
*** 1059,1064 ****
--- 1086,1093 ----
           Sind : Source_File_Index;
           --  Index of corresponding source file
  
+          Fname : File_Name_Type;
+ 
        begin
           for J in 1 .. Num_Sdep loop
              Unum := Sdep_Table (J);
*************** package body Lib.Writ is
*** 1071,1077 ****
              --  Normal case of a unit entry with a source index
  
              if Sind /= No_Source_File then
!                Write_Info_Name (File_Name (Sind));
                 Write_Info_Tab (25);
                 Write_Info_Str (String (Time_Stamp (Sind)));
                 Write_Info_Char (' ');
--- 1100,1117 ----
              --  Normal case of a unit entry with a source index
  
              if Sind /= No_Source_File then
!                Fname := File_Name (Sind);
! 
!                --  Ensure that on platforms where the file names are not
!                --  case sensitive, the recorded file name is in lower case.
! 
!                if not File_Names_Case_Sensitive then
!                   Get_Name_String (Fname);
!                   To_Lower (Name_Buffer (1 .. Name_Len));
!                   Fname := Name_Find;
!                end if;
! 
!                Write_Info_Name (Fname);
                 Write_Info_Tab (25);
                 Write_Info_Str (String (Time_Stamp (Sind)));
                 Write_Info_Char (' ');
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-writ.ads gcc-4.1.0/gcc/ada/lib-writ.ads
*** gcc-4.0.2/gcc/ada/lib-writ.ads	Mon Jan  3 15:32:16 2005
--- gcc-4.1.0/gcc/ada/lib-writ.ads	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Lib.Writ is
*** 63,69 ****
     --  If the following guidelines are respected, downward compatibility
     --  problems (old tools reading new ali files) should be minimized:
  
!    --    The basic key character format must be kept.
  
     --    The V line must be the first line, this is checked by ali.adb
     --    even in Ignore_Errors mode, and is used to verify that the file
--- 63,69 ----
     --  If the following guidelines are respected, downward compatibility
     --  problems (old tools reading new ali files) should be minimized:
  
!    --    The basic key character format must be kept
  
     --    The V line must be the first line, this is checked by ali.adb
     --    even in Ignore_Errors mode, and is used to verify that the file
*************** package Lib.Writ is
*** 233,242 ****
     --         UA  Unreserve_All_Interrupts pragma was processed in one or
     --             more units in this file
     --
-    --         UX  Generated code contains unit exception table pointer
-    --             (i.e. it uses zero-cost exceptions, and there is at
-    --             least one subprogram present).
-    --
     --         ZX  Units in this file use zero-cost exceptions and have
     --             generated exception tables. If ZX is not present, the
     --             longjmp/setjmp exception scheme is in use.
--- 233,238 ----
*************** package Lib.Writ is
*** 390,396 ****
     --  -- U  Unit Header --
     --  --------------------
  
!    --  The lines for each compilation unit have the following form.
  
     --    U unit-name source-name version <<attributes>>
     --
--- 386,392 ----
     --  -- U  Unit Header --
     --  --------------------
  
!    --  The lines for each compilation unit have the following form
  
     --    U unit-name source-name version <<attributes>>
     --
*************** package Lib.Writ is
*** 466,472 ****
  
     --  Following each U line, is a series of lines of the form
  
!    --    W unit-name [source-name lib-name] [E] [EA] [ED]
     --
     --      One of these lines is present for each unit that is mentioned in
     --      an explicit with clause by the current unit. The first parameter
--- 462,468 ----
  
     --  Following each U line, is a series of lines of the form
  
!    --    W unit-name [source-name lib-name] [E] [EA] [ED] [AD]
     --
     --      One of these lines is present for each unit that is mentioned in
     --      an explicit with clause by the current unit. The first parameter
*************** package Lib.Writ is
*** 483,493 ****
     --
     --        EA  pragma Elaborate_All applies to this unit
     --
!    --        ED  Elaborate_All_Desirable set for this unit, which means
     --            that there is no Elaborate_All, but the analysis suggests
     --            that Program_Error may be raised if the Elaborate_All
     --            conditions cannot be satisfied. The binder will attempt
!    --            to treat ED as EA if it can.
     --
     --      The parameter source-name and lib-name are omitted for the case
     --      of a generic unit compiled with earlier versions of GNAT which
--- 479,495 ----
     --
     --        EA  pragma Elaborate_All applies to this unit
     --
!    --        ED  Elaborate_Desirable set for this unit, which means
!    --            that there is no Elaborate, but the analysis suggests
!    --            that Program_Error may be raised if the Elaborate
!    --            conditions cannot be satisfied. The binder will attempt
!    --            to treat ED as E if it can.
!    --
!    --        AD  Elaborate_All_Desirable set for this unit, which means
     --            that there is no Elaborate_All, but the analysis suggests
     --            that Program_Error may be raised if the Elaborate_All
     --            conditions cannot be satisfied. The binder will attempt
!    --            to treat AD as EA if it can.
     --
     --      The parameter source-name and lib-name are omitted for the case
     --      of a generic unit compiled with earlier versions of GNAT which
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-xref.adb gcc-4.1.0/gcc/ada/lib-xref.adb
*** gcc-4.0.2/gcc/ada/lib-xref.adb	Thu Feb 10 13:50:25 2005
--- gcc-4.1.0/gcc/ada/lib-xref.adb	Tue Nov 15 14:00:18 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Nlists;   use Nlists;
*** 34,39 ****
--- 34,40 ----
  with Opt;      use Opt;
  with Restrict; use Restrict;
  with Rident;   use Rident;
+ with Sem;      use Sem;
  with Sem_Prag; use Sem_Prag;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
*************** package body Lib.Xref is
*** 110,117 ****
        if Opt.Xref_Active
  
           --  Definition must come from source
  
!          and then Comes_From_Source (E)
  
           --  And must have a reasonable source location that is not
           --  within an instance (all entities in instances are ignored)
--- 111,123 ----
        if Opt.Xref_Active
  
           --  Definition must come from source
+          --  We make an exception for subprogram child units that have no
+          --  spec. For these we generate a subprogram declaration for library
+          --  use, and the corresponding entity does not come from source.
+          --  Nevertheless, all references will be attached to it and we have
+          --  to treat is as coming from user code.
  
!          and then (Comes_From_Source (E) or else Is_Child_Unit (E))
  
           --  And must have a reasonable source location that is not
           --  within an instance (all entities in instances are ignored)
*************** package body Lib.Xref is
*** 133,138 ****
--- 139,148 ----
           Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
           Xrefs.Table (Indx).Lun := No_Unit;
           Set_Has_Xref_Entry (E);
+ 
+          if In_Inlined_Body then
+             Set_Referenced (E);
+          end if;
        end if;
     end Generate_Definition;
  
*************** package body Lib.Xref is
*** 269,275 ****
  
        --  Warn if reference to Ada 2005 entity not in Ada 2005 mode
  
!       if Is_Ada_2005 (E) and then Ada_Version < Ada_05 then
           Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
        end if;
  
--- 279,288 ----
  
        --  Warn if reference to Ada 2005 entity not in Ada 2005 mode
  
!       if Is_Ada_2005 (E)
!         and then Ada_Version < Ada_05
!         and then Warn_On_Ada_2005_Compatibility
!       then
           Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
        end if;
  
*************** package body Lib.Xref is
*** 510,515 ****
--- 523,536 ----
                 end if;
              end loop;
  
+          --  The internally created defining entity for a child subprogram
+          --  that has no previous spec has valid references.
+ 
+          elsif Is_Overloadable (E)
+            and then Is_Child_Unit (E)
+          then
+             Ent := E;
+ 
           --  Record components of discriminated subtypes or derived types
           --  must be treated as references to the original component.
  
*************** package body Lib.Xref is
*** 534,540 ****
  
           Xrefs.Table (Indx).Loc := Ref;
  
!          --  Overriding operations are marked with 'P'.
  
           if Typ = 'p'
             and then Is_Subprogram (N)
--- 555,561 ----
  
           Xrefs.Table (Indx).Loc := Ref;
  
!          --  Overriding operations are marked with 'P'
  
           if Typ = 'p'
             and then Is_Subprogram (N)
*************** package body Lib.Xref is
*** 723,729 ****
                       exit;
                    end if;
  
!                --  For a subtype, go to ancestor subtype.
  
                 else
                    Tref := Ancestor_Subtype (Tref);
--- 744,750 ----
                       exit;
                    end if;
  
!                --  For a subtype, go to ancestor subtype
  
                 else
                    Tref := Ancestor_Subtype (Tref);
*************** package body Lib.Xref is
*** 778,784 ****
                    (Is_Wrapper_Package (Scope (Tref))
                       or else Is_Generic_Instance (Scope (Tref)))
                 then
!                   Tref := Base_Type (Tref);
                 end if;
  
                 return;
--- 799,805 ----
                    (Is_Wrapper_Package (Scope (Tref))
                       or else Is_Generic_Instance (Scope (Tref)))
                 then
!                   Tref := First_Subtype (Base_Type (Tref));
                 end if;
  
                 return;
*************** package body Lib.Xref is
*** 810,816 ****
              Language_Name := Name_Ada;
  
           else
!             --  These are the only languages that GPS knows about.
  
              return;
           end if;
--- 831,837 ----
              Language_Name := Name_Ada;
  
           else
!             --  These are the only languages that GPS knows about
  
              return;
           end if;
*************** package body Lib.Xref is
*** 1164,1169 ****
--- 1185,1194 ----
                 --  the given source ptr in [file|line[...]] form. No output
                 --  if the given location is not a generic template reference.
  
+                procedure Output_Overridden_Op (Old_E : Entity_Id);
+                --  For a subprogram that is overriding, display information
+                --  about the inherited operation that it overrides.
+ 
                 -------------------------------
                 -- Output_Instantiation_Refs --
                 -------------------------------
*************** package body Lib.Xref is
*** 1204,1209 ****
--- 1229,1263 ----
                    return;
                 end Output_Instantiation_Refs;
  
+                --------------------------
+                -- Output_Overridden_Op --
+                --------------------------
+ 
+                procedure Output_Overridden_Op (Old_E : Entity_Id) is
+                begin
+                   if Present (Old_E)
+                     and then Sloc (Old_E) /= Standard_Location
+                   then
+                      declare
+                         Loc      : constant Source_Ptr := Sloc (Old_E);
+                         Par_Unit : constant Unit_Number_Type :=
+                                      Get_Source_Unit (Loc);
+                      begin
+                         Write_Info_Char ('<');
+ 
+                         if Par_Unit /= Curxu then
+                            Write_Info_Nat (Dependency_Num (Par_Unit));
+                            Write_Info_Char ('|');
+                         end if;
+ 
+                         Write_Info_Nat (Int (Get_Logical_Line_Number (Loc)));
+                         Write_Info_Char ('p');
+                         Write_Info_Nat (Int (Get_Column_Number (Loc)));
+                         Write_Info_Char ('>');
+                      end;
+                   end if;
+                end Output_Overridden_Op;
+ 
              --  Start of processing for Output_One_Ref
  
              begin
*************** package body Lib.Xref is
*** 1260,1265 ****
--- 1314,1327 ----
                       if Present (Ent) then
                          Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
                       end if;
+ 
+                   elsif Is_Generic_Type (Ent) then
+ 
+                      --  If the type of the entity is a  generic private type
+                      --  there is no usable full view, so retain the indication
+                      --  that this is an object.
+ 
+                      Ctyp := '*';
                    end if;
  
                    --  Special handling for access parameter
*************** package body Lib.Xref is
*** 1285,1291 ****
                    end;
                 end if;
  
!                --  Special handling for abstract types and operations.
  
                 if Is_Abstract (XE.Ent) then
  
--- 1347,1353 ----
                    end;
                 end if;
  
!                --  Special handling for abstract types and operations
  
                 if Is_Abstract (XE.Ent) then
  
*************** package body Lib.Xref is
*** 1524,1530 ****
                             Rref := Selector_Name (Rref);
                          end if;
  
!                         if Nkind (Rref) /= N_Identifier then
                             Rref := Empty;
                          end if;
                       end if;
--- 1586,1610 ----
                             Rref := Selector_Name (Rref);
                          end if;
  
!                         if Nkind (Rref) = N_Identifier
!                           or else Nkind (Rref) = N_Operator_Symbol
!                         then
!                            null;
! 
!                         --  For renamed array components, use the array name
!                         --  for the renamed entity, which reflect the fact that
!                         --  in general the whole array is aliased.
! 
!                         elsif Nkind (Rref) = N_Indexed_Component then
!                            if Nkind (Prefix (Rref)) = N_Identifier then
!                               Rref := Prefix (Rref);
!                            elsif Nkind (Prefix (Rref)) = N_Expanded_Name then
!                               Rref := Selector_Name (Prefix (Rref));
!                            else
!                               Rref := Empty;
!                            end if;
! 
!                         else
                             Rref := Empty;
                          end if;
                       end if;
*************** package body Lib.Xref is
*** 1545,1550 ****
--- 1625,1655 ----
  
                       Curru := Curxu;
  
+                      --  Write out information about generic parent,
+                      --  if entity is an instance.
+ 
+                      if  Is_Generic_Instance (XE.Ent) then
+                         declare
+                            Gen_Par : constant Entity_Id :=
+                              Generic_Parent
+                                (Specification
+                                   (Unit_Declaration_Node (XE.Ent)));
+                            Loc : constant Source_Ptr := Sloc (Gen_Par);
+                            Gen_U : constant Unit_Number_Type :=
+                                      Get_Source_Unit (Loc);
+                         begin
+                            Write_Info_Char ('[');
+                            if Curru /= Gen_U then
+                               Write_Info_Nat (Dependency_Num (Gen_U));
+                               Write_Info_Char ('|');
+                            end if;
+ 
+                            Write_Info_Nat
+                              (Int (Get_Logical_Line_Number (Loc)));
+                            Write_Info_Char (']');
+                         end;
+                      end if;
+ 
                       --  See if we have a type reference and if so output
  
                       Get_Type_Reference (XE.Ent, Tref, Left, Right);
*************** package body Lib.Xref is
*** 1602,1607 ****
--- 1707,1721 ----
                          end if;
                       end if;
  
+                      --  If the entity is an overriding operation, write
+                      --  info on operation that was overridden.
+ 
+                      if Is_Subprogram (XE.Ent)
+                        and then Is_Overriding_Operation (XE.Ent)
+                      then
+                         Output_Overridden_Op (Overridden_Operation (XE.Ent));
+                      end if;
+ 
                       --  End of processing for entity output
  
                       Crloc := No_Location;
diff -Nrcpad gcc-4.0.2/gcc/ada/lib-xref.ads gcc-4.1.0/gcc/ada/lib-xref.ads
*** gcc-4.0.2/gcc/ada/lib-xref.ads	Wed Apr 21 10:10:31 2004
--- gcc-4.1.0/gcc/ada/lib-xref.ads	Mon Sep  5 07:55:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1998-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  information.
  
  with Einfo; use Einfo;
- with Types; use Types;
  
  package Lib.Xref is
  
--- 28,33 ----
*************** package Lib.Xref is
*** 54,60 ****
  
     --  The lines following the header look like
  
!    --     line type col level entity renameref typeref ref  ref  ref
  
     --        line is the line number of the referenced entity. The name of
     --        the entity starts in column col. Columns are numbered from one,
--- 53,59 ----
  
     --  The lines following the header look like
  
!    --  line type col level entity renameref instref typeref overref ref  ref
  
     --        line is the line number of the referenced entity. The name of
     --        the entity starts in column col. Columns are numbered from one,
*************** package Lib.Xref is
*** 93,98 ****
--- 92,108 ----
     --        reference is a complex expressions, then renameref is omitted.
     --        Here line/col give line/column as defined above.
  
+    --        instref is only present for package and subprogram instances.
+    --        The information in instref is the location of the point of
+    --        declaration of the generic parent unit. This part has the form:
+ 
+    --            [file|line]
+ 
+    --        without column information, on the reasonable assumption that
+    --        there is only one unit per line (the same assumption is made
+    --        in references to entities that are declared within instances,
+    --        see below).
+ 
     --        typeref is the reference for a related type. This part is
     --        optional. It is present for the following cases:
  
*************** package Lib.Xref is
*** 119,124 ****
--- 129,145 ----
     --          referenced file. For the standard entity form, the name between
     --          the brackets is the normal name of the entity in lower case.
  
+    --        overref is present for overriding operations (procedures and
+    --        functions), and provides information on the operation that it
+    --        overrides. This information has the format:
+ 
+    --        '<' file | line 'o' col '>'
+ 
+    --           file is the dependency number of the file containing the
+    --           declaration of the overridden operation. It and the following
+    --           vertical bar are omitted if the file is the same as that of
+    --           the overriding operation.
+ 
     --     There may be zero or more ref entries on each line
  
     --        file | line type col [...]
*************** package Lib.Xref is
*** 130,136 ****
  
     --           line is the line number of the reference
  
!    --           col is the column number of the reference, as defined above.
  
     --           type is one of
     --              b = body entity
--- 151,157 ----
  
     --           line is the line number of the reference
  
!    --           col is the column number of the reference, as defined above
  
     --           type is one of
     --              b = body entity
*************** package Lib.Xref is
*** 296,302 ****
     --              the END line of the body has an explict reference to
     --              the name of the procedure at line 12, column 13.
  
!    --              the body ends at line 12, column 15, just past this label.
  
     --        16I9*My_Type<2|4I9> 18r8
  
--- 317,323 ----
     --              the END line of the body has an explict reference to
     --              the name of the procedure at line 12, column 13.
  
!    --              the body ends at line 12, column 15, just past this label
  
     --        16I9*My_Type<2|4I9> 18r8
  
*************** package Lib.Xref is
*** 350,356 ****
     --  For private types, the character + appears in the table. In this
     --  case the kind of the underlying type is used, if available, to
     --  determine the character to use in the xref listing. The listing
!    --  will still include a '+' for a generic private type, for example.
  
     --  For subprograms, the characters 'U' and 'V' appear in the table,
     --  indicating procedures and functions. If the operation is abstract,
--- 371,379 ----
     --  For private types, the character + appears in the table. In this
     --  case the kind of the underlying type is used, if available, to
     --  determine the character to use in the xref listing. The listing
!    --  will still include a '+' for a generic private type, for example,
!    --  but will retain the '*' for an object or formal parameter of such
!    --  a type.
  
     --  For subprograms, the characters 'U' and 'V' appear in the table,
     --  indicating procedures and functions. If the operation is abstract,
*************** package Lib.Xref is
*** 597,602 ****
     --  Output references to the current ali file
  
     procedure Initialize;
!    --  Initialize internal tables.
  
  end Lib.Xref;
--- 620,625 ----
     --  Output references to the current ali file
  
     procedure Initialize;
!    --  Initialize internal tables
  
  end Lib.Xref;
diff -Nrcpad gcc-4.0.2/gcc/ada/lib.adb gcc-4.1.0/gcc/ada/lib.adb
*** gcc-4.0.2/gcc/ada/lib.adb	Fri Jun 25 16:39:28 2004
--- gcc-4.1.0/gcc/ada/lib.adb	Mon Sep  5 07:46:59 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Atree;   use Atree;
*** 39,45 ****
  with Einfo;   use Einfo;
  with Fname;   use Fname;
  with Namet;   use Namet;
- with Namet;   use Namet;
  with Output;  use Output;
  with Sinfo;   use Sinfo;
  with Sinput;  use Sinput;
--- 39,44 ----
*************** package body Lib is
*** 827,833 ****
        Linker_Option_Lines.Init;
        Load_Stack.Init;
        Units.Init;
-       Unit_Exception_Table_Present := False;
        Compilation_Switches.Init;
     end Initialize;
  
--- 826,831 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/lib.ads gcc-4.1.0/gcc/ada/lib.ads
*** gcc-4.0.2/gcc/ada/lib.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/lib.ads	Mon Sep  5 07:53:24 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Lib is
*** 239,249 ****
     --  Main_Unit is a body with a separate spec, in which case it is the
     --  entity for the spec.
  
-    Unit_Exception_Table_Present : Boolean;
-    --  Set true if a unit exception table is present for the unit (i.e.
-    --  zero cost exception handling is active and there is at least one
-    --  subprogram in the extended unit).
- 
     -----------------
     -- Units Table --
     -----------------
--- 239,244 ----
*************** package Lib is
*** 623,629 ****
  
     function Generic_Separately_Compiled
       (Sfile : File_Name_Type) return  Boolean;
!    --  Same as the previous function, but works directly on a unit file name.
  
  private
     pragma Inline (Cunit);
--- 618,624 ----
  
     function Generic_Separately_Compiled
       (Sfile : File_Name_Type) return  Boolean;
!    --  Same as the previous function, but works directly on a unit file name
  
  private
     pragma Inline (Cunit);
*************** private
*** 722,737 ****
     type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
     --  Type to hold list of indirect references to unit number table
  
!    --  The Load_Stack table contains a list of unit numbers (indexes into the
!    --  unit table) of units being loaded on a single dependency chain. The
!    --  First entry is the main unit. The second entry, if present is a unit
!    --  on which the first unit depends, etc. This stack is used to generate
!    --  error messages showing the dependency chain if a file is not found.
!    --  The Load function makes an entry in this table when it is called, and
!    --  removes the entry just before it returns.
  
     package Load_Stack is new Table.Table (
!      Table_Component_Type => Unit_Number_Type,
       Table_Index_Type     => Nat,
       Table_Low_Bound      => 0,
       Table_Initial        => Alloc.Load_Stack_Initial,
--- 717,739 ----
     type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
     --  Type to hold list of indirect references to unit number table
  
!    type Load_Stack_Entry is record
!       Unit_Number       : Unit_Number_Type;
!       From_Limited_With : Boolean;
!    end record;
! 
!    --  The Load_Stack table contains a list of unit numbers (indices into the
!    --  unit table) of units being loaded on a single dependency chain, and a
!    --  flag to indicate whether this unit is loaded through a limited_with
!    --  clause. The First entry is the main unit. The second entry, if present
!    --  is a unit on which the first unit depends, etc. This stack is used to
!    --  generate error messages showing the dependency chain if a file is not
!    --  found, or whether a true circular dependency exists.  The Load_Unit
!    --  function makes an entry in this table when it is called, and removes
!    --  the entry just before it returns.
  
     package Load_Stack is new Table.Table (
!      Table_Component_Type => Load_Stack_Entry,
       Table_Index_Type     => Nat,
       Table_Low_Bound      => 0,
       Table_Initial        => Alloc.Load_Stack_Initial,
diff -Nrcpad gcc-4.0.2/gcc/ada/link.c gcc-4.1.0/gcc/ada/link.c
*** gcc-4.0.2/gcc/ada/link.c	Wed Oct 27 12:28:43 2004
--- gcc-4.1.0/gcc/ada/link.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 30,36 ****
   *                                                                          *
   ****************************************************************************/
  
! /*  This file contains host-specific parameters describing the behaviour    */
  /*  of the linker. It is used by gnatlink as well as all tools that use     */
  /*  Mlib.                                                                   */
  
--- 30,36 ----
   *                                                                          *
   ****************************************************************************/
  
! /*  This file contains host-specific parameters describing the behavior     */
  /*  of the linker. It is used by gnatlink as well as all tools that use     */
  /*  Mlib.                                                                   */
  
diff -Nrcpad gcc-4.0.2/gcc/ada/live.adb gcc-4.1.0/gcc/ada/live.adb
*** gcc-4.0.2/gcc/ada/live.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/live.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Live is
*** 58,64 ****
     --  The problem of finding live entities is solved in two steps:
  
     procedure Mark (Root : Node_Id; Marks : out Name_Set);
!    --  Mark all live entities in Root as Marked.
  
     procedure Sweep (Root : Node_Id; Marks : Name_Set);
     --  For all unmarked entities in Root set Is_Eliminated to true
--- 58,64 ----
     --  The problem of finding live entities is solved in two steps:
  
     procedure Mark (Root : Node_Id; Marks : out Name_Set);
!    --  Mark all live entities in Root as Marked
  
     procedure Sweep (Root : Node_Id; Marks : Name_Set);
     --  For all unmarked entities in Root set Is_Eliminated to true
diff -Nrcpad gcc-4.0.2/gcc/ada/live.ads gcc-4.1.0/gcc/ada/live.ads
*** gcc-4.0.2/gcc/ada/live.ads	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/live.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/make.adb gcc-4.1.0/gcc/ada/make.adb
*** gcc-4.0.2/gcc/ada/make.adb	Thu Feb 10 13:54:58 2005
--- gcc-4.1.0/gcc/ada/make.adb	Tue Nov 15 14:00:29 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Make is
*** 250,259 ****
       Table_Increment      => 100,
       Table_Name           => "Make.Library_Projs");
  
!    --  Two variables to keep the last binder and linker switch index
!    --  in tables Binder_Switches and Linker_Switches, before adding
!    --  switches from the project file (if any) and switches from the
!    --  command line (if any).
  
     Last_Binder_Switch : Integer := 0;
     Last_Linker_Switch : Integer := 0;
--- 250,258 ----
       Table_Increment      => 100,
       Table_Name           => "Make.Library_Projs");
  
!    --  Two variables to keep the last binder and linker switch index in tables
!    --  Binder_Switches and Linker_Switches, before adding switches from the
!    --  project file (if any) and switches from the command line (if any).
  
     Last_Binder_Switch : Integer := 0;
     Last_Linker_Switch : Integer := 0;
*************** package body Make is
*** 275,287 ****
     Current_Verbosity : Prj.Verbosity  := Prj.Default;
     --  Verbosity to parse the project files
  
     Main_Project : Prj.Project_Id := No_Project;
     --  The project id of the main project file, if any
  
     Project_Object_Directory : Project_Id := No_Project;
!    --  The object directory of the project for the last compilation.
!    --  Avoid calling Change_Dir if the current working directory is already
!    --  this directory
  
     --  Packages of project files where unknown attributes are errors
  
--- 274,288 ----
     Current_Verbosity : Prj.Verbosity  := Prj.Default;
     --  Verbosity to parse the project files
  
+    Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
+ 
     Main_Project : Prj.Project_Id := No_Project;
     --  The project id of the main project file, if any
  
     Project_Object_Directory : Project_Id := No_Project;
!    --  The object directory of the project for the last compilation. Avoid
!    --  calling Change_Dir if the current working directory is already this
!    --  directory
  
     --  Packages of project files where unknown attributes are errors
  
*************** package body Make is
*** 301,316 ****
     Packages_To_Check_By_Gnatmake : constant String_List_Access :=
       Gnatmake_Packages'Access;
  
     procedure Add_Source_Dir (N : String);
!    --  Call Add_Src_Search_Dir.
!    --  Output one line when in verbose mode.
  
     procedure Add_Source_Directories is
       new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
  
     procedure Add_Object_Dir (N : String);
!    --  Call Add_Lib_Search_Dir.
!    --  Output one line when in verbose mode.
  
     procedure Add_Object_Directories is
       new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
--- 302,331 ----
     Packages_To_Check_By_Gnatmake : constant String_List_Access :=
       Gnatmake_Packages'Access;
  
+    procedure Add_Library_Search_Dir
+      (Path            : String;
+       On_Command_Line : Boolean);
+    --  Call Add_Lib_Search_Dir with an absolute directory path. If Path is a
+    --  relative path, when On_Command_Line is True, it is relative to the
+    --  current working directory; when On_Command_Line is False, it is relative
+    --  to the project directory of the main project.
+ 
+    procedure Add_Source_Search_Dir
+      (Path            : String;
+       On_Command_Line : Boolean);
+    --  Call Add_Src_Search_Dir with an absolute directory path. If Path is a
+    --  relative path, when On_Command_Line is True, it is relative to the
+    --  current working directory; when On_Command_Line is False, it is relative
+    --  to the project directory of the main project.
+ 
     procedure Add_Source_Dir (N : String);
!    --  Call Add_Src_Search_Dir (output one line when in verbose mode)
  
     procedure Add_Source_Directories is
       new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
  
     procedure Add_Object_Dir (N : String);
!    --  Call Add_Lib_Search_Dir (output one line when in verbose mode)
  
     procedure Add_Object_Directories is
       new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
*************** package body Make is
*** 324,334 ****
        Unit  : Unit_Name_Type;
        Found : Boolean;
     end record;
!    --  File is the name of the file for which a compilation failed.
!    --  Unit is for gnatdist use in order to easily get the unit name
!    --  of a file when its name is krunched or declared in gnat.adc.
!    --  Found is False if the compilation failed because the file could
!    --  not be found.
  
     package Bad_Compilation is new Table.Table (
       Table_Component_Type => Bad_Compilation_Info,
--- 339,348 ----
        Unit  : Unit_Name_Type;
        Found : Boolean;
     end record;
!    --  File is the name of the file for which a compilation failed. Unit is for
!    --  gnatdist use in order to easily get the unit name of a file when its
!    --  name is krunched or declared in gnat.adc. Found is False if the
!    --  compilation failed because the file could not be found.
  
     package Bad_Compilation is new Table.Table (
       Table_Component_Type => Bad_Compilation_Info,
*************** package body Make is
*** 399,405 ****
     --  if an executable is up to date or not.
  
     procedure Enter_Into_Obsoleted (F : Name_Id);
!    --  Enter a file name, without directory information, into the has table
     --  Obsoleted.
  
     function Is_In_Obsoleted (F : Name_Id) return Boolean;
--- 413,419 ----
     --  if an executable is up to date or not.
  
     procedure Enter_Into_Obsoleted (F : Name_Id);
!    --  Enter a file name, without directory information, into the hash table
     --  Obsoleted.
  
     function Is_In_Obsoleted (F : Name_Id) return Boolean;
*************** package body Make is
*** 478,489 ****
     --  Prints out the list of all files for which the compilation failed
  
     procedure Verbose_Msg
!      (N1     : Name_Id;
!       S1     : String;
!       N2     : Name_Id := No_Name;
!       S2     : String  := "";
!       Prefix : String  := "  -> ");
!    --  If the verbose flag (Verbose_Mode) is set then print Prefix to standard
     --  output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
     --  S1. S2 is printed last. Both N1 and N2 are printed in quotation marks.
  
--- 492,505 ----
     --  Prints out the list of all files for which the compilation failed
  
     procedure Verbose_Msg
!      (N1                : Name_Id;
!       S1                : String;
!       N2                : Name_Id := No_Name;
!       S2                : String  := "";
!       Prefix            : String  := "  -> ";
!       Minimum_Verbosity : Verbosity_Level_Type := Opt.Low);
!    --  If the verbose flag (Verbose_Mode) is set and the verbosity level is
!    --  at least equal to Minimum_Verbosity, then print Prefix to standard
     --  output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
     --  S1. S2 is printed last. Both N1 and N2 are printed in quotation marks.
  
*************** package body Make is
*** 502,507 ****
--- 518,527 ----
        Depth   : Natural);
     --  Compute depth of Project and of the projects it depends on
  
+    procedure Compute_All_Imported_Projects (Project : Project_Id);
+    --  Compute, the list of the projects imported directly or indirectly by
+    --  project Project.
+ 
     -----------------------
     -- Gnatmake Routines --
     -----------------------
*************** package body Make is
*** 517,535 ****
     Ada_Lib_Dir : constant Lib_Mark_Type := 1;
     --  Used to mark a directory as a GNAT lib dir
  
!    --  Note that the notion of GNAT lib dir is no longer used. The code
!    --  related to it has not been removed to give an idea on how to use
!    --  the directory prefix marking mechanism.
  
!    --  An Ada library directory is a directory containing ali and object
!    --  files but no source files for the bodies (the specs can be in the
!    --  same or some other directory). These directories are specified
!    --  in the Gnatmake command line with the switch "-Adir" (to specify the
!    --  spec location -Idir cab be used).  Gnatmake skips the missing sources
!    --  whose ali are in Ada library directories. For an explanation of why
!    --  Gnatmake behaves that way, see the spec of Make.Compile_Sources.
!    --  The directory lookup penalty is incurred every single time this
!    --  routine is called.
  
     procedure Check_Steps;
     --  Check what steps (Compile, Bind, Link) must be executed.
--- 537,554 ----
     Ada_Lib_Dir : constant Lib_Mark_Type := 1;
     --  Used to mark a directory as a GNAT lib dir
  
!    --  Note that the notion of GNAT lib dir is no longer used. The code related
!    --  to it has not been removed to give an idea on how to use the directory
!    --  prefix marking mechanism.
  
!    --  An Ada library directory is a directory containing ali and object files
!    --  but no source files for the bodies (the specs can be in the same or some
!    --  other directory). These directories are specified in the Gnatmake
!    --  command line with the switch "-Adir" (to specify the spec location -Idir
!    --  cab be used). Gnatmake skips the missing sources whose ali are in Ada
!    --  library directories. For an explanation of why Gnatmake behaves that
!    --  way, see the spec of Make.Compile_Sources. The directory lookup penalty
!    --  is incurred every single time this routine is called.
  
     procedure Check_Steps;
     --  Check what steps (Compile, Bind, Link) must be executed.
*************** package body Make is
*** 540,549 ****
     --  table for this directory. Then check if an Ada lib mark has been set.
  
     procedure Mark_Directory
!      (Dir  : String;
!       Mark : Lib_Mark_Type);
!    --  Store Dir in name table and set lib mark as name info to identify
!    --  Ada libraries.
  
     Output_Is_Object : Boolean := True;
     --  Set to False when using a switch -S for the compiler
--- 559,573 ----
     --  table for this directory. Then check if an Ada lib mark has been set.
  
     procedure Mark_Directory
!      (Dir             : String;
!       Mark            : Lib_Mark_Type;
!       On_Command_Line : Boolean);
!    --  Store the absolute path from Dir in name table and set lib mark as name
!    --  info to identify Ada libraries.
!    --
!    --  If Dir is a relative path, when On_Command_Line is True, it is relative
!    --  to the current working directory; when On_Command_Line is False, it is
!    --  relative to the project directory of the main project.
  
     Output_Is_Object : Boolean := True;
     --  Set to False when using a switch -S for the compiler
*************** package body Make is
*** 559,570 ****
        Naming           : Naming_Data;
        In_Package       : Package_Id;
        Allow_ALI        : Boolean) return Variable_Value;
!    --  Return the switches for the source file in the specified package
!    --  of a project file. If the Source_File ends with a standard GNAT
!    --  extension (".ads" or ".adb"), try first the full name, then the
!    --  name without the extension, then, if Allow_ALI is True, the name with
!    --  the extension ".ali". If there is no switches for either names, try the
!    --  default switches for Ada. If all failed, return No_Variable_Value.
  
     function Is_In_Object_Directory
       (Source_File   : File_Name_Type;
--- 583,594 ----
        Naming           : Naming_Data;
        In_Package       : Package_Id;
        Allow_ALI        : Boolean) return Variable_Value;
!    --  Return the switches for the source file in the specified package of a
!    --  project file. If the Source_File ends with a standard GNAT extension
!    --  (".ads" or ".adb"), try first the full name, then the name without the
!    --  extension, then, if Allow_ALI is True, the name with the extension
!    --  ".ali". If there is no switches for either names, try the default
!    --  switches for Ada. If all failed, return No_Variable_Value.
  
     function Is_In_Object_Directory
       (Source_File   : File_Name_Type;
*************** package body Make is
*** 783,788 ****
--- 807,834 ----
        Dependencies.Table (Dependencies.Last) := (S, On);
     end Add_Dependency;
  
+    ----------------------------
+    -- Add_Library_Search_Dir --
+    ----------------------------
+ 
+    procedure Add_Library_Search_Dir
+      (Path            : String;
+       On_Command_Line : Boolean)
+    is
+    begin
+       if On_Command_Line then
+          Add_Lib_Search_Dir
+            (Normalize_Pathname (Path));
+ 
+       else
+          Get_Name_String
+            (Project_Tree.Projects.Table (Main_Project).Directory);
+          Add_Lib_Search_Dir
+            (Normalize_Pathname
+               (Path, Name_Buffer (1 .. Name_Len)));
+       end if;
+    end Add_Library_Search_Dir;
+ 
     --------------------
     -- Add_Object_Dir --
     --------------------
*************** package body Make is
*** 815,820 ****
--- 861,888 ----
        end if;
     end Add_Source_Dir;
  
+    ---------------------------
+    -- Add_Source_Search_Dir --
+    ---------------------------
+ 
+    procedure Add_Source_Search_Dir
+      (Path            : String;
+       On_Command_Line : Boolean)
+    is
+    begin
+       if On_Command_Line then
+          Add_Src_Search_Dir
+            (Normalize_Pathname (Path));
+ 
+       else
+          Get_Name_String
+            (Project_Tree.Projects.Table (Main_Project).Directory);
+          Add_Src_Search_Dir
+            (Normalize_Pathname
+               (Path, Name_Buffer (1 .. Name_Len)));
+       end if;
+    end Add_Source_Search_Dir;
+ 
     ----------------
     -- Add_Switch --
     ----------------
*************** package body Make is
*** 836,842 ****
        -- Generic_Position --
        ----------------------
  
!       procedure  Generic_Position (New_Position : out Integer) is
        begin
           T.Increment_Last;
  
--- 904,910 ----
        -- Generic_Position --
        ----------------------
  
!       procedure Generic_Position (New_Position : out Integer) is
        begin
           T.Increment_Last;
  
*************** package body Make is
*** 943,949 ****
             (Source_File      => Name_Find,
              Source_File_Name => File_Name,
              Source_Index     => Index,
!             Naming           => Projects.Table (Main_Project).Naming,
              In_Package       => The_Package,
              Allow_ALI        =>
                Program = Binder or else Program = Linker);
--- 1011,1018 ----
             (Source_File      => Name_Find,
              Source_File_Name => File_Name,
              Source_Index     => Index,
!             Naming           => Project_Tree.Projects.Table
!                                   (Main_Project).Naming,
              In_Package       => The_Package,
              Allow_ALI        =>
                Program = Binder or else Program = Linker);
*************** package body Make is
*** 958,971 ****
                 Switch_List := Switches.Values;
  
                 while Switch_List /= Nil_String loop
!                   Element := String_Elements.Table (Switch_List);
                    Get_Name_String (Element.Value);
  
                    if Name_Len > 0 then
                       declare
                          Argv : constant String := Name_Buffer (1 .. Name_Len);
!                         --  We need a copy, because Name_Buffer may be
!                         --  modified.
  
                       begin
                          if Verbose_Mode then
--- 1027,1040 ----
                 Switch_List := Switches.Values;
  
                 while Switch_List /= Nil_String loop
!                   Element :=
!                     Project_Tree.String_Elements.Table (Switch_List);
                    Get_Name_String (Element.Value);
  
                    if Name_Len > 0 then
                       declare
                          Argv : constant String := Name_Buffer (1 .. Name_Len);
!                         --  We need a copy, because Name_Buffer may be modified
  
                       begin
                          if Verbose_Mode then
*************** package body Make is
*** 1029,1036 ****
           Bind_Args (Args'Range) := Args;
        end if;
  
!       --  It is completely pointless to re-check source file time stamps.
!       --  This has been done already by gnatmake
  
        Bind_Last := Bind_Last + 1;
        Bind_Args (Bind_Last) := Do_Not_Check_Flag;
--- 1098,1105 ----
           Bind_Args (Args'Range) := Args;
        end if;
  
!       --  It is completely pointless to re-check source file time stamps. This
!       --  has been done already by gnatmake
  
        Bind_Last := Bind_Last + 1;
        Bind_Args (Bind_Last) := Do_Not_Check_Flag;
*************** package body Make is
*** 1061,1089 ****
     --------------------------------
  
     procedure Change_To_Object_Directory (Project : Project_Id) is
     begin
!       --  Nothing to do if the current working directory is alresdy the one
!       --  we want.
  
!       if Project_Object_Directory /= Project then
!          Project_Object_Directory := Project;
  
!          --  If in a real project, set the working directory to the object
!          --  directory of the project.
  
!          if Project /= No_Project then
!             Change_Dir
!               (Get_Name_String (Projects.Table (Project).Object_Directory));
  
!          --  Otherwise, for sources outside of any project, set the working
!          --  directory to the object directory of the main project.
  
-          elsif Main_Project /= No_Project then
-             Change_Dir
-               (Get_Name_String
-                  (Projects.Table (Main_Project).Object_Directory));
-          end if;
        end if;
     end Change_To_Object_Directory;
  
     -----------
--- 1130,1174 ----
     --------------------------------
  
     procedure Change_To_Object_Directory (Project : Project_Id) is
+       Actual_Project : Project_Id;
+ 
     begin
!       --  For sources outside of any project, compilation occurs in the object
!       --  directory of the main project, otherwise we use the project given.
  
!       if Project = No_Project then
!          Actual_Project := Main_Project;
!       else
!          Actual_Project := Project;
!       end if;
  
!       --  Nothing to do if the current working directory is already the correct
!       --  object directory.
  
!       if Project_Object_Directory /= Actual_Project then
!          Project_Object_Directory := Actual_Project;
  
!          --  Set the working directory to the object directory of the actual
!          --  project.
! 
!          Change_Dir
!            (Get_Name_String
!               (Project_Tree.Projects.Table
!                  (Actual_Project).Object_Directory));
  
        end if;
+ 
+    exception
+       --  Fail if unable to change to the object directory
+ 
+       when Directory_Error =>
+          Make_Failed ("unable to change to object directory """ &
+                       Get_Name_String
+                         (Project_Tree.Projects.Table
+                            (Actual_Project).Object_Directory) &
+                       """ of project " &
+                       Get_Name_String (Project_Tree.Projects.Table
+                                          (Actual_Project).Display_Name));
     end Change_To_Object_Directory;
  
     -----------
*************** package body Make is
*** 1122,1130 ****
           Spec_File_Name : File_Name_Type := No_File;
  
           function New_Spec (Uname : Unit_Name_Type) return Boolean;
!          --  Uname is the name of the spec or body of some ada unit.
!          --  This function returns True if the Uname is the name of a body
!          --  which has a spec not mentioned inali file A. If True is returned
           --  Spec_File_Name above is set to the name of this spec file.
  
           --------------
--- 1207,1215 ----
           Spec_File_Name : File_Name_Type := No_File;
  
           function New_Spec (Uname : Unit_Name_Type) return Boolean;
!          --  Uname is the name of the spec or body of some ada unit. This
!          --  function returns True if the Uname is the name of a body which has
!          --  a spec not mentioned inali file A. If True is returned
           --  Spec_File_Name above is set to the name of this spec file.
  
           --------------
*************** package body Make is
*** 1242,1250 ****
     begin
        pragma Assert (Lib_File /= No_File);
  
!       --  If the ALI file is read-only, set temporarily
!       --  Check_Object_Consistency to False: we don't care if the object file
!       --  is not there; presumably, a library will be used for linking.
  
        if Read_Only then
           declare
--- 1327,1335 ----
     begin
        pragma Assert (Lib_File /= No_File);
  
!       --  If ALI file is read-only, temporarily set Check_Object_Consistency to
!       --  False. We don't care if the object file is not there (presumably a
!       --  library will be used for linking.)
  
        if Read_Only then
           declare
*************** package body Make is
*** 1266,1274 ****
        Obj_Stamp     := Current_Object_File_Stamp;
  
        if Full_Lib_File = No_File then
!          Verbose_Msg (Lib_File, "being checked ...", Prefix => "  ");
        else
!          Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => "  ");
        end if;
  
        ALI     := No_ALI_Id;
--- 1351,1367 ----
        Obj_Stamp     := Current_Object_File_Stamp;
  
        if Full_Lib_File = No_File then
!          Verbose_Msg
!            (Lib_File,
!             "being checked ...",
!             Prefix => "  ",
!             Minimum_Verbosity => Opt.Medium);
        else
!          Verbose_Msg
!            (Full_Lib_File,
!             "being checked ...",
!             Prefix => "  ",
!             Minimum_Verbosity => Opt.Medium);
        end if;
  
        ALI     := No_ALI_Id;
*************** package body Make is
*** 1362,1374 ****
  
              for J in 1 .. Switches_To_Check.Last loop
  
!                --  Comparing switches is delicate because gcc reorders
!                --  a number of switches, according to lang-specs.h, but
!                --  gnatmake doesn't have the sufficient knowledge to
!                --  perform the same reordering. Instead, we ignore orders
!                --  between different "first letter" switches, but keep
!                --  orders between same switches, e.g -O -O2 is different
!                --  than -O2 -O, but -g -O is equivalent to -O -g.
  
                 if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
                     (Prev_Switch'Length >= 6 and then
--- 1455,1467 ----
  
              for J in 1 .. Switches_To_Check.Last loop
  
!                --  Comparing switches is delicate because gcc reorders a number
!                --  of switches, according to lang-specs.h, but gnatmake doesn't
!                --  have the sufficient knowledge to perform the same
!                --  reordering. Instead, we ignore orders between different
!                --  "first letter" switches, but keep orders between same
!                --  switches, e.g -O -O2 is different than -O2 -O, but -g -O is
!                --  equivalent to -O -g.
  
                 if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
                     (Prev_Switch'Length >= 6 and then
*************** package body Make is
*** 1541,1547 ****
              Name_Len := Name_Len - 1;
           end loop;
  
!          if Name_Len <= 0 then
              return;
  
           elsif Name_Buffer (1) = '-' then
--- 1634,1640 ----
              Name_Len := Name_Len - 1;
           end loop;
  
!          if Name_Len = 0 then
              return;
  
           elsif Name_Buffer (1) = '-' then
*************** package body Make is
*** 1716,1722 ****
                Get_Reference
                (Source_File_Name => Source_File_Name,
                 Project          => Arguments_Project,
!                Path             => Arguments_Path_Name);
  
              --  If the source is not a source of a project file, check if
              --  this is allowed.
--- 1809,1816 ----
                Get_Reference
                (Source_File_Name => Source_File_Name,
                 Project          => Arguments_Project,
!                Path             => Arguments_Path_Name,
!                In_Tree          => Project_Tree);
  
              --  If the source is not a source of a project file, check if
              --  this is allowed.
*************** package body Make is
*** 1736,1749 ****
                 --  We get the project directory for the relative path
                 --  switches and arguments.
  
!                Data := Projects.Table (Arguments_Project);
  
                 --  If the source is in an extended project, we go to
                 --  the ultimate extending project.
  
                 while Data.Extended_By /= No_Project loop
                    Arguments_Project := Data.Extended_By;
!                   Data := Projects.Table (Arguments_Project);
                 end loop;
  
                 --  If building a dynamic or relocatable library, compile with
--- 1830,1844 ----
                 --  We get the project directory for the relative path
                 --  switches and arguments.
  
!                Data := Project_Tree.Projects.Table (Arguments_Project);
  
                 --  If the source is in an extended project, we go to
                 --  the ultimate extending project.
  
                 while Data.Extended_By /= No_Project loop
                    Arguments_Project := Data.Extended_By;
!                   Data :=
!                     Project_Tree.Projects.Table (Arguments_Project);
                 end loop;
  
                 --  If building a dynamic or relocatable library, compile with
*************** package body Make is
*** 1763,1769 ****
                 if Data.Dir_Path = null then
                    Data.Dir_Path :=
                      new String'(Get_Name_String (Data.Display_Directory));
!                   Projects.Table (Arguments_Project) := Data;
                 end if;
  
                 --  We now look for package Compiler
--- 1858,1865 ----
                 if Data.Dir_Path = null then
                    Data.Dir_Path :=
                      new String'(Get_Name_String (Data.Display_Directory));
!                   Project_Tree.Projects.Table (Arguments_Project) :=
!                     Data;
                 end if;
  
                 --  We now look for package Compiler
*************** package body Make is
*** 1772,1778 ****
                 Compiler_Package :=
                   Prj.Util.Value_Of
                     (Name        => Name_Compiler,
!                     In_Packages => Data.Decl.Packages);
  
                 if Compiler_Package /= No_Package then
  
--- 1868,1875 ----
                 Compiler_Package :=
                   Prj.Util.Value_Of
                     (Name        => Name_Compiler,
!                     In_Packages => Data.Decl.Packages,
!                     In_Tree     => Project_Tree);
  
                 if Compiler_Package /= No_Package then
  
*************** package body Make is
*** 1804,1834 ****
  
                       begin
                          while Current /= Nil_String loop
!                            Element := String_Elements.Table (Current);
                             Number  := Number + 1;
                             Current := Element.Next;
                          end loop;
  
                          declare
                             New_Args : Argument_List (1 .. Number);
  
                          begin
                             Current := Switches.Values;
  
                             for Index in New_Args'Range loop
!                               Element := String_Elements.Table (Current);
                                Get_Name_String (Element.Value);
!                               New_Args (Index) :=
!                                 new String'(Name_Buffer (1 .. Name_Len));
!                               Test_If_Relative_Path
!                                 (New_Args (Index), Parent => Data.Dir_Path);
                                Current := Element.Next;
                             end loop;
  
                             Add_Arguments
                               (Configuration_Pragmas_Switch
                                  (Arguments_Project) &
!                               New_Args & The_Saved_Gcc_Switches.all);
                          end;
                       end;
  
--- 1901,1941 ----
  
                       begin
                          while Current /= Nil_String loop
!                            Element := Project_Tree.String_Elements.
!                                         Table (Current);
                             Number  := Number + 1;
                             Current := Element.Next;
                          end loop;
  
                          declare
                             New_Args : Argument_List (1 .. Number);
+                            Last_New : Natural := 0;
  
                          begin
                             Current := Switches.Values;
  
                             for Index in New_Args'Range loop
!                               Element := Project_Tree.String_Elements.
!                                            Table (Current);
                                Get_Name_String (Element.Value);
! 
!                               if Name_Len > 0 then
!                                  Last_New := Last_New + 1;
!                                  New_Args (Last_New) :=
!                                    new String'(Name_Buffer (1 .. Name_Len));
!                                  Test_If_Relative_Path
!                                    (New_Args (Last_New),
!                                     Parent => Data.Dir_Path);
!                               end if;
! 
                                Current := Element.Next;
                             end loop;
  
                             Add_Arguments
                               (Configuration_Pragmas_Switch
                                  (Arguments_Project) &
!                               New_Args (1 .. Last_New) &
!                               The_Saved_Gcc_Switches.all);
                          end;
                       end;
  
*************** package body Make is
*** 2221,2242 ****
           --  check for an eventual library project, and use the full path.
  
           if Arguments_Project /= No_Project then
!             if not Projects.Table (Arguments_Project).Externally_Built then
!                Prj.Env.Set_Ada_Paths (Arguments_Project, True);
  
                 if not Unique_Compile
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
                 then
                    declare
                       The_Data : Project_Data :=
!                                   Projects.Table (Arguments_Project);
  
                       Prj : Project_Id := Arguments_Project;
  
                    begin
                       while The_Data.Extended_By /= No_Project loop
                          Prj := The_Data.Extended_By;
!                         The_Data := Projects.Table (Prj);
                       end loop;
  
                       if The_Data.Library
--- 2328,2353 ----
           --  check for an eventual library project, and use the full path.
  
           if Arguments_Project /= No_Project then
!             if not Project_Tree.Projects.Table
!                      (Arguments_Project).Externally_Built
!             then
!                Prj.Env.Set_Ada_Paths
!                  (Arguments_Project, Project_Tree, True);
  
                 if not Unique_Compile
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
                 then
                    declare
                       The_Data : Project_Data :=
!                                   Project_Tree.Projects.Table
!                                     (Arguments_Project);
  
                       Prj : Project_Id := Arguments_Project;
  
                    begin
                       while The_Data.Extended_By /= No_Project loop
                          Prj := The_Data.Extended_By;
!                         The_Data := Project_Tree.Projects.Table (Prj);
                       end loop;
  
                       if The_Data.Library
*************** package body Make is
*** 2252,2258 ****
  
                          --  Now mark the project as processed
  
!                         Projects.Table (Prj).Need_To_Build_Lib := True;
                       end if;
                    end;
                 end if;
--- 2363,2370 ----
  
                          --  Now mark the project as processed
  
!                         Project_Tree.Projects.Table
!                           (Prj).Need_To_Build_Lib := True;
                       end if;
                    end;
                 end if;
*************** package body Make is
*** 2294,2299 ****
--- 2406,2412 ----
           Comp_Args : Argument_List (Args'First .. Args'Last + 9);
           Comp_Next : Integer := Args'First;
           Comp_Last : Integer;
+          Arg_Index : Integer;
  
           function Ada_File_Name (Name : Name_Id) return Boolean;
           --  Returns True if Name is the name of an ada source file
*************** package body Make is
*** 2358,2371 ****
             and then S = Strip_Directory (S)
           then
              Comp_Last := Comp_Next + Args'Length - 3;
!             Comp_Args (Comp_Next .. Comp_Last) :=
!               Args (Args'First + 1 .. Args'Last - 1);
  
           else
              Comp_Last := Comp_Next + Args'Length - 1;
!             Comp_Args (Comp_Next .. Comp_Last) := Args;
           end if;
  
           --  Set -gnatpg for predefined files (for this purpose the renamings
           --  such as Text_IO do not count as predefined). Note that we strip
           --  the directory name from the source file name becase the call to
--- 2471,2491 ----
             and then S = Strip_Directory (S)
           then
              Comp_Last := Comp_Next + Args'Length - 3;
!             Arg_Index := Args'First + 1;
  
           else
              Comp_Last := Comp_Next + Args'Length - 1;
!             Arg_Index := Args'First;
           end if;
  
+          --  Make a deep copy of the arguments, because Normalize_Arguments
+          --  may deallocate some arguments.
+ 
+          for J in Comp_Next .. Comp_Last loop
+             Comp_Args (J) := new String'(Args (Arg_Index).all);
+             Arg_Index := Arg_Index + 1;
+          end loop;
+ 
           --  Set -gnatpg for predefined files (for this purpose the renamings
           --  such as Text_IO do not count as predefined). Note that we strip
           --  the directory name from the source file name becase the call to
*************** package body Make is
*** 2640,2646 ****
                   and then In_Ada_Lib_Dir (Full_Lib_File)
                 then
                    Verbose_Msg
!                     (Lib_File, "is in an Ada library", Prefix => "  ");
  
                    --  If the library file is a read-only library skip it, but
                    --  only if, when using project files, this library file is
--- 2760,2769 ----
                   and then In_Ada_Lib_Dir (Full_Lib_File)
                 then
                    Verbose_Msg
!                     (Lib_File,
!                      "is in an Ada library",
!                      Prefix => "  ",
!                      Minimum_Verbosity => Opt.High);
  
                    --  If the library file is a read-only library skip it, but
                    --  only if, when using project files, this library file is
*************** package body Make is
*** 2654,2660 ****
                   and then Is_In_Object_Directory (Source_File, Full_Lib_File)
                 then
                    Verbose_Msg
!                     (Lib_File, "is a read-only library", Prefix => "  ");
  
                    --  The source file that we are checking cannot be located
  
--- 2777,2786 ----
                   and then Is_In_Object_Directory (Source_File, Full_Lib_File)
                 then
                    Verbose_Msg
!                     (Lib_File,
!                      "is a read-only library",
!                      Prefix => "  ",
!                      Minimum_Verbosity => Opt.High);
  
                    --  The source file that we are checking cannot be located
  
*************** package body Make is
*** 2677,2683 ****
                    end if;
  
                    Verbose_Msg
!                     (Lib_File, "is an internal library", Prefix => "  ");
  
                 --  The source file that we are checking can be located
  
--- 2803,2812 ----
                    end if;
  
                    Verbose_Msg
!                     (Lib_File,
!                      "is an internal library",
!                      Prefix => "  ",
!                      Minimum_Verbosity => Opt.High);
  
                 --  The source file that we are checking can be located
  
*************** package body Make is
*** 2717,2768 ****
                       end if;
  
                    else
!                      --  Is this the first file we have to compile?
  
!                      if First_Compiled_File = No_File then
!                         First_Compiled_File  := Full_Source_File;
!                         Most_Recent_Obj_File := No_File;
  
!                         if Do_Not_Execute then
!                            exit Make_Loop;
                          end if;
-                      end if;
  
!                      if In_Place_Mode then
  
!                         --  If the library file was not found, then save the
!                         --  library file near the source file.
  
!                         if Full_Lib_File = No_File then
!                            Lib_File := Osint.Lib_File_Name
!                              (Full_Source_File, Source_Index);
  
!                            --  If the library file was found, then save the
!                            --  library file in the same place.
  
!                         else
!                            Lib_File := Full_Lib_File;
!                         end if;
  
!                      end if;
  
!                      --  Start the compilation and record it. We can do this
!                      --  because there is at least one free process.
  
!                      Collect_Arguments_And_Compile (Source_File, Source_Index);
  
!                      --  Make sure we could successfully start the compilation
  
!                      if Process_Created then
!                         if Pid = Invalid_Pid then
!                            Record_Failure (Full_Source_File, Source_Unit);
!                         else
!                            Add_Process
!                              (Pid,
!                               Full_Source_File,
!                               Lib_File,
!                               Source_Unit,
!                               Mfile);
                          end if;
                       end if;
                    end if;
--- 2846,2910 ----
                       end if;
  
                    else
!                      --  Do nothing if project of source is externally built
  
!                      if not Arguments_Collected then
!                         Collect_Arguments (Source_File, Source_Index, Args);
!                      end if;
  
!                      if Arguments_Project = No_Project
!                        or else not Project_Tree.Projects.Table
!                                      (Arguments_Project).Externally_Built
!                      then
!                         --  Is this the first file we have to compile?
! 
!                         if First_Compiled_File = No_File then
!                            First_Compiled_File  := Full_Source_File;
!                            Most_Recent_Obj_File := No_File;
! 
!                            if Do_Not_Execute then
!                               exit Make_Loop;
!                            end if;
                          end if;
  
!                         if In_Place_Mode then
  
!                            --  If the library file was not found, then save
!                            --  the library file near the source file.
  
!                            if Full_Lib_File = No_File then
!                               Lib_File := Osint.Lib_File_Name
!                                 (Full_Source_File, Source_Index);
  
!                               --  If the library file was found, then save the
!                               --  library file in the same place.
  
!                            else
!                               Lib_File := Full_Lib_File;
!                            end if;
  
!                         end if;
  
!                         --  Start the compilation and record it. We can do
!                         --  this because there is at least one free process.
  
!                         Collect_Arguments_And_Compile
!                           (Source_File, Source_Index);
  
!                         --  Make sure we could successfully start
!                         --  the Compilation.
  
!                         if Process_Created then
!                            if Pid = Invalid_Pid then
!                               Record_Failure (Full_Source_File, Source_Unit);
!                            else
!                               Add_Process
!                                 (Pid,
!                                  Full_Source_File,
!                                  Lib_File,
!                                  Source_Unit,
!                                  Mfile);
!                            end if;
                          end if;
                       end if;
                    end if;
*************** package body Make is
*** 2960,2965 ****
--- 3102,3196 ----
  
     end Compile_Sources;
  
+    -----------------------------------
+    -- Compute_All_Imported_Projects --
+    -----------------------------------
+ 
+    procedure Compute_All_Imported_Projects (Project : Project_Id) is
+       procedure Add_To_List (Prj : Project_Id);
+       --  Add a project to the list All_Imported_Projects of project Project
+ 
+       procedure Recursive_Add_Imported (Project : Project_Id);
+       --  Recursively add the projects imported by project Project, but not
+       --  those that are extended.
+ 
+       -----------------
+       -- Add_To_List --
+       -----------------
+ 
+       procedure Add_To_List (Prj : Project_Id) is
+          Element : constant Project_Element :=
+            (Prj, Project_Tree.Projects.Table (Project).All_Imported_Projects);
+          List : Project_List;
+       begin
+          Project_List_Table.Increment_Last (Project_Tree.Project_Lists);
+          List := Project_List_Table.Last (Project_Tree.Project_Lists);
+          Project_Tree.Project_Lists.Table (List) := Element;
+          Project_Tree.Projects.Table (Project).All_Imported_Projects := List;
+       end Add_To_List;
+ 
+       ----------------------------
+       -- Recursive_Add_Imported --
+       ----------------------------
+ 
+       procedure Recursive_Add_Imported (Project : Project_Id) is
+          List    : Project_List;
+          Element : Project_Element;
+          Prj     : Project_Id;
+ 
+       begin
+          if Project /= No_Project then
+ 
+             --  For all the imported projects
+ 
+             List := Project_Tree.Projects.Table (Project).Imported_Projects;
+             while List /= Empty_Project_List loop
+                Element := Project_Tree.Project_Lists.Table (List);
+                Prj := Element.Project;
+ 
+                --  Get the ultimate extending project
+ 
+                while
+                  Project_Tree.Projects.Table (Prj).Extended_By /= No_Project
+                loop
+                   Prj := Project_Tree.Projects.Table (Prj).Extended_By;
+                end loop;
+ 
+                --  If project has not yet been visited, add to list and recurse
+ 
+                if not Project_Tree.Projects.Table (Prj).Seen then
+                   Project_Tree.Projects.Table (Prj).Seen := True;
+                   Add_To_List (Prj);
+                   Recursive_Add_Imported (Prj);
+                end if;
+ 
+                List := Element.Next;
+             end loop;
+ 
+             --  Recurse on projects being imported, if any
+ 
+             Recursive_Add_Imported
+               (Project_Tree.Projects.Table (Project).Extends);
+          end if;
+       end Recursive_Add_Imported;
+ 
+    begin
+       --  Reset the Seen flag for all projects
+ 
+       for Index in 1 .. Project_Table.Last (Project_Tree.Projects) loop
+          Project_Tree.Projects.Table (Index).Seen := False;
+       end loop;
+ 
+       --  Make sure the list is empty
+ 
+       Project_Tree.Projects.Table (Project).All_Imported_Projects :=
+         Empty_Project_List;
+ 
+       --  Add to the list all projects imported directly or indirectly
+ 
+       Recursive_Add_Imported (Project);
+    end Compute_All_Imported_Projects;
+ 
     ----------------------------------
     -- Configuration_Pragmas_Switch --
     ----------------------------------
*************** package body Make is
*** 3006,3012 ****
              else
                 declare
                    Parent_Directory : constant String :=
!                     Get_Name_String (Projects.Table (Project).Directory);
  
                 begin
                    if Parent_Directory (Parent_Directory'Last) =
--- 3237,3245 ----
              else
                 declare
                    Parent_Directory : constant String :=
!                     Get_Name_String
!                       (Project_Tree.Projects.Table
!                            (Project).Directory);
  
                 begin
                    if Parent_Directory (Parent_Directory'Last) =
*************** package body Make is
*** 3025,3041 ****
     --  Start of processing for Configuration_Pragmas_Switch
  
     begin
!       Prj.Env.Create_Config_Pragmas_File (For_Project, Main_Project);
  
!       if Projects.Table (For_Project).Config_File_Name /= No_Name then
           Temporary_Config_File :=
!            Projects.Table (For_Project).Config_File_Temp;
           Last := 1;
           Result (1) :=
             new String'
                   ("-gnatec=" &
                    Get_Name_String
!                     (Projects.Table (For_Project).Config_File_Name));
  
        else
           Temporary_Config_File := False;
--- 3258,3278 ----
     --  Start of processing for Configuration_Pragmas_Switch
  
     begin
!       Prj.Env.Create_Config_Pragmas_File
!         (For_Project, Main_Project, Project_Tree);
  
!       if Project_Tree.Projects.Table
!            (For_Project).Config_File_Name /= No_Name
!       then
           Temporary_Config_File :=
!            Project_Tree.Projects.Table (For_Project).Config_File_Temp;
           Last := 1;
           Result (1) :=
             new String'
                   ("-gnatec=" &
                    Get_Name_String
!                     (Project_Tree.Projects.Table
!                        (For_Project).Config_File_Name));
  
        else
           Temporary_Config_File := False;
*************** package body Make is
*** 3043,3058 ****
  
        --  Check for attribute Builder'Global_Configuration_Pragmas
  
!       The_Packages := Projects.Table (Main_Project).Decl.Packages;
        Gnatmake :=
          Prj.Util.Value_Of
            (Name        => Name_Builder,
!            In_Packages => The_Packages);
  
        if Gnatmake /= No_Package then
           Global_Attribute := Prj.Util.Value_Of
             (Variable_Name => Name_Global_Configuration_Pragmas,
!             In_Variables => Packages.Table (Gnatmake).Decl.Attributes);
           Global_Attribute_Present :=
             Global_Attribute /= Nil_Variable_Value
             and then Get_Name_String (Global_Attribute.Value) /= "";
--- 3280,3299 ----
  
        --  Check for attribute Builder'Global_Configuration_Pragmas
  
!       The_Packages := Project_Tree.Projects.Table
!                         (Main_Project).Decl.Packages;
        Gnatmake :=
          Prj.Util.Value_Of
            (Name        => Name_Builder,
!            In_Packages => The_Packages,
!            In_Tree     => Project_Tree);
  
        if Gnatmake /= No_Package then
           Global_Attribute := Prj.Util.Value_Of
             (Variable_Name => Name_Global_Configuration_Pragmas,
!             In_Variables  => Project_Tree.Packages.Table
!                                (Gnatmake).Decl.Attributes,
!             In_Tree       => Project_Tree);
           Global_Attribute_Present :=
             Global_Attribute /= Nil_Variable_Value
             and then Get_Name_String (Global_Attribute.Value) /= "";
*************** package body Make is
*** 3076,3091 ****
  
        --  Check for attribute Compiler'Local_Configuration_Pragmas
  
!       The_Packages := Projects.Table (For_Project).Decl.Packages;
        Compiler :=
          Prj.Util.Value_Of
            (Name        => Name_Compiler,
!            In_Packages => The_Packages);
  
        if Compiler /= No_Package then
           Local_Attribute := Prj.Util.Value_Of
             (Variable_Name => Name_Local_Configuration_Pragmas,
!             In_Variables => Packages.Table (Compiler).Decl.Attributes);
           Local_Attribute_Present :=
             Local_Attribute /= Nil_Variable_Value
             and then Get_Name_String (Local_Attribute.Value) /= "";
--- 3317,3336 ----
  
        --  Check for attribute Compiler'Local_Configuration_Pragmas
  
!       The_Packages :=
!         Project_Tree.Projects.Table (For_Project).Decl.Packages;
        Compiler :=
          Prj.Util.Value_Of
            (Name        => Name_Compiler,
!            In_Packages => The_Packages,
!            In_Tree     => Project_Tree);
  
        if Compiler /= No_Package then
           Local_Attribute := Prj.Util.Value_Of
             (Variable_Name => Name_Local_Configuration_Pragmas,
!             In_Variables  => Project_Tree.Packages.Table
!                                (Compiler).Decl.Attributes,
!             In_Tree       => Project_Tree);
           Local_Attribute_Present :=
             Local_Attribute /= Nil_Variable_Value
             and then Get_Name_String (Local_Attribute.Value) /= "";
*************** package body Make is
*** 3134,3140 ****
        if Gnatmake_Called and not Debug.Debug_Flag_N then
           Delete_Mapping_Files;
           Delete_Temp_Config_Files;
!          Prj.Env.Delete_All_Path_Files;
        end if;
     end Delete_All_Temp_Files;
  
--- 3379,3385 ----
        if Gnatmake_Called and not Debug.Debug_Flag_N then
           Delete_Mapping_Files;
           Delete_Temp_Config_Files;
!          Prj.Env.Delete_All_Path_Files (Project_Tree);
        end if;
     end Delete_All_Temp_Files;
  
*************** package body Make is
*** 3167,3184 ****
        Success : Boolean;
     begin
        if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then
!          for Project in 1 .. Projects.Last loop
!             if Projects.Table (Project).Config_File_Temp then
                 if Verbose_Mode then
                    Write_Str ("Deleting temp configuration file """);
                    Write_Str (Get_Name_String
!                              (Projects.Table (Project).Config_File_Name));
                    Write_Line ("""");
                 end if;
  
                 Delete_File
                   (Name    => Get_Name_String
!                   (Projects.Table (Project).Config_File_Name),
                    Success => Success);
  
                 --  Make sure that we don't have a config file for this
--- 3412,3435 ----
        Success : Boolean;
     begin
        if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then
!          for Project in Project_Table.First ..
!                         Project_Table.Last (Project_Tree.Projects)
!          loop
!             if
!               Project_Tree.Projects.Table (Project).Config_File_Temp
!             then
                 if Verbose_Mode then
                    Write_Str ("Deleting temp configuration file """);
                    Write_Str (Get_Name_String
!                                (Project_Tree.Projects.Table
!                                   (Project).Config_File_Name));
                    Write_Line ("""");
                 end if;
  
                 Delete_File
                   (Name    => Get_Name_String
!                                (Project_Tree.Projects.Table
!                                   (Project).Config_File_Name),
                    Success => Success);
  
                 --  Make sure that we don't have a config file for this
*************** package body Make is
*** 3186,3194 ****
                 --  In this case, we will recreate another config file:
                 --  we cannot reuse the one that we just deleted!
  
!                Projects.Table (Project).Config_Checked   := False;
!                Projects.Table (Project).Config_File_Name := No_Name;
!                Projects.Table (Project).Config_File_Temp := False;
              end if;
           end loop;
        end if;
--- 3437,3448 ----
                 --  In this case, we will recreate another config file:
                 --  we cannot reuse the one that we just deleted!
  
!                Project_Tree.Projects.Table (Project).
!                  Config_Checked := False;
!                Project_Tree.Projects.Table (Project).
!                  Config_File_Name := No_Name;
!                Project_Tree.Projects.Table (Project).
!                  Config_File_Temp := False;
              end if;
           end loop;
        end if;
*************** package body Make is
*** 3446,3452 ****
  
                 --  Get the project of the current main
  
!                Proj := Prj.Env.Project_Of (File_Name, Main_Project);
  
                 --  Fail if the current main is not a source of a
                 --  project.
--- 3700,3707 ----
  
                 --  Get the project of the current main
  
!                Proj := Prj.Env.Project_Of
!                          (File_Name, Main_Project, Project_Tree);
  
                 --  Fail if the current main is not a source of a
                 --  project.
*************** package body Make is
*** 3462,3468 ****
                    --  is the actual path of a source of a project.
  
                    if Main /= File_Name then
!                      Data := Projects.Table (Main_Project);
  
                       Real_Path :=
                         Locate_Regular_File
--- 3717,3724 ----
                    --  is the actual path of a source of a project.
  
                    if Main /= File_Name then
!                      Data :=
!                        Project_Tree.Projects.Table (Main_Project);
  
                       Real_Path :=
                         Locate_Regular_File
*************** package body Make is
*** 3496,3501 ****
--- 3752,3758 ----
                                           Prj.Env.File_Name_Of_Library_Unit_Body
                                             (Name              => File_Name,
                                              Project           => Main_Project,
+                                             In_Tree           => Project_Tree,
                                              Main_Project_Only => False,
                                              Full_Path         => True);
                          Normed_Path  : constant String :=
*************** package body Make is
*** 3542,3548 ****
                            ("""" & Main &
                             """ is not a source of project " &
                             Get_Name_String
!                              (Projects.Table
                                  (Real_Main_Project).Name));
                       end if;
                    end if;
--- 3799,3805 ----
                            ("""" & Main &
                             """ is not a source of project " &
                             Get_Name_String
!                              (Project_Tree.Projects.Table
                                  (Real_Main_Project).Name));
                       end if;
                    end if;
*************** package body Make is
*** 3591,3602 ****
  
              --  Traverse all units
  
!             for J in Prj.Com.Units.First .. Prj.Com.Units.Last loop
                 declare
!                   Unit : constant Prj.Com.Unit_Data :=
!                            Prj.Com.Units.Table (J);
!                   use Prj.Com;
! 
                 begin
                    if Unit.Name /= No_Name then
  
--- 3848,3859 ----
  
              --  Traverse all units
  
!             for J in Unit_Table.First ..
!                      Unit_Table.Last (Project_Tree.Units)
!             loop
                 declare
!                   Unit : constant Unit_Data :=
!                            Project_Tree.Units.Table (J);
                 begin
                    if Unit.Name /= No_Name then
  
*************** package body Make is
*** 3650,3658 ****
  
                       if ALI_Name /= No_Name
                         and then
!                          Projects.Table (ALI_Project).Extended_By = No_Project
                         and then
!                          Projects.Table (ALI_Project).Extends = No_Project
                       then
                          --  First line is the unit name
  
--- 3907,3917 ----
  
                       if ALI_Name /= No_Name
                         and then
!                          Project_Tree.Projects.Table
!                            (ALI_Project).Extended_By = No_Project
                         and then
!                          Project_Tree.Projects.Table
!                            (ALI_Project).Extends = No_Project
                       then
                          --  First line is the unit name
  
*************** package body Make is
*** 3682,3698 ****
  
                          exit when not OK;
  
!                         --  Third line it the ALI path name,
!                         --  concatenation of the project
                          --  directory with the ALI file name.
  
                          declare
                             ALI : constant String :=
                                     Get_Name_String (ALI_Name);
                          begin
!                            Get_Name_String
!                              (Projects.Table (ALI_Project).
!                                 Object_Directory);
  
                             if Name_Buffer (Name_Len) /=
                               Directory_Separator
--- 3941,3965 ----
  
                          exit when not OK;
  
!                         --  Third line it the ALI path name, concatenation
!                         --  of either the library directory or the object
                          --  directory with the ALI file name.
  
                          declare
                             ALI : constant String :=
                                     Get_Name_String (ALI_Name);
+                            PD  : Project_Data renames
+                                    Project_Tree.Projects.Table (ALI_Project);
+ 
                          begin
!                            --  For library projects, use the library directory,
!                            --  for other projects, use the object directory.
! 
!                            if PD.Library then
!                               Get_Name_String (PD.Library_Dir);
!                            else
!                               Get_Name_String (PD.Object_Directory);
!                            end if;
  
                             if Name_Buffer (Name_Len) /=
                               Directory_Separator
*************** package body Make is
*** 3792,3798 ****
  
           --  And the project file cannot be a library project file
  
!          elsif Projects.Table (Main_Project).Library then
              Make_Failed ("-B cannot be used for a library project file");
  
           else
--- 4059,4065 ----
  
           --  And the project file cannot be a library project file
  
!          elsif Project_Tree.Projects.Table (Main_Project).Library then
              Make_Failed ("-B cannot be used for a library project file");
  
           else
*************** package body Make is
*** 3832,3838 ****
           --  cannot be specified on the command line.
  
           if Osint.Number_Of_Files /= 0 then
!             if Projects.Table (Main_Project).Library
                and then not Unique_Compile
                and then ((not Make_Steps) or else Bind_Only or else Link_Only)
              then
--- 4099,4105 ----
           --  cannot be specified on the command line.
  
           if Osint.Number_Of_Files /= 0 then
!             if Project_Tree.Projects.Table (Main_Project).Library
                and then not Unique_Compile
                and then ((not Make_Steps) or else Bind_Only or else Link_Only)
              then
*************** package body Make is
*** 3859,3865 ****
              end if;
  
              declare
!                Value : String_List_Id := Projects.Table (Main_Project).Mains;
  
              begin
                 --  The attribute Main is an empty list or not specified,
--- 4126,4133 ----
              end if;
  
              declare
!                Value : String_List_Id :=
!                  Project_Tree.Projects.Table (Main_Project).Mains;
  
              begin
                 --  The attribute Main is an empty list or not specified,
*************** package body Make is
*** 3868,3874 ****
                 if Value = Prj.Nil_String or else Unique_Compile then
  
                    if (not Make_Steps) or else Compile_Only
!                     or else not Projects.Table (Main_Project).Library
                    then
                       --  First make sure that the binder and the linker
                       --  will not be invoked.
--- 4136,4143 ----
                 if Value = Prj.Nil_String or else Unique_Compile then
  
                    if (not Make_Steps) or else Compile_Only
!                     or else not Project_Tree.Projects.Table
!                                   (Main_Project).Library
                    then
                       --  First make sure that the binder and the linker
                       --  will not be invoked.
*************** package body Make is
*** 3883,3892 ****
                          All_Projects => Unique_Compile_All_Projects,
                          Into_Q       => False);
  
!                      --  If there are no sources to compile, we fail
  
                       if Osint.Number_Of_Files = 0 then
!                         Make_Failed ("no sources to compile");
                       end if;
                    end if;
  
--- 4152,4171 ----
                          All_Projects => Unique_Compile_All_Projects,
                          Into_Q       => False);
  
!                      --  If no sources to compile, then there is nothing to do
  
                       if Osint.Number_Of_Files = 0 then
!                         if not Debug.Debug_Flag_N then
!                            Delete_Mapping_Files;
!                            Prj.Env.Delete_All_Path_Files (Project_Tree);
!                         end if;
! 
!                         if not Quiet_Output then
!                            Osint.Write_Program_Name;
!                            Write_Line (": no sources to compile");
!                         end if;
! 
!                         Exit_Program (E_Success);
                       end if;
                    end if;
  
*************** package body Make is
*** 3900,3910 ****
  
                    declare
                       Data : constant Project_Data :=
!                               Projects.Table (Main_Project);
  
                       Languages : constant Variable_Value :=
                                     Prj.Util.Value_Of
!                                      (Name_Languages, Data.Decl.Attributes);
  
                       Current : String_List_Id;
                       Element : String_Element;
--- 4179,4191 ----
  
                    declare
                       Data : constant Project_Data :=
!                            Project_Tree.Projects.Table (Main_Project);
  
                       Languages : constant Variable_Value :=
                                     Prj.Util.Value_Of
!                                     (Name_Languages,
!                                      Data.Decl.Attributes,
!                                      Project_Tree);
  
                       Current : String_List_Id;
                       Element : String_Element;
*************** package body Make is
*** 3921,3927 ****
  
                          Look_For_Foreign :
                          while Current /= Nil_String loop
!                            Element := String_Elements.Table (Current);
                             Get_Name_String (Element.Value);
                             To_Lower (Name_Buffer (1 .. Name_Len));
  
--- 4202,4209 ----
  
                          Look_For_Foreign :
                          while Current /= Nil_String loop
!                            Element := Project_Tree.String_Elements.
!                                         Table (Current);
                             Get_Name_String (Element.Value);
                             To_Lower (Name_Buffer (1 .. Name_Len));
  
*************** package body Make is
*** 3938,3944 ****
                       --  language, all the Ada mains.
  
                       while Value /= Prj.Nil_String loop
!                         Get_Name_String (String_Elements.Table (Value).Value);
  
                          --  To know if a main is an Ada main, get its project.
                          --  It should be the project specified on the command
--- 4220,4228 ----
                       --  language, all the Ada mains.
  
                       while Value /= Prj.Nil_String loop
!                         Get_Name_String
!                           (Project_Tree.String_Elements.Table
!                              (Value).Value);
  
                          --  To know if a main is an Ada main, get its project.
                          --  It should be the project specified on the command
*************** package body Make is
*** 3946,3962 ****
  
                          if (not Foreign_Language) or else
                              Prj.Env.Project_Of
!                               (Name_Buffer (1 .. Name_Len), Main_Project) =
                               Main_Project
                          then
                             At_Least_One_Main := True;
                             Osint.Add_File
                               (Get_Name_String
!                                 (String_Elements.Table (Value).Value),
!                               Index => String_Elements.Table (Value).Index);
                          end if;
  
!                         Value := String_Elements.Table (Value).Next;
                       end loop;
  
                       --  If we did not get any main, it means that all mains
--- 4230,4252 ----
  
                          if (not Foreign_Language) or else
                              Prj.Env.Project_Of
!                               (Name_Buffer (1 .. Name_Len),
!                                Main_Project,
!                                Project_Tree) =
                               Main_Project
                          then
                             At_Least_One_Main := True;
                             Osint.Add_File
                               (Get_Name_String
!                                 (Project_Tree.String_Elements.Table
!                                    (Value).Value),
!                               Index =>
!                                 Project_Tree.String_Elements.Table
!                                   (Value).Index);
                          end if;
  
!                         Value := Project_Tree.String_Elements.Table
!                                    (Value).Next;
                       end loop;
  
                       --  If we did not get any main, it means that all mains
*************** package body Make is
*** 3984,3990 ****
        end if;
  
        if Main_Project /= No_Project
!         and then Projects.Table (Main_Project).Externally_Built
        then
           Make_Failed
             ("nothing to do for a main project that is externally built");
--- 4274,4281 ----
        end if;
  
        if Main_Project /= No_Project
!         and then Project_Tree.Projects.Table
!                    (Main_Project).Externally_Built
        then
           Make_Failed
             ("nothing to do for a main project that is externally built");
*************** package body Make is
*** 3992,4001 ****
  
        if Osint.Number_Of_Files = 0 then
           if Main_Project /= No_Project
!            and then Projects.Table (Main_Project).Library
           then
              if Do_Bind_Step
!               and then not Projects.Table (Main_Project).Standalone_Library
              then
                 Make_Failed ("only stand-alone libraries may be bound");
              end if;
--- 4283,4293 ----
  
        if Osint.Number_Of_Files = 0 then
           if Main_Project /= No_Project
!            and then Project_Tree.Projects.Table (Main_Project).Library
           then
              if Do_Bind_Step
!               and then not Project_Tree.Projects.Table
!                              (Main_Project).Standalone_Library
              then
                 Make_Failed ("only stand-alone libraries may be bound");
              end if;
*************** package body Make is
*** 4008,4013 ****
--- 4300,4306 ----
  
              MLib.Prj.Build_Library
                (For_Project   => Main_Project,
+                In_Tree       => Project_Tree,
                 Gnatbind      => Gnatbind.all,
                 Gnatbind_Path => Gnatbind_Path,
                 Gcc           => Gcc.all,
*************** package body Make is
*** 4079,4142 ****
  
        if Main_Project /= No_Project then
  
!          if Projects.Table (Main_Project).Object_Directory /= No_Name then
! 
!             --  Change the current directory to the object directory of
!             --  the main project.
! 
!             begin
!                Project_Object_Directory := No_Project;
!                Change_To_Object_Directory (Main_Project);
! 
!             exception
!                when Directory_Error =>
! 
!                   --  This should never happen. But, if it does, display the
!                   --  content of the parent directory of the obj dir.
! 
!                   declare
!                      Parent : constant Dir_Name_Str :=
!                                 Dir_Name
!                                   (Get_Name_String
!                                      (Projects.Table
!                                         (Main_Project).Object_Directory));
! 
!                      Dir  : Dir_Type;
!                      Str  : String (1 .. 200);
!                      Last : Natural;
! 
!                   begin
!                      Write_Str ("Contents of directory """);
!                      Write_Str (Parent);
!                      Write_Line (""":");
! 
!                      Open (Dir, Parent);
! 
!                      loop
!                         Read (Dir, Str, Last);
!                         exit when Last = 0;
!                         Write_Str ("   ");
!                         Write_Line (Str (1 .. Last));
!                      end loop;
! 
!                      Close (Dir);
! 
!                   exception
!                      when X : others =>
!                         Write_Line ("(unexpected exception)");
!                         Write_Line (Exception_Information (X));
! 
!                         if Is_Open (Dir) then
!                            Close (Dir);
!                         end if;
!                   end;
  
!                   Make_Failed
!                     ("unable to change working directory to """,
!                      Get_Name_String
!                        (Projects.Table (Main_Project).Object_Directory),
!                      """");
!             end;
           end if;
  
           --  Source file lookups should be cached for efficiency.
--- 4372,4384 ----
  
        if Main_Project /= No_Project then
  
!          if Project_Tree.Projects.Table
!               (Main_Project).Object_Directory /= No_Name
!          then
!             --  Change current directory to object directory of main project
  
!             Project_Object_Directory := No_Project;
!             Change_To_Object_Directory (Main_Project);
           end if;
  
           --  Source file lookups should be cached for efficiency.
*************** package body Make is
*** 4153,4178 ****
                                        Prj.Env.File_Name_Of_Library_Unit_Body
                                          (Name    => Main_Source_File_Name,
                                           Project => Main_Project,
                                           Main_Project_Only =>
                                             not Unique_Compile);
  
              The_Packages : constant Package_Id :=
!               Projects.Table (Main_Project).Decl.Packages;
  
              Builder_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
                             (Name        => Name_Builder,
!                             In_Packages => The_Packages);
  
              Binder_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
                             (Name        => Name_Binder,
!                             In_Packages => The_Packages);
  
              Linker_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
!                            (Name       => Name_Linker,
!                             In_Packages => The_Packages);
  
           begin
              --  We fail if we cannot find the main source file
--- 4395,4424 ----
                                        Prj.Env.File_Name_Of_Library_Unit_Body
                                          (Name    => Main_Source_File_Name,
                                           Project => Main_Project,
+                                          In_Tree => Project_Tree,
                                           Main_Project_Only =>
                                             not Unique_Compile);
  
              The_Packages : constant Package_Id :=
!               Project_Tree.Projects.Table (Main_Project).Decl.Packages;
  
              Builder_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
                             (Name        => Name_Builder,
!                             In_Packages => The_Packages,
!                             In_Tree     => Project_Tree);
  
              Binder_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
                             (Name        => Name_Binder,
!                             In_Packages => The_Packages,
!                             In_Tree     => Project_Tree);
  
              Linker_Package : constant Prj.Package_Id :=
                           Prj.Util.Value_Of
!                            (Name        => Name_Linker,
!                             In_Packages => The_Packages,
!                             In_Tree     => Project_Tree);
  
           begin
              --  We fail if we cannot find the main source file
*************** package body Make is
*** 4250,4262 ****
                           (Name                    => Name_Ada,
                            Index                   => 0,
                            Attribute_Or_Array_Name => Name_Default_Switches,
!                           In_Package              => Builder_Package);
  
                       Switches : constant Array_Element_Id :=
                            Prj.Util.Value_Of
                               (Name      => Name_Switches,
                                In_Arrays =>
!                                 Packages.Table (Builder_Package).Decl.Arrays);
  
                    begin
                       if Defaults /= Nil_Variable_Value then
--- 4496,4511 ----
                           (Name                    => Name_Ada,
                            Index                   => 0,
                            Attribute_Or_Array_Name => Name_Default_Switches,
!                           In_Package              => Builder_Package,
!                           In_Tree                 => Project_Tree);
  
                       Switches : constant Array_Element_Id :=
                            Prj.Util.Value_Of
                               (Name      => Name_Switches,
                                In_Arrays =>
!                                 Project_Tree.Packages.Table
!                                   (Builder_Package).Decl.Arrays,
!                               In_Tree   => Project_Tree);
  
                    begin
                       if Defaults /= Nil_Variable_Value then
*************** package body Make is
*** 4359,4388 ****
           if not Unique_Compile
             and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
           then
!             for Proj in Projects.First .. Projects.Last loop
!                if Projects.Table (Proj).Library then
!                   Projects.Table (Proj).Need_To_Build_Lib :=
!                     (not MLib.Tgt.Library_Exists_For (Proj))
!                     and then (not Projects.Table (Proj).Externally_Built);
! 
!                   if Projects.Table (Proj).Need_To_Build_Lib then
  
                       --  If there is no object directory, then it will be
                       --  impossible to build the library. So fail immediately.
  
!                      if Projects.Table (Proj).Object_Directory = No_Name then
                          Make_Failed
                            ("no object files to build library for project """,
!                            Get_Name_String (Projects.Table (Proj).Name),
                             """");
!                         Projects.Table (Proj).Need_To_Build_Lib := False;
  
                       else
                          if Verbose_Mode then
                             Write_Str
                               ("Library file does not exist for project """);
                             Write_Str
!                              (Get_Name_String (Projects.Table (Proj).Name));
                             Write_Line ("""");
                          end if;
  
--- 4608,4648 ----
           if not Unique_Compile
             and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
           then
!             for Proj in Project_Table.First ..
!                         Project_Table.Last (Project_Tree.Projects)
!             loop
!                if Project_Tree.Projects.Table (Proj).Library then
!                   Project_Tree.Projects.Table
!                     (Proj).Need_To_Build_Lib :=
!                       (not MLib.Tgt.Library_Exists_For (Proj, Project_Tree))
!                     and then (not Project_Tree.Projects.Table
!                                 (Proj).Externally_Built);
  
+                   if Project_Tree.Projects.Table
+                        (Proj).Need_To_Build_Lib
+                   then
                       --  If there is no object directory, then it will be
                       --  impossible to build the library. So fail immediately.
  
!                      if Project_Tree.Projects.Table
!                        (Proj).Object_Directory = No_Name
!                      then
                          Make_Failed
                            ("no object files to build library for project """,
!                            Get_Name_String
!                              (Project_Tree.Projects.Table (Proj).Name),
                             """");
!                         Project_Tree.Projects.Table
!                           (Proj).Need_To_Build_Lib := False;
  
                       else
                          if Verbose_Mode then
                             Write_Str
                               ("Library file does not exist for project """);
                             Write_Str
!                              (Get_Name_String
!                                 (Project_Tree.Projects.Table
!                                    (Proj).Name));
                             Write_Line ("""");
                          end if;
  
*************** package body Make is
*** 4407,4423 ****
  
                 begin
                    if not Is_Absolute_Path (Exec_File_Name) then
!                      for Index in Exec_File_Name'Range loop
!                         if Exec_File_Name (Index) = Directory_Separator then
!                            Make_Failed ("relative executable (""",
!                                         Exec_File_Name,
!                                         """) with directory part not " &
!                                         "allowed when using project files");
!                         end if;
!                      end loop;
! 
!                      Get_Name_String (Projects.Table
!                                         (Main_Project).Exec_Directory);
  
                       if Name_Buffer (Name_Len) /= Directory_Separator then
                          Name_Len := Name_Len + 1;
--- 4667,4675 ----
  
                 begin
                    if not Is_Absolute_Path (Exec_File_Name) then
!                      Get_Name_String
!                        (Project_Tree.Projects.Table
!                           (Main_Project).Exec_Directory);
  
                       if Name_Buffer (Name_Len) /= Directory_Separator then
                          Name_Len := Name_Len + 1;
*************** package body Make is
*** 4445,4451 ****
           declare
              Dir_Path : constant String_Access :=
                new String'(Get_Name_String
!                             (Projects.Table (Main_Project).Directory));
           begin
              for J in 1 .. Binder_Switches.Last loop
                 Test_If_Relative_Path
--- 4697,4704 ----
           declare
              Dir_Path : constant String_Access :=
                new String'(Get_Name_String
!                             (Project_Tree.Projects.Table
!                                (Main_Project).Directory));
           begin
              for J in 1 .. Binder_Switches.Last loop
                 Test_If_Relative_Path
*************** package body Make is
*** 4481,4490 ****
           end;
        end if;
  
!       --  We now put in the Binder_Switches and Linker_Switches tables,
!       --  the binder and linker switches of the command line that have been
!       --  put in the Saved_ tables. If a project file was used, then the
!       --  command line switches will follow the project file switches.
  
        for J in 1 .. Saved_Binder_Switches.Last loop
           Add_Switch
--- 4734,4743 ----
           end;
        end if;
  
!       --  We now put in the Binder_Switches and Linker_Switches tables, the
!       --  binder and linker switches of the command line that have been put in
!       --  the Saved_ tables. If a project file was used, then the command line
!       --  switches will follow the project file switches.
  
        for J in 1 .. Saved_Binder_Switches.Last loop
           Add_Switch
*************** package body Make is
*** 4563,4577 ****
  
        The_Mapping_File_Names :=
          new Temp_File_Names
!               (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
        Last_Mapping_File_Names :=
!         new Indices'(No_Project .. Projects.Last => 0);
  
        The_Free_Mapping_File_Indices :=
          new Free_File_Indices
!               (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
        Last_Free_Indices :=
!         new Indices'(No_Project .. Projects.Last => 0);
  
        Bad_Compilation.Init;
  
--- 4816,4835 ----
  
        The_Mapping_File_Names :=
          new Temp_File_Names
!           (No_Project .. Project_Table.Last (Project_Tree.Projects),
!            1 .. Saved_Maximum_Processes);
        Last_Mapping_File_Names :=
!         new Indices'
!           (No_Project .. Project_Table.Last (Project_Tree.Projects)
!             => 0);
  
        The_Free_Mapping_File_Indices :=
          new Free_File_Indices
!           (No_Project .. Project_Table.Last (Project_Tree.Projects),
!            1 .. Saved_Maximum_Processes);
        Last_Free_Indices :=
!         new Indices'(No_Project .. Project_Table.Last
!                                      (Project_Tree.Projects) => 0);
  
        Bad_Compilation.Init;
  
*************** package body Make is
*** 4632,4639 ****
                 --  executable "main.2" for a main subprogram
                 --  "main.2.ada", when the body termination is ".2.ada".
  
!                Executable := Prj.Util.Executable_Of
!                                (Main_Project, Main_Source_File, Main_Index);
              end if;
           end if;
  
--- 4890,4898 ----
                 --  executable "main.2" for a main subprogram
                 --  "main.2.ada", when the body termination is ".2.ada".
  
!                Executable :=
!                  Prj.Util.Executable_Of
!                    (Main_Project, Project_Tree, Main_Source_File, Main_Index);
              end if;
           end if;
  
*************** package body Make is
*** 4644,4660 ****
  
              begin
                 if not Is_Absolute_Path (Exec_File_Name) then
-                   for Index in Exec_File_Name'Range loop
-                      if Exec_File_Name (Index) = Directory_Separator then
-                         Make_Failed ("relative executable (""",
-                                            Exec_File_Name,
-                                            """) with directory part not " &
-                                            "allowed when using project files");
-                      end if;
-                   end loop;
  
!                   Get_Name_String (Projects.Table
!                                            (Main_Project).Exec_Directory);
  
                    if
                      Name_Buffer (Name_Len) /= Directory_Separator
--- 4903,4911 ----
  
              begin
                 if not Is_Absolute_Path (Exec_File_Name) then
  
!                   Get_Name_String (Project_Tree.Projects.Table
!                                      (Main_Project).Exec_Directory);
  
                    if
                      Name_Buffer (Name_Len) /= Directory_Separator
*************** package body Make is
*** 4669,4676 ****
  
                    Name_Len := Name_Len + Exec_File_Name'Length;
                    Executable := Name_Find;
-                   Non_Std_Executable := True;
                 end if;
              end;
           end if;
  
--- 4920,4928 ----
  
                    Name_Len := Name_Len + Exec_File_Name'Length;
                    Executable := Name_Find;
                 end if;
+ 
+                Non_Std_Executable := True;
              end;
           end if;
  
*************** package body Make is
*** 4737,4790 ****
  
                 if Main_Project /= No_Project
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
!                  and then (Do_Bind_Step or Unique_Compile_All_Projects
!                            or not Compile_Only)
                   and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
                 then
                    Library_Projs.Init;
  
                    declare
-                      Proj2   : Project_Id;
                       Depth   : Natural;
                       Current : Natural;
  
                    begin
                       --  Put in Library_Projs table all library project
                       --  file ids when the library need to be rebuilt.
  
!                      for Proj1 in Projects.First .. Projects.Last loop
! 
!                         if Projects.Table (Proj1).Standalone_Library then
                             There_Are_Stand_Alone_Libraries := True;
                          end if;
  
!                         if Projects.Table (Proj1).Library
!                           and then not Projects.Table (Proj1).Need_To_Build_Lib
!                           and then not Projects.Table (Proj1).Externally_Built
                          then
!                            MLib.Prj.Check_Library (Proj1);
                          end if;
  
!                         if Projects.Table (Proj1).Need_To_Build_Lib then
!                            Library_Projs.Increment_Last;
!                            Current := Library_Projs.Last;
!                            Depth := Projects.Table (Proj1).Depth;
  
!                            --  Put the projects in decreasing depth order,
!                            --  so that if libA depends on libB, libB is first
!                            --  in order.
  
!                            while Current > 1 loop
!                               Proj2 := Library_Projs.Table (Current - 1);
!                               exit when Projects.Table (Proj2).Depth >= Depth;
!                               Library_Projs.Table (Current) := Proj2;
!                               Current := Current - 1;
!                            end loop;
  
!                            Library_Projs.Table (Current) := Proj1;
!                            Projects.Table (Proj1).Need_To_Build_Lib := False;
                          end if;
                       end loop;
                    end;
  
                    --  Build the libraries, if any need to be built
--- 4989,5130 ----
  
                 if Main_Project /= No_Project
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
!                  and then (Do_Bind_Step
!                              or Unique_Compile_All_Projects
!                              or not Compile_Only)
                   and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
                 then
                    Library_Projs.Init;
  
                    declare
                       Depth   : Natural;
                       Current : Natural;
  
+                      procedure Add_To_Library_Projs (Proj : Project_Id);
+                      --  Add project Project to table Library_Projs
+                      --  in decreasing depth order.
+ 
+                      --------------------------
+                      -- Add_To_Library_Projs --
+                      --------------------------
+ 
+                      procedure Add_To_Library_Projs (Proj : Project_Id) is
+                         Prj   : Project_Id;
+ 
+                      begin
+                         Library_Projs.Increment_Last;
+                         Depth := Project_Tree.Projects.Table (Proj).Depth;
+ 
+                         --  Put the projects in decreasing depth order,
+                         --  so that if libA depends on libB, libB is first
+                         --  in order.
+ 
+                         Current := Library_Projs.Last;
+                         while Current > 1 loop
+                            Prj := Library_Projs.Table (Current - 1);
+                            exit when Project_Tree.Projects.Table
+                              (Prj).Depth >= Depth;
+                            Library_Projs.Table (Current) := Prj;
+                            Current := Current - 1;
+                         end loop;
+ 
+                         Library_Projs.Table (Current) := Proj;
+                      end Add_To_Library_Projs;
+ 
+                   --  Start of processing for ??? (should name declare block
+                   --  or probably better, break this out as a nested proc.
+ 
                    begin
                       --  Put in Library_Projs table all library project
                       --  file ids when the library need to be rebuilt.
  
!                      for Proj1 in Project_Table.First ..
!                                   Project_Table.Last (Project_Tree.Projects)
!                      loop
!                         if Project_Tree.Projects.Table
!                           (Proj1).Standalone_Library
!                         then
                             There_Are_Stand_Alone_Libraries := True;
                          end if;
  
!                         if Project_Tree.Projects.Table (Proj1).Library then
!                            MLib.Prj.Check_Library (Proj1, Project_Tree);
!                         end if;
! 
!                         if Project_Tree.Projects.Table
!                              (Proj1).Need_To_Build_Lib
                          then
!                            Add_To_Library_Projs (Proj1);
                          end if;
+                      end loop;
  
!                      --  Check if importing libraries should be regenerated
!                      --  because at least an imported library will be
!                      --  regenerated or is more recent.
  
!                      for Proj1 in Project_Table.First ..
!                                   Project_Table.Last (Project_Tree.Projects)
!                      loop
!                         if Project_Tree.Projects.Table (Proj1).Library
!                           and then not Project_Tree.Projects.Table
!                             (Proj1).Need_To_Build_Lib
!                           and then not Project_Tree.Projects.Table
!                             (Proj1).Externally_Built
!                         then
!                            declare
!                               List    : Project_List;
!                               Element : Project_Element;
!                               Proj2   : Project_Id;
!                               Rebuild : Boolean := False;
  
!                               Lib_Timestamp1 : constant Time_Stamp_Type :=
!                                                  Project_Tree.Projects.Table
!                                                    (Proj1). Library_TS;
  
!                            begin
!                               List := Project_Tree.Projects.Table (Proj1).
!                                                       All_Imported_Projects;
!                               while List /= Empty_Project_List loop
!                                  Element :=
!                                    Project_Tree.Project_Lists.Table (List);
!                                  Proj2 := Element.Project;
! 
!                                  if
!                                    Project_Tree.Projects.Table (Proj2).Library
!                                  then
!                                     if Project_Tree.Projects.Table (Proj2).
!                                           Need_To_Build_Lib
!                                       or else
!                                         (Lib_Timestamp1 <
!                                              Project_Tree.Projects.Table
!                                                (Proj2).Library_TS)
!                                     then
!                                        Rebuild := True;
!                                        exit;
!                                     end if;
!                                  end if;
! 
!                                  List := Element.Next;
!                               end loop;
! 
!                               if Rebuild then
!                                  Project_Tree.Projects.Table
!                                    (Proj1).Need_To_Build_Lib := True;
!                                  Add_To_Library_Projs (Proj1);
!                               end if;
!                            end;
                          end if;
                       end loop;
+ 
+                      --  Reset the flags Need_To_Build_Lib for the next main,
+                      --  to avoid rebuilding libraries uselessly.
+ 
+                      for Proj1 in Project_Table.First ..
+                                   Project_Table.Last (Project_Tree.Projects)
+                      loop
+                         Project_Tree.Projects.Table
+                           (Proj1).Need_To_Build_Lib := False;
+                      end loop;
                    end;
  
                    --  Build the libraries, if any need to be built
*************** package body Make is
*** 4793,4798 ****
--- 5133,5139 ----
                       Library_Rebuilt := True;
                       MLib.Prj.Build_Library
                         (For_Project   => Library_Projs.Table (J),
+                         In_Tree       => Project_Tree,
                          Gnatbind      => Gnatbind.all,
                          Gnatbind_Path => Gnatbind_Path,
                          Gcc           => Gcc.all,
*************** package body Make is
*** 4994,5002 ****
                 if Main_Project /= No_Project
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
                 then
!                   for Proj in Projects.First .. Projects.Last loop
!                      if Projects.Table (Proj).Library and then
!                        Projects.Table (Proj).Library_Kind /= Static
                       then
                          Shared_Libs := True;
                          Bind_Shared := Shared_Switch'Access;
--- 5335,5346 ----
                 if Main_Project /= No_Project
                   and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
                 then
!                   for Proj in Project_Table.First ..
!                         Project_Table.Last (Project_Tree.Projects)
!                   loop
!                      if Project_Tree.Projects.Table (Proj).Library
!                        and then Project_Tree.Projects.Table
!                                   (Proj).Library_Kind /= Static
                       then
                          Shared_Libs := True;
                          Bind_Shared := Shared_Switch'Access;
*************** package body Make is
*** 5039,5045 ****
                    --  Put all the source directories in ADA_INCLUDE_PATH,
                    --  and all the object directories in ADA_OBJECTS_PATH
  
!                   Prj.Env.Set_Ada_Paths (Main_Project, False);
  
                    --  If switch -C was specified, create a binder mapping file
  
--- 5383,5389 ----
                    --  Put all the source directories in ADA_INCLUDE_PATH,
                    --  and all the object directories in ADA_OBJECTS_PATH
  
!                   Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False);
  
                    --  If switch -C was specified, create a binder mapping file
  
*************** package body Make is
*** 5103,5116 ****
                    if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
                       --  Check for library projects
  
!                      for Proj1 in 1 .. Projects.Last loop
                          if Proj1 /= Main_Project
!                           and then Projects.Table (Proj1).Library
                          then
                             --  Add this project to table Library_Projs
  
                             There_Are_Libraries := True;
!                            Depth := Projects.Table (Proj1).Depth;
                             Library_Projs.Increment_Last;
                             Current := Library_Projs.Last;
  
--- 5447,5464 ----
                    if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
                       --  Check for library projects
  
!                      for Proj1 in Project_Table.First ..
!                            Project_Table.Last (Project_Tree.Projects)
!                      loop
                          if Proj1 /= Main_Project
!                           and then
!                             Project_Tree.Projects.Table (Proj1).Library
                          then
                             --  Add this project to table Library_Projs
  
                             There_Are_Libraries := True;
!                            Depth :=
!                              Project_Tree.Projects.Table (Proj1).Depth;
                             Library_Projs.Increment_Last;
                             Current := Library_Projs.Last;
  
*************** package body Make is
*** 5119,5125 ****
  
                             while Current > 1 loop
                                Proj2 := Library_Projs.Table (Current - 1);
!                               exit when Projects.Table (Proj2).Depth <= Depth;
                                Library_Projs.Table (Current) := Proj2;
                                Current := Current - 1;
                             end loop;
--- 5467,5474 ----
  
                             while Current > 1 loop
                                Proj2 := Library_Projs.Table (Current - 1);
!                               exit when Project_Tree.Projects.Table
!                                           (Proj2).Depth <= Depth;
                                Library_Projs.Table (Current) := Proj2;
                                Current := Current - 1;
                             end loop;
*************** package body Make is
*** 5129,5142 ****
                             --  If it is not a static library and path option
                             --  is set, add it to the Library_Paths table.
  
!                            if Projects.Table (Proj1).Library_Kind /= Static
                               and then Path_Option /= null
                             then
                                Library_Paths.Increment_Last;
                                Library_Paths.Table (Library_Paths.Last) :=
                                  new String'
                                    (Get_Name_String
!                                        (Projects.Table (Proj1).Library_Dir));
                             end if;
                          end if;
                       end loop;
--- 5478,5493 ----
                             --  If it is not a static library and path option
                             --  is set, add it to the Library_Paths table.
  
!                            if Project_Tree.Projects.Table
!                                 (Proj1).Library_Kind /= Static
                               and then Path_Option /= null
                             then
                                Library_Paths.Increment_Last;
                                Library_Paths.Table (Library_Paths.Last) :=
                                  new String'
                                    (Get_Name_String
!                                        (Project_Tree.Projects.Table
!                                             (Proj1).Library_Dir));
                             end if;
                          end if;
                       end loop;
*************** package body Make is
*** 5148,5154 ****
                          Linker_Switches.Table (Linker_Switches.Last) :=
                            new String'("-L" &
                                        Get_Name_String
!                                         (Projects.Table
                                             (Library_Projs.Table (Index)).
                                                Library_Dir));
  
--- 5499,5505 ----
                          Linker_Switches.Table (Linker_Switches.Last) :=
                            new String'("-L" &
                                        Get_Name_String
!                                         (Project_Tree.Projects.Table
                                             (Library_Projs.Table (Index)).
                                                Library_Dir));
  
*************** package body Make is
*** 5158,5164 ****
                          Linker_Switches.Table (Linker_Switches.Last) :=
                            new String'("-l" &
                                        Get_Name_String
!                                         (Projects.Table
                                             (Library_Projs.Table (Index)).
                                                Library_Name));
                       end loop;
--- 5509,5515 ----
                          Linker_Switches.Table (Linker_Switches.Last) :=
                            new String'("-l" &
                                        Get_Name_String
!                                         (Project_Tree.Projects.Table
                                             (Library_Projs.Table (Index)).
                                                Library_Name));
                       end loop;
*************** package body Make is
*** 5233,5247 ****
  
                    --  Put the object directories in ADA_OBJECTS_PATH
  
!                   Prj.Env.Set_Ada_Paths (Main_Project, False);
  
                    --  Check for attributes Linker'Linker_Options in projects
                    --  other than the main project
  
                    declare
                       Linker_Options : constant String_List :=
!                        Linker_Options_Switches (Main_Project);
! 
                    begin
                       for Option in Linker_Options'Range loop
                          Linker_Switches.Increment_Last;
--- 5584,5598 ----
  
                    --  Put the object directories in ADA_OBJECTS_PATH
  
!                   Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False);
  
                    --  Check for attributes Linker'Linker_Options in projects
                    --  other than the main project
  
                    declare
                       Linker_Options : constant String_List :=
!                                         Linker_Options_Switches
!                                           (Main_Project, Project_Tree);
                    begin
                       for Option in Linker_Options'Range loop
                          Linker_Switches.Increment_Last;
*************** package body Make is
*** 5340,5360 ****
                                              File_Name_Of_Library_Unit_Body
                                                (Name => Main_Source_File_Name,
                                                 Project => Main_Project,
                                                 Main_Project_Only =>
                                                   not Unique_Compile);
  
                    The_Packages : constant Package_Id :=
!                     Projects.Table (Main_Project).Decl.Packages;
  
                    Binder_Package : constant Prj.Package_Id :=
                                 Prj.Util.Value_Of
                                   (Name        => Name_Binder,
!                                   In_Packages => The_Packages);
  
                    Linker_Package : constant Prj.Package_Id :=
                                 Prj.Util.Value_Of
!                                  (Name       => Name_Linker,
!                                  In_Packages => The_Packages);
  
                 begin
                    --  We fail if we cannot find the main source file
--- 5691,5715 ----
                                              File_Name_Of_Library_Unit_Body
                                                (Name => Main_Source_File_Name,
                                                 Project => Main_Project,
+                                                In_Tree => Project_Tree,
                                                 Main_Project_Only =>
                                                   not Unique_Compile);
  
                    The_Packages : constant Package_Id :=
!                     Project_Tree.Projects.Table
!                       (Main_Project).Decl.Packages;
  
                    Binder_Package : constant Prj.Package_Id :=
                                 Prj.Util.Value_Of
                                   (Name        => Name_Binder,
!                                   In_Packages => The_Packages,
!                                   In_Tree     => Project_Tree);
  
                    Linker_Package : constant Prj.Package_Id :=
                                 Prj.Util.Value_Of
!                                  (Name        => Name_Linker,
!                                   In_Packages => The_Packages,
!                                   In_Tree     => Project_Tree);
  
                 begin
                    --  We fail if we cannot find the main source file
*************** package body Make is
*** 5442,5448 ****
                    declare
                       Dir_Path : constant String_Access :=
                         new String'(Get_Name_String
!                                     (Projects.Table (Main_Project).Directory));
                    begin
                       for
                         J in Last_Binder_Switch + 1 .. Binder_Switches.Last
--- 5797,5804 ----
                    declare
                       Dir_Path : constant String_Access :=
                         new String'(Get_Name_String
!                                      (Project_Tree.Projects.Table
!                                         (Main_Project).Directory));
                    begin
                       for
                         J in Last_Binder_Switch + 1 .. Binder_Switches.Last
*************** package body Make is
*** 5516,5522 ****
  
        if not Debug.Debug_Flag_N then
           Delete_Mapping_Files;
!          Prj.Env.Delete_All_Path_Files;
        end if;
  
        Exit_Program (E_Success);
--- 5872,5878 ----
  
        if not Debug.Debug_Flag_N then
           Delete_Mapping_Files;
!          Prj.Env.Delete_All_Path_Files (Project_Tree);
        end if;
  
        Exit_Program (E_Success);
*************** package body Make is
*** 5528,5534 ****
        when Compilation_Failed =>
           if not Debug.Debug_Flag_N then
              Delete_Mapping_Files;
!             Prj.Env.Delete_All_Path_Files;
           end if;
  
           Exit_Program (E_Fatal);
--- 5884,5890 ----
        when Compilation_Failed =>
           if not Debug.Debug_Flag_N then
              Delete_Mapping_Files;
!             Prj.Env.Delete_All_Path_Files (Project_Tree);
           end if;
  
           Exit_Program (E_Fatal);
*************** package body Make is
*** 5605,5611 ****
  
        if Project /= No_Project then
           Prj.Env.Create_Mapping_File
!            (Project,
              The_Mapping_File_Names
                (Project, Last_Mapping_File_Names (Project)));
  
--- 5961,5967 ----
  
        if Project /= No_Project then
           Prj.Env.Create_Mapping_File
!            (Project, Project_Tree,
              The_Mapping_File_Names
                (Project, Last_Mapping_File_Names (Project)));
  
*************** package body Make is
*** 5669,5675 ****
  
        Snames.Initialize;
  
!       Prj.Initialize;
  
        Dependencies.Init;
  
--- 6025,6031 ----
  
        Snames.Initialize;
  
!       Prj.Initialize (Project_Tree);
  
        Dependencies.Init;
  
*************** package body Make is
*** 5789,5794 ****
--- 6145,6151 ----
  
           Prj.Pars.Parse
             (Project           => Main_Project,
+             In_Tree           => Project_Tree,
              Project_File_Name => Project_File_Name.all,
              Packages_To_Check => Packages_To_Check_By_Gnatmake);
  
*************** package body Make is
*** 5807,5825 ****
           --  We add the source directories and the object directories
           --  to the search paths.
  
!          Add_Source_Directories (Main_Project);
!          Add_Object_Directories (Main_Project);
  
           --  Compute depth of each project
  
!          for Proj in 1 .. Projects.Last loop
!             Projects.Table (Proj).Seen := False;
!             Projects.Table (Proj).Depth := 0;
           end loop;
  
           Recursive_Compute_Depth
             (Main_Project, Depth => 1);
  
        else
  
           Osint.Add_Default_Search_Dirs;
--- 6164,6193 ----
           --  We add the source directories and the object directories
           --  to the search paths.
  
!          Add_Source_Directories (Main_Project, Project_Tree);
!          Add_Object_Directories (Main_Project, Project_Tree);
  
           --  Compute depth of each project
  
!          for Proj in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!          loop
!             Project_Tree.Projects.Table (Proj).Seen := False;
!             Project_Tree.Projects.Table (Proj).Depth := 0;
           end loop;
  
           Recursive_Compute_Depth
             (Main_Project, Depth => 1);
  
+          --  For each project compute the list of the projects it imports
+          --  directly or indirectly.
+ 
+          for Proj in Project_Table.First ..
+                      Project_Table.Last (Project_Tree.Projects)
+          loop
+             Compute_All_Imported_Projects (Proj);
+          end loop;
+ 
        else
  
           Osint.Add_Default_Search_Dirs;
*************** package body Make is
*** 5860,5870 ****
        Into_Q       : Boolean)
     is
        Put_In_Q : Boolean := Into_Q;
!       Unit     : Com.Unit_Data;
        Sfile    : Name_Id;
  
        Extending : constant Boolean :=
!                     Projects.Table (The_Project).Extends /= No_Project;
  
        function Check_Project (P : Project_Id) return Boolean;
        --  Returns True if P is The_Project or a project extended by
--- 6228,6239 ----
        Into_Q       : Boolean)
     is
        Put_In_Q : Boolean := Into_Q;
!       Unit     : Unit_Data;
        Sfile    : Name_Id;
  
        Extending : constant Boolean :=
!                     Project_Tree.Projects.Table
!                       (The_Project).Extends /= No_Project;
  
        function Check_Project (P : Project_Id) return Boolean;
        --  Returns True if P is The_Project or a project extended by
*************** package body Make is
*** 5880,5886 ****
              return True;
           elsif Extending then
              declare
!                Data : Project_Data := Projects.Table (The_Project);
  
              begin
                 loop
--- 6249,6256 ----
              return True;
           elsif Extending then
              declare
!                Data : Project_Data :=
!                         Project_Tree.Projects.Table (The_Project);
  
              begin
                 loop
*************** package body Make is
*** 5888,5894 ****
                       return True;
                    end if;
  
!                   Data := Projects.Table (Data.Extends);
                    exit when Data.Extends = No_Project;
                 end loop;
              end;
--- 6258,6264 ----
                       return True;
                    end if;
  
!                   Data := Project_Tree.Projects.Table (Data.Extends);
                    exit when Data.Extends = No_Project;
                 end loop;
              end;
*************** package body Make is
*** 5897,5926 ****
           return False;
        end Check_Project;
  
!    --  Start of processing of Insert_Project_Sources
  
     begin
        --  For all the sources in the project files,
  
!       for Id in Com.Units.First .. Com.Units.Last loop
!          Unit  := Com.Units.Table (Id);
           Sfile := No_Name;
  
           --  If there is a source for the body, and the body has not been
           --  locally removed,
  
!          if Unit.File_Names (Com.Body_Part).Name /= No_Name
!            and then Unit.File_Names (Com.Body_Part).Path /= Slash
           then
- 
              --  And it is a source for the specified project
  
!             if Check_Project (Unit.File_Names (Com.Body_Part).Project) then
  
                 --  If we don't have a spec, we cannot consider the source
                 --  if it is a subunit
  
!                if Unit.File_Names (Com.Specification).Name = No_Name then
                    declare
                       Src_Ind : Source_File_Index;
  
--- 6267,6297 ----
           return False;
        end Check_Project;
  
!    --  Start of processing for Insert_Project_Sources
  
     begin
        --  For all the sources in the project files,
  
!       for Id in Unit_Table.First ..
!                 Unit_Table.Last (Project_Tree.Units)
!       loop
!          Unit  := Project_Tree.Units.Table (Id);
           Sfile := No_Name;
  
           --  If there is a source for the body, and the body has not been
           --  locally removed,
  
!          if Unit.File_Names (Body_Part).Name /= No_Name
!            and then Unit.File_Names (Body_Part).Path /= Slash
           then
              --  And it is a source for the specified project
  
!             if Check_Project (Unit.File_Names (Body_Part).Project) then
  
                 --  If we don't have a spec, we cannot consider the source
                 --  if it is a subunit
  
!                if Unit.File_Names (Specification).Name = No_Name then
                    declare
                       Src_Ind : Source_File_Index;
  
*************** package body Make is
*** 5937,5943 ****
                    begin
                       Src_Ind := Sinput.P.Load_Project_File
                                    (Get_Name_String
!                                      (Unit.File_Names (Com.Body_Part).Path));
  
                       --  If it is a subunit, discard it
  
--- 6308,6314 ----
                    begin
                       Src_Ind := Sinput.P.Load_Project_File
                                    (Get_Name_String
!                                      (Unit.File_Names (Body_Part).Path));
  
                       --  If it is a subunit, discard it
  
*************** package body Make is
*** 5945,5968 ****
                          Sfile := No_Name;
  
                       else
!                         Sfile := Unit.File_Names (Com.Body_Part).Name;
                       end if;
                    end;
  
                 else
!                   Sfile := Unit.File_Names (Com.Body_Part).Name;
                 end if;
              end if;
  
!          elsif Unit.File_Names (Com.Specification).Name /= No_Name
!            and then Unit.File_Names (Com.Specification).Path /= Slash
!            and then Check_Project (Unit.File_Names (Com.Specification).Project)
           then
              --  If there is no source for the body, but there is a source
              --  for the spec which has not been locally removed, then we take
              --  this one.
  
!             Sfile := Unit.File_Names (Com.Specification).Name;
           end if;
  
           --  If Put_In_Q is True, we insert into the Q
--- 6316,6339 ----
                          Sfile := No_Name;
  
                       else
!                         Sfile := Unit.File_Names (Body_Part).Name;
                       end if;
                    end;
  
                 else
!                   Sfile := Unit.File_Names (Body_Part).Name;
                 end if;
              end if;
  
!          elsif Unit.File_Names (Specification).Name /= No_Name
!            and then Unit.File_Names (Specification).Path /= Slash
!            and then Check_Project (Unit.File_Names (Specification).Project)
           then
              --  If there is no source for the body, but there is a source
              --  for the spec which has not been locally removed, then we take
              --  this one.
  
!             Sfile := Unit.File_Names (Specification).Name;
           end if;
  
           --  If Put_In_Q is True, we insert into the Q
*************** package body Make is
*** 6006,6011 ****
--- 6377,6389 ----
  
              Osint.Add_File (Get_Name_String (Sfile));
              Put_In_Q := True;
+ 
+             --  As we may look into the Q later, ensure the Q has been
+             --  initialized to avoid errors.
+ 
+             if First_Q_Initialization then
+                Init_Q;
+             end if;
           end if;
        end loop;
     end Insert_Project_Sources;
*************** package body Make is
*** 6090,6096 ****
           declare
              Source_File_Name : constant String :=
                                   Get_Name_String (Source_File);
!             Saved_Verbosity  : constant Verbosity := Prj.Com.Current_Verbosity;
              Project          : Project_Id := No_Project;
              Path_Name        : Name_Id := No_Name;
              Data             : Project_Data;
--- 6468,6474 ----
           declare
              Source_File_Name : constant String :=
                                   Get_Name_String (Source_File);
!             Saved_Verbosity  : constant Verbosity := Current_Verbosity;
              Project          : Project_Id := No_Project;
              Path_Name        : Name_Id := No_Name;
              Data             : Project_Data;
*************** package body Make is
*** 6100,6112 ****
              --  the source. Call it with verbosity default to avoid verbose
              --  messages.
  
!             Prj.Com.Current_Verbosity := Default;
              Prj.Env.
                Get_Reference
                (Source_File_Name => Source_File_Name,
                 Project          => Project,
                 Path             => Path_Name);
!             Prj.Com.Current_Verbosity := Saved_Verbosity;
  
              --  If this source is in a project, check that the ALI file is
              --  in its object directory. If it is not, return False, so that
--- 6478,6491 ----
              --  the source. Call it with verbosity default to avoid verbose
              --  messages.
  
!             Current_Verbosity := Default;
              Prj.Env.
                Get_Reference
                (Source_File_Name => Source_File_Name,
                 Project          => Project,
+                In_Tree          => Project_Tree,
                 Path             => Path_Name);
!             Current_Verbosity := Saved_Verbosity;
  
              --  If this source is in a project, check that the ALI file is
              --  in its object directory. If it is not, return False, so that
*************** package body Make is
*** 6116,6124 ****
              --  the general case and return True at the end of the function.
  
              if Project /= No_Project
!               and then Projects.Table (Project).Extends /= No_Project
              then
!                Data := Projects.Table (Project);
  
                 declare
                    Object_Directory : constant String :=
--- 6495,6504 ----
              --  the general case and return True at the end of the function.
  
              if Project /= No_Project
!               and then Project_Tree.Projects.Table
!                          (Project).Extends /= No_Project
              then
!                Data := Project_Tree.Projects.Table (Project);
  
                 declare
                    Object_Directory : constant String :=
*************** package body Make is
*** 6288,6304 ****
     --------------------
  
     procedure Mark_Directory
!      (Dir  : String;
!       Mark : Lib_Mark_Type)
     is
        N : Name_Id;
        B : Byte;
  
     begin
!       --  Dir last character is supposed to be a directory separator
  
!       Name_Len := Dir'Length;
!       Name_Buffer (1 .. Name_Len) := Dir;
  
        if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
           Name_Len := Name_Len + 1;
--- 6668,6718 ----
     --------------------
  
     procedure Mark_Directory
!      (Dir             : String;
!       Mark            : Lib_Mark_Type;
!       On_Command_Line : Boolean)
     is
        N : Name_Id;
        B : Byte;
  
     begin
!       if On_Command_Line then
!          declare
!             Real_Path : constant String :=
!               Normalize_Pathname (Dir);
  
!          begin
!             if Real_Path'Length = 0 then
!                Name_Len := Dir'Length;
!                Name_Buffer (1 .. Name_Len) := Dir;
! 
!             else
!                Name_Len := Real_Path'Length;
!                Name_Buffer (1 .. Name_Len) := Real_Path;
!             end if;
!          end;
! 
!       else
!          declare
!             Real_Path : constant String :=
!               Normalize_Pathname
!                 (Dir,
!                  Get_Name_String
!                    (Project_Tree.Projects.Table (Main_Project).Directory));
! 
!          begin
!             if Real_Path'Length = 0 then
!                Name_Len := Dir'Length;
!                Name_Buffer (1 .. Name_Len) := Dir;
! 
!             else
!                Name_Len := Real_Path'Length;
!                Name_Buffer (1 .. Name_Len) := Real_Path;
!             end if;
!          end;
!       end if;
! 
!       --  Last character is supposed to be a directory separator
  
        if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
           Name_Len := Name_Len + 1;
*************** package body Make is
*** 6328,6353 ****
        --  been seen or if the depth is large enough.
  
        if Project = No_Project
!         or else Projects.Table (Project).Seen
!         or else Projects.Table (Project).Depth >= Depth
        then
           return;
        end if;
  
!       Projects.Table (Project).Depth := Depth;
  
        --  Mark the project as Seen to avoid endless loop caused by limited
        --  withs.
  
!       Projects.Table (Project).Seen := True;
  
!       List := Projects.Table (Project).Imported_Projects;
  
        --  Visit each imported project
  
        while List /= Empty_Project_List loop
!          Proj := Project_Lists.Table (List).Project;
!          List := Project_Lists.Table (List).Next;
           Recursive_Compute_Depth
             (Project => Proj,
              Depth => Depth + 1);
--- 6742,6767 ----
        --  been seen or if the depth is large enough.
  
        if Project = No_Project
!         or else Project_Tree.Projects.Table (Project).Seen
!         or else Project_Tree.Projects.Table (Project).Depth >= Depth
        then
           return;
        end if;
  
!       Project_Tree.Projects.Table (Project).Depth := Depth;
  
        --  Mark the project as Seen to avoid endless loop caused by limited
        --  withs.
  
!       Project_Tree.Projects.Table (Project).Seen := True;
  
!       List := Project_Tree.Projects.Table (Project).Imported_Projects;
  
        --  Visit each imported project
  
        while List /= Empty_Project_List loop
!          Proj := Project_Tree.Project_Lists.Table (List).Project;
!          List := Project_Tree.Project_Lists.Table (List).Next;
           Recursive_Compute_Depth
             (Project => Proj,
              Depth => Depth + 1);
*************** package body Make is
*** 6356,6367 ****
        --  Visit a project being extended, if any
  
        Recursive_Compute_Depth
!         (Project => Projects.Table (Project).Extends,
           Depth   => Depth + 1);
  
        --  Reset the Seen flag, as we leave this project
  
!       Projects.Table (Project).Seen := False;
     end Recursive_Compute_Depth;
  
     -----------------------
--- 6770,6781 ----
        --  Visit a project being extended, if any
  
        Recursive_Compute_Depth
!         (Project => Project_Tree.Projects.Table (Project).Extends,
           Depth   => Depth + 1);
  
        --  Reset the Seen flag, as we leave this project
  
!       Project_Tree.Projects.Table (Project).Seen := False;
     end Recursive_Compute_Depth;
  
     -----------------------
*************** package body Make is
*** 6522,6532 ****
  
              elsif Program_Args = Compiler then
                 if Argv (3 .. Argv'Last) /= "-" then
!                   Add_Src_Search_Dir (Argv (3 .. Argv'Last));
                 end if;
  
              elsif Program_Args = Binder then
!                Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
              end if;
           end if;
  
--- 6936,6946 ----
  
              elsif Program_Args = Compiler then
                 if Argv (3 .. Argv'Last) /= "-" then
!                   Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
                 end if;
  
              elsif Program_Args = Binder then
!                Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
              end if;
           end if;
  
*************** package body Make is
*** 6686,6700 ****
           --  -Idir
  
           elsif Argv (2) = 'I' then
!             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
!             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
              Add_Switch (Argv, Compiler, And_Save => And_Save);
              Add_Switch (Argv, Binder, And_Save => And_Save);
  
           --  -aIdir (to gcc this is like a -I switch)
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
!             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
              Add_Switch ("-I" & Argv (4 .. Argv'Last),
                          Compiler,
                          And_Save => And_Save);
--- 7100,7114 ----
           --  -Idir
  
           elsif Argv (2) = 'I' then
!             Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
!             Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
              Add_Switch (Argv, Compiler, And_Save => And_Save);
              Add_Switch (Argv, Binder, And_Save => And_Save);
  
           --  -aIdir (to gcc this is like a -I switch)
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
!             Add_Source_Search_Dir (Argv (4 .. Argv'Last), And_Save);
              Add_Switch ("-I" & Argv (4 .. Argv'Last),
                          Compiler,
                          And_Save => And_Save);
*************** package body Make is
*** 6703,6716 ****
           --  -aOdir
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
!             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
              Add_Switch (Argv, Binder, And_Save => And_Save);
  
           --  -aLdir (to gnatbind this is like a -aO switch)
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
!             Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir);
!             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
              Add_Switch ("-aO" & Argv (4 .. Argv'Last),
                          Binder,
                          And_Save => And_Save);
--- 7117,7130 ----
           --  -aOdir
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
!             Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
              Add_Switch (Argv, Binder, And_Save => And_Save);
  
           --  -aLdir (to gnatbind this is like a -aO switch)
  
           elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
!             Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir, And_Save);
!             Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
              Add_Switch ("-aO" & Argv (4 .. Argv'Last),
                          Binder,
                          And_Save => And_Save);
*************** package body Make is
*** 6718,6726 ****
           --  -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
  
           elsif Argv (2) = 'A' then
!             Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir);
!             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
!             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
              Add_Switch ("-I"  & Argv (3 .. Argv'Last),
                          Compiler,
                          And_Save => And_Save);
--- 7132,7140 ----
           --  -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
  
           elsif Argv (2) = 'A' then
!             Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir, And_Save);
!             Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
!             Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
              Add_Switch ("-I"  & Argv (3 .. Argv'Last),
                          Compiler,
                          And_Save => And_Save);
*************** package body Make is
*** 6940,6945 ****
--- 7354,7362 ----
             and then Argv (2 .. Argv'Last) /= "F"
             and then Argv (2 .. Argv'Last) /= "M"
             and then Argv (2 .. Argv'Last) /= "B"
+            and then Argv (2 .. Argv'Last) /= "vl"
+            and then Argv (2 .. Argv'Last) /= "vm"
+            and then Argv (2 .. Argv'Last) /= "vh"
             and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
           then
              Add_Switch (Argv, Compiler, And_Save => And_Save);
*************** package body Make is
*** 6976,6995 ****
                     Prj.Util.Value_Of
                       (Name      => Name_Default_Switches,
                        In_Arrays =>
!                       Packages.Table (In_Package).Decl.Arrays);
  
        Switches_Array : constant Array_Element_Id :=
                           Prj.Util.Value_Of
                             (Name      => Name_Switches,
                              In_Arrays =>
!                               Packages.Table (In_Package).Decl.Arrays);
  
     begin
        Switches :=
          Prj.Util.Value_Of
            (Index     => Source_File,
             Src_Index => Source_Index,
!            In_Array  => Switches_Array);
  
        if Switches = Nil_Variable_Value then
           declare
--- 7393,7417 ----
                     Prj.Util.Value_Of
                       (Name      => Name_Default_Switches,
                        In_Arrays =>
!                         Project_Tree.Packages.Table
!                           (In_Package).Decl.Arrays,
!                       In_Tree   => Project_Tree);
  
        Switches_Array : constant Array_Element_Id :=
                           Prj.Util.Value_Of
                             (Name      => Name_Switches,
                              In_Arrays =>
!                               Project_Tree.Packages.Table
!                                 (In_Package).Decl.Arrays,
!                             In_Tree   => Project_Tree);
  
     begin
        Switches :=
          Prj.Util.Value_Of
            (Index     => Source_File,
             Src_Index => Source_Index,
!            In_Array  => Switches_Array,
!            In_Tree   => Project_Tree);
  
        if Switches = Nil_Variable_Value then
           declare
*************** package body Make is
*** 7028,7034 ****
                   Prj.Util.Value_Of
                     (Index     => Name_Find,
                      Src_Index => 0,
!                     In_Array  => Switches_Array);
  
                 if Switches = Nil_Variable_Value
                   and then Allow_ALI
--- 7450,7457 ----
                   Prj.Util.Value_Of
                     (Index     => Name_Find,
                      Src_Index => 0,
!                     In_Array  => Switches_Array,
!                     In_Tree   => Project_Tree);
  
                 if Switches = Nil_Variable_Value
                   and then Allow_ALI
*************** package body Make is
*** 7046,7052 ****
                      Prj.Util.Value_Of
                        (Index     => Name_Find,
                         Src_Index => 0,
!                        In_Array  => Switches_Array);
                 end if;
              end if;
           end;
--- 7469,7476 ----
                      Prj.Util.Value_Of
                        (Index     => Name_Find,
                         Src_Index => 0,
!                        In_Array  => Switches_Array,
!                        In_Tree   => Project_Tree);
                 end if;
              end if;
           end;
*************** package body Make is
*** 7057,7063 ****
             Prj.Util.Value_Of
               (Index     => Name_Ada,
                Src_Index => 0,
!               In_Array  => Defaults);
        end if;
  
        return Switches;
--- 7481,7488 ----
             Prj.Util.Value_Of
               (Index     => Name_Ada,
                Src_Index => 0,
!               In_Array  => Defaults,
!               In_Tree   => Project_Tree);
        end if;
  
        return Switches;
*************** package body Make is
*** 7080,7093 ****
     -----------------
  
     procedure Verbose_Msg
!      (N1     : Name_Id;
!       S1     : String;
!       N2     : Name_Id := No_Name;
!       S2     : String  := "";
!       Prefix : String := "  -> ")
     is
     begin
!       if not Verbose_Mode then
           return;
        end if;
  
--- 7505,7519 ----
     -----------------
  
     procedure Verbose_Msg
!      (N1                : Name_Id;
!       S1                : String;
!       N2                : Name_Id := No_Name;
!       S2                : String  := "";
!       Prefix            : String := "  -> ";
!       Minimum_Verbosity : Verbosity_Level_Type := Opt.Low)
     is
     begin
!       if (not Verbose_Mode) or else (Minimum_Verbosity > Verbosity_Level) then
           return;
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/make.ads gcc-4.1.0/gcc/ada/make.ads
*** gcc-4.0.2/gcc/ada/make.ads	Wed May  5 10:09:54 2004
--- gcc-4.1.0/gcc/ada/make.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Make is
*** 75,87 ****
     --  is raised. These need to be handled by the calling routines.
  
     Compilation_Failed : exception;
!    --  Raised by Compile_Sources if a compilation failed.
  
     Bind_Failed : exception;
!    --  Raised by Bind below if the bind failed.
  
     Link_Failed : exception;
!    --  Raised by Link below if the link failed.
  
     procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
     --  Binds ALI_File. Args are the arguments to pass to the binder.
--- 75,87 ----
     --  is raised. These need to be handled by the calling routines.
  
     Compilation_Failed : exception;
!    --  Raised by Compile_Sources if a compilation failed
  
     Bind_Failed : exception;
!    --  Raised by Bind below if the bind failed
  
     Link_Failed : exception;
!    --  Raised by Link below if the link failed
  
     procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
     --  Binds ALI_File. Args are the arguments to pass to the binder.
*************** package Make is
*** 96,108 ****
     --  Compile_Sources can be called by an external unit.
  
     procedure Scan_Make_Arg (Argv : String; And_Save : Boolean);
!    --  Scan make arguments. Argv is a single argument to be processed.
  
     procedure Extract_Failure
       (File  : out File_Name_Type;
        Unit  : out Unit_Name_Type;
        Found : out Boolean);
!    --  Extracts the first failure report from Bad_Compilation table.
  
     procedure Compile_Sources
       (Main_Source           : File_Name_Type;
--- 96,108 ----
     --  Compile_Sources can be called by an external unit.
  
     procedure Scan_Make_Arg (Argv : String; And_Save : Boolean);
!    --  Scan make arguments. Argv is a single argument to be processed
  
     procedure Extract_Failure
       (File  : out File_Name_Type;
        Unit  : out Unit_Name_Type;
        Found : out Boolean);
!    --  Extracts the first failure report from Bad_Compilation table
  
     procedure Compile_Sources
       (Main_Source           : File_Name_Type;
diff -Nrcpad gcc-4.0.2/gcc/ada/makegpr.adb gcc-4.1.0/gcc/ada/makegpr.adb
*** gcc-4.0.2/gcc/ada/makegpr.adb	Mon Jan  3 15:36:25 2005
--- gcc-4.1.0/gcc/ada/makegpr.adb	Tue Nov 15 14:05:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --       Copyright (C) 2004-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Output;           use Output;
*** 46,52 ****
  with Opt;              use Opt;
  with Osint;            use Osint;
  with Prj;              use Prj;
- with Prj.Com;          use Prj.Com;
  with Prj.Pars;
  with Prj.Util;         use Prj.Util;
  with Snames;           use Snames;
--- 46,51 ----
*************** package body Makegpr is
*** 61,70 ****
     --  The maximum number of arguments for a single invocation of the
     --  Archive Indexer (ar).
  
-    Cpp_Linker : constant String := "c++linker";
-    --  The name of a linking script, built one the fly, when there are C++
-    --  sources and the C++ compiler is not g++.
- 
     No_Argument : aliased Argument_List := (1 .. 0 => null);
     --  Null argument list representing case of no arguments
  
--- 60,65 ----
*************** package body Makegpr is
*** 134,140 ****
     --  ar commands.
  
     Archive_Indexer_Path : String_Access := null;
!    --  The path name of the archive indexer (ranlib), if it exists.
  
     Copyright_Output : Boolean := False;
     Usage_Output     : Boolean := False;
--- 129,135 ----
     --  ar commands.
  
     Archive_Indexer_Path : String_Access := null;
!    --  The path name of the archive indexer (ranlib), if it exists
  
     Copyright_Output : Boolean := False;
     Usage_Output     : Boolean := False;
*************** package body Makegpr is
*** 168,173 ****
--- 163,170 ----
     Packages_To_Check : constant String_List_Access := List_Of_Packages'Access;
     --  List of the packages to be checked when parsing/processing project files
  
+    Project_Tree : constant Project_Tree_Ref := new Project_Tree_Data;
+ 
     Main_Project : Project_Id;
     --  The project id of the main project
  
*************** package body Makegpr is
*** 279,284 ****
--- 276,283 ----
     Dash_c            : constant String_Access := Dash_c_String'Access;
     Dash_cargs_String : aliased  String := "-cargs";
     Dash_cargs        : constant String_Access := Dash_cargs_String'Access;
+    Dash_d_String     : aliased  String := "-d";
+    Dash_d            : constant String_Access := Dash_d_String'Access;
     Dash_f_String     : aliased  String := "-f";
     Dash_f            : constant String_Access := Dash_f_String'Access;
     Dash_k_String     : aliased  String := "-k";
*************** package body Makegpr is
*** 357,363 ****
  
     procedure Add_Argument (Arg : String_Access; Display : Boolean);
     procedure Add_Argument (Arg : String; Display : Boolean);
!    --  Add an argument to Arguments. Reallocate if necessary.
  
     procedure Add_Arguments (Args : Argument_List; Display : Boolean);
     --  Add a list of arguments to Arguments. Reallocate if necessary
--- 356,362 ----
  
     procedure Add_Argument (Arg : String_Access; Display : Boolean);
     procedure Add_Argument (Arg : String; Display : Boolean);
!    --  Add an argument to Arguments. Reallocate if necessary
  
     procedure Add_Arguments (Args : Argument_List; Display : Boolean);
     --  Add a list of arguments to Arguments. Reallocate if necessary
*************** package body Makegpr is
*** 617,623 ****
           --  Nothing to do when there is no project specified
  
           if Project /= No_Project then
!             Data := Projects.Table (Project);
  
              --  Nothing to do if the project has already been processed
  
--- 616,622 ----
           --  Nothing to do when there is no project specified
  
           if Project /= No_Project then
!             Data := Project_Tree.Projects.Table (Project);
  
              --  Nothing to do if the project has already been processed
  
*************** package body Makegpr is
*** 625,631 ****
  
                 --  Mark the project as processed, to avoid processing it again
  
!                Projects.Table (Project).Seen := True;
  
                 Recursive_Add_Archives (Data.Extends);
  
--- 624,630 ----
  
                 --  Mark the project as processed, to avoid processing it again
  
!                Project_Tree.Projects.Table (Project).Seen := True;
  
                 Recursive_Add_Archives (Data.Extends);
  
*************** package body Makegpr is
*** 634,650 ****
                 --  Call itself recursively for all imported projects
  
                 while Imported /= Empty_Project_List loop
!                   Prj := Project_Lists.Table (Imported).Project;
  
                    if Prj /= No_Project then
!                      while Projects.Table (Prj).Extended_By /= No_Project loop
!                         Prj := Projects.Table (Prj).Extended_By;
                       end loop;
  
                       Recursive_Add_Archives (Prj);
                    end if;
  
!                   Imported := Project_Lists.Table (Imported).Next;
                 end loop;
  
                 --  If there is sources of language other than Ada in this
--- 633,654 ----
                 --  Call itself recursively for all imported projects
  
                 while Imported /= Empty_Project_List loop
!                   Prj := Project_Tree.Project_Lists.Table
!                            (Imported).Project;
  
                    if Prj /= No_Project then
!                      while Project_Tree.Projects.Table
!                              (Prj).Extended_By /= No_Project
!                      loop
!                         Prj := Project_Tree.Projects.Table
!                                  (Prj).Extended_By;
                       end loop;
  
                       Recursive_Add_Archives (Prj);
                    end if;
  
!                   Imported := Project_Tree.Project_Lists.Table
!                                 (Imported).Next;
                 end loop;
  
                 --  If there is sources of language other than Ada in this
*************** package body Makegpr is
*** 664,671 ****
     begin
        --  First, mark all projects as not processed
  
!       for Project in 1 .. Projects.Last loop
!          Projects.Table (Project).Seen := False;
        end loop;
  
        --  Take care of the run path option
--- 668,677 ----
     begin
        --  First, mark all projects as not processed
  
!       for Project in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!       loop
!          Project_Tree.Projects.Table (Project).Seen := False;
        end loop;
  
        --  Take care of the run path option
*************** package body Makegpr is
*** 939,948 ****
              raise Program_Error;
  
           when Linker =>
!             Pkg := Value_Of (Name_Linker, Data.Decl.Packages);
  
           when Compiler =>
!             Pkg := Value_Of (Name_Compiler, Data.Decl.Packages);
        end case;
  
        if Pkg /= No_Package then
--- 945,954 ----
              raise Program_Error;
  
           when Linker =>
!             Pkg := Value_Of (Name_Linker, Data.Decl.Packages, Project_Tree);
  
           when Compiler =>
!             Pkg := Value_Of (Name_Compiler, Data.Decl.Packages, Project_Tree);
        end case;
  
        if Pkg /= No_Package then
*************** package body Makegpr is
*** 950,973 ****
  
           Switches_Array := Prj.Util.Value_Of
             (Name      => Name_Switches,
!             In_Arrays => Packages.Table (Pkg).Decl.Arrays);
  
           Switches :=
             Prj.Util.Value_Of
               (Index     => File_Name,
                Src_Index => 0,
!               In_Array  => Switches_Array);
  
           --  Otherwise, get the Default_Switches ("language"), if they exist
  
           if Switches = Nil_Variable_Value then
              Defaults := Prj.Util.Value_Of
                (Name      => Name_Default_Switches,
!                In_Arrays => Packages.Table (Pkg).Decl.Arrays);
              Switches := Prj.Util.Value_Of
                (Index     => Language_Names.Table (Language),
                 Src_Index => 0,
!                In_Array  => Defaults);
           end if;
  
           --  If there are switches, add them to Arguments
--- 956,985 ----
  
           Switches_Array := Prj.Util.Value_Of
             (Name      => Name_Switches,
!             In_Arrays => Project_Tree.Packages.Table
!                           (Pkg).Decl.Arrays,
!             In_Tree   => Project_Tree);
  
           Switches :=
             Prj.Util.Value_Of
               (Index     => File_Name,
                Src_Index => 0,
!               In_Array  => Switches_Array,
!               In_Tree   => Project_Tree);
  
           --  Otherwise, get the Default_Switches ("language"), if they exist
  
           if Switches = Nil_Variable_Value then
              Defaults := Prj.Util.Value_Of
                (Name      => Name_Default_Switches,
!                In_Arrays => Project_Tree.Packages.Table
!                               (Pkg).Decl.Arrays,
!                In_Tree   => Project_Tree);
              Switches := Prj.Util.Value_Of
                (Index     => Language_Names.Table (Language),
                 Src_Index => 0,
!                In_Array  => Defaults,
!                In_Tree   => Project_Tree);
           end if;
  
           --  If there are switches, add them to Arguments
*************** package body Makegpr is
*** 975,981 ****
           if Switches /= Nil_Variable_Value then
              Element_Id := Switches.Values;
              while Element_Id /= Nil_String loop
!                Element := String_Elements.Table (Element_Id);
  
                 if Element.Value /= No_Name then
                    Get_Name_String (Element.Value);
--- 987,994 ----
           if Switches /= Nil_Variable_Value then
              Element_Id := Switches.Values;
              while Element_Id /= Nil_String loop
!                Element := Project_Tree.String_Elements.Table
!                             (Element_Id);
  
                 if Element.Value /= No_Name then
                    Get_Name_String (Element.Value);
*************** package body Makegpr is
*** 1003,1010 ****
     --------------------------
  
     procedure Build_Global_Archive is
!       Data      : Project_Data := Projects.Table (Main_Project);
        Source_Id : Other_Source_Id;
        Source    : Other_Source;
        Success   : Boolean;
  
--- 1016,1025 ----
     --------------------------
  
     procedure Build_Global_Archive is
!       Data      : Project_Data :=
!                     Project_Tree.Projects.Table (Main_Project);
        Source_Id : Other_Source_Id;
+       S_Id      : Other_Source_Id;
        Source    : Other_Source;
        Success   : Boolean;
  
*************** package body Makegpr is
*** 1072,1090 ****
                 --  Put all sources of language other than Ada in
                 --  Source_Indexes.
  
!                for Proj in 1 .. Projects.Last loop
!                   Data := Projects.Table (Proj);
  
!                   if not Data.Library then
!                      Last_Source := 0;
!                      Source_Id := Data.First_Other_Source;
  
!                      while Source_Id /= No_Other_Source loop
!                         Add_Source_Id (Proj, Source_Id);
!                         Source_Id := Other_Sources.Table (Source_Id).Next;
!                      end loop;
!                   end if;
!                end loop;
  
                 --  Read the dependency file, line by line
  
--- 1087,1114 ----
                 --  Put all sources of language other than Ada in
                 --  Source_Indexes.
  
!                declare
!                   Local_Data : Project_Data;
  
!                begin
!                   Last_Source := 0;
  
!                   for Proj in Project_Table.First ..
!                     Project_Table.Last (Project_Tree.Projects)
!                   loop
!                      Local_Data := Project_Tree.Projects.Table (Proj);
! 
!                      if not Local_Data.Library then
!                         Source_Id := Local_Data.First_Other_Source;
! 
!                         while Source_Id /= No_Other_Source loop
!                            Add_Source_Id (Proj, Source_Id);
!                            Source_Id := Project_Tree.Other_Sources.Table
!                              (Source_Id).Next;
!                         end loop;
!                      end if;
!                   end loop;
!                end;
  
                 --  Read the dependency file, line by line
  
*************** package body Makegpr is
*** 1099,1106 ****
                    --  Check if this object file is for a source of this project
  
                    for S in 1 .. Last_Source loop
!                      Source_Id := Source_Indexes (S).Id;
!                      Source := Other_Sources.Table (Source_Id);
  
                       if (not Source_Indexes (S).Found)
                         and then Source.Object_Path = Object_Path
--- 1123,1130 ----
                    --  Check if this object file is for a source of this project
  
                    for S in 1 .. Last_Source loop
!                      S_Id := Source_Indexes (S).Id;
!                      Source := Project_Tree.Other_Sources.Table (S_Id);
  
                       if (not Source_Indexes (S).Found)
                         and then Source.Object_Path = Object_Path
*************** package body Makegpr is
*** 1108,1113 ****
--- 1132,1138 ----
                          --  We have found the object file: get the source
                          --  data, and mark it as found.
  
+                         Source_Id := S_Id;
                          Source_Indexes (S).Found := True;
                          exit;
                       end if;
*************** package body Makegpr is
*** 1219,1232 ****
  
           --  Followed by all the object files of the non library projects
  
!          for Proj in 1 .. Projects.Last loop
!             Data := Projects.Table (Proj);
  
              if not Data.Library then
                 Source_Id := Data.First_Other_Source;
  
                 while Source_Id /= No_Other_Source loop
!                   Source := Other_Sources.Table (Source_Id);
  
                    --  Only include object file name that have not been
                    --  overriden in extending projects.
--- 1244,1260 ----
  
           --  Followed by all the object files of the non library projects
  
!          for Proj in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!          loop
!             Data := Project_Tree.Projects.Table (Proj);
  
              if not Data.Library then
                 Source_Id := Data.First_Other_Source;
  
                 while Source_Id /= No_Other_Source loop
!                   Source :=
!                     Project_Tree.Other_Sources.Table (Source_Id);
  
                    --  Only include object file name that have not been
                    --  overriden in extending projects.
*************** package body Makegpr is
*** 1345,1351 ****
     -------------------
  
     procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is
!       Data      : constant Project_Data := Projects.Table (Project);
        Source_Id : Other_Source_Id;
        Source    : Other_Source;
  
--- 1373,1380 ----
     -------------------
  
     procedure Build_Library (Project : Project_Id; Unconditionally : Boolean) is
!       Data      : constant Project_Data :=
!                     Project_Tree.Projects.Table (Project);
        Source_Id : Other_Source_Id;
        Source    : Other_Source;
  
*************** package body Makegpr is
*** 1366,1372 ****
        Time_Stamp  : Time_Stamp_Type;
        Driver_Name : Name_Id := No_Name;
  
!       Lib_Opts : Argument_List_Access := No_Argument'Unrestricted_Access;
     begin
        Check_Archive_Builder;
  
--- 1395,1401 ----
        Time_Stamp  : Time_Stamp_Type;
        Driver_Name : Name_Id := No_Name;
  
!       Lib_Opts : Argument_List_Access := No_Argument'Access;
     begin
        Check_Archive_Builder;
  
*************** package body Makegpr is
*** 1414,1420 ****
  
                 while Source_Id /= No_Other_Source loop
                    Add_Source_Id (Project, Source_Id);
!                   Source_Id := Other_Sources.Table (Source_Id).Next;
                 end loop;
  
                 --  Read the dependency file, line by line
--- 1443,1450 ----
  
                 while Source_Id /= No_Other_Source loop
                    Add_Source_Id (Project, Source_Id);
!                   Source_Id := Project_Tree.Other_Sources.Table
!                                  (Source_Id).Next;
                 end loop;
  
                 --  Read the dependency file, line by line
*************** package body Makegpr is
*** 1430,1445 ****
                    --  Check if this object file is for a source of this project
  
                    for S in 1 .. Last_Source loop
!                      if (not Source_Indexes (S).Found) and then
!                        Other_Sources.Table
!                          (Source_Indexes (S).Id).Object_Name =
!                        Object_Name
                       then
                          --  We have found the object file: get the source
                          --  data, and mark it as found.
  
                          Source_Id := Source_Indexes (S).Id;
!                         Source := Other_Sources.Table (Source_Id);
                          Source_Indexes (S).Found := True;
                          exit;
                       end if;
--- 1460,1476 ----
                    --  Check if this object file is for a source of this project
  
                    for S in 1 .. Last_Source loop
!                      if (not Source_Indexes (S).Found)
!                        and then
!                          Project_Tree.Other_Sources.Table
!                            (Source_Indexes (S).Id).Object_Name = Object_Name
                       then
                          --  We have found the object file: get the source
                          --  data, and mark it as found.
  
                          Source_Id := Source_Indexes (S).Id;
!                         Source := Project_Tree.Other_Sources.Table
!                                     (Source_Id);
                          Source_Indexes (S).Found := True;
                          exit;
                       end if;
*************** package body Makegpr is
*** 1526,1532 ****
  
                          if Verbose_Mode then
                             Source_Id := Source_Indexes (Index).Id;
!                            Source := Other_Sources.Table (Source_Id);
                             Write_Str  ("      -> ");
                             Write_Str  (Get_Name_String (Source.Object_Name));
                             Write_Str  (" is not in the archive ");
--- 1557,1564 ----
  
                          if Verbose_Mode then
                             Source_Id := Source_Indexes (Index).Id;
!                            Source := Project_Tree.Other_Sources.Table
!                                        (Source_Id);
                             Write_Str  ("      -> ");
                             Write_Str  (Get_Name_String (Source.Object_Name));
                             Write_Str  (" is not in the archive ");
*************** package body Makegpr is
*** 1566,1572 ****
              Source_Id := Data.First_Other_Source;
  
              while Source_Id /= No_Other_Source loop
!                Source := Other_Sources.Table (Source_Id);
                 Add_Argument
                   (Get_Name_String (Source.Object_Name), Verbose_Mode);
                 Source_Id := Source.Next;
--- 1598,1604 ----
              Source_Id := Data.First_Other_Source;
  
              while Source_Id /= No_Other_Source loop
!                Source := Project_Tree.Other_Sources.Table (Source_Id);
                 Add_Argument
                   (Get_Name_String (Source.Object_Name), Verbose_Mode);
                 Source_Id := Source.Next;
*************** package body Makegpr is
*** 1605,1611 ****
                    Library_Options : constant Variable_Value :=
                                        Value_Of
                                          (Name_Library_Options,
!                                          Data.Decl.Attributes);
  
                 begin
                    if not Library_Options.Default then
--- 1637,1644 ----
                    Library_Options : constant Variable_Value :=
                                        Value_Of
                                          (Name_Library_Options,
!                                          Data.Decl.Attributes,
!                                          Project_Tree);
  
                 begin
                    if not Library_Options.Default then
*************** package body Makegpr is
*** 1615,1621 ****
  
                       begin
                          while Current /= Nil_String loop
!                            Element := String_Elements.Table (Current);
                             Get_Name_String (Element.Value);
  
                             if Name_Len /= 0 then
--- 1648,1655 ----
  
                       begin
                          while Current /= Nil_String loop
!                            Element := Project_Tree.String_Elements.
!                                         Table (Current);
                             Get_Name_String (Element.Value);
  
                             if Name_Len /= 0 then
*************** package body Makegpr is
*** 1654,1660 ****
  
           declare
              Archive : Ada.Text_IO.File_Type;
-             use Ada.Text_IO;
           begin
              Create (Archive, Out_File, Archive_Name);
              Close (Archive);
--- 1688,1693 ----
*************** package body Makegpr is
*** 1982,1988 ****
                       end if;
                    end;
  
!                   --  If the source path name ends the line, we are done.
  
                    exit Line_Loop when Finish = Last;
  
--- 2015,2021 ----
                       end if;
                    end;
  
!                   --  If the source path name ends the line, we are done
  
                    exit Line_Loop when Finish = Last;
  
*************** package body Makegpr is
*** 2034,2042 ****
     begin
        C_Plus_Plus_Is_Used := False;
  
!       for Project in 1 .. Projects.Last loop
           if
!            Projects.Table (Project).Languages (C_Plus_Plus_Language_Index)
           then
              C_Plus_Plus_Is_Used := True;
              exit;
--- 2067,2078 ----
     begin
        C_Plus_Plus_Is_Used := False;
  
!       for Project in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!       loop
           if
!            Project_Tree.Projects.Table (Project).Languages
!                                            (C_Plus_Plus_Language_Index)
           then
              C_Plus_Plus_Is_Used := True;
              exit;
*************** package body Makegpr is
*** 2053,2059 ****
        Data         : in Project_Data;
        Local_Errors : in out Boolean)
     is
!       Source  : Other_Source := Other_Sources.Table (Source_Id);
        Success : Boolean;
        CPATH   : String_Access := null;
  
--- 2089,2096 ----
        Data         : in Project_Data;
        Local_Errors : in out Boolean)
     is
!       Source  : Other_Source :=
!         Project_Tree.Other_Sources.Table (Source_Id);
        Success : Boolean;
        CPATH   : String_Access := null;
  
*************** package body Makegpr is
*** 2283,2289 ****
           else
              --  Everything looks fine, update the Other_Sources table
  
!             Other_Sources.Table (Source_Id) := Source;
           end if;
  
        --  Compilation failed
--- 2320,2326 ----
           else
              --  Everything looks fine, update the Other_Sources table
  
!             Project_Tree.Other_Sources.Table (Source_Id) := Source;
           end if;
  
        --  Compilation failed
*************** package body Makegpr is
*** 2302,2308 ****
     --------------------------------
  
     procedure Compile_Individual_Sources is
!       Data         : Project_Data := Projects.Table (Main_Project);
        Source_Id    : Other_Source_Id;
        Source       : Other_Source;
        Source_Name  : Name_Id;
--- 2339,2346 ----
     --------------------------------
  
     procedure Compile_Individual_Sources is
!       Data         : Project_Data :=
!                        Project_Tree.Projects.Table (Main_Project);
        Source_Id    : Other_Source_Id;
        Source       : Other_Source;
        Source_Name  : Name_Id;
*************** package body Makegpr is
*** 2318,2324 ****
        Compile_Only := True;
  
        Get_Imported_Directories (Main_Project, Data);
!       Projects.Table (Main_Project) := Data;
  
        --  Compilation will occur in the object directory
  
--- 2356,2362 ----
        Compile_Only := True;
  
        Get_Imported_Directories (Main_Project, Data);
!       Project_Tree.Projects.Table (Main_Project) := Data;
  
        --  Compilation will occur in the object directory
  
*************** package body Makegpr is
*** 2361,2367 ****
                    Source_Id := Data.First_Other_Source;
  
                    while Source_Id /= No_Other_Source loop
!                      Source := Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Source_Name;
                       Source_Id := Source.Next;
                    end loop;
--- 2399,2406 ----
                    Source_Id := Data.First_Other_Source;
  
                    while Source_Id /= No_Other_Source loop
!                      Source :=
!                        Project_Tree.Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Source_Name;
                       Source_Id := Source.Next;
                    end loop;
*************** package body Makegpr is
*** 2406,2412 ****
     --------------------------------
  
     procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
!       Data    : constant Project_Data := Projects.Table (Main_Project);
        Success : Boolean;
  
     begin
--- 2445,2452 ----
     --------------------------------
  
     procedure Compile_Link_With_Gnatmake (Mains_Specified : Boolean) is
!       Data    : constant Project_Data :=
!                   Project_Tree.Projects.Table (Main_Project);
        Success : Boolean;
  
     begin
*************** package body Makegpr is
*** 2458,2463 ****
--- 2498,2509 ----
           Add_Argument (Dash_c, True);
        end if;
  
+       --  -d
+ 
+       if Display_Compilation_Progress then
+          Add_Argument (Dash_d, True);
+       end if;
+ 
        --  -k
  
        if Keep_Going then
*************** package body Makegpr is
*** 2563,2579 ****
        --  Keep_Going is True, to inhibit the building of the archive.
  
        Need_To_Compile : Boolean;
!       --  Set to True when a source needs to be compiled/recompiled.
  
        Need_To_Rebuild_Archive : Boolean := Force_Compilations;
        --  True when the archive needs to be built/rebuilt unconditionally
  
     begin
        --  Loop through project files
  
!       for Project in 1 .. Projects.Last loop
           Local_Errors := False;
!          Data := Projects.Table (Project);
  
           --  Nothing to do when no sources of language other than Ada
  
--- 2609,2648 ----
        --  Keep_Going is True, to inhibit the building of the archive.
  
        Need_To_Compile : Boolean;
!       --  Set to True when a source needs to be compiled/recompiled
  
        Need_To_Rebuild_Archive : Boolean := Force_Compilations;
        --  True when the archive needs to be built/rebuilt unconditionally
  
+       Total_Number_Of_Sources : Int := 0;
+ 
+       Current_Source_Number : Int := 0;
+ 
     begin
+       --  First, get the number of sources
+ 
+       for Project in Project_Table.First ..
+                      Project_Table.Last (Project_Tree.Projects)
+       loop
+          Data := Project_Tree.Projects.Table (Project);
+ 
+          if (not Data.Virtual) and then Data.Other_Sources_Present then
+             Source_Id := Data.First_Other_Source;
+             while Source_Id /= No_Other_Source loop
+                Source := Project_Tree.Other_Sources.Table (Source_Id);
+                Total_Number_Of_Sources := Total_Number_Of_Sources + 1;
+                Source_Id := Source.Next;
+             end loop;
+          end if;
+       end loop;
+ 
        --  Loop through project files
  
!       for Project in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!       loop
           Local_Errors := False;
!          Data := Project_Tree.Projects.Table (Project);
  
           --  Nothing to do when no sources of language other than Ada
  
*************** package body Makegpr is
*** 2584,2590 ****
              if not Data.Include_Data_Set then
                 Get_Imported_Directories (Project, Data);
                 Data.Include_Data_Set := True;
!                Projects.Table (Project) := Data;
              end if;
  
              Need_To_Rebuild_Archive := Force_Compilations;
--- 2653,2659 ----
              if not Data.Include_Data_Set then
                 Get_Imported_Directories (Project, Data);
                 Data.Include_Data_Set := True;
!                Project_Tree.Projects.Table (Project) := Data;
              end if;
  
              Need_To_Rebuild_Archive := Force_Compilations;
*************** package body Makegpr is
*** 2598,2604 ****
              --  Process each source one by one
  
              while Source_Id /= No_Other_Source loop
!                Source := Other_Sources.Table (Source_Id);
                 Need_To_Compile := Force_Compilations;
  
                 --  Check if compilation is needed
--- 2667,2675 ----
              --  Process each source one by one
  
              while Source_Id /= No_Other_Source loop
! 
!                Source := Project_Tree.Other_Sources.Table (Source_Id);
!                Current_Source_Number := Current_Source_Number + 1;
                 Need_To_Compile := Force_Compilations;
  
                 --  Check if compilation is needed
*************** package body Makegpr is
*** 2618,2623 ****
--- 2689,2706 ----
                    Compile (Source_Id, Data, Local_Errors);
                 end if;
  
+                if Display_Compilation_Progress then
+                   Write_Str ("completed ");
+                   Write_Int (Current_Source_Number);
+                   Write_Str (" out of ");
+                   Write_Int (Total_Number_Of_Sources);
+                   Write_Str (" (");
+                   Write_Int
+                     ((Current_Source_Number * 100) / Total_Number_Of_Sources);
+                   Write_Str ("%)...");
+                   Write_Eol;
+                end if;
+ 
                 --  Next source, if any
  
                 Source_Id := Source.Next;
*************** package body Makegpr is
*** 2670,2676 ****
        Source_Id : Other_Source_Id := First_Source;
        Source    : Other_Source;
        Dep_File  : Ada.Text_IO.File_Type;
-       use Ada.Text_IO;
  
     begin
        --  Create the file in Append mode, to avoid automatic insertion of
--- 2753,2758 ----
*************** package body Makegpr is
*** 2679,2685 ****
        Create (Dep_File, Append_File, Name);
  
        while Source_Id /= No_Other_Source loop
!          Source := Other_Sources.Table (Source_Id);
           Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
           Put_Line (Dep_File, String (Source.Object_TS));
           Source_Id := Source.Next;
--- 2761,2767 ----
        Create (Dep_File, Append_File, Name);
  
        while Source_Id /= No_Other_Source loop
!          Source := Project_Tree.Other_Sources.Table (Source_Id);
           Put_Line (Dep_File, Get_Name_String (Source.Object_Name));
           Put_Line (Dep_File, String (Source.Object_TS));
           Source_Id := Source.Next;
*************** package body Makegpr is
*** 2703,2710 ****
        Source    : Other_Source;
        Dep_File  : Ada.Text_IO.File_Type;
  
-       use Ada.Text_IO;
- 
     begin
        --  Create the file in Append mode, to avoid automatic insertion of
        --  an end of line if file is empty.
--- 2785,2790 ----
*************** package body Makegpr is
*** 2713,2724 ****
  
        --  Get all the object files of non-Ada sources in non-library projects
  
!       for Project in 1 .. Projects.Last loop
!          if not Projects.Table (Project).Library then
!             Source_Id := Projects.Table (Project).First_Other_Source;
  
              while Source_Id /= No_Other_Source loop
!                Source := Other_Sources.Table (Source_Id);
  
                 --  Put only those object files that are in the global archive
  
--- 2793,2807 ----
  
        --  Get all the object files of non-Ada sources in non-library projects
  
!       for Project in Project_Table.First ..
!                      Project_Table.Last (Project_Tree.Projects)
!       loop
!          if not Project_Tree.Projects.Table (Project).Library then
!             Source_Id :=
!               Project_Tree.Projects.Table (Project).First_Other_Source;
  
              while Source_Id /= No_Other_Source loop
!                Source := Project_Tree.Other_Sources.Table (Source_Id);
  
                 --  Put only those object files that are in the global archive
  
*************** package body Makegpr is
*** 2791,2800 ****
     ------------------
  
     procedure Get_Compiler (For_Language : First_Language_Indexes) is
!       Data : constant Project_Data := Projects.Table (Main_Project);
  
        Ide : constant Package_Id :=
!         Value_Of (Name_Ide, In_Packages => Data.Decl.Packages);
        --  The id of the package IDE in the project file
  
        Compiler : constant Variable_Value :=
--- 2874,2887 ----
     ------------------
  
     procedure Get_Compiler (For_Language : First_Language_Indexes) is
!       Data : constant Project_Data :=
!                Project_Tree.Projects.Table (Main_Project);
  
        Ide : constant Package_Id :=
!         Value_Of
!           (Name_Ide,
!            In_Packages => Data.Decl.Packages,
!            In_Tree     => Project_Tree);
        --  The id of the package IDE in the project file
  
        Compiler : constant Variable_Value :=
*************** package body Makegpr is
*** 2802,2808 ****
            (Name                    => Language_Names.Table (For_Language),
             Index                   => 0,
             Attribute_Or_Array_Name => Name_Compiler_Command,
!            In_Package              => Ide);
        --  The value of Compiler_Command ("language") in package IDE, if defined
  
     begin
--- 2889,2896 ----
            (Name                    => Language_Names.Table (For_Language),
             Index                   => 0,
             Attribute_Or_Array_Name => Name_Compiler_Command,
!            In_Package              => Ide,
!            In_Tree                 => Project_Tree);
        --  The value of Compiler_Command ("language") in package IDE, if defined
  
     begin
*************** package body Makegpr is
*** 2902,2908 ****
           --  Add each source directory path name, preceded by "-I" to Arguments
  
           while Element_Id /= Nil_String loop
!             Element := String_Elements.Table (Element_Id);
  
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Value);
--- 2990,2996 ----
           --  Add each source directory path name, preceded by "-I" to Arguments
  
           while Element_Id /= Nil_String loop
!             Element := Project_Tree.String_Elements.Table (Element_Id);
  
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Value);
*************** package body Makegpr is
*** 2960,2966 ****
           --  Nothing to do if project is undefined
  
           if Prj /= No_Project then
!             Data := Projects.Table (Prj);
  
              --  Nothing to do if project has already been processed
  
--- 3048,3054 ----
           --  Nothing to do if project is undefined
  
           if Prj /= No_Project then
!             Data := Project_Tree.Projects.Table (Prj);
  
              --  Nothing to do if project has already been processed
  
*************** package body Makegpr is
*** 2969,2975 ****
                 --  Mark the project as processed, to avoid multiple processing
                 --  of the same project.
  
!                Projects.Table (Prj).Seen := True;
  
                 --  Add the source directories of this project
  
--- 3057,3063 ----
                 --  Mark the project as processed, to avoid multiple processing
                 --  of the same project.
  
!                Project_Tree.Projects.Table (Prj).Seen := True;
  
                 --  Add the source directories of this project
  
*************** package body Makegpr is
*** 2984,2991 ****
                 --  Call itself for all imported projects, if any
  
                 while Imported /= Empty_Project_List loop
!                   Recursive_Get_Dirs (Project_Lists.Table (Imported).Project);
!                   Imported := Project_Lists.Table (Imported).Next;
                 end loop;
              end if;
           end if;
--- 3072,3082 ----
                 --  Call itself for all imported projects, if any
  
                 while Imported /= Empty_Project_List loop
!                   Recursive_Get_Dirs
!                     (Project_Tree.Project_Lists.Table
!                        (Imported).Project);
!                   Imported :=
!                     Project_Tree.Project_Lists.Table (Imported).Next;
                 end loop;
              end if;
           end if;
*************** package body Makegpr is
*** 2996,3003 ****
     begin
        --  First, mark all project as not processed
  
!       for J in 1 .. Projects.Last loop
!          Projects.Table (J).Seen := False;
        end loop;
  
        --  Empty Arguments
--- 3087,3096 ----
     begin
        --  First, mark all project as not processed
  
!       for J in Project_Table.First ..
!                Project_Table.Last (Project_Tree.Projects)
!       loop
!          Project_Tree.Projects.Table (J).Seen := False;
        end loop;
  
        --  Empty Arguments
*************** package body Makegpr is
*** 3006,3020 ****
  
        --  Process this project individually, project data are already known
  
!       Projects.Table (Project).Seen := True;
  
        Add (Data.Source_Dirs);
  
        Recursive_Get_Dirs (Data.Extends);
  
        while Imported_Projects /= Empty_Project_List loop
!          Recursive_Get_Dirs (Project_Lists.Table (Imported_Projects).Project);
!          Imported_Projects := Project_Lists.Table (Imported_Projects).Next;
        end loop;
  
        Data.Imported_Directories_Switches :=
--- 3099,3116 ----
  
        --  Process this project individually, project data are already known
  
!       Project_Tree.Projects.Table (Project).Seen := True;
  
        Add (Data.Source_Dirs);
  
        Recursive_Get_Dirs (Data.Extends);
  
        while Imported_Projects /= Empty_Project_List loop
!          Recursive_Get_Dirs
!            (Project_Tree.Project_Lists.Table
!               (Imported_Projects).Project);
!          Imported_Projects := Project_Tree.Project_Lists.Table
!                                 (Imported_Projects).Next;
        end loop;
  
        Data.Imported_Directories_Switches :=
*************** package body Makegpr is
*** 3059,3064 ****
--- 3155,3161 ----
  
        Prj.Pars.Parse
          (Project           => Main_Project,
+          In_Tree           => Project_Tree,
           Project_File_Name => Project_File_Name.all,
           Packages_To_Check => Packages_To_Check);
  
*************** package body Makegpr is
*** 3092,3098 ****
  
        else
           declare
!             Data : constant Prj.Project_Data := Projects.Table (Main_Project);
           begin
              if Data.Library and then Mains.Number_Of_Mains /= 0 then
                 Osint.Fail
--- 3189,3196 ----
  
        else
           declare
!             Data : constant Prj.Project_Data :=
!                      Project_Tree.Projects.Table (Main_Project);
           begin
              if Data.Library and then Mains.Number_Of_Mains /= 0 then
                 Osint.Fail
*************** package body Makegpr is
*** 3119,3125 ****
              --  If -c was not specified, link the executables,
              --  if there are any.
  
!             if not Compile_Only and then not Data.Library then
                 Build_Global_Archive;
                 Link_Executables;
              end if;
--- 3217,3226 ----
              --  If -c was not specified, link the executables,
              --  if there are any.
  
!             if not Compile_Only
!               and then not Data.Library
!               and then Data.Object_Directory /= No_Name
!             then
                 Build_Global_Archive;
                 Link_Executables;
              end if;
*************** package body Makegpr is
*** 3143,3149 ****
        Csets.Initialize;
        Namet.Initialize;
        Snames.Initialize;
!       Prj.Initialize;
        Mains.Delete;
  
        --  Set Name_Ide and Name_Compiler_Command
--- 3244,3250 ----
        Csets.Initialize;
        Namet.Initialize;
        Snames.Initialize;
!       Prj.Initialize (Project_Tree);
        Mains.Delete;
  
        --  Set Name_Ide and Name_Compiler_Command
*************** package body Makegpr is
*** 3198,3216 ****
       (Object_Name : Name_Id;
        Project     : Project_Id) return Boolean
     is
!       Data   : Project_Data := Projects.Table (Project);
        Source : Other_Source_Id;
  
     begin
        while Data.Extended_By /= No_Project loop
!          Data := Projects.Table (Data.Extended_By);
!          Source := Data.First_Other_Source;
  
           while Source /= No_Other_Source loop
!             if Other_Sources.Table (Source).Object_Name = Object_Name then
                 return False;
              else
!                Source := Other_Sources.Table (Source).Next;
              end if;
           end loop;
        end loop;
--- 3299,3320 ----
       (Object_Name : Name_Id;
        Project     : Project_Id) return Boolean
     is
!       Data   : Project_Data := Project_Tree.Projects.Table (Project);
        Source : Other_Source_Id;
  
     begin
        while Data.Extended_By /= No_Project loop
!          Data := Project_Tree.Projects.Table (Data.Extended_By);
  
+          Source := Data.First_Other_Source;
           while Source /= No_Other_Source loop
!             if Project_Tree.Other_Sources.Table (Source).Object_Name =
!                  Object_Name
!             then
                 return False;
              else
!                Source :=
!                  Project_Tree.Other_Sources.Table (Source).Next;
              end if;
           end loop;
        end loop;
*************** package body Makegpr is
*** 3223,3229 ****
     ----------------------
  
     procedure Link_Executables is
!       Data : constant Project_Data := Projects.Table (Main_Project);
  
        Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
        --  True if main sources were specified on the command line
--- 3327,3334 ----
     ----------------------
  
     procedure Link_Executables is
!       Data : constant Project_Data :=
!                Project_Tree.Projects.Table (Main_Project);
  
        Mains_Specified : constant Boolean := Mains.Number_Of_Mains /= 0;
        --  True if main sources were specified on the command line
*************** package body Makegpr is
*** 3266,3283 ****
  
        procedure Add_C_Plus_Plus_Link_For_Gnatmake is
        begin
!          if Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
!             Add_Argument
!               ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
!                Verbose_Mode);
! 
!          else
!             Add_Argument
!               ("--LINK=" &
!                Object_Dir & Directory_Separator &
!                Cpp_Linker,
!                Verbose_Mode);
!          end if;
        end Add_C_Plus_Plus_Link_For_Gnatmake;
  
        -----------------------
--- 3371,3379 ----
  
        procedure Add_C_Plus_Plus_Link_For_Gnatmake is
        begin
!          Add_Argument
!            ("--LINK=" & Compiler_Names (C_Plus_Plus_Language_Index).all,
!             Verbose_Mode);
        end Add_C_Plus_Plus_Link_For_Gnatmake;
  
        -----------------------
*************** package body Makegpr is
*** 3288,3295 ****
           Prj_Data : Project_Data;
  
        begin
!          for Prj in 1 .. Projects.Last loop
!             Prj_Data := Projects.Table (Prj);
  
              --  There is an archive only in project
              --  files with sources other than Ada
--- 3384,3393 ----
           Prj_Data : Project_Data;
  
        begin
!          for Prj in Project_Table.First ..
!                     Project_Table.Last (Project_Tree.Projects)
!          loop
!             Prj_Data := Project_Tree.Projects.Table (Prj);
  
              --  There is an archive only in project
              --  files with sources other than Ada
*************** package body Makegpr is
*** 3344,3372 ****
           if Compiler_Names (C_Plus_Plus_Language_Index) = null then
              Get_Compiler (C_Plus_Plus_Language_Index);
           end if;
- 
-          if not Compiler_Is_Gcc (C_Plus_Plus_Language_Index) then
-             Change_Dir (Object_Dir);
- 
-             declare
-                File : Ada.Text_IO.File_Type;
-                use Ada.Text_IO;
- 
-             begin
-                Create (File, Out_File, Cpp_Linker);
- 
-                Put_Line (File, "#!/bin/sh");
- 
-                Put_Line (File, "LIBGCC=`gcc -print-libgcc-file-name`");
-                Put_Line
-                  (File,
-                   Compiler_Names (C_Plus_Plus_Language_Index).all &
-                   " $* ${LIBGCC}");
- 
-                Close (File);
-                Set_Executable (Cpp_Linker);
-             end;
-          end if;
        end Choose_C_Plus_Plus_Link_Process;
  
        ------------------
--- 3442,3447 ----
*************** package body Makegpr is
*** 3381,3390 ****
           Executable_Name : constant String :=
                               Get_Name_String
                                 (Executable_Of
!                                   (Project  => Main_Project,
!                                    Main     => Main_Id,
!                                    Index    => 0,
!                                    Ada_Main => False));
           --  File name of the executable
  
           Executable_Path : constant String :=
--- 3456,3466 ----
           Executable_Name : constant String :=
                               Get_Name_String
                                 (Executable_Of
!                                     (Project  => Main_Project,
!                                      In_Tree  => Project_Tree,
!                                      Main     => Main_Id,
!                                      Index    => 0,
!                                      Ada_Main => False));
           --  File name of the executable
  
           Executable_Path : constant String :=
*************** package body Makegpr is
*** 3453,3458 ****
--- 3529,3535 ----
                 Get_Name_String
                   (Executable_Of
                      (Project  => Main_Project,
+                      In_Tree  => Project_Tree,
                       Main     => Main_Id,
                       Index    => 0,
                       Ada_Main => False)),
*************** package body Makegpr is
*** 3484,3490 ****
              if Link_Options_Switches = null then
                 Link_Options_Switches :=
                   new Argument_List'
!                    (Linker_Options_Switches (Main_Project));
              end if;
  
              Add_Arguments (Link_Options_Switches.all, True);
--- 3561,3567 ----
              if Link_Options_Switches = null then
                 Link_Options_Switches :=
                   new Argument_List'
!                    (Linker_Options_Switches (Main_Project, Project_Tree));
              end if;
  
              Add_Arguments (Link_Options_Switches.all, True);
*************** package body Makegpr is
*** 3532,3538 ****
  
           begin
              while Element_Id /= Nil_String loop
!                Element := String_Elements.Table (Element_Id);
  
                 if Element.Value /= No_Name then
                    Mains.Add_Main (Get_Name_String (Element.Value));
--- 3609,3616 ----
  
           begin
              while Element_Id /= Nil_String loop
!                Element := Project_Tree.String_Elements.Table
!                             (Element_Id);
  
                 if Element.Value /= No_Name then
                    Mains.Add_Main (Get_Name_String (Element.Value));
*************** package body Makegpr is
*** 3602,3608 ****
              --  project. Any main that is not a source of the other languages
              --  will be deemed to be an Ada main.
  
!             --  Find the mains of the other languages and the Ada mains.
  
              Mains.Reset;
              Ada_Mains.Set_Last (0);
--- 3680,3686 ----
              --  project. Any main that is not a source of the other languages
              --  will be deemed to be an Ada main.
  
!             --  Find the mains of the other languages and the Ada mains
  
              Mains.Reset;
              Ada_Mains.Set_Last (0);
*************** package body Makegpr is
*** 3629,3635 ****
                    --  Check if it is a source of a language other than Ada
  
                    while Source_Id /= No_Other_Source loop
!                      Source := Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Main_Id;
                       Source_Id := Source.Next;
                    end loop;
--- 3707,3714 ----
                    --  Check if it is a source of a language other than Ada
  
                    while Source_Id /= No_Other_Source loop
!                      Source :=
!                        Project_Tree.Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Main_Id;
                       Source_Id := Source.Next;
                    end loop;
*************** package body Makegpr is
*** 3674,3679 ****
--- 3753,3759 ----
                         (Get_Name_String
                            (Executable_Of
                               (Project  => Main_Project,
+                               In_Tree  => Project_Tree,
                                Main     => Other_Mains.Table (Main).File_Name,
                                Index    => 0,
                                Ada_Main => False)),
*************** package body Makegpr is
*** 3774,3780 ****
                    --  Check if it is a source of the main project file
  
                    while Source_Id /= No_Other_Source loop
!                      Source := Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Main_Id;
                       Source_Id := Source.Next;
                    end loop;
--- 3854,3861 ----
                    --  Check if it is a source of the main project file
  
                    while Source_Id /= No_Other_Source loop
!                      Source :=
!                        Project_Tree.Other_Sources.Table (Source_Id);
                       exit when Source.File_Name = Main_Id;
                       Source_Id := Source.Next;
                    end loop;
*************** package body Makegpr is
*** 3815,3820 ****
--- 3896,3902 ----
                         (Get_Name_String
                            (Executable_Of
                               (Project  => Main_Project,
+                               In_Tree  => Project_Tree,
                                Main     => Main_Id,
                                Index    => 0,
                                Ada_Main => False)));
*************** package body Makegpr is
*** 3962,3967 ****
--- 4044,4059 ----
           if Arg = "-c" then
              Compile_Only := True;
  
+             --  Make sure that when a main is specified and switch -c is used,
+             --  only the main(s) is/are compiled.
+ 
+             if Mains.Number_Of_Mains > 0 then
+                Unique_Compile := True;
+             end if;
+ 
+          elsif Arg = "-d" then
+             Display_Compilation_Progress := True;
+ 
           elsif Arg = "-f" then
              Force_Compilations := True;
  
*************** package body Makegpr is
*** 4034,4039 ****
--- 4126,4138 ----
           --  Not a switch: must be a main
  
           Mains.Add_Main (Arg);
+ 
+          --  Make sure that when a main is specified and switch -c is used,
+          --  only the main(s) is/are compiled.
+ 
+          if Compile_Only then
+             Unique_Compile := True;
+          end if;
        end if;
     end Scan_Arg;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/makegpr.ads gcc-4.1.0/gcc/ada/makegpr.ads
*** gcc-4.0.2/gcc/ada/makegpr.ads	Mon May  3 11:58:34 2004
--- gcc-4.1.0/gcc/ada/makegpr.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 30,35 ****
  package Makegpr is
  
     procedure Gprmake;
!    --  The driver of gprmake.
  
  end Makegpr;
--- 30,35 ----
  package Makegpr is
  
     procedure Gprmake;
!    --  The driver of gprmake
  
  end Makegpr;
diff -Nrcpad gcc-4.0.2/gcc/ada/makeusg.adb gcc-4.1.0/gcc/ada/makeusg.adb
*** gcc-4.0.2/gcc/ada/makeusg.adb	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/makeusg.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/makeusg.ads gcc-4.1.0/gcc/ada/makeusg.ads
*** gcc-4.0.2/gcc/ada/makeusg.ads	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/makeusg.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/makeutl.adb gcc-4.1.0/gcc/ada/makeutl.adb
*** gcc-4.0.2/gcc/ada/makeutl.adb	Mon May 10 16:18:52 2004
--- gcc-4.1.0/gcc/ada/makeutl.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,37 ****
  
  with Namet;    use Namet;
  with Osint;    use Osint;
- with Prj;      use Prj;
  with Prj.Ext;
  with Prj.Util;
  with Snames;   use Snames;
  with Table;
- with Types;    use Types;
  
  with System.HTable;
  
--- 26,35 ----
*************** package body Makeutl is
*** 59,65 ****
        Key        => Mark_Key,
        Hash       => Hash,
        Equal      => "=");
!    --  A hash table to keep tracks of the marked units.
  
     type Linker_Options_Data is record
        Project : Project_Id;
--- 57,63 ----
        Key        => Mark_Key,
        Hash       => Hash,
        Equal      => "=");
!    --  A hash table to keep tracks of the marked units
  
     type Linker_Options_Data is record
        Project : Project_Id;
*************** package body Makeutl is
*** 185,191 ****
     -----------------------------
  
     function Linker_Options_Switches
!      (Project  : Project_Id) return String_List
     is
        procedure Recursive_Add_Linker_Options (Proj : Project_Id);
        --  The recursive routine used to add linker options
--- 183,190 ----
     -----------------------------
  
     function Linker_Options_Switches
!      (Project  : Project_Id;
!       In_Tree  : Project_Tree_Ref) return String_List
     is
        procedure Recursive_Add_Linker_Options (Proj : Project_Id);
        --  The recursive routine used to add linker options
*************** package body Makeutl is
*** 202,230 ****
  
        begin
           if Proj /= No_Project then
!             Data := Projects.Table (Proj);
  
              if not Data.Seen then
!                Projects.Table (Proj).Seen := True;
                 Imported := Data.Imported_Projects;
  
                 while Imported /= Empty_Project_List loop
                    Recursive_Add_Linker_Options
!                     (Project_Lists.Table (Imported).Project);
!                   Imported := Project_Lists.Table (Imported).Next;
                 end loop;
  
                 if Proj /= Project then
                    Linker_Package :=
                      Prj.Util.Value_Of
!                       (Name => Name_Linker,
!                        In_Packages => Data.Decl.Packages);
                    Options :=
                      Prj.Util.Value_Of
!                       (Name => Name_Ada,
!                        Index => 0,
                         Attribute_Or_Array_Name => Name_Linker_Options,
!                        In_Package => Linker_Package);
  
                    --  If attribute is present, add the project with
                    --  the attribute to table Linker_Opts.
--- 201,233 ----
  
        begin
           if Proj /= No_Project then
!             Data := In_Tree.Projects.Table (Proj);
  
              if not Data.Seen then
!                In_Tree.Projects.Table (Proj).Seen := True;
                 Imported := Data.Imported_Projects;
  
                 while Imported /= Empty_Project_List loop
                    Recursive_Add_Linker_Options
!                     (In_Tree.Project_Lists.Table
!                        (Imported).Project);
!                   Imported := In_Tree.Project_Lists.Table
!                                 (Imported).Next;
                 end loop;
  
                 if Proj /= Project then
                    Linker_Package :=
                      Prj.Util.Value_Of
!                       (Name        => Name_Linker,
!                        In_Packages => Data.Decl.Packages,
!                        In_Tree     => In_Tree);
                    Options :=
                      Prj.Util.Value_Of
!                       (Name                    => Name_Ada,
!                        Index                   => 0,
                         Attribute_Or_Array_Name => Name_Linker_Options,
!                        In_Package              => Linker_Package,
!                        In_Tree                 => In_Tree);
  
                    --  If attribute is present, add the project with
                    --  the attribute to table Linker_Opts.
*************** package body Makeutl is
*** 244,251 ****
     begin
        Linker_Opts.Init;
  
!       for Index in 1 .. Projects.Last loop
!          Projects.Table (Index).Seen := False;
        end loop;
  
        Recursive_Add_Linker_Options (Project);
--- 247,256 ----
     begin
        Linker_Opts.Init;
  
!       for Index in Project_Table.First ..
!                    Project_Table.Last (In_Tree.Projects)
!       loop
!          In_Tree.Projects.Table (Index).Seen := False;
        end loop;
  
        Recursive_Add_Linker_Options (Project);
*************** package body Makeutl is
*** 262,276 ****
           begin
              --  If Dir_Path has not been computed for this project, do it now
  
!             if Projects.Table (Proj).Dir_Path = null then
!                Projects.Table (Proj).Dir_Path :=
                   new String'
!                    (Get_Name_String (Projects.Table (Proj). Directory));
              end if;
  
              while Options /= Nil_String loop
!                Option := String_Elements.Table (Options).Value;
!                Options := String_Elements.Table (Options).Next;
                 Add_Linker_Option (Get_Name_String (Option));
  
                 --  Object files and -L switches specified with
--- 267,285 ----
           begin
              --  If Dir_Path has not been computed for this project, do it now
  
!             if In_Tree.Projects.Table (Proj).Dir_Path = null then
!                In_Tree.Projects.Table (Proj).Dir_Path :=
                   new String'
!                    (Get_Name_String
!                         (In_Tree.Projects.Table
!                              (Proj). Directory));
              end if;
  
              while Options /= Nil_String loop
!                Option :=
!                  In_Tree.String_Elements.Table (Options).Value;
!                Options :=
!                  In_Tree.String_Elements.Table (Options).Next;
                 Add_Linker_Option (Get_Name_String (Option));
  
                 --  Object files and -L switches specified with
*************** package body Makeutl is
*** 280,286 ****
                 Test_If_Relative_Path
                   (Switch =>
                      Linker_Options_Buffer (Last_Linker_Option),
!                   Parent => Projects.Table (Proj).Dir_Path,
                    Including_L_Switch => True);
              end loop;
           end;
--- 289,296 ----
                 Test_If_Relative_Path
                   (Switch =>
                      Linker_Options_Buffer (Last_Linker_Option),
!                   Parent =>
!                     In_Tree.Projects.Table (Proj).Dir_Path,
                    Including_L_Switch => True);
              end loop;
           end;
*************** package body Makeutl is
*** 326,332 ****
        procedure Delete is
        begin
           Names.Set_Last (0);
!          Reset;
        end Delete;
  
        ---------------
--- 336,342 ----
        procedure Delete is
        begin
           Names.Set_Last (0);
!          Mains.Reset;
        end Delete;
  
        ---------------
diff -Nrcpad gcc-4.0.2/gcc/ada/makeutl.ads gcc-4.1.0/gcc/ada/makeutl.ads
*** gcc-4.0.2/gcc/ada/makeutl.ads	Mon May 10 16:18:52 2004
--- gcc-4.1.0/gcc/ada/makeutl.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Makeutl is
*** 56,63 ****
     --  been entered by a call to Prj.Ext.Add, so that in a project
     --  file, External ("name") will return "value".
  
!    function Linker_Options_Switches (Project  : Project_Id) return String_List;
!    --  Comment required ???
  
     --  Package Mains is used to store the mains specified on the command line
     --  and to retrieve them when a project file is used, to verify that the
--- 56,67 ----
     --  been entered by a call to Prj.Ext.Add, so that in a project
     --  file, External ("name") will return "value".
  
!    function Linker_Options_Switches
!      (Project  : Project_Id;
!       In_Tree  : Project_Tree_Ref) return String_List;
!    --  Collect the options specified in the Linker'Linker_Options attributes
!    --  of project Project, in project tree In_Tree, and in the projects that
!    --  it imports directly or indirectly, and returns the result.
  
     --  Package Mains is used to store the mains specified on the command line
     --  and to retrieve them when a project file is used, to verify that the
*************** package Makeutl is
*** 109,115 ****
     function Is_Marked
       (Source_File : File_Name_Type;
        Index       : Int := 0) return Boolean;
!    --  Returns True if the unit was previously marked.
  
     procedure Delete_All_Marks;
     --  Remove all file/index couples marked
--- 113,119 ----
     function Is_Marked
       (Source_File : File_Name_Type;
        Index       : Int := 0) return Boolean;
!    --  Returns True if the unit was previously marked
  
     procedure Delete_All_Marks;
     --  Remove all file/index couples marked
diff -Nrcpad gcc-4.0.2/gcc/ada/math_lib.adb gcc-4.1.0/gcc/ada/math_lib.adb
*** gcc-4.0.2/gcc/ada/math_lib.adb	Thu Apr 24 17:54:06 2003
--- gcc-4.1.0/gcc/ada/math_lib.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                             M A T H _ L I B                              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                             M A T H _ L I B                              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll-fil.adb gcc-4.1.0/gcc/ada/mdll-fil.adb
*** gcc-4.0.2/gcc/ada/mdll-fil.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mdll-fil.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Simple services used by GNATDLL to deal with Filename extension.
  
  with Ada.Strings.Fixed;
  
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Simple services used by GNATDLL to deal with Filename extension
  
  with Ada.Strings.Fixed;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll-fil.ads gcc-4.1.0/gcc/ada/mdll-fil.ads
*** gcc-4.0.2/gcc/ada/mdll-fil.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mdll-fil.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package MDLL.Fil is
*** 35,41 ****
     --  Return extension of Filename
  
     function Is_Ali (Filename : String) return Boolean;
!    --  Test if Filename is an Ada library file (.ali).
  
     function Is_Obj (Filename : String) return Boolean;
     --  Test if Filename is an object file (.o or .obj)
--- 35,41 ----
     --  Return extension of Filename
  
     function Is_Ali (Filename : String) return Boolean;
!    --  Test if Filename is an Ada library file (.ali)
  
     function Is_Obj (Filename : String) return Boolean;
     --  Test if Filename is an object file (.o or .obj)
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll-utl.adb gcc-4.1.0/gcc/ada/mdll-utl.adb
*** gcc-4.0.2/gcc/ada/mdll-utl.adb	Mon Apr 19 15:20:00 2004
--- gcc-4.1.0/gcc/ada/mdll-utl.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll-utl.ads gcc-4.1.0/gcc/ada/mdll-utl.ads
*** gcc-4.0.2/gcc/ada/mdll-utl.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mdll-utl.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package MDLL.Utl is
*** 44,50 ****
        Options     : Argument_List;
        Base_File   : String := "";
        Build_Lib   : Boolean := False);
!    --  Run gcc binary.
  
     procedure Gnatbind
       (Alis : Argument_List;
--- 44,50 ----
        Options     : Argument_List;
        Base_File   : String := "";
        Build_Lib   : Boolean := False);
!    --  Run gcc binary
  
     procedure Gnatbind
       (Alis : Argument_List;
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll.adb gcc-4.1.0/gcc/ada/mdll.adb
*** gcc-4.0.2/gcc/ada/mdll.adb	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/mdll.adb	Tue Nov 15 14:00:50 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body MDLL is
*** 38,43 ****
--- 38,47 ----
     use Ada;
     use GNAT;
  
+    function Get_Dll_Name (Lib_Filename : String) return String;
+    --  Returns <Lib_Filename> if it contains a file extension otherwise it
+    --  returns <Lib_Filename>.dll.
+ 
     ---------------------------
     -- Build_Dynamic_Library --
     ---------------------------
*************** package body MDLL is
*** 63,69 ****
        Def_File : aliased constant String := Def_Filename;
        Jnk_File : aliased          String := Base_Filename & ".jnk";
        Bas_File : aliased constant String := Base_Filename & ".base";
!       Dll_File : aliased          String := Base_Filename & ".dll";
        Exp_File : aliased          String := Base_Filename & ".exp";
        Lib_File : aliased constant String := "lib" & Base_Filename & ".a";
  
--- 67,73 ----
        Def_File : aliased constant String := Def_Filename;
        Jnk_File : aliased          String := Base_Filename & ".jnk";
        Bas_File : aliased constant String := Base_Filename & ".base";
!       Dll_File : aliased          String := Get_Dll_Name (Lib_Filename);
        Exp_File : aliased          String := Base_Filename & ".exp";
        Lib_File : aliased constant String := "lib" & Base_Filename & ".a";
  
*************** package body MDLL is
*** 75,108 ****
  
        L_Afiles : Argument_List := Afiles;
        --  Local afiles list. This list can be reordered to ensure that the
!       --  binder ali file is not the first entry in this list.
  
        All_Options : constant Argument_List := Options & Largs_Options;
  
        procedure Build_Reloc_DLL;
!       --  Build a relocatable DLL with only objects file specified.
!       --  this use the well known 5 steps build. (see GNAT User's Guide).
  
        procedure Ada_Build_Reloc_DLL;
!       --  Build a relocatable DLL with Ada code.
!       --  this use the well known 5 steps build. (see GNAT User's Guide).
  
        procedure Build_Non_Reloc_DLL;
!       --  Build a non relocatable DLL containing no Ada code.
  
        procedure Ada_Build_Non_Reloc_DLL;
!       --  Build a non relocatable DLL with Ada code.
  
        ---------------------
        -- Build_Reloc_DLL --
        ---------------------
  
        procedure Build_Reloc_DLL is
           --  Objects plus the export table (.exp) file
-          Objects_Exp_File : constant OS_Lib.Argument_List
-            := Exp_File'Unchecked_Access & Ofiles;
  
           Success : Boolean;
        begin
           if not Quiet then
              Text_IO.Put_Line ("building relocatable DLL...");
--- 79,114 ----
  
        L_Afiles : Argument_List := Afiles;
        --  Local afiles list. This list can be reordered to ensure that the
!       --  binder ALI file is not the first entry in this list.
  
        All_Options : constant Argument_List := Options & Largs_Options;
  
        procedure Build_Reloc_DLL;
!       --  Build a relocatable DLL with only objects file specified. This uses
!       --  the well known five step build (see GNAT User's Guide).
  
        procedure Ada_Build_Reloc_DLL;
!       --  Build a relocatable DLL with Ada code. This uses the well known five
!       --  step build (see GNAT User's Guide).
  
        procedure Build_Non_Reloc_DLL;
!       --  Build a non relocatable DLL containing no Ada code
  
        procedure Ada_Build_Non_Reloc_DLL;
!       --  Build a non relocatable DLL with Ada code
  
        ---------------------
        -- Build_Reloc_DLL --
        ---------------------
  
        procedure Build_Reloc_DLL is
+ 
+          Objects_Exp_File : constant OS_Lib.Argument_List :=
+                               Exp_File'Unchecked_Access & Ofiles;
           --  Objects plus the export table (.exp) file
  
           Success : Boolean;
+ 
        begin
           if not Quiet then
              Text_IO.Put_Line ("building relocatable DLL...");
*************** package body MDLL is
*** 115,121 ****
              end if;
           end if;
  
!          --  1) Build base file with objects files.
  
           Utl.Gcc (Output_File => Jnk_File,
                    Files       => Ofiles,
--- 121,127 ----
              end if;
           end if;
  
!          --  1) Build base file with objects files
  
           Utl.Gcc (Output_File => Jnk_File,
                    Files       => Ofiles,
*************** package body MDLL is
*** 123,136 ****
                    Base_File   => Bas_File,
                    Build_Lib   => True);
  
!          --  2) Build exp from base file.
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Base_File    => Bas_File,
                        Exp_Table    => Exp_File,
                        Build_Import => False);
  
!          --  3) Build base file with exp file and objects files.
  
           Utl.Gcc (Output_File => Jnk_File,
                    Files       => Objects_Exp_File,
--- 129,142 ----
                    Base_File   => Bas_File,
                    Build_Lib   => True);
  
!          --  2) Build exp from base file
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Base_File    => Bas_File,
                        Exp_Table    => Exp_File,
                        Build_Import => False);
  
!          --  3) Build base file with exp file and objects files
  
           Utl.Gcc (Output_File => Jnk_File,
                    Files       => Objects_Exp_File,
*************** package body MDLL is
*** 148,164 ****
           --  5) Build the dynamic library
  
           declare
!             Params : OS_Lib.Argument_List :=
!                        Adr_Opt'Unchecked_Access & All_Options;
           begin
              if Map_File then
!                Params := Map_Opt'Unchecked_Access & Params;
              end if;
  
              Utl.Gcc
                (Output_File => Dll_File,
                 Files       => Objects_Exp_File,
!                Options     => Params,
                 Build_Lib   => True);
           end;
  
--- 154,173 ----
           --  5) Build the dynamic library
  
           declare
!             Params      : constant OS_Lib.Argument_List :=
!                             Map_Opt'Unchecked_Access &
!                             Adr_Opt'Unchecked_Access & All_Options;
!             First_Param : Positive := Params'First + 1;
! 
           begin
              if Map_File then
!                First_Param := Params'First;
              end if;
  
              Utl.Gcc
                (Output_File => Dll_File,
                 Files       => Objects_Exp_File,
!                Options     => Params (First_Param .. Params'Last),
                 Build_Lib   => True);
           end;
  
*************** package body MDLL is
*** 180,185 ****
--- 189,195 ----
  
        procedure Ada_Build_Reloc_DLL is
           Success : Boolean;
+ 
        begin
           if not Quiet then
              Text_IO.Put_Line ("Building relocatable DLL...");
*************** package body MDLL is
*** 192,198 ****
              end if;
           end if;
  
!          --  1) Build base file with objects files.
  
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
--- 202,208 ----
              end if;
           end if;
  
!          --  1) Build base file with objects files
  
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
*************** package body MDLL is
*** 208,221 ****
              Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
           end;
  
!          --  2) Build exp from base file.
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Base_File    => Bas_File,
                        Exp_Table    => Exp_File,
                        Build_Import => False);
  
!          --  3) Build base file with exp file and objects files.
  
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
--- 218,231 ----
              Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
           end;
  
!          --  2) Build exp from base file
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Base_File    => Bas_File,
                        Exp_Table    => Exp_File,
                        Build_Import => False);
  
!          --  3) Build base file with exp file and objects files
  
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
*************** package body MDLL is
*** 244,263 ****
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
           declare
!             Params : OS_Lib.Argument_List :=
!                        Out_Opt'Unchecked_Access &
!                        Dll_File'Unchecked_Access &
!                        Lib_Opt'Unchecked_Access &
!                        Exp_File'Unchecked_Access &
!                        Adr_Opt'Unchecked_Access &
!                        Ofiles &
!                        All_Options;
           begin
              if Map_File then
!                Params := Map_Opt'Unchecked_Access & Params;
              end if;
  
!             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
           end;
  
           OS_Lib.Delete_File (Exp_File, Success);
--- 254,278 ----
           Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
  
           declare
!             Params      : constant OS_Lib.Argument_List :=
!                             Map_Opt'Unchecked_Access &
!                             Out_Opt'Unchecked_Access &
!                             Dll_File'Unchecked_Access &
!                             Lib_Opt'Unchecked_Access &
!                             Exp_File'Unchecked_Access &
!                             Adr_Opt'Unchecked_Access &
!                             Ofiles &
!                             All_Options;
!             First_Param : Positive := Params'First + 1;
! 
           begin
              if Map_File then
!                First_Param := Params'First;
              end if;
  
!             Utl.Gnatlink
!               (L_Afiles (L_Afiles'Last).all,
!                Params (First_Param .. Params'Last));
           end;
  
           OS_Lib.Delete_File (Exp_File, Success);
*************** package body MDLL is
*** 278,283 ****
--- 293,299 ----
  
        procedure Build_Non_Reloc_DLL is
           Success : Boolean;
+ 
        begin
           if not Quiet then
              Text_IO.Put_Line ("building non relocatable DLL...");
*************** package body MDLL is
*** 291,297 ****
              end if;
           end if;
  
!          --  Build exp table and the lib .a file.
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Exp_Table    => Exp_File,
--- 307,313 ----
              end if;
           end if;
  
!          --  Build exp table and the lib .a file
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Exp_Table    => Exp_File,
*************** package body MDLL is
*** 325,334 ****
        -- Ada_Build_Non_Reloc_DLL --
        -----------------------------
  
!       --  Build a non relocatable DLL with Ada code.
  
        procedure Ada_Build_Non_Reloc_DLL is
           Success : Boolean;
        begin
           if not Quiet then
              Text_IO.Put_Line ("building non relocatable DLL...");
--- 341,351 ----
        -- Ada_Build_Non_Reloc_DLL --
        -----------------------------
  
!       --  Build a non relocatable DLL with Ada code
  
        procedure Ada_Build_Non_Reloc_DLL is
           Success : Boolean;
+ 
        begin
           if not Quiet then
              Text_IO.Put_Line ("building non relocatable DLL...");
*************** package body MDLL is
*** 342,348 ****
              end if;
           end if;
  
!          --  Build exp table and the lib .a file.
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Exp_Table    => Exp_File,
--- 359,365 ----
              end if;
           end if;
  
!          --  Build exp table and the lib .a file
  
           Utl.Dlltool (Def_File, Dll_File, Lib_File,
                        Exp_Table    => Exp_File,
*************** package body MDLL is
*** 378,386 ****
        end Ada_Build_Non_Reloc_DLL;
  
     begin
!       --  On Windows the binder file must not be in the first position
!       --  in the list. This is due to the way DLL's are built on Windows.
!       --  We swap the first ali with the last one if it is the case.
  
        if L_Afiles'Length > 1 then
           declare
--- 395,403 ----
        end Ada_Build_Non_Reloc_DLL;
  
     begin
!       --  On Windows the binder file must not be in the first position in the
!       --  list. This is due to the way DLL's are built on Windows. We swap the
!       --  first ali with the last one if it is the case.
  
        if L_Afiles'Length > 1 then
           declare
*************** package body MDLL is
*** 422,464 ****
        Def_Filename : String)
     is
  
!       procedure Build_Import_Library (Def_Base_Filename : String);
!       --  Build an import library.
!       --  this is to build only a .a library to link against a DLL.
! 
!       Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
  
        --------------------------
        -- Build_Import_Library --
        --------------------------
  
!       procedure Build_Import_Library (Def_Base_Filename : String) is
!          Def_File : String renames Def_Filename;
!          Dll_File : constant String := Def_Base_Filename & ".dll";
!          Lib_File : constant String := "lib" & Base_Filename & ".a";
  
        begin
           if not Quiet then
              Text_IO.Put_Line ("Building import library...");
!             Text_IO.Put_Line ("make " & Lib_File &
!                               " to use dynamic library " & Dll_File);
           end if;
  
!          Utl.Dlltool (Def_File, Dll_File, Lib_File,
!                       Build_Import => True);
        end Build_Import_Library;
  
     begin
!       --  If the library has the form lib<name>.a then the def file should
!       --  be <name>.def and the DLL to link against <name>.dll
!       --  this is a Windows convention and we try as much as possible to
!       --  follow the platform convention.
  
        if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
!          Build_Import_Library (Base_Filename (4 .. Base_Filename'Last));
        else
!          Build_Import_Library (Base_Filename);
        end if;
     end Build_Import_Library;
  
  end MDLL;
--- 439,495 ----
        Def_Filename : String)
     is
  
!       procedure Build_Import_Library (Lib_Filename : String);
!       --  Build an import library. This is to build only a .a library to link
!       --  against a DLL.
  
        --------------------------
        -- Build_Import_Library --
        --------------------------
  
!       procedure Build_Import_Library (Lib_Filename : String) is
!          Def_File      : String renames Def_Filename;
!          Dll_File      : constant String := Get_Dll_Name (Lib_Filename);
!          Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
!          Lib_File      : constant String := "lib" & Base_Filename & ".a";
  
        begin
           if not Quiet then
              Text_IO.Put_Line ("Building import library...");
!             Text_IO.Put_Line
!               ("make " & Lib_File & " to use dynamic library " & Dll_File);
           end if;
  
!          Utl.Dlltool
!            (Def_File, Dll_File, Lib_File, Build_Import => True);
        end Build_Import_Library;
  
+    --  Start of processing for Build_Import_Library
+ 
     begin
!       --  If the library has the form lib<name>.a then the def file should be
!       --  <name>.def and the DLL to link against <name>.dll. This is a Windows
!       --  convention and we try as much as possible to follow the platform
!       --  convention.
  
        if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
!          Build_Import_Library (Lib_Filename (4 .. Lib_Filename'Last));
        else
!          Build_Import_Library (Lib_Filename);
        end if;
     end Build_Import_Library;
  
+    ------------------
+    -- Get_Dll_Name --
+    ------------------
+ 
+    function Get_Dll_Name (Lib_Filename : in String) return String is
+    begin
+       if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
+          return Lib_Filename & ".dll";
+       else
+          return Lib_Filename;
+       end if;
+    end Get_Dll_Name;
+ 
  end MDLL;
diff -Nrcpad gcc-4.0.2/gcc/ada/mdll.ads gcc-4.1.0/gcc/ada/mdll.ads
*** gcc-4.0.2/gcc/ada/mdll.ads	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/mdll.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/memroot.adb gcc-4.1.0/gcc/ada/memroot.adb
*** gcc-4.0.2/gcc/ada/memroot.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/memroot.adb	Tue Nov 15 13:52:43 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1997-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,33 ****
  with GNAT.Table;
  with GNAT.HTable; use GNAT.HTable;
  with Ada.Text_IO; use Ada.Text_IO;
- with System.Storage_Elements; use System.Storage_Elements;
  
  package body Memroot is
  
--- 27,32 ----
*************** package body Memroot is
*** 425,430 ****
--- 424,430 ----
        pragma Warnings (Off, Line);
  
        procedure Find_File;
+       pragma Inline (Find_File);
        --  Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains
        --  the file name. The file name may not be on the current line since
        --  a frame may be printed on more than one line when there is a lot
*************** package body Memroot is
*** 432,452 ****
        --  lines of input.
  
        procedure Find_Line;
        --  Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains
        --  the line number.
  
        procedure Find_Name;
        --  Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains
        --  the subprogram name.
  
        function Skip_To_Space (Pos : Integer) return Integer;
        --  Scans Line starting with position Pos, returning the position
        --  immediately before the first space, or the value of Last if no
        --  spaces were found
  
- 
-       pragma Inline (Find_File, Find_Line, Find_Name, Skip_To_Space);
- 
        ---------------
        -- Find_File --
        ---------------
--- 432,452 ----
        --  lines of input.
  
        procedure Find_Line;
+       pragma Inline (Find_Line);
        --  Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains
        --  the line number.
  
        procedure Find_Name;
+       pragma Inline (Find_Name);
        --  Position Curs1 and Curs2 so that Line (Curs1 .. Curs2) contains
        --  the subprogram name.
  
        function Skip_To_Space (Pos : Integer) return Integer;
+       pragma Inline (Skip_To_Space);
        --  Scans Line starting with position Pos, returning the position
        --  immediately before the first space, or the value of Last if no
        --  spaces were found
  
        ---------------
        -- Find_File --
        ---------------
diff -Nrcpad gcc-4.0.2/gcc/ada/memroot.ads gcc-4.1.0/gcc/ada/memroot.ads
*** gcc-4.0.2/gcc/ada/memroot.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/memroot.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1997-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1997-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with System.Storage_Elements; use System
*** 39,45 ****
  
  package Memroot is
  
!    --  Simple abstract type for names. A name is a sequence of letters.
  
     type Name_Id is new Natural;
     No_Name_Id : constant Name_Id := 0;
--- 39,45 ----
  
  package Memroot is
  
!    --  Simple abstract type for names. A name is a sequence of letters
  
     type Name_Id is new Natural;
     No_Name_Id : constant Name_Id := 0;
diff -Nrcpad gcc-4.0.2/gcc/ada/memtrack.adb gcc-4.1.0/gcc/ada/memtrack.adb
*** gcc-4.0.2/gcc/ada/memtrack.adb	Mon Mar 29 12:03:10 2004
--- gcc-4.1.0/gcc/ada/memtrack.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 53,59 ****
  
  --    gnatmem -i gmem.out program
  
! --  See gnatmem section in the GNAT User's Guide for more details.
  
  --  NOTE: This capability is currently supported on the following targets:
  
--- 53,59 ----
  
  --    gnatmem -i gmem.out program
  
! --  See gnatmem section in the GNAT User's Guide for more details
  
  --  NOTE: This capability is currently supported on the following targets:
  
*************** package body System.Memory is
*** 120,132 ****
     pragma Import (C, fclose);
  
     procedure Finalize;
-    --  Replace the default __gnat_finalize to properly close the log file.
     pragma Export (C, Finalize, "__gnat_finalize");
  
!    Address_Size    : constant := System.Address'Max_Size_In_Storage_Elements;
     --  Size in bytes of a pointer
  
!    Max_Call_Stack  : constant := 200;
     --  Maximum number of frames supported
  
     Tracebk   : aliased array (0 .. Max_Call_Stack) of Traceback_Entry;
--- 120,132 ----
     pragma Import (C, fclose);
  
     procedure Finalize;
     pragma Export (C, Finalize, "__gnat_finalize");
+    --  Replace the default __gnat_finalize to properly close the log file
  
!    Address_Size : constant := System.Address'Max_Size_In_Storage_Elements;
     --  Size in bytes of a pointer
  
!    Max_Call_Stack : constant := 200;
     --  Maximum number of frames supported
  
     Tracebk   : aliased array (0 .. Max_Call_Stack) of Traceback_Entry;
*************** package body System.Memory is
*** 137,143 ****
     --  ??? What about Ada.Command_Line.Command_Name & ".out" instead of static
     --  gmem.out
  
!    Gmemfile  : File_Ptr;
     --  Global C file pointer to the allocation log
  
     procedure Gmem_Initialize;
--- 137,143 ----
     --  ??? What about Ada.Command_Line.Command_Name & ".out" instead of static
     --  gmem.out
  
!    Gmemfile : File_Ptr;
     --  Global C file pointer to the allocation log
  
     procedure Gmem_Initialize;
diff -Nrcpad gcc-4.0.2/gcc/ada/mingw32.h gcc-4.1.0/gcc/ada/mingw32.h
*** gcc-4.0.2/gcc/ada/mingw32.h	Thu Nov 25 16:14:01 2004
--- gcc-4.1.0/gcc/ada/mingw32.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/misc.c gcc-4.1.0/gcc/ada/misc.c
*** gcc-4.0.2/gcc/ada/misc.c	Thu Apr  7 06:51:30 2005
--- gcc-4.1.0/gcc/ada/misc.c	Thu Dec 15 13:29:14 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 41,47 ****
  #include "tree.h"
  #include "real.h"
  #include "rtl.h"
- #include "errors.h"
  #include "diagnostic.h"
  #include "expr.h"
  #include "libfuncs.h"
--- 41,46 ----
*************** static tree gnat_type_max_size		(tree);
*** 137,144 ****
  #define LANG_HOOKS_EXPAND_EXPR		gnat_expand_expr
  #undef  LANG_HOOKS_MARK_ADDRESSABLE
  #define LANG_HOOKS_MARK_ADDRESSABLE	gnat_mark_addressable
- #undef  LANG_HOOKS_TRUTHVALUE_CONVERSION
- #define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion
  #undef  LANG_HOOKS_PRINT_DECL
  #define LANG_HOOKS_PRINT_DECL		gnat_print_decl
  #undef  LANG_HOOKS_PRINT_TYPE
--- 136,141 ----
*************** extern char **gnat_argv;
*** 217,234 ****
  
  
  /* Declare functions we use as part of startup.  */
! extern void __gnat_initialize	(void *);
! extern void adainit		(void);
! extern void _ada_gnat1drv	(void);
  
  /* The parser for the language.  For us, we process the GNAT tree.  */
  
  static void
  gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
  {
    /* call the target specific initializations */
    __gnat_initialize (NULL);
  
    /* Call the front-end elaboration procedures */
    adainit ();
  
--- 214,240 ----
  
  
  /* Declare functions we use as part of startup.  */
! extern void __gnat_initialize           (void *);
! extern void __gnat_install_SEH_handler  (void *);
! extern void adainit		        (void);
! extern void _ada_gnat1drv	        (void);
  
  /* The parser for the language.  For us, we process the GNAT tree.  */
  
  static void
  gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
  {
+   int seh[2];
+ 
    /* call the target specific initializations */
    __gnat_initialize (NULL);
  
+   /* ??? call the SEH initialization routine, this is to workaround a
+   bootstrap path problem. The call below should be removed at some point and
+   the seh pointer passed to __gnat_initialize() above.  */
+ 
+   __gnat_install_SEH_handler((void *)seh);
+ 
    /* Call the front-end elaboration procedures */
    adainit ();
  
*************** gnat_handle_option (size_t scode, const 
*** 250,256 ****
    const struct cl_option *option = &cl_options[scode];
    enum opt_code code = (enum opt_code) scode;
    char *q;
-   unsigned int i;
  
    if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
      {
--- 256,261 ----
*************** gnat_handle_option (size_t scode, const 
*** 295,301 ****
        break;
  
      case OPT_gant:
!       warning ("%<-gnat%> misspelled as %<-gant%>");
  
        /* ... fall through ... */
  
--- 300,306 ----
        break;
  
      case OPT_gant:
!       warning (0, "%<-gnat%> misspelled as %<-gant%>");
  
        /* ... fall through ... */
  
*************** gnat_handle_option (size_t scode, const 
*** 305,321 ****
        gnat_argv[gnat_argc][0] = '-';
        strcpy (gnat_argv[gnat_argc] + 1, arg);
        gnat_argc++;
  
!       if (arg[0] == 'O')
! 	for (i = 1; i < save_argc - 1; i++)
! 	  if (!strncmp (save_argv[i], "-gnatO", 6))
! 	    if (save_argv[++i][0] != '-')
! 	      {
! 		/* Preserve output filename as GCC doesn't save it for GNAT. */
! 		gnat_argv[gnat_argc] = xstrdup (save_argv[i]);
! 		gnat_argc++;
! 		break;
! 	      }
        break;
      }
  
--- 310,322 ----
        gnat_argv[gnat_argc][0] = '-';
        strcpy (gnat_argv[gnat_argc] + 1, arg);
        gnat_argc++;
+       break;
  
!     case OPT_gnatO:
!       gnat_argv[gnat_argc] = xstrdup ("-O");
!       gnat_argc++;
!       gnat_argv[gnat_argc] = xstrdup (arg);
!       gnat_argc++;
        break;
      }
  
*************** gnat_post_options (const char **pfilenam
*** 367,372 ****
--- 368,375 ----
    if (flag_inline_functions)
      flag_inline_trees = 2;
  
+   flag_tree_salias = 0;
+ 
    /* Do not enable Tree-SRA unless specifically requested as it
       is known to badly interact with some Ada constructs.  */
    if (!tree_sra_requested)
*************** gnat_post_options (const char **pfilenam
*** 380,391 ****
  static void
  internal_error_function (const char *msgid, va_list *ap)
  {
!   char buffer[1000];		/* Assume this is big enough.  */
    char *p;
    String_Template temp;
    Fat_Pointer fp;
  
!   vsprintf (buffer, msgid, *ap);
  
    /* Go up to the first newline.  */
    for (p = buffer; *p; p++)
--- 383,405 ----
  static void
  internal_error_function (const char *msgid, va_list *ap)
  {
!   text_info tinfo;
!   char *buffer;
    char *p;
    String_Template temp;
    Fat_Pointer fp;
  
!   /* Reset the pretty-printer.  */
!   pp_clear_output_area (global_dc->printer);
! 
!   /* Format the message into the pretty-printer.  */
!   tinfo.format_spec = msgid;
!   tinfo.args_ptr = ap;
!   tinfo.err_no = errno;
!   pp_format_verbatim (global_dc->printer, &tinfo);
! 
!   /* Extract a (writable) pointer to the formatted text.  */
!   buffer = (char*) pp_formatted_text (global_dc->printer);
  
    /* Go up to the first newline.  */
    for (p = buffer; *p; p++)
*************** internal_error_function (const char *msg
*** 395,402 ****
  	break;
        }
  
!   temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
!   fp.Array = buffer, fp.Bounds = &temp;
  
    Current_Error_Node = error_gnat_node;
    Compiler_Abort (fp, -1);
--- 409,418 ----
  	break;
        }
  
!   temp.Low_Bound = 1;
!   temp.High_Bound = p - buffer;
!   fp.Bounds = &temp;
!   fp.Array = buffer;
  
    Current_Error_Node = error_gnat_node;
    Compiler_Abort (fp, -1);
*************** gnat_init_gcc_eh (void)
*** 480,485 ****
--- 496,502 ----
    eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
    lang_eh_type_covers = gnat_eh_type_covers;
    lang_eh_runtime_type = gnat_eh_runtime_type;
+   default_init_unwind_resume_libfunc ();
  
    /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
       the generation of the necessary exception runtime tables. The second one
*************** gnat_print_decl (FILE *file, tree node, 
*** 514,520 ****
        break;
  
      case FIELD_DECL:
!       print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
  		  indent + 4);
        break;
  
--- 531,542 ----
        break;
  
      case FIELD_DECL:
!       print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
! 		  indent + 4);
!       break;
! 
!     case VAR_DECL:
!       print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
  		  indent + 4);
        break;
  
*************** gnat_expand_body (tree gnu_decl)
*** 644,649 ****
--- 666,679 ----
      return;
  
    tree_rest_of_compilation (gnu_decl);
+ 
+   if (DECL_STATIC_CONSTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+     targetm.asm_out.constructor (XEXP (DECL_RTL (gnu_decl), 0),
+                                  DEFAULT_INIT_PRIORITY);
+ 
+   if (DECL_STATIC_DESTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
+     targetm.asm_out.destructor (XEXP (DECL_RTL (gnu_decl), 0),
+                                 DEFAULT_INIT_PRIORITY);
  }
  
  /* Adjusts the RLI used to layout a record after all the fields have been
diff -Nrcpad gcc-4.0.2/gcc/ada/mkdir.c gcc-4.1.0/gcc/ada/mkdir.c
*** gcc-4.0.2/gcc/ada/mkdir.c	Fri Oct 31 01:08:43 2003
--- gcc-4.1.0/gcc/ada/mkdir.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-fil.adb gcc-4.1.0/gcc/ada/mlib-fil.adb
*** gcc-4.0.2/gcc/ada/mlib-fil.adb	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mlib-fil.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-fil.ads gcc-4.1.0/gcc/ada/mlib-fil.ads
*** gcc-4.0.2/gcc/ada/mlib-fil.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mlib-fil.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package MLib.Fil is
*** 32,41 ****
       (Filename : String;
        New_Ext  : String := "")
        return     String;
!    --  Return Filename with the extension change to New_Ext.
  
     function Get_Ext (Filename : String) return String;
!    --  Return extension of filename.
  
     function Is_Archive (Filename : String) return Boolean;
     --  Test if filename is an archive
--- 32,41 ----
       (Filename : String;
        New_Ext  : String := "")
        return     String;
!    --  Return Filename with the extension change to New_Ext
  
     function Get_Ext (Filename : String) return String;
!    --  Return extension of filename
  
     function Is_Archive (Filename : String) return Boolean;
     --  Test if filename is an archive
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-prj.adb gcc-4.1.0/gcc/ada/mlib-prj.adb
*** gcc-4.0.2/gcc/ada/mlib-prj.adb	Thu Feb 10 13:50:33 2005
--- gcc-4.1.0/gcc/ada/mlib-prj.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2005, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with MLib.Tgt; use MLib.Tgt;
*** 32,38 ****
  with MLib.Utl; use MLib.Utl;
  with Namet;    use Namet;
  with Opt;
- with Osint;    use Osint;
  with Output;   use Output;
  with Prj.Com;  use Prj.Com;
  with Prj.Env;  use Prj.Env;
--- 32,37 ----
*************** with Sinput.P;
*** 41,53 ****
  with Snames;   use Snames;
  with Switch;   use Switch;
  with Table;
- with Types;    use Types;
  
  with Ada.Characters.Handling;
  
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  with GNAT.HTable;
- with GNAT.OS_Lib;               use GNAT.OS_Lib;
  with Interfaces.C_Streams;      use Interfaces.C_Streams;
  with System;                    use System;
  with System.Case_Util;          use System.Case_Util;
--- 40,50 ----
*************** package body MLib.Prj is
*** 96,101 ****
--- 93,100 ----
     Compile_Switch_String : aliased String := "-c";
     Compile_Switch : constant String_Access := Compile_Switch_String'Access;
  
+    Auto_Initialize : constant String := "-a";
+ 
     --  List of objects to put inside the library
  
     Object_Files : Argument_List_Access;
*************** package body MLib.Prj is
*** 140,146 ****
        Table_Initial        => 50,
        Table_Increment      => 100);
  
!    --  List of options set in the command line.
  
     Options : Argument_List_Access;
  
--- 139,145 ----
        Table_Initial        => 50,
        Table_Increment      => 100);
  
!    --  List of options set in the command line
  
     Options : Argument_List_Access;
  
*************** package body MLib.Prj is
*** 183,189 ****
        Hash       => Hash,
        Equal      => "=");
  
!    --  The projects imported directly or indirectly.
  
     package Processed_Projects is new GNAT.HTable.Simple_HTable
       (Header_Num => Header_Num,
--- 182,188 ----
        Hash       => Hash,
        Equal      => "=");
  
!    --  The projects imported directly or indirectly
  
     package Processed_Projects is new GNAT.HTable.Simple_HTable
       (Header_Num => Header_Num,
*************** package body MLib.Prj is
*** 193,199 ****
        Hash       => Hash,
        Equal      => "=");
  
!    --  The library projects imported directly or indirectly.
  
     package Library_Projs is new Table.Table (
       Table_Component_Type => Project_Id,
--- 192,198 ----
        Hash       => Hash,
        Equal      => "=");
  
!    --  The library projects imported directly or indirectly
  
     package Library_Projs is new Table.Table (
       Table_Component_Type => Project_Id,
*************** package body MLib.Prj is
*** 206,229 ****
     type Build_Mode_State is (None, Static, Dynamic, Relocatable);
  
     procedure Add_Argument (S : String);
!    --  Add one argument to the array Arguments.
!    --  If Arguments is full, double its size.
  
     function ALI_File_Name (Source : String) return String;
!    --  Return the ALI file name corresponding to a source.
  
     procedure Check (Filename : String);
!    --  Check if filename is a regular file. Fail if it is not.
  
     procedure Check_Context;
     --  Check each object files in table Object_Files
     --  Fail if any of them is not a regular file
  
-    procedure Clean (Directory : Name_Id);
-    --  Attempt to delete all files in Directory, but not subdirectories
- 
     procedure Copy_Interface_Sources
       (For_Project : Project_Id;
        Interfaces  : Argument_List;
        To_Dir      : Name_Id);
     --  Copy the interface sources of a SAL to directory To_Dir
--- 205,225 ----
     type Build_Mode_State is (None, Static, Dynamic, Relocatable);
  
     procedure Add_Argument (S : String);
!    --  Add one argument to Arguments array, if array is full, double its size
  
     function ALI_File_Name (Source : String) return String;
!    --  Return the ALI file name corresponding to a source
  
     procedure Check (Filename : String);
!    --  Check if filename is a regular file. Fail if it is not
  
     procedure Check_Context;
     --  Check each object files in table Object_Files
     --  Fail if any of them is not a regular file
  
     procedure Copy_Interface_Sources
       (For_Project : Project_Id;
+       In_Tree     : Project_Tree_Ref;
        Interfaces  : Argument_List;
        To_Dir      : Name_Id);
     --  Copy the interface sources of a SAL to directory To_Dir
*************** package body MLib.Prj is
*** 240,245 ****
--- 236,251 ----
     --  Make sure that all the above tables are empty
     --  (Objects, Foreign_Objects, Ali_Files, Options).
  
+    function SALs_Use_Constructors return Boolean;
+    --  Indicate if Stand-Alone Libraries are automatically initialized using
+    --  the constructor mechanism.
+ 
+    function Ultimate_Extension_Of
+      (Project : Project_Id;
+       In_Tree : Project_Tree_Ref) return Project_Id;
+    --  Returns the Project_Id of project Project. Returns No_Project
+    --  if Project is No_Project.
+ 
     ------------------
     -- Add_Argument --
     ------------------
*************** package body MLib.Prj is
*** 294,299 ****
--- 300,306 ----
  
     procedure Build_Library
       (For_Project   : Project_Id;
+       In_Tree       : Project_Tree_Ref;
        Gnatbind      : String;
        Gnatbind_Path : String_Access;
        Gcc           : String;
*************** package body MLib.Prj is
*** 315,321 ****
        --  On OpenVMS, set to True if library needs to be linked with
        --  g-trasym.obj.
  
!       Data : Project_Data := Projects.Table (For_Project);
  
        Object_Directory_Path : constant String :=
                            Get_Name_String (Data.Object_Directory);
--- 322,328 ----
        --  On OpenVMS, set to True if library needs to be linked with
        --  g-trasym.obj.
  
!       Data : Project_Data := In_Tree.Projects.Table (For_Project);
  
        Object_Directory_Path : constant String :=
                            Get_Name_String (Data.Object_Directory);
*************** package body MLib.Prj is
*** 355,363 ****
        --  If null, Path Option is not supported.
        --  Not a constant so that it can be deallocated.
  
-       Copy_Dir : Name_Id;
-       --  Directory where to copy ALI files and possibly interface sources
- 
        First_ALI : Name_Id := No_Name;
        --  Store the ALI file name of a source of the library (the first found)
  
--- 362,367 ----
*************** package body MLib.Prj is
*** 484,498 ****
  
           elsif P /= No_Project then
              declare
!                Data : Project_Data := Projects.Table (For_Project);
! 
              begin
                 while Data.Extends /= No_Project loop
                    if P = Data.Extends then
                       return True;
                    end if;
  
!                   Data := Projects.Table (Data.Extends);
                 end loop;
              end;
           end if;
--- 488,502 ----
  
           elsif P /= No_Project then
              declare
!                Data : Project_Data :=
!                         In_Tree.Projects.Table (For_Project);
              begin
                 while Data.Extends /= No_Project loop
                    if P = Data.Extends then
                       return True;
                    end if;
  
!                   Data := In_Tree.Projects.Table (Data.Extends);
                 end loop;
              end;
           end if;
*************** package body MLib.Prj is
*** 668,674 ****
           ---------------------
  
           procedure Process_Project (Project : Project_Id) is
!             Data     : constant Project_Data := Projects.Table (Project);
              Imported : Project_List := Data.Imported_Projects;
              Element  : Project_Element;
  
--- 672,679 ----
           ---------------------
  
           procedure Process_Project (Project : Project_Id) is
!             Data     : constant Project_Data :=
!                          In_Tree.Projects.Table (Project);
              Imported : Project_List := Data.Imported_Projects;
              Element  : Project_Element;
  
*************** package body MLib.Prj is
*** 683,689 ****
                 --  we have a proper reverse order for the libraries.
  
                 while Imported /= Empty_Project_List loop
!                   Element := Project_Lists.Table (Imported);
  
                    if Element.Project /= No_Project then
                       Process_Project (Element.Project);
--- 688,695 ----
                 --  we have a proper reverse order for the libraries.
  
                 while Imported /= Empty_Project_List loop
!                   Element :=
!                     In_Tree.Project_Lists.Table (Imported);
  
                    if Element.Project /= No_Project then
                       Process_Project (Element.Project);
*************** package body MLib.Prj is
*** 718,724 ****
           for Index in reverse 1 .. Library_Projs.Last loop
              Current := Library_Projs.Table (Index);
  
!             Get_Name_String (Projects.Table (Current).Library_Dir);
              Opts.Increment_Last;
              Opts.Table (Opts.Last) :=
                new String'("-L" & Name_Buffer (1 .. Name_Len));
--- 724,731 ----
           for Index in reverse 1 .. Library_Projs.Last loop
              Current := Library_Projs.Table (Index);
  
!             Get_Name_String
!               (In_Tree.Projects.Table (Current).Library_Dir);
              Opts.Increment_Last;
              Opts.Table (Opts.Last) :=
                new String'("-L" & Name_Buffer (1 .. Name_Len));
*************** package body MLib.Prj is
*** 732,738 ****
                new String'
                  ("-l" &
                   Get_Name_String
!                    (Projects.Table (Current).Library_Name));
           end loop;
        end Process_Imported_Libraries;
  
--- 739,746 ----
                new String'
                  ("-l" &
                   Get_Name_String
!                    (In_Tree.Projects.Table
!                       (Current).Library_Name));
           end loop;
        end Process_Imported_Libraries;
  
*************** package body MLib.Prj is
*** 805,818 ****
                (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
              Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
  
!             --  Check if Binder'Default_Switches ("Ada) is defined. If it is,
              --  add these switches to call gnatbind.
  
              declare
                 Binder_Package : constant Package_Id :=
                                    Value_Of
                                      (Name        => Name_Binder,
!                                      In_Packages => Data.Decl.Packages);
  
              begin
                 if Binder_Package /= No_Package then
--- 813,831 ----
                (B_Start & Get_Name_String (Data.Library_Name) & ".adb");
              Add_Argument ("-L" & Get_Name_String (Data.Library_Name));
  
!             if Data.Lib_Auto_Init and then SALs_Use_Constructors then
!                Add_Argument (Auto_Initialize);
!             end if;
! 
!             --  Check if Binder'Default_Switches ("Ada") is defined. If it is,
              --  add these switches to call gnatbind.
  
              declare
                 Binder_Package : constant Package_Id :=
                                    Value_Of
                                      (Name        => Name_Binder,
!                                      In_Packages => Data.Decl.Packages,
!                                      In_Tree     => In_Tree);
  
              begin
                 if Binder_Package /= No_Package then
*************** package body MLib.Prj is
*** 821,828 ****
                                    Value_Of
                                      (Name      => Name_Default_Switches,
                                       In_Arrays =>
!                                        Packages.Table
!                                          (Binder_Package).Decl.Arrays);
                       Switches : Variable_Value := Nil_Variable_Value;
  
                       Switch : String_List_Id := Nil_String;
--- 834,842 ----
                                    Value_Of
                                      (Name      => Name_Default_Switches,
                                       In_Arrays =>
!                                        In_Tree.Packages.Table
!                                          (Binder_Package).Decl.Arrays,
!                                      In_Tree   => In_Tree);
                       Switches : Variable_Value := Nil_Variable_Value;
  
                       Switch : String_List_Id := Nil_String;
*************** package body MLib.Prj is
*** 833,839 ****
                            Value_Of
                              (Index     => Name_Ada,
                               Src_Index => 0,
!                              In_Array  => Defaults);
  
                          if not Switches.Default then
                             Switch := Switches.Values;
--- 847,854 ----
                            Value_Of
                              (Index     => Name_Ada,
                               Src_Index => 0,
!                              In_Array  => Defaults,
!                              In_Tree   => In_Tree);
  
                          if not Switches.Default then
                             Switch := Switches.Values;
*************** package body MLib.Prj is
*** 841,848 ****
                             while Switch /= Nil_String loop
                                Add_Argument
                                  (Get_Name_String
!                                    (String_Elements.Table (Switch).Value));
!                               Switch := String_Elements.Table (Switch).Next;
                             end loop;
                          end if;
                       end if;
--- 856,865 ----
                             while Switch /= Nil_String loop
                                Add_Argument
                                  (Get_Name_String
!                                    (In_Tree.String_Elements.Table
!                                       (Switch).Value));
!                               Switch := In_Tree.String_Elements.
!                                           Table (Switch).Next;
                             end loop;
                          end if;
                       end if;
*************** package body MLib.Prj is
*** 862,869 ****
              Interface_ALIs.Reset;
              Processed_ALIs.Reset;
  
!             for Source in 1 .. Com.Units.Last loop
!                Unit := Com.Units.Table (Source);
  
                 if Unit.File_Names (Body_Part).Name /= No_Name
                   and then Unit.File_Names (Body_Part).Path /= Slash
--- 879,888 ----
              Interface_ALIs.Reset;
              Processed_ALIs.Reset;
  
!             for Source in Unit_Table.First ..
!                           Unit_Table.Last (In_Tree.Units)
!             loop
!                Unit := In_Tree.Units.Table (Source);
  
                 if Unit.File_Names (Body_Part).Name /= No_Name
                   and then Unit.File_Names (Body_Part).Path /= Slash
*************** package body MLib.Prj is
*** 917,923 ****
  
              if First_ALI /= No_Name then
                 declare
-                   use Types;
                    T : Text_Buffer_Ptr;
                    A : ALI_Id;
  
--- 936,941 ----
*************** package body MLib.Prj is
*** 944,951 ****
                          declare
                             Arg : String_Ptr renames Args.Table (Index);
                          begin
!                            if
!                              Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
                             then
                                Add_Argument (Arg.all);
                                exit;
--- 962,969 ----
                          declare
                             Arg : String_Ptr renames Args.Table (Index);
                          begin
!                            if Arg'Length >= 6 and then
!                               Arg (Arg'First + 2 .. Arg'First + 5) = "RTS="
                             then
                                Add_Argument (Arg.all);
                                exit;
*************** package body MLib.Prj is
*** 959,965 ****
              --  Set the paths
  
              Set_Ada_Paths
!               (Project => For_Project, Including_Libraries => True);
  
              --  Display the gnatbind command, if not in quiet output
  
--- 977,985 ----
              --  Set the paths
  
              Set_Ada_Paths
!               (Project             => For_Project,
!                In_Tree             => In_Tree,
!                Including_Libraries => True);
  
              --  Display the gnatbind command, if not in quiet output
  
*************** package body MLib.Prj is
*** 982,988 ****
              --  Set the paths
  
              Set_Ada_Paths
!               (Project => For_Project, Including_Libraries => True);
  
              --  Invoke <gcc> -c b$$<lib>.adb
  
--- 1002,1010 ----
              --  Set the paths
  
              Set_Ada_Paths
!               (Project             => For_Project,
!                In_Tree             => In_Tree,
!                Including_Libraries => True);
  
              --  Invoke <gcc> -c b$$<lib>.adb
  
*************** package body MLib.Prj is
*** 1013,1019 ****
  
              if First_ALI /= No_Name then
                 declare
-                   use Types;
                    T : Text_Buffer_Ptr;
                    A : ALI_Id;
  
--- 1035,1040 ----
*************** package body MLib.Prj is
*** 1076,1082 ****
        if Link then
           --  If attribute Library_GCC was specified, get the driver name
  
!          Library_GCC := Value_Of (Name_Library_GCC, Data.Decl.Attributes);
  
           if not Library_GCC.Default then
              Driver_Name := Library_GCC.Value;
--- 1097,1104 ----
        if Link then
           --  If attribute Library_GCC was specified, get the driver name
  
!          Library_GCC :=
!            Value_Of (Name_Library_GCC, Data.Decl.Attributes, In_Tree);
  
           if not Library_GCC.Default then
              Driver_Name := Library_GCC.Value;
*************** package body MLib.Prj is
*** 1086,1092 ****
           --  options.
  
           Library_Options :=
!            Value_Of (Name_Library_Options, Data.Decl.Attributes);
  
           if not Library_Options.Default then
              declare
--- 1108,1114 ----
           --  options.
  
           Library_Options :=
!            Value_Of (Name_Library_Options, Data.Decl.Attributes, In_Tree);
  
           if not Library_Options.Default then
              declare
*************** package body MLib.Prj is
*** 1095,1101 ****
  
              begin
                 while Current /= Nil_String loop
!                   Element := String_Elements.Table (Current);
                    Get_Name_String (Element.Value);
  
                    if Name_Len /= 0 then
--- 1117,1124 ----
  
              begin
                 while Current /= Nil_String loop
!                   Element :=
!                     In_Tree.String_Elements.Table (Current);
                    Get_Name_String (Element.Value);
  
                    if Name_Len /= 0 then
*************** package body MLib.Prj is
*** 1240,1246 ****
              exit when Data.Extends = No_Project;
  
              In_Main_Object_Directory  := False;
!             Data := Projects.Table (Data.Extends);
           end loop;
  
           --  Add the -L and -l switches for the imported Library Project Files,
--- 1263,1269 ----
              exit when Data.Extends = No_Project;
  
              In_Main_Object_Directory  := False;
!             Data := In_Tree.Projects.Table (Data.Extends);
           end loop;
  
           --  Add the -L and -l switches for the imported Library Project Files,
*************** package body MLib.Prj is
*** 1371,1377 ****
  
           declare
              DLL_Name : aliased String :=
!                          Lib_Dirpath.all & "/lib" &
                             Lib_Filename.all & "." & DLL_Ext;
  
              Archive_Name : aliased String :=
--- 1394,1400 ----
  
           declare
              DLL_Name : aliased String :=
!                          Lib_Dirpath.all & '/' & DLL_Prefix &
                             Lib_Filename.all & "." & DLL_Ext;
  
              Archive_Name : aliased String :=
*************** package body MLib.Prj is
*** 1416,1422 ****
           --  the library directory (by Copy_ALI_Files, below).
  
           if Standalone then
!             Data := Projects.Table (For_Project);
  
              declare
                 Iface : String_List_Id := Data.Lib_Interface_ALIs;
--- 1439,1445 ----
           --  the library directory (by Copy_ALI_Files, below).
  
           if Standalone then
!             Data := In_Tree.Projects.Table (For_Project);
  
              declare
                 Iface : String_List_Id := Data.Lib_Interface_ALIs;
*************** package body MLib.Prj is
*** 1424,1434 ****
  
              begin
                 while Iface /= Nil_String loop
!                   ALI := String_Elements.Table (Iface).Value;
                    Interface_ALIs.Set (ALI, True);
!                   Get_Name_String (String_Elements.Table (Iface).Value);
                    Add_Argument (Name_Buffer (1 .. Name_Len));
!                   Iface := String_Elements.Table (Iface).Next;
                 end loop;
  
                 Iface := Data.Lib_Interface_ALIs;
--- 1447,1460 ----
  
              begin
                 while Iface /= Nil_String loop
!                   ALI :=
!                     In_Tree.String_Elements.Table (Iface).Value;
                    Interface_ALIs.Set (ALI, True);
!                   Get_Name_String
!                     (In_Tree.String_Elements.Table (Iface).Value);
                    Add_Argument (Name_Buffer (1 .. Name_Len));
!                   Iface :=
!                     In_Tree.String_Elements.Table (Iface).Next;
                 end loop;
  
                 Iface := Data.Lib_Interface_ALIs;
*************** package body MLib.Prj is
*** 1440,1460 ****
                    --  interface. If it is not the case, output a warning.
  
                    while Iface /= Nil_String loop
!                      ALI := String_Elements.Table (Iface).Value;
                       Process (ALI);
!                      Iface := String_Elements.Table (Iface).Next;
                    end loop;
                 end if;
              end;
           end if;
  
!          --  Clean the library directory, if it is also the directory where
!          --  the ALI files are copied, either because there is no interface
!          --  copy directory or because the interface copy directory is the
!          --  same as the library directory.
  
!          Copy_Dir := Projects.Table (For_Project).Library_Dir;
!          Clean (Copy_Dir);
  
           --  Call procedure to build the library, depending on the build mode
  
--- 1466,1595 ----
                    --  interface. If it is not the case, output a warning.
  
                    while Iface /= Nil_String loop
!                      ALI := In_Tree.String_Elements.Table
!                               (Iface).Value;
                       Process (ALI);
!                      Iface :=
!                        In_Tree.String_Elements.Table (Iface).Next;
                    end loop;
                 end if;
              end;
           end if;
  
!          declare
!             Current_Dir  : constant String := Get_Current_Dir;
!             Dir          : Dir_Type;
  
!             Name : String (1 .. 200);
!             Last : Natural;
! 
!             Disregard : Boolean;
! 
!             DLL_Name : aliased constant String :=
!                          Lib_Filename.all & "." & DLL_Ext;
! 
!             Archive_Name : aliased constant String :=
!                              Lib_Filename.all & "." & Archive_Ext;
! 
!             Delete : Boolean := False;
! 
!          begin
!             --  Clean the library directory: remove any file with the name of
!             --  the library file and any ALI file of a source of the project.
! 
!             begin
!                Get_Name_String
!                  (In_Tree.Projects.Table (For_Project).Library_Dir);
!                Change_Dir (Name_Buffer (1 .. Name_Len));
! 
!             exception
!                when others =>
!                   Com.Fail
!                     ("unable to access library directory """,
!                      Name_Buffer (1 .. Name_Len),
!                      """");
!             end;
! 
!             Open (Dir, ".");
! 
!             loop
!                Read (Dir, Name, Last);
!                exit when Last = 0;
! 
!                if Is_Regular_File (Name (1 .. Last)) then
!                   Canonical_Case_File_Name (Name (1 .. Last));
!                   Delete := False;
! 
!                   if (The_Build_Mode = Static and then
!                         Name (1 .. Last) =  Archive_Name)
!                     or else
!                       ((The_Build_Mode = Dynamic or else
!                           The_Build_Mode = Relocatable)
!                        and then
!                          Name (1 .. Last) = DLL_Name)
!                   then
!                      Delete := True;
! 
!                   elsif Last > 4 and then Name (Last - 3 .. Last) = ".ali" then
!                      declare
!                         Unit : Unit_Data;
!                      begin
!                         --  Compare with ALI file names of the project
! 
!                         for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
!                            Unit := In_Tree.Units.Table (Index);
! 
!                            if Unit.File_Names (Body_Part).Project /=
!                              No_Project
!                            then
!                               if  Ultimate_Extension_Of
!                                 (Unit.File_Names (Body_Part).Project, In_Tree)
!                                  = For_Project
!                               then
!                                  Get_Name_String
!                                    (Unit.File_Names (Body_Part).Name);
!                                  Name_Len := Name_Len -
!                                    File_Extension
!                                      (Name (1 .. Name_Len))'Length;
!                                  if Name_Buffer (1 .. Name_Len) =
!                                      Name (1 .. Last - 4)
!                                  then
!                                     Delete := True;
!                                     exit;
!                                  end if;
!                               end if;
! 
!                            elsif Ultimate_Extension_Of
!                              (Unit.File_Names (Specification).Project, In_Tree)
!                              = For_Project
!                            then
!                               Get_Name_String
!                                 (Unit.File_Names (Specification).Name);
!                               Name_Len := Name_Len -
!                                 File_Extension (Name (1 .. Name_Len))'Length;
! 
!                               if Name_Buffer (1 .. Name_Len) =
!                                    Name (1 .. Last - 4)
!                               then
!                                  Delete := True;
!                                  exit;
!                               end if;
!                            end if;
!                         end loop;
!                      end;
!                   end if;
! 
!                   if Delete then
!                      Set_Writable (Name (1 .. Last));
!                      Delete_File (Name (1 .. Last), Disregard);
!                   end if;
!                end if;
!             end loop;
! 
!             Close (Dir);
! 
!             Change_Dir (Current_Dir);
!          end;
  
           --  Call procedure to build the library, depending on the build mode
  
*************** package body MLib.Prj is
*** 1486,1492 ****
           end case;
  
           --  We need to copy the ALI files from the object directory to
!          --  the library directory, so that the linker find them there,
           --  and does not need to look in the object directory where it
           --  would also find the object files; and we don't want that:
           --  we want the linker to use the library.
--- 1621,1627 ----
           end case;
  
           --  We need to copy the ALI files from the object directory to
!          --  the library ALI directory, so that the linker find them there,
           --  and does not need to look in the object directory where it
           --  would also find the object files; and we don't want that:
           --  we want the linker to use the library.
*************** package body MLib.Prj is
*** 1496,1522 ****
  
           Copy_ALI_Files
             (Files      => Ali_Files.all,
!             To         => Copy_Dir,
              Interfaces => Arguments (1 .. Argument_Number));
  
           --  Copy interface sources if Library_Src_Dir specified
  
           if Standalone
!            and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
           then
!             --  Clean the interface copy directory, if it is not also the
!             --  library directory. If it is also the library directory, it
!             --  has already been cleaned before generation of the library.
  
!             if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
!                Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
!                Clean (Copy_Dir);
!             end if;
  
              Copy_Interface_Sources
                (For_Project => For_Project,
!                Interfaces => Arguments (1 .. Argument_Number),
!                To_Dir => Copy_Dir);
           end if;
        end if;
  
--- 1631,1728 ----
  
           Copy_ALI_Files
             (Files      => Ali_Files.all,
!             To         => In_Tree.Projects.Table (For_Project).Library_ALI_Dir,
              Interfaces => Arguments (1 .. Argument_Number));
  
           --  Copy interface sources if Library_Src_Dir specified
  
           if Standalone
!            and then In_Tree.Projects.Table
!                       (For_Project).Library_Src_Dir /= No_Name
           then
!             --  Clean the interface copy directory: remove any source that
!             --  could be a source of the project.
  
!             begin
!                Get_Name_String
!                  (In_Tree.Projects.Table (For_Project).Library_Src_Dir);
!                Change_Dir (Name_Buffer (1 .. Name_Len));
! 
!             exception
!                when others =>
!                   Com.Fail
!                     ("unable to access library source copy directory """,
!                      Name_Buffer (1 .. Name_Len),
!                      """");
!             end;
! 
!             declare
!                Dir    : Dir_Type;
!                Delete : Boolean;
!                Unit   : Unit_Data;
! 
!                Name : String (1 .. 200);
!                Last : Natural;
! 
!                Disregard : Boolean;
! 
!             begin
!                Open (Dir, ".");
! 
!                loop
!                   Read (Dir, Name, Last);
!                   exit when Last = 0;
! 
!                   if Is_Regular_File (Name (1 .. Last)) then
!                      Canonical_Case_File_Name (Name (1 .. Last));
!                      Delete := False;
! 
!                      --  Compare with source file names of the project
! 
!                      for Index in 1 .. Unit_Table.Last (In_Tree.Units) loop
!                         Unit := In_Tree.Units.Table (Index);
! 
!                         if Ultimate_Extension_Of
!                             (Unit.File_Names (Body_Part).Project, In_Tree) =
!                             For_Project
!                           and then
!                             Get_Name_String
!                               (Unit.File_Names (Body_Part).Name) =
!                             Name (1 .. Last)
!                         then
!                            Delete := True;
!                            exit;
!                         end if;
! 
!                         if Ultimate_Extension_Of
!                            (Unit.File_Names (Specification).Project, In_Tree) =
!                            For_Project
!                           and then
!                            Get_Name_String
!                              (Unit.File_Names (Specification).Name) =
!                            Name (1 .. Last)
!                         then
!                            Delete := True;
!                            exit;
!                         end if;
!                      end loop;
!                   end if;
! 
!                   if Delete then
!                      Set_Writable (Name (1 .. Last));
!                      Delete_File (Name (1 .. Last), Disregard);
!                   end if;
!                end loop;
! 
!                Close (Dir);
!             end;
  
              Copy_Interface_Sources
                (For_Project => For_Project,
!                In_Tree     => In_Tree,
!                Interfaces  => Arguments (1 .. Argument_Number),
!                To_Dir      => In_Tree.Projects.Table
!                                 (For_Project).Library_Src_Dir);
           end if;
        end if;
  
*************** package body MLib.Prj is
*** 1553,1680 ****
     -- Check_Library --
     -------------------
  
!    procedure Check_Library (For_Project : Project_Id) is
!       Data : constant Project_Data := Projects.Table (For_Project);
  
     begin
        --  No need to build the library if there is no object directory,
        --  hence no object files to build the library.
  
!       if Data.Library
!         and then not Data.Need_To_Build_Lib
!         and then Data.Object_Directory /= No_Name
!       then
           declare
!             Current  : constant Dir_Name_Str := Get_Current_Dir;
!             Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
!             Lib_TS   : Time_Stamp_Type;
!             Obj_TS   : Time_Stamp_Type;
! 
!             Object_Dir : Dir_Type;
! 
           begin
-             if Hostparm.OpenVMS then
-                B_Start (B_Start'Last) := '$';
-             end if;
- 
              Change_Dir (Get_Name_String (Data.Library_Dir));
- 
              Lib_TS := File_Stamp (Lib_Name);
  
!             --  If the library file does not exist, then the time stamp will
!             --  be Empty_Time_Stamp, earlier than any other time stamp.
! 
!             Change_Dir (Get_Name_String (Data.Object_Directory));
!             Open (Dir => Object_Dir, Dir_Name => ".");
! 
!             --  For all entries in the object directory
! 
!             loop
!                Read (Object_Dir, Name_Buffer, Name_Len);
!                exit when Name_Len = 0;
! 
!                --  Check if it is an object file, but ignore any binder
!                --  generated file.
! 
!                if Is_Obj (Name_Buffer (1 .. Name_Len))
!                   and then Name_Buffer (1 .. B_Start'Length) /= B_Start
!                then
!                   --  Get the object file time stamp
! 
!                   Obj_TS := File_Stamp (Name_Find);
! 
!                   --  If library file time stamp is earlier, set
!                   --  Need_To_Build_Lib and return. String comparaison is used,
!                   --  otherwise time stamps may be too close and the
!                   --  comparaison would return True, which would trigger
!                   --  an unnecessary rebuild of the library.
! 
!                   if String (Lib_TS) < String (Obj_TS) then
! 
!                      --  Library must be rebuilt
  
!                      Projects.Table (For_Project).Need_To_Build_Lib := True;
!                      exit;
!                   end if;
                 end if;
-             end loop;
  
!             Change_Dir (Current);
!          end;
!       end if;
!    end Check_Library;
! 
!    -----------
!    -- Clean --
!    -----------
! 
!    procedure Clean (Directory : Name_Id) is
!       Current  : constant Dir_Name_Str := Get_Current_Dir;
  
!       Dir : Dir_Type;
  
!       Name : String (1 .. 200);
!       Last : Natural;
  
!       Disregard : Boolean;
  
!    begin
!       Get_Name_String (Directory);
  
!       --  Change the working directory to the directory to clean
  
!       begin
!          Change_Dir (Name_Buffer (1 .. Name_Len));
  
!       exception
!          when others =>
!             Com.Fail
!               ("unable to access directory """,
!                Name_Buffer (1 .. Name_Len),
!                """");
!       end;
  
!       Open (Dir, ".");
  
!       --  For each regular file in the directory, make it writable and
!       --  delete the file.
  
!       loop
!          Read (Dir, Name, Last);
!          exit when Last = 0;
  
!          if Is_Regular_File (Name (1 .. Last)) then
!             Set_Writable (Name (1 .. Last));
!             Delete_File (Name (1 .. Last), Disregard);
           end if;
-       end loop;
  
!       Close (Dir);
! 
!       --  Restore the initial working directory
! 
!       Change_Dir (Current);
!    end Clean;
  
     ----------------------------
     -- Copy_Interface_Sources --
--- 1759,1845 ----
     -- Check_Library --
     -------------------
  
!    procedure Check_Library
!      (For_Project : Project_Id; In_Tree : Project_Tree_Ref)
!    is
!       Data    : constant Project_Data :=
!                   In_Tree.Projects.Table (For_Project);
!       Lib_TS  : Time_Stamp_Type;
!       Current : constant Dir_Name_Str := Get_Current_Dir;
  
     begin
        --  No need to build the library if there is no object directory,
        --  hence no object files to build the library.
  
!       if Data.Library then
           declare
!             Lib_Name : constant Name_Id :=
!               Library_File_Name_For (For_Project, In_Tree);
           begin
              Change_Dir (Get_Name_String (Data.Library_Dir));
              Lib_TS := File_Stamp (Lib_Name);
+             In_Tree.Projects.Table (For_Project).Library_TS := Lib_TS;
+          end;
  
!          if not Data.Externally_Built
!            and then not Data.Need_To_Build_Lib
!            and then Data.Object_Directory /= No_Name
!          then
!             declare
!                Obj_TS     : Time_Stamp_Type;
!                Object_Dir : Dir_Type;
  
!             begin
!                if Hostparm.OpenVMS then
!                   B_Start (B_Start'Last) := '$';
                 end if;
  
!                --  If the library file does not exist, then the time stamp will
!                --  be Empty_Time_Stamp, earlier than any other time stamp.
  
!                Change_Dir (Get_Name_String (Data.Object_Directory));
!                Open (Dir => Object_Dir, Dir_Name => ".");
  
!                --  For all entries in the object directory
  
!                loop
!                   Read (Object_Dir, Name_Buffer, Name_Len);
!                   exit when Name_Len = 0;
  
!                   --  Check if it is an object file, but ignore any binder
!                   --  generated file.
  
!                   if Is_Obj (Name_Buffer (1 .. Name_Len))
!                     and then Name_Buffer (1 .. B_Start'Length) /= B_Start
!                   then
!                      --  Get the object file time stamp
  
!                      Obj_TS := File_Stamp (Name_Find);
  
!                      --  If library file time stamp is earlier, set
!                      --  Need_To_Build_Lib and return. String comparaison is
!                      --  used, otherwise time stamps may be too close and the
!                      --  comparaison would return True, which would trigger
!                      --  an unnecessary rebuild of the library.
  
!                      if String (Lib_TS) < String (Obj_TS) then
  
!                         --  Library must be rebuilt
  
!                         In_Tree.Projects.Table
!                           (For_Project).Need_To_Build_Lib := True;
!                         exit;
!                      end if;
!                   end if;
!                end loop;
  
!                Close (Object_Dir);
!             end;
           end if;
  
!          Change_Dir (Current);
!       end if;
!    end Check_Library;
  
     ----------------------------
     -- Copy_Interface_Sources --
*************** package body MLib.Prj is
*** 1682,1692 ****
  
     procedure Copy_Interface_Sources
       (For_Project : Project_Id;
        Interfaces  : Argument_List;
        To_Dir      : Name_Id)
     is
!       Current  : constant Dir_Name_Str := Get_Current_Dir;
!       Target   : constant Dir_Name_Str := Get_Name_String (To_Dir);
  
        Text     : Text_Buffer_Ptr;
        The_ALI  : ALI.ALI_Id;
--- 1847,1861 ----
  
     procedure Copy_Interface_Sources
       (For_Project : Project_Id;
+       In_Tree     : Project_Tree_Ref;
        Interfaces  : Argument_List;
        To_Dir      : Name_Id)
     is
!       Current : constant Dir_Name_Str := Get_Current_Dir;
!       --  The current directory, where to return to at the end
! 
!       Target : constant Dir_Name_Str := Get_Name_String (To_Dir);
!       --  The directory where to copy sources
  
        Text     : Text_Buffer_Ptr;
        The_ALI  : ALI.ALI_Id;
*************** package body MLib.Prj is
*** 1698,1707 ****
--- 1867,1883 ----
        Data : Unit_Data;
  
        Copy_Subunits : Boolean := False;
+       --  When True, indicates that subunits, if any, need to be copied too
  
        procedure Copy (File_Name : Name_Id);
        --  Copy one source of the project to the target directory
  
+       function Is_Same_Or_Extension
+         (Extending : Project_Id;
+          Extended  : Project_Id) return Boolean;
+       --  Return True if project Extending is equal to or extends project
+       --  Extended.
+ 
        ----------
        -- Copy --
        ----------
*************** package body MLib.Prj is
*** 1711,1721 ****
  
        begin
           Unit_Loop :
!          for Index in 1 .. Com.Units.Last loop
!             Data := Com.Units.Table (Index);
  
              for J in Data.File_Names'Range loop
!                if Data.File_Names (J).Project = For_Project
                   and then Data.File_Names (J).Name = File_Name
                 then
                    Copy_File
--- 1887,1902 ----
  
        begin
           Unit_Loop :
!          for Index in Unit_Table.First ..
!                       Unit_Table.Last (In_Tree.Units)
!          loop
!             Data := In_Tree.Units.Table (Index);
! 
!             --  Find and copy the immediate or inherited source
  
              for J in Data.File_Names'Range loop
!                if Is_Same_Or_Extension
!                     (For_Project, Data.File_Names (J).Project)
                   and then Data.File_Names (J).Name = File_Name
                 then
                    Copy_File
*************** package body MLib.Prj is
*** 1730,1736 ****
           end loop Unit_Loop;
        end Copy;
  
!       use ALI;
  
     --  Start of processing for Copy_Interface_Sources
  
--- 1911,1937 ----
           end loop Unit_Loop;
        end Copy;
  
!       --------------------------
!       -- Is_Same_Or_Extension --
!       --------------------------
! 
!       function Is_Same_Or_Extension
!         (Extending : Project_Id;
!          Extended  : Project_Id) return Boolean
!       is
!          Ext : Project_Id := Extending;
! 
!       begin
!          while Ext /= No_Project loop
!             if Ext = Extended then
!                return True;
!             end if;
! 
!             Ext := In_Tree.Projects.Table (Ext).Extends;
!          end loop;
! 
!          return False;
!       end Is_Same_Or_Extension;
  
     --  Start of processing for Copy_Interface_Sources
  
*************** package body MLib.Prj is
*** 1738,1744 ****
        --  Change the working directory to the object directory
  
        Change_Dir
!         (Get_Name_String (Projects.Table (For_Project).Object_Directory));
  
        for Index in Interfaces'Range loop
  
--- 1939,1947 ----
        --  Change the working directory to the object directory
  
        Change_Dir
!         (Get_Name_String
!            (In_Tree.Projects.Table
!               (For_Project).Object_Directory));
  
        for Index in Interfaces'Range loop
  
*************** package body MLib.Prj is
*** 1825,1831 ****
        Fd : FILEs;
        --  Binder file's descriptor
  
!       Read_Mode  : constant String := "r" & ASCII.Nul;
        --  For fopen
  
        Status : Interfaces.C_Streams.int;
--- 2028,2034 ----
        Fd : FILEs;
        --  Binder file's descriptor
  
!       Read_Mode : constant String := "r" & ASCII.Nul;
        --  For fopen
  
        Status : Interfaces.C_Streams.int;
*************** package body MLib.Prj is
*** 1963,1969 ****
--- 2166,2174 ----
        end if;
  
        Status := fclose (Fd);
+ 
        --  Is it really right to ignore any close error ???
+ 
     end Process_Binder_File;
  
     ------------------
*************** package body MLib.Prj is
*** 1981,1984 ****
--- 2186,2224 ----
        Library_Projs.Init;
     end Reset_Tables;
  
+    ---------------------------
+    -- SALs_Use_Constructors --
+    ---------------------------
+ 
+    function SALs_Use_Constructors return Boolean is
+       function C_SALs_Init_Using_Constructors return Integer;
+       pragma Import (C, C_SALs_Init_Using_Constructors,
+                      "__gnat_sals_init_using_constructors");
+    begin
+       return C_SALs_Init_Using_Constructors /= 0;
+    end SALs_Use_Constructors;
+ 
+    ---------------------------
+    -- Ultimate_Extension_Of --
+    ---------------------------
+ 
+    function Ultimate_Extension_Of
+      (Project : Project_Id;
+       In_Tree : Project_Tree_Ref) return Project_Id
+    is
+       Result : Project_Id := Project;
+       Data   : Project_Data;
+ 
+    begin
+       if Project /= No_Project then
+          loop
+             Data := In_Tree.Projects.Table (Result);
+             exit when Data.Extended_By = No_Project;
+             Result := Data.Extended_By;
+          end loop;
+       end if;
+ 
+       return Result;
+    end Ultimate_Extension_Of;
+ 
  end MLib.Prj;
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-prj.ads gcc-4.1.0/gcc/ada/mlib-prj.ads
*** gcc-4.0.2/gcc/ada/mlib-prj.ads	Tue Oct 21 13:42:09 2003
--- gcc-4.1.0/gcc/ada/mlib-prj.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001-2003, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package MLib.Prj is
*** 32,37 ****
--- 32,38 ----
  
     procedure Build_Library
       (For_Project   : Project_Id;
+       In_Tree       : Project_Tree_Ref;
        Gnatbind      : String;
        Gnatbind_Path : String_Access;
        Gcc           : String;
*************** package MLib.Prj is
*** 45,51 ****
     --  files. If Bind is False the binding of a stand-alone library is skipped.
     --  If Link is False, the library is not linked/built.
  
!    procedure Check_Library (For_Project : Project_Id);
     --  Check if the library of a library project needs to be rebuilt,
     --  because its time-stamp is earlier than the time stamp of one of its
     --  object files.
--- 46,53 ----
     --  files. If Bind is False the binding of a stand-alone library is skipped.
     --  If Link is False, the library is not linked/built.
  
!    procedure Check_Library
!      (For_Project : Project_Id; In_Tree : Project_Tree_Ref);
     --  Check if the library of a library project needs to be rebuilt,
     --  because its time-stamp is earlier than the time stamp of one of its
     --  object files.
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-aix.adb gcc-4.1.0/gcc/ada/mlib-tgt-aix.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-aix.adb	Wed Oct 27 12:27:51 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-aix.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004, Ada Core Technologies, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,42 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic or relocatable libraries.
  
! --  This is the AIX version of the body.
  
  with Ada.Strings.Fixed; use Ada.Strings.Fixed;
- with GNAT.OS_Lib;       use GNAT.OS_Lib;
  
  with MLib.Fil;
  with MLib.Utl;
  with Namet;    use Namet;
- with Osint;    use Osint;
  with Opt;
  with Output;   use Output;
  with Prj.Com;
--- 28,40 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic or relocatable libraries.
  
! --  This is the AIX version of the body
  
  with Ada.Strings.Fixed; use Ada.Strings.Fixed;
  
  with MLib.Fil;
  with MLib.Utl;
  with Namet;    use Namet;
  with Opt;
  with Output;   use Output;
  with Prj.Com;
*************** package body MLib.Tgt is
*** 47,58 ****
     No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
     Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
  
-    Wl_Initfini_String  : constant String := "-Wl,-binitfini:";
- 
-    Init_Fini_List      :  constant Argument_List_Access :=
-                             new Argument_List'(1 => null);
-    --  Used to put switch for automatic elaboration/finalization
- 
     Bexpall : aliased String := "-Wl,-bexpall";
     Bexpall_Option : constant String_Access := Bexpall'Access;
     --  The switch to export all symbols
--- 45,50 ----
*************** package body MLib.Tgt is
*** 142,157 ****
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
        pragma Unreferenced (Lib_Version);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
                     MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
        --  The file name of the library
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
-       --  The switch for automatic initialization of Stand-Alone Libraries.
-       --  Changed to a real switch when Auto_Init is True.
- 
        Thread_Opts : Argument_List_Access := Empty_Argument_List;
        --  Set to Thread_Options if -lgnarl is found in the Options
  
--- 134,146 ----
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
        pragma Unreferenced (Lib_Version);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
                     MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
        --  The file name of the library
  
        Thread_Opts : Argument_List_Access := Empty_Argument_List;
        --  Set to Thread_Options if -lgnarl is found in the Options
  
*************** package body MLib.Tgt is
*** 161,176 ****
           Write_Line (Lib_File);
        end if;
  
!       --  If specified, add automatic elaboration/finalization
! 
!       if Auto_Init then
!          Init_Fini := Init_Fini_List;
!          Init_Fini (1) :=
!            new String'(Wl_Initfini_String & Lib_Filename & "init:" &
!                        Lib_Filename & "final");
!       end if;
! 
!       --  Look for -lgnarl in Options. If found, set the thread options.
  
        for J in Options'Range loop
           if Options (J).all = "-lgnarl" then
--- 150,156 ----
           Write_Line (Lib_File);
        end if;
  
!       --  Look for -lgnarl in Options. If found, set the thread options
  
        for J in Options'Range loop
           if Options (J).all = "-lgnarl" then
*************** package body MLib.Tgt is
*** 223,229 ****
        MLib.Utl.Gcc
          (Output_File => Lib_File,
           Objects     => Ofiles,
!          Options     => Options & Bexpall_Option & Init_Fini.all,
           Driver_Name => Driver_Name,
           Options_2   => Options_2 & Thread_Opts.all);
     end Build_Dynamic_Library;
--- 203,209 ----
        MLib.Utl.Gcc
          (Output_File => Lib_File,
           Objects     => Ofiles,
!          Options     => Options & Bexpall_Option,
           Driver_Name => Driver_Name,
           Options_2   => Options_2 & Thread_Opts.all);
     end Build_Dynamic_Library;
*************** package body MLib.Tgt is
*** 237,242 ****
--- 217,231 ----
        return "a";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 286,294 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 275,285 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 296,309 ****
        else
           declare
              Lib_Dir  : constant String :=
!                          Get_Name_String
!                            (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!                          Get_Name_String
!                            (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 287,303 ----
        else
           declare
              Lib_Dir  : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
! 
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 321,329 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 315,326 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 331,343 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 328,343 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
*************** package body MLib.Tgt is
*** 382,388 ****
  
     function Support_For_Libraries return Library_Support is
     begin
!       return Full;
     end Support_For_Libraries;
  
  end MLib.Tgt;
--- 382,388 ----
  
     function Support_For_Libraries return Library_Support is
     begin
!       return Static_Only;
     end Support_For_Libraries;
  
  end MLib.Tgt;
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-darwin.adb gcc-4.1.0/gcc/ada/mlib-tgt-darwin.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-darwin.adb	Wed Oct 27 12:27:51 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-darwin.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the Darwin version of the body.
  
  with MLib.Fil;
  with MLib.Utl;
--- 28,34 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the Darwin version of the body
  
  with MLib.Fil;
  with MLib.Utl;
*************** package body MLib.Tgt is
*** 43,63 ****
     use GNAT;
     use MLib;
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : aliased String         := "-Wl,-init";
-    Wl_Init        : constant String_Access := Wl_Init_String'Access;
-    Wl_Fini_String : aliased String         := "-Wl,-fini";
-    Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => Wl_Init,
-                                           2 => null,
-                                           3 => Wl_Fini,
-                                           4 => null);
-    --  Used to put switches for automatic elaboration/finalization
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 43,48 ----
*************** package body MLib.Tgt is
*** 125,130 ****
--- 110,116 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 133,140 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
--- 119,124 ----
*************** package body MLib.Tgt is
*** 143,170 ****
  
        --  If specified, add automatic elaboration/finalization
  
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-          Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-       end if;
- 
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options & Init_Fini.all,
              Driver_Name => Driver_Name,
              Options_2   => Options_2);
  
        else
!          Version_Arg := new String'("-Wl,-flat_namespace"); -- ???
  
           if Is_Absolute_Path (Lib_Version) then
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 127,152 ----
  
        --  If specified, add automatic elaboration/finalization
  
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options,
              Driver_Name => Driver_Name,
              Options_2   => Options_2);
  
        else
!          --  Instruct the linker to build the shared library as a flat
!          --  namespace image, which is not the default. The default is a two
!          --  level namespace image.
! 
!          Version_Arg := new String'("-Wl,-flat_namespace");
  
           if Is_Absolute_Path (Lib_Version) then
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 173,179 ****
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed :=
--- 155,161 ----
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 217,222 ****
--- 199,213 ----
        return "dylib";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 250,256 ****
  
     function Is_Archive_Ext (Ext : String) return Boolean is
     begin
!       return Ext = ".a" or else Ext = ".dyld";
     end Is_Archive_Ext;
  
     -------------
--- 241,247 ----
  
     function Is_Archive_Ext (Ext : String) return Boolean is
     begin
!       return Ext = ".dylib" or else Ext = ".a";
     end Is_Archive_Ext;
  
     -------------
*************** package body MLib.Tgt is
*** 266,274 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 257,267 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 276,287 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 269,284 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 299,307 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 296,307 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 309,321 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 309,323 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-hpux.adb gcc-4.1.0/gcc/ada/mlib-tgt-hpux.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-hpux.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-hpux.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004, Ada Core Technologies, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  This package provides a set of target dependent routines to build
  --  libraries (static only on HP-UX).
  
! --  This is the HP-UX version of the body.
  
  with MLib.Fil;
  with MLib.Utl;
--- 28,34 ----
  --  This package provides a set of target dependent routines to build
  --  libraries (static only on HP-UX).
  
! --  This is the HP-UX version of the body
  
  with MLib.Fil;
  with MLib.Utl;
*************** with System;
*** 40,59 ****
  
  package body MLib.Tgt is
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : aliased String         := "-Wl,+init";
-    Wl_Init        : constant String_Access := Wl_Init_String'Access;
-    Wl_Fini_String : aliased String         := "-Wl,+fini";
-    Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => Wl_Init,
-                                           2 => null,
-                                           3 => Wl_Fini,
-                                           4 => null);
-    --  Used to put switches for automatic elaboration/finalization
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 40,45 ----
*************** package body MLib.Tgt is
*** 121,126 ****
--- 107,113 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 129,136 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
        Common_Options : constant Argument_List :=
                           Options & new String'(PIC_Option);
        --  Common set of options to the gcc command performing the link.
--- 116,121 ----
*************** package body MLib.Tgt is
*** 144,162 ****
           Write_Line (Lib_File);
        end if;
  
-       --  If specified, add automatic elaboration/finalization
- 
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-          Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-       end if;
- 
        if Lib_Version = "" then
           MLib.Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Common_Options & Init_Fini.all,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
--- 129,139 ----
           Write_Line (Lib_File);
        end if;
  
        if Lib_Version = "" then
           MLib.Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Common_Options,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
*************** package body MLib.Tgt is
*** 167,173 ****
              MLib.Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Common_Options & Version_Arg & Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 144,150 ----
              MLib.Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Common_Options & Version_Arg,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 176,182 ****
              MLib.Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Common_Options & Version_Arg & Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
--- 153,159 ----
              MLib.Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Common_Options & Version_Arg,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 220,225 ****
--- 197,211 ----
        return "sl";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 269,277 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 255,265 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 279,290 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 267,282 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 302,310 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 294,305 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 312,324 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 307,322 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-irix.adb gcc-4.1.0/gcc/ada/mlib-tgt-irix.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-irix.adb	Wed Oct 27 12:27:51 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-irix.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004, Ada Core Technologies, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2003-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the IRIX version of the body.
  
  with MLib.Fil;
  with MLib.Utl;
--- 28,34 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the IRIX version of the body
  
  with MLib.Fil;
  with MLib.Utl;
*************** with System;
*** 40,60 ****
  
  package body MLib.Tgt is
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : aliased String         := "-Wl,-init";
-    Wl_Init        : constant String_Access := Wl_Init_String'Access;
-    Wl_Fini_String : aliased String         := "-Wl,-fini";
-    Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => Wl_Init,
-                                           2 => null,
-                                           3 => Wl_Fini,
-                                           4 => null);
-    --  Used to put switches for automatic elaboration/finalization
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 40,45 ----
*************** package body MLib.Tgt is
*** 122,127 ****
--- 107,113 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 130,137 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
        N_Options    : Argument_List := Options;
        Options_Last : Natural := N_Options'Last;
        --  After moving -lxxx to Options_2, N_Options up to index Options_Last
--- 116,121 ----
*************** package body MLib.Tgt is
*** 148,161 ****
           Write_Line (Lib_File);
        end if;
  
-       --  If specified, add automatic elaboration/finalization
- 
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-          Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-       end if;
- 
        --  Move all -lxxx to Options_2
  
        declare
--- 132,137 ----
*************** package body MLib.Tgt is
*** 192,199 ****
           MLib.Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => N_Options (N_Options'First .. Options_Last) &
!                            Init_Fini.all,
              Driver_Name => Driver_Name,
              Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
  
--- 168,174 ----
           MLib.Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => N_Options (N_Options'First .. Options_Last),
              Driver_Name => Driver_Name,
              Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
  
*************** package body MLib.Tgt is
*** 205,211 ****
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
                 Options     => N_Options (N_Options'First .. Options_Last) &
!                               Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 180,186 ----
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
                 Options     => N_Options (N_Options'First .. Options_Last) &
!                               Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 215,221 ****
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
                 Options     => N_Options (N_Options'First .. Options_Last) &
!                               Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
              Symbolic_Link_Needed :=
--- 190,196 ----
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
                 Options     => N_Options (N_Options'First .. Options_Last) &
!                               Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Real_Options_2 (1 .. Real_Options_2_Last));
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 260,265 ****
--- 235,249 ----
        return "so";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 309,317 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 293,303 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 319,330 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 305,320 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 342,350 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 332,343 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 352,364 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 345,360 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-linux.adb gcc-4.1.0/gcc/ada/mlib-tgt-linux.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-linux.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-linux.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the GNU/Linux version of the body.
  
  with MLib.Fil;
  with MLib.Utl;
--- 28,34 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the GNU/Linux version of the body
  
  with MLib.Fil;
  with MLib.Utl;
*************** package body MLib.Tgt is
*** 43,63 ****
     use GNAT;
     use MLib;
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : aliased String         := "-Wl,-init";
-    Wl_Init        : constant String_Access := Wl_Init_String'Access;
-    Wl_Fini_String : aliased String         := "-Wl,-fini";
-    Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => Wl_Init,
-                                           2 => null,
-                                           3 => Wl_Fini,
-                                           4 => null);
-    --  Used to put switches for automatic elaboration/finalization
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 43,48 ----
*************** package body MLib.Tgt is
*** 125,130 ****
--- 110,117 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
+       --  Initialization is done through the contructor mechanism
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 133,159 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
           Write_Line (Lib_File);
        end if;
  
-       --  If specified, add automatic elaboration/finalization
- 
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-          Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-       end if;
- 
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options & Init_Fini.all,
              Driver_Name => Driver_Name,
              Options_2   => Options_2);
  
--- 120,136 ----
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
           Write_Line (Lib_File);
        end if;
  
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options,
              Driver_Name => Driver_Name,
              Options_2   => Options_2);
  
*************** package body MLib.Tgt is
*** 164,170 ****
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 141,147 ----
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 173,179 ****
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed :=
--- 150,156 ----
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Driver_Name => Driver_Name,
                 Options_2   => Options_2);
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 217,222 ****
--- 194,208 ----
        return "so";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 266,274 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 252,262 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 276,287 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 264,279 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!                  Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 299,307 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 291,302 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 309,321 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 304,319 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!                  Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-lynxos.adb gcc-4.1.0/gcc/ada/mlib-tgt-lynxos.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-lynxos.adb	Thu Feb 10 14:04:42 2005
--- gcc-4.1.0/gcc/ada/mlib-tgt-lynxos.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body MLib.Tgt is
*** 125,130 ****
--- 125,139 ----
        return "";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 174,182 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 183,193 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 184,195 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 195,210 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 207,215 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 222,233 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 217,229 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 235,250 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-mingw.adb gcc-4.1.0/gcc/ada/mlib-tgt-mingw.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-mingw.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-mingw.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Opt;
*** 36,43 ****
  with Output; use Output;
  with Prj.Com;
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
- 
  with MLib.Fil;
  with MLib.Utl;
  
--- 36,41 ----
*************** package body MLib.Tgt is
*** 46,51 ****
--- 44,52 ----
     package Files renames MLib.Fil;
     package Tools renames MLib.Utl;
  
+    No_Argument_List : constant String_List := (1 .. 0 => null);
+    --  Used as value of parameter Options or Options2 in calls to Gcc
+ 
     ---------------------
     -- Archive_Builder --
     ---------------------
*************** package body MLib.Tgt is
*** 111,120 ****
     is
        pragma Unreferenced (Foreign);
        pragma Unreferenced (Afiles);
-       pragma Unreferenced (Auto_Init);
        pragma Unreferenced (Symbol_Data);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Lib_Version);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator &
--- 112,121 ----
     is
        pragma Unreferenced (Foreign);
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Symbol_Data);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Lib_Version);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator &
*************** package body MLib.Tgt is
*** 131,137 ****
        Tools.Gcc
          (Output_File => Lib_File,
           Objects     => Ofiles,
!          Options     => Tools.No_Argument_List,
           Options_2   => Options & Options_2,
           Driver_Name => Driver_Name);
     end Build_Dynamic_Library;
--- 132,138 ----
        Tools.Gcc
          (Output_File => Lib_File,
           Objects     => Ofiles,
!          Options     => No_Argument_List,
           Options_2   => Options & Options_2,
           Driver_Name => Driver_Name);
     end Build_Dynamic_Library;
*************** package body MLib.Tgt is
*** 145,150 ****
--- 146,160 ----
        return "dll";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 194,202 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 204,213 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 204,217 ****
        else
           declare
              Lib_Dir : constant String :=
!                         Get_Name_String
!                           (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!                          Get_Name_String
!                            (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
--- 215,230 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    MLib.Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 229,237 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 242,252 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 239,248 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 Name_Len := 3;
                 Name_Buffer (1 .. Name_Len) := "lib";
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
--- 254,266 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Name_Len := 3;
                 Name_Buffer (1 .. Name_Len) := "lib";
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 281,287 ****
  
     function Standalone_Library_Auto_Init_Is_Supported return Boolean is
     begin
!       return False;
     end Standalone_Library_Auto_Init_Is_Supported;
  
     ---------------------------
--- 299,305 ----
  
     function Standalone_Library_Auto_Init_Is_Supported return Boolean is
     begin
!       return True;
     end Standalone_Library_Auto_Init_Is_Supported;
  
     ---------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-solaris.adb gcc-4.1.0/gcc/ada/mlib-tgt-solaris.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-solaris.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-solaris.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2002-2004 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2002-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with System;
*** 40,57 ****
  
  package body MLib.Tgt is
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : constant String         := "-Wl,-zinitarray=";
-    Wl_Fini_String : constant String         := "-Wl,-zfiniarray=";
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => null,
-                                           2 => null);
- 
-    --  Used to put switches for automatic elaboration/finalization
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 40,45 ----
*************** package body MLib.Tgt is
*** 119,124 ****
--- 107,113 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 127,155 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
           Write_Line (Lib_File);
        end if;
  
-       --  If specified, add automatic elaboration/finalization
- 
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (1) :=
-            new String'(Wl_Init_String & Lib_Filename & "init");
-          Init_Fini (2) :=
-            new String'(Wl_Fini_String & Lib_Filename & "final");
-       end if;
- 
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options & Init_Fini.all,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
--- 116,132 ----
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
           Write_Line (Lib_File);
        end if;
  
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
*************** package body MLib.Tgt is
*** 160,166 ****
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 137,143 ----
              Utl.Gcc
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 169,175 ****
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg & Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
--- 146,152 ----
              Utl.Gcc
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
!                Options     => Options & Version_Arg,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 214,219 ****
--- 191,205 ----
        return "so";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 263,271 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 249,259 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 273,284 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 261,276 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 296,304 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 288,299 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 306,318 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 301,316 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-tru64.adb gcc-4.1.0/gcc/ada/mlib-tgt-tru64.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-tru64.adb	Wed Oct 27 12:27:51 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-tru64.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2002-2004 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,34 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the True64 version of the body.
  
  with MLib.Fil;
  with MLib.Utl;
--- 28,34 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  This is the True64 version of the body
  
  with MLib.Fil;
  with MLib.Utl;
*************** package body MLib.Tgt is
*** 45,65 ****
  
     Expect_Unresolved : aliased String := "-Wl,-expect_unresolved,*";
  
-    No_Arguments        : aliased Argument_List         := (1 .. 0 => null);
-    Empty_Argument_List : constant Argument_List_Access := No_Arguments'Access;
- 
-    Wl_Init_String : aliased String         := "-Wl,-init";
-    Wl_Init        : constant String_Access := Wl_Init_String'Access;
-    Wl_Fini_String : aliased String         := "-Wl,-fini";
-    Wl_Fini        : constant String_Access := Wl_Fini_String'Access;
- 
-    Init_Fini_List :  constant Argument_List_Access :=
-                        new Argument_List'(1 => Wl_Init,
-                                           2 => null,
-                                           3 => Wl_Fini,
-                                           4 => null);
-    --  Used to put switches for automatic elaboration/finalization
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 45,50 ----
*************** package body MLib.Tgt is
*** 127,132 ****
--- 112,119 ----
        pragma Unreferenced (Afiles);
        pragma Unreferenced (Interfaces);
        pragma Unreferenced (Symbol_Data);
+       pragma Unreferenced (Auto_Init);
+       --  Initialization is done through the contructor mechanism
  
        Lib_File : constant String :=
                     Lib_Dir & Directory_Separator & "lib" &
*************** package body MLib.Tgt is
*** 135,142 ****
        Version_Arg          : String_Access;
        Symbolic_Link_Needed : Boolean := False;
  
-       Init_Fini : Argument_List_Access := Empty_Argument_List;
- 
     begin
        if Opt.Verbose_Mode then
           Write_Str ("building relocatable shared library ");
--- 122,127 ----
*************** package body MLib.Tgt is
*** 145,164 ****
  
        --  If specified, add automatic elaboration/finalization
  
-       if Auto_Init then
-          Init_Fini := Init_Fini_List;
-          Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
-          Init_Fini (4) := new String'("-Wl," & Lib_Filename & "final");
-       end if;
- 
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     =>
!               Options &
!               Expect_Unresolved'Access &
!               Init_Fini.all,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
--- 130,140 ----
  
        --  If specified, add automatic elaboration/finalization
  
        if Lib_Version = "" then
           Utl.Gcc
             (Output_File => Lib_File,
              Objects     => Ofiles,
!             Options     => Options & Expect_Unresolved'Access,
              Options_2   => Options_2,
              Driver_Name => Driver_Name);
  
*************** package body MLib.Tgt is
*** 170,179 ****
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
                 Options     =>
!                  Options &
!                  Version_Arg &
!                  Expect_Unresolved'Access &
!                  Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
--- 146,152 ----
                (Output_File => Lib_Version,
                 Objects     => Ofiles,
                 Options     =>
!                  Options & Version_Arg & Expect_Unresolved'Access,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed := Lib_Version /= Lib_File;
*************** package body MLib.Tgt is
*** 183,192 ****
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
                 Options     =>
!                  Options &
!                  Version_Arg &
!                  Expect_Unresolved'Access &
!                  Init_Fini.all,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
--- 156,162 ----
                (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
                 Objects     => Ofiles,
                 Options     =>
!                  Options & Version_Arg & Expect_Unresolved'Access,
                 Options_2   => Options_2,
                 Driver_Name => Driver_Name);
              Symbolic_Link_Needed :=
*************** package body MLib.Tgt is
*** 231,236 ****
--- 201,215 ----
        return "so";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 280,288 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 259,269 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 290,301 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 271,286 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 313,321 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 298,309 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 323,335 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 311,326 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-vms-alpha.adb gcc-4.1.0/gcc/ada/mlib-tgt-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-vms-alpha.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-vms-alpha.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2004, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,45 ****
  
  with Ada.Characters.Handling; use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
! with GNAT.OS_Lib;                use GNAT.OS_Lib;
  
  with MLib.Fil;
  with MLib.Utl;
! with Namet;             use Namet;
! with Opt;               use Opt;
! with Output;            use Output;
  with Prj.Com;
! with System;            use System;
! with System.Case_Util;  use System.Case_Util;
  
  package body MLib.Tgt is
  
--- 29,46 ----
  
  with Ada.Characters.Handling; use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  
  with MLib.Fil;
  with MLib.Utl;
! with Namet;    use Namet;
! with Opt;      use Opt;
! with Output;   use Output;
  with Prj.Com;
! 
! with System;           use System;
! with System.Case_Util; use System.Case_Util;
! with System.CRTL;      use System.CRTL;
  
  package body MLib.Tgt is
  
*************** package body MLib.Tgt is
*** 50,56 ****
     --  Used to add the generated auto-init object files for auto-initializing
     --  stand-alone libraries.
  
!    Macro_Name   : constant String := "mcr gnu:[bin]gcc -c -x assembler";
     --  The name of the command to invoke the macro-assembler
  
     VMS_Options : Argument_List := (1 .. 1 => null);
--- 51,57 ----
     --  Used to add the generated auto-init object files for auto-initializing
     --  stand-alone libraries.
  
!    Macro_Name : constant String := "mcr gnu:[bin]gcc -c -x assembler";
     --  The name of the command to invoke the macro-assembler
  
     VMS_Options : Argument_List := (1 .. 1 => null);
*************** package body MLib.Tgt is
*** 72,87 ****
     Link_With_Shared_Libgcc : Argument_List_Access :=
                                 No_Shared_Libgcc_Switch'Access;
  
-    ------------------------------
-    -- Target dependent section --
-    ------------------------------
- 
-    function Popen (Command, Mode : System.Address) return System.Address;
-    pragma Import (C, Popen);
- 
-    function Pclose (File : System.Address) return Integer;
-    pragma Import (C, Pclose);
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 73,78 ----
*************** package body MLib.Tgt is
*** 168,175 ****
        --  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 --
--- 159,168 ----
        --  Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
  
        function Version_String return String;
!       --  Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
!       --  not Autonomous, otherwise returns "".
!       --  When Symbol_Data.Symbol_Policy is Autonomous, fails gnatmake if
!       --  Lib_Version is not the image of a positive number.
  
        ------------------
        -- Is_Interface --
*************** package body MLib.Tgt is
*** 223,230 ****
        function Version_String return String is
           Version : Integer := 0;
        begin
!          if Lib_Version = "" then
!             return "1";
  
           else
              begin
--- 216,225 ----
        function Version_String return String is
           Version : Integer := 0;
        begin
!          if Lib_Version = ""
!            or else Symbol_Data.Symbol_Policy /= Autonomous
!          then
!             return "";
  
           else
              begin
*************** package body MLib.Tgt is
*** 302,313 ****
              Len             : Natural;
              OK              : Boolean := True;
  
!             Command  : constant String :=
                           Macro_Name & " " & Macro_File_Name & ASCII.NUL;
              --  The command to invoke the assembler on the generated auto-init
              --  assembly file.
  
!             Mode : constant String := "r" & ASCII.NUL;
              --  The mode for the invocation of Popen
  
           begin
--- 297,308 ----
              Len             : Natural;
              OK              : Boolean := True;
  
!             command  : constant String :=
                           Macro_Name & " " & Macro_File_Name & ASCII.NUL;
              --  The command to invoke the assembler on the generated auto-init
              --  assembly file.
  
!             mode : constant String := "r" & ASCII.NUL;
              --  The mode for the invocation of Popen
  
           begin
*************** package body MLib.Tgt is
*** 365,372 ****
                 Write_Line ("""");
              end if;
  
!             Popen_Result := Popen (Command (Command'First)'Address,
!                                    Mode (Mode'First)'Address);
  
              if Popen_Result = Null_Address then
                 Fail ("assembly of auto-init assembly file """,
--- 360,367 ----
                 Write_Line ("""");
              end if;
  
!             Popen_Result := popen (command (command'First)'Address,
!                                    mode (mode'First)'Address);
  
              if Popen_Result = Null_Address then
                 Fail ("assembly of auto-init assembly file """,
*************** package body MLib.Tgt is
*** 375,381 ****
  
              --  Wait for the end of execution of the macro-assembler
  
!             Pclose_Result := Pclose (Popen_Result);
  
              if Pclose_Result < 0 then
                 Fail ("assembly of auto init assembly file """,
--- 370,376 ----
  
              --  Wait for the end of execution of the macro-assembler
  
!             Pclose_Result := pclose (Popen_Result);
  
              if Pclose_Result < 0 then
                 Fail ("assembly of auto init assembly file """,
*************** package body MLib.Tgt is
*** 544,549 ****
--- 539,553 ----
        return "exe";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 604,612 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Fail ("INTERNAL ERROR: Library_Exists_For called " &
                 "for non library project");
           return False;
--- 608,618 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Fail ("INTERNAL ERROR: Library_Exists_For called " &
                 "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 614,625 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 620,635 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 637,645 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 647,658 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 647,659 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 660,675 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-vms-ia64.adb gcc-4.1.0/gcc/ada/mlib-tgt-vms-ia64.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-vms-ia64.adb	Thu Feb 10 13:49:15 2005
--- gcc-4.1.0/gcc/ada/mlib-tgt-vms-ia64.adb	Tue Nov 15 13:51:50 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,45 ****
  
  with Ada.Characters.Handling; use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
! with GNAT.OS_Lib;                use GNAT.OS_Lib;
  
  with MLib.Fil;
  with MLib.Utl;
! with Namet;             use Namet;
! with Opt;               use Opt;
! with Output;            use Output;
  with Prj.Com;
! with System;            use System;
! with System.Case_Util;  use System.Case_Util;
  
  package body MLib.Tgt is
  
--- 29,46 ----
  
  with Ada.Characters.Handling; use Ada.Characters.Handling;
  
! with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  
  with MLib.Fil;
  with MLib.Utl;
! with Namet;    use Namet;
! with Opt;      use Opt;
! with Output;   use Output;
  with Prj.Com;
! 
! with System;           use System;
! with System.Case_Util; use System.Case_Util;
! with System.CRTL;      use System.CRTL;
  
  package body MLib.Tgt is
  
*************** package body MLib.Tgt is
*** 72,87 ****
     Link_With_Shared_Libgcc : Argument_List_Access :=
                                 No_Shared_Libgcc_Switch'Access;
  
-    ------------------------------
-    -- Target dependent section --
-    ------------------------------
- 
-    function Popen (Command, Mode : System.Address) return System.Address;
-    pragma Import (C, Popen, "decc$popen");
- 
-    function Pclose (File : System.Address) return Integer;
-    pragma Import (C, Pclose, "decc$pclose");
- 
     ---------------------
     -- Archive_Builder --
     ---------------------
--- 73,78 ----
*************** package body MLib.Tgt is
*** 168,175 ****
        --  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 --
--- 159,168 ----
        --  Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt"
  
        function Version_String return String;
!       --  Returns Lib_Version if not empty and if Symbol_Data.Symbol_Policy is
!       --  not Autonomous, otherwise returns "".
!       --  When Symbol_Data.Symbol_Policy is Autonomous, fails gnatmake if
!       --  Lib_Version is not the image of a positive number.
  
        ------------------
        -- Is_Interface --
*************** package body MLib.Tgt is
*** 223,230 ****
        function Version_String return String is
           Version : Integer := 0;
        begin
!          if Lib_Version = "" then
!             return "1";
  
           else
              begin
--- 216,225 ----
        function Version_String return String is
           Version : Integer := 0;
        begin
!          if Lib_Version = ""
!            or else Symbol_Data.Symbol_Policy /= Autonomous
!          then
!             return "";
  
           else
              begin
*************** package body MLib.Tgt is
*** 300,311 ****
              Len             : Natural;
              OK              : Boolean := True;
  
!             Command  : constant String :=
                           Macro_Name & " " & Macro_File_Name & ASCII.NUL;
              --  The command to invoke the assembler on the generated auto-init
              --  assembly file.
  
!             Mode : constant String := "r" & ASCII.NUL;
              --  The mode for the invocation of Popen
  
           begin
--- 295,306 ----
              Len             : Natural;
              OK              : Boolean := True;
  
!             command  : constant String :=
                           Macro_Name & " " & Macro_File_Name & ASCII.NUL;
              --  The command to invoke the assembler on the generated auto-init
              --  assembly file.
  
!             mode : constant String := "r" & ASCII.NUL;
              --  The mode for the invocation of Popen
  
           begin
*************** package body MLib.Tgt is
*** 398,405 ****
                 Write_Line ("""");
              end if;
  
!             Popen_Result := Popen (Command (Command'First)'Address,
!                                    Mode (Mode'First)'Address);
  
              if Popen_Result = Null_Address then
                 Fail ("assembly of auto-init assembly file """,
--- 393,400 ----
                 Write_Line ("""");
              end if;
  
!             Popen_Result := popen (command (command'First)'Address,
!                                    mode (mode'First)'Address);
  
              if Popen_Result = Null_Address then
                 Fail ("assembly of auto-init assembly file """,
*************** package body MLib.Tgt is
*** 408,414 ****
  
              --  Wait for the end of execution of the macro-assembler
  
!             Pclose_Result := Pclose (Popen_Result);
  
              if Pclose_Result < 0 then
                 Fail ("assembly of auto init assembly file """,
--- 403,409 ----
  
              --  Wait for the end of execution of the macro-assembler
  
!             Pclose_Result := pclose (Popen_Result);
  
              if Pclose_Result < 0 then
                 Fail ("assembly of auto init assembly file """,
*************** package body MLib.Tgt is
*** 577,582 ****
--- 572,586 ----
        return "exe";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 637,645 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Fail ("INTERNAL ERROR: Library_Exists_For called " &
                 "for non library project");
           return False;
--- 641,651 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Fail ("INTERNAL ERROR: Library_Exists_For called " &
                 "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 647,658 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 653,668 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 670,678 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 680,691 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 680,692 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 693,707 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt-vxworks.adb gcc-4.1.0/gcc/ada/mlib-tgt-vxworks.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt-vxworks.adb	Wed Oct 27 12:27:52 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt-vxworks.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2004 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2003-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body MLib.Tgt is
*** 134,139 ****
--- 134,148 ----
        return "";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 215,223 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
--- 224,234 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
                         "for non library project");
           return False;
*************** package body MLib.Tgt is
*** 225,236 ****
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
!             if Projects.Table (Project).Library_Kind = Static then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
--- 236,251 ----
        else
           declare
              Lib_Dir : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Dir);
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 return Is_Regular_File
                   (Lib_Dir & Directory_Separator & "lib" &
                    Fil.Ext_To (Lib_Name, Archive_Ext));
*************** package body MLib.Tgt is
*** 248,256 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
     begin
!       if not Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
--- 263,274 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
     begin
!       if not In_Tree.Projects.Table (Project).Library then
           Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
                         "for non library project");
           return No_Name;
*************** package body MLib.Tgt is
*** 258,270 ****
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String (Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if Projects.Table (Project).Library_Kind = Static then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
--- 276,291 ----
        else
           declare
              Lib_Name : constant String :=
!               Get_Name_String
!                 (In_Tree.Projects.Table (Project).Library_Name);
  
           begin
              Name_Len := 3;
              Name_Buffer (1 .. Name_Len) := "lib";
  
!             if In_Tree.Projects.Table (Project).Library_Kind =
!               Static
!             then
                 Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
  
              else
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt.adb gcc-4.1.0/gcc/ada/mlib-tgt.adb
*** gcc-4.0.2/gcc/ada/mlib-tgt.adb	Wed Oct 27 12:27:53 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt.adb	Tue Nov 15 13:51:50 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004, Ada Core Technologies, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body MLib.Tgt is
*** 120,125 ****
--- 120,134 ----
        return "";
     end DLL_Ext;
  
+    ----------------
+    -- DLL_Prefix --
+    ----------------
+ 
+    function DLL_Prefix return String is
+    begin
+       return "lib";
+    end DLL_Prefix;
+ 
     --------------------
     -- Dynamic_Option --
     --------------------
*************** package body MLib.Tgt is
*** 172,179 ****
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For (Project : Project_Id) return Boolean is
        pragma Unreferenced (Project);
     begin
        return False;
     end Library_Exists_For;
--- 181,191 ----
     -- Library_Exists_For --
     ------------------------
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
!    is
        pragma Unreferenced (Project);
+       pragma Unreferenced (In_Tree);
     begin
        return False;
     end Library_Exists_For;
*************** package body MLib.Tgt is
*** 182,189 ****
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id is
        pragma Unreferenced (Project);
     begin
        return No_Name;
     end Library_File_Name_For;
--- 194,205 ----
     -- Library_File_Name_For --
     ---------------------------
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id
!    is
        pragma Unreferenced (Project);
+       pragma Unreferenced (In_Tree);
     begin
        return No_Name;
     end Library_File_Name_For;
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-tgt.ads gcc-4.1.0/gcc/ada/mlib-tgt.ads
*** gcc-4.0.2/gcc/ada/mlib-tgt.ads	Wed Oct 27 12:27:53 2004
--- gcc-4.1.0/gcc/ada/mlib-tgt.ads	Tue Nov 15 13:51:50 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --              Copyright (C) 2001-2004, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,38 ****
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  There are several versions for the body of this package.
  
  --  In the default version, libraries are not supported, so function
  --  Support_For_Libraries return None.
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
  with Prj;         use Prj;
  
  package MLib.Tgt is
--- 27,37 ----
  --  This package provides a set of target dependent routines to build
  --  static, dynamic and shared libraries.
  
! --  There are several versions for the body of this package
  
  --  In the default version, libraries are not supported, so function
  --  Support_For_Libraries return None.
  
  with Prj;         use Prj;
  
  package MLib.Tgt is
*************** package MLib.Tgt is
*** 61,71 ****
     --  A list of options to invoke the Archive_Builder, usually "cr" for "ar"
  
     function Archive_Indexer return String;
!    --  Returns the name of the program, if any, that generates an index
!    --  to the contents of an archive, usually "ranlib".
  
     function Archive_Indexer_Options return String_List_Access;
!    --  A list of options to invoke the Archive_Indexer, usually empty.
  
     function Dynamic_Option return String;
     --  gcc option to create a dynamic library.
--- 60,71 ----
     --  A list of options to invoke the Archive_Builder, usually "cr" for "ar"
  
     function Archive_Indexer return String;
!    --  Returns the name of the program, if any, that generates an index to the
!    --  contents of an archive, usually "ranlib". If there is no archive indexer
!    --  to be used, returns an empty string.
  
     function Archive_Indexer_Options return String_List_Access;
!    --  A list of options to invoke the Archive_Indexer, usually empty
  
     function Dynamic_Option return String;
     --  gcc option to create a dynamic library.
*************** package MLib.Tgt is
*** 82,87 ****
--- 82,91 ----
     --  System dependent object extension, without leadien dot.
     --  On Unix, returns "o".
  
+    function DLL_Prefix return String;
+    --  System dependent dynamic library prefix.
+    --  On Windows, returns "". On other platforms, returns "lib".
+ 
     function DLL_Ext return String;
     --  System dependent dynamic library extension, without leading dot.
     --  On Windows, returns "dll". On Unix, usually returns "so", but not
*************** package MLib.Tgt is
*** 147,157 ****
     --  into account. For example, on Linux, Foreign, Afiles Lib_Address and
     --  Relocatable are ignored.
  
!    function Library_Exists_For (Project : Project_Id) return Boolean;
     --  Return True if the library file for a library project already exists.
     --  This function can only be called for library projects.
  
!    function Library_File_Name_For (Project : Project_Id) return Name_Id;
     --  Returns the file name of the library file of a library project.
     --  This function can only be called for library projects.
  
--- 151,164 ----
     --  into account. For example, on Linux, Foreign, Afiles Lib_Address and
     --  Relocatable are ignored.
  
!    function Library_Exists_For
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean;
     --  Return True if the library file for a library project already exists.
     --  This function can only be called for library projects.
  
!    function Library_File_Name_For
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return Name_Id;
     --  Returns the file name of the library file of a library project.
     --  This function can only be called for library projects.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-utl.adb gcc-4.1.0/gcc/ada/mlib-utl.adb
*** gcc-4.0.2/gcc/ada/mlib-utl.adb	Wed Oct 27 12:27:53 2004
--- gcc-4.1.0/gcc/ada/mlib-utl.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --              Copyright (C) 2002-2004, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib-utl.ads gcc-4.1.0/gcc/ada/mlib-utl.ads
*** gcc-4.0.2/gcc/ada/mlib-utl.ads	Mon Oct  4 14:53:51 2004
--- gcc-4.1.0/gcc/ada/mlib-utl.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2001-2004, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,37 ****
  
  package MLib.Utl is
  
-    No_Argument_List : constant Argument_List := (1 .. 0 => null);
-    --  Comment needed ???
- 
     procedure Delete_File (Filename : in String);
     --  Delete the file Filename
     --  Why is this different from the standard OS_Lib routine???
--- 29,34 ----
*************** package MLib.Utl is
*** 43,60 ****
        Options_2   : Argument_List;
        Driver_Name : Name_Id := No_Name);
     --  Driver_Name indicates the "driver" to invoke; by default, the "driver"
!    --  is gcc.
!    --  This procedure invokes the driver to create a shared library.
     --  Options are passed to gcc before the objects, Options_2 after.
!    --  Output_File is the name of the library file to create.
!    --  Objects are the names of the object files to put in the library.
  
     procedure Ar
       (Output_File : String;
        Objects     : Argument_List);
!    --  Run ar to move all the binaries inside the archive.
!    --  If ranlib is on the path, run it also.
!    --  Arguments need documenting ???
  
     function Lib_Directory return String;
     --  Return the directory containing libgnat
--- 40,57 ----
        Options_2   : Argument_List;
        Driver_Name : Name_Id := No_Name);
     --  Driver_Name indicates the "driver" to invoke; by default, the "driver"
!    --  is gcc. This procedure invokes the driver to create a shared library.
     --  Options are passed to gcc before the objects, Options_2 after.
!    --  Output_File is the name of the library file to create. Objects are the
!    --  names of the object files to put in the library.
  
     procedure Ar
       (Output_File : String;
        Objects     : Argument_List);
!    --  Run ar to move all the binaries inside the archive. If ranlib is on the
!    --  path, run it also. Output_File is the path name of the archive to
!    --  create. Objects is the list of the path names of the object files to be
!    --  put in the archive.
  
     function Lib_Directory return String;
     --  Return the directory containing libgnat
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib.adb gcc-4.1.0/gcc/ada/mlib.adb
*** gcc-4.0.2/gcc/ada/mlib.adb	Thu Feb 10 13:50:33 2005
--- gcc-4.1.0/gcc/ada/mlib.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2005, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Namet;  use Namet;
*** 34,41 ****
  
  with MLib.Utl; use MLib.Utl;
  
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
- with GNAT.OS_Lib;               use GNAT.OS_Lib;
  
  package body MLib is
  
--- 34,42 ----
  
  with MLib.Utl; use MLib.Utl;
  
+ with Prj.Com;
+ 
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  
  package body MLib is
  
*************** package body MLib is
*** 51,58 ****
     is
        pragma Warnings (Off, Afiles);
  
-       use GNAT.OS_Lib;
- 
     begin
        if not Opt.Quiet_Output then
           Write_Line ("building a library...");
--- 52,57 ----
*************** package body MLib is
*** 70,93 ****
     procedure Check_Library_Name (Name : String) is
     begin
        if Name'Length = 0 then
!          Fail ("library name cannot be empty");
        end if;
  
        if Name'Length > Max_Characters_In_Library_Name then
!          Fail ("illegal library name """, Name, """: too long");
        end if;
  
        if not Is_Letter (Name (Name'First)) then
!          Fail ("illegal library name """,
!                Name,
!                """: should start with a letter");
        end if;
  
        for Index in Name'Range loop
           if not Is_Alphanumeric (Name (Index)) then
!             Fail ("illegal library name """,
!                   Name,
!                   """: should include only letters and digits");
           end if;
        end loop;
     end Check_Library_Name;
--- 69,92 ----
     procedure Check_Library_Name (Name : String) is
     begin
        if Name'Length = 0 then
!          Prj.Com.Fail ("library name cannot be empty");
        end if;
  
        if Name'Length > Max_Characters_In_Library_Name then
!          Prj.Com.Fail ("illegal library name """, Name, """: too long");
        end if;
  
        if not Is_Letter (Name (Name'First)) then
!          Prj.Com.Fail ("illegal library name """,
!                        Name,
!                        """: should start with a letter");
        end if;
  
        for Index in Name'Range loop
           if not Is_Alphanumeric (Name (Index)) then
!             Prj.Com.Fail ("illegal library name """,
!                           Name,
!                           """: should include only letters and digits");
           end if;
        end loop;
     end Check_Library_Name;
*************** package body MLib is
*** 276,282 ****
              end;
  
              if not Success then
!                Fail ("could not copy ALI files to library dir");
              end if;
           end loop;
        end if;
--- 275,281 ----
              end;
  
              if not Success then
!                Prj.Com.Fail ("could not copy ALI files to library dir");
              end if;
           end loop;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/mlib.ads gcc-4.1.0/gcc/ada/mlib.ads
*** gcc-4.0.2/gcc/ada/mlib.ads	Mon Apr 19 15:20:01 2004
--- gcc-4.1.0/gcc/ada/mlib.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1999-2004, Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/namet.adb gcc-4.1.0/gcc/ada/namet.adb
*** gcc-4.0.2/gcc/ada/namet.adb	Thu Feb 10 13:50:27 2005
--- gcc-4.1.0/gcc/ada/namet.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,41 ****
--- 36,42 ----
  --  which is created manually from namet.ads and namet.adb.
  
  with Debug;    use Debug;
+ with Opt;      use Opt;
  with Output;   use Output;
  with Tree_IO;  use Tree_IO;
  with Widechar; use Widechar;
*************** package body Namet is
*** 119,125 ****
        end loop;
     end Add_Str_To_Name_Buffer;
  
- 
     --------------
     -- Finalize --
     --------------
--- 120,125 ----
*************** package body Namet is
*** 299,305 ****
                and then Name_Buffer (Old + 1) /= '_'
              then
                 Old := Old + 1;
!                Insert_Character (Character'Val (Hex (2)));
  
              --  WW (wide wide character insertion)
  
--- 299,317 ----
                and then Name_Buffer (Old + 1) /= '_'
              then
                 Old := Old + 1;
! 
!                --  If we have upper half encoding, then we have to set an
!                --  appropriate wide character sequence for this character.
! 
!                if Upper_Half_Encoding then
!                   Widechar.Set_Wide (Char_Code (Hex (2)), New_Buf, New_Len);
! 
!                   --  For other encoding methods, upper half characters can
!                   --  simply use their normal representation.
! 
!                else
!                   Insert_Character (Character'Val (Hex (2)));
!                end if;
  
              --  WW (wide wide character insertion)
  
diff -Nrcpad gcc-4.0.2/gcc/ada/namet.ads gcc-4.1.0/gcc/ada/namet.ads
*** gcc-4.0.2/gcc/ada/namet.ads	Thu Feb 10 13:50:27 2005
--- gcc-4.1.0/gcc/ada/namet.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Namet is
*** 61,67 ****
  --                       followed by an upper case letter (other than the WW
  --                       sequence), or an underscore.
  
- 
  --    Operator symbols   Stored with an initial letter O, and the remainder
  --                       of the name is the lower case characters XXX where
  --                       the name is Name_Op_XXX, see Snames spec for a full
--- 61,66 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/namet.h gcc-4.1.0/gcc/ada/namet.h
*** gcc-4.0.2/gcc/ada/namet.h	Fri Oct 24 02:28:37 2003
--- gcc-4.1.0/gcc/ada/namet.h	Tue Nov 15 14:00:59 2005
***************
*** 6,12 ****
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-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- *
--- 6,12 ----
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1992-2005 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
*************** extern Boolean Is_Non_Ada_Error (Entity_
*** 111,125 ****
--- 111,130 ----
  /* Here are some functions in sinput.adb we call from a-trans.c.  */
  typedef Nat Source_File_Index;
  typedef Int Logical_Line_Number;
+ typedef Int Column_Number;
  
  #define Debug_Source_Name sinput__debug_source_name
  #define Full_Debug_Name sinput__full_debug_name
  #define Reference_Name sinput__reference_name
  #define Get_Source_File_Index sinput__get_source_file_index
  #define Get_Logical_Line_Number sinput__get_logical_line_number
+ #define Get_Column_Number sinput__get_column_number
+ #define Instantiation sinput__instantiation
  
  extern File_Name_Type Debug_Source_Name	(Source_File_Index);
  extern File_Name_Type Full_Debug_Name	(Source_File_Index);
  extern File_Name_Type Reference_Name	(Source_File_Index);
  extern Source_File_Index Get_Source_File_Index (Source_Ptr);
  extern Logical_Line_Number Get_Logical_Line_Number (Source_Ptr);
+ extern Column_Number Get_Column_Number (Source_Ptr);
+ extern Source_Ptr Instantiation (Source_File_Index);
diff -Nrcpad gcc-4.0.2/gcc/ada/nlists.adb gcc-4.1.0/gcc/ada/nlists.adb
*** gcc-4.0.2/gcc/ada/nlists.adb	Wed Dec  8 11:48:04 2004
--- gcc-4.1.0/gcc/ada/nlists.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/nlists.ads gcc-4.1.0/gcc/ada/nlists.ads
*** gcc-4.0.2/gcc/ada/nlists.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/nlists.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/nlists.h gcc-4.1.0/gcc/ada/nlists.h
*** gcc-4.0.2/gcc/ada/nlists.h	Fri Oct 24 13:02:42 2003
--- gcc-4.1.0/gcc/ada/nlists.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/nmake.adt gcc-4.1.0/gcc/ada/nmake.adt
*** gcc-4.0.2/gcc/ada/nmake.adt	Tue Oct 21 13:42:10 2003
--- gcc-4.1.0/gcc/ada/nmake.adt	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                             T e m p l a t e                              --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                             T e m p l a t e                              --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,38 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
- 
- pragma Style_Checks (All_Checks);
- --  Turn off subprogram order checking, since the routines here are
- --  generated automatically in order.
- 
  --  This file is a template used as input to the utility program XNmake,
  --  which reads this template, and the spec of Sinfo (sinfo.ads) and
  --  generates the body and/or the spec for the Nmake package (files
  --  nmake.ads and nmake.adb)
  
  with Atree;  use Atree;       --  body only
  with Nlists; use Nlists;      --  spec only
  with Sinfo;  use Sinfo;       --  body only
--- 16,37 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  --  This file is a template used as input to the utility program XNmake,
  --  which reads this template, and the spec of Sinfo (sinfo.ads) and
  --  generates the body and/or the spec for the Nmake package (files
  --  nmake.ads and nmake.adb)
  
+ pragma Style_Checks (All_Checks);
+ --  Turn off subprogram order checking, since the routines here are
+ --  generated automatically in order.
+ 
  with Atree;  use Atree;       --  body only
  with Nlists; use Nlists;      --  spec only
  with Sinfo;  use Sinfo;       --  body only
diff -Nrcpad gcc-4.0.2/gcc/ada/opt.adb gcc-4.1.0/gcc/ada/opt.adb
*** gcc-4.0.2/gcc/ada/opt.adb	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/opt.adb	Mon Sep  5 07:56:02 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Gnatvsn; use Gnatvsn;
  with System;  use System;
  with Tree_IO; use Tree_IO;
  
--- 31,36 ----
*************** package body Opt is
*** 50,60 ****
--- 49,63 ----
     procedure Register_Opt_Config_Switches is
     begin
        Ada_Version_Config                    := Ada_Version;
+       Ada_Version_Explicit_Config           := Ada_Version_Explicit;
+       Assertions_Enabled_Config             := Assertions_Enabled;
+       Debug_Pragmas_Enabled_Config          := Debug_Pragmas_Enabled;
        Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
        Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
        Extensions_Allowed_Config             := Extensions_Allowed;
        External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
        External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
+       Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
        Polling_Required_Config               := Polling_Required;
        Use_VADS_Size_Config                  := Use_VADS_Size;
     end Register_Opt_Config_Switches;
*************** package body Opt is
*** 66,76 ****
--- 69,83 ----
     procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
     begin
        Ada_Version                    := Save.Ada_Version;
+       Ada_Version_Explicit           := Save.Ada_Version_Explicit;
+       Assertions_Enabled             := Save.Assertions_Enabled;
+       Debug_Pragmas_Enabled          := Save.Debug_Pragmas_Enabled;
        Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
        Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
        Extensions_Allowed             := Save.Extensions_Allowed;
        External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
        External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
+       Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
        Polling_Required               := Save.Polling_Required;
        Use_VADS_Size                  := Save.Use_VADS_Size;
     end Restore_Opt_Config_Switches;
*************** package body Opt is
*** 82,92 ****
--- 89,103 ----
     procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
     begin
        Save.Ada_Version                    := Ada_Version;
+       Save.Ada_Version_Explicit           := Ada_Version_Explicit;
+       Save.Assertions_Enabled             := Assertions_Enabled;
+       Save.Debug_Pragmas_Enabled          := Debug_Pragmas_Enabled;
        Save.Dynamic_Elaboration_Checks     := Dynamic_Elaboration_Checks;
        Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
        Save.Extensions_Allowed             := Extensions_Allowed;
        Save.External_Name_Exp_Casing       := External_Name_Exp_Casing;
        Save.External_Name_Imp_Casing       := External_Name_Imp_Casing;
+       Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
        Save.Polling_Required               := Polling_Required;
        Save.Use_VADS_Size                  := Use_VADS_Size;
     end Save_Opt_Config_Switches;
*************** package body Opt is
*** 95,121 ****
     -- Set_Opt_Config_Switches --
     -----------------------------
  
!    procedure Set_Opt_Config_Switches (Internal_Unit : Boolean) is
     begin
        if Internal_Unit then
           Ada_Version                := Ada_Version_Runtime;
           Dynamic_Elaboration_Checks := False;
           Extensions_Allowed         := True;
           External_Name_Exp_Casing   := As_Is;
           External_Name_Imp_Casing   := Lowercase;
           Use_VADS_Size              := False;
  
        else
           Ada_Version                := Ada_Version_Config;
           Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
           Extensions_Allowed         := Extensions_Allowed_Config;
           External_Name_Exp_Casing   := External_Name_Exp_Casing_Config;
           External_Name_Imp_Casing   := External_Name_Imp_Casing_Config;
           Use_VADS_Size              := Use_VADS_Size_Config;
        end if;
  
        Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
        Polling_Required               := Polling_Required_Config;
     end Set_Opt_Config_Switches;
  
     ---------------
--- 106,155 ----
     -- Set_Opt_Config_Switches --
     -----------------------------
  
!    procedure Set_Opt_Config_Switches
!      (Internal_Unit : Boolean;
!       Main_Unit     : Boolean)
!    is
     begin
+       --  Case of internal unit
+ 
        if Internal_Unit then
           Ada_Version                := Ada_Version_Runtime;
           Dynamic_Elaboration_Checks := False;
           Extensions_Allowed         := True;
           External_Name_Exp_Casing   := As_Is;
           External_Name_Imp_Casing   := Lowercase;
+          Persistent_BSS_Mode        := False;
           Use_VADS_Size              := False;
  
+          --  For an internal unit, assertions/debug pragmas are off unless this
+          --  is the main unit and they were explicitly enabled.
+ 
+          if Main_Unit then
+             Assertions_Enabled := Assertions_Enabled_Config;
+             Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
+          else
+             Assertions_Enabled := False;
+             Debug_Pragmas_Enabled := False;
+          end if;
+ 
+       --  Case of non-internal unit
+ 
        else
           Ada_Version                := Ada_Version_Config;
+          Assertions_Enabled         := Assertions_Enabled_Config;
+          Debug_Pragmas_Enabled      := Debug_Pragmas_Enabled_Config;
           Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
           Extensions_Allowed         := Extensions_Allowed_Config;
           External_Name_Exp_Casing   := External_Name_Exp_Casing_Config;
           External_Name_Imp_Casing   := External_Name_Imp_Casing_Config;
+          Persistent_BSS_Mode        := Persistent_BSS_Mode_Config;
           Use_VADS_Size              := Use_VADS_Size_Config;
        end if;
  
        Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
        Polling_Required               := Polling_Required_Config;
+       Ada_Version_Explicit           := Ada_Version_Explicit_Config;
     end Set_Opt_Config_Switches;
  
     ---------------
*************** package body Opt is
*** 123,130 ****
     ---------------
  
     procedure Tree_Read is
!       Tree_Version_String_Len : Nat;
!       Ada_Version_Config_Val  : Nat;
  
     begin
        Tree_Read_Int  (Tree_ASIS_Version_Number);
--- 157,166 ----
     ---------------
  
     procedure Tree_Read is
!       Tree_Version_String_Len         : Nat;
!       Ada_Version_Config_Val          : Nat;
!       Ada_Version_Explicit_Config_Val : Nat;
!       Assertions_Enabled_Config_Val   : Nat;
  
     begin
        Tree_Read_Int  (Tree_ASIS_Version_Number);
*************** package body Opt is
*** 138,149 ****
        Tree_Read_Data (Warning_Mode'Address,
                        Warning_Mode_Type'Object_Size / Storage_Unit);
        Tree_Read_Int  (Ada_Version_Config_Val);
        Tree_Read_Bool (All_Errors_Mode);
        Tree_Read_Bool (Assertions_Enabled);
        Tree_Read_Bool (Enable_Overflow_Checks);
        Tree_Read_Bool (Full_List);
  
!       Ada_Version_Config := Ada_Version_Type'Val (Ada_Version_Config_Val);
  
        --  Read version string: we have to check the length first
  
--- 174,193 ----
        Tree_Read_Data (Warning_Mode'Address,
                        Warning_Mode_Type'Object_Size / Storage_Unit);
        Tree_Read_Int  (Ada_Version_Config_Val);
+       Tree_Read_Int  (Ada_Version_Explicit_Config_Val);
+       Tree_Read_Int  (Assertions_Enabled_Config_Val);
        Tree_Read_Bool (All_Errors_Mode);
        Tree_Read_Bool (Assertions_Enabled);
+       Tree_Read_Bool (Debug_Pragmas_Enabled);
        Tree_Read_Bool (Enable_Overflow_Checks);
        Tree_Read_Bool (Full_List);
  
!       Ada_Version_Config :=
!         Ada_Version_Type'Val (Ada_Version_Config_Val);
!       Ada_Version_Explicit_Config :=
!         Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
!       Assertions_Enabled_Config :=
!         Boolean'Val (Assertions_Enabled_Config_Val);
  
        --  Read version string: we have to check the length first
  
*************** package body Opt is
*** 199,206 ****
--- 243,253 ----
        Tree_Write_Data (Warning_Mode'Address,
                         Warning_Mode_Type'Object_Size / Storage_Unit);
        Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Config));
+       Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
+       Tree_Write_Int  (Boolean'Pos (Assertions_Enabled_Config));
        Tree_Write_Bool (All_Errors_Mode);
        Tree_Write_Bool (Assertions_Enabled);
+       Tree_Write_Bool (Debug_Pragmas_Enabled);
        Tree_Write_Bool (Enable_Overflow_Checks);
        Tree_Write_Bool (Full_List);
        Tree_Write_Int  (Int (Version_String'Length));
diff -Nrcpad gcc-4.0.2/gcc/ada/opt.ads gcc-4.1.0/gcc/ada/opt.ads
*** gcc-4.0.2/gcc/ada/opt.ads	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/opt.ads	Tue Nov 15 13:59:30 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,40 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains global flags set by the initialization
! --  routine from the command line and referenced throughout the compiler,
! --  the binder, gnatmake or other GNAT tools. The comments indicate which
! --  options are used by which programs (GNAT, GNATBIND, GNATMAKE, etc).
  
  with Gnatvsn;  use Gnatvsn;
  with Hostparm; use Hostparm;
--- 31,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains global flags set by the initialization routine from
! --  the command line and referenced throughout the compiler, the binder, or
! --  other GNAT tools. The comments indicate which options are used by which
! --  programs (GNAT, GNATBIND, GNATLINK, GNATMAKE, GPRMAKE, etc).
  
  with Gnatvsn;  use Gnatvsn;
  with Hostparm; use Hostparm;
*************** package Opt is
*** 61,68 ****
--- 61,72 ----
     --  Set True if binder file to be generated in Ada rather than C
  
     type Ada_Version_Type is (Ada_83, Ada_95, Ada_05);
+    pragma Warnings (Off, Ada_Version_Type);
     --  Versions of Ada for Ada_Version below. Note that these are ordered,
     --  so that tests like Ada_Version >= Ada_95 are legitimate and useful.
+    --  The Warnings_Off pragma stops warnings for Ada_Version >= Ada_05,
+    --  which we want to allow, so that things work OK when Ada_15 is added!
+    --  This warning is now removed, so this pragma can be removed some time???
  
     Ada_Version_Default : Ada_Version_Type := Ada_95;
     --  GNAT
*************** package Opt is
*** 70,80 ****
  
     Ada_Version : Ada_Version_Type := Ada_Version_Default;
     --  GNAT
!    --  Current Ada version for compiler
  
     Ada_Version_Runtime : Ada_Version_Type := Ada_05;
     --  GNAT
!    --  Ada version used to compile the runtime
  
     Ada_Final_Suffix : constant String := "final";
     Ada_Final_Name : String_Ptr := new String'("ada" & Ada_Final_Suffix);
--- 74,96 ----
  
     Ada_Version : Ada_Version_Type := Ada_Version_Default;
     --  GNAT
!    --  Current Ada version for compiler, as set by configuration pragmas,
!    --  compiler switches, or implicitly (to Ada_Version_Runtime) when a
!    --  predefined or internal file is compiled.
! 
!    Ada_Version_Explicit : Ada_Version_Type := Ada_Version_Default;
!    --  GNAT
!    --  Like Ada_Version, but does not get set implicitly for predefined
!    --  or internal units, so it reflects the Ada version explicitly set
!    --  using configuration pragmas or compiler switches (or if neither
!    --  appears, it remains set to Ada_Version_Default). This is used in
!    --  the rare cases (notably for pragmas Preelaborate_05 and Pure_05)
!    --  where in the run-time we want the explicit version set.
  
     Ada_Version_Runtime : Ada_Version_Type := Ada_05;
     --  GNAT
!    --  Ada version used to compile the runtime. Used to set Ada_Version (but
!    --  not Ada_Version_Explicit) when compiling predefined or internal units.
  
     Ada_Final_Suffix : constant String := "final";
     Ada_Final_Name : String_Ptr := new String'("ada" & Ada_Final_Suffix);
*************** package Opt is
*** 104,109 ****
--- 120,129 ----
     --  GNAT
     --  Set False to disable address clause warnings
  
+    Address_Is_Private : Boolean := False;
+    --  GNAT, GNATBIND
+    --  Set True if package System has the line "type Address is private;"
+ 
     All_Errors_Mode : Boolean := False;
     --  GNAT
     --  Flag set to force display of multiple errors on a single line and
*************** package Opt is
*** 122,128 ****
  
     Assertions_Enabled : Boolean := False;
     --  GNAT
!    --  Enable assertions made using pragma Assert.
  
     ASIS_Mode : Boolean := False;
     --  GNAT
--- 142,148 ----
  
     Assertions_Enabled : Boolean := False;
     --  GNAT
!    --  Enable assertions made using pragma Assert
  
     ASIS_Mode : Boolean := False;
     --  GNAT
*************** package Opt is
*** 132,138 ****
     --  it ON. It is set ON when Tree_Output is set ON, it can also be set ON
     --  from the code of GNSA-based tool (a client may need to set ON the
     --  Back_Annotate_Rep_Info flag in this case. At the moment this does not
!    --  make very much sense, because GNSA can not do back annotation).
  
     Back_Annotate_Rep_Info : Boolean := False;
     --  GNAT
--- 152,158 ----
     --  it ON. It is set ON when Tree_Output is set ON, it can also be set ON
     --  from the code of GNSA-based tool (a client may need to set ON the
     --  Back_Annotate_Rep_Info flag in this case. At the moment this does not
!    --  make very much sense, because GNSA cannot do back annotation).
  
     Back_Annotate_Rep_Info : Boolean := False;
     --  GNAT
*************** package Opt is
*** 149,155 ****
  
     Bind_Main_Program : Boolean := True;
     --  GNATBIND
!    --  Set to False if not binding main Ada program.
  
     Bind_For_Library : Boolean := False;
     --  GNATBIND
--- 169,175 ----
  
     Bind_Main_Program : Boolean := True;
     --  GNATBIND
!    --  Set to False if not binding main Ada program
  
     Bind_For_Library : Boolean := False;
     --  GNATBIND
*************** package Opt is
*** 157,163 ****
     --  building a library. May be set to True by Gnatbind.Scan_Bind_Arg.
  
     Bind_Only : Boolean := False;
!    --  GNATMAKE
     --  Set to True to skip compile and link steps
     --  (except when Compile_Only and/or Link_Only are True).
  
--- 177,183 ----
     --  building a library. May be set to True by Gnatbind.Scan_Bind_Arg.
  
     Bind_Only : Boolean := False;
!    --  GNATMAKE, GPRMAKE
     --  Set to True to skip compile and link steps
     --  (except when Compile_Only and/or Link_Only are True).
  
*************** package Opt is
*** 188,198 ****
  
     Check_Only : Boolean := False;
     --  GNATBIND
!    --  Set to True to do checks only, no output of binder file.
  
     Check_Readonly_Files : Boolean := False;
     --  GNATMAKE
!    --  Set to True to check readonly files during the make process.
  
     Check_Source_Files : Boolean := True;
     --  GNATBIND, GNATMAKE
--- 208,218 ----
  
     Check_Only : Boolean := False;
     --  GNATBIND
!    --  Set to True to do checks only, no output of binder file
  
     Check_Readonly_Files : Boolean := False;
     --  GNATMAKE
!    --  Set to True to check readonly files during the make process
  
     Check_Source_Files : Boolean := True;
     --  GNATBIND, GNATMAKE
*************** package Opt is
*** 202,209 ****
     --  directly modified by gnatmake, to affect the shared binder routines.
  
     Check_Switches : Boolean := False;
!    --  GNATMAKE
!    --  Set to True to check compiler options during the make process.
  
     Check_Unreferenced : Boolean := False;
     --  GNAT
--- 222,229 ----
     --  directly modified by gnatmake, to affect the shared binder routines.
  
     Check_Switches : Boolean := False;
!    --  GNATMAKE, GPRMAKE
!    --  Set to True to check compiler options during the make process
  
     Check_Unreferenced : Boolean := False;
     --  GNAT
*************** package Opt is
*** 212,219 ****
  
     Check_Unreferenced_Formals : Boolean := False;
     --  GNAT
!    --  Set True to check for unreferenced formals. This is turned
!    --  on by -gnatwa/wf/wu and turned off by -gnatwA/wF/wU.
  
     Check_Withs : Boolean := False;
     --  GNAT
--- 232,239 ----
  
     Check_Unreferenced_Formals : Boolean := False;
     --  GNAT
!    --  Set True to check for unreferenced formals. This is turned on by
!    --  -gnatwa/wf/wu and turned off by -gnatwA/wF/wU.
  
     Check_Withs : Boolean := False;
     --  GNAT
*************** package Opt is
*** 226,234 ****
     --  in the output file.
  
     Compile_Only : Boolean := False;
!    --  GNATMAKE, GNATCLEAN
!    --  GNATMAKE: set to True to skip bind and link steps (except when
!    --            Bind_Only is True).
     --  GNATCLEAN: set to True to only the files produced by the compiler are to
     --             be deleted, but not the library files or executable files.
  
--- 246,254 ----
     --  in the output file.
  
     Compile_Only : Boolean := False;
!    --  GNATMAKE, GNATCLEAN, GPRMAKE
!    --  GNATMAKE, GPRMAKE: set to True to skip bind and link steps (except when
!    --                     Bind_Only is True).
     --  GNATCLEAN: set to True to only the files produced by the compiler are to
     --             be deleted, but not the library files or executable files.
  
*************** package Opt is
*** 252,260 ****
     --  Set to True to activate warnings on constant conditions
  
     Create_Mapping_File : Boolean := False;
!    --  GNATMAKE
!    --  Set to True (-C switch) to indicate that gnatmake will invoke
!    --  the compiler with a mapping file (-gnatem compiler switch).
  
     subtype Debug_Level_Value is Nat range 0 .. 3;
     Debugger_Level : Debug_Level_Value := 0;
--- 272,284 ----
     --  Set to True to activate warnings on constant conditions
  
     Create_Mapping_File : Boolean := False;
!    --  GNATMAKE, GPRMAKE
!    --  Set to True (-C switch) to indicate that the compiler will be invoked
!    --  with a mapping file (-gnatem compiler switch).
! 
!    Debug_Pragmas_Enabled : Boolean := False;
!    --  GNAT
!    --  Enable debug statements from pragma Debug
  
     subtype Debug_Level_Value is Nat range 0 .. 3;
     Debugger_Level : Debug_Level_Value := 0;
*************** package Opt is
*** 289,295 ****
     --  potentially blocking operations are detected from protected actions.
  
     Display_Compilation_Progress : Boolean := False;
!    --  GNATMAKE
     --  Set True (-d switch) to display information on progress while compiling
     --  files. Internal flag to be used in conjunction with an IDE (e.g GPS).
  
--- 313,319 ----
     --  potentially blocking operations are detected from protected actions.
  
     Display_Compilation_Progress : Boolean := False;
!    --  GNATMAKE, GPRMAKE
     --  Set True (-d switch) to display information on progress while compiling
     --  files. Internal flag to be used in conjunction with an IDE (e.g GPS).
  
*************** package Opt is
*** 351,381 ****
        --  the code generator). AT END handlers are converted into
        --  exception handlers by the front end in this mode.
  
!       Front_End_ZCX_Exceptions,
!       --  Exceptions use the zero cost table mechanism with explicit
!       --  tables and exception regions generated by the front end.
!       --  AT END handlers are converted into exception handlers by
!       --  the front end in this mode.
! 
!       Back_End_ZCX_Exceptions);
        --  Exceptions are handled by the back end. The front end simply
        --  generates the handlers as they appear in the source, and AT
        --  END handlers are left untouched (they are not converted into
!       --  exception handlers when operating in this mode. Note that the
!       --  name includes ZCX, since the expectation is that the back end
!       --  mechanism will in fact be a ZCX approach, but nothing in the
!       --  compiler depends on this, so for example if GNAT is run with
!       --  a version of GCC configured for setjmp/longjmp exception handling,
!       --  then everything will work fine.
     pragma Convention (C, Exception_Mechanism_Type);
  
     Exception_Mechanism : Exception_Mechanism_Type :=
                             Front_End_Setjmp_Longjmp_Exceptions;
     --  GNAT
     --  Set to the appropriate value depending on the default as given in
!    --  system.ads (ZCX_By_Default, GCC_ZCX_Support, Front_End_ZCX_Support)
!    --  and the use of -gnatL -gnatZ (and -gnatdX). The C convention is
!    --  there to make this variable accessible to gigi.
  
     Exception_Tracebacks : Boolean := False;
     --  GNATBIND
--- 375,393 ----
        --  the code generator). AT END handlers are converted into
        --  exception handlers by the front end in this mode.
  
!       Back_End_Exceptions);
        --  Exceptions are handled by the back end. The front end simply
        --  generates the handlers as they appear in the source, and AT
        --  END handlers are left untouched (they are not converted into
!       --  exception handlers when operating in this mode.
     pragma Convention (C, Exception_Mechanism_Type);
  
     Exception_Mechanism : Exception_Mechanism_Type :=
                             Front_End_Setjmp_Longjmp_Exceptions;
     --  GNAT
     --  Set to the appropriate value depending on the default as given in
!    --  system.ads (ZCX_By_Default, GCC_ZCX_Support).
!    --  The C convention is there to make this variable accessible to gigi.
  
     Exception_Tracebacks : Boolean := False;
     --  GNATBIND
*************** package Opt is
*** 443,460 ****
     --  (-F switch set).
  
     Force_Compilations : Boolean := False;
!    --  GNATMAKE
     --  Set to force recompilations even when the objects are up-to-date.
  
-    Force_RM_Elaboration_Order : Boolean := False;
-    --  GNATBIND
-    --  True if binding with forced RM elaboration order (-f switch set)
-    --  Note: this is considered an obsolescent option, to be removed in
-    --  some future release. It is no longer documented. The proper way
-    --  to get this effect is to use -gnatE and suppress elab checks.
- 
     Full_Path_Name_For_Brief_Errors : Boolean := False;
!    --  GNAT, GNATMAKE, GNATCLEAN
     --  When True, in Brief_Output mode, each error message line
     --  will start with the full path name of the source.
     --  When False, only the file name without directory information
--- 455,465 ----
     --  (-F switch set).
  
     Force_Compilations : Boolean := False;
!    --  GNATMAKE, GPRMAKE
     --  Set to force recompilations even when the objects are up-to-date.
  
     Full_Path_Name_For_Brief_Errors : Boolean := False;
!    --  GNAT, GNATMAKE, GNATCLEAN, GPRMAKE
     --  When True, in Brief_Output mode, each error message line
     --  will start with the full path name of the source.
     --  When False, only the file name without directory information
*************** package Opt is
*** 469,475 ****
  
     GCC_Version : constant Nat := get_gcc_version;
     --  GNATMAKE
!    --  Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x).
  
     Global_Discard_Names : Boolean := False;
     --  GNAT, GNATBIND
--- 474,480 ----
  
     GCC_Version : constant Nat := get_gcc_version;
     --  GNATMAKE
!    --  Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x)
  
     Global_Discard_Names : Boolean := False;
     --  GNAT, GNATBIND
*************** package Opt is
*** 550,556 ****
  
     Front_End_Inlining : Boolean := False;
     --  GNAT
!    --  Set True to activate inlining by front-end expansion.
  
     Inline_Processing_Required : Boolean := False;
     --  GNAT
--- 555,561 ----
  
     Front_End_Inlining : Boolean := False;
     --  GNAT
!    --  Set True to activate inlining by front-end expansion
  
     Inline_Processing_Required : Boolean := False;
     --  GNAT
*************** package Opt is
*** 565,572 ****
     --  if not.
  
     Keep_Going : Boolean := False;
!    --  GNATMAKE
!    --  When True signals gnatmake to ignore compilation errors and keep
     --  processing sources until there is no more work.
  
     Keep_Temporary_Files : Boolean := False;
--- 570,577 ----
     --  if not.
  
     Keep_Going : Boolean := False;
!    --  GNATMAKE, GPRMAKE
!    --  When True signals to ignore compilation errors and keep
     --  processing sources until there is no more work.
  
     Keep_Temporary_Files : Boolean := False;
*************** package Opt is
*** 575,581 ****
     --  deleted. Set by switch -dn or qualifier /KEEP_TEMPORARY_FILES.
  
     Link_Only : Boolean := False;
!    --  GNATMAKE
     --  Set to True to skip compile and bind steps
     --  (except when Bind_Only is set to True).
  
--- 580,586 ----
     --  deleted. Set by switch -dn or qualifier /KEEP_TEMPORARY_FILES.
  
     Link_Only : Boolean := False;
!    --  GNATMAKE, GPRMAKE
     --  Set to True to skip compile and bind steps
     --  (except when Bind_Only is set to True).
  
*************** package Opt is
*** 692,704 ****
     --  Column_Number'Last during scanning of configuration pragma files.
  
     Maximum_Processes : Positive := 1;
!    --  GNATMAKE
     --  Maximum number of processes that should be spawned to carry out
     --  compilations.
  
     Minimal_Recompilation : Boolean := False;
     --  GNATMAKE
!    --  Set to True if minimal recompilation mode requested.
  
     Multiple_Unit_Index : Int;
     --  GNAT
--- 697,709 ----
     --  Column_Number'Last during scanning of configuration pragma files.
  
     Maximum_Processes : Positive := 1;
!    --  GNATMAKE, GPRMAKE
     --  Maximum number of processes that should be spawned to carry out
     --  compilations.
  
     Minimal_Recompilation : Boolean := False;
     --  GNATMAKE
!    --  Set to True if minimal recompilation mode requested
  
     Multiple_Unit_Index : Int;
     --  GNAT
*************** package Opt is
*** 761,771 ****
     --  This constant reflects the optimization level (0,1,2 for -O0,-O1,-O2)
  
     Output_File_Name_Present : Boolean := False;
!    --  GNATBIND, GNAT, GNATMAKE
     --  Set to True when the output C file name is given with option -o
     --  for GNATBIND, when the object file name is given with option
     --  -gnatO for GNAT or when the executable is given with option -o
!    --  for GNATMAKE.
  
     Output_Linker_Option_List : Boolean := False;
     --  GNATBIND
--- 766,776 ----
     --  This constant reflects the optimization level (0,1,2 for -O0,-O1,-O2)
  
     Output_File_Name_Present : Boolean := False;
!    --  GNATBIND, GNAT, GNATMAKE, GPRMAKE
     --  Set to True when the output C file name is given with option -o
     --  for GNATBIND, when the object file name is given with option
     --  -gnatO for GNAT or when the executable is given with option -o
!    --  for GNATMAKE or GPRMAKE.
  
     Output_Linker_Option_List : Boolean := False;
     --  GNATBIND
*************** package Opt is
*** 775,780 ****
--- 780,790 ----
     --  GNATBIND
     --  True if output of list of objects is requested (-O switch set)
  
+    Persistent_BSS_Mode : Boolean := False;
+    --  GNAT
+    --  True if a Persistent_BSS configuration pragma is in effect, causing
+    --  potentially persistent data to be placed in the persistent_bss section.
+ 
     Pessimistic_Elab_Order : Boolean := False;
     --  GNATBIND
     --  True if pessimistic elaboration order is to be chosen (-p switch set)
*************** package Opt is
*** 823,832 ****
     --  used if the policy is set in package System.
  
     Quiet_Output : Boolean := False;
!    --  GNATMAKE, GNATCLEAN, GPR2MAKE
     --  Set to True if the tool should not have any output if there are no
     --  errors or warnings.
  
     RTS_Lib_Path_Name : String_Ptr := null;
     RTS_Src_Path_Name : String_Ptr := null;
     --  GNAT
--- 833,846 ----
     --  used if the policy is set in package System.
  
     Quiet_Output : Boolean := False;
!    --  GNATMAKE, GNATCLEAN, GPRMAKE
     --  Set to True if the tool should not have any output if there are no
     --  errors or warnings.
  
+    Replace_In_Comments : Boolean := False;
+    --  GNATPREP
+    --  Set to True if -C switch used
+ 
     RTS_Lib_Path_Name : String_Ptr := null;
     RTS_Src_Path_Name : String_Ptr := null;
     --  GNAT
*************** package Opt is
*** 859,870 ****
  
     Stack_Checking_Enabled : Boolean;
     --  GNAT
!    --  Set to indicate if -fstack-check switch is set for the compilation.
!    --  True means that the switch is set, so that stack checking is enabled.
!    --  False means that the switch is not set (no stack checking). This
!    --  value is obtained from the external imported value flag_stack_check
!    --  in the gcc backend (see Frontend) and may be referenced throughout
!    --  the compilation phases.
  
     Style_Check : Boolean := False;
     --  GNAT
--- 873,884 ----
  
     Stack_Checking_Enabled : Boolean;
     --  GNAT
!    --  Set to indicate if -fstack-check switch is set for the compilation. True
!    --  means that the switch is set, so that stack checking is enabled. False
!    --  means that the switch is not set (no stack checking). This value is
!    --  obtained from the external imported value flag_stack_check in the gcc
!    --  backend (see Frontend) and may be referenced throughout the compilation
!    --  phases.
  
     Style_Check : Boolean := False;
     --  GNAT
*************** package Opt is
*** 884,890 ****
     --  is never appropriate in GNAT_Mode (and causes troubles, including
     --  bogus circularities, if we try to compile the run-time library with
     --  a System extension). If GNAT_Mode is not set, then System_Extend_Unit
!    --  is a copy of the value set in System_Extend_Pragma_Ary.
  
     Subunits_Missing : Boolean := False;
     --  GNAT
--- 898,904 ----
     --  is never appropriate in GNAT_Mode (and causes troubles, including
     --  bogus circularities, if we try to compile the run-time library with
     --  a System extension). If GNAT_Mode is not set, then System_Extend_Unit
!    --  is a copy of the value set in System_Extend_Pragma_Arg.
  
     Subunits_Missing : Boolean := False;
     --  GNAT
*************** package Opt is
*** 911,920 ****
     Table_Factor : Int := 1;
     --  GNAT
     --  Factor by which all initial table sizes set in Alloc are multiplied.
!    --  Used in Table to calculate initial table sizes (the initial table
!    --  size is the value in Alloc, used as the Table_Initial parameter
!    --  value, multiplied by the factor given here. The default value is
!    --  used if no -gnatT switch appears.
  
     Task_Dispatching_Policy : Character := ' ';
     --  GNAT, GNATBIND
--- 925,934 ----
     Table_Factor : Int := 1;
     --  GNAT
     --  Factor by which all initial table sizes set in Alloc are multiplied.
!    --  Used in Table to calculate initial table sizes (the initial table size
!    --  is the value in Alloc, used as the Table_Initial parameter value,
!    --  multiplied by the factor given here. The default value is used if no
!    --  -gnatT switch appears.
  
     Task_Dispatching_Policy : Character := ' ';
     --  GNAT, GNATBIND
*************** package Opt is
*** 939,956 ****
  
     Time_Slice_Value : Nat;
     --  GNATBIND
!    --  Time slice value. Valid only if Time_Slice_Set is True, i.e. if a
!    --  Time_Slice pragma has been processed. Set to the time slice value
!    --  in microseconds. Negative values are stored as zero, and the value
!    --  is not larger than 1_000_000_000 (1000 seconds). Values larger than
!    --  this are reset to this maximum. This can also be set with the -gnatTnn
!    --  switch.
  
     Tolerate_Consistency_Errors : Boolean := False;
     --  GNATBIND
!    --  Tolerate time stamp and other consistency errors. If this flag is
!    --  set to True (-t), then inconsistencies result in warnings rather than
!    --  errors.
  
     Tree_Output : Boolean := False;
     --  GNAT
--- 953,968 ----
  
     Time_Slice_Value : Nat;
     --  GNATBIND
!    --  Time slice value. Valid only if Time_Slice_Set is True, i.e. if
!    --  Time_Slice pragma has been processed. Set to the time slice value in
!    --  microseconds. Negative values are stored as zero, and the value is not
!    --  larger than 1_000_000_000 (1000 seconds). Values larger than this are
!    --  reset to this maximum. This can also be set with the -gnatTnn switch.
  
     Tolerate_Consistency_Errors : Boolean := False;
     --  GNATBIND
!    --  Tolerate time stamp and other consistency errors. If this flag is set to
!    --  True (-t), then inconsistencies result in warnings rather than errors.
  
     Tree_Output : Boolean := False;
     --  GNAT
*************** package Opt is
*** 976,1005 ****
  
     Universal_Addressing_On_AAMP : Boolean := False;
     --  GNAAMP
!    --  Indicates if library-level objects should be accessed and updated
!    --  using universal addressing instructions on the AAMP architecture.
!    --  This flag is set to True when pragma Universal_Data is given as
!    --  a configuration pragma.
  
     Unreserve_All_Interrupts : Boolean := False;
     --  GNAT, GNATBIND
!    --  Normally set False, set True if a valid Unreserve_All_Interrupts
!    --  pragma appears anywhere in the main unit for GNAT, or if any ALI
!    --  file has the corresponding attribute set in GNATBIND.
  
     Upper_Half_Encoding : Boolean := False;
     --  GNAT
     --  Normally set False, indicating that upper half ASCII characters are
     --  used in the normal way to represent themselves. If the wide character
!    --  encoding method uses the upper bit for this encoding, then this flag
!    --  is set True, and upper half characters in the source indicate the
!    --  start of a wide character sequence.
  
     Usage_Requested : Boolean := False;
     --  GNAT, GNATBIND, GNATMAKE
     --  Set to True if -h (-gnath for the compiler) switch encountered
     --  requesting usage information
  
     Use_VADS_Size : Boolean := False;
     --  GNAT
     --  Set to True if a valid pragma Use_VADS_Size is processed
--- 988,1021 ----
  
     Universal_Addressing_On_AAMP : Boolean := False;
     --  GNAAMP
!    --  Indicates if library-level objects should be accessed and updated using
!    --  universal addressing instructions on the AAMP architecture. This flag is
!    --  set to True when pragma Universal_Data is given as a configuration
!    --  pragma.
  
     Unreserve_All_Interrupts : Boolean := False;
     --  GNAT, GNATBIND
!    --  Normally set False, set True if a valid Unreserve_All_Interrupts pragma
!    --  appears anywhere in the main unit for GNAT, or if any ALI file has the
!    --  corresponding attribute set in GNATBIND.
  
     Upper_Half_Encoding : Boolean := False;
     --  GNAT
     --  Normally set False, indicating that upper half ASCII characters are
     --  used in the normal way to represent themselves. If the wide character
!    --  encoding method uses the upper bit for this encoding, then this flag is
!    --  set True, and upper half characters in the source indicate the start of
!    --  a wide character sequence.
  
     Usage_Requested : Boolean := False;
     --  GNAT, GNATBIND, GNATMAKE
     --  Set to True if -h (-gnath for the compiler) switch encountered
     --  requesting usage information
  
+    Use_Pragma_Linker_Constructor : Boolean := False;
+    --  GNATBIND
+    --  True if pragma Linker_Constructor applies to adainit
+ 
     Use_VADS_Size : Boolean := False;
     --  GNAT
     --  Set to True if a valid pragma Use_VADS_Size is processed
*************** package Opt is
*** 1008,1026 ****
     --  GNAT
     --  This flag determines if validity checking is on or off. The initial
     --  state is on, and the required default validity checks are active. The
!    --  actual set of checks that is performed if Validity_Checks_On is set
!    --  is defined by the switches in package Sem_Val. The Validity_Checks_On
!    --  flag is controlled by pragma Validity_Checks (On | Off), and also
!    --  some generated compiler code (typically code that has to do with
!    --  validity check generation) is compiled with this flag set to False.
!    --  This flag is set to False by the -gnatp switch.
  
     Verbose_Mode : Boolean := False;
!    --  GNAT, GNATBIND, GNATMAKE, GNATLINK, GNATLS, GNATCHOP, GNATNAME,
!    --  GNATCLEAN
     --  Set to True to get verbose mode (full error message text and location
     --  information sent to standard output, also header, copyright and summary)
  
     Warn_On_Constant : Boolean := False;
     --  GNAT
     --  Set to True to generate warnings for variables that could be declared
--- 1024,1068 ----
     --  GNAT
     --  This flag determines if validity checking is on or off. The initial
     --  state is on, and the required default validity checks are active. The
!    --  actual set of checks that is performed if Validity_Checks_On is set is
!    --  defined by the switches in package Validsw. The Validity_Checks_On flag
!    --  is controlled by pragma Validity_Checks (On | Off), and also some
!    --  generated compiler code (typically code that has to do with validity
!    --  check generation) is compiled with this flag set to False. This flag is
!    --  set to False by the -gnatp switch.
  
     Verbose_Mode : Boolean := False;
!    --  GNAT, GNATBIND, GNATMAKE, GNATLINK, GNATLS, GNATNAME, GNATCLEAN,
!    --  GPRMAKE
     --  Set to True to get verbose mode (full error message text and location
     --  information sent to standard output, also header, copyright and summary)
  
+    type Verbosity_Level_Type is (None, Low, Medium, High);
+    Verbosity_Level : Verbosity_Level_Type := High;
+    --  GNATMAKE, GPRMAKE
+    --  Modified by gnatmake or gprmake switches -v, -vl, -vm, -vh. Indicates
+    --  the level of verbosity of informational messages:
+    --
+    --  In Low Verbosity, the reasons why a source is recompiled, the name
+    --  of the executable and the reason it must be rebuilt is output.
+    --
+    --  In Medium Verbosity, additional lines are output for each ALI file
+    --  that is checked.
+    --
+    --  In High Verbosity, additional lines are output when the ALI file
+    --  is part of an Ada library, is read-only or is part of the runtime.
+ 
+    Warn_On_Ada_2005_Compatibility : Boolean := True;
+    --  GNAT
+    --  Set to True to active all warnings on Ada 2005 compatibility issues,
+    --  including warnings on Ada 2005 obsolescent features used in Ada 2005
+    --  mode. Set False by -gnatwY.
+ 
+    Warn_On_Bad_Fixed_Value : Boolean := False;
+    --  GNAT
+    --  Set to True to generate warnings for static fixed-point expression
+    --  values that are not an exact multiple of the small value of the type.
+ 
     Warn_On_Constant : Boolean := False;
     --  GNAT
     --  Set to True to generate warnings for variables that could be declared
*************** package Opt is
*** 1043,1050 ****
  
     Warn_On_Modified_Unread : Boolean := False;
     --  GNAT
!    --  Set to True to generate warnings if a variable is assigned but is
!    --  never read. The default is that this warning is suppressed.
  
     Warn_On_No_Value_Assigned : Boolean := True;
     --  GNAT
--- 1085,1092 ----
  
     Warn_On_Modified_Unread : Boolean := False;
     --  GNAT
!    --  Set to True to generate warnings if a variable is assigned but is never
!    --  read. The default is that this warning is suppressed.
  
     Warn_On_No_Value_Assigned : Boolean := True;
     --  GNAT
*************** package Opt is
*** 1054,1061 ****
  
     Warn_On_Obsolescent_Feature : Boolean := False;
     --  GNAT
!    --  Set to True to generate warnings on use of any feature in Annex J
!    --  or if a subprogram is called for which a pragma Obsolescent applies.
  
     Warn_On_Redundant_Constructs : Boolean := False;
     --  GNAT
--- 1096,1103 ----
  
     Warn_On_Obsolescent_Feature : Boolean := False;
     --  GNAT
!    --  Set to True to generate warnings on use of any feature in Annex or if a
!    --  subprogram is called for which a pragma Obsolescent applies.
  
     Warn_On_Redundant_Constructs : Boolean := False;
     --  GNAT
*************** package Opt is
*** 1087,1127 ****
     --  description of type in unit System.WCh_Con for a list of the methods
     --  that are currently supported. Note that brackets notation is always
     --  recognized in source programs regardless of the setting of this
!    --  variable. The default setting causes only the brackets notation
!    --  to be recognized. If this is the main unit, this setting also
!    --  controls the output of the W=? parameter in the ALI file, which
!    --  is used to provide the default for Wide_Text_IO files.
  
     Xref_Active : Boolean := True;
     --  GNAT
     --  Set if cross-referencing is enabled (i.e. xref info in ALI files)
  
-    Zero_Cost_Exceptions_Val : Boolean;
-    Zero_Cost_Exceptions_Set : Boolean := False;
-    --  GNAT
-    --  These values are to record the setting of the zero cost exception
-    --  handling mode set by argument switches (-gnatZ/-gnatL). If the
-    --  value is set by one of these switches, then Zero_Cost_Exceptions_Set
-    --  is set to True, and Zero_Cost_Exceptions_Val indicates the setting.
- 
     ----------------------------
     -- Configuration Settings --
     ----------------------------
  
!    --  These are settings that are used to establish the mode at the start
!    --  of each unit. The values defined below can be affected either by
!    --  command line switches, or by the use of appropriate configuration
!    --  pragmas in the gnat.adc file.
  
     Ada_Version_Config : Ada_Version_Type;
     --  GNAT
     --  This is the value of the configuration switch for the Ada 83 mode, as
!    --  set by the command line switches -gnat83/95/05, and possibly modified
!    --  by the use of configuration pragmas Ada_83/Ada95/Ada05. This switch
!    --  is used to set the initial value for Ada_Version mode at the start
!    --  of analysis of a unit. Note however, that the setting of this flag
!    --  is ignored for internal and predefined units (which are always compiled
!    --  in the most up to date version of Ada).
  
     Dynamic_Elaboration_Checks_Config : Boolean := False;
     --  GNAT
--- 1129,1178 ----
     --  description of type in unit System.WCh_Con for a list of the methods
     --  that are currently supported. Note that brackets notation is always
     --  recognized in source programs regardless of the setting of this
!    --  variable. The default setting causes only the brackets notation to be
!    --  recognized. If this is the main unit, this setting also controls the
!    --  output of the W=? parameter in the ALI file, which is used to provide
!    --  the default for Wide_Text_IO files.
  
     Xref_Active : Boolean := True;
     --  GNAT
     --  Set if cross-referencing is enabled (i.e. xref info in ALI files)
  
     ----------------------------
     -- Configuration Settings --
     ----------------------------
  
!    --  These are settings that are used to establish the mode at the start of
!    --  each unit. The values defined below can be affected either by command
!    --  line switches, or by the use of appropriate configuration pragmas in the
!    --  gnat.adc file.
  
     Ada_Version_Config : Ada_Version_Type;
     --  GNAT
     --  This is the value of the configuration switch for the Ada 83 mode, as
!    --  set by the command line switches -gnat83/95/05, and possibly modified by
!    --  the use of configuration pragmas Ada_83/Ada95/Ada05. This switch is used
!    --  to set the initial value for Ada_Version mode at the start of analysis
!    --  of a unit. Note however, that the setting of this flag is ignored for
!    --  internal and predefined units (which are always compiled in the most up
!    --  to date version of Ada).
! 
!    Ada_Version_Explicit_Config : Ada_Version_Type;
!    --  GNAT
!    --  Same as above but used to initialize Ada_Version_Explicit. Currently
!    --  this will always have the same value as Ada_Version_Config.
! 
!    Assertions_Enabled_Config : Boolean;
!    --  GNAT
!    --  This is the value of the configuration switch for assertions enabled
!    --  mode, as possibly set by the command line switch -gnata, and possibly
!    --  modified by the use of the configuration pragma Assertion_Policy.
! 
!    Debug_Pragmas_Enabled_Config : Boolean;
!    --  GNAT
!    --  This is the value of the configuration switch for debug pragmas enabled
!    --  mode, as possibly set by the command line switch -gnata and possibly
!    --  modified by the use of the configuration pragma Debug_Policy.
  
     Dynamic_Elaboration_Checks_Config : Boolean := False;
     --  GNAT
*************** package Opt is
*** 1134,1206 ****
  
     Extensions_Allowed_Config : Boolean;
     --  GNAT
!    --  This is the flag that indicates whether extensions are allowed.
!    --  It can be set True either by use of the -gnatX switch, or by use
!    --  of the configuration pragma Extensions_Allowed (On). It is always
!    --  set to True for internal GNAT units, since extensions are always
!    --  permitted in such units.
  
     External_Name_Exp_Casing_Config : External_Casing_Type;
     --  GNAT
!    --  This is the value of the configuration switch that controls casing
!    --  of external symbols for which an explicit external name is given. It
!    --  can be set to Uppercase by the command line switch -gnatF, and further
!    --  modified by the use of the configuration pragma External_Name_Casing
!    --  in the gnat.adc file. This flag is used to set the initial value
!    --  for External_Name_Exp_Casing at the start of analyzing each unit.
!    --  Note however that the setting of this flag is ignored for internal
!    --  and predefined units (which are always compiled with As_Is mode).
  
     External_Name_Imp_Casing_Config : External_Casing_Type;
     --  GNAT
!    --  This is the value of the configuration switch that controls casing
!    --  of external symbols where the external name is implicitly given. It
!    --  can be set to Uppercase by the command line switch -gnatF, and further
!    --  modified by the use of the configuration pragma External_Name_Casing
!    --  in the gnat.adc file. This flag is used to set the initial value
!    --  for External_Name_Imp_Casing at the start of analyzing each unit.
!    --  Note however that the setting of this flag is ignored for internal
!    --  and predefined units (which are always compiled with Lowercase mode).
  
     Polling_Required_Config : Boolean;
     --  GNAT
     --  This is the value of the configuration switch that controls polling
     --  mode. It can be set True by the command line switch -gnatP, and then
!    --  further modified by the use of pragma Polling in the gnat.adc file.
!    --  This flag is used to set the initial value for Polling_Required
!    --  at the start of analyzing each unit.
  
     Use_VADS_Size_Config : Boolean;
     --  GNAT
!    --  This is the value of the configuration switch that controls the use
!    --  of VADS_Size instead of Size whereever the attribute Size is used.
!    --  It can be set True by the use of the pragma Use_VADS_Size in the
!    --  gnat.adc file. This flag is used to set the initial value for
!    --  Use_VADS_Size at the start of analyzing each unit. Note however that
!    --  the setting of this flag is ignored for internal and predefined
!    --  units (which are always compiled with the standard Size semantics).
  
     type Config_Switches_Type is private;
     --  Type used to save values of the switches set from Config values
  
     procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type);
     --  This procedure saves the current values of the switches which are
!    --  initialized from the above Config values, and then resets these
!    --  switches according to the Config value settings.
  
!    procedure Set_Opt_Config_Switches (Internal_Unit : Boolean);
!    --  This procedure sets the switches to the appropriate initial values.
!    --  The parameter Internal_Unit is True for an internal or predefined
!    --  unit, and affects the way the switches are set (see above).
  
     procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type);
!    --  This procedure restores a set of switch values previously saved
!    --  by a call to Save_Opt_Switches.
  
     procedure Register_Opt_Config_Switches;
     --  This procedure is called after processing the gnat.adc file to record
!    --  the values of the Config switches, as possibly modified by the use
!    --  of command line switches and configuration pragmas.
  
     ------------------------
     -- Other Global Flags --
--- 1185,1272 ----
  
     Extensions_Allowed_Config : Boolean;
     --  GNAT
!    --  This is the flag that indicates whether extensions are allowed. It can
!    --  be set True either by use of the -gnatX switch, or by use of the
!    --  configuration pragma Extensions_Allowed (On). It is always set to True
!    --  for internal GNAT units, since extensions are always permitted in such
!    --  units.
  
     External_Name_Exp_Casing_Config : External_Casing_Type;
     --  GNAT
!    --  This is the value of the configuration switch that controls casing of
!    --  external symbols for which an explicit external name is given. It can be
!    --  set to Uppercase by the command line switch -gnatF, and further modified
!    --  by the use of the configuration pragma External_Name_Casing in the
!    --  gnat.adc file. This flag is used to set the initial value for
!    --  External_Name_Exp_Casing at the start of analyzing each unit. Note
!    --  however that the setting of this flag is ignored for internal and
!    --  predefined units (which are always compiled with As_Is mode).
  
     External_Name_Imp_Casing_Config : External_Casing_Type;
     --  GNAT
!    --  This is the value of the configuration switch that controls casing of
!    --  external symbols where the external name is implicitly given. It can be
!    --  set to Uppercase by the command line switch -gnatF, and further modified
!    --  by the use of the configuration pragma External_Name_Casing in the
!    --  gnat.adc file. This flag is used to set the initial value for
!    --  External_Name_Imp_Casing at the start of analyzing each unit. Note
!    --  however that the setting of this flag is ignored for internal and
!    --  predefined units (which are always compiled with Lowercase mode).
! 
!    Persistent_BSS_Mode_Config : Boolean;
!    --  GNAT
!    --  This is the value of the configuration switch that controls whether
!    --  potentially persistent data is to be placed in the persistent_bss
!    --  section. It can be set True by use of the pragma Persistent_BSS.
!    --  This flag is used to set the initial value of Persistent_BSS_Mode
!    --  at the start of each compilation unit, except that it is always
!    --  set False for predefined units.
  
     Polling_Required_Config : Boolean;
     --  GNAT
     --  This is the value of the configuration switch that controls polling
     --  mode. It can be set True by the command line switch -gnatP, and then
!    --  further modified by the use of pragma Polling in the gnat.adc file. This
!    --  flag is used to set the initial value for Polling_Required at the start
!    --  of analyzing each unit.
  
     Use_VADS_Size_Config : Boolean;
     --  GNAT
!    --  This is the value of the configuration switch that controls the use of
!    --  VADS_Size instead of Size whereever the attribute Size is used. It can
!    --  be set True by the use of the pragma Use_VADS_Size in the gnat.adc file.
!    --  This flag is used to set the initial value for Use_VADS_Size at the
!    --  start of analyzing each unit. Note however that the setting of this flag
!    --  is ignored for internal and predefined units (which are always compiled
!    --  with the standard Size semantics).
  
     type Config_Switches_Type is private;
     --  Type used to save values of the switches set from Config values
  
     procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type);
     --  This procedure saves the current values of the switches which are
!    --  initialized from the above Config values, and then resets these switches
!    --  according to the Config value settings.
  
!    procedure Set_Opt_Config_Switches
!      (Internal_Unit : Boolean;
!       Main_Unit     : Boolean);
!    --  This procedure sets the switches to the appropriate initial values. The
!    --  parameter Internal_Unit is True for an internal or predefined unit, and
!    --  affects the way the switches are set (see above). Main_Unit is true if
!    --  switches are being set for the main unit (this affects setting of the
!    --  assert/debug pragm switches, which are normally set false by default for
!    --  an internal unit, except when the internal unit is the main unit, in
!    --  which case we use the command line settings).
  
     procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type);
!    --  This procedure restores a set of switch values previously saved by a
!    --  call to Save_Opt_Switches.
  
     procedure Register_Opt_Config_Switches;
     --  This procedure is called after processing the gnat.adc file to record
!    --  the values of the Config switches, as possibly modified by the use of
!    --  command line switches and configuration pragmas.
  
     ------------------------
     -- Other Global Flags --
*************** package Opt is
*** 1211,1220 ****
     --  (False). When expansion is deactivated all calls to expander routines
     --  have no effect. Note that the initial setting of False is merely to
     --  prevent saving of an undefined value for an initial call to the
!    --  Expander_Mode_Save_And_Set procedure. For more information on the
!    --  use of this flag, see package Expander. Indeed this flag might more
!    --  logically be in the spec of Expander, but it is referenced by Errout,
!    --  and it really seems wrong for Errout to depend on Expander.
  
     -----------------------
     -- Tree I/O Routines --
--- 1277,1286 ----
     --  (False). When expansion is deactivated all calls to expander routines
     --  have no effect. Note that the initial setting of False is merely to
     --  prevent saving of an undefined value for an initial call to the
!    --  Expander_Mode_Save_And_Set procedure. For more information on the use of
!    --  this flag, see package Expander. Indeed this flag might more logically
!    --  be in the spec of Expander, but it is referenced by Errout, and it
!    --  really seems wrong for Errout to depend on Expander.
  
     -----------------------
     -- Tree I/O Routines --
*************** package Opt is
*** 1239,1250 ****
     --  from the Gnatvsn package which is a part of ASIS implementation.
  
     Tree_Version_String : String (Gnat_Version_String'Range);
!    --  Used to store the compiler version string read from a tree file to
!    --  check if it is the same as stored in the version string in Gnatvsn.
!    --  Therefore its length is taken directly from the version string in
!    --  Gnatvsn. If the length of the version string stored in the tree is
!    --  different, then versions are for sure different, and a string containing
!    --  '?' characters is assigned to this variable as a result of tree read.
  
     Tree_ASIS_Version_Number : Int;
     --  Used to store the ASIS version number read from a tree file to check if
--- 1305,1316 ----
     --  from the Gnatvsn package which is a part of ASIS implementation.
  
     Tree_Version_String : String (Gnat_Version_String'Range);
!    --  Used to store the compiler version string read from a tree file to check
!    --  if it is the same as stored in the version string in Gnatvsn. Therefore
!    --  its length is taken directly from the version string in Gnatvsn. If the
!    --  length of the version string stored in the tree is different, then
!    --  versions are for sure different, and a string containing '?' characters
!    --  is assigned to this variable as a result of tree read.
  
     Tree_ASIS_Version_Number : Int;
     --  Used to store the ASIS version number read from a tree file to check if
*************** private
*** 1254,1264 ****
--- 1320,1334 ----
  
     type Config_Switches_Type is record
        Ada_Version                    : Ada_Version_Type;
+       Ada_Version_Explicit           : Ada_Version_Type;
+       Assertions_Enabled             : Boolean;
+       Debug_Pragmas_Enabled          : Boolean;
        Dynamic_Elaboration_Checks     : Boolean;
        Exception_Locations_Suppressed : Boolean;
        Extensions_Allowed             : Boolean;
        External_Name_Exp_Casing       : External_Casing_Type;
        External_Name_Imp_Casing       : External_Casing_Type;
+       Persistent_BSS_Mode            : Boolean;
        Polling_Required               : Boolean;
        Use_VADS_Size                  : Boolean;
     end record;
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-b.adb gcc-4.1.0/gcc/ada/osint-b.adb
*** gcc-4.0.2/gcc/ada/osint-b.adb	Tue Oct 21 13:42:10 2003
--- gcc-4.1.0/gcc/ada/osint-b.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-b.ads gcc-4.1.0/gcc/ada/osint-b.ads
*** gcc-4.0.2/gcc/ada/osint-b.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-b.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-c.adb gcc-4.1.0/gcc/ada/osint-c.adb
*** gcc-4.0.2/gcc/ada/osint-c.adb	Thu Apr  1 10:04:38 2004
--- gcc-4.1.0/gcc/ada/osint-c.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 2001-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Tree_IO;  use Tree_IO;
*** 32,45 ****
  package body Osint.C is
  
     Output_Object_File_Name : String_Ptr;
!    --  Argument of -o compiler option, if given. This is needed to
!    --  verify consistency with the ALI file name.
  
     procedure Adjust_OS_Resource_Limits;
     pragma Import (C, Adjust_OS_Resource_Limits,
                    "__gnat_adjust_os_resource_limits");
!    --  Procedure to make system specific adjustments to make GNAT
!    --  run better.
  
     function Create_Auxiliary_File
       (Src    : File_Name_Type;
--- 32,44 ----
  package body Osint.C is
  
     Output_Object_File_Name : String_Ptr;
!    --  Argument of -o compiler option, if given. This is needed to verify
!    --  consistency with the ALI file name.
  
     procedure Adjust_OS_Resource_Limits;
     pragma Import (C, Adjust_OS_Resource_Limits,
                    "__gnat_adjust_os_resource_limits");
!    --  Procedure to make system specific adjustments to make GNAT run better
  
     function Create_Auxiliary_File
       (Src    : File_Name_Type;
*************** package body Osint.C is
*** 325,331 ****
        EL  : constant Natural := Ext'Length;
  
     begin
!       --  Make sure that the object file has the expected extension.
  
        if NL <= EL
           or else
--- 324,330 ----
        EL  : constant Natural := Ext'Length;
  
     begin
!       --  Make sure that the object file has the expected extension
  
        if NL <= EL
           or else
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-c.ads gcc-4.1.0/gcc/ada/osint-c.ads
*** gcc-4.0.2/gcc/ada/osint-c.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-c.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-l.adb gcc-4.1.0/gcc/ada/osint-l.adb
*** gcc-4.0.2/gcc/ada/osint-l.adb	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-l.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001 Free Software Foundation, Inc.               --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-l.ads gcc-4.1.0/gcc/ada/osint-l.ads
*** gcc-4.0.2/gcc/ada/osint-l.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-l.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001 Free Software Foundation, Inc.               --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-m.adb gcc-4.1.0/gcc/ada/osint-m.adb
*** gcc-4.0.2/gcc/ada/osint-m.adb	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-m.adb	Mon Nov 14 13:05:58 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001 Free Software Foundation, Inc.               --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,29 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package body Osint.M is
  
     -----------------------
--- 16,40 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ with Osint;
+ 
+ pragma Elaborate_All (Osint);
+ --  This pragma is needed because of the call to Set_Program in the
+ --  elaboration of the package. We cannot rely on the static model
+ --  of elaboration since the compiler is routinely compiled with
+ --  checks off (-gnatp), and with older versions of the compiler
+ --  (up to and including most 5.04 wavefronts), -gnatp suppresses
+ --  the static elaboration check mechanisms. It could be removed
+ --  one day, but there really is no need to do so.
+ 
  package body Osint.M is
  
     -----------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/osint-m.ads gcc-4.1.0/gcc/ada/osint-m.ads
*** gcc-4.0.2/gcc/ada/osint-m.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/osint-m.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001 Free Software Foundation, Inc.               --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/osint.adb gcc-4.1.0/gcc/ada/osint.adb
*** gcc-4.0.2/gcc/ada/osint.adb	Tue Jul 20 10:26:51 2004
--- gcc-4.1.0/gcc/ada/osint.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with System.Case_Util; use System.Case_U
*** 37,43 ****
  
  with Unchecked_Conversion;
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
  with GNAT.HTable;
  
  package body Osint is
--- 37,42 ----
*************** package body Osint is
*** 77,83 ****
     function Append_Suffix_To_File_Name
       (Name   : Name_Id;
        Suffix : String) return Name_Id;
!    --  Appends Suffix to Name and returns the new name.
  
     function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
     --  Convert OS format time to GNAT format time stamp
--- 76,82 ----
     function Append_Suffix_To_File_Name
       (Name   : Name_Id;
        Suffix : String) return Name_Id;
!    --  Appends Suffix to Name and returns the new name
  
     function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
     --  Convert OS format time to GNAT format time stamp
*************** package body Osint is
*** 116,122 ****
     --  full file name if file found, or No_File if not found.
  
     function C_String_Length (S : Address) return Integer;
!    --  Returns length of a C string. Returns zero for a null address.
  
     function To_Path_String_Access
       (Path_Addr : Address;
--- 115,121 ----
     --  full file name if file found, or No_File if not found.
  
     function C_String_Length (S : Address) return Integer;
!    --  Returns length of a C string. Returns zero for a null address
  
     function To_Path_String_Access
       (Path_Addr : Address;
*************** package body Osint is
*** 201,207 ****
     --  time stamp.
  
     File_Cache_Enabled : Boolean := False;
!    --  Set to true if you want the enable the file data caching mechanism.
  
     type File_Hash_Num is range 0 .. 1020;
  
--- 200,206 ----
     --  time stamp.
  
     File_Cache_Enabled : Boolean := False;
!    --  Set to true if you want the enable the file data caching mechanism
  
     type File_Hash_Num is range 0 .. 1020;
  
*************** package body Osint is
*** 314,320 ****
           --  For the call to Close
  
        begin
!          --  Construct a C compatible character string buffer.
  
           Buffer (1 .. Buffer'Last - 1) := Path_File_Name.all;
           Buffer (Buffer'Last) := ASCII.NUL;
--- 313,319 ----
           --  For the call to Close
  
        begin
!          --  Construct a C compatible character string buffer
  
           Buffer (1 .. Buffer'Last - 1) := Path_File_Name.all;
           Buffer (Buffer'Last) := ASCII.NUL;
*************** package body Osint is
*** 409,414 ****
--- 408,427 ----
        --  environment variable. Get this value, extract the directory names
        --  and store in the tables.
  
+       --  Check for eventual project path file env vars
+ 
+       Path_File_Name := Getenv (Project_Include_Path_File);
+ 
+       if Path_File_Name'Length > 0 then
+          Get_Dirs_From_File (Additional_Source_Dir => True);
+       end if;
+ 
+       Path_File_Name := Getenv (Project_Objects_Path_File);
+ 
+       if Path_File_Name'Length > 0 then
+          Get_Dirs_From_File (Additional_Source_Dir => False);
+       end if;
+ 
        --  On VMS, don't expand the logical name (e.g. environment variable),
        --  just put it into Unix (e.g. canonical) format. System services
        --  will handle the expansion as part of the file processing.
*************** package body Osint is
*** 443,463 ****
           end loop;
        end loop;
  
!       --  Check for eventual project path file env vars
! 
!       Path_File_Name := Getenv (Project_Include_Path_File);
! 
!       if Path_File_Name'Length > 0 then
!          Get_Dirs_From_File (Additional_Source_Dir => True);
!       end if;
! 
!       Path_File_Name := Getenv (Project_Objects_Path_File);
! 
!       if Path_File_Name'Length > 0 then
!          Get_Dirs_From_File (Additional_Source_Dir => False);
!       end if;
! 
!       --  For the compiler, if --RTS= was apecified, add the runtime
        --  directories.
  
        if RTS_Src_Path_Name /= null and then
--- 456,462 ----
           end loop;
        end loop;
  
!       --  For the compiler, if --RTS= was specified, add the runtime
        --  directories.
  
        if RTS_Src_Path_Name /= null and then
diff -Nrcpad gcc-4.0.2/gcc/ada/osint.ads gcc-4.1.0/gcc/ada/osint.ads
*** gcc-4.0.2/gcc/ada/osint.ads	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/osint.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Osint is
*** 90,118 ****
     --  so that two file names compare equal if they refer to the same file.
  
     function Number_Of_Files return Int;
!    --  gives the total number of filenames found on the command line.
  
     No_Index : constant := -1;
!    --  Value used in Add_File to indicate that no index is specified
!    --  for a main.
  
     procedure Add_File (File_Name : String; Index : Int := No_Index);
!    --  Called by the subprogram processing the command line for each
!    --  file name found. The index, when not defaulted to No_Index
!    --  is the index of the subprogram in its source, zero indicating
!    --  that the source is not multi-unit.
  
     procedure Find_Program_Name;
     --  Put simple name of current program being run (excluding the directory
     --  path) in Name_Buffer, with the length in Name_Len.
  
     function Program_Name (Nam : String) return String_Access;
!    --  In the native compilation case, Create a string containing Nam. In
!    --  the cross compilation case, looks at the prefix of the current
!    --  program being run and prepend it to Nam. For instance if the program
!    --  being run is <target>-gnatmake and Nam is "gcc", the returned value
!    --  will be a pointer to "<target>-gcc". This function clobbers
!    --  Name_Buffer and Name_Len.
  
     procedure Write_Program_Name;
     --  Writes name of program as invoked to the current output
--- 90,116 ----
     --  so that two file names compare equal if they refer to the same file.
  
     function Number_Of_Files return Int;
!    --  Gives the total number of filenames found on the command line
  
     No_Index : constant := -1;
!    --  Value used in Add_File to indicate no index is specified for main
  
     procedure Add_File (File_Name : String; Index : Int := No_Index);
!    --  Called by the subprogram processing the command line for each file name
!    --  found. The index, when not defaulted to No_Index is the index of the
!    --  subprogram in its source, zero indicating that the source is not
!    --  multi-unit.
  
     procedure Find_Program_Name;
     --  Put simple name of current program being run (excluding the directory
     --  path) in Name_Buffer, with the length in Name_Len.
  
     function Program_Name (Nam : String) return String_Access;
!    --  In the native compilation case, Create a string containing Nam. In the
!    --  cross compilation case, looks at the prefix of the current program being
!    --  run and prepend it to Nam. For instance if the program being run is
!    --  <target>-gnatmake and Nam is "gcc", the returned value will be a pointer
!    --  to "<target>-gcc". This function clobbers Name_Buffer and Name_Len.
  
     procedure Write_Program_Name;
     --  Writes name of program as invoked to the current output
*************** package Osint is
*** 121,128 ****
     procedure Fail (S1 : String; S2 : String := ""; S3 : String := "");
     pragma No_Return (Fail);
     --  Outputs error messages S1 & S2 & S3 preceded by the name of the
!    --  executing program and exits with E_Fatal. The output goes to
!    --  standard error, except if special output is in effect (see Output).
  
     function Is_Directory_Separator (C : Character) return Boolean;
     --  Returns True if C is a directory separator
--- 119,126 ----
     procedure Fail (S1 : String; S2 : String := ""; S3 : String := "");
     pragma No_Return (Fail);
     --  Outputs error messages S1 & S2 & S3 preceded by the name of the
!    --  executing program and exits with E_Fatal. The output goes to standard
!    --  error, except if special output is in effect (see Output).
  
     function Is_Directory_Separator (C : Character) return Boolean;
     --  Returns True if C is a directory separator
*************** package Osint is
*** 133,139 ****
     --  directory part in the name.
  
     function Is_Readonly_Library (File : File_Name_Type) return Boolean;
!    --  Check if this library file is a read-only file.
  
     function Strip_Directory (Name : File_Name_Type) return File_Name_Type;
     --  Strips the prefix directory name (if any) from Name. Returns the
--- 131,137 ----
     --  directory part in the name.
  
     function Is_Readonly_Library (File : File_Name_Type) return Boolean;
!    --  Check if this library file is a read-only file
  
     function Strip_Directory (Name : File_Name_Type) return File_Name_Type;
     --  Strips the prefix directory name (if any) from Name. Returns the
*************** package Osint is
*** 177,187 ****
        Prefix_Style : Boolean) return String_Access;
     --  Convert a host syntax directory specification (e.g. on a VMS host:
     --  "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
!    --  If Prefix_Style then make it a valid file specification prefix.
!    --  A file specification prefix is a directory specification that
!    --  can be appended with a simple file specification to yield a valid
!    --  absolute or relative path to a file. On a conversion to Unix syntax
!    --  this simply means the spec has a trailing slash ("/").
  
     function To_Canonical_File_Spec
       (Host_File : String) return String_Access;
--- 175,185 ----
        Prefix_Style : Boolean) return String_Access;
     --  Convert a host syntax directory specification (e.g. on a VMS host:
     --  "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
!    --  If Prefix_Style then make it a valid file specification prefix. A file
!    --  specification prefix is a directory specification that can be appended
!    --  with a simple file specification to yield a valid absolute or relative
!    --  path to a file. On a conversion to Unix syntax this simply means the
!    --  spec has a trailing slash ("/").
  
     function To_Canonical_File_Spec
       (Host_File : String) return String_Access;
*************** package Osint is
*** 204,210 ****
  
     function To_Host_File_Spec
       (Canonical_File : String) return String_Access;
!    --  Convert a canonical syntax file specification to host syntax.
  
     function Relocate_Path
       (Prefix : String;
--- 202,208 ----
  
     function To_Host_File_Spec
       (Canonical_File : String) return String_Access;
!    --  Convert a canonical syntax file specification to host syntax
  
     function Relocate_Path
       (Prefix : String;
*************** package Osint is
*** 552,558 ****
  private
  
     ALI_Suffix : constant String_Ptr := new String'("ali");
!    --  The suffix used for the library files (also known as ALI files).
  
     Current_Main : File_Name_Type := No_File;
     --  Used to save a simple file name between calls to Next_Main_Source and
--- 550,556 ----
  private
  
     ALI_Suffix : constant String_Ptr := new String'("ali");
!    --  The suffix used for the library files (also known as ALI files)
  
     Current_Main : File_Name_Type := No_File;
     --  Used to save a simple file name between calls to Next_Main_Source and
*************** private
*** 561,567 ****
     --  last call to Next_Main_Source (and stored here) is to be read.
  
     Object_Suffix : constant String := Get_Object_Suffix.all;
!    --  The suffix used for the object files.
  
     Output_FD : File_Descriptor;
     --  The file descriptor for the current library info, tree or binder output
--- 559,565 ----
     --  last call to Next_Main_Source (and stored here) is to be read.
  
     Object_Suffix : constant String := Get_Object_Suffix.all;
!    --  The suffix used for the object files
  
     Output_FD : File_Descriptor;
     --  The file descriptor for the current library info, tree or binder output
*************** private
*** 609,618 ****
     --  A check is made that this procedure is not called several times.
  
     function More_Files return Boolean;
!    --  Implements More_Source_Files and More_Lib_Files.
  
     function Next_Main_File return File_Name_Type;
!    --  Implements Next_Main_Source and Next_Main_Lib_File.
  
     function Object_File_Name (N : File_Name_Type) return File_Name_Type;
     --  Constructs the name of the object file corresponding to library
--- 607,616 ----
     --  A check is made that this procedure is not called several times.
  
     function More_Files return Boolean;
!    --  Implements More_Source_Files and More_Lib_Files
  
     function Next_Main_File return File_Name_Type;
!    --  Implements Next_Main_Source and Next_Main_Lib_File
  
     function Object_File_Name (N : File_Name_Type) return File_Name_Type;
     --  Constructs the name of the object file corresponding to library
diff -Nrcpad gcc-4.0.2/gcc/ada/output.adb gcc-4.1.0/gcc/ada/output.adb
*** gcc-4.0.2/gcc/ada/output.adb	Thu Nov 27 11:40:45 2003
--- gcc-4.1.0/gcc/ada/output.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Output is
*** 63,69 ****
     --  will be silently ignored.
  
     Next_Column : Pos range 1 .. Buffer'Length + 1 := 1;
!    --  Column about to be written.
  
     -----------------------
     -- Local_Subprograms --
--- 63,69 ----
     --  will be silently ignored.
  
     Next_Column : Pos range 1 .. Buffer'Length + 1 := 1;
!    --  Column about to be written
  
     -----------------------
     -- Local_Subprograms --
diff -Nrcpad gcc-4.0.2/gcc/ada/output.ads gcc-4.1.0/gcc/ada/output.ads
*** gcc-4.0.2/gcc/ada/output.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/output.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Types; use Types;
  
  package Output is
! pragma Elaborate_Body (Output);
  
     type Output_Proc is access procedure (S : String);
     --  This type is used for the Set_Special_Output procedure. If this
--- 38,44 ----
  with Types; use Types;
  
  package Output is
!    pragma Elaborate_Body;
  
     type Output_Proc is access procedure (S : String);
     --  This type is used for the Set_Special_Output procedure. If this
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch10.adb gcc-4.1.0/gcc/ada/par-ch10.adb
*** gcc-4.0.2/gcc/ada/par-ch10.adb	Mon Jun  7 14:16:22 2004
--- gcc-4.1.0/gcc/ada/par-ch10.adb	Tue Nov 15 14:01:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** pragma Style_Checks (All_Checks);
*** 28,34 ****
  --  Turn off subprogram body ordering check. Subprograms are in order
  --  by RM section rather than alphabetical
  
- with Fname;    use Fname;
  with Fname.UF; use Fname.UF;
  with Uname;    use Uname;
  
--- 28,33 ----
*************** package body Ch10 is
*** 354,361 ****
        elsif Token = Tok_Separate then
           Set_Unit (Comp_Unit_Node, P_Subunit);
  
!       elsif Token = Tok_Procedure
!         or else Token = Tok_Function
        then
           Set_Unit (Comp_Unit_Node, P_Subprogram (Pf_Decl_Gins_Pbod_Rnam));
  
--- 353,362 ----
        elsif Token = Tok_Separate then
           Set_Unit (Comp_Unit_Node, P_Subunit);
  
!       elsif Token = Tok_Function
!         or else Token = Tok_Not
!         or else Token = Tok_Overriding
!         or else Token = Tok_Procedure
        then
           Set_Unit (Comp_Unit_Node, P_Subprogram (Pf_Decl_Gins_Pbod_Rnam));
  
*************** package body Ch10 is
*** 404,412 ****
  
           elsif Private_Sloc /= No_Location
             and then
!              Nkind (Unit (Comp_Unit_Node)) /= N_Function_Instantiation
!            and then
!              Nkind (Unit (Comp_Unit_Node)) /= N_Procedure_Instantiation
             and then
               Nkind (Unit (Comp_Unit_Node)) /= N_Subprogram_Renaming_Declaration
           then
--- 405,411 ----
  
           elsif Private_Sloc /= No_Location
             and then
!              Nkind (Unit (Comp_Unit_Node)) not in N_Subprogram_Instantiation
             and then
               Nkind (Unit (Comp_Unit_Node)) /= N_Subprogram_Renaming_Declaration
           then
*************** package body Ch10 is
*** 528,535 ****
             or else Nkind (Unit_Node) = N_Single_Protected_Declaration
           then
              Name_Node := Defining_Identifier (Unit_Node);
!          else
              Name_Node := Defining_Unit_Name (Unit_Node);
           end if;
  
           Set_Sloc (Comp_Unit_Node, Sloc (Name_Node));
--- 527,551 ----
             or else Nkind (Unit_Node) = N_Single_Protected_Declaration
           then
              Name_Node := Defining_Identifier (Unit_Node);
! 
!          elsif Nkind (Unit_Node) = N_Function_Instantiation
!            or else Nkind (Unit_Node) = N_Function_Specification
!            or else Nkind (Unit_Node) = N_Generic_Function_Renaming_Declaration
!            or else Nkind (Unit_Node) = N_Generic_Package_Renaming_Declaration
!            or else Nkind (Unit_Node) = N_Generic_Procedure_Renaming_Declaration
!            or else Nkind (Unit_Node) = N_Package_Body
!            or else Nkind (Unit_Node) = N_Package_Instantiation
!            or else Nkind (Unit_Node) = N_Package_Renaming_Declaration
!            or else Nkind (Unit_Node) = N_Package_Specification
!            or else Nkind (Unit_Node) = N_Procedure_Instantiation
!            or else Nkind (Unit_Node) = N_Procedure_Specification
!          then
              Name_Node := Defining_Unit_Name (Unit_Node);
+ 
+          --  Anything else is a serious error, abandon scan
+ 
+          else
+             raise Error_Resync;
           end if;
  
           Set_Sloc (Comp_Unit_Node, Sloc (Name_Node));
*************** package body Ch10 is
*** 1090,1095 ****
--- 1106,1113 ----
           loop
              exit when Loc = Token_Ptr;
  
+             --  Should we worry about UTF_32 line terminators here
+ 
              if Source (Loc) in Line_Terminator then
                 Skip_Line_Terminators (Loc, Physical);
                 exit when Physical;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch11.adb gcc-4.1.0/gcc/ada/par-ch11.adb
*** gcc-4.0.2/gcc/ada/par-ch11.adb	Mon Jun  7 14:16:22 2004
--- gcc-4.1.0/gcc/ada/par-ch11.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch11 is
*** 190,195 ****
--- 190,205 ----
           Set_Name (Raise_Node, P_Name);
        end if;
  
+       if Token = Tok_With then
+          if Ada_Version < Ada_05 then
+             Error_Msg_SC ("string expression in raise is Ada 2005 extension");
+             Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
+          end if;
+ 
+          Scan; -- past WITH
+          Set_Expression (Raise_Node, P_Expression);
+       end if;
+ 
        TF_Semicolon;
        return Raise_Node;
     end P_Raise_Statement;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch12.adb gcc-4.1.0/gcc/ada/par-ch12.adb
*** gcc-4.0.2/gcc/ada/par-ch12.adb	Thu Feb 10 13:50:44 2005
--- gcc-4.1.0/gcc/ada/par-ch12.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch12 is
*** 153,159 ****
  
        Decl_Loop : loop
           P_Pragmas_Opt (Decls);
!          Ignore (Tok_Private);
  
           if Token = Tok_Use then
              Append (P_Use_Clause, Decls);
--- 153,163 ----
  
        Decl_Loop : loop
           P_Pragmas_Opt (Decls);
! 
!          if Token = Tok_Private then
!             Error_Msg_S ("generic private child packages not permitted");
!             Scan; -- past PRIVATE
!          end if;
  
           if Token = Tok_Use then
              Append (P_Use_Clause, Decls);
*************** package body Ch12 is
*** 487,499 ****
     --  | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
     --  | FORMAL_ARRAY_TYPE_DEFINITION
     --  | FORMAL_ACCESS_TYPE_DEFINITION
  
     --  FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION
  
     --  FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
  
     function P_Formal_Type_Definition return Node_Id is
!       Scan_State : Saved_Scan_State;
  
     begin
        if Token_Name = Name_Abstract then
--- 491,507 ----
     --  | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
     --  | FORMAL_ARRAY_TYPE_DEFINITION
     --  | FORMAL_ACCESS_TYPE_DEFINITION
+    --  | FORMAL_INTERFACE_TYPE_DEFINITION
  
     --  FORMAL_ARRAY_TYPE_DEFINITION ::= ARRAY_TYPE_DEFINITION
  
     --  FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
  
+    --  FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION
+ 
     function P_Formal_Type_Definition return Node_Id is
!       Scan_State   : Saved_Scan_State;
!       Typedef_Node : Node_Id;
  
     begin
        if Token_Name = Name_Abstract then
*************** package body Ch12 is
*** 524,561 ****
                 return P_Formal_Private_Type_Definition;
              end if;
  
!          when Tok_Private | Tok_Limited | Tok_Tagged =>
!             return P_Formal_Private_Type_Definition;
  
!          when Tok_New =>
!             return P_Formal_Derived_Type_Definition;
  
           when Tok_Left_Paren =>
              return P_Formal_Discrete_Type_Definition;
  
!          when Tok_Range =>
!             return P_Formal_Signed_Integer_Type_Definition;
  
           when Tok_Mod =>
              return P_Formal_Modular_Type_Definition;
  
!          when Tok_Digits =>
!             return P_Formal_Floating_Point_Definition;
! 
!          when Tok_Delta =>
!             return P_Formal_Fixed_Point_Definition;
  
!          when Tok_Array =>
!             return P_Array_Type_Definition;
  
!          when Tok_Access =>
!             return P_Access_Type_Definition;
  
           when Tok_Record =>
              Error_Msg_SC ("record not allowed in generic type definition!");
              Discard_Junk_Node (P_Record_Definition);
              return Error;
  
           when others =>
              Error_Msg_BC ("expecting generic type definition here");
              Resync_Past_Semicolon;
--- 532,620 ----
                 return P_Formal_Private_Type_Definition;
              end if;
  
!          when Tok_Access =>
!             return P_Access_Type_Definition;
  
!          when Tok_Array =>
!             return P_Array_Type_Definition;
! 
!          when Tok_Delta =>
!             return P_Formal_Fixed_Point_Definition;
! 
!          when Tok_Digits =>
!             return P_Formal_Floating_Point_Definition;
! 
!          when Tok_Interface => --  Ada 2005 (AI-251)
!             return P_Interface_Type_Definition (Is_Synchronized => False);
  
           when Tok_Left_Paren =>
              return P_Formal_Discrete_Type_Definition;
  
!          when Tok_Limited =>
!             Save_Scan_State (Scan_State);
!             Scan; --  past LIMITED
! 
!             if Token = Tok_Interface then
!                Typedef_Node := P_Interface_Type_Definition
!                                 (Is_Synchronized => False);
!                Set_Limited_Present (Typedef_Node);
!                return Typedef_Node;
! 
!             else
!                Restore_Scan_State (Scan_State);
!                return P_Formal_Private_Type_Definition;
!             end if;
  
           when Tok_Mod =>
              return P_Formal_Modular_Type_Definition;
  
!          when Tok_New =>
!             return P_Formal_Derived_Type_Definition;
  
!          when Tok_Private |
!               Tok_Tagged  =>
!             return P_Formal_Private_Type_Definition;
  
!          when Tok_Range =>
!             return P_Formal_Signed_Integer_Type_Definition;
  
           when Tok_Record =>
              Error_Msg_SC ("record not allowed in generic type definition!");
              Discard_Junk_Node (P_Record_Definition);
              return Error;
  
+          --  Ada 2005 (AI-345)
+ 
+          when Tok_Protected    |
+               Tok_Synchronized |
+               Tok_Task         =>
+ 
+             Scan; -- past TASK, PROTECTED or SYNCHRONIZED
+ 
+             declare
+                Saved_Token  : constant Token_Type := Token;
+ 
+             begin
+                Typedef_Node := P_Interface_Type_Definition
+                                 (Is_Synchronized => True);
+ 
+                case Saved_Token is
+                   when Tok_Task =>
+                      Set_Task_Present         (Typedef_Node);
+ 
+                   when Tok_Protected =>
+                      Set_Protected_Present    (Typedef_Node);
+ 
+                   when Tok_Synchronized =>
+                      Set_Synchronized_Present (Typedef_Node);
+ 
+                   when others =>
+                      null;
+                end case;
+ 
+                return Typedef_Node;
+             end;
+ 
           when others =>
              Error_Msg_BC ("expecting generic type definition here");
              Resync_Past_Semicolon;
*************** package body Ch12 is
*** 617,623 ****
     --------------------------------------------
  
     --  FORMAL_DERIVED_TYPE_DEFINITION ::=
!    --    [abstract] new SUBTYPE_MARK [with private]
  
     --  The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
  
--- 676,682 ----
     --------------------------------------------
  
     --  FORMAL_DERIVED_TYPE_DEFINITION ::=
!    --    [abstract] new SUBTYPE_MARK [[AND interface_list] with private]
  
     --  The caller has checked the initial token(s) is/are NEW or ASTRACT NEW
  
*************** package body Ch12 is
*** 638,643 ****
--- 697,722 ----
        Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
        No_Constraint;
  
+       --  Ada 2005 (AI-251): Deal with interfaces
+ 
+       if Token = Tok_And then
+          Scan; -- past AND
+ 
+          if Ada_Version < Ada_05 then
+             Error_Msg_SP
+               ("abstract interface is an Ada 2005 extension");
+             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+          end if;
+ 
+          Set_Interface_List (Def_Node, New_List);
+ 
+          loop
+             Append (P_Qualified_Simple_Name, Interface_List (Def_Node));
+             exit when Token /= Tok_And;
+             Scan; -- past AND
+          end loop;
+       end if;
+ 
        if Token = Tok_With then
           Scan; -- past WITH
           Set_Private_Present (Def_Node, True);
*************** package body Ch12 is
*** 819,829 ****
  
     --  SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
  
!    --  DEFAULT_NAME ::= NAME
  
     --  The caller has checked that the initial tokens are WITH FUNCTION or
     --  WITH PROCEDURE, and the initial WITH has been scanned out.
  
     --  Error recovery: cannot raise Error_Resync
  
     function P_Formal_Subprogram_Declaration return Node_Id is
--- 898,910 ----
  
     --  SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
  
!    --  DEFAULT_NAME ::= NAME | null
  
     --  The caller has checked that the initial tokens are WITH FUNCTION or
     --  WITH PROCEDURE, and the initial WITH has been scanned out.
  
+    --  A null default is an Ada 2005 feature
+ 
     --  Error recovery: cannot raise Error_Resync
  
     function P_Formal_Subprogram_Declaration return Node_Id is
*************** package body Ch12 is
*** 861,866 ****
--- 942,963 ----
              Scan; -- past <>
              T_Semicolon;
  
+          elsif Token = Tok_Null then
+             if Ada_Version < Ada_05 then
+                Error_Msg_SP
+                  ("null default subprograms are an Ada 2005 extension");
+                Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+             end if;
+ 
+             if Nkind (Spec_Node) = N_Procedure_Specification then
+                Set_Null_Present (Spec_Node);
+             else
+                Error_Msg_SP ("only procedures can be null");
+             end if;
+ 
+             Scan;  --  past NULL
+             T_Semicolon;
+ 
           else
              Set_Default_Name (Def_Node, P_Name);
              T_Semicolon;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch13.adb gcc-4.1.0/gcc/ada/par-ch13.adb
*** gcc-4.0.2/gcc/ada/par-ch13.adb	Thu Oct 30 11:50:12 2003
--- gcc-4.1.0/gcc/ada/par-ch13.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch2.adb gcc-4.1.0/gcc/ada/par-ch2.adb
*** gcc-4.0.2/gcc/ada/par-ch2.adb	Thu Feb 10 13:50:28 2005
--- gcc-4.1.0/gcc/ada/par-ch2.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch2 is
*** 33,39 ****
  
     --  Local functions, used only in this chapter
  
!    function P_Pragma_Argument_Association return Node_Id;
  
     ---------------------
     -- 2.3  Identifier --
--- 33,46 ----
  
     --  Local functions, used only in this chapter
  
!    procedure Scan_Pragma_Argument_Association
!      (Identifier_Seen : in out Boolean;
!       Association     : out Node_Id);
!    --  Scans out a pragma argument association. Identifier_Seen is true on
!    --  entry if a previous association had an identifier, and gets set True if
!    --  the scanned association has an identifier (this is used to check the
!    --  rule that no associations without identifiers can follow an association
!    --  which has an identifier). The result is returned in Association.
  
     ---------------------
     -- 2.3  Identifier --
*************** package body Ch2 is
*** 55,65 ****
  
        if Token = Tok_Identifier then
  
!          --  Ada 2005 (AI-284): Compiling in Ada95 mode we notify
!          --  that interface, overriding, and synchronized are
!          --  new reserved words
  
!          if Ada_Version = Ada_95 then
              if Token_Name = Name_Overriding
                or else Token_Name = Name_Synchronized
                or else (Token_Name = Name_Interface
--- 62,73 ----
  
        if Token = Tok_Identifier then
  
!          --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
!          --  OVERRIDING, and SYNCHRONIZED are new reserved words.
  
!          if Ada_Version = Ada_95
!            and then Warn_On_Ada_2005_Compatibility
!          then
              if Token_Name = Name_Overriding
                or else Token_Name = Name_Synchronized
                or else (Token_Name = Name_Interface
*************** package body Ch2 is
*** 231,236 ****
--- 239,248 ----
        Arg_Count : Int := 0;
        --  Number of argument associations processed
  
+       Identifier_Seen : Boolean := False;
+       --  Set True if an identifier is encountered for a pragma argument. Used
+       --  to check that there are no more arguments without identifiers.
+ 
        Pragma_Node   : Node_Id;
        Pragma_Name   : Name_Id;
        Semicolon_Loc : Source_Ptr;
*************** package body Ch2 is
*** 305,311 ****
  
           loop
              Arg_Count := Arg_Count + 1;
!             Assoc_Node := P_Pragma_Argument_Association;
  
              if Arg_Count = 2
                and then (Interface_Check_Required or else Import_Check_Required)
--- 317,323 ----
  
           loop
              Arg_Count := Arg_Count + 1;
!             Scan_Pragma_Argument_Association (Identifier_Seen, Assoc_Node);
  
              if Arg_Count = 2
                and then (Interface_Check_Required or else Import_Check_Required)
*************** package body Ch2 is
*** 438,451 ****
  
     --  Error recovery: cannot raise Error_Resync
  
!    function P_Pragma_Argument_Association return Node_Id is
        Scan_State      : Saved_Scan_State;
-       Pragma_Arg_Node : Node_Id;
        Identifier_Node : Node_Id;
  
     begin
!       Pragma_Arg_Node := New_Node (N_Pragma_Argument_Association, Token_Ptr);
!       Set_Chars (Pragma_Arg_Node, No_Name);
  
        if Token = Tok_Identifier then
           Identifier_Node := Token_Node;
--- 450,465 ----
  
     --  Error recovery: cannot raise Error_Resync
  
!    procedure Scan_Pragma_Argument_Association
!      (Identifier_Seen : in out Boolean;
!       Association     : out Node_Id)
!    is
        Scan_State      : Saved_Scan_State;
        Identifier_Node : Node_Id;
  
     begin
!       Association := New_Node (N_Pragma_Argument_Association, Token_Ptr);
!       Set_Chars (Association, No_Name);
  
        if Token = Tok_Identifier then
           Identifier_Node := Token_Node;
*************** package body Ch2 is
*** 453,469 ****
           Scan; -- past Identifier
  
           if Token = Tok_Arrow then
              Scan; -- past arrow
!             Set_Chars (Pragma_Arg_Node, Chars (Identifier_Node));
              Delete_Node (Identifier_Node);
           else
              Restore_Scan_State (Scan_State); -- to Identifier
           end if;
        end if;
  
!       Set_Expression (Pragma_Arg_Node, P_Expression);
!       return Pragma_Arg_Node;
! 
!    end P_Pragma_Argument_Association;
  
  end Ch2;
--- 467,490 ----
           Scan; -- past Identifier
  
           if Token = Tok_Arrow then
+             Identifier_Seen := True;
              Scan; -- past arrow
!             Set_Chars (Association, Chars (Identifier_Node));
              Delete_Node (Identifier_Node);
+ 
+             --  Case of argument with no identifier
+ 
           else
              Restore_Scan_State (Scan_State); -- to Identifier
+ 
+             if Identifier_Seen then
+                Error_Msg_SC
+                  ("|pragma argument identifier required here ('R'M' 2.8(4))");
+             end if;
           end if;
        end if;
  
!       Set_Expression (Association, P_Expression);
!    end Scan_Pragma_Argument_Association;
  
  end Ch2;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch3.adb gcc-4.1.0/gcc/ada/par-ch3.adb
*** gcc-4.0.2/gcc/ada/par-ch3.adb	Thu Feb 10 13:50:33 2005
--- gcc-4.1.0/gcc/ada/par-ch3.adb	Tue Nov 15 13:58:31 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,32 ****
  
  pragma Style_Checks (All_Checks);
  --  Turn off subprogram body ordering check. Subprograms are in order
! --  by RM section rather than alphabetical
  
  with Sinfo.CN; use Sinfo.CN;
  
--- 26,32 ----
  
  pragma Style_Checks (All_Checks);
  --  Turn off subprogram body ordering check. Subprograms are in order
! --  by RM section rather than alphabetical.
  
  with Sinfo.CN; use Sinfo.CN;
  
*************** package body Ch3 is
*** 175,185 ****
  
        if Token = Tok_Identifier then
  
!          --  Ada 2005 (AI-284): Compiling in Ada95 mode we notify
!          --  that interface, overriding, and synchronized are
!          --  new reserved words
  
!          if Ada_Version = Ada_95 then
              if Token_Name = Name_Overriding
                or else Token_Name = Name_Synchronized
                or else (Token_Name = Name_Interface
--- 175,186 ----
  
        if Token = Tok_Identifier then
  
!          --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
!          --  OVERRIDING, and SYNCHRONIZED are new reserved words.
  
!          if Ada_Version = Ada_95
!            and then Warn_On_Ada_2005_Compatibility
!          then
              if Token_Name = Name_Overriding
                or else Token_Name = Name_Synchronized
                or else (Token_Name = Name_Interface
*************** package body Ch3 is
*** 227,233 ****
     --  | CONCURRENT_TYPE_DECLARATION
  
     --  INCOMPLETE_TYPE_DECLARATION ::=
!    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART];
  
     --  PRIVATE_TYPE_DECLARATION ::=
     --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
--- 228,234 ----
     --  | CONCURRENT_TYPE_DECLARATION
  
     --  INCOMPLETE_TYPE_DECLARATION ::=
!    --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [IS TAGGED];
  
     --  PRIVATE_TYPE_DECLARATION ::=
     --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
*************** package body Ch3 is
*** 235,252 ****
  
     --  PRIVATE_EXTENSION_DECLARATION ::=
     --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!    --      [abstract] new ancestor_SUBTYPE_INDICATION with private;
  
     --  TYPE_DEFINITION ::=
     --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
     --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
     --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
!    --  | DERIVED_TYPE_DEFINITION
  
     --  INTEGER_TYPE_DEFINITION ::=
     --    SIGNED_INTEGER_TYPE_DEFINITION
     --    MODULAR_TYPE_DEFINITION
  
     --  Error recovery: can raise Error_Resync
  
     --  Note: The processing for full type declaration, incomplete type
--- 236,258 ----
  
     --  PRIVATE_EXTENSION_DECLARATION ::=
     --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!    --      [abstract] new ancestor_SUBTYPE_INDICATION
!    --      [and INTERFACE_LIST] with private;
  
     --  TYPE_DEFINITION ::=
     --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
     --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
     --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
!    --  | DERIVED_TYPE_DEFINITION      | INTERFACE_TYPE_DEFINITION
  
     --  INTEGER_TYPE_DEFINITION ::=
     --    SIGNED_INTEGER_TYPE_DEFINITION
     --    MODULAR_TYPE_DEFINITION
  
+    --  INTERFACE_TYPE_DEFINITION ::=
+    --    [limited | task | protected | synchronized ] interface
+    --      [AND interface_list]
+ 
     --  Error recovery: can raise Error_Resync
  
     --  Note: The processing for full type declaration, incomplete type
*************** package body Ch3 is
*** 256,281 ****
     --  function handles only declarations starting with TYPE).
  
     function P_Type_Declaration return Node_Id is
!       Type_Loc         : Source_Ptr;
!       Type_Start_Col   : Column_Number;
!       Ident_Node       : Node_Id;
        Decl_Node        : Node_Id;
        Discr_List       : List_Id;
-       Unknown_Dis      : Boolean;
        Discr_Sloc       : Source_Ptr;
-       Abstract_Present : Boolean;
-       Abstract_Loc     : Source_Ptr;
        End_Labl         : Node_Id;
  
!       Typedef_Node : Node_Id;
        --  Normally holds type definition, except in the case of a private
        --  extension declaration, in which case it holds the declaration itself
  
     begin
        Type_Loc := Token_Ptr;
        Type_Start_Col := Start_Column;
!       T_Type;
!       Ident_Node := P_Defining_Identifier (C_Is);
        Discr_Sloc := Token_Ptr;
  
        if P_Unknown_Discriminant_Part_Opt then
--- 262,309 ----
     --  function handles only declarations starting with TYPE).
  
     function P_Type_Declaration return Node_Id is
!       Abstract_Present : Boolean;
!       Abstract_Loc     : Source_Ptr;
        Decl_Node        : Node_Id;
        Discr_List       : List_Id;
        Discr_Sloc       : Source_Ptr;
        End_Labl         : Node_Id;
+       Type_Loc         : Source_Ptr;
+       Type_Start_Col   : Column_Number;
+       Ident_Node       : Node_Id;
+       Is_Derived_Iface : Boolean := False;
+       Unknown_Dis      : Boolean;
  
!       Typedef_Node     : Node_Id;
        --  Normally holds type definition, except in the case of a private
        --  extension declaration, in which case it holds the declaration itself
  
     begin
        Type_Loc := Token_Ptr;
        Type_Start_Col := Start_Column;
! 
!       --  If we have TYPE, then proceed ahead and scan identifier
! 
!       if Token = Tok_Type then
!          Scan; -- past TYPE
!          Ident_Node := P_Defining_Identifier (C_Is);
! 
!       --  Otherwise this is an error case, and we may already have converted
!       --  the current token to a defining identifier, so don't do it again!
! 
!       else
!          T_Type;
! 
!          if Token = Tok_Identifier
!            and then Nkind (Token_Node) = N_Defining_Identifier
!          then
!             Ident_Node := Token_Node;
!             Scan; -- past defining identifier
!          else
!             Ident_Node := P_Defining_Identifier (C_Is);
!          end if;
!       end if;
! 
        Discr_Sloc := Token_Ptr;
  
        if P_Unknown_Discriminant_Part_Opt then
*************** package body Ch3 is
*** 490,495 ****
--- 518,541 ----
              when Tok_Tagged =>
                 Scan; -- past TAGGED
  
+                --  Ada 2005 (AI-326): If the words IS TAGGED appear, the type
+                --  is a tagged incomplete type.
+ 
+                if Ada_Version >= Ada_05
+                  and then Token = Tok_Semicolon
+                then
+                   Scan; -- past ;
+ 
+                   Decl_Node :=
+                     New_Node (N_Incomplete_Type_Declaration, Type_Loc);
+                   Set_Defining_Identifier           (Decl_Node, Ident_Node);
+                   Set_Tagged_Present                (Decl_Node);
+                   Set_Unknown_Discriminants_Present (Decl_Node, Unknown_Dis);
+                   Set_Discriminant_Specifications   (Decl_Node, Discr_List);
+ 
+                   return Decl_Node;
+                end if;
+ 
                 if Token = Tok_Abstract then
                    Error_Msg_SC ("ABSTRACT must come before TAGGED");
                    Abstract_Present := True;
*************** package body Ch3 is
*** 551,562 ****
                 TF_Semicolon;
                 exit;
  
-             when Tok_Private =>
-                Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
-                Scan; -- past PRIVATE
-                TF_Semicolon;
-                exit;
- 
              when Tok_Limited =>
                 Scan; -- past LIMITED
  
--- 597,602 ----
*************** package body Ch3 is
*** 585,590 ****
--- 625,674 ----
                    Typedef_Node := P_Record_Definition;
                    Set_Limited_Present (Typedef_Node, True);
  
+                --  Ada 2005 (AI-251): LIMITED INTERFACE
+ 
+                --  If we are compiling in Ada 83 or Ada 95 mode, "interface"
+                --  is not a reserved word but we force its analysis to
+                --  generate the corresponding usage error.
+ 
+                elsif Token = Tok_Interface
+                  or else (Token = Tok_Identifier
+                            and then Chars (Token_Node) = Name_Interface)
+                then
+                   Typedef_Node := P_Interface_Type_Definition
+                                     (Is_Synchronized => False);
+                   Abstract_Present := True;
+                   Set_Limited_Present (Typedef_Node);
+ 
+                   if Nkind (Typedef_Node) = N_Derived_Type_Definition then
+                      Is_Derived_Iface := True;
+                   end if;
+ 
+                   --  Ada 2005 (AI-419): LIMITED NEW
+ 
+                elsif Token = Tok_New then
+                   if Ada_Version < Ada_05 then
+                      Error_Msg_SP
+                        ("LIMITED in derived type is an Ada 2005 extension");
+                      Error_Msg_SP
+                        ("\unit must be compiled with -gnat05 switch");
+                   end if;
+ 
+                   Typedef_Node := P_Derived_Type_Def_Or_Private_Ext_Decl;
+                   Set_Limited_Present (Typedef_Node);
+ 
+                   if Nkind (Typedef_Node) = N_Derived_Type_Definition
+                     and then Present (Record_Extension_Part (Typedef_Node))
+                   then
+                      End_Labl :=
+                        Make_Identifier (Token_Ptr,
+                                         Chars => Chars (Ident_Node));
+                      Set_Comes_From_Source (End_Labl, False);
+ 
+                      Set_End_Label
+                        (Record_Extension_Part (Typedef_Node), End_Labl);
+                   end if;
+ 
                 --  LIMITED PRIVATE is the only remaining possibility here
  
                 else
*************** package body Ch3 is
*** 634,639 ****
--- 718,773 ----
  
                 exit;
  
+             --  Ada 2005 (AI-251): INTERFACE
+ 
+             when Tok_Interface =>
+                Typedef_Node := P_Interface_Type_Definition
+                                 (Is_Synchronized => False);
+                Abstract_Present := True;
+                TF_Semicolon;
+                exit;
+ 
+             when Tok_Private =>
+                Decl_Node := New_Node (N_Private_Type_Declaration, Type_Loc);
+                Scan; -- past PRIVATE
+                TF_Semicolon;
+                exit;
+ 
+             --  Ada 2005 (AI-345)
+ 
+             when Tok_Protected    |
+                  Tok_Synchronized |
+                  Tok_Task         =>
+ 
+                declare
+                   Saved_Token : constant Token_Type := Token;
+ 
+                begin
+                   Scan; -- past TASK, PROTECTED or SYNCHRONIZED
+ 
+                   Typedef_Node := P_Interface_Type_Definition
+                                    (Is_Synchronized => True);
+                   Abstract_Present := True;
+ 
+                   case Saved_Token is
+                      when Tok_Task =>
+                         Set_Task_Present         (Typedef_Node);
+ 
+                      when Tok_Protected =>
+                         Set_Protected_Present    (Typedef_Node);
+ 
+                      when Tok_Synchronized =>
+                         Set_Synchronized_Present (Typedef_Node);
+ 
+                      when others =>
+                         pragma Assert (False);
+                         null;
+                   end case;
+                end;
+ 
+                TF_Semicolon;
+                exit;
+ 
              --  Anything else is an error
  
              when others =>
*************** package body Ch3 is
*** 693,698 ****
--- 827,833 ----
           if Nkind (Typedef_Node) = N_Record_Definition
             or else (Nkind (Typedef_Node) = N_Derived_Type_Definition
                        and then Present (Record_Extension_Part (Typedef_Node)))
+            or else Is_Derived_Iface
           then
              Set_Abstract_Present (Typedef_Node, Abstract_Present);
  
*************** package body Ch3 is
*** 743,748 ****
--- 878,884 ----
     function P_Subtype_Declaration return Node_Id is
        Decl_Node        : Node_Id;
        Not_Null_Present : Boolean := False;
+ 
     begin
        Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
        Scan; -- past SUBTYPE
*************** package body Ch3 is
*** 778,787 ****
           return False;
  
        else
           if Ada_Version < Ada_05 then
              Error_Msg_SP
!               ("null-excluding access is an Ada 2005 extension");
!             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
           end if;
  
           Scan; --  past NOT
--- 914,926 ----
           return False;
  
        else
+          --  Ada 2005 (AI-441): The qualifier has no semantic meaning in Ada 95
+          --  (all access Parameters Are "not null" in Ada 95).
+ 
           if Ada_Version < Ada_05 then
              Error_Msg_SP
!               ("null-excluding access is an Ada 2005 extension?");
!             Error_Msg_SP ("\unit should be compiled with -gnat05 switch?");
           end if;
  
           Scan; --  past NOT
*************** package body Ch3 is
*** 1031,1036 ****
--- 1170,1177 ----
     --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
     --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
     --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+    --      ACCESS_DEFINITION [:= EXPRESSION];
+    --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
     --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
  
     --  NUMBER_DECLARATION ::=
*************** package body Ch3 is
*** 1325,1332 ****
                    Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
                    Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
  
!                   Set_Object_Definition (Decl_Node,
!                      P_Subtype_Indication (Not_Null_Present));
                 end if;
  
                 if Token = Tok_Renames then
--- 1466,1486 ----
                    Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
                    Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
  
!                   if Token = Tok_Access then
!                      if Ada_Version < Ada_05 then
!                         Error_Msg_SP
!                           ("generalized use of anonymous access types " &
!                            "is an Ada 2005 extension");
!                         Error_Msg_SP
!                           ("\unit must be compiled with -gnat05 switch");
!                      end if;
! 
!                      Set_Object_Definition
!                        (Decl_Node, P_Access_Definition (Not_Null_Present));
!                   else
!                      Set_Object_Definition
!                        (Decl_Node, P_Subtype_Indication (Not_Null_Present));
!                   end if;
                 end if;
  
                 if Token = Tok_Renames then
*************** package body Ch3 is
*** 1372,1379 ****
              else
                 Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
                 Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
!                Set_Object_Definition (Decl_Node,
!                   P_Subtype_Indication (Not_Null_Present));
              end if;
  
           --  Array case
--- 1526,1549 ----
              else
                 Not_Null_Present := P_Null_Exclusion; --  Ada 2005 (AI-231)
                 Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
! 
!                --  Access definition (AI-406) or subtype indication
! 
!                if Token = Tok_Access then
!                   if Ada_Version < Ada_05 then
!                      Error_Msg_SP
!                        ("generalized use of anonymous access types " &
!                         "is an Ada 2005 extension");
!                      Error_Msg_SP
!                        ("\unit must be compiled with -gnat05 switch");
!                   end if;
! 
!                   Set_Object_Definition
!                     (Decl_Node, P_Access_Definition (Not_Null_Present));
!                else
!                   Set_Object_Definition
!                     (Decl_Node, P_Subtype_Indication (Not_Null_Present));
!                end if;
              end if;
  
           --  Array case
*************** package body Ch3 is
*** 1382,1394 ****
              Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
              Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
  
!          --  Ada 2005 (AI-254)
  
           elsif Token = Tok_Not then
  
              --  OBJECT_DECLARATION ::=
              --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
              --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
  
              --  OBJECT_RENAMING_DECLARATION ::=
              --    ...
--- 1552,1566 ----
              Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
              Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
  
!          --  Ada 2005 (AI-254, AI-406)
  
           elsif Token = Tok_Not then
  
              --  OBJECT_DECLARATION ::=
              --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
              --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+             --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+             --          ACCESS_DEFINITION [:= EXPRESSION];
  
              --  OBJECT_RENAMING_DECLARATION ::=
              --    ...
*************** package body Ch3 is
*** 1407,1422 ****
                 Acc_Node := P_Access_Definition (Not_Null_Present);
  
                 if Token /= Tok_Renames then
!                   Error_Msg_SC ("'RENAMES' expected");
!                   raise Error_Resync;
!                end if;
  
!                Scan; --  past renames
!                No_List;
!                Decl_Node :=
!                  New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
!                Set_Access_Definition (Decl_Node, Acc_Node);
!                Set_Name (Decl_Node, P_Name);
  
              else
                 Type_Node := P_Subtype_Mark;
--- 1579,1596 ----
                 Acc_Node := P_Access_Definition (Not_Null_Present);
  
                 if Token /= Tok_Renames then
!                   Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
!                   Set_Object_Definition (Decl_Node, Acc_Node);
!                   goto init;
  
!                else
!                   Scan; --  past renames
!                   No_List;
!                   Decl_Node :=
!                     New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
!                   Set_Access_Definition (Decl_Node, Acc_Node);
!                   Set_Name (Decl_Node, P_Name);
!                end if;
  
              else
                 Type_Node := P_Subtype_Mark;
*************** package body Ch3 is
*** 1462,1478 ****
  
              Acc_Node := P_Access_Definition (Null_Exclusion_Present => False);
  
              if Token /= Tok_Renames then
!                Error_Msg_SC ("'RENAMES' expected");
!                raise Error_Resync;
!             end if;
  
!             Scan; --  past renames
!             No_List;
!             Decl_Node :=
!               New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
!             Set_Access_Definition (Decl_Node, Acc_Node);
!             Set_Name (Decl_Node, P_Name);
  
           --  Subtype indication case
  
--- 1636,1656 ----
  
              Acc_Node := P_Access_Definition (Null_Exclusion_Present => False);
  
+             --  Object declaration with access definition, or renaming
+ 
              if Token /= Tok_Renames then
!                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
!                Set_Object_Definition (Decl_Node, Acc_Node);
!                goto init; -- ??? is this really needed goes here anyway
  
!             else
!                Scan; --  past renames
!                No_List;
!                Decl_Node :=
!                  New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
!                Set_Access_Definition (Decl_Node, Acc_Node);
!                Set_Name (Decl_Node, P_Name);
!             end if;
  
           --  Subtype indication case
  
*************** package body Ch3 is
*** 1511,1516 ****
--- 1689,1695 ----
  
           --  Scan out initialization, allowed only for object declaration
  
+          <<init>> -- is this really needed ???
           Init_Loc := Token_Ptr;
           Init_Expr := Init_Expr_Opt;
  
*************** package body Ch3 is
*** 1582,1593 ****
     -------------------------------------------------------------------------
  
     --  DERIVED_TYPE_DEFINITION ::=
!    --    [abstract] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
!    --    [RECORD_EXTENSION_PART]
  
     --  PRIVATE_EXTENSION_DECLARATION ::=
     --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!    --       [abstract] new ancestor_SUBTYPE_INDICATION with PRIVATE;
  
     --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
  
--- 1761,1773 ----
     -------------------------------------------------------------------------
  
     --  DERIVED_TYPE_DEFINITION ::=
!    --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
!    --    [[AND interface_list] RECORD_EXTENSION_PART]
  
     --  PRIVATE_EXTENSION_DECLARATION ::=
     --     type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!    --       [abstract] [limited] new ancestor_SUBTYPE_INDICATION
!    --       [AND interface_list] with PRIVATE;
  
     --  RECORD_EXTENSION_PART ::= with RECORD_DEFINITION
  
*************** package body Ch3 is
*** 1605,1610 ****
--- 1785,1791 ----
        Typedef_Node     : Node_Id;
        Typedecl_Node    : Node_Id;
        Not_Null_Present : Boolean := False;
+ 
     begin
        Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
        T_New;
*************** package body Ch3 is
*** 1619,1624 ****
--- 1800,1830 ----
        Set_Subtype_Indication (Typedef_Node,
           P_Subtype_Indication (Not_Null_Present));
  
+       --  Ada 2005 (AI-251): Deal with interfaces
+ 
+       if Token = Tok_And then
+          Scan; -- past AND
+ 
+          if Ada_Version < Ada_05 then
+             Error_Msg_SP
+               ("abstract interface is an Ada 2005 extension");
+             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+          end if;
+ 
+          Set_Interface_List (Typedef_Node, New_List);
+ 
+          loop
+             Append (P_Qualified_Simple_Name, Interface_List (Typedef_Node));
+             exit when Token /= Tok_And;
+             Scan; -- past AND
+          end loop;
+ 
+          if Token /= Tok_With then
+             Error_Msg_SC ("WITH expected");
+             raise Error_Resync;
+          end if;
+       end if;
+ 
        --  Deal with record extension, note that we assume that a WITH is
        --  missing in the case of "type X is new Y record ..." or in the
        --  case of "type X is new Y null record".
*************** package body Ch3 is
*** 1649,1655 ****
                Make_Private_Extension_Declaration (No_Location,
                  Defining_Identifier => Empty,
                  Subtype_Indication  => Subtype_Indication (Typedef_Node),
!                 Abstract_Present    => Abstract_Present (Typedef_Node));
  
              Delete_Node (Typedef_Node);
              return Typedecl_Node;
--- 1855,1862 ----
                Make_Private_Extension_Declaration (No_Location,
                  Defining_Identifier => Empty,
                  Subtype_Indication  => Subtype_Indication (Typedef_Node),
!                 Abstract_Present    => Abstract_Present (Typedef_Node),
!                 Interface_List      => Interface_List (Typedef_Node));
  
              Delete_Node (Typedef_Node);
              return Typedecl_Node;
*************** package body Ch3 is
*** 3279,3284 ****
--- 3486,3579 ----
  
     --  Parsed by P_Derived_Type_Def_Or_Private_Ext_Decl (3.4)
  
+    --------------------------------------
+    -- 3.9.4  Interface Type Definition --
+    --------------------------------------
+ 
+    --  INTERFACE_TYPE_DEFINITION ::=
+    --    [limited | task | protected | synchronized] interface
+    --      [AND interface_list]
+ 
+    --  Error recovery: cannot raise Error_Resync
+ 
+    function P_Interface_Type_Definition
+       (Is_Synchronized : Boolean) return Node_Id
+    is
+       Typedef_Node : Node_Id;
+ 
+    begin
+       if Ada_Version < Ada_05 then
+          Error_Msg_SP ("abstract interface is an Ada 2005 extension");
+          Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+       end if;
+ 
+       Scan; -- past INTERFACE
+ 
+       --  Ada 2005 (AI-345): In case of synchronized interfaces and
+       --  interfaces with a null list of interfaces we build a
+       --  record_definition node.
+ 
+       if Is_Synchronized
+         or else Token = Tok_Semicolon
+       then
+          Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
+ 
+          Set_Abstract_Present  (Typedef_Node);
+          Set_Tagged_Present    (Typedef_Node);
+          Set_Null_Present      (Typedef_Node);
+          Set_Interface_Present (Typedef_Node);
+ 
+          if Is_Synchronized
+            and then Token = Tok_And
+          then
+             Scan; -- past AND
+             Set_Interface_List (Typedef_Node, New_List);
+ 
+             loop
+                Append (P_Qualified_Simple_Name,
+                        Interface_List (Typedef_Node));
+                exit when Token /= Tok_And;
+                Scan; -- past AND
+             end loop;
+          end if;
+ 
+       --  Ada 2005 (AI-251): In case of not-synchronized interfaces that have
+       --  a list of interfaces we build a derived_type_definition node. This
+       --  simplifies the semantic analysis (and hence further mainteinance)
+ 
+       else
+          if Token /= Tok_And then
+             Error_Msg_AP ("AND expected");
+          else
+             Scan; -- past AND
+          end if;
+ 
+          Typedef_Node := New_Node (N_Derived_Type_Definition, Token_Ptr);
+ 
+          Set_Abstract_Present   (Typedef_Node);
+          Set_Interface_Present  (Typedef_Node);
+          Set_Subtype_Indication (Typedef_Node, P_Qualified_Simple_Name);
+ 
+          Set_Record_Extension_Part (Typedef_Node,
+            New_Node (N_Record_Definition, Token_Ptr));
+          Set_Null_Present (Record_Extension_Part (Typedef_Node));
+ 
+          if Token = Tok_And then
+             Set_Interface_List (Typedef_Node, New_List);
+             Scan; -- past AND
+ 
+             loop
+                Append (P_Qualified_Simple_Name,
+                        Interface_List (Typedef_Node));
+                exit when Token /= Tok_And;
+                Scan; -- past AND
+             end loop;
+          end if;
+       end if;
+ 
+       return Typedef_Node;
+    end P_Interface_Type_Definition;
+ 
     ----------------------------------
     -- 3.10  Access Type Definition --
     ----------------------------------
*************** package body Ch3 is
*** 3313,3318 ****
--- 3608,3615 ----
        Prot_Flag             : Boolean;
        Not_Null_Present      : Boolean := False;
        Type_Def_Node         : Node_Id;
+       Result_Not_Null       : Boolean;
+       Result_Node           : Node_Id;
  
        procedure Check_Junk_Subprogram_Name;
        --  Used in access to subprogram definition cases to check for an
*************** package body Ch3 is
*** 3383,3390 ****
           Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
           Set_Protected_Present (Type_Def_Node, Prot_Flag);
           TF_Return;
!          Set_Subtype_Mark (Type_Def_Node, P_Subtype_Mark);
!          No_Constraint;
  
        else
           Type_Def_Node :=
--- 3680,3711 ----
           Set_Parameter_Specifications (Type_Def_Node, P_Parameter_Profile);
           Set_Protected_Present (Type_Def_Node, Prot_Flag);
           TF_Return;
! 
!          Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
! 
!          --  Ada 2005 (AI-318-02)
! 
!          if Token = Tok_Access then
!             if Ada_Version < Ada_05 then
!                Error_Msg_SC
!                  ("anonymous access result type is an Ada 2005 extension");
!                Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
!             end if;
! 
!             Result_Node := P_Access_Definition (Result_Not_Null);
! 
!          else
!             Result_Node := P_Subtype_Mark;
!             No_Constraint;
!          end if;
! 
!          --  Note: A null exclusion given on the result type needs to
!          --  be coded by a distinct flag, since Null_Exclusion_Present
!          --  on an access-to-function type pertains to a null exclusion
!          --  on the access type itself (as set above). ???
!          --  Set_Null_Exclusion_Present??? (Type_Def_Node, Result_Not_Null);
! 
!          Set_Result_Definition (Type_Def_Node, Result_Node);
  
        else
           Type_Def_Node :=
*************** package body Ch3 is
*** 3495,3505 ****
        --  Ada 95
  
        else
-          --  Ada 2005 (AI-254): The null-exclusion present is never present
-          --  in Ada 83 and Ada 95
- 
-          pragma Assert (Null_Exclusion_Present = False);
- 
           Set_Null_Exclusion_Present (Def_Node, False);
           Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
           No_Constraint;
--- 3816,3821 ----
*************** package body Ch3 is
*** 3619,3624 ****
--- 3935,3954 ----
              Check_Bad_Layout;
              P_Identifier_Declarations (Decls, Done, In_Spec);
  
+          --  Ada2005: A subprogram declaration can start with "not" or
+          --  "overriding". In older versions, "overriding" is handled
+          --  like an identifier, with the appropriate warning.
+ 
+          when Tok_Not =>
+             Check_Bad_Layout;
+             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub), Decls);
+             Done := False;
+ 
+          when Tok_Overriding =>
+             Check_Bad_Layout;
+             Append (P_Subprogram (Pf_Decl_Gins_Pbod_Rnam_Stub), Decls);
+             Done := False;
+ 
           when Tok_Package =>
              Check_Bad_Layout;
              Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub), Decls);
*************** package body Ch3 is
*** 3921,3927 ****
  
        SIS_Entry_Active := False;
  
!       --  Test for assorted illegal declarations not diagnosed elsewhere.
  
        Decl := First (Decls);
  
--- 4251,4257 ----
  
        SIS_Entry_Active := False;
  
!       --  Test for assorted illegal declarations not diagnosed elsewhere
  
        Decl := First (Decls);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch4.adb gcc-4.1.0/gcc/ada/par-ch4.adb
*** gcc-4.0.2/gcc/ada/par-ch4.adb	Mon Jan  3 15:32:15 2005
--- gcc-4.1.0/gcc/ada/par-ch4.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch4 is
*** 402,409 ****
--- 402,426 ----
                    if Apostrophe_Should_Be_Semicolon then
                       Expr_Form := EF_Name;
                       return Name_Node;
+ 
+                   --  Here for a bad attribute name
+ 
                    else
                       Signal_Bad_Attribute;
+                      Scan; -- past bad identifier
+ 
+                      if Token = Tok_Left_Paren then
+                         Scan; -- past left paren
+ 
+                         loop
+                            Discard_Junk_Node (P_Expression);
+                            exit when not Comma_Present;
+                         end loop;
+ 
+                         T_Right_Paren;
+                      end if;
+ 
+                      return Error;
                    end if;
                 end if;
  
*************** package body Ch4 is
*** 490,496 ****
  
           --   (discrete_range)
  
!          --      This is a slice. This case is handled in LP_State_Init.
  
           --   (expression, expression, ..)
  
--- 507,513 ----
  
           --   (discrete_range)
  
!          --      This is a slice. This case is handled in LP_State_Init
  
           --   (expression, expression, ..)
  
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch5.adb gcc-4.1.0/gcc/ada/par-ch5.adb
*** gcc-4.0.2/gcc/ada/par-ch5.adb	Fri Nov 19 10:56:52 2004
--- gcc-4.1.0/gcc/ada/par-ch5.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch5 is
*** 1215,1221 ****
                 --  Here we have an else that really is an else
  
                 if Present (Else_Statements (If_Node)) then
!                   Error_Msg_SP ("Only one ELSE part allowed");
                    Append_List
                      (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq),
                       Else_Statements (If_Node));
--- 1215,1221 ----
                 --  Here we have an else that really is an else
  
                 if Present (Else_Statements (If_Node)) then
!                   Error_Msg_SP ("only one ELSE part allowed");
                    Append_List
                      (P_Sequence_Of_Statements (SS_Eftm_Eltm_Sreq),
                       Else_Statements (If_Node));
*************** package body Ch5 is
*** 1671,1677 ****
  
     --  This function parses a block statement with DECLARE present
  
!    --  The caller has checked that the initial token is DECLARE.
  
     --  Error recovery: cannot raise Error_Resync
  
--- 1671,1677 ----
  
     --  This function parses a block statement with DECLARE present
  
!    --  The caller has checked that the initial token is DECLARE
  
     --  Error recovery: cannot raise Error_Resync
  
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch6.adb gcc-4.1.0/gcc/ada/par-ch6.adb
*** gcc-4.0.2/gcc/ada/par-ch6.adb	Mon Jun  7 14:16:22 2004
--- gcc-4.1.0/gcc/ada/par-ch6.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Ch6 is
*** 39,44 ****
--- 39,45 ----
     function P_Defining_Operator_Symbol   return Node_Id;
  
     procedure Check_Junk_Semicolon_Before_Return;
+ 
     --  Check for common error of junk semicolon before RETURN keyword of
     --  function specification. If present, skip over it with appropriate
     --  error message, leaving Scan_Ptr pointing to the RETURN after. This
*************** package body Ch6 is
*** 58,64 ****
  
           if Token = Tok_Return then
              Restore_Scan_State (Scan_State);
!             Error_Msg_SC ("Unexpected semicolon ignored");
              Scan; -- rescan past junk semicolon
  
           else
--- 59,65 ----
  
           if Token = Tok_Return then
              Restore_Scan_State (Scan_State);
!             Error_Msg_SC ("unexpected semicolon ignored");
              Scan; -- rescan past junk semicolon
  
           else
*************** package body Ch6 is
*** 109,114 ****
--- 110,122 ----
     --  | function DEFINING_DESIGNATOR is
     --      new generic_function_NAME [GENERIC_ACTUAL_PART];
  
+    --  NULL_PROCEDURE_DECLARATION ::=
+    --    SUBPROGRAM_SPECIFICATION is null;
+ 
+    --  Null procedures are an Ada 2005 feature. A null procedure declaration
+    --  is classified as a basic declarative item, but it is parsed here, with
+    --  other subprogram constructs.
+ 
     --  The value in Pf_Flags indicates which of these possible declarations
     --  is acceptable to the caller:
  
*************** package body Ch6 is
*** 123,147 ****
     --  context is issued. The only possible values for Pf_Flags are those
     --  defined as constants in the Par package.
  
!    --  The caller has checked that the initial token is FUNCTION or PROCEDURE
  
     --  Error recovery: cannot raise Error_Resync
  
     function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id is
        Specification_Node : Node_Id;
!       Name_Node   : Node_Id;
!       Fpart_List  : List_Id;
!       Fpart_Sloc  : Source_Ptr;
!       Return_Node : Node_Id;
!       Inst_Node   : Node_Id;
!       Body_Node   : Node_Id;
!       Decl_Node   : Node_Id;
!       Rename_Node : Node_Id;
!       Absdec_Node : Node_Id;
!       Stub_Node   : Node_Id;
!       Fproc_Sloc  : Source_Ptr;
!       Func        : Boolean;
!       Scan_State  : Saved_Scan_State;
  
     begin
        --  Set up scope stack entry. Note that the Labl field will be set later
--- 131,164 ----
     --  context is issued. The only possible values for Pf_Flags are those
     --  defined as constants in the Par package.
  
!    --  The caller has checked that the initial token is FUNCTION, PROCEDURE,
!    --  NOT or OVERRIDING.
  
     --  Error recovery: cannot raise Error_Resync
  
     function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id is
        Specification_Node : Node_Id;
!       Name_Node          : Node_Id;
!       Fpart_List         : List_Id;
!       Fpart_Sloc         : Source_Ptr;
!       Result_Not_Null    : Boolean := False;
!       Result_Node        : Node_Id;
!       Inst_Node          : Node_Id;
!       Body_Node          : Node_Id;
!       Decl_Node          : Node_Id;
!       Rename_Node        : Node_Id;
!       Absdec_Node        : Node_Id;
!       Stub_Node          : Node_Id;
!       Fproc_Sloc         : Source_Ptr;
!       Func               : Boolean;
!       Scan_State         : Saved_Scan_State;
! 
!       --  Flags for optional overriding indication. Two flags are needed,
!       --  to distinguish positive and negative overriding indicators from
!       --  the absence of any indicator.
! 
!       Is_Overriding  : Boolean := False;
!       Not_Overriding : Boolean := False;
  
     begin
        --  Set up scope stack entry. Note that the Labl field will be set later
*************** package body Ch6 is
*** 154,159 ****
--- 171,211 ----
        Scope.Table (Scope.Last).Ecol := Start_Column;
        Scope.Table (Scope.Last).Lreq := False;
  
+       --  Ada2005: scan leading overriding indicator
+ 
+       if Token = Tok_Not then
+          Scan;  -- past NOT
+ 
+          if Token = Tok_Overriding then
+             Scan;  --  past OVERRIDING
+             Not_Overriding := True;
+          else
+             Error_Msg_SC ("OVERRIDING expected!");
+          end if;
+ 
+       elsif Token = Tok_Overriding then
+          Scan;  --  past OVERRIDING
+          Is_Overriding := True;
+       end if;
+ 
+       if (Is_Overriding or else Not_Overriding) then
+          if Ada_Version < Ada_05 then
+             Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
+             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ 
+          --  An overriding indicator is allowed for subprogram declarations,
+          --  bodies, renamings, stubs, and instantiations.
+ 
+          elsif Pf_Flags /= Pf_Decl_Gins_Pbod_Rnam_Stub then
+             Error_Msg_SC ("overriding indicator not allowed here!");
+ 
+          elsif Token /= Tok_Function
+            and then Token /= Tok_Procedure
+          then
+             Error_Msg_SC ("FUNCTION or PROCEDURE expected!");
+          end if;
+       end if;
+ 
        Func := (Token = Tok_Function);
        Fproc_Sloc := Token_Ptr;
        Scan; -- past FUNCTION or PROCEDURE
*************** package body Ch6 is
*** 202,208 ****
  
        if Token = Tok_Is then
           Save_Scan_State (Scan_State); -- at the IS
!          T_Is; -- checks for redundant IS's
  
           if Token = Tok_New then
              if not Pf_Flags.Gins then
--- 254,260 ----
  
        if Token = Tok_Is then
           Save_Scan_State (Scan_State); -- at the IS
!          T_Is; -- checks for redundant IS
  
           if Token = Tok_New then
              if not Pf_Flags.Gins then
*************** package body Ch6 is
*** 223,228 ****
--- 275,288 ----
              Set_Generic_Associations (Inst_Node, P_Generic_Actual_Part_Opt);
              TF_Semicolon;
              Pop_Scope_Stack; -- Don't need scope stack entry in this case
+ 
+             if Is_Overriding then
+                Set_Must_Override (Inst_Node);
+ 
+             elsif Not_Overriding then
+                Set_Must_Not_Override (Inst_Node);
+             end if;
+ 
              return Inst_Node;
  
           else
*************** package body Ch6 is
*** 259,265 ****
        --  since later RETURN statements will be valid in either case.
  
        Check_Junk_Semicolon_Before_Return;
!       Return_Node := Error;
  
        if Token = Tok_Return then
           if not Func then
--- 319,325 ----
        --  since later RETURN statements will be valid in either case.
  
        Check_Junk_Semicolon_Before_Return;
!       Result_Node := Error;
  
        if Token = Tok_Return then
           if not Func then
*************** package body Ch6 is
*** 268,275 ****
           end if;
  
           Scan; -- past RETURN
!          Return_Node := P_Subtype_Mark;
!          No_Constraint;
  
        else
           if Func then
--- 328,351 ----
           end if;
  
           Scan; -- past RETURN
! 
!          Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
! 
!          --  Ada 2005 (AI-318-02)
! 
!          if Token = Tok_Access then
!             if Ada_Version < Ada_05 then
!                Error_Msg_SC
!                  ("anonymous access result type is an Ada 2005 extension");
!                Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
!             end if;
! 
!             Result_Node := P_Access_Definition (Result_Not_Null);
! 
!          else
!             Result_Node := P_Subtype_Mark;
!             No_Constraint;
!          end if;
  
        else
           if Func then
*************** package body Ch6 is
*** 281,287 ****
        if Func then
           Specification_Node :=
             New_Node (N_Function_Specification, Fproc_Sloc);
!          Set_Subtype_Mark (Specification_Node, Return_Node);
  
        else
           Specification_Node :=
--- 357,365 ----
        if Func then
           Specification_Node :=
             New_Node (N_Function_Specification, Fproc_Sloc);
! 
!          Set_Null_Exclusion_Present (Specification_Node, Result_Not_Null);
!          Set_Result_Definition (Specification_Node, Result_Node);
  
        else
           Specification_Node :=
*************** package body Ch6 is
*** 291,296 ****
--- 369,381 ----
        Set_Defining_Unit_Name (Specification_Node, Name_Node);
        Set_Parameter_Specifications (Specification_Node, Fpart_List);
  
+       if Is_Overriding then
+          Set_Must_Override (Specification_Node);
+ 
+       elsif Not_Overriding then
+          Set_Must_Not_Override (Specification_Node);
+       end if;
+ 
        --  Error check: barriers not allowed on protected functions/procedures
  
        if Token = Tok_When then
*************** package body Ch6 is
*** 384,389 ****
--- 469,493 ----
                 TF_Semicolon;
                 return Absdec_Node;
  
+             --  Ada 2005 (AI-248): Parse a null procedure declaration
+ 
+             elsif Token = Tok_Null then
+                if Ada_Version < Ada_05 then
+                   Error_Msg_SP ("null procedures are an Ada 2005 extension");
+                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+                end if;
+ 
+                Scan; -- past NULL
+ 
+                if Func then
+                   Error_Msg_SP ("only procedures can be null");
+                else
+                   Set_Null_Present (Specification_Node);
+                end if;
+ 
+                TF_Semicolon;
+                goto Subprogram_Declaration;
+ 
              --  Check for IS NEW with Formal_Part present and handle nicely
  
              elsif Token = Tok_New then
*************** package body Ch6 is
*** 533,538 ****
--- 637,644 ----
  
     function P_Subprogram_Specification return Node_Id is
        Specification_Node : Node_Id;
+       Result_Not_Null    : Boolean;
+       Result_Node        : Node_Id;
  
     begin
        if Token = Tok_Function then
*************** package body Ch6 is
*** 544,551 ****
             (Specification_Node, P_Parameter_Profile);
           Check_Junk_Semicolon_Before_Return;
           TF_Return;
!          Set_Subtype_Mark (Specification_Node, P_Subtype_Mark);
!          No_Constraint;
           return Specification_Node;
  
        elsif Token = Tok_Procedure then
--- 650,676 ----
             (Specification_Node, P_Parameter_Profile);
           Check_Junk_Semicolon_Before_Return;
           TF_Return;
! 
!          Result_Not_Null := P_Null_Exclusion;     --  Ada 2005 (AI-231)
! 
!          --  Ada 2005 (AI-318-02)
! 
!          if Token = Tok_Access then
!             if Ada_Version < Ada_05 then
!                Error_Msg_SC
!                  ("anonymous access result type is an Ada 2005 extension");
!                Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
!             end if;
! 
!             Result_Node := P_Access_Definition (Result_Not_Null);
! 
!          else
!             Result_Node := P_Subtype_Mark;
!             No_Constraint;
!          end if;
! 
!          Set_Null_Exclusion_Present (Specification_Node, Result_Not_Null);
!          Set_Result_Definition (Specification_Node, Result_Node);
           return Specification_Node;
  
        elsif Token = Tok_Procedure then
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch7.adb gcc-4.1.0/gcc/ada/par-ch7.adb
*** gcc-4.0.2/gcc/ada/par-ch7.adb	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/par-ch7.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch8.adb gcc-4.1.0/gcc/ada/par-ch8.adb
*** gcc-4.0.2/gcc/ada/par-ch8.adb	Mon Jun  7 14:16:23 2004
--- gcc-4.1.0/gcc/ada/par-ch8.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/par-ch9.adb gcc-4.1.0/gcc/ada/par-ch9.adb
*** gcc-4.0.2/gcc/ada/par-ch9.adb	Mon Jun  7 14:16:23 2004
--- gcc-4.1.0/gcc/ada/par-ch9.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,32 ****
  ------------------------------------------------------------------------------
  
  pragma Style_Checks (All_Checks);
! --  Turn off subprogram body ordering check. Subprograms are in order
! --  by RM section rather than alphabetical
  
  separate (Par)
  package body Ch9 is
--- 25,32 ----
  ------------------------------------------------------------------------------
  
  pragma Style_Checks (All_Checks);
! --  Turn off subprogram body ordering check. Subprograms are in order by RM
! --  section rather than alphabetical.
  
  separate (Par)
  package body Ch9 is
*************** package body Ch9 is
*** 53,62 ****
  
     --  TASK_TYPE_DECLARATION ::=
     --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!    --      [is TASK_DEFINITION];
  
     --  SINGLE_TASK_DECLARATION ::=
!    --    task DEFINING_IDENTIFIER [is TASK_DEFINITION];
  
     --  TASK_BODY ::=
     --    task body DEFINING_IDENTIFIER is
--- 53,63 ----
  
     --  TASK_TYPE_DECLARATION ::=
     --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!    --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
  
     --  SINGLE_TASK_DECLARATION ::=
!    --    task DEFINING_IDENTIFIER
!    --      [is [new INTERFACE_LIST with] TASK_DEFINITION];
  
     --  TASK_BODY ::=
     --    task body DEFINING_IDENTIFIER is
*************** package body Ch9 is
*** 161,166 ****
--- 162,198 ----
              end if;
           else
              TF_Is; -- must have IS if no semicolon
+ 
+             --  Ada 2005 (AI-345)
+ 
+             if Token = Tok_New then
+                Scan; --  past NEW
+ 
+                if Ada_Version < Ada_05 then
+                   Error_Msg_SP ("task interface is an Ada 2005 extension");
+                   Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+                end if;
+ 
+                Set_Interface_List (Task_Node, New_List);
+ 
+                loop
+                   Append (P_Qualified_Simple_Name, Interface_List (Task_Node));
+                   exit when Token /= Tok_And;
+                   Scan; --  past AND
+                end loop;
+ 
+                if Token /= Tok_With then
+                   Error_Msg_SC ("WITH expected");
+                end if;
+ 
+                Scan; -- past WITH
+ 
+                if Token = Tok_Private then
+                   Error_Msg_SP
+                     ("PRIVATE not allowed in task type declaration");
+                end if;
+             end if;
+ 
              Set_Task_Definition (Task_Node, P_Task_Definition);
           end if;
  
*************** package body Ch9 is
*** 214,220 ****
           --  Deal gracefully with multiple PRIVATE parts
  
           while Token = Tok_Private loop
!             Error_Msg_SC ("Only one private part allowed per task");
              Scan; -- past PRIVATE
              Append_List (P_Task_Items, Private_Declarations (Def_Node));
           end loop;
--- 246,252 ----
           --  Deal gracefully with multiple PRIVATE parts
  
           while Token = Tok_Private loop
!             Error_Msg_SC ("only one private part allowed per task");
              Scan; -- past PRIVATE
              Append_List (P_Task_Items, Private_Declarations (Def_Node));
           end loop;
*************** package body Ch9 is
*** 258,264 ****
           if Token = Tok_Pragma then
              Append (P_Pragma, Items);
  
!          elsif Token = Tok_Entry then
              Append (P_Entry_Declaration, Items);
  
           elsif Token = Tok_For then
--- 290,302 ----
           if Token = Tok_Pragma then
              Append (P_Pragma, Items);
  
!          --  Ada 2005 (AI-397): Reserved words NOT and OVERRIDING
!          --  may begin an entry declaration.
! 
!          elsif Token = Tok_Entry
!            or else Token = Tok_Not
!            or else Token = Tok_Overriding
!          then
              Append (P_Entry_Declaration, Items);
  
           elsif Token = Tok_For then
*************** package body Ch9 is
*** 285,291 ****
           elsif Token = Tok_Identifier
             or else Token in Token_Class_Declk
           then
!             Error_Msg_SC ("Illegal declaration in task definition");
              Resync_Past_Semicolon;
  
           else
--- 323,329 ----
           elsif Token = Tok_Identifier
             or else Token in Token_Class_Declk
           then
!             Error_Msg_SC ("illegal declaration in task definition");
              Resync_Past_Semicolon;
  
           else
*************** package body Ch9 is
*** 308,317 ****
  
     --  PROTECTED_TYPE_DECLARATION ::=
     --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!    --      is PROTECTED_DEFINITION;
  
     --  SINGLE_PROTECTED_DECLARATION ::=
!    --    protected DEFINING_IDENTIFIER is PROTECTED_DEFINITION;
  
     --  PROTECTED_BODY ::=
     --    protected body DEFINING_IDENTIFIER is
--- 346,356 ----
  
     --  PROTECTED_TYPE_DECLARATION ::=
     --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!    --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
  
     --  SINGLE_PROTECTED_DECLARATION ::=
!    --    protected DEFINING_IDENTIFIER
!    --    is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
  
     --  PROTECTED_BODY ::=
     --    protected body DEFINING_IDENTIFIER is
*************** package body Ch9 is
*** 402,407 ****
--- 441,479 ----
           end if;
  
           T_Is;
+ 
+          --  Ada 2005 (AI-345)
+ 
+          if Token = Tok_New then
+             Scan; --  past NEW
+ 
+             if Ada_Version < Ada_05 then
+                Error_Msg_SP ("task interface is an Ada 2005 extension");
+                Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+             end if;
+ 
+             Set_Interface_List (Protected_Node, New_List);
+ 
+             loop
+                Append (P_Qualified_Simple_Name,
+                  Interface_List (Protected_Node));
+ 
+                exit when Token /= Tok_And;
+                Scan; --  past AND
+             end loop;
+ 
+             if Token /= Tok_With then
+                Error_Msg_SC ("WITH expected");
+             end if;
+ 
+             Scan; -- past WITH
+ 
+             if Token = Tok_Private then
+                Error_Msg_SP
+                  ("PRIVATE not allowed in protected type declaration");
+             end if;
+          end if;
+ 
           Set_Protected_Definition (Protected_Node, P_Protected_Definition);
           return Protected_Node;
        end if;
*************** package body Ch9 is
*** 507,512 ****
--- 579,641 ----
        L : List_Id;
        P : Source_Ptr;
  
+       function P_Entry_Or_Subprogram_With_Indicator return Node_Id;
+       --  Ada 2005 (AI-397): Parse an entry or a subprogram with an overriding
+       --  indicator. The caller has checked that the initial token is NOT or
+       --  OVERRIDING.
+ 
+       ------------------------------------------
+       -- P_Entry_Or_Subprogram_With_Indicator --
+       ------------------------------------------
+ 
+       function P_Entry_Or_Subprogram_With_Indicator return Node_Id is
+          Decl           : Node_Id := Error;
+          Is_Overriding  : Boolean := False;
+          Not_Overriding : Boolean := False;
+ 
+       begin
+          if Token = Tok_Not then
+             Scan;  -- past NOT
+ 
+             if Token = Tok_Overriding then
+                Scan;  -- past OVERRIDING
+                Not_Overriding := True;
+             else
+                Error_Msg_SC ("OVERRIDING expected!");
+             end if;
+ 
+          else
+             Scan;  -- past OVERRIDING
+             Is_Overriding := True;
+          end if;
+ 
+          if (Is_Overriding or else Not_Overriding) then
+             if Ada_Version < Ada_05 then
+                Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
+                Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ 
+             elsif Token = Tok_Entry then
+                Decl := P_Entry_Declaration;
+ 
+                Set_Must_Override     (Decl, Is_Overriding);
+                Set_Must_Not_Override (Decl, Not_Overriding);
+ 
+             elsif Token = Tok_Function or else Token = Tok_Procedure then
+                Decl := P_Subprogram (Pf_Decl);
+ 
+                Set_Must_Override     (Specification (Decl), Is_Overriding);
+                Set_Must_Not_Override (Specification (Decl), Not_Overriding);
+ 
+             else
+                Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!");
+             end if;
+          end if;
+ 
+          return Decl;
+       end P_Entry_Or_Subprogram_With_Indicator;
+ 
+    --  Start of processing for P_Protected_Operation_Declaration_Opt
+ 
     begin
        --  This loop runs more than once only when a junk declaration
        --  is skipped.
*************** package body Ch9 is
*** 515,520 ****
--- 644,652 ----
           if Token = Tok_Pragma then
              return P_Pragma;
  
+          elsif Token = Tok_Not or else Token = Tok_Overriding then
+             return P_Entry_Or_Subprogram_With_Indicator;
+ 
           elsif Token = Tok_Entry then
              return P_Entry_Declaration;
  
*************** package body Ch9 is
*** 615,624 ****
     ------------------------------
  
     --  ENTRY_DECLARATION ::=
     --    entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
     --      PARAMETER_PROFILE;
  
!    --  The caller has checked that the initial token is ENTRY
  
     --  Error recovery: cannot raise Error_Resync
  
--- 747,758 ----
     ------------------------------
  
     --  ENTRY_DECLARATION ::=
+    --    [OVERRIDING_INDICATOR]
     --    entry DEFINING_IDENTIFIER [(DISCRETE_SUBTYPE_DEFINITION)]
     --      PARAMETER_PROFILE;
  
!    --  The caller has checked that the initial token is ENTRY, NOT or
!    --  OVERRIDING.
  
     --  Error recovery: cannot raise Error_Resync
  
*************** package body Ch9 is
*** 626,632 ****
--- 760,800 ----
        Decl_Node  : Node_Id;
        Scan_State : Saved_Scan_State;
  
+       --  Flags for optional overriding indication. Two flags are needed,
+       --  to distinguish positive and negative overriding indicators from
+       --  the absence of any indicator.
+ 
+       Is_Overriding  : Boolean := False;
+       Not_Overriding : Boolean := False;
+ 
     begin
+       --  Ada 2005 (AI-397): Scan leading overriding indicator
+ 
+       if Token = Tok_Not then
+          Scan;  -- past NOT
+ 
+          if Token = Tok_Overriding then
+             Scan;  -- part OVERRIDING
+             Not_Overriding := True;
+          else
+             Error_Msg_SC ("OVERRIDING expected!");
+          end if;
+ 
+       elsif Token = Tok_Overriding then
+          Scan;  -- part OVERRIDING
+          Is_Overriding := True;
+       end if;
+ 
+       if (Is_Overriding or else Not_Overriding) then
+          if Ada_Version < Ada_05 then
+             Error_Msg_SP (" overriding indicator is an Ada 2005 extension");
+             Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+ 
+          elsif Token /= Tok_Entry then
+             Error_Msg_SC ("ENTRY expected!");
+          end if;
+       end if;
+ 
        Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
        Scan; -- past ENTRY
  
*************** package body Ch9 is
*** 670,675 ****
--- 838,849 ----
           end if;
        end if;
  
+       if Is_Overriding then
+          Set_Must_Override (Decl_Node);
+       elsif Not_Overriding then
+          Set_Must_Not_Override (Decl_Node);
+       end if;
+ 
        --  Error recovery check for illegal return
  
        if Token = Tok_Return then
*************** package body Ch9 is
*** 688,693 ****
--- 862,872 ----
  
        TF_Semicolon;
        return Decl_Node;
+ 
+    exception
+       when Error_Resync =>
+          Resync_Past_Semicolon;
+          return Error;
     end P_Entry_Declaration;
  
     -----------------------------
*************** package body Ch9 is
*** 1178,1184 ****
              elsif Nkind (Ecall_Node) = N_Identifier
                or else Nkind (Ecall_Node) = N_Selected_Component
              then
!                --  Case of a call to a parameterless entry.
  
                 declare
                    C_Node : constant Node_Id :=
--- 1357,1363 ----
              elsif Nkind (Ecall_Node) = N_Identifier
                or else Nkind (Ecall_Node) = N_Selected_Component
              then
!                --  Case of a call to a parameterless entry
  
                 declare
                    C_Node : constant Node_Id :=
diff -Nrcpad gcc-4.0.2/gcc/ada/par-endh.adb gcc-4.1.0/gcc/ada/par-endh.adb
*** gcc-4.0.2/gcc/ada/par-endh.adb	Tue Oct 21 13:42:10 2003
--- gcc-4.1.0/gcc/ada/par-endh.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Endh is
*** 87,93 ****
     --  child unit or a node with a Chars field identifying the actual label.
  
     End_Labl_Present : Boolean;
!    --  Indicates that the value in End_Labl was for an explicit label.
  
     Syntax_OK : Boolean;
     --  Set True if the entry is syntactically correct
--- 87,93 ----
     --  child unit or a node with a Chars field identifying the actual label.
  
     End_Labl_Present : Boolean;
!    --  Indicates that the value in End_Labl was for an explicit label
  
     Syntax_OK : Boolean;
     --  Set True if the entry is syntactically correct
diff -Nrcpad gcc-4.0.2/gcc/ada/par-labl.adb gcc-4.1.0/gcc/ada/par-labl.adb
*** gcc-4.0.2/gcc/ada/par-labl.adb	Thu Jul 15 20:34:36 2004
--- gcc-4.1.0/gcc/ada/par-labl.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure Labl is
*** 42,51 ****
     --  Next label node to process
  
     function Find_Enclosing_Body_Or_Block (N : Node_Id) return Node_Id;
!    --  Find the innermost body or block that encloses N.
  
     function Find_Enclosing_Body (N : Node_Id) return Node_Id;
!    --  Find the innermost body that encloses N.
  
     procedure Check_Distinct_Labels;
     --  Checks the rule in RM-5.1(11), which requires distinct identifiers
--- 42,51 ----
     --  Next label node to process
  
     function Find_Enclosing_Body_Or_Block (N : Node_Id) return Node_Id;
!    --  Find the innermost body or block that encloses N
  
     function Find_Enclosing_Body (N : Node_Id) return Node_Id;
!    --  Find the innermost body that encloses N
  
     procedure Check_Distinct_Labels;
     --  Checks the rule in RM-5.1(11), which requires distinct identifiers
*************** procedure Labl is
*** 134,140 ****
        Result : Node_Id := Parent (N);
  
     begin
!       --  Climb up the parent chain until we find a body or block.
  
        while Present (Result)
          and then Nkind (Result) /= N_Accept_Statement
--- 134,140 ----
        Result : Node_Id := Parent (N);
  
     begin
!       --  Climb up the parent chain until we find a body or block
  
        while Present (Result)
          and then Nkind (Result) /= N_Accept_Statement
*************** procedure Labl is
*** 160,166 ****
        Succ      : Elmt_Id;
  
        function Goto_Id (Goto_Node : Node_Id) return Name_Id;
!       --  Find Name_Id of goto statement, which may be an expanded name.
  
        function Matches
          (Label_Node : Node_Id;
--- 160,166 ----
        Succ      : Elmt_Id;
  
        function Goto_Id (Goto_Node : Node_Id) return Name_Id;
!       --  Find Name_Id of goto statement, which may be an expanded name
  
        function Matches
          (Label_Node : Node_Id;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-load.adb gcc-4.1.0/gcc/ada/par-load.adb
*** gcc-4.0.2/gcc/ada/par-load.adb	Mon Mar 29 12:03:14 2004
--- gcc-4.1.0/gcc/ada/par-load.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 30,42 ****
  --  and parents of subunits. All these units are loaded and pointers installed
  --  in the tree as described in the spec of package Lib.
  
- with Fname;    use Fname;
  with Fname.UF; use Fname.UF;
  with Lib.Load; use Lib.Load;
  with Uname;    use Uname;
- with Namet;    use Namet;
- with Casing;   use Casing;
- with Opt;      use Opt;
  with Osint;    use Osint;
  with Sinput.L; use Sinput.L;
  with Stylesw;  use Stylesw;
--- 30,38 ----
*************** procedure Load is
*** 87,92 ****
--- 83,91 ----
     Unum : Unit_Number_Type;
     --  Unit number of loaded unit
  
+    Limited_With_Found : Boolean := False;
+    --  Set True if a limited WITH is found, used to ???
+ 
     function Same_File_Name_Except_For_Case
       (Expected_File_Name : File_Name_Type;
        Actual_File_Name   : File_Name_Type) return Boolean;
*************** begin
*** 297,305 ****
           return;
        end if;
  
!    --  If current unit is a child unit spec, load its parent
  
!    elsif Nkind (Unit (Curunit)) = N_Package_Declaration
       or else Nkind (Unit (Curunit)) =  N_Subprogram_Declaration
       or else Nkind (Unit (Curunit)) in N_Generic_Declaration
       or else Nkind (Unit (Curunit)) in N_Generic_Instantiation
--- 296,305 ----
           return;
        end if;
  
!    --  If current unit is a child unit spec, load its parent. If the child unit
!    --  is loaded through a limited with, the parent must be as well.
  
!    elsif     Nkind (Unit (Curunit)) = N_Package_Declaration
       or else Nkind (Unit (Curunit)) =  N_Subprogram_Declaration
       or else Nkind (Unit (Curunit)) in N_Generic_Declaration
       or else Nkind (Unit (Curunit)) in N_Generic_Instantiation
*************** begin
*** 317,326 ****
        if Spec_Name /= No_Name then
           Unum :=
             Load_Unit
!              (Load_Name  => Spec_Name,
!               Required   => True,
!               Subunit    => False,
!               Error_Node => Curunit);
  
           if Unum /= No_Unit then
              Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
--- 317,327 ----
        if Spec_Name /= No_Name then
           Unum :=
             Load_Unit
!              (Load_Name         => Spec_Name,
!               Required          => True,
!               Subunit           => False,
!               Error_Node        => Curunit,
!               From_Limited_With => From_Limited_With);
  
           if Unum /= No_Unit then
              Set_Parent_Spec (Unit (Curunit), Cunit (Unum));
*************** begin
*** 350,429 ****
        Reset_Validity_Check_Options;
     end if;
  
!    --  Loop through context items
  
!    Context_Node := First (Context_Items (Curunit));
!    while Present (Context_Node) loop
!       if Nkind (Context_Node) = N_With_Clause then
!          With_Node := Context_Node;
!          Spec_Name := Get_Unit_Name (With_Node);
  
!          Unum :=
!            Load_Unit
!              (Load_Name  => Spec_Name,
!               Required   => False,
!               Subunit    => False,
!               Error_Node => With_Node,
!               Renamings  => True);
  
!          --  If we find the unit, then set spec pointer in the N_With_Clause
!          --  to point to the compilation unit for the spec. Remember that
!          --  the Load routine itself sets our Fatal_Error flag if the loaded
!          --  unit gets a fatal error, so we don't need to worry about that.
  
!          if Unum /= No_Unit then
!             Set_Library_Unit (With_Node, Cunit (Unum));
  
!          --  If the spec isn't found, then try finding the corresponding
!          --  body, since it is possible that we have a subprogram body
!          --  that is acting as a spec (since no spec is present).
  
-          else
-             Body_Name := Get_Body_Name (Spec_Name);
              Unum :=
                Load_Unit
!                 (Load_Name  => Body_Name,
!                  Required   => False,
!                  Subunit    => False,
!                  Error_Node => With_Node,
!                  Renamings  => True);
  
!             --  If we got a subprogram body, then mark that we are using
!             --  the body as a spec in the file table, and set the spec
!             --  pointer in the N_With_Clause to point to the body entity.
  
!             if Unum /= No_Unit
!               and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body
!             then
!                With_Cunit := Cunit (Unum);
!                Set_Library_Unit (With_Node, With_Cunit);
!                Set_Acts_As_Spec (With_Cunit, True);
!                Set_Library_Unit (With_Cunit, With_Cunit);
  
!             --  If we couldn't find the body, or if it wasn't a body spec
!             --  then we are in trouble. We make one more call to Load to
!             --  require the spec. We know it will fail of course, the
!             --  purpose is to generate the required error message (we prefer
!             --  that this message refer to the missing spec, not the body)
  
              else
                 Unum :=
                   Load_Unit
!                    (Load_Name  => Spec_Name,
!                     Required   => True,
                      Subunit    => False,
                      Error_Node => With_Node,
                      Renamings  => True);
  
!                --  Here we create a dummy package unit for the missing unit
  
!                Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name);
!                Set_Library_Unit (With_Node, Cunit (Unum));
              end if;
           end if;
-       end if;
  
!       Next (Context_Node);
     end loop;
  
     --  Restore style/validity check mode for main unit
--- 351,459 ----
        Reset_Validity_Check_Options;
     end if;
  
!    --  Load the context items in two rounds: the first round handles normal
!    --  withed units and the second round handles Ada 2005 limited-withed units.
!    --  This is required to allow the low-level circuitry that detects circular
!    --  dependencies of units the correct notification of the following error:
  
!    --       limited with D;
!    --       with D;                  with C;
!    --       package C is ...         package D is ...
  
!    for Round in 1 .. 2 loop
!       Context_Node := First (Context_Items (Curunit));
!       while Present (Context_Node) loop
  
!          --  During the first round we check if there is some limited-with
!          --  context clause; otherwise the second round will be skipped
  
!          if Nkind (Context_Node) = N_With_Clause
!            and then Round = 1
!            and then Limited_Present (Context_Node)
!          then
!             Limited_With_Found := True;
!          end if;
  
!          if Nkind (Context_Node) = N_With_Clause
!            and then ((Round = 1 and then not Limited_Present (Context_Node))
!                         or else
!                      (Round = 2 and then Limited_Present (Context_Node)))
!          then
!             With_Node := Context_Node;
!             Spec_Name := Get_Unit_Name (With_Node);
  
              Unum :=
                Load_Unit
!                 (Load_Name         => Spec_Name,
!                  Required          => False,
!                  Subunit           => False,
!                  Error_Node        => With_Node,
!                  Renamings         => True,
!                  From_Limited_With => From_Limited_With
!                                         or else
!                                       Limited_Present (Context_Node));
  
!             --  If we find the unit, then set spec pointer in the N_With_Clause
!             --  to point to the compilation unit for the spec. Remember that
!             --  the Load routine itself sets our Fatal_Error flag if the loaded
!             --  unit gets a fatal error, so we don't need to worry about that.
  
!             if Unum /= No_Unit then
!                Set_Library_Unit (With_Node, Cunit (Unum));
  
!             --  If the spec isn't found, then try finding the corresponding
!             --  body, since it is possible that we have a subprogram body
!             --  that is acting as a spec (since no spec is present).
  
              else
+                Body_Name := Get_Body_Name (Spec_Name);
                 Unum :=
                   Load_Unit
!                    (Load_Name  => Body_Name,
!                     Required   => False,
                      Subunit    => False,
                      Error_Node => With_Node,
                      Renamings  => True);
  
!                --  If we got a subprogram body, then mark that we are using
!                --  the body as a spec in the file table, and set the spec
!                --  pointer in the N_With_Clause to point to the body entity.
  
!                if Unum /= No_Unit
!                  and then Nkind (Unit (Cunit (Unum))) = N_Subprogram_Body
!                then
!                   With_Cunit := Cunit (Unum);
!                   Set_Library_Unit (With_Node, With_Cunit);
!                   Set_Acts_As_Spec (With_Cunit, True);
!                   Set_Library_Unit (With_Cunit, With_Cunit);
! 
!                --  If we couldn't find the body, or if it wasn't a body spec
!                --  then we are in trouble. We make one more call to Load to
!                --  require the spec. We know it will fail of course, the
!                --  purpose is to generate the required error message (we prefer
!                --  that this message refer to the missing spec, not the body)
! 
!                else
!                   Unum :=
!                     Load_Unit
!                       (Load_Name  => Spec_Name,
!                        Required   => True,
!                        Subunit    => False,
!                        Error_Node => With_Node,
!                        Renamings  => True);
! 
!                   --  Here we create a dummy package unit for the missing unit
! 
!                   Unum := Create_Dummy_Package_Unit (With_Node, Spec_Name);
!                   Set_Library_Unit (With_Node, Cunit (Unum));
!                end if;
              end if;
           end if;
  
!          Next (Context_Node);
!       end loop;
! 
!       exit when not Limited_With_Found;
     end loop;
  
     --  Restore style/validity check mode for main unit
diff -Nrcpad gcc-4.0.2/gcc/ada/par-prag.adb gcc-4.1.0/gcc/ada/par-prag.adb
*** gcc-4.0.2/gcc/ada/par-prag.adb	Thu Feb 10 13:50:26 2005
--- gcc-4.1.0/gcc/ada/par-prag.adb	Tue Nov 15 14:04:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** function Prag (Pragma_Node : Node_Id; Se
*** 233,239 ****
           elsif Id = Name_No_Dependence then
              Set_Restriction_No_Dependence
                (Unit => Expr,
!                Warn  => Prag_Id = Pragma_Restriction_Warnings);
           end if;
  
           Next (Arg);
--- 233,239 ----
           elsif Id = Name_No_Dependence then
              Set_Restriction_No_Dependence
                (Unit => Expr,
!                Warn => Prag_Id = Pragma_Restriction_Warnings);
           end if;
  
           Next (Arg);
*************** begin
*** 288,293 ****
--- 288,294 ----
  
        when Pragma_Ada_83 =>
           Ada_Version := Ada_83;
+          Ada_Version_Explicit := Ada_Version;
  
        ------------
        -- Ada_95 --
*************** begin
*** 299,304 ****
--- 300,306 ----
  
        when Pragma_Ada_95 =>
           Ada_Version := Ada_95;
+          Ada_Version_Explicit := Ada_Version;
  
        ------------
        -- Ada_05 --
*************** begin
*** 312,317 ****
--- 314,320 ----
        when Pragma_Ada_05 =>
           if Arg_Count = 0 then
              Ada_Version := Ada_05;
+             Ada_Version_Explicit := Ada_Version;
           end if;
  
        -----------
*************** begin
*** 370,375 ****
--- 373,380 ----
              Ada_Version := Ada_Version_Type'Min (Ada_Version, Ada_95);
           end if;
  
+          Ada_Version_Explicit := Ada_Version;
+ 
        ----------------
        -- List (2.8) --
        ----------------
*************** begin
*** 958,979 ****
        ---------------------
  
        --  pragma Warnings (On | Off, [LOCAL_NAME])
  
!       --  The one argument case is processed by the parser, since it may
!       --  control parser warnings as well as semantic warnings, and in any
!       --  case we want to be absolutely sure that the range in the warnings
!       --  table is set well before any semantic analysis is performed.
  
        when Pragma_Warnings =>
           if Arg_Count = 1 then
              Check_No_Identifier (Arg1);
-             Check_Arg_Is_On_Or_Off (Arg1);
  
!             if Chars (Expression (Arg1)) = Name_On then
!                Set_Warnings_Mode_On (Pragma_Sloc);
!             else
!                Set_Warnings_Mode_Off (Pragma_Sloc);
!             end if;
           end if;
  
        -----------------------
--- 963,990 ----
        ---------------------
  
        --  pragma Warnings (On | Off, [LOCAL_NAME])
+       --  pragma Warnings (static_string_EXPRESSION);
  
!       --  The one argument ON/OFF case is processed by the parser, since it may
!       --  control parser warnings as well as semantic warnings, and in any case
!       --  we want to be absolutely sure that the range in the warnings table is
!       --  set well before any semantic analysis is performed.
  
        when Pragma_Warnings =>
           if Arg_Count = 1 then
              Check_No_Identifier (Arg1);
  
!             declare
!                Argx : constant Node_Id := Expression (Arg1);
!             begin
!                if Nkind (Argx) = N_Identifier then
!                   if Chars (Argx) = Name_On then
!                      Set_Warnings_Mode_On (Pragma_Sloc);
!                   elsif Chars (Argx) = Name_Off then
!                      Set_Warnings_Mode_Off (Pragma_Sloc);
!                   end if;
!                end if;
!             end;
           end if;
  
        -----------------------
*************** begin
*** 984,989 ****
--- 995,1001 ----
        --  entirely in Sem_Prag, and no further checking is done by Par.
  
        when Pragma_Abort_Defer                  |
+            Pragma_Assertion_Policy             |
             Pragma_AST_Entry                    |
             Pragma_All_Calls_Remote             |
             Pragma_Annotate                     |
*************** begin
*** 1005,1010 ****
--- 1017,1023 ----
             Pragma_Component_Alignment          |
             Pragma_Controlled                   |
             Pragma_Convention                   |
+            Pragma_Debug_Policy                 |
             Pragma_Detect_Blocking              |
             Pragma_Discard_Names                |
             Pragma_Eliminate                    |
*************** begin
*** 1048,1053 ****
--- 1061,1068 ----
             Pragma_License                      |
             Pragma_Link_With                    |
             Pragma_Linker_Alias                 |
+            Pragma_Linker_Constructor           |
+            Pragma_Linker_Destructor            |
             Pragma_Linker_Options               |
             Pragma_Linker_Section               |
             Pragma_Locking_Policy               |
*************** begin
*** 1066,1080 ****
             Pragma_Pack                         |
             Pragma_Passive                      |
             Pragma_Polling                      |
!            Pragma_Persistent_Data              |
!            Pragma_Persistent_Object            |
             Pragma_Preelaborate                 |
             Pragma_Priority                     |
             Pragma_Profile                      |
             Pragma_Profile_Warnings             |
             Pragma_Propagate_Exceptions         |
             Pragma_Psect_Object                 |
             Pragma_Pure                         |
             Pragma_Pure_Function                |
             Pragma_Queuing_Policy               |
             Pragma_Remote_Call_Interface        |
--- 1081,1096 ----
             Pragma_Pack                         |
             Pragma_Passive                      |
             Pragma_Polling                      |
!            Pragma_Persistent_BSS               |
             Pragma_Preelaborate                 |
+            Pragma_Preelaborate_05              |
             Pragma_Priority                     |
             Pragma_Profile                      |
             Pragma_Profile_Warnings             |
             Pragma_Propagate_Exceptions         |
             Pragma_Psect_Object                 |
             Pragma_Pure                         |
+            Pragma_Pure_05                      |
             Pragma_Pure_Function                |
             Pragma_Queuing_Policy               |
             Pragma_Remote_Call_Interface        |
diff -Nrcpad gcc-4.0.2/gcc/ada/par-sync.adb gcc-4.1.0/gcc/ada/par-sync.adb
*** gcc-4.0.2/gcc/ada/par-sync.adb	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/par-sync.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/par-tchk.adb gcc-4.1.0/gcc/ada/par-tchk.adb
*** gcc-4.0.2/gcc/ada/par-tchk.adb	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/par-tchk.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Token scan routines.
  
  --  Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
  
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Token scan routines
  
  --  Error recovery: none of the T_xxx or TF_xxx routines raise Error_Resync
  
*************** package body Tchk is
*** 801,807 ****
        M : String (1 .. Missing'Length + Tok_Name'Length);
  
     begin
!       --  Set M to Missing & Tok_Name.
  
        M (1 .. Missing'Length) := Missing;
        M (Missing'Length + 1 .. M'Last) := Tok_Name;
--- 801,807 ----
        M : String (1 .. Missing'Length + Tok_Name'Length);
  
     begin
!       --  Set M to Missing & Tok_Name
  
        M (1 .. Missing'Length) := Missing;
        M (Missing'Length + 1 .. M'Last) := Tok_Name;
diff -Nrcpad gcc-4.0.2/gcc/ada/par-util.adb gcc-4.1.0/gcc/ada/par-util.adb
*** gcc-4.0.2/gcc/ada/par-util.adb	Fri Jun 25 16:39:29 2004
--- gcc-4.1.0/gcc/ada/par-util.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/par.adb gcc-4.1.0/gcc/ada/par.adb
*** gcc-4.0.2/gcc/ada/par.adb	Mon Jan  3 15:40:30 2005
--- gcc-4.1.0/gcc/ada/par.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Tbuild;   use Tbuild;
*** 50,57 ****
  -- Par --
  ---------
  
! function Par (Configuration_Pragmas : Boolean) return List_Id is
! 
     Num_Library_Units : Natural := 0;
     --  Count number of units parsed (relevant only in syntax check only mode,
     --  since in semantics check mode only a single unit is permitted anyway)
--- 50,59 ----
  -- Par --
  ---------
  
! function Par
!   (Configuration_Pragmas : Boolean;
!    From_Limited_With     : Boolean := False) return List_Id
! is
     Num_Library_Units : Natural := 0;
     --  Count number of units parsed (relevant only in syntax check only mode,
     --  since in semantics check mode only a single unit is permitted anyway)
*************** function Par (Configuration_Pragmas : Bo
*** 92,98 ****
     --  an entry in the scope stack, invalidating the contents of the stack.
  
     Error_Resync : exception;
!    --  Exception raised on error that is not handled locally, see above.
  
     Last_Resync_Point : Source_Ptr;
     --  The resynchronization routines in Par.Sync run a risk of getting
--- 94,100 ----
     --  an entry in the scope stack, invalidating the contents of the stack.
  
     Error_Resync : exception;
!    --  Exception raised on error that is not handled locally, see above
  
     Last_Resync_Point : Source_Ptr;
     --  The resynchronization routines in Par.Sync run a risk of getting
*************** function Par (Configuration_Pragmas : Bo
*** 601,606 ****
--- 603,619 ----
        --  treatment of errors in case a reserved word is scanned. See the
        --  declaration of this type for details.
  
+       function P_Interface_Type_Definition
+         (Is_Synchronized : Boolean) return Node_Id;
+       --  Ada 2005 (AI-251): Parse the interface type definition part. The
+       --  parameter Is_Synchronized is True in case of task interfaces,
+       --  protected interfaces, and synchronized interfaces; it is used to
+       --  generate a record_definition node. In the rest of cases (limited
+       --  interfaces and interfaces) we generate a record_definition node if
+       --  the list of interfaces is empty; otherwise we generate a
+       --  derived_type_definition node (the first interface in this list is the
+       --  ancestor interface).
+ 
        function P_Null_Exclusion return Boolean;
        --  Ada 2005 (AI-231): Parse the null-excluding part. True indicates
        --  that the null-excluding part was present.
*************** begin
*** 1262,1268 ****
  
        for Ucount in Pos loop
           Set_Opt_Config_Switches
!            (Is_Internal_File_Name (File_Name (Current_Source_File)));
  
           --  Initialize scope table and other parser control variables
  
--- 1275,1282 ----
  
        for Ucount in Pos loop
           Set_Opt_Config_Switches
!            (Is_Internal_File_Name (File_Name (Current_Source_File)),
!             Current_Source_Unit = Main_Unit);
  
           --  Initialize scope table and other parser control variables
  
*************** begin
*** 1307,1315 ****
                 end if;
              end;
  
!             --  Here if we are not skipping a file in multiple unit per file
!             --  mode. Parse the unit that we are interested in. Note that in
!             --  check syntax mode we are interested in all units in the file.
  
           else
              declare
--- 1321,1329 ----
                 end if;
              end;
  
!          --  Here if we are not skipping a file in multiple unit per file
!          --  mode. Parse the unit that we are interested in. Note that in
!          --  check syntax mode we are interested in all units in the file.
  
           else
              declare
*************** begin
*** 1344,1368 ****
  
                       Name := Uname (Uname'First .. Uname'Last - 2);
  
!                      if (Name = "ada"                    or else
!                          Name = "calendar"               or else
!                          Name = "interfaces"             or else
!                          Name = "system"                 or else
!                          Name = "machine_code"           or else
!                          Name = "unchecked_conversion"   or else
!                          Name = "unchecked_deallocation"
!                            or else (Name'Length > 4
!                                      and then
!                                        Name (Name'First .. Name'First + 3) =
!                                                                  "ada.")
!                            or else (Name'Length > 11
!                                      and then
!                                        Name (Name'First .. Name'First + 10) =
!                                                                  "interfaces.")
!                            or else (Name'Length > 7
!                                      and then
!                                        Name (Name'First .. Name'First + 6) =
!                                                                  "system."))
                         and then Name /= "system.rpc"
                         and then
                           (Name'Length < 11
--- 1358,1395 ----
  
                       Name := Uname (Uname'First .. Uname'Last - 2);
  
!                      if Name = "ada"                    or else
!                         Name = "calendar"               or else
!                         Name = "interfaces"             or else
!                         Name = "system"                 or else
!                         Name = "machine_code"           or else
!                         Name = "unchecked_conversion"   or else
!                         Name = "unchecked_deallocation"
!                      then
!                         Error_Msg
!                           ("language defined units may not be recompiled",
!                            Sloc (Unit (Comp_Unit_Node)));
! 
!                      elsif Name'Length > 4
!                        and then
!                          Name (Name'First .. Name'First + 3) = "ada."
!                      then
!                         Error_Msg
!                           ("descendents of package Ada " &
!                              "may not be compiled",
!                            Sloc (Unit (Comp_Unit_Node)));
! 
!                      elsif Name'Length > 11
!                        and then
!                          Name (Name'First .. Name'First + 10) = "interfaces."
!                      then
!                         Error_Msg
!                           ("descendents of package Interfaces " &
!                              "may not be compiled",
!                            Sloc (Unit (Comp_Unit_Node)));
! 
!                      elsif Name'Length > 7
!                        and then Name (Name'First .. Name'First + 6) = "system."
                         and then Name /= "system.rpc"
                         and then
                           (Name'Length < 11
*************** begin
*** 1370,1376 ****
                                                                   "system.rpc.")
                       then
                          Error_Msg
!                           ("language defined units may not be recompiled",
                             Sloc (Unit (Comp_Unit_Node)));
                       end if;
                    end;
--- 1397,1404 ----
                                                                   "system.rpc.")
                       then
                          Error_Msg
!                           ("descendents of package System " &
!                              "may not be compiled",
                             Sloc (Unit (Comp_Unit_Node)));
                       end if;
                    end;
diff -Nrcpad gcc-4.0.2/gcc/ada/par.ads gcc-4.1.0/gcc/ada/par.ads
*** gcc-4.0.2/gcc/ada/par.ads	Thu Apr 24 17:54:07 2003
--- gcc-4.1.0/gcc/ada/par.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,42 ****
  
  with Types; use Types;
  
! function Par (Configuration_Pragmas : Boolean) return List_Id;
  --  Top level parsing routine. There are two cases:
  --
  --  If Configuration_Pragmas is False, Par parses a compilation unit in the
  --  current source file and sets the Cunit, Cunit_Entity and Unit_Name fields
  --  of the units table entry for Current_Source_Unit. On return the parse tree
  --  is complete, and decorated with any required implicit label declarations.
! --  The value returned in this case is always No_List.
  --
  --  If Configuration_Pragmas is True, Par parses a list of configuration
  --  pragmas from the current source file, and returns the list of pragmas.
--- 29,46 ----
  
  with Types; use Types;
  
! function Par
!   (Configuration_Pragmas : Boolean;
!    From_Limited_With     : Boolean := False) return List_Id;
  --  Top level parsing routine. There are two cases:
  --
  --  If Configuration_Pragmas is False, Par parses a compilation unit in the
  --  current source file and sets the Cunit, Cunit_Entity and Unit_Name fields
  --  of the units table entry for Current_Source_Unit. On return the parse tree
  --  is complete, and decorated with any required implicit label declarations.
! --  The value returned in this case is always No_List. If From_Limited_With is
! --  True, we are parsing a compilation unit found in a limited-with clause (Ada
! --  2005, AI-50217)
  --
  --  If Configuration_Pragmas is True, Par parses a list of configuration
  --  pragmas from the current source file, and returns the list of pragmas.
diff -Nrcpad gcc-4.0.2/gcc/ada/prep.adb gcc-4.1.0/gcc/ada/prep.adb
*** gcc-4.0.2/gcc/ada/prep.adb	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prep.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Snames;   use Snames;
*** 35,41 ****
  with Sinput;
  with Stringt;  use Stringt;
  with Table;
- with Types;    use Types;
  
  with GNAT.Heap_Sort_G;
  
--- 35,40 ----
*************** package body Prep is
*** 129,135 ****
     -- Behaviour --
     ---------------
  
!    --  Accesses to procedure specified by procedure Initialize.
  
     Error_Msg : Error_Msg_Proc;
     --  Report an error
--- 128,134 ----
     -- Behaviour --
     ---------------
  
!    --  Accesses to procedure specified by procedure Initialize
  
     Error_Msg : Error_Msg_Proc;
     --  Report an error
*************** package body Prep is
*** 160,166 ****
        --  Used to detect multiple #else.
  
        Deleting : Boolean;
!       --  Set to True when the code should be deleted or commented out.
  
        Match_Seen : Boolean;
        --  Set to True when a condition in an #if or an #elsif is True.
--- 159,165 ----
        --  Used to detect multiple #else.
  
        Deleting : Boolean;
!       --  Set to True when the code should be deleted or commented out
  
        Match_Seen : Boolean;
        --  Set to True when a condition in an #if or an #elsif is True.
*************** package body Prep is
*** 277,284 ****
           then
              for J in Index + 1 .. Definition'Last loop
                 case Definition (J) is
!                   when '_' | '.' | '0' .. '9' |
!                     'a' .. 'z' | 'A' .. 'Z' =>
                       null;
  
                    when others =>
--- 276,282 ----
           then
              for J in Index + 1 .. Definition'Last loop
                 case Definition (J) is
!                   when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
                       null;
  
                    when others =>
*************** package body Prep is
*** 337,344 ****
        --  Put the symbol name in the result
  
        declare
!          Sym : constant String :=
!            Name_Buffer (1 .. Name_Len);
  
        begin
           for Index in 1 .. Name_Len loop
--- 335,341 ----
        --  Put the symbol name in the result
  
        declare
!          Sym : constant String := Name_Buffer (1 .. Name_Len);
  
        begin
           for Index in 1 .. Name_Len loop
*************** package body Prep is
*** 375,387 ****
     ----------------
  
     function Expression (Evaluate_It : Boolean) return Boolean is
!       Evaluation       : Boolean := Evaluate_It;
        --  Is set to False after an "or else" when left term is True and
        --  after an "and then" when left term is False.
  
!       Final_Result     : Boolean := False;
  
!       Current_Result   : Boolean := False;
        --  Value of a term
  
        Current_Operator : Operator := None;
--- 372,384 ----
     ----------------
  
     function Expression (Evaluate_It : Boolean) return Boolean is
!       Evaluation : Boolean := Evaluate_It;
        --  Is set to False after an "or else" when left term is True and
        --  after an "and then" when left term is False.
  
!       Final_Result : Boolean := False;
  
!       Current_Result : Boolean := False;
        --  Value of a term
  
        Current_Operator : Operator := None;
*************** package body Prep is
*** 431,436 ****
--- 428,434 ----
                 Scan.all;
  
                 if Token = Tok_Apostrophe then
+ 
                    --  symbol'Defined
  
                    Scan.all;
*************** package body Prep is
*** 691,699 ****
  
        procedure Output_Line (From, To : Source_Ptr);
        --  Output a line or the end of a line from the buffer to the output
!       --  file, followed by an end of line terminator.
!       --  Depending on the value of Deleting and the switches, the line
!       --  may be commented out, blank or not output at all.
  
        ------------
        -- Output --
--- 689,697 ----
  
        procedure Output_Line (From, To : Source_Ptr);
        --  Output a line or the end of a line from the buffer to the output
!       --  file, followed by an end of line terminator. Depending on the value
!       --  of Deleting and the switches, the line may be commented out, blank or
!       --  not output at all.
  
        ------------
        -- Output --
*************** package body Prep is
*** 740,752 ****
     begin
        Start_Of_Processing := Scan_Ptr;
  
!       --  We need to call Scan for the first time, because Initialyze_Scanner
        --  is no longer doing it.
  
        Scan.all;
  
!       Input_Line_Loop :
!       loop
           exit Input_Line_Loop when Token = Tok_EOF;
  
           Preprocessor_Line := False;
--- 738,749 ----
     begin
        Start_Of_Processing := Scan_Ptr;
  
!       --  We need to call Scan for the first time, because Initialize_Scanner
        --  is no longer doing it.
  
        Scan.all;
  
!       Input_Line_Loop : loop
           exit Input_Line_Loop when Token = Tok_EOF;
  
           Preprocessor_Line := False;
*************** package body Prep is
*** 761,769 ****
  
                    case Token is
  
!                      when Tok_If =>
!                         --  #if
  
                          declare
                             If_Ptr : constant Source_Ptr := Token_Ptr;
  
--- 758,766 ----
  
                    case Token is
  
!                      --  #if
  
+                      when Tok_If =>
                          declare
                             If_Ptr : constant Source_Ptr := Token_Ptr;
  
*************** package body Prep is
*** 807,815 ****
                             end;
                          end;
  
!                      when Tok_Elsif =>
!                         --  #elsif
  
                          Cond := False;
  
                          if Pp_States.Last = 0
--- 804,812 ----
                             end;
                          end;
  
!                      --  #elsif
  
+                      when Tok_Elsif =>
                          Cond := False;
  
                          if Pp_States.Last = 0
*************** package body Prep is
*** 861,869 ****
                             end if;
                          end if;
  
!                      when Tok_Else =>
!                         --  #else
  
                          if Pp_States.Last = 0 then
                             Error_Msg ("no IF for this ELSE", Token_Ptr);
  
--- 858,866 ----
                             end if;
                          end if;
  
!                      --  #else
  
+                      when Tok_Else =>
                          if Pp_States.Last = 0 then
                             Error_Msg ("no IF for this ELSE", Token_Ptr);
  
*************** package body Prep is
*** 907,915 ****
                             Go_To_End_Of_Line;
                          end if;
  
!                      when Tok_End =>
!                         --  #end if;
  
                          if Pp_States.Last = 0 then
                             Error_Msg ("no IF for this END", Token_Ptr);
                          end if;
--- 904,912 ----
                             Go_To_End_Of_Line;
                          end if;
  
!                      --  #end if;
  
+                      when Tok_End =>
                          if Pp_States.Last = 0 then
                             Error_Msg ("no IF for this END", Token_Ptr);
                          end if;
*************** package body Prep is
*** 945,959 ****
  
                          Go_To_End_Of_Line;
  
!                         --  Decrement the depth of the #if stack.
  
                          if Pp_States.Last > 0 then
                             Pp_States.Decrement_Last;
                          end if;
  
!                      when others =>
!                         --  Illegal preprocessor line
  
                          if Pp_States.Last = 0 then
                             Error_Msg ("IF expected", Token_Ptr);
  
--- 942,956 ----
  
                          Go_To_End_Of_Line;
  
!                         --  Decrement the depth of the #if stack
  
                          if Pp_States.Last > 0 then
                             Pp_States.Decrement_Last;
                          end if;
  
!                      --  Illegal preprocessor line
  
+                      when others =>
                          if Pp_States.Last = 0 then
                             Error_Msg ("IF expected", Token_Ptr);
  
*************** package body Prep is
*** 991,998 ****
                         and then Special_Character = '$'
                       then
                          declare
!                            Dollar_Ptr   : constant Source_Ptr := Token_Ptr;
!                            Symbol       : Symbol_Id;
  
                          begin
                             Scan.all;
--- 988,995 ----
                         and then Special_Character = '$'
                       then
                          declare
!                            Dollar_Ptr : constant Source_Ptr := Token_Ptr;
!                            Symbol     : Symbol_Id;
  
                          begin
                             Scan.all;
*************** package body Prep is
*** 1005,1012 ****
  
                                Symbol := Index_Of (Token_Name);
  
!                               --  If there is such a symbol, replace it by its
!                               --  value.
  
                                if Symbol /= No_Symbol then
                                   Output (Start_Of_Processing, Dollar_Ptr - 1);
--- 1002,1008 ----
  
                                Symbol := Index_Of (Token_Name);
  
!                               --  If symbol exists, replace by its value
  
                                if Symbol /= No_Symbol then
                                   Output (Start_Of_Processing, Dollar_Ptr - 1);
*************** package body Prep is
*** 1071,1087 ****
                    and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
              then
                 Start_Of_Processing := Token_Ptr + 2;
- 
              else
                 Start_Of_Processing := Token_Ptr + 1;
              end if;
           end if;
  
!          --  Now, we scan the first token of the next line.
!          --  If the token is EOF, the scan ponter will not move, and the token
!          --  will still be EOF.
  
           Scan.all;
        end loop Input_Line_Loop;
  
        --  Report an error for any missing some "#end if;"
--- 1067,1083 ----
                    and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
              then
                 Start_Of_Processing := Token_Ptr + 2;
              else
                 Start_Of_Processing := Token_Ptr + 1;
              end if;
           end if;
  
!          --  Now, scan the first token of the next line. If the token is EOF,
!          --  the scan ponter will not move, and the token will still be EOF.
  
+          Set_Ignore_Errors (To => True);
           Scan.all;
+          Set_Ignore_Errors (To => False);
        end loop Input_Line_Loop;
  
        --  Report an error for any missing some "#end if;"
diff -Nrcpad gcc-4.0.2/gcc/ada/prep.ads gcc-4.1.0/gcc/ada/prep.ads
*** gcc-4.0.2/gcc/ada/prep.ads	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prep.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/prepcomp.adb gcc-4.1.0/gcc/ada/prepcomp.adb
*** gcc-4.0.2/gcc/ada/prepcomp.adb	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prepcomp.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Prepcomp is
*** 135,140 ****
--- 135,141 ----
  
     procedure Add_Command_Line_Symbols is
        Symbol_Id : Prep.Symbol_Id;
+ 
     begin
        for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop
           Symbol_Id := Prep.Index_Of (Command_Line_Symbols.Table (J).Symbol);
*************** package body Prepcomp is
*** 225,235 ****
     ------------------------------
  
     procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is
!       OK : Boolean := False;
        Dash_Location : Source_Ptr;
!       Symbol_Data : Prep.Symbol_Data;
!       Symbol_Id   : Prep.Symbol_Id;
!       T : constant Nat := Total_Errors_Detected;
  
     begin
        --  Load the preprocessing data file
--- 226,236 ----
     ------------------------------
  
     procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is
!       OK            : Boolean := False;
        Dash_Location : Source_Ptr;
!       Symbol_Data   : Prep.Symbol_Data;
!       Symbol_Id     : Prep.Symbol_Id;
!       T             : constant Nat := Total_Errors_Detected;
  
     begin
        --  Load the preprocessing data file
*************** package body Prepcomp is
*** 246,258 ****
        end if;
  
        --  Initialize the sanner and set its behavior for a processing data file
        Scn.Scanner.Initialize_Scanner
          (No_Unit, Source_Index_Of_Preproc_Data_File);
        Scn.Scanner.Set_End_Of_Line_As_Token (True);
        Scn.Scanner.Reset_Special_Characters;
  
!       For_Each_Line :
!       loop
           <<Scan_Line>>
           Scan;
  
--- 247,259 ----
        end if;
  
        --  Initialize the sanner and set its behavior for a processing data file
+ 
        Scn.Scanner.Initialize_Scanner
          (No_Unit, Source_Index_Of_Preproc_Data_File);
        Scn.Scanner.Set_End_Of_Line_As_Token (True);
        Scn.Scanner.Reset_Special_Characters;
  
!       For_Each_Line : loop
           <<Scan_Line>>
           Scan;
  
*************** package body Prepcomp is
*** 340,346 ****
           --  Check the switches that may follow
  
           while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
- 
              if Token /= Tok_Minus then
                 Error_Msg ("`'-` expected", Token_Ptr);
                 Skip_To_End_Of_Line;
--- 341,346 ----
*************** package body Prepcomp is
*** 508,514 ****
  
                          Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol);
  
!                         --  Otherwise, add a new entry in the table.
  
                          if Symbol_Id = No_Symbol then
                             Symbol_Table.Increment_Last (Prep.Mapping);
--- 508,514 ----
  
                          Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol);
  
!                         --  Otherwise, add a new entry in the table
  
                          if Symbol_Id = No_Symbol then
                             Symbol_Table.Increment_Last (Prep.Mapping);
*************** package body Prepcomp is
*** 635,640 ****
--- 635,641 ----
        --  If not already done it, process the definition file
  
        if Current_Data.Processed then
+ 
           --  Set Prep.Mapping
  
           Prep.Mapping := Current_Data.Mapping;
diff -Nrcpad gcc-4.0.2/gcc/ada/prepcomp.ads gcc-4.1.0/gcc/ada/prepcomp.ads
*** gcc-4.0.2/gcc/ada/prepcomp.ads	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prepcomp.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Prepcomp is
*** 46,52 ****
     --  Parse_Preprocessing_Data_File should be called instead.
  
     procedure Parse_Preprocessing_Data_File (N : File_Name_Type);
!    --  Parse a preprocessing data file, specified with a -gnatep= switch.
  
     procedure Prepare_To_Preprocess
       (Source               : File_Name_Type;
--- 46,52 ----
     --  Parse_Preprocessing_Data_File should be called instead.
  
     procedure Parse_Preprocessing_Data_File (N : File_Name_Type);
!    --  Parse a preprocessing data file, specified with a -gnatep= switch
  
     procedure Prepare_To_Preprocess
       (Source               : File_Name_Type;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-attr-pm.adb gcc-4.1.0/gcc/ada/prj-attr-pm.adb
*** gcc-4.0.2/gcc/ada/prj-attr-pm.adb	Fri Sep 17 13:46:12 2004
--- gcc-4.1.0/gcc/ada/prj-attr-pm.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-attr-pm.ads gcc-4.1.0/gcc/ada/prj-attr-pm.ads
*** gcc-4.0.2/gcc/ada/prj-attr-pm.ads	Fri Sep 17 13:46:12 2004
--- gcc-4.1.0/gcc/ada/prj-attr-pm.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2005, 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- --
***************
*** 16,34 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Types; use Types;
  
  package Prj.Attr.PM is
     --  The following procedures are not secure and should only be used by the
     --  Project Manager, that is the packages of the Prj or MLib hierarchies.
  
     procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id);
     --  Add a new unknown package. The Name cannot be the name of a predefined
--- 16,38 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains insecure procedures that are intended to be used
! --  only inside the Prj and MLib hierarchies. It should not be imported by
! --  other tools, such as GPS.
  
  package Prj.Attr.PM is
+ 
     --  The following procedures are not secure and should only be used by the
     --  Project Manager, that is the packages of the Prj or MLib hierarchies.
+    --  What does "not secure" mean???
  
     procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id);
     --  Add a new unknown package. The Name cannot be the name of a predefined
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-attr.adb gcc-4.1.0/gcc/ada/prj-attr.adb
*** gcc-4.0.2/gcc/ada/prj-attr.adb	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-attr.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Prj.Attr is
*** 55,61 ****
     --        insensitive
     --    'c' same as 'b', with optional index
  
!    --  End is indicated by two consecutive '#'.
  
     Initialization_Data : constant String :=
  
--- 55,61 ----
     --        insensitive
     --    'c' same as 'b', with optional index
  
!    --  End is indicated by two consecutive '#'
  
     Initialization_Data : constant String :=
  
*************** package body Prj.Attr is
*** 75,80 ****
--- 75,81 ----
       "SVlibrary_auto_init#" &
       "LVlibrary_options#" &
       "SVlibrary_src_dir#" &
+      "SVlibrary_ali_dir#" &
       "SVlibrary_gcc#" &
       "SVlibrary_symbol_file#" &
       "SVlibrary_symbol_policy#" &
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-attr.ads gcc-4.1.0/gcc/ada/prj-attr.ads
*** gcc-4.0.2/gcc/ada/prj-attr.ads	Mon Oct  4 14:58:21 2004
--- gcc-4.1.0/gcc/ada/prj-attr.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,34 ****
  
  --  This package defines packages and attributes in GNAT project files.
  --  There are predefined packages and attributes.
- --  It is also possible to define new packages with their attributes.
  
! with Types; use Types;
  
  package Prj.Attr is
  
--- 26,35 ----
  
  --  This package defines packages and attributes in GNAT project files.
  --  There are predefined packages and attributes.
  
! --  It is also possible to define new packages with their attributes
! 
! with Table;
  
  package Prj.Attr is
  
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-com.adb gcc-4.1.0/gcc/ada/prj-com.adb
*** gcc-4.0.2/gcc/ada/prj-com.adb	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-com.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,42 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT COMPILER COMPONENTS                         --
- --                                                                          --
- --                              P R J . C O M                               --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --             Copyright (C) 2000-2004 Free Software Foundation, Inc.       --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- with Namet;   use Namet;
- with Stringt; use Stringt;
- 
- package body Prj.Com is
- 
-    ----------
-    -- Hash --
-    ----------
- 
-    function Hash (Name : String_Id) return Header_Num is
-    begin
-       String_To_Name_Buffer (Name);
-       return Hash (Name_Buffer (1 .. Name_Len));
-    end Hash;
- 
- end Prj.Com;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-com.ads gcc-4.1.0/gcc/ada/prj-com.ads
*** gcc-4.0.2/gcc/ada/prj-com.ads	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-com.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,114 ****
  --  The following package declares data types for GNAT project.
  --  These data types are used in the bodies of the Prj hierarchy.
  
! with GNAT.HTable;
  with Osint;
- with Table;
- with Types; use Types;
  
  package Prj.Com is
  
-    --  At one point, this package was private.
-    --  It cannot be private, because it is used outside of
-    --  the Prj hierarchy.
- 
     type Fail_Proc is access procedure
!      (S1 : String; S2 : String := ""; S3 : String := "");
  
     Fail : Fail_Proc := Osint.Fail'Access;
!    --  This procedure is used in the project facility, instead of
!    --  directly calling Osint.Fail.
!    --  It may be specified by tools to do clean up before calling
!    --  Osint.Fail, or to simply report an error and return.
! 
!    Tool_Name : Name_Id := No_Name;
! 
!    Current_Verbosity : Verbosity := Default;
! 
!    type Spec_Or_Body is
!      (Specification, Body_Part);
! 
!    type File_Name_Data is record
!       Name         : Name_Id := No_Name;
!       Index        : Int     := 0;
!       Display_Name : Name_Id := No_Name;
!       Path         : Name_Id := No_Name;
!       Display_Path : Name_Id := No_Name;
!       Project      : Project_Id := No_Project;
!       Needs_Pragma : Boolean := False;
!    end record;
!    --  File and Path name of a spec or body.
! 
!    type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
! 
!    type Unit_Id is new Nat;
!    No_Unit : constant Unit_Id := 0;
!    type Unit_Data is record
!       Name       : Name_Id    := No_Name;
!       File_Names : File_Names_Data;
!    end record;
!    --  File and Path names of a unit, with a reference to its
!    --  GNAT Project File.
! 
!    package Units is new Table.Table
!      (Table_Component_Type => Unit_Data,
!       Table_Index_Type     => Unit_Id,
!       Table_Low_Bound      => 1,
!       Table_Initial        => 100,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Com.Units");
! 
!    function Hash (Name : String_Id) return Header_Num;
! 
!    package Units_Htable is new GNAT.HTable.Simple_HTable
!      (Header_Num => Header_Num,
!       Element    => Unit_Id,
!       No_Element => No_Unit,
!       Key        => Name_Id,
!       Hash       => Hash,
!       Equal      => "=");
!    --  Mapping of unit names to indexes in the Units table
! 
!    type Unit_Project is record
!       Unit    : Unit_Id    := No_Unit;
!       Project : Project_Id := No_Project;
!    end record;
! 
!    No_Unit_Project : constant Unit_Project := (No_Unit, No_Project);
! 
!    package Files_Htable is new GNAT.HTable.Simple_HTable
!      (Header_Num => Header_Num,
!       Element    => Unit_Project,
!       No_Element => No_Unit_Project,
!       Key        => Name_Id,
!       Hash       => Hash,
!       Equal      => "=");
!    --  Mapping of file names to indexes in the Units table
  
  end Prj.Com;
--- 27,46 ----
  --  The following package declares data types for GNAT project.
  --  These data types are used in the bodies of the Prj hierarchy.
  
! --  Above comment seems *far* too general ???
! 
  with Osint;
  
  package Prj.Com is
  
     type Fail_Proc is access procedure
!      (S1 : String;
!       S2 : String := "";
!       S3 : String := "");
  
     Fail : Fail_Proc := Osint.Fail'Access;
!    --  This procedure is used in the project facility, instead of directly
!    --  calling Osint.Fail. It may be specified by tools to do clean up before
!    --  calling Osint.Fail, or to simply report an error and return.
  
  end Prj.Com;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-dect.adb gcc-4.1.0/gcc/ada/prj-dect.adb
*** gcc-4.0.2/gcc/ada/prj-dect.adb	Mon Sep 13 10:18:40 2004
--- gcc-4.1.0/gcc/ada/prj-dect.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Opt;         use Opt;
*** 30,38 ****
  with Prj.Err;     use Prj.Err;
  with Prj.Strt;    use Prj.Strt;
  with Prj.Tree;    use Prj.Tree;
- with Scans;       use Scans;
  with Snames;
- with Types;       use Types;
  with Prj.Attr;    use Prj.Attr;
  with Prj.Attr.PM; use Prj.Attr.PM;
  with Uintp;       use Uintp;
--- 30,36 ----
*************** package body Prj.Dect is
*** 45,84 ****
     --  (In_Project).
  
     procedure Parse_Attribute_Declaration
!      (Attribute         : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id);
!    --  Parse an attribute declaration.
  
     procedure Parse_Case_Construction
!      (Case_Construction : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id);
     --  Parse a case construction
  
     procedure Parse_Declarative_Items
!      (Declarations      : out Project_Node_Id;
        In_Zone           : Zone;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id);
     --  Parse declarative items. Depending on In_Zone, some declarative
     --  items may be forbiden.
  
     procedure Parse_Package_Declaration
!      (Package_Declaration : out Project_Node_Id;
!       Current_Project     : Project_Node_Id);
     --  Parse a package declaration
  
     procedure Parse_String_Type_Declaration
!      (String_Type     : out Project_Node_Id;
        Current_Project : Project_Node_Id);
     --  type <name> is ( <literal_string> { , <literal_string> } ) ;
  
     procedure Parse_Variable_Declaration
!      (Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
     --  Parse a variable assignment
--- 43,92 ----
     --  (In_Project).
  
     procedure Parse_Attribute_Declaration
!      (In_Tree           : Project_Node_Tree_Ref;
!       Attribute         : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access);
!    --  Parse an attribute declaration
  
     procedure Parse_Case_Construction
!      (In_Tree           : Project_Node_Tree_Ref;
!       Case_Construction : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access);
     --  Parse a case construction
  
     procedure Parse_Declarative_Items
!      (In_Tree           : Project_Node_Tree_Ref;
!       Declarations      : out Project_Node_Id;
        In_Zone           : Zone;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access);
     --  Parse declarative items. Depending on In_Zone, some declarative
     --  items may be forbiden.
  
     procedure Parse_Package_Declaration
!      (In_Tree             : Project_Node_Tree_Ref;
!       Package_Declaration : out Project_Node_Id;
!       Current_Project     : Project_Node_Id;
!       Packages_To_Check   : String_List_Access);
     --  Parse a package declaration
  
     procedure Parse_String_Type_Declaration
!      (In_Tree         : Project_Node_Tree_Ref;
!       String_Type     : out Project_Node_Id;
        Current_Project : Project_Node_Id);
     --  type <name> is ( <literal_string> { , <literal_string> } ) ;
  
     procedure Parse_Variable_Declaration
!      (In_Tree         : Project_Node_Tree_Ref;
!       Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
     --  Parse a variable assignment
*************** package body Prj.Dect is
*** 90,114 ****
     -----------
  
     procedure Parse
!      (Declarations    : out Project_Node_Id;
!       Current_Project : Project_Node_Id;
!       Extends         : Project_Node_Id)
     is
        First_Declarative_Item : Project_Node_Id := Empty_Node;
  
     begin
!       Declarations := Default_Project_Node (Of_Kind => N_Project_Declaration);
!       Set_Location_Of (Declarations, To => Token_Ptr);
!       Set_Extended_Project_Of (Declarations, To => Extends);
!       Set_Project_Declaration_Of (Current_Project, Declarations);
        Parse_Declarative_Items
!         (Declarations    => First_Declarative_Item,
!          In_Zone         => In_Project,
!          First_Attribute => Prj.Attr.Attribute_First,
!          Current_Project => Current_Project,
!          Current_Package => Empty_Node);
        Set_First_Declarative_Item_Of
!         (Declarations, To => First_Declarative_Item);
     end Parse;
  
     ---------------------------------
--- 98,128 ----
     -----------
  
     procedure Parse
!      (In_Tree           : Project_Node_Tree_Ref;
!       Declarations      : out Project_Node_Id;
!       Current_Project   : Project_Node_Id;
!       Extends           : Project_Node_Id;
!       Packages_To_Check : String_List_Access)
     is
        First_Declarative_Item : Project_Node_Id := Empty_Node;
  
     begin
!       Declarations :=
!         Default_Project_Node
!           (Of_Kind => N_Project_Declaration, In_Tree => In_Tree);
!       Set_Location_Of (Declarations, In_Tree, To => Token_Ptr);
!       Set_Extended_Project_Of (Declarations, In_Tree, To => Extends);
!       Set_Project_Declaration_Of (Current_Project, In_Tree, Declarations);
        Parse_Declarative_Items
!         (Declarations      => First_Declarative_Item,
!          In_Tree           => In_Tree,
!          In_Zone           => In_Project,
!          First_Attribute   => Prj.Attr.Attribute_First,
!          Current_Project   => Current_Project,
!          Current_Package   => Empty_Node,
!          Packages_To_Check => Packages_To_Check);
        Set_First_Declarative_Item_Of
!         (Declarations, In_Tree, To => First_Declarative_Item);
     end Parse;
  
     ---------------------------------
*************** package body Prj.Dect is
*** 116,125 ****
     ---------------------------------
  
     procedure Parse_Attribute_Declaration
!      (Attribute       : out Project_Node_Id;
!       First_Attribute : Attribute_Node_Id;
!       Current_Project : Project_Node_Id;
!       Current_Package : Project_Node_Id)
     is
        Current_Attribute      : Attribute_Node_Id := First_Attribute;
        Full_Associative_Array : Boolean           := False;
--- 130,141 ----
     ---------------------------------
  
     procedure Parse_Attribute_Declaration
!      (In_Tree           : Project_Node_Tree_Ref;
!       Attribute         : out Project_Node_Id;
!       First_Attribute   : Attribute_Node_Id;
!       Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access)
     is
        Current_Attribute      : Attribute_Node_Id := First_Attribute;
        Full_Associative_Array : Boolean           := False;
*************** package body Prj.Dect is
*** 129,141 ****
        Warning                : Boolean           := False;
  
     begin
!       Attribute := Default_Project_Node (Of_Kind => N_Attribute_Declaration);
!       Set_Location_Of (Attribute, To => Token_Ptr);
        Set_Previous_Line_Node (Attribute);
  
        --  Scan past "for"
  
!       Scan;
  
        --  Body may be an attribute name
  
--- 145,159 ----
        Warning                : Boolean           := False;
  
     begin
!       Attribute :=
!         Default_Project_Node
!           (Of_Kind => N_Attribute_Declaration, In_Tree => In_Tree);
!       Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
        Set_Previous_Line_Node (Attribute);
  
        --  Scan past "for"
  
!       Scan (In_Tree);
  
        --  Body may be an attribute name
  
*************** package body Prj.Dect is
*** 148,155 ****
  
        if Token = Tok_Identifier then
           Attribute_Name := Token_Name;
!          Set_Name_Of (Attribute, To => Token_Name);
!          Set_Location_Of (Attribute, To => Token_Ptr);
  
           --  Find the attribute
  
--- 166,173 ----
  
        if Token = Tok_Identifier then
           Attribute_Name := Token_Name;
!          Set_Name_Of (Attribute, In_Tree, To => Token_Name);
!          Set_Location_Of (Attribute, In_Tree, To => Token_Ptr);
  
           --  Find the attribute
  
*************** package body Prj.Dect is
*** 161,169 ****
  
           if Current_Attribute = Empty_Attribute then
              if Current_Package /= Empty_Node
!               and then Expression_Kind_Of (Current_Package) = Ignored
              then
!                Pkg_Id := Package_Id_Of (Current_Package);
                 Add_Attribute (Pkg_Id, Token_Name, Current_Attribute);
                 Error_Msg_Name_1 := Token_Name;
                 Error_Msg ("?unknown attribute {", Token_Ptr);
--- 179,187 ----
  
           if Current_Attribute = Empty_Attribute then
              if Current_Package /= Empty_Node
!               and then Expression_Kind_Of (Current_Package, In_Tree) = Ignored
              then
!                Pkg_Id := Package_Id_Of (Current_Package, In_Tree);
                 Add_Attribute (Pkg_Id, Token_Name, Current_Attribute);
                 Error_Msg_Name_1 := Token_Name;
                 Error_Msg ("?unknown attribute {", Token_Ptr);
*************** package body Prj.Dect is
*** 173,189 ****
                 --  if inside a package that does not need to be checked.
  
                 Warning := Current_Package /= Empty_Node and then
!                           Current_Packages_To_Check /= All_Packages;
  
                 if Warning then
  
                    --  Check that we are not in a package to check
  
!                   Get_Name_String (Name_Of (Current_Package));
  
!                   for Index in Current_Packages_To_Check'Range loop
                       if Name_Buffer (1 .. Name_Len) =
!                        Current_Packages_To_Check (Index).all
                       then
                          Warning := False;
                          exit;
--- 191,207 ----
                 --  if inside a package that does not need to be checked.
  
                 Warning := Current_Package /= Empty_Node and then
!                           Packages_To_Check /= All_Packages;
  
                 if Warning then
  
                    --  Check that we are not in a package to check
  
!                   Get_Name_String (Name_Of (Current_Package, In_Tree));
  
!                   for Index in Packages_To_Check'Range loop
                       if Name_Buffer (1 .. Name_Len) =
!                        Packages_To_Check (Index).all
                       then
                          Warning := False;
                          exit;
*************** package body Prj.Dect is
*** 192,204 ****
                 end if;
  
                 Error_Msg_Name_1 := Token_Name;
! 
!                if Warning then
!                   Error_Msg ("?undefined attribute {", Token_Ptr);
! 
!                else
!                   Error_Msg ("undefined attribute {", Token_Ptr);
!                end if;
              end if;
  
           --  Set, if appropriate the index case insensitivity flag
--- 210,217 ----
                 end if;
  
                 Error_Msg_Name_1 := Token_Name;
!                Error_Msg_Warn := Warning;
!                Error_Msg ("<undefined attribute {", Token_Ptr);
              end if;
  
           --  Set, if appropriate the index case insensitivity flag
*************** package body Prj.Dect is
*** 207,235 ****
                   Case_Insensitive_Associative_Array ..
                   Optional_Index_Case_Insensitive_Associative_Array
           then
!             Set_Case_Insensitive (Attribute, To => True);
           end if;
  
!          Scan; --  past the attribute name
        end if;
  
        --  Change obsolete names of attributes to the new names
  
        if Current_Package /= Empty_Node
!         and then Expression_Kind_Of (Current_Package) /= Ignored
        then
!          case Name_Of (Attribute) is
           when Snames.Name_Specification =>
!             Set_Name_Of (Attribute, To => Snames.Name_Spec);
  
           when Snames.Name_Specification_Suffix =>
!             Set_Name_Of (Attribute, To => Snames.Name_Spec_Suffix);
  
           when Snames.Name_Implementation =>
!             Set_Name_Of (Attribute, To => Snames.Name_Body);
  
           when Snames.Name_Implementation_Suffix =>
!             Set_Name_Of (Attribute, To => Snames.Name_Body_Suffix);
  
           when others =>
              null;
--- 220,248 ----
                   Case_Insensitive_Associative_Array ..
                   Optional_Index_Case_Insensitive_Associative_Array
           then
!             Set_Case_Insensitive (Attribute, In_Tree, To => True);
           end if;
  
!          Scan (In_Tree); --  past the attribute name
        end if;
  
        --  Change obsolete names of attributes to the new names
  
        if Current_Package /= Empty_Node
!         and then Expression_Kind_Of (Current_Package, In_Tree) /= Ignored
        then
!          case Name_Of (Attribute, In_Tree) is
           when Snames.Name_Specification =>
!             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec);
  
           when Snames.Name_Specification_Suffix =>
!             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Spec_Suffix);
  
           when Snames.Name_Implementation =>
!             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body);
  
           when Snames.Name_Implementation_Suffix =>
!             Set_Name_Of (Attribute, In_Tree, To => Snames.Name_Body_Suffix);
  
           when others =>
              null;
*************** package body Prj.Dect is
*** 251,274 ****
                         Get_Name_String
                            (Attribute_Name_Of (Current_Attribute)) &
                         """ cannot be an associative array",
!                        Location_Of (Attribute));
  
           elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
              Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array);
           end if;
  
!          Scan; --  past the left parenthesis
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Set_Associative_Array_Index_Of (Attribute, Token_Name);
!             Scan; --  past the literal string index
  
              if Token = Tok_At then
                 case Attribute_Kind_Of (Current_Attribute) is
                    when Optional_Index_Associative_Array |
                         Optional_Index_Case_Insensitive_Associative_Array =>
!                      Scan;
                       Expect (Tok_Integer_Literal, "integer literal");
  
                       if Token = Tok_Integer_Literal then
--- 264,287 ----
                         Get_Name_String
                            (Attribute_Name_Of (Current_Attribute)) &
                         """ cannot be an associative array",
!                        Location_Of (Attribute, In_Tree));
  
           elsif Attribute_Kind_Of (Current_Attribute) = Unknown then
              Set_Attribute_Kind_Of (Current_Attribute, To => Associative_Array);
           end if;
  
!          Scan (In_Tree); --  past the left parenthesis
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Set_Associative_Array_Index_Of (Attribute, In_Tree, Token_Name);
!             Scan (In_Tree); --  past the literal string index
  
              if Token = Tok_At then
                 case Attribute_Kind_Of (Current_Attribute) is
                    when Optional_Index_Associative_Array |
                         Optional_Index_Case_Insensitive_Associative_Array =>
!                      Scan (In_Tree);
                       Expect (Tok_Integer_Literal, "integer literal");
  
                       if Token = Tok_Integer_Literal then
*************** package body Prj.Dect is
*** 282,300 ****
                             if Index = 0 then
                                Error_Msg ("index cannot be zero", Token_Ptr);
                             else
!                               Set_Source_Index_Of (Attribute, To => Index);
                             end if;
                          end;
  
!                         Scan;
                       end if;
  
                    when others =>
                       Error_Msg ("index not allowed here", Token_Ptr);
!                      Scan;
  
                       if Token = Tok_Integer_Literal then
!                         Scan;
                       end if;
                 end case;
              end if;
--- 295,314 ----
                             if Index = 0 then
                                Error_Msg ("index cannot be zero", Token_Ptr);
                             else
!                               Set_Source_Index_Of
!                                 (Attribute, In_Tree, To => Index);
                             end if;
                          end;
  
!                         Scan (In_Tree);
                       end if;
  
                    when others =>
                       Error_Msg ("index not allowed here", Token_Ptr);
!                      Scan (In_Tree);
  
                       if Token = Tok_Integer_Literal then
!                         Scan (In_Tree);
                       end if;
                 end case;
              end if;
*************** package body Prj.Dect is
*** 303,309 ****
           Expect (Tok_Right_Paren, "`)`");
  
           if Token = Tok_Right_Paren then
!             Scan; --  past the right parenthesis
           end if;
  
        else
--- 317,323 ----
           Expect (Tok_Right_Paren, "`)`");
  
           if Token = Tok_Right_Paren then
!             Scan (In_Tree); --  past the right parenthesis
           end if;
  
        else
*************** package body Prj.Dect is
*** 328,341 ****
  
        if Current_Attribute /= Empty_Attribute then
           Set_Expression_Kind_Of
!            (Attribute, To => Variable_Kind_Of (Current_Attribute));
           Optional_Index := Optional_Index_Of (Current_Attribute);
        end if;
  
        Expect (Tok_Use, "USE");
  
        if Token = Tok_Use then
!          Scan;
  
           if Full_Associative_Array then
  
--- 342,355 ----
  
        if Current_Attribute /= Empty_Attribute then
           Set_Expression_Kind_Of
!            (Attribute, In_Tree, To => Variable_Kind_Of (Current_Attribute));
           Optional_Index := Optional_Index_Of (Current_Attribute);
        end if;
  
        Expect (Tok_Use, "USE");
  
        if Token = Tok_Use then
!          Scan (In_Tree);
  
           if Full_Associative_Array then
  
*************** package body Prj.Dect is
*** 368,382 ****
                    --  in the project being extended.
  
                    The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, Token_Name);
  
                    if The_Project = Empty_Node then
                       Error_Msg ("unknown project", Location);
!                      Scan; --  past the project name
  
                    else
                       Project_Name := Token_Name;
!                      Scan; --  past the project name
  
                       --  If this is inside a package, a dot followed by the
                       --  name of the package must followed the project name.
--- 382,396 ----
                    --  in the project being extended.
  
                    The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, In_Tree, Token_Name);
  
                    if The_Project = Empty_Node then
                       Error_Msg ("unknown project", Location);
!                      Scan (In_Tree); --  past the project name
  
                    else
                       Project_Name := Token_Name;
!                      Scan (In_Tree); --  past the project name
  
                       --  If this is inside a package, a dot followed by the
                       --  name of the package must followed the project name.
*************** package body Prj.Dect is
*** 388,394 ****
                             The_Project := Empty_Node;
  
                          else
!                            Scan; --  past the dot
                             Expect (Tok_Identifier, "identifier");
  
                             if Token /= Tok_Identifier then
--- 402,408 ----
                             The_Project := Empty_Node;
  
                          else
!                            Scan (In_Tree); --  past the dot
                             Expect (Tok_Identifier, "identifier");
  
                             if Token /= Tok_Identifier then
*************** package body Prj.Dect is
*** 396,418 ****
  
                             --  If it is not the same package name, issue error
  
!                            elsif Token_Name /= Name_Of (Current_Package) then
                                The_Project := Empty_Node;
                                Error_Msg
                                  ("not the same package as " &
!                                  Get_Name_String (Name_Of (Current_Package)),
                                   Token_Ptr);
  
                             else
!                               The_Package := First_Package_Of (The_Project);
  
                                --  Look for the package node
  
                                while The_Package /= Empty_Node
!                                 and then Name_Of (The_Package) /= Token_Name
                                loop
                                   The_Package :=
!                                    Next_Package_In_Project (The_Package);
                                end loop;
  
                                --  If the package cannot be found in the
--- 410,438 ----
  
                             --  If it is not the same package name, issue error
  
!                            elsif
!                              Token_Name /= Name_Of (Current_Package, In_Tree)
!                            then
                                The_Project := Empty_Node;
                                Error_Msg
                                  ("not the same package as " &
!                                  Get_Name_String
!                                    (Name_Of (Current_Package, In_Tree)),
                                   Token_Ptr);
  
                             else
!                               The_Package :=
!                                 First_Package_Of (The_Project, In_Tree);
  
                                --  Look for the package node
  
                                while The_Package /= Empty_Node
!                                 and then
!                                 Name_Of (The_Package, In_Tree) /= Token_Name
                                loop
                                   The_Package :=
!                                    Next_Package_In_Project
!                                      (The_Package, In_Tree);
                                end loop;
  
                                --  If the package cannot be found in the
*************** package body Prj.Dect is
*** 427,433 ****
                                     Token_Ptr);
                                end if;
  
!                               Scan; --  past the package name
                             end if;
                          end if;
                       end if;
--- 447,453 ----
                                     Token_Ptr);
                                end if;
  
!                               Scan (In_Tree); --  past the package name
                             end if;
                          end if;
                       end if;
*************** package body Prj.Dect is
*** 444,450 ****
                       The_Project := Empty_Node;
  
                    else
!                      Scan; --  past the apostrophe
                       Expect (Tok_Identifier, "identifier");
  
                       if Token /= Tok_Identifier then
--- 464,470 ----
                       The_Project := Empty_Node;
  
                    else
!                      Scan (In_Tree); --  past the apostrophe
                       Expect (Tok_Identifier, "identifier");
  
                       if Token /= Tok_Identifier then
*************** package body Prj.Dect is
*** 459,465 ****
                             Error_Msg ("invalid name, should be %", Token_Ptr);
                          end if;
  
!                         Scan; --  past the attribute name
                       end if;
                    end if;
                 end if;
--- 479,485 ----
                             Error_Msg ("invalid name, should be %", Token_Ptr);
                          end if;
  
!                         Scan (In_Tree); --  past the attribute name
                       end if;
                    end if;
                 end if;
*************** package body Prj.Dect is
*** 477,484 ****
                    --  characterizes full associative array attribute
                    --  declarations.
  
!                   Set_Associative_Project_Of (Attribute, The_Project);
!                   Set_Associative_Package_Of (Attribute, The_Package);
                 end if;
              end;
  
--- 497,504 ----
                    --  characterizes full associative array attribute
                    --  declarations.
  
!                   Set_Associative_Project_Of (Attribute, In_Tree, The_Project);
!                   Set_Associative_Package_Of (Attribute, In_Tree, The_Package);
                 end if;
              end;
  
*************** package body Prj.Dect is
*** 496,506 ****
                 --  Get the expression value and set it in the attribute node
  
                 Parse_Expression
!                  (Expression      => Expression,
                    Current_Project => Current_Project,
                    Current_Package => Current_Package,
                    Optional_Index  => Optional_Index);
!                Set_Expression_Of (Attribute, To => Expression);
  
                 --  If the expression is legal, but not of the right kind
                 --  for the attribute, issue an error.
--- 516,527 ----
                 --  Get the expression value and set it in the attribute node
  
                 Parse_Expression
!                  (In_Tree         => In_Tree,
!                   Expression      => Expression,
                    Current_Project => Current_Project,
                    Current_Package => Current_Package,
                    Optional_Index  => Optional_Index);
!                Set_Expression_Of (Attribute, In_Tree, To => Expression);
  
                 --  If the expression is legal, but not of the right kind
                 --  for the attribute, issue an error.
*************** package body Prj.Dect is
*** 508,519 ****
                 if Current_Attribute /= Empty_Attribute
                   and then Expression /= Empty_Node
                   and then Variable_Kind_Of (Current_Attribute) /=
!                  Expression_Kind_Of (Expression)
                 then
                    if  Variable_Kind_Of (Current_Attribute) = Undefined then
                       Set_Variable_Kind_Of
                         (Current_Attribute,
!                         To => Expression_Kind_Of (Expression));
  
                    else
                       Error_Msg
--- 529,540 ----
                 if Current_Attribute /= Empty_Attribute
                   and then Expression /= Empty_Node
                   and then Variable_Kind_Of (Current_Attribute) /=
!                  Expression_Kind_Of (Expression, In_Tree)
                 then
                    if  Variable_Kind_Of (Current_Attribute) = Undefined then
                       Set_Variable_Kind_Of
                         (Current_Attribute,
!                         To => Expression_Kind_Of (Expression, In_Tree));
  
                    else
                       Error_Msg
*************** package body Prj.Dect is
*** 545,554 ****
     -----------------------------
  
     procedure Parse_Case_Construction
!      (Case_Construction : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id)
     is
        Current_Item    : Project_Node_Id := Empty_Node;
        Next_Item       : Project_Node_Id := Empty_Node;
--- 566,577 ----
     -----------------------------
  
     procedure Parse_Case_Construction
!      (In_Tree           : Project_Node_Tree_Ref;
!       Case_Construction : out Project_Node_Id;
        First_Attribute   : Attribute_Node_Id;
        Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access)
     is
        Current_Item    : Project_Node_Id := Empty_Node;
        Next_Item       : Project_Node_Id := Empty_Node;
*************** package body Prj.Dect is
*** 569,580 ****
  
     begin
        Case_Construction  :=
!         Default_Project_Node (Of_Kind => N_Case_Construction);
!       Set_Location_Of (Case_Construction, To => Token_Ptr);
  
        --  Scan past "case"
  
!       Scan;
  
        --  Get the switch variable
  
--- 592,604 ----
  
     begin
        Case_Construction  :=
!         Default_Project_Node
!           (Of_Kind => N_Case_Construction, In_Tree => In_Tree);
!       Set_Location_Of (Case_Construction, In_Tree, To => Token_Ptr);
  
        --  Scan past "case"
  
!       Scan (In_Tree);
  
        --  Get the switch variable
  
*************** package body Prj.Dect is
*** 583,606 ****
        if Token = Tok_Identifier then
           Variable_Location := Token_Ptr;
           Parse_Variable_Reference
!            (Variable        => Case_Variable,
              Current_Project => Current_Project,
              Current_Package => Current_Package);
           Set_Case_Variable_Reference_Of
!            (Case_Construction, To => Case_Variable);
  
        else
           if Token /= Tok_Is then
!             Scan;
           end if;
        end if;
  
        if Case_Variable /= Empty_Node then
!          String_Type := String_Type_Of (Case_Variable);
  
           if String_Type = Empty_Node then
              Error_Msg ("variable """ &
!                        Get_Name_String (Name_Of (Case_Variable)) &
                         """ is not typed",
                         Variable_Location);
           end if;
--- 607,631 ----
        if Token = Tok_Identifier then
           Variable_Location := Token_Ptr;
           Parse_Variable_Reference
!            (In_Tree         => In_Tree,
!             Variable        => Case_Variable,
              Current_Project => Current_Project,
              Current_Package => Current_Package);
           Set_Case_Variable_Reference_Of
!            (Case_Construction, In_Tree, To => Case_Variable);
  
        else
           if Token /= Tok_Is then
!             Scan (In_Tree);
           end if;
        end if;
  
        if Case_Variable /= Empty_Node then
!          String_Type := String_Type_Of (Case_Variable, In_Tree);
  
           if String_Type = Empty_Node then
              Error_Msg ("variable """ &
!                        Get_Name_String (Name_Of (Case_Variable, In_Tree)) &
                         """ is not typed",
                         Variable_Location);
           end if;
*************** package body Prj.Dect is
*** 615,652 ****
  
           --  Scan past "is"
  
!          Scan;
        end if;
  
!       Start_New_Case_Construction (String_Type);
  
        When_Loop :
  
        while Token = Tok_When loop
  
           if First_Case_Item then
!             Current_Item := Default_Project_Node (Of_Kind => N_Case_Item);
!             Set_First_Case_Item_Of (Case_Construction, To => Current_Item);
              First_Case_Item := False;
  
           else
!             Next_Item := Default_Project_Node (Of_Kind => N_Case_Item);
!             Set_Next_Case_Item (Current_Item, To => Next_Item);
              Current_Item := Next_Item;
           end if;
  
!          Set_Location_Of (Current_Item, To => Token_Ptr);
  
           --  Scan past "when"
  
!          Scan;
  
           if Token = Tok_Others then
              When_Others := True;
  
              --  Scan past "others"
  
!             Scan;
  
              Expect (Tok_Arrow, "`=>`");
              Set_End_Of_Line (Current_Item);
--- 640,682 ----
  
           --  Scan past "is"
  
!          Scan (In_Tree);
        end if;
  
!       Start_New_Case_Construction (In_Tree, String_Type);
  
        When_Loop :
  
        while Token = Tok_When loop
  
           if First_Case_Item then
!             Current_Item :=
!               Default_Project_Node
!                 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
!             Set_First_Case_Item_Of
!               (Case_Construction, In_Tree, To => Current_Item);
              First_Case_Item := False;
  
           else
!             Next_Item :=
!               Default_Project_Node
!                 (Of_Kind => N_Case_Item, In_Tree => In_Tree);
!             Set_Next_Case_Item (Current_Item, In_Tree, To => Next_Item);
              Current_Item := Next_Item;
           end if;
  
!          Set_Location_Of (Current_Item, In_Tree, To => Token_Ptr);
  
           --  Scan past "when"
  
!          Scan (In_Tree);
  
           if Token = Tok_Others then
              When_Others := True;
  
              --  Scan past "others"
  
!             Scan (In_Tree);
  
              Expect (Tok_Arrow, "`=>`");
              Set_End_Of_Line (Current_Item);
*************** package body Prj.Dect is
*** 655,700 ****
              --  Empty_Node in Field1 of a Case_Item indicates
              --  the "when others =>" branch.
  
!             Set_First_Choice_Of (Current_Item, To => Empty_Node);
  
              Parse_Declarative_Items
!               (Declarations    => First_Declarative_Item,
!                In_Zone         => In_Case_Construction,
!                First_Attribute => First_Attribute,
!                Current_Project => Current_Project,
!                Current_Package => Current_Package);
  
              --  "when others =>" must be the last branch, so save the
              --  Case_Item and exit
  
              Set_First_Declarative_Item_Of
!               (Current_Item, To => First_Declarative_Item);
              exit When_Loop;
  
           else
!             Parse_Choice_List (First_Choice => First_Choice);
!             Set_First_Choice_Of (Current_Item, To => First_Choice);
  
              Expect (Tok_Arrow, "`=>`");
              Set_End_Of_Line (Current_Item);
              Set_Previous_Line_Node (Current_Item);
  
              Parse_Declarative_Items
!               (Declarations    => First_Declarative_Item,
!                In_Zone         => In_Case_Construction,
!                First_Attribute => First_Attribute,
!                Current_Project => Current_Project,
!                Current_Package => Current_Package);
  
              Set_First_Declarative_Item_Of
!               (Current_Item, To => First_Declarative_Item);
  
           end if;
        end loop When_Loop;
  
        End_Case_Construction
          (Check_All_Labels => not When_Others and not Quiet_Output,
!          Case_Location    => Location_Of (Case_Construction));
  
        Expect (Tok_End, "`END CASE`");
        Remove_Next_End_Node;
--- 685,736 ----
              --  Empty_Node in Field1 of a Case_Item indicates
              --  the "when others =>" branch.
  
!             Set_First_Choice_Of (Current_Item, In_Tree, To => Empty_Node);
  
              Parse_Declarative_Items
!               (In_Tree           => In_Tree,
!                Declarations      => First_Declarative_Item,
!                In_Zone           => In_Case_Construction,
!                First_Attribute   => First_Attribute,
!                Current_Project   => Current_Project,
!                Current_Package   => Current_Package,
!                Packages_To_Check => Packages_To_Check);
  
              --  "when others =>" must be the last branch, so save the
              --  Case_Item and exit
  
              Set_First_Declarative_Item_Of
!               (Current_Item, In_Tree, To => First_Declarative_Item);
              exit When_Loop;
  
           else
!             Parse_Choice_List
!               (In_Tree      => In_Tree,
!                First_Choice => First_Choice);
!             Set_First_Choice_Of (Current_Item, In_Tree, To => First_Choice);
  
              Expect (Tok_Arrow, "`=>`");
              Set_End_Of_Line (Current_Item);
              Set_Previous_Line_Node (Current_Item);
  
              Parse_Declarative_Items
!               (In_Tree           => In_Tree,
!                Declarations      => First_Declarative_Item,
!                In_Zone           => In_Case_Construction,
!                First_Attribute   => First_Attribute,
!                Current_Project   => Current_Project,
!                Current_Package   => Current_Package,
!                Packages_To_Check => Packages_To_Check);
  
              Set_First_Declarative_Item_Of
!               (Current_Item, In_Tree, To => First_Declarative_Item);
  
           end if;
        end loop When_Loop;
  
        End_Case_Construction
          (Check_All_Labels => not When_Others and not Quiet_Output,
!          Case_Location    => Location_Of (Case_Construction, In_Tree));
  
        Expect (Tok_End, "`END CASE`");
        Remove_Next_End_Node;
*************** package body Prj.Dect is
*** 703,709 ****
  
           --  Scan past "end"
  
!          Scan;
  
           Expect (Tok_Case, "CASE");
  
--- 739,745 ----
  
           --  Scan past "end"
  
!          Scan (In_Tree);
  
           Expect (Tok_Case, "CASE");
  
*************** package body Prj.Dect is
*** 711,717 ****
  
        --  Scan past "case"
  
!       Scan;
  
        Expect (Tok_Semicolon, "`;`");
        Set_Previous_End_Node (Case_Construction);
--- 747,753 ----
  
        --  Scan past "case"
  
!       Scan (In_Tree);
  
        Expect (Tok_Semicolon, "`;`");
        Set_Previous_End_Node (Case_Construction);
*************** package body Prj.Dect is
*** 723,733 ****
     -----------------------------
  
     procedure Parse_Declarative_Items
!      (Declarations    : out Project_Node_Id;
!       In_Zone         : Zone;
!       First_Attribute : Attribute_Node_Id;
!       Current_Project : Project_Node_Id;
!       Current_Package : Project_Node_Id)
     is
        Current_Declarative_Item : Project_Node_Id := Empty_Node;
        Next_Declarative_Item    : Project_Node_Id := Empty_Node;
--- 759,771 ----
     -----------------------------
  
     procedure Parse_Declarative_Items
!      (In_Tree           : Project_Node_Tree_Ref;
!       Declarations      : out Project_Node_Id;
!       In_Zone           : Zone;
!       First_Attribute   : Attribute_Node_Id;
!       Current_Project   : Project_Node_Id;
!       Current_Package   : Project_Node_Id;
!       Packages_To_Check : String_List_Access)
     is
        Current_Declarative_Item : Project_Node_Id := Empty_Node;
        Next_Declarative_Item    : Project_Node_Id := Empty_Node;
*************** package body Prj.Dect is
*** 742,748 ****
           --  the first token of the declarative element.
           --  Scan past it
  
!          Scan;
  
           Item_Location := Token_Ptr;
  
--- 780,786 ----
           --  the first token of the declarative element.
           --  Scan past it
  
!          Scan (In_Tree);
  
           Item_Location := Token_Ptr;
  
*************** package body Prj.Dect is
*** 755,761 ****
                 end if;
  
                 Parse_Variable_Declaration
!                  (Current_Declaration,
                    Current_Project => Current_Project,
                    Current_Package => Current_Package);
  
--- 793,800 ----
                 end if;
  
                 Parse_Variable_Declaration
!                  (In_Tree,
!                   Current_Declaration,
                    Current_Project => Current_Project,
                    Current_Package => Current_Package);
  
*************** package body Prj.Dect is
*** 765,781 ****
              when Tok_For =>
  
                 Parse_Attribute_Declaration
!                  (Attribute       => Current_Declaration,
!                   First_Attribute => First_Attribute,
!                   Current_Project => Current_Project,
!                   Current_Package => Current_Package);
  
                 Set_End_Of_Line (Current_Declaration);
                 Set_Previous_Line_Node (Current_Declaration);
  
              when Tok_Null =>
  
!                Scan; --  past "null"
  
              when Tok_Package =>
  
--- 804,822 ----
              when Tok_For =>
  
                 Parse_Attribute_Declaration
!                  (In_Tree           => In_Tree,
!                   Attribute         => Current_Declaration,
!                   First_Attribute   => First_Attribute,
!                   Current_Project   => Current_Project,
!                   Current_Package   => Current_Package,
!                   Packages_To_Check => Packages_To_Check);
  
                 Set_End_Of_Line (Current_Declaration);
                 Set_Previous_Line_Node (Current_Declaration);
  
              when Tok_Null =>
  
!                Scan (In_Tree); --  past "null"
  
              when Tok_Package =>
  
*************** package body Prj.Dect is
*** 786,793 ****
                 end if;
  
                 Parse_Package_Declaration
!                  (Package_Declaration => Current_Declaration,
!                   Current_Project     => Current_Project);
  
                 Set_Previous_End_Node (Current_Declaration);
  
--- 827,836 ----
                 end if;
  
                 Parse_Package_Declaration
!                  (In_Tree             => In_Tree,
!                   Package_Declaration => Current_Declaration,
!                   Current_Project     => Current_Project,
!                   Packages_To_Check   => Packages_To_Check);
  
                 Set_Previous_End_Node (Current_Declaration);
  
*************** package body Prj.Dect is
*** 801,807 ****
                 end if;
  
                 Parse_String_Type_Declaration
!                  (String_Type     => Current_Declaration,
                    Current_Project => Current_Project);
  
                 Set_End_Of_Line (Current_Declaration);
--- 844,851 ----
                 end if;
  
                 Parse_String_Type_Declaration
!                  (In_Tree         => In_Tree,
!                   String_Type     => Current_Declaration,
                    Current_Project => Current_Project);
  
                 Set_End_Of_Line (Current_Declaration);
*************** package body Prj.Dect is
*** 812,821 ****
                 --  Case construction
  
                 Parse_Case_Construction
!                  (Case_Construction => Current_Declaration,
                    First_Attribute   => First_Attribute,
                    Current_Project   => Current_Project,
!                   Current_Package   => Current_Package);
  
                 Set_Previous_End_Node (Current_Declaration);
  
--- 856,867 ----
                 --  Case construction
  
                 Parse_Case_Construction
!                  (In_Tree           => In_Tree,
!                   Case_Construction => Current_Declaration,
                    First_Attribute   => First_Attribute,
                    Current_Project   => Current_Project,
!                   Current_Package   => Current_Package,
!                   Packages_To_Check => Packages_To_Check);
  
                 Set_Previous_End_Node (Current_Declaration);
  
*************** package body Prj.Dect is
*** 837,860 ****
           if Current_Declaration /= Empty_Node then
              if Current_Declarative_Item = Empty_Node then
                 Current_Declarative_Item :=
!                  Default_Project_Node (Of_Kind => N_Declarative_Item);
                 Declarations  := Current_Declarative_Item;
  
              else
                 Next_Declarative_Item :=
!                  Default_Project_Node (Of_Kind => N_Declarative_Item);
                 Set_Next_Declarative_Item
!                  (Current_Declarative_Item, To => Next_Declarative_Item);
                 Current_Declarative_Item := Next_Declarative_Item;
              end if;
  
              Set_Current_Item_Node
!               (Current_Declarative_Item, To => Current_Declaration);
!             Set_Location_Of (Current_Declarative_Item, To => Item_Location);
           end if;
- 
        end loop;
- 
     end Parse_Declarative_Items;
  
     -------------------------------
--- 883,909 ----
           if Current_Declaration /= Empty_Node then
              if Current_Declarative_Item = Empty_Node then
                 Current_Declarative_Item :=
!                  Default_Project_Node
!                    (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
                 Declarations  := Current_Declarative_Item;
  
              else
                 Next_Declarative_Item :=
!                  Default_Project_Node
!                    (Of_Kind => N_Declarative_Item, In_Tree => In_Tree);
                 Set_Next_Declarative_Item
!                  (Current_Declarative_Item, In_Tree,
!                   To => Next_Declarative_Item);
                 Current_Declarative_Item := Next_Declarative_Item;
              end if;
  
              Set_Current_Item_Node
!               (Current_Declarative_Item, In_Tree,
!                To => Current_Declaration);
!             Set_Location_Of
!               (Current_Declarative_Item, In_Tree, To => Item_Location);
           end if;
        end loop;
     end Parse_Declarative_Items;
  
     -------------------------------
*************** package body Prj.Dect is
*** 862,869 ****
     -------------------------------
  
     procedure Parse_Package_Declaration
!      (Package_Declaration : out Project_Node_Id;
!       Current_Project     : Project_Node_Id)
     is
        First_Attribute        : Attribute_Node_Id := Empty_Attribute;
        Current_Package        : Package_Node_Id   := Empty_Package;
--- 911,920 ----
     -------------------------------
  
     procedure Parse_Package_Declaration
!      (In_Tree             : Project_Node_Tree_Ref;
!       Package_Declaration : out Project_Node_Id;
!       Current_Project     : Project_Node_Id;
!       Packages_To_Check   : String_List_Access)
     is
        First_Attribute        : Attribute_Node_Id := Empty_Attribute;
        Current_Package        : Package_Node_Id   := Empty_Package;
*************** package body Prj.Dect is
*** 871,887 ****
  
     begin
        Package_Declaration :=
!         Default_Project_Node (Of_Kind => N_Package_Declaration);
!       Set_Location_Of (Package_Declaration, To => Token_Ptr);
  
        --  Scan past "package"
  
!       Scan;
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
! 
!          Set_Name_Of (Package_Declaration, To => Token_Name);
  
           Current_Package := Package_Node_Id_Of (Token_Name);
  
--- 922,938 ----
  
     begin
        Package_Declaration :=
!         Default_Project_Node
!           (Of_Kind => N_Package_Declaration, In_Tree => In_Tree);
!       Set_Location_Of (Package_Declaration, In_Tree, To => Token_Ptr);
  
        --  Scan past "package"
  
!       Scan (In_Tree);
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
!          Set_Name_Of (Package_Declaration, In_Tree, To => Token_Name);
  
           Current_Package := Package_Node_Id_Of (Token_Name);
  
*************** package body Prj.Dect is
*** 890,925 ****
  
           else
              Error_Msg ("?""" &
!                        Get_Name_String (Name_Of (Package_Declaration)) &
                         """ is not a known package name",
                         Token_Ptr);
  
              --  Set the package declaration to "ignored" so that it is not
              --  processed by Prj.Proc.Process.
  
!             Set_Expression_Kind_Of (Package_Declaration, Ignored);
  
              --  Add the unknown package in the list of packages
  
              Add_Unknown_Package (Token_Name, Current_Package);
           end if;
  
!          Set_Package_Id_Of (Package_Declaration, To => Current_Package);
  
           declare
!             Current : Project_Node_Id := First_Package_Of (Current_Project);
  
           begin
              while Current /= Empty_Node
!               and then Name_Of (Current) /= Token_Name
              loop
!                Current := Next_Package_In_Project (Current);
              end loop;
  
              if Current /= Empty_Node then
                 Error_Msg
                   ("package """ &
!                   Get_Name_String (Name_Of (Package_Declaration)) &
                    """ is declared twice in the same project",
                    Token_Ptr);
  
--- 941,979 ----
  
           else
              Error_Msg ("?""" &
!                        Get_Name_String
!                          (Name_Of (Package_Declaration, In_Tree)) &
                         """ is not a known package name",
                         Token_Ptr);
  
              --  Set the package declaration to "ignored" so that it is not
              --  processed by Prj.Proc.Process.
  
!             Set_Expression_Kind_Of (Package_Declaration, In_Tree, Ignored);
  
              --  Add the unknown package in the list of packages
  
              Add_Unknown_Package (Token_Name, Current_Package);
           end if;
  
!          Set_Package_Id_Of
!            (Package_Declaration, In_Tree, To => Current_Package);
  
           declare
!             Current : Project_Node_Id :=
!                         First_Package_Of (Current_Project, In_Tree);
  
           begin
              while Current /= Empty_Node
!               and then Name_Of (Current, In_Tree) /= Token_Name
              loop
!                Current := Next_Package_In_Project (Current, In_Tree);
              end loop;
  
              if Current /= Empty_Node then
                 Error_Msg
                   ("package """ &
!                   Get_Name_String (Name_Of (Package_Declaration, In_Tree)) &
                    """ is declared twice in the same project",
                    Token_Ptr);
  
*************** package body Prj.Dect is
*** 927,949 ****
                 --  Add the package to the project list
  
                 Set_Next_Package_In_Project
!                  (Package_Declaration,
!                   To => First_Package_Of (Current_Project));
                 Set_First_Package_Of
!                  (Current_Project, To => Package_Declaration);
              end if;
           end;
  
           --  Scan past the package name
  
!          Scan;
        end if;
  
        if Token = Tok_Renames then
  
           --  Scan past "renames"
  
!          Scan;
  
           Expect (Tok_Identifier, "identifier");
  
--- 981,1003 ----
                 --  Add the package to the project list
  
                 Set_Next_Package_In_Project
!                  (Package_Declaration, In_Tree,
!                   To => First_Package_Of (Current_Project, In_Tree));
                 Set_First_Package_Of
!                  (Current_Project, In_Tree, To => Package_Declaration);
              end if;
           end;
  
           --  Scan past the package name
  
!          Scan (In_Tree);
        end if;
  
        if Token = Tok_Renames then
  
           --  Scan past "renames"
  
!          Scan (In_Tree);
  
           Expect (Tok_Identifier, "identifier");
  
*************** package body Prj.Dect is
*** 951,970 ****
              declare
                 Project_Name : constant Name_Id := Token_Name;
                 Clause       : Project_Node_Id :=
!                                 First_With_Clause_Of (Current_Project);
                 The_Project  : Project_Node_Id := Empty_Node;
                 Extended     : constant Project_Node_Id :=
                                  Extended_Project_Of
!                                   (Project_Declaration_Of (Current_Project));
              begin
                 while Clause /= Empty_Node loop
!                   --  Only non limited imported projects may be used
!                   --  in a renames declaration.
  
!                   The_Project := Non_Limited_Project_Node_Of (Clause);
                    exit when The_Project /= Empty_Node
!                     and then Name_Of (The_Project) = Project_Name;
!                   Clause := Next_With_Clause_Of (Clause);
                 end loop;
  
                 if Clause = Empty_Node then
--- 1005,1027 ----
              declare
                 Project_Name : constant Name_Id := Token_Name;
                 Clause       : Project_Node_Id :=
!                               First_With_Clause_Of (Current_Project, In_Tree);
                 The_Project  : Project_Node_Id := Empty_Node;
                 Extended     : constant Project_Node_Id :=
                                  Extended_Project_Of
!                                   (Project_Declaration_Of
!                                     (Current_Project, In_Tree),
!                                    In_Tree);
              begin
                 while Clause /= Empty_Node loop
!                   --  Only non limited imported projects may be used in a
!                   --  renames declaration.
  
!                   The_Project :=
!                     Non_Limited_Project_Node_Of (Clause, In_Tree);
                    exit when The_Project /= Empty_Node
!                     and then Name_Of (The_Project, In_Tree) = Project_Name;
!                   Clause := Next_With_Clause_Of (Clause, In_Tree);
                 end loop;
  
                 if Clause = Empty_Node then
*************** package body Prj.Dect is
*** 972,980 ****
                    --  if it's the name of an eventual extended project.
  
                    if Extended /= Empty_Node
!                     and then Name_Of (Extended) = Project_Name then
                       Set_Project_Of_Renamed_Package_Of
!                        (Package_Declaration, To => Extended);
                    else
                       Error_Msg_Name_1 := Project_Name;
                       Error_Msg
--- 1029,1038 ----
                    --  if it's the name of an eventual extended project.
  
                    if Extended /= Empty_Node
!                     and then Name_Of (Extended, In_Tree) = Project_Name
!                   then
                       Set_Project_Of_Renamed_Package_Of
!                        (Package_Declaration, In_Tree, To => Extended);
                    else
                       Error_Msg_Name_1 := Project_Name;
                       Error_Msg
*************** package body Prj.Dect is
*** 982,1016 ****
                    end if;
                 else
                    Set_Project_Of_Renamed_Package_Of
!                     (Package_Declaration, To => The_Project);
                 end if;
              end;
  
!             Scan;
              Expect (Tok_Dot, "`.`");
  
              if Token = Tok_Dot then
!                Scan;
                 Expect (Tok_Identifier, "identifier");
  
                 if Token = Tok_Identifier then
!                   if Name_Of (Package_Declaration) /= Token_Name then
                       Error_Msg ("not the same package name", Token_Ptr);
                    elsif
!                     Project_Of_Renamed_Package_Of (Package_Declaration)
!                                                               /= Empty_Node
                    then
                       declare
                          Current : Project_Node_Id :=
                                      First_Package_Of
                                        (Project_Of_Renamed_Package_Of
!                                          (Package_Declaration));
  
                       begin
                          while Current /= Empty_Node
!                           and then Name_Of (Current) /= Token_Name
                          loop
!                            Current := Next_Package_In_Project (Current);
                          end loop;
  
                          if Current = Empty_Node then
--- 1040,1076 ----
                    end if;
                 else
                    Set_Project_Of_Renamed_Package_Of
!                     (Package_Declaration, In_Tree, To => The_Project);
                 end if;
              end;
  
!             Scan (In_Tree);
              Expect (Tok_Dot, "`.`");
  
              if Token = Tok_Dot then
!                Scan (In_Tree);
                 Expect (Tok_Identifier, "identifier");
  
                 if Token = Tok_Identifier then
!                   if Name_Of (Package_Declaration, In_Tree) /= Token_Name then
                       Error_Msg ("not the same package name", Token_Ptr);
                    elsif
!                     Project_Of_Renamed_Package_Of
!                       (Package_Declaration, In_Tree) /= Empty_Node
                    then
                       declare
                          Current : Project_Node_Id :=
                                      First_Package_Of
                                        (Project_Of_Renamed_Package_Of
!                                            (Package_Declaration, In_Tree),
!                                        In_Tree);
  
                       begin
                          while Current /= Empty_Node
!                           and then Name_Of (Current, In_Tree) /= Token_Name
                          loop
!                            Current :=
!                              Next_Package_In_Project (Current, In_Tree);
                          end loop;
  
                          if Current = Empty_Node then
*************** package body Prj.Dect is
*** 1023,1029 ****
                       end;
                    end if;
  
!                   Scan;
                 end if;
              end if;
           end if;
--- 1083,1089 ----
                       end;
                    end if;
  
!                   Scan (In_Tree);
                 end if;
              end if;
           end if;
*************** package body Prj.Dect is
*** 1038,1051 ****
           Set_Next_End_Node (Package_Declaration);
  
           Parse_Declarative_Items
!            (Declarations    => First_Declarative_Item,
!             In_Zone         => In_Package,
!             First_Attribute => First_Attribute,
!             Current_Project => Current_Project,
!             Current_Package => Package_Declaration);
  
           Set_First_Declarative_Item_Of
!            (Package_Declaration, To => First_Declarative_Item);
  
           Expect (Tok_End, "END");
  
--- 1098,1113 ----
           Set_Next_End_Node (Package_Declaration);
  
           Parse_Declarative_Items
!            (In_Tree           => In_Tree,
!             Declarations      => First_Declarative_Item,
!             In_Zone           => In_Package,
!             First_Attribute   => First_Attribute,
!             Current_Project   => Current_Project,
!             Current_Package   => Package_Declaration,
!             Packages_To_Check => Packages_To_Check);
  
           Set_First_Declarative_Item_Of
!            (Package_Declaration, In_Tree, To => First_Declarative_Item);
  
           Expect (Tok_End, "END");
  
*************** package body Prj.Dect is
*** 1053,1059 ****
  
              --  Scan past "end"
  
!             Scan;
           end if;
  
           --  We should have the name of the package after "end"
--- 1115,1121 ----
  
              --  Scan past "end"
  
!             Scan (In_Tree);
           end if;
  
           --  We should have the name of the package after "end"
*************** package body Prj.Dect is
*** 1061,1070 ****
           Expect (Tok_Identifier, "identifier");
  
           if Token = Tok_Identifier
!            and then Name_Of (Package_Declaration) /= No_Name
!            and then Token_Name /= Name_Of (Package_Declaration)
           then
!             Error_Msg_Name_1 := Name_Of (Package_Declaration);
              Error_Msg ("expected {", Token_Ptr);
           end if;
  
--- 1123,1132 ----
           Expect (Tok_Identifier, "identifier");
  
           if Token = Tok_Identifier
!            and then Name_Of (Package_Declaration, In_Tree) /= No_Name
!            and then Token_Name /= Name_Of (Package_Declaration, In_Tree)
           then
!             Error_Msg_Name_1 := Name_Of (Package_Declaration, In_Tree);
              Error_Msg ("expected {", Token_Ptr);
           end if;
  
*************** package body Prj.Dect is
*** 1072,1078 ****
  
              --  Scan past the package name
  
!             Scan;
           end if;
  
           Expect (Tok_Semicolon, "`;`");
--- 1134,1140 ----
  
              --  Scan past the package name
  
!             Scan (In_Tree);
           end if;
  
           Expect (Tok_Semicolon, "`;`");
*************** package body Prj.Dect is
*** 1089,1095 ****
     -----------------------------------
  
     procedure Parse_String_Type_Declaration
!      (String_Type     : out Project_Node_Id;
        Current_Project : Project_Node_Id)
     is
        Current      : Project_Node_Id := Empty_Node;
--- 1151,1158 ----
     -----------------------------------
  
     procedure Parse_String_Type_Declaration
!      (In_Tree         : Project_Node_Tree_Ref;
!       String_Type     : out Project_Node_Id;
        Current_Project : Project_Node_Id)
     is
        Current      : Project_Node_Id := Empty_Node;
*************** package body Prj.Dect is
*** 1097,1121 ****
  
     begin
        String_Type :=
!         Default_Project_Node (Of_Kind => N_String_Type_Declaration);
  
!       Set_Location_Of (String_Type, To => Token_Ptr);
  
        --  Scan past "type"
  
!       Scan;
  
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
!          Set_Name_Of (String_Type, To => Token_Name);
  
!          Current := First_String_Type_Of (Current_Project);
           while Current /= Empty_Node
             and then
!            Name_Of (Current) /= Token_Name
           loop
!             Current := Next_String_Type (Current);
           end loop;
  
           if Current /= Empty_Node then
--- 1160,1185 ----
  
     begin
        String_Type :=
!         Default_Project_Node
!           (Of_Kind => N_String_Type_Declaration, In_Tree => In_Tree);
  
!       Set_Location_Of (String_Type, In_Tree, To => Token_Ptr);
  
        --  Scan past "type"
  
!       Scan (In_Tree);
  
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
!          Set_Name_Of (String_Type, In_Tree, To => Token_Name);
  
!          Current := First_String_Type_Of (Current_Project, In_Tree);
           while Current /= Empty_Node
             and then
!            Name_Of (Current, In_Tree) /= Token_Name
           loop
!             Current := Next_String_Type (Current, In_Tree);
           end loop;
  
           if Current /= Empty_Node then
*************** package body Prj.Dect is
*** 1124,1134 ****
                         """",
                         Token_Ptr);
           else
!             Current := First_Variable_Of (Current_Project);
              while Current /= Empty_Node
!               and then Name_Of (Current) /= Token_Name
              loop
!                Current := Next_Variable (Current);
              end loop;
  
              if Current /= Empty_Node then
--- 1188,1198 ----
                         """",
                         Token_Ptr);
           else
!             Current := First_Variable_Of (Current_Project, In_Tree);
              while Current /= Empty_Node
!               and then Name_Of (Current, In_Tree) /= Token_Name
              loop
!                Current := Next_Variable (Current, In_Tree);
              end loop;
  
              if Current /= Empty_Node then
*************** package body Prj.Dect is
*** 1137,1171 ****
                            """ is already a variable name", Token_Ptr);
              else
                 Set_Next_String_Type
!                  (String_Type, To => First_String_Type_Of (Current_Project));
!                Set_First_String_Type_Of (Current_Project, To => String_Type);
              end if;
           end if;
  
           --  Scan past the name
  
!          Scan;
        end if;
  
        Expect (Tok_Is, "IS");
  
        if Token = Tok_Is then
!          Scan;
        end if;
  
        Expect (Tok_Left_Paren, "`(`");
  
        if Token = Tok_Left_Paren then
!          Scan;
        end if;
  
!       Parse_String_Type_List (First_String => First_String);
!       Set_First_Literal_String (String_Type, To => First_String);
  
        Expect (Tok_Right_Paren, "`)`");
  
        if Token = Tok_Right_Paren then
!          Scan;
        end if;
  
     end Parse_String_Type_Declaration;
--- 1201,1238 ----
                            """ is already a variable name", Token_Ptr);
              else
                 Set_Next_String_Type
!                  (String_Type, In_Tree,
!                   To => First_String_Type_Of (Current_Project, In_Tree));
!                Set_First_String_Type_Of
!                  (Current_Project, In_Tree, To => String_Type);
              end if;
           end if;
  
           --  Scan past the name
  
!          Scan (In_Tree);
        end if;
  
        Expect (Tok_Is, "IS");
  
        if Token = Tok_Is then
!          Scan (In_Tree);
        end if;
  
        Expect (Tok_Left_Paren, "`(`");
  
        if Token = Tok_Left_Paren then
!          Scan (In_Tree);
        end if;
  
!       Parse_String_Type_List
!         (In_Tree => In_Tree, First_String => First_String);
!       Set_First_Literal_String (String_Type, In_Tree, To => First_String);
  
        Expect (Tok_Right_Paren, "`)`");
  
        if Token = Tok_Right_Paren then
!          Scan (In_Tree);
        end if;
  
     end Parse_String_Type_Declaration;
*************** package body Prj.Dect is
*** 1175,1181 ****
     --------------------------------
  
     procedure Parse_Variable_Declaration
!      (Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
     is
--- 1242,1249 ----
     --------------------------------
  
     procedure Parse_Variable_Declaration
!      (In_Tree         : Project_Node_Tree_Ref;
!       Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
     is
*************** package body Prj.Dect is
*** 1190,1209 ****
  
     begin
        Variable :=
!         Default_Project_Node (Of_Kind => N_Variable_Declaration);
!       Set_Name_Of (Variable, To => Variable_Name);
!       Set_Location_Of (Variable, To => Token_Ptr);
  
        --  Scan past the variable name
  
!       Scan;
  
        if Token = Tok_Colon then
  
           --  Typed string variable declaration
  
!          Scan;
!          Set_Kind_Of (Variable, N_Typed_Variable_Declaration);
           Expect (Tok_Identifier, "identifier");
  
           OK := Token = Tok_Identifier;
--- 1258,1278 ----
  
     begin
        Variable :=
!         Default_Project_Node
!           (Of_Kind => N_Variable_Declaration, In_Tree => In_Tree);
!       Set_Name_Of (Variable, In_Tree, To => Variable_Name);
!       Set_Location_Of (Variable, In_Tree, To => Token_Ptr);
  
        --  Scan past the variable name
  
!       Scan (In_Tree);
  
        if Token = Tok_Colon then
  
           --  Typed string variable declaration
  
!          Scan (In_Tree);
!          Set_Kind_Of (Variable, In_Tree, N_Typed_Variable_Declaration);
           Expect (Tok_Identifier, "identifier");
  
           OK := Token = Tok_Identifier;
*************** package body Prj.Dect is
*** 1211,1217 ****
           if OK then
              String_Type_Name := Token_Name;
              Type_Location := Token_Ptr;
!             Scan;
  
              if Token = Tok_Dot then
                 Project_String_Type_Name := String_Type_Name;
--- 1280,1286 ----
           if OK then
              String_Type_Name := Token_Name;
              Type_Location := Token_Ptr;
!             Scan (In_Tree);
  
              if Token = Tok_Dot then
                 Project_String_Type_Name := String_Type_Name;
*************** package body Prj.Dect is
*** 1219,1231 ****
  
                 --  Scan past the dot
  
!                Scan;
                 Expect (Tok_Identifier, "identifier");
  
                 if Token = Tok_Identifier then
                    String_Type_Name := Token_Name;
                    Type_Location := Token_Ptr;
!                   Scan;
                 else
                    OK := False;
                 end if;
--- 1288,1300 ----
  
                 --  Scan past the dot
  
!                Scan (In_Tree);
                 Expect (Tok_Identifier, "identifier");
  
                 if Token = Tok_Identifier then
                    String_Type_Name := Token_Name;
                    Type_Location := Token_Ptr;
!                   Scan (In_Tree);
                 else
                    OK := False;
                 end if;
*************** package body Prj.Dect is
*** 1234,1240 ****
              if OK then
                 declare
                    Current : Project_Node_Id :=
!                               First_String_Type_Of (Current_Project);
  
                 begin
                    if Project_String_Type_Name /= No_Name then
--- 1303,1309 ----
              if OK then
                 declare
                    Current : Project_Node_Id :=
!                               First_String_Type_Of (Current_Project, In_Tree);
  
                 begin
                    if Project_String_Type_Name /= No_Name then
*************** package body Prj.Dect is
*** 1242,1248 ****
                          The_Project_Name_And_Node : constant
                            Tree_Private_Part.Project_Name_And_Node :=
                            Tree_Private_Part.Projects_Htable.Get
!                                                     (Project_String_Type_Name);
  
                          use Tree_Private_Part;
  
--- 1311,1317 ----
                          The_Project_Name_And_Node : constant
                            Tree_Private_Part.Project_Name_And_Node :=
                            Tree_Private_Part.Projects_Htable.Get
!                             (In_Tree.Projects_HT, Project_String_Type_Name);
  
                          use Tree_Private_Part;
  
*************** package body Prj.Dect is
*** 1259,1273 ****
                          else
                             Current :=
                               First_String_Type_Of
!                                          (The_Project_Name_And_Node.Node);
                          end if;
                       end;
                    end if;
  
                    while Current /= Empty_Node
!                     and then Name_Of (Current) /= String_Type_Name
                    loop
!                      Current := Next_String_Type (Current);
                    end loop;
  
                    if Current = Empty_Node then
--- 1328,1342 ----
                          else
                             Current :=
                               First_String_Type_Of
!                                (The_Project_Name_And_Node.Node, In_Tree);
                          end if;
                       end;
                    end if;
  
                    while Current /= Empty_Node
!                     and then Name_Of (Current, In_Tree) /= String_Type_Name
                    loop
!                      Current := Next_String_Type (Current, In_Tree);
                    end loop;
  
                    if Current = Empty_Node then
*************** package body Prj.Dect is
*** 1278,1284 ****
                       OK := False;
                    else
                       Set_String_Type_Of
!                        (Variable, To => Current);
                    end if;
                 end;
              end if;
--- 1347,1353 ----
                       OK := False;
                    else
                       Set_String_Type_Of
!                        (Variable, In_Tree, To => Current);
                    end if;
                 end;
              end if;
*************** package body Prj.Dect is
*** 1290,1296 ****
        OK := OK and (Token = Tok_Colon_Equal);
  
        if Token = Tok_Colon_Equal then
!          Scan;
        end if;
  
        --  Get the single string or string list value
--- 1359,1365 ----
        OK := OK and (Token = Tok_Colon_Equal);
  
        if Token = Tok_Colon_Equal then
!          Scan (In_Tree);
        end if;
  
        --  Get the single string or string list value
*************** package body Prj.Dect is
*** 1298,1321 ****
        Expression_Location := Token_Ptr;
  
        Parse_Expression
!         (Expression      => Expression,
           Current_Project => Current_Project,
           Current_Package => Current_Package,
           Optional_Index  => False);
!       Set_Expression_Of (Variable, To => Expression);
  
        if Expression /= Empty_Node then
           --  A typed string must have a single string value, not a list
  
!          if Kind_Of (Variable) = N_Typed_Variable_Declaration
!            and then Expression_Kind_Of (Expression) = List
           then
              Error_Msg
                ("expression must be a single string", Expression_Location);
           end if;
  
           Set_Expression_Kind_Of
!            (Variable, To => Expression_Kind_Of (Expression));
        end if;
  
        if OK then
--- 1367,1392 ----
        Expression_Location := Token_Ptr;
  
        Parse_Expression
!         (In_Tree         => In_Tree,
!          Expression      => Expression,
           Current_Project => Current_Project,
           Current_Package => Current_Package,
           Optional_Index  => False);
!       Set_Expression_Of (Variable, In_Tree, To => Expression);
  
        if Expression /= Empty_Node then
           --  A typed string must have a single string value, not a list
  
!          if Kind_Of (Variable, In_Tree) = N_Typed_Variable_Declaration
!            and then Expression_Kind_Of (Expression, In_Tree) = List
           then
              Error_Msg
                ("expression must be a single string", Expression_Location);
           end if;
  
           Set_Expression_Kind_Of
!            (Variable, In_Tree,
!             To => Expression_Kind_Of (Expression, In_Tree));
        end if;
  
        if OK then
*************** package body Prj.Dect is
*** 1324,1364 ****
  
           begin
              if Current_Package /= Empty_Node then
!                The_Variable :=  First_Variable_Of (Current_Package);
              elsif Current_Project /= Empty_Node then
!                The_Variable :=  First_Variable_Of (Current_Project);
              end if;
  
              while The_Variable /= Empty_Node
!               and then Name_Of (The_Variable) /= Variable_Name
              loop
!                The_Variable := Next_Variable (The_Variable);
              end loop;
  
              if The_Variable = Empty_Node then
                 if Current_Package /= Empty_Node then
                    Set_Next_Variable
!                     (Variable, To => First_Variable_Of (Current_Package));
!                   Set_First_Variable_Of (Current_Package, To => Variable);
  
                 elsif Current_Project /= Empty_Node then
                    Set_Next_Variable
!                     (Variable, To => First_Variable_Of (Current_Project));
!                   Set_First_Variable_Of (Current_Project, To => Variable);
                 end if;
  
              else
!                if Expression_Kind_Of (Variable) /= Undefined then
!                   if Expression_Kind_Of (The_Variable) = Undefined then
                       Set_Expression_Kind_Of
!                        (The_Variable, To => Expression_Kind_Of (Variable));
  
                    else
!                      if Expression_Kind_Of (The_Variable) /=
!                        Expression_Kind_Of (Variable)
                       then
                          Error_Msg ("wrong expression kind for variable """ &
!                                      Get_Name_String (Name_Of (The_Variable)) &
                                       """",
                                     Expression_Location);
                       end if;
--- 1395,1443 ----
  
           begin
              if Current_Package /= Empty_Node then
!                The_Variable := First_Variable_Of (Current_Package, In_Tree);
              elsif Current_Project /= Empty_Node then
!                The_Variable :=  First_Variable_Of (Current_Project, In_Tree);
              end if;
  
              while The_Variable /= Empty_Node
!               and then Name_Of (The_Variable, In_Tree) /= Variable_Name
              loop
!                The_Variable := Next_Variable (The_Variable, In_Tree);
              end loop;
  
              if The_Variable = Empty_Node then
                 if Current_Package /= Empty_Node then
                    Set_Next_Variable
!                     (Variable, In_Tree,
!                      To => First_Variable_Of (Current_Package, In_Tree));
!                   Set_First_Variable_Of
!                     (Current_Package, In_Tree, To => Variable);
  
                 elsif Current_Project /= Empty_Node then
                    Set_Next_Variable
!                     (Variable, In_Tree,
!                      To => First_Variable_Of (Current_Project, In_Tree));
!                   Set_First_Variable_Of
!                     (Current_Project, In_Tree, To => Variable);
                 end if;
  
              else
!                if Expression_Kind_Of (Variable, In_Tree) /= Undefined then
!                   if
!                     Expression_Kind_Of (The_Variable, In_Tree) = Undefined
!                   then
                       Set_Expression_Kind_Of
!                        (The_Variable, In_Tree,
!                         To => Expression_Kind_Of (Variable, In_Tree));
  
                    else
!                      if Expression_Kind_Of (The_Variable, In_Tree) /=
!                        Expression_Kind_Of (Variable, In_Tree)
                       then
                          Error_Msg ("wrong expression kind for variable """ &
!                                    Get_Name_String
!                                      (Name_Of (The_Variable, In_Tree)) &
                                       """",
                                     Expression_Location);
                       end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-dect.ads gcc-4.1.0/gcc/ada/prj-dect.ads
*** gcc-4.0.2/gcc/ada/prj-dect.ads	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prj-dect.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Prj.Tree;
*** 31,39 ****
  private package Prj.Dect is
  
     procedure Parse
!      (Declarations    : out Prj.Tree.Project_Node_Id;
!       Current_Project : Prj.Tree.Project_Node_Id;
!       Extends         : Prj.Tree.Project_Node_Id);
!    --  Parse project declarative items. What are parameters ???
  
  end Prj.Dect;
--- 31,57 ----
  private package Prj.Dect is
  
     procedure Parse
!      (In_Tree           : Prj.Tree.Project_Node_Tree_Ref;
!       Declarations      : out Prj.Tree.Project_Node_Id;
!       Current_Project   : Prj.Tree.Project_Node_Id;
!       Extends           : Prj.Tree.Project_Node_Id;
!       Packages_To_Check : String_List_Access);
!    --  Parse project declarative items
!    --
!    --  In_Tree is the project node tree
!    --
!    --  Declarations is the resulting project node
!    --
!    --  Current_Project is the project node of the project for which the
!    --  declarative items are parsed.
!    --
!    --  Extends is the project node of the project that project Current_Project
!    --  extends. If project Current-Project does not extend any project,
!    --  Extends has the value Empty_Node.
!    --
!    --  Packages_To_Check is the list of packages that needs to be checked.
!    --  For legal packages declared in project Current_Project that are not in
!    --  Packages_To_Check, only the syntax of the declarations are checked, not
!    --  the attribute names and kinds.
  
  end Prj.Dect;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-env.adb gcc-4.1.0/gcc/ada/prj-env.adb
*** gcc-4.0.2/gcc/ada/prj-env.adb	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-env.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Opt;
*** 29,44 ****
  with Osint;    use Osint;
  with Output;   use Output;
  with Prj.Com;  use Prj.Com;
- with Table;
  with Tempdir;
  
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
- with GNAT.OS_Lib;               use GNAT.OS_Lib;
  
  package body Prj.Env is
  
-    type Naming_Id is new Nat;
- 
     Current_Source_Path_File : Name_Id := No_Name;
     --  Current value of project source path file env var.
     --  Used to avoid setting the env var to the same value.
--- 29,40 ----
*************** package body Prj.Env is
*** 52,58 ****
     --  and ADA_OBJECTS_PATH are stored.
  
     Ada_Path_Length : Natural := 0;
!    --  Index of the last valid character in Ada_Path_Buffer.
  
     Ada_Prj_Include_File_Set : Boolean := False;
     Ada_Prj_Objects_File_Set : Boolean := False;
--- 48,54 ----
     --  and ADA_OBJECTS_PATH are stored.
  
     Ada_Path_Length : Natural := 0;
!    --  Index of the last valid character in Ada_Path_Buffer
  
     Ada_Prj_Include_File_Set : Boolean := False;
     Ada_Prj_Objects_File_Set : Boolean := False;
*************** package body Prj.Env is
*** 62,124 ****
     --  platforms, except on VMS where the logical names are deassigned, thus
     --  avoiding the pollution of the environment of the caller.
  
!    package Namings is new Table.Table
!      (Table_Component_Type => Naming_Data,
!       Table_Index_Type     => Naming_Id,
!       Table_Low_Bound      => 1,
!       Table_Initial        => 5,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Env.Namings");
! 
!    Default_Naming : constant Naming_Id := Namings.First;
  
     Fill_Mapping_File : Boolean := True;
  
-    package Path_Files is new Table.Table
-      (Table_Component_Type => Name_Id,
-       Table_Index_Type     => Natural,
-       Table_Low_Bound      => 1,
-       Table_Initial        => 50,
-       Table_Increment      => 50,
-       Table_Name           => "Prj.Env.Path_Files");
-    --  Table storing all the temp path file names.
-    --  Used by Delete_All_Path_Files.
- 
     type Project_Flags is array (Project_Id range <>) of Boolean;
     --  A Boolean array type used in Create_Mapping_File to select the projects
     --  in the closure of a specific project.
  
-    package Source_Paths is new Table.Table
-      (Table_Component_Type => Name_Id,
-       Table_Index_Type     => Natural,
-       Table_Low_Bound      => 1,
-       Table_Initial        => 50,
-       Table_Increment      => 50,
-       Table_Name           => "Prj.Env.Source_Paths");
-    --  A table to store the source dirs before creating the source path file
- 
-    package Object_Paths is new Table.Table
-      (Table_Component_Type => Name_Id,
-       Table_Index_Type     => Natural,
-       Table_Low_Bound      => 1,
-       Table_Initial        => 50,
-       Table_Increment      => 50,
-       Table_Name           => "Prj.Env.Source_Paths");
-    --  A table to store the object dirs, before creating the object path file
- 
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    function Body_Path_Name_Of (Unit : Unit_Id) return String;
     --  Returns the path name of the body of a unit.
     --  Compute it first, if necessary.
  
!    function Spec_Path_Name_Of (Unit : Unit_Id) return String;
     --  Returns the path name of the spec of a unit.
     --  Compute it first, if necessary.
  
!    procedure Add_To_Path (Source_Dirs : String_List_Id);
     --  Add to Ada_Path_Buffer all the source directories in string list
     --  Source_Dirs, if any. Increment Ada_Path_Length.
  
--- 58,90 ----
     --  platforms, except on VMS where the logical names are deassigned, thus
     --  avoiding the pollution of the environment of the caller.
  
!    Default_Naming : constant Naming_Id := Naming_Table.First;
  
     Fill_Mapping_File : Boolean := True;
  
     type Project_Flags is array (Project_Id range <>) of Boolean;
     --  A Boolean array type used in Create_Mapping_File to select the projects
     --  in the closure of a specific project.
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
!    function Body_Path_Name_Of
!      (Unit    : Unit_Id;
!       In_Tree : Project_Tree_Ref) return String;
     --  Returns the path name of the body of a unit.
     --  Compute it first, if necessary.
  
!    function Spec_Path_Name_Of
!      (Unit    : Unit_Id;
!       In_Tree : Project_Tree_Ref) return String;
     --  Returns the path name of the spec of a unit.
     --  Compute it first, if necessary.
  
!    procedure Add_To_Path
!      (Source_Dirs : String_List_Id;
!       In_Tree     : Project_Tree_Ref);
     --  Add to Ada_Path_Buffer all the source directories in string list
     --  Source_Dirs, if any. Increment Ada_Path_Length.
  
*************** package body Prj.Env is
*** 128,138 ****
     --  If Ada_Path_Length /= 0, prepend a Path_Separator character to
     --  Path.
  
!    procedure Add_To_Source_Path (Source_Dirs : String_List_Id);
     --  Add to Ada_Path_B all the source directories in string list
     --  Source_Dirs, if any. Increment Ada_Path_Length.
  
!    procedure Add_To_Object_Path (Object_Dir : Name_Id);
     --  Add Object_Dir to object path table. Make sure it is not duplicate
     --  and it is the last one in the current table.
  
--- 94,107 ----
     --  If Ada_Path_Length /= 0, prepend a Path_Separator character to
     --  Path.
  
!    procedure Add_To_Source_Path
!      (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref);
     --  Add to Ada_Path_B all the source directories in string list
     --  Source_Dirs, if any. Increment Ada_Path_Length.
  
!    procedure Add_To_Object_Path
!      (Object_Dir : Name_Id;
!       In_Tree    : Project_Tree_Ref);
     --  Add Object_Dir to object path table. Make sure it is not duplicate
     --  and it is the last one in the current table.
  
*************** package body Prj.Env is
*** 140,146 ****
     --  Return True if there is at least one ALI file in the directory Dir
  
     procedure Create_New_Path_File
!      (Path_FD   : out File_Descriptor;
        Path_Name : out Name_Id);
     --  Create a new temporary path file. Get the file name in Path_Name.
     --  The name is normally obtained by increasing the number in
--- 109,116 ----
     --  Return True if there is at least one ALI file in the directory Dir
  
     procedure Create_New_Path_File
!      (In_Tree   : Project_Tree_Ref;
!       Path_FD   : out File_Descriptor;
        Path_Name : out Name_Id);
     --  Create a new temporary path file. Get the file name in Path_Name.
     --  The name is normally obtained by increasing the number in
*************** package body Prj.Env is
*** 149,155 ****
     procedure Set_Path_File_Var (Name : String; Value : String);
     --  Call Setenv, after calling To_Host_File_Spec
  
!    function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id;
     --  Return a project that is either Project or an extended ancestor of
     --  Project that itself is not extended.
  
--- 119,126 ----
     procedure Set_Path_File_Var (Name : String; Value : String);
     --  Call Setenv, after calling To_Host_File_Spec
  
!    function Ultimate_Extension_Of
!      (Project : in Project_Id; In_Tree : Project_Tree_Ref) return Project_Id;
     --  Return a project that is either Project or an extended ancestor of
     --  Project that itself is not extended.
  
*************** package body Prj.Env is
*** 157,163 ****
     -- Ada_Include_Path --
     ----------------------
  
!    function Ada_Include_Path (Project : Project_Id) return String_Access is
  
        procedure Add (Project : Project_Id);
        --  Add all the source directories of a project to the path only if
--- 128,136 ----
     -- Ada_Include_Path --
     ----------------------
  
!    function Ada_Include_Path
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return String_Access is
  
        procedure Add (Project : Project_Id);
        --  Add all the source directories of a project to the path only if
*************** package body Prj.Env is
*** 173,189 ****
        begin
           --  If Seen is empty, then the project cannot have been visited
  
!          if not Projects.Table (Project).Seen then
!             Projects.Table (Project).Seen := True;
  
              declare
!                Data : constant Project_Data := Projects.Table (Project);
                 List : Project_List := Data.Imported_Projects;
  
              begin
                 --  Add to path all source directories of this project
  
!                Add_To_Path (Data.Source_Dirs);
  
                 --  Call Add to the project being extended, if any
  
--- 146,163 ----
        begin
           --  If Seen is empty, then the project cannot have been visited
  
!          if not In_Tree.Projects.Table (Project).Seen then
!             In_Tree.Projects.Table (Project).Seen := True;
  
              declare
!                Data : constant Project_Data :=
!                         In_Tree.Projects.Table (Project);
                 List : Project_List := Data.Imported_Projects;
  
              begin
                 --  Add to path all source directories of this project
  
!                Add_To_Path (Data.Source_Dirs, In_Tree);
  
                 --  Call Add to the project being extended, if any
  
*************** package body Prj.Env is
*** 194,201 ****
                 --  Call Add for each imported project, if any
  
                 while List /= Empty_Project_List loop
!                   Add (Project_Lists.Table (List).Project);
!                   List := Project_Lists.Table (List).Next;
                 end loop;
              end;
           end if;
--- 168,176 ----
                 --  Call Add for each imported project, if any
  
                 while List /= Empty_Project_List loop
!                   Add
!                     (In_Tree.Project_Lists.Table (List).Project);
!                   List := In_Tree.Project_Lists.Table (List).Next;
                 end loop;
              end;
           end if;
*************** package body Prj.Env is
*** 207,225 ****
        --  If it is the first time we call this function for
        --  this project, compute the source path
  
!       if Projects.Table (Project).Ada_Include_Path = null then
           Ada_Path_Length := 0;
  
!          for Index in 1 .. Projects.Last loop
!             Projects.Table (Index).Seen := False;
           end loop;
  
           Add (Project);
!          Projects.Table (Project).Ada_Include_Path :=
             new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
        end if;
  
!       return Projects.Table (Project).Ada_Include_Path;
     end Ada_Include_Path;
  
     ----------------------
--- 182,204 ----
        --  If it is the first time we call this function for
        --  this project, compute the source path
  
!       if
!         In_Tree.Projects.Table (Project).Ada_Include_Path = null
!       then
           Ada_Path_Length := 0;
  
!          for Index in Project_Table.First ..
!                       Project_Table.Last (In_Tree.Projects)
!          loop
!             In_Tree.Projects.Table (Index).Seen := False;
           end loop;
  
           Add (Project);
!          In_Tree.Projects.Table (Project).Ada_Include_Path :=
             new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
        end if;
  
!       return In_Tree.Projects.Table (Project).Ada_Include_Path;
     end Ada_Include_Path;
  
     ----------------------
*************** package body Prj.Env is
*** 228,241 ****
  
     function Ada_Include_Path
       (Project   : Project_Id;
        Recursive : Boolean) return String
     is
     begin
        if Recursive then
!          return Ada_Include_Path (Project).all;
        else
           Ada_Path_Length := 0;
!          Add_To_Path (Projects.Table (Project).Source_Dirs);
           return Ada_Path_Buffer (1 .. Ada_Path_Length);
        end if;
     end Ada_Include_Path;
--- 207,222 ----
  
     function Ada_Include_Path
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        Recursive : Boolean) return String
     is
     begin
        if Recursive then
!          return Ada_Include_Path (Project, In_Tree).all;
        else
           Ada_Path_Length := 0;
!          Add_To_Path
!            (In_Tree.Projects.Table (Project).Source_Dirs, In_Tree);
           return Ada_Path_Buffer (1 .. Ada_Path_Length);
        end if;
     end Ada_Include_Path;
*************** package body Prj.Env is
*** 246,251 ****
--- 227,233 ----
  
     function Ada_Objects_Path
       (Project             : Project_Id;
+       In_Tree             : Project_Tree_Ref;
        Including_Libraries : Boolean := True) return String_Access
     is
        procedure Add (Project : Project_Id);
*************** package body Prj.Env is
*** 262,272 ****
        begin
           --  If this project has not been seen yet
  
!          if not Projects.Table (Project).Seen then
!             Projects.Table (Project).Seen := True;
  
              declare
!                Data : constant Project_Data := Projects.Table (Project);
                 List : Project_List := Data.Imported_Projects;
  
              begin
--- 244,255 ----
        begin
           --  If this project has not been seen yet
  
!          if not In_Tree.Projects.Table (Project).Seen then
!             In_Tree.Projects.Table (Project).Seen := True;
  
              declare
!                Data : constant Project_Data :=
!                  In_Tree.Projects.Table (Project);
                 List : Project_List := Data.Imported_Projects;
  
              begin
*************** package body Prj.Env is
*** 286,294 ****
  
                    if Data.Library then
                       if Data.Object_Directory = No_Name
!                        or else Contains_ALI_Files (Data.Library_Dir)
                       then
!                         Add_To_Path (Get_Name_String (Data.Library_Dir));
                       else
                          Add_To_Path (Get_Name_String (Data.Object_Directory));
                       end if;
--- 269,278 ----
  
                    if Data.Library then
                       if Data.Object_Directory = No_Name
!                        or else
!                          Contains_ALI_Files (Data.Library_ALI_Dir)
                       then
!                         Add_To_Path (Get_Name_String (Data.Library_ALI_Dir));
                       else
                          Add_To_Path (Get_Name_String (Data.Object_Directory));
                       end if;
*************** package body Prj.Env is
*** 309,316 ****
                 --  Call Add for each imported project, if any
  
                 while List /= Empty_Project_List loop
!                   Add (Project_Lists.Table (List).Project);
!                   List := Project_Lists.Table (List).Next;
                 end loop;
              end;
  
--- 293,301 ----
                 --  Call Add for each imported project, if any
  
                 while List /= Empty_Project_List loop
!                   Add
!                     (In_Tree.Project_Lists.Table (List).Project);
!                   List := In_Tree.Project_Lists.Table (List).Next;
                 end loop;
              end;
  
*************** package body Prj.Env is
*** 323,382 ****
        --  If it is the first time we call this function for
        --  this project, compute the objects path
  
!       if Projects.Table (Project).Ada_Objects_Path = null then
           Ada_Path_Length := 0;
  
!          for Index in 1 .. Projects.Last loop
!             Projects.Table (Index).Seen := False;
           end loop;
  
           Add (Project);
!          Projects.Table (Project).Ada_Objects_Path :=
             new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
        end if;
  
!       return Projects.Table (Project).Ada_Objects_Path;
     end Ada_Objects_Path;
  
     ------------------------
     -- Add_To_Object_Path --
     ------------------------
  
!    procedure Add_To_Object_Path (Object_Dir : Name_Id) is
     begin
        --  Check if the directory is already in the table
  
!       for Index in 1 .. Object_Paths.Last loop
  
           --  If it is, remove it, and add it as the last one
  
!          if Object_Paths.Table (Index) = Object_Dir then
!             for Index2 in Index + 1 .. Object_Paths.Last loop
!                Object_Paths.Table (Index2 - 1) :=
!                  Object_Paths.Table (Index2);
              end loop;
  
!             Object_Paths.Table (Object_Paths.Last) := Object_Dir;
              return;
           end if;
        end loop;
  
        --  The directory is not already in the table, add it
  
!       Object_Paths.Increment_Last;
!       Object_Paths.Table (Object_Paths.Last) := Object_Dir;
     end Add_To_Object_Path;
  
     -----------------
     -- Add_To_Path --
     -----------------
  
!    procedure Add_To_Path (Source_Dirs : String_List_Id) is
        Current    : String_List_Id := Source_Dirs;
        Source_Dir : String_Element;
     begin
        while Current /= Nil_String loop
!          Source_Dir := String_Elements.Table (Current);
           Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
           Current := Source_Dir.Next;
        end loop;
--- 308,385 ----
        --  If it is the first time we call this function for
        --  this project, compute the objects path
  
!       if
!         In_Tree.Projects.Table (Project).Ada_Objects_Path = null
!       then
           Ada_Path_Length := 0;
  
!          for Index in Project_Table.First ..
!                       Project_Table.Last (In_Tree.Projects)
!          loop
!             In_Tree.Projects.Table (Index).Seen := False;
           end loop;
  
           Add (Project);
!          In_Tree.Projects.Table (Project).Ada_Objects_Path :=
             new String'(Ada_Path_Buffer (1 .. Ada_Path_Length));
        end if;
  
!       return In_Tree.Projects.Table (Project).Ada_Objects_Path;
     end Ada_Objects_Path;
  
     ------------------------
     -- Add_To_Object_Path --
     ------------------------
  
!    procedure Add_To_Object_Path
!      (Object_Dir : Name_Id; In_Tree : Project_Tree_Ref)
!    is
     begin
        --  Check if the directory is already in the table
  
!       for Index in Object_Path_Table.First ..
!                    Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)
!       loop
  
           --  If it is, remove it, and add it as the last one
  
!          if In_Tree.Private_Part.Object_Paths.Table (Index) = Object_Dir then
!             for Index2 in Index + 1 ..
!                           Object_Path_Table.Last
!                             (In_Tree.Private_Part.Object_Paths)
!             loop
!                In_Tree.Private_Part.Object_Paths.Table (Index2 - 1) :=
!                  In_Tree.Private_Part.Object_Paths.Table (Index2);
              end loop;
  
!             In_Tree.Private_Part.Object_Paths.Table
!               (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
!                  Object_Dir;
              return;
           end if;
        end loop;
  
        --  The directory is not already in the table, add it
  
!       Object_Path_Table.Increment_Last (In_Tree.Private_Part.Object_Paths);
!       In_Tree.Private_Part.Object_Paths.Table
!         (Object_Path_Table.Last (In_Tree.Private_Part.Object_Paths)) :=
!            Object_Dir;
     end Add_To_Object_Path;
  
     -----------------
     -- Add_To_Path --
     -----------------
  
!    procedure Add_To_Path
!      (Source_Dirs : String_List_Id;
!       In_Tree     : Project_Tree_Ref)
!    is
        Current    : String_List_Id := Source_Dirs;
        Source_Dir : String_Element;
     begin
        while Current /= Nil_String loop
!          Source_Dir := In_Tree.String_Elements.Table (Current);
           Add_To_Path (Get_Name_String (Source_Dir.Display_Value));
           Current := Source_Dir.Next;
        end loop;
*************** package body Prj.Env is
*** 467,473 ****
     -- Add_To_Source_Path --
     ------------------------
  
!    procedure Add_To_Source_Path (Source_Dirs : String_List_Id) is
        Current    : String_List_Id := Source_Dirs;
        Source_Dir : String_Element;
        Add_It     : Boolean;
--- 470,478 ----
     -- Add_To_Source_Path --
     ------------------------
  
!    procedure Add_To_Source_Path
!      (Source_Dirs : String_List_Id; In_Tree : Project_Tree_Ref)
!    is
        Current    : String_List_Id := Source_Dirs;
        Source_Dir : String_Element;
        Add_It     : Boolean;
*************** package body Prj.Env is
*** 476,498 ****
        --  Add each source directory
  
        while Current /= Nil_String loop
!          Source_Dir := String_Elements.Table (Current);
           Add_It := True;
  
           --  Check if the source directory is already in the table
  
!          for Index in 1 .. Source_Paths.Last loop
              --  If it is already, no need to add it
  
!             if Source_Paths.Table (Index) = Source_Dir.Value then
                 Add_It := False;
                 exit;
              end if;
           end loop;
  
           if Add_It then
!             Source_Paths.Increment_Last;
!             Source_Paths.Table (Source_Paths.Last) := Source_Dir.Value;
           end if;
  
           --  Next source directory
--- 481,511 ----
        --  Add each source directory
  
        while Current /= Nil_String loop
!          Source_Dir := In_Tree.String_Elements.Table (Current);
           Add_It := True;
  
           --  Check if the source directory is already in the table
  
!          for Index in Source_Path_Table.First ..
!                       Source_Path_Table.Last
!                                           (In_Tree.Private_Part.Source_Paths)
!          loop
              --  If it is already, no need to add it
  
!             if In_Tree.Private_Part.Source_Paths.Table (Index) =
!                         Source_Dir.Value
!             then
                 Add_It := False;
                 exit;
              end if;
           end loop;
  
           if Add_It then
!             Source_Path_Table.Increment_Last
!               (In_Tree.Private_Part.Source_Paths);
!             In_Tree.Private_Part.Source_Paths.Table
!               (Source_Path_Table.Last (In_Tree.Private_Part.Source_Paths)) :=
!               Source_Dir.Value;
           end if;
  
           --  Next source directory
*************** package body Prj.Env is
*** 505,512 ****
     -- Body_Path_Name_Of --
     -----------------------
  
!    function Body_Path_Name_Of (Unit : Unit_Id) return String is
!       Data : Unit_Data := Units.Table (Unit);
  
     begin
        --  If we don't know the path name of the body of this unit,
--- 518,527 ----
     -- Body_Path_Name_Of --
     -----------------------
  
!    function Body_Path_Name_Of
!      (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String
!    is
!       Data : Unit_Data := In_Tree.Units.Table (Unit);
  
     begin
        --  If we don't know the path name of the body of this unit,
*************** package body Prj.Env is
*** 515,521 ****
        if Data.File_Names (Body_Part).Path = No_Name then
           declare
              Current_Source : String_List_Id :=
!               Projects.Table (Data.File_Names (Body_Part).Project).Sources;
              Path : GNAT.OS_Lib.String_Access;
  
           begin
--- 530,537 ----
        if Data.File_Names (Body_Part).Path = No_Name then
           declare
              Current_Source : String_List_Id :=
!               In_Tree.Projects.Table
!                 (Data.File_Names (Body_Part).Project).Sources;
              Path : GNAT.OS_Lib.String_Access;
  
           begin
*************** package body Prj.Env is
*** 532,541 ****
                     (Namet.Get_Name_String
                        (Data.File_Names (Body_Part).Name),
                      Namet.Get_Name_String
!                        (String_Elements.Table (Current_Source).Value));
  
!                --  If the file is in this directory,
!                --  then we store the path, and we are done.
  
                 if Path /= null then
                    Name_Len := Path'Length;
--- 548,558 ----
                     (Namet.Get_Name_String
                        (Data.File_Names (Body_Part).Name),
                      Namet.Get_Name_String
!                       (In_Tree.String_Elements.Table
!                          (Current_Source).Value));
  
!                --  If the file is in this directory, then we store the path,
!                --  and we are done.
  
                 if Path /= null then
                    Name_Len := Path'Length;
*************** package body Prj.Env is
*** 545,555 ****
  
                 else
                    Current_Source :=
!                     String_Elements.Table (Current_Source).Next;
                 end if;
              end loop;
  
!             Units.Table (Unit) := Data;
           end;
        end if;
  
--- 562,573 ----
  
                 else
                    Current_Source :=
!                     In_Tree.String_Elements.Table
!                       (Current_Source).Next;
                 end if;
              end loop;
  
!             In_Tree.Units.Table (Unit) := Data;
           end;
        end if;
  
*************** package body Prj.Env is
*** 604,609 ****
--- 622,628 ----
     procedure Create_Config_Pragmas_File
       (For_Project          : Project_Id;
        Main_Project         : Project_Id;
+       In_Tree              : Project_Tree_Ref;
        Include_Config_Files : Boolean := True)
     is
        pragma Unreferenced (Main_Project);
*************** package body Prj.Env is
*** 612,618 ****
        File_Name : Name_Id         := No_Name;
        File      : File_Descriptor := Invalid_FD;
  
!       Current_Unit : Unit_Id := Units.First;
  
        First_Project : Project_List := Empty_Project_List;
  
--- 631,637 ----
        File_Name : Name_Id         := No_Name;
        File      : File_Descriptor := Invalid_FD;
  
!       Current_Unit : Unit_Id := Unit_Table.First;
  
        First_Project : Project_List := Empty_Project_List;
  
*************** package body Prj.Env is
*** 648,654 ****
        -----------
  
        procedure Check (Project : Project_Id) is
!          Data : constant Project_Data := Projects.Table (Project);
  
        begin
           if Current_Verbosity = High then
--- 667,674 ----
        -----------
  
        procedure Check (Project : Project_Id) is
!          Data : constant Project_Data :=
!            In_Tree.Projects.Table (Project);
  
        begin
           if Current_Verbosity = High then
*************** package body Prj.Env is
*** 662,695 ****
  
           Current_Project := First_Project;
           while Current_Project /= Empty_Project_List
!            and then Project_Lists.Table (Current_Project).Project /= Project
           loop
!             Current_Project := Project_Lists.Table (Current_Project).Next;
           end loop;
  
           --  If it is not, put it in the list, and visit it
  
           if Current_Project = Empty_Project_List then
!             Project_Lists.Increment_Last;
!             Project_Lists.Table (Project_Lists.Last) :=
!               (Project => Project, Next => First_Project);
!             First_Project := Project_Lists.Last;
  
              --  Is the naming scheme of this project one that we know?
  
              Current_Naming := Default_Naming;
!             while Current_Naming <= Namings.Last and then
!               not Same_Naming_Scheme
!               (Left => Namings.Table (Current_Naming),
                 Right => Data.Naming) loop
                 Current_Naming := Current_Naming + 1;
              end loop;
  
              --  If we don't know it, add it
  
!             if Current_Naming > Namings.Last then
!                Namings.Increment_Last;
!                Namings.Table (Namings.Last) := Data.Naming;
  
                 --  We need a temporary file to be created
  
--- 682,725 ----
  
           Current_Project := First_Project;
           while Current_Project /= Empty_Project_List
!            and then In_Tree.Project_Lists.Table
!                       (Current_Project).Project /= Project
           loop
!             Current_Project :=
!               In_Tree.Project_Lists.Table (Current_Project).Next;
           end loop;
  
           --  If it is not, put it in the list, and visit it
  
           if Current_Project = Empty_Project_List then
!             Project_List_Table.Increment_Last
!               (In_Tree.Project_Lists);
!             In_Tree.Project_Lists.Table
!               (Project_List_Table.Last (In_Tree.Project_Lists)) :=
!                  (Project => Project, Next => First_Project);
!                First_Project :=
!                  Project_List_Table.Last (In_Tree.Project_Lists);
  
              --  Is the naming scheme of this project one that we know?
  
              Current_Naming := Default_Naming;
!             while Current_Naming <=
!                     Naming_Table.Last (In_Tree.Private_Part.Namings)
!               and then not Same_Naming_Scheme
!               (Left => In_Tree.Private_Part.Namings.Table (Current_Naming),
                 Right => Data.Naming) loop
                 Current_Naming := Current_Naming + 1;
              end loop;
  
              --  If we don't know it, add it
  
!             if Current_Naming >
!                  Naming_Table.Last (In_Tree.Private_Part.Namings)
!             then
!                Naming_Table.Increment_Last (In_Tree.Private_Part.Namings);
!                In_Tree.Private_Part.Namings.Table
!                  (Naming_Table.Last (In_Tree.Private_Part.Namings)) :=
!                     Data.Naming;
  
                 --  We need a temporary file to be created
  
*************** package body Prj.Env is
*** 760,767 ****
  
              begin
                 while Current /= Empty_Project_List loop
!                   Check (Project_Lists.Table (Current).Project);
!                   Current := Project_Lists.Table (Current).Next;
                 end loop;
              end;
           end if;
--- 790,800 ----
  
              begin
                 while Current /= Empty_Project_List loop
!                   Check
!                     (In_Tree.Project_Lists.Table
!                        (Current).Project);
!                   Current := In_Tree.Project_Lists.Table
!                                (Current).Next;
                 end loop;
              end;
           end if;
*************** package body Prj.Env is
*** 870,880 ****
     --  Start of processing for Create_Config_Pragmas_File
  
     begin
!       if not Projects.Table (For_Project).Config_Checked then
  
           --  Remove any memory of processed naming schemes, if any
  
!          Namings.Set_Last (Default_Naming);
  
           --  Check the naming schemes
  
--- 903,915 ----
     --  Start of processing for Create_Config_Pragmas_File
  
     begin
!       if not
!         In_Tree.Projects.Table (For_Project).Config_Checked
!       then
  
           --  Remove any memory of processed naming schemes, if any
  
!          Naming_Table.Set_Last (In_Tree.Private_Part.Namings, Default_Naming);
  
           --  Check the naming schemes
  
*************** package body Prj.Env is
*** 882,891 ****
  
           --  Visit all the units and process those that need an SFN pragma
  
!          while Current_Unit <= Units.Last loop
              declare
                 Unit : constant Unit_Data :=
!                  Units.Table (Current_Unit);
  
              begin
                 if Unit.File_Names (Specification).Needs_Pragma then
--- 917,928 ----
  
           --  Visit all the units and process those that need an SFN pragma
  
!          while
!            Current_Unit <= Unit_Table.Last (In_Tree.Units)
!          loop
              declare
                 Unit : constant Unit_Data :=
!                  In_Tree.Units.Table (Current_Unit);
  
              begin
                 if Unit.File_Names (Specification).Needs_Pragma then
*************** package body Prj.Env is
*** 938,947 ****
              Write_Line ("""");
           end if;
  
!          Projects.Table (For_Project).Config_File_Name := File_Name;
!          Projects.Table (For_Project).Config_File_Temp := True;
  
!          Projects.Table (For_Project).Config_Checked := True;
        end if;
     end Create_Config_Pragmas_File;
  
--- 975,987 ----
              Write_Line ("""");
           end if;
  
!          In_Tree.Projects.Table (For_Project).Config_File_Name :=
!            File_Name;
!          In_Tree.Projects.Table (For_Project).Config_File_Temp :=
!            True;
  
!          In_Tree.Projects.Table (For_Project).Config_Checked :=
!            True;
        end if;
     end Create_Config_Pragmas_File;
  
*************** package body Prj.Env is
*** 951,956 ****
--- 991,997 ----
  
     procedure Create_Mapping_File
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Name    : out Name_Id)
     is
        File          : File_Descriptor := Invalid_FD;
*************** package body Prj.Env is
*** 960,966 ****
        Status : Boolean;
        --  For call to Close
  
!       Present : Project_Flags (No_Project .. Projects.Last) :=
          (others => False);
        --  For each project in the closure of Project, the corresponding flag
        --  will be set to True;
--- 1001,1008 ----
        Status : Boolean;
        --  For call to Close
  
!       Present       : Project_Flags
!         (No_Project .. Project_Table.Last (In_Tree.Projects)) :=
          (others => False);
        --  For each project in the closure of Project, the corresponding flag
        --  will be set to True;
*************** package body Prj.Env is
*** 1045,1063 ****
           --  Flag the current project
  
           Present (Prj) := True;
!          Imported := Projects.Table (Prj).Imported_Projects;
  
           --  Call itself for each project directly imported
  
           while Imported /= Empty_Project_List loop
!             Proj := Project_Lists.Table (Imported).Project;
!             Imported := Project_Lists.Table (Imported).Next;
              Recursive_Flag (Proj);
           end loop;
  
           --  Call itself for an eventual project being extended
  
!          Recursive_Flag (Projects.Table (Prj).Extends);
        end Recursive_Flag;
  
     --  Start of processing for Create_Mapping_File
--- 1087,1108 ----
           --  Flag the current project
  
           Present (Prj) := True;
!          Imported :=
!            In_Tree.Projects.Table (Prj).Imported_Projects;
  
           --  Call itself for each project directly imported
  
           while Imported /= Empty_Project_List loop
!             Proj :=
!               In_Tree.Project_Lists.Table (Imported).Project;
!             Imported :=
!               In_Tree.Project_Lists.Table (Imported).Next;
              Recursive_Flag (Proj);
           end loop;
  
           --  Call itself for an eventual project being extended
  
!          Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
        end Recursive_Flag;
  
     --  Start of processing for Create_Mapping_File
*************** package body Prj.Env is
*** 1081,1090 ****
        end if;
  
        if Fill_Mapping_File then
           --  For all units in table Units
  
!          for Unit in 1 .. Units.Last loop
!             The_Unit_Data := Units.Table (Unit);
  
              --  If the unit has a valid name
  
--- 1126,1136 ----
        end if;
  
        if Fill_Mapping_File then
+ 
           --  For all units in table Units
  
!          for Unit in 1 .. Unit_Table.Last (In_Tree.Units) loop
!             The_Unit_Data := In_Tree.Units.Table (Unit);
  
              --  If the unit has a valid name
  
*************** package body Prj.Env is
*** 1123,1129 ****
     --------------------------
  
     procedure Create_New_Path_File
!      (Path_FD   : out File_Descriptor;
        Path_Name : out Name_Id)
     is
     begin
--- 1169,1176 ----
     --------------------------
  
     procedure Create_New_Path_File
!      (In_Tree   : Project_Tree_Ref;
!       Path_FD   : out File_Descriptor;
        Path_Name : out Name_Id)
     is
     begin
*************** package body Prj.Env is
*** 1134,1141 ****
           --  Record the name, so that the temp path file will be deleted
           --  at the end of the program.
  
!          Path_Files.Increment_Last;
!          Path_Files.Table (Path_Files.Last) := Path_Name;
        end if;
     end Create_New_Path_File;
  
--- 1181,1190 ----
           --  Record the name, so that the temp path file will be deleted
           --  at the end of the program.
  
!          Path_File_Table.Increment_Last (In_Tree.Private_Part.Path_Files);
!          In_Tree.Private_Part.Path_Files.Table
!            (Path_File_Table.Last (In_Tree.Private_Part.Path_Files)) :=
!               Path_Name;
        end if;
     end Create_New_Path_File;
  
*************** package body Prj.Env is
*** 1143,1156 ****
     -- Delete_All_Path_Files --
     ---------------------------
  
!    procedure Delete_All_Path_Files is
        Disregard : Boolean := True;
  
     begin
!       for Index in 1 .. Path_Files.Last loop
!          if Path_Files.Table (Index) /= No_Name then
              Delete_File
!               (Get_Name_String (Path_Files.Table (Index)), Disregard);
           end if;
        end loop;
  
--- 1192,1209 ----
     -- Delete_All_Path_Files --
     ---------------------------
  
!    procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref) is
        Disregard : Boolean := True;
  
     begin
!       for Index in Path_File_Table.First ..
!                    Path_File_Table.Last (In_Tree.Private_Part.Path_Files)
!       loop
!          if In_Tree.Private_Part.Path_Files.Table (Index) /= No_Name then
              Delete_File
!               (Get_Name_String
!                  (In_Tree.Private_Part.Path_Files.Table (Index)),
!                Disregard);
           end if;
        end loop;
  
*************** package body Prj.Env is
*** 1177,1187 ****
     function File_Name_Of_Library_Unit_Body
       (Name              : String;
        Project           : Project_Id;
        Main_Project_Only : Boolean := True;
        Full_Path         : Boolean := False) return String
     is
        The_Project   : Project_Id := Project;
!       Data          : Project_Data := Projects.Table (Project);
        Original_Name : String := Name;
  
        Extended_Spec_Name : String :=
--- 1230,1242 ----
     function File_Name_Of_Library_Unit_Body
       (Name              : String;
        Project           : Project_Id;
+       In_Tree           : Project_Tree_Ref;
        Main_Project_Only : Boolean := True;
        Full_Path         : Boolean := False) return String
     is
        The_Project   : Project_Id := Project;
!       Data          : Project_Data :=
!                         In_Tree.Projects.Table (Project);
        Original_Name : String := Name;
  
        Extended_Spec_Name : String :=
*************** package body Prj.Env is
*** 1236,1243 ****
           --  Loop through units
           --  Should have comment explaining reverse ???
  
!          for Current in reverse Units.First .. Units.Last loop
!             Unit := Units.Table (Current);
  
              --  Check for body
  
--- 1291,1300 ----
           --  Loop through units
           --  Should have comment explaining reverse ???
  
!          for Current in reverse Unit_Table.First ..
!                                 Unit_Table.Last (In_Tree.Units)
!          loop
!             Unit := In_Tree.Units.Table (Current);
  
              --  Check for body
  
*************** package body Prj.Env is
*** 1370,1376 ****
           --  Otherwise, look in the project we are extending
  
           The_Project := Data.Extends;
!          Data := Projects.Table (The_Project);
        end loop;
  
        --  We don't know this file name, return an empty string
--- 1427,1433 ----
           --  Otherwise, look in the project we are extending
  
           The_Project := Data.Extends;
!          Data := In_Tree.Projects.Table (The_Project);
        end loop;
  
        --  We don't know this file name, return an empty string
*************** package body Prj.Env is
*** 1382,1388 ****
     -- For_All_Object_Dirs --
     -------------------------
  
!    procedure For_All_Object_Dirs (Project : Project_Id) is
        Seen : Project_List := Empty_Project_List;
  
        procedure Add (Project : Project_Id);
--- 1439,1448 ----
     -- For_All_Object_Dirs --
     -------------------------
  
!    procedure For_All_Object_Dirs
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref)
!    is
        Seen : Project_List := Empty_Project_List;
  
        procedure Add (Project : Project_Id);
*************** package body Prj.Env is
*** 1395,1401 ****
        ---------
  
        procedure Add (Project : Project_Id) is
!          Data : constant Project_Data := Projects.Table (Project);
           List : Project_List := Data.Imported_Projects;
  
        begin
--- 1455,1462 ----
        ---------
  
        procedure Add (Project : Project_Id) is
!          Data : constant Project_Data :=
!                   In_Tree.Projects.Table (Project);
           List : Project_List := Data.Imported_Projects;
  
        begin
*************** package body Prj.Env is
*** 1403,1411 ****
           --  for sure we never visited this project.
  
           if Seen = Empty_Project_List then
!             Project_Lists.Increment_Last;
!             Seen := Project_Lists.Last;
!             Project_Lists.Table (Seen) :=
                (Project => Project, Next => Empty_Project_List);
  
           else
--- 1464,1474 ----
           --  for sure we never visited this project.
  
           if Seen = Empty_Project_List then
!             Project_List_Table.Increment_Last
!               (In_Tree.Project_Lists);
!             Seen :=
!               Project_List_Table.Last (In_Tree.Project_Lists);
!             In_Tree.Project_Lists.Table (Seen) :=
                (Project => Project, Next => Empty_Project_List);
  
           else
*************** package body Prj.Env is
*** 1418,1438 ****
                 loop
                    --  If it is, then there is nothing else to do
  
!                   if Project_Lists.Table (Current).Project = Project then
                       return;
                    end if;
  
!                   exit when Project_Lists.Table (Current).Next =
!                     Empty_Project_List;
!                   Current := Project_Lists.Table (Current).Next;
                 end loop;
  
                 --  This project has never been visited, add it
                 --  to the list.
  
!                Project_Lists.Increment_Last;
!                Project_Lists.Table (Current).Next := Project_Lists.Last;
!                Project_Lists.Table (Project_Lists.Last) :=
                   (Project => Project, Next => Empty_Project_List);
              end;
           end if;
--- 1481,1509 ----
                 loop
                    --  If it is, then there is nothing else to do
  
!                   if In_Tree.Project_Lists.Table
!                                            (Current).Project = Project
!                   then
                       return;
                    end if;
  
!                   exit when
!                     In_Tree.Project_Lists.Table (Current).Next =
!                       Empty_Project_List;
!                   Current :=
!                     In_Tree.Project_Lists.Table (Current).Next;
                 end loop;
  
                 --  This project has never been visited, add it
                 --  to the list.
  
!                Project_List_Table.Increment_Last
!                  (In_Tree.Project_Lists);
!                In_Tree.Project_Lists.Table (Current).Next :=
!                  Project_List_Table.Last (In_Tree.Project_Lists);
!                In_Tree.Project_Lists.Table
!                  (Project_List_Table.Last
!                     (In_Tree.Project_Lists)) :=
                   (Project => Project, Next => Empty_Project_List);
              end;
           end if;
*************** package body Prj.Env is
*** 1454,1461 ****
           --  And visit all imported projects
  
           while List /= Empty_Project_List loop
!             Add (Project_Lists.Table (List).Project);
!             List := Project_Lists.Table (List).Next;
           end loop;
        end Add;
  
--- 1525,1532 ----
           --  And visit all imported projects
  
           while List /= Empty_Project_List loop
!             Add (In_Tree.Project_Lists.Table (List).Project);
!             List := In_Tree.Project_Lists.Table (List).Next;
           end loop;
        end Add;
  
*************** package body Prj.Env is
*** 1472,1478 ****
     -- For_All_Source_Dirs --
     -------------------------
  
!    procedure For_All_Source_Dirs (Project : Project_Id) is
        Seen : Project_List := Empty_Project_List;
  
        procedure Add (Project : Project_Id);
--- 1543,1552 ----
     -- For_All_Source_Dirs --
     -------------------------
  
!    procedure For_All_Source_Dirs
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref)
!    is
        Seen : Project_List := Empty_Project_List;
  
        procedure Add (Project : Project_Id);
*************** package body Prj.Env is
*** 1485,1491 ****
        ---------
  
        procedure Add (Project : Project_Id) is
!          Data : constant Project_Data := Projects.Table (Project);
           List : Project_List := Data.Imported_Projects;
  
        begin
--- 1559,1566 ----
        ---------
  
        procedure Add (Project : Project_Id) is
!          Data : constant Project_Data :=
!                   In_Tree.Projects.Table (Project);
           List : Project_List := Data.Imported_Projects;
  
        begin
*************** package body Prj.Env is
*** 1493,1501 ****
           --  for sure we never visited this project.
  
           if Seen = Empty_Project_List then
!             Project_Lists.Increment_Last;
!             Seen := Project_Lists.Last;
!             Project_Lists.Table (Seen) :=
                (Project => Project, Next => Empty_Project_List);
  
           else
--- 1568,1578 ----
           --  for sure we never visited this project.
  
           if Seen = Empty_Project_List then
!             Project_List_Table.Increment_Last
!               (In_Tree.Project_Lists);
!             Seen := Project_List_Table.Last
!                                          (In_Tree.Project_Lists);
!             In_Tree.Project_Lists.Table (Seen) :=
                (Project => Project, Next => Empty_Project_List);
  
           else
*************** package body Prj.Env is
*** 1508,1528 ****
                 loop
                    --  If it is, then there is nothing else to do
  
!                   if Project_Lists.Table (Current).Project = Project then
                       return;
                    end if;
  
!                   exit when Project_Lists.Table (Current).Next =
!                     Empty_Project_List;
!                   Current := Project_Lists.Table (Current).Next;
                 end loop;
  
                 --  This project has never been visited, add it
                 --  to the list.
  
!                Project_Lists.Increment_Last;
!                Project_Lists.Table (Current).Next := Project_Lists.Last;
!                Project_Lists.Table (Project_Lists.Last) :=
                   (Project => Project, Next => Empty_Project_List);
              end;
           end if;
--- 1585,1613 ----
                 loop
                    --  If it is, then there is nothing else to do
  
!                   if In_Tree.Project_Lists.Table
!                                            (Current).Project = Project
!                   then
                       return;
                    end if;
  
!                   exit when
!                     In_Tree.Project_Lists.Table (Current).Next =
!                       Empty_Project_List;
!                   Current :=
!                     In_Tree.Project_Lists.Table (Current).Next;
                 end loop;
  
                 --  This project has never been visited, add it
                 --  to the list.
  
!                Project_List_Table.Increment_Last
!                  (In_Tree.Project_Lists);
!                In_Tree.Project_Lists.Table (Current).Next :=
!                  Project_List_Table.Last (In_Tree.Project_Lists);
!                In_Tree.Project_Lists.Table
!                  (Project_List_Table.Last
!                     (In_Tree.Project_Lists)) :=
                   (Project => Project, Next => Empty_Project_List);
              end;
           end if;
*************** package body Prj.Env is
*** 1535,1543 ****
              --  If there are Ada sources, call action with the name of every
              --  source directory.
  
!             if Projects.Table (Project).Ada_Sources_Present then
                 while Current /= Nil_String loop
!                   The_String := String_Elements.Table (Current);
                    Action (Get_Name_String (The_String.Value));
                    Current := The_String.Next;
                 end loop;
--- 1620,1631 ----
              --  If there are Ada sources, call action with the name of every
              --  source directory.
  
!             if
!               In_Tree.Projects.Table (Project).Ada_Sources_Present
!             then
                 while Current /= Nil_String loop
!                   The_String :=
!                     In_Tree.String_Elements.Table (Current);
                    Action (Get_Name_String (The_String.Value));
                    Current := The_String.Next;
                 end loop;
*************** package body Prj.Env is
*** 1553,1560 ****
           --  And visit all imported projects
  
           while List /= Empty_Project_List loop
!             Add (Project_Lists.Table (List).Project);
!             List := Project_Lists.Table (List).Next;
           end loop;
        end Add;
  
--- 1641,1648 ----
           --  And visit all imported projects
  
           while List /= Empty_Project_List loop
!             Add (In_Tree.Project_Lists.Table (List).Project);
!             List := In_Tree.Project_Lists.Table (List).Next;
           end loop;
        end Add;
  
*************** package body Prj.Env is
*** 1572,1577 ****
--- 1660,1666 ----
  
     procedure Get_Reference
       (Source_File_Name : String;
+       In_Tree          : Project_Tree_Ref;
        Project          : out Project_Id;
        Path             : out Name_Id)
     is
*************** package body Prj.Env is
*** 1591,1598 ****
        begin
           Canonical_Case_File_Name (Original_Name);
  
!          for Id in Units.First .. Units.Last loop
!             Unit := Units.Table (Id);
  
              if (Unit.File_Names (Specification).Name /= No_Name
                   and then
--- 1680,1689 ----
        begin
           Canonical_Case_File_Name (Original_Name);
  
!          for Id in Unit_Table.First ..
!                    Unit_Table.Last (In_Tree.Units)
!          loop
!             Unit := In_Tree.Units.Table (Id);
  
              if (Unit.File_Names (Specification).Name /= No_Name
                   and then
*************** package body Prj.Env is
*** 1605,1611 ****
                                                                Original_Name)
              then
                 Project := Ultimate_Extension_Of
!                             (Unit.File_Names (Specification).Project);
                 Path := Unit.File_Names (Specification).Display_Path;
  
                 if Current_Verbosity > Default then
--- 1696,1703 ----
                                                                Original_Name)
              then
                 Project := Ultimate_Extension_Of
!                            (Project => Unit.File_Names (Specification).Project,
!                             In_Tree => In_Tree);
                 Path := Unit.File_Names (Specification).Display_Path;
  
                 if Current_Verbosity > Default then
*************** package body Prj.Env is
*** 1625,1631 ****
                                                               Original_Name)
              then
                 Project := Ultimate_Extension_Of
!                             (Unit.File_Names (Body_Part).Project);
                 Path := Unit.File_Names (Body_Part).Display_Path;
  
                 if Current_Verbosity > Default then
--- 1717,1724 ----
                                                               Original_Name)
              then
                 Project := Ultimate_Extension_Of
!                             (Project => Unit.File_Names (Body_Part).Project,
!                              In_Tree => In_Tree);
                 Path := Unit.File_Names (Body_Part).Display_Path;
  
                 if Current_Verbosity > Default then
*************** package body Prj.Env is
*** 1651,1662 ****
     -- Initialize --
     ----------------
  
-    --  This is a place holder for possible required initialization in
-    --  the future. In the current version no initialization is required.
- 
     procedure Initialize is
     begin
!       null;
     end Initialize;
  
     ------------------------------------
--- 1744,1752 ----
     -- Initialize --
     ----------------
  
     procedure Initialize is
     begin
!       Fill_Mapping_File := True;
     end Initialize;
  
     ------------------------------------
*************** package body Prj.Env is
*** 1667,1675 ****
  
     function Path_Name_Of_Library_Unit_Body
       (Name    : String;
!       Project : Project_Id) return String
     is
!       Data          : constant Project_Data := Projects.Table (Project);
        Original_Name : String := Name;
  
        Extended_Spec_Name : String :=
--- 1757,1767 ----
  
     function Path_Name_Of_Library_Unit_Body
       (Name    : String;
!       Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return String
     is
!       Data          : constant Project_Data :=
!                         In_Tree.Projects.Table (Project);
        Original_Name : String := Name;
  
        Extended_Spec_Name : String :=
*************** package body Prj.Env is
*** 1679,1685 ****
                               Name & Namet.Get_Name_String
                                       (Data.Naming.Ada_Body_Suffix);
  
!       First   : Unit_Id := Units.First;
        Current : Unit_Id;
        Unit    : Unit_Data;
  
--- 1771,1777 ----
                               Name & Namet.Get_Name_String
                                       (Data.Naming.Ada_Body_Suffix);
  
!       First   : Unit_Id := Unit_Table.First;
        Current : Unit_Id;
        Unit    : Unit_Data;
  
*************** package body Prj.Env is
*** 1703,1717 ****
           Write_Eol;
        end if;
  
!       while First <= Units.Last
!         and then Units.Table (First).File_Names (Body_Part).Project /= Project
        loop
           First := First + 1;
        end loop;
  
        Current := First;
!       while Current <= Units.Last loop
!          Unit := Units.Table (Current);
  
           if Unit.File_Names (Body_Part).Project = Project
             and then Unit.File_Names (Body_Part).Name /= No_Name
--- 1795,1810 ----
           Write_Eol;
        end if;
  
!       while First <= Unit_Table.Last (In_Tree.Units)
!         and then In_Tree.Units.Table
!                    (First).File_Names (Body_Part).Project /= Project
        loop
           First := First + 1;
        end loop;
  
        Current := First;
!       while Current <= Unit_Table.Last (In_Tree.Units) loop
!          Unit := In_Tree.Units.Table (Current);
  
           if Unit.File_Names (Body_Part).Project = Project
             and then Unit.File_Names (Body_Part).Name /= No_Name
*************** package body Prj.Env is
*** 1732,1745 ****
                       Write_Line ("   OK");
                    end if;
  
!                   return Body_Path_Name_Of (Current);
  
                 elsif Current_Name = Extended_Body_Name then
                    if Current_Verbosity = High then
                       Write_Line ("   OK");
                    end if;
  
!                   return Body_Path_Name_Of (Current);
  
                 else
                    if Current_Verbosity = High then
--- 1825,1838 ----
                       Write_Line ("   OK");
                    end if;
  
!                   return Body_Path_Name_Of (Current, In_Tree);
  
                 elsif Current_Name = Extended_Body_Name then
                    if Current_Verbosity = High then
                       Write_Line ("   OK");
                    end if;
  
!                   return Body_Path_Name_Of (Current, In_Tree);
  
                 else
                    if Current_Verbosity = High then
*************** package body Prj.Env is
*** 1767,1780 ****
                       Write_Line ("   OK");
                    end if;
  
!                   return Spec_Path_Name_Of (Current);
  
                 elsif Current_Name = Extended_Spec_Name then
                    if Current_Verbosity = High then
                       Write_Line ("   OK");
                    end if;
  
!                   return Spec_Path_Name_Of (Current);
  
                 else
                    if Current_Verbosity = High then
--- 1860,1873 ----
                       Write_Line ("   OK");
                    end if;
  
!                   return Spec_Path_Name_Of (Current, In_Tree);
  
                 elsif Current_Name = Extended_Spec_Name then
                    if Current_Verbosity = High then
                       Write_Line ("   OK");
                    end if;
  
!                   return Spec_Path_Name_Of (Current, In_Tree);
  
                 else
                    if Current_Verbosity = High then
*************** package body Prj.Env is
*** 1795,1808 ****
  
     --  Could use some comments in this body ???
  
!    procedure Print_Sources is
        Unit : Unit_Data;
  
     begin
        Write_Line ("List of Sources:");
  
!       for Id in Units.First .. Units.Last loop
!          Unit := Units.Table (Id);
           Write_Str  ("   ");
           Write_Line (Namet.Get_Name_String (Unit.Name));
  
--- 1888,1903 ----
  
     --  Could use some comments in this body ???
  
!    procedure Print_Sources (In_Tree : Project_Tree_Ref) is
        Unit : Unit_Data;
  
     begin
        Write_Line ("List of Sources:");
  
!       for Id in Unit_Table.First ..
!                 Unit_Table.Last (In_Tree.Units)
!       loop
!          Unit := In_Tree.Units.Table (Id);
           Write_Str  ("   ");
           Write_Line (Namet.Get_Name_String (Unit.Name));
  
*************** package body Prj.Env is
*** 1813,1819 ****
              else
                 Write_Str  ("   Project: ");
                 Get_Name_String
!                  (Projects.Table
                     (Unit.File_Names (Specification).Project).Path_Name);
                 Write_Line (Name_Buffer (1 .. Name_Len));
              end if;
--- 1908,1914 ----
              else
                 Write_Str  ("   Project: ");
                 Get_Name_String
!                  (In_Tree.Projects.Table
                     (Unit.File_Names (Specification).Project).Path_Name);
                 Write_Line (Name_Buffer (1 .. Name_Len));
              end if;
*************** package body Prj.Env is
*** 1831,1837 ****
              else
                 Write_Str  ("   Project: ");
                 Get_Name_String
!                  (Projects.Table
                     (Unit.File_Names (Body_Part).Project).Path_Name);
                 Write_Line (Name_Buffer (1 .. Name_Len));
              end if;
--- 1926,1932 ----
              else
                 Write_Str  ("   Project: ");
                 Get_Name_String
!                  (In_Tree.Projects.Table
                     (Unit.File_Names (Body_Part).Project).Path_Name);
                 Write_Line (Name_Buffer (1 .. Name_Len));
              end if;
*************** package body Prj.Env is
*** 1852,1864 ****
  
     function Project_Of
       (Name         : String;
!       Main_Project : Project_Id) return Project_Id
     is
        Result : Project_Id := No_Project;
  
        Original_Name : String := Name;
  
!       Data : constant Project_Data := Projects.Table (Main_Project);
  
        Extended_Spec_Name : String :=
                               Name & Namet.Get_Name_String
--- 1947,1961 ----
  
     function Project_Of
       (Name         : String;
!       Main_Project : Project_Id;
!       In_Tree      : Project_Tree_Ref) return Project_Id
     is
        Result : Project_Id := No_Project;
  
        Original_Name : String := Name;
  
!       Data   : constant Project_Data :=
!         In_Tree.Projects.Table (Main_Project);
  
        Extended_Spec_Name : String :=
                               Name & Namet.Get_Name_String
*************** package body Prj.Env is
*** 1891,1898 ****
        Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
        The_Body_Name := Name_Find;
  
!       for Current in reverse Units.First .. Units.Last loop
!          Unit := Units.Table (Current);
  
           --  Check for body
  
--- 1988,1997 ----
        Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
        The_Body_Name := Name_Find;
  
!       for Current in reverse Unit_Table.First ..
!                              Unit_Table.Last (In_Tree.Units)
!       loop
!          Unit := In_Tree.Units.Table (Current);
  
           --  Check for body
  
*************** package body Prj.Env is
*** 1936,1943 ****
        --  Get the ultimate extending project
  
        if Result /= No_Project then
!          while Projects.Table (Result).Extended_By /= No_Project loop
!             Result := Projects.Table (Result).Extended_By;
           end loop;
        end if;
  
--- 2035,2044 ----
        --  Get the ultimate extending project
  
        if Result /= No_Project then
!          while In_Tree.Projects.Table (Result).Extended_By /=
!            No_Project
!          loop
!             Result := In_Tree.Projects.Table (Result).Extended_By;
           end loop;
        end if;
  
*************** package body Prj.Env is
*** 1950,1955 ****
--- 2051,2057 ----
  
     procedure Set_Ada_Paths
       (Project             : Project_Id;
+       In_Tree             : Project_Tree_Ref;
        Including_Libraries : Boolean)
     is
        Source_FD : File_Descriptor := Invalid_FD;
*************** package body Prj.Env is
*** 1986,1996 ****
           begin
              --  If Seen is False, then the project has not yet been visited
  
!             if not Projects.Table (Project).Seen then
!                Projects.Table (Project).Seen := True;
  
                 declare
!                   Data : constant Project_Data := Projects.Table (Project);
                    List : Project_List := Data.Imported_Projects;
  
                 begin
--- 2088,2099 ----
           begin
              --  If Seen is False, then the project has not yet been visited
  
!             if not In_Tree.Projects.Table (Project).Seen then
!                In_Tree.Projects.Table (Project).Seen := True;
  
                 declare
!                   Data : constant Project_Data :=
!                     In_Tree.Projects.Table (Project);
                    List : Project_List := Data.Imported_Projects;
  
                 begin
*************** package body Prj.Env is
*** 1999,2006 ****
                       --  Add to path all source directories of this project
                       --  if there are Ada sources.
  
!                      if Projects.Table (Project).Ada_Sources_Present then
!                         Add_To_Source_Path (Data.Source_Dirs);
                       end if;
                    end if;
  
--- 2102,2111 ----
                       --  Add to path all source directories of this project
                       --  if there are Ada sources.
  
!                      if In_Tree.Projects.Table
!                           (Project).Ada_Sources_Present
!                      then
!                         Add_To_Source_Path (Data.Source_Dirs, In_Tree);
                       end if;
                    end if;
  
*************** package body Prj.Env is
*** 2016,2040 ****
                            and then
                              (not Including_Libraries or else not Data.Library))
                       then
!                         --  For a library project, add the library directory
!                         --  if there is no object directory or if the library
!                         --  directory contains ALI files; otherwise add the
!                         --  object directory.
  
                          if Data.Library then
                             if Data.Object_Directory = No_Name
!                              or else Contains_ALI_Files (Data.Library_Dir)
                             then
!                               Add_To_Object_Path (Data.Library_Dir);
                             else
!                               Add_To_Object_Path (Data.Object_Directory);
                             end if;
  
                          --  For a non-library project, add the object
!                         --  directory, if it is not a virtual project.
  
!                         elsif not Data.Virtual then
!                            Add_To_Object_Path (Data.Object_Directory);
                          end if;
                       end if;
                    end if;
--- 2121,2159 ----
                            and then
                              (not Including_Libraries or else not Data.Library))
                       then
!                         --  For a library project, add the library ALI
!                         --  directory if there is no object directory or
!                         --  if the library ALI directory contains ALI files;
!                         --  otherwise add the object directory.
  
                          if Data.Library then
                             if Data.Object_Directory = No_Name
!                              or else Contains_ALI_Files (Data.Library_ALI_Dir)
                             then
!                               Add_To_Object_Path
!                                 (Data.Library_ALI_Dir, In_Tree);
                             else
!                               Add_To_Object_Path
!                                 (Data.Object_Directory, In_Tree);
                             end if;
  
                          --  For a non-library project, add the object
!                         --  directory, if it is not a virtual project, and
!                         --  if there are Ada sources or if the project is an
!                         --  extending project. if There Are No Ada sources,
!                         --  adding the object directory could disrupt
!                         --  the order of the object dirs in the path.
  
!                         elsif not Data.Virtual
!                           and then (In_Tree.Projects.Table
!                                       (Project).Ada_Sources_Present
!                                     or else
!                                       (Data.Extends /= No_Project
!                                        and then
!                                        Data.Object_Directory /= No_Name))
!                         then
!                            Add_To_Object_Path
!                              (Data.Object_Directory, In_Tree);
                          end if;
                       end if;
                    end if;
*************** package body Prj.Env is
*** 2048,2066 ****
                    --  Call Add for each imported project, if any
  
                    while List /= Empty_Project_List loop
!                      Recursive_Add (Project_Lists.Table (List).Project);
!                      List := Project_Lists.Table (List).Next;
                    end loop;
                 end;
              end if;
           end Recursive_Add;
  
        begin
!          Source_Paths.Set_Last (0);
!          Object_Paths.Set_Last (0);
  
!          for Index in 1 .. Projects.Last loop
!             Projects.Table (Index).Seen := False;
           end loop;
  
           Recursive_Add (Proj);
--- 2167,2190 ----
                    --  Call Add for each imported project, if any
  
                    while List /= Empty_Project_List loop
!                      Recursive_Add
!                        (In_Tree.Project_Lists.Table
!                           (List).Project);
!                      List :=
!                        In_Tree.Project_Lists.Table (List).Next;
                    end loop;
                 end;
              end if;
           end Recursive_Add;
  
        begin
!          Source_Path_Table.Set_Last (In_Tree.Private_Part.Source_Paths, 0);
!          Object_Path_Table.Set_Last (In_Tree.Private_Part.Object_Paths, 0);
  
!          for Index in Project_Table.First ..
!                       Project_Table.Last (In_Tree.Projects)
!          loop
!             In_Tree.Projects.Table (Index).Seen := False;
           end loop;
  
           Recursive_Add (Proj);
*************** package body Prj.Env is
*** 2072,2101 ****
        --  If it is the first time we call this procedure for
        --  this project, compute the source path and/or the object path.
  
!       if Projects.Table (Project).Include_Path_File = No_Name then
           Process_Source_Dirs := True;
           Create_New_Path_File
!            (Source_FD, Projects.Table (Project).Include_Path_File);
        end if;
  
        --  For the object path, we make a distinction depending on
        --  Including_Libraries.
  
        if Including_Libraries then
!          if Projects.Table (Project).Objects_Path_File_With_Libs = No_Name then
              Process_Object_Dirs := True;
              Create_New_Path_File
!               (Object_FD, Projects.Table (Project).
                                             Objects_Path_File_With_Libs);
           end if;
  
        else
!          if
!            Projects.Table (Project).Objects_Path_File_Without_Libs = No_Name
           then
              Process_Object_Dirs := True;
              Create_New_Path_File
!               (Object_FD, Projects.Table (Project).
                                             Objects_Path_File_Without_Libs);
           end if;
        end if;
--- 2196,2230 ----
        --  If it is the first time we call this procedure for
        --  this project, compute the source path and/or the object path.
  
!       if In_Tree.Projects.Table (Project).Include_Path_File =
!         No_Name
!       then
           Process_Source_Dirs := True;
           Create_New_Path_File
!            (In_Tree, Source_FD,
!             In_Tree.Projects.Table (Project).Include_Path_File);
        end if;
  
        --  For the object path, we make a distinction depending on
        --  Including_Libraries.
  
        if Including_Libraries then
!          if In_Tree.Projects.Table
!            (Project).Objects_Path_File_With_Libs = No_Name
!          then
              Process_Object_Dirs := True;
              Create_New_Path_File
!               (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
                                             Objects_Path_File_With_Libs);
           end if;
  
        else
!          if In_Tree.Projects.Table
!               (Project).Objects_Path_File_Without_Libs = No_Name
           then
              Process_Object_Dirs := True;
              Create_New_Path_File
!               (In_Tree, Object_FD, In_Tree.Projects.Table (Project).
                                             Objects_Path_File_Without_Libs);
           end if;
        end if;
*************** package body Prj.Env is
*** 2107,2117 ****
           Add (Project);
        end if;
  
!       --  Write and close any file that has been created.
  
        if Source_FD /= Invalid_FD then
!          for Index in 1 .. Source_Paths.Last loop
!             Get_Name_String (Source_Paths.Table (Index));
              Name_Len := Name_Len + 1;
              Name_Buffer (Name_Len) := ASCII.LF;
              Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);
--- 2236,2249 ----
           Add (Project);
        end if;
  
!       --  Write and close any file that has been created
  
        if Source_FD /= Invalid_FD then
!          for Index in Source_Path_Table.First ..
!                       Source_Path_Table.Last
!                         (In_Tree.Private_Part.Source_Paths)
!          loop
!             Get_Name_String (In_Tree.Private_Part.Source_Paths.Table (Index));
              Name_Len := Name_Len + 1;
              Name_Buffer (Name_Len) := ASCII.LF;
              Len := Write (Source_FD, Name_Buffer (1)'Address, Name_Len);
*************** package body Prj.Env is
*** 2129,2136 ****
        end if;
  
        if Object_FD /= Invalid_FD then
!          for Index in 1 .. Object_Paths.Last loop
!             Get_Name_String (Object_Paths.Table (Index));
              Name_Len := Name_Len + 1;
              Name_Buffer (Name_Len) := ASCII.LF;
              Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);
--- 2261,2271 ----
        end if;
  
        if Object_FD /= Invalid_FD then
!          for Index in Object_Path_Table.First ..
!                       Object_Path_Table.Last
!                         (In_Tree.Private_Part.Object_Paths)
!          loop
!             Get_Name_String (In_Tree.Private_Part.Object_Paths.Table (Index));
              Name_Len := Name_Len + 1;
              Name_Buffer (Name_Len) := ASCII.LF;
              Len := Write (Object_FD, Name_Buffer (1)'Address, Name_Len);
*************** package body Prj.Env is
*** 2151,2160 ****
        --  corresponding flags.
  
        if Current_Source_Path_File /=
!            Projects.Table (Project).Include_Path_File
        then
           Current_Source_Path_File :=
!            Projects.Table (Project).Include_Path_File;
           Set_Path_File_Var
             (Project_Include_Path_File,
              Get_Name_String (Current_Source_Path_File));
--- 2286,2295 ----
        --  corresponding flags.
  
        if Current_Source_Path_File /=
!            In_Tree.Projects.Table (Project).Include_Path_File
        then
           Current_Source_Path_File :=
!            In_Tree.Projects.Table (Project).Include_Path_File;
           Set_Path_File_Var
             (Project_Include_Path_File,
              Get_Name_String (Current_Source_Path_File));
*************** package body Prj.Env is
*** 2163,2172 ****
  
        if Including_Libraries then
           if Current_Object_Path_File
!               /= Projects.Table (Project).Objects_Path_File_With_Libs
           then
              Current_Object_Path_File :=
!               Projects.Table (Project).Objects_Path_File_With_Libs;
              Set_Path_File_Var
                (Project_Objects_Path_File,
                 Get_Name_String (Current_Object_Path_File));
--- 2298,2309 ----
  
        if Including_Libraries then
           if Current_Object_Path_File
!            /= In_Tree.Projects.Table
!                 (Project).Objects_Path_File_With_Libs
           then
              Current_Object_Path_File :=
!               In_Tree.Projects.Table
!                 (Project).Objects_Path_File_With_Libs;
              Set_Path_File_Var
                (Project_Objects_Path_File,
                 Get_Name_String (Current_Object_Path_File));
*************** package body Prj.Env is
*** 2174,2184 ****
           end if;
  
        else
!          if Current_Object_Path_File
!               /= Projects.Table (Project).Objects_Path_File_Without_Libs
           then
              Current_Object_Path_File :=
!               Projects.Table (Project).Objects_Path_File_Without_Libs;
              Set_Path_File_Var
                (Project_Objects_Path_File,
                 Get_Name_String (Current_Object_Path_File));
--- 2311,2323 ----
           end if;
  
        else
!          if Current_Object_Path_File /=
!            In_Tree.Projects.Table
!              (Project).Objects_Path_File_Without_Libs
           then
              Current_Object_Path_File :=
!               In_Tree.Projects.Table
!                 (Project).Objects_Path_File_Without_Libs;
              Set_Path_File_Var
                (Project_Objects_Path_File,
                 Get_Name_String (Current_Object_Path_File));
*************** package body Prj.Env is
*** 2217,2230 ****
     -- Spec_Path_Name_Of --
     -----------------------
  
!    function Spec_Path_Name_Of (Unit : Unit_Id) return String is
!       Data : Unit_Data := Units.Table (Unit);
  
     begin
        if Data.File_Names (Specification).Path = No_Name then
           declare
              Current_Source : String_List_Id :=
!               Projects.Table (Data.File_Names (Specification).Project).Sources;
              Path : GNAT.OS_Lib.String_Access;
  
           begin
--- 2356,2372 ----
     -- Spec_Path_Name_Of --
     -----------------------
  
!    function Spec_Path_Name_Of
!      (Unit : Unit_Id; In_Tree : Project_Tree_Ref) return String
!    is
!       Data : Unit_Data := In_Tree.Units.Table (Unit);
  
     begin
        if Data.File_Names (Specification).Path = No_Name then
           declare
              Current_Source : String_List_Id :=
!               In_Tree.Projects.Table
!                 (Data.File_Names (Specification).Project).Sources;
              Path : GNAT.OS_Lib.String_Access;
  
           begin
*************** package body Prj.Env is
*** 2236,2242 ****
                   (Namet.Get_Name_String
                    (Data.File_Names (Specification).Name),
                    Namet.Get_Name_String
!                    (String_Elements.Table (Current_Source).Value));
  
                 if Path /= null then
                    Name_Len := Path'Length;
--- 2378,2385 ----
                   (Namet.Get_Name_String
                    (Data.File_Names (Specification).Name),
                    Namet.Get_Name_String
!                     (In_Tree.String_Elements.Table
!                        (Current_Source).Value));
  
                 if Path /= null then
                    Name_Len := Path'Length;
*************** package body Prj.Env is
*** 2245,2255 ****
                    exit;
                 else
                    Current_Source :=
!                     String_Elements.Table (Current_Source).Next;
                 end if;
              end loop;
  
!             Units.Table (Unit) := Data;
           end;
        end if;
  
--- 2388,2399 ----
                    exit;
                 else
                    Current_Source :=
!                     In_Tree.String_Elements.Table
!                       (Current_Source).Next;
                 end if;
              end loop;
  
!             In_Tree.Units.Table (Unit) := Data;
           end;
        end if;
  
*************** package body Prj.Env is
*** 2260,2280 ****
     -- Ultimate_Extension_Of --
     ---------------------------
  
!    function Ultimate_Extension_Of (Project : in Project_Id) return Project_Id
     is
        Result : Project_Id := Project;
  
     begin
!       while Projects.Table (Result).Extended_By /= No_Project loop
!          Result := Projects.Table (Result).Extended_By;
        end loop;
  
        return Result;
     end Ultimate_Extension_Of;
  
- --  Package initialization
- --  What is relationshiop to procedure Initialize
- 
- begin
-    Path_Files.Set_Last (0);
  end Prj.Env;
--- 2404,2422 ----
     -- Ultimate_Extension_Of --
     ---------------------------
  
!    function Ultimate_Extension_Of
!      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id
     is
        Result : Project_Id := Project;
  
     begin
!       while In_Tree.Projects.Table (Result).Extended_By /=
!         No_Project
!       loop
!          Result := In_Tree.Projects.Table (Result).Extended_By;
        end loop;
  
        return Result;
     end Ultimate_Extension_Of;
  
  end Prj.Env;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-env.ads gcc-4.1.0/gcc/ada/prj-env.ads
*** gcc-4.0.2/gcc/ada/prj-env.ads	Mon Apr 19 15:20:02 2004
--- gcc-4.1.0/gcc/ada/prj-env.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,45 ****
  --  This package implements services for Project-aware tools, mostly related
  --  to the environment (configuration pragma files, path files, mapping files).
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
- 
  package Prj.Env is
  
     procedure Initialize;
!    --  Called by Prj.Initialize to perform required initialization
!    --  steps for this package.
  
!    procedure Print_Sources;
     --  Output the list of sources, after Project files have been scanned
  
     procedure Create_Mapping_File
       (Project : Project_Id;
        Name    : out Name_Id);
     --  Create a temporary mapping file for project Project. For each unit
     --  in the closure of immediate sources of Project, put the mapping of
--- 27,44 ----
  --  This package implements services for Project-aware tools, mostly related
  --  to the environment (configuration pragma files, path files, mapping files).
  
  package Prj.Env is
  
     procedure Initialize;
!    --  Called by Prj.Initialize to perform required initialization steps for
!    --  this package.
  
!    procedure Print_Sources (In_Tree : Project_Tree_Ref);
     --  Output the list of sources, after Project files have been scanned
  
     procedure Create_Mapping_File
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Name    : out Name_Id);
     --  Create a temporary mapping file for project Project. For each unit
     --  in the closure of immediate sources of Project, put the mapping of
*************** package Prj.Env is
*** 52,57 ****
--- 51,57 ----
     procedure Create_Config_Pragmas_File
       (For_Project          : Project_Id;
        Main_Project         : Project_Id;
+       In_Tree              : Project_Tree_Ref;
        Include_Config_Files : Boolean := True);
     --  If there needs to have SFN pragmas, either for non standard naming
     --  schemes or for individual units, or (when Include_Config_Files is True)
*************** package Prj.Env is
*** 61,72 ****
     --  a temporary file that contains all configuration pragmas, and specify
     --  the configuration pragmas file in the project data.
  
!    function Ada_Include_Path (Project : Project_Id) return String_Access;
     --  Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute
     --  it and cache it.
  
     function Ada_Include_Path
       (Project   : Project_Id;
        Recursive : Boolean) return String;
     --  Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True,
     --  get all the source directories of the imported and modified project
--- 61,75 ----
     --  a temporary file that contains all configuration pragmas, and specify
     --  the configuration pragmas file in the project data.
  
!    function Ada_Include_Path
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return String_Access;
     --  Get the ADA_INCLUDE_PATH of a Project file. For the first call, compute
     --  it and cache it.
  
     function Ada_Include_Path
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        Recursive : Boolean) return String;
     --  Get the ADA_INCLUDE_PATH of a Project file. If Recursive it True,
     --  get all the source directories of the imported and modified project
*************** package Prj.Env is
*** 76,81 ****
--- 79,85 ----
  
     function Ada_Objects_Path
       (Project             : Project_Id;
+       In_Tree             : Project_Tree_Ref;
        Including_Libraries : Boolean := True) return String_Access;
     --  Get the ADA_OBJECTS_PATH of a Project file. For the first call, compute
     --  it and cache it. When Including_Libraries is False, do not include the
*************** package Prj.Env is
*** 83,104 ****
  
     procedure Set_Ada_Paths
       (Project             : Project_Id;
        Including_Libraries : Boolean);
     --  Set the env vars for additional project path files, after
     --  creating the path files if necessary.
  
!    procedure Delete_All_Path_Files;
     --  Delete all temporary path files that have been created by
     --  calls to Set_Ada_Paths.
  
     function Path_Name_Of_Library_Unit_Body
       (Name    : String;
!       Project : Project_Id) return String;
     --  Returns the Path of a library unit
  
     function File_Name_Of_Library_Unit_Body
       (Name              : String;
        Project           : Project_Id;
        Main_Project_Only : Boolean := True;
        Full_Path         : Boolean := False) return String;
     --  Returns the file name of a library unit, in canonical case. Name may or
--- 87,111 ----
  
     procedure Set_Ada_Paths
       (Project             : Project_Id;
+       In_Tree             : Project_Tree_Ref;
        Including_Libraries : Boolean);
     --  Set the env vars for additional project path files, after
     --  creating the path files if necessary.
  
!    procedure Delete_All_Path_Files (In_Tree : Project_Tree_Ref);
     --  Delete all temporary path files that have been created by
     --  calls to Set_Ada_Paths.
  
     function Path_Name_Of_Library_Unit_Body
       (Name    : String;
!       Project : Project_Id;
!       In_Tree : Project_Tree_Ref) return String;
     --  Returns the Path of a library unit
  
     function File_Name_Of_Library_Unit_Body
       (Name              : String;
        Project           : Project_Id;
+       In_Tree           : Project_Tree_Ref;
        Main_Project_Only : Boolean := True;
        Full_Path         : Boolean := False) return String;
     --  Returns the file name of a library unit, in canonical case. Name may or
*************** package Prj.Env is
*** 117,123 ****
  
     function Project_Of
       (Name         : String;
!       Main_Project : Project_Id) return Project_Id;
     --  Get the project of a source. The source file name may be truncated
     --  (".adb" or ".ads" may be missing). If the source is in a project being
     --  extended, return the ultimate extending project. If it is not a source
--- 124,131 ----
  
     function Project_Of
       (Name         : String;
!       Main_Project : Project_Id;
!       In_Tree      : Project_Tree_Ref) return Project_Id;
     --  Get the project of a source. The source file name may be truncated
     --  (".adb" or ".ads" may be missing). If the source is in a project being
     --  extended, return the ultimate extending project. If it is not a source
*************** package Prj.Env is
*** 125,144 ****
  
     procedure Get_Reference
       (Source_File_Name : String;
        Project          : out Project_Id;
        Path             : out Name_Id);
     --  Returns the project of a source and its path in displayable form
  
     generic
        with procedure Action (Path : String);
!    procedure For_All_Source_Dirs (Project : Project_Id);
!    --  Iterate through all the source directories of a project,
!    --  including those of imported or modified projects.
  
     generic
        with procedure Action (Path : String);
!    procedure For_All_Object_Dirs (Project : Project_Id);
!    --  Iterate through all the object directories of a project,
!    --  including those of imported or modified projects.
  
  end Prj.Env;
--- 133,157 ----
  
     procedure Get_Reference
       (Source_File_Name : String;
+       In_Tree          : Project_Tree_Ref;
        Project          : out Project_Id;
        Path             : out Name_Id);
     --  Returns the project of a source and its path in displayable form
  
     generic
        with procedure Action (Path : String);
!    procedure For_All_Source_Dirs
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref);
!    --  Iterate through all the source directories of a project, including
!    --  those of imported or modified projects.
  
     generic
        with procedure Action (Path : String);
!    procedure For_All_Object_Dirs
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref);
!    --  Iterate through all the object directories of a project, including
!    --  those of imported or modified projects.
  
  end Prj.Env;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-err.adb gcc-4.1.0/gcc/ada/prj-err.adb
*** gcc-4.0.2/gcc/ada/prj-err.adb	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/prj-err.adb	Mon Sep  5 07:50:46 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,32 ****
  
  with Namet;   use Namet;
  with Output;  use Output;
- with Scans;   use Scans;
  with Stringt; use Stringt;
  
  package body Prj.Err is
--- 26,31 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-err.ads gcc-4.1.0/gcc/ada/prj-err.ads
*** gcc-4.0.2/gcc/ada/prj-err.ads	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/prj-err.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,39 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routines to output error messages and the
! --  scanner for the project files. It replaces Errout and Scn.
! --  It is not dependent on the GNAT tree packages (Atree, Sinfo, ...).
! --  It uses the same global variables as Errout, located in package
! --  Err_Vars. Like Errout, it also uses the common variables and routines
! --  in package Erroutc.
  
  with Scng;
  with Errutil;
- with Types; use Types;
  
  package Prj.Err is
  
--- 16,37 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routines to output error messages and the scanner
! --  for the project files. It replaces Errout and Scn. It is not dependent on
! --  the GNAT tree packages (Atree, Sinfo, ...). It uses exactly the same global
! --  variables as Errout, located in package Err_Vars. Like Errout, it also uses
! --  the common variables and routines in package Erroutc.
  
  with Scng;
  with Errutil;
  
  package Prj.Err is
  
*************** package Prj.Err is
*** 64,73 ****
  
     procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr)
       renames Errutil.Error_Msg;
!    --  Output a message at specified location.
  
     procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S;
!    --  Output a message at current scan pointer location.
  
     procedure Error_Msg_SC (Msg : String) renames Errutil.Error_Msg_SC;
     --  Output a message at the start of the current token, unless we are at
--- 62,71 ----
  
     procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr)
       renames Errutil.Error_Msg;
!    --  Output a message at specified location
  
     procedure Error_Msg_S (Msg : String) renames Errutil.Error_Msg_S;
!    --  Output a message at current scan pointer location
  
     procedure Error_Msg_SC (Msg : String) renames Errutil.Error_Msg_SC;
     --  Output a message at the start of the current token, unless we are at
*************** package Prj.Err is
*** 75,81 ****
     --  last real token in the file.
  
     procedure Error_Msg_SP (Msg : String) renames Errutil.Error_Msg_SP;
!    --  Output a message at the start of the previous token.
  
     -------------
     -- Scanner --
--- 73,79 ----
     --  last real token in the file.
  
     procedure Error_Msg_SP (Msg : String) renames Errutil.Error_Msg_SP;
!    --  Output a message at the start of the previous token
  
     -------------
     -- Scanner --
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-ext.adb gcc-4.1.0/gcc/ada/prj-ext.adb
*** gcc-4.0.2/gcc/ada/prj-ext.adb	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-ext.adb	Tue Nov 15 14:01:18 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,52 ****
  ------------------------------------------------------------------------------
  
  with Namet;   use Namet;
  with Osint;   use Osint;
  with Sdefault;
- with Types;   use Types;
  
  with GNAT.HTable;
- with GNAT.OS_Lib; use GNAT.OS_Lib;
  
  package body Prj.Ext is
  
     Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
!    --  Name of the env. variable that contains path name(s) of directories
!    --  where project files may reside.
  
!    Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
     --  The path name(s) of directories where project files may reside.
     --  May be empty.
  
     No_Project_Default_Dir : constant String := "-";
  
     Current_Project_Path : String_Access;
!    --  The project path; initialized during elaboration of package
!    --  Contains at least the current working directory.
  
     package Htable is new GNAT.HTable.Simple_HTable
       (Header_Num => Header_Num,
--- 25,54 ----
  ------------------------------------------------------------------------------
  
  with Namet;   use Namet;
+ with Output;  use Output;
  with Osint;   use Osint;
  with Sdefault;
  
  with GNAT.HTable;
  
  package body Prj.Ext is
  
+    Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
     Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
!    --  Name of the env. variables that contain path name(s) of directories
!    --  where project files may reside. GPR_PROJECT_PATH has precedence over
!    --  ADA_PROJECT_PATH.
  
!    Gpr_Prj_Path : constant String_Access := Getenv (Gpr_Project_Path);
!    Ada_Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
     --  The path name(s) of directories where project files may reside.
     --  May be empty.
  
     No_Project_Default_Dir : constant String := "-";
  
     Current_Project_Path : String_Access;
!    --  The project path. Initialized during elaboration of package Contains at
!    --  least the current working directory.
  
     package Htable is new GNAT.HTable.Simple_HTable
       (Header_Num => Header_Num,
*************** package body Prj.Ext is
*** 155,162 ****
           return The_Value;
        end if;
  
!       --  Find if it is an environment.
!       --  If it is, put the value in the hash table.
  
        declare
           Env_Value : String_Access := Getenv (Name);
--- 157,163 ----
           return The_Value;
        end if;
  
!       --  Find if it is an environment, if it is, put value in the hash table
  
        declare
           Env_Value : String_Access := Getenv (Name);
*************** begin
*** 184,197 ****
        Add_Default_Dir : Boolean := True;
        First           : Positive;
        Last            : Positive;
  
     begin
        --  The current directory is always first
  
        Name_Len := 1;
        Name_Buffer (Name_Len) := '.';
  
!       --  If env. var. is defined and not empty, add its content
  
        if Prj_Path.all /= "" then
           Name_Len := Name_Len + 1;
--- 185,214 ----
        Add_Default_Dir : Boolean := True;
        First           : Positive;
        Last            : Positive;
+       New_Len         : Positive;
+       New_Last        : Positive;
+       Prj_Path        : String_Access := Gpr_Prj_Path;
  
     begin
+       if Gpr_Prj_Path.all /= "" then
+ 
+          --  Warn if both environment variables are defined
+ 
+          if Ada_Prj_Path.all /= "" then
+             Write_Line ("Warning: ADA_PROJECT_PATH is not taken into account");
+             Write_Line ("         when GPR_PROJECT_PATH is defined");
+          end if;
+ 
+       else
+          Prj_Path := Ada_Prj_Path;
+       end if;
+ 
        --  The current directory is always first
  
        Name_Len := 1;
        Name_Buffer (Name_Len) := '.';
  
!       --  If environment variable is defined and not empty, add its content
  
        if Prj_Path.all /= "" then
           Name_Len := Name_Len + 1;
*************** begin
*** 201,206 ****
--- 218,224 ----
  
           --  Scan the directory path to see if "-" is one of the directories.
           --  Remove each occurence of "-" and set Add_Default_Dir to False.
+          --  Also resolve relative paths and symbolic links.
  
           First := 3;
           loop
*************** begin
*** 232,237 ****
--- 250,276 ----
                 end loop;
  
                 Name_Len := Name_Len - No_Project_Default_Dir'Length - 1;
+ 
+             else
+                declare
+                   New_Dir : constant String :=
+                              Normalize_Pathname (Name_Buffer (First .. Last));
+                begin
+                   --  If the absolute path was resolved and is different from
+                   --  the original, replace original with the resolved path.
+ 
+                   if New_Dir /= Name_Buffer (First .. Last)
+                     and then New_Dir'Length /= 0
+                   then
+                      New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
+                      New_Last := First + New_Dir'Length - 1;
+                      Name_Buffer (New_Last + 1 .. New_Len) :=
+                        Name_Buffer (Last + 1 .. Name_Len);
+                      Name_Buffer (First .. New_Last) := New_Dir;
+                      Name_Len := New_Len;
+                      Last := New_Last;
+                   end if;
+                end;
              end if;
  
              First := Last + 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-ext.ads gcc-4.1.0/gcc/ada/prj-ext.ads
*** gcc-4.0.2/gcc/ada/prj-ext.ads	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-ext.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,34 ****
  --  Subprograms to set, get and cache external references, to be used as
  --  External functions in project files.
  
- with Types; use Types;
- 
  package Prj.Ext is
  
     function Project_Path return String;
--- 27,32 ----
*************** package Prj.Ext is
*** 44,56 ****
     procedure Add
       (External_Name : String;
        Value         : String);
!    --  Add an external reference (or modify an existing one).
  
     function Value_Of
       (External_Name : Name_Id;
        With_Default  : Name_Id := No_Name)
        return          Name_Id;
!    --  Get the value of an external reference, and cache it for future uses.
  
     function Check (Declaration : String) return Boolean;
     --  Check that an external declaration <external>=<value> is correct.
--- 42,54 ----
     procedure Add
       (External_Name : String;
        Value         : String);
!    --  Add an external reference (or modify an existing one)
  
     function Value_Of
       (External_Name : Name_Id;
        With_Default  : Name_Id := No_Name)
        return          Name_Id;
!    --  Get the value of an external reference, and cache it for future uses
  
     function Check (Declaration : String) return Boolean;
     --  Check that an external declaration <external>=<value> is correct.
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-makr.adb gcc-4.1.0/gcc/ada/prj-makr.adb
*** gcc-4.0.2/gcc/ada/prj-makr.adb	Thu Feb 10 13:55:43 2005
--- gcc-4.1.0/gcc/ada/prj-makr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Table;    use Table;
*** 40,46 ****
  
  with Ada.Characters.Handling;   use Ada.Characters.Handling;
  with GNAT.Directory_Operations; use GNAT.Directory_Operations;
- with GNAT.OS_Lib;               use GNAT.OS_Lib;
  with GNAT.Regexp;               use GNAT.Regexp;
  
  with System.Case_Util;          use System.Case_Util;
--- 40,45 ----
*************** package body Prj.Makr is
*** 117,122 ****
--- 116,123 ----
        Preproc_Switches  : Argument_List;
        Very_Verbose      : Boolean)
     is
+       Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
+ 
        Path_Name : String (1 .. File_Path'Length +
                              Project_File_Extension'Length);
        Path_Last : Natural := File_Path'Length;
*************** package body Prj.Makr is
*** 475,520 ****
                                         Decl_Item : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind =>
!                                                 N_Declarative_Item);
  
                                         Attribute : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind =>
!                                                 N_Attribute_Declaration);
  
                                         Expression : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind => N_Expression,
!                                             And_Expr_Kind => Single);
  
                                         Term : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind => N_Term,
!                                             And_Expr_Kind => Single);
  
                                         Value : constant Project_Node_Id :=
                                           Default_Project_Node
!                                            (Of_Kind => N_Literal_String,
!                                             And_Expr_Kind => Single);
  
                                      begin
                                         Set_Next_Declarative_Item
                                           (Decl_Item,
                                            To => First_Declarative_Item_Of
!                                             (Naming_Package));
                                         Set_First_Declarative_Item_Of
!                                          (Naming_Package, To => Decl_Item);
                                         Set_Current_Item_Node
!                                          (Decl_Item, To => Attribute);
  
                                         --  Is it a spec or a body?
  
                                         if SFN_Prag.Spec then
                                            Set_Name_Of
!                                             (Attribute, To => Name_Spec);
                                         else
                                            Set_Name_Of
!                                             (Attribute,
                                               To => Name_Body);
                                         end if;
  
--- 476,532 ----
                                         Decl_Item : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind =>
!                                                 N_Declarative_Item,
!                                             In_Tree => Tree);
  
                                         Attribute : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind =>
!                                                 N_Attribute_Declaration,
!                                             In_Tree => Tree);
  
                                         Expression : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind => N_Expression,
!                                             And_Expr_Kind => Single,
!                                             In_Tree => Tree);
  
                                         Term : constant Project_Node_Id :=
                                           Default_Project_Node
                                             (Of_Kind => N_Term,
!                                             And_Expr_Kind => Single,
!                                             In_Tree => Tree);
  
                                         Value : constant Project_Node_Id :=
                                           Default_Project_Node
!                                            (Of_Kind       => N_Literal_String,
!                                             And_Expr_Kind => Single,
!                                             In_Tree       => Tree);
  
                                      begin
                                         Set_Next_Declarative_Item
                                           (Decl_Item,
                                            To => First_Declarative_Item_Of
!                                             (Naming_Package, Tree),
!                                           In_Tree => Tree);
                                         Set_First_Declarative_Item_Of
!                                          (Naming_Package,
!                                           To => Decl_Item,
!                                           In_Tree => Tree);
                                         Set_Current_Item_Node
!                                          (Decl_Item,
!                                           To => Attribute,
!                                           In_Tree => Tree);
  
                                         --  Is it a spec or a body?
  
                                         if SFN_Prag.Spec then
                                            Set_Name_Of
!                                             (Attribute, Tree,
!                                              To => Name_Spec);
                                         else
                                            Set_Name_Of
!                                             (Attribute, Tree,
                                               To => Name_Body);
                                         end if;
  
*************** package body Prj.Makr is
*** 523,542 ****
                                         Get_Name_String (SFN_Prag.Unit);
                                         To_Lower (Name_Buffer (1 .. Name_Len));
                                         Set_Associative_Array_Index_Of
!                                          (Attribute, To => Name_Find);
  
                                         Set_Expression_Of
!                                          (Attribute, To => Expression);
                                         Set_First_Term
!                                          (Expression, To => Term);
!                                        Set_Current_Term (Term, To => Value);
  
                                         --  And set the name of the file
  
                                         Set_String_Value_Of
!                                          (Value, To => File_Name_Id);
                                         Set_Source_Index_Of
!                                          (Value, To => SFN_Prag.Index);
                                      end;
                                   end if;
                                end loop;
--- 535,555 ----
                                         Get_Name_String (SFN_Prag.Unit);
                                         To_Lower (Name_Buffer (1 .. Name_Len));
                                         Set_Associative_Array_Index_Of
!                                          (Attribute, Tree, To => Name_Find);
  
                                         Set_Expression_Of
!                                          (Attribute, Tree, To => Expression);
                                         Set_First_Term
!                                          (Expression, Tree, To => Term);
!                                        Set_Current_Term
!                                          (Term, Tree, To => Value);
  
                                         --  And set the name of the file
  
                                         Set_String_Value_Of
!                                          (Value, Tree, To => File_Name_Id);
                                         Set_Source_Index_Of
!                                          (Value, Tree, To => SFN_Prag.Index);
                                      end;
                                   end if;
                                end loop;
*************** package body Prj.Makr is
*** 649,655 ****
        Csets.Initialize;
        Namet.Initialize;
        Snames.Initialize;
!       Prj.Initialize;
  
        SFN_Pragmas.Set_Last (0);
  
--- 662,669 ----
        Csets.Initialize;
        Namet.Initialize;
        Snames.Initialize;
!       Prj.Initialize (No_Project_Tree);
!       Prj.Tree.Initialize (Tree);
  
        SFN_Pragmas.Set_Last (0);
  
*************** package body Prj.Makr is
*** 707,713 ****
              end if;
  
              Part.Parse
!               (Project                => Project_Node,
                 Project_File_Name      => Output_Name (1 .. Output_Name_Last),
                 Always_Errout_Finalize => False);
  
--- 721,728 ----
              end if;
  
              Part.Parse
!               (In_Tree                => Tree,
!                Project                => Project_Node,
                 Project_File_Name      => Output_Name (1 .. Output_Name_Last),
                 Always_Errout_Finalize => False);
  
*************** package body Prj.Makr is
*** 725,751 ****
  
                 declare
                    With_Clause : Project_Node_Id :=
!                                   First_With_Clause_Of (Project_Node);
                    Previous    : Project_Node_Id := Empty_Node;
  
                 begin
                    while With_Clause /= Empty_Node loop
!                      if Tree.Name_Of (With_Clause) = Project_Naming_Id then
                          if Previous = Empty_Node then
                             Set_First_With_Clause_Of
!                              (Project_Node,
!                               To => Next_With_Clause_Of (With_Clause));
                          else
                             Set_Next_With_Clause_Of
!                              (Previous,
!                               To => Next_With_Clause_Of (With_Clause));
                          end if;
  
                          exit;
                       end if;
  
                       Previous := With_Clause;
!                      With_Clause := Next_With_Clause_Of (With_Clause);
                    end loop;
                 end;
  
--- 740,768 ----
  
                 declare
                    With_Clause : Project_Node_Id :=
!                                   First_With_Clause_Of (Project_Node, Tree);
                    Previous    : Project_Node_Id := Empty_Node;
  
                 begin
                    while With_Clause /= Empty_Node loop
!                      if Prj.Tree.Name_Of (With_Clause, Tree) =
!                           Project_Naming_Id
!                      then
                          if Previous = Empty_Node then
                             Set_First_With_Clause_Of
!                              (Project_Node, Tree,
!                               To => Next_With_Clause_Of (With_Clause, Tree));
                          else
                             Set_Next_With_Clause_Of
!                              (Previous, Tree,
!                               To => Next_With_Clause_Of (With_Clause, Tree));
                          end if;
  
                          exit;
                       end if;
  
                       Previous := With_Clause;
!                      With_Clause := Next_With_Clause_Of (With_Clause, Tree);
                    end loop;
                 end;
  
*************** package body Prj.Makr is
*** 757,797 ****
                    Declaration  : Project_Node_Id :=
                                     First_Declarative_Item_Of
                                       (Project_Declaration_Of
!                                        (Project_Node));
                    Previous     : Project_Node_Id := Empty_Node;
                    Current_Node : Project_Node_Id := Empty_Node;
  
                 begin
                    while Declaration /= Empty_Node loop
!                      Current_Node := Current_Item_Node (Declaration);
  
!                      if (Kind_Of (Current_Node) = N_Attribute_Declaration
                             and then
!                             (Tree.Name_Of (Current_Node) = Name_Source_Files
!                                or else Tree.Name_Of (Current_Node) =
!                                                  Name_Source_List_File
!                                or else Tree.Name_Of (Current_Node) =
!                                                  Name_Source_Dirs))
                         or else
!                        (Kind_Of (Current_Node) = N_Package_Declaration
!                           and then Tree.Name_Of (Current_Node) = Name_Naming)
                       then
                          if Previous = Empty_Node then
                             Set_First_Declarative_Item_Of
!                              (Project_Declaration_Of (Project_Node),
!                               To => Next_Declarative_Item (Declaration));
  
                          else
                             Set_Next_Declarative_Item
!                              (Previous,
!                               To => Next_Declarative_Item (Declaration));
                          end if;
  
                       else
                          Previous := Declaration;
                       end if;
  
!                      Declaration := Next_Declarative_Item (Declaration);
                    end loop;
                 end;
              end if;
--- 774,818 ----
                    Declaration  : Project_Node_Id :=
                                     First_Declarative_Item_Of
                                       (Project_Declaration_Of
!                                         (Project_Node, Tree),
!                                       Tree);
                    Previous     : Project_Node_Id := Empty_Node;
                    Current_Node : Project_Node_Id := Empty_Node;
  
                 begin
                    while Declaration /= Empty_Node loop
!                      Current_Node := Current_Item_Node (Declaration, Tree);
  
!                      if (Kind_Of (Current_Node, Tree) = N_Attribute_Declaration
                             and then
!                            (Prj.Tree.Name_Of (Current_Node, Tree) =
!                               Name_Source_Files
!                              or else Prj.Tree.Name_Of (Current_Node, Tree) =
!                                                Name_Source_List_File
!                              or else Prj.Tree.Name_Of (Current_Node, Tree) =
!                                                Name_Source_Dirs))
                         or else
!                        (Kind_Of (Current_Node, Tree) = N_Package_Declaration
!                         and then Prj.Tree.Name_Of (Current_Node, Tree) =
!                                    Name_Naming)
                       then
                          if Previous = Empty_Node then
                             Set_First_Declarative_Item_Of
!                              (Project_Declaration_Of (Project_Node, Tree),
!                               Tree,
!                               To => Next_Declarative_Item (Declaration, Tree));
  
                          else
                             Set_Next_Declarative_Item
!                              (Previous, Tree,
!                               To => Next_Declarative_Item (Declaration, Tree));
                          end if;
  
                       else
                          Previous := Declaration;
                       end if;
  
!                      Declaration := Next_Declarative_Item (Declaration, Tree);
                    end loop;
                 end;
              end if;
*************** package body Prj.Makr is
*** 971,981 ****
           --  name and its project declaration node.
  
           if Project_Node = Empty_Node then
!             Project_Node := Default_Project_Node (Of_Kind => N_Project);
!             Set_Name_Of (Project_Node, To => Output_Name_Id);
              Set_Project_Declaration_Of
!               (Project_Node,
!                To => Default_Project_Node (Of_Kind => N_Project_Declaration));
  
           end if;
  
--- 992,1004 ----
           --  name and its project declaration node.
  
           if Project_Node = Empty_Node then
!             Project_Node :=
!               Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
!             Set_Name_Of (Project_Node, Tree, To => Output_Name_Id);
              Set_Project_Declaration_Of
!               (Project_Node, Tree,
!                To => Default_Project_Node
!                  (Of_Kind => N_Project_Declaration, In_Tree => Tree));
  
           end if;
  
*************** package body Prj.Makr is
*** 983,1075 ****
           --  for Source_Files as an empty list, to indicate there are no
           --  sources in the naming project.
  
!          Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
!          Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
           Project_Naming_Decl :=
!            Default_Project_Node (Of_Kind => N_Project_Declaration);
!          Set_Project_Declaration_Of (Project_Naming_Node, Project_Naming_Decl);
           Naming_Package :=
!            Default_Project_Node (Of_Kind => N_Package_Declaration);
!          Set_Name_Of (Naming_Package, To => Name_Naming);
  
           declare
              Decl_Item : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_Declarative_Item);
  
              Attribute : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Attribute_Declaration,
!                And_Expr_Kind => List);
  
              Expression : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Expression,
!                And_Expr_Kind => List);
  
!             Term  : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Term,
!                And_Expr_Kind => List);
  
              Empty_List : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Literal_String_List);
  
           begin
              Set_First_Declarative_Item_Of
!               (Project_Naming_Decl, To => Decl_Item);
!             Set_Next_Declarative_Item (Decl_Item, Naming_Package);
!             Set_Current_Item_Node (Decl_Item, To => Attribute);
!             Set_Name_Of (Attribute, To => Name_Source_Files);
!             Set_Expression_Of (Attribute, To => Expression);
!             Set_First_Term (Expression, To => Term);
!             Set_Current_Term (Term, To => Empty_List);
           end;
  
           --  Add a with clause on the naming project in the main project
  
           declare
              With_Clause : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_With_Clause);
  
           begin
              Set_Next_With_Clause_Of
!               (With_Clause, To => First_With_Clause_Of (Project_Node));
!             Set_First_With_Clause_Of (Project_Node, To => With_Clause);
!             Set_Name_Of (With_Clause, To => Project_Naming_Id);
  
              --  We set the project node to something different than
              --  Empty_Node, so that Prj.PP does not generate a limited
              --  with clause.
  
!             Set_Project_Node_Of (With_Clause, Non_Empty_Node);
  
              Name_Len := Project_Naming_Last;
              Name_Buffer (1 .. Name_Len) :=
                Project_Naming_File_Name (1 .. Project_Naming_Last);
!             Set_String_Value_Of (With_Clause, To => Name_Find);
           end;
  
!          Project_Declaration := Project_Declaration_Of (Project_Node);
  
           --  Add a renaming declaration for package Naming in the main project
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_Declarative_Item);
  
              Naming : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_Package_Declaration);
           begin
              Set_Next_Declarative_Item
!               (Decl_Item,
!                To => First_Declarative_Item_Of (Project_Declaration));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, To => Naming);
!             Set_Name_Of (Naming, To => Name_Naming);
              Set_Project_Of_Renamed_Package_Of
!               (Naming, To => Project_Naming_Node);
           end;
  
           --  Add an attribute declaration for Source_Dirs, initialized as an
--- 1006,1114 ----
           --  for Source_Files as an empty list, to indicate there are no
           --  sources in the naming project.
  
!          Project_Naming_Node :=
!            Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree);
!          Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id);
           Project_Naming_Decl :=
!            Default_Project_Node
!              (Of_Kind => N_Project_Declaration, In_Tree => Tree);
!          Set_Project_Declaration_Of
!            (Project_Naming_Node, Tree, Project_Naming_Decl);
           Naming_Package :=
!            Default_Project_Node
!              (Of_Kind => N_Package_Declaration, In_Tree => Tree);
!          Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
  
           declare
              Decl_Item : constant Project_Node_Id :=
!                           Default_Project_Node
!                             (Of_Kind => N_Declarative_Item, In_Tree => Tree);
  
              Attribute : constant Project_Node_Id :=
!                           Default_Project_Node
!                             (Of_Kind       => N_Attribute_Declaration,
!                              In_Tree       => Tree,
!                              And_Expr_Kind => List);
  
              Expression : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Expression,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => List);
  
!             Term      : constant Project_Node_Id :=
!                           Default_Project_Node
!                             (Of_Kind       => N_Term,
!                              In_Tree       => Tree,
!                              And_Expr_Kind => List);
  
              Empty_List : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind => N_Literal_String_List,
!                               In_Tree => Tree);
  
           begin
              Set_First_Declarative_Item_Of
!               (Project_Naming_Decl, Tree, To => Decl_Item);
!             Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package);
!             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
!             Set_Name_Of (Attribute, Tree, To => Name_Source_Files);
!             Set_Expression_Of (Attribute, Tree, To => Expression);
!             Set_First_Term (Expression, Tree, To => Term);
!             Set_Current_Term (Term, Tree, To => Empty_List);
           end;
  
           --  Add a with clause on the naming project in the main project
  
           declare
              With_Clause : constant Project_Node_Id :=
!                             Default_Project_Node
!                               (Of_Kind => N_With_Clause, In_Tree => Tree);
  
           begin
              Set_Next_With_Clause_Of
!               (With_Clause, Tree,
!                To => First_With_Clause_Of (Project_Node, Tree));
!             Set_First_With_Clause_Of (Project_Node, Tree, To => With_Clause);
!             Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id);
  
              --  We set the project node to something different than
              --  Empty_Node, so that Prj.PP does not generate a limited
              --  with clause.
  
!             Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
  
              Name_Len := Project_Naming_Last;
              Name_Buffer (1 .. Name_Len) :=
                Project_Naming_File_Name (1 .. Project_Naming_Last);
!             Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
           end;
  
!          Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
  
           --  Add a renaming declaration for package Naming in the main project
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind => N_Declarative_Item,
!                               In_Tree => Tree);
  
              Naming : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind => N_Package_Declaration,
!                               In_Tree => Tree);
! 
           begin
              Set_Next_Declarative_Item
!               (Decl_Item, Tree,
!                To => First_Declarative_Item_Of (Project_Declaration, Tree));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, Tree, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, Tree, To => Naming);
!             Set_Name_Of (Naming, Tree, To => Name_Naming);
              Set_Project_Of_Renamed_Package_Of
!               (Naming, Tree, To => Project_Naming_Node);
           end;
  
           --  Add an attribute declaration for Source_Dirs, initialized as an
*************** package body Prj.Makr is
*** 1078,1113 ****
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_Declarative_Item);
  
              Attribute : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Attribute_Declaration,
!                And_Expr_Kind => List);
  
              Expression : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Expression,
!                And_Expr_Kind => List);
  
              Term  : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Term, And_Expr_Kind => List);
  
           begin
              Set_Next_Declarative_Item
!               (Decl_Item,
!                To => First_Declarative_Item_Of (Project_Declaration));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, To => Attribute);
!             Set_Name_Of (Attribute, To => Name_Source_Dirs);
!             Set_Expression_Of (Attribute, To => Expression);
!             Set_First_Term (Expression, To => Term);
              Source_Dirs_List :=
!               Default_Project_Node (Of_Kind => N_Literal_String_List,
!                                     And_Expr_Kind => List);
!             Set_Current_Term (Term, To => Source_Dirs_List);
           end;
  
           --  Add an attribute declaration for Source_List_File with the
--- 1117,1159 ----
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind => N_Declarative_Item,
!                               In_Tree => Tree);
  
              Attribute : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Attribute_Declaration,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => List);
  
              Expression : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Expression,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => List);
  
              Term  : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Term, In_Tree => Tree,
!                               And_Expr_Kind => List);
  
           begin
              Set_Next_Declarative_Item
!               (Decl_Item, Tree,
!                To => First_Declarative_Item_Of (Project_Declaration, Tree));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, Tree, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
!             Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs);
!             Set_Expression_Of (Attribute, Tree, To => Expression);
!             Set_First_Term (Expression, Tree, To => Term);
              Source_Dirs_List :=
!               Default_Project_Node
!                 (Of_Kind       => N_Literal_String_List,
!                  In_Tree       => Tree,
!                  And_Expr_Kind => List);
!             Set_Current_Term (Term, Tree, To => Source_Dirs_List);
           end;
  
           --  Add an attribute declaration for Source_List_File with the
*************** package body Prj.Makr is
*** 1115,1157 ****
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!               Default_Project_Node (Of_Kind => N_Declarative_Item);
  
!             Attribute : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Attribute_Declaration,
!                And_Expr_Kind => Single);
  
              Expression : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Expression,
!                And_Expr_Kind => Single);
  
!             Term  : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Term,
!                And_Expr_Kind => Single);
  
!             Value : constant Project_Node_Id :=
!               Default_Project_Node
!               (Of_Kind => N_Literal_String,
!                And_Expr_Kind => Single);
  
           begin
              Set_Next_Declarative_Item
!               (Decl_Item,
!                To => First_Declarative_Item_Of (Project_Declaration));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, To => Attribute);
!             Set_Name_Of (Attribute, To => Name_Source_List_File);
!             Set_Expression_Of (Attribute, To => Expression);
!             Set_First_Term (Expression, To => Term);
!             Set_Current_Term (Term, To => Value);
              Name_Len := Source_List_Last;
              Name_Buffer (1 .. Name_Len) :=
                Source_List_Path (1 .. Source_List_Last);
!             Set_String_Value_Of (Value, To => Name_Find);
           end;
        end if;
  
--- 1161,1209 ----
  
           declare
              Decl_Item  : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind => N_Declarative_Item,
!                               In_Tree => Tree);
  
!             Attribute  : constant Project_Node_Id :=
!                             Default_Project_Node
!                               (Of_Kind       => N_Attribute_Declaration,
!                                In_Tree       => Tree,
!                                And_Expr_Kind => Single);
  
              Expression : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Expression,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => Single);
  
!             Term       : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Term,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => Single);
  
!             Value      : constant Project_Node_Id :=
!                            Default_Project_Node
!                              (Of_Kind       => N_Literal_String,
!                               In_Tree       => Tree,
!                               And_Expr_Kind => Single);
  
           begin
              Set_Next_Declarative_Item
!               (Decl_Item, Tree,
!                To => First_Declarative_Item_Of (Project_Declaration, Tree));
              Set_First_Declarative_Item_Of
!               (Project_Declaration, Tree, To => Decl_Item);
!             Set_Current_Item_Node (Decl_Item, Tree, To => Attribute);
!             Set_Name_Of (Attribute, Tree, To => Name_Source_List_File);
!             Set_Expression_Of (Attribute, Tree, To => Expression);
!             Set_First_Term (Expression, Tree, To => Term);
!             Set_Current_Term (Term, Tree, To => Value);
              Name_Len := Source_List_Last;
              Name_Buffer (1 .. Name_Len) :=
                Source_List_Path (1 .. Source_List_Last);
!             Set_String_Value_Of (Value, Tree, To => Name_Find);
           end;
        end if;
  
*************** package body Prj.Makr is
*** 1163,1168 ****
--- 1215,1221 ----
              Dir_Name    : constant String := Directories (Index).all;
              Last        : Natural := Dir_Name'Last;
              Recursively : Boolean := False;
+ 
           begin
              if Dir_Name'Length >= 4
                and then (Dir_Name (Last - 2 .. Last) = "/**")
*************** package body Prj.Makr is
*** 1177,1211 ****
  
                 declare
                    Expression : constant Project_Node_Id :=
!                     Default_Project_Node
!                     (Of_Kind => N_Expression,
!                      And_Expr_Kind => Single);
  
!                   Term : constant Project_Node_Id :=
!                     Default_Project_Node
!                     (Of_Kind => N_Term,
!                      And_Expr_Kind => Single);
  
!                   Value : constant Project_Node_Id :=
!                     Default_Project_Node
!                     (Of_Kind => N_Literal_String,
!                      And_Expr_Kind => Single);
  
                 begin
                    if Current_Source_Dir = Empty_Node then
                       Set_First_Expression_In_List
!                        (Source_Dirs_List, To => Expression);
                    else
                       Set_Next_Expression_In_List
!                        (Current_Source_Dir, To => Expression);
                    end if;
  
                    Current_Source_Dir := Expression;
!                   Set_First_Term (Expression, To => Term);
!                   Set_Current_Term (Term, To => Value);
                    Name_Len := Dir_Name'Length;
                    Name_Buffer (1 .. Name_Len) := Dir_Name;
!                   Set_String_Value_Of (Value, To => Name_Find);
                 end;
              end if;
  
--- 1230,1267 ----
  
                 declare
                    Expression : constant Project_Node_Id :=
!                                  Default_Project_Node
!                                    (Of_Kind       => N_Expression,
!                                     In_Tree       => Tree,
!                                     And_Expr_Kind => Single);
  
!                   Term       : constant Project_Node_Id :=
!                                  Default_Project_Node
!                                    (Of_Kind       => N_Term,
!                                     In_Tree       => Tree,
!                                     And_Expr_Kind => Single);
  
!                   Value      : constant Project_Node_Id :=
!                                  Default_Project_Node
!                                    (Of_Kind       => N_Literal_String,
!                                     In_Tree       => Tree,
!                                     And_Expr_Kind => Single);
  
                 begin
                    if Current_Source_Dir = Empty_Node then
                       Set_First_Expression_In_List
!                        (Source_Dirs_List, Tree, To => Expression);
                    else
                       Set_Next_Expression_In_List
!                        (Current_Source_Dir, Tree, To => Expression);
                    end if;
  
                    Current_Source_Dir := Expression;
!                   Set_First_Term (Expression, Tree, To => Term);
!                   Set_Current_Term (Term, Tree, To => Value);
                    Name_Len := Dir_Name'Length;
                    Name_Buffer (1 .. Name_Len) := Dir_Name;
!                   Set_String_Value_Of (Value, Tree, To => Name_Find);
                 end;
              end if;
  
*************** package body Prj.Makr is
*** 1252,1258 ****
              --  Output the project file
  
              Prj.PP.Pretty_Print
!               (Project_Node,
                 W_Char => Write_A_Char'Access,
                 W_Eol  => Write_Eol'Access,
                 W_Str  => Write_A_String'Access,
--- 1308,1314 ----
              --  Output the project file
  
              Prj.PP.Pretty_Print
!               (Project_Node, Tree,
                 W_Char => Write_A_Char'Access,
                 W_Eol  => Write_Eol'Access,
                 W_Str  => Write_A_String'Access,
*************** package body Prj.Makr is
*** 1290,1296 ****
              --  Output the naming project file
  
              Prj.PP.Pretty_Print
!               (Project_Naming_Node,
                 W_Char => Write_A_Char'Access,
                 W_Eol  => Write_Eol'Access,
                 W_Str  => Write_A_String'Access,
--- 1346,1352 ----
              --  Output the naming project file
  
              Prj.PP.Pretty_Print
!               (Project_Naming_Node, Tree,
                 W_Char => Write_A_Char'Access,
                 W_Eol  => Write_Eol'Access,
                 W_Str  => Write_A_String'Access,
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-makr.ads gcc-4.1.0/gcc/ada/prj-makr.ads
*** gcc-4.0.2/gcc/ada/prj-makr.ads	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prj-makr.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,36 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Support for procedure Gnatname.
  
  --  For arbitrary naming schemes, create or update a project file,
  --  or create a configuration pragmas file.
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
- 
  package Prj.Makr is
  
     procedure Make
--- 16,34 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Support for procedure Gnatname
  
  --  For arbitrary naming schemes, create or update a project file,
  --  or create a configuration pragmas file.
  
  package Prj.Makr is
  
     procedure Make
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-nmsc.adb gcc-4.1.0/gcc/ada/prj-nmsc.adb
*** gcc-4.0.2/gcc/ada/prj-nmsc.adb	Wed Dec  8 11:25:43 2004
--- gcc-4.1.0/gcc/ada/prj-nmsc.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Namet;    use Namet;
*** 32,45 ****
  with Osint;    use Osint;
  with Output;   use Output;
  with MLib.Tgt; use MLib.Tgt;
- with Prj.Com;  use Prj.Com;
  with Prj.Env;  use Prj.Env;
  with Prj.Err;
  with Prj.Util; use Prj.Util;
  with Sinput.P;
  with Snames;   use Snames;
  with Table;    use Table;
- with Types;    use Types;
  
  with Ada.Characters.Handling;    use Ada.Characters.Handling;
  with Ada.Strings;                use Ada.Strings;
--- 32,43 ----
*************** with Ada.Strings.Maps.Constants; use Ada
*** 48,54 ****
  
  with GNAT.Case_Util;             use GNAT.Case_Util;
  with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
- with GNAT.OS_Lib;                use GNAT.OS_Lib;
  with GNAT.HTable;
  
  package body Prj.Nmsc is
--- 46,51 ----
*************** package body Prj.Nmsc is
*** 147,164 ****
     function ALI_File_Name (Source : String) return String;
     --  Return the ALI file name corresponding to a source
  
!    procedure Check_Ada_Name
!      (Name : String;
!       Unit : out Name_Id);
     --  Check that a name is a valid Ada unit name
  
     procedure Check_Naming_Scheme
       (Data    : in out Project_Data;
!       Project : Project_Id);
     --  Check the naming scheme part of Data
  
     procedure Check_Ada_Naming_Scheme_Validity
       (Project : Project_Id;
        Naming  : Naming_Data);
     --  Check that the package Naming is correct
  
--- 144,161 ----
     function ALI_File_Name (Source : String) return String;
     --  Return the ALI file name corresponding to a source
  
!    procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
     --  Check that a name is a valid Ada unit name
  
     procedure Check_Naming_Scheme
       (Data    : in out Project_Data;
!       Project : Project_Id;
!       In_Tree : Project_Tree_Ref);
     --  Check the naming scheme part of Data
  
     procedure Check_Ada_Naming_Scheme_Validity
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Naming  : Naming_Data);
     --  Check that the package Naming is correct
  
*************** package body Prj.Nmsc is
*** 166,219 ****
       (File_Name        : Name_Id;
        Path_Name        : Name_Id;
        Project          : Project_Id;
        Data             : in out Project_Data;
        Location         : Source_Ptr;
        Language         : Language_Index;
        Suffix           : String;
        Naming_Exception : Boolean);
!    --  Check if a file in a source directory is a source for a specific
!    --  language other than Ada. Comments required for parameters ???
  
     procedure Check_If_Externally_Built
       (Project : Project_Id;
        Data    : in out Project_Data);
!    --  ??? comment required
  
     procedure Check_Library_Attributes
       (Project   : Project_Id;
        Data      : in out Project_Data);
!    --  ??? comment required
  
     procedure Check_Package_Naming
       (Project : Project_Id;
        Data    : in out Project_Data);
!    --  ??? comment required
  
!    procedure Check_Programming_Languages (Data : in out Project_Data);
!    --  ??? comment required
  
     function Check_Project
       (P            : Project_Id;
        Root_Project : Project_Id;
        Extending    : Boolean) return Boolean;
     --  Returns True if P is Root_Project or, if Extending is True, a project
     --  extended by Root_Project.
  
     procedure Check_Stand_Alone_Library
       (Project   : Project_Id;
        Data      : in out Project_Data;
        Extending : Boolean);
  
     function Compute_Directory_Last (Dir : String) return Natural;
     --  Return the index of the last significant character in Dir. This is used
     --  to avoid duplicates '/' at the end of directory names
  
     function Body_Suffix_Of
!      (Language : Language_Index; In_Project : Project_Data)
        return String;
  
     procedure Error_Msg
       (Project       : Project_Id;
        Msg           : String;
        Flag_Location : Source_Ptr);
     --  Output an error message. If Error_Report is null, simply call
--- 163,236 ----
       (File_Name        : Name_Id;
        Path_Name        : Name_Id;
        Project          : Project_Id;
+       In_Tree          : Project_Tree_Ref;
        Data             : in out Project_Data;
        Location         : Source_Ptr;
        Language         : Language_Index;
        Suffix           : String;
        Naming_Exception : Boolean);
!    --  Check if a file, with name File_Name and path Path_Name, in a source
!    --  directory is a source for language Language in project Project of
!    --  project tree In_Tree. ???
  
     procedure Check_If_Externally_Built
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Data    : in out Project_Data);
!    --  Check attribute Externally_Built of project Project in project tree
!    --  In_Tree and modify its data Data if it has the value "true".
  
     procedure Check_Library_Attributes
       (Project   : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Data      : in out Project_Data);
!    --  Check the library attributes of project Project in project tree In_Tree
!    --  and modify its data Data accordingly.
  
     procedure Check_Package_Naming
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Data    : in out Project_Data);
!    --  Check package Naming of project Project in project tree In_Tree and
!    --  modify its data Data accordingly.
  
!    procedure Check_Programming_Languages
!      (In_Tree : Project_Tree_Ref; Data : in out Project_Data);
!    --  Check attribute Languages for the project with data Data in project
!    --  tree In_Tree and set the components of Data for all the programming
!    --  languages indicated in attribute Languages, if any.
  
     function Check_Project
       (P            : Project_Id;
        Root_Project : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Extending    : Boolean) return Boolean;
     --  Returns True if P is Root_Project or, if Extending is True, a project
     --  extended by Root_Project.
  
     procedure Check_Stand_Alone_Library
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        Data      : in out Project_Data;
        Extending : Boolean);
+    --  Check if project Project in project tree In_Tree is a Stand-Alone
+    --  Library project, and modify its data Data accordingly if it is one.
  
     function Compute_Directory_Last (Dir : String) return Natural;
     --  Return the index of the last significant character in Dir. This is used
     --  to avoid duplicates '/' at the end of directory names
  
     function Body_Suffix_Of
!      (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref)
        return String;
+    --  Returns the suffix of sources of language Language in project In_Project
+    --  in project tree In_Tree.
  
     procedure Error_Msg
       (Project       : Project_Id;
+       In_Tree       : Project_Tree_Ref;
        Msg           : String;
        Flag_Location : Source_Ptr);
     --  Output an error message. If Error_Report is null, simply call
*************** package body Prj.Nmsc is
*** 222,227 ****
--- 239,245 ----
  
     procedure Find_Sources
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Data         : in out Project_Data;
        For_Language : Language_Index;
        Follow_Links : Boolean := False);
*************** package body Prj.Nmsc is
*** 233,250 ****
  
     procedure Get_Directories
       (Project : Project_Id;
        Data    : in out Project_Data);
     --  Get the object directory, the exec directory and the source directories
     --  of a project.
  
!    procedure Get_Mains (Project : Project_Id; Data : in out Project_Data);
     --  Get the mains of a project from attribute Main, if it exists, and put
     --  them in the project data.
  
     procedure Get_Sources_From_File
       (Path     : String;
        Location : Source_Ptr;
!       Project  : Project_Id);
     --  Get the list of sources from a text file and put them in hash table
     --  Source_Names.
  
--- 251,273 ----
  
     procedure Get_Directories
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Data    : in out Project_Data);
     --  Get the object directory, the exec directory and the source directories
     --  of a project.
  
!    procedure Get_Mains
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data);
     --  Get the mains of a project from attribute Main, if it exists, and put
     --  them in the project data.
  
     procedure Get_Sources_From_File
       (Path     : String;
        Location : Source_Ptr;
!       Project  : Project_Id;
!       In_Tree  : Project_Tree_Ref);
     --  Get the list of sources from a text file and put them in hash table
     --  Source_Names.
  
*************** package body Prj.Nmsc is
*** 280,288 ****
  
     procedure Look_For_Sources
       (Project      : Project_Id;
        Data         : in out Project_Data;
        Follow_Links : Boolean);
!    --  Comment required ???
  
     function Path_Name_Of
       (File_Name : Name_Id;
--- 303,312 ----
  
     procedure Look_For_Sources
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Data         : in out Project_Data;
        Follow_Links : Boolean);
!    --  Find all the sources of a project
  
     function Path_Name_Of
       (File_Name : Name_Id;
*************** package body Prj.Nmsc is
*** 291,304 ****
     --  Returns an empty string if file cannot be found.
  
     procedure Prepare_Ada_Naming_Exceptions
!      (List : Array_Element_Id;
!       Kind : Spec_Or_Body);
     --  Prepare the internal hash tables used for checking naming exceptions
     --  for Ada. Insert all elements of List in the tables.
  
     function Project_Extends
       (Extending : Project_Id;
!       Extended  : Project_Id) return Boolean;
     --  Returns True if Extending is extending Extended either directly or
     --  indirectly.
  
--- 315,330 ----
     --  Returns an empty string if file cannot be found.
  
     procedure Prepare_Ada_Naming_Exceptions
!      (List    : Array_Element_Id;
!       In_Tree : Project_Tree_Ref;
!       Kind    : Spec_Or_Body);
     --  Prepare the internal hash tables used for checking naming exceptions
     --  for Ada. Insert all elements of List in the tables.
  
     function Project_Extends
       (Extending : Project_Id;
!       Extended  : Project_Id;
!       In_Tree   : Project_Tree_Ref) return Boolean;
     --  Returns True if Extending is extending Extended either directly or
     --  indirectly.
  
*************** package body Prj.Nmsc is
*** 306,311 ****
--- 332,338 ----
       (File_Name       : Name_Id;
        Path_Name       : Name_Id;
        Project         : Project_Id;
+       In_Tree         : Project_Tree_Ref;
        Data            : in out Project_Data;
        Location        : Source_Ptr;
        Current_Source  : in out String_List_Id;
*************** package body Prj.Nmsc is
*** 316,321 ****
--- 343,349 ----
  
     procedure Record_Other_Sources
       (Project           : Project_Id;
+       In_Tree           : Project_Tree_Ref;
        Data              : in out Project_Data;
        Language          : Language_Index;
        Naming_Exceptions : Boolean);
*************** package body Prj.Nmsc is
*** 323,339 ****
     --  When Naming_Exceptions is True, mark the found sources as such, to
     --  later remove those that are not named in a list of sources.
  
!    procedure Show_Source_Dirs (Project : Project_Id);
     --  List all the source directories of a project
  
     function Suffix_For
       (Language : Language_Index;
!       Naming   : Naming_Data) return Name_Id;
     --  Get the suffix for the source of a language from a package naming.
     --  If not specified, return the default for the language.
  
     procedure Warn_If_Not_Sources
       (Project     : Project_Id;
        Conventions : Array_Element_Id;
        Specs       : Boolean;
        Extending   : Boolean);
--- 351,370 ----
     --  When Naming_Exceptions is True, mark the found sources as such, to
     --  later remove those that are not named in a list of sources.
  
!    procedure Show_Source_Dirs
!      (Project : Project_Id; In_Tree : Project_Tree_Ref);
     --  List all the source directories of a project
  
     function Suffix_For
       (Language : Language_Index;
!       Naming   : Naming_Data;
!       In_Tree  : Project_Tree_Ref) return Name_Id;
     --  Get the suffix for the source of a language from a package naming.
     --  If not specified, return the default for the language.
  
     procedure Warn_If_Not_Sources
       (Project     : Project_Id;
+       In_Tree     : Project_Tree_Ref;
        Conventions : Array_Element_Id;
        Specs       : Boolean;
        Extending   : Boolean);
*************** package body Prj.Nmsc is
*** 367,378 ****
  
     procedure Check
       (Project      : Project_Id;
        Report_Error : Put_Line_Access;
        Follow_Links : Boolean)
     is
!       Data         : Project_Data := Projects.Table (Project);
! 
!       Extending    : Boolean := False;
  
     begin
        Error_Report := Report_Error;
--- 398,409 ----
  
     procedure Check
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Report_Error : Put_Line_Access;
        Follow_Links : Boolean)
     is
!       Data      : Project_Data := In_Tree.Projects.Table (Project);
!       Extending : Boolean := False;
  
     begin
        Error_Report := Report_Error;
*************** package body Prj.Nmsc is
*** 381,415 ****
  
        --  Object, exec and source directories
  
!       Get_Directories (Project, Data);
  
        --  Get the programming languages
  
!       Check_Programming_Languages (Data);
  
        --  Library attributes
  
!       Check_Library_Attributes (Project, Data);
  
!       Check_If_Externally_Built (Project, Data);
  
        if Current_Verbosity = High then
!          Show_Source_Dirs (Project);
        end if;
  
!       Check_Package_Naming (Project, Data);
  
        Extending := Data.Extends /= No_Project;
  
!       Check_Naming_Scheme (Data, Project);
  
!       Prepare_Ada_Naming_Exceptions (Data.Naming.Bodies, Body_Part);
!       Prepare_Ada_Naming_Exceptions (Data.Naming.Specs,  Specification);
  
        --  Find the sources
  
        if Data.Source_Dirs /= Nil_String then
!          Look_For_Sources (Project, Data, Follow_Links);
        end if;
  
        if Data.Ada_Sources_Present then
--- 412,448 ----
  
        --  Object, exec and source directories
  
!       Get_Directories (Project, In_Tree, Data);
  
        --  Get the programming languages
  
!       Check_Programming_Languages (In_Tree, Data);
  
        --  Library attributes
  
!       Check_Library_Attributes (Project, In_Tree, Data);
  
!       Check_If_Externally_Built (Project, In_Tree, Data);
  
        if Current_Verbosity = High then
!          Show_Source_Dirs (Project, In_Tree);
        end if;
  
!       Check_Package_Naming (Project, In_Tree, Data);
  
        Extending := Data.Extends /= No_Project;
  
!       Check_Naming_Scheme (Data, Project, In_Tree);
  
!       Prepare_Ada_Naming_Exceptions
!         (Data.Naming.Bodies, In_Tree, Body_Part);
!       Prepare_Ada_Naming_Exceptions
!         (Data.Naming.Specs, In_Tree, Specification);
  
        --  Find the sources
  
        if Data.Source_Dirs /= Nil_String then
!          Look_For_Sources (Project, In_Tree, Data, Follow_Links);
        end if;
  
        if Data.Ada_Sources_Present then
*************** package body Prj.Nmsc is
*** 418,446 ****
           --  this project file.
  
           Warn_If_Not_Sources
!            (Project, Data.Naming.Bodies,
              Specs     => False,
              Extending => Extending);
           Warn_If_Not_Sources
!            (Project, Data.Naming.Specs,
              Specs     => True,
              Extending => Extending);
        end if;
  
- 
        --  If it is a library project file, check if it is a standalone library
  
        if Data.Library then
!          Check_Stand_Alone_Library (Project, Data, Extending);
        end if;
  
        --  Put the list of Mains, if any, in the project data
  
!       Get_Mains (Project, Data);
  
        --  Update the project data in the Projects table
  
!       Projects.Table (Project) := Data;
  
        Free_Ada_Naming_Exceptions;
     end Check;
--- 451,478 ----
           --  this project file.
  
           Warn_If_Not_Sources
!            (Project, In_Tree, Data.Naming.Bodies,
              Specs     => False,
              Extending => Extending);
           Warn_If_Not_Sources
!            (Project, In_Tree, Data.Naming.Specs,
              Specs     => True,
              Extending => Extending);
        end if;
  
        --  If it is a library project file, check if it is a standalone library
  
        if Data.Library then
!          Check_Stand_Alone_Library (Project, In_Tree, Data, Extending);
        end if;
  
        --  Put the list of Mains, if any, in the project data
  
!       Get_Mains (Project, In_Tree, Data);
  
        --  Update the project data in the Projects table
  
!       In_Tree.Projects.Table (Project) := Data;
  
        Free_Ada_Naming_Exceptions;
     end Check;
*************** package body Prj.Nmsc is
*** 449,458 ****
     -- Check_Ada_Name --
     --------------------
  
!    procedure Check_Ada_Name
!      (Name : String;
!       Unit : out Name_Id)
!    is
        The_Name        : String := Name;
        Real_Name       : Name_Id;
        Need_Letter     : Boolean := True;
--- 481,487 ----
     -- Check_Ada_Name --
     --------------------
  
!    procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
        The_Name        : String := Name;
        Real_Name       : Name_Id;
        Need_Letter     : Boolean := True;
*************** package body Prj.Nmsc is
*** 571,582 ****
  
     procedure Check_Ada_Naming_Scheme_Validity
       (Project : Project_Id;
        Naming  : Naming_Data)
     is
     begin
!       --  Only check if we are not using the standard naming scheme
  
!       if Naming /= Standard_Naming_Data then
           declare
              Dot_Replacement       : constant String :=
                                       Get_Name_String
--- 600,612 ----
  
     procedure Check_Ada_Naming_Scheme_Validity
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Naming  : Naming_Data)
     is
     begin
!       --  Only check if we are not using the Default naming scheme
  
!       if Naming /= In_Tree.Private_Part.Default_Naming then
           declare
              Dot_Replacement       : constant String :=
                                       Get_Name_String
*************** package body Prj.Nmsc is
*** 619,625 ****
                                    Pattern => ".") /= 0)
              then
                 Error_Msg
!                  (Project,
                    '"' & Dot_Replacement &
                    """ is illegal for Dot_Replacement.",
                    Naming.Dot_Repl_Loc);
--- 649,655 ----
                                    Pattern => ".") /= 0)
              then
                 Error_Msg
!                  (Project, In_Tree,
                    '"' & Dot_Replacement &
                    """ is illegal for Dot_Replacement.",
                    Naming.Dot_Repl_Loc);
*************** package body Prj.Nmsc is
*** 633,639 ****
              then
                 Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix;
                 Error_Msg
!                  (Project,
                    "{ is illegal for Spec_Suffix",
                    Naming.Spec_Suffix_Loc);
              end if;
--- 663,669 ----
              then
                 Err_Vars.Error_Msg_Name_1 := Naming.Ada_Spec_Suffix;
                 Error_Msg
!                  (Project, In_Tree,
                    "{ is illegal for Spec_Suffix",
                    Naming.Spec_Suffix_Loc);
              end if;
*************** package body Prj.Nmsc is
*** 643,649 ****
              then
                 Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix;
                 Error_Msg
!                  (Project,
                    "{ is illegal for Body_Suffix",
                    Naming.Body_Suffix_Loc);
              end if;
--- 673,679 ----
              then
                 Err_Vars.Error_Msg_Name_1 := Naming.Ada_Body_Suffix;
                 Error_Msg
!                  (Project, In_Tree,
                    "{ is illegal for Body_Suffix",
                    Naming.Body_Suffix_Loc);
              end if;
*************** package body Prj.Nmsc is
*** 654,660 ****
                 then
                    Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix;
                    Error_Msg
!                     (Project,
                       "{ is illegal for Separate_Suffix",
                       Naming.Sep_Suffix_Loc);
                 end if;
--- 684,690 ----
                 then
                    Err_Vars.Error_Msg_Name_1 := Naming.Separate_Suffix;
                    Error_Msg
!                     (Project, In_Tree,
                       "{ is illegal for Separate_Suffix",
                       Naming.Sep_Suffix_Loc);
                 end if;
*************** package body Prj.Nmsc is
*** 670,676 ****
                               Body_Suffix'Last) = Spec_Suffix
              then
                 Error_Msg
!                  (Project,
                    "Body_Suffix (""" &
                    Body_Suffix &
                    """) cannot end with" &
--- 700,706 ----
                               Body_Suffix'Last) = Spec_Suffix
              then
                 Error_Msg
!                  (Project, In_Tree,
                    "Body_Suffix (""" &
                    Body_Suffix &
                    """) cannot end with" &
*************** package body Prj.Nmsc is
*** 688,694 ****
                     Separate_Suffix'Last) = Spec_Suffix
              then
                 Error_Msg
!                  (Project,
                    "Separate_Suffix (""" &
                    Separate_Suffix &
                    """) cannot end with" &
--- 718,724 ----
                     Separate_Suffix'Last) = Spec_Suffix
              then
                 Error_Msg
!                  (Project, In_Tree,
                    "Separate_Suffix (""" &
                    Separate_Suffix &
                    """) cannot end with" &
*************** package body Prj.Nmsc is
*** 708,713 ****
--- 738,744 ----
       (File_Name        : Name_Id;
        Path_Name        : Name_Id;
        Project          : Project_Id;
+       In_Tree          : Project_Tree_Ref;
        Data             : in out Project_Data;
        Location         : Source_Ptr;
        Language         : Language_Index;
*************** package body Prj.Nmsc is
*** 842,849 ****
              --  directories.
  
              while Source_Id /= No_Other_Source loop
!                Source := Other_Sources.Table (Source_Id);
!                Source_Id := Source.Next;
  
                 if Source.File_Name = File_Id then
  
--- 873,879 ----
              --  directories.
  
              while Source_Id /= No_Other_Source loop
!                Source := In_Tree.Other_Sources.Table (Source_Id);
  
                 if Source.File_Name = File_Id then
  
*************** package body Prj.Nmsc is
*** 853,859 ****
                    if Source.Language /= Language then
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg
!                        (Project,
                          "{ cannot be a source of several languages",
                          Real_Location);
                       return;
--- 883,889 ----
                    if Source.Language /= Language then
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg
!                        (Project, In_Tree,
                          "{ cannot be a source of several languages",
                          Real_Location);
                       return;
*************** package body Prj.Nmsc is
*** 867,874 ****
                       --  naming exception.
  
                       if not Naming_Exception then
!                         Other_Sources.Table (Source_Id).Naming_Exception :=
!                           False;
                       end if;
  
                       return;
--- 897,904 ----
                       --  naming exception.
  
                       if not Naming_Exception then
!                         In_Tree.Other_Sources.Table
!                           (Source_Id).Naming_Exception := False;
                       end if;
  
                       return;
*************** package body Prj.Nmsc is
*** 887,893 ****
                    else
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg
!                        (Project,
                          "{ is found in several source directories",
                          Real_Location);
                       return;
--- 917,923 ----
                    else
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is found in several source directories",
                          Real_Location);
                       return;
*************** package body Prj.Nmsc is
*** 901,911 ****
                    Error_Msg_Name_2 := Source.File_Name;
                    Error_Msg_Name_3 := Obj_Id;
                    Error_Msg
!                        (Project,
                          "{ and { have the same object file {",
                          Real_Location);
                       return;
                 end if;
              end loop;
  
              if Current_Verbosity = High then
--- 931,943 ----
                    Error_Msg_Name_2 := Source.File_Name;
                    Error_Msg_Name_3 := Obj_Id;
                    Error_Msg
!                        (Project, In_Tree,
                          "{ and { have the same object file {",
                          Real_Location);
                       return;
                 end if;
+ 
+                Source_Id := Source.Next;
              end loop;
  
              if Current_Verbosity = High then
*************** package body Prj.Nmsc is
*** 936,943 ****
  
              --  And add it to the Other_Sources table
  
!             Other_Sources.Increment_Last;
!             Other_Sources.Table (Other_Sources.Last) := Source;
  
              --  There are sources of languages other than Ada in this project
  
--- 968,978 ----
  
              --  And add it to the Other_Sources table
  
!             Other_Source_Table.Increment_Last
!               (In_Tree.Other_Sources);
!             In_Tree.Other_Sources.Table
!               (Other_Source_Table.Last (In_Tree.Other_Sources)) :=
!                  Source;
  
              --  There are sources of languages other than Ada in this project
  
*************** package body Prj.Nmsc is
*** 945,964 ****
  
              --  And there are sources of this language in this project
  
!             Set (Language, True, Data);
  
              --  Add this source to the list of sources of languages other than
              --  Ada of the project.
  
              if Data.First_Other_Source = No_Other_Source then
!                Data.First_Other_Source := Other_Sources.Last;
  
              else
!                Other_Sources.Table (Data.Last_Other_Source).Next :=
!                  Other_Sources.Last;
              end if;
  
!             Data.Last_Other_Source  := Other_Sources.Last;
           end;
        end if;
     end Check_For_Source;
--- 980,1001 ----
  
              --  And there are sources of this language in this project
  
!             Set (Language, True, Data, In_Tree);
  
              --  Add this source to the list of sources of languages other than
              --  Ada of the project.
  
              if Data.First_Other_Source = No_Other_Source then
!                Data.First_Other_Source :=
!                  Other_Source_Table.Last (In_Tree.Other_Sources);
  
              else
!                In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next :=
!                  Other_Source_Table.Last (In_Tree.Other_Sources);
              end if;
  
!             Data.Last_Other_Source :=
!               Other_Source_Table.Last (In_Tree.Other_Sources);
           end;
        end if;
     end Check_For_Source;
*************** package body Prj.Nmsc is
*** 968,978 ****
     -------------------------------
  
     procedure Check_If_Externally_Built
!      (Project : Project_Id; Data : in out Project_Data)
     is
        Externally_Built : constant Variable_Value :=
                             Util.Value_Of
!                              (Name_Externally_Built, Data.Decl.Attributes);
  
     begin
        if not Externally_Built.Default then
--- 1005,1018 ----
     -------------------------------
  
     procedure Check_If_Externally_Built
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data)
     is
        Externally_Built : constant Variable_Value :=
                             Util.Value_Of
!                             (Name_Externally_Built,
!                              Data.Decl.Attributes, In_Tree);
  
     begin
        if not Externally_Built.Default then
*************** package body Prj.Nmsc is
*** 983,989 ****
              Data.Externally_Built := True;
  
           elsif Name_Buffer (1 .. Name_Len) /= "false" then
!             Error_Msg (Project,
                         "Externally_Built may only be true or false",
                         Externally_Built.Location);
           end if;
--- 1023,1029 ----
              Data.Externally_Built := True;
  
           elsif Name_Buffer (1 .. Name_Len) /= "false" then
!             Error_Msg (Project, In_Tree,
                         "Externally_Built may only be true or false",
                         Externally_Built.Location);
           end if;
*************** package body Prj.Nmsc is
*** 1006,1015 ****
  
     procedure Check_Naming_Scheme
       (Data    : in out Project_Data;
!       Project : Project_Id)
     is
        Naming_Id : constant Package_Id :=
!                     Util.Value_Of (Name_Naming, Data.Decl.Packages);
  
        Naming : Package_Element;
  
--- 1046,1056 ----
  
     procedure Check_Naming_Scheme
       (Data    : in out Project_Data;
!       Project : Project_Id;
!       In_Tree : Project_Tree_Ref)
     is
        Naming_Id : constant Package_Id :=
!                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
  
        Naming : Package_Element;
  
*************** package body Prj.Nmsc is
*** 1029,1035 ****
           --  Loop through elements of the string list
  
           while Current /= No_Array_Element loop
!             Element := Array_Elements.Table (Current);
  
              --  Put file name in canonical case
  
--- 1070,1076 ----
           --  Loop through elements of the string list
  
           while Current /= No_Array_Element loop
!             Element := In_Tree.Array_Elements.Table (Current);
  
              --  Put file name in canonical case
  
*************** package body Prj.Nmsc is
*** 1045,1051 ****
              if Unit_Name = No_Name then
                 Err_Vars.Error_Msg_Name_1 := Element.Index;
                 Error_Msg
!                  (Project,
                    "{ is not a valid unit name.",
                    Element.Value.Location);
  
--- 1086,1092 ----
              if Unit_Name = No_Name then
                 Err_Vars.Error_Msg_Name_1 := Element.Index;
                 Error_Msg
!                  (Project, In_Tree,
                    "{ is not a valid unit name.",
                    Element.Value.Location);
  
*************** package body Prj.Nmsc is
*** 1057,1063 ****
                 end if;
  
                 Element.Index := Unit_Name;
!                Array_Elements.Table (Current) := Element;
              end if;
  
              Current := Element.Next;
--- 1098,1104 ----
                 end if;
  
                 Element.Index := Unit_Name;
!                In_Tree.Array_Elements.Table (Current) := Element;
              end if;
  
              Current := Element.Next;
*************** package body Prj.Nmsc is
*** 1071,1077 ****
        --  this package Naming.
  
        if Naming_Id /= No_Package then
!          Naming := Packages.Table (Naming_Id);
  
           if Current_Verbosity = High then
              Write_Line ("Checking ""Naming"" for Ada.");
--- 1112,1118 ----
        --  this package Naming.
  
        if Naming_Id /= No_Package then
!          Naming := In_Tree.Packages.Table (Naming_Id);
  
           if Current_Verbosity = High then
              Write_Line ("Checking ""Naming"" for Ada.");
*************** package body Prj.Nmsc is
*** 1079,1088 ****
  
           declare
              Bodies : constant Array_Element_Id :=
!                        Util.Value_Of (Name_Body, Naming.Decl.Arrays);
  
              Specs : constant Array_Element_Id :=
!                       Util.Value_Of (Name_Spec, Naming.Decl.Arrays);
  
           begin
              if Bodies /= No_Array_Element then
--- 1120,1129 ----
  
           declare
              Bodies : constant Array_Element_Id :=
!                        Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
  
              Specs : constant Array_Element_Id :=
!                       Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
  
           begin
              if Bodies /= No_Array_Element then
*************** package body Prj.Nmsc is
*** 1133,1139 ****
              Dot_Replacement : constant Variable_Value :=
                                  Util.Value_Of
                                    (Name_Dot_Replacement,
!                                    Naming.Decl.Attributes);
  
           begin
              pragma Assert (Dot_Replacement.Kind = Single,
--- 1174,1180 ----
              Dot_Replacement : constant Variable_Value :=
                                  Util.Value_Of
                                    (Name_Dot_Replacement,
!                                    Naming.Decl.Attributes, In_Tree);
  
           begin
              pragma Assert (Dot_Replacement.Kind = Single,
*************** package body Prj.Nmsc is
*** 1144,1150 ****
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project,
                       "Dot_Replacement cannot be empty",
                       Dot_Replacement.Location);
  
--- 1185,1191 ----
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project, In_Tree,
                       "Dot_Replacement cannot be empty",
                       Dot_Replacement.Location);
  
*************** package body Prj.Nmsc is
*** 1168,1174 ****
           declare
              Casing_String : constant Variable_Value :=
                                Util.Value_Of
!                                 (Name_Casing, Naming.Decl.Attributes);
  
           begin
              pragma Assert (Casing_String.Kind = Single,
--- 1209,1215 ----
           declare
              Casing_String : constant Variable_Value :=
                                Util.Value_Of
!                                 (Name_Casing, Naming.Decl.Attributes, In_Tree);
  
           begin
              pragma Assert (Casing_String.Kind = Single,
*************** package body Prj.Nmsc is
*** 1183,1204 ****
                       Casing_Value : constant Casing_Type :=
                                        Value (Casing_Image);
                    begin
!                      --  Ignore Casing on platforms where file names are
!                      --  case-insensitive.
! 
!                      if not File_Names_Case_Sensitive then
!                         Data.Naming.Casing := All_Lower_Case;
! 
!                      else
!                         Data.Naming.Casing := Casing_Value;
!                      end if;
                    end;
  
                 exception
                    when Constraint_Error =>
                       if Casing_Image'Length = 0 then
                          Error_Msg
!                           (Project,
                             "Casing cannot be an empty string",
                             Casing_String.Location);
  
--- 1224,1237 ----
                       Casing_Value : constant Casing_Type :=
                                        Value (Casing_Image);
                    begin
!                      Data.Naming.Casing := Casing_Value;
                    end;
  
                 exception
                    when Constraint_Error =>
                       if Casing_Image'Length = 0 then
                          Error_Msg
!                           (Project, In_Tree,
                             "Casing cannot be an empty string",
                             Casing_String.Location);
  
*************** package body Prj.Nmsc is
*** 1207,1213 ****
                          Name_Buffer (1 .. Name_Len) := Casing_Image;
                          Err_Vars.Error_Msg_Name_1 := Name_Find;
                          Error_Msg
!                           (Project,
                             "{ is not a correct Casing",
                             Casing_String.Location);
                       end if;
--- 1240,1246 ----
                          Name_Buffer (1 .. Name_Len) := Casing_Image;
                          Err_Vars.Error_Msg_Name_1 := Name_Find;
                          Error_Msg
!                           (Project, In_Tree,
                             "{ is not a correct Casing",
                             Casing_String.Location);
                       end if;
*************** package body Prj.Nmsc is
*** 1229,1235 ****
                                  Prj.Util.Value_Of
                                    (Index     => Name_Ada,
                                     Src_Index => 0,
!                                    In_Array  => Data.Naming.Spec_Suffix);
  
           begin
              if Ada_Spec_Suffix.Kind = Single
--- 1262,1269 ----
                                  Prj.Util.Value_Of
                                    (Index     => Name_Ada,
                                     Src_Index => 0,
!                                    In_Array  => Data.Naming.Spec_Suffix,
!                                    In_Tree   => In_Tree);
  
           begin
              if Ada_Spec_Suffix.Kind = Single
*************** package body Prj.Nmsc is
*** 1259,1265 ****
                Prj.Util.Value_Of
                  (Index     => Name_Ada,
                   Src_Index => 0,
!                  In_Array  => Data.Naming.Body_Suffix);
  
           begin
              if Ada_Body_Suffix.Kind = Single
--- 1293,1300 ----
                Prj.Util.Value_Of
                  (Index     => Name_Ada,
                   Src_Index => 0,
!                  In_Array  => Data.Naming.Body_Suffix,
!                  In_Tree   => In_Tree);
  
           begin
              if Ada_Body_Suffix.Kind = Single
*************** package body Prj.Nmsc is
*** 1288,1294 ****
              Ada_Sep_Suffix : constant Variable_Value :=
                                 Prj.Util.Value_Of
                                   (Variable_Name => Name_Separate_Suffix,
!                                   In_Variables  => Naming.Decl.Attributes);
  
           begin
              if Ada_Sep_Suffix.Default then
--- 1323,1330 ----
              Ada_Sep_Suffix : constant Variable_Value :=
                                 Prj.Util.Value_Of
                                   (Variable_Name => Name_Separate_Suffix,
!                                   In_Variables  => Naming.Decl.Attributes,
!                                   In_Tree       => In_Tree);
  
           begin
              if Ada_Sep_Suffix.Default then
*************** package body Prj.Nmsc is
*** 1300,1306 ****
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project,
                       "Separate_Suffix cannot be empty",
                       Ada_Sep_Suffix.Location);
  
--- 1336,1342 ----
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project, In_Tree,
                       "Separate_Suffix cannot be empty",
                       Ada_Sep_Suffix.Location);
  
*************** package body Prj.Nmsc is
*** 1321,1327 ****
  
           --  Check if Data.Naming is valid
  
!          Check_Ada_Naming_Scheme_Validity (Project, Data.Naming);
  
        else
           Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
--- 1357,1363 ----
  
           --  Check if Data.Naming is valid
  
!          Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
  
        else
           Data.Naming.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
*************** package body Prj.Nmsc is
*** 1335,1357 ****
     ------------------------------
  
     procedure Check_Library_Attributes
!      (Project : Project_Id; Data : in out Project_Data)
     is
        Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
  
        Lib_Dir : constant Prj.Variable_Value :=
!                   Prj.Util.Value_Of (Snames.Name_Library_Dir, Attributes);
  
        Lib_Name : constant Prj.Variable_Value :=
!                    Prj.Util.Value_Of (Snames.Name_Library_Name, Attributes);
  
        Lib_Version : constant Prj.Variable_Value :=
                        Prj.Util.Value_Of
!                         (Snames.Name_Library_Version, Attributes);
  
        The_Lib_Kind : constant Prj.Variable_Value :=
                         Prj.Util.Value_Of
!                          (Snames.Name_Library_Kind, Attributes);
  
     begin
        --  Special case of extending project
--- 1371,1401 ----
     ------------------------------
  
     procedure Check_Library_Attributes
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data)
     is
        Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
  
        Lib_Dir : constant Prj.Variable_Value :=
!                   Prj.Util.Value_Of
!                     (Snames.Name_Library_Dir, Attributes, In_Tree);
  
        Lib_Name : constant Prj.Variable_Value :=
!                    Prj.Util.Value_Of
!                      (Snames.Name_Library_Name, Attributes, In_Tree);
  
        Lib_Version : constant Prj.Variable_Value :=
                        Prj.Util.Value_Of
!                         (Snames.Name_Library_Version, Attributes, In_Tree);
! 
!       Lib_ALI_Dir : constant Prj.Variable_Value :=
!                       Prj.Util.Value_Of
!                         (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
  
        The_Lib_Kind : constant Prj.Variable_Value :=
                         Prj.Util.Value_Of
!                          (Snames.Name_Library_Kind, Attributes, In_Tree);
  
     begin
        --  Special case of extending project
*************** package body Prj.Nmsc is
*** 1359,1365 ****
        if Data.Extends /= No_Project then
           declare
              Extended_Data : constant Project_Data :=
!                               Projects.Table (Data.Extends);
  
           begin
              --  If the project extended is a library project, we inherit
--- 1403,1409 ----
        if Data.Extends /= No_Project then
           declare
              Extended_Data : constant Project_Data :=
!                            In_Tree.Projects.Table (Data.Extends);
  
           begin
              --  If the project extended is a library project, we inherit
*************** package body Prj.Nmsc is
*** 1375,1388 ****
                 if Lib_Dir.Default then
                    if not Data.Virtual then
                       Error_Msg
!                        (Project,
                          "a project extending a library project must " &
                          "specify an attribute Library_Dir",
                          Data.Location);
                    end if;
                 end if;
  
!                Projects.Table (Data.Extends).Library := False;
              end if;
           end;
        end if;
--- 1419,1433 ----
                 if Lib_Dir.Default then
                    if not Data.Virtual then
                       Error_Msg
!                        (Project, In_Tree,
                          "a project extending a library project must " &
                          "specify an attribute Library_Dir",
                          Data.Location);
                    end if;
                 end if;
  
!                In_Tree.Projects.Table (Data.Extends).Library :=
!                  False;
              end if;
           end;
        end if;
*************** package body Prj.Nmsc is
*** 1431,1460 ****
                 --  Report the error
  
                 Error_Msg
!                  (Project,
                    "library directory { does not exist",
                    Lib_Dir.Location);
              end;
  
!          --  comment ???
  
           elsif Data.Library_Dir = Data.Object_Directory then
              Error_Msg
!               (Project,
                 "library directory cannot be the same " &
                 "as object directory",
                 Lib_Dir.Location);
              Data.Library_Dir := No_Name;
              Data.Display_Library_Dir := No_Name;
  
-          --  comment ???
- 
           else
!             if Current_Verbosity = High then
!                Write_Str ("Library directory =""");
!                Write_Str (Get_Name_String (Data.Display_Library_Dir));
!                Write_Line ("""");
!             end if;
           end if;
        end if;
  
--- 1476,1569 ----
                 --  Report the error
  
                 Error_Msg
!                  (Project, In_Tree,
                    "library directory { does not exist",
                    Lib_Dir.Location);
              end;
  
!          --  The library directory cannot be the same as the Object directory
  
           elsif Data.Library_Dir = Data.Object_Directory then
              Error_Msg
!               (Project, In_Tree,
                 "library directory cannot be the same " &
                 "as object directory",
                 Lib_Dir.Location);
              Data.Library_Dir := No_Name;
              Data.Display_Library_Dir := No_Name;
  
           else
!             declare
!                OK       : Boolean := True;
!                Dirs_Id  : String_List_Id;
!                Dir_Elem : String_Element;
! 
!             begin
!                --  The library directory cannot be the same as a source
!                --  directory of the current project.
! 
!                Dirs_Id := Data.Source_Dirs;
!                while Dirs_Id /= Nil_String loop
!                   Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
!                   Dirs_Id  := Dir_Elem.Next;
! 
!                   if Data.Library_Dir = Dir_Elem.Value then
!                      Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
!                      Error_Msg
!                        (Project, In_Tree,
!                         "library directory cannot be the same " &
!                         "as source directory {",
!                         Lib_Dir.Location);
!                      OK := False;
!                      exit;
!                   end if;
!                end loop;
! 
!                if OK then
! 
!                   --  The library directory cannot be the same as a source
!                   --  directory of another project either.
! 
!                   Project_Loop :
!                   for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
!                      if Pid /= Project then
!                         Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
! 
!                         Dir_Loop : while Dirs_Id /= Nil_String loop
!                            Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
!                            Dirs_Id  := Dir_Elem.Next;
! 
!                            if Data.Library_Dir = Dir_Elem.Value then
!                               Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
!                               Err_Vars.Error_Msg_Name_2 :=
!                                 In_Tree.Projects.Table (Pid).Name;
! 
!                               Error_Msg
!                                 (Project, In_Tree,
!                                  "library directory cannot be the same " &
!                                  "as source directory { of project {",
!                                  Lib_Dir.Location);
!                               OK := False;
!                               exit Project_Loop;
!                            end if;
!                         end loop Dir_Loop;
!                      end if;
!                   end loop Project_Loop;
!                end if;
! 
!                if not OK then
!                   Data.Library_Dir := No_Name;
!                   Data.Display_Library_Dir := No_Name;
! 
!                elsif Current_Verbosity = High then
! 
!                   --  Display the Library directory in high verbosity
! 
!                   Write_Str ("Library directory =""");
!                   Write_Str (Get_Name_String (Data.Display_Library_Dir));
!                   Write_Line ("""");
!                end if;
!             end;
           end if;
        end if;
  
*************** package body Prj.Nmsc is
*** 1489,1500 ****
        if Data.Library then
           if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
              Error_Msg
!               (Project,
                 "?libraries are not supported on this platform",
                 Lib_Name.Location);
              Data.Library := False;
  
           else
              pragma Assert (Lib_Version.Kind = Single);
  
              if Lib_Version.Value = Empty_String then
--- 1598,1761 ----
        if Data.Library then
           if MLib.Tgt.Support_For_Libraries = MLib.Tgt.None then
              Error_Msg
!               (Project, In_Tree,
                 "?libraries are not supported on this platform",
                 Lib_Name.Location);
              Data.Library := False;
  
           else
+             if Lib_ALI_Dir.Value = Empty_String then
+                if Current_Verbosity = High then
+                   Write_Line ("No library 'A'L'I directory specified");
+                end if;
+                Data.Library_ALI_Dir := Data.Library_Dir;
+                Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
+ 
+             else
+                --  Find path name, check that it is a directory
+ 
+                Locate_Directory
+                  (Lib_ALI_Dir.Value, Data.Display_Directory,
+                   Data.Library_ALI_Dir, Data.Display_Library_ALI_Dir);
+ 
+                if Data.Library_ALI_Dir = No_Name then
+ 
+                   --  Get the absolute name of the library ALI directory that
+                   --  does not exist, to report an error.
+ 
+                   declare
+                      Dir_Name : constant String :=
+                                   Get_Name_String (Lib_ALI_Dir.Value);
+ 
+                   begin
+                      if Is_Absolute_Path (Dir_Name) then
+                         Err_Vars.Error_Msg_Name_1 := Lib_Dir.Value;
+ 
+                      else
+                         Get_Name_String (Data.Display_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
+ 
+                      Error_Msg
+                        (Project, In_Tree,
+                         "library 'A'L'I directory { does not exist",
+                         Lib_ALI_Dir.Location);
+                   end;
+                end if;
+ 
+                if Data.Library_ALI_Dir /= Data.Library_Dir then
+ 
+                   --  The library ALI directory cannot be the same as the
+                   --  Object directory.
+ 
+                   if Data.Library_ALI_Dir = Data.Object_Directory then
+                      Error_Msg
+                        (Project, In_Tree,
+                         "library 'A'L'I directory cannot be the same " &
+                         "as object directory",
+                         Lib_ALI_Dir.Location);
+                      Data.Library_ALI_Dir := No_Name;
+                      Data.Display_Library_ALI_Dir := No_Name;
+ 
+                   else
+                      declare
+                         OK       : Boolean := True;
+                         Dirs_Id  : String_List_Id;
+                         Dir_Elem : String_Element;
+ 
+                      begin
+                         --  The library ALI directory cannot be the same as
+                         --  a source directory of the current project.
+ 
+                         Dirs_Id := Data.Source_Dirs;
+                         while Dirs_Id /= Nil_String loop
+                            Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
+                            Dirs_Id  := Dir_Elem.Next;
+ 
+                            if Data.Library_ALI_Dir = Dir_Elem.Value then
+                               Err_Vars.Error_Msg_Name_1 := Dir_Elem.Value;
+                               Error_Msg
+                                 (Project, In_Tree,
+                                  "library 'A'L'I directory cannot be " &
+                                  "the same as source directory {",
+                                  Lib_ALI_Dir.Location);
+                               OK := False;
+                               exit;
+                            end if;
+                         end loop;
+ 
+                         if OK then
+ 
+                            --  The library ALI directory cannot be the same as
+                            --  a source directory of another project either.
+ 
+                            ALI_Project_Loop :
+                            for
+                              Pid in 1 .. Project_Table.Last (In_Tree.Projects)
+                            loop
+                               if Pid /= Project then
+                                  Dirs_Id :=
+                                    In_Tree.Projects.Table (Pid).Source_Dirs;
+ 
+                                  ALI_Dir_Loop :
+                                  while Dirs_Id /= Nil_String loop
+                                     Dir_Elem :=
+                                       In_Tree.String_Elements.Table (Dirs_Id);
+                                     Dirs_Id  := Dir_Elem.Next;
+ 
+                                     if
+                                       Data.Library_ALI_Dir = Dir_Elem.Value
+                                     then
+                                        Err_Vars.Error_Msg_Name_1 :=
+                                          Dir_Elem.Value;
+                                        Err_Vars.Error_Msg_Name_2 :=
+                                          In_Tree.Projects.Table (Pid).Name;
+ 
+                                        Error_Msg
+                                          (Project, In_Tree,
+                                           "library 'A'L'I directory cannot " &
+                                           "be the same as source directory " &
+                                           "{ of project {",
+                                           Lib_ALI_Dir.Location);
+                                        OK := False;
+                                        exit ALI_Project_Loop;
+                                     end if;
+                                  end loop ALI_Dir_Loop;
+                               end if;
+                            end loop ALI_Project_Loop;
+                         end if;
+ 
+                         if not OK then
+                            Data.Library_ALI_Dir := No_Name;
+                            Data.Display_Library_ALI_Dir := No_Name;
+ 
+                         elsif Current_Verbosity = High then
+ 
+                            --  Display the Library ALI directory in high
+                            --  verbosity.
+ 
+                            Write_Str ("Library ALI directory =""");
+                            Write_Str
+                              (Get_Name_String (Data.Display_Library_ALI_Dir));
+                            Write_Line ("""");
+                         end if;
+                      end;
+                   end if;
+                end if;
+             end if;
+ 
              pragma Assert (Lib_Version.Kind = Single);
  
              if Lib_Version.Value = Empty_String then
*************** package body Prj.Nmsc is
*** 1534,1540 ****
  
                    else
                       Error_Msg
!                        (Project,
                          "illegal value for Library_Kind",
                          The_Lib_Kind.Location);
                       OK := False;
--- 1795,1801 ----
  
                    else
                       Error_Msg
!                        (Project, In_Tree,
                          "illegal value for Library_Kind",
                          The_Lib_Kind.Location);
                       OK := False;
*************** package body Prj.Nmsc is
*** 1549,1555 ****
                      MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
                    then
                       Error_Msg
!                        (Project,
                          "only static libraries are supported " &
                          "on this platform",
                          The_Lib_Kind.Location);
--- 1810,1816 ----
                      MLib.Tgt.Support_For_Libraries = MLib.Tgt.Static_Only
                    then
                       Error_Msg
!                        (Project, In_Tree,
                          "only static libraries are supported " &
                          "on this platform",
                          The_Lib_Kind.Location);
*************** package body Prj.Nmsc is
*** 1571,1580 ****
     --------------------------
  
     procedure Check_Package_Naming
!      (Project : Project_Id; Data : in out Project_Data)
     is
        Naming_Id : constant Package_Id :=
!                     Util.Value_Of (Name_Naming, Data.Decl.Packages);
  
        Naming : Package_Element;
  
--- 1832,1843 ----
     --------------------------
  
     procedure Check_Package_Naming
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data)
     is
        Naming_Id : constant Package_Id :=
!                     Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
  
        Naming : Package_Element;
  
*************** package body Prj.Nmsc is
*** 1583,1589 ****
        --  what is in this package Naming.
  
        if Naming_Id /= No_Package then
!          Naming := Packages.Table (Naming_Id);
  
           if Current_Verbosity = High then
              Write_Line ("Checking ""Naming"".");
--- 1846,1852 ----
        --  what is in this package Naming.
  
        if Naming_Id /= No_Package then
!          Naming := In_Tree.Packages.Table (Naming_Id);
  
           if Current_Verbosity = High then
              Write_Line ("Checking ""Naming"".");
*************** package body Prj.Nmsc is
*** 1595,1601 ****
              Spec_Suffixs : Array_Element_Id :=
                               Util.Value_Of
                                 (Name_Spec_Suffix,
!                                 Naming.Decl.Arrays);
  
              Suffix  : Array_Element_Id;
              Element : Array_Element;
--- 1858,1865 ----
              Spec_Suffixs : Array_Element_Id :=
                               Util.Value_Of
                                 (Name_Spec_Suffix,
!                                 Naming.Decl.Arrays,
!                                 In_Tree);
  
              Suffix  : Array_Element_Id;
              Element : Array_Element;
*************** package body Prj.Nmsc is
*** 1611,1623 ****
                 Suffix := Data.Naming.Spec_Suffix;
  
                 while Suffix /= No_Array_Element loop
!                   Element := Array_Elements.Table (Suffix);
                    Suffix2 := Spec_Suffixs;
  
                    while Suffix2 /= No_Array_Element loop
!                      exit when Array_Elements.Table (Suffix2).Index =
!                        Element.Index;
!                      Suffix2 := Array_Elements.Table (Suffix2).Next;
                    end loop;
  
                    --  There is a registered default suffix, but no
--- 1875,1889 ----
                 Suffix := Data.Naming.Spec_Suffix;
  
                 while Suffix /= No_Array_Element loop
!                   Element :=
!                     In_Tree.Array_Elements.Table (Suffix);
                    Suffix2 := Spec_Suffixs;
  
                    while Suffix2 /= No_Array_Element loop
!                      exit when In_Tree.Array_Elements.Table
!                                 (Suffix2).Index = Element.Index;
!                      Suffix2 := In_Tree.Array_Elements.Table
!                                  (Suffix2).Next;
                    end loop;
  
                    --  There is a registered default suffix, but no
*************** package body Prj.Nmsc is
*** 1625,1638 ****
                    --  Add the default to the array.
  
                    if Suffix2 = No_Array_Element then
!                      Array_Elements.Increment_Last;
!                      Array_Elements.Table (Array_Elements.Last) :=
                         (Index                => Element.Index,
                          Src_Index            => Element.Src_Index,
                          Index_Case_Sensitive => False,
                          Value                => Element.Value,
                          Next                 => Spec_Suffixs);
!                      Spec_Suffixs := Array_Elements.Last;
                    end if;
  
                    Suffix := Element.Next;
--- 1891,1908 ----
                    --  Add the default to the array.
  
                    if Suffix2 = No_Array_Element then
!                      Array_Element_Table.Increment_Last
!                        (In_Tree.Array_Elements);
!                      In_Tree.Array_Elements.Table
!                        (Array_Element_Table.Last
!                           (In_Tree.Array_Elements)) :=
                         (Index                => Element.Index,
                          Src_Index            => Element.Src_Index,
                          Index_Case_Sensitive => False,
                          Value                => Element.Value,
                          Next                 => Spec_Suffixs);
!                      Spec_Suffixs := Array_Element_Table.Last
!                                        (In_Tree.Array_Elements);
                    end if;
  
                    Suffix := Element.Next;
*************** package body Prj.Nmsc is
*** 1650,1666 ****
  
           begin
              while Current /= No_Array_Element loop
!                Element := Array_Elements.Table (Current);
                 Get_Name_String (Element.Value.Value);
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project,
                       "Spec_Suffix cannot be empty",
                       Element.Value.Location);
                 end if;
  
!                Array_Elements.Table (Current) := Element;
                 Current := Element.Next;
              end loop;
           end;
--- 1920,1936 ----
  
           begin
              while Current /= No_Array_Element loop
!                Element := In_Tree.Array_Elements.Table (Current);
                 Get_Name_String (Element.Value.Value);
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project, In_Tree,
                       "Spec_Suffix cannot be empty",
                       Element.Value.Location);
                 end if;
  
!                In_Tree.Array_Elements.Table (Current) := Element;
                 Current := Element.Next;
              end loop;
           end;
*************** package body Prj.Nmsc is
*** 1671,1677 ****
              Impl_Suffixs : Array_Element_Id :=
                Util.Value_Of
                  (Name_Body_Suffix,
!                  Naming.Decl.Arrays);
  
              Suffix       : Array_Element_Id;
              Element      : Array_Element;
--- 1941,1948 ----
              Impl_Suffixs : Array_Element_Id :=
                Util.Value_Of
                  (Name_Body_Suffix,
!                  Naming.Decl.Arrays,
!                  In_Tree);
  
              Suffix       : Array_Element_Id;
              Element      : Array_Element;
*************** package body Prj.Nmsc is
*** 1687,1699 ****
                 Suffix := Data.Naming.Body_Suffix;
  
                 while Suffix /= No_Array_Element loop
!                   Element := Array_Elements.Table (Suffix);
                    Suffix2 := Impl_Suffixs;
  
                    while Suffix2 /= No_Array_Element loop
!                      exit when Array_Elements.Table (Suffix2).Index =
!                        Element.Index;
!                      Suffix2 := Array_Elements.Table (Suffix2).Next;
                    end loop;
  
                    --  There is a registered default suffix, but no suffix was
--- 1958,1972 ----
                 Suffix := Data.Naming.Body_Suffix;
  
                 while Suffix /= No_Array_Element loop
!                   Element :=
!                     In_Tree.Array_Elements.Table (Suffix);
                    Suffix2 := Impl_Suffixs;
  
                    while Suffix2 /= No_Array_Element loop
!                      exit when In_Tree.Array_Elements.Table
!                                 (Suffix2).Index = Element.Index;
!                      Suffix2 := In_Tree.Array_Elements.Table
!                                   (Suffix2).Next;
                    end loop;
  
                    --  There is a registered default suffix, but no suffix was
*************** package body Prj.Nmsc is
*** 1701,1714 ****
                    --  array.
  
                    if Suffix2 = No_Array_Element then
!                      Array_Elements.Increment_Last;
!                      Array_Elements.Table (Array_Elements.Last) :=
                         (Index                => Element.Index,
                          Src_Index            => Element.Src_Index,
                          Index_Case_Sensitive => False,
                          Value                => Element.Value,
                          Next                 => Impl_Suffixs);
!                      Impl_Suffixs := Array_Elements.Last;
                    end if;
  
                    Suffix := Element.Next;
--- 1974,1991 ----
                    --  array.
  
                    if Suffix2 = No_Array_Element then
!                      Array_Element_Table.Increment_Last
!                        (In_Tree.Array_Elements);
!                      In_Tree.Array_Elements.Table
!                        (Array_Element_Table.Last
!                           (In_Tree.Array_Elements)) :=
                         (Index                => Element.Index,
                          Src_Index            => Element.Src_Index,
                          Index_Case_Sensitive => False,
                          Value                => Element.Value,
                          Next                 => Impl_Suffixs);
!                      Impl_Suffixs := Array_Element_Table.Last
!                                        (In_Tree.Array_Elements);
                    end if;
  
                    Suffix := Element.Next;
*************** package body Prj.Nmsc is
*** 1726,1742 ****
  
           begin
              while Current /= No_Array_Element loop
!                Element := Array_Elements.Table (Current);
                 Get_Name_String (Element.Value.Value);
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project,
                       "Body_Suffix cannot be empty",
                       Element.Value.Location);
                 end if;
  
!                Array_Elements.Table (Current) := Element;
                 Current := Element.Next;
              end loop;
           end;
--- 2003,2019 ----
  
           begin
              while Current /= No_Array_Element loop
!                Element := In_Tree.Array_Elements.Table (Current);
                 Get_Name_String (Element.Value.Value);
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project, In_Tree,
                       "Body_Suffix cannot be empty",
                       Element.Value.Location);
                 end if;
  
!                In_Tree.Array_Elements.Table (Current) := Element;
                 Current := Element.Next;
              end loop;
           end;
*************** package body Prj.Nmsc is
*** 1746,1757 ****
           Data.Naming.Specification_Exceptions :=
             Util.Value_Of
               (Name_Specification_Exceptions,
!               In_Arrays => Naming.Decl.Arrays);
  
           Data.Naming.Implementation_Exceptions :=
             Util.Value_Of
               (Name_Implementation_Exceptions,
!               In_Arrays => Naming.Decl.Arrays);
        end if;
     end Check_Package_Naming;
  
--- 2023,2036 ----
           Data.Naming.Specification_Exceptions :=
             Util.Value_Of
               (Name_Specification_Exceptions,
!               In_Arrays => Naming.Decl.Arrays,
!               In_Tree   => In_Tree);
  
           Data.Naming.Implementation_Exceptions :=
             Util.Value_Of
               (Name_Implementation_Exceptions,
!               In_Arrays => Naming.Decl.Arrays,
!               In_Tree   => In_Tree);
        end if;
     end Check_Package_Naming;
  
*************** package body Prj.Nmsc is
*** 1759,1769 ****
     -- Check_Programming_Languages --
     ---------------------------------
  
!    procedure Check_Programming_Languages (Data : in out Project_Data) is
        Languages : Variable_Value := Nil_Variable_Value;
  
     begin
!       Languages := Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes);
        Data.Ada_Sources_Present   := Data.Source_Dirs /= Nil_String;
        Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
  
--- 2038,2052 ----
     -- Check_Programming_Languages --
     ---------------------------------
  
!    procedure Check_Programming_Languages
!      (In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data)
!    is
        Languages : Variable_Value := Nil_Variable_Value;
  
     begin
!       Languages :=
!         Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
        Data.Ada_Sources_Present   := Data.Source_Dirs /= Nil_String;
        Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
  
*************** package body Prj.Nmsc is
*** 1799,1805 ****
                 --  Languages, if any
  
                 while Current /= Nil_String loop
!                   Element := String_Elements.Table (Current);
                    Get_Name_String (Element.Value);
                    To_Lower (Name_Buffer (1 .. Name_Len));
                    Lang_Name := Name_Find;
--- 2082,2089 ----
                 --  Languages, if any
  
                 while Current /= Nil_String loop
!                   Element :=
!                     In_Tree.String_Elements.Table (Current);
                    Get_Name_String (Element.Value);
                    To_Lower (Name_Buffer (1 .. Name_Len));
                    Lang_Name := Name_Find;
*************** package body Prj.Nmsc is
*** 1810,1819 ****
                       Index := Last_Language_Index;
                    end if;
  
!                   Set (Index, True, Data);
                    Set (Language_Processing => Default_Language_Processing_Data,
                         For_Language        => Index,
!                        In_Project          => Data);
  
                    if Index = Ada_Language_Index then
                       Data.Ada_Sources_Present := True;
--- 2094,2104 ----
                       Index := Last_Language_Index;
                    end if;
  
!                   Set (Index, True, Data, In_Tree);
                    Set (Language_Processing => Default_Language_Processing_Data,
                         For_Language        => Index,
!                        In_Project          => Data,
!                        In_Tree             => In_Tree);
  
                    if Index = Ada_Language_Index then
                       Data.Ada_Sources_Present := True;
*************** package body Prj.Nmsc is
*** 1836,1841 ****
--- 2121,2127 ----
     function Check_Project
       (P            : Project_Id;
        Root_Project : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Extending    : Boolean) return Boolean
     is
     begin
*************** package body Prj.Nmsc is
*** 1844,1850 ****
  
        elsif Extending then
           declare
!             Data : Project_Data := Projects.Table (Root_Project);
  
           begin
              while Data.Extends /= No_Project loop
--- 2130,2136 ----
  
        elsif Extending then
           declare
!             Data : Project_Data := In_Tree.Projects.Table (Root_Project);
  
           begin
              while Data.Extends /= No_Project loop
*************** package body Prj.Nmsc is
*** 1852,1858 ****
                    return True;
                 end if;
  
!                Data := Projects.Table (Data.Extends);
              end loop;
           end;
        end if;
--- 2138,2144 ----
                    return True;
                 end if;
  
!                Data := In_Tree.Projects.Table (Data.Extends);
              end loop;
           end;
        end if;
*************** package body Prj.Nmsc is
*** 1866,1903 ****
  
     procedure Check_Stand_Alone_Library
       (Project   : Project_Id;
        Data      : in out Project_Data;
        Extending : Boolean)
     is
        Lib_Interfaces      : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Interface,
!                                  Data.Decl.Attributes);
  
        Lib_Auto_Init       : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Auto_Init,
!                                  Data.Decl.Attributes);
  
        Lib_Src_Dir         : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Src_Dir,
!                                  Data.Decl.Attributes);
  
        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.
--- 2152,2196 ----
  
     procedure Check_Stand_Alone_Library
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        Data      : in out Project_Data;
        Extending : Boolean)
     is
        Lib_Interfaces      : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Interface,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Lib_Auto_Init       : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Auto_Init,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Lib_Src_Dir         : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Src_Dir,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Lib_Symbol_File     : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Symbol_File,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Lib_Symbol_Policy   : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Symbol_Policy,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
                                Prj.Util.Value_Of
                                  (Snames.Name_Library_Reference_Symbol_File,
!                                  Data.Decl.Attributes,
!                                  In_Tree);
  
        Auto_Init_Supported : constant Boolean :=
                                MLib.Tgt.
*************** package body Prj.Nmsc is
*** 1939,1954 ****
                    Name_Buffer (1 .. Name_Len) := ALI;
                    ALI_Name_Id := Name_Find;
  
!                   String_Elements.Increment_Last;
!                   String_Elements.Table (String_Elements.Last) :=
                      (Value         => ALI_Name_Id,
                       Index         => 0,
                       Display_Value => ALI_Name_Id,
!                      Location      => String_Elements.Table
!                        (Interfaces).Location,
                       Flag          => False,
                       Next          => Interface_ALIs);
!                   Interface_ALIs := String_Elements.Last;
                 end;
              end Add_ALI_For;
  
--- 2232,2252 ----
                    Name_Buffer (1 .. Name_Len) := ALI;
                    ALI_Name_Id := Name_Find;
  
!                   String_Element_Table.Increment_Last
!                     (In_Tree.String_Elements);
!                   In_Tree.String_Elements.Table
!                     (String_Element_Table.Last
!                       (In_Tree.String_Elements)) :=
                      (Value         => ALI_Name_Id,
                       Index         => 0,
                       Display_Value => ALI_Name_Id,
!                      Location      =>
!                        In_Tree.String_Elements.Table
!                          (Interfaces).Location,
                       Flag          => False,
                       Next          => Interface_ALIs);
!                   Interface_ALIs := String_Element_Table.Last
!                                       (In_Tree.String_Elements);
                 end;
              end Add_ALI_For;
  
*************** package body Prj.Nmsc is
*** 1961,1967 ****
  
              if Interfaces = Nil_String then
                 Error_Msg
!                  (Project,
                    "Library_Interface cannot be an empty list",
                    Lib_Interfaces.Location);
              end if;
--- 2259,2265 ----
  
              if Interfaces = Nil_String then
                 Error_Msg
!                  (Project, In_Tree,
                    "Library_Interface cannot be an empty list",
                    Lib_Interfaces.Location);
              end if;
*************** package body Prj.Nmsc is
*** 1971,2009 ****
  
              while Interfaces /= Nil_String loop
                 Get_Name_String
!                  (String_Elements.Table (Interfaces).Value);
                 To_Lower (Name_Buffer (1 .. Name_Len));
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project,
                       "an interface cannot be an empty string",
!                      String_Elements.Table (Interfaces).Location);
  
                 else
                    Unit := Name_Find;
                    Error_Msg_Name_1 := Unit;
!                   The_Unit_Id := Units_Htable.Get (Unit);
  
!                   if The_Unit_Id = Prj.Com.No_Unit then
                       Error_Msg
!                        (Project,
                          "unknown unit {",
!                         String_Elements.Table (Interfaces).Location);
  
                    else
                       --  Check that the unit is part of the project
  
!                      The_Unit_Data := Units.Table (The_Unit_Id);
  
!                      if The_Unit_Data.File_Names
!                        (Com.Body_Part).Name /= No_Name
!                        and then The_Unit_Data.File_Names
!                          (Com.Body_Part).Path /= Slash
                       then
                          if Check_Project
                            (The_Unit_Data.File_Names (Body_Part).Project,
!                            Project, Extending)
                          then
                             --  There is a body for this unit.
                             --  If there is no spec, we need to check
--- 2269,2311 ----
  
              while Interfaces /= Nil_String loop
                 Get_Name_String
!                  (In_Tree.String_Elements.Table
!                                                      (Interfaces).Value);
                 To_Lower (Name_Buffer (1 .. Name_Len));
  
                 if Name_Len = 0 then
                    Error_Msg
!                     (Project, In_Tree,
                       "an interface cannot be an empty string",
!                      In_Tree.String_Elements.Table
!                                                    (Interfaces).Location);
  
                 else
                    Unit := Name_Find;
                    Error_Msg_Name_1 := Unit;
!                   The_Unit_Id :=
!                     Units_Htable.Get (In_Tree.Units_HT, Unit);
  
!                   if The_Unit_Id = No_Unit then
                       Error_Msg
!                        (Project, In_Tree,
                          "unknown unit {",
!                         In_Tree.String_Elements.Table
!                           (Interfaces).Location);
  
                    else
                       --  Check that the unit is part of the project
  
!                      The_Unit_Data :=
!                        In_Tree.Units.Table (The_Unit_Id);
  
!                      if The_Unit_Data.File_Names (Body_Part).Name /= No_Name
!                        and then The_Unit_Data.File_Names (Body_Part).Path /=
!                                                                         Slash
                       then
                          if Check_Project
                            (The_Unit_Data.File_Names (Body_Part).Project,
!                            Project, In_Tree, Extending)
                          then
                             --  There is a body for this unit.
                             --  If there is no spec, we need to check
*************** package body Prj.Nmsc is
*** 2025,2035 ****
                                     (Src_Ind)
                                   then
                                      Error_Msg
!                                       (Project,
                                         "{ is a subunit; " &
                                         "it cannot be an interface",
!                                        String_Elements.Table
!                                          (Interfaces).Location);
                                   end if;
                                end;
                             end if;
--- 2327,2338 ----
                                     (Src_Ind)
                                   then
                                      Error_Msg
!                                       (Project, In_Tree,
                                         "{ is a subunit; " &
                                         "it cannot be an interface",
!                                        In_Tree.
!                                          String_Elements.Table
!                                            (Interfaces).Location);
                                   end if;
                                end;
                             end if;
*************** package body Prj.Nmsc is
*** 2043,2062 ****
  
                          else
                             Error_Msg
!                              (Project,
                                "{ is not an unit of this project",
!                               String_Elements.Table
                                  (Interfaces).Location);
                          end if;
  
                       elsif The_Unit_Data.File_Names
!                        (Com.Specification).Name /= No_Name
                         and then The_Unit_Data.File_Names
!                          (Com.Specification).Path /= Slash
                         and then Check_Project
                           (The_Unit_Data.File_Names
                                (Specification).Project,
!                           Project, Extending)
  
                       then
                          --  The unit is part of the project, it has
--- 2346,2365 ----
  
                          else
                             Error_Msg
!                              (Project, In_Tree,
                                "{ is not an unit of this project",
!                               In_Tree.String_Elements.Table
                                  (Interfaces).Location);
                          end if;
  
                       elsif The_Unit_Data.File_Names
!                        (Specification).Name /= No_Name
                         and then The_Unit_Data.File_Names
!                          (Specification).Path /= Slash
                         and then Check_Project
                           (The_Unit_Data.File_Names
                                (Specification).Project,
!                           Project, In_Tree, Extending)
  
                       then
                          --  The unit is part of the project, it has
*************** package body Prj.Nmsc is
*** 2068,2082 ****
  
                       else
                          Error_Msg
!                           (Project,
                             "{ is not an unit of this project",
!                            String_Elements.Table (Interfaces).Location);
                       end if;
                    end if;
  
                 end if;
  
!                Interfaces := String_Elements.Table (Interfaces).Next;
              end loop;
  
              --  Put the list of Interface ALIs in the project data
--- 2371,2387 ----
  
                       else
                          Error_Msg
!                           (Project, In_Tree,
                             "{ is not an unit of this project",
!                            In_Tree.String_Elements.Table
!                                                     (Interfaces).Location);
                       end if;
                    end if;
  
                 end if;
  
!                Interfaces :=
!                  In_Tree.String_Elements.Table (Interfaces).Next;
              end loop;
  
              --  Put the list of Interface ALIs in the project data
*************** package body Prj.Nmsc is
*** 2109,2115 ****
                       --  is not supported
  
                       Error_Msg
!                        (Project,
                          "library auto init not supported " &
                          "on this platform",
                          Lib_Auto_Init.Location);
--- 2414,2420 ----
                       --  is not supported
  
                       Error_Msg
!                        (Project, In_Tree,
                          "library auto init not supported " &
                          "on this platform",
                          Lib_Auto_Init.Location);
*************** package body Prj.Nmsc is
*** 2117,2123 ****
  
                 else
                    Error_Msg
!                     (Project,
                       "invalid value for attribute Library_Auto_Init",
                       Lib_Auto_Init.Location);
                 end if;
--- 2422,2428 ----
  
                 else
                    Error_Msg
!                     (Project, In_Tree,
                       "invalid value for attribute Library_Auto_Init",
                       Lib_Auto_Init.Location);
                 end if;
*************** package body Prj.Nmsc is
*** 2178,2184 ****
                       --  Report the error
  
                       Error_Msg
!                        (Project,
                          "Directory { does not exist",
                          Lib_Src_Dir.Location);
                    end;
--- 2483,2489 ----
                       --  Report the error
  
                       Error_Msg
!                        (Project, In_Tree,
                          "Directory { does not exist",
                          Lib_Src_Dir.Location);
                    end;
*************** package body Prj.Nmsc is
*** 2188,2238 ****
  
                 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;
  
-                   --  Check if it is 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 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;
  
!                   --  pages of code follow here with no comments at all ???
  
                    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_Policy.Default then
              declare
                 Value : constant String :=
--- 2493,2588 ----
  
                 elsif Data.Library_Src_Dir = Data.Object_Directory then
                    Error_Msg
!                     (Project, In_Tree,
                       "directory to copy interfaces cannot be " &
                       "the object directory",
                       Lib_Src_Dir.Location);
                    Data.Library_Src_Dir := No_Name;
  
                 else
                    declare
!                      Src_Dirs : String_List_Id;
                       Src_Dir  : String_Element;
  
                    begin
+                      --  Interface copy directory cannot be one of the source
+                      --  directory of the current project.
+ 
+                      Src_Dirs := Data.Source_Dirs;
                       while Src_Dirs /= Nil_String loop
!                         Src_Dir := In_Tree.String_Elements.Table
!                                                           (Src_Dirs);
  
                          --  Report error if it is one of the source directories
  
                          if Data.Library_Src_Dir = Src_Dir.Value then
                             Error_Msg
!                              (Project, In_Tree,
                                "directory to copy interfaces cannot " &
                                "be one of the source directories",
                                Lib_Src_Dir.Location);
                             Data.Library_Src_Dir := No_Name;
                             exit;
                          end if;
+ 
+                         Src_Dirs := Src_Dir.Next;
                       end loop;
+ 
+                      if Data.Library_Src_Dir /= No_Name then
+ 
+                         --  It cannot be a source directory of any other
+                         --  project either.
+ 
+                         Project_Loop : for Pid in 1 ..
+                           Project_Table.Last (In_Tree.Projects)
+                         loop
+                            Src_Dirs :=
+                              In_Tree.Projects.Table (Pid).Source_Dirs;
+                            Dir_Loop : while Src_Dirs /= Nil_String loop
+                               Src_Dir :=
+                                 In_Tree.String_Elements.Table (Src_Dirs);
+ 
+                               --  Report error if it is one of the source
+                               --  directories
+ 
+                               if Data.Library_Src_Dir = Src_Dir.Value then
+                                  Error_Msg_Name_1 := Src_Dir.Value;
+                                  Error_Msg_Name_2 :=
+                                    In_Tree.Projects.Table (Pid).Name;
+                                  Error_Msg
+                                    (Project, In_Tree,
+                                     "directory to copy interfaces cannot " &
+                                     "be the same as source directory { of " &
+                                     "project {",
+                                     Lib_Src_Dir.Location);
+                                  Data.Library_Src_Dir := No_Name;
+                                  exit Project_Loop;
+                               end if;
+ 
+                               Src_Dirs := Src_Dir.Next;
+                            end loop Dir_Loop;
+                         end loop Project_Loop;
+                      end if;
                    end;
  
!                   --  In high verbosity, if there is a valid Library_Src_Dir,
!                   --  display its path name.
  
                    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_Src_Dir));
                       Write_Line ("""");
                    end if;
                 end if;
              end;
           end if;
  
+          --  Check the symbol related attributes
+ 
+          --  First, the symbol policy
+ 
           if not Lib_Symbol_Policy.Default then
              declare
                 Value : constant String :=
*************** package body Prj.Nmsc is
*** 2240,2245 ****
--- 2590,2597 ----
                     (Get_Name_String (Lib_Symbol_Policy.Value));
  
              begin
+                --  Symbol policy must hove one of a limited number of values
+ 
                 if Value = "autonomous" or else Value = "default" then
                    Data.Symbol_Data.Symbol_Policy := Autonomous;
  
*************** package body Prj.Nmsc is
*** 2254,2283 ****
  
                 else
                    Error_Msg
!                     (Project,
                       "illegal value for Library_Symbol_Policy",
                       Lib_Symbol_Policy.Location);
                 end if;
              end;
           end if;
  
           if Lib_Symbol_File.Default then
              if Data.Symbol_Data.Symbol_Policy = Restricted then
                 Error_Msg
!                  (Project,
                    "Library_Symbol_File needs to be defined when " &
                    "symbol policy is Restricted",
                    Lib_Symbol_Policy.Location);
              end if;
  
           else
              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);
  
--- 2606,2640 ----
  
                 else
                    Error_Msg
!                     (Project, In_Tree,
                       "illegal value for Library_Symbol_Policy",
                       Lib_Symbol_Policy.Location);
                 end if;
              end;
           end if;
  
+          --  If attribute Library_Symbol_File is not specified, symbol policy
+          --  cannot be Restricted.
+ 
           if Lib_Symbol_File.Default then
              if Data.Symbol_Data.Symbol_Policy = Restricted then
                 Error_Msg
!                  (Project, In_Tree,
                    "Library_Symbol_File needs to be defined when " &
                    "symbol policy is Restricted",
                    Lib_Symbol_Policy.Location);
              end if;
  
           else
+             --  Library_Symbol_File is defined. Check that the file exists
+ 
              Data.Symbol_Data.Symbol_File := Lib_Symbol_File.Value;
  
              Get_Name_String (Lib_Symbol_File.Value);
  
              if Name_Len = 0 then
                 Error_Msg
!                  (Project, In_Tree,
                    "symbol file name cannot be an empty string",
                    Lib_Symbol_File.Location);
  
*************** package body Prj.Nmsc is
*** 2298,2304 ****
                 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);
--- 2655,2661 ----
                 if not OK then
                    Error_Msg_Name_1 := Lib_Symbol_File.Value;
                    Error_Msg
!                     (Project, In_Tree,
                       "symbol file name { is illegal. " &
                       "Name canot include directory info.",
                       Lib_Symbol_File.Location);
*************** package body Prj.Nmsc is
*** 2306,2329 ****
              end if;
           end if;
  
           if Lib_Ref_Symbol_File.Default then
              if Data.Symbol_Data.Symbol_Policy = Compliant
                or else Data.Symbol_Data.Symbol_Policy = Controlled
              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_Ref_Symbol_File.Value);
  
              if Name_Len = 0 then
                 Error_Msg
!                  (Project,
                    "reference symbol file name cannot be an empty string",
                    Lib_Symbol_File.Location);
  
--- 2663,2691 ----
              end if;
           end if;
  
+          --  If attribute Library_Reference_Symbol_File is not defined,
+          --  symbol policy cannot be Compilant or Controlled.
+ 
           if Lib_Ref_Symbol_File.Default then
              if Data.Symbol_Data.Symbol_Policy = Compliant
                or else Data.Symbol_Data.Symbol_Policy = Controlled
              then
                 Error_Msg
!                  (Project, In_Tree,
                    "a reference symbol file need to be defined",
                    Lib_Symbol_Policy.Location);
              end if;
  
           else
+             --  Library_Reference_Symbol_File is defined, check file exists
+ 
              Data.Symbol_Data.Reference := Lib_Ref_Symbol_File.Value;
  
              Get_Name_String (Lib_Ref_Symbol_File.Value);
  
              if Name_Len = 0 then
                 Error_Msg
!                  (Project, In_Tree,
                    "reference symbol file name cannot be an empty string",
                    Lib_Symbol_File.Location);
  
*************** package body Prj.Nmsc is
*** 2344,2350 ****
                 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);
--- 2706,2712 ----
                 if not OK then
                    Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
                    Error_Msg
!                     (Project, In_Tree,
                       "reference symbol file { name is illegal. " &
                       "Name canot include directory info.",
                       Lib_Ref_Symbol_File.Location);
*************** package body Prj.Nmsc is
*** 2356,2389 ****
                    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;
--- 2718,2746 ----
                    Get_Name_String (Lib_Ref_Symbol_File.Value))
                 then
                    Error_Msg_Name_1 := Lib_Ref_Symbol_File.Value;
  
!                   --  For controlled symbol policy, it is an error if the
!                   --  reference symbol file does not exist. For other symbol
!                   --  policies, this is just a warning
  
!                   Error_Msg_Warn :=
!                     Data.Symbol_Data.Symbol_Policy /= Controlled;
  
!                   Error_Msg
!                     (Project, In_Tree,
!                      "<library reference symbol file { does not exist",
!                      Lib_Ref_Symbol_File.Location);
  
!                   --  In addition in the non-controlled case, if symbol policy
!                   --  is Compliant, it is changed to Autonomous, because there
!                   --  is no reference to check against, and we don't want to
!                   --  fail in this case.
! 
!                   if Data.Symbol_Data.Symbol_Policy /= Controlled then
!                      if Data.Symbol_Data.Symbol_Policy = Compliant then
!                         Data.Symbol_Data.Symbol_Policy := Autonomous;
                       end if;
!                   end if;
                 end if;
              end if;
           end if;
*************** package body Prj.Nmsc is
*** 2412,2420 ****
  
     function Body_Suffix_Of
       (Language   : Language_Index;
!       In_Project : Project_Data) return String
     is
!       Suffix_Id : constant Name_Id := Suffix_Of (Language, In_Project);
     begin
        if Suffix_Id /= No_Name then
           return Get_Name_String (Suffix_Id);
--- 2769,2779 ----
  
     function Body_Suffix_Of
       (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return String
     is
!       Suffix_Id : constant Name_Id :=
!                     Suffix_Of (Language, In_Project, In_Tree);
     begin
        if Suffix_Id /= No_Name then
           return Get_Name_String (Suffix_Id);
*************** package body Prj.Nmsc is
*** 2429,2434 ****
--- 2788,2794 ----
  
     procedure Error_Msg
       (Project       : Project_Id;
+       In_Tree       : Project_Tree_Ref;
        Msg           : String;
        Flag_Location : Source_Ptr)
     is
*************** package body Prj.Nmsc is
*** 2481,2491 ****
        if Msg (First) = '\' then
           First := First + 1;
  
!       --  Warniung character is always the first one in this package
  
        elsif Msg (First) = '?' then
           First := First + 1;
           Add ("Warning: ");
        end if;
  
        for Index in First .. Msg'Last loop
--- 2841,2859 ----
        if Msg (First) = '\' then
           First := First + 1;
  
!          --  Warniung character is always the first one in this package
!          --  this is an undoocumented kludge!!!
  
        elsif Msg (First) = '?' then
           First := First + 1;
           Add ("Warning: ");
+ 
+       elsif Msg (First) = '<' then
+          First := First + 1;
+ 
+          if Err_Vars.Error_Msg_Warn then
+             Add ("Warning: ");
+          end if;
        end if;
  
        for Index in First .. Msg'Last loop
*************** package body Prj.Nmsc is
*** 2512,2518 ****
  
        end loop;
  
!       Error_Report (Error_Buffer (1 .. Error_Last), Project);
     end Error_Msg;
  
     ------------------
--- 2880,2886 ----
  
        end loop;
  
!       Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
     end Error_Msg;
  
     ------------------
*************** package body Prj.Nmsc is
*** 2521,2526 ****
--- 2889,2895 ----
  
     procedure Find_Sources
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Data         : in out Project_Data;
        For_Language : Language_Index;
        Follow_Links : Boolean := False)
*************** package body Prj.Nmsc is
*** 2541,2547 ****
        while Source_Dir /= Nil_String loop
           begin
              Source_Recorded := False;
!             Element := String_Elements.Table (Source_Dir);
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Display_Value);
  
--- 2910,2916 ----
        while Source_Dir /= Nil_String loop
           begin
              Source_Recorded := False;
!             Element := In_Tree.String_Elements.Table (Source_Dir);
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Display_Value);
  
*************** package body Prj.Nmsc is
*** 2599,2604 ****
--- 2968,2974 ----
                               (File_Name       => File_Name,
                                Path_Name       => Path_Name,
                                Project         => Project,
+                               In_Tree         => In_Tree,
                                Data            => Data,
                                Location        => No_Location,
                                Current_Source  => Current_Source,
*************** package body Prj.Nmsc is
*** 2610,2620 ****
                               (File_Name        => File_Name,
                                Path_Name        => Path_Name,
                                Project          => Project,
                                Data             => Data,
                                Location         => No_Location,
                                Language         => For_Language,
                                Suffix           =>
!                                 Body_Suffix_Of (For_Language, Data),
                                Naming_Exception => False);
                          end if;
                       end;
--- 2980,2991 ----
                               (File_Name        => File_Name,
                                Path_Name        => Path_Name,
                                Project          => Project,
+                               In_Tree          => In_Tree,
                                Data             => Data,
                                Location         => No_Location,
                                Language         => For_Language,
                                Suffix           =>
!                                 Body_Suffix_Of (For_Language, Data, In_Tree),
                                Naming_Exception => False);
                          end if;
                       end;
*************** package body Prj.Nmsc is
*** 2630,2636 ****
           end;
  
           if Source_Recorded then
!             String_Elements.Table (Source_Dir).Flag := True;
           end if;
  
           Source_Dir := Element.Next;
--- 3001,3008 ----
           end;
  
           if Source_Recorded then
!             In_Tree.String_Elements.Table (Source_Dir).Flag :=
!               True;
           end if;
  
           Source_Dir := Element.Next;
*************** package body Prj.Nmsc is
*** 2652,2658 ****
  
           elsif Data.Extends = No_Project then
              Error_Msg
!               (Project,
                 "there are no Ada sources in this project",
                 Data.Location);
           end if;
--- 3024,3030 ----
  
           elsif Data.Extends = No_Project then
              Error_Msg
!               (Project, In_Tree,
                 "there are no Ada sources in this project",
                 Data.Location);
           end if;
*************** package body Prj.Nmsc is
*** 2676,2692 ****
  
     procedure Get_Directories
       (Project : Project_Id;
        Data    : in out Project_Data)
     is
        Object_Dir : constant Variable_Value :=
!                      Util.Value_Of (Name_Object_Dir, Data.Decl.Attributes);
  
        Exec_Dir   : constant Variable_Value :=
!                      Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
  
        Source_Dirs : constant Variable_Value :=
                        Util.Value_Of
!                         (Name_Source_Dirs, Data.Decl.Attributes);
  
        Last_Source_Dir : String_List_Id  := Nil_String;
  
--- 3048,3067 ----
  
     procedure Get_Directories
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Data    : in out Project_Data)
     is
        Object_Dir : constant Variable_Value :=
!                      Util.Value_Of
!                        (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
  
        Exec_Dir   : constant Variable_Value :=
!                      Util.Value_Of
!                        (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
  
        Source_Dirs : constant Variable_Value :=
                        Util.Value_Of
!                         (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
  
        Last_Source_Dir : String_List_Id  := Nil_String;
  
*************** package body Prj.Nmsc is
*** 2752,2758 ****
              --  Check if directory is already in list
  
              while List /= Nil_String loop
!                Element := String_Elements.Table (List);
  
                 if Element.Value /= No_Name then
                    Found := Element.Value = Canonical_Path;
--- 3127,3133 ----
              --  Check if directory is already in list
  
              while List /= Nil_String loop
!                Element := In_Tree.String_Elements.Table (List);
  
                 if Element.Value /= No_Name then
                    Found := Element.Value = Canonical_Path;
*************** package body Prj.Nmsc is
*** 2770,2776 ****
                    Write_Line (The_Path (The_Path'First .. The_Path_Last));
                 end if;
  
!                String_Elements.Increment_Last;
                 Element :=
                   (Value    => Canonical_Path,
                    Display_Value => Non_Canonical_Path,
--- 3145,3152 ----
                    Write_Line (The_Path (The_Path'First .. The_Path_Last));
                 end if;
  
!                String_Element_Table.Increment_Last
!                  (In_Tree.String_Elements);
                 Element :=
                   (Value    => Canonical_Path,
                    Display_Value => Non_Canonical_Path,
*************** package body Prj.Nmsc is
*** 2782,2802 ****
                 --  Case of first source directory
  
                 if Last_Source_Dir = Nil_String then
!                   Data.Source_Dirs := String_Elements.Last;
  
                    --  Here we already have source directories
  
                 else
                    --  Link the previous last to the new one
  
!                   String_Elements.Table (Last_Source_Dir).Next :=
!                     String_Elements.Last;
                 end if;
  
                 --  And register this source directory as the new last
  
!                Last_Source_Dir  := String_Elements.Last;
!                String_Elements.Table (Last_Source_Dir) := Element;
              end if;
  
              --  Now look for subdirectories. We do that even when this
--- 3158,3183 ----
                 --  Case of first source directory
  
                 if Last_Source_Dir = Nil_String then
!                   Data.Source_Dirs := String_Element_Table.Last
!                                         (In_Tree.String_Elements);
  
                    --  Here we already have source directories
  
                 else
                    --  Link the previous last to the new one
  
!                   In_Tree.String_Elements.Table
!                     (Last_Source_Dir).Next :=
!                       String_Element_Table.Last
!                         (In_Tree.String_Elements);
                 end if;
  
                 --  And register this source directory as the new last
  
!                Last_Source_Dir  := String_Element_Table.Last
!                  (In_Tree.String_Elements);
!                In_Tree.String_Elements.Table (Last_Source_Dir) :=
!                  Element;
              end if;
  
              --  Now look for subdirectories. We do that even when this
*************** package body Prj.Nmsc is
*** 2906,2917 ****
  
                    if Location = No_Location then
                       Error_Msg
!                        (Project,
                          "{ is not a valid directory.",
                          Data.Location);
                    else
                       Error_Msg
!                        (Project,
                          "{ is not a valid directory.",
                          Location);
                    end if;
--- 3287,3298 ----
  
                    if Location = No_Location then
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is not a valid directory.",
                          Data.Location);
                    else
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is not a valid directory.",
                          Location);
                    end if;
*************** package body Prj.Nmsc is
*** 2950,2961 ****
  
                    if Location = No_Location then
                       Error_Msg
!                        (Project,
                          "{ is not a valid directory",
                          Data.Location);
                    else
                       Error_Msg
!                        (Project,
                          "{ is not a valid directory",
                          Location);
                    end if;
--- 3331,3342 ----
  
                    if Location = No_Location then
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is not a valid directory",
                          Data.Location);
                    else
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is not a valid directory",
                          Location);
                    end if;
*************** package body Prj.Nmsc is
*** 2964,2970 ****
                    --  As it is an existing directory, we add it to
                    --  the list of directories.
  
!                   String_Elements.Increment_Last;
                    Element.Value := Path_Name;
                    Element.Display_Value := Display_Path_Name;
  
--- 3345,3352 ----
                    --  As it is an existing directory, we add it to
                    --  the list of directories.
  
!                   String_Element_Table.Increment_Last
!                     (In_Tree.String_Elements);
                    Element.Value := Path_Name;
                    Element.Display_Value := Display_Path_Name;
  
*************** package body Prj.Nmsc is
*** 2972,2991 ****
  
                       --  This is the first source directory
  
!                      Data.Source_Dirs := String_Elements.Last;
  
                    else
                       --  We already have source directories,
                       --  link the previous last to the new one.
  
!                      String_Elements.Table (Last_Source_Dir).Next :=
!                        String_Elements.Last;
                    end if;
  
                    --  And register this source directory as the new last
  
!                   Last_Source_Dir := String_Elements.Last;
!                   String_Elements.Table (Last_Source_Dir) := Element;
                 end if;
              end;
           end if;
--- 3354,3378 ----
  
                       --  This is the first source directory
  
!                      Data.Source_Dirs := String_Element_Table.Last
!                                         (In_Tree.String_Elements);
  
                    else
                       --  We already have source directories,
                       --  link the previous last to the new one.
  
!                      In_Tree.String_Elements.Table
!                        (Last_Source_Dir).Next :=
!                          String_Element_Table.Last
!                            (In_Tree.String_Elements);
                    end if;
  
                    --  And register this source directory as the new last
  
!                   Last_Source_Dir := String_Element_Table.Last
!                     (In_Tree.String_Elements);
!                   In_Tree.String_Elements.Table
!                     (Last_Source_Dir) := Element;
                 end if;
              end;
           end if;
*************** package body Prj.Nmsc is
*** 3013,3019 ****
  
           if Name_Len = 0 then
              Error_Msg
!               (Project,
                 "Object_Dir cannot be empty",
                 Object_Dir.Location);
  
--- 3400,3406 ----
  
           if Name_Len = 0 then
              Error_Msg
!               (Project, In_Tree,
                 "Object_Dir cannot be empty",
                 Object_Dir.Location);
  
*************** package body Prj.Nmsc is
*** 3030,3036 ****
  
                 Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
                 Error_Msg
!                  (Project,
                    "the object directory { cannot be found",
                    Data.Location);
  
--- 3417,3423 ----
  
                 Err_Vars.Error_Msg_Name_1 := Object_Dir.Value;
                 Error_Msg
!                  (Project, In_Tree,
                    "the object directory { cannot be found",
                    Data.Location);
  
*************** package body Prj.Nmsc is
*** 3072,3078 ****
  
           if Name_Len = 0 then
              Error_Msg
!               (Project,
                 "Exec_Dir cannot be empty",
                 Exec_Dir.Location);
  
--- 3459,3465 ----
  
           if Name_Len = 0 then
              Error_Msg
!               (Project, In_Tree,
                 "Exec_Dir cannot be empty",
                 Exec_Dir.Location);
  
*************** package body Prj.Nmsc is
*** 3087,3093 ****
              if Data.Exec_Directory = No_Name then
                 Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
                 Error_Msg
!                  (Project,
                    "the exec directory { cannot be found",
                    Data.Location);
              end if;
--- 3474,3480 ----
              if Data.Exec_Directory = No_Name then
                 Err_Vars.Error_Msg_Name_1 := Exec_Dir.Value;
                 Error_Msg
!                  (Project, In_Tree,
                    "the exec directory { cannot be found",
                    Data.Location);
              end if;
*************** package body Prj.Nmsc is
*** 3117,3125 ****
           --  No Source_Dirs specified: the single source directory
           --  is the one containing the project file
  
!          String_Elements.Increment_Last;
!          Data.Source_Dirs := String_Elements.Last;
!          String_Elements.Table (Data.Source_Dirs) :=
             (Value         => Data.Directory,
              Display_Value => Data.Display_Directory,
              Location      => No_Location,
--- 3504,3514 ----
           --  No Source_Dirs specified: the single source directory
           --  is the one containing the project file
  
!          String_Element_Table.Increment_Last
!            (In_Tree.String_Elements);
!          Data.Source_Dirs := String_Element_Table.Last
!            (In_Tree.String_Elements);
!          In_Tree.String_Elements.Table (Data.Source_Dirs) :=
             (Value         => Data.Directory,
              Display_Value => Data.Display_Directory,
              Location      => No_Location,
*************** package body Prj.Nmsc is
*** 3161,3167 ****
              --  element of the list
  
              while Source_Dir /= Nil_String loop
!                Element := String_Elements.Table (Source_Dir);
                 Find_Source_Dirs (Element.Value, Element.Location);
                 Source_Dir := Element.Next;
              end loop;
--- 3550,3557 ----
              --  element of the list
  
              while Source_Dir /= Nil_String loop
!                Element :=
!                  In_Tree.String_Elements.Table (Source_Dir);
                 Find_Source_Dirs (Element.Value, Element.Location);
                 Source_Dir := Element.Next;
              end loop;
*************** package body Prj.Nmsc is
*** 3178,3189 ****
  
        begin
           while Current /= Nil_String loop
!             Element := String_Elements.Table (Current);
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Value);
                 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                 Element.Value := Name_Find;
!                String_Elements.Table (Current) := Element;
              end if;
  
              Current := Element.Next;
--- 3568,3579 ----
  
        begin
           while Current /= Nil_String loop
!             Element := In_Tree.String_Elements.Table (Current);
              if Element.Value /= No_Name then
                 Get_Name_String (Element.Value);
                 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                 Element.Value := Name_Find;
!                In_Tree.String_Elements.Table (Current) := Element;
              end if;
  
              Current := Element.Next;
*************** package body Prj.Nmsc is
*** 3196,3204 ****
     -- Get_Mains --
     ---------------
  
!    procedure Get_Mains (Project : Project_Id; Data : in out Project_Data) is
        Mains : constant Variable_Value :=
!                 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes);
  
     begin
        Data.Mains := Mains.Values;
--- 3586,3597 ----
     -- Get_Mains --
     ---------------
  
!    procedure Get_Mains
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref;
!       Data    : in out Project_Data) is
        Mains : constant Variable_Value :=
!                 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
  
     begin
        Data.Mains := Mains.Values;
*************** package body Prj.Nmsc is
*** 3208,3221 ****
  
        if Mains.Default then
           if Data.Extends /= No_Project then
!             Data.Mains := Projects.Table (Data.Extends).Mains;
           end if;
  
        --  In a library project file, Main cannot be specified
  
        elsif Data.Library then
           Error_Msg
!            (Project,
              "a library project file cannot have Main specified",
              Mains.Location);
        end if;
--- 3601,3615 ----
  
        if Mains.Default then
           if Data.Extends /= No_Project then
!             Data.Mains :=
!               In_Tree.Projects.Table (Data.Extends).Mains;
           end if;
  
        --  In a library project file, Main cannot be specified
  
        elsif Data.Library then
           Error_Msg
!            (Project, In_Tree,
              "a library project file cannot have Main specified",
              Mains.Location);
        end if;
*************** package body Prj.Nmsc is
*** 3228,3234 ****
     procedure Get_Sources_From_File
       (Path     : String;
        Location : Source_Ptr;
!       Project  : Project_Id)
     is
        File        : Prj.Util.Text_File;
        Line        : String (1 .. 250);
--- 3622,3629 ----
     procedure Get_Sources_From_File
       (Path     : String;
        Location : Source_Ptr;
!       Project  : Project_Id;
!       In_Tree  : Project_Tree_Ref)
     is
        File        : Prj.Util.Text_File;
        Line        : String (1 .. 250);
*************** package body Prj.Nmsc is
*** 3249,3255 ****
        Prj.Util.Open (File, Path);
  
        if not Prj.Util.Is_Valid (File) then
!          Error_Msg (Project, "file does not exist", Location);
        else
           --  Read the lines one by one
  
--- 3644,3650 ----
        Prj.Util.Open (File, Path);
  
        if not Prj.Util.Is_Valid (File) then
!          Error_Msg (Project, In_Tree, "file does not exist", Location);
        else
           --  Read the lines one by one
  
*************** package body Prj.Nmsc is
*** 3686,3691 ****
--- 4081,4087 ----
  
     procedure Look_For_Sources
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Data         : in out Project_Data;
        Follow_Links : Boolean)
     is
*************** package body Prj.Nmsc is
*** 3726,3732 ****
  
           while Source_Dir /= Nil_String loop
              Source_Recorded := False;
!             Element := String_Elements.Table (Source_Dir);
  
              declare
                 Dir_Path : constant String := Get_Name_String (Element.Value);
--- 4122,4128 ----
  
           while Source_Dir /= Nil_String loop
              Source_Recorded := False;
!             Element := In_Tree.String_Elements.Table (Source_Dir);
  
              declare
                 Dir_Path : constant String := Get_Name_String (Element.Value);
*************** package body Prj.Nmsc is
*** 3775,3780 ****
--- 4171,4177 ----
                         (File_Name       => Name,
                          Path_Name       => Path,
                          Project         => Project,
+                         In_Tree         => In_Tree,
                          Data            => Data,
                          Location        => NL.Location,
                          Current_Source  => Current_Source,
*************** package body Prj.Nmsc is
*** 3787,3793 ****
              end;
  
              if Source_Recorded then
!                String_Elements.Table (Source_Dir).Flag := True;
              end if;
  
              Source_Dir := Element.Next;
--- 4184,4191 ----
              end;
  
              if Source_Recorded then
!                In_Tree.String_Elements.Table (Source_Dir).Flag :=
!                  True;
              end if;
  
              Source_Dir := Element.Next;
*************** package body Prj.Nmsc is
*** 3804,3817 ****
  
                 if First_Error then
                    Error_Msg
!                     (Project,
                       "source file { cannot be found",
                       NL.Location);
                    First_Error := False;
  
                 else
                    Error_Msg
!                     (Project,
                       "\source file { cannot be found",
                       NL.Location);
                 end if;
--- 4202,4215 ----
  
                 if First_Error then
                    Error_Msg
!                     (Project, In_Tree,
                       "source file { cannot be found",
                       NL.Location);
                    First_Error := False;
  
                 else
                    Error_Msg
!                     (Project, In_Tree,
                       "\source file { cannot be found",
                       NL.Location);
                 end if;
*************** package body Prj.Nmsc is
*** 3833,3839 ****
           --  Get the list of sources from the file and put them in hash table
           --  Source_Names.
  
!          Get_Sources_From_File (Path, Location, Project);
  
           --  Look in the source directories to find those sources
  
--- 4231,4237 ----
           --  Get the list of sources from the file and put them in hash table
           --  Source_Names.
  
!          Get_Sources_From_File (Path, Location, Project, In_Tree);
  
           --  Look in the source directories to find those sources
  
*************** package body Prj.Nmsc is
*** 3843,3849 ****
           --  If not, report an error.
  
           if Data.Sources = Nil_String then
!             Error_Msg (Project,
                         "there are no Ada sources in this project",
                         Location);
           end if;
--- 4241,4247 ----
           --  If not, report an error.
  
           if Data.Sources = Nil_String then
!             Error_Msg (Project, In_Tree,
                         "there are no Ada sources in this project",
                         Location);
           end if;
*************** package body Prj.Nmsc is
*** 3855,3871 ****
              Sources          : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Source_Files,
!                                     Data.Decl.Attributes);
  
              Source_List_File : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Source_List_File,
!                                     Data.Decl.Attributes);
  
              Locally_Removed  : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Locally_Removed_Files,
!                                     Data.Decl.Attributes);
  
           begin
              pragma Assert
--- 4253,4272 ----
              Sources          : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Source_Files,
!                                     Data.Decl.Attributes,
!                                     In_Tree);
  
              Source_List_File : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Source_List_File,
!                                     Data.Decl.Attributes,
!                                     In_Tree);
  
              Locally_Removed  : constant Variable_Value :=
                                   Util.Value_Of
                                     (Name_Locally_Removed_Files,
!                                     Data.Decl.Attributes,
!                                     In_Tree);
  
           begin
              pragma Assert
*************** package body Prj.Nmsc is
*** 3879,3885 ****
              if not Sources.Default then
                 if not Source_List_File.Default then
                    Error_Msg
!                     (Project,
                       "?both variables source_files and " &
                       "source_list_file are present",
                       Source_List_File.Location);
--- 4280,4286 ----
              if not Sources.Default then
                 if not Source_List_File.Default then
                    Error_Msg
!                     (Project, In_Tree,
                       "?both variables source_files and " &
                       "source_list_file are present",
                       Source_List_File.Location);
*************** package body Prj.Nmsc is
*** 3899,3905 ****
                    Data.Ada_Sources_Present := Current /= Nil_String;
  
                    while Current /= Nil_String loop
!                      Element := String_Elements.Table (Current);
                       Get_Name_String (Element.Value);
                       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                       Name := Name_Find;
--- 4300,4307 ----
                    Data.Ada_Sources_Present := Current /= Nil_String;
  
                    while Current /= Nil_String loop
!                      Element :=
!                        In_Tree.String_Elements.Table (Current);
                       Get_Name_String (Element.Value);
                       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                       Name := Name_Find;
*************** package body Prj.Nmsc is
*** 3945,3951 ****
                    if Source_File_Path_Name'Length = 0 then
                       Err_Vars.Error_Msg_Name_1 := Source_List_File.Value;
                       Error_Msg
!                        (Project,
                          "file with sources { does not exist",
                          Source_List_File.Location);
  
--- 4347,4353 ----
                    if Source_File_Path_Name'Length = 0 then
                       Err_Vars.Error_Msg_Name_1 := Source_List_File.Value;
                       Error_Msg
!                        (Project, In_Tree,
                          "file with sources { does not exist",
                          Source_List_File.Location);
  
*************** package body Prj.Nmsc is
*** 3962,3968 ****
                 --  scheme in all the source directories.
  
                 Find_Sources
!                  (Project, Data, Ada_Language_Index, Follow_Links);
              end if;
  
              --  If there are sources that are locally removed, mark them as
--- 4364,4370 ----
                 --  scheme in all the source directories.
  
                 Find_Sources
!                  (Project, In_Tree, Data, Ada_Language_Index, Follow_Links);
              end if;
  
              --  If there are sources that are locally removed, mark them as
*************** package body Prj.Nmsc is
*** 3975,3981 ****
  
                 if Data.Extends = No_Project then
                    Error_Msg
!                     (Project,
                       "Locally_Removed_Files can only be used " &
                       "in an extending project file",
                       Locally_Removed.Location);
--- 4377,4383 ----
  
                 if Data.Extends = No_Project then
                    Error_Msg
!                     (Project, In_Tree,
                       "Locally_Removed_Files can only be used " &
                       "in an extending project file",
                       Locally_Removed.Location);
*************** package body Prj.Nmsc is
*** 3992,3998 ****
  
                    begin
                       while Current /= Nil_String loop
!                         Element := String_Elements.Table (Current);
                          Get_Name_String (Element.Value);
                          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                          Name := Name_Find;
--- 4394,4401 ----
  
                    begin
                       while Current /= Nil_String loop
!                         Element :=
!                           In_Tree.String_Elements.Table (Current);
                          Get_Name_String (Element.Value);
                          Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
                          Name := Name_Find;
*************** package body Prj.Nmsc is
*** 4009,4016 ****
  
                          OK := False;
  
!                         for Index in 1 .. Units.Last loop
!                            Unit := Units.Table (Index);
  
                             if Unit.File_Names (Specification).Name = Name then
                                OK := True;
--- 4412,4421 ----
  
                          OK := False;
  
!                         for Index in Unit_Table.First ..
!                                   Unit_Table.Last (In_Tree.Units)
!                         loop
!                            Unit := In_Tree.Units.Table (Index);
  
                             if Unit.File_Names (Specification).Name = Name then
                                OK := True;
*************** package body Prj.Nmsc is
*** 4024,4049 ****
  
                                if Extended = Project then
                                   Error_Msg
!                                    (Project,
                                      "cannot remove a source " &
                                      "of the same project",
                                      Location);
  
                                elsif
!                                 Project_Extends (Project, Extended)
                                then
                                   Unit.File_Names
                                     (Specification).Path := Slash;
                                   Unit.File_Names
                                     (Specification).Needs_Pragma := False;
!                                  Units.Table (Index) := Unit;
                                   Add_Forbidden_File_Name
                                     (Unit.File_Names (Specification).Name);
                                   exit;
  
                                else
                                   Error_Msg
!                                    (Project,
                                      "cannot remove a source from " &
                                      "another project",
                                      Location);
--- 4429,4455 ----
  
                                if Extended = Project then
                                   Error_Msg
!                                    (Project, In_Tree,
                                      "cannot remove a source " &
                                      "of the same project",
                                      Location);
  
                                elsif
!                                 Project_Extends (Project, Extended, In_Tree)
                                then
                                   Unit.File_Names
                                     (Specification).Path := Slash;
                                   Unit.File_Names
                                     (Specification).Needs_Pragma := False;
!                                  In_Tree.Units.Table (Index) :=
!                                    Unit;
                                   Add_Forbidden_File_Name
                                     (Unit.File_Names (Specification).Name);
                                   exit;
  
                                else
                                   Error_Msg
!                                    (Project, In_Tree,
                                      "cannot remove a source from " &
                                      "another project",
                                      Location);
*************** package body Prj.Nmsc is
*** 4063,4080 ****
  
                                if Extended = Project then
                                   Error_Msg
!                                    (Project,
                                      "cannot remove a source " &
                                      "of the same project",
                                      Location);
  
                                elsif
!                                 Project_Extends (Project, Extended)
                                then
                                   Unit.File_Names (Body_Part).Path := Slash;
                                   Unit.File_Names (Body_Part).Needs_Pragma
                                     := False;
!                                  Units.Table (Index) := Unit;
                                   Add_Forbidden_File_Name
                                     (Unit.File_Names (Body_Part).Name);
                                   exit;
--- 4469,4487 ----
  
                                if Extended = Project then
                                   Error_Msg
!                                    (Project, In_Tree,
                                      "cannot remove a source " &
                                      "of the same project",
                                      Location);
  
                                elsif
!                                 Project_Extends (Project, Extended, In_Tree)
                                then
                                   Unit.File_Names (Body_Part).Path := Slash;
                                   Unit.File_Names (Body_Part).Needs_Pragma
                                     := False;
!                                  In_Tree.Units.Table (Index) :=
!                                    Unit;
                                   Add_Forbidden_File_Name
                                     (Unit.File_Names (Body_Part).Name);
                                   exit;
*************** package body Prj.Nmsc is
*** 4085,4091 ****
  
                          if not OK then
                             Err_Vars.Error_Msg_Name_1 := Name;
!                            Error_Msg (Project, "unknown file {", Location);
                          end if;
  
                          Current := Element.Next;
--- 4492,4499 ----
  
                          if not OK then
                             Err_Vars.Error_Msg_Name_1 := Name;
!                            Error_Msg
!                              (Project, In_Tree, "unknown file {", Location);
                          end if;
  
                          Current := Element.Next;
*************** package body Prj.Nmsc is
*** 4106,4124 ****
  
              --  For each language (other than Ada) in the project file
  
!             if Is_Present (Lang, Data) then
  
                 --  Reset the indication that there are sources of this
                 --  language. It will be set back to True whenever we find a
                 --  source of the language.
  
!                Set (Lang, False, Data);
  
                 --  First, get the source suffix for the language
  
!                Set (Suffix       => Suffix_For (Lang, Data.Naming),
                      For_Language => Lang,
!                     In_Project   => Data);
  
                 --  Then, deal with the naming exceptions, if any
  
--- 4514,4533 ----
  
              --  For each language (other than Ada) in the project file
  
!             if Is_Present (Lang, Data, In_Tree) then
  
                 --  Reset the indication that there are sources of this
                 --  language. It will be set back to True whenever we find a
                 --  source of the language.
  
!                Set (Lang, False, Data, In_Tree);
  
                 --  First, get the source suffix for the language
  
!                Set (Suffix       => Suffix_For (Lang, Data.Naming, In_Tree),
                      For_Language => Lang,
!                     In_Project   => Data,
!                     In_Tree      => In_Tree);
  
                 --  Then, deal with the naming exceptions, if any
  
*************** package body Prj.Nmsc is
*** 4129,4135 ****
                      Value_Of
                        (Index     => Language_Names.Table (Lang),
                         Src_Index => 0,
!                        In_Array  => Data.Naming.Implementation_Exceptions);
                    Element_Id        : String_List_Id;
                    Element           : String_Element;
                    File_Id           : Name_Id;
--- 4538,4545 ----
                      Value_Of
                        (Index     => Language_Names.Table (Lang),
                         Src_Index => 0,
!                        In_Array  => Data.Naming.Implementation_Exceptions,
!                        In_Tree   => In_Tree);
                    Element_Id        : String_List_Id;
                    Element           : String_Element;
                    File_Id           : Name_Id;
*************** package body Prj.Nmsc is
*** 4143,4149 ****
                       Element_Id := Naming_Exceptions.Values;
  
                       while Element_Id /= Nil_String loop
!                         Element := String_Elements.Table (Element_Id);
                          Get_Name_String (Element.Value);
                          Canonical_Case_File_Name
                            (Name_Buffer (1 .. Name_Len));
--- 4553,4560 ----
                       Element_Id := Naming_Exceptions.Values;
  
                       while Element_Id /= Nil_String loop
!                         Element := In_Tree.String_Elements.Table
!                                                           (Element_Id);
                          Get_Name_String (Element.Value);
                          Canonical_Case_File_Name
                            (Name_Buffer (1 .. Name_Len));
*************** package body Prj.Nmsc is
*** 4173,4178 ****
--- 4584,4590 ----
                       if Source_Found then
                          Record_Other_Sources
                            (Project           => Project,
+                            In_Tree           => In_Tree,
                             Data              => Data,
                             Language          => Lang,
                             Naming_Exceptions => True);
*************** package body Prj.Nmsc is
*** 4191,4202 ****
                    Sources          : constant Variable_Value :=
                                         Util.Value_Of
                                           (Name_Source_Files,
!                                           Data.Decl.Attributes);
  
                    Source_List_File : constant Variable_Value :=
                                         Util.Value_Of
                                           (Name_Source_List_File,
!                                           Data.Decl.Attributes);
  
                 begin
                    pragma Assert
--- 4603,4616 ----
                    Sources          : constant Variable_Value :=
                                         Util.Value_Of
                                           (Name_Source_Files,
!                                           Data.Decl.Attributes,
!                                           In_Tree);
  
                    Source_List_File : constant Variable_Value :=
                                         Util.Value_Of
                                           (Name_Source_List_File,
!                                           Data.Decl.Attributes,
!                                           In_Tree);
  
                 begin
                    pragma Assert
*************** package body Prj.Nmsc is
*** 4210,4216 ****
                    if not Sources.Default then
                       if not Source_List_File.Default then
                          Error_Msg
!                           (Project,
                             "?both variables source_files and " &
                             "source_list_file are present",
                             Source_List_File.Location);
--- 4624,4630 ----
                    if not Sources.Default then
                       if not Source_List_File.Default then
                          Error_Msg
!                           (Project, In_Tree,
                             "?both variables source_files and " &
                             "source_list_file are present",
                             Source_List_File.Location);
*************** package body Prj.Nmsc is
*** 4230,4236 ****
                          --  Put all the sources in the Source_Names hash table
  
                          while Current /= Nil_String loop
!                            Element := String_Elements.Table (Current);
                             Get_Name_String (Element.Value);
                             Canonical_Case_File_Name
                               (Name_Buffer (1 .. Name_Len));
--- 4644,4652 ----
                          --  Put all the sources in the Source_Names hash table
  
                          while Current /= Nil_String loop
!                            Element :=
!                              In_Tree.String_Elements.Table
!                                (Current);
                             Get_Name_String (Element.Value);
                             Canonical_Case_File_Name
                               (Name_Buffer (1 .. Name_Len));
*************** package body Prj.Nmsc is
*** 4259,4264 ****
--- 4675,4681 ----
  
                          Record_Other_Sources
                            (Project           => Project,
+                            In_Tree           => In_Tree,
                             Data              => Data,
                             Language          => Lang,
                             Naming_Exceptions => False);
*************** package body Prj.Nmsc is
*** 4284,4290 ****
                             Err_Vars.Error_Msg_Name_1 :=
                               Source_List_File.Value;
                             Error_Msg
!                              (Project,
                                "file with sources { does not exist",
                                Source_List_File.Location);
  
--- 4701,4707 ----
                             Err_Vars.Error_Msg_Name_1 :=
                               Source_List_File.Value;
                             Error_Msg
!                              (Project, In_Tree,
                                "file with sources { does not exist",
                                Source_List_File.Location);
  
*************** package body Prj.Nmsc is
*** 4295,4306 ****
                             Get_Sources_From_File
                               (Source_File_Path_Name,
                                Source_List_File.Location,
!                               Project);
  
                             --  And look for their directories
  
                             Record_Other_Sources
                               (Project           => Project,
                                Data              => Data,
                                Language          => Lang,
                                Naming_Exceptions => False);
--- 4712,4724 ----
                             Get_Sources_From_File
                               (Source_File_Path_Name,
                                Source_List_File.Location,
!                               Project, In_Tree);
  
                             --  And look for their directories
  
                             Record_Other_Sources
                               (Project           => Project,
+                               In_Tree           => In_Tree,
                                Data              => Data,
                                Language          => Lang,
                                Naming_Exceptions => False);
*************** package body Prj.Nmsc is
*** 4315,4321 ****
                       --  that effectively exist are also part of the source
                       --  of this language.
  
!                      Find_Sources (Project, Data, Lang);
                    end if;
                 end;
              end if;
--- 4733,4739 ----
                       --  that effectively exist are also part of the source
                       --  of this language.
  
!                      Find_Sources (Project, In_Tree, Data, Lang);
                    end if;
                 end;
              end if;
*************** package body Prj.Nmsc is
*** 4354,4361 ****
     -------------------------------
  
     procedure Prepare_Ada_Naming_Exceptions
!      (List : Array_Element_Id;
!       Kind : Spec_Or_Body)
     is
        Current : Array_Element_Id := List;
        Element : Array_Element;
--- 4772,4780 ----
     -------------------------------
  
     procedure Prepare_Ada_Naming_Exceptions
!      (List    : Array_Element_Id;
!       In_Tree : Project_Tree_Ref;
!       Kind    : Spec_Or_Body)
     is
        Current : Array_Element_Id := List;
        Element : Array_Element;
*************** package body Prj.Nmsc is
*** 4366,4372 ****
        --  Traverse the list
  
        while Current /= No_Array_Element loop
!          Element := Array_Elements.Table (Current);
  
           if Element.Index /= No_Name then
              Unit :=
--- 4785,4791 ----
        --  Traverse the list
  
        while Current /= No_Array_Element loop
!          Element := In_Tree.Array_Elements.Table (Current);
  
           if Element.Index /= No_Name then
              Unit :=
*************** package body Prj.Nmsc is
*** 4393,4399 ****
  
     function Project_Extends
       (Extending : Project_Id;
!       Extended  : Project_Id) return Boolean
     is
        Current : Project_Id := Extending;
     begin
--- 4812,4819 ----
  
     function Project_Extends
       (Extending : Project_Id;
!       Extended  : Project_Id;
!       In_Tree   : Project_Tree_Ref) return Boolean
     is
        Current : Project_Id := Extending;
     begin
*************** package body Prj.Nmsc is
*** 4405,4411 ****
              return True;
           end if;
  
!          Current := Projects.Table (Current).Extends;
        end loop;
     end Project_Extends;
  
--- 4825,4831 ----
              return True;
           end if;
  
!          Current := In_Tree.Projects.Table (Current).Extends;
        end loop;
     end Project_Extends;
  
*************** package body Prj.Nmsc is
*** 4417,4422 ****
--- 4837,4843 ----
       (File_Name       : Name_Id;
        Path_Name       : Name_Id;
        Project         : Project_Id;
+       In_Tree         : Project_Tree_Ref;
        Data            : in out Project_Data;
        Location        : Source_Ptr;
        Current_Source  : in out String_List_Id;
*************** package body Prj.Nmsc is
*** 4520,4527 ****
              --  Put the file name in the list of sources of the project
  
              if not File_Name_Recorded then
!                String_Elements.Increment_Last;
!                String_Elements.Table (String_Elements.Last) :=
                   (Value         => Canonical_File_Name,
                    Display_Value => File_Name,
                    Location      => No_Location,
--- 4941,4951 ----
              --  Put the file name in the list of sources of the project
  
              if not File_Name_Recorded then
!                String_Element_Table.Increment_Last
!                  (In_Tree.String_Elements);
!                In_Tree.String_Elements.Table
!                  (String_Element_Table.Last
!                    (In_Tree.String_Elements)) :=
                   (Value         => Canonical_File_Name,
                    Display_Value => File_Name,
                    Location      => No_Location,
*************** package body Prj.Nmsc is
*** 4531,4548 ****
              end if;
  
              if Current_Source = Nil_String then
!                Data.Sources := String_Elements.Last;
              else
!                String_Elements.Table (Current_Source).Next :=
!                  String_Elements.Last;
              end if;
  
!             Current_Source := String_Elements.Last;
  
              --  Put the unit in unit list
  
              declare
!                The_Unit      : Unit_Id := Units_Htable.Get (Unit_Name);
                 The_Unit_Data : Unit_Data;
  
              begin
--- 4955,4977 ----
              end if;
  
              if Current_Source = Nil_String then
!                Data.Sources := String_Element_Table.Last
!                                  (In_Tree.String_Elements);
              else
!                In_Tree.String_Elements.Table
!                  (Current_Source).Next :=
!                  String_Element_Table.Last
!                    (In_Tree.String_Elements);
              end if;
  
!             Current_Source := String_Element_Table.Last
!                                 (In_Tree.String_Elements);
  
              --  Put the unit in unit list
  
              declare
!                The_Unit      : Unit_Id :=
!                  Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
                 The_Unit_Data : Unit_Data;
  
              begin
*************** package body Prj.Nmsc is
*** 4556,4568 ****
                 --  only the other unit kind (spec or body), or what is
                 --  in the unit list is a unit of a project we are extending.
  
!                if The_Unit /= Prj.Com.No_Unit then
!                   The_Unit_Data := Units.Table (The_Unit);
  
                    if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
                      or else Project_Extends
                        (Data.Extends,
!                        The_Unit_Data.File_Names (Unit_Kind).Project)
                    then
                       if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
                          Remove_Forbidden_File_Name
--- 4985,4998 ----
                 --  only the other unit kind (spec or body), or what is
                 --  in the unit list is a unit of a project we are extending.
  
!                if The_Unit /= No_Unit then
!                   The_Unit_Data := In_Tree.Units.Table (The_Unit);
  
                    if The_Unit_Data.File_Names (Unit_Kind).Name = No_Name
                      or else Project_Extends
                        (Data.Extends,
!                        The_Unit_Data.File_Names (Unit_Kind).Project,
!                        In_Tree)
                    then
                       if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
                          Remove_Forbidden_File_Name
*************** package body Prj.Nmsc is
*** 4572,4578 ****
                       --  Record the file name in the hash table Files_Htable
  
                       Unit_Prj := (Unit => The_Unit, Project => Project);
!                      Files_Htable.Set (Canonical_File_Name, Unit_Prj);
  
                       The_Unit_Data.File_Names (Unit_Kind) :=
                         (Name         => Canonical_File_Name,
--- 5002,5011 ----
                       --  Record the file name in the hash table Files_Htable
  
                       Unit_Prj := (Unit => The_Unit, Project => Project);
!                      Files_Htable.Set
!                        (In_Tree.Files_HT,
!                         Canonical_File_Name,
!                         Unit_Prj);
  
                       The_Unit_Data.File_Names (Unit_Kind) :=
                         (Name         => Canonical_File_Name,
*************** package body Prj.Nmsc is
*** 4582,4588 ****
                          Display_Path => Path_Name,
                          Project      => Project,
                          Needs_Pragma => Needs_Pragma);
!                      Units.Table (The_Unit) := The_Unit_Data;
                       Source_Recorded := True;
  
                    elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
--- 5015,5022 ----
                          Display_Path => Path_Name,
                          Project      => Project,
                          Needs_Pragma => Needs_Pragma);
!                      In_Tree.Units.Table (The_Unit) :=
!                        The_Unit_Data;
                       Source_Recorded := True;
  
                    elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
*************** package body Prj.Nmsc is
*** 4593,4601 ****
                       if Previous_Source = Nil_String then
                          Data.Sources := Nil_String;
                       else
!                         String_Elements.Table (Previous_Source).Next :=
!                           Nil_String;
!                         String_Elements.Decrement_Last;
                       end if;
  
                       Current_Source := Previous_Source;
--- 5027,5036 ----
                       if Previous_Source = Nil_String then
                          Data.Sources := Nil_String;
                       else
!                         In_Tree.String_Elements.Table
!                           (Previous_Source).Next := Nil_String;
!                         String_Element_Table.Decrement_Last
!                           (In_Tree.String_Elements);
                       end if;
  
                       Current_Source := Previous_Source;
*************** package body Prj.Nmsc is
*** 4605,4629 ****
                       --  and the same kind (spec or body).
  
                       if The_Location = No_Location then
!                         The_Location := Projects.Table (Project).Location;
                       end if;
  
                       Err_Vars.Error_Msg_Name_1 := Unit_Name;
!                      Error_Msg (Project, "duplicate source {", The_Location);
  
                       Err_Vars.Error_Msg_Name_1 :=
!                        Projects.Table
                           (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
                       Err_Vars.Error_Msg_Name_2 :=
                         The_Unit_Data.File_Names (Unit_Kind).Path;
                       Error_Msg
!                        (Project, "\   project file {, {", The_Location);
  
                       Err_Vars.Error_Msg_Name_1 :=
!                        Projects.Table (Project).Name;
                       Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name;
                       Error_Msg
!                        (Project, "\   project file {, {", The_Location);
                    end if;
  
                 --  It is a new unit, create a new record
--- 5040,5069 ----
                       --  and the same kind (spec or body).
  
                       if The_Location = No_Location then
!                         The_Location :=
!                           In_Tree.Projects.Table
!                             (Project).Location;
                       end if;
  
                       Err_Vars.Error_Msg_Name_1 := Unit_Name;
!                      Error_Msg
!                        (Project, In_Tree, "duplicate source {", The_Location);
  
                       Err_Vars.Error_Msg_Name_1 :=
!                        In_Tree.Projects.Table
                           (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
                       Err_Vars.Error_Msg_Name_2 :=
                         The_Unit_Data.File_Names (Unit_Kind).Path;
                       Error_Msg
!                        (Project, In_Tree,
!                         "\   project file {, {", The_Location);
  
                       Err_Vars.Error_Msg_Name_1 :=
!                        In_Tree.Projects.Table (Project).Name;
                       Err_Vars.Error_Msg_Name_2 := Canonical_Path_Name;
                       Error_Msg
!                        (Project, In_Tree,
!                         "\   project file {, {", The_Location);
                    end if;
  
                 --  It is a new unit, create a new record
*************** package body Prj.Nmsc is
*** 4634,4658 ****
                    --  Of course, we do that only for the first unit in the
                    --  source file.
  
!                   Unit_Prj := Files_Htable.Get (Canonical_File_Name);
  
                    if not File_Name_Recorded and then
                      Unit_Prj /= No_Unit_Project
                    then
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg_Name_2 :=
!                        Projects.Table (Unit_Prj.Project).Name;
                       Error_Msg
!                        (Project,
                          "{ is already a source of project {",
                          Location);
  
                    else
!                      Units.Increment_Last;
!                      The_Unit := Units.Last;
!                      Units_Htable.Set (Unit_Name, The_Unit);
                       Unit_Prj := (Unit => The_Unit, Project => Project);
!                      Files_Htable.Set (Canonical_File_Name, Unit_Prj);
                       The_Unit_Data.Name := Unit_Name;
                       The_Unit_Data.File_Names (Unit_Kind) :=
                         (Name         => Canonical_File_Name,
--- 5074,5104 ----
                    --  Of course, we do that only for the first unit in the
                    --  source file.
  
!                   Unit_Prj := Files_Htable.Get
!                     (In_Tree.Files_HT, Canonical_File_Name);
  
                    if not File_Name_Recorded and then
                      Unit_Prj /= No_Unit_Project
                    then
                       Error_Msg_Name_1 := File_Name;
                       Error_Msg_Name_2 :=
!                        In_Tree.Projects.Table
!                          (Unit_Prj.Project).Name;
                       Error_Msg
!                        (Project, In_Tree,
                          "{ is already a source of project {",
                          Location);
  
                    else
!                      Unit_Table.Increment_Last (In_Tree.Units);
!                      The_Unit := Unit_Table.Last (In_Tree.Units);
!                      Units_Htable.Set
!                        (In_Tree.Units_HT, Unit_Name, The_Unit);
                       Unit_Prj := (Unit => The_Unit, Project => Project);
!                      Files_Htable.Set
!                        (In_Tree.Files_HT,
!                         Canonical_File_Name,
!                         Unit_Prj);
                       The_Unit_Data.Name := Unit_Name;
                       The_Unit_Data.File_Names (Unit_Kind) :=
                         (Name         => Canonical_File_Name,
*************** package body Prj.Nmsc is
*** 4662,4668 ****
                          Display_Path => Path_Name,
                          Project      => Project,
                          Needs_Pragma => Needs_Pragma);
!                      Units.Table (The_Unit) := The_Unit_Data;
                       Source_Recorded := True;
                    end if;
                 end if;
--- 5108,5115 ----
                          Display_Path => Path_Name,
                          Project      => Project,
                          Needs_Pragma => Needs_Pragma);
!                      In_Tree.Units.Table (The_Unit) :=
!                        The_Unit_Data;
                       Source_Recorded := True;
                    end if;
                 end if;
*************** package body Prj.Nmsc is
*** 4680,4685 ****
--- 5127,5133 ----
  
     procedure Record_Other_Sources
       (Project           : Project_Id;
+       In_Tree           : Project_Tree_Ref;
        Data              : in out Project_Data;
        Language          : Language_Index;
        Naming_Exceptions : Boolean)
*************** package body Prj.Nmsc is
*** 4697,4707 ****
  
        First_Error : Boolean := True;
  
!       Suffix : constant String := Body_Suffix_Of (Language, Data);
  
     begin
        while Source_Dir /= Nil_String loop
!          Element := String_Elements.Table (Source_Dir);
  
           declare
              Dir_Path : constant String := Get_Name_String (Element.Value);
--- 5145,5155 ----
  
        First_Error : Boolean := True;
  
!       Suffix : constant String := Body_Suffix_Of (Language, Data, In_Tree);
  
     begin
        while Source_Dir /= Nil_String loop
!          Element := In_Tree.String_Elements.Table (Source_Dir);
  
           declare
              Dir_Path : constant String := Get_Name_String (Element.Value);
*************** package body Prj.Nmsc is
*** 4743,4749 ****
                          if not Data.Known_Order_Of_Source_Dirs then
                             Error_Msg_Name_1 := Canonical_Name;
                             Error_Msg
!                              (Project,
                                "{ is found in several source directories",
                                NL.Location);
                          end if;
--- 5191,5197 ----
                          if not Data.Known_Order_Of_Source_Dirs then
                             Error_Msg_Name_1 := Canonical_Name;
                             Error_Msg
!                              (Project, In_Tree,
                                "{ is found in several source directories",
                                NL.Location);
                          end if;
*************** package body Prj.Nmsc is
*** 4761,4766 ****
--- 5209,5215 ----
                            (File_Name        => Canonical_Name,
                             Path_Name        => Path,
                             Project          => Project,
+                            In_Tree          => In_Tree,
                             Data             => Data,
                             Location         => NL.Location,
                             Language         => Language,
*************** package body Prj.Nmsc is
*** 4789,4802 ****
  
                 if First_Error then
                    Error_Msg
!                     (Project,
                       "source file { cannot be found",
                       NL.Location);
                    First_Error := False;
  
                 else
                    Error_Msg
!                     (Project,
                       "\source file { cannot be found",
                       NL.Location);
                 end if;
--- 5238,5251 ----
  
                 if First_Error then
                    Error_Msg
!                     (Project, In_Tree,
                       "source file { cannot be found",
                       NL.Location);
                    First_Error := False;
  
                 else
                    Error_Msg
!                     (Project, In_Tree,
                       "\source file { cannot be found",
                       NL.Location);
                 end if;
*************** package body Prj.Nmsc is
*** 4815,4821 ****
  
           begin
              while Source_Id /= No_Other_Source loop
!                Source := Other_Sources.Table (Source_Id);
  
                 if Source.Language = Language
                   and then Source.Naming_Exception
--- 5264,5270 ----
  
           begin
              while Source_Id /= No_Other_Source loop
!                Source := In_Tree.Other_Sources.Table (Source_Id);
  
                 if Source.Language = Language
                   and then Source.Naming_Exception
*************** package body Prj.Nmsc is
*** 4831,4837 ****
                       Data.First_Other_Source := Source.Next;
  
                    else
!                      Other_Sources.Table (Prev_Id).Next := Source.Next;
                    end if;
  
                    Source_Id := Source.Next;
--- 5280,5287 ----
                       Data.First_Other_Source := Source.Next;
  
                    else
!                      In_Tree.Other_Sources.Table
!                        (Prev_Id).Next := Source.Next;
                    end if;
  
                    Source_Id := Source.Next;
*************** package body Prj.Nmsc is
*** 4853,4867 ****
     -- Show_Source_Dirs --
     ----------------------
  
!    procedure Show_Source_Dirs (Project : Project_Id) is
!       Current : String_List_Id := Projects.Table (Project).Source_Dirs;
        Element : String_Element;
  
     begin
        Write_Line ("Source_Dirs:");
  
        while Current /= Nil_String loop
!          Element := String_Elements.Table (Current);
           Write_Str  ("   ");
           Write_Line (Get_Name_String (Element.Value));
           Current := Element.Next;
--- 5303,5321 ----
     -- Show_Source_Dirs --
     ----------------------
  
!    procedure Show_Source_Dirs
!      (Project : Project_Id;
!       In_Tree : Project_Tree_Ref)
!    is
!       Current : String_List_Id;
        Element : String_Element;
  
     begin
        Write_Line ("Source_Dirs:");
  
+       Current := In_Tree.Projects.Table (Project).Source_Dirs;
        while Current /= Nil_String loop
!          Element := In_Tree.String_Elements.Table (Current);
           Write_Str  ("   ");
           Write_Line (Get_Name_String (Element.Value));
           Current := Element.Next;
*************** package body Prj.Nmsc is
*** 4876,4888 ****
  
     function Suffix_For
       (Language : Language_Index;
!       Naming   : Naming_Data) return Name_Id
     is
        Suffix : constant Variable_Value :=
          Value_Of
            (Index     => Language_Names.Table (Language),
             Src_Index => 0,
!            In_Array  => Naming.Body_Suffix);
     begin
        --  If no suffix for this language in package Naming, use the default
  
--- 5330,5344 ----
  
     function Suffix_For
       (Language : Language_Index;
!       Naming   : Naming_Data;
!       In_Tree  : Project_Tree_Ref) return Name_Id
     is
        Suffix : constant Variable_Value :=
          Value_Of
            (Index     => Language_Names.Table (Language),
             Src_Index => 0,
!            In_Array  => Naming.Body_Suffix,
!            In_Tree   => In_Tree);
     begin
        --  If no suffix for this language in package Naming, use the default
  
*************** package body Prj.Nmsc is
*** 4897,4903 ****
                 Add_Str_To_Name_Buffer (".c");
  
              when C_Plus_Plus_Language_Index =>
!                Add_Str_To_Name_Buffer (".cc");
  
              when others =>
                 return No_Name;
--- 5353,5359 ----
                 Add_Str_To_Name_Buffer (".c");
  
              when C_Plus_Plus_Language_Index =>
!                Add_Str_To_Name_Buffer (".cpp");
  
              when others =>
                 return No_Name;
*************** package body Prj.Nmsc is
*** 4921,4926 ****
--- 5377,5383 ----
  
     procedure Warn_If_Not_Sources
       (Project     : Project_Id;
+       In_Tree     : Project_Tree_Ref;
        Conventions : Array_Element_Id;
        Specs       : Boolean;
        Extending   : Boolean)
*************** package body Prj.Nmsc is
*** 4933,4980 ****
  
     begin
        while Conv /= No_Array_Element loop
!          Unit := Array_Elements.Table (Conv).Index;
           Error_Msg_Name_1 := Unit;
           Get_Name_String (Unit);
           To_Lower (Name_Buffer (1 .. Name_Len));
           Unit := Name_Find;
!          The_Unit_Id := Units_Htable.Get (Unit);
!          Location := Array_Elements.Table (Conv).Value.Location;
  
!          if The_Unit_Id = Prj.Com.No_Unit then
              Error_Msg
!               (Project,
                 "?unknown unit {",
                 Location);
  
           else
!             The_Unit_Data := Units.Table (The_Unit_Id);
  
              if Specs then
                 if not Check_Project
                   (The_Unit_Data.File_Names (Specification).Project,
!                   Project, Extending)
                 then
                    Error_Msg
!                     (Project,
                       "?unit{ has no spec in this project",
                       Location);
                 end if;
  
              else
                 if not Check_Project
!                  (The_Unit_Data.File_Names (Com.Body_Part).Project,
!                   Project, Extending)
                 then
                    Error_Msg
!                     (Project,
                       "?unit{ has no body in this project",
                       Location);
                 end if;
              end if;
           end if;
  
!          Conv := Array_Elements.Table (Conv).Next;
        end loop;
     end Warn_If_Not_Sources;
  
--- 5390,5439 ----
  
     begin
        while Conv /= No_Array_Element loop
!          Unit := In_Tree.Array_Elements.Table (Conv).Index;
           Error_Msg_Name_1 := Unit;
           Get_Name_String (Unit);
           To_Lower (Name_Buffer (1 .. Name_Len));
           Unit := Name_Find;
!          The_Unit_Id := Units_Htable.Get
!            (In_Tree.Units_HT, Unit);
!          Location := In_Tree.Array_Elements.Table
!                                             (Conv).Value.Location;
  
!          if The_Unit_Id = No_Unit then
              Error_Msg
!               (Project, In_Tree,
                 "?unknown unit {",
                 Location);
  
           else
!             The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
  
              if Specs then
                 if not Check_Project
                   (The_Unit_Data.File_Names (Specification).Project,
!                   Project, In_Tree, Extending)
                 then
                    Error_Msg
!                     (Project, In_Tree,
                       "?unit{ has no spec in this project",
                       Location);
                 end if;
  
              else
                 if not Check_Project
!                  (The_Unit_Data.File_Names (Body_Part).Project,
!                   Project, In_Tree, Extending)
                 then
                    Error_Msg
!                     (Project, In_Tree,
                       "?unit{ has no body in this project",
                       Location);
                 end if;
              end if;
           end if;
  
!          Conv := In_Tree.Array_Elements.Table (Conv).Next;
        end loop;
     end Warn_If_Not_Sources;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-nmsc.ads gcc-4.1.0/gcc/ada/prj-nmsc.ads
*** gcc-4.0.2/gcc/ada/prj-nmsc.ads	Wed Dec  8 11:25:45 2004
--- gcc-4.1.0/gcc/ada/prj-nmsc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,30 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Check the Naming Scheme of a project file, find the source files.
  
  private package Prj.Nmsc is
  
--- 16,30 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Check the Naming Scheme of a project file, find the source files
  
  private package Prj.Nmsc is
  
*************** private package Prj.Nmsc is
*** 34,39 ****
--- 34,40 ----
  
     procedure Check
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Report_Error : Put_Line_Access;
        Follow_Links : Boolean);
     --  Check the object directory and the source directories
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-pars.adb gcc-4.1.0/gcc/ada/prj-pars.adb
*** gcc-4.0.2/gcc/ada/prj-pars.adb	Wed Dec  8 11:25:45 2004
--- gcc-4.1.0/gcc/ada/prj-pars.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Ada.Exceptions; use Ada.Exceptions;
*** 28,34 ****
  
  with Opt;
  with Output;   use Output;
- with Prj.Com;  use Prj.Com;
  with Prj.Err;  use Prj.Err;
  with Prj.Part;
  with Prj.Proc;
--- 28,33 ----
*************** package body Prj.Pars is
*** 41,72 ****
     -----------
  
     procedure Parse
!      (Project           : out Project_Id;
        Project_File_Name : String;
        Packages_To_Check : String_List_Access := All_Packages)
     is
!       Project_Tree      : Project_Node_Id := Empty_Node;
        The_Project       : Project_Id      := No_Project;
        Success           : Boolean         := True;
  
     begin
        --  Parse the main project file into a tree
  
        Prj.Part.Parse
!         (Project                => Project_Tree,
           Project_File_Name      => Project_File_Name,
           Always_Errout_Finalize => False,
           Packages_To_Check      => Packages_To_Check);
  
        --  If there were no error, process the tree
  
!       if Project_Tree /= Empty_Node then
           Prj.Proc.Process
!            (Project           => The_Project,
!             Success           => Success,
!             From_Project_Node => Project_Tree,
!             Report_Error      => null,
!             Follow_Links      => Opt.Follow_Links);
           Prj.Err.Finalize;
  
           if not Success then
--- 40,79 ----
     -----------
  
     procedure Parse
!      (In_Tree           : Project_Tree_Ref;
!       Project           : out Project_Id;
        Project_File_Name : String;
        Packages_To_Check : String_List_Access := All_Packages)
     is
!       Project_Node_Tree : constant Project_Node_Tree_Ref :=
!                             new Project_Node_Tree_Data;
!       Project_Node      : Project_Node_Id := Empty_Node;
        The_Project       : Project_Id      := No_Project;
        Success           : Boolean         := True;
  
     begin
+       Prj.Tree.Initialize (Project_Node_Tree);
+ 
        --  Parse the main project file into a tree
  
        Prj.Part.Parse
!         (In_Tree                => Project_Node_Tree,
!          Project                => Project_Node,
           Project_File_Name      => Project_File_Name,
           Always_Errout_Finalize => False,
           Packages_To_Check      => Packages_To_Check);
  
        --  If there were no error, process the tree
  
!       if Project_Node /= Empty_Node then
           Prj.Proc.Process
!            (In_Tree                => In_Tree,
!             Project                => The_Project,
!             Success                => Success,
!             From_Project_Node      => Project_Node,
!             From_Project_Node_Tree => Project_Node_Tree,
!             Report_Error           => null,
!             Follow_Links           => Opt.Follow_Links);
           Prj.Err.Finalize;
  
           if not Success then
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-pars.ads gcc-4.1.0/gcc/ada/prj-pars.ads
*** gcc-4.0.2/gcc/ada/prj-pars.ads	Wed Dec  8 11:25:45 2004
--- gcc-4.1.0/gcc/ada/prj-pars.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,43 ****
  
  --  Implements the parsing of project files
  
- with GNAT.OS_Lib; use GNAT.OS_Lib;
- 
  package Prj.Pars is
  
     procedure Set_Verbosity (To : Verbosity);
     --  Set the verbosity when parsing the project files
  
     procedure Parse
!      (Project           : out Project_Id;
        Project_File_Name : String;
        Packages_To_Check : String_List_Access := All_Packages);
!    --  Parse a project files and all its imported project files.
     --
     --  If parsing is successful, Project_Id is the project ID
     --  of the main project file; otherwise, Project_Id is set
--- 26,43 ----
  
  --  Implements the parsing of project files
  
  package Prj.Pars is
  
     procedure Set_Verbosity (To : Verbosity);
     --  Set the verbosity when parsing the project files
  
     procedure Parse
!      (In_Tree           : Project_Tree_Ref;
!       Project           : out Project_Id;
        Project_File_Name : String;
        Packages_To_Check : String_List_Access := All_Packages);
!    --  Parse a project files and all its imported project files, in the
!    --  project tree In_Tree.
     --
     --  If parsing is successful, Project_Id is the project ID
     --  of the main project file; otherwise, Project_Id is set
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-part.adb gcc-4.1.0/gcc/ada/prj-part.adb
*** gcc-4.0.2/gcc/ada/prj-part.adb	Wed Dec  8 11:25:45 2004
--- gcc-4.1.0/gcc/ada/prj-part.adb	Tue Nov 15 14:01:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Prj.Com;  use Prj.Com;
*** 33,57 ****
  with Prj.Dect;
  with Prj.Err;  use Prj.Err;
  with Prj.Ext;  use Prj.Ext;
- with Scans;    use Scans;
  with Sinput;   use Sinput;
  with Sinput.P; use Sinput.P;
  with Snames;
  with Table;
- with Types;    use Types;
  
  with Ada.Characters.Handling;    use Ada.Characters.Handling;
  with Ada.Exceptions;             use Ada.Exceptions;
  
  with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
- with GNAT.OS_Lib;                use GNAT.OS_Lib;
  
  with System.HTable;              use System.HTable;
  
- pragma Elaborate_All (GNAT.OS_Lib);
- 
  package body Prj.Part is
  
     Dir_Sep  : Character renames GNAT.OS_Lib.Directory_Separator;
  
     type Extension_Origin is (None, Extending_Simple, Extending_All);
--- 33,55 ----
  with Prj.Dect;
  with Prj.Err;  use Prj.Err;
  with Prj.Ext;  use Prj.Ext;
  with Sinput;   use Sinput;
  with Sinput.P; use Sinput.P;
  with Snames;
  with Table;
  
  with Ada.Characters.Handling;    use Ada.Characters.Handling;
  with Ada.Exceptions;             use Ada.Exceptions;
  
  with GNAT.Directory_Operations;  use GNAT.Directory_Operations;
  
  with System.HTable;              use System.HTable;
  
  package body Prj.Part is
  
+    Buffer      : String_Access;
+    Buffer_Last : Natural := 0;
+ 
     Dir_Sep  : Character renames GNAT.OS_Lib.Directory_Separator;
  
     type Extension_Origin is (None, Extending_Simple, Extending_All);
*************** package body Prj.Part is
*** 104,110 ****
     --  limited imported projects when there is a circularity with at least
     --  one limited imported project file.
  
!    package Virtual_Hash is new Simple_HTable
       (Header_Num => Header_Num,
        Element    => Project_Node_Id,
        No_Element => Empty_Node,
--- 102,108 ----
     --  limited imported projects when there is a circularity with at least
     --  one limited imported project file.
  
!    package Virtual_Hash is new System.HTable.Simple_HTable
       (Header_Num => Header_Num,
        Element    => Project_Node_Id,
        No_Element => Empty_Node,
*************** package body Prj.Part is
*** 114,120 ****
     --  Hash table to store the node id of the project for which a virtual
     --  extending project need to be created.
  
!    package Processed_Hash is new Simple_HTable
       (Header_Num => Header_Num,
        Element    => Boolean,
        No_Element => False,
--- 112,118 ----
     --  Hash table to store the node id of the project for which a virtual
     --  extending project need to be created.
  
!    package Processed_Hash is new System.HTable.Simple_HTable
       (Header_Num => Header_Num,
        Element    => Boolean,
        No_Element => False,
*************** package body Prj.Part is
*** 127,138 ****
  
     procedure Create_Virtual_Extending_Project
       (For_Project  : Project_Node_Id;
!       Main_Project : Project_Node_Id);
     --  Create a virtual extending project of For_Project. Main_Project is
     --  the extending all project.
  
     procedure Look_For_Virtual_Projects_For
       (Proj                : Project_Node_Id;
        Potentially_Virtual : Boolean);
     --  Look for projects that need to have a virtual extending project.
     --  This procedure is recursive. If called with Potentially_Virtual set to
--- 125,142 ----
  
     procedure Create_Virtual_Extending_Project
       (For_Project  : Project_Node_Id;
!       Main_Project : Project_Node_Id;
!       In_Tree      : Project_Node_Tree_Ref);
     --  Create a virtual extending project of For_Project. Main_Project is
     --  the extending all project.
+    --
+    --  The String_Value_Of is not set for the automatically added with
+    --  clause and keeps the default value of No_Name. This enables Prj.PP
+    --  to skip these automatically added with clauses to be processed.
  
     procedure Look_For_Virtual_Projects_For
       (Proj                : Project_Node_Id;
+       In_Tree             : Project_Node_Tree_Ref;
        Potentially_Virtual : Boolean);
     --  Look for projects that need to have a virtual extending project.
     --  This procedure is recursive. If called with Potentially_Virtual set to
*************** package body Prj.Part is
*** 140,146 ****
     --  does not (because it is already extended), but other projects that it
     --  imports may need to be virtually extended.
  
!    procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id);
     --  Parse the context clause of a project.
     --  Store the paths and locations of the imported projects in table Withs.
     --  Does nothing if there is no context clause (if the current
--- 144,152 ----
     --  does not (because it is already extended), but other projects that it
     --  imports may need to be virtually extended.
  
!    procedure Pre_Parse_Context_Clause
!      (In_Tree        : Project_Node_Tree_Ref;
!       Context_Clause : out With_Id);
     --  Parse the context clause of a project.
     --  Store the paths and locations of the imported projects in table Withs.
     --  Does nothing if there is no context clause (if the current
*************** package body Prj.Part is
*** 148,169 ****
  
     procedure Post_Parse_Context_Clause
       (Context_Clause    : With_Id;
        Imported_Projects : out Project_Node_Id;
        Project_Directory : Name_Id;
        From_Extended     : Extension_Origin;
!       In_Limited        : Boolean);
     --  Parse the imported projects that have been stored in table Withs,
     --  if any. From_Extended is used for the call to Parse_Single_Project
     --  below. When In_Limited is True, the importing path includes at least
     --  one "limited with".
  
     procedure Parse_Single_Project
!      (Project       : out Project_Node_Id;
!       Extends_All   : out Boolean;
!       Path_Name     : String;
!       Extended      : Boolean;
!       From_Extended : Extension_Origin;
!       In_Limited    : Boolean);
     --  Parse a project file.
     --  Recursive procedure: it calls itself for imported and extended
     --  projects. When From_Extended is not None, if the project has already
--- 154,179 ----
  
     procedure Post_Parse_Context_Clause
       (Context_Clause    : With_Id;
+       In_Tree           : Project_Node_Tree_Ref;
        Imported_Projects : out Project_Node_Id;
        Project_Directory : Name_Id;
        From_Extended     : Extension_Origin;
!       In_Limited        : Boolean;
!       Packages_To_Check : String_List_Access);
     --  Parse the imported projects that have been stored in table Withs,
     --  if any. From_Extended is used for the call to Parse_Single_Project
     --  below. When In_Limited is True, the importing path includes at least
     --  one "limited with".
  
     procedure Parse_Single_Project
!      (In_Tree           : Project_Node_Tree_Ref;
!       Project           : out Project_Node_Id;
!       Extends_All       : out Boolean;
!       Path_Name         : String;
!       Extended          : Boolean;
!       From_Extended     : Extension_Origin;
!       In_Limited        : Boolean;
!       Packages_To_Check : String_List_Access);
     --  Parse a project file.
     --  Recursive procedure: it calls itself for imported and extended
     --  projects. When From_Extended is not None, if the project has already
*************** package body Prj.Part is
*** 193,204 ****
  
     procedure Create_Virtual_Extending_Project
       (For_Project  : Project_Node_Id;
!       Main_Project : Project_Node_Id)
     is
  
        Virtual_Name : constant String :=
                         Virtual_Prefix &
!                          Get_Name_String (Name_Of (For_Project));
        --  The name of the virtual extending project
  
        Virtual_Name_Id : Name_Id;
--- 203,215 ----
  
     procedure Create_Virtual_Extending_Project
       (For_Project  : Project_Node_Id;
!       Main_Project : Project_Node_Id;
!       In_Tree      : Project_Node_Tree_Ref)
     is
  
        Virtual_Name : constant String :=
                         Virtual_Prefix &
!                          Get_Name_String (Name_Of (For_Project, In_Tree));
        --  The name of the virtual extending project
  
        Virtual_Name_Id : Name_Id;
*************** package body Prj.Part is
*** 209,215 ****
        --  the same directory as the extending all project.
  
        Virtual_Dir_Id  : constant Name_Id :=
!                           Immediate_Directory_Of (Path_Name_Of (Main_Project));
        --  The directory of the extending all project
  
        --  The source of the virtual extending project is something like:
--- 220,226 ----
        --  the same directory as the extending all project.
  
        Virtual_Dir_Id  : constant Name_Id :=
!         Immediate_Directory_Of (Path_Name_Of (Main_Project, In_Tree));
        --  The directory of the extending all project
  
        --  The source of the virtual extending project is something like:
*************** package body Prj.Part is
*** 226,248 ****
        --  Nodes that made up the virtual extending project
  
        Virtual_Project         : constant Project_Node_Id :=
!                                   Default_Project_Node (N_Project);
        With_Clause             : constant Project_Node_Id :=
!                                   Default_Project_Node (N_With_Clause);
        Project_Declaration     : constant Project_Node_Id :=
!                                   Default_Project_Node (N_Project_Declaration);
        Source_Dirs_Declaration : constant Project_Node_Id :=
!                                   Default_Project_Node (N_Declarative_Item);
        Source_Dirs_Attribute   : constant Project_Node_Id :=
                                    Default_Project_Node
!                                     (N_Attribute_Declaration, List);
        Source_Dirs_Expression  : constant Project_Node_Id :=
!                                   Default_Project_Node (N_Expression, List);
        Source_Dirs_Term        : constant Project_Node_Id :=
!                                   Default_Project_Node (N_Term, List);
        Source_Dirs_List        : constant Project_Node_Id :=
                                    Default_Project_Node
!                                     (N_Literal_String_List, List);
  
     begin
        --  Get the virtual name id
--- 237,265 ----
        --  Nodes that made up the virtual extending project
  
        Virtual_Project         : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_Project);
        With_Clause             : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_With_Clause);
        Project_Declaration     : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_Project_Declaration);
        Source_Dirs_Declaration : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_Declarative_Item);
        Source_Dirs_Attribute   : constant Project_Node_Id :=
                                    Default_Project_Node
!                                     (In_Tree, N_Attribute_Declaration, List);
        Source_Dirs_Expression  : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_Expression, List);
        Source_Dirs_Term        : constant Project_Node_Id :=
!                                   Default_Project_Node
!                                     (In_Tree, N_Term, List);
        Source_Dirs_List        : constant Project_Node_Id :=
                                    Default_Project_Node
!                                     (In_Tree, N_Literal_String_List, List);
  
     begin
        --  Get the virtual name id
*************** package body Prj.Part is
*** 253,259 ****
  
        --  Get the virtual path name
  
!       Get_Name_String (Path_Name_Of (Main_Project));
  
        while Name_Len > 0
          and then Name_Buffer (Name_Len) /= Directory_Separator
--- 270,276 ----
  
        --  Get the virtual path name
  
!       Get_Name_String (Path_Name_Of (Main_Project, In_Tree));
  
        while Name_Len > 0
          and then Name_Buffer (Name_Len) /= Directory_Separator
*************** package body Prj.Part is
*** 269,316 ****
  
        --  With clause
  
!       Set_Name_Of (With_Clause, Virtual_Name_Id);
!       Set_Path_Name_Of (With_Clause, Virtual_Path_Id);
!       Set_Project_Node_Of (With_Clause, Virtual_Project);
        Set_Next_With_Clause_Of
!         (With_Clause, First_With_Clause_Of (Main_Project));
!       Set_First_With_Clause_Of (Main_Project, With_Clause);
  
        --  Virtual project node
  
!       Set_Name_Of (Virtual_Project, Virtual_Name_Id);
!       Set_Path_Name_Of (Virtual_Project, Virtual_Path_Id);
!       Set_Location_Of (Virtual_Project, Location_Of (Main_Project));
!       Set_Directory_Of (Virtual_Project, Virtual_Dir_Id);
!       Set_Project_Declaration_Of (Virtual_Project, Project_Declaration);
        Set_Extended_Project_Path_Of
!         (Virtual_Project, Path_Name_Of (For_Project));
  
        --  Project declaration
  
        Set_First_Declarative_Item_Of
!         (Project_Declaration, Source_Dirs_Declaration);
!       Set_Extended_Project_Of (Project_Declaration, For_Project);
  
        --  Source_Dirs declaration
  
!       Set_Current_Item_Node (Source_Dirs_Declaration, Source_Dirs_Attribute);
  
        --  Source_Dirs attribute
  
!       Set_Name_Of (Source_Dirs_Attribute, Snames.Name_Source_Dirs);
!       Set_Expression_Of (Source_Dirs_Attribute, Source_Dirs_Expression);
  
        --  Source_Dirs expression
  
!       Set_First_Term (Source_Dirs_Expression, Source_Dirs_Term);
  
        --  Source_Dirs term
  
!       Set_Current_Term (Source_Dirs_Term, Source_Dirs_List);
  
        --  Source_Dirs empty list: nothing to do
  
     end Create_Virtual_Extending_Project;
  
     ----------------------------
--- 286,346 ----
  
        --  With clause
  
!       Set_Name_Of (With_Clause, In_Tree, Virtual_Name_Id);
!       Set_Path_Name_Of (With_Clause, In_Tree, Virtual_Path_Id);
!       Set_Project_Node_Of (With_Clause, In_Tree, Virtual_Project);
        Set_Next_With_Clause_Of
!         (With_Clause, In_Tree, First_With_Clause_Of (Main_Project, In_Tree));
!       Set_First_With_Clause_Of (Main_Project, In_Tree, With_Clause);
  
        --  Virtual project node
  
!       Set_Name_Of (Virtual_Project, In_Tree, Virtual_Name_Id);
!       Set_Path_Name_Of (Virtual_Project, In_Tree, Virtual_Path_Id);
!       Set_Location_Of
!         (Virtual_Project, In_Tree, Location_Of (Main_Project, In_Tree));
!       Set_Directory_Of (Virtual_Project, In_Tree, Virtual_Dir_Id);
!       Set_Project_Declaration_Of
!         (Virtual_Project, In_Tree, Project_Declaration);
        Set_Extended_Project_Path_Of
!         (Virtual_Project, In_Tree, Path_Name_Of (For_Project, In_Tree));
  
        --  Project declaration
  
        Set_First_Declarative_Item_Of
!         (Project_Declaration, In_Tree, Source_Dirs_Declaration);
!       Set_Extended_Project_Of (Project_Declaration, In_Tree, For_Project);
  
        --  Source_Dirs declaration
  
!       Set_Current_Item_Node
!         (Source_Dirs_Declaration, In_Tree, Source_Dirs_Attribute);
  
        --  Source_Dirs attribute
  
!       Set_Name_Of (Source_Dirs_Attribute, In_Tree, Snames.Name_Source_Dirs);
!       Set_Expression_Of
!         (Source_Dirs_Attribute, In_Tree, Source_Dirs_Expression);
  
        --  Source_Dirs expression
  
!       Set_First_Term (Source_Dirs_Expression, In_Tree, Source_Dirs_Term);
  
        --  Source_Dirs term
  
!       Set_Current_Term (Source_Dirs_Term, In_Tree, Source_Dirs_List);
  
        --  Source_Dirs empty list: nothing to do
  
+       --  Put virtual project into Projects_Htable
+ 
+       Prj.Tree.Tree_Private_Part.Projects_Htable.Set
+         (T => In_Tree.Projects_HT,
+          K => Virtual_Name_Id,
+          E => (Name           => Virtual_Name_Id,
+                Node           => Virtual_Project,
+                Canonical_Path => No_Name,
+                Extended       => False));
     end Create_Virtual_Extending_Project;
  
     ----------------------------
*************** package body Prj.Part is
*** 352,357 ****
--- 382,388 ----
  
     procedure Look_For_Virtual_Projects_For
       (Proj                : Project_Node_Id;
+       In_Tree             : Project_Node_Tree_Ref;
        Potentially_Virtual : Boolean)
  
     is
*************** package body Prj.Part is
*** 376,385 ****
  
           Processed_Hash.Set (Proj, True);
  
!          Declaration := Project_Declaration_Of (Proj);
  
           if Declaration /= Empty_Node then
!             Extended := Extended_Project_Of (Declaration);
           end if;
  
           --  If this is a project that may need a virtual extending project
--- 407,416 ----
  
           Processed_Hash.Set (Proj, True);
  
!          Declaration := Project_Declaration_Of (Proj, In_Tree);
  
           if Declaration /= Empty_Node then
!             Extended := Extended_Project_Of (Declaration, In_Tree);
           end if;
  
           --  If this is a project that may need a virtual extending project
*************** package body Prj.Part is
*** 391,407 ****
  
           --  Now check the projects it imports
  
!          With_Clause := First_With_Clause_Of (Proj);
  
           while With_Clause /= Empty_Node loop
!             Imported := Project_Node_Of (With_Clause);
  
              if Imported /= Empty_Node then
                 Look_For_Virtual_Projects_For
!                  (Imported, Potentially_Virtual => True);
              end if;
  
!             With_Clause := Next_With_Clause_Of (With_Clause);
           end loop;
  
           --  Check also the eventual project extended by Proj. As this project
--- 422,438 ----
  
           --  Now check the projects it imports
  
!          With_Clause := First_With_Clause_Of (Proj, In_Tree);
  
           while With_Clause /= Empty_Node loop
!             Imported := Project_Node_Of (With_Clause, In_Tree);
  
              if Imported /= Empty_Node then
                 Look_For_Virtual_Projects_For
!                  (Imported, In_Tree, Potentially_Virtual => True);
              end if;
  
!             With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
           end loop;
  
           --  Check also the eventual project extended by Proj. As this project
*************** package body Prj.Part is
*** 409,415 ****
           --  being False.
  
           Look_For_Virtual_Projects_For
!            (Extended, Potentially_Virtual => False);
        end if;
     end Look_For_Virtual_Projects_For;
  
--- 440,446 ----
           --  being False.
  
           Look_For_Virtual_Projects_For
!            (Extended, In_Tree, Potentially_Virtual => False);
        end if;
     end Look_For_Virtual_Projects_For;
  
*************** package body Prj.Part is
*** 418,424 ****
     -----------
  
     procedure Parse
!      (Project                : out Project_Node_Id;
        Project_File_Name      : String;
        Always_Errout_Finalize : Boolean;
        Packages_To_Check      : String_List_Access := All_Packages;
--- 449,456 ----
     -----------
  
     procedure Parse
!      (In_Tree                : Project_Node_Tree_Ref;
!       Project                : out Project_Node_Id;
        Project_File_Name      : String;
        Always_Errout_Finalize : Boolean;
        Packages_To_Check      : String_List_Access := All_Packages;
*************** package body Prj.Part is
*** 428,438 ****
        Dummy : Boolean;
  
     begin
-       --  Save the Packages_To_Check in Prj, so that it is visible from
-       --  Prj.Dect.
- 
-       Current_Packages_To_Check := Packages_To_Check;
- 
        Project := Empty_Node;
  
        if Current_Verbosity >= Medium then
--- 460,465 ----
*************** package body Prj.Part is
*** 461,478 ****
           end if;
  
           Parse_Single_Project
!            (Project       => Project,
!             Extends_All   => Dummy,
!             Path_Name     => Path_Name,
!             Extended      => False,
!             From_Extended => None,
!             In_Limited    => False);
  
           --  If Project is an extending-all project, create the eventual
           --  virtual extending projects and check that there are no illegally
           --  imported projects.
  
!          if Project /= Empty_Node and then Is_Extending_All (Project) then
              --  First look for projects that potentially need a virtual
              --  extending project.
  
--- 488,509 ----
           end if;
  
           Parse_Single_Project
!            (In_Tree           => In_Tree,
!             Project           => Project,
!             Extends_All       => Dummy,
!             Path_Name         => Path_Name,
!             Extended          => False,
!             From_Extended     => None,
!             In_Limited        => False,
!             Packages_To_Check => Packages_To_Check);
  
           --  If Project is an extending-all project, create the eventual
           --  virtual extending projects and check that there are no illegally
           --  imported projects.
  
!          if Project /= Empty_Node
!            and then Is_Extending_All (Project, In_Tree)
!          then
              --  First look for projects that potentially need a virtual
              --  extending project.
  
*************** package body Prj.Part is
*** 487,496 ****
  
              declare
                 Declaration : constant Project_Node_Id :=
!                  Project_Declaration_Of (Project);
              begin
                 Look_For_Virtual_Projects_For
!                  (Extended_Project_Of (Declaration),
                    Potentially_Virtual => False);
              end;
  
--- 518,527 ----
  
              declare
                 Declaration : constant Project_Node_Id :=
!                                Project_Declaration_Of (Project, In_Tree);
              begin
                 Look_For_Virtual_Projects_For
!                  (Extended_Project_Of (Declaration, In_Tree), In_Tree,
                    Potentially_Virtual => False);
              end;
  
*************** package body Prj.Part is
*** 501,530 ****
              --  the project being "extended-all" by the main project.
  
              declare
!                With_Clause : Project_Node_Id :=
!                  First_With_Clause_Of (Project);
                 Imported    : Project_Node_Id := Empty_Node;
                 Declaration : Project_Node_Id := Empty_Node;
  
              begin
                 while With_Clause /= Empty_Node loop
!                   Imported := Project_Node_Of (With_Clause);
  
                    if Imported /= Empty_Node then
!                      Declaration := Project_Declaration_Of (Imported);
  
!                      if Extended_Project_Of (Declaration) /= Empty_Node then
                          loop
!                            Imported := Extended_Project_Of (Declaration);
                             exit when Imported = Empty_Node;
                             Virtual_Hash.Remove (Imported);
!                            Declaration := Project_Declaration_Of (Imported);
                          end loop;
                       end if;
- 
                    end if;
  
!                   With_Clause := Next_With_Clause_Of (With_Clause);
                 end loop;
              end;
  
--- 532,564 ----
              --  the project being "extended-all" by the main project.
  
              declare
!                With_Clause : Project_Node_Id;
                 Imported    : Project_Node_Id := Empty_Node;
                 Declaration : Project_Node_Id := Empty_Node;
  
              begin
+                With_Clause := First_With_Clause_Of (Project, In_Tree);
                 while With_Clause /= Empty_Node loop
!                   Imported := Project_Node_Of (With_Clause, In_Tree);
  
                    if Imported /= Empty_Node then
!                      Declaration := Project_Declaration_Of (Imported, In_Tree);
  
!                      if Extended_Project_Of (Declaration, In_Tree) /=
!                                Empty_Node
!                      then
                          loop
!                            Imported :=
!                              Extended_Project_Of (Declaration, In_Tree);
                             exit when Imported = Empty_Node;
                             Virtual_Hash.Remove (Imported);
!                            Declaration :=
!                              Project_Declaration_Of (Imported, In_Tree);
                          end loop;
                       end if;
                    end if;
  
!                   With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
                 end loop;
              end;
  
*************** package body Prj.Part is
*** 534,540 ****
                 Proj : Project_Node_Id := Virtual_Hash.Get_First;
              begin
                 while Proj /= Empty_Node loop
!                   Create_Virtual_Extending_Project (Proj, Project);
                    Proj := Virtual_Hash.Get_Next;
                 end loop;
              end;
--- 568,574 ----
                 Proj : Project_Node_Id := Virtual_Hash.Get_First;
              begin
                 while Proj /= Empty_Node loop
!                   Create_Virtual_Extending_Project (Proj, Project, In_Tree);
                    Proj := Virtual_Hash.Get_Next;
                 end loop;
              end;
*************** package body Prj.Part is
*** 568,574 ****
     -- Pre_Parse_Context_Clause --
     ------------------------------
  
!    procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is
        Current_With_Clause    : With_Id := No_With;
        Limited_With           : Boolean         := False;
  
--- 602,611 ----
     -- Pre_Parse_Context_Clause --
     ------------------------------
  
!    procedure Pre_Parse_Context_Clause
!      (In_Tree        : Project_Node_Tree_Ref;
!       Context_Clause : out With_Id)
!    is
        Current_With_Clause    : With_Id := No_With;
        Limited_With           : Boolean         := False;
  
*************** package body Prj.Part is
*** 582,603 ****
        Context_Clause := No_With;
        With_Loop :
  
!       --  If Token is not WITH or LIMITED, there is no context clause,
!       --  or we have exhausted the with clauses.
  
        while Token = Tok_With or else Token = Tok_Limited loop
!          Current_With_Node := Default_Project_Node (Of_Kind => N_With_Clause);
           Limited_With := Token = Tok_Limited;
  
           if Limited_With then
!             Scan;  --  scan past LIMITED
              Expect (Tok_With, "WITH");
              exit With_Loop when Token /= Tok_With;
           end if;
  
           Comma_Loop :
           loop
!             Scan; -- scan past WITH or ","
  
              Expect (Tok_String_Literal, "literal string");
  
--- 619,641 ----
        Context_Clause := No_With;
        With_Loop :
  
!       --  If Token is not WITH or LIMITED, there is no context clause, or we
!       --  have exhausted the with clauses.
  
        while Token = Tok_With or else Token = Tok_Limited loop
!          Current_With_Node :=
!            Default_Project_Node (Of_Kind => N_With_Clause, In_Tree => In_Tree);
           Limited_With := Token = Tok_Limited;
  
           if Limited_With then
!             Scan (In_Tree);  --  scan past LIMITED
              Expect (Tok_With, "WITH");
              exit With_Loop when Token /= Tok_With;
           end if;
  
           Comma_Loop :
           loop
!             Scan (In_Tree); -- scan past WITH or ","
  
              Expect (Tok_String_Literal, "literal string");
  
*************** package body Prj.Part is
*** 626,632 ****
  
              Current_With_Clause := Withs.Last;
  
!             Scan;
  
              if Token = Tok_Semicolon then
                 Set_End_Of_Line (Current_With_Node);
--- 664,670 ----
  
              Current_With_Clause := Withs.Last;
  
!             Scan (In_Tree);
  
              if Token = Tok_Semicolon then
                 Set_End_Of_Line (Current_With_Node);
*************** package body Prj.Part is
*** 634,664 ****
  
                 --  End of (possibly multiple) with clause;
  
!                Scan; -- scan past the semicolon.
                 exit Comma_Loop;
  
!             elsif Token /= Tok_Comma then
                 Error_Msg ("expected comma or semi colon", Token_Ptr);
                 exit Comma_Loop;
              end if;
  
              Current_With_Node :=
!               Default_Project_Node (Of_Kind => N_With_Clause);
           end loop Comma_Loop;
        end loop With_Loop;
     end Pre_Parse_Context_Clause;
  
- 
     -------------------------------
     -- Post_Parse_Context_Clause --
     -------------------------------
  
     procedure Post_Parse_Context_Clause
       (Context_Clause    : With_Id;
        Imported_Projects : out Project_Node_Id;
        Project_Directory : Name_Id;
        From_Extended     : Extension_Origin;
!       In_Limited        : Boolean)
     is
        Current_With_Clause : With_Id := Context_Clause;
  
--- 672,707 ----
  
                 --  End of (possibly multiple) with clause;
  
!                Scan (In_Tree); -- scan past the semicolon.
                 exit Comma_Loop;
  
!             elsif Token = Tok_Comma then
!                Set_Is_Not_Last_In_List (Current_With_Node, In_Tree);
! 
!             else
                 Error_Msg ("expected comma or semi colon", Token_Ptr);
                 exit Comma_Loop;
              end if;
  
              Current_With_Node :=
!               Default_Project_Node
!                 (Of_Kind => N_With_Clause, In_Tree => In_Tree);
           end loop Comma_Loop;
        end loop With_Loop;
     end Pre_Parse_Context_Clause;
  
     -------------------------------
     -- Post_Parse_Context_Clause --
     -------------------------------
  
     procedure Post_Parse_Context_Clause
       (Context_Clause    : With_Id;
+       In_Tree           : Project_Node_Tree_Ref;
        Imported_Projects : out Project_Node_Id;
        Project_Directory : Name_Id;
        From_Extended     : Extension_Origin;
!       In_Limited        : Boolean;
!       Packages_To_Check : String_List_Access)
     is
        Current_With_Clause : With_Id := Context_Clause;
  
*************** package body Prj.Part is
*** 684,695 ****
  
           declare
              Original_Path : constant String :=
!                                  Get_Name_String (Current_With.Path);
  
              Imported_Path_Name : constant String :=
                                     Project_Path_Name_Of
!                                      (Original_Path,
!                                       Project_Directory_Path);
  
              Resolved_Path : constant String :=
                                Normalize_Pathname
--- 727,737 ----
  
           declare
              Original_Path : constant String :=
!                               Get_Name_String (Current_With.Path);
  
              Imported_Path_Name : constant String :=
                                     Project_Path_Name_Of
!                                      (Original_Path, Project_Directory_Path);
  
              Resolved_Path : constant String :=
                                Normalize_Pathname
*************** package body Prj.Part is
*** 732,744 ****
  
                 else
                    Next_Project := Current_With.Node;
!                   Set_Next_With_Clause_Of (Current_Project, Next_Project);
                    Current_Project := Next_Project;
                 end if;
  
                 Set_String_Value_Of
!                  (Current_Project, Current_With.Path);
!                Set_Location_Of (Current_Project, Current_With.Location);
  
                 --  If this is a "limited with", check if we have a circularity.
                 --  If we have one, get the project id of the limited imported
--- 774,788 ----
  
                 else
                    Next_Project := Current_With.Node;
!                   Set_Next_With_Clause_Of
!                     (Current_Project, In_Tree, Next_Project);
                    Current_Project := Next_Project;
                 end if;
  
                 Set_String_Value_Of
!                  (Current_Project, In_Tree, Current_With.Path);
!                Set_Location_Of
!                  (Current_Project, In_Tree, Current_With.Location);
  
                 --  If this is a "limited with", check if we have a circularity.
                 --  If we have one, get the project id of the limited imported
*************** package body Prj.Part is
*** 772,786 ****
  
                 if Withed_Project = Empty_Node then
                    Parse_Single_Project
!                     (Project       => Withed_Project,
!                      Extends_All   => Extends_All,
!                      Path_Name     => Imported_Path_Name,
!                      Extended      => False,
!                      From_Extended => From_Extended,
!                      In_Limited    => Limited_With);
  
                 else
!                   Extends_All := Is_Extending_All (Withed_Project);
                 end if;
  
                 if Withed_Project = Empty_Node then
--- 816,832 ----
  
                 if Withed_Project = Empty_Node then
                    Parse_Single_Project
!                     (In_Tree           => In_Tree,
!                      Project           => Withed_Project,
!                      Extends_All       => Extends_All,
!                      Path_Name         => Imported_Path_Name,
!                      Extended          => False,
!                      From_Extended     => From_Extended,
!                      In_Limited        => Limited_With,
!                      Packages_To_Check => Packages_To_Check);
  
                 else
!                   Extends_All := Is_Extending_All (Withed_Project, In_Tree);
                 end if;
  
                 if Withed_Project = Empty_Node then
*************** package body Prj.Part is
*** 794,800 ****
  
                    else
                       Set_Next_With_Clause_Of
!                        (Current_Project, Empty_Node);
                    end if;
                 else
                    --  If parsing was successful, record project name
--- 840,846 ----
  
                    else
                       Set_Next_With_Clause_Of
!                        (Current_Project, In_Tree, Empty_Node);
                    end if;
                 else
                    --  If parsing was successful, record project name
*************** package body Prj.Part is
*** 802,817 ****
  
                    Set_Project_Node_Of
                      (Node         => Current_Project,
                       To           => Withed_Project,
!                      Limited_With => Limited_With);
!                   Set_Name_Of (Current_Project, Name_Of (Withed_Project));
  
                    Name_Len := Resolved_Path'Length;
                    Name_Buffer (1 .. Name_Len) := Resolved_Path;
!                   Set_Path_Name_Of (Current_Project, Name_Find);
  
                    if Extends_All then
!                      Set_Is_Extending_All (Current_Project);
                    end if;
                 end if;
              end if;
--- 848,867 ----
  
                    Set_Project_Node_Of
                      (Node         => Current_Project,
+                      In_Tree      => In_Tree,
                       To           => Withed_Project,
!                      Limited_With => Current_With.Limited_With);
!                   Set_Name_Of
!                     (Current_Project,
!                      In_Tree,
!                      Name_Of (Withed_Project, In_Tree));
  
                    Name_Len := Resolved_Path'Length;
                    Name_Buffer (1 .. Name_Len) := Resolved_Path;
!                   Set_Path_Name_Of (Current_Project, In_Tree, Name_Find);
  
                    if Extends_All then
!                      Set_Is_Extending_All (Current_Project, In_Tree);
                    end if;
                 end if;
              end if;
*************** package body Prj.Part is
*** 824,835 ****
     --------------------------
  
     procedure Parse_Single_Project
!      (Project       : out Project_Node_Id;
!       Extends_All   : out Boolean;
!       Path_Name     : String;
!       Extended      : Boolean;
!       From_Extended : Extension_Origin;
!       In_Limited    : Boolean)
     is
        Normed_Path_Name    : Name_Id;
        Canonical_Path_Name : Name_Id;
--- 874,887 ----
     --------------------------
  
     procedure Parse_Single_Project
!      (In_Tree           : Project_Node_Tree_Ref;
!       Project           : out Project_Node_Id;
!       Extends_All       : out Boolean;
!       Path_Name         : String;
!       Extended          : Boolean;
!       From_Extended     : Extension_Origin;
!       In_Limited        : Boolean;
!       Packages_To_Check : String_List_Access)
     is
        Normed_Path_Name    : Name_Id;
        Canonical_Path_Name : Name_Id;
*************** package body Prj.Part is
*** 842,848 ****
        Extended_Project    : Project_Node_Id := Empty_Node;
  
        A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
!                                   Tree_Private_Part.Projects_Htable.Get_First;
  
        Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
  
--- 894,901 ----
        Extended_Project    : Project_Node_Id := Empty_Node;
  
        A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
!                                   Tree_Private_Part.Projects_Htable.Get_First
!                                     (In_Tree.Projects_HT);
  
        Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
  
*************** package body Prj.Part is
*** 931,937 ****
  
              elsif A_Project_Name_And_Node.Extended then
                 Extends_All :=
!                  Is_Extending_All (A_Project_Name_And_Node.Node);
  
                 --  If the imported project is an extended project A,
                 --  and we are in an extended project, replace A with the
--- 984,990 ----
  
              elsif A_Project_Name_And_Node.Extended then
                 Extends_All :=
!                  Is_Extending_All (A_Project_Name_And_Node.Node, In_Tree);
  
                 --  If the imported project is an extended project A,
                 --  and we are in an extended project, replace A with the
*************** package body Prj.Part is
*** 941,955 ****
                    declare
                       Decl : Project_Node_Id :=
                                Project_Declaration_Of
!                                 (A_Project_Name_And_Node.Node);
  
!                      Prj  : Project_Node_Id := Extending_Project_Of (Decl);
  
                    begin
                       loop
!                         Decl := Project_Declaration_Of (Prj);
!                         exit when Extending_Project_Of (Decl) = Empty_Node;
!                         Prj := Extending_Project_Of (Decl);
                       end loop;
  
                       A_Project_Name_And_Node.Node := Prj;
--- 994,1010 ----
                    declare
                       Decl : Project_Node_Id :=
                                Project_Declaration_Of
!                                 (A_Project_Name_And_Node.Node, In_Tree);
  
!                      Prj  : Project_Node_Id :=
!                               Extending_Project_Of (Decl, In_Tree);
  
                    begin
                       loop
!                         Decl := Project_Declaration_Of (Prj, In_Tree);
!                         exit when Extending_Project_Of (Decl, In_Tree) =
!                           Empty_Node;
!                         Prj := Extending_Project_Of (Decl, In_Tree);
                       end loop;
  
                       A_Project_Name_And_Node.Node := Prj;
*************** package body Prj.Part is
*** 966,972 ****
              return;
           end if;
  
!          A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
        end loop;
  
        --  We never encountered this project file
--- 1021,1028 ----
              return;
           end if;
  
!          A_Project_Name_And_Node :=
!            Tree_Private_Part.Projects_Htable.Get_Next (In_Tree.Projects_HT);
        end loop;
  
        --  We never encountered this project file
*************** package body Prj.Part is
*** 986,992 ****
  
        Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
        Tree.Reset_State;
!       Scan;
  
        if Name_From_Path = No_Name then
  
--- 1042,1048 ----
  
        Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
        Tree.Reset_State;
!       Scan (In_Tree);
  
        if Name_From_Path = No_Name then
  
*************** package body Prj.Part is
*** 1007,1028 ****
  
        --  Is there any imported project?
  
!       Pre_Parse_Context_Clause (First_With);
  
        Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
!       Project := Default_Project_Node (Of_Kind => N_Project);
        Project_Stack.Table (Project_Stack.Last).Id := Project;
!       Set_Directory_Of (Project, Project_Directory);
!       Set_Path_Name_Of (Project, Normed_Path_Name);
!       Set_Location_Of (Project, Token_Ptr);
  
        Expect (Tok_Project, "PROJECT");
  
        --  Mark location of PROJECT token if present
  
        if Token = Tok_Project then
!          Set_Location_Of (Project, Token_Ptr);
!          Scan; -- scan past project
        end if;
  
        --  Clear the Buffer
--- 1063,1085 ----
  
        --  Is there any imported project?
  
!       Pre_Parse_Context_Clause (In_Tree, First_With);
  
        Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
!       Project := Default_Project_Node
!                    (Of_Kind => N_Project, In_Tree => In_Tree);
        Project_Stack.Table (Project_Stack.Last).Id := Project;
!       Set_Directory_Of (Project, In_Tree, Project_Directory);
!       Set_Path_Name_Of (Project, In_Tree,  Normed_Path_Name);
!       Set_Location_Of (Project, In_Tree, Token_Ptr);
  
        Expect (Tok_Project, "PROJECT");
  
        --  Mark location of PROJECT token if present
  
        if Token = Tok_Project then
!          Scan (In_Tree); -- scan past PROJECT
!          Set_Location_Of (Project, In_Tree, Token_Ptr);
        end if;
  
        --  Clear the Buffer
*************** package body Prj.Part is
*** 1042,1062 ****
           --  Add the identifier name to the buffer
  
           Get_Name_String (Token_Name);
!          Add_To_Buffer (Name_Buffer (1 .. Name_Len));
  
           --  Scan past the identifier
  
!          Scan;
  
           --  If we have a dot, add a dot the the Buffer and look for the next
           --  identifier.
  
           exit when Token /= Tok_Dot;
!          Add_To_Buffer (".");
  
           --  Scan past the dot
  
!          Scan;
        end loop;
  
        --  See if this is an extending project
--- 1099,1119 ----
           --  Add the identifier name to the buffer
  
           Get_Name_String (Token_Name);
!          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
  
           --  Scan past the identifier
  
!          Scan (In_Tree);
  
           --  If we have a dot, add a dot the the Buffer and look for the next
           --  identifier.
  
           exit when Token /= Tok_Dot;
!          Add_To_Buffer (".", Buffer, Buffer_Last);
  
           --  Scan past the dot
  
!          Scan (In_Tree);
        end loop;
  
        --  See if this is an extending project
*************** package body Prj.Part is
*** 1071,1082 ****
  
           Extending := True;
  
!          Scan; -- scan past EXTENDS
  
           if Token = Tok_All then
              Extends_All := True;
!             Set_Is_Extending_All (Project);
!             Scan; --  scan past ALL
           end if;
        end if;
  
--- 1128,1139 ----
  
           Extending := True;
  
!          Scan (In_Tree); -- scan past EXTENDS
  
           if Token = Tok_All then
              Extends_All := True;
!             Set_Is_Extending_All (Project, In_Tree);
!             Scan (In_Tree); --  scan past ALL
           end if;
        end if;
  
*************** package body Prj.Part is
*** 1089,1095 ****
           Name_Len := Buffer_Last;
           Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
           Name_Of_Project := Name_Find;
!          Set_Name_Of (Project, Name_Of_Project);
  
           --  To get expected name of the project file, replace dots by dashes
  
--- 1146,1152 ----
           Name_Len := Buffer_Last;
           Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
           Name_Of_Project := Name_Find;
!          Set_Name_Of (Project, In_Tree, Name_Of_Project);
  
           --  To get expected name of the project file, replace dots by dashes
  
*************** package body Prj.Part is
*** 1138,1154 ****
              end if;
  
              Post_Parse_Context_Clause
!               (Context_Clause    => First_With,
                 Imported_Projects => Imported_Projects,
                 Project_Directory => Project_Directory,
                 From_Extended     => From_Ext,
!                In_Limited        => In_Limited);
!             Set_First_With_Clause_Of (Project, Imported_Projects);
           end;
  
           declare
              Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
!                               Tree_Private_Part.Projects_Htable.Get_First;
              Project_Name : Name_Id := Name_And_Node.Name;
  
           begin
--- 1195,1214 ----
              end if;
  
              Post_Parse_Context_Clause
!               (In_Tree           => In_Tree,
!                Context_Clause    => First_With,
                 Imported_Projects => Imported_Projects,
                 Project_Directory => Project_Directory,
                 From_Extended     => From_Ext,
!                In_Limited        => In_Limited,
!                Packages_To_Check => Packages_To_Check);
!             Set_First_With_Clause_Of (Project, In_Tree, Imported_Projects);
           end;
  
           declare
              Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
!               Tree_Private_Part.Projects_Htable.Get_First
!                 (In_Tree.Projects_HT);
              Project_Name : Name_Id := Name_And_Node.Name;
  
           begin
*************** package body Prj.Part is
*** 1157,1163 ****
              while Project_Name /= No_Name
                and then Project_Name /= Name_Of_Project
              loop
!                Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
                 Project_Name := Name_And_Node.Name;
              end loop;
  
--- 1217,1225 ----
              while Project_Name /= No_Name
                and then Project_Name /= Name_Of_Project
              loop
!                Name_And_Node :=
!                  Tree_Private_Part.Projects_Htable.Get_Next
!                    (In_Tree.Projects_HT);
                 Project_Name := Name_And_Node.Name;
              end loop;
  
*************** package body Prj.Part is
*** 1165,1173 ****
  
              if Project_Name /= No_Name then
                 Error_Msg_Name_1 := Project_Name;
!                Error_Msg ("duplicate project name {", Location_Of (Project));
!                Error_Msg_Name_1 := Path_Name_Of (Name_And_Node.Node);
!                Error_Msg ("\already in {", Location_Of (Project));
  
              else
                 --  Otherwise, add the name of the project to the hash table, so
--- 1227,1238 ----
  
              if Project_Name /= No_Name then
                 Error_Msg_Name_1 := Project_Name;
!                Error_Msg
!                  ("duplicate project name {", Location_Of (Project, In_Tree));
!                Error_Msg_Name_1 :=
!                  Path_Name_Of (Name_And_Node.Node, In_Tree);
!                Error_Msg
!                  ("\already in {", Location_Of (Project, In_Tree));
  
              else
                 --  Otherwise, add the name of the project to the hash table, so
*************** package body Prj.Part is
*** 1175,1181 ****
                 --  the same name.
  
                 Tree_Private_Part.Projects_Htable.Set
!                  (K => Name_Of_Project,
                    E => (Name           => Name_Of_Project,
                          Node           => Project,
                          Canonical_Path => Canonical_Path_Name,
--- 1240,1247 ----
                 --  the same name.
  
                 Tree_Private_Part.Projects_Htable.Set
!                  (T => In_Tree.Projects_HT,
!                   K => Name_Of_Project,
                    E => (Name           => Name_Of_Project,
                          Node           => Project,
                          Canonical_Path => Canonical_Path_Name,
*************** package body Prj.Part is
*** 1189,1195 ****
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Set_Extended_Project_Path_Of (Project, Token_Name);
  
              declare
                 Original_Path_Name : constant String :=
--- 1255,1261 ----
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Set_Extended_Project_Path_Of (Project, In_Tree, Token_Name);
  
              declare
                 Original_Path_Name : constant String :=
*************** package body Prj.Part is
*** 1198,1205 ****
                 Extended_Project_Path_Name : constant String :=
                                                Project_Path_Name_Of
                                                  (Original_Path_Name,
!                                                    Get_Name_String
!                                                      (Project_Directory));
  
              begin
                 if Extended_Project_Path_Name = "" then
--- 1264,1271 ----
                 Extended_Project_Path_Name : constant String :=
                                                Project_Path_Name_Of
                                                  (Original_Path_Name,
!                                                  Get_Name_String
!                                                    (Project_Directory));
  
              begin
                 if Extended_Project_Path_Name = "" then
*************** package body Prj.Part is
*** 1235,1284 ****
                       end if;
  
                       Parse_Single_Project
!                        (Project       => Extended_Project,
!                         Extends_All   => Extends_All,
!                         Path_Name     => Extended_Project_Path_Name,
!                         Extended      => True,
!                         From_Extended => From_Ext,
!                         In_Limited    => In_Limited);
                    end;
  
                    --  A project that extends an extending-all project is also
                    --  an extending-all project.
  
                    if Extended_Project /= Empty_Node
!                     and then Is_Extending_All (Extended_Project)
                    then
!                      Set_Is_Extending_All (Project);
                    end if;
                 end if;
              end;
  
!             Scan; -- scan past the extended project path
           end if;
        end if;
  
        --  Check that a non extending-all project does not import an
        --  extending-all project.
  
!       if not Is_Extending_All (Project) then
           declare
!             With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
              Imported    : Project_Node_Id := Empty_Node;
  
           begin
              With_Clause_Loop :
              while With_Clause /= Empty_Node loop
!                Imported := Project_Node_Of (With_Clause);
  
!                if Is_Extending_All (With_Clause) then
!                   Error_Msg_Name_1 := Name_Of (Imported);
                    Error_Msg ("cannot import extending-all project {",
                               Token_Ptr);
                    exit With_Clause_Loop;
                 end if;
  
!                With_Clause := Next_With_Clause_Of (With_Clause);
              end loop With_Clause_Loop;
           end;
        end if;
--- 1301,1353 ----
                       end if;
  
                       Parse_Single_Project
!                        (In_Tree           => In_Tree,
!                         Project           => Extended_Project,
!                         Extends_All       => Extends_All,
!                         Path_Name         => Extended_Project_Path_Name,
!                         Extended          => True,
!                         From_Extended     => From_Ext,
!                         In_Limited        => In_Limited,
!                         Packages_To_Check => Packages_To_Check);
                    end;
  
                    --  A project that extends an extending-all project is also
                    --  an extending-all project.
  
                    if Extended_Project /= Empty_Node
!                     and then Is_Extending_All (Extended_Project, In_Tree)
                    then
!                      Set_Is_Extending_All (Project, In_Tree);
                    end if;
                 end if;
              end;
  
!             Scan (In_Tree); -- scan past the extended project path
           end if;
        end if;
  
        --  Check that a non extending-all project does not import an
        --  extending-all project.
  
!       if not Is_Extending_All (Project, In_Tree) then
           declare
!             With_Clause : Project_Node_Id :=
!                             First_With_Clause_Of (Project, In_Tree);
              Imported    : Project_Node_Id := Empty_Node;
  
           begin
              With_Clause_Loop :
              while With_Clause /= Empty_Node loop
!                Imported := Project_Node_Of (With_Clause, In_Tree);
  
!                if Is_Extending_All (With_Clause, In_Tree) then
!                   Error_Msg_Name_1 := Name_Of (Imported, In_Tree);
                    Error_Msg ("cannot import extending-all project {",
                               Token_Ptr);
                    exit With_Clause_Loop;
                 end if;
  
!                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
              end loop With_Clause_Loop;
           end;
        end if;
*************** package body Prj.Part is
*** 1308,1329 ****
           declare
              Parent_Name  : constant Name_Id := Name_Find;
              Parent_Found : Boolean := False;
!             With_Clause  : Project_Node_Id := First_With_Clause_Of (Project);
  
           begin
              --  If there is an extended project, check its name
  
              if Extended_Project /= Empty_Node then
!                Parent_Found := Name_Of (Extended_Project) = Parent_Name;
              end if;
  
              --  If the parent project is not the extended project,
              --  check each imported project until we find the parent project.
  
              while not Parent_Found and then With_Clause /= Empty_Node loop
!                Parent_Found := Name_Of (Project_Node_Of (With_Clause))
!                  = Parent_Name;
!                With_Clause := Next_With_Clause_Of (With_Clause);
              end loop;
  
              --  If the parent project was not found, report an error
--- 1377,1401 ----
           declare
              Parent_Name  : constant Name_Id := Name_Find;
              Parent_Found : Boolean := False;
!             With_Clause  : Project_Node_Id :=
!                              First_With_Clause_Of (Project, In_Tree);
  
           begin
              --  If there is an extended project, check its name
  
              if Extended_Project /= Empty_Node then
!                Parent_Found :=
!                  Name_Of (Extended_Project, In_Tree) = Parent_Name;
              end if;
  
              --  If the parent project is not the extended project,
              --  check each imported project until we find the parent project.
  
              while not Parent_Found and then With_Clause /= Empty_Node loop
!                Parent_Found :=
!                  Name_Of (Project_Node_Of (With_Clause, In_Tree), In_Tree) =
!                     Parent_Name;
!                With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
              end loop;
  
              --  If the parent project was not found, report an error
*************** package body Prj.Part is
*** 1332,1338 ****
                 Error_Msg_Name_1 := Name_Of_Project;
                 Error_Msg_Name_2 := Parent_Name;
                 Error_Msg ("project { does not import or extend project {",
!                           Location_Of (Project));
              end if;
           end;
        end if;
--- 1404,1410 ----
                 Error_Msg_Name_1 := Name_Of_Project;
                 Error_Msg_Name_2 := Parent_Name;
                 Error_Msg ("project { does not import or extend project {",
!                           Location_Of (Project, In_Tree));
              end if;
           end;
        end if;
*************** package body Prj.Part is
*** 1349,1362 ****
           --  No need to Scan past "is", Prj.Dect.Parse will do it
  
           Prj.Dect.Parse
!            (Declarations    => Project_Declaration,
!             Current_Project => Project,
!             Extends         => Extended_Project);
!          Set_Project_Declaration_Of (Project, Project_Declaration);
  
           if Extended_Project /= Empty_Node then
              Set_Extending_Project_Of
!               (Project_Declaration_Of (Extended_Project), To => Project);
           end if;
        end;
  
--- 1421,1437 ----
           --  No need to Scan past "is", Prj.Dect.Parse will do it
  
           Prj.Dect.Parse
!            (In_Tree           => In_Tree,
!             Declarations      => Project_Declaration,
!             Current_Project   => Project,
!             Extends           => Extended_Project,
!             Packages_To_Check => Packages_To_Check);
!          Set_Project_Declaration_Of (Project, In_Tree, Project_Declaration);
  
           if Extended_Project /= Empty_Node then
              Set_Extending_Project_Of
!               (Project_Declaration_Of (Extended_Project, In_Tree), In_Tree,
!                To => Project);
           end if;
        end;
  
*************** package body Prj.Part is
*** 1366,1372 ****
        --  Skip "end" if present
  
        if Token = Tok_End then
!          Scan;
        end if;
  
        --  Clear the Buffer
--- 1441,1447 ----
        --  Skip "end" if present
  
        if Token = Tok_End then
!          Scan (In_Tree);
        end if;
  
        --  Clear the Buffer
*************** package body Prj.Part is
*** 1389,1414 ****
  
           --  Add the identifier to the Buffer
           Get_Name_String (Token_Name);
!          Add_To_Buffer (Name_Buffer (1 .. Name_Len));
  
           --  Scan past the identifier
  
!          Scan;
           exit when Token /= Tok_Dot;
!          Add_To_Buffer (".");
!          Scan;
        end loop;
  
        --  If we have a valid name, check if it is the name of the project
  
        if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
           if To_Lower (Buffer (1 .. Buffer_Last)) /=
!             Get_Name_String (Name_Of (Project))
           then
              --  Invalid name: report an error
  
!             Error_Msg ("Expected """ &
!                        Get_Name_String (Name_Of (Project)) & """",
                         Token_Ptr);
           end if;
        end if;
--- 1464,1489 ----
  
           --  Add the identifier to the Buffer
           Get_Name_String (Token_Name);
!          Add_To_Buffer (Name_Buffer (1 .. Name_Len), Buffer, Buffer_Last);
  
           --  Scan past the identifier
  
!          Scan (In_Tree);
           exit when Token /= Tok_Dot;
!          Add_To_Buffer (".", Buffer, Buffer_Last);
!          Scan (In_Tree);
        end loop;
  
        --  If we have a valid name, check if it is the name of the project
  
        if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
           if To_Lower (Buffer (1 .. Buffer_Last)) /=
!             Get_Name_String (Name_Of (Project, In_Tree))
           then
              --  Invalid name: report an error
  
!             Error_Msg ("expected """ &
!                        Get_Name_String (Name_Of (Project, In_Tree)) & """",
                         Token_Ptr);
           end if;
        end if;
*************** package body Prj.Part is
*** 1420,1430 ****
  
        if Token = Tok_Semicolon then
           Set_Previous_End_Node (Project);
!          Scan;
  
           if Token /= Tok_EOF then
              Error_Msg
!               ("Unexpected text following end of project", Token_Ptr);
           end if;
        end if;
  
--- 1495,1505 ----
  
        if Token = Tok_Semicolon then
           Set_Previous_End_Node (Project);
!          Scan (In_Tree);
  
           if Token /= Tok_EOF then
              Error_Msg
!               ("unexpected text following end of project", Token_Ptr);
           end if;
        end if;
  
*************** package body Prj.Part is
*** 1439,1445 ****
        --  Indicate if there are unkept comments
  
        Tree.Set_Project_File_Includes_Unkept_Comments
!         (Node => Project, To => Tree.There_Are_Unkept_Comments);
  
        --  And restore the comment state that was saved
  
--- 1514,1522 ----
        --  Indicate if there are unkept comments
  
        Tree.Set_Project_File_Includes_Unkept_Comments
!         (Node    => Project,
!          In_Tree => In_Tree,
!          To      => Tree.There_Are_Unkept_Comments);
  
        --  And restore the comment state that was saved
  
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-part.ads gcc-4.1.0/gcc/ada/prj-part.ads
*** gcc-4.0.2/gcc/ada/prj-part.ads	Mon Dec  8 10:33:15 2003
--- gcc-4.1.0/gcc/ada/prj-part.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,37 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Implements the parsing of project files into a tree.
  
  with Prj.Tree;  use Prj.Tree;
  
  package Prj.Part is
  
     procedure Parse
!      (Project                : out Project_Node_Id;
        Project_File_Name      : String;
        Always_Errout_Finalize : Boolean;
        Packages_To_Check      : String_List_Access := All_Packages;
--- 16,38 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Implements the parsing of project files into a tree
  
  with Prj.Tree;  use Prj.Tree;
  
  package Prj.Part is
  
     procedure Parse
!      (In_Tree                : Project_Node_Tree_Ref;
!       Project                : out Project_Node_Id;
        Project_File_Name      : String;
        Always_Errout_Finalize : Boolean;
        Packages_To_Check      : String_List_Access := All_Packages;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-pp.adb gcc-4.1.0/gcc/ada/prj-pp.adb
*** gcc-4.0.2/gcc/ada/prj-pp.adb	Wed May  5 10:09:55 2004
--- gcc-4.1.0/gcc/ada/prj-pp.adb	Tue Nov 15 14:01:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Prj.PP is
*** 38,49 ****
     Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
  
     Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
!    --  Maximum length of a line.
  
     Column : Natural := 0;
     --  Column number of the last character in the line. Used to avoid
     --  outputing lines longer than Max_Line_Length.
  
     procedure Indicate_Tested (Kind : Project_Node_Kind);
     --  Set the corresponding component of array Not_Tested to False.
     --  Only called by pragmas Debug.
--- 38,54 ----
     Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
  
     Max_Line_Length : constant := Hostparm.Max_Line_Length - 5;
!    --  Maximum length of a line
  
     Column : Natural := 0;
     --  Column number of the last character in the line. Used to avoid
     --  outputing lines longer than Max_Line_Length.
  
+    First_With_In_List : Boolean := True;
+    --  Indicate that the next with clause is first in a list such as
+    --    with "A", "B";
+    --  First_With_In_List will be True for "A", but not for "B".
+ 
     procedure Indicate_Tested (Kind : Project_Node_Kind);
     --  Set the corresponding component of array Not_Tested to False.
     --  Only called by pragmas Debug.
*************** package body Prj.PP is
*** 63,68 ****
--- 68,74 ----
  
     procedure Pretty_Print
       (Project                            : Prj.Tree.Project_Node_Id;
+       In_Tree                            : Prj.Tree.Project_Node_Tree_Ref;
        Increment                          : Positive      := 3;
        Eliminate_Empty_Case_Constructions : Boolean       := False;
        Minimize_Empty_Lines               : Boolean       := False;
*************** package body Prj.PP is
*** 85,91 ****
        --  Outputs a name
  
        procedure Start_Line (Indent : Natural);
!       --  Outputs the indentation at the beginning of the line.
  
        procedure Output_String (S : Name_Id);
        --  Outputs a string using the default output procedures
--- 91,97 ----
        --  Outputs a name
  
        procedure Start_Line (Indent : Natural);
!       --  Outputs the indentation at the beginning of the line
  
        procedure Output_String (S : Name_Id);
        --  Outputs a string using the default output procedures
*************** package body Prj.PP is
*** 108,117 ****
        Write_Char : Write_Char_Ap := Output.Write_Char'Access;
        Write_Eol  : Write_Eol_Ap  := Output.Write_Eol'Access;
        Write_Str  : Write_Str_Ap  := Output.Write_Str'Access;
!       --  These three access to procedure values are used for the output.
  
        Last_Line_Is_Empty : Boolean := False;
!       --  Used to avoid two consecutive empty lines.
  
        ---------------------------
        -- Output_Attribute_Name --
--- 114,123 ----
        Write_Char : Write_Char_Ap := Output.Write_Char'Access;
        Write_Eol  : Write_Eol_Ap  := Output.Write_Eol'Access;
        Write_Str  : Write_Str_Ap  := Output.Write_Str'Access;
!       --  These three access to procedure values are used for the output
  
        Last_Line_Is_Empty : Boolean := False;
!       --  Used to avoid two consecutive empty lines
  
        ---------------------------
        -- Output_Attribute_Name --
*************** package body Prj.PP is
*** 254,260 ****
        -------------------------------
  
        procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
!          Value : constant Name_Id := End_Of_Line_Comment (Node);
  
        begin
           if Value /= No_Name then
--- 260,266 ----
        -------------------------------
  
        procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
!          Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
  
        begin
           if Value /= No_Name then
*************** package body Prj.PP is
*** 309,444 ****
        begin
           if Node /= Empty_Node then
  
!             case Kind_Of (Node) is
  
                 when N_Project  =>
                    pragma Debug (Indicate_Tested (N_Project));
!                   if First_With_Clause_Of (Node) /= Empty_Node then
  
                       --  with clause(s)
  
!                      Print (First_With_Clause_Of (Node), Indent);
                       Write_Empty_Line (Always => True);
                    end if;
  
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
                    Write_String ("project ");
!                   Output_Name (Name_Of (Node));
  
                    --  Check if this project extends another project
  
!                   if Extended_Project_Path_Of (Node) /= No_Name then
                       Write_String (" extends ");
!                      Output_String (Extended_Project_Path_Of (Node));
                    end if;
  
                    Write_String (" is");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node), Indent + Increment);
                    Write_Empty_Line (Always => True);
  
                    --  Output all of the declarations in the project
  
!                   Print (Project_Declaration_Of (Node), Indent);
!                   Print (First_Comment_Before_End (Node), Indent + Increment);
                    Start_Line (Indent);
                    Write_String ("end ");
!                   Output_Name (Name_Of (Node));
                    Write_Line (";");
!                   Print (First_Comment_After_End (Node), Indent);
  
                 when N_With_Clause =>
                    pragma Debug (Indicate_Tested (N_With_Clause));
  
!                   if Name_Of (Node) /= No_Name then
!                      Print (First_Comment_Before (Node), Indent);
!                      Start_Line (Indent);
  
!                      if Non_Limited_Project_Node_Of (Node) = Empty_Node then
!                         Write_String ("limited ");
                       end if;
  
!                      Write_String ("with ");
!                      Output_String (String_Value_Of (Node));
!                      Write_String (";");
!                      Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After (Node), Indent);
                    end if;
  
!                   Print (Next_With_Clause_Of (Node), Indent);
  
                 when N_Project_Declaration =>
                    pragma Debug (Indicate_Tested (N_Project_Declaration));
  
!                   if First_Declarative_Item_Of (Node) /= Empty_Node then
                       Print
!                        (First_Declarative_Item_Of (Node), Indent + Increment);
                       Write_Empty_Line (Always => True);
                    end if;
  
                 when N_Declarative_Item =>
                    pragma Debug (Indicate_Tested (N_Declarative_Item));
!                   Print (Current_Item_Node (Node), Indent);
!                   Print (Next_Declarative_Item (Node), Indent);
  
                 when N_Package_Declaration =>
                    pragma Debug (Indicate_Tested (N_Package_Declaration));
                    Write_Empty_Line (Always => True);
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
                    Write_String ("package ");
!                   Output_Name (Name_Of (Node));
  
!                   if Project_Of_Renamed_Package_Of (Node) /= Empty_Node then
                       Write_String (" renames ");
                       Output_Name
!                        (Name_Of (Project_Of_Renamed_Package_Of (Node)));
                       Write_String (".");
!                      Output_Name (Name_Of (Node));
                       Write_String (";");
                       Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After_End (Node), Indent);
  
                    else
                       Write_String (" is");
                       Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After (Node), Indent + Increment);
  
!                      if First_Declarative_Item_Of (Node) /= Empty_Node then
                          Print
!                           (First_Declarative_Item_Of (Node),
                             Indent + Increment);
                       end if;
  
!                      Print (First_Comment_Before_End (Node),
                              Indent + Increment);
                       Start_Line (Indent);
                       Write_String ("end ");
!                      Output_Name (Name_Of (Node));
                       Write_Line (";");
!                      Print (First_Comment_After_End (Node), Indent);
                       Write_Empty_Line;
                    end if;
  
                 when N_String_Type_Declaration =>
                    pragma Debug (Indicate_Tested (N_String_Type_Declaration));
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
                    Write_String ("type ");
!                   Output_Name (Name_Of (Node));
                    Write_Line (" is");
                    Start_Line (Indent + Increment);
                    Write_String ("(");
  
                    declare
                       String_Node : Project_Node_Id :=
!                        First_Literal_String (Node);
  
                    begin
                       while String_Node /= Empty_Node loop
!                         Output_String (String_Value_Of (String_Node));
!                         String_Node := Next_Literal_String (String_Node);
  
                          if String_Node /= Empty_Node then
                             Write_String (", ");
--- 315,490 ----
        begin
           if Node /= Empty_Node then
  
!             case Kind_Of (Node, In_Tree) is
  
                 when N_Project  =>
                    pragma Debug (Indicate_Tested (N_Project));
!                   if First_With_Clause_Of (Node, In_Tree) /= Empty_Node then
  
                       --  with clause(s)
  
!                      First_With_In_List := True;
!                      Print (First_With_Clause_Of (Node, In_Tree), Indent);
                       Write_Empty_Line (Always => True);
                    end if;
  
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
                    Write_String ("project ");
!                   Output_Name (Name_Of (Node, In_Tree));
  
                    --  Check if this project extends another project
  
!                   if Extended_Project_Path_Of (Node, In_Tree) /= No_Name then
                       Write_String (" extends ");
! 
!                      if Is_Extending_All (Node, In_Tree) then
!                         Write_String ("all ");
!                      end if;
! 
!                      Output_String (Extended_Project_Path_Of (Node, In_Tree));
                    end if;
  
                    Write_String (" is");
                    Write_End_Of_Line_Comment (Node);
!                   Print
!                     (First_Comment_After (Node, In_Tree), Indent + Increment);
                    Write_Empty_Line (Always => True);
  
                    --  Output all of the declarations in the project
  
!                   Print (Project_Declaration_Of (Node, In_Tree), Indent);
!                   Print
!                     (First_Comment_Before_End (Node, In_Tree),
!                      Indent + Increment);
                    Start_Line (Indent);
                    Write_String ("end ");
!                   Output_Name (Name_Of (Node, In_Tree));
                    Write_Line (";");
!                   Print (First_Comment_After_End (Node, In_Tree), Indent);
  
                 when N_With_Clause =>
                    pragma Debug (Indicate_Tested (N_With_Clause));
  
!                   --  The with clause will sometimes contain an invalid name
!                   --  when we are importing a virtual project from an
!                   --  extending all project. Do not output anything in this
!                   --  case
  
!                   if Name_Of (Node, In_Tree) /= No_Name
!                     and then String_Value_Of (Node, In_Tree) /= No_Name
!                   then
!                      if First_With_In_List then
!                         Print (First_Comment_Before (Node, In_Tree), Indent);
!                         Start_Line (Indent);
! 
!                         if Non_Limited_Project_Node_Of (Node, In_Tree) =
!                              Empty_Node
!                         then
!                            Write_String ("limited ");
!                         end if;
! 
!                         Write_String ("with ");
                       end if;
  
!                      Output_String (String_Value_Of (Node, In_Tree));
! 
!                      if Is_Not_Last_In_List (Node, In_Tree) then
!                         Write_String (", ");
!                         First_With_In_List := False;
! 
!                      else
!                         Write_String (";");
!                         Write_End_Of_Line_Comment (Node);
!                         Print (First_Comment_After (Node, In_Tree), Indent);
!                         First_With_In_List := True;
!                      end if;
                    end if;
  
!                   Print (Next_With_Clause_Of (Node, In_Tree), Indent);
  
                 when N_Project_Declaration =>
                    pragma Debug (Indicate_Tested (N_Project_Declaration));
  
!                   if
!                     First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
!                   then
                       Print
!                        (First_Declarative_Item_Of (Node, In_Tree),
!                         Indent + Increment);
                       Write_Empty_Line (Always => True);
                    end if;
  
                 when N_Declarative_Item =>
                    pragma Debug (Indicate_Tested (N_Declarative_Item));
!                   Print (Current_Item_Node (Node, In_Tree), Indent);
!                   Print (Next_Declarative_Item (Node, In_Tree), Indent);
  
                 when N_Package_Declaration =>
                    pragma Debug (Indicate_Tested (N_Package_Declaration));
                    Write_Empty_Line (Always => True);
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
                    Write_String ("package ");
!                   Output_Name (Name_Of (Node, In_Tree));
  
!                   if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
!                        Empty_Node
!                   then
                       Write_String (" renames ");
                       Output_Name
!                        (Name_Of
!                           (Project_Of_Renamed_Package_Of (Node, In_Tree),
!                            In_Tree));
                       Write_String (".");
!                      Output_Name (Name_Of (Node, In_Tree));
                       Write_String (";");
                       Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After_End (Node, In_Tree), Indent);
  
                    else
                       Write_String (" is");
                       Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After (Node, In_Tree),
!                             Indent + Increment);
  
!                      if First_Declarative_Item_Of (Node, In_Tree) /=
!                           Empty_Node
!                      then
                          Print
!                           (First_Declarative_Item_Of (Node, In_Tree),
                             Indent + Increment);
                       end if;
  
!                      Print (First_Comment_Before_End (Node, In_Tree),
                              Indent + Increment);
                       Start_Line (Indent);
                       Write_String ("end ");
!                      Output_Name (Name_Of (Node, In_Tree));
                       Write_Line (";");
!                      Print (First_Comment_After_End (Node, In_Tree), Indent);
                       Write_Empty_Line;
                    end if;
  
                 when N_String_Type_Declaration =>
                    pragma Debug (Indicate_Tested (N_String_Type_Declaration));
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
                    Write_String ("type ");
!                   Output_Name (Name_Of (Node, In_Tree));
                    Write_Line (" is");
                    Start_Line (Indent + Increment);
                    Write_String ("(");
  
                    declare
                       String_Node : Project_Node_Id :=
!                        First_Literal_String (Node, In_Tree);
  
                    begin
                       while String_Node /= Empty_Node loop
!                         Output_String (String_Value_Of (String_Node, In_Tree));
!                         String_Node :=
!                           Next_Literal_String (String_Node, In_Tree);
  
                          if String_Node /= Empty_Node then
                             Write_String (", ");
*************** package body Prj.PP is
*** 448,523 ****
  
                    Write_String (");");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node), Indent);
  
                 when N_Literal_String =>
                    pragma Debug (Indicate_Tested (N_Literal_String));
!                   Output_String (String_Value_Of (Node));
  
!                   if Source_Index_Of (Node) /= 0 then
                       Write_String (" at ");
!                      Write_String (Source_Index_Of (Node)'Img);
                    end if;
  
                 when N_Attribute_Declaration =>
                    pragma Debug (Indicate_Tested (N_Attribute_Declaration));
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
                    Write_String ("for ");
!                   Output_Attribute_Name (Name_Of (Node));
  
!                   if Associative_Array_Index_Of (Node) /= No_Name then
                       Write_String (" (");
!                      Output_String (Associative_Array_Index_Of (Node));
  
!                      if Source_Index_Of (Node) /= 0 then
                          Write_String (" at ");
!                         Write_String (Source_Index_Of (Node)'Img);
                       end if;
  
                       Write_String (")");
                    end if;
  
                    Write_String (" use ");
!                   Print (Expression_Of (Node), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node), Indent);
  
                 when N_Typed_Variable_Declaration =>
                    pragma Debug
                      (Indicate_Tested (N_Typed_Variable_Declaration));
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
!                   Output_Name (Name_Of (Node));
                    Write_String (" : ");
!                   Output_Name (Name_Of (String_Type_Of (Node)));
                    Write_String (" := ");
!                   Print (Expression_Of (Node), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node), Indent);
  
                 when N_Variable_Declaration =>
                    pragma Debug (Indicate_Tested (N_Variable_Declaration));
!                   Print (First_Comment_Before (Node), Indent);
                    Start_Line (Indent);
!                   Output_Name (Name_Of (Node));
                    Write_String (" := ");
!                   Print (Expression_Of (Node), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node), Indent);
  
                 when N_Expression =>
                    pragma Debug (Indicate_Tested (N_Expression));
                    declare
!                      Term : Project_Node_Id := First_Term (Node);
  
                    begin
                       while Term /= Empty_Node loop
                          Print (Term, Indent);
!                         Term := Next_Term (Term);
  
                          if Term /= Empty_Node then
                             Write_String (" & ");
--- 494,571 ----
  
                    Write_String (");");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node, In_Tree), Indent);
  
                 when N_Literal_String =>
                    pragma Debug (Indicate_Tested (N_Literal_String));
!                   Output_String (String_Value_Of (Node, In_Tree));
  
!                   if Source_Index_Of (Node, In_Tree) /= 0 then
                       Write_String (" at ");
!                      Write_String (Source_Index_Of (Node, In_Tree)'Img);
                    end if;
  
                 when N_Attribute_Declaration =>
                    pragma Debug (Indicate_Tested (N_Attribute_Declaration));
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
                    Write_String ("for ");
!                   Output_Attribute_Name (Name_Of (Node, In_Tree));
  
!                   if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
                       Write_String (" (");
!                      Output_String
!                        (Associative_Array_Index_Of (Node, In_Tree));
  
!                      if Source_Index_Of (Node, In_Tree) /= 0 then
                          Write_String (" at ");
!                         Write_String (Source_Index_Of (Node, In_Tree)'Img);
                       end if;
  
                       Write_String (")");
                    end if;
  
                    Write_String (" use ");
!                   Print (Expression_Of (Node, In_Tree), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node, In_Tree), Indent);
  
                 when N_Typed_Variable_Declaration =>
                    pragma Debug
                      (Indicate_Tested (N_Typed_Variable_Declaration));
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
!                   Output_Name (Name_Of (Node, In_Tree));
                    Write_String (" : ");
!                   Output_Name
!                     (Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
                    Write_String (" := ");
!                   Print (Expression_Of (Node, In_Tree), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node, In_Tree), Indent);
  
                 when N_Variable_Declaration =>
                    pragma Debug (Indicate_Tested (N_Variable_Declaration));
!                   Print (First_Comment_Before (Node, In_Tree), Indent);
                    Start_Line (Indent);
!                   Output_Name (Name_Of (Node, In_Tree));
                    Write_String (" := ");
!                   Print (Expression_Of (Node, In_Tree), Indent);
                    Write_String (";");
                    Write_End_Of_Line_Comment (Node);
!                   Print (First_Comment_After (Node, In_Tree), Indent);
  
                 when N_Expression =>
                    pragma Debug (Indicate_Tested (N_Expression));
                    declare
!                      Term : Project_Node_Id := First_Term (Node, In_Tree);
  
                    begin
                       while Term /= Empty_Node loop
                          Print (Term, Indent);
!                         Term := Next_Term (Term, In_Tree);
  
                          if Term /= Empty_Node then
                             Write_String (" & ");
*************** package body Prj.PP is
*** 527,533 ****
  
                 when N_Term =>
                    pragma Debug (Indicate_Tested (N_Term));
!                   Print (Current_Term (Node), Indent);
  
                 when N_Literal_String_List =>
                    pragma Debug (Indicate_Tested (N_Literal_String_List));
--- 575,581 ----
  
                 when N_Term =>
                    pragma Debug (Indicate_Tested (N_Term));
!                   Print (Current_Term (Node, In_Tree), Indent);
  
                 when N_Literal_String_List =>
                    pragma Debug (Indicate_Tested (N_Literal_String_List));
*************** package body Prj.PP is
*** 535,546 ****
  
                    declare
                       Expression : Project_Node_Id :=
!                        First_Expression_In_List (Node);
  
                    begin
                       while Expression /= Empty_Node loop
                          Print (Expression, Indent);
!                         Expression := Next_Expression_In_List (Expression);
  
                          if Expression /= Empty_Node then
                             Write_String (", ");
--- 583,595 ----
  
                    declare
                       Expression : Project_Node_Id :=
!                        First_Expression_In_List (Node, In_Tree);
  
                    begin
                       while Expression /= Empty_Node loop
                          Print (Expression, Indent);
!                         Expression :=
!                           Next_Expression_In_List (Expression, In_Tree);
  
                          if Expression /= Empty_Node then
                             Write_String (", ");
*************** package body Prj.PP is
*** 552,577 ****
  
                 when N_Variable_Reference =>
                    pragma Debug (Indicate_Tested (N_Variable_Reference));
!                   if Project_Node_Of (Node) /= Empty_Node then
!                      Output_Name (Name_Of (Project_Node_Of (Node)));
                       Write_String (".");
                    end if;
  
!                   if Package_Node_Of (Node) /= Empty_Node then
!                      Output_Name (Name_Of (Package_Node_Of (Node)));
                       Write_String (".");
                    end if;
  
!                   Output_Name (Name_Of (Node));
  
                 when N_External_Value =>
                    pragma Debug (Indicate_Tested (N_External_Value));
                    Write_String ("external (");
!                   Print (External_Reference_Of (Node), Indent);
  
!                   if External_Default_Of (Node) /= Empty_Node then
                       Write_String (", ");
!                      Print (External_Default_Of (Node), Indent);
                    end if;
  
                    Write_String (")");
--- 601,628 ----
  
                 when N_Variable_Reference =>
                    pragma Debug (Indicate_Tested (N_Variable_Reference));
!                   if Project_Node_Of (Node, In_Tree) /= Empty_Node then
!                      Output_Name
!                        (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
                       Write_String (".");
                    end if;
  
!                   if Package_Node_Of (Node, In_Tree) /= Empty_Node then
!                      Output_Name
!                        (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
                       Write_String (".");
                    end if;
  
!                   Output_Name (Name_Of (Node, In_Tree));
  
                 when N_External_Value =>
                    pragma Debug (Indicate_Tested (N_External_Value));
                    Write_String ("external (");
!                   Print (External_Reference_Of (Node, In_Tree), Indent);
  
!                   if External_Default_Of (Node, In_Tree) /= Empty_Node then
                       Write_String (", ");
!                      Print (External_Default_Of (Node, In_Tree), Indent);
                    end if;
  
                    Write_String (")");
*************** package body Prj.PP is
*** 579,607 ****
                 when N_Attribute_Reference =>
                    pragma Debug (Indicate_Tested (N_Attribute_Reference));
  
!                   if Project_Node_Of (Node) /= Empty_Node
!                     and then Project_Node_Of (Node) /= Project
                    then
!                      Output_Name (Name_Of (Project_Node_Of (Node)));
  
!                      if Package_Node_Of (Node) /= Empty_Node then
                          Write_String (".");
!                         Output_Name (Name_Of (Package_Node_Of (Node)));
                       end if;
  
!                   elsif Package_Node_Of (Node) /= Empty_Node then
!                      Output_Name (Name_Of (Package_Node_Of (Node)));
  
                    else
                       Write_String ("project");
                    end if;
  
                    Write_String ("'");
!                   Output_Attribute_Name (Name_Of (Node));
  
                    declare
                       Index : constant Name_Id :=
!                        Associative_Array_Index_Of (Node);
  
                    begin
                       if Index /= No_Name then
--- 630,661 ----
                 when N_Attribute_Reference =>
                    pragma Debug (Indicate_Tested (N_Attribute_Reference));
  
!                   if Project_Node_Of (Node, In_Tree) /= Empty_Node
!                     and then Project_Node_Of (Node, In_Tree) /= Project
                    then
!                      Output_Name
!                        (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
  
!                      if Package_Node_Of (Node, In_Tree) /= Empty_Node then
                          Write_String (".");
!                         Output_Name
!                           (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
                       end if;
  
!                   elsif Package_Node_Of (Node, In_Tree) /= Empty_Node then
!                      Output_Name
!                        (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
  
                    else
                       Write_String ("project");
                    end if;
  
                    Write_String ("'");
!                   Output_Attribute_Name (Name_Of (Node, In_Tree));
  
                    declare
                       Index : constant Name_Id :=
!                                Associative_Array_Index_Of (Node, In_Tree);
  
                    begin
                       if Index /= No_Name then
*************** package body Prj.PP is
*** 615,686 ****
                    pragma Debug (Indicate_Tested (N_Case_Construction));
  
                    declare
!                      Case_Item : Project_Node_Id := First_Case_Item_Of (Node);
                       Is_Non_Empty : Boolean := False;
                    begin
                       while Case_Item /= Empty_Node loop
!                         if First_Declarative_Item_Of (Case_Item) /= Empty_Node
                            or else not Eliminate_Empty_Case_Constructions
                          then
                             Is_Non_Empty := True;
                             exit;
                          end if;
!                         Case_Item := Next_Case_Item (Case_Item);
                       end loop;
  
                       if Is_Non_Empty then
                          Write_Empty_Line;
!                         Print (First_Comment_Before (Node), Indent);
                          Start_Line (Indent);
                          Write_String ("case ");
!                         Print (Case_Variable_Reference_Of (Node), Indent);
                          Write_String (" is");
                          Write_End_Of_Line_Comment (Node);
!                         Print (First_Comment_After (Node), Indent + Increment);
  
                          declare
                             Case_Item : Project_Node_Id :=
!                              First_Case_Item_Of (Node);
! 
                          begin
                             while Case_Item /= Empty_Node loop
                                pragma Assert
!                                 (Kind_Of (Case_Item) = N_Case_Item);
                                Print (Case_Item, Indent + Increment);
!                               Case_Item := Next_Case_Item (Case_Item);
                             end loop;
                          end;
  
!                         Print (First_Comment_Before_End (Node),
                                 Indent + Increment);
                          Start_Line (Indent);
                          Write_Line ("end case;");
!                         Print (First_Comment_After_End (Node), Indent);
                       end if;
                    end;
  
                 when N_Case_Item =>
                    pragma Debug (Indicate_Tested (N_Case_Item));
  
!                   if First_Declarative_Item_Of (Node) /= Empty_Node
                      or else not Eliminate_Empty_Case_Constructions
                    then
                       Write_Empty_Line;
!                      Print (First_Comment_Before (Node), Indent);
                       Start_Line (Indent);
                       Write_String ("when ");
  
!                      if First_Choice_Of (Node) = Empty_Node then
                          Write_String ("others");
  
                       else
                          declare
!                            Label : Project_Node_Id := First_Choice_Of (Node);
! 
                          begin
                             while Label /= Empty_Node loop
                                Print (Label, Indent);
!                               Label := Next_Literal_String (Label);
  
                                if Label /= Empty_Node then
                                   Write_String (" | ");
--- 669,749 ----
                    pragma Debug (Indicate_Tested (N_Case_Construction));
  
                    declare
!                      Case_Item    : Project_Node_Id;
                       Is_Non_Empty : Boolean := False;
+ 
                    begin
+                      Case_Item := First_Case_Item_Of (Node, In_Tree);
                       while Case_Item /= Empty_Node loop
!                         if First_Declarative_Item_Of (Case_Item, In_Tree) /=
!                              Empty_Node
                            or else not Eliminate_Empty_Case_Constructions
                          then
                             Is_Non_Empty := True;
                             exit;
                          end if;
! 
!                         Case_Item := Next_Case_Item (Case_Item, In_Tree);
                       end loop;
  
                       if Is_Non_Empty then
                          Write_Empty_Line;
!                         Print (First_Comment_Before (Node, In_Tree), Indent);
                          Start_Line (Indent);
                          Write_String ("case ");
!                         Print
!                           (Case_Variable_Reference_Of (Node, In_Tree),
!                            Indent);
                          Write_String (" is");
                          Write_End_Of_Line_Comment (Node);
!                         Print
!                           (First_Comment_After (Node, In_Tree),
!                            Indent + Increment);
  
                          declare
                             Case_Item : Project_Node_Id :=
!                                          First_Case_Item_Of (Node, In_Tree);
                          begin
                             while Case_Item /= Empty_Node loop
                                pragma Assert
!                                 (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
                                Print (Case_Item, Indent + Increment);
!                               Case_Item :=
!                                 Next_Case_Item (Case_Item, In_Tree);
                             end loop;
                          end;
  
!                         Print (First_Comment_Before_End (Node, In_Tree),
                                 Indent + Increment);
                          Start_Line (Indent);
                          Write_Line ("end case;");
!                         Print
!                           (First_Comment_After_End (Node, In_Tree), Indent);
                       end if;
                    end;
  
                 when N_Case_Item =>
                    pragma Debug (Indicate_Tested (N_Case_Item));
  
!                   if First_Declarative_Item_Of (Node, In_Tree) /= Empty_Node
                      or else not Eliminate_Empty_Case_Constructions
                    then
                       Write_Empty_Line;
!                      Print (First_Comment_Before (Node, In_Tree), Indent);
                       Start_Line (Indent);
                       Write_String ("when ");
  
!                      if First_Choice_Of (Node, In_Tree) = Empty_Node then
                          Write_String ("others");
  
                       else
                          declare
!                            Label : Project_Node_Id :=
!                                      First_Choice_Of (Node, In_Tree);
                          begin
                             while Label /= Empty_Node loop
                                Print (Label, Indent);
!                               Label := Next_Literal_String (Label, In_Tree);
  
                                if Label /= Empty_Node then
                                   Write_String (" | ");
*************** package body Prj.PP is
*** 691,706 ****
  
                       Write_String (" =>");
                       Write_End_Of_Line_Comment (Node);
!                      Print (First_Comment_After (Node), Indent + Increment);
  
                       declare
                          First : constant Project_Node_Id :=
!                                   First_Declarative_Item_Of (Node);
! 
                       begin
                          if First = Empty_Node then
                             Write_Empty_Line;
- 
                          else
                             Print (First, Indent + Increment);
                          end if;
--- 754,769 ----
  
                       Write_String (" =>");
                       Write_End_Of_Line_Comment (Node);
!                      Print
!                        (First_Comment_After (Node, In_Tree),
!                         Indent + Increment);
  
                       declare
                          First : constant Project_Node_Id :=
!                                   First_Declarative_Item_Of (Node, In_Tree);
                       begin
                          if First = Empty_Node then
                             Write_Empty_Line;
                          else
                             Print (First, Indent + Increment);
                          end if;
*************** package body Prj.PP is
*** 716,737 ****
                 when N_Comment =>
                    pragma Debug (Indicate_Tested (N_Comment));
  
!                   if Follows_Empty_Line (Node) then
                       Write_Empty_Line;
                    end if;
  
                    Start_Line (Indent);
                    Write_String ("--");
                    Write_String
!                     (Get_Name_String (String_Value_Of (Node)),
                       Truncated => True);
                    Write_Line ("");
  
!                   if Is_Followed_By_Empty_Line (Node) then
                       Write_Empty_Line;
                    end if;
  
!                   Print (Next_Comment (Node), Indent);
              end case;
           end if;
        end Print;
--- 779,800 ----
                 when N_Comment =>
                    pragma Debug (Indicate_Tested (N_Comment));
  
!                   if Follows_Empty_Line (Node, In_Tree) then
                       Write_Empty_Line;
                    end if;
  
                    Start_Line (Indent);
                    Write_String ("--");
                    Write_String
!                     (Get_Name_String (String_Value_Of (Node, In_Tree)),
                       Truncated => True);
                    Write_Line ("");
  
!                   if Is_Followed_By_Empty_Line (Node, In_Tree) then
                       Write_Empty_Line;
                    end if;
  
!                   Print (Next_Comment (Node, In_Tree), Indent);
              end case;
           end if;
        end Print;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-pp.ads gcc-4.1.0/gcc/ada/prj-pp.ads
*** gcc-4.0.2/gcc/ada/prj-pp.ads	Tue Oct 21 13:42:12 2003
--- gcc-4.1.0/gcc/ada/prj-pp.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,42 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is the Project File Pretty Printer.
! --  It is used to output a project file from a project file tree.
! --  It is used by gnatname to update or create project files.
! --  It is also used GLIDE2 to display project file trees.
! --  It can also be used for debugging purposes for tools that create project
! --  file trees.
  
  with Prj.Tree;
  
  package Prj.PP is
  
!    --  The following access to procedure types are used
!    --  to redirect output when calling Pretty_Print.
  
     type Write_Char_Ap is access procedure (C : Character);
  
--- 16,42 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package is the Project File Pretty Printer
! 
! --    Used to output a project file from a project file tree.
! --    Used by gnatname to update or create project files.
! --    Also used GPS to display project file trees.
! --    Also be used for debugging tools that create project file trees.
  
  with Prj.Tree;
  
  package Prj.PP is
  
!    --  The following access to procedure types are used to redirect output when
!    --  calling Pretty_Print.
  
     type Write_Char_Ap is access procedure (C : Character);
  
*************** package Prj.PP is
*** 46,51 ****
--- 46,52 ----
  
     procedure Pretty_Print
       (Project                            : Prj.Tree.Project_Node_Id;
+       In_Tree                            : Prj.Tree.Project_Node_Tree_Ref;
        Increment                          : Positive      := 3;
        Eliminate_Empty_Case_Constructions : Boolean       := False;
        Minimize_Empty_Lines               : Boolean       := False;
*************** package Prj.PP is
*** 53,60 ****
        W_Eol                              : Write_Eol_Ap  := null;
        W_Str                              : Write_Str_Ap  := null;
        Backward_Compatibility             : Boolean);
!    --  Output a project file, using either the default output
!    --  routines, or the ones specified by W_Char, W_Eol and W_Str.
     --
     --  Increment is the number of spaces for each indentation level.
     --
--- 54,61 ----
        W_Eol                              : Write_Eol_Ap  := null;
        W_Str                              : Write_Str_Ap  := null;
        Backward_Compatibility             : Boolean);
!    --  Output a project file, using either the default output routines, or the
!    --  ones specified by W_Char, W_Eol and W_Str.
     --
     --  Increment is the number of spaces for each indentation level.
     --
*************** package Prj.PP is
*** 64,73 ****
     --  If Eliminate_Empty_Case_Constructions is True, then case constructions
     --  and case items that do not include any declarations will not be output.
     --
!    --  If Minimize_Empty_Lines is True, empty lines will be output only
!    --  after the last with clause, after the line declaring the project name,
!    --  after the last declarative item of the project and before each
!    --  package declaration. Otherwise, more empty lines are output.
     --
     --  If Backward_Compatibility is True, then new attributes (Spec,
     --  Spec_Suffix, Body, Body_Suffix) will be replaced by obsolete ones
--- 65,74 ----
     --  If Eliminate_Empty_Case_Constructions is True, then case constructions
     --  and case items that do not include any declarations will not be output.
     --
!    --  If Minimize_Empty_Lines is True, empty lines will be output only after
!    --  the last with clause, after the line declaring the project name, after
!    --  the last declarative item of the project and before each package
!    --  declaration. Otherwise, more empty lines are output.
     --
     --  If Backward_Compatibility is True, then new attributes (Spec,
     --  Spec_Suffix, Body, Body_Suffix) will be replaced by obsolete ones
*************** package Prj.PP is
*** 77,84 ****
  private
  
     procedure Output_Statistics;
!    --  This procedure can be used after one or more calls to Pretty_Print
!    --  to display what Project_Node_Kinds have not been exercised by the
!    --  call(s) to Pretty_Print. It is used only for testing purposes.
  
  end Prj.PP;
--- 78,85 ----
  private
  
     procedure Output_Statistics;
!    --  This procedure can be used after one or more calls to Pretty_Print to
!    --  display what Project_Node_Kinds have not been exercised by the call(s)
!    --  to Pretty_Print. It is used only for testing purposes.
  
  end Prj.PP;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-proc.adb gcc-4.1.0/gcc/ada/prj-proc.adb
*** gcc-4.0.2/gcc/ada/prj-proc.adb	Wed Dec  8 11:25:46 2004
--- gcc-4.1.0/gcc/ada/prj-proc.adb	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Prj.Attr; use Prj.Attr;
*** 33,38 ****
--- 33,39 ----
  with Prj.Err;  use Prj.Err;
  with Prj.Ext;  use Prj.Ext;
  with Prj.Nmsc; use Prj.Nmsc;
+ with Sinput;   use Sinput;
  with Snames;
  
  with GNAT.Case_Util; use GNAT.Case_Util;
*************** package body Prj.Proc is
*** 57,105 ****
  
     procedure Add_Attributes
       (Project : Project_Id;
        Decl    : in out Declarations;
        First   : Attribute_Node_Id);
     --  Add all attributes, starting with First, with their default
     --  values to the package or project with declarations Decl.
  
     procedure Check
!      (Project      : in out Project_Id;
        Follow_Links : Boolean);
     --  Set all projects to not checked, then call Recursive_Check for the
     --  main project Project. Project is set to No_Project if errors occurred.
  
     function Expression
!      (Project           : Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Pkg               : Package_Id;
!       First_Term        : Project_Node_Id;
!       Kind              : Variable_Kind) return Variable_Value;
     --  From N_Expression project node From_Project_Node, compute the value
     --  of an expression and return it as a Variable_Value.
  
     function Imported_Or_Extended_Project_From
       (Project   : Project_Id;
        With_Name : Name_Id) return Project_Id;
     --  Find an imported or extended project of Project whose name is With_Name
  
     function Package_From
       (Project   : Project_Id;
        With_Name : Name_Id) return Package_Id;
     --  Find the package of Project whose name is With_Name
  
     procedure Process_Declarative_Items
!      (Project           : Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Pkg               : Package_Id;
!       Item              : Project_Node_Id);
     --  Process declarative items starting with From_Project_Node, and put them
     --  in declarations Decl. This is a recursive procedure; it calls itself for
     --  a package declaration or a case construction.
  
     procedure Recursive_Process
!      (Project           : out Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Extended_By       : Project_Id);
     --  Process project with node From_Project_Node in the tree.
     --  Do nothing if From_Project_Node is Empty_Node.
     --  If project has already been processed, simply return its project id.
--- 58,116 ----
  
     procedure Add_Attributes
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Decl    : in out Declarations;
        First   : Attribute_Node_Id);
     --  Add all attributes, starting with First, with their default
     --  values to the package or project with declarations Decl.
  
     procedure Check
!      (In_Tree      : Project_Tree_Ref;
!       Project      : in out Project_Id;
        Follow_Links : Boolean);
     --  Set all projects to not checked, then call Recursive_Check for the
     --  main project Project. Project is set to No_Project if errors occurred.
  
     function Expression
!      (Project                : Project_Id;
!       In_Tree                : Project_Tree_Ref;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Pkg                    : Package_Id;
!       First_Term             : Project_Node_Id;
!       Kind                   : Variable_Kind) return Variable_Value;
     --  From N_Expression project node From_Project_Node, compute the value
     --  of an expression and return it as a Variable_Value.
  
     function Imported_Or_Extended_Project_From
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        With_Name : Name_Id) return Project_Id;
     --  Find an imported or extended project of Project whose name is With_Name
  
     function Package_From
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        With_Name : Name_Id) return Package_Id;
     --  Find the package of Project whose name is With_Name
  
     procedure Process_Declarative_Items
!      (Project                : Project_Id;
!       In_Tree                : Project_Tree_Ref;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Pkg                    : Package_Id;
!       Item                   : Project_Node_Id);
     --  Process declarative items starting with From_Project_Node, and put them
     --  in declarations Decl. This is a recursive procedure; it calls itself for
     --  a package declaration or a case construction.
  
     procedure Recursive_Process
!      (In_Tree                : Project_Tree_Ref;
!       Project                : out Project_Id;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Extended_By            : Project_Id);
     --  Process project with node From_Project_Node in the tree.
     --  Do nothing if From_Project_Node is Empty_Node.
     --  If project has already been processed, simply return its project id.
*************** package body Prj.Proc is
*** 109,114 ****
--- 120,126 ----
  
     procedure Recursive_Check
       (Project      : Project_Id;
+       In_Tree      : Project_Tree_Ref;
        Follow_Links : Boolean);
     --  If Project is not marked as checked, mark it as checked, call
     --  Check_Naming_Scheme for the project, then call itself for a
*************** package body Prj.Proc is
*** 146,151 ****
--- 158,164 ----
  
     procedure Add_Attributes
       (Project : Project_Id;
+       In_Tree : Project_Tree_Ref;
        Decl    : in out Declarations;
        First   : Attribute_Node_Id)
     is
*************** package body Prj.Proc is
*** 190,201 ****
  
                 end case;
  
!                Variable_Elements.Increment_Last;
!                Variable_Elements.Table (Variable_Elements.Last) :=
                   (Next  => Decl.Attributes,
                    Name  => Attribute_Name_Of (The_Attribute),
                    Value => New_Attribute);
!                Decl.Attributes := Variable_Elements.Last;
              end;
           end if;
  
--- 203,218 ----
  
                 end case;
  
!                Variable_Element_Table.Increment_Last
!                  (In_Tree.Variable_Elements);
!                In_Tree.Variable_Elements.Table
!                  (Variable_Element_Table.Last
!                    (In_Tree.Variable_Elements)) :=
                   (Next  => Decl.Attributes,
                    Name  => Attribute_Name_Of (The_Attribute),
                    Value => New_Attribute);
!                Decl.Attributes := Variable_Element_Table.Last
!                  (In_Tree.Variable_Elements);
              end;
           end if;
  
*************** package body Prj.Proc is
*** 208,224 ****
     -----------
  
     procedure Check
!      (Project      : in out Project_Id;
        Follow_Links : Boolean)
     is
     begin
        --  Make sure that all projects are marked as not checked
  
!       for Index in 1 .. Projects.Last loop
!          Projects.Table (Index).Checked := False;
        end loop;
  
!       Recursive_Check (Project, Follow_Links);
     end Check;
  
     ----------------
--- 225,244 ----
     -----------
  
     procedure Check
!      (In_Tree      : Project_Tree_Ref;
!       Project      : in out Project_Id;
        Follow_Links : Boolean)
     is
     begin
        --  Make sure that all projects are marked as not checked
  
!       for Index in Project_Table.First ..
!                    Project_Table.Last (In_Tree.Projects)
!       loop
!          In_Tree.Projects.Table (Index).Checked := False;
        end loop;
  
!       Recursive_Check (Project, In_Tree, Follow_Links);
     end Check;
  
     ----------------
*************** package body Prj.Proc is
*** 226,236 ****
     ----------------
  
     function Expression
!      (Project           : Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Pkg               : Package_Id;
!       First_Term        : Project_Node_Id;
!       Kind              : Variable_Kind) return Variable_Value
     is
        The_Term : Project_Node_Id := First_Term;
        --  The term in the expression list
--- 246,258 ----
     ----------------
  
     function Expression
!      (Project                : Project_Id;
!       In_Tree                : Project_Tree_Ref;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Pkg                    : Package_Id;
!       First_Term             : Project_Node_Id;
!       Kind                   : Variable_Kind) return Variable_Value
     is
        The_Term : Project_Node_Id := First_Term;
        --  The term in the expression list
*************** package body Prj.Proc is
*** 246,259 ****
  
     begin
        Result.Project := Project;
!       Result.Location := Location_Of (First_Term);
  
        --  Process each term of the expression, starting with First_Term
  
        while The_Term /= Empty_Node loop
!          The_Current_Term := Current_Term (The_Term);
  
!          case Kind_Of (The_Current_Term) is
  
              when N_Literal_String =>
  
--- 268,281 ----
  
     begin
        Result.Project := Project;
!       Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
  
        --  Process each term of the expression, starting with First_Term
  
        while The_Term /= Empty_Node loop
!          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
  
!          case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
  
              when N_Literal_String =>
  
*************** package body Prj.Proc is
*** 267,296 ****
                       raise Program_Error;
  
                    when Single =>
!                      Add (Result.Value, String_Value_Of (The_Current_Term));
!                      Result.Index := Source_Index_Of (The_Current_Term);
  
                    when List =>
  
!                      String_Elements.Increment_Last;
  
                       if Last = Nil_String then
  
                          --  This can happen in an expression like () & "toto"
  
!                         Result.Values := String_Elements.Last;
  
                       else
!                         String_Elements.Table (Last).Next :=
!                           String_Elements.Last;
                       end if;
  
!                      Last := String_Elements.Last;
!                      String_Elements.Table (Last) :=
!                        (Value    => String_Value_Of (The_Current_Term),
!                         Index    => Source_Index_Of (The_Current_Term),
                          Display_Value => No_Name,
!                         Location => Location_Of (The_Current_Term),
                          Flag     => False,
                          Next     => Nil_String);
                 end case;
--- 289,334 ----
                       raise Program_Error;
  
                    when Single =>
!                      Add (Result.Value,
!                           String_Value_Of
!                             (The_Current_Term, From_Project_Node_Tree));
!                      Result.Index :=
!                        Source_Index_Of
!                          (The_Current_Term, From_Project_Node_Tree);
  
                    when List =>
  
!                      String_Element_Table.Increment_Last
!                        (In_Tree.String_Elements);
  
                       if Last = Nil_String then
  
                          --  This can happen in an expression like () & "toto"
  
!                         Result.Values := String_Element_Table.Last
!                           (In_Tree.String_Elements);
  
                       else
!                         In_Tree.String_Elements.Table
!                           (Last).Next := String_Element_Table.Last
!                                        (In_Tree.String_Elements);
                       end if;
  
!                      Last := String_Element_Table.Last
!                        (In_Tree.String_Elements);
!                      In_Tree.String_Elements.Table (Last) :=
!                        (Value    =>
!                           String_Value_Of
!                             (The_Current_Term,
!                              From_Project_Node_Tree),
!                         Index    =>
!                           Source_Index_Of
!                             (The_Current_Term, From_Project_Node_Tree),
                          Display_Value => No_Name,
!                         Location      =>
!                           Location_Of
!                             (The_Current_Term,
!                              From_Project_Node_Tree),
                          Flag     => False,
                          Next     => Nil_String);
                 end case;
*************** package body Prj.Proc is
*** 299,305 ****
  
                 declare
                    String_Node : Project_Node_Id :=
!                                   First_Expression_In_List (The_Current_Term);
  
                    Value : Variable_Value;
  
--- 337,345 ----
  
                 declare
                    String_Node : Project_Node_Id :=
!                                   First_Expression_In_List
!                                     (The_Current_Term,
!                                      From_Project_Node_Tree);
  
                    Value : Variable_Value;
  
*************** package body Prj.Proc is
*** 310,336 ****
                       --  there is nothing to do
  
                       Value := Expression
!                        (Project           => Project,
!                         From_Project_Node => From_Project_Node,
!                         Pkg               => Pkg,
!                         First_Term        => Tree.First_Term (String_Node),
!                         Kind              => Single);
!                      String_Elements.Increment_Last;
  
                       if Result.Values = Nil_String then
  
                          --  This literal string list is the first term
                          --  in a string list expression
  
!                         Result.Values := String_Elements.Last;
  
                       else
!                         String_Elements.Table (Last).Next :=
!                           String_Elements.Last;
                       end if;
  
!                      Last := String_Elements.Last;
!                      String_Elements.Table (Last) :=
                         (Value    => Value.Value,
                          Display_Value => No_Name,
                          Location => Value.Location,
--- 350,385 ----
                       --  there is nothing to do
  
                       Value := Expression
!                        (Project                => Project,
!                         In_Tree                => In_Tree,
!                         From_Project_Node      => From_Project_Node,
!                         From_Project_Node_Tree => From_Project_Node_Tree,
!                         Pkg                    => Pkg,
!                         First_Term             =>
!                           Tree.First_Term
!                             (String_Node, From_Project_Node_Tree),
!                         Kind                   => Single);
!                      String_Element_Table.Increment_Last
!                        (In_Tree.String_Elements);
  
                       if Result.Values = Nil_String then
  
                          --  This literal string list is the first term
                          --  in a string list expression
  
!                         Result.Values :=
!                           String_Element_Table.Last (In_Tree.String_Elements);
  
                       else
!                         In_Tree.String_Elements.Table
!                           (Last).Next :=
!                           String_Element_Table.Last (In_Tree.String_Elements);
                       end if;
  
!                      Last :=
!                        String_Element_Table.Last (In_Tree.String_Elements);
! 
!                      In_Tree.String_Elements.Table (Last) :=
                         (Value    => Value.Value,
                          Display_Value => No_Name,
                          Location => Value.Location,
*************** package body Prj.Proc is
*** 343,365 ****
                          --  one after the other
  
                          String_Node :=
!                           Next_Expression_In_List (String_Node);
  
                          exit when String_Node = Empty_Node;
  
                          Value :=
                            Expression
!                           (Project           => Project,
!                            From_Project_Node => From_Project_Node,
!                            Pkg               => Pkg,
!                            First_Term        => Tree.First_Term (String_Node),
!                            Kind              => Single);
  
!                         String_Elements.Increment_Last;
!                         String_Elements.Table (Last).Next :=
!                           String_Elements.Last;
!                         Last := String_Elements.Last;
!                         String_Elements.Table (Last) :=
                            (Value    => Value.Value,
                             Display_Value => No_Name,
                             Location => Value.Location,
--- 392,422 ----
                          --  one after the other
  
                          String_Node :=
!                           Next_Expression_In_List
!                             (String_Node, From_Project_Node_Tree);
  
                          exit when String_Node = Empty_Node;
  
                          Value :=
                            Expression
!                             (Project                => Project,
!                              In_Tree                => In_Tree,
!                              From_Project_Node      => From_Project_Node,
!                              From_Project_Node_Tree => From_Project_Node_Tree,
!                              Pkg                    => Pkg,
!                              First_Term             =>
!                                Tree.First_Term
!                                  (String_Node, From_Project_Node_Tree),
!                              Kind                   => Single);
  
!                         String_Element_Table.Increment_Last
!                           (In_Tree.String_Elements);
!                         In_Tree.String_Elements.Table
!                           (Last).Next := String_Element_Table.Last
!                                         (In_Tree.String_Elements);
!                         Last := String_Element_Table.Last
!                           (In_Tree.String_Elements);
!                         In_Tree.String_Elements.Table (Last) :=
                            (Value    => Value.Value,
                             Display_Value => No_Name,
                             Location => Value.Location,
*************** package body Prj.Proc is
*** 367,375 ****
                             Next     => Nil_String,
                             Index    => Value.Index);
                       end loop;
- 
                    end if;
- 
                 end;
  
              when N_Variable_Reference | N_Attribute_Reference =>
--- 424,430 ----
*************** package body Prj.Proc is
*** 381,389 ****
                    The_Variable_Id : Variable_Id := No_Variable;
                    The_Variable    : Variable_Value;
                    Term_Project    : constant Project_Node_Id :=
!                                       Project_Node_Of (The_Current_Term);
                    Term_Package    : constant Project_Node_Id :=
!                                       Package_Node_Of (The_Current_Term);
                    Index           : Name_Id   := No_Name;
  
                 begin
--- 436,446 ----
                    The_Variable_Id : Variable_Id := No_Variable;
                    The_Variable    : Variable_Value;
                    Term_Project    : constant Project_Node_Id :=
!                     Project_Node_Of
!                       (The_Current_Term, From_Project_Node_Tree);
                    Term_Package    : constant Project_Node_Id :=
!                     Package_Node_Of
!                       (The_Current_Term, From_Project_Node_Tree);
                    Index           : Name_Id   := No_Name;
  
                 begin
*************** package body Prj.Proc is
*** 392,400 ****
                    then
                       --  This variable or attribute comes from another project
  
!                      The_Name := Name_Of (Term_Project);
                       The_Project := Imported_Or_Extended_Project_From
                                        (Project   => Project,
                                         With_Name => The_Name);
                    end if;
  
--- 449,459 ----
                    then
                       --  This variable or attribute comes from another project
  
!                      The_Name :=
!                        Name_Of (Term_Project, From_Project_Node_Tree);
                       The_Project := Imported_Or_Extended_Project_From
                                        (Project   => Project,
+                                        In_Tree   => In_Tree,
                                         With_Name => The_Name);
                    end if;
  
*************** package body Prj.Proc is
*** 402,428 ****
  
                       --  This is an attribute of a package
  
!                      The_Name := Name_Of (Term_Package);
!                      The_Package := Projects.Table (The_Project).Decl.Packages;
  
                       while The_Package /= No_Package
!                        and then Packages.Table (The_Package).Name /= The_Name
                       loop
!                         The_Package := Packages.Table (The_Package).Next;
                       end loop;
  
                       pragma Assert
                         (The_Package /= No_Package,
                          "package not found.");
  
!                   elsif Kind_Of (The_Current_Term) = N_Attribute_Reference then
                       The_Package := No_Package;
                    end if;
  
!                   The_Name := Name_Of (The_Current_Term);
  
!                   if Kind_Of (The_Current_Term) = N_Attribute_Reference then
!                      Index := Associative_Array_Index_Of (The_Current_Term);
                    end if;
  
                    --  If it is not an associative array attribute
--- 461,499 ----
  
                       --  This is an attribute of a package
  
!                      The_Name :=
!                        Name_Of (Term_Package, From_Project_Node_Tree);
!                      The_Package := In_Tree.Projects.Table
!                                       (The_Project).Decl.Packages;
  
                       while The_Package /= No_Package
!                        and then In_Tree.Packages.Table
!                                   (The_Package).Name /= The_Name
                       loop
!                         The_Package :=
!                           In_Tree.Packages.Table
!                             (The_Package).Next;
                       end loop;
  
                       pragma Assert
                         (The_Package /= No_Package,
                          "package not found.");
  
!                   elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
!                           N_Attribute_Reference
!                   then
                       The_Package := No_Package;
                    end if;
  
!                   The_Name :=
!                     Name_Of (The_Current_Term, From_Project_Node_Tree);
  
!                   if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
!                        N_Attribute_Reference
!                   then
!                      Index :=
!                        Associative_Array_Index_Of
!                          (The_Current_Term, From_Project_Node_Tree);
                    end if;
  
                    --  If it is not an associative array attribute
*************** package body Prj.Proc is
*** 435,458 ****
  
                          --  First, if there is a package, look into the package
  
!                         if
!                           Kind_Of (The_Current_Term) = N_Variable_Reference
                          then
                             The_Variable_Id :=
!                              Packages.Table (The_Package).Decl.Variables;
! 
                          else
                             The_Variable_Id :=
!                              Packages.Table (The_Package).Decl.Attributes;
                          end if;
  
                          while The_Variable_Id /= No_Variable
                            and then
!                           Variable_Elements.Table (The_Variable_Id).Name /=
!                           The_Name
                          loop
                             The_Variable_Id :=
!                              Variable_Elements.Table (The_Variable_Id).Next;
                          end loop;
  
                       end if;
--- 506,531 ----
  
                          --  First, if there is a package, look into the package
  
!                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
!                              N_Variable_Reference
                          then
                             The_Variable_Id :=
!                              In_Tree.Packages.Table
!                                (The_Package).Decl.Variables;
                          else
                             The_Variable_Id :=
!                              In_Tree.Packages.Table
!                                (The_Package).Decl.Attributes;
                          end if;
  
                          while The_Variable_Id /= No_Variable
                            and then
!                             In_Tree.Variable_Elements.Table
!                               (The_Variable_Id).Name /= The_Name
                          loop
                             The_Variable_Id :=
!                              In_Tree.Variable_Elements.Table
!                                (The_Variable_Id).Next;
                          end loop;
  
                       end if;
*************** package body Prj.Proc is
*** 461,484 ****
  
                          --  If we have not found it, look into the project
  
!                         if
!                           Kind_Of (The_Current_Term) = N_Variable_Reference
                          then
                             The_Variable_Id :=
!                              Projects.Table (The_Project).Decl.Variables;
! 
                          else
                             The_Variable_Id :=
!                              Projects.Table (The_Project).Decl.Attributes;
                          end if;
  
                          while The_Variable_Id /= No_Variable
                            and then
!                           Variable_Elements.Table (The_Variable_Id).Name /=
!                           The_Name
                          loop
                             The_Variable_Id :=
!                              Variable_Elements.Table (The_Variable_Id).Next;
                          end loop;
  
                       end if;
--- 534,559 ----
  
                          --  If we have not found it, look into the project
  
!                         if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
!                              N_Variable_Reference
                          then
                             The_Variable_Id :=
!                              In_Tree.Projects.Table
!                                (The_Project).Decl.Variables;
                          else
                             The_Variable_Id :=
!                              In_Tree.Projects.Table
!                                (The_Project).Decl.Attributes;
                          end if;
  
                          while The_Variable_Id /= No_Variable
                            and then
!                           In_Tree.Variable_Elements.Table
!                             (The_Variable_Id).Name /= The_Name
                          loop
                             The_Variable_Id :=
!                              In_Tree.Variable_Elements.Table
!                                (The_Variable_Id).Next;
                          end loop;
  
                       end if;
*************** package body Prj.Proc is
*** 486,492 ****
                       pragma Assert (The_Variable_Id /= No_Variable,
                                        "variable or attribute not found");
  
!                      The_Variable := Variable_Elements.Table
                                                      (The_Variable_Id).Value;
  
                    else
--- 561,568 ----
                       pragma Assert (The_Variable_Id /= No_Variable,
                                        "variable or attribute not found");
  
!                      The_Variable :=
!                        In_Tree.Variable_Elements.Table
                                                      (The_Variable_Id).Value;
  
                    else
*************** package body Prj.Proc is
*** 497,546 ****
                          The_Array   : Array_Id := No_Array;
                          The_Element : Array_Element_Id := No_Array_Element;
                          Array_Index : Name_Id := No_Name;
                       begin
                          if The_Package /= No_Package then
                             The_Array :=
!                              Packages.Table (The_Package).Decl.Arrays;
! 
                          else
                             The_Array :=
!                              Projects.Table (The_Project).Decl.Arrays;
                          end if;
  
                          while The_Array /= No_Array
!                           and then Arrays.Table (The_Array).Name /= The_Name
                          loop
!                            The_Array := Arrays.Table (The_Array).Next;
                          end loop;
  
                          if The_Array /= No_Array then
!                            The_Element := Arrays.Table (The_Array).Value;
  
                             Get_Name_String (Index);
  
!                            if Case_Insensitive (The_Current_Term) then
                                To_Lower (Name_Buffer (1 .. Name_Len));
                             end if;
  
                             Array_Index := Name_Find;
  
                             while The_Element /= No_Array_Element
!                              and then Array_Elements.Table (The_Element).Index
!                                                          /= Array_Index
                             loop
                                The_Element :=
!                                 Array_Elements.Table (The_Element).Next;
                             end loop;
  
                          end if;
  
                          if The_Element /= No_Array_Element then
                             The_Variable :=
!                              Array_Elements.Table (The_Element).Value;
  
                          else
!                            if
!                              Expression_Kind_Of (The_Current_Term) = List
                             then
                                The_Variable :=
                                  (Project  => Project,
--- 573,633 ----
                          The_Array   : Array_Id := No_Array;
                          The_Element : Array_Element_Id := No_Array_Element;
                          Array_Index : Name_Id := No_Name;
+ 
                       begin
                          if The_Package /= No_Package then
                             The_Array :=
!                              In_Tree.Packages.Table
!                                (The_Package).Decl.Arrays;
                          else
                             The_Array :=
!                              In_Tree.Projects.Table
!                                (The_Project).Decl.Arrays;
                          end if;
  
                          while The_Array /= No_Array
!                           and then In_Tree.Arrays.Table
!                                      (The_Array).Name /= The_Name
                          loop
!                            The_Array := In_Tree.Arrays.Table
!                                           (The_Array).Next;
                          end loop;
  
                          if The_Array /= No_Array then
!                            The_Element := In_Tree.Arrays.Table
!                                             (The_Array).Value;
  
                             Get_Name_String (Index);
  
!                            if Case_Insensitive
!                                 (The_Current_Term, From_Project_Node_Tree)
!                            then
                                To_Lower (Name_Buffer (1 .. Name_Len));
                             end if;
  
                             Array_Index := Name_Find;
  
                             while The_Element /= No_Array_Element
!                              and then
!                              In_Tree.Array_Elements.Table
!                                (The_Element).Index /= Array_Index
                             loop
                                The_Element :=
!                                 In_Tree.Array_Elements.Table
!                                   (The_Element).Next;
                             end loop;
  
                          end if;
  
                          if The_Element /= No_Array_Element then
                             The_Variable :=
!                              In_Tree.Array_Elements.Table
!                                (The_Element).Value;
  
                          else
!                            if Expression_Kind_Of
!                              (The_Current_Term, From_Project_Node_Tree) =
!                                                                         List
                             then
                                The_Variable :=
                                  (Project  => Project,
*************** package body Prj.Proc is
*** 548,554 ****
                                   Location => No_Location,
                                   Default  => True,
                                   Values   => Nil_String);
- 
                             else
                                The_Variable :=
                                  (Project  => Project,
--- 635,640 ----
*************** package body Prj.Proc is
*** 599,626 ****
                                null;
  
                             when Single =>
!                               String_Elements.Increment_Last;
  
                                if Last = Nil_String then
  
                                   --  This can happen in an expression such as
                                   --  () & Var
  
!                                  Result.Values := String_Elements.Last;
  
                                else
!                                  String_Elements.Table (Last).Next :=
!                                    String_Elements.Last;
                                end if;
  
!                               Last := String_Elements.Last;
!                               String_Elements.Table (Last) :=
!                                 (Value    => The_Variable.Value,
                                   Display_Value => No_Name,
!                                  Location => Location_Of (The_Current_Term),
!                                  Flag     => False,
!                                  Next     => Nil_String,
!                                  Index    => 0);
  
                             when List =>
  
--- 685,722 ----
                                null;
  
                             when Single =>
!                               String_Element_Table.Increment_Last
!                                 (In_Tree.String_Elements);
  
                                if Last = Nil_String then
  
                                   --  This can happen in an expression such as
                                   --  () & Var
  
!                                  Result.Values :=
!                                    String_Element_Table.Last
!                                      (In_Tree.String_Elements);
  
                                else
!                                  In_Tree.String_Elements.Table
!                                    (Last).Next :=
!                                      String_Element_Table.Last
!                                        (In_Tree.String_Elements);
                                end if;
  
!                               Last :=
!                                 String_Element_Table.Last
!                                   (In_Tree.String_Elements);
! 
!                               In_Tree.String_Elements.Table (Last) :=
!                                 (Value         => The_Variable.Value,
                                   Display_Value => No_Name,
!                                  Location      => Location_Of
!                                                     (The_Current_Term,
!                                                      From_Project_Node_Tree),
!                                  Flag          => False,
!                                  Next          => Nil_String,
!                                  Index         => 0);
  
                             when List =>
  
*************** package body Prj.Proc is
*** 630,659 ****
  
                                begin
                                   while The_List /= Nil_String loop
!                                     String_Elements.Increment_Last;
  
                                      if Last = Nil_String then
!                                        Result.Values := String_Elements.Last;
  
                                      else
!                                        String_Elements.Table (Last).Next :=
!                                          String_Elements.Last;
  
                                      end if;
  
!                                     Last := String_Elements.Last;
!                                     String_Elements.Table (Last) :=
!                                       (Value    =>
!                                          String_Elements.Table
!                                                           (The_List).Value,
                                         Display_Value => No_Name,
!                                        Location => Location_Of
!                                                           (The_Current_Term),
!                                        Flag     => False,
!                                        Next     => Nil_String,
!                                        Index    => 0);
                                      The_List :=
!                                       String_Elements.Table (The_List).Next;
                                   end loop;
                                end;
                          end case;
--- 726,769 ----
  
                                begin
                                   while The_List /= Nil_String loop
!                                     String_Element_Table.Increment_Last
!                                       (In_Tree.String_Elements);
  
                                      if Last = Nil_String then
!                                        Result.Values :=
!                                          String_Element_Table.Last
!                                            (In_Tree.
!                                                 String_Elements);
  
                                      else
!                                        In_Tree.
!                                          String_Elements.Table (Last).Next :=
!                                          String_Element_Table.Last
!                                            (In_Tree.
!                                                 String_Elements);
  
                                      end if;
  
!                                     Last :=
!                                       String_Element_Table.Last
!                                         (In_Tree.String_Elements);
! 
!                                     In_Tree.String_Elements.Table (Last) :=
!                                       (Value         =>
!                                          In_Tree.String_Elements.Table
!                                            (The_List).Value,
                                         Display_Value => No_Name,
!                                        Location      =>
!                                          Location_Of
!                                            (The_Current_Term,
!                                             From_Project_Node_Tree),
!                                        Flag         => False,
!                                        Next         => Nil_String,
!                                        Index        => 0);
! 
                                      The_List :=
!                                       In_Tree. String_Elements.Table
!                                         (The_List).Next;
                                   end loop;
                                end;
                          end case;
*************** package body Prj.Proc is
*** 662,680 ****
  
              when N_External_Value =>
                 Get_Name_String
!                  (String_Value_Of (External_Reference_Of (The_Current_Term)));
  
                 declare
                    Name    : constant Name_Id  := Name_Find;
                    Default : Name_Id           := No_Name;
                    Value   : Name_Id           := No_Name;
  
                    Default_Node : constant Project_Node_Id :=
!                                    External_Default_Of (The_Current_Term);
  
                 begin
                    if Default_Node /= Empty_Node then
!                      Default := String_Value_Of (Default_Node);
                    end if;
  
                    Value := Prj.Ext.Value_Of (Name, Default);
--- 772,812 ----
  
              when N_External_Value =>
                 Get_Name_String
!                  (String_Value_Of
!                     (External_Reference_Of
!                        (The_Current_Term, From_Project_Node_Tree),
!                      From_Project_Node_Tree));
  
                 declare
                    Name    : constant Name_Id  := Name_Find;
                    Default : Name_Id           := No_Name;
                    Value   : Name_Id           := No_Name;
  
+                   Def_Var : Variable_Value;
+ 
                    Default_Node : constant Project_Node_Id :=
!                     External_Default_Of
!                       (The_Current_Term, From_Project_Node_Tree);
  
                 begin
+                   --  If there is a default value for the external reference,
+                   --  get its value.
+ 
                    if Default_Node /= Empty_Node then
!                      Def_Var := Expression
!                        (Project                => Project,
!                         In_Tree                => In_Tree,
!                         From_Project_Node      => Default_Node,
!                         From_Project_Node_Tree => From_Project_Node_Tree,
!                         Pkg                    => Pkg,
!                         First_Term             =>
!                           Tree.First_Term
!                             (Default_Node, From_Project_Node_Tree),
!                         Kind                   => Single);
! 
!                      if Def_Var /= Nil_Variable_Value then
!                         Default := Def_Var.Value;
!                      end if;
                    end if;
  
                    Value := Prj.Ext.Value_Of (Name, Default);
*************** package body Prj.Proc is
*** 684,701 ****
                          if Error_Report = null then
                             Error_Msg
                               ("?undefined external reference",
!                               Location_Of (The_Current_Term));
! 
                          else
                             Error_Report
                               ("warning: """ & Get_Name_String (Name) &
                                """ is an undefined external reference",
!                               Project);
                          end if;
                       end if;
  
                       Value := Empty_String;
- 
                    end if;
  
                    case Kind is
--- 816,832 ----
                          if Error_Report = null then
                             Error_Msg
                               ("?undefined external reference",
!                               Location_Of
!                                 (The_Current_Term, From_Project_Node_Tree));
                          else
                             Error_Report
                               ("warning: """ & Get_Name_String (Name) &
                                """ is an undefined external reference",
!                               Project, In_Tree);
                          end if;
                       end if;
  
                       Value := Empty_String;
                    end if;
  
                    case Kind is
*************** package body Prj.Proc is
*** 707,727 ****
                          Add (Result.Value, Value);
  
                       when List =>
!                         String_Elements.Increment_Last;
  
                          if Last = Nil_String then
!                            Result.Values := String_Elements.Last;
  
                          else
!                            String_Elements.Table (Last).Next :=
!                              String_Elements.Last;
                          end if;
  
!                         Last := String_Elements.Last;
!                         String_Elements.Table (Last) :=
                            (Value    => Value,
                             Display_Value => No_Name,
!                            Location => Location_Of (The_Current_Term),
                             Flag     => False,
                             Next     => Nil_String,
                             Index    => 0);
--- 838,864 ----
                          Add (Result.Value, Value);
  
                       when List =>
!                         String_Element_Table.Increment_Last
!                           (In_Tree.String_Elements);
  
                          if Last = Nil_String then
!                            Result.Values := String_Element_Table.Last
!                              (In_Tree.String_Elements);
  
                          else
!                            In_Tree.String_Elements.Table
!                              (Last).Next := String_Element_Table.Last
!                                        (In_Tree.String_Elements);
                          end if;
  
!                         Last := String_Element_Table.Last
!                                   (In_Tree.String_Elements);
!                         In_Tree.String_Elements.Table (Last) :=
                            (Value    => Value,
                             Display_Value => No_Name,
!                            Location      =>
!                              Location_Of
!                                (The_Current_Term, From_Project_Node_Tree),
                             Flag     => False,
                             Next     => Nil_String,
                             Index    => 0);
*************** package body Prj.Proc is
*** 740,746 ****
  
           end case;
  
!          The_Term := Next_Term (The_Term);
        end loop;
  
        return Result;
--- 877,883 ----
  
           end case;
  
!          The_Term := Next_Term (The_Term, From_Project_Node_Tree);
        end loop;
  
        return Result;
*************** package body Prj.Proc is
*** 752,760 ****
  
     function Imported_Or_Extended_Project_From
       (Project   : Project_Id;
        With_Name : Name_Id) return Project_Id
     is
!       Data        : constant Project_Data := Projects.Table (Project);
        List        : Project_List          := Data.Imported_Projects;
        Result      : Project_Id := No_Project;
        Temp_Result : Project_Id := No_Project;
--- 889,899 ----
  
     function Imported_Or_Extended_Project_From
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        With_Name : Name_Id) return Project_Id
     is
!       Data        : constant Project_Data :=
!                       In_Tree.Projects.Table (Project);
        List        : Project_List          := Data.Imported_Projects;
        Result      : Project_Id := No_Project;
        Temp_Result : Project_Id := No_Project;
*************** package body Prj.Proc is
*** 763,769 ****
        --  First check if it is the name of an extended project
  
        if Data.Extends /= No_Project
!         and then Projects.Table (Data.Extends).Name = With_Name
        then
           return Data.Extends;
  
--- 902,909 ----
        --  First check if it is the name of an extended project
  
        if Data.Extends /= No_Project
!         and then In_Tree.Projects.Table (Data.Extends).Name =
!                    With_Name
        then
           return Data.Extends;
  
*************** package body Prj.Proc is
*** 771,781 ****
           --  Then check the name of each imported project
  
           while List /= Empty_Project_List loop
!             Result := Project_Lists.Table (List).Project;
  
              --  If the project is directly imported, then returns its ID
  
!             if Projects.Table (Result).Name = With_Name then
                 return Result;
              end if;
  
--- 911,923 ----
           --  Then check the name of each imported project
  
           while List /= Empty_Project_List loop
!             Result := In_Tree.Project_Lists.Table (List).Project;
  
              --  If the project is directly imported, then returns its ID
  
!             if
!               In_Tree.Projects.Table (Result).Name = With_Name
!             then
                 return Result;
              end if;
  
*************** package body Prj.Proc is
*** 784,802 ****
              --  returned ID if the project is not imported directly.
  
              declare
!                Proj : Project_Id := Projects.Table (Result).Extends;
              begin
                 while Proj /= No_Project loop
!                   if Projects.Table (Proj).Name = With_Name then
                       Temp_Result := Result;
                       exit;
                    end if;
  
!                   Proj := Projects.Table (Proj).Extends;
                 end loop;
              end;
  
!             List := Project_Lists.Table (List).Next;
           end loop;
  
           pragma Assert
--- 926,947 ----
              --  returned ID if the project is not imported directly.
  
              declare
!                Proj : Project_Id :=
!                  In_Tree.Projects.Table (Result).Extends;
              begin
                 while Proj /= No_Project loop
!                   if In_Tree.Projects.Table (Proj).Name =
!                        With_Name
!                   then
                       Temp_Result := Result;
                       exit;
                    end if;
  
!                   Proj := In_Tree.Projects.Table (Proj).Extends;
                 end loop;
              end;
  
!             List := In_Tree.Project_Lists.Table (List).Next;
           end loop;
  
           pragma Assert
*************** package body Prj.Proc is
*** 813,835 ****
  
     function Package_From
       (Project   : Project_Id;
        With_Name : Name_Id) return Package_Id
     is
!       Data   : constant Project_Data := Projects.Table (Project);
        Result : Package_Id := Data.Decl.Packages;
  
     begin
        --  Check the name of each existing package of Project
  
        while Result /= No_Package
!         and then
!         Packages.Table (Result).Name /= With_Name
        loop
!          Result := Packages.Table (Result).Next;
        end loop;
  
        if Result = No_Package then
           --  Should never happen
           Write_Line ("package """ & Get_Name_String (With_Name) &
                       """ not found");
           raise Program_Error;
--- 958,983 ----
  
     function Package_From
       (Project   : Project_Id;
+       In_Tree   : Project_Tree_Ref;
        With_Name : Name_Id) return Package_Id
     is
!       Data   : constant Project_Data :=
!         In_Tree.Projects.Table (Project);
        Result : Package_Id := Data.Decl.Packages;
  
     begin
        --  Check the name of each existing package of Project
  
        while Result /= No_Package
!         and then In_Tree.Packages.Table (Result).Name /= With_Name
        loop
!          Result := In_Tree.Packages.Table (Result).Next;
        end loop;
  
        if Result = No_Package then
+ 
           --  Should never happen
+ 
           Write_Line ("package """ & Get_Name_String (With_Name) &
                       """ not found");
           raise Program_Error;
*************** package body Prj.Proc is
*** 844,854 ****
     -------------
  
     procedure Process
!      (Project           : out Project_Id;
!       Success           : out Boolean;
!       From_Project_Node : Project_Node_Id;
!       Report_Error      : Put_Line_Access;
!       Follow_Links      : Boolean := True)
     is
        Obj_Dir    : Name_Id;
        Extending  : Project_Id;
--- 992,1004 ----
     -------------
  
     procedure Process
!      (In_Tree                : Project_Tree_Ref;
!       Project                : out Project_Id;
!       Success                : out Boolean;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Report_Error           : Put_Line_Access;
!       Follow_Links           : Boolean := True)
     is
        Obj_Dir    : Name_Id;
        Extending  : Project_Id;
*************** package body Prj.Proc is
*** 860,878 ****
  
        --  Make sure there is no projects in the data structure
  
!       Projects.Set_Last (No_Project);
        Processed_Projects.Reset;
  
        --  And process the main project and all of the projects it depends on,
        --  recursively
  
        Recursive_Process
!         (Project           => Project,
!          From_Project_Node => From_Project_Node,
!          Extended_By       => No_Project);
  
        if Project /= No_Project then
!          Check (Project, Follow_Links);
        end if;
  
        --  If main project is an extending all project, set the object
--- 1010,1030 ----
  
        --  Make sure there is no projects in the data structure
  
!       Project_Table.Set_Last (In_Tree.Projects, No_Project);
        Processed_Projects.Reset;
  
        --  And process the main project and all of the projects it depends on,
        --  recursively
  
        Recursive_Process
!         (Project                => Project,
!          In_Tree                => In_Tree,
!          From_Project_Node      => From_Project_Node,
!          From_Project_Node_Tree => From_Project_Node_Tree,
!          Extended_By            => No_Project);
  
        if Project /= No_Project then
!          Check (In_Tree, Project, Follow_Links);
        end if;
  
        --  If main project is an extending all project, set the object
*************** package body Prj.Proc is
*** 880,894 ****
        --  of the main project.
  
        if Project /= No_Project
!         and then Is_Extending_All (From_Project_Node)
        then
           declare
              Object_Dir : constant Name_Id :=
!               Projects.Table (Project).Object_Directory;
           begin
!             for Index in Projects.First .. Projects.Last loop
!                if Projects.Table (Index).Virtual then
!                   Projects.Table (Index).Object_Directory := Object_Dir;
                 end if;
              end loop;
           end;
--- 1032,1049 ----
        --  of the main project.
  
        if Project /= No_Project
!         and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
        then
           declare
              Object_Dir : constant Name_Id :=
!                            In_Tree.Projects.Table (Project).Object_Directory;
           begin
!             for Index in
!               Project_Table.First .. Project_Table.Last (In_Tree.Projects)
!             loop
!                if In_Tree.Projects.Table (Index).Virtual then
!                   In_Tree.Projects.Table (Index).Object_Directory :=
!                     Object_Dir;
                 end if;
              end loop;
           end;
*************** package body Prj.Proc is
*** 898,908 ****
        --  the project(s) it extends.
  
        if Project /= No_Project then
!          for Proj in 1 .. Projects.Last loop
!             Extending := Projects.Table (Proj).Extended_By;
  
              if Extending /= No_Project then
!                Obj_Dir := Projects.Table (Proj).Object_Directory;
  
                 --  Check that a project being extended does not share its
                 --  object directory with any project that extends it, directly
--- 1053,1065 ----
        --  the project(s) it extends.
  
        if Project /= No_Project then
!          for Proj in
!            Project_Table.First .. Project_Table.Last (In_Tree.Projects)
!          loop
!             Extending := In_Tree.Projects.Table (Proj).Extended_By;
  
              if Extending /= No_Project then
!                Obj_Dir := In_Tree.Projects.Table (Proj).Object_Directory;
  
                 --  Check that a project being extended does not share its
                 --  object directory with any project that extends it, directly
*************** package body Prj.Proc is
*** 911,963 ****
                 --  Start with the project directly extending it
  
                 Extending2 := Extending;
- 
                 while Extending2 /= No_Project loop
! 
! --  why is this code commented out ???
! 
! --                if ((Process_Languages = Ada_Language
! --                     and then
! --                       Projects.Table (Extending2).Ada_Sources_Present)
! --                    or else
! --                      (Process_Languages = Other_Languages
! --                       and then
! --                         Projects.Table (Extending2).Other_Sources_Present))
! 
!                   if Projects.Table (Extending2).Ada_Sources_Present
                      and then
!                      Projects.Table (Extending2).Object_Directory = Obj_Dir
                    then
!                      if Projects.Table (Extending2).Virtual then
!                         Error_Msg_Name_1 := Projects.Table (Proj).Name;
  
                          if Error_Report = null then
                             Error_Msg
!                              ("project % cannot be extended by a virtual " &
                                "project with the same object directory",
!                               Projects.Table (Proj).Location);
! 
                          else
                             Error_Report
                               ("project """ &
                                Get_Name_String (Error_Msg_Name_1) &
                                """ cannot be extended by a virtual " &
                                "project with the same object directory",
!                               Project);
                          end if;
  
                       else
                          Error_Msg_Name_1 :=
!                           Projects.Table (Extending2).Name;
!                         Error_Msg_Name_2 := Projects.Table (Proj).Name;
  
                          if Error_Report = null then
                             Error_Msg
!                              ("project % cannot extend project %",
!                               Projects.Table (Extending2).Location);
                             Error_Msg
                               ("\they share the same object directory",
!                               Projects.Table (Extending2).Location);
  
                          else
                             Error_Report
--- 1068,1110 ----
                 --  Start with the project directly extending it
  
                 Extending2 := Extending;
                 while Extending2 /= No_Project loop
!                   if In_Tree.Projects.Table (Extending2).Ada_Sources_Present
                      and then
!                       In_Tree.Projects.Table (Extending2).Object_Directory =
!                                                                       Obj_Dir
                    then
!                      if In_Tree.Projects.Table (Extending2).Virtual then
!                         Error_Msg_Name_1 :=
!                           In_Tree.Projects.Table (Proj).Display_Name;
  
                          if Error_Report = null then
                             Error_Msg
!                              ("project { cannot be extended by a virtual " &
                                "project with the same object directory",
!                               In_Tree.Projects.Table (Proj).Location);
                          else
                             Error_Report
                               ("project """ &
                                Get_Name_String (Error_Msg_Name_1) &
                                """ cannot be extended by a virtual " &
                                "project with the same object directory",
!                               Project, In_Tree);
                          end if;
  
                       else
                          Error_Msg_Name_1 :=
!                           In_Tree.Projects.Table (Extending2).Display_Name;
!                         Error_Msg_Name_2 :=
!                           In_Tree.Projects.Table (Proj).Display_Name;
  
                          if Error_Report = null then
                             Error_Msg
!                              ("project { cannot extend project {",
!                               In_Tree.Projects.Table (Extending2).Location);
                             Error_Msg
                               ("\they share the same object directory",
!                               In_Tree.Projects.Table (Extending2).Location);
  
                          else
                             Error_Report
*************** package body Prj.Proc is
*** 965,987 ****
                                Get_Name_String (Error_Msg_Name_1) &
                                """ cannot extend project """ &
                                Get_Name_String (Error_Msg_Name_2) & """",
!                               Project);
                             Error_Report
                               ("they share the same object directory",
!                               Project);
                          end if;
                       end if;
                    end if;
  
                    --  Continue with the next extending project, if any
  
!                   Extending2 := Projects.Table (Extending2).Extended_By;
                 end loop;
              end if;
           end loop;
        end if;
  
!       Success := Total_Errors_Detected <= 0;
     end Process;
  
     -------------------------------
--- 1112,1135 ----
                                Get_Name_String (Error_Msg_Name_1) &
                                """ cannot extend project """ &
                                Get_Name_String (Error_Msg_Name_2) & """",
!                               Project, In_Tree);
                             Error_Report
                               ("they share the same object directory",
!                               Project, In_Tree);
                          end if;
                       end if;
                    end if;
  
                    --  Continue with the next extending project, if any
  
!                   Extending2 :=
!                     In_Tree.Projects.Table (Extending2).Extended_By;
                 end loop;
              end if;
           end loop;
        end if;
  
!       Success := Total_Errors_Detected = 0;
     end Process;
  
     -------------------------------
*************** package body Prj.Proc is
*** 989,998 ****
     -------------------------------
  
     procedure Process_Declarative_Items
!      (Project           : Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Pkg               : Package_Id;
!       Item              : Project_Node_Id)
     is
        Current_Declarative_Item : Project_Node_Id := Item;
        Current_Item             : Project_Node_Id := Empty_Node;
--- 1137,1148 ----
     -------------------------------
  
     procedure Process_Declarative_Items
!      (Project                : Project_Id;
!       In_Tree                : Project_Tree_Ref;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Pkg                    : Package_Id;
!       Item                   : Project_Node_Id)
     is
        Current_Declarative_Item : Project_Node_Id := Item;
        Current_Item             : Project_Node_Id := Empty_Node;
*************** package body Prj.Proc is
*** 1004,1053 ****
  
           --  Get its data
  
!          Current_Item := Current_Item_Node (Current_Declarative_Item);
  
           --  And set Current_Declarative_Item to the next declarative item
           --  ready for the next iteration.
  
!          Current_Declarative_Item := Next_Declarative_Item
!                                             (Current_Declarative_Item);
  
!          case Kind_Of (Current_Item) is
  
              when N_Package_Declaration =>
                 --  Do not process a package declaration that should be ignored
  
!                if Expression_Kind_Of (Current_Item) /= Ignored then
                    --  Create the new package
  
!                   Packages.Increment_Last;
  
                    declare
!                      New_Pkg         : constant Package_Id := Packages.Last;
                       The_New_Package : Package_Element;
  
!                      Project_Of_Renamed_Package : constant Project_Node_Id :=
!                        Project_Of_Renamed_Package_Of
!                        (Current_Item);
  
                    begin
                       --  Set the name of the new package
  
!                      The_New_Package.Name := Name_Of (Current_Item);
  
                       --  Insert the new package in the appropriate list
  
                       if Pkg /= No_Package then
                          The_New_Package.Next :=
!                           Packages.Table (Pkg).Decl.Packages;
!                         Packages.Table (Pkg).Decl.Packages := New_Pkg;
                       else
                          The_New_Package.Next :=
!                           Projects.Table (Project).Decl.Packages;
!                         Projects.Table (Project).Decl.Packages := New_Pkg;
                       end if;
  
!                      Packages.Table (New_Pkg) := The_New_Package;
  
                       if Project_Of_Renamed_Package /= Empty_Node then
  
--- 1154,1214 ----
  
           --  Get its data
  
!          Current_Item :=
!            Current_Item_Node
!              (Current_Declarative_Item, From_Project_Node_Tree);
  
           --  And set Current_Declarative_Item to the next declarative item
           --  ready for the next iteration.
  
!          Current_Declarative_Item :=
!            Next_Declarative_Item
!              (Current_Declarative_Item, From_Project_Node_Tree);
  
!          case Kind_Of (Current_Item, From_Project_Node_Tree) is
  
              when N_Package_Declaration =>
                 --  Do not process a package declaration that should be ignored
  
!                if Expression_Kind_Of
!                     (Current_Item, From_Project_Node_Tree) /= Ignored
!                then
                    --  Create the new package
  
!                   Package_Table.Increment_Last (In_Tree.Packages);
  
                    declare
!                      New_Pkg         : constant Package_Id :=
!                                          Package_Table.Last (In_Tree.Packages);
                       The_New_Package : Package_Element;
  
!                      Project_Of_Renamed_Package :
!                        constant Project_Node_Id :=
!                          Project_Of_Renamed_Package_Of
!                            (Current_Item, From_Project_Node_Tree);
  
                    begin
                       --  Set the name of the new package
  
!                      The_New_Package.Name :=
!                        Name_Of (Current_Item, From_Project_Node_Tree);
  
                       --  Insert the new package in the appropriate list
  
                       if Pkg /= No_Package then
                          The_New_Package.Next :=
!                           In_Tree.Packages.Table (Pkg).Decl.Packages;
!                         In_Tree.Packages.Table (Pkg).Decl.Packages :=
!                           New_Pkg;
                       else
                          The_New_Package.Next :=
!                           In_Tree.Projects.Table (Project).Decl.Packages;
!                         In_Tree.Projects.Table (Project).Decl.Packages :=
!                           New_Pkg;
                       end if;
  
!                      In_Tree.Packages.Table (New_Pkg) :=
!                        The_New_Package;
  
                       if Project_Of_Renamed_Package /= Empty_Node then
  
*************** package body Prj.Proc is
*** 1055,1078 ****
  
                          declare
                             Project_Name : constant Name_Id :=
!                              Name_Of
!                              (Project_Of_Renamed_Package);
  
!                            Renamed_Project : constant Project_Id :=
!                              Imported_Or_Extended_Project_From
!                              (Project, Project_Name);
  
                             Renamed_Package : constant Package_Id :=
!                              Package_From
!                              (Renamed_Project,
!                               Name_Of (Current_Item));
  
                          begin
                             --  For a renamed package, set declarations to
                             --  the declarations of the renamed package.
  
!                            Packages.Table (New_Pkg).Decl :=
!                              Packages.Table (Renamed_Package).Decl;
                          end;
  
                       --  Standard package declaration, not renaming
--- 1216,1243 ----
  
                          declare
                             Project_Name : constant Name_Id :=
!                                             Name_Of
!                                               (Project_Of_Renamed_Package,
!                                                From_Project_Node_Tree);
  
!                            Renamed_Project :
!                              constant Project_Id :=
!                                Imported_Or_Extended_Project_From
!                                (Project, In_Tree, Project_Name);
  
                             Renamed_Package : constant Package_Id :=
!                                                Package_From
!                                                  (Renamed_Project, In_Tree,
!                                                   Name_Of
!                                                     (Current_Item,
!                                                      From_Project_Node_Tree));
  
                          begin
                             --  For a renamed package, set declarations to
                             --  the declarations of the renamed package.
  
!                            In_Tree.Packages.Table (New_Pkg).Decl :=
!                              In_Tree.Packages.Table (Renamed_Package).Decl;
                          end;
  
                       --  Standard package declaration, not renaming
*************** package body Prj.Proc is
*** 1081,1099 ****
                          --  Set the default values of the attributes
  
                          Add_Attributes
!                           (Project,
!                            Packages.Table (New_Pkg).Decl,
                             First_Attribute_Of
!                              (Package_Id_Of (Current_Item)));
  
                          --  And process declarative items of the new package
  
                          Process_Declarative_Items
!                           (Project           => Project,
!                            From_Project_Node => From_Project_Node,
!                            Pkg               => New_Pkg,
!                            Item              => First_Declarative_Item_Of
!                              (Current_Item));
                       end if;
                    end;
                 end if;
--- 1246,1268 ----
                          --  Set the default values of the attributes
  
                          Add_Attributes
!                           (Project, In_Tree,
!                            In_Tree.Packages.Table (New_Pkg).Decl,
                             First_Attribute_Of
!                              (Package_Id_Of
!                                 (Current_Item, From_Project_Node_Tree)));
  
                          --  And process declarative items of the new package
  
                          Process_Declarative_Items
!                           (Project                => Project,
!                            In_Tree                => In_Tree,
!                            From_Project_Node      => From_Project_Node,
!                            From_Project_Node_Tree => From_Project_Node_Tree,
!                            Pkg                    => New_Pkg,
!                            Item                   =>
!                              First_Declarative_Item_Of
!                                (Current_Item, From_Project_Node_Tree));
                       end if;
                    end;
                 end if;
*************** package body Prj.Proc is
*** 1108,1120 ****
                   N_Typed_Variable_Declaration |
                   N_Variable_Declaration       =>
  
!                if Expression_Of (Current_Item) = Empty_Node then
  
                    --  It must be a full associative array attribute declaration
  
                    declare
                       Current_Item_Name : constant Name_Id :=
!                                            Name_Of (Current_Item);
                       --  The name of the attribute
  
                       New_Array  : Array_Id;
--- 1277,1291 ----
                   N_Typed_Variable_Declaration |
                   N_Variable_Declaration       =>
  
!                if Expression_Of (Current_Item, From_Project_Node_Tree) =
!                     Empty_Node
!                then
  
                    --  It must be a full associative array attribute declaration
  
                    declare
                       Current_Item_Name : constant Name_Id :=
!                        Name_Of (Current_Item, From_Project_Node_Tree);
                       --  The name of the attribute
  
                       New_Array  : Array_Id;
*************** package body Prj.Proc is
*** 1160,1207 ****
                       --  has elements declared.
  
                       if Pkg /= No_Package then
!                         New_Array := Packages.Table (Pkg).Decl.Arrays;
  
                       else
!                         New_Array := Projects.Table (Project).Decl.Arrays;
                       end if;
  
!                      while New_Array /= No_Array and then
!                            Arrays.Table (New_Array).Name /= Current_Item_Name
                       loop
!                         New_Array := Arrays.Table (New_Array).Next;
                       end loop;
  
                       --  If the attribute has never been declared add new entry
                       --  in the arrays of the project/package and link it.
  
                       if New_Array = No_Array then
!                         Arrays.Increment_Last;
!                         New_Array := Arrays.Last;
  
                          if Pkg /= No_Package then
!                            Arrays.Table (New_Array) :=
                               (Name  => Current_Item_Name,
                                Value => No_Array_Element,
!                               Next  => Packages.Table (Pkg).Decl.Arrays);
!                            Packages.Table (Pkg).Decl.Arrays := New_Array;
  
                          else
!                            Arrays.Table (New_Array) :=
                               (Name  => Current_Item_Name,
                                Value => No_Array_Element,
!                               Next  => Projects.Table (Project).Decl.Arrays);
!                            Projects.Table (Project).Decl.Arrays := New_Array;
                          end if;
                       end if;
  
                       --  Find the project where the value is declared
  
                       Orig_Project_Name :=
!                        Name_Of (Associative_Project_Of (Current_Item));
  
!                      for Index in Projects.First .. Projects.Last loop
!                         if Projects.Table (Index).Name = Orig_Project_Name then
                             Orig_Project := Index;
                             exit;
                          end if;
--- 1331,1395 ----
                       --  has elements declared.
  
                       if Pkg /= No_Package then
!                         New_Array := In_Tree.Packages.Table
!                                        (Pkg).Decl.Arrays;
  
                       else
!                         New_Array := In_Tree.Projects.Table
!                                        (Project).Decl.Arrays;
                       end if;
  
!                      while New_Array /= No_Array
!                        and then In_Tree.Arrays.Table (New_Array).Name /=
!                                                            Current_Item_Name
                       loop
!                         New_Array := In_Tree.Arrays.Table (New_Array).Next;
                       end loop;
  
                       --  If the attribute has never been declared add new entry
                       --  in the arrays of the project/package and link it.
  
                       if New_Array = No_Array then
!                         Array_Table.Increment_Last (In_Tree.Arrays);
!                         New_Array := Array_Table.Last (In_Tree.Arrays);
  
                          if Pkg /= No_Package then
!                            In_Tree.Arrays.Table (New_Array) :=
                               (Name  => Current_Item_Name,
                                Value => No_Array_Element,
!                               Next  =>
!                                 In_Tree.Packages.Table (Pkg).Decl.Arrays);
! 
!                            In_Tree.Packages.Table (Pkg).Decl.Arrays :=
!                              New_Array;
  
                          else
!                            In_Tree.Arrays.Table (New_Array) :=
                               (Name  => Current_Item_Name,
                                Value => No_Array_Element,
!                               Next  =>
!                                 In_Tree.Projects.Table (Project).Decl.Arrays);
! 
!                            In_Tree.Projects.Table (Project).Decl.Arrays :=
!                              New_Array;
                          end if;
                       end if;
  
                       --  Find the project where the value is declared
  
                       Orig_Project_Name :=
!                        Name_Of
!                          (Associative_Project_Of
!                               (Current_Item, From_Project_Node_Tree),
!                           From_Project_Node_Tree);
  
!                      for Index in Project_Table.First ..
!                                   Project_Table.Last
!                                     (In_Tree.Projects)
!                      loop
!                         if In_Tree.Projects.Table (Index).Name =
!                                                            Orig_Project_Name
!                         then
                             Orig_Project := Index;
                             exit;
                          end if;
*************** package body Prj.Proc is
*** 1210,1264 ****
                       pragma Assert (Orig_Project /= No_Project,
                                      "original project not found");
  
!                      if Associative_Package_Of (Current_Item) = Empty_Node then
                          Orig_Array :=
!                           Projects.Table (Orig_Project).Decl.Arrays;
  
                       else
                          --  If in a package, find the package where the
                          --  value is declared.
  
                          Orig_Package_Name :=
!                           Name_Of (Associative_Package_Of (Current_Item));
                          Orig_Package :=
!                           Projects.Table (Orig_Project).Decl.Packages;
                          pragma Assert (Orig_Package /= No_Package,
                                         "original package not found");
  
!                         while Packages.Table (Orig_Package).Name /=
!                           Orig_Package_Name
                          loop
!                            Orig_Package := Packages.Table (Orig_Package).Next;
                             pragma Assert (Orig_Package /= No_Package,
                                            "original package not found");
                          end loop;
  
                          Orig_Array :=
!                           Packages.Table (Orig_Package).Decl.Arrays;
                       end if;
  
                       --  Now look for the array
  
                       while Orig_Array /= No_Array and then
!                            Arrays.Table (Orig_Array).Name /= Current_Item_Name
                       loop
!                         Orig_Array := Arrays.Table (Orig_Array).Next;
                       end loop;
  
                       if Orig_Array = No_Array then
                          if Error_Report = null then
                             Error_Msg
                               ("associative array value cannot be found",
!                               Location_Of (Current_Item));
  
                          else
                             Error_Report
                               ("associative array value cannot be found",
!                               Project);
                          end if;
  
                       else
!                         Orig_Element := Arrays.Table (Orig_Array).Value;
  
                          --  Copy each array element
  
--- 1398,1466 ----
                       pragma Assert (Orig_Project /= No_Project,
                                      "original project not found");
  
!                      if Associative_Package_Of
!                           (Current_Item, From_Project_Node_Tree) = Empty_Node
!                      then
                          Orig_Array :=
!                           In_Tree.Projects.Table
!                             (Orig_Project).Decl.Arrays;
  
                       else
                          --  If in a package, find the package where the
                          --  value is declared.
  
                          Orig_Package_Name :=
!                           Name_Of
!                             (Associative_Package_Of
!                                  (Current_Item, From_Project_Node_Tree),
!                              From_Project_Node_Tree);
! 
                          Orig_Package :=
!                           In_Tree.Projects.Table
!                             (Orig_Project).Decl.Packages;
                          pragma Assert (Orig_Package /= No_Package,
                                         "original package not found");
  
!                         while In_Tree.Packages.Table
!                                 (Orig_Package).Name /= Orig_Package_Name
                          loop
!                            Orig_Package := In_Tree.Packages.Table
!                                              (Orig_Package).Next;
                             pragma Assert (Orig_Package /= No_Package,
                                            "original package not found");
                          end loop;
  
                          Orig_Array :=
!                           In_Tree.Packages.Table
!                             (Orig_Package).Decl.Arrays;
                       end if;
  
                       --  Now look for the array
  
                       while Orig_Array /= No_Array and then
!                      In_Tree.Arrays.Table (Orig_Array).Name /=
!                                                          Current_Item_Name
                       loop
!                         Orig_Array := In_Tree.Arrays.Table
!                                         (Orig_Array).Next;
                       end loop;
  
                       if Orig_Array = No_Array then
                          if Error_Report = null then
                             Error_Msg
                               ("associative array value cannot be found",
!                               Location_Of
!                                 (Current_Item, From_Project_Node_Tree));
  
                          else
                             Error_Report
                               ("associative array value cannot be found",
!                               Project, In_Tree);
                          end if;
  
                       else
!                         Orig_Element :=
!                           In_Tree.Arrays.Table (Orig_Array).Value;
  
                          --  Copy each array element
  
*************** package body Prj.Proc is
*** 1271,1290 ****
                                --  And there is no array element declared yet,
                                --  create a new first array element.
  
!                               if Arrays.Table (New_Array).Value =
                                                                No_Array_Element
                                then
!                                  Array_Elements.Increment_Last;
!                                  New_Element := Array_Elements.Last;
!                                  Arrays.Table (New_Array).Value := New_Element;
                                   Next_Element := No_Array_Element;
  
                                --  Otherwise, the new element is the first
  
                                else
!                                  New_Element := Arrays.Table (New_Array).Value;
                                   Next_Element :=
!                                    Array_Elements.Table (New_Element).Next;
                                end if;
  
                             --  Otherwise, reuse an existing element, or create
--- 1473,1497 ----
                                --  And there is no array element declared yet,
                                --  create a new first array element.
  
!                               if In_Tree.Arrays.Table (New_Array).Value =
                                                                No_Array_Element
                                then
!                                  Array_Element_Table.Increment_Last
!                                    (In_Tree.Array_Elements);
!                                  New_Element := Array_Element_Table.Last
!                                    (In_Tree.Array_Elements);
!                                  In_Tree.Arrays.Table
!                                    (New_Array).Value := New_Element;
                                   Next_Element := No_Array_Element;
  
                                --  Otherwise, the new element is the first
  
                                else
!                                  New_Element := In_Tree.Arrays.
!                                                   Table (New_Array).Value;
                                   Next_Element :=
!                                    In_Tree.Array_Elements.Table
!                                      (New_Element).Next;
                                end if;
  
                             --  Otherwise, reuse an existing element, or create
*************** package body Prj.Proc is
*** 1292,1321 ****
  
                             else
                                Next_Element :=
!                                 Array_Elements.Table (Prev_Element).Next;
  
                                if Next_Element = No_Array_Element then
!                                  Array_Elements.Increment_Last;
!                                  New_Element := Array_Elements.Last;
  
                                else
                                   New_Element := Next_Element;
                                   Next_Element :=
!                                    Array_Elements.Table (New_Element).Next;
                                end if;
                             end if;
  
                             --  Copy the value of the element
  
!                            Array_Elements.Table (New_Element) :=
!                              Array_Elements.Table (Orig_Element);
!                            Array_Elements.Table (New_Element).Value.Project :=
!                              Project;
  
                             --  Adjust the Next link
  
!                            Array_Elements.Table (New_Element).Next :=
!                              Next_Element;
  
                             --  Adjust the previous id for the next element
  
--- 1499,1534 ----
  
                             else
                                Next_Element :=
!                                 In_Tree.Array_Elements.Table
!                                   (Prev_Element).Next;
  
                                if Next_Element = No_Array_Element then
!                                  Array_Element_Table.Increment_Last
!                                    (In_Tree.Array_Elements);
!                                  New_Element := Array_Element_Table.Last
!                                    (In_Tree.Array_Elements);
  
                                else
                                   New_Element := Next_Element;
                                   Next_Element :=
!                                    In_Tree.Array_Elements.Table
!                                      (New_Element).Next;
                                end if;
                             end if;
  
                             --  Copy the value of the element
  
!                            In_Tree.Array_Elements.Table
!                              (New_Element) :=
!                                In_Tree.Array_Elements.Table
!                                  (Orig_Element);
!                            In_Tree.Array_Elements.Table
!                              (New_Element).Value.Project := Project;
  
                             --  Adjust the Next link
  
!                            In_Tree.Array_Elements.Table
!                              (New_Element).Next := Next_Element;
  
                             --  Adjust the previous id for the next element
  
*************** package body Prj.Proc is
*** 1324,1337 ****
                             --  Go to the next element in the original array
  
                             Orig_Element :=
!                              Array_Elements.Table (Orig_Element).Next;
                          end loop;
  
                          --  Make sure that the array ends here, in case there
                          --  previously a greater number of elements.
  
!                         Array_Elements.Table (New_Element).Next :=
!                           No_Array_Element;
                       end if;
                    end;
  
--- 1537,1551 ----
                             --  Go to the next element in the original array
  
                             Orig_Element :=
!                              In_Tree.Array_Elements.Table
!                                (Orig_Element).Next;
                          end loop;
  
                          --  Make sure that the array ends here, in case there
                          --  previously a greater number of elements.
  
!                         In_Tree.Array_Elements.Table
!                           (New_Element).Next := No_Array_Element;
                       end if;
                    end;
  
*************** package body Prj.Proc is
*** 1341,1402 ****
                    declare
                       New_Value : constant Variable_Value :=
                         Expression
!                          (Project           => Project,
!                           From_Project_Node => From_Project_Node,
!                           Pkg               => Pkg,
!                           First_Term        =>
!                             Tree.First_Term (Expression_Of
!                                                         (Current_Item)),
!                           Kind              =>
!                             Expression_Kind_Of (Current_Item));
                       --  The expression value
  
                       The_Variable : Variable_Id := No_Variable;
  
                       Current_Item_Name : constant Name_Id :=
!                        Name_Of (Current_Item);
  
                    begin
                       --  Process a typed variable declaration
  
!                      if
!                        Kind_Of (Current_Item) = N_Typed_Variable_Declaration
                       then
                          --  Report an error for an empty string
  
                          if New_Value.Value = Empty_String then
!                            Error_Msg_Name_1 := Name_Of (Current_Item);
  
                             if Error_Report = null then
                                Error_Msg
                                  ("no value defined for %",
!                                  Location_Of (Current_Item));
  
                             else
                                Error_Report
                                  ("no value defined for " &
                                   Get_Name_String (Error_Msg_Name_1),
!                                  Project);
                             end if;
  
                          else
                             declare
                                Current_String : Project_Node_Id :=
!                                 First_Literal_String
!                                   (String_Type_Of
!                                        (Current_Item));
  
                             begin
!                               --  Loop through all the valid strings for
!                               --  the string type and compare to the string
!                               --  value.
  
                                while Current_String /= Empty_Node
!                                 and then String_Value_Of (Current_String) /=
!                                 New_Value.Value
                                loop
                                   Current_String :=
!                                    Next_Literal_String (Current_String);
                                end loop;
  
                                --  Report an error if the string value is not
--- 1555,1627 ----
                    declare
                       New_Value : constant Variable_Value :=
                         Expression
!                          (Project                => Project,
!                           In_Tree                => In_Tree,
!                           From_Project_Node      => From_Project_Node,
!                           From_Project_Node_Tree => From_Project_Node_Tree,
!                           Pkg                    => Pkg,
!                           First_Term             =>
!                             Tree.First_Term
!                               (Expression_Of
!                                    (Current_Item, From_Project_Node_Tree),
!                                From_Project_Node_Tree),
!                           Kind                   =>
!                             Expression_Kind_Of
!                               (Current_Item, From_Project_Node_Tree));
                       --  The expression value
  
                       The_Variable : Variable_Id := No_Variable;
  
                       Current_Item_Name : constant Name_Id :=
!                        Name_Of (Current_Item, From_Project_Node_Tree);
  
                    begin
                       --  Process a typed variable declaration
  
!                      if Kind_Of (Current_Item, From_Project_Node_Tree) =
!                           N_Typed_Variable_Declaration
                       then
                          --  Report an error for an empty string
  
                          if New_Value.Value = Empty_String then
!                            Error_Msg_Name_1 :=
!                              Name_Of (Current_Item, From_Project_Node_Tree);
  
                             if Error_Report = null then
                                Error_Msg
                                  ("no value defined for %",
!                                  Location_Of
!                                    (Current_Item, From_Project_Node_Tree));
  
                             else
                                Error_Report
                                  ("no value defined for " &
                                   Get_Name_String (Error_Msg_Name_1),
!                                  Project, In_Tree);
                             end if;
  
                          else
                             declare
                                Current_String : Project_Node_Id :=
!                                                  First_Literal_String
!                                                    (String_Type_Of
!                                                       (Current_Item,
!                                                        From_Project_Node_Tree),
!                                                     From_Project_Node_Tree);
  
                             begin
!                               --  Loop through all the valid strings for the
!                               --  string type and compare to the string value.
  
                                while Current_String /= Empty_Node
!                                 and then
!                                   String_Value_Of
!                                     (Current_String, From_Project_Node_Tree) /=
!                                                                New_Value.Value
                                loop
                                   Current_String :=
!                                    Next_Literal_String
!                                      (Current_String, From_Project_Node_Tree);
                                end loop;
  
                                --  Report an error if the string value is not
*************** package body Prj.Proc is
*** 1404,1415 ****
  
                                if Current_String = Empty_Node then
                                   Error_Msg_Name_1 := New_Value.Value;
!                                  Error_Msg_Name_2 := Name_Of (Current_Item);
  
                                   if Error_Report = null then
                                      Error_Msg
                                        ("value { is illegal for typed string %",
!                                        Location_Of (Current_Item));
  
                                   else
                                      Error_Report
--- 1629,1644 ----
  
                                if Current_String = Empty_Node then
                                   Error_Msg_Name_1 := New_Value.Value;
!                                  Error_Msg_Name_2 :=
!                                    Name_Of
!                                      (Current_Item, From_Project_Node_Tree);
  
                                   if Error_Report = null then
                                      Error_Msg
                                        ("value { is illegal for typed string %",
!                                        Location_Of
!                                          (Current_Item,
!                                           From_Project_Node_Tree));
  
                                   else
                                      Error_Report
*************** package body Prj.Proc is
*** 1418,1433 ****
                                         """ is illegal for typed string """ &
                                         Get_Name_String (Error_Msg_Name_2) &
                                         """",
!                                        Project);
                                   end if;
                                end if;
                             end;
                          end if;
                       end if;
  
!                      if Kind_Of (Current_Item) /= N_Attribute_Declaration
                         or else
!                          Associative_Array_Index_Of (Current_Item) = No_Name
                       then
                          --  Case of a variable declaration or of a not
                          --  associative array attribute.
--- 1647,1664 ----
                                         """ is illegal for typed string """ &
                                         Get_Name_String (Error_Msg_Name_2) &
                                         """",
!                                        Project, In_Tree);
                                   end if;
                                end if;
                             end;
                          end if;
                       end if;
  
!                      if Kind_Of (Current_Item, From_Project_Node_Tree) /=
!                           N_Attribute_Declaration
                         or else
!                          Associative_Array_Index_Of
!                            (Current_Item, From_Project_Node_Tree) = No_Name
                       then
                          --  Case of a variable declaration or of a not
                          --  associative array attribute.
*************** package body Prj.Proc is
*** 1435,1460 ****
                          --  First, find the list where to find the variable
                          --  or attribute.
  
!                         if
!                           Kind_Of (Current_Item) = N_Attribute_Declaration
                          then
                             if Pkg /= No_Package then
                                The_Variable :=
!                                 Packages.Table (Pkg).Decl.Attributes;
! 
                             else
                                The_Variable :=
!                                 Projects.Table (Project).Decl.Attributes;
                             end if;
  
                          else
                             if Pkg /= No_Package then
                                The_Variable :=
!                                 Packages.Table (Pkg).Decl.Variables;
! 
                             else
                                The_Variable :=
!                                 Projects.Table (Project).Decl.Variables;
                             end if;
  
                          end if;
--- 1666,1693 ----
                          --  First, find the list where to find the variable
                          --  or attribute.
  
!                         if Kind_Of (Current_Item, From_Project_Node_Tree) =
!                              N_Attribute_Declaration
                          then
                             if Pkg /= No_Package then
                                The_Variable :=
!                                 In_Tree.Packages.Table
!                                   (Pkg).Decl.Attributes;
                             else
                                The_Variable :=
!                                 In_Tree.Projects.Table
!                                   (Project).Decl.Attributes;
                             end if;
  
                          else
                             if Pkg /= No_Package then
                                The_Variable :=
!                                 In_Tree.Packages.Table
!                                   (Pkg).Decl.Variables;
                             else
                                The_Variable :=
!                                 In_Tree.Projects.Table
!                                   (Project).Decl.Variables;
                             end if;
  
                          end if;
*************** package body Prj.Proc is
*** 1462,1519 ****
                          --  Loop through the list, to find if it has already
                          --  been declared.
  
!                         while
!                           The_Variable /= No_Variable
                            and then
!                         Variable_Elements.Table (The_Variable).Name /=
!                           Current_Item_Name
                          loop
                             The_Variable :=
!                              Variable_Elements.Table (The_Variable).Next;
                          end loop;
  
                          --  If it has not been declared, create a new entry
                          --  in the list.
  
                          if The_Variable = No_Variable then
                             --  All single string attribute should already have
                             --  been declared with a default empty string value.
  
                             pragma Assert
!                              (Kind_Of (Current_Item) /=
                                  N_Attribute_Declaration,
                                "illegal attribute declaration");
  
!                            Variable_Elements.Increment_Last;
!                            The_Variable := Variable_Elements.Last;
  
                             --  Put the new variable in the appropriate list
  
                             if Pkg /= No_Package then
!                               Variable_Elements.Table (The_Variable) :=
                                  (Next    =>
!                                    Packages.Table (Pkg).Decl.Variables,
                                   Name    => Current_Item_Name,
                                   Value   => New_Value);
!                               Packages.Table (Pkg).Decl.Variables :=
!                                 The_Variable;
  
                             else
!                               Variable_Elements.Table (The_Variable) :=
                                  (Next    =>
!                                    Projects.Table (Project).Decl.Variables,
                                   Name    => Current_Item_Name,
                                   Value   => New_Value);
!                               Projects.Table (Project).Decl.Variables :=
!                                 The_Variable;
                             end if;
  
                          --  If the variable/attribute has already been
                          --  declared, just change the value.
  
                          else
!                            Variable_Elements.Table (The_Variable).Value :=
!                              New_Value;
  
                          end if;
  
--- 1695,1759 ----
                          --  Loop through the list, to find if it has already
                          --  been declared.
  
!                         while The_Variable /= No_Variable
                            and then
!                             In_Tree.Variable_Elements.Table
!                               (The_Variable).Name /= Current_Item_Name
                          loop
                             The_Variable :=
!                              In_Tree.Variable_Elements.Table
!                                (The_Variable).Next;
                          end loop;
  
                          --  If it has not been declared, create a new entry
                          --  in the list.
  
                          if The_Variable = No_Variable then
+ 
                             --  All single string attribute should already have
                             --  been declared with a default empty string value.
  
                             pragma Assert
!                              (Kind_Of (Current_Item, From_Project_Node_Tree) /=
                                  N_Attribute_Declaration,
                                "illegal attribute declaration");
  
!                            Variable_Element_Table.Increment_Last
!                              (In_Tree.Variable_Elements);
!                            The_Variable := Variable_Element_Table.Last
!                              (In_Tree.Variable_Elements);
  
                             --  Put the new variable in the appropriate list
  
                             if Pkg /= No_Package then
!                               In_Tree.Variable_Elements.Table (The_Variable) :=
                                  (Next    =>
!                                    In_Tree.Packages.Table
!                                      (Pkg).Decl.Variables,
                                   Name    => Current_Item_Name,
                                   Value   => New_Value);
!                               In_Tree.Packages.Table
!                                 (Pkg).Decl.Variables := The_Variable;
  
                             else
!                               In_Tree.Variable_Elements.Table (The_Variable) :=
                                  (Next    =>
!                                    In_Tree.Projects.Table
!                                      (Project).Decl.Variables,
                                   Name    => Current_Item_Name,
                                   Value   => New_Value);
!                               In_Tree.Projects.Table
!                                 (Project).Decl.Variables :=
!                                   The_Variable;
                             end if;
  
                          --  If the variable/attribute has already been
                          --  declared, just change the value.
  
                          else
!                            In_Tree.Variable_Elements.Table
!                              (The_Variable).Value :=
!                                 New_Value;
  
                          end if;
  
*************** package body Prj.Proc is
*** 1523,1533 ****
                          --  Get the string index
  
                          Get_Name_String
!                           (Associative_Array_Index_Of (Current_Item));
  
                          --  Put in lower case, if necessary
  
!                         if Case_Insensitive (Current_Item) then
                             GNAT.Case_Util.To_Lower
                                              (Name_Buffer (1 .. Name_Len));
                          end if;
--- 1763,1776 ----
                          --  Get the string index
  
                          Get_Name_String
!                           (Associative_Array_Index_Of
!                              (Current_Item, From_Project_Node_Tree));
  
                          --  Put in lower case, if necessary
  
!                         if Case_Insensitive
!                              (Current_Item, From_Project_Node_Tree)
!                         then
                             GNAT.Case_Util.To_Lower
                                              (Name_Buffer (1 .. Name_Len));
                          end if;
*************** package body Prj.Proc is
*** 1536,1542 ****
                             The_Array : Array_Id;
  
                             The_Array_Element : Array_Element_Id :=
!                              No_Array_Element;
  
                             Index_Name : constant Name_Id := Name_Find;
                             --  The name id of the index
--- 1779,1785 ----
                             The_Array : Array_Id;
  
                             The_Array_Element : Array_Element_Id :=
!                                                  No_Array_Element;
  
                             Index_Name : constant Name_Id := Name_Find;
                             --  The name id of the index
*************** package body Prj.Proc is
*** 1545,1563 ****
                             --  Look for the array in the appropriate list
  
                             if Pkg /= No_Package then
!                               The_Array := Packages.Table (Pkg).Decl.Arrays;
  
                             else
!                               The_Array := Projects.Table
                                               (Project).Decl.Arrays;
                             end if;
  
                             while
                               The_Array /= No_Array
!                              and then Arrays.Table (The_Array).Name /=
!                              Current_Item_Name
                             loop
!                               The_Array := Arrays.Table (The_Array).Next;
                             end loop;
  
                             --  If the array cannot be found, create a new
--- 1788,1808 ----
                             --  Look for the array in the appropriate list
  
                             if Pkg /= No_Package then
!                               The_Array := In_Tree.Packages.Table
!                                              (Pkg).Decl.Arrays;
  
                             else
!                               The_Array := In_Tree.Projects.Table
                                               (Project).Decl.Arrays;
                             end if;
  
                             while
                               The_Array /= No_Array
!                              and then In_Tree.Arrays.Table
!                                         (The_Array).Name /= Current_Item_Name
                             loop
!                               The_Array := In_Tree.Arrays.Table
!                                              (The_Array).Next;
                             end loop;
  
                             --  If the array cannot be found, create a new
*************** package body Prj.Proc is
*** 1566,1589 ****
                             --  will be created automatically later.
  
                             if The_Array = No_Array then
!                               Arrays.Increment_Last;
!                               The_Array := Arrays.Last;
  
                                if Pkg /= No_Package then
!                                  Arrays.Table (The_Array) :=
                                     (Name  => Current_Item_Name,
                                      Value => No_Array_Element,
!                                     Next  => Packages.Table (Pkg).Decl.Arrays);
!                                  Packages.Table (Pkg).Decl.Arrays := The_Array;
  
                                else
!                                  Arrays.Table (The_Array) :=
                                     (Name  => Current_Item_Name,
                                      Value => No_Array_Element,
                                      Next  =>
!                                       Projects.Table (Project).Decl.Arrays);
!                                  Projects.Table (Project).Decl.Arrays :=
!                                    The_Array;
                                end if;
  
                             --  Otherwise, initialize The_Array_Element as the
--- 1811,1846 ----
                             --  will be created automatically later.
  
                             if The_Array = No_Array then
!                               Array_Table.Increment_Last
!                                 (In_Tree.Arrays);
!                               The_Array := Array_Table.Last
!                                 (In_Tree.Arrays);
  
                                if Pkg /= No_Package then
!                                  In_Tree.Arrays.Table
!                                    (The_Array) :=
                                     (Name  => Current_Item_Name,
                                      Value => No_Array_Element,
!                                     Next  =>
!                                       In_Tree.Packages.Table
!                                         (Pkg).Decl.Arrays);
! 
!                                  In_Tree.Packages.Table
!                                    (Pkg).Decl.Arrays :=
!                                      The_Array;
  
                                else
!                                  In_Tree.Arrays.Table
!                                    (The_Array) :=
                                     (Name  => Current_Item_Name,
                                      Value => No_Array_Element,
                                      Next  =>
!                                       In_Tree.Projects.Table
!                                         (Project).Decl.Arrays);
! 
!                                  In_Tree.Projects.Table
!                                    (Project).Decl.Arrays :=
!                                      The_Array;
                                end if;
  
                             --  Otherwise, initialize The_Array_Element as the
*************** package body Prj.Proc is
*** 1591,1597 ****
  
                             else
                                The_Array_Element :=
!                                 Arrays.Table (The_Array).Value;
                             end if;
  
                             --  Look in the list, if any, to find an element
--- 1848,1855 ----
  
                             else
                                The_Array_Element :=
!                                 In_Tree.Arrays.Table
!                                   (The_Array).Value;
                             end if;
  
                             --  Look in the list, if any, to find an element
*************** package body Prj.Proc is
*** 1599,1609 ****
  
                             while The_Array_Element /= No_Array_Element
                               and then
!                            Array_Elements.Table (The_Array_Element).Index /=
!                              Index_Name
                             loop
                                The_Array_Element :=
!                                 Array_Elements.Table (The_Array_Element).Next;
                             end loop;
  
                             --  If no such element were found, create a new
--- 1857,1868 ----
  
                             while The_Array_Element /= No_Array_Element
                               and then
!                                In_Tree.Array_Elements.Table
!                                  (The_Array_Element).Index /= Index_Name
                             loop
                                The_Array_Element :=
!                                 In_Tree.Array_Elements.Table
!                                   (The_Array_Element).Next;
                             end loop;
  
                             --  If no such element were found, create a new
*************** package body Prj.Proc is
*** 1611,1635 ****
                             --  the propoer value.
  
                             if The_Array_Element = No_Array_Element then
!                               Array_Elements.Increment_Last;
!                               The_Array_Element := Array_Elements.Last;
  
!                               Array_Elements.Table (The_Array_Element) :=
                                  (Index  => Index_Name,
!                                  Src_Index => Source_Index_Of (Current_Item),
                                   Index_Case_Sensitive =>
!                                  not Case_Insensitive (Current_Item),
                                   Value  => New_Value,
!                                  Next   => Arrays.Table (The_Array).Value);
!                               Arrays.Table (The_Array).Value :=
!                                 The_Array_Element;
  
                             --  An element with the same index already exists,
                             --  just replace its value with the new one.
  
                             else
!                               Array_Elements.Table (The_Array_Element).Value :=
!                                 New_Value;
                             end if;
                          end;
                       end if;
--- 1870,1901 ----
                             --  the propoer value.
  
                             if The_Array_Element = No_Array_Element then
!                               Array_Element_Table.Increment_Last
!                                 (In_Tree.Array_Elements);
!                               The_Array_Element := Array_Element_Table.Last
!                                 (In_Tree.Array_Elements);
  
!                               In_Tree.Array_Elements.Table
!                                 (The_Array_Element) :=
                                  (Index  => Index_Name,
!                                  Src_Index =>
!                                    Source_Index_Of
!                                      (Current_Item, From_Project_Node_Tree),
                                   Index_Case_Sensitive =>
!                                  not Case_Insensitive
!                                    (Current_Item, From_Project_Node_Tree),
                                   Value  => New_Value,
!                                  Next => In_Tree.Arrays.Table
!                                            (The_Array).Value);
!                               In_Tree.Arrays.Table
!                                 (The_Array).Value := The_Array_Element;
  
                             --  An element with the same index already exists,
                             --  just replace its value with the new one.
  
                             else
!                               In_Tree.Array_Elements.Table
!                                 (The_Array_Element).Value := New_Value;
                             end if;
                          end;
                       end if;
*************** package body Prj.Proc is
*** 1658,1664 ****
                    declare
                       Variable_Node : constant Project_Node_Id :=
                                         Case_Variable_Reference_Of
!                                          (Current_Item);
  
                       Var_Id : Variable_Id := No_Variable;
                       Name   : Name_Id     := No_Name;
--- 1924,1931 ----
                    declare
                       Variable_Node : constant Project_Node_Id :=
                                         Case_Variable_Reference_Of
!                                          (Current_Item,
!                                           From_Project_Node_Tree);
  
                       Var_Id : Variable_Id := No_Variable;
                       Name   : Name_Id     := No_Name;
*************** package body Prj.Proc is
*** 1667,1699 ****
                       --  If a project were specified for the case variable,
                       --  get its id.
  
!                      if Project_Node_Of (Variable_Node) /= Empty_Node then
!                         Name := Name_Of (Project_Node_Of (Variable_Node));
                          The_Project :=
!                           Imported_Or_Extended_Project_From (Project, Name);
                       end if;
  
                       --  If a package were specified for the case variable,
                       --  get its id.
  
!                      if Package_Node_Of (Variable_Node) /= Empty_Node then
!                         Name := Name_Of (Package_Node_Of (Variable_Node));
!                         The_Package := Package_From (The_Project, Name);
                       end if;
  
!                      Name := Name_Of (Variable_Node);
  
                       --  First, look for the case variable into the package,
                       --  if any.
  
                       if The_Package /= No_Package then
!                         Var_Id := Packages.Table (The_Package).Decl.Variables;
!                         Name := Name_Of (Variable_Node);
                          while Var_Id /= No_Variable
                            and then
!                             Variable_Elements.Table (Var_Id).Name /= Name
                          loop
!                            Var_Id := Variable_Elements.Table (Var_Id).Next;
                          end loop;
                       end if;
  
--- 1934,1984 ----
                       --  If a project were specified for the case variable,
                       --  get its id.
  
!                      if Project_Node_Of
!                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
!                      then
!                         Name :=
!                           Name_Of
!                             (Project_Node_Of
!                                (Variable_Node, From_Project_Node_Tree),
!                              From_Project_Node_Tree);
                          The_Project :=
!                           Imported_Or_Extended_Project_From
!                             (Project, In_Tree, Name);
                       end if;
  
                       --  If a package were specified for the case variable,
                       --  get its id.
  
!                      if Package_Node_Of
!                        (Variable_Node, From_Project_Node_Tree) /= Empty_Node
!                      then
!                         Name :=
!                           Name_Of
!                             (Package_Node_Of
!                                (Variable_Node, From_Project_Node_Tree),
!                              From_Project_Node_Tree);
!                         The_Package :=
!                           Package_From (The_Project, In_Tree, Name);
                       end if;
  
!                      Name := Name_Of (Variable_Node, From_Project_Node_Tree);
  
                       --  First, look for the case variable into the package,
                       --  if any.
  
                       if The_Package /= No_Package then
!                         Var_Id := In_Tree.Packages.Table
!                                     (The_Package).Decl.Variables;
!                         Name :=
!                           Name_Of (Variable_Node, From_Project_Node_Tree);
                          while Var_Id /= No_Variable
                            and then
!                             In_Tree.Variable_Elements.Table
!                               (Var_Id).Name /= Name
                          loop
!                            Var_Id := In_Tree.Variable_Elements.
!                                        Table (Var_Id).Next;
                          end loop;
                       end if;
  
*************** package body Prj.Proc is
*** 1701,1714 ****
                       --  package, look at the project level.
  
                       if Var_Id = No_Variable
!                        and then Package_Node_Of (Variable_Node) = Empty_Node
                       then
!                         Var_Id := Projects.Table (The_Project).Decl.Variables;
                          while Var_Id /= No_Variable
                            and then
!                             Variable_Elements.Table (Var_Id).Name /= Name
                          loop
!                            Var_Id := Variable_Elements.Table (Var_Id).Next;
                          end loop;
                       end if;
  
--- 1986,2004 ----
                       --  package, look at the project level.
  
                       if Var_Id = No_Variable
!                         and then
!                         Package_Node_Of
!                           (Variable_Node, From_Project_Node_Tree) = Empty_Node
                       then
!                         Var_Id := In_Tree.Projects.Table
!                                     (The_Project).Decl.Variables;
                          while Var_Id /= No_Variable
                            and then
!                             In_Tree.Variable_Elements.Table
!                               (Var_Id).Name /= Name
                          loop
!                            Var_Id := In_Tree.Variable_Elements.
!                                        Table (Var_Id).Next;
                          end loop;
                       end if;
  
*************** package body Prj.Proc is
*** 1725,1731 ****
  
                       --  Get the case variable
  
!                      The_Variable := Variable_Elements.Table (Var_Id).Value;
  
                       if The_Variable.Kind /= Single then
  
--- 2015,2022 ----
  
                       --  Get the case variable
  
!                      The_Variable := In_Tree.Variable_Elements.
!                                        Table (Var_Id).Value;
  
                       if The_Variable.Kind /= Single then
  
*************** package body Prj.Proc is
*** 1744,1759 ****
  
                    --  Now look into all the case items of the case construction
  
!                   Case_Item := First_Case_Item_Of (Current_Item);
                    Case_Item_Loop :
                       while Case_Item /= Empty_Node loop
!                         Choice_String := First_Choice_Of (Case_Item);
  
                          --  When Choice_String is nil, it means that it is
                          --  the "when others =>" alternative.
  
                          if Choice_String = Empty_Node then
!                            Decl_Item := First_Declarative_Item_Of (Case_Item);
                             exit Case_Item_Loop;
                          end if;
  
--- 2035,2054 ----
  
                    --  Now look into all the case items of the case construction
  
!                   Case_Item :=
!                     First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
                    Case_Item_Loop :
                       while Case_Item /= Empty_Node loop
!                         Choice_String :=
!                           First_Choice_Of (Case_Item, From_Project_Node_Tree);
  
                          --  When Choice_String is nil, it means that it is
                          --  the "when others =>" alternative.
  
                          if Choice_String = Empty_Node then
!                            Decl_Item :=
!                              First_Declarative_Item_Of
!                                (Case_Item, From_Project_Node_Tree);
                             exit Case_Item_Loop;
                          end if;
  
*************** package body Prj.Proc is
*** 1761,1788 ****
  
                          Choice_Loop :
                             while Choice_String /= Empty_Node loop
!                               if
!                                 Case_Value = String_Value_Of (Choice_String)
                                then
                                   Decl_Item :=
!                                    First_Declarative_Item_Of (Case_Item);
                                   exit Case_Item_Loop;
                                end if;
  
                                Choice_String :=
!                                 Next_Literal_String (Choice_String);
                             end loop Choice_Loop;
!                         Case_Item := Next_Case_Item (Case_Item);
                       end loop Case_Item_Loop;
  
                    --  If there is an alternative, then we process it
  
                    if Decl_Item /= Empty_Node then
                       Process_Declarative_Items
!                        (Project           => Project,
!                         From_Project_Node => From_Project_Node,
!                         Pkg               => Pkg,
!                         Item              => Decl_Item);
                    end if;
                 end;
  
--- 2056,2090 ----
  
                          Choice_Loop :
                             while Choice_String /= Empty_Node loop
!                               if Case_Value =
!                                 String_Value_Of
!                                   (Choice_String, From_Project_Node_Tree)
                                then
                                   Decl_Item :=
!                                    First_Declarative_Item_Of
!                                      (Case_Item, From_Project_Node_Tree);
                                   exit Case_Item_Loop;
                                end if;
  
                                Choice_String :=
!                                 Next_Literal_String
!                                   (Choice_String, From_Project_Node_Tree);
                             end loop Choice_Loop;
! 
!                         Case_Item :=
!                           Next_Case_Item (Case_Item, From_Project_Node_Tree);
                       end loop Case_Item_Loop;
  
                    --  If there is an alternative, then we process it
  
                    if Decl_Item /= Empty_Node then
                       Process_Declarative_Items
!                        (Project                => Project,
!                         In_Tree                => In_Tree,
!                         From_Project_Node      => From_Project_Node,
!                         From_Project_Node_Tree => From_Project_Node_Tree,
!                         Pkg                    => Pkg,
!                         Item                   => Decl_Item);
                    end if;
                 end;
  
*************** package body Prj.Proc is
*** 1791,1797 ****
                 --  Should never happen
  
                 Write_Line ("Illegal declarative item: " &
!                            Project_Node_Kind'Image (Kind_Of (Current_Item)));
                 raise Program_Error;
           end case;
        end loop;
--- 2093,2101 ----
                 --  Should never happen
  
                 Write_Line ("Illegal declarative item: " &
!                            Project_Node_Kind'Image
!                              (Kind_Of
!                                 (Current_Item, From_Project_Node_Tree)));
                 raise Program_Error;
           end case;
        end loop;
*************** package body Prj.Proc is
*** 1803,1808 ****
--- 2107,2113 ----
  
     procedure Recursive_Check
       (Project           : Project_Id;
+       In_Tree           : Project_Tree_Ref;
        Follow_Links      : Boolean)
     is
        Data                  : Project_Data;
*************** package body Prj.Proc is
*** 1813,1841 ****
        --  been marked as checked.
  
        if Project /= No_Project
!         and then not Projects.Table (Project).Checked
        then
           --  Mark project as checked, to avoid infinite recursion in
           --  ill-formed trees, where a project imports itself.
  
!          Projects.Table (Project).Checked := True;
  
!          Data := Projects.Table (Project);
  
           --  Call itself for a possible extended project.
           --  (if there is no extended project, then nothing happens).
  
!          Recursive_Check (Data.Extends, Follow_Links);
  
           --  Call itself for all imported projects
  
           Imported_Project_List := Data.Imported_Projects;
           while Imported_Project_List /= Empty_Project_List loop
              Recursive_Check
!               (Project_Lists.Table (Imported_Project_List).Project,
!                Follow_Links);
              Imported_Project_List :=
!               Project_Lists.Table (Imported_Project_List).Next;
           end loop;
  
           if Opt.Verbose_Mode then
--- 2118,2148 ----
        --  been marked as checked.
  
        if Project /= No_Project
!         and then not In_Tree.Projects.Table (Project).Checked
        then
           --  Mark project as checked, to avoid infinite recursion in
           --  ill-formed trees, where a project imports itself.
  
!          In_Tree.Projects.Table (Project).Checked := True;
  
!          Data := In_Tree.Projects.Table (Project);
  
           --  Call itself for a possible extended project.
           --  (if there is no extended project, then nothing happens).
  
!          Recursive_Check (Data.Extends, In_Tree, Follow_Links);
  
           --  Call itself for all imported projects
  
           Imported_Project_List := Data.Imported_Projects;
           while Imported_Project_List /= Empty_Project_List loop
              Recursive_Check
!               (In_Tree.Project_Lists.Table
!                  (Imported_Project_List).Project,
!                In_Tree, Follow_Links);
              Imported_Project_List :=
!               In_Tree.Project_Lists.Table
!                 (Imported_Project_List).Next;
           end loop;
  
           if Opt.Verbose_Mode then
*************** package body Prj.Proc is
*** 1844,1850 ****
              Write_Line ("""");
           end if;
  
!          Prj.Nmsc.Check (Project, Error_Report, Follow_Links);
        end if;
     end Recursive_Check;
  
--- 2151,2157 ----
              Write_Line ("""");
           end if;
  
!          Prj.Nmsc.Check (Project, In_Tree, Error_Report, Follow_Links);
        end if;
     end Recursive_Check;
  
*************** package body Prj.Proc is
*** 1853,1861 ****
     -----------------------
  
     procedure Recursive_Process
!      (Project           : out Project_Id;
!       From_Project_Node : Project_Node_Id;
!       Extended_By       : Project_Id)
     is
        With_Clause : Project_Node_Id;
  
--- 2160,2170 ----
     -----------------------
  
     procedure Recursive_Process
!      (In_Tree                : Project_Tree_Ref;
!       Project                : out Project_Id;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Extended_By            : Project_Id)
     is
        With_Clause : Project_Node_Id;
  
*************** package body Prj.Proc is
*** 1865,1874 ****
  
        else
           declare
!             Processed_Data   : Project_Data     := Empty_Project;
              Imported         : Project_List     := Empty_Project_List;
              Declaration_Node : Project_Node_Id  := Empty_Node;
!             Name             : constant Name_Id := Name_Of (From_Project_Node);
  
           begin
              Project := Processed_Projects.Get (Name);
--- 2174,2189 ----
  
        else
           declare
!             Processed_Data   : Project_Data     := Empty_Project (In_Tree);
              Imported         : Project_List     := Empty_Project_List;
              Declaration_Node : Project_Node_Id  := Empty_Node;
!             Tref             : Source_Buffer_Ptr;
!             Name             : constant Name_Id :=
!                                  Name_Of
!                                    (From_Project_Node, From_Project_Node_Tree);
!             Location         : Source_Ptr :=
!                                  Location_Of
!                                    (From_Project_Node, From_Project_Node_Tree);
  
           begin
              Project := Processed_Projects.Get (Name);
*************** package body Prj.Proc is
*** 1877,1884 ****
                 return;
              end if;
  
!             Projects.Increment_Last;
!             Project := Projects.Last;
              Processed_Projects.Set (Name, Project);
  
              Processed_Data.Name := Name;
--- 2192,2199 ----
                 return;
              end if;
  
!             Project_Table.Increment_Last (In_Tree.Projects);
!             Project := Project_Table.Last (In_Tree.Projects);
              Processed_Projects.Set (Name, Project);
  
              Processed_Data.Name := Name;
*************** package body Prj.Proc is
*** 1893,1919 ****
                           Virtual_Prefix
              then
                 Processed_Data.Virtual := True;
              end if;
  
              Processed_Data.Display_Path_Name :=
!               Path_Name_Of (From_Project_Node);
              Get_Name_String (Processed_Data.Display_Path_Name);
              Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
              Processed_Data.Path_Name := Name_Find;
  
!             Processed_Data.Location := Location_Of (From_Project_Node);
  
              Processed_Data.Display_Directory :=
!               Directory_Of (From_Project_Node);
              Get_Name_String (Processed_Data.Display_Directory);
              Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
              Processed_Data.Directory := Name_Find;
  
              Processed_Data.Extended_By := Extended_By;
-             Processed_Data.Naming      := Standard_Naming_Data;
  
!             Add_Attributes (Project, Processed_Data.Decl, Attribute_First);
!             With_Clause := First_With_Clause_Of (From_Project_Node);
  
              while With_Clause /= Empty_Node loop
                 declare
--- 2208,2256 ----
                           Virtual_Prefix
              then
                 Processed_Data.Virtual := True;
+                Processed_Data.Display_Name := Name;
+ 
+             --  If there is no file, for example when the project node tree is
+             --  built in memory by GPS, the Display_Name cannot be found in
+             --  the source, so its value is the same as Name.
+ 
+             elsif Location = No_Location then
+                Processed_Data.Display_Name := Name;
+ 
+             --  Get the spelling of the project name from the project file
+ 
+             else
+                Tref := Source_Text (Get_Source_File_Index (Location));
+ 
+                for J in 1 .. Name_Len loop
+                   Name_Buffer (J) := Tref (Location);
+                   Location := Location + 1;
+                end loop;
+ 
+                Processed_Data.Display_Name := Name_Find;
              end if;
  
              Processed_Data.Display_Path_Name :=
!               Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
              Get_Name_String (Processed_Data.Display_Path_Name);
              Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
              Processed_Data.Path_Name := Name_Find;
  
!             Processed_Data.Location :=
!               Location_Of (From_Project_Node, From_Project_Node_Tree);
  
              Processed_Data.Display_Directory :=
!               Directory_Of (From_Project_Node, From_Project_Node_Tree);
              Get_Name_String (Processed_Data.Display_Directory);
              Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
              Processed_Data.Directory := Name_Find;
  
              Processed_Data.Extended_By := Extended_By;
  
!             Add_Attributes
!               (Project, In_Tree, Processed_Data.Decl, Attribute_First);
!             With_Clause :=
!               First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
  
              while With_Clause /= Empty_Node loop
                 declare
*************** package body Prj.Proc is
*** 1922,1977 ****
  
                 begin
                    Recursive_Process
!                     (Project           => New_Project,
!                      From_Project_Node => Project_Node_Of (With_Clause),
!                      Extended_By       => No_Project);
!                   New_Data := Projects.Table (New_Project);
  
                    --  If we were the first project to import it,
                    --  set First_Referred_By to us.
  
                    if New_Data.First_Referred_By = No_Project then
                       New_Data.First_Referred_By := Project;
!                      Projects.Table (New_Project) := New_Data;
                    end if;
  
                    --  Add this project to our list of imported projects
  
!                   Project_Lists.Increment_Last;
!                   Project_Lists.Table (Project_Lists.Last) :=
                      (Project => New_Project, Next => Empty_Project_List);
  
                    --  Imported is the id of the last imported project.
                    --  If it is nil, then this imported project is our first.
  
                    if Imported = Empty_Project_List then
!                      Processed_Data.Imported_Projects := Project_Lists.Last;
  
                    else
!                      Project_Lists.Table (Imported).Next := Project_Lists.Last;
                    end if;
  
!                   Imported := Project_Lists.Last;
  
!                   With_Clause := Next_With_Clause_Of (With_Clause);
                 end;
              end loop;
  
!             Declaration_Node := Project_Declaration_Of (From_Project_Node);
  
              Recursive_Process
!               (Project           => Processed_Data.Extends,
!                From_Project_Node => Extended_Project_Of (Declaration_Node),
!                Extended_By       => Project);
  
!             Projects.Table (Project) := Processed_Data;
  
              Process_Declarative_Items
!               (Project           => Project,
!                From_Project_Node => From_Project_Node,
!                Pkg               => No_Package,
!                Item              => First_Declarative_Item_Of
!                                       (Declaration_Node));
  
              --  If it is an extending project, inherit all packages
              --  from the extended project that are not explicitely defined
--- 2259,2337 ----
  
                 begin
                    Recursive_Process
!                     (In_Tree                => In_Tree,
!                      Project                => New_Project,
!                      From_Project_Node      =>
!                        Project_Node_Of (With_Clause, From_Project_Node_Tree),
!                      From_Project_Node_Tree => From_Project_Node_Tree,
!                      Extended_By            => No_Project);
!                   New_Data :=
!                     In_Tree.Projects.Table (New_Project);
  
                    --  If we were the first project to import it,
                    --  set First_Referred_By to us.
  
                    if New_Data.First_Referred_By = No_Project then
                       New_Data.First_Referred_By := Project;
!                      In_Tree.Projects.Table (New_Project) :=
!                        New_Data;
                    end if;
  
                    --  Add this project to our list of imported projects
  
!                   Project_List_Table.Increment_Last
!                     (In_Tree.Project_Lists);
!                   In_Tree.Project_Lists.Table
!                     (Project_List_Table.Last
!                        (In_Tree.Project_Lists)) :=
                      (Project => New_Project, Next => Empty_Project_List);
  
                    --  Imported is the id of the last imported project.
                    --  If it is nil, then this imported project is our first.
  
                    if Imported = Empty_Project_List then
!                      Processed_Data.Imported_Projects :=
!                        Project_List_Table.Last
!                          (In_Tree.Project_Lists);
  
                    else
!                      In_Tree.Project_Lists.Table
!                        (Imported).Next := Project_List_Table.Last
!                           (In_Tree.Project_Lists);
                    end if;
  
!                   Imported := Project_List_Table.Last
!                                 (In_Tree.Project_Lists);
  
!                   With_Clause :=
!                     Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
                 end;
              end loop;
  
!             Declaration_Node :=
!               Project_Declaration_Of
!                 (From_Project_Node, From_Project_Node_Tree);
  
              Recursive_Process
!               (In_Tree                => In_Tree,
!                Project                => Processed_Data.Extends,
!                From_Project_Node      =>
!                  Extended_Project_Of
!                    (Declaration_Node, From_Project_Node_Tree),
!                From_Project_Node_Tree => From_Project_Node_Tree,
!                Extended_By            => Project);
  
!             In_Tree.Projects.Table (Project) := Processed_Data;
  
              Process_Declarative_Items
!               (Project                => Project,
!                In_Tree                => In_Tree,
!                From_Project_Node      => From_Project_Node,
!                From_Project_Node_Tree => From_Project_Node_Tree,
!                Pkg                    => No_Package,
!                Item                   =>
!                  First_Declarative_Item_Of
!                    (Declaration_Node, From_Project_Node_Tree));
  
              --  If it is an extending project, inherit all packages
              --  from the extended project that are not explicitely defined
*************** package body Prj.Proc is
*** 1979,1989 ****
              --  is not explicitely defined.
  
              if Processed_Data.Extends /= No_Project then
!                Processed_Data := Projects.Table (Project);
  
                 declare
                    Extended_Pkg : Package_Id :=
!                                    Projects.Table
                                       (Processed_Data.Extends).Decl.Packages;
                    Current_Pkg : Package_Id;
                    Element     : Package_Element;
--- 2339,2349 ----
              --  is not explicitely defined.
  
              if Processed_Data.Extends /= No_Project then
!                Processed_Data := In_Tree.Projects.Table (Project);
  
                 declare
                    Extended_Pkg : Package_Id :=
!                                    In_Tree.Projects.Table
                                       (Processed_Data.Extends).Decl.Packages;
                    Current_Pkg : Package_Id;
                    Element     : Package_Element;
*************** package body Prj.Proc is
*** 1996,2016 ****
  
                 begin
                    while Extended_Pkg /= No_Package loop
!                      Element := Packages.Table (Extended_Pkg);
  
                       Current_Pkg := First;
  
                       loop
                          exit when Current_Pkg = No_Package
!                           or else Packages.Table (Current_Pkg).Name
!                                      = Element.Name;
!                         Current_Pkg := Packages.Table (Current_Pkg).Next;
                       end loop;
  
                       if Current_Pkg = No_Package then
!                         Packages.Increment_Last;
!                         Current_Pkg := Packages.Last;
!                         Packages.Table (Current_Pkg) :=
                            (Name   => Element.Name,
                             Decl   => Element.Decl,
                             Parent => No_Package,
--- 2356,2380 ----
  
                 begin
                    while Extended_Pkg /= No_Package loop
!                      Element :=
!                        In_Tree.Packages.Table (Extended_Pkg);
  
                       Current_Pkg := First;
  
                       loop
                          exit when Current_Pkg = No_Package
!                           or else In_Tree.Packages.Table
!                                     (Current_Pkg).Name = Element.Name;
!                         Current_Pkg := In_Tree.Packages.Table
!                                          (Current_Pkg).Next;
                       end loop;
  
                       if Current_Pkg = No_Package then
!                         Package_Table.Increment_Last
!                           (In_Tree.Packages);
!                         Current_Pkg := Package_Table.Last
!                           (In_Tree.Packages);
!                         In_Tree.Packages.Table (Current_Pkg) :=
                            (Name   => Element.Name,
                             Decl   => Element.Decl,
                             Parent => No_Package,
*************** package body Prj.Proc is
*** 2026,2032 ****
  
                    Attribute1 := Processed_Data.Decl.Attributes;
                    while Attribute1 /= No_Variable loop
!                      Attr_Value1 := Variable_Elements.Table (Attribute1);
                       exit when Attr_Value1.Name = Snames.Name_Languages;
                       Attribute1 := Attr_Value1.Next;
                    end loop;
--- 2390,2397 ----
  
                    Attribute1 := Processed_Data.Decl.Attributes;
                    while Attribute1 /= No_Variable loop
!                      Attr_Value1 := In_Tree.Variable_Elements.
!                                       Table (Attribute1);
                       exit when Attr_Value1.Name = Snames.Name_Languages;
                       Attribute1 := Attr_Value1.Next;
                    end loop;
*************** package body Prj.Proc is
*** 2039,2048 ****
                       --  extended.
  
                       Attribute2 :=
!                        Projects.Table (Processed_Data.Extends).Decl.Attributes;
  
                       while Attribute2 /= No_Variable loop
!                         Attr_Value2 := Variable_Elements.Table (Attribute2);
                          exit when Attr_Value2.Name = Snames.Name_Languages;
                          Attribute2 := Attr_Value2.Next;
                       end loop;
--- 2404,2415 ----
                       --  extended.
  
                       Attribute2 :=
!                        In_Tree.Projects.Table
!                          (Processed_Data.Extends).Decl.Attributes;
  
                       while Attribute2 /= No_Variable loop
!                         Attr_Value2 := In_Tree.Variable_Elements.
!                                          Table (Attribute2);
                          exit when Attr_Value2.Name = Snames.Name_Languages;
                          Attribute2 := Attr_Value2.Next;
                       end loop;
*************** package body Prj.Proc is
*** 2055,2074 ****
                          --  project.
  
                          if Attribute1 = No_Variable then
!                            Variable_Elements.Increment_Last;
!                            Attribute1 := Variable_Elements.Last;
                             Attr_Value1.Next := Processed_Data.Decl.Attributes;
                             Processed_Data.Decl.Attributes := Attribute1;
                          end if;
  
                          Attr_Value1.Name := Snames.Name_Languages;
                          Attr_Value1.Value := Attr_Value2.Value;
!                         Variable_Elements.Table (Attribute1) := Attr_Value1;
                       end if;
                    end if;
                 end;
  
!                Projects.Table (Project) := Processed_Data;
              end if;
           end;
        end if;
--- 2422,2444 ----
                          --  project.
  
                          if Attribute1 = No_Variable then
!                            Variable_Element_Table.Increment_Last
!                              (In_Tree.Variable_Elements);
!                            Attribute1 := Variable_Element_Table.Last
!                              (In_Tree.Variable_Elements);
                             Attr_Value1.Next := Processed_Data.Decl.Attributes;
                             Processed_Data.Decl.Attributes := Attribute1;
                          end if;
  
                          Attr_Value1.Name := Snames.Name_Languages;
                          Attr_Value1.Value := Attr_Value2.Value;
!                         In_Tree.Variable_Elements.Table
!                           (Attribute1) := Attr_Value1;
                       end if;
                    end if;
                 end;
  
!                In_Tree.Projects.Table (Project) := Processed_Data;
              end if;
           end;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-proc.ads gcc-4.1.0/gcc/ada/prj-proc.ads
*** gcc-4.0.2/gcc/ada/prj-proc.ads	Wed Dec  8 11:25:46 2004
--- gcc-4.1.0/gcc/ada/prj-proc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,46 ****
  ------------------------------------------------------------------------------
  
  --  This package is used to convert a project file tree (see prj-tree.ads) to
! --  project file data structures (see prj.ads), taking into account
! --  the environment (external references).
  
  with Prj.Tree;  use Prj.Tree;
  
  package Prj.Proc is
  
     procedure Process
!      (Project           : out Project_Id;
!       Success           : out Boolean;
!       From_Project_Node : Project_Node_Id;
!       Report_Error      : Put_Line_Access;
!       Follow_Links      : Boolean := True);
!    --  Process a project file tree into project file data structures.
!    --  If Report_Error is null, use the error reporting mechanism.
!    --  Otherwise, report errors using Report_Error.
     --
     --  If Follow_Links is False, it is assumed that the project doesn't contain
     --  any file duplicated through symbolic links (although the latter are
--- 25,48 ----
  ------------------------------------------------------------------------------
  
  --  This package is used to convert a project file tree (see prj-tree.ads) to
! --  project file data structures (see prj.ads), taking into account the
! --  environment (external references).
  
  with Prj.Tree;  use Prj.Tree;
  
  package Prj.Proc is
  
     procedure Process
!      (In_Tree                : Project_Tree_Ref;
!       Project                : out Project_Id;
!       Success                : out Boolean;
!       From_Project_Node      : Project_Node_Id;
!       From_Project_Node_Tree : Project_Node_Tree_Ref;
!       Report_Error           : Put_Line_Access;
!       Follow_Links           : Boolean := True);
!    --  Process a project file tree into project file data structures. If
!    --  Report_Error is null, use the error reporting mechanism. Otherwise,
!    --  report errors using Report_Error.
     --
     --  If Follow_Links is False, it is assumed that the project doesn't contain
     --  any file duplicated through symbolic links (although the latter are
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-strt.adb gcc-4.1.0/gcc/ada/prj-strt.adb
*** gcc-4.0.2/gcc/ada/prj-strt.adb	Thu Jul 15 20:34:37 2004
--- gcc-4.1.0/gcc/ada/prj-strt.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,42 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Err_Vars;  use Err_Vars;
! with Namet;     use Namet;
! with Prj.Attr;  use Prj.Attr;
! with Prj.Err;   use Prj.Err;
! with Prj.Tree;  use Prj.Tree;
! with Scans;     use Scans;
  with Snames;
  with Table;
! with Types;     use Types;
! with Uintp;     use Uintp;
  
  package body Prj.Strt is
  
     type Choice_String is record
        The_String   : Name_Id;
        Already_Used : Boolean := False;
--- 16,42 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Err_Vars; use Err_Vars;
! with Namet;    use Namet;
! with Prj.Attr; use Prj.Attr;
! with Prj.Err;  use Prj.Err;
  with Snames;
  with Table;
! with Uintp;    use Uintp;
  
  package body Prj.Strt is
  
+    Buffer      : String_Access;
+    Buffer_Last : Natural := 0;
+ 
     type Choice_String is record
        The_String   : Name_Id;
        Already_Used : Boolean := False;
*************** package body Prj.Strt is
*** 64,70 ****
                         Table_Initial        => Choices_Initial,
                         Table_Increment      => Choices_Increment,
                         Table_Name           => "Prj.Strt.Choices");
!    --  Used to store the case labels and check that there is no duplicate.
  
     package Choice_Lasts is
        new Table.Table (Table_Component_Type => Choice_Node_Id,
--- 64,70 ----
                         Table_Initial        => Choices_Initial,
                         Table_Increment      => Choices_Increment,
                         Table_Name           => "Prj.Strt.Choices");
!    --  Used to store the case labels and check that there is no duplicate
  
     package Choice_Lasts is
        new Table.Table (Table_Component_Type => Choice_Node_Id,
*************** package body Prj.Strt is
*** 102,119 ****
     procedure Add_To_Names (NL : Name_Location);
     --  Add one single names to table Names
  
!    procedure External_Reference (External_Value : out Project_Node_Id);
!    --  Parse an external reference. Current token is "external".
  
     procedure Attribute_Reference
!      (Reference       : out Project_Node_Id;
        First_Attribute : Attribute_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
!    --  Parse an attribute reference. Current token is an apostrophe.
  
     procedure Terms
!      (Term            : out Project_Node_Id;
        Expr_Kind       : in out Variable_Kind;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
--- 102,125 ----
     procedure Add_To_Names (NL : Name_Location);
     --  Add one single names to table Names
  
!    procedure External_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Current_Project : Project_Node_Id;
!       Current_Package : Project_Node_Id;
!       External_Value  : out Project_Node_Id);
!    --  Parse an external reference. Current token is "external"
  
     procedure Attribute_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Reference       : out Project_Node_Id;
        First_Attribute : Attribute_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
!    --  Parse an attribute reference. Current token is an apostrophe
  
     procedure Terms
!      (In_Tree         : Project_Node_Tree_Ref;
!       Term            : out Project_Node_Id;
        Expr_Kind       : in out Variable_Kind;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
*************** package body Prj.Strt is
*** 148,154 ****
     -------------------------
  
     procedure Attribute_Reference
!      (Reference       : out Project_Node_Id;
        First_Attribute : Attribute_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
--- 154,161 ----
     -------------------------
  
     procedure Attribute_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Reference       : out Project_Node_Id;
        First_Attribute : Attribute_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
*************** package body Prj.Strt is
*** 158,166 ****
     begin
        --  Declare the node of the attribute reference
  
!       Reference :=  Default_Project_Node (Of_Kind => N_Attribute_Reference);
!       Set_Location_Of (Reference, To => Token_Ptr);
!       Scan; --  past apostrophe
  
        --  Body may be an attribute name
  
--- 165,175 ----
     begin
        --  Declare the node of the attribute reference
  
!       Reference :=
!         Default_Project_Node
!           (Of_Kind => N_Attribute_Reference, In_Tree => In_Tree);
!       Set_Location_Of (Reference, In_Tree, To => Token_Ptr);
!       Scan (In_Tree); --  past apostrophe
  
        --  Body may be an attribute name
  
*************** package body Prj.Strt is
*** 172,178 ****
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
!          Set_Name_Of (Reference, To => Token_Name);
  
           --  Check if the identifier is one of the attribute identifiers in the
           --  context (package or project level attributes).
--- 181,187 ----
        Expect (Tok_Identifier, "identifier");
  
        if Token = Tok_Identifier then
!          Set_Name_Of (Reference, In_Tree, To => Token_Name);
  
           --  Check if the identifier is one of the attribute identifiers in the
           --  context (package or project level attributes).
*************** package body Prj.Strt is
*** 189,210 ****
  
              --  Scan past the attribute name
  
!             Scan;
  
           else
              --  Give its characteristics to this attribute reference
  
!             Set_Project_Node_Of (Reference, To => Current_Project);
!             Set_Package_Node_Of (Reference, To => Current_Package);
              Set_Expression_Kind_Of
!               (Reference, To => Variable_Kind_Of (Current_Attribute));
              Set_Case_Insensitive
!               (Reference, To => Attribute_Kind_Of (Current_Attribute) =
!                                           Case_Insensitive_Associative_Array);
  
              --  Scan past the attribute name
  
!             Scan;
  
              --  If the attribute is an associative array, get the index
  
--- 198,220 ----
  
              --  Scan past the attribute name
  
!             Scan (In_Tree);
  
           else
              --  Give its characteristics to this attribute reference
  
!             Set_Project_Node_Of (Reference, In_Tree, To => Current_Project);
!             Set_Package_Node_Of (Reference, In_Tree, To => Current_Package);
              Set_Expression_Kind_Of
!               (Reference, In_Tree, To => Variable_Kind_Of (Current_Attribute));
              Set_Case_Insensitive
!               (Reference, In_Tree,
!                To => Attribute_Kind_Of (Current_Attribute) =
!                        Case_Insensitive_Associative_Array);
  
              --  Scan past the attribute name
  
!             Scan (In_Tree);
  
              --  If the attribute is an associative array, get the index
  
*************** package body Prj.Strt is
*** 212,228 ****
                 Expect (Tok_Left_Paren, "`(`");
  
                 if Token = Tok_Left_Paren then
!                   Scan;
                    Expect (Tok_String_Literal, "literal string");
  
                    if Token = Tok_String_Literal then
                       Set_Associative_Array_Index_Of
!                        (Reference, To => Token_Name);
!                      Scan;
                       Expect (Tok_Right_Paren, "`)`");
  
                       if Token = Tok_Right_Paren then
!                         Scan;
                       end if;
                    end if;
                 end if;
--- 222,238 ----
                 Expect (Tok_Left_Paren, "`(`");
  
                 if Token = Tok_Left_Paren then
!                   Scan (In_Tree);
                    Expect (Tok_String_Literal, "literal string");
  
                    if Token = Tok_String_Literal then
                       Set_Associative_Array_Index_Of
!                        (Reference, In_Tree, To => Token_Name);
!                      Scan (In_Tree);
                       Expect (Tok_Right_Paren, "`)`");
  
                       if Token = Tok_Right_Paren then
!                         Scan (In_Tree);
                       end if;
                    end if;
                 end if;
*************** package body Prj.Strt is
*** 232,249 ****
           --  Change name of obsolete attributes
  
           if Reference /= Empty_Node then
!             case Name_Of (Reference) is
                 when Snames.Name_Specification =>
!                   Set_Name_Of (Reference, To => Snames.Name_Spec);
  
                 when Snames.Name_Specification_Suffix =>
!                   Set_Name_Of (Reference, To => Snames.Name_Spec_Suffix);
  
                 when Snames.Name_Implementation =>
!                   Set_Name_Of (Reference, To => Snames.Name_Body);
  
                 when Snames.Name_Implementation_Suffix =>
!                   Set_Name_Of (Reference, To => Snames.Name_Body_Suffix);
  
                 when others =>
                    null;
--- 242,261 ----
           --  Change name of obsolete attributes
  
           if Reference /= Empty_Node then
!             case Name_Of (Reference, In_Tree) is
                 when Snames.Name_Specification =>
!                   Set_Name_Of (Reference, In_Tree, To => Snames.Name_Spec);
  
                 when Snames.Name_Specification_Suffix =>
!                   Set_Name_Of
!                     (Reference, In_Tree, To => Snames.Name_Spec_Suffix);
  
                 when Snames.Name_Implementation =>
!                   Set_Name_Of (Reference, In_Tree, To => Snames.Name_Body);
  
                 when Snames.Name_Implementation_Suffix =>
!                   Set_Name_Of
!                     (Reference, In_Tree, To => Snames.Name_Body_Suffix);
  
                 when others =>
                    null;
*************** package body Prj.Strt is
*** 327,352 ****
     -- External_Reference --
     ------------------------
  
!    procedure External_Reference (External_Value : out Project_Node_Id) is
        Field_Id : Project_Node_Id := Empty_Node;
  
     begin
        External_Value :=
!         Default_Project_Node (Of_Kind       => N_External_Value,
!                               And_Expr_Kind => Single);
!       Set_Location_Of (External_Value, To => Token_Ptr);
  
        --  The current token is External
  
        --  Get the left parenthesis
  
!       Scan;
        Expect (Tok_Left_Paren, "`(`");
  
        --  Scan past the left parenthesis
  
        if Token = Tok_Left_Paren then
!          Scan;
        end if;
  
        --  Get the name of the external reference
--- 339,371 ----
     -- External_Reference --
     ------------------------
  
!    procedure External_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Current_Project : Project_Node_Id;
!       Current_Package : Project_Node_Id;
!       External_Value  : out Project_Node_Id)
!    is
        Field_Id : Project_Node_Id := Empty_Node;
  
     begin
        External_Value :=
!         Default_Project_Node
!           (Of_Kind       => N_External_Value,
!            In_Tree       => In_Tree,
!            And_Expr_Kind => Single);
!       Set_Location_Of (External_Value, In_Tree, To => Token_Ptr);
  
        --  The current token is External
  
        --  Get the left parenthesis
  
!       Scan (In_Tree);
        Expect (Tok_Left_Paren, "`(`");
  
        --  Scan past the left parenthesis
  
        if Token = Tok_Left_Paren then
!          Scan (In_Tree);
        end if;
  
        --  Get the name of the external reference
*************** package body Prj.Strt is
*** 355,399 ****
  
        if Token = Tok_String_Literal then
           Field_Id :=
!            Default_Project_Node (Of_Kind       => N_Literal_String,
!                                  And_Expr_Kind => Single);
!          Set_String_Value_Of (Field_Id, To => Token_Name);
!          Set_External_Reference_Of (External_Value, To => Field_Id);
  
           --  Scan past the first argument
  
!          Scan;
  
           case Token is
  
              when Tok_Right_Paren =>
  
                 --  Scan past the right parenthesis
!                Scan;
  
              when Tok_Comma =>
  
                 --  Scan past the comma
  
!                Scan;
  
!                Expect (Tok_String_Literal, "literal string");
  
!                --  Get the default
  
!                if Token = Tok_String_Literal then
!                   Field_Id :=
!                     Default_Project_Node (Of_Kind       => N_Literal_String,
!                                           And_Expr_Kind => Single);
!                   Set_String_Value_Of (Field_Id, To => Token_Name);
!                   Set_External_Default_Of (External_Value, To => Field_Id);
!                   Scan;
!                   Expect (Tok_Right_Paren, "`)`");
!                end if;
  
                 --  Scan past the right parenthesis
                 if Token = Tok_Right_Paren then
!                   Scan;
                 end if;
  
              when others =>
--- 374,430 ----
  
        if Token = Tok_String_Literal then
           Field_Id :=
!            Default_Project_Node
!              (Of_Kind       => N_Literal_String,
!               In_Tree       => In_Tree,
!               And_Expr_Kind => Single);
!          Set_String_Value_Of (Field_Id, In_Tree, To => Token_Name);
!          Set_External_Reference_Of (External_Value, In_Tree, To => Field_Id);
  
           --  Scan past the first argument
  
!          Scan (In_Tree);
  
           case Token is
  
              when Tok_Right_Paren =>
  
                 --  Scan past the right parenthesis
!                Scan (In_Tree);
  
              when Tok_Comma =>
  
                 --  Scan past the comma
  
!                Scan (In_Tree);
  
!                --  Get the string expression for the default
  
!                declare
!                   Loc : constant Source_Ptr := Token_Ptr;
  
!                begin
!                   Parse_Expression
!                     (In_Tree         => In_Tree,
!                      Expression      => Field_Id,
!                      Current_Project => Current_Project,
!                      Current_Package => Current_Package,
!                      Optional_Index  => False);
! 
!                   if Expression_Kind_Of (Field_Id, In_Tree) = List then
!                      Error_Msg ("expression must be a single string", Loc);
!                   else
!                      Set_External_Default_Of
!                        (External_Value, In_Tree, To => Field_Id);
!                   end if;
!                end;
! 
!                Expect (Tok_Right_Paren, "`)`");
  
                 --  Scan past the right parenthesis
+ 
                 if Token = Tok_Right_Paren then
!                   Scan (In_Tree);
                 end if;
  
              when others =>
*************** package body Prj.Strt is
*** 406,412 ****
     -- Parse_Choice_List --
     -----------------------
  
!    procedure Parse_Choice_List (First_Choice : out Project_Node_Id) is
        Current_Choice : Project_Node_Id := Empty_Node;
        Next_Choice    : Project_Node_Id := Empty_Node;
        Choice_String  : Name_Id         := No_Name;
--- 437,446 ----
     -- Parse_Choice_List --
     -----------------------
  
!    procedure Parse_Choice_List
!      (In_Tree      : Project_Node_Tree_Ref;
!       First_Choice : out Project_Node_Id)
!    is
        Current_Choice : Project_Node_Id := Empty_Node;
        Next_Choice    : Project_Node_Id := Empty_Node;
        Choice_String  : Name_Id         := No_Name;
*************** package body Prj.Strt is
*** 416,423 ****
        --  Declare the node of the first choice
  
        First_Choice :=
!         Default_Project_Node (Of_Kind       => N_Literal_String,
!                               And_Expr_Kind => Single);
  
        --  Initially Current_Choice is the same as First_Choice
  
--- 450,459 ----
        --  Declare the node of the first choice
  
        First_Choice :=
!         Default_Project_Node
!           (Of_Kind       => N_Literal_String,
!            In_Tree       => In_Tree,
!            And_Expr_Kind => Single);
  
        --  Initially Current_Choice is the same as First_Choice
  
*************** package body Prj.Strt is
*** 426,437 ****
        loop
           Expect (Tok_String_Literal, "literal string");
           exit when Token /= Tok_String_Literal;
!          Set_Location_Of (Current_Choice, To => Token_Ptr);
           Choice_String := Token_Name;
  
           --  Give the string value to the current choice
  
!          Set_String_Value_Of (Current_Choice, To => Choice_String);
  
           --  Check if the label is part of the string type and if it has not
           --  been already used.
--- 462,473 ----
        loop
           Expect (Tok_String_Literal, "literal string");
           exit when Token /= Tok_String_Literal;
!          Set_Location_Of (Current_Choice, In_Tree, To => Token_Ptr);
           Choice_String := Token_Name;
  
           --  Give the string value to the current choice
  
!          Set_String_Value_Of (Current_Choice, In_Tree, To => Choice_String);
  
           --  Check if the label is part of the string type and if it has not
           --  been already used.
*************** package body Prj.Strt is
*** 466,472 ****
  
           --  Scan past the label
  
!          Scan;
  
           --  If there is no '|', we are done
  
--- 502,508 ----
  
           --  Scan past the label
  
!          Scan (In_Tree);
  
           --  If there is no '|', we are done
  
*************** package body Prj.Strt is
*** 475,485 ****
              --  Current_Choice and set Current_Choice to this new node.
  
              Next_Choice :=
!               Default_Project_Node (Of_Kind       => N_Literal_String,
!                                     And_Expr_Kind => Single);
!             Set_Next_Literal_String (Current_Choice, To => Next_Choice);
              Current_Choice := Next_Choice;
!             Scan;
           else
              exit;
           end if;
--- 511,524 ----
              --  Current_Choice and set Current_Choice to this new node.
  
              Next_Choice :=
!               Default_Project_Node
!                 (Of_Kind       => N_Literal_String,
!                  In_Tree       => In_Tree,
!                  And_Expr_Kind => Single);
!             Set_Next_Literal_String
!               (Current_Choice, In_Tree, To => Next_Choice);
              Current_Choice := Next_Choice;
!             Scan (In_Tree);
           else
              exit;
           end if;
*************** package body Prj.Strt is
*** 491,497 ****
     ----------------------
  
     procedure Parse_Expression
!      (Expression      : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
        Optional_Index  : Boolean)
--- 530,537 ----
     ----------------------
  
     procedure Parse_Expression
!      (In_Tree         : Project_Node_Tree_Ref;
!       Expression      : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
        Optional_Index  : Boolean)
*************** package body Prj.Strt is
*** 502,513 ****
     begin
        --  Declare the node of the expression
  
!       Expression := Default_Project_Node (Of_Kind => N_Expression);
!       Set_Location_Of (Expression, To => Token_Ptr);
  
        --  Parse the term or terms of the expression
  
!       Terms (Term            => First_Term,
               Expr_Kind       => Expression_Kind,
               Current_Project => Current_Project,
               Current_Package => Current_Package,
--- 542,555 ----
     begin
        --  Declare the node of the expression
  
!       Expression :=
!         Default_Project_Node (Of_Kind => N_Expression, In_Tree => In_Tree);
!       Set_Location_Of (Expression, In_Tree, To => Token_Ptr);
  
        --  Parse the term or terms of the expression
  
!       Terms (In_Tree         => In_Tree,
!              Term            => First_Term,
               Expr_Kind       => Expression_Kind,
               Current_Project => Current_Project,
               Current_Package => Current_Package,
*************** package body Prj.Strt is
*** 515,529 ****
  
        --  Set the first term and the expression kind
  
!       Set_First_Term (Expression, To => First_Term);
!       Set_Expression_Kind_Of (Expression, To => Expression_Kind);
     end Parse_Expression;
  
     ----------------------------
     -- Parse_String_Type_List --
     ----------------------------
  
!    procedure Parse_String_Type_List (First_String : out Project_Node_Id) is
        Last_String  : Project_Node_Id := Empty_Node;
        Next_String  : Project_Node_Id := Empty_Node;
        String_Value : Name_Id         := No_Name;
--- 557,574 ----
  
        --  Set the first term and the expression kind
  
!       Set_First_Term (Expression, In_Tree, To => First_Term);
!       Set_Expression_Kind_Of (Expression, In_Tree, To => Expression_Kind);
     end Parse_Expression;
  
     ----------------------------
     -- Parse_String_Type_List --
     ----------------------------
  
!    procedure Parse_String_Type_List
!      (In_Tree      : Project_Node_Tree_Ref;
!       First_String : out Project_Node_Id)
!    is
        Last_String  : Project_Node_Id := Empty_Node;
        Next_String  : Project_Node_Id := Empty_Node;
        String_Value : Name_Id         := No_Name;
*************** package body Prj.Strt is
*** 532,539 ****
        --  Declare the node of the first string
  
        First_String :=
!         Default_Project_Node (Of_Kind       => N_Literal_String,
!                               And_Expr_Kind => Single);
  
        --  Initially, Last_String is the same as First_String
  
--- 577,586 ----
        --  Declare the node of the first string
  
        First_String :=
!         Default_Project_Node
!           (Of_Kind       => N_Literal_String,
!            In_Tree       => In_Tree,
!            And_Expr_Kind => Single);
  
        --  Initially, Last_String is the same as First_String
  
*************** package body Prj.Strt is
*** 546,553 ****
  
           --  Give its string value to Last_String
  
!          Set_String_Value_Of (Last_String, To => String_Value);
!          Set_Location_Of (Last_String, To => Token_Ptr);
  
           --  Now, check if the string is already part of the string type
  
--- 593,600 ----
  
           --  Give its string value to Last_String
  
!          Set_String_Value_Of (Last_String, In_Tree, To => String_Value);
!          Set_Location_Of (Last_String, In_Tree, To => Token_Ptr);
  
           --  Now, check if the string is already part of the string type
  
*************** package body Prj.Strt is
*** 556,562 ****
  
           begin
              while Current /= Last_String loop
!                if String_Value_Of (Current) = String_Value then
                    --  This is a repetition, report an error
  
                    Error_Msg_Name_1 := String_Value;
--- 603,609 ----
  
           begin
              while Current /= Last_String loop
!                if String_Value_Of (Current, In_Tree) = String_Value then
                    --  This is a repetition, report an error
  
                    Error_Msg_Name_1 := String_Value;
*************** package body Prj.Strt is
*** 564,576 ****
                    exit;
                 end if;
  
!                Current := Next_Literal_String (Current);
              end loop;
           end;
  
           --  Scan past the literal string
  
!          Scan;
  
           --  If there is no comma following the literal string, we are done
  
--- 611,623 ----
                    exit;
                 end if;
  
!                Current := Next_Literal_String (Current, In_Tree);
              end loop;
           end;
  
           --  Scan past the literal string
  
!          Scan (In_Tree);
  
           --  If there is no comma following the literal string, we are done
  
*************** package body Prj.Strt is
*** 582,592 ****
              --  Last_String to its node.
  
              Next_String :=
!               Default_Project_Node (Of_Kind       => N_Literal_String,
!                                     And_Expr_Kind => Single);
!             Set_Next_Literal_String (Last_String, To => Next_String);
              Last_String := Next_String;
!             Scan;
           end if;
        end loop;
     end Parse_String_Type_List;
--- 629,641 ----
              --  Last_String to its node.
  
              Next_String :=
!               Default_Project_Node
!                 (Of_Kind       => N_Literal_String,
!                  In_Tree       => In_Tree,
!                  And_Expr_Kind => Single);
!             Set_Next_Literal_String (Last_String, In_Tree, To => Next_String);
              Last_String := Next_String;
!             Scan (In_Tree);
           end if;
        end loop;
     end Parse_String_Type_List;
*************** package body Prj.Strt is
*** 596,602 ****
     ------------------------------
  
     procedure Parse_Variable_Reference
!      (Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
     is
--- 645,652 ----
     ------------------------------
  
     procedure Parse_Variable_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id)
     is
*************** package body Prj.Strt is
*** 623,631 ****
           end if;
  
           Add_To_Names (NL => (Name => Token_Name, Location => Token_Ptr));
!          Scan;
           exit when Token /= Tok_Dot;
!          Scan;
        end loop;
  
        if Look_For_Variable then
--- 673,681 ----
           end if;
  
           Add_To_Names (NL => (Name => Token_Name, Location => Token_Ptr));
!          Scan (In_Tree);
           exit when Token /= Tok_Dot;
!          Scan (In_Tree);
        end loop;
  
        if Look_For_Variable then
*************** package body Prj.Strt is
*** 654,660 ****
                    --  Now, look if it can be a project name
  
                    The_Project := Imported_Or_Extended_Project_Of
!                     (Current_Project, Names.Table (1).Name);
  
                    if The_Project = Empty_Node then
                       --  If it is neither a project name nor a package name,
--- 704,710 ----
                    --  Now, look if it can be a project name
  
                    The_Project := Imported_Or_Extended_Project_Of
!                     (Current_Project, In_Tree, Names.Table (1).Name);
  
                    if The_Project = Empty_Node then
                       --  If it is neither a project name nor a package name,
*************** package body Prj.Strt is
*** 670,683 ****
                          --  If it is a package name, check if the package
                          --  has already been declared in the current project.
  
!                         The_Package := First_Package_Of (Current_Project);
  
                          while The_Package /= Empty_Node
!                           and then Name_Of (The_Package) /=
                            Names.Table (1).Name
                          loop
                             The_Package :=
!                              Next_Package_In_Project (The_Package);
                          end loop;
  
                          --  If it has not been already declared, report an
--- 720,734 ----
                          --  If it is a package name, check if the package
                          --  has already been declared in the current project.
  
!                         The_Package :=
!                           First_Package_Of (Current_Project, In_Tree);
  
                          while The_Package /= Empty_Node
!                           and then Name_Of (The_Package, In_Tree) /=
                            Names.Table (1).Name
                          loop
                             The_Package :=
!                              Next_Package_In_Project (The_Package, In_Tree);
                          end loop;
  
                          --  If it has not been already declared, report an
*************** package body Prj.Strt is
*** 717,726 ****
  
                       for Index in 1 .. Names.Last - 1 loop
                          Add_To_Buffer
!                           (Get_Name_String (Names.Table (Index).Name));
  
                          if Index /= Names.Last - 1 then
!                            Add_To_Buffer (".");
                          end if;
                       end loop;
  
--- 768,778 ----
  
                       for Index in 1 .. Names.Last - 1 loop
                          Add_To_Buffer
!                           (Get_Name_String (Names.Table (Index).Name),
!                            Buffer, Buffer_Last);
  
                          if Index /= Names.Last - 1 then
!                            Add_To_Buffer (".", Buffer, Buffer_Last);
                          end if;
                       end loop;
  
*************** package body Prj.Strt is
*** 732,740 ****
                       --  Now, add the last simple name to get the name of the
                       --  long project.
  
!                      Add_To_Buffer (".");
                       Add_To_Buffer
!                        (Get_Name_String (Names.Table (Names.Last).Name));
                       Name_Len := Buffer_Last;
                       Name_Buffer (1 .. Buffer_Last) :=
                         Buffer (1 .. Buffer_Last);
--- 784,793 ----
                       --  Now, add the last simple name to get the name of the
                       --  long project.
  
!                      Add_To_Buffer (".", Buffer, Buffer_Last);
                       Add_To_Buffer
!                        (Get_Name_String (Names.Table (Names.Last).Name),
!                         Buffer, Buffer_Last);
                       Name_Len := Buffer_Last;
                       Name_Buffer (1 .. Buffer_Last) :=
                         Buffer (1 .. Buffer_Last);
*************** package body Prj.Strt is
*** 743,749 ****
                       --  Check if the long project is imported or extended
  
                       The_Project := Imported_Or_Extended_Project_Of
!                                       (Current_Project, Long_Project);
  
                       --  If the long project exists, then this is the prefix
                       --  of the attribute.
--- 796,802 ----
                       --  Check if the long project is imported or extended
  
                       The_Project := Imported_Or_Extended_Project_Of
!                                       (Current_Project, In_Tree, Long_Project);
  
                       --  If the long project exists, then this is the prefix
                       --  of the attribute.
*************** package body Prj.Strt is
*** 757,763 ****
                          --  or extended.
  
                          The_Project := Imported_Or_Extended_Project_Of
!                                          (Current_Project, Short_Project);
  
                          --  If the short project does not exist, we report an
                          --  error.
--- 810,817 ----
                          --  or extended.
  
                          The_Project := Imported_Or_Extended_Project_Of
!                                          (Current_Project, In_Tree,
!                                           Short_Project);
  
                          --  If the short project does not exist, we report an
                          --  error.
*************** package body Prj.Strt is
*** 774,786 ****
                             --  Now, we check if the package has been declared
                             --  in this project.
  
!                            The_Package := First_Package_Of (The_Project);
                             while The_Package /= Empty_Node
!                              and then Name_Of (The_Package) /=
                               Names.Table (Names.Last).Name
                             loop
                                The_Package :=
!                                 Next_Package_In_Project (The_Package);
                             end loop;
  
                             --  If it has not, then we report an error
--- 828,841 ----
                             --  Now, we check if the package has been declared
                             --  in this project.
  
!                            The_Package :=
!                              First_Package_Of (The_Project, In_Tree);
                             while The_Package /= Empty_Node
!                              and then Name_Of (The_Package, In_Tree) /=
                               Names.Table (Names.Last).Name
                             loop
                                The_Package :=
!                                 Next_Package_In_Project (The_Package, In_Tree);
                             end loop;
  
                             --  If it has not, then we report an error
*************** package body Prj.Strt is
*** 799,805 ****
  
                                First_Attribute :=
                                  First_Attribute_Of
!                                   (Package_Id_Of (The_Package));
                             end if;
                          end if;
                       end if;
--- 854,860 ----
  
                                First_Attribute :=
                                  First_Attribute_Of
!                                   (Package_Id_Of (The_Package, In_Tree));
                             end if;
                          end if;
                       end if;
*************** package body Prj.Strt is
*** 807,813 ****
              end case;
  
              Attribute_Reference
!               (Variable,
                 Current_Project => The_Project,
                 Current_Package => The_Package,
                 First_Attribute => First_Attribute);
--- 862,869 ----
              end case;
  
              Attribute_Reference
!               (In_Tree,
!                Variable,
                 Current_Project => The_Project,
                 Current_Package => The_Package,
                 First_Attribute => First_Attribute);
*************** package body Prj.Strt is
*** 816,822 ****
        end if;
  
        Variable :=
!         Default_Project_Node (Of_Kind => N_Variable_Reference);
  
        if Look_For_Variable then
           case Names.Last is
--- 872,879 ----
        end if;
  
        Variable :=
!         Default_Project_Node
!           (Of_Kind => N_Variable_Reference, In_Tree => In_Tree);
  
        if Look_For_Variable then
           case Names.Last is
*************** package body Prj.Strt is
*** 830,836 ****
  
                 --  Simple variable name
  
!                Set_Name_Of (Variable, To => Names.Table (1).Name);
  
              when 2 =>
  
--- 887,893 ----
  
                 --  Simple variable name
  
!                Set_Name_Of (Variable, In_Tree, To => Names.Table (1).Name);
  
              when 2 =>
  
*************** package body Prj.Strt is
*** 838,859 ****
                 --  a project name or a package name. Project names have
                 --  priority over package names.
  
!                Set_Name_Of (Variable, To => Names.Table (2).Name);
  
                 --  Check if it can be a package name
  
!                The_Package := First_Package_Of (Current_Project);
  
                 while The_Package /= Empty_Node
!                  and then Name_Of (The_Package) /= Names.Table (1).Name
                 loop
!                   The_Package := Next_Package_In_Project (The_Package);
                 end loop;
  
                 --  Now look for a possible project name
  
                 The_Project := Imported_Or_Extended_Project_Of
!                                 (Current_Project, Names.Table (1).Name);
  
                 if The_Project /= Empty_Node then
                    Specified_Project := The_Project;
--- 895,918 ----
                 --  a project name or a package name. Project names have
                 --  priority over package names.
  
!                Set_Name_Of (Variable, In_Tree, To => Names.Table (2).Name);
  
                 --  Check if it can be a package name
  
!                The_Package := First_Package_Of (Current_Project, In_Tree);
  
                 while The_Package /= Empty_Node
!                  and then Name_Of (The_Package, In_Tree) /=
!                             Names.Table (1).Name
                 loop
!                   The_Package :=
!                     Next_Package_In_Project (The_Package, In_Tree);
                 end loop;
  
                 --  Now look for a possible project name
  
                 The_Project := Imported_Or_Extended_Project_Of
!                               (Current_Project, In_Tree, Names.Table (1).Name);
  
                 if The_Project /= Empty_Node then
                    Specified_Project := The_Project;
*************** package body Prj.Strt is
*** 874,880 ****
                 --  made of several simple names, or a project name followed
                 --  by a package name.
  
!                Set_Name_Of (Variable, To => Names.Table (Names.Last).Name);
  
                 declare
                    Short_Project : Name_Id;
--- 933,940 ----
                 --  made of several simple names, or a project name followed
                 --  by a package name.
  
!                Set_Name_Of
!                  (Variable, In_Tree, To => Names.Table (Names.Last).Name);
  
                 declare
                    Short_Project : Name_Id;
*************** package body Prj.Strt is
*** 891,900 ****
  
                    for Index in 1 .. Names.Last - 2 loop
                       Add_To_Buffer
!                        (Get_Name_String (Names.Table (Index).Name));
  
                       if Index /= Names.Last - 2 then
!                         Add_To_Buffer (".");
                       end if;
                    end loop;
  
--- 951,961 ----
  
                    for Index in 1 .. Names.Last - 2 loop
                       Add_To_Buffer
!                        (Get_Name_String (Names.Table (Index).Name),
!                         Buffer, Buffer_Last);
  
                       if Index /= Names.Last - 2 then
!                         Add_To_Buffer (".", Buffer, Buffer_Last);
                       end if;
                    end loop;
  
*************** package body Prj.Strt is
*** 904,912 ****
  
                    --  Add the simple name before the name of the variable
  
!                   Add_To_Buffer (".");
                    Add_To_Buffer
!                     (Get_Name_String (Names.Table (Names.Last - 1).Name));
                    Name_Len := Buffer_Last;
                    Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
                    Long_Project := Name_Find;
--- 965,974 ----
  
                    --  Add the simple name before the name of the variable
  
!                   Add_To_Buffer (".", Buffer, Buffer_Last);
                    Add_To_Buffer
!                     (Get_Name_String (Names.Table (Names.Last - 1).Name),
!                      Buffer, Buffer_Last);
                    Name_Len := Buffer_Last;
                    Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
                    Long_Project := Name_Find;
*************** package body Prj.Strt is
*** 915,921 ****
                    --  extended project.
  
                    The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, Long_Project);
  
                    if The_Project /= Empty_Node then
                       Specified_Project := The_Project;
--- 977,983 ----
                    --  extended project.
  
                    The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, In_Tree, Long_Project);
  
                    if The_Project /= Empty_Node then
                       Specified_Project := The_Project;
*************** package body Prj.Strt is
*** 927,933 ****
                       --  First check for a possible project name
  
                       The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, Short_Project);
  
                       if The_Project = Empty_Node then
                          --  Unknown prefix, report an error
--- 989,995 ----
                       --  First check for a possible project name
  
                       The_Project := Imported_Or_Extended_Project_Of
!                                    (Current_Project, In_Tree, Short_Project);
  
                       if The_Project = Empty_Node then
                          --  Unknown prefix, report an error
*************** package body Prj.Strt is
*** 943,956 ****
  
                          --  Now look for the package in this project
  
!                         The_Package := First_Package_Of (The_Project);
  
                          while The_Package /= Empty_Node
!                           and then Name_Of (The_Package) /=
                                                Names.Table (Names.Last - 1).Name
                          loop
                             The_Package :=
!                              Next_Package_In_Project (The_Package);
                          end loop;
  
                          if The_Package = Empty_Node then
--- 1005,1018 ----
  
                          --  Now look for the package in this project
  
!                         The_Package := First_Package_Of (The_Project, In_Tree);
  
                          while The_Package /= Empty_Node
!                           and then Name_Of (The_Package, In_Tree) /=
                                                Names.Table (Names.Last - 1).Name
                          loop
                             The_Package :=
!                              Next_Package_In_Project (The_Package, In_Tree);
                          end loop;
  
                          if The_Package = Empty_Node then
*************** package body Prj.Strt is
*** 971,979 ****
        end if;
  
        if Look_For_Variable then
!          Variable_Name := Name_Of (Variable);
!          Set_Project_Node_Of (Variable, To => Specified_Project);
!          Set_Package_Node_Of (Variable, To => Specified_Package);
  
           if Specified_Project /= Empty_Node then
              The_Project := Specified_Project;
--- 1033,1041 ----
        end if;
  
        if Look_For_Variable then
!          Variable_Name := Name_Of (Variable, In_Tree);
!          Set_Project_Node_Of (Variable, In_Tree, To => Specified_Project);
!          Set_Package_Node_Of (Variable, In_Tree, To => Specified_Package);
  
           if Specified_Project /= Empty_Node then
              The_Project := Specified_Project;
*************** package body Prj.Strt is
*** 990,1002 ****
           --  declared in this package.
  
           if Specified_Package /= Empty_Node then
!             Current_Variable := First_Variable_Of (Specified_Package);
  
              while Current_Variable /= Empty_Node
                and then
!               Name_Of (Current_Variable) /= Variable_Name
              loop
!                Current_Variable := Next_Variable (Current_Variable);
              end loop;
  
           else
--- 1052,1065 ----
           --  declared in this package.
  
           if Specified_Package /= Empty_Node then
!             Current_Variable :=
!               First_Variable_Of (Specified_Package, In_Tree);
  
              while Current_Variable /= Empty_Node
                and then
!               Name_Of (Current_Variable, In_Tree) /= Variable_Name
              loop
!                Current_Variable := Next_Variable (Current_Variable, In_Tree);
              end loop;
  
           else
*************** package body Prj.Strt is
*** 1007,1018 ****
              if Specified_Project = Empty_Node
                and then Current_Package /= Empty_Node
              then
!                Current_Variable := First_Variable_Of (Current_Package);
  
                 while Current_Variable /= Empty_Node
!                  and then Name_Of (Current_Variable) /= Variable_Name
                 loop
!                   Current_Variable := Next_Variable (Current_Variable);
                 end loop;
              end if;
  
--- 1070,1083 ----
              if Specified_Project = Empty_Node
                and then Current_Package /= Empty_Node
              then
!                Current_Variable :=
!                  First_Variable_Of (Current_Package, In_Tree);
  
                 while Current_Variable /= Empty_Node
!                  and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
                 loop
!                   Current_Variable :=
!                     Next_Variable (Current_Variable, In_Tree);
                 end loop;
              end if;
  
*************** package body Prj.Strt is
*** 1020,1031 ****
              --  variable has been declared in the project.
  
              if Current_Variable = Empty_Node then
!                Current_Variable := First_Variable_Of (The_Project);
  
                 while Current_Variable /= Empty_Node
!                  and then Name_Of (Current_Variable) /= Variable_Name
                 loop
!                   Current_Variable := Next_Variable (Current_Variable);
                 end loop;
              end if;
           end if;
--- 1085,1097 ----
              --  variable has been declared in the project.
  
              if Current_Variable = Empty_Node then
!                Current_Variable := First_Variable_Of (The_Project, In_Tree);
  
                 while Current_Variable /= Empty_Node
!                  and then Name_Of (Current_Variable, In_Tree) /= Variable_Name
                 loop
!                   Current_Variable :=
!                     Next_Variable (Current_Variable, In_Tree);
                 end loop;
              end if;
           end if;
*************** package body Prj.Strt is
*** 1041,1051 ****
  
        if Current_Variable /= Empty_Node then
           Set_Expression_Kind_Of
!            (Variable, To => Expression_Kind_Of (Current_Variable));
  
!          if Kind_Of (Current_Variable) = N_Typed_Variable_Declaration then
              Set_String_Type_Of
!               (Variable, To => String_Type_Of (Current_Variable));
           end if;
        end if;
  
--- 1107,1121 ----
  
        if Current_Variable /= Empty_Node then
           Set_Expression_Kind_Of
!            (Variable, In_Tree,
!             To => Expression_Kind_Of (Current_Variable, In_Tree));
  
!          if
!            Kind_Of (Current_Variable, In_Tree) = N_Typed_Variable_Declaration
!          then
              Set_String_Type_Of
!               (Variable, In_Tree,
!                To => String_Type_Of (Current_Variable, In_Tree));
           end if;
        end if;
  
*************** package body Prj.Strt is
*** 1054,1068 ****
  
        if Token = Tok_Left_Paren then
           Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
!          Scan;
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Scan;
              Expect (Tok_Right_Paren, "`)`");
  
              if Token = Tok_Right_Paren then
!                Scan;
              end if;
           end if;
        end if;
--- 1124,1138 ----
  
        if Token = Tok_Left_Paren then
           Error_Msg ("\variables cannot be associative arrays", Token_Ptr);
!          Scan (In_Tree);
           Expect (Tok_String_Literal, "literal string");
  
           if Token = Tok_String_Literal then
!             Scan (In_Tree);
              Expect (Tok_Right_Paren, "`)`");
  
              if Token = Tok_Right_Paren then
!                Scan (In_Tree);
              end if;
           end if;
        end if;
*************** package body Prj.Strt is
*** 1072,1078 ****
     -- Start_New_Case_Construction --
     ---------------------------------
  
!    procedure Start_New_Case_Construction (String_Type  : Project_Node_Id) is
        Current_String : Project_Node_Id;
  
     begin
--- 1142,1151 ----
     -- Start_New_Case_Construction --
     ---------------------------------
  
!    procedure Start_New_Case_Construction
!      (In_Tree      : Project_Node_Tree_Ref;
!       String_Type  : Project_Node_Id)
!    is
        Current_String : Project_Node_Id;
  
     begin
*************** package body Prj.Strt is
*** 1089,1099 ****
        --  Add to table Choices the literal of the string type
  
        if String_Type /= Empty_Node then
!          Current_String := First_Literal_String (String_Type);
  
           while Current_String /= Empty_Node loop
!             Add (This_String => String_Value_Of (Current_String));
!             Current_String := Next_Literal_String (Current_String);
           end loop;
        end if;
  
--- 1162,1172 ----
        --  Add to table Choices the literal of the string type
  
        if String_Type /= Empty_Node then
!          Current_String := First_Literal_String (String_Type, In_Tree);
  
           while Current_String /= Empty_Node loop
!             Add (This_String => String_Value_Of (Current_String, In_Tree));
!             Current_String := Next_Literal_String (Current_String, In_Tree);
           end loop;
        end if;
  
*************** package body Prj.Strt is
*** 1109,1115 ****
     -----------
  
     procedure Terms
!      (Term            : out Project_Node_Id;
        Expr_Kind       : in out Variable_Kind;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
--- 1182,1189 ----
     -----------
  
     procedure Terms
!      (In_Tree         : Project_Node_Tree_Ref;
!       Term            : out Project_Node_Id;
        Expr_Kind       : in out Variable_Kind;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
*************** package body Prj.Strt is
*** 1125,1132 ****
     begin
        --  Declare a new node for the term
  
!       Term := Default_Project_Node (Of_Kind => N_Term);
!       Set_Location_Of (Term, To => Token_Ptr);
  
        case Token is
           when Tok_Left_Paren =>
--- 1199,1206 ----
     begin
        --  Declare a new node for the term
  
!       Term := Default_Project_Node (Of_Kind => N_Term, In_Tree => In_Tree);
!       Set_Location_Of (Term, In_Tree, To => Token_Ptr);
  
        case Token is
           when Tok_Left_Paren =>
*************** package body Prj.Strt is
*** 1156,1175 ****
              --  Declare a new node for this literal string list
  
              Term_Id := Default_Project_Node
!               (Of_Kind => N_Literal_String_List,
                 And_Expr_Kind => List);
!             Set_Current_Term (Term, To => Term_Id);
!             Set_Location_Of (Term, To => Token_Ptr);
  
              --  Scan past the left parenthesis
  
!             Scan;
  
              --  If the left parenthesis is immediately followed by a right
              --  parenthesis, the literal string list is empty.
  
              if Token = Tok_Right_Paren then
!                Scan;
  
              else
                 --  Otherwise, we parse the expression(s) in the literal string
--- 1230,1250 ----
              --  Declare a new node for this literal string list
  
              Term_Id := Default_Project_Node
!               (Of_Kind       => N_Literal_String_List,
!                In_Tree       => In_Tree,
                 And_Expr_Kind => List);
!             Set_Current_Term (Term, In_Tree, To => Term_Id);
!             Set_Location_Of  (Term, In_Tree, To => Token_Ptr);
  
              --  Scan past the left parenthesis
  
!             Scan (In_Tree);
  
              --  If the left parenthesis is immediately followed by a right
              --  parenthesis, the literal string list is empty.
  
              if Token = Tok_Right_Paren then
!                Scan (In_Tree);
  
              else
                 --  Otherwise, we parse the expression(s) in the literal string
*************** package body Prj.Strt is
*** 1177,1190 ****
  
                 loop
                    Current_Location := Token_Ptr;
!                   Parse_Expression (Expression      => Next_Expression,
!                                     Current_Project => Current_Project,
!                                     Current_Package => Current_Package,
!                                     Optional_Index  => Optional_Index);
  
                    --  The expression kind is String list, report an error
  
!                   if Expression_Kind_Of (Next_Expression) = List then
                       Error_Msg ("single expression expected",
                                  Current_Location);
                    end if;
--- 1252,1267 ----
  
                 loop
                    Current_Location := Token_Ptr;
!                   Parse_Expression
!                     (In_Tree         => In_Tree,
!                      Expression      => Next_Expression,
!                      Current_Project => Current_Project,
!                      Current_Package => Current_Package,
!                      Optional_Index  => Optional_Index);
  
                    --  The expression kind is String list, report an error
  
!                   if Expression_Kind_Of (Next_Expression, In_Tree) = List then
                       Error_Msg ("single expression expected",
                                  Current_Location);
                    end if;
*************** package body Prj.Strt is
*** 1194,1203 ****
  
                    if Current_Expression = Empty_Node then
                       Set_First_Expression_In_List
!                        (Term_Id, To => Next_Expression);
                    else
                       Set_Next_Expression_In_List
!                        (Current_Expression, To => Next_Expression);
                    end if;
  
                    Current_Expression := Next_Expression;
--- 1271,1280 ----
  
                    if Current_Expression = Empty_Node then
                       Set_First_Expression_In_List
!                        (Term_Id, In_Tree, To => Next_Expression);
                    else
                       Set_Next_Expression_In_List
!                        (Current_Expression, In_Tree, To => Next_Expression);
                    end if;
  
                    Current_Expression := Next_Expression;
*************** package body Prj.Strt is
*** 1205,1211 ****
                    --  If there is a comma, continue with the next expression
  
                    exit when Token /= Tok_Comma;
!                   Scan; -- past the comma
                 end loop;
  
                 --  We expect a closing right parenthesis
--- 1282,1288 ----
                    --  If there is a comma, continue with the next expression
  
                    exit when Token /= Tok_Comma;
!                   Scan (In_Tree); -- past the comma
                 end loop;
  
                 --  We expect a closing right parenthesis
*************** package body Prj.Strt is
*** 1213,1219 ****
                 Expect (Tok_Right_Paren, "`)`");
  
                 if Token = Tok_Right_Paren then
!                   Scan;
                 end if;
              end if;
  
--- 1290,1296 ----
                 Expect (Tok_Right_Paren, "`)`");
  
                 if Token = Tok_Right_Paren then
!                   Scan (In_Tree);
                 end if;
              end if;
  
*************** package body Prj.Strt is
*** 1228,1256 ****
  
              --  Declare a new node for the string literal
  
!             Term_Id := Default_Project_Node (Of_Kind => N_Literal_String);
!             Set_Current_Term (Term, To => Term_Id);
!             Set_String_Value_Of (Term_Id, To => Token_Name);
  
              --  Scan past the string literal
  
!             Scan;
  
              --  Check for possible index expression
  
              if Token = Tok_At then
                 if not Optional_Index then
                    Error_Msg ("index not allowed here", Token_Ptr);
!                   Scan;
  
                    if Token = Tok_Integer_Literal then
!                      Scan;
                    end if;
  
                 --  Set the index value
  
                 else
!                   Scan;
                    Expect (Tok_Integer_Literal, "integer literal");
  
                    if Token = Tok_Integer_Literal then
--- 1305,1335 ----
  
              --  Declare a new node for the string literal
  
!             Term_Id :=
!               Default_Project_Node
!                 (Of_Kind => N_Literal_String, In_Tree => In_Tree);
!             Set_Current_Term (Term, In_Tree, To => Term_Id);
!             Set_String_Value_Of (Term_Id, In_Tree, To => Token_Name);
  
              --  Scan past the string literal
  
!             Scan (In_Tree);
  
              --  Check for possible index expression
  
              if Token = Tok_At then
                 if not Optional_Index then
                    Error_Msg ("index not allowed here", Token_Ptr);
!                   Scan (In_Tree);
  
                    if Token = Tok_Integer_Literal then
!                      Scan (In_Tree);
                    end if;
  
                 --  Set the index value
  
                 else
!                   Scan (In_Tree);
                    Expect (Tok_Integer_Literal, "integer literal");
  
                    if Token = Tok_Integer_Literal then
*************** package body Prj.Strt is
*** 1260,1270 ****
                          if Index = 0 then
                             Error_Msg ("index cannot be zero", Token_Ptr);
                          else
!                            Set_Source_Index_Of (Term_Id, To => Index);
                          end if;
                       end;
  
!                      Scan;
                    end if;
                 end if;
              end if;
--- 1339,1350 ----
                          if Index = 0 then
                             Error_Msg ("index cannot be zero", Token_Ptr);
                          else
!                            Set_Source_Index_Of
!                              (Term_Id, In_Tree, To => Index);
                          end if;
                       end;
  
!                      Scan (In_Tree);
                    end if;
                 end if;
              end if;
*************** package body Prj.Strt is
*** 1275,1284 ****
              --  Get the variable or attribute reference
  
              Parse_Variable_Reference
!               (Variable        => Reference,
                 Current_Project => Current_Project,
                 Current_Package => Current_Package);
!             Set_Current_Term (Term, To => Reference);
  
              if Reference /= Empty_Node then
  
--- 1355,1365 ----
              --  Get the variable or attribute reference
  
              Parse_Variable_Reference
!               (In_Tree         => In_Tree,
!                Variable        => Reference,
                 Current_Project => Current_Project,
                 Current_Package => Current_Package);
!             Set_Current_Term (Term, In_Tree, To => Reference);
  
              if Reference /= Empty_Node then
  
*************** package body Prj.Strt is
*** 1286,1295 ****
                 --  has the kind of the variable or attribute reference.
  
                 if Expr_Kind = Undefined then
!                   Expr_Kind := Expression_Kind_Of (Reference);
  
                 elsif Expr_Kind = Single
!                  and then Expression_Kind_Of (Reference) = List
                 then
                    --  If the expression is a single list, and the reference is
                    --  a string list, report an error, and set the expression
--- 1367,1376 ----
                 --  has the kind of the variable or attribute reference.
  
                 if Expr_Kind = Undefined then
!                   Expr_Kind := Expression_Kind_Of (Reference, In_Tree);
  
                 elsif Expr_Kind = Single
!                  and then Expression_Kind_Of (Reference, In_Tree) = List
                 then
                    --  If the expression is a single list, and the reference is
                    --  a string list, report an error, and set the expression
*************** package body Prj.Strt is
*** 1308,1333 ****
              --  attribute reference of the current project.
  
              Current_Location := Token_Ptr;
!             Scan;
              Expect (Tok_Apostrophe, "`'`");
  
              if Token = Tok_Apostrophe then
                 Attribute_Reference
!                  (Reference       => Reference,
                    First_Attribute => Prj.Attr.Attribute_First,
                    Current_Project => Current_Project,
                    Current_Package => Empty_Node);
!                Set_Current_Term (Term, To => Reference);
              end if;
  
              --  Same checks as above for the expression kind
  
              if Reference /= Empty_Node then
                 if Expr_Kind = Undefined then
!                   Expr_Kind := Expression_Kind_Of (Reference);
  
                 elsif Expr_Kind = Single
!                  and then Expression_Kind_Of (Reference) = List
                 then
                    Error_Msg
                      ("lists cannot appear in single string expression",
--- 1389,1415 ----
              --  attribute reference of the current project.
  
              Current_Location := Token_Ptr;
!             Scan (In_Tree);
              Expect (Tok_Apostrophe, "`'`");
  
              if Token = Tok_Apostrophe then
                 Attribute_Reference
!                  (In_Tree         => In_Tree,
!                   Reference       => Reference,
                    First_Attribute => Prj.Attr.Attribute_First,
                    Current_Project => Current_Project,
                    Current_Package => Empty_Node);
!                Set_Current_Term (Term, In_Tree, To => Reference);
              end if;
  
              --  Same checks as above for the expression kind
  
              if Reference /= Empty_Node then
                 if Expr_Kind = Undefined then
!                   Expr_Kind := Expression_Kind_Of (Reference, In_Tree);
  
                 elsif Expr_Kind = Single
!                  and then Expression_Kind_Of (Reference, In_Tree) = List
                 then
                    Error_Msg
                      ("lists cannot appear in single string expression",
*************** package body Prj.Strt is
*** 1342,1349 ****
                 Expr_Kind := Single;
              end if;
  
!             External_Reference (External_Value => Reference);
!             Set_Current_Term (Term, To => Reference);
  
           when others =>
              Error_Msg ("cannot be part of an expression", Token_Ptr);
--- 1424,1435 ----
                 Expr_Kind := Single;
              end if;
  
!             External_Reference
!               (In_Tree         => In_Tree,
!                Current_Project => Current_Project,
!                Current_Package => Current_Package,
!                External_Value  => Reference);
!             Set_Current_Term (Term, In_Tree, To => Reference);
  
           when others =>
              Error_Msg ("cannot be part of an expression", Token_Ptr);
*************** package body Prj.Strt is
*** 1357,1373 ****
  
           --  Scan past the '&'
  
!          Scan;
  
!          Terms (Term            => Next_Term,
!                 Expr_Kind       => Expr_Kind,
!                 Current_Project => Current_Project,
!                 Current_Package => Current_Package,
!                 Optional_Index  => Optional_Index);
  
           --  And link the next term to this term
  
!          Set_Next_Term (Term, To => Next_Term);
        end if;
     end Terms;
  
--- 1443,1461 ----
  
           --  Scan past the '&'
  
!          Scan (In_Tree);
  
!          Terms
!            (In_Tree         => In_Tree,
!             Term            => Next_Term,
!             Expr_Kind       => Expr_Kind,
!             Current_Project => Current_Project,
!             Current_Package => Current_Package,
!             Optional_Index  => Optional_Index);
  
           --  And link the next term to this term
  
!          Set_Next_Term (Term, In_Tree, To => Next_Term);
        end if;
     end Terms;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-strt.ads gcc-4.1.0/gcc/ada/prj-strt.ads
*** gcc-4.0.2/gcc/ada/prj-strt.ads	Fri Jun 11 10:47:36 2004
--- gcc-4.1.0/gcc/ada/prj-strt.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,36 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package implements parsing of string expressions in project files.
  
  with Prj.Tree;  use Prj.Tree;
  
  private package Prj.Strt is
  
!    procedure Parse_String_Type_List (First_String : out Project_Node_Id);
     --  Get the list of literal strings that are allowed for a typed string.
     --  On entry, the current token is the first literal string following
     --  a left parenthesis in a string type declaration such as:
--- 16,38 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package implements parsing of string expressions in project files
  
  with Prj.Tree;  use Prj.Tree;
  
  private package Prj.Strt is
  
!    procedure Parse_String_Type_List
!      (In_Tree      : Project_Node_Tree_Ref;
!       First_String : out Project_Node_Id);
     --  Get the list of literal strings that are allowed for a typed string.
     --  On entry, the current token is the first literal string following
     --  a left parenthesis in a string type declaration such as:
*************** private package Prj.Strt is
*** 45,51 ****
     --      or after a comma
     --    - two literal strings in the list are equal
  
!    procedure Start_New_Case_Construction (String_Type : Project_Node_Id);
     --  This procedure is called at the beginning of a case construction
     --  The parameter String_Type is the node for the string type
     --  of the case label variable.
--- 47,55 ----
     --      or after a comma
     --    - two literal strings in the list are equal
  
!    procedure Start_New_Case_Construction
!      (In_Tree     : Project_Node_Tree_Ref;
!       String_Type : Project_Node_Id);
     --  This procedure is called at the beginning of a case construction
     --  The parameter String_Type is the node for the string type
     --  of the case label variable.
*************** private package Prj.Strt is
*** 65,71 ****
     --  not been specified.
  
     procedure Parse_Choice_List
!      (First_Choice : out Project_Node_Id);
     --  Get the label for a choice list.
     --  Report an error if
     --    - a case label is not a literal string
--- 69,76 ----
     --  not been specified.
  
     procedure Parse_Choice_List
!      (In_Tree      : Project_Node_Tree_Ref;
!       First_Choice : out Project_Node_Id);
     --  Get the label for a choice list.
     --  Report an error if
     --    - a case label is not a literal string
*************** private package Prj.Strt is
*** 73,79 ****
     --    - the same case label is repeated in the same case construction
  
     procedure Parse_Expression
!      (Expression      : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
        Optional_Index  : Boolean);
--- 78,85 ----
     --    - the same case label is repeated in the same case construction
  
     procedure Parse_Expression
!      (In_Tree         : Project_Node_Tree_Ref;
!       Expression      : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id;
        Optional_Index  : Boolean);
*************** private package Prj.Strt is
*** 85,91 ****
     --  been parsed.
  
     procedure Parse_Variable_Reference
!      (Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
     --  Parse a variable or attribute reference.
--- 91,98 ----
     --  been parsed.
  
     procedure Parse_Variable_Reference
!      (In_Tree         : Project_Node_Tree_Ref;
!       Variable        : out Project_Node_Id;
        Current_Project : Project_Node_Id;
        Current_Package : Project_Node_Id);
     --  Parse a variable or attribute reference.
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-tree.adb gcc-4.1.0/gcc/ada/prj-tree.adb
*** gcc-4.0.2/gcc/ada/prj-tree.adb	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/prj-tree.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Prj.Tree is
*** 76,82 ****
     --  Set to True when some comments may not be associated with any node
  
     function Comment_Zones_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     --  Returns the ID of the N_Comment_Zones node associated with node Node.
     --  If there is not already an N_Comment_Zones node, create one and
     --  associate it with node Node.
--- 76,83 ----
     --  Set to True when some comments may not be associated with any node
  
     function Comment_Zones_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Returns the ID of the N_Comment_Zones node associated with node Node.
     --  If there is not already an N_Comment_Zones node, create one and
     --  associate it with node Node.
*************** package body Prj.Tree is
*** 85,91 ****
     -- Add_Comments --
     ------------------
  
!    procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location) is
        Zone     : Project_Node_Id := Empty_Node;
        Previous : Project_Node_Id := Empty_Node;
  
--- 86,95 ----
     -- Add_Comments --
     ------------------
  
!    procedure Add_Comments
!      (To       : Project_Node_Id;
!       In_Tree  : Project_Node_Tree_Ref;
!       Where    : Comment_Location) is
        Zone     : Project_Node_Id := Empty_Node;
        Previous : Project_Node_Id := Empty_Node;
  
*************** package body Prj.Tree is
*** 93,108 ****
        pragma Assert
          (To /= Empty_Node
            and then
!          Project_Nodes.Table (To).Kind /= N_Comment);
  
!       Zone := Project_Nodes.Table (To).Comments;
  
        if Zone = Empty_Node then
  
           --  Create new N_Comment_Zones node
  
!          Project_Nodes.Increment_Last;
!          Project_Nodes.Table (Project_Nodes.Last) :=
             (Kind             => N_Comment_Zones,
              Expr_Kind        => Undefined,
              Location         => No_Location,
--- 97,113 ----
        pragma Assert
          (To /= Empty_Node
            and then
!          In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
  
!       Zone := In_Tree.Project_Nodes.Table (To).Comments;
  
        if Zone = Empty_Node then
  
           --  Create new N_Comment_Zones node
  
!          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!          In_Tree.Project_Nodes.Table
!            (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
             (Kind             => N_Comment_Zones,
              Expr_Kind        => Undefined,
              Location         => No_Location,
*************** package body Prj.Tree is
*** 121,132 ****
              Flag2            => False,
              Comments         => Empty_Node);
  
!          Zone := Project_Nodes.Last;
!          Project_Nodes.Table (To).Comments := Zone;
        end if;
  
        if Where = End_Of_Line then
!          Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
  
        else
           --  Get each comments in the Comments table and link them to node To
--- 126,137 ----
              Flag2            => False,
              Comments         => Empty_Node);
  
!          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
!          In_Tree.Project_Nodes.Table (To).Comments := Zone;
        end if;
  
        if Where = End_Of_Line then
!          In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
  
        else
           --  Get each comments in the Comments table and link them to node To
*************** package body Prj.Tree is
*** 145,152 ****
                 return;
              end if;
  
!             Project_Nodes.Increment_Last;
!             Project_Nodes.Table (Project_Nodes.Last) :=
                (Kind             => N_Comment,
                 Expr_Kind        => Undefined,
                 Flag1            => Comments.Table (J).Follows_Empty_Line,
--- 150,158 ----
                 return;
              end if;
  
!             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!             In_Tree.Project_Nodes.Table
!               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
                (Kind             => N_Comment,
                 Expr_Kind        => Undefined,
                 Flag1            => Comments.Table (J).Follows_Empty_Line,
*************** package body Prj.Tree is
*** 172,187 ****
              if Previous = Empty_Node then
                 case Where is
                    when Before =>
!                      Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
  
                    when After =>
!                      Project_Nodes.Table (Zone).Field2 := Project_Nodes.Last;
  
                    when Before_End =>
!                      Project_Nodes.Table (Zone).Field3 := Project_Nodes.Last;
  
                    when After_End =>
!                      Project_Nodes.Table (Zone).Comments := Project_Nodes.Last;
  
                    when End_Of_Line =>
                       null;
--- 178,197 ----
              if Previous = Empty_Node then
                 case Where is
                    when Before =>
!                      In_Tree.Project_Nodes.Table (Zone).Field1 :=
!                        Project_Node_Table.Last (In_Tree.Project_Nodes);
  
                    when After =>
!                      In_Tree.Project_Nodes.Table (Zone).Field2 :=
!                        Project_Node_Table.Last (In_Tree.Project_Nodes);
  
                    when Before_End =>
!                      In_Tree.Project_Nodes.Table (Zone).Field3 :=
!                        Project_Node_Table.Last (In_Tree.Project_Nodes);
  
                    when After_End =>
!                      In_Tree.Project_Nodes.Table (Zone).Comments :=
!                        Project_Node_Table.Last (In_Tree.Project_Nodes);
  
                    when End_Of_Line =>
                       null;
*************** package body Prj.Tree is
*** 190,202 ****
              else
                 --  When it is not the first, link it to the previous one
  
!                Project_Nodes.Table (Previous).Comments := Project_Nodes.Last;
              end if;
  
              --  This node becomes the previous one for the next comment, if
              --  there is one.
  
!             Previous := Project_Nodes.Last;
           end loop;
        end if;
  
--- 200,213 ----
              else
                 --  When it is not the first, link it to the previous one
  
!                In_Tree.Project_Nodes.Table (Previous).Comments :=
!                  Project_Node_Table.Last (In_Tree.Project_Nodes);
              end if;
  
              --  This node becomes the previous one for the next comment, if
              --  there is one.
  
!             Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
           end loop;
        end if;
  
*************** package body Prj.Tree is
*** 211,226 ****
     --------------------------------
  
     function Associative_Array_Index_Of
!      (Node : Project_Node_Id) return Name_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return Project_Nodes.Table (Node).Value;
     end Associative_Array_Index_Of;
  
     ----------------------------
--- 222,238 ----
     --------------------------------
  
     function Associative_Array_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return In_Tree.Project_Nodes.Table (Node).Value;
     end Associative_Array_Index_Of;
  
     ----------------------------
*************** package body Prj.Tree is
*** 228,241 ****
     ----------------------------
  
     function Associative_Package_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       return Project_Nodes.Table (Node).Field3;
     end Associative_Package_Of;
  
     ----------------------------
--- 240,254 ----
     ----------------------------
  
     function Associative_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Associative_Package_Of;
  
     ----------------------------
*************** package body Prj.Tree is
*** 243,271 ****
     ----------------------------
  
     function Associative_Project_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       return Project_Nodes.Table (Node).Field2;
     end Associative_Project_Of;
  
     ----------------------
     -- Case_Insensitive --
     ----------------------
  
!    function Case_Insensitive (Node : Project_Node_Id) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return Project_Nodes.Table (Node).Flag1;
     end Case_Insensitive;
  
     --------------------------------
--- 256,287 ----
     ----------------------------
  
     function Associative_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Associative_Project_Of;
  
     ----------------------
     -- Case_Insensitive --
     ----------------------
  
!    function Case_Insensitive
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return In_Tree.Project_Nodes.Table (Node).Flag1;
     end Case_Insensitive;
  
     --------------------------------
*************** package body Prj.Tree is
*** 273,286 ****
     --------------------------------
  
     function Case_Variable_Reference_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       return Project_Nodes.Table (Node).Field1;
     end Case_Variable_Reference_Of;
  
     ----------------------
--- 289,303 ----
     --------------------------------
  
     function Case_Variable_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Case_Variable_Reference_Of;
  
     ----------------------
*************** package body Prj.Tree is
*** 288,308 ****
     ----------------------
  
     function Comment_Zones_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
        Zone : Project_Node_Id;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        --  If there is not already an N_Comment_Zones associated, create a new
        --  one and associate it with node Node.
  
        if Zone = Empty_Node then
!          Project_Nodes.Increment_Last;
!          Zone := Project_Nodes.Last;
!          Project_Nodes.Table (Zone) :=
          (Kind             => N_Comment_Zones,
           Location         => No_Location,
           Directory        => No_Name,
--- 305,326 ----
     ----------------------
  
     function Comment_Zones_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
        Zone : Project_Node_Id;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        --  If there is not already an N_Comment_Zones associated, create a new
        --  one and associate it with node Node.
  
        if Zone = Empty_Node then
!          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
!          In_Tree.Project_Nodes.Table (Zone) :=
          (Kind             => N_Comment_Zones,
           Location         => No_Location,
           Directory        => No_Name,
*************** package body Prj.Tree is
*** 320,326 ****
           Flag1            => False,
           Flag2            => False,
           Comments         => Empty_Node);
!          Project_Nodes.Table (Node).Comments := Zone;
        end if;
  
        return Zone;
--- 338,344 ----
           Flag1            => False,
           Flag2            => False,
           Comments         => Empty_Node);
!          In_Tree.Project_Nodes.Table (Node).Comments := Zone;
        end if;
  
        return Zone;
*************** package body Prj.Tree is
*** 331,344 ****
     -----------------------
  
     function Current_Item_Node
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       return Project_Nodes.Table (Node).Field1;
     end Current_Item_Node;
  
     ------------------
--- 349,363 ----
     -----------------------
  
     function Current_Item_Node
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Current_Item_Node;
  
     ------------------
*************** package body Prj.Tree is
*** 346,359 ****
     ------------------
  
     function Current_Term
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Term);
!       return Project_Nodes.Table (Node).Field1;
     end Current_Term;
  
     --------------------------
--- 365,379 ----
     ------------------
  
     function Current_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Current_Term;
  
     --------------------------
*************** package body Prj.Tree is
*** 361,367 ****
     --------------------------
  
     function Default_Project_Node
!      (Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
     is
        Result   : Project_Node_Id;
--- 381,388 ----
     --------------------------
  
     function Default_Project_Node
!      (In_Tree       : Project_Node_Tree_Ref;
!       Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
     is
        Result   : Project_Node_Id;
*************** package body Prj.Tree is
*** 371,378 ****
     begin
        --  Create new node with specified kind and expression kind
  
!       Project_Nodes.Increment_Last;
!       Project_Nodes.Table (Project_Nodes.Last) :=
          (Kind             => Of_Kind,
           Location         => No_Location,
           Directory        => No_Name,
--- 392,400 ----
     begin
        --  Create new node with specified kind and expression kind
  
!       Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!       In_Tree.Project_Nodes.Table
!         (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
          (Kind             => Of_Kind,
           Location         => No_Location,
           Directory        => No_Name,
*************** package body Prj.Tree is
*** 393,399 ****
  
        --  Save the new node for the returned value
  
!       Result := Project_Nodes.Last;
  
        if Comments.Last > 0 then
  
--- 415,421 ----
  
        --  Save the new node for the returned value
  
!       Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
  
        if Comments.Last > 0 then
  
*************** package body Prj.Tree is
*** 404,411 ****
  
           elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
  
!             Project_Nodes.Increment_Last;
!             Project_Nodes.Table (Project_Nodes.Last) :=
                (Kind             => N_Comment_Zones,
                 Expr_Kind        => Undefined,
                 Location         => No_Location,
--- 426,434 ----
  
           elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
  
!             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!             In_Tree.Project_Nodes.Table
!               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
                (Kind             => N_Comment_Zones,
                 Expr_Kind        => Undefined,
                 Location         => No_Location,
*************** package body Prj.Tree is
*** 424,439 ****
                 Flag2            => False,
                 Comments         => Empty_Node);
  
!             Zone := Project_Nodes.Last;
!             Project_Nodes.Table (Result).Comments := Zone;
              Previous := Empty_Node;
  
              for J in 1 .. Comments.Last loop
  
                 --  Create a new N_Comment node
  
!                Project_Nodes.Increment_Last;
!                Project_Nodes.Table (Project_Nodes.Last) :=
                   (Kind             => N_Comment,
                    Expr_Kind        => Undefined,
                    Flag1            => Comments.Table (J).Follows_Empty_Line,
--- 447,463 ----
                 Flag2            => False,
                 Comments         => Empty_Node);
  
!             Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
!             In_Tree.Project_Nodes.Table (Result).Comments := Zone;
              Previous := Empty_Node;
  
              for J in 1 .. Comments.Last loop
  
                 --  Create a new N_Comment node
  
!                Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
!                In_Tree.Project_Nodes.Table
!                  (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
                   (Kind             => N_Comment,
                    Expr_Kind        => Undefined,
                    Flag1            => Comments.Table (J).Follows_Empty_Line,
*************** package body Prj.Tree is
*** 457,473 ****
                 --  otherwise to the previous one.
  
                 if Previous = Empty_Node then
!                   Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
  
                 else
!                   Project_Nodes.Table (Previous).Comments :=
!                     Project_Nodes.Last;
                 end if;
  
                 --  This new node will be the previous one for the next
                 --  N_Comment node, if there is one.
  
!                Previous := Project_Nodes.Last;
              end loop;
  
              --  Empty the Comments table after all comments have been processed
--- 481,498 ----
                 --  otherwise to the previous one.
  
                 if Previous = Empty_Node then
!                   In_Tree.Project_Nodes.Table (Zone).Field1 :=
!                     Project_Node_Table.Last (In_Tree.Project_Nodes);
  
                 else
!                   In_Tree.Project_Nodes.Table (Previous).Comments :=
!                     Project_Node_Table.Last (In_Tree.Project_Nodes);
                 end if;
  
                 --  This new node will be the previous one for the next
                 --  N_Comment node, if there is one.
  
!                Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
              end loop;
  
              --  Empty the Comments table after all comments have been processed
*************** package body Prj.Tree is
*** 483,512 ****
     -- Directory_Of --
     ------------------
  
!    function Directory_Of (Node : Project_Node_Id) return Name_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Directory;
     end Directory_Of;
  
     -------------------------
     -- End_Of_Line_Comment --
     -------------------------
  
!    function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return No_Name;
        else
!          return Project_Nodes.Table (Zone).Value;
        end if;
     end End_Of_Line_Comment;
  
--- 508,541 ----
     -- Directory_Of --
     ------------------
  
!    function Directory_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Directory;
     end Directory_Of;
  
     -------------------------
     -- End_Of_Line_Comment --
     -------------------------
  
!    function End_Of_Line_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return No_Name;
        else
!          return In_Tree.Project_Nodes.Table (Zone).Value;
        end if;
     end End_Of_Line_Comment;
  
*************** package body Prj.Tree is
*** 514,543 ****
     -- Expression_Kind_Of --
     ------------------------
  
!    function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
     begin
        pragma Assert
          (Node /= Empty_Node
             and then
!              (Project_Nodes.Table (Node).Kind = N_Literal_String
                  or else
!               Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Package_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Expression
                  or else
!               Project_Nodes.Table (Node).Kind = N_Term
                  or else
!               Project_Nodes.Table (Node).Kind = N_Variable_Reference
                  or else
!               Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
  
!       return Project_Nodes.Table (Node).Expr_Kind;
     end Expression_Kind_Of;
  
     -------------------
--- 543,576 ----
     -- Expression_Kind_Of --
     ------------------------
  
!    function Expression_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Variable_Kind is
     begin
        pragma Assert
          (Node /= Empty_Node
             and then
!              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind =
!                        N_Typed_Variable_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind =
!                         N_Attribute_Reference));
  
!       return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
     end Expression_Kind_Of;
  
     -------------------
*************** package body Prj.Tree is
*** 545,563 ****
     -------------------
  
     function Expression_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
  
!       return Project_Nodes.Table (Node).Field1;
     end Expression_Of;
  
     -------------------------
--- 578,600 ----
     -------------------
  
     function Expression_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Attribute_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Declaration));
  
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Expression_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 565,578 ****
     -------------------------
  
     function Extended_Project_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       return Project_Nodes.Table (Node).Field2;
     end Extended_Project_Of;
  
     ------------------------------
--- 602,616 ----
     -------------------------
  
     function Extended_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Extended_Project_Of;
  
     ------------------------------
*************** package body Prj.Tree is
*** 580,607 ****
     ------------------------------
  
     function Extended_Project_Path_Of
!      (Node : Project_Node_Id) return Name_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Value;
     end Extended_Project_Path_Of;
  
     --------------------------
     -- Extending_Project_Of --
     --------------------------
     function Extending_Project_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       return Project_Nodes.Table (Node).Field3;
     end Extending_Project_Of;
  
     ---------------------------
--- 618,647 ----
     ------------------------------
  
     function Extended_Project_Path_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Value;
     end Extended_Project_Path_Of;
  
     --------------------------
     -- Extending_Project_Of --
     --------------------------
     function Extending_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Extending_Project_Of;
  
     ---------------------------
*************** package body Prj.Tree is
*** 609,622 ****
     ---------------------------
  
     function External_Reference_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_External_Value);
!       return Project_Nodes.Table (Node).Field1;
     end External_Reference_Of;
  
     -------------------------
--- 649,663 ----
     ---------------------------
  
     function External_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end External_Reference_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 624,638 ****
     -------------------------
  
     function External_Default_Of
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_External_Value);
!       return Project_Nodes.Table (Node).Field2;
     end External_Default_Of;
  
     ------------------------
--- 665,680 ----
     -------------------------
  
     function External_Default_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end External_Default_Of;
  
     ------------------------
*************** package body Prj.Tree is
*** 640,653 ****
     ------------------------
  
     function First_Case_Item_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       return Project_Nodes.Table (Node).Field2;
     end First_Case_Item_Of;
  
     ---------------------
--- 682,696 ----
     ------------------------
  
     function First_Case_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end First_Case_Item_Of;
  
     ---------------------
*************** package body Prj.Tree is
*** 655,669 ****
     ---------------------
  
     function First_Choice_Of
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Item);
!       return Project_Nodes.Table (Node).Field1;
     end First_Choice_Of;
  
     -------------------------
--- 698,713 ----
     ---------------------
  
     function First_Choice_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end First_Choice_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 671,688 ****
     -------------------------
  
     function First_Comment_After
!      (Node : Project_Node_Id) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return Project_Nodes.Table (Zone).Field2;
        end if;
     end First_Comment_After;
  
--- 715,733 ----
     -------------------------
  
     function First_Comment_After
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return In_Tree.Project_Nodes.Table (Zone).Field2;
        end if;
     end First_Comment_After;
  
*************** package body Prj.Tree is
*** 691,710 ****
     -----------------------------
  
     function First_Comment_After_End
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return Project_Nodes.Table (Zone).Comments;
        end if;
     end First_Comment_After_End;
  
--- 736,756 ----
     -----------------------------
  
     function First_Comment_After_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return In_Tree.Project_Nodes.Table (Zone).Comments;
        end if;
     end First_Comment_After_End;
  
*************** package body Prj.Tree is
*** 713,731 ****
     --------------------------
  
     function First_Comment_Before
!      (Node : Project_Node_Id) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return Project_Nodes.Table (Zone).Field1;
        end if;
     end First_Comment_Before;
  
--- 759,778 ----
     --------------------------
  
     function First_Comment_Before
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return In_Tree.Project_Nodes.Table (Zone).Field1;
        end if;
     end First_Comment_Before;
  
*************** package body Prj.Tree is
*** 734,752 ****
     ------------------------------
  
     function First_Comment_Before_End
!      (Node : Project_Node_Id) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return Project_Nodes.Table (Zone).Field3;
        end if;
     end First_Comment_Before_End;
  
--- 781,800 ----
     ------------------------------
  
     function First_Comment_Before_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
        Zone : Project_Node_Id := Empty_Node;
  
     begin
        pragma Assert (Node /= Empty_Node);
!       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
  
        if Zone = Empty_Node then
           return Empty_Node;
  
        else
!          return In_Tree.Project_Nodes.Table (Zone).Field3;
        end if;
     end First_Comment_Before_End;
  
*************** package body Prj.Tree is
*** 755,776 ****
     -------------------------------
  
     function First_Declarative_Item_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Case_Item
                 or else
!              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
!          return Project_Nodes.Table (Node).Field1;
        else
!          return Project_Nodes.Table (Node).Field2;
        end if;
     end First_Declarative_Item_Of;
  
--- 803,825 ----
     -------------------------------
  
     function First_Declarative_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
!          return In_Tree.Project_Nodes.Table (Node).Field1;
        else
!          return In_Tree.Project_Nodes.Table (Node).Field2;
        end if;
     end First_Declarative_Item_Of;
  
*************** package body Prj.Tree is
*** 779,792 ****
     ------------------------------
  
     function First_Expression_In_List
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Literal_String_List);
!       return Project_Nodes.Table (Node).Field1;
     end First_Expression_In_List;
  
     --------------------------
--- 828,842 ----
     ------------------------------
  
     function First_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end First_Expression_In_List;
  
     --------------------------
*************** package body Prj.Tree is
*** 794,807 ****
     --------------------------
  
     function First_Literal_String
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
!       return Project_Nodes.Table (Node).Field1;
     end First_Literal_String;
  
     ----------------------
--- 844,859 ----
     --------------------------
  
     function First_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!          In_Tree.Project_Nodes.Table (Node).Kind =
!            N_String_Type_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end First_Literal_String;
  
     ----------------------
*************** package body Prj.Tree is
*** 809,822 ****
     ----------------------
  
     function First_Package_Of
!      (Node : Project_Node_Id) return Package_Declaration_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Packages;
     end First_Package_Of;
  
     --------------------------
--- 861,875 ----
     ----------------------
  
     function First_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Packages;
     end First_Package_Of;
  
     --------------------------
*************** package body Prj.Tree is
*** 824,837 ****
     --------------------------
  
     function First_String_Type_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Field3;
     end First_String_Type_Of;
  
     ----------------
--- 877,891 ----
     --------------------------
  
     function First_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end First_String_Type_Of;
  
     ----------------
*************** package body Prj.Tree is
*** 839,852 ****
     ----------------
  
     function First_Term
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Expression);
!       return Project_Nodes.Table (Node).Field1;
     end First_Term;
  
     -----------------------
--- 893,907 ----
     ----------------
  
     function First_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end First_Term;
  
     -----------------------
*************** package body Prj.Tree is
*** 854,870 ****
     -----------------------
  
     function First_Variable_Of
!      (Node : Project_Node_Id) return Variable_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       return Project_Nodes.Table (Node).Variables;
     end First_Variable_Of;
  
     --------------------------
--- 909,926 ----
     -----------------------
  
     function First_Variable_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       return In_Tree.Project_Nodes.Table (Node).Variables;
     end First_Variable_Of;
  
     --------------------------
*************** package body Prj.Tree is
*** 872,898 ****
     --------------------------
  
     function First_With_Clause_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Field1;
     end First_With_Clause_Of;
  
     ------------------------
     -- Follows_Empty_Line --
     ------------------------
  
!    function Follows_Empty_Line (Node : Project_Node_Id) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
           and then
!          Project_Nodes.Table (Node).Kind = N_Comment);
!       return Project_Nodes.Table (Node).Flag1;
     end Follows_Empty_Line;
  
     ----------
--- 928,957 ----
     --------------------------
  
     function First_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end First_With_Clause_Of;
  
     ------------------------
     -- Follows_Empty_Line --
     ------------------------
  
!    function Follows_Empty_Line
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
           and then
!          In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
!       return In_Tree.Project_Nodes.Table (Node).Flag1;
     end Follows_Empty_Line;
  
     ----------
*************** package body Prj.Tree is
*** 908,917 ****
     -- Initialize --
     ----------------
  
!    procedure Initialize is
     begin
!       Project_Nodes.Set_Last (Empty_Node);
!       Projects_Htable.Reset;
     end Initialize;
  
     -------------------------------
--- 967,976 ----
     -- Initialize --
     ----------------
  
!    procedure Initialize (Tree : Project_Node_Tree_Ref) is
     begin
!       Project_Node_Table.Init (Tree.Project_Nodes);
!       Projects_Htable.Reset (Tree.Projects_HT);
     end Initialize;
  
     -------------------------------
*************** package body Prj.Tree is
*** 919,958 ****
     -------------------------------
  
     function Is_Followed_By_Empty_Line
!      (Node : Project_Node_Id) return Boolean
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Comment);
!       return Project_Nodes.Table (Node).Flag2;
     end Is_Followed_By_Empty_Line;
  
     ----------------------
     -- Is_Extending_All --
     ----------------------
  
!    function Is_Extending_All (Node  : Project_Node_Id) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_Project
                or else
!             Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return Project_Nodes.Table (Node).Flag2;
     end Is_Extending_All;
  
     -------------------------------------
     -- Imported_Or_Extended_Project_Of --
     -------------------------------------
  
     function Imported_Or_Extended_Project_Of
       (Project   : Project_Node_Id;
        With_Name : Name_Id) return Project_Node_Id
     is
!       With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
        Result      : Project_Node_Id := Empty_Node;
  
     begin
--- 978,1037 ----
     -------------------------------
  
     function Is_Followed_By_Empty_Line
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
!       return In_Tree.Project_Nodes.Table (Node).Flag2;
     end Is_Followed_By_Empty_Line;
  
     ----------------------
     -- Is_Extending_All --
     ----------------------
  
!    function Is_Extending_All
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return In_Tree.Project_Nodes.Table (Node).Flag2;
     end Is_Extending_All;
  
+    -------------------------
+    -- Is_Not_Last_In_List --
+    -------------------------
+ 
+    function Is_Not_Last_In_List
+      (Node    : Project_Node_Id;
+       In_Tree : Project_Node_Tree_Ref) return Boolean is
+    begin
+       pragma Assert
+         (Node /= Empty_Node
+           and then
+             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+       return In_Tree.Project_Nodes.Table (Node).Flag1;
+    end Is_Not_Last_In_List;
+ 
     -------------------------------------
     -- Imported_Or_Extended_Project_Of --
     -------------------------------------
  
     function Imported_Or_Extended_Project_Of
       (Project   : Project_Node_Id;
+       In_Tree   : Project_Node_Tree_Ref;
        With_Name : Name_Id) return Project_Node_Id
     is
!       With_Clause : Project_Node_Id :=
!         First_With_Clause_Of (Project, In_Tree);
        Result      : Project_Node_Id := Empty_Node;
  
     begin
*************** package body Prj.Tree is
*** 963,980 ****
           --  Only non limited imported project may be used as prefix
           --  of variable or attributes.
  
!          Result := Non_Limited_Project_Node_Of (With_Clause);
!          exit when Result /= Empty_Node and then Name_Of (Result) = With_Name;
!          With_Clause := Next_With_Clause_Of (With_Clause);
        end loop;
  
        --  If it is not an imported project, it might be the imported project
  
        if With_Clause = Empty_Node then
!          Result := Extended_Project_Of (Project_Declaration_Of (Project));
  
           if Result /= Empty_Node
!            and then Name_Of (Result) /= With_Name
           then
              Result := Empty_Node;
           end if;
--- 1042,1062 ----
           --  Only non limited imported project may be used as prefix
           --  of variable or attributes.
  
!          Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
!          exit when Result /= Empty_Node
!            and then Name_Of (Result, In_Tree) = With_Name;
!          With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
        end loop;
  
        --  If it is not an imported project, it might be the imported project
  
        if With_Clause = Empty_Node then
!          Result :=
!            Extended_Project_Of
!              (Project_Declaration_Of (Project, In_Tree), In_Tree);
  
           if Result /= Empty_Node
!            and then Name_Of (Result, In_Tree) /= With_Name
           then
              Result := Empty_Node;
           end if;
*************** package body Prj.Tree is
*** 987,1016 ****
     -- Kind_Of --
     -------------
  
!    function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
     begin
        pragma Assert (Node /= Empty_Node);
!       return Project_Nodes.Table (Node).Kind;
     end Kind_Of;
  
     -----------------
     -- Location_Of --
     -----------------
  
!    function Location_Of (Node : Project_Node_Id) return Source_Ptr is
     begin
        pragma Assert (Node /= Empty_Node);
!       return Project_Nodes.Table (Node).Location;
     end Location_Of;
  
     -------------
     -- Name_Of --
     -------------
  
!    function Name_Of (Node : Project_Node_Id) return Name_Id is
     begin
        pragma Assert (Node /= Empty_Node);
!       return Project_Nodes.Table (Node).Name;
     end Name_Of;
  
     --------------------
--- 1069,1104 ----
     -- Kind_Of --
     -------------
  
!    function Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
     begin
        pragma Assert (Node /= Empty_Node);
!       return In_Tree.Project_Nodes.Table (Node).Kind;
     end Kind_Of;
  
     -----------------
     -- Location_Of --
     -----------------
  
!    function Location_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
     begin
        pragma Assert (Node /= Empty_Node);
!       return In_Tree.Project_Nodes.Table (Node).Location;
     end Location_Of;
  
     -------------
     -- Name_Of --
     -------------
  
!    function Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id is
     begin
        pragma Assert (Node /= Empty_Node);
!       return In_Tree.Project_Nodes.Table (Node).Name;
     end Name_Of;
  
     --------------------
*************** package body Prj.Tree is
*** 1018,1044 ****
     --------------------
  
     function Next_Case_Item
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Item);
!       return Project_Nodes.Table (Node).Field3;
     end Next_Case_Item;
  
     ------------------
     -- Next_Comment --
     ------------------
  
!    function Next_Comment (Node : Project_Node_Id) return Project_Node_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Comment);
!       return Project_Nodes.Table (Node).Comments;
     end Next_Comment;
  
     ---------------------------
--- 1106,1135 ----
     --------------------
  
     function Next_Case_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Next_Case_Item;
  
     ------------------
     -- Next_Comment --
     ------------------
  
!    function Next_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
!       return In_Tree.Project_Nodes.Table (Node).Comments;
     end Next_Comment;
  
     ---------------------------
*************** package body Prj.Tree is
*** 1046,1059 ****
     ---------------------------
  
     function Next_Declarative_Item
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       return Project_Nodes.Table (Node).Field2;
     end Next_Declarative_Item;
  
     -----------------------------
--- 1137,1151 ----
     ---------------------------
  
     function Next_Declarative_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Next_Declarative_Item;
  
     -----------------------------
*************** package body Prj.Tree is
*** 1061,1074 ****
     -----------------------------
  
     function Next_Expression_In_List
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Expression);
!       return Project_Nodes.Table (Node).Field2;
     end Next_Expression_In_List;
  
     -------------------------
--- 1153,1167 ----
     -----------------------------
  
     function Next_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Next_Expression_In_List;
  
     -------------------------
*************** package body Prj.Tree is
*** 1076,1090 ****
     -------------------------
  
     function Next_Literal_String
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Literal_String);
!       return Project_Nodes.Table (Node).Field1;
     end Next_Literal_String;
  
     -----------------------------
--- 1169,1184 ----
     -------------------------
  
     function Next_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Next_Literal_String;
  
     -----------------------------
*************** package body Prj.Tree is
*** 1092,1105 ****
     -----------------------------
  
     function Next_Package_In_Project
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return Project_Nodes.Table (Node).Field3;
     end Next_Package_In_Project;
  
     ----------------------
--- 1186,1200 ----
     -----------------------------
  
     function Next_Package_In_Project
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Next_Package_In_Project;
  
     ----------------------
*************** package body Prj.Tree is
*** 1107,1121 ****
     ----------------------
  
     function Next_String_Type
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
!       return Project_Nodes.Table (Node).Field2;
     end Next_String_Type;
  
     ---------------
--- 1202,1218 ----
     ----------------------
  
     function Next_String_Type
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!          In_Tree.Project_Nodes.Table (Node).Kind =
!            N_String_Type_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Next_String_Type;
  
     ---------------
*************** package body Prj.Tree is
*** 1123,1136 ****
     ---------------
  
     function Next_Term
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Term);
!       return Project_Nodes.Table (Node).Field2;
     end Next_Term;
  
     -------------------
--- 1220,1234 ----
     ---------------
  
     function Next_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Next_Term;
  
     -------------------
*************** package body Prj.Tree is
*** 1138,1155 ****
     -------------------
  
     function Next_Variable
!      (Node : Project_Node_Id)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
  
!       return Project_Nodes.Table (Node).Field3;
     end Next_Variable;
  
     -------------------------
--- 1236,1256 ----
     -------------------
  
     function Next_Variable
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Declaration));
  
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Next_Variable;
  
     -------------------------
*************** package body Prj.Tree is
*** 1157,1170 ****
     -------------------------
  
     function Next_With_Clause_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_With_Clause);
!       return Project_Nodes.Table (Node).Field2;
     end Next_With_Clause_Of;
  
     ---------------------------------
--- 1258,1272 ----
     -------------------------
  
     function Next_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Next_With_Clause_Of;
  
     ---------------------------------
*************** package body Prj.Tree is
*** 1172,1198 ****
     ---------------------------------
  
     function Non_Limited_Project_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return Project_Nodes.Table (Node).Field3;
     end Non_Limited_Project_Node_Of;
  
     -------------------
     -- Package_Id_Of --
     -------------------
  
!    function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return Project_Nodes.Table (Node).Pkg_Id;
     end Package_Id_Of;
  
     ---------------------
--- 1274,1304 ----
     ---------------------------------
  
     function Non_Limited_Project_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return In_Tree.Project_Nodes.Table (Node).Field3;
     end Non_Limited_Project_Node_Of;
  
     -------------------
     -- Package_Id_Of --
     -------------------
  
!    function Package_Id_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
     end Package_Id_Of;
  
     ---------------------
*************** package body Prj.Tree is
*** 1200,1230 ****
     ---------------------
  
     function Package_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return Project_Nodes.Table (Node).Field2;
     end Package_Node_Of;
  
     ------------------
     -- Path_Name_Of --
     ------------------
  
!    function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return Project_Nodes.Table (Node).Path_Name;
     end Path_Name_Of;
  
     ----------------------------
--- 1306,1340 ----
     ---------------------
  
     function Package_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Package_Node_Of;
  
     ------------------
     -- Path_Name_Of --
     ------------------
  
!    function Path_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
!       return In_Tree.Project_Nodes.Table (Node).Path_Name;
     end Path_Name_Of;
  
     ----------------------------
*************** package body Prj.Tree is
*** 1232,1245 ****
     ----------------------------
  
     function Project_Declaration_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       return Project_Nodes.Table (Node).Field2;
     end Project_Declaration_Of;
  
     -------------------------------------------
--- 1342,1356 ----
     ----------------------------
  
     function Project_Declaration_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       return In_Tree.Project_Nodes.Table (Node).Field2;
     end Project_Declaration_Of;
  
     -------------------------------------------
*************** package body Prj.Tree is
*** 1247,1257 ****
     -------------------------------------------
  
     function Project_File_Includes_Unkept_Comments
!      (Node : Project_Node_Id) return Boolean
     is
!       Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
     begin
!       return Project_Nodes.Table (Declaration).Flag1;
     end Project_File_Includes_Unkept_Comments;
  
     ---------------------
--- 1358,1370 ----
     -------------------------------------------
  
     function Project_File_Includes_Unkept_Comments
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean
     is
!       Declaration : constant Project_Node_Id :=
!                       Project_Declaration_Of (Node, In_Tree);
     begin
!       return In_Tree.Project_Nodes.Table (Declaration).Flag1;
     end Project_File_Includes_Unkept_Comments;
  
     ---------------------
*************** package body Prj.Tree is
*** 1259,1276 ****
     ---------------------
  
     function Project_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_With_Clause
                or else
!             Project_Nodes.Table (Node).Kind = N_Variable_Reference
                or else
!             Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return Project_Nodes.Table (Node).Field1;
     end Project_Node_Of;
  
     -----------------------------------
--- 1372,1390 ----
     ---------------------
  
     function Project_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
                or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Project_Node_Of;
  
     -----------------------------------
*************** package body Prj.Tree is
*** 1278,1291 ****
     -----------------------------------
  
     function Project_Of_Renamed_Package_Of
!      (Node : Project_Node_Id) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return Project_Nodes.Table (Node).Field1;
     end Project_Of_Renamed_Package_Of;
  
     --------------------------
--- 1392,1406 ----
     -----------------------------------
  
     function Project_Of_Renamed_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       return In_Tree.Project_Nodes.Table (Node).Field1;
     end Project_Of_Renamed_Package_Of;
  
     --------------------------
*************** package body Prj.Tree is
*** 1354,1361 ****
     -- Scan --
     ----------
  
!    procedure Scan is
        Empty_Line : Boolean := False;
     begin
        --  If there are comments, then they will not be kept. Set the flag and
        --  clear the comments.
--- 1469,1477 ----
     -- Scan --
     ----------
  
!    procedure Scan (In_Tree : Project_Node_Tree_Ref) is
        Empty_Line : Boolean := False;
+ 
     begin
        --  If there are comments, then they will not be kept. Set the flag and
        --  clear the comments.
*************** package body Prj.Tree is
*** 1400,1408 ****
                 elsif End_Of_Line_Node /= Empty_Node then
                    declare
                       Zones : constant Project_Node_Id :=
!                                Comment_Zones_Of (End_Of_Line_Node);
                    begin
!                      Project_Nodes.Table (Zones).Value := Comment_Id;
                    end;
  
                 --  Otherwise, this end of line node cannot be kept
--- 1516,1524 ----
                 elsif End_Of_Line_Node /= Empty_Node then
                    declare
                       Zones : constant Project_Node_Id :=
!                                Comment_Zones_Of (End_Of_Line_Node, In_Tree);
                    begin
!                      In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
                    end;
  
                 --  Otherwise, this end of line node cannot be kept
*************** package body Prj.Tree is
*** 1424,1434 ****
                   not Comments.Table (1).Follows_Empty_Line then
                    if Previous_Line_Node /= Empty_Node then
                       Add_Comments
!                        (To => Previous_Line_Node, Where => After);
  
                    elsif Previous_End_Node /= Empty_Node then
                       Add_Comments
!                        (To => Previous_End_Node, Where => After_End);
                    end if;
                 end if;
  
--- 1540,1554 ----
                   not Comments.Table (1).Follows_Empty_Line then
                    if Previous_Line_Node /= Empty_Node then
                       Add_Comments
!                        (To      => Previous_Line_Node,
!                         Where   => After,
!                         In_Tree => In_Tree);
  
                    elsif Previous_End_Node /= Empty_Node then
                       Add_Comments
!                        (To      => Previous_End_Node,
!                         Where   => After_End,
!                         In_Tree => In_Tree);
                    end if;
                 end if;
  
*************** package body Prj.Tree is
*** 1440,1447 ****
                 if Comments.Last > 0 and then Token = Tok_End then
                    if Next_End_Nodes.Last > 0 then
                       Add_Comments
!                        (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
!                         Where => Before_End);
  
                    else
                       Unkept_Comments := True;
--- 1560,1568 ----
                 if Comments.Last > 0 and then Token = Tok_End then
                    if Next_End_Nodes.Last > 0 then
                       Add_Comments
!                        (To      => Next_End_Nodes.Table (Next_End_Nodes.Last),
!                         Where   => Before_End,
!                         In_Tree => In_Tree);
  
                    else
                       Unkept_Comments := True;
*************** package body Prj.Tree is
*** 1469,1485 ****
     ------------------------------------
  
     procedure Set_Associative_Array_Index_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       Project_Nodes.Table (Node).Value := To;
     end Set_Associative_Array_Index_Of;
  
     --------------------------------
--- 1590,1607 ----
     ------------------------------------
  
     procedure Set_Associative_Array_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       In_Tree.Project_Nodes.Table (Node).Value := To;
     end Set_Associative_Array_Index_Of;
  
     --------------------------------
*************** package body Prj.Tree is
*** 1487,1501 ****
     --------------------------------
  
     procedure Set_Associative_Package_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
           (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_Associative_Package_Of;
  
     --------------------------------
--- 1609,1624 ----
     --------------------------------
  
     procedure Set_Associative_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
           (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_Associative_Package_Of;
  
     --------------------------------
*************** package body Prj.Tree is
*** 1503,1517 ****
     --------------------------------
  
     procedure Set_Associative_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Associative_Project_Of;
  
     --------------------------
--- 1626,1642 ----
     --------------------------------
  
     procedure Set_Associative_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Attribute_Declaration));
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Associative_Project_Of;
  
     --------------------------
*************** package body Prj.Tree is
*** 1519,1535 ****
     --------------------------
  
     procedure Set_Case_Insensitive
!      (Node : Project_Node_Id;
!       To   : Boolean)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!             Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       Project_Nodes.Table (Node).Flag1 := To;
     end Set_Case_Insensitive;
  
     ------------------------------------
--- 1644,1661 ----
     --------------------------
  
     procedure Set_Case_Insensitive
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Boolean)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       In_Tree.Project_Nodes.Table (Node).Flag1 := To;
     end Set_Case_Insensitive;
  
     ------------------------------------
*************** package body Prj.Tree is
*** 1537,1551 ****
     ------------------------------------
  
     procedure Set_Case_Variable_Reference_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Case_Variable_Reference_Of;
  
     ---------------------------
--- 1663,1678 ----
     ------------------------------------
  
     procedure Set_Case_Variable_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Case_Variable_Reference_Of;
  
     ---------------------------
*************** package body Prj.Tree is
*** 1553,1567 ****
     ---------------------------
  
     procedure Set_Current_Item_Node
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Current_Item_Node;
  
     ----------------------
--- 1680,1695 ----
     ---------------------------
  
     procedure Set_Current_Item_Node
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Current_Item_Node;
  
     ----------------------
*************** package body Prj.Tree is
*** 1569,1583 ****
     ----------------------
  
     procedure Set_Current_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Term);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Current_Term;
  
     ----------------------
--- 1697,1712 ----
     ----------------------
  
     procedure Set_Current_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Current_Term;
  
     ----------------------
*************** package body Prj.Tree is
*** 1585,1599 ****
     ----------------------
  
     procedure Set_Directory_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Directory := To;
     end Set_Directory_Of;
  
     ---------------------
--- 1714,1729 ----
     ----------------------
  
     procedure Set_Directory_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Directory := To;
     end Set_Directory_Of;
  
     ---------------------
*************** package body Prj.Tree is
*** 1610,1640 ****
     ----------------------------
  
     procedure Set_Expression_Kind_Of
!      (Node : Project_Node_Id;
!       To   : Variable_Kind)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
             and then
!              (Project_Nodes.Table (Node).Kind = N_Literal_String
                  or else
!               Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Package_Declaration
                  or else
!               Project_Nodes.Table (Node).Kind = N_Expression
                  or else
!               Project_Nodes.Table (Node).Kind = N_Term
                  or else
!               Project_Nodes.Table (Node).Kind = N_Variable_Reference
                  or else
!               Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       Project_Nodes.Table (Node).Expr_Kind := To;
     end Set_Expression_Kind_Of;
  
     -----------------------
--- 1740,1773 ----
     ----------------------------
  
     procedure Set_Expression_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Variable_Kind)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
             and then
!              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind =
!                 N_Typed_Variable_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                  or else
!               In_Tree.Project_Nodes.Table (Node).Kind =
!                 N_Attribute_Reference));
!       In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
     end Set_Expression_Kind_Of;
  
     -----------------------
*************** package body Prj.Tree is
*** 1642,1660 ****
     -----------------------
  
     procedure Set_Expression_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Expression_Of;
  
     -------------------------------
--- 1775,1797 ----
     -----------------------
  
     procedure Set_Expression_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Attribute_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Declaration));
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Expression_Of;
  
     -------------------------------
*************** package body Prj.Tree is
*** 1662,1676 ****
     -------------------------------
  
     procedure Set_External_Reference_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_External_Value);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_External_Reference_Of;
  
     -----------------------------
--- 1799,1814 ----
     -------------------------------
  
     procedure Set_External_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_External_Reference_Of;
  
     -----------------------------
*************** package body Prj.Tree is
*** 1678,1692 ****
     -----------------------------
  
     procedure Set_External_Default_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_External_Value);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_External_Default_Of;
  
     ----------------------------
--- 1816,1831 ----
     -----------------------------
  
     procedure Set_External_Default_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_External_Default_Of;
  
     ----------------------------
*************** package body Prj.Tree is
*** 1694,1708 ****
     ----------------------------
  
     procedure Set_First_Case_Item_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_First_Case_Item_Of;
  
     -------------------------
--- 1833,1848 ----
     ----------------------------
  
     procedure Set_First_Case_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_First_Case_Item_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 1710,1724 ****
     -------------------------
  
     procedure Set_First_Choice_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Item);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Choice_Of;
  
     -----------------------------
--- 1850,1865 ----
     -------------------------
  
     procedure Set_First_Choice_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Choice_Of;
  
     -----------------------------
*************** package body Prj.Tree is
*** 1726,1737 ****
     -----------------------------
  
     procedure Set_First_Comment_After
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
     begin
!       Project_Nodes.Table (Zone).Field2 := To;
     end Set_First_Comment_After;
  
     ---------------------------------
--- 1867,1879 ----
     -----------------------------
  
     procedure Set_First_Comment_After
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
     begin
!       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
     end Set_First_Comment_After;
  
     ---------------------------------
*************** package body Prj.Tree is
*** 1739,1750 ****
     ---------------------------------
  
     procedure Set_First_Comment_After_End
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
     begin
!       Project_Nodes.Table (Zone).Comments := To;
     end Set_First_Comment_After_End;
  
     ------------------------------
--- 1881,1893 ----
     ---------------------------------
  
     procedure Set_First_Comment_After_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
     begin
!       In_Tree.Project_Nodes.Table (Zone).Comments := To;
     end Set_First_Comment_After_End;
  
     ------------------------------
*************** package body Prj.Tree is
*** 1752,1764 ****
     ------------------------------
  
     procedure Set_First_Comment_Before
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
  
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
     begin
!       Project_Nodes.Table (Zone).Field1 := To;
     end Set_First_Comment_Before;
  
     ----------------------------------
--- 1895,1908 ----
     ------------------------------
  
     procedure Set_First_Comment_Before
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
  
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
     begin
!       In_Tree.Project_Nodes.Table (Zone).Field1 := To;
     end Set_First_Comment_Before;
  
     ----------------------------------
*************** package body Prj.Tree is
*** 1766,1777 ****
     ----------------------------------
  
     procedure Set_First_Comment_Before_End
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
     begin
!       Project_Nodes.Table (Zone).Field2 := To;
     end Set_First_Comment_Before_End;
  
     ------------------------
--- 1910,1922 ----
     ----------------------------------
  
     procedure Set_First_Comment_Before_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
!       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
     begin
!       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
     end Set_First_Comment_Before_End;
  
     ------------------------
*************** package body Prj.Tree is
*** 1779,1793 ****
     ------------------------
  
     procedure Set_Next_Case_Item
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Case_Item);
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Case_Item;
  
     ----------------------
--- 1924,1939 ----
     ------------------------
  
     procedure Set_Next_Case_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Case_Item;
  
     ----------------------
*************** package body Prj.Tree is
*** 1795,1809 ****
     ----------------------
  
     procedure Set_Next_Comment
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Comment);
!       Project_Nodes.Table (Node).Comments := To;
     end Set_Next_Comment;
  
     -----------------------------------
--- 1941,1956 ----
     ----------------------
  
     procedure Set_Next_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
!       In_Tree.Project_Nodes.Table (Node).Comments := To;
     end Set_Next_Comment;
  
     -----------------------------------
*************** package body Prj.Tree is
*** 1811,1833 ****
     -----------------------------------
  
     procedure Set_First_Declarative_Item_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Case_Item
                 or else
!              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
!          Project_Nodes.Table (Node).Field1 := To;
        else
!          Project_Nodes.Table (Node).Field2 := To;
        end if;
     end Set_First_Declarative_Item_Of;
  
--- 1958,1981 ----
     -----------------------------------
  
     procedure Set_First_Declarative_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
  
!       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
!          In_Tree.Project_Nodes.Table (Node).Field1 := To;
        else
!          In_Tree.Project_Nodes.Table (Node).Field2 := To;
        end if;
     end Set_First_Declarative_Item_Of;
  
*************** package body Prj.Tree is
*** 1836,1850 ****
     ----------------------------------
  
     procedure Set_First_Expression_In_List
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Literal_String_List);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Expression_In_List;
  
     ------------------------------
--- 1984,1999 ----
     ----------------------------------
  
     procedure Set_First_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Expression_In_List;
  
     ------------------------------
*************** package body Prj.Tree is
*** 1852,1866 ****
     ------------------------------
  
     procedure Set_First_Literal_String
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Literal_String;
  
     --------------------------
--- 2001,2017 ----
     ------------------------------
  
     procedure Set_First_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!          In_Tree.Project_Nodes.Table (Node).Kind =
!            N_String_Type_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Literal_String;
  
     --------------------------
*************** package body Prj.Tree is
*** 1868,1882 ****
     --------------------------
  
     procedure Set_First_Package_Of
!      (Node : Project_Node_Id;
!       To   : Package_Declaration_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Packages := To;
     end Set_First_Package_Of;
  
     ------------------------------
--- 2019,2034 ----
     --------------------------
  
     procedure Set_First_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Package_Declaration_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Packages := To;
     end Set_First_Package_Of;
  
     ------------------------------
*************** package body Prj.Tree is
*** 1884,1898 ****
     ------------------------------
  
     procedure Set_First_String_Type_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_First_String_Type_Of;
  
     --------------------
--- 2036,2051 ----
     ------------------------------
  
     procedure Set_First_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_First_String_Type_Of;
  
     --------------------
*************** package body Prj.Tree is
*** 1900,1914 ****
     --------------------
  
     procedure Set_First_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Expression);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Term;
  
     ---------------------------
--- 2053,2068 ----
     --------------------
  
     procedure Set_First_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_First_Term;
  
     ---------------------------
*************** package body Prj.Tree is
*** 1916,1932 ****
     ---------------------------
  
     procedure Set_First_Variable_Of
!      (Node : Project_Node_Id;
!       To   : Variable_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
!       Project_Nodes.Table (Node).Variables := To;
     end Set_First_Variable_Of;
  
     ------------------------------
--- 2070,2087 ----
     ---------------------------
  
     procedure Set_First_Variable_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Variable_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
!       In_Tree.Project_Nodes.Table (Node).Variables := To;
     end Set_First_Variable_Of;
  
     ------------------------------
*************** package body Prj.Tree is
*** 1934,1976 ****
     ------------------------------
  
     procedure Set_First_With_Clause_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_First_With_Clause_Of;
  
     --------------------------
     -- Set_Is_Extending_All --
     --------------------------
  
!    procedure Set_Is_Extending_All (Node  : Project_Node_Id) is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              Project_Nodes.Table (Node).Kind = N_With_Clause));
!       Project_Nodes.Table (Node).Flag2 := True;
     end Set_Is_Extending_All;
  
     -----------------
     -- Set_Kind_Of --
     -----------------
  
     procedure Set_Kind_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Kind)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       Project_Nodes.Table (Node).Kind := To;
     end Set_Kind_Of;
  
     ---------------------
--- 2089,2152 ----
     ------------------------------
  
     procedure Set_First_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_First_With_Clause_Of;
  
     --------------------------
     -- Set_Is_Extending_All --
     --------------------------
  
!    procedure Set_Is_Extending_All
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
!       In_Tree.Project_Nodes.Table (Node).Flag2 := True;
     end Set_Is_Extending_All;
  
+    -----------------------------
+    -- Set_Is_Not_Last_In_List --
+    -----------------------------
+ 
+    procedure Set_Is_Not_Last_In_List
+      (Node    : Project_Node_Id;
+       In_Tree : Project_Node_Tree_Ref)
+    is
+    begin
+       pragma Assert
+         (Node /= Empty_Node
+           and then
+              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+       In_Tree.Project_Nodes.Table (Node).Flag1 := True;
+    end Set_Is_Not_Last_In_List;
+ 
     -----------------
     -- Set_Kind_Of --
     -----------------
  
     procedure Set_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Kind)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       In_Tree.Project_Nodes.Table (Node).Kind := To;
     end Set_Kind_Of;
  
     ---------------------
*************** package body Prj.Tree is
*** 1978,1989 ****
     ---------------------
  
     procedure Set_Location_Of
!      (Node : Project_Node_Id;
!       To   : Source_Ptr)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       Project_Nodes.Table (Node).Location := To;
     end Set_Location_Of;
  
     -----------------------------
--- 2154,2166 ----
     ---------------------
  
     procedure Set_Location_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Source_Ptr)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       In_Tree.Project_Nodes.Table (Node).Location := To;
     end Set_Location_Of;
  
     -----------------------------
*************** package body Prj.Tree is
*** 1991,2005 ****
     -----------------------------
  
     procedure Set_Extended_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Extended_Project_Of;
  
     ----------------------------------
--- 2168,2183 ----
     -----------------------------
  
     procedure Set_Extended_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Extended_Project_Of;
  
     ----------------------------------
*************** package body Prj.Tree is
*** 2007,2021 ****
     ----------------------------------
  
     procedure Set_Extended_Project_Path_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Value := To;
     end Set_Extended_Project_Path_Of;
  
     ------------------------------
--- 2185,2200 ----
     ----------------------------------
  
     procedure Set_Extended_Project_Path_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Value := To;
     end Set_Extended_Project_Path_Of;
  
     ------------------------------
*************** package body Prj.Tree is
*** 2023,2037 ****
     ------------------------------
  
     procedure Set_Extending_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_Extending_Project_Of;
  
     -----------------
--- 2202,2217 ----
     ------------------------------
  
     procedure Set_Extending_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_Extending_Project_Of;
  
     -----------------
*************** package body Prj.Tree is
*** 2039,2050 ****
     -----------------
  
     procedure Set_Name_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       Project_Nodes.Table (Node).Name := To;
     end Set_Name_Of;
  
     -------------------------------
--- 2219,2231 ----
     -----------------
  
     procedure Set_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert (Node /= Empty_Node);
!       In_Tree.Project_Nodes.Table (Node).Name := To;
     end Set_Name_Of;
  
     -------------------------------
*************** package body Prj.Tree is
*** 2052,2066 ****
     -------------------------------
  
     procedure Set_Next_Declarative_Item
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Declarative_Item;
  
     -----------------------
--- 2233,2248 ----
     -------------------------------
  
     procedure Set_Next_Declarative_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Declarative_Item;
  
     -----------------------
*************** package body Prj.Tree is
*** 2078,2092 ****
     ---------------------------------
  
     procedure Set_Next_Expression_In_List
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Expression);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Expression_In_List;
  
     -----------------------------
--- 2260,2275 ----
     ---------------------------------
  
     procedure Set_Next_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Expression_In_List;
  
     -----------------------------
*************** package body Prj.Tree is
*** 2094,2108 ****
     -----------------------------
  
     procedure Set_Next_Literal_String
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Literal_String);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Next_Literal_String;
  
     ---------------------------------
--- 2277,2292 ----
     -----------------------------
  
     procedure Set_Next_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Next_Literal_String;
  
     ---------------------------------
*************** package body Prj.Tree is
*** 2110,2124 ****
     ---------------------------------
  
     procedure Set_Next_Package_In_Project
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Package_In_Project;
  
     --------------------------
--- 2294,2309 ----
     ---------------------------------
  
     procedure Set_Next_Package_In_Project
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Package_In_Project;
  
     --------------------------
*************** package body Prj.Tree is
*** 2126,2140 ****
     --------------------------
  
     procedure Set_Next_String_Type
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_String_Type;
  
     -------------------
--- 2311,2327 ----
     --------------------------
  
     procedure Set_Next_String_Type
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!          In_Tree.Project_Nodes.Table (Node).Kind =
!            N_String_Type_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_String_Type;
  
     -------------------
*************** package body Prj.Tree is
*** 2142,2156 ****
     -------------------
  
     procedure Set_Next_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Term);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Term;
  
     -----------------------
--- 2329,2344 ----
     -------------------
  
     procedure Set_Next_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_Term;
  
     -----------------------
*************** package body Prj.Tree is
*** 2158,2174 ****
     -----------------------
  
     procedure Set_Next_Variable
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
                 or else
!              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
!       Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Variable;
  
     -----------------------------
--- 2346,2365 ----
     -----------------------
  
     procedure Set_Next_Variable
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Declaration));
!       In_Tree.Project_Nodes.Table (Node).Field3 := To;
     end Set_Next_Variable;
  
     -----------------------------
*************** package body Prj.Tree is
*** 2176,2190 ****
     -----------------------------
  
     procedure Set_Next_With_Clause_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_With_Clause);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_With_Clause_Of;
  
     -----------------------
--- 2367,2382 ----
     -----------------------------
  
     procedure Set_Next_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Next_With_Clause_Of;
  
     -----------------------
*************** package body Prj.Tree is
*** 2192,2206 ****
     -----------------------
  
     procedure Set_Package_Id_Of
!      (Node : Project_Node_Id;
!       To   : Package_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       Project_Nodes.Table (Node).Pkg_Id := To;
     end Set_Package_Id_Of;
  
     -------------------------
--- 2384,2399 ----
     -----------------------
  
     procedure Set_Package_Id_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Package_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
     end Set_Package_Id_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 2208,2224 ****
     -------------------------
  
     procedure Set_Package_Node_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Package_Node_Of;
  
     ----------------------
--- 2401,2418 ----
     -------------------------
  
     procedure Set_Package_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Package_Node_Of;
  
     ----------------------
*************** package body Prj.Tree is
*** 2226,2242 ****
     ----------------------
  
     procedure Set_Path_Name_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              Project_Nodes.Table (Node).Kind = N_With_Clause));
!       Project_Nodes.Table (Node).Path_Name := To;
     end Set_Path_Name_Of;
  
     ---------------------------
--- 2420,2437 ----
     ----------------------
  
     procedure Set_Path_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
!       In_Tree.Project_Nodes.Table (Node).Path_Name := To;
     end Set_Path_Name_Of;
  
     ---------------------------
*************** package body Prj.Tree is
*** 2261,2275 ****
     --------------------------------
  
     procedure Set_Project_Declaration_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
           and then
!            Project_Nodes.Table (Node).Kind = N_Project);
!       Project_Nodes.Table (Node).Field2 := To;
     end Set_Project_Declaration_Of;
  
     -----------------------------------------------
--- 2456,2471 ----
     --------------------------------
  
     procedure Set_Project_Declaration_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
           and then
!            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
!       In_Tree.Project_Nodes.Table (Node).Field2 := To;
     end Set_Project_Declaration_Of;
  
     -----------------------------------------------
*************** package body Prj.Tree is
*** 2277,2288 ****
     -----------------------------------------------
  
     procedure Set_Project_File_Includes_Unkept_Comments
!      (Node : Project_Node_Id;
!       To   : Boolean)
     is
!       Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
     begin
!       Project_Nodes.Table (Declaration).Flag1 := To;
     end Set_Project_File_Includes_Unkept_Comments;
  
     -------------------------
--- 2473,2486 ----
     -----------------------------------------------
  
     procedure Set_Project_File_Includes_Unkept_Comments
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Boolean)
     is
!       Declaration : constant Project_Node_Id :=
!                       Project_Declaration_Of (Node, In_Tree);
     begin
!       In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
     end Set_Project_File_Includes_Unkept_Comments;
  
     -------------------------
*************** package body Prj.Tree is
*** 2291,2296 ****
--- 2489,2495 ----
  
     procedure Set_Project_Node_Of
       (Node         : Project_Node_Id;
+       In_Tree      : Project_Node_Tree_Ref;
        To           : Project_Node_Id;
        Limited_With : Boolean := False)
     is
*************** package body Prj.Tree is
*** 2298,2314 ****
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_With_Clause
                 or else
!              Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       Project_Nodes.Table (Node).Field1 := To;
  
!       if Project_Nodes.Table (Node).Kind = N_With_Clause
          and then not Limited_With
        then
!          Project_Nodes.Table (Node).Field3 := To;
        end if;
     end Set_Project_Node_Of;
  
--- 2497,2513 ----
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
  
!       if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
          and then not Limited_With
        then
!          In_Tree.Project_Nodes.Table (Node).Field3 := To;
        end if;
     end Set_Project_Node_Of;
  
*************** package body Prj.Tree is
*** 2317,2331 ****
     ---------------------------------------
  
     procedure Set_Project_Of_Renamed_Package_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       Project_Nodes.Table (Node).Field1 := To;
     end Set_Project_Of_Renamed_Package_Of;
  
     -------------------------
--- 2516,2531 ----
     ---------------------------------------
  
     procedure Set_Project_Of_Renamed_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
!       In_Tree.Project_Nodes.Table (Node).Field1 := To;
     end Set_Project_Of_Renamed_Package_Of;
  
     -------------------------
*************** package body Prj.Tree is
*** 2333,2349 ****
     -------------------------
  
     procedure Set_Source_Index_Of
!      (Node : Project_Node_Id;
!       To   : Int)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_Literal_String
              or else
!             Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       Project_Nodes.Table (Node).Src_Index := To;
     end Set_Source_Index_Of;
  
     ------------------------
--- 2533,2551 ----
     -------------------------
  
     procedure Set_Source_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Int)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
              or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Attribute_Declaration));
!       In_Tree.Project_Nodes.Table (Node).Src_Index := To;
     end Set_Source_Index_Of;
  
     ------------------------
*************** package body Prj.Tree is
*** 2351,2373 ****
     ------------------------
  
     procedure Set_String_Type_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
            and then
!             Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
  
!       if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
!          Project_Nodes.Table (Node).Field3 := To;
        else
!          Project_Nodes.Table (Node).Field2 := To;
        end if;
     end Set_String_Type_Of;
  
--- 2553,2578 ----
     ------------------------
  
     procedure Set_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Reference
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration)
            and then
!             In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
  
!       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
!          In_Tree.Project_Nodes.Table (Node).Field3 := To;
        else
!          In_Tree.Project_Nodes.Table (Node).Field2 := To;
        end if;
     end Set_String_Type_Of;
  
*************** package body Prj.Tree is
*** 2376,2428 ****
     -------------------------
  
     procedure Set_String_Value_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_With_Clause
                 or else
!              Project_Nodes.Table (Node).Kind = N_Comment
                 or else
!              Project_Nodes.Table (Node).Kind = N_Literal_String));
!       Project_Nodes.Table (Node).Value := To;
     end Set_String_Value_Of;
  
     ---------------------
     -- Source_Index_Of --
     ---------------------
  
!    function Source_Index_Of (Node : Project_Node_Id) return Int is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Literal_String
                or else
!              Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
!       return Project_Nodes.Table (Node).Src_Index;
     end Source_Index_Of;
  
     --------------------
     -- String_Type_Of --
     --------------------
  
!    function String_Type_Of (Node : Project_Node_Id) return Project_Node_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
                 or else
!              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
  
!       if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
!          return Project_Nodes.Table (Node).Field3;
        else
!          return Project_Nodes.Table (Node).Field2;
        end if;
     end String_Type_Of;
  
--- 2581,2643 ----
     -------------------------
  
     procedure Set_String_Value_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id)
     is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
                 or else
!              In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
!       In_Tree.Project_Nodes.Table (Node).Value := To;
     end Set_String_Value_Of;
  
     ---------------------
     -- Source_Index_Of --
     ---------------------
  
!    function Source_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Int
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
                or else
!              In_Tree.Project_Nodes.Table (Node).Kind =
!                N_Attribute_Declaration));
!       return In_Tree.Project_Nodes.Table (Node).Src_Index;
     end Source_Index_Of;
  
     --------------------
     -- String_Type_Of --
     --------------------
  
!    function String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Variable_Reference
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind =
!               N_Typed_Variable_Declaration));
  
!       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
!          return In_Tree.Project_Nodes.Table (Node).Field3;
        else
!          return In_Tree.Project_Nodes.Table (Node).Field2;
        end if;
     end String_Type_Of;
  
*************** package body Prj.Tree is
*** 2430,2446 ****
     -- String_Value_Of --
     ---------------------
  
!    function String_Value_Of (Node : Project_Node_Id) return Name_Id is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (Project_Nodes.Table (Node).Kind = N_With_Clause
                or else
!             Project_Nodes.Table (Node).Kind = N_Comment
                 or else
!             Project_Nodes.Table (Node).Kind = N_Literal_String));
!       return Project_Nodes.Table (Node).Value;
     end String_Value_Of;
  
     --------------------
--- 2645,2664 ----
     -- String_Value_Of --
     ---------------------
  
!    function String_Value_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id
!    is
     begin
        pragma Assert
          (Node /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
                or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
                 or else
!             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
!       return In_Tree.Project_Nodes.Table (Node).Value;
     end String_Value_Of;
  
     --------------------
*************** package body Prj.Tree is
*** 2449,2475 ****
  
     function Value_Is_Valid
       (For_Typed_Variable : Project_Node_Id;
        Value              : Name_Id) return Boolean
     is
     begin
        pragma Assert
          (For_Typed_Variable /= Empty_Node
            and then
!            (Project_Nodes.Table (For_Typed_Variable).Kind =
                                       N_Typed_Variable_Declaration));
  
        declare
           Current_String : Project_Node_Id :=
                              First_Literal_String
!                               (String_Type_Of (For_Typed_Variable));
  
        begin
           while Current_String /= Empty_Node
             and then
!              String_Value_Of (Current_String) /= Value
           loop
              Current_String :=
!               Next_Literal_String (Current_String);
           end loop;
  
           return Current_String /= Empty_Node;
--- 2667,2695 ----
  
     function Value_Is_Valid
       (For_Typed_Variable : Project_Node_Id;
+       In_Tree            : Project_Node_Tree_Ref;
        Value              : Name_Id) return Boolean
     is
     begin
        pragma Assert
          (For_Typed_Variable /= Empty_Node
            and then
!            (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
                                       N_Typed_Variable_Declaration));
  
        declare
           Current_String : Project_Node_Id :=
                              First_Literal_String
!                               (String_Type_Of (For_Typed_Variable, In_Tree),
!                                In_Tree);
  
        begin
           while Current_String /= Empty_Node
             and then
!              String_Value_Of (Current_String, In_Tree) /= Value
           loop
              Current_String :=
!               Next_Literal_String (Current_String, In_Tree);
           end loop;
  
           return Current_String /= Empty_Node;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-tree.ads gcc-4.1.0/gcc/ada/prj-tree.ads
*** gcc-4.0.2/gcc/ada/prj-tree.ads	Wed Dec  8 11:25:48 2004
--- gcc-4.1.0/gcc/ada/prj-tree.ads	Tue Nov 15 14:01:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,39 ****
  
  --  This package defines the structure of the Project File tree
  
! with GNAT.HTable;
  
  with Prj.Attr; use Prj.Attr;
- with Table;    use Table;
- with Types;    use Types;
  
  package Prj.Tree is
  
     Project_Nodes_Initial   : constant := 1_000;
     Project_Nodes_Increment : constant := 100;
     --  Allocation parameters for initializing and extending number
--- 26,43 ----
  
  --  This package defines the structure of the Project File tree
  
! with GNAT.Dynamic_HTables;
! with GNAT.Dynamic_Tables;
  
  with Prj.Attr; use Prj.Attr;
  
  package Prj.Tree is
  
+    type Project_Node_Tree_Data;
+    type Project_Node_Tree_Ref is access all Project_Node_Tree_Data;
+    --  Type to designate a project node tree, so that several project node
+    --  trees can coexist in memory.
+ 
     Project_Nodes_Initial   : constant := 1_000;
     Project_Nodes_Increment : constant := 100;
     --  Allocation parameters for initializing and extending number
*************** package Prj.Tree is
*** 81,105 ****
        N_Case_Item,
        N_Comment_Zones,
        N_Comment);
!    --  Each node in the tree is of a Project_Node_Kind
!    --  For the signification of the fields in each node of a
!    --  Project_Node_Kind, look at package Tree_Private_Part.
  
!    procedure Initialize;
     --  Initialize the Project File tree: empty the Project_Nodes table
     --  and reset the Projects_Htable.
  
     function Default_Project_Node
!      (Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
!    --  Returns a Project_Node_Record with the specified Kind and
!    --  Expr_Kind; all the other components have default nil values.
  
     function Hash (N : Project_Node_Id) return Header_Num;
     --  Used for hash tables where the key is a Project_Node_Id
  
     function Imported_Or_Extended_Project_Of
       (Project   : Project_Node_Id;
        With_Name : Name_Id) return Project_Node_Id;
     --  Return the node of a project imported or extended by project Project and
     --  whose name is With_Name. Return Empty_Node if there is no such project.
--- 85,111 ----
        N_Case_Item,
        N_Comment_Zones,
        N_Comment);
!    --  Each node in the tree is of a Project_Node_Kind. For the signification
!    --  of the fields in each node of Project_Node_Kind, look at package
!    --  Tree_Private_Part.
  
!    procedure Initialize (Tree : Project_Node_Tree_Ref);
     --  Initialize the Project File tree: empty the Project_Nodes table
     --  and reset the Projects_Htable.
  
     function Default_Project_Node
!      (In_Tree       : Project_Node_Tree_Ref;
!       Of_Kind       : Project_Node_Kind;
        And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id;
!    --  Returns a Project_Node_Record with the specified Kind and Expr_Kind. All
!    --  the other components have default nil values.
  
     function Hash (N : Project_Node_Id) return Header_Num;
     --  Used for hash tables where the key is a Project_Node_Id
  
     function Imported_Or_Extended_Project_Of
       (Project   : Project_Node_Id;
+       In_Tree   : Project_Node_Tree_Ref;
        With_Name : Name_Id) return Project_Node_Id;
     --  Return the node of a project imported or extended by project Project and
     --  whose name is With_Name. Return Empty_Node if there is no such project.
*************** package Prj.Tree is
*** 143,152 ****
     --  comment, then it should be associated with this node.
  
     procedure Set_Next_End_Node (To : Project_Node_Id);
!    --  Put node To on the top of the end node stack. When an "end" line
!    --  is found with this node on the top of the end node stack, the comments,
!    --  if any, immediately preceding this "end" line will be associated with
!    --  this node.
  
     procedure Remove_Next_End_Node;
     --  Remove the top of the end node stack
--- 149,157 ----
     --  comment, then it should be associated with this node.
  
     procedure Set_Next_End_Node (To : Project_Node_Id);
!    --  Put node To on the top of the end node stack. When an END line is found
!    --  with this node on the top of the end node stack, the comments, if any,
!    --  immediately preceding this "end" line will be associated with this node.
  
     procedure Remove_Next_End_Node;
     --  Remove the top of the end node stack
*************** package Prj.Tree is
*** 160,165 ****
--- 165,171 ----
        Follows_Empty_Line        : Boolean := False;
        Is_Followed_By_Empty_Line : Boolean := False;
     end record;
+    --  Component type for Comments Table below
  
     package Comments is new Table.Table
       (Table_Component_Type => Comment_Data,
*************** package Prj.Tree is
*** 170,182 ****
        Table_Name           => "Prj.Tree.Comments");
     --  A table to store the comments that may be stored is the tree
  
!    procedure Scan;
     --  Scan the tokens and accumulate comments
  
     type Comment_Location is
       (Before, After, Before_End, After_End, End_Of_Line);
  
!    procedure Add_Comments (To : Project_Node_Id; Where : Comment_Location);
     --  Add comments to this node
  
     ----------------------
--- 176,192 ----
        Table_Name           => "Prj.Tree.Comments");
     --  A table to store the comments that may be stored is the tree
  
!    procedure Scan (In_Tree : Project_Node_Tree_Ref);
     --  Scan the tokens and accumulate comments
  
     type Comment_Location is
       (Before, After, Before_End, After_End, End_Of_Line);
+    --  Used in call to Add_Comments below
  
!    procedure Add_Comments
!      (To      : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       Where   : Comment_Location);
     --  Add comments to this node
  
     ----------------------
*************** package Prj.Tree is
*** 184,472 ****
     ----------------------
  
     --  The following query functions are part of the abstract interface
!    --  of the Project File tree
  
!    function Name_Of (Node : Project_Node_Id) return Name_Id;
     pragma Inline (Name_Of);
     --  Valid for all non empty nodes. May return No_Name for nodes that have
     --  no names.
  
!    function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind;
     pragma Inline (Kind_Of);
     --  Valid for all non empty nodes
  
!    function Location_Of (Node : Project_Node_Id) return Source_Ptr;
     pragma Inline (Location_Of);
     --  Valid for all non empty nodes
  
     function First_Comment_After
!      (Node : Project_Node_Id) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_After_End
!      (Node : Project_Node_Id) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_Before
!      (Node : Project_Node_Id) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_Before_End
!      (Node : Project_Node_Id) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
!    function Next_Comment (Node : Project_Node_Id) return Project_Node_Id;
     --  Valid only for N_Comment nodes
  
!    function End_Of_Line_Comment (Node : Project_Node_Id) return Name_Id;
     --  Valid only for non empty nodes
  
!    function Follows_Empty_Line (Node : Project_Node_Id) return Boolean;
     --  Valid only for N_Comment nodes
  
!    function Is_Followed_By_Empty_Line (Node : Project_Node_Id) return Boolean;
     --  Valid only for N_Comment nodes
  
     function Project_File_Includes_Unkept_Comments
!      (Node : Project_Node_Id)
        return Boolean;
     --  Valid only for N_Project nodes
  
!    function Directory_Of (Node : Project_Node_Id) return Name_Id;
     pragma Inline (Directory_Of);
     --  Only valid for N_Project nodes
  
!    function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind;
     pragma Inline (Expression_Kind_Of);
     --  Only valid for N_Literal_String, N_Attribute_Declaration,
     --  N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
     --  N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
  
!    function Is_Extending_All (Node  : Project_Node_Id) return Boolean;
     pragma Inline (Is_Extending_All);
     --  Only valid for N_Project and N_With_Clause
  
     function First_Variable_Of
!      (Node : Project_Node_Id) return Variable_Node_Id;
     pragma Inline (First_Variable_Of);
     --  Only valid for N_Project or N_Package_Declaration nodes
  
     function First_Package_Of
!      (Node : Project_Node_Id) return Package_Declaration_Id;
     pragma Inline (First_Package_Of);
     --  Only valid for N_Project nodes
  
!    function Package_Id_Of (Node  : Project_Node_Id) return Package_Node_Id;
     pragma Inline (Package_Id_Of);
     --  Only valid for N_Package_Declaration nodes
  
!    function Path_Name_Of (Node : Project_Node_Id) return Name_Id;
     pragma Inline (Path_Name_Of);
     --  Only valid for N_Project and N_With_Clause nodes
  
!    function String_Value_Of (Node : Project_Node_Id) return Name_Id;
     pragma Inline (String_Value_Of);
!    --  Only valid for N_With_Clause, N_Literal_String nodes or N_Comment
  
!    function Source_Index_Of (Node : Project_Node_Id) return Int;
     pragma Inline (Source_Index_Of);
     --  Only valid for N_Literal_String and N_Attribute_Declaration nodes
  
     function First_With_Clause_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_With_Clause_Of);
     --  Only valid for N_Project nodes
  
     function Project_Declaration_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Project_Declaration_Of);
     --  Only valid for N_Project nodes
  
     function Extending_Project_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Extending_Project_Of);
     --  Only valid for N_Project_Declaration nodes
  
     function First_String_Type_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_String_Type_Of);
     --  Only valid for N_Project nodes
  
     function Extended_Project_Path_Of
!      (Node : Project_Node_Id) return Name_Id;
     pragma Inline (Extended_Project_Path_Of);
     --  Only valid for N_With_Clause nodes
  
     function Project_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Project_Node_Of);
     --  Only valid for N_With_Clause, N_Variable_Reference and
     --  N_Attribute_Reference nodes.
  
     function Non_Limited_Project_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Non_Limited_Project_Node_Of);
     --  Only valid for N_With_Clause nodes. Returns Empty_Node for limited
     --  imported project files, otherwise returns the same result as
     --  Project_Node_Of.
  
     function Next_With_Clause_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_With_Clause_Of);
     --  Only valid for N_With_Clause nodes
  
     function First_Declarative_Item_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Declarative_Item_Of);
     --  Only valid for N_With_Clause nodes
  
     function Extended_Project_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Extended_Project_Of);
     --  Only valid for N_Project_Declaration nodes
  
     function Current_Item_Node
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Current_Item_Node);
     --  Only valid for N_Declarative_Item nodes
  
     function Next_Declarative_Item
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Declarative_Item);
     --  Only valid for N_Declarative_Item node
  
     function Project_Of_Renamed_Package_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Project_Of_Renamed_Package_Of);
     --  Only valid for N_Package_Declaration nodes.
     --  May return Empty_Node.
  
     function Next_Package_In_Project
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Package_In_Project);
     --  Only valid for N_Package_Declaration nodes
  
     function First_Literal_String
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Literal_String);
     --  Only valid for N_String_Type_Declaration nodes
  
     function Next_String_Type
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_String_Type);
     --  Only valid for N_String_Type_Declaration nodes
  
     function Next_Literal_String
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Literal_String);
     --  Only valid for N_Literal_String nodes
  
     function Expression_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Expression_Of);
     --  Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
     --  or N_Variable_Declaration nodes
  
     function Associative_Project_Of
!      (Node  : Project_Node_Id)
        return  Project_Node_Id;
     pragma Inline (Associative_Project_Of);
     --  Only valid for N_Attribute_Declaration nodes
  
     function Associative_Package_Of
!      (Node  : Project_Node_Id)
        return  Project_Node_Id;
     pragma Inline (Associative_Package_Of);
     --  Only valid for N_Attribute_Declaration nodes
  
     function Value_Is_Valid
       (For_Typed_Variable : Project_Node_Id;
        Value              : Name_Id) return Boolean;
     pragma Inline (Value_Is_Valid);
     --  Only valid for N_Typed_Variable_Declaration. Returns True if Value is
     --  in the list of allowed strings for For_Typed_Variable. False otherwise.
  
     function Associative_Array_Index_Of
!      (Node : Project_Node_Id) return Name_Id;
     pragma Inline (Associative_Array_Index_Of);
     --  Only valid for N_Attribute_Declaration and N_Attribute_Reference.
     --  Returns No_String for non associative array attributes.
  
     function Next_Variable
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Variable);
     --  Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
     --  nodes.
  
     function First_Term
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Term);
     --  Only valid for N_Expression nodes
  
     function Next_Expression_In_List
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Expression_In_List);
     --  Only valid for N_Expression nodes
  
     function Current_Term
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Current_Term);
     --  Only valid for N_Term nodes
  
     function Next_Term
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Term);
     --  Only valid for N_Term nodes
  
     function First_Expression_In_List
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Expression_In_List);
     --  Only valid for N_Literal_String_List nodes
  
     function Package_Node_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Package_Node_Of);
     --  Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
     --  May return Empty_Node.
  
     function String_Type_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (String_Type_Of);
     --  Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
     --  nodes.
  
     function External_Reference_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (External_Reference_Of);
     --  Only valid for N_External_Value nodes
  
     function External_Default_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (External_Default_Of);
     --  Only valid for N_External_Value nodes
  
     function Case_Variable_Reference_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Case_Variable_Reference_Of);
     --  Only valid for N_Case_Construction nodes
  
     function First_Case_Item_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Case_Item_Of);
     --  Only valid for N_Case_Construction nodes
  
     function First_Choice_Of
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (First_Choice_Of);
     --  Return the first choice in a N_Case_Item, or Empty_Node if
     --  this is when others.
  
     function Next_Case_Item
!      (Node : Project_Node_Id) return Project_Node_Id;
     pragma Inline (Next_Case_Item);
     --  Only valid for N_Case_Item nodes
  
!    function Case_Insensitive (Node : Project_Node_Id) return Boolean;
     --  Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
  
     --------------------
--- 194,566 ----
     ----------------------
  
     --  The following query functions are part of the abstract interface
!    --  of the Project File tree. They provide access to fields of a project.
  
!    --  In the following, there are "valid if" comments, but no indication
!    --  of what happens if they are called with invalid arguments ???
! 
!    function Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (Name_Of);
     --  Valid for all non empty nodes. May return No_Name for nodes that have
     --  no names.
  
!    function Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind;
     pragma Inline (Kind_Of);
     --  Valid for all non empty nodes
  
!    function Location_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Source_Ptr;
     pragma Inline (Location_Of);
     --  Valid for all non empty nodes
  
     function First_Comment_After
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_After_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_Before
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
     function First_Comment_Before_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Valid only for N_Comment_Zones nodes
  
!    function Next_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     --  Valid only for N_Comment nodes
  
!    function End_Of_Line_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     --  Valid only for non empty nodes
  
!    function Follows_Empty_Line
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean;
     --  Valid only for N_Comment nodes
  
!    function Is_Followed_By_Empty_Line
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean;
     --  Valid only for N_Comment nodes
  
     function Project_File_Includes_Unkept_Comments
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return Boolean;
     --  Valid only for N_Project nodes
  
!    function Directory_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (Directory_Of);
     --  Only valid for N_Project nodes
  
!    function Expression_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Variable_Kind;
     pragma Inline (Expression_Kind_Of);
     --  Only valid for N_Literal_String, N_Attribute_Declaration,
     --  N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
     --  N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
  
!    function Is_Extending_All
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean;
     pragma Inline (Is_Extending_All);
     --  Only valid for N_Project and N_With_Clause
  
+    function Is_Not_Last_In_List
+      (Node    : Project_Node_Id;
+       In_Tree : Project_Node_Tree_Ref) return Boolean;
+    pragma Inline (Is_Not_Last_In_List);
+    --  Only valid for N_With_Clause
+ 
     function First_Variable_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id;
     pragma Inline (First_Variable_Of);
     --  Only valid for N_Project or N_Package_Declaration nodes
  
     function First_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id;
     pragma Inline (First_Package_Of);
     --  Only valid for N_Project nodes
  
!    function Package_Id_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Package_Node_Id;
     pragma Inline (Package_Id_Of);
     --  Only valid for N_Package_Declaration nodes
  
!    function Path_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (Path_Name_Of);
     --  Only valid for N_Project and N_With_Clause nodes
  
!    function String_Value_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (String_Value_Of);
!    --  Only valid for N_With_Clause, N_Literal_String nodes or N_Comment.
!    --  For a N_With_Clause created automatically for a virtual extending
!    --  project, No_Name is returned.
  
!    function Source_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Int;
     pragma Inline (Source_Index_Of);
     --  Only valid for N_Literal_String and N_Attribute_Declaration nodes
  
     function First_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_With_Clause_Of);
     --  Only valid for N_Project nodes
  
     function Project_Declaration_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Project_Declaration_Of);
     --  Only valid for N_Project nodes
  
     function Extending_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Extending_Project_Of);
     --  Only valid for N_Project_Declaration nodes
  
     function First_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_String_Type_Of);
     --  Only valid for N_Project nodes
  
     function Extended_Project_Path_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (Extended_Project_Path_Of);
     --  Only valid for N_With_Clause nodes
  
     function Project_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Project_Node_Of);
     --  Only valid for N_With_Clause, N_Variable_Reference and
     --  N_Attribute_Reference nodes.
  
     function Non_Limited_Project_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Non_Limited_Project_Node_Of);
     --  Only valid for N_With_Clause nodes. Returns Empty_Node for limited
     --  imported project files, otherwise returns the same result as
     --  Project_Node_Of.
  
     function Next_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_With_Clause_Of);
     --  Only valid for N_With_Clause nodes
  
     function First_Declarative_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Declarative_Item_Of);
     --  Only valid for N_With_Clause nodes
  
     function Extended_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Extended_Project_Of);
     --  Only valid for N_Project_Declaration nodes
  
     function Current_Item_Node
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Current_Item_Node);
     --  Only valid for N_Declarative_Item nodes
  
     function Next_Declarative_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Declarative_Item);
     --  Only valid for N_Declarative_Item node
  
     function Project_Of_Renamed_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Project_Of_Renamed_Package_Of);
     --  Only valid for N_Package_Declaration nodes.
     --  May return Empty_Node.
  
     function Next_Package_In_Project
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Package_In_Project);
     --  Only valid for N_Package_Declaration nodes
  
     function First_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Literal_String);
     --  Only valid for N_String_Type_Declaration nodes
  
     function Next_String_Type
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_String_Type);
     --  Only valid for N_String_Type_Declaration nodes
  
     function Next_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Literal_String);
     --  Only valid for N_Literal_String nodes
  
     function Expression_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Expression_Of);
     --  Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
     --  or N_Variable_Declaration nodes
  
     function Associative_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return  Project_Node_Id;
     pragma Inline (Associative_Project_Of);
     --  Only valid for N_Attribute_Declaration nodes
  
     function Associative_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref)
        return  Project_Node_Id;
     pragma Inline (Associative_Package_Of);
     --  Only valid for N_Attribute_Declaration nodes
  
     function Value_Is_Valid
       (For_Typed_Variable : Project_Node_Id;
+       In_Tree            : Project_Node_Tree_Ref;
        Value              : Name_Id) return Boolean;
     pragma Inline (Value_Is_Valid);
     --  Only valid for N_Typed_Variable_Declaration. Returns True if Value is
     --  in the list of allowed strings for For_Typed_Variable. False otherwise.
  
     function Associative_Array_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Name_Id;
     pragma Inline (Associative_Array_Index_Of);
     --  Only valid for N_Attribute_Declaration and N_Attribute_Reference.
     --  Returns No_String for non associative array attributes.
  
     function Next_Variable
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Variable);
     --  Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
     --  nodes.
  
     function First_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Term);
     --  Only valid for N_Expression nodes
  
     function Next_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Expression_In_List);
     --  Only valid for N_Expression nodes
  
     function Current_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Current_Term);
     --  Only valid for N_Term nodes
  
     function Next_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Term);
     --  Only valid for N_Term nodes
  
     function First_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Expression_In_List);
     --  Only valid for N_Literal_String_List nodes
  
     function Package_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Package_Node_Of);
     --  Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
     --  May return Empty_Node.
  
     function String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (String_Type_Of);
     --  Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
     --  nodes.
  
     function External_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (External_Reference_Of);
     --  Only valid for N_External_Value nodes
  
     function External_Default_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (External_Default_Of);
     --  Only valid for N_External_Value nodes
  
     function Case_Variable_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Case_Variable_Reference_Of);
     --  Only valid for N_Case_Construction nodes
  
     function First_Case_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Case_Item_Of);
     --  Only valid for N_Case_Construction nodes
  
     function First_Choice_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (First_Choice_Of);
     --  Return the first choice in a N_Case_Item, or Empty_Node if
     --  this is when others.
  
     function Next_Case_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
     pragma Inline (Next_Case_Item);
     --  Only valid for N_Case_Item nodes
  
!    function Case_Insensitive
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref) return Boolean;
     --  Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
  
     --------------------
*************** package Prj.Tree is
*** 480,745 ****
     --  nodes as the corresponding query function above.
  
     procedure Set_Name_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_Name_Of);
  
     procedure Set_Kind_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Kind);
     pragma Inline (Set_Kind_Of);
  
     procedure Set_Location_Of
!      (Node : Project_Node_Id;
!       To   : Source_Ptr);
     pragma Inline (Set_Location_Of);
  
     procedure Set_First_Comment_After
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Comment_After);
  
     procedure Set_First_Comment_After_End
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Comment_After_End);
  
     procedure Set_First_Comment_Before
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Comment_Before);
  
     procedure Set_First_Comment_Before_End
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Comment_Before_End);
  
     procedure Set_Next_Comment
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Comment);
  
     procedure Set_Project_File_Includes_Unkept_Comments
!      (Node : Project_Node_Id;
!       To   : Boolean);
  
     procedure Set_Directory_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_Directory_Of);
  
     procedure Set_Expression_Kind_Of
!      (Node : Project_Node_Id;
!       To   : Variable_Kind);
     pragma Inline (Set_Expression_Kind_Of);
  
!    procedure Set_Is_Extending_All (Node  : Project_Node_Id);
     pragma Inline (Set_Is_Extending_All);
  
     procedure Set_First_Variable_Of
!      (Node : Project_Node_Id;
!       To   : Variable_Node_Id);
     pragma Inline (Set_First_Variable_Of);
  
     procedure Set_First_Package_Of
!      (Node : Project_Node_Id;
!       To   : Package_Declaration_Id);
     pragma Inline (Set_First_Package_Of);
  
     procedure Set_Package_Id_Of
!      (Node : Project_Node_Id;
!       To   : Package_Node_Id);
     pragma Inline (Set_Package_Id_Of);
  
     procedure Set_Path_Name_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_Path_Name_Of);
  
     procedure Set_String_Value_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_String_Value_Of);
  
     procedure Set_First_With_Clause_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_With_Clause_Of);
  
     procedure Set_Project_Declaration_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Project_Declaration_Of);
  
     procedure Set_Extending_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Extending_Project_Of);
  
     procedure Set_First_String_Type_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_String_Type_Of);
  
     procedure Set_Extended_Project_Path_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_Extended_Project_Path_Of);
  
     procedure Set_Project_Node_Of
       (Node         : Project_Node_Id;
        To           : Project_Node_Id;
        Limited_With : Boolean := False);
     pragma Inline (Set_Project_Node_Of);
  
     procedure Set_Next_With_Clause_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_With_Clause_Of);
  
     procedure Set_First_Declarative_Item_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Declarative_Item_Of);
  
     procedure Set_Extended_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Extended_Project_Of);
  
     procedure Set_Current_Item_Node
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Current_Item_Node);
  
     procedure Set_Next_Declarative_Item
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Declarative_Item);
  
     procedure Set_Project_Of_Renamed_Package_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Project_Of_Renamed_Package_Of);
  
     procedure Set_Next_Package_In_Project
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Package_In_Project);
  
     procedure Set_First_Literal_String
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Literal_String);
  
     procedure Set_Next_String_Type
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_String_Type);
  
     procedure Set_Next_Literal_String
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Literal_String);
  
     procedure Set_Expression_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Expression_Of);
  
     procedure Set_Associative_Project_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Associative_Project_Of);
  
     procedure Set_Associative_Package_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Associative_Package_Of);
  
     procedure Set_Associative_Array_Index_Of
!      (Node : Project_Node_Id;
!       To   : Name_Id);
     pragma Inline (Set_Associative_Array_Index_Of);
  
     procedure Set_Next_Variable
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Variable);
  
     procedure Set_First_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Term);
  
     procedure Set_Next_Expression_In_List
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Expression_In_List);
  
     procedure Set_Current_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Current_Term);
  
     procedure Set_Next_Term
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Term);
  
     procedure Set_First_Expression_In_List
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Expression_In_List);
  
     procedure Set_Package_Node_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Package_Node_Of);
  
     procedure Set_Source_Index_Of
!      (Node : Project_Node_Id;
!       To   : Int);
     pragma Inline (Set_Source_Index_Of);
  
     procedure Set_String_Type_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_String_Type_Of);
  
     procedure Set_External_Reference_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_External_Reference_Of);
  
     procedure Set_External_Default_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_External_Default_Of);
  
     procedure Set_Case_Variable_Reference_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Case_Variable_Reference_Of);
  
     procedure Set_First_Case_Item_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Case_Item_Of);
  
     procedure Set_First_Choice_Of
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_First_Choice_Of);
  
     procedure Set_Next_Case_Item
!      (Node : Project_Node_Id;
!       To   : Project_Node_Id);
     pragma Inline (Set_Next_Case_Item);
  
     procedure Set_Case_Insensitive
!      (Node : Project_Node_Id;
!       To   : Boolean);
  
     -------------------------------
     -- Restricted Access Section --
--- 574,898 ----
     --  nodes as the corresponding query function above.
  
     procedure Set_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_Name_Of);
  
     procedure Set_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Kind);
     pragma Inline (Set_Kind_Of);
  
     procedure Set_Location_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Source_Ptr);
     pragma Inline (Set_Location_Of);
  
     procedure Set_First_Comment_After
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Comment_After);
  
     procedure Set_First_Comment_After_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Comment_After_End);
  
     procedure Set_First_Comment_Before
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Comment_Before);
  
     procedure Set_First_Comment_Before_End
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Comment_Before_End);
  
     procedure Set_Next_Comment
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Comment);
  
     procedure Set_Project_File_Includes_Unkept_Comments
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Boolean);
  
     procedure Set_Directory_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_Directory_Of);
  
     procedure Set_Expression_Kind_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Variable_Kind);
     pragma Inline (Set_Expression_Kind_Of);
  
!    procedure Set_Is_Extending_All
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref);
     pragma Inline (Set_Is_Extending_All);
  
+    procedure Set_Is_Not_Last_In_List
+      (Node    : Project_Node_Id;
+       In_Tree : Project_Node_Tree_Ref);
+    pragma Inline (Set_Is_Not_Last_In_List);
+ 
     procedure Set_First_Variable_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Variable_Node_Id);
     pragma Inline (Set_First_Variable_Of);
  
     procedure Set_First_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Package_Declaration_Id);
     pragma Inline (Set_First_Package_Of);
  
     procedure Set_Package_Id_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Package_Node_Id);
     pragma Inline (Set_Package_Id_Of);
  
     procedure Set_Path_Name_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_Path_Name_Of);
  
     procedure Set_String_Value_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_String_Value_Of);
  
     procedure Set_First_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_With_Clause_Of);
  
     procedure Set_Project_Declaration_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Project_Declaration_Of);
  
     procedure Set_Extending_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Extending_Project_Of);
  
     procedure Set_First_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_String_Type_Of);
  
     procedure Set_Extended_Project_Path_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_Extended_Project_Path_Of);
  
     procedure Set_Project_Node_Of
       (Node         : Project_Node_Id;
+       In_Tree      : Project_Node_Tree_Ref;
        To           : Project_Node_Id;
        Limited_With : Boolean := False);
     pragma Inline (Set_Project_Node_Of);
  
     procedure Set_Next_With_Clause_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_With_Clause_Of);
  
     procedure Set_First_Declarative_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Declarative_Item_Of);
  
     procedure Set_Extended_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Extended_Project_Of);
  
     procedure Set_Current_Item_Node
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Current_Item_Node);
  
     procedure Set_Next_Declarative_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Declarative_Item);
  
     procedure Set_Project_Of_Renamed_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Project_Of_Renamed_Package_Of);
  
     procedure Set_Next_Package_In_Project
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Package_In_Project);
  
     procedure Set_First_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Literal_String);
  
     procedure Set_Next_String_Type
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_String_Type);
  
     procedure Set_Next_Literal_String
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Literal_String);
  
     procedure Set_Expression_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Expression_Of);
  
     procedure Set_Associative_Project_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Associative_Project_Of);
  
     procedure Set_Associative_Package_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Associative_Package_Of);
  
     procedure Set_Associative_Array_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Name_Id);
     pragma Inline (Set_Associative_Array_Index_Of);
  
     procedure Set_Next_Variable
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Variable);
  
     procedure Set_First_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Term);
  
     procedure Set_Next_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Expression_In_List);
  
     procedure Set_Current_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Current_Term);
  
     procedure Set_Next_Term
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Term);
  
     procedure Set_First_Expression_In_List
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Expression_In_List);
  
     procedure Set_Package_Node_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Package_Node_Of);
  
     procedure Set_Source_Index_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Int);
     pragma Inline (Set_Source_Index_Of);
  
     procedure Set_String_Type_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_String_Type_Of);
  
     procedure Set_External_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_External_Reference_Of);
  
     procedure Set_External_Default_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_External_Default_Of);
  
     procedure Set_Case_Variable_Reference_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Case_Variable_Reference_Of);
  
     procedure Set_First_Case_Item_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Case_Item_Of);
  
     procedure Set_First_Choice_Of
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_First_Choice_Of);
  
     procedure Set_Next_Case_Item
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Project_Node_Id);
     pragma Inline (Set_Next_Case_Item);
  
     procedure Set_Case_Insensitive
!      (Node    : Project_Node_Id;
!       In_Tree : Project_Node_Tree_Ref;
!       To      : Boolean);
  
     -------------------------------
     -- Restricted Access Section --
*************** package Prj.Tree is
*** 812,817 ****
--- 965,976 ----
           --    N_Project_Declaration
           --              - it indicates that there are unkept comments in the
           --                project.
+          --    N_With_Clause
+          --              - it indicates that this is not the last with in a
+          --                with clause. It is set for "A", but not for "B" in
+          --                    with "B";
+          --                  and
+          --                    with "A", "B";
  
           Flag2 : Boolean := False;
           --  This flag is significant only for:
*************** package Prj.Tree is
*** 1028,1040 ****
        --    --  Flag2:     comment is followed by an empty line
        --    --  Comments:  next comment
  
!       package Project_Nodes is
!          new Table.Table (Table_Component_Type => Project_Node_Record,
!                           Table_Index_Type     => Project_Node_Id,
!                           Table_Low_Bound      => First_Node_Id,
!                           Table_Initial        => Project_Nodes_Initial,
!                           Table_Increment      => Project_Nodes_Increment,
!                           Table_Name           => "Project_Nodes");
        --  This table contains the syntactic tree of project data
        --  from project files.
  
--- 1187,1199 ----
        --    --  Flag2:     comment is followed by an empty line
        --    --  Comments:  next comment
  
!       package Project_Node_Table is
!         new GNAT.Dynamic_Tables
!           (Table_Component_Type => Project_Node_Record,
!            Table_Index_Type     => Project_Node_Id,
!            Table_Low_Bound      => First_Node_Id,
!            Table_Initial        => Project_Nodes_Initial,
!            Table_Increment      => Project_Nodes_Increment);
        --  This table contains the syntactic tree of project data
        --  from project files.
  
*************** package Prj.Tree is
*** 1058,1064 ****
           Canonical_Path => No_Name,
           Extended       => True);
  
!       package Projects_Htable is new GNAT.HTable.Simple_HTable
          (Header_Num => Header_Num,
           Element    => Project_Name_And_Node,
           No_Element => No_Project_Name_And_Node,
--- 1217,1223 ----
           Canonical_Path => No_Name,
           Extended       => True);
  
!       package Projects_Htable is new GNAT.Dynamic_HTables.Simple_HTable
          (Header_Num => Header_Num,
           Element    => Project_Name_And_Node,
           No_Element => No_Project_Name_And_Node,
*************** package Prj.Tree is
*** 1073,1078 ****
--- 1232,1243 ----
  
     end Tree_Private_Part;
  
+    type Project_Node_Tree_Data is record
+       Project_Nodes : Tree_Private_Part.Project_Node_Table.Instance;
+       Projects_HT   : Tree_Private_Part.Projects_Htable.Instance;
+    end record;
+    --  The data for a project node tree
+ 
  private
     type Comment_Array is array (Positive range <>) of Comment_Data;
     type Comments_Ptr is access Comment_Array;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-util.adb gcc-4.1.0/gcc/ada/prj-util.adb
*** gcc-4.0.2/gcc/ada/prj-util.adb	Wed Dec  8 11:25:48 2004
--- gcc-4.1.0/gcc/ada/prj-util.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Prj.Util is
*** 75,80 ****
--- 75,81 ----
  
     function Executable_Of
       (Project  : Project_Id;
+       In_Tree  : Project_Tree_Ref;
        Main     : Name_Id;
        Index    : Int;
        Ada_Main : Boolean := True) return Name_Id
*************** package body Prj.Util is
*** 82,100 ****
        pragma Assert (Project /= No_Project);
  
        The_Packages : constant Package_Id :=
!                        Projects.Table (Project).Decl.Packages;
  
        Builder_Package : constant Prj.Package_Id :=
                            Prj.Util.Value_Of
                              (Name        => Name_Builder,
!                              In_Packages => The_Packages);
  
        Executable : Variable_Value :=
                       Prj.Util.Value_Of
                         (Name                    => Main,
                          Index                   => Index,
                          Attribute_Or_Array_Name => Name_Executable,
!                         In_Package              => Builder_Package);
  
        Executable_Suffix : constant Variable_Value :=
                              Prj.Util.Value_Of
--- 83,103 ----
        pragma Assert (Project /= No_Project);
  
        The_Packages : constant Package_Id :=
!                        In_Tree.Projects.Table (Project).Decl.Packages;
  
        Builder_Package : constant Prj.Package_Id :=
                            Prj.Util.Value_Of
                              (Name        => Name_Builder,
!                              In_Packages => The_Packages,
!                              In_Tree     => In_Tree);
  
        Executable : Variable_Value :=
                       Prj.Util.Value_Of
                         (Name                    => Main,
                          Index                   => Index,
                          Attribute_Or_Array_Name => Name_Executable,
!                         In_Package              => Builder_Package,
!                         In_Tree                 => In_Tree);
  
        Executable_Suffix : constant Variable_Value :=
                              Prj.Util.Value_Of
*************** package body Prj.Util is
*** 102,116 ****
                                 Index                   => 0,
                                 Attribute_Or_Array_Name =>
                                   Name_Executable_Suffix,
!                                In_Package              => Builder_Package);
  
        Body_Append : constant String := Get_Name_String
!                                           (Projects.Table
                                              (Project).
                                                Naming.Ada_Body_Suffix);
  
        Spec_Append : constant String := Get_Name_String
!                                           (Projects.Table
                                              (Project).
                                                 Naming.Ada_Spec_Suffix);
  
--- 105,120 ----
                                 Index                   => 0,
                                 Attribute_Or_Array_Name =>
                                   Name_Executable_Suffix,
!                                In_Package              => Builder_Package,
!                                In_Tree                 => In_Tree);
  
        Body_Append : constant String := Get_Name_String
!                                           (In_Tree.Projects.Table
                                              (Project).
                                                Naming.Ada_Body_Suffix);
  
        Spec_Append : constant String := Get_Name_String
!                                           (In_Tree.Projects.Table
                                              (Project).
                                                 Naming.Ada_Spec_Suffix);
  
*************** package body Prj.Util is
*** 128,134 ****
                 Last : Positive := Name_Len;
  
                 Naming : constant Naming_Data :=
!                           Projects.Table (Project).Naming;
  
                 Spec_Suffix : constant String :=
                                 Get_Name_String (Naming.Ada_Spec_Suffix);
--- 132,138 ----
                 Last : Positive := Name_Len;
  
                 Naming : constant Naming_Data :=
!                           In_Tree.Projects.Table (Project).Naming;
  
                 Spec_Suffix : constant String :=
                                 Get_Name_String (Naming.Ada_Spec_Suffix);
*************** package body Prj.Util is
*** 163,169 ****
                        (Name                    => Name_Find,
                         Index                   => 0,
                         Attribute_Or_Array_Name => Name_Executable,
!                        In_Package              => Builder_Package);
                 end if;
              end;
           end if;
--- 167,174 ----
                        (Name                    => Name_Find,
                         Index                   => 0,
                         Attribute_Or_Array_Name => Name_Executable,
!                        In_Package              => Builder_Package,
!                        In_Tree                 => In_Tree);
                 end if;
              end;
           end if;
*************** package body Prj.Util is
*** 400,406 ****
  
     function Value_Of
       (Index     : Name_Id;
!       In_Array  : Array_Element_Id) return Name_Id
     is
        Current    : Array_Element_Id := In_Array;
        Element    : Array_Element;
--- 405,412 ----
  
     function Value_Of
       (Index     : Name_Id;
!       In_Array  : Array_Element_Id;
!       In_Tree   : Project_Tree_Ref) return Name_Id
     is
        Current    : Array_Element_Id := In_Array;
        Element    : Array_Element;
*************** package body Prj.Util is
*** 411,417 ****
           return No_Name;
        end if;
  
!       Element := Array_Elements.Table (Current);
  
        if not Element.Index_Case_Sensitive then
           Get_Name_String (Index);
--- 417,423 ----
           return No_Name;
        end if;
  
!       Element := In_Tree.Array_Elements.Table (Current);
  
        if not Element.Index_Case_Sensitive then
           Get_Name_String (Index);
*************** package body Prj.Util is
*** 420,426 ****
        end if;
  
        while Current /= No_Array_Element loop
!          Element := Array_Elements.Table (Current);
  
           if Real_Index = Element.Index then
              exit when Element.Value.Kind /= Single;
--- 426,432 ----
        end if;
  
        while Current /= No_Array_Element loop
!          Element := In_Tree.Array_Elements.Table (Current);
  
           if Real_Index = Element.Index then
              exit when Element.Value.Kind /= Single;
*************** package body Prj.Util is
*** 437,443 ****
     function Value_Of
       (Index     : Name_Id;
        Src_Index : Int := 0;
!       In_Array  : Array_Element_Id) return Variable_Value
     is
        Current : Array_Element_Id := In_Array;
        Element : Array_Element;
--- 443,450 ----
     function Value_Of
       (Index     : Name_Id;
        Src_Index : Int := 0;
!       In_Array  : Array_Element_Id;
!       In_Tree   : Project_Tree_Ref) return Variable_Value
     is
        Current : Array_Element_Id := In_Array;
        Element : Array_Element;
*************** package body Prj.Util is
*** 448,454 ****
           return Nil_Variable_Value;
        end if;
  
!       Element := Array_Elements.Table (Current);
  
        if not Element.Index_Case_Sensitive then
           Get_Name_String (Index);
--- 455,461 ----
           return Nil_Variable_Value;
        end if;
  
!       Element := In_Tree.Array_Elements.Table (Current);
  
        if not Element.Index_Case_Sensitive then
           Get_Name_String (Index);
*************** package body Prj.Util is
*** 457,463 ****
        end if;
  
        while Current /= No_Array_Element loop
!          Element := Array_Elements.Table (Current);
  
           if Real_Index = Element.Index and then
             Src_Index = Element.Src_Index
--- 464,470 ----
        end if;
  
        while Current /= No_Array_Element loop
!          Element := In_Tree.Array_Elements.Table (Current);
  
           if Real_Index = Element.Index and then
             Src_Index = Element.Src_Index
*************** package body Prj.Util is
*** 475,481 ****
       (Name                    : Name_Id;
        Index                   : Int := 0;
        Attribute_Or_Array_Name : Name_Id;
!       In_Package              : Package_Id) return Variable_Value
     is
        The_Array     : Array_Element_Id;
        The_Attribute : Variable_Value := Nil_Variable_Value;
--- 482,489 ----
       (Name                    : Name_Id;
        Index                   : Int := 0;
        Attribute_Or_Array_Name : Name_Id;
!       In_Package              : Package_Id;
!       In_Tree                 : Project_Tree_Ref) return Variable_Value
     is
        The_Array     : Array_Element_Id;
        The_Attribute : Variable_Value := Nil_Variable_Value;
*************** package body Prj.Util is
*** 488,499 ****
           The_Array :=
             Value_Of
               (Name      => Attribute_Or_Array_Name,
!               In_Arrays => Packages.Table (In_Package).Decl.Arrays);
           The_Attribute :=
             Value_Of
               (Index     => Name,
                Src_Index => Index,
!               In_Array  => The_Array);
  
           --  If there is no array element, look for a variable
  
--- 496,509 ----
           The_Array :=
             Value_Of
               (Name      => Attribute_Or_Array_Name,
!               In_Arrays => In_Tree.Packages.Table (In_Package).Decl.Arrays,
!               In_Tree   => In_Tree);
           The_Attribute :=
             Value_Of
               (Index     => Name,
                Src_Index => Index,
!               In_Array  => The_Array,
!               In_Tree   => In_Tree);
  
           --  If there is no array element, look for a variable
  
*************** package body Prj.Util is
*** 501,507 ****
              The_Attribute :=
                Value_Of
                  (Variable_Name => Attribute_Or_Array_Name,
!                  In_Variables  => Packages.Table (In_Package).Decl.Attributes);
           end if;
        end if;
  
--- 511,519 ----
              The_Attribute :=
                Value_Of
                  (Variable_Name => Attribute_Or_Array_Name,
!                  In_Variables  => In_Tree.Packages.Table
!                                     (In_Package).Decl.Attributes,
!                  In_Tree       => In_Tree);
           end if;
        end if;
  
*************** package body Prj.Util is
*** 511,526 ****
     function Value_Of
       (Index     : Name_Id;
        In_Array  : Name_Id;
!       In_Arrays : Array_Id) return Name_Id
     is
        Current : Array_Id := In_Arrays;
        The_Array : Array_Data;
  
     begin
        while Current /= No_Array loop
!          The_Array := Arrays.Table (Current);
           if The_Array.Name = In_Array then
!             return Value_Of (Index, In_Array => The_Array.Value);
           else
              Current := The_Array.Next;
           end if;
--- 523,540 ----
     function Value_Of
       (Index     : Name_Id;
        In_Array  : Name_Id;
!       In_Arrays : Array_Id;
!       In_Tree   : Project_Tree_Ref) return Name_Id
     is
        Current : Array_Id := In_Arrays;
        The_Array : Array_Data;
  
     begin
        while Current /= No_Array loop
!          The_Array := In_Tree.Arrays.Table (Current);
           if The_Array.Name = In_Array then
!             return Value_Of
!               (Index, In_Array => The_Array.Value, In_Tree => In_Tree);
           else
              Current := The_Array.Next;
           end if;
*************** package body Prj.Util is
*** 531,544 ****
  
     function Value_Of
       (Name      : Name_Id;
!       In_Arrays : Array_Id) return Array_Element_Id
     is
        Current    : Array_Id := In_Arrays;
        The_Array  : Array_Data;
  
     begin
        while Current /= No_Array loop
!          The_Array := Arrays.Table (Current);
  
           if The_Array.Name = Name then
              return The_Array.Value;
--- 545,559 ----
  
     function Value_Of
       (Name      : Name_Id;
!       In_Arrays : Array_Id;
!       In_Tree   : Project_Tree_Ref) return Array_Element_Id
     is
        Current    : Array_Id := In_Arrays;
        The_Array  : Array_Data;
  
     begin
        while Current /= No_Array loop
!          The_Array := In_Tree.Arrays.Table (Current);
  
           if The_Array.Name = Name then
              return The_Array.Value;
*************** package body Prj.Util is
*** 552,565 ****
  
     function Value_Of
       (Name        : Name_Id;
!       In_Packages : Package_Id) return Package_Id
     is
        Current : Package_Id := In_Packages;
        The_Package : Package_Element;
  
     begin
        while Current /= No_Package loop
!          The_Package := Packages.Table (Current);
           exit when The_Package.Name /= No_Name
             and then The_Package.Name = Name;
           Current := The_Package.Next;
--- 567,581 ----
  
     function Value_Of
       (Name        : Name_Id;
!       In_Packages : Package_Id;
!       In_Tree     : Project_Tree_Ref) return Package_Id
     is
        Current : Package_Id := In_Packages;
        The_Package : Package_Element;
  
     begin
        while Current /= No_Package loop
!          The_Package := In_Tree.Packages.Table (Current);
           exit when The_Package.Name /= No_Name
             and then The_Package.Name = Name;
           Current := The_Package.Next;
*************** package body Prj.Util is
*** 570,583 ****
  
     function Value_Of
       (Variable_Name : Name_Id;
!       In_Variables  : Variable_Id) return Variable_Value
     is
        Current      : Variable_Id := In_Variables;
        The_Variable : Variable;
  
     begin
        while Current /= No_Variable loop
!          The_Variable := Variable_Elements.Table (Current);
  
           if Variable_Name = The_Variable.Name then
              return The_Variable.Value;
--- 586,601 ----
  
     function Value_Of
       (Variable_Name : Name_Id;
!       In_Variables  : Variable_Id;
!       In_Tree       : Project_Tree_Ref) return Variable_Value
     is
        Current      : Variable_Id := In_Variables;
        The_Variable : Variable;
  
     begin
        while Current /= No_Variable loop
!          The_Variable :=
!            In_Tree.Variable_Elements.Table (Current);
  
           if Variable_Name = The_Variable.Name then
              return The_Variable.Value;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj-util.ads gcc-4.1.0/gcc/ada/prj-util.ads
*** gcc-4.0.2/gcc/ada/prj-util.ads	Wed May  5 10:09:55 2004
--- gcc-4.1.0/gcc/ada/prj-util.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,39 ****
  
  --  Utilities for use in processing project files
  
- with Types; use Types;
- 
- with GNAT.OS_Lib; use GNAT.OS_Lib;
- 
  package Prj.Util is
  
     function Executable_Of
       (Project  : Project_Id;
        Main     : Name_Id;
        Index    : Int;
        Ada_Main : Boolean := True) return Name_Id;
--- 26,36 ----
  
  --  Utilities for use in processing project files
  
  package Prj.Util is
  
     function Executable_Of
       (Project  : Project_Id;
+       In_Tree  : Project_Tree_Ref;
        Main     : Name_Id;
        Index    : Int;
        Ada_Main : Boolean := True) return Name_Id;
*************** package Prj.Util is
*** 51,57 ****
  
     function Value_Of
       (Index    : Name_Id;
!       In_Array : Array_Element_Id) return Name_Id;
     --  Get a single string array component. Returns No_Name if there is no
     --  component Index, if In_Array is null, or if the component is a String
     --  list. Depending on the attribute (only attributes may be associative
--- 48,55 ----
  
     function Value_Of
       (Index    : Name_Id;
!       In_Array : Array_Element_Id;
!       In_Tree  : Project_Tree_Ref) return Name_Id;
     --  Get a single string array component. Returns No_Name if there is no
     --  component Index, if In_Array is null, or if the component is a String
     --  list. Depending on the attribute (only attributes may be associative
*************** package Prj.Util is
*** 62,87 ****
     function Value_Of
       (Index     : Name_Id;
        Src_Index : Int := 0;
!       In_Array  : Array_Element_Id) return Variable_Value;
     --  Get a string array component (single String or String list).
     --  Returns Nil_Variable_Value if there is no component Index
     --  or if In_Array is null.
     --
     --  Depending on the attribute (only attributes may be associative arrays)
!    --  the index may or may not be case sensitive. If the index is not
!    --  case sensitive, it is first set to lower case before the search
!    --  in the associative array.
  
     function Value_Of
       (Name                    : Name_Id;
        Index                   : Int := 0;
        Attribute_Or_Array_Name : Name_Id;
!       In_Package              : Package_Id) return Variable_Value;
     --  In a specific package,
!    --   - if there exists an array Attribute_Or_Array_Name with an index
!    --     Name, returns the corresponding component (depending on the
!    --     attribute, the index may or may not be case sensitive, see previous
!    --     function),
     --   - otherwise if there is a single attribute Attribute_Or_Array_Name,
     --     returns this attribute,
     --   - otherwise, returns Nil_Variable_Value.
--- 60,86 ----
     function Value_Of
       (Index     : Name_Id;
        Src_Index : Int := 0;
!       In_Array  : Array_Element_Id;
!       In_Tree   : Project_Tree_Ref) return Variable_Value;
     --  Get a string array component (single String or String list).
     --  Returns Nil_Variable_Value if there is no component Index
     --  or if In_Array is null.
     --
     --  Depending on the attribute (only attributes may be associative arrays)
!    --  the index may or may not be case sensitive. If the index is not case
!    --  sensitive, it is first set to lower case before the search in the
!    --  associative array.
  
     function Value_Of
       (Name                    : Name_Id;
        Index                   : Int := 0;
        Attribute_Or_Array_Name : Name_Id;
!       In_Package              : Package_Id;
!       In_Tree                 : Project_Tree_Ref) return Variable_Value;
     --  In a specific package,
!    --   - if there exists an array Attribute_Or_Array_Name with an index Name,
!    --     returns the corresponding component (depending on the attribute, the
!    --     index may or may not be case sensitive, see previous function),
     --   - otherwise if there is a single attribute Attribute_Or_Array_Name,
     --     returns this attribute,
     --   - otherwise, returns Nil_Variable_Value.
*************** package Prj.Util is
*** 90,117 ****
     function Value_Of
       (Index     : Name_Id;
        In_Array  : Name_Id;
!       In_Arrays : Array_Id) return Name_Id;
!    --  Get a string array component in an array of an array list.
!    --  Returns No_Name if there is no component Index, if In_Arrays is null, if
     --  In_Array is not found in In_Arrays or if the component is a String list.
  
     function Value_Of
       (Name      : Name_Id;
!       In_Arrays : Array_Id) return Array_Element_Id;
     --  Returns a specified array in an array list. Returns No_Array_Element
     --  if In_Arrays is null or if Name is not the name of an array in
     --  In_Arrays. The caller must ensure that Name is in lower case.
  
     function Value_Of
       (Name        : Name_Id;
!       In_Packages : Package_Id) return Package_Id;
!    --  Returns a specified package in a package list. Returns No_Package
!    --  if In_Packages is null or if Name is not the name of a package in
     --  Package_List. The caller must ensure that Name is in lower case.
  
     function Value_Of
       (Variable_Name : Name_Id;
!       In_Variables  : Variable_Id) return Variable_Value;
     --  Returns a specified variable in a variable list. Returns null if
     --  In_Variables is null or if Variable_Name is not the name of a
     --  variable in In_Variables. Caller must ensure that Name is lower case.
--- 89,120 ----
     function Value_Of
       (Index     : Name_Id;
        In_Array  : Name_Id;
!       In_Arrays : Array_Id;
!       In_Tree   : Project_Tree_Ref) return Name_Id;
!    --  Get a string array component in an array of an array list. Returns
!    --  No_Name if there is no component Index, if In_Arrays is null, if
     --  In_Array is not found in In_Arrays or if the component is a String list.
  
     function Value_Of
       (Name      : Name_Id;
!       In_Arrays : Array_Id;
!       In_Tree   : Project_Tree_Ref) return Array_Element_Id;
     --  Returns a specified array in an array list. Returns No_Array_Element
     --  if In_Arrays is null or if Name is not the name of an array in
     --  In_Arrays. The caller must ensure that Name is in lower case.
  
     function Value_Of
       (Name        : Name_Id;
!       In_Packages : Package_Id;
!       In_Tree     : Project_Tree_Ref) return Package_Id;
!    --  Returns a specified package in a package list. Returns No_Package if
!    --  In_Packages is null or if Name is not the name of a package in
     --  Package_List. The caller must ensure that Name is in lower case.
  
     function Value_Of
       (Variable_Name : Name_Id;
!       In_Variables  : Variable_Id;
!       In_Tree       : Project_Tree_Ref) return Variable_Value;
     --  Returns a specified variable in a variable list. Returns null if
     --  In_Variables is null or if Variable_Name is not the name of a
     --  variable in In_Variables. Caller must ensure that Name is lower case.
*************** package Prj.Util is
*** 125,152 ****
     --  the last character of each line, if possible.
  
     type Text_File is limited private;
!    --  Represents a text file. Default is invalid text file.
  
     function Is_Valid (File : Text_File) return Boolean;
     --  Returns True if File designates an open text file that
     --  has not yet been closed.
  
     procedure Open (File : out Text_File; Name : String);
!    --  Open a text file. If this procedure fails, File is invalid.
  
     function End_Of_File (File : Text_File) return Boolean;
!    --  Returns True if the end of the text file File has been
!    --  reached. Fails if File is invalid.
  
     procedure Get_Line
       (File : Text_File;
        Line : out String;
        Last : out Natural);
!    --  Reads a line from an open text file. Fails if File is invalid.
  
     procedure Close (File : in out Text_File);
!    --  Close an open text file. File becomes invalid.
!    --  Fails if File is already invalid.
  
  private
  
--- 128,155 ----
     --  the last character of each line, if possible.
  
     type Text_File is limited private;
!    --  Represents a text file. Default is invalid text file
  
     function Is_Valid (File : Text_File) return Boolean;
     --  Returns True if File designates an open text file that
     --  has not yet been closed.
  
     procedure Open (File : out Text_File; Name : String);
!    --  Open a text file. If this procedure fails, File is invalid
  
     function End_Of_File (File : Text_File) return Boolean;
!    --  Returns True if the end of the text file File has been reached. Fails if
!    --  File is invalid.
  
     procedure Get_Line
       (File : Text_File;
        Line : out String;
        Last : out Natural);
!    --  Reads a line from an open text file. Fails if File is invalid
  
     procedure Close (File : in out Text_File);
!    --  Close an open text file. File becomes invalid. Fails if File is already
!    --  invalid.
  
  private
  
diff -Nrcpad gcc-4.0.2/gcc/ada/prj.adb gcc-4.1.0/gcc/ada/prj.adb
*** gcc-4.0.2/gcc/ada/prj.adb	Wed Dec  8 11:25:42 2004
--- gcc-4.1.0/gcc/ada/prj.adb	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Namet;    use Namet;
*** 30,51 ****
  with Output;   use Output;
  with Osint;    use Osint;
  with Prj.Attr;
- with Prj.Com;
  with Prj.Env;
  with Prj.Err;  use Prj.Err;
- with Scans;    use Scans;
  with Snames;   use Snames;
  with Uintp;    use Uintp;
  
  with GNAT.Case_Util; use GNAT.Case_Util;
- with GNAT.OS_Lib;    use GNAT.OS_Lib;
  
  package body Prj is
  
     The_Empty_String : Name_Id;
  
     Name_C_Plus_Plus : Name_Id;
  
     subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  
     The_Casing_Images : constant array (Known_Casing) of String_Access :=
--- 30,56 ----
  with Output;   use Output;
  with Osint;    use Osint;
  with Prj.Attr;
  with Prj.Env;
  with Prj.Err;  use Prj.Err;
  with Snames;   use Snames;
  with Uintp;    use Uintp;
  
  with GNAT.Case_Util; use GNAT.Case_Util;
  
  package body Prj is
  
+    Initial_Buffer_Size : constant := 100;
+    --  Initial size for extensible buffer used in Add_To_Buffer
+ 
     The_Empty_String : Name_Id;
  
     Name_C_Plus_Plus : Name_Id;
  
+    Default_Ada_Spec_Suffix_Id : Name_Id;
+    Default_Ada_Body_Suffix_Id : Name_Id;
+    Slash_Id                   : Name_Id;
+    --  Initialized in Prj.Initialized, then never modified
+ 
     subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
  
     The_Casing_Images : constant array (Known_Casing) of String_Access :=
*************** package body Prj is
*** 77,88 ****
        Specification_Exceptions  => No_Array_Element,
        Implementation_Exceptions => No_Array_Element);
  
!    Project_Empty : constant Project_Data :=
       (Externally_Built               => False,
        Languages                      => No_Languages,
        Supp_Languages                 => No_Supp_Language_Index,
        First_Referred_By              => No_Project,
        Name                           => No_Name,
        Path_Name                      => No_Name,
        Display_Path_Name              => No_Name,
        Virtual                        => False,
--- 82,94 ----
        Specification_Exceptions  => No_Array_Element,
        Implementation_Exceptions => No_Array_Element);
  
!    Project_Empty : Project_Data :=
       (Externally_Built               => False,
        Languages                      => No_Languages,
        Supp_Languages                 => No_Supp_Language_Index,
        First_Referred_By              => No_Project,
        Name                           => No_Name,
+       Display_Name                   => No_Name,
        Path_Name                      => No_Name,
        Display_Path_Name              => No_Name,
        Virtual                        => False,
*************** package body Prj is
*** 96,101 ****
--- 102,109 ----
        Display_Library_Dir            => No_Name,
        Library_Src_Dir                => No_Name,
        Display_Library_Src_Dir        => No_Name,
+       Library_ALI_Dir                => No_Name,
+       Display_Library_ALI_Dir        => No_Name,
        Library_Name                   => No_Name,
        Library_Kind                   => Static,
        Lib_Internal_Name              => No_Name,
*************** package body Prj is
*** 115,120 ****
--- 123,129 ----
        Known_Order_Of_Source_Dirs     => True,
        Object_Directory               => No_Name,
        Display_Object_Dir             => No_Name,
+       Library_TS                     => Empty_Time_Stamp,
        Exec_Directory                 => No_Name,
        Display_Exec_Dir               => No_Name,
        Extends                        => No_Project,
*************** package body Prj is
*** 126,131 ****
--- 135,141 ----
        Default_Linker_Path            => No_Name,
        Decl                           => No_Declarations,
        Imported_Projects              => Empty_Project_List,
+       All_Imported_Projects          => Empty_Project_List,
        Ada_Include_Path               => null,
        Ada_Objects_Path               => null,
        Include_Path_File              => No_Name,
*************** package body Prj is
*** 157,182 ****
     -- Add_To_Buffer --
     -------------------
  
!    procedure Add_To_Buffer (S : String) is
     begin
        --  If Buffer is too small, double its size
  
!       if Buffer_Last + S'Length > Buffer'Last then
           declare
              New_Buffer : constant  String_Access :=
!                            new String (1 .. 2 * Buffer'Last);
  
           begin
!             New_Buffer (1 .. Buffer_Last) := Buffer (1 .. Buffer_Last);
!             Free (Buffer);
!             Buffer := New_Buffer;
           end;
!       end if;
  
!       Buffer (Buffer_Last + 1 .. Buffer_Last + S'Length) := S;
!       Buffer_Last := Buffer_Last + S'Length;
     end Add_To_Buffer;
  
     ---------------------------
     -- Display_Language_Name --
     ---------------------------
--- 167,219 ----
     -- Add_To_Buffer --
     -------------------
  
!    procedure Add_To_Buffer
!      (S    : String;
!       To   : in out String_Access;
!       Last : in out Natural)
!    is
     begin
+       if To = null then
+          To := new String (1 .. Initial_Buffer_Size);
+          Last := 0;
+       end if;
+ 
        --  If Buffer is too small, double its size
  
!       while Last + S'Length > To'Last loop
           declare
              New_Buffer : constant  String_Access :=
!                            new String (1 .. 2 * Last);
  
           begin
!             New_Buffer (1 .. Last) := To (1 .. Last);
!             Free (To);
!             To := New_Buffer;
           end;
!       end loop;
  
!       To (Last + 1 .. Last + S'Length) := S;
!       Last := Last + S'Length;
     end Add_To_Buffer;
  
+    -----------------------------
+    -- Default_Ada_Body_Suffix --
+    -----------------------------
+ 
+    function Default_Ada_Body_Suffix return Name_Id is
+    begin
+       return Default_Ada_Body_Suffix_Id;
+    end Default_Ada_Body_Suffix;
+ 
+    -----------------------------
+    -- Default_Ada_Spec_Suffix --
+    -----------------------------
+ 
+    function Default_Ada_Spec_Suffix return Name_Id is
+    begin
+       return Default_Ada_Spec_Suffix_Id;
+    end Default_Ada_Spec_Suffix;
+ 
     ---------------------------
     -- Display_Language_Name --
     ---------------------------
*************** package body Prj is
*** 192,201 ****
     -- Empty_Project --
     -------------------
  
!    function Empty_Project return Project_Data is
     begin
!       Prj.Initialize;
!       return Project_Empty;
     end Empty_Project;
  
     ------------------
--- 229,241 ----
     -- Empty_Project --
     -------------------
  
!    function Empty_Project (Tree : Project_Tree_Ref)  return Project_Data is
!       Value : Project_Data;
     begin
!       Prj.Initialize (Tree => No_Project_Tree);
!       Value := Project_Empty;
!       Value.Naming := Tree.Private_Part.Default_Naming;
!       return Value;
     end Empty_Project;
  
     ------------------
*************** package body Prj is
*** 224,264 ****
  
     procedure For_Every_Project_Imported
       (By         : Project_Id;
        With_State : in out State)
     is
  
!       procedure Check (Project : Project_Id);
        --  Check if a project has already been seen. If not seen, mark it as
        --  Seen, Call Action, and check all its imported projects.
  
!       -----------
!       -- Check --
!       -----------
  
!       procedure Check (Project : Project_Id) is
           List : Project_List;
  
        begin
!          if not Projects.Table (Project).Seen then
!             Projects.Table (Project).Seen := True;
              Action (Project, With_State);
  
!             List := Projects.Table (Project).Imported_Projects;
              while List /= Empty_Project_List loop
!                Check (Project_Lists.Table (List).Project);
!                List := Project_Lists.Table (List).Next;
              end loop;
           end if;
!       end Check;
  
!    --  Start of procecessing for For_Every_Project_Imported
  
     begin
!       for Project in Projects.First .. Projects.Last loop
!          Projects.Table (Project).Seen := False;
        end loop;
  
!       Check (Project => By);
     end For_Every_Project_Imported;
  
     ----------
--- 264,308 ----
  
     procedure For_Every_Project_Imported
       (By         : Project_Id;
+       In_Tree    : Project_Tree_Ref;
        With_State : in out State)
     is
  
!       procedure Recursive_Check (Project : Project_Id);
        --  Check if a project has already been seen. If not seen, mark it as
        --  Seen, Call Action, and check all its imported projects.
  
!       ---------------------
!       -- Recursive_Check --
!       ---------------------
  
!       procedure Recursive_Check (Project : Project_Id) is
           List : Project_List;
  
        begin
!          if not In_Tree.Projects.Table (Project).Seen then
!             In_Tree.Projects.Table (Project).Seen := True;
              Action (Project, With_State);
  
!             List :=
!               In_Tree.Projects.Table (Project).Imported_Projects;
              while List /= Empty_Project_List loop
!                Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
!                List := In_Tree.Project_Lists.Table (List).Next;
              end loop;
           end if;
!       end Recursive_Check;
  
!    --  Start of processing for For_Every_Project_Imported
  
     begin
!       for Project in Project_Table.First ..
!                      Project_Table.Last (In_Tree.Projects)
!       loop
!          In_Tree.Projects.Table (Project).Seen := False;
        end loop;
  
!       Recursive_Check (Project => By);
     end For_Every_Project_Imported;
  
     ----------
*************** package body Prj is
*** 283,289 ****
     -- Initialize --
     ----------------
  
!    procedure Initialize is
     begin
        if not Initialized then
           Initialized := True;
--- 327,333 ----
     -- Initialize --
     ----------------
  
!    procedure Initialize (Tree : Project_Tree_Ref) is
     begin
        if not Initialized then
           Initialized := True;
*************** package body Prj is
*** 293,316 ****
           Empty_Name := The_Empty_String;
           Name_Len := 4;
           Name_Buffer (1 .. 4) := ".ads";
!          Default_Ada_Spec_Suffix := Name_Find;
           Name_Len := 4;
           Name_Buffer (1 .. 4) := ".adb";
!          Default_Ada_Body_Suffix := Name_Find;
           Name_Len := 1;
           Name_Buffer (1) := '/';
!          Slash := Name_Find;
           Name_Len := 3;
           Name_Buffer (1 .. 3) := "c++";
           Name_C_Plus_Plus := Name_Find;
  
           Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
           Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
!          Std_Naming_Data.Separate_Suffix     := Default_Ada_Body_Suffix;
!          Register_Default_Naming_Scheme
!            (Language            => Name_Ada,
!             Default_Spec_Suffix => Default_Ada_Spec_Suffix,
!             Default_Body_Suffix => Default_Ada_Body_Suffix);
           Prj.Env.Initialize;
           Prj.Attr.Initialize;
           Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
--- 337,357 ----
           Empty_Name := The_Empty_String;
           Name_Len := 4;
           Name_Buffer (1 .. 4) := ".ads";
!          Default_Ada_Spec_Suffix_Id := Name_Find;
           Name_Len := 4;
           Name_Buffer (1 .. 4) := ".adb";
!          Default_Ada_Body_Suffix_Id := Name_Find;
           Name_Len := 1;
           Name_Buffer (1) := '/';
!          Slash_Id := Name_Find;
           Name_Len := 3;
           Name_Buffer (1 .. 3) := "c++";
           Name_C_Plus_Plus := Name_Find;
  
           Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
           Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
!          Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
!          Project_Empty.Naming := Std_Naming_Data;
           Prj.Env.Initialize;
           Prj.Attr.Initialize;
           Set_Name_Table_Byte (Name_Project,  Token_Type'Pos (Tok_Project));
*************** package body Prj is
*** 324,329 ****
--- 365,374 ----
           Add_Language_Name (Name_C);
           Add_Language_Name (Name_C_Plus_Plus);
        end if;
+ 
+       if Tree /= No_Project_Tree then
+          Reset (Tree);
+       end if;
     end Initialize;
  
     ----------------
*************** package body Prj is
*** 332,338 ****
  
     function Is_Present
       (Language   : Language_Index;
!       In_Project : Project_Data) return Boolean
     is
     begin
        case Language is
--- 377,384 ----
  
     function Is_Present
       (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Boolean
     is
     begin
        case Language is
*************** package body Prj is
*** 349,355 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Present_Languages.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Present;
--- 395,401 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Present_Languages.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Present;
*************** package body Prj is
*** 369,375 ****
  
     function Language_Processing_Data_Of
       (Language   : Language_Index;
!       In_Project : Project_Data) return Language_Processing_Data
     is
     begin
        case Language is
--- 415,422 ----
  
     function Language_Processing_Data_Of
       (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Language_Processing_Data
     is
     begin
        case Language is
*************** package body Prj is
*** 387,393 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Supp_Languages.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Data;
--- 434,440 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Data;
*************** package body Prj is
*** 408,414 ****
     procedure Register_Default_Naming_Scheme
       (Language            : Name_Id;
        Default_Spec_Suffix : Name_Id;
!       Default_Body_Suffix : Name_Id)
     is
        Lang : Name_Id;
        Suffix : Array_Element_Id;
--- 455,462 ----
     procedure Register_Default_Naming_Scheme
       (Language            : Name_Id;
        Default_Spec_Suffix : Name_Id;
!       Default_Body_Suffix : Name_Id;
!       In_Tree             : Project_Tree_Ref)
     is
        Lang : Name_Id;
        Suffix : Array_Element_Id;
*************** package body Prj is
*** 422,447 ****
        Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
        Lang := Name_Find;
  
!       Suffix := Std_Naming_Data.Spec_Suffix;
        Found := False;
  
        --  Look for an element of the spec sufix array indexed by the language
        --  name. If one is found, put the default value.
  
        while Suffix /= No_Array_Element and then not Found loop
!          Element := Array_Elements.Table (Suffix);
  
           if Element.Index = Lang then
              Found := True;
              Element.Value.Value := Default_Spec_Suffix;
!             Array_Elements.Table (Suffix) := Element;
  
           else
              Suffix := Element.Next;
           end if;
        end loop;
  
!       --  If none can be found, create a new one.
  
        if not Found then
           Element :=
--- 470,495 ----
        Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
        Lang := Name_Find;
  
!       Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
        Found := False;
  
        --  Look for an element of the spec sufix array indexed by the language
        --  name. If one is found, put the default value.
  
        while Suffix /= No_Array_Element and then not Found loop
!          Element := In_Tree.Array_Elements.Table (Suffix);
  
           if Element.Index = Lang then
              Found := True;
              Element.Value.Value := Default_Spec_Suffix;
!             In_Tree.Array_Elements.Table (Suffix) := Element;
  
           else
              Suffix := Element.Next;
           end if;
        end loop;
  
!       --  If none can be found, create a new one
  
        if not Found then
           Element :=
*************** package body Prj is
*** 454,485 ****
                        Default  => False,
                        Value    => Default_Spec_Suffix,
                        Index    => 0),
!             Next  => Std_Naming_Data.Spec_Suffix);
!          Array_Elements.Increment_Last;
!          Array_Elements.Table (Array_Elements.Last) := Element;
!          Std_Naming_Data.Spec_Suffix := Array_Elements.Last;
        end if;
  
!       Suffix := Std_Naming_Data.Body_Suffix;
        Found := False;
  
        --  Look for an element of the body sufix array indexed by the language
        --  name. If one is found, put the default value.
  
        while Suffix /= No_Array_Element and then not Found loop
!          Element := Array_Elements.Table (Suffix);
  
           if Element.Index = Lang then
              Found := True;
              Element.Value.Value := Default_Body_Suffix;
!             Array_Elements.Table (Suffix) := Element;
  
           else
              Suffix := Element.Next;
           end if;
        end loop;
  
!       --  If none can be found, create a new one.
  
        if not Found then
           Element :=
--- 502,536 ----
                        Default  => False,
                        Value    => Default_Spec_Suffix,
                        Index    => 0),
!             Next  => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
!          Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
!          In_Tree.Array_Elements.Table
!            (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
!             Element;
!          In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
!            Array_Element_Table.Last (In_Tree.Array_Elements);
        end if;
  
!       Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
        Found := False;
  
        --  Look for an element of the body sufix array indexed by the language
        --  name. If one is found, put the default value.
  
        while Suffix /= No_Array_Element and then not Found loop
!          Element := In_Tree.Array_Elements.Table (Suffix);
  
           if Element.Index = Lang then
              Found := True;
              Element.Value.Value := Default_Body_Suffix;
!             In_Tree.Array_Elements.Table (Suffix) := Element;
  
           else
              Suffix := Element.Next;
           end if;
        end loop;
  
!       --  If none can be found, create a new one
  
        if not Found then
           Element :=
*************** package body Prj is
*** 492,501 ****
                        Default  => False,
                        Value    => Default_Body_Suffix,
                        Index    => 0),
!             Next  => Std_Naming_Data.Body_Suffix);
!          Array_Elements.Increment_Last;
!          Array_Elements.Table (Array_Elements.Last) := Element;
!          Std_Naming_Data.Body_Suffix := Array_Elements.Last;
        end if;
     end Register_Default_Naming_Scheme;
  
--- 543,556 ----
                        Default  => False,
                        Value    => Default_Body_Suffix,
                        Index    => 0),
!             Next  => In_Tree.Private_Part.Default_Naming.Body_Suffix);
!          Array_Element_Table.Increment_Last
!            (In_Tree.Array_Elements);
!          In_Tree.Array_Elements.Table
!            (Array_Element_Table.Last (In_Tree.Array_Elements))
!              := Element;
!          In_Tree.Private_Part.Default_Naming.Body_Suffix :=
!            Array_Element_Table.Last (In_Tree.Array_Elements);
        end if;
     end Register_Default_Naming_Scheme;
  
*************** package body Prj is
*** 503,519 ****
     -- Reset --
     -----------
  
!    procedure Reset is
     begin
!       Projects.Init;
!       Project_Lists.Init;
!       Packages.Init;
!       Arrays.Init;
!       Variable_Elements.Init;
!       String_Elements.Init;
!       Prj.Com.Units.Init;
!       Prj.Com.Units_Htable.Reset;
!       Prj.Com.Files_Htable.Reset;
     end Reset;
  
     ------------------------
--- 558,591 ----
     -- Reset --
     -----------
  
!    procedure Reset (Tree : Project_Tree_Ref) is
     begin
!       Prj.Env.Initialize;
!       Present_Language_Table.Init (Tree.Present_Languages);
!       Supp_Suffix_Table.Init      (Tree.Supp_Suffixes);
!       Name_List_Table.Init        (Tree.Name_Lists);
!       Supp_Language_Table.Init    (Tree.Supp_Languages);
!       Other_Source_Table.Init     (Tree.Other_Sources);
!       String_Element_Table.Init   (Tree.String_Elements);
!       Variable_Element_Table.Init (Tree.Variable_Elements);
!       Array_Element_Table.Init    (Tree.Array_Elements);
!       Array_Table.Init            (Tree.Arrays);
!       Package_Table.Init          (Tree.Packages);
!       Project_List_Table.Init     (Tree.Project_Lists);
!       Project_Table.Init          (Tree.Projects);
!       Unit_Table.Init             (Tree.Units);
!       Units_Htable.Reset          (Tree.Units_HT);
!       Files_Htable.Reset          (Tree.Files_HT);
!       Naming_Table.Init           (Tree.Private_Part.Namings);
!       Path_File_Table.Init        (Tree.Private_Part.Path_Files);
!       Source_Path_Table.Init      (Tree.Private_Part.Source_Paths);
!       Object_Path_Table.Init      (Tree.Private_Part.Object_Paths);
!       Tree.Private_Part.Default_Naming := Std_Naming_Data;
!       Register_Default_Naming_Scheme
!         (Language            => Name_Ada,
!          Default_Spec_Suffix => Default_Ada_Spec_Suffix,
!          Default_Body_Suffix => Default_Ada_Body_Suffix,
!          In_Tree             => Tree);
     end Reset;
  
     ------------------------
*************** package body Prj is
*** 538,544 ****
     procedure Set
       (Language   : Language_Index;
        Present    : Boolean;
!       In_Project : in out Project_Data)
     is
     begin
        case Language is
--- 610,617 ----
     procedure Set
       (Language   : Language_Index;
        Present    : Boolean;
!       In_Project : in out Project_Data;
!       In_Tree    : Project_Tree_Ref)
     is
     begin
        case Language is
*************** package body Prj is
*** 555,564 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Present_Languages.Table (Supp_Index);
  
                    if Supp.Index = Language then
!                      Present_Languages.Table (Supp_Index).Present := Present;
                       return;
                    end if;
  
--- 628,639 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Present_Languages.Table
!                                                                 (Supp_Index);
  
                    if Supp.Index = Language then
!                      In_Tree.Present_Languages.Table
!                                             (Supp_Index).Present := Present;
                       return;
                    end if;
  
*************** package body Prj is
*** 567,584 ****
  
                 Supp := (Index => Language, Present => Present,
                          Next  => In_Project.Supp_Languages);
!                Present_Languages.Increment_Last;
!                Supp_Index := Present_Languages.Last;
!                Present_Languages.Table (Supp_Index) := Supp;
                 In_Project.Supp_Languages := Supp_Index;
              end;
        end case;
     end Set;
  
     procedure Set
!      (Language_Processing : in Language_Processing_Data;
        For_Language        : Language_Index;
!       In_Project          : in out Project_Data)
     is
     begin
        case For_Language is
--- 642,663 ----
  
                 Supp := (Index => Language, Present => Present,
                          Next  => In_Project.Supp_Languages);
!                Present_Language_Table.Increment_Last
!                  (In_Tree.Present_Languages);
!                Supp_Index := Present_Language_Table.Last
!                  (In_Tree.Present_Languages);
!                In_Tree.Present_Languages.Table (Supp_Index) :=
!                  Supp;
                 In_Project.Supp_Languages := Supp_Index;
              end;
        end case;
     end Set;
  
     procedure Set
!      (Language_Processing : Language_Processing_Data;
        For_Language        : Language_Index;
!       In_Project          : in out Project_Data;
!       In_Tree             : Project_Tree_Ref)
     is
     begin
        case For_Language is
*************** package body Prj is
*** 597,607 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Supp_Languages.Table (Supp_Index);
  
                    if Supp.Index = For_Language then
!                      Supp_Languages.Table (Supp_Index).Data :=
!                        Language_Processing;
                       return;
                    end if;
  
--- 676,686 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Supp_Languages.Table (Supp_Index);
  
                    if Supp.Index = For_Language then
!                      In_Tree.Supp_Languages.Table
!                        (Supp_Index).Data := Language_Processing;
                       return;
                    end if;
  
*************** package body Prj is
*** 610,618 ****
  
                 Supp := (Index => For_Language, Data => Language_Processing,
                          Next  => In_Project.Supp_Language_Processing);
!                Supp_Languages.Increment_Last;
!                Supp_Index := Supp_Languages.Last;
!                Supp_Languages.Table (Supp_Index) := Supp;
                 In_Project.Supp_Language_Processing := Supp_Index;
              end;
        end case;
--- 689,699 ----
  
                 Supp := (Index => For_Language, Data => Language_Processing,
                          Next  => In_Project.Supp_Language_Processing);
!                Supp_Language_Table.Increment_Last
!                  (In_Tree.Supp_Languages);
!                Supp_Index := Supp_Language_Table.Last
!                                (In_Tree.Supp_Languages);
!                In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
                 In_Project.Supp_Language_Processing := Supp_Index;
              end;
        end case;
*************** package body Prj is
*** 621,627 ****
     procedure Set
       (Suffix       : Name_Id;
        For_Language : Language_Index;
!       In_Project   : in out Project_Data)
     is
     begin
        case For_Language is
--- 702,709 ----
     procedure Set
       (Suffix       : Name_Id;
        For_Language : Language_Index;
!       In_Project   : in out Project_Data;
!       In_Tree      : Project_Tree_Ref)
     is
     begin
        case For_Language is
*************** package body Prj is
*** 639,648 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Supp_Suffix_Table.Table (Supp_Index);
  
                    if Supp.Index = For_Language then
!                      Supp_Suffix_Table.Table (Supp_Index).Suffix := Suffix;
                       return;
                    end if;
  
--- 721,732 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Supp_Suffixes.Table
!                                                             (Supp_Index);
  
                    if Supp.Index = For_Language then
!                      In_Tree.Supp_Suffixes.Table
!                        (Supp_Index).Suffix := Suffix;
                       return;
                    end if;
  
*************** package body Prj is
*** 651,673 ****
  
                 Supp := (Index => For_Language, Suffix => Suffix,
                          Next  => In_Project.Naming.Supp_Suffixes);
!                Supp_Suffix_Table.Increment_Last;
!                Supp_Index := Supp_Suffix_Table.Last;
!                Supp_Suffix_Table.Table (Supp_Index) := Supp;
                 In_Project.Naming.Supp_Suffixes := Supp_Index;
              end;
        end case;
     end Set;
  
  
     --------------------------
     -- Standard_Naming_Data --
     --------------------------
  
!    function Standard_Naming_Data return Naming_Data is
     begin
!       Prj.Initialize;
!       return Std_Naming_Data;
     end Standard_Naming_Data;
  
     ---------------
--- 735,774 ----
  
                 Supp := (Index => For_Language, Suffix => Suffix,
                          Next  => In_Project.Naming.Supp_Suffixes);
!                Supp_Suffix_Table.Increment_Last
!                  (In_Tree.Supp_Suffixes);
!                Supp_Index := Supp_Suffix_Table.Last
!                  (In_Tree.Supp_Suffixes);
!                In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
                 In_Project.Naming.Supp_Suffixes := Supp_Index;
              end;
        end case;
     end Set;
  
+    -----------
+    -- Slash --
+    -----------
+ 
+    function Slash return Name_Id is
+    begin
+       return Slash_Id;
+    end Slash;
  
     --------------------------
     -- Standard_Naming_Data --
     --------------------------
  
!    function Standard_Naming_Data
!      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
!    is
     begin
!       if Tree = No_Project_Tree then
!          Prj.Initialize (Tree => No_Project_Tree);
!          return Std_Naming_Data;
! 
!       else
!          return Tree.Private_Part.Default_Naming;
!       end if;
     end Standard_Naming_Data;
  
     ---------------
*************** package body Prj is
*** 676,682 ****
  
     function Suffix_Of
       (Language   : Language_Index;
!       In_Project : Project_Data) return Name_Id
     is
     begin
        case Language is
--- 777,784 ----
  
     function Suffix_Of
       (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Name_Id
     is
     begin
        case Language is
*************** package body Prj is
*** 694,700 ****
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := Supp_Suffix_Table.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Suffix;
--- 796,802 ----
  
              begin
                 while Supp_Index /= No_Supp_Language_Index loop
!                   Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
  
                    if Supp.Index = Language then
                       return Supp.Suffix;
diff -Nrcpad gcc-4.0.2/gcc/ada/prj.ads gcc-4.1.0/gcc/ada/prj.ads
*** gcc-4.0.2/gcc/ada/prj.ads	Wed Dec  8 11:25:42 2004
--- gcc-4.1.0/gcc/ada/prj.ads	Tue Nov 15 13:56:14 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Scans;  use Scans;
*** 35,73 ****
  with Table;
  with Types;  use Types;
  
! with GNAT.OS_Lib; use GNAT.OS_Lib;
  
! with System.HTable; use System.HTable;
  
  package Prj is
  
!    Empty_Name : Name_Id;
!    --  Name_Id for an empty name (no characters). Initialized by the call
!    --  to procedure Initialize.
! 
!    All_Packages : constant String_List_Access := null;
     --  Default value of parameter Packages of procedures Parse, in Prj.Pars and
     --  Prj.Part, indicating that all packages should be checked.
  
!    Virtual_Prefix : constant String := "v$";
!    --  The prefix for virtual extending projects. Because of the '$', which is
!    --  normally forbidden for project names, there cannot be any name clash.
  
!    Project_File_Extension : String := ".gpr";
!    --  The standard project file name extension. It is not a constant, because
!    --  Canonical_Case_File_Name is called on this variable in the body of Prj.
  
!    Default_Ada_Spec_Suffix : Name_Id;
     --  The Name_Id for the standard GNAT suffix for Ada spec source file
     --  name ".ads". Initialized by Prj.Initialize.
  
!    Default_Ada_Body_Suffix : Name_Id;
     --  The Name_Id for the standard GNAT suffix for Ada body source file
     --  name ".adb". Initialized by Prj.Initialize.
  
!    Slash : Name_Id;
     --  "/", used as the path of locally removed files
  
     type Language_Index is new Nat;
  
     No_Language_Index           : constant Language_Index := 0;
--- 35,83 ----
  with Table;
  with Types;  use Types;
  
! with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
! with GNAT.Dynamic_Tables;
! with GNAT.OS_Lib;           use GNAT.OS_Lib;
  
! with System.HTable;
  
  package Prj is
  
!    All_Packages : constant String_List_Access;
     --  Default value of parameter Packages of procedures Parse, in Prj.Pars and
     --  Prj.Part, indicating that all packages should be checked.
  
!    type Project_Tree_Data;
!    type Project_Tree_Ref is access all Project_Tree_Data;
!    --  Reference to a project tree.
!    --  Several project trees may exist in memory at the same time.
  
!    No_Project_Tree : constant Project_Tree_Ref;
  
!    function Default_Ada_Spec_Suffix return Name_Id;
!    pragma Inline (Default_Ada_Spec_Suffix);
     --  The Name_Id for the standard GNAT suffix for Ada spec source file
     --  name ".ads". Initialized by Prj.Initialize.
  
!    function Default_Ada_Body_Suffix return Name_Id;
!    pragma Inline (Default_Ada_Body_Suffix);
     --  The Name_Id for the standard GNAT suffix for Ada body source file
     --  name ".adb". Initialized by Prj.Initialize.
  
!    function Slash return Name_Id;
!    pragma Inline (Slash);
     --  "/", used as the path of locally removed files
  
+    Project_File_Extension : String := ".gpr";
+    --  The standard project file name extension. It is not a constant, because
+    --  Canonical_Case_File_Name is called on this variable in the body of Prj.
+ 
+    -----------------------------------------------------
+    -- Multi-language Stuff That Will be Modified Soon --
+    -----------------------------------------------------
+ 
+    --  Still should be properly commented ???
+ 
     type Language_Index is new Nat;
  
     No_Language_Index           : constant Language_Index := 0;
*************** package Prj is
*** 129,141 ****
        Next    : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Present_Languages is new Table.Table
       (Table_Component_Type => Supp_Language,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Present_Languages");
     --  The table for the presence of languages with an index that is outside
     --  of First_Language_Indexes.
  
--- 139,150 ----
        Next    : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Present_Language_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Supp_Language,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100);
     --  The table for the presence of languages with an index that is outside
     --  of First_Language_Indexes.
  
*************** package Prj is
*** 152,164 ****
        Next    : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Supp_Suffix_Table is new Table.Table
       (Table_Component_Type => Supp_Suffix,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Supp_Suffix_Table");
     --  The table for the presence of languages with an index that is outside
     --  of First_Language_Indexes.
  
--- 161,172 ----
        Next    : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Supp_Suffix_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Supp_Suffix,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100);
     --  The table for the presence of languages with an index that is outside
     --  of First_Language_Indexes.
  
*************** package Prj is
*** 172,184 ****
        Next : Name_List_Index := No_Name_List;
     end record;
  
!    package Name_Lists is new Table.Table
       (Table_Component_Type => Name_Node,
        Table_Index_Type     => Name_List_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 10,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Name_Lists");
     --  The table for lists of names used in package Language_Processing
  
     type Language_Processing_Data is record
--- 180,191 ----
        Next : Name_List_Index := No_Name_List;
     end record;
  
!    package Name_List_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Name_Node,
        Table_Index_Type     => Name_List_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 10,
!       Table_Increment      => 100);
     --  The table for lists of names used in package Language_Processing
  
     type Language_Processing_Data is record
*************** package Prj is
*** 206,213 ****
     type First_Language_Processing_Data is
       array (First_Language_Indexes) of Language_Processing_Data;
  
!    Default_First_Language_Processing_Data : First_Language_Processing_Data :=
!      (others => Default_Language_Processing_Data);
  
     type Supp_Language_Data is record
        Index : Language_Index := No_Language_Index;
--- 213,221 ----
     type First_Language_Processing_Data is
       array (First_Language_Indexes) of Language_Processing_Data;
  
!    Default_First_Language_Processing_Data :
!       constant First_Language_Processing_Data :=
!                  (others => Default_Language_Processing_Data);
  
     type Supp_Language_Data is record
        Index : Language_Index := No_Language_Index;
*************** package Prj is
*** 215,232 ****
        Next  : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Supp_Languages is new Table.Table
       (Table_Component_Type => Supp_Language_Data,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Supp_Languages");
     --  The table for language data when there are more languages than
     --  in First_Language_Indexes.
  
     type Other_Source_Id is new Nat;
     No_Other_Source : constant Other_Source_Id := 0;
     type Other_Source is record
        Language         : Language_Index;       --  language of the source
        File_Name        : Name_Id;              --  source file simple name
--- 223,240 ----
        Next  : Supp_Language_Index := No_Supp_Language_Index;
     end record;
  
!    package Supp_Language_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Supp_Language_Data,
        Table_Index_Type     => Supp_Language_Index,
        Table_Low_Bound      => 1,
        Table_Initial        => 4,
!       Table_Increment      => 100);
     --  The table for language data when there are more languages than
     --  in First_Language_Indexes.
  
     type Other_Source_Id is new Nat;
     No_Other_Source : constant Other_Source_Id := 0;
+ 
     type Other_Source is record
        Language         : Language_Index;       --  language of the source
        File_Name        : Name_Id;              --  source file simple name
*************** package Prj is
*** 243,271 ****
     end record;
     --  Data for a source in a language other than Ada
  
!    package Other_Sources is new Table.Table
       (Table_Component_Type => Other_Source,
        Table_Index_Type     => Other_Source_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Other_Sources");
     --  The table for sources of languages other than Ada
  
     type Verbosity is (Default, Medium, High);
     --  Verbosity when parsing GNAT Project Files
     --    Default is default (very quiet, if no errors).
     --    Medium is more verbose.
     --    High is extremely verbose.
  
     type Lib_Kind is (Static, Dynamic, Relocatable);
     type Policy is (Autonomous, Compliant, Controlled, Restricted);
     --  Type to specify the symbol policy, when symbol control is supported.
     --  See full explanation about this type in package Symbols.
!    --  Autonomous: Create a symbol file without considering any reference
!    --  Compliant: Try to be as compatible as possible with an existing ref
!    --  Controlled: Fail if symbols are not the same as those in the reference
!    --  Restricted: Restrict the symbols to those in the symbol file
  
     type Symbol_Record is record
        Symbol_File   : Name_Id := No_Name;
--- 251,285 ----
     end record;
     --  Data for a source in a language other than Ada
  
!    package Other_Source_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Other_Source,
        Table_Index_Type     => Other_Source_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100);
     --  The table for sources of languages other than Ada
  
+    ----------------------------------
+    --  End of multi-language stuff --
+    ----------------------------------
+ 
     type Verbosity is (Default, Medium, High);
     --  Verbosity when parsing GNAT Project Files
     --    Default is default (very quiet, if no errors).
     --    Medium is more verbose.
     --    High is extremely verbose.
  
+    Current_Verbosity : Verbosity := Default;
+    --  The current value of the verbosity the project files are parsed with
+ 
     type Lib_Kind is (Static, Dynamic, Relocatable);
     type Policy is (Autonomous, Compliant, Controlled, Restricted);
     --  Type to specify the symbol policy, when symbol control is supported.
     --  See full explanation about this type in package Symbols.
!    --    Autonomous: Create a symbol file without considering any reference
!    --    Compliant:  Try to be as compatible as possible with an existing ref
!    --    Controlled: Fail if symbols are not the same as those in the reference
!    --    Restricted: Restrict the symbols to those in the symbol file
  
     type Symbol_Record is record
        Symbol_File   : Name_Id := No_Name;
*************** package Prj is
*** 274,280 ****
     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);
--- 288,294 ----
     end record;
     --  Type to keep the symbol data to be used when building a shared library
  
!    No_Symbols : constant Symbol_Record :=
       (Symbol_File   => No_Name,
        Reference     => No_Name,
        Symbol_Policy => Autonomous);
*************** package Prj is
*** 290,313 ****
     type String_List_Id is new Nat;
     Nil_String : constant String_List_Id := 0;
     type String_Element is record
!       Value    : Name_Id        := No_Name;
!       Index    : Int            := 0;
        Display_Value : Name_Id   := No_Name;
!       Location : Source_Ptr     := No_Location;
!       Flag     : Boolean        := False;
!       Next     : String_List_Id := Nil_String;
     end record;
     --  To hold values for string list variables and array elements.
     --  Component Flag may be used for various purposes. For source
     --  directories, it indicates if the directory contains Ada source(s).
  
!    package String_Elements is new Table.Table
       (Table_Component_Type => String_Element,
        Table_Index_Type     => String_List_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.String_Elements");
     --  The table for string elements in string lists
  
     type Variable_Kind is (Undefined, List, Single);
--- 304,326 ----
     type String_List_Id is new Nat;
     Nil_String : constant String_List_Id := 0;
     type String_Element is record
!       Value         : Name_Id        := No_Name;
!       Index         : Int            := 0;
        Display_Value : Name_Id   := No_Name;
!       Location      : Source_Ptr     := No_Location;
!       Flag          : Boolean        := False;
!       Next          : String_List_Id := Nil_String;
     end record;
     --  To hold values for string list variables and array elements.
     --  Component Flag may be used for various purposes. For source
     --  directories, it indicates if the directory contains Ada source(s).
  
!    package String_Element_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => String_Element,
        Table_Index_Type     => String_List_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100);
     --  The table for string elements in string lists
  
     type Variable_Kind is (Undefined, List, Single);
*************** package Prj is
*** 316,322 ****
     subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
     --  The defined kinds of variables
  
!    Ignored : constant Variable_Kind := Single;
     --  Used to indicate that a package declaration must be ignored
     --  while processing the project tree (unknown package name).
  
--- 329,335 ----
     subtype Defined_Variable_Kind is Variable_Kind range List .. Single;
     --  The defined kinds of variables
  
!    Ignored : constant Variable_Kind;
     --  Used to indicate that a package declaration must be ignored
     --  while processing the project tree (unknown package name).
  
*************** package Prj is
*** 337,365 ****
     --  Values for variables and array elements. Default is True if the
     --  current value is the default one for the variable
  
!    Nil_Variable_Value : constant Variable_Value :=
!      (Project  => No_Project,
!       Kind     => Undefined,
!       Location => No_Location,
!       Default  => False);
     --  Value of a non existing variable or array element
  
     type Variable_Id is new Nat;
     No_Variable : constant Variable_Id := 0;
     type Variable is record
!       Next     : Variable_Id := No_Variable;
!       Name     : Name_Id;
!       Value    : Variable_Value;
     end record;
     --  To hold the list of variables in a project file and in packages
  
!    package Variable_Elements is new Table.Table
       (Table_Component_Type => Variable,
        Table_Index_Type     => Variable_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Variable_Elements");
     --  The table of variable in list of variables
  
     type Array_Element_Id is new Nat;
--- 350,373 ----
     --  Values for variables and array elements. Default is True if the
     --  current value is the default one for the variable
  
!    Nil_Variable_Value : constant Variable_Value;
     --  Value of a non existing variable or array element
  
     type Variable_Id is new Nat;
     No_Variable : constant Variable_Id := 0;
     type Variable is record
!       Next  : Variable_Id := No_Variable;
!       Name  : Name_Id;
!       Value : Variable_Value;
     end record;
     --  To hold the list of variables in a project file and in packages
  
!    package Variable_Element_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Variable,
        Table_Index_Type     => Variable_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100);
     --  The table of variable in list of variables
  
     type Array_Element_Id is new Nat;
*************** package Prj is
*** 374,386 ****
     --  Each Array_Element represents an array element and is linked (Next)
     --  to the next array element, if any, in the array.
  
!    package Array_Elements is new Table.Table
       (Table_Component_Type => Array_Element,
        Table_Index_Type     => Array_Element_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Array_Elements");
     --  The table that contains all array elements
  
     type Array_Id is new Nat;
--- 382,393 ----
     --  Each Array_Element represents an array element and is linked (Next)
     --  to the next array element, if any, in the array.
  
!    package Array_Element_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Array_Element,
        Table_Index_Type     => Array_Element_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100);
     --  The table that contains all array elements
  
     type Array_Id is new Nat;
*************** package Prj is
*** 394,406 ****
     --  Value is the id of the first element.
     --  Next is the id of the next array in the project file or package.
  
!    package Arrays is new Table.Table
       (Table_Component_Type => Array_Data,
        Table_Index_Type     => Array_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Arrays");
     --  The table that contains all arrays
  
     type Package_Id is new Nat;
--- 401,412 ----
     --  Value is the id of the first element.
     --  Next is the id of the next array in the project file or package.
  
!    package Array_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Array_Data,
        Table_Index_Type     => Array_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 200,
!       Table_Increment      => 100);
     --  The table that contains all arrays
  
     type Package_Id is new Nat;
*************** package Prj is
*** 419,425 ****
        Attributes => No_Variable,
        Arrays     => No_Array,
        Packages   => No_Package);
!    --  Default value of Declarations: indicates that there is no declarations.
  
     type Package_Element is record
        Name   : Name_Id      := No_Name;
--- 425,431 ----
        Attributes => No_Variable,
        Arrays     => No_Array,
        Packages   => No_Package);
!    --  Default value of Declarations: indicates that there is no declarations
  
     type Package_Element is record
        Name   : Name_Id      := No_Name;
*************** package Prj is
*** 427,442 ****
        Parent : Package_Id   := No_Package;
        Next   : Package_Id   := No_Package;
     end record;
!    --  A package. Includes declarations that may include other packages.
  
!    package Packages is new Table.Table
       (Table_Component_Type => Package_Element,
        Table_Index_Type     => Package_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 100,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Packages");
!    --  The table that contains all packages.
  
     function Image (Casing : Casing_Type) return String;
     --  Similar to 'Image (but avoid use of this attribute in compiler)
--- 433,447 ----
        Parent : Package_Id   := No_Package;
        Next   : Package_Id   := No_Package;
     end record;
!    --  A package (includes declarations that may include other packages)
  
!    package Package_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Package_Element,
        Table_Index_Type     => Package_Id,
        Table_Low_Bound      => 1,
        Table_Initial        => 100,
!       Table_Increment      => 100);
!    --  The table that contains all packages
  
     function Image (Casing : Casing_Type) return String;
     --  Similar to 'Image (but avoid use of this attribute in compiler)
*************** package Prj is
*** 450,463 ****
     type Naming_Data is record
  
        Dot_Replacement : Name_Id := No_Name;
!       --  The string to replace '.' in the source file name (for Ada).
  
        Dot_Repl_Loc : Source_Ptr := No_Location;
!       --  The position in the project file source where
!       --  Dot_Replacement is defined.
  
        Casing : Casing_Type := All_Lower_Case;
!       --  The casing of the source file name (for Ada).
  
        Spec_Suffix : Array_Element_Id := No_Array_Element;
        --  The string to append to the unit name for the
--- 455,468 ----
     type Naming_Data is record
  
        Dot_Replacement : Name_Id := No_Name;
!       --  The string to replace '.' in the source file name (for Ada)
  
        Dot_Repl_Loc : Source_Ptr := No_Location;
!       --  The position in the project file source where Dot_Replacement is
!       --  defined.
  
        Casing : Casing_Type := All_Lower_Case;
!       --  The casing of the source file name (for Ada)
  
        Spec_Suffix : Array_Element_Id := No_Array_Element;
        --  The string to append to the unit name for the
*************** package Prj is
*** 471,478 ****
        --  The position in the project file source where
        --  Ada_Spec_Suffix is defined.
  
!       Impl_Suffixes    : Impl_Suffix_Array   := No_Impl_Suffixes;
!       Supp_Suffixes    : Supp_Language_Index := No_Supp_Language_Index;
        --  The source suffixes of the different languages
  
        Body_Suffix : Array_Element_Id := No_Array_Element;
--- 476,483 ----
        --  The position in the project file source where
        --  Ada_Spec_Suffix is defined.
  
!       Impl_Suffixes : Impl_Suffix_Array   := No_Impl_Suffixes;
!       Supp_Suffixes : Supp_Language_Index := No_Supp_Language_Index;
        --  The source suffixes of the different languages
  
        Body_Suffix : Array_Element_Id := No_Array_Element;
*************** package Prj is
*** 488,504 ****
        --  Ada_Body_Suffix is defined.
  
        Separate_Suffix : Name_Id := No_Name;
!       --  String to append to unit name for source file name of an Ada subunit.
  
        Sep_Suffix_Loc : Source_Ptr := No_Location;
!       --  Position in the project file source where Separate_Suffix is defined.
  
        Specs : Array_Element_Id := No_Array_Element;
!       --  An associative array mapping individual specs to source file names.
        --  This is specific to Ada.
  
        Bodies : Array_Element_Id := No_Array_Element;
!       --  An associative array mapping individual bodies to source file names.
        --  This is specific to Ada.
  
        Specification_Exceptions : Array_Element_Id := No_Array_Element;
--- 493,509 ----
        --  Ada_Body_Suffix is defined.
  
        Separate_Suffix : Name_Id := No_Name;
!       --  String to append to unit name for source file name of an Ada subunit
  
        Sep_Suffix_Loc : Source_Ptr := No_Location;
!       --  Position in the project file source where Separate_Suffix is defined
  
        Specs : Array_Element_Id := No_Array_Element;
!       --  An associative array mapping individual specs to source file names
        --  This is specific to Ada.
  
        Bodies : Array_Element_Id := No_Array_Element;
!       --  An associative array mapping individual bodies to source file names
        --  This is specific to Ada.
  
        Specification_Exceptions : Array_Element_Id := No_Array_Element;
*************** package Prj is
*** 511,519 ****
  
     end record;
  
!    function Standard_Naming_Data return Naming_Data;
     pragma Inline (Standard_Naming_Data);
!    --  The standard GNAT naming scheme
  
     function Same_Naming_Scheme
       (Left, Right : Naming_Data) return Boolean;
--- 516,527 ----
  
     end record;
  
!    function Standard_Naming_Data
!      (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data;
     pragma Inline (Standard_Naming_Data);
!    --  The standard GNAT naming scheme when Tree is No_Project_Tree.
!    --  Otherwise, return the default naming scheme for the project tree Tree,
!    --  which must have been Initialized.
  
     function Same_Naming_Scheme
       (Left, Right : Naming_Data) return Boolean;
*************** package Prj is
*** 531,543 ****
     --  Element in a list of project files. Next is the id of the next
     --  project file in the list.
  
!    package Project_Lists is new Table.Table
       (Table_Component_Type => Project_Element,
        Table_Index_Type     => Project_List,
        Table_Low_Bound      => 1,
        Table_Initial        => 100,
!       Table_Increment      => 100,
!       Table_Name           => "Prj.Project_Lists");
     --  The table that contains the lists of project files
  
     --  The following record describes a project file representation
--- 539,550 ----
     --  Element in a list of project files. Next is the id of the next
     --  project file in the list.
  
!    package Project_List_Table is new GNAT.Dynamic_Tables
       (Table_Component_Type => Project_Element,
        Table_Index_Type     => Project_List,
        Table_Low_Bound      => 1,
        Table_Initial        => 100,
!       Table_Increment      => 100);
     --  The table that contains the lists of project files
  
     --  The following record describes a project file representation
*************** package Prj is
*** 549,564 ****
        Supp_Languages : Supp_Language_Index  := No_Supp_Language_Index;
        --  Indicate the different languages of the source of this project
  
!       First_Referred_By  : Project_Id := No_Project;
!       --  The project, if any, that was the first to be known
!       --  as importing or extending this project.
!       --  Set by Prj.Proc.Process.
  
        Name : Name_Id := No_Name;
!       --  The name of the project. Set by Prj.Proc.Process.
  
        Path_Name : Name_Id := No_Name;
!       --  The path name of the project file. Set by Prj.Proc.Process.
  
        Display_Path_Name : Name_Id := No_Name;
        --  The path name used for display purposes. May be different from
--- 556,574 ----
        Supp_Languages : Supp_Language_Index  := No_Supp_Language_Index;
        --  Indicate the different languages of the source of this project
  
!       First_Referred_By : Project_Id := No_Project;
!       --  The project, if any, that was the first to be known as importing or
!       --  extending this project. Set by Prj.Proc.Process.
  
        Name : Name_Id := No_Name;
!       --  The name of the project. Set by Prj.Proc.Process
! 
!       Display_Name : Name_Id := No_Name;
!       --  The name of the project with the spelling of its declaration.
!       --  Set by Prj.Proc.Process.
  
        Path_Name : Name_Id := No_Name;
!       --  The path name of the project file. Set by Prj.Proc.Process
  
        Display_Path_Name : Name_Id := No_Name;
        --  The path name used for display purposes. May be different from
*************** package Prj is
*** 572,613 ****
        --  project. Set by Prj.Proc.Process.
  
        Mains : String_List_Id := Nil_String;
!       --  List of mains specified by attribute Main. Set by Prj.Nmsc.Check.
  
        Directory : Name_Id := No_Name;
!       --  Directory where the project file resides. Set by Prj.Proc.Process.
  
        Display_Directory : Name_Id := No_Name;
  
        Dir_Path : String_Access;
!       --  Same as Directory, but as an access to String.
!       --  Set by Make.Compile_Sources.Collect_Arguments_And_Compile.
  
        Library : Boolean := False;
!       --  True if this is a library project.
!       --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Library_Dir : Name_Id := No_Name;
!       --  If a library project, directory where resides the library
!       --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Display_Library_Dir : Name_Id := No_Name;
!       --  The name of the library directory, for display purposes.
!       --  May be different from Library_Dir for platforms where the file names
!       --  are case-insensitive.
  
        Library_Src_Dir : Name_Id := No_Name;
!       --  If a library project, directory where the sources and the ALI files
!       --  of the library are copied. By default, if attribute Library_Src_Dir
!       --  is not specified, sources are not copied anywhere and ALI files are
!       --  copied in the Library Directory.
!       --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Display_Library_Src_Dir : Name_Id := No_Name;
        --  The name of the library source directory, for display purposes.
        --  May be different from Library_Src_Dir for platforms where the file
        --  names are case-insensitive.
  
        Library_Name : Name_Id := No_Name;
        --  If a library project, name of the library
        --  Set by Prj.Nmsc.Language_Independent_Check.
--- 582,637 ----
        --  project. Set by Prj.Proc.Process.
  
        Mains : String_List_Id := Nil_String;
!       --  List of mains specified by attribute Main. Set by Prj.Nmsc.Check
  
        Directory : Name_Id := No_Name;
!       --  Directory where the project file resides. Set by Prj.Proc.Process
  
        Display_Directory : Name_Id := No_Name;
+       --  comment ???
  
        Dir_Path : String_Access;
!       --  Same as Directory, but as an access to String. Set by
!       --  Make.Compile_Sources.Collect_Arguments_And_Compile.
  
        Library : Boolean := False;
!       --  True if this is a library project. Set by
!       --  Prj.Nmsc.Language_Independent_Check.
  
        Library_Dir : Name_Id := No_Name;
!       --  If a library project, directory where resides the library Set by
!       --  Prj.Nmsc.Language_Independent_Check.
  
        Display_Library_Dir : Name_Id := No_Name;
!       --  The name of the library directory, for display purposes. May be
!       --  different from Library_Dir for platforms where the file names are
!       --  case-insensitive.
! 
!       Library_TS : Time_Stamp_Type := Empty_Time_Stamp;
!       --  The timestamp of a library file in a library project.
!       --  Set by MLib.Prj.Check_Library.
  
        Library_Src_Dir : Name_Id := No_Name;
!       --  If a Stand-Alone Library project, directory where the sources
!       --  of the interfaces of the library are copied. By default, if
!       --  attribute Library_Src_Dir is not specified, sources of the interfaces
!       --  are not copied anywhere. Set by Prj.Nmsc.Check_Stand_Alone_Library.
  
        Display_Library_Src_Dir : Name_Id := No_Name;
        --  The name of the library source directory, for display purposes.
        --  May be different from Library_Src_Dir for platforms where the file
        --  names are case-insensitive.
  
+       Library_ALI_Dir : Name_Id := No_Name;
+       --  In a library project, directory where the ALI files are copied.
+       --  If attribute Library_ALI_Dir is not specified, ALI files are
+       --  copied in the Library_Dir. Set by Prj.Nmsc.Check_Library_Attributes.
+ 
+       Display_Library_ALI_Dir : Name_Id := No_Name;
+       --  The name of the library ALI directory, for display purposes. May be
+       --  different from Library_ALI_Dir for platforms where the file names are
+       --  case-insensitive.
+ 
        Library_Name : Name_Id := No_Name;
        --  If a library project, name of the library
        --  Set by Prj.Nmsc.Language_Independent_Check.
*************** package Prj is
*** 617,632 ****
        --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Lib_Internal_Name : Name_Id := No_Name;
!       --  If a library project, internal name store inside the library
!       --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Standalone_Library : Boolean := False;
!       --  Indicate that this is a Standalone Library Project File.
!       --  Set by Prj.Nmsc.Check.
  
        Lib_Interface_ALIs : String_List_Id := Nil_String;
!       --  For Standalone Library Project Files, indicate the list
!       --  of Interface ALI files. Set by Prj.Nmsc.Check.
  
        Lib_Auto_Init : Boolean := False;
        --  For non static Standalone Library Project Files, indicate if
--- 641,656 ----
        --  Set by Prj.Nmsc.Language_Independent_Check.
  
        Lib_Internal_Name : Name_Id := No_Name;
!       --  If a library project, internal name store inside the library Set by
!       --  Prj.Nmsc.Language_Independent_Check.
  
        Standalone_Library : Boolean := False;
!       --  Indicate that this is a Standalone Library Project File. Set by
!       --  Prj.Nmsc.Check.
  
        Lib_Interface_ALIs : String_List_Id := Nil_String;
!       --  For Standalone Library Project Files, indicate the list of Interface
!       --  ALI files. Set by Prj.Nmsc.Check.
  
        Lib_Auto_Init : Boolean := False;
        --  For non static Standalone Library Project Files, indicate if
*************** package Prj is
*** 646,653 ****
        --  A flag that indicates that there are non-Ada sources in this project
  
        Sources : String_List_Id := Nil_String;
!       --  The list of all the source file names. Set by
!       --  Prj.Nmsc.Check_Ada_Naming_Scheme.
  
        First_Other_Source : Other_Source_Id := No_Other_Source;
        Last_Other_Source  : Other_Source_Id := No_Other_Source;
--- 670,677 ----
        --  A flag that indicates that there are non-Ada sources in this project
  
        Sources : String_List_Id := Nil_String;
!       --  The list of all the source file names.
!       --  Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
  
        First_Other_Source : Other_Source_Id := No_Other_Source;
        Last_Other_Source  : Other_Source_Id := No_Other_Source;
*************** package Prj is
*** 687,733 ****
        --  Object_Directory. Set by Prj.Nmsc.Language_Independent_Check.
  
        Display_Exec_Dir : Name_Id := No_Name;
!       --  The name of the exec directory, for display purposes.
!       --  May be different from Exec_Directory for platforms where the file
!       --  names are case-insensitive.
  
        Extends : Project_Id := No_Project;
!       --  The reference of the project file, if any, that this
!       --  project file extends. Set by Prj.Proc.Process.
  
        Extended_By : Project_Id := No_Project;
!       --  The reference of the project file, if any, that
!       --  extends this project file. Set by Prj.Proc.Process.
  
        Naming : Naming_Data := Standard_Naming_Data;
        --  The naming scheme of this project file.
        --  Set by Prj.Nmsc.Check_Naming_Scheme.
  
        First_Language_Processing : First_Language_Processing_Data :=
!         Default_First_Language_Processing_Data;
  
!       Supp_Language_Processing      : Supp_Language_Index :=
!                                        No_Supp_Language_Index;
  
!       Default_Linker                : Name_Id := No_Name;
!       Default_Linker_Path           : Name_Id := No_Name;
  
        Decl : Declarations := No_Declarations;
        --  The declarations (variables, attributes and packages) of this
        --  project file. Set by Prj.Proc.Process.
  
        Imported_Projects : Project_List := Empty_Project_List;
!       --  The list of all directly imported projects, if any.
!       --  Set by Prj.Proc.Process.
  
        Ada_Include_Path : String_Access := null;
!       --  The cached value of ADA_INCLUDE_PATH for this project file.
!       --  Do not use this field directly outside of the compiler, use
        --  Prj.Env.Ada_Include_Path instead. Set by Prj.Env.Ada_Include_Path.
  
        Ada_Objects_Path : String_Access := null;
!       --  The cached value of ADA_OBJECTS_PATH for this project file.
!       --  Do not use this field directly outside of the compiler, use
        --  Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path
  
        Include_Path_File : Name_Id := No_Name;
--- 711,762 ----
        --  Object_Directory. Set by Prj.Nmsc.Language_Independent_Check.
  
        Display_Exec_Dir : Name_Id := No_Name;
!       --  The name of the exec directory, for display purposes. May be
!       --  different from Exec_Directory for platforms where the file names are
!       --  case-insensitive.
  
        Extends : Project_Id := No_Project;
!       --  The reference of the project file, if any, that this project file
!       --  extends. Set by Prj.Proc.Process.
  
        Extended_By : Project_Id := No_Project;
!       --  The reference of the project file, if any, that extends this project
!       --  file. Set by Prj.Proc.Process.
  
        Naming : Naming_Data := Standard_Naming_Data;
        --  The naming scheme of this project file.
        --  Set by Prj.Nmsc.Check_Naming_Scheme.
  
        First_Language_Processing : First_Language_Processing_Data :=
!                                     Default_First_Language_Processing_Data;
!       --  Comment needed ???
  
!       Supp_Language_Processing : Supp_Language_Index := No_Supp_Language_Index;
!       --  Comment needed
  
!       Default_Linker      : Name_Id := No_Name;
!       Default_Linker_Path : Name_Id := No_Name;
  
        Decl : Declarations := No_Declarations;
        --  The declarations (variables, attributes and packages) of this
        --  project file. Set by Prj.Proc.Process.
  
        Imported_Projects : Project_List := Empty_Project_List;
!       --  The list of all directly imported projects, if any. Set by
!       --  Prj.Proc.Process.
! 
!       All_Imported_Projects : Project_List := Empty_Project_List;
!       --  The list of all projects imported directly or indirectly, if any.
!       --  Set by Make.Initialize.
  
        Ada_Include_Path : String_Access := null;
!       --  The cached value of ADA_INCLUDE_PATH for this project file. Do not
!       --  use this field directly outside of the compiler, use
        --  Prj.Env.Ada_Include_Path instead. Set by Prj.Env.Ada_Include_Path.
  
        Ada_Objects_Path : String_Access := null;
!       --  The cached value of ADA_OBJECTS_PATH for this project file. Do not
!       --  use this field directly outside of the compiler, use
        --  Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path
  
        Include_Path_File : Name_Id := No_Name;
*************** package Prj is
*** 764,770 ****
        --  A flag to avoid checking repetitively the naming scheme of
        --  this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
  
!       Seen                           : Boolean := False;
        --  A flag to mark a project as "visited" to avoid processing the same
        --  project several time.
  
--- 793,799 ----
        --  A flag to avoid checking repetitively the naming scheme of
        --  this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme.
  
!       Seen : Boolean := False;
        --  A flag to mark a project as "visited" to avoid processing the same
        --  project several time.
  
*************** package Prj is
*** 782,861 ****
  
     end record;
  
!    function Is_Present
!      (Language   : Language_Index;
!       In_Project : Project_Data) return Boolean;
!    --  Return True when Language is one of the languages used in
!    --  project Project.
! 
!    procedure Set
!      (Language   : Language_Index;
!       Present    : Boolean;
!       In_Project : in out Project_Data);
!    --  Indicate if Language is or not a language used in project Project
! 
!    function Language_Processing_Data_Of
!      (Language   : Language_Index;
!       In_Project : Project_Data) return Language_Processing_Data;
!    --  Return the Language_Processing_Data for language Language in project
!    --  In_Project. Return the default when no Language_Processing_Data are
!    --  defined for the language.
! 
!    procedure Set
!      (Language_Processing : Language_Processing_Data;
!       For_Language        : Language_Index;
!       In_Project          : in out Project_Data);
!    --  Set the Language_Processing_Data for language Language in project
!    --  In_Project.
! 
!    function Suffix_Of
!      (Language   : Language_Index;
!       In_Project : Project_Data) return Name_Id;
!    --  Return the suffix for language Language in project In_Project. Return
!    --  No_Name when no suffix is defined for the language.
! 
!    procedure Set
!      (Suffix       : Name_Id;
!       For_Language : Language_Index;
!       In_Project   : in out Project_Data);
!    --  Set the suffix for language Language in project In_Project
  
     Project_Error : exception;
!    --  Raised by some subprograms in Prj.Attr.
! 
!    function Empty_Project return Project_Data;
!    --  Return the representation of an empty project
  
!    package Projects is new Table.Table (
       Table_Component_Type => Project_Data,
       Table_Index_Type     => Project_Id,
       Table_Low_Bound      => 1,
       Table_Initial        => 100,
!      Table_Increment      => 100,
!      Table_Name           => "Prj.Projects");
     --  The set of all project files
  
     type Put_Line_Access is access procedure
       (Line    : String;
!       Project : Project_Id);
     --  Use to customize error reporting in Prj.Proc and Prj.Nmsc
  
     procedure Expect (The_Token : Token_Type; Token_Image : String);
     --  Check that the current token is The_Token. If it is not, then
     --  output an error message.
  
!    procedure Initialize;
     --  This procedure must be called before using any services from the Prj
     --  hierarchy. Namet.Initialize must be called before Prj.Initialize.
  
!    procedure Reset;
     --  This procedure resets all the tables that are used when processing a
     --  project file tree. Initialize must be called before the call to Reset.
  
     procedure Register_Default_Naming_Scheme
       (Language            : Name_Id;
        Default_Spec_Suffix : Name_Id;
!       Default_Body_Suffix : Name_Id);
     --  Register the default suffixes for a given language. These extensions
     --  will be ignored if the user has specified a new naming scheme in a
     --  project file.
--- 811,936 ----
  
     end record;
  
!    function Empty_Project (Tree : Project_Tree_Ref) return Project_Data;
!    --  Return the representation of an empty project in project Tree tree.
!    --  The project tree Tree must have been Initialized and/or Reset.
  
     Project_Error : exception;
!    --  Raised by some subprograms in Prj.Attr
  
!    package Project_Table is new GNAT.Dynamic_Tables (
       Table_Component_Type => Project_Data,
       Table_Index_Type     => Project_Id,
       Table_Low_Bound      => 1,
       Table_Initial        => 100,
!      Table_Increment      => 100);
     --  The set of all project files
  
+    type Spec_Or_Body is
+      (Specification, Body_Part);
+ 
+    type File_Name_Data is record
+       Name         : Name_Id := No_Name;
+       Index        : Int     := 0;
+       Display_Name : Name_Id := No_Name;
+       Path         : Name_Id := No_Name;
+       Display_Path : Name_Id := No_Name;
+       Project      : Project_Id := No_Project;
+       Needs_Pragma : Boolean := False;
+    end record;
+    --  File and Path name of a spec or body
+ 
+    type File_Names_Data is array (Spec_Or_Body) of File_Name_Data;
+ 
+    type Unit_Id is new Nat;
+    No_Unit : constant Unit_Id := 0;
+    type Unit_Data is record
+       Name       : Name_Id    := No_Name;
+       File_Names : File_Names_Data;
+    end record;
+    --  Name and File and Path names of a unit, with a reference to its
+    --  GNAT Project File(s).
+ 
+    package Unit_Table is new GNAT.Dynamic_Tables
+      (Table_Component_Type => Unit_Data,
+       Table_Index_Type     => Unit_Id,
+       Table_Low_Bound      => 1,
+       Table_Initial        => 100,
+       Table_Increment      => 100);
+    --  Table of all units in a project tree
+ 
+    package Units_Htable is new Simple_HTable
+      (Header_Num => Header_Num,
+       Element    => Unit_Id,
+       No_Element => No_Unit,
+       Key        => Name_Id,
+       Hash       => Hash,
+       Equal      => "=");
+    --  Mapping of unit names to indexes in the Units table
+ 
+    type Unit_Project is record
+       Unit    : Unit_Id    := No_Unit;
+       Project : Project_Id := No_Project;
+    end record;
+ 
+    No_Unit_Project : constant Unit_Project := (No_Unit, No_Project);
+ 
+    package Files_Htable is new Simple_HTable
+      (Header_Num => Header_Num,
+       Element    => Unit_Project,
+       No_Element => No_Unit_Project,
+       Key        => Name_Id,
+       Hash       => Hash,
+       Equal      => "=");
+    --  Mapping of file names to indexes in the Units table
+ 
+    type Private_Project_Tree_Data is private;
+    --  Data for a project tree that is used only by the Project Manager
+ 
+    type Project_Tree_Data is
+       record
+          Present_Languages : Present_Language_Table.Instance;
+          Supp_Suffixes     : Supp_Suffix_Table.Instance;
+          Name_Lists        : Name_List_Table.Instance;
+          Supp_Languages    : Supp_Language_Table.Instance;
+          Other_Sources     : Other_Source_Table.Instance;
+          String_Elements   : String_Element_Table.Instance;
+          Variable_Elements : Variable_Element_Table.Instance;
+          Array_Elements    : Array_Element_Table.Instance;
+          Arrays            : Array_Table.Instance;
+          Packages          : Package_Table.Instance;
+          Project_Lists     : Project_List_Table.Instance;
+          Projects          : Project_Table.Instance;
+          Units             : Unit_Table.Instance;
+          Units_HT          : Units_Htable.Instance;
+          Files_HT          : Files_Htable.Instance;
+          Private_Part      : Private_Project_Tree_Data;
+       end record;
+    --  Data for a project tree
+ 
     type Put_Line_Access is access procedure
       (Line    : String;
!       Project : Project_Id;
!       In_Tree : Project_Tree_Ref);
     --  Use to customize error reporting in Prj.Proc and Prj.Nmsc
  
     procedure Expect (The_Token : Token_Type; Token_Image : String);
     --  Check that the current token is The_Token. If it is not, then
     --  output an error message.
  
!    procedure Initialize (Tree : Project_Tree_Ref);
     --  This procedure must be called before using any services from the Prj
     --  hierarchy. Namet.Initialize must be called before Prj.Initialize.
  
!    procedure Reset (Tree : Project_Tree_Ref);
     --  This procedure resets all the tables that are used when processing a
     --  project file tree. Initialize must be called before the call to Reset.
  
     procedure Register_Default_Naming_Scheme
       (Language            : Name_Id;
        Default_Spec_Suffix : Name_Id;
!       Default_Body_Suffix : Name_Id;
!       In_Tree             : Project_Tree_Ref);
     --  Register the default suffixes for a given language. These extensions
     --  will be ignored if the user has specified a new naming scheme in a
     --  project file.
*************** package Prj is
*** 870,898 ****
           With_State : in out State);
     procedure For_Every_Project_Imported
       (By         : Project_Id;
        With_State : in out State);
     --  Call Action for each project imported directly or indirectly by project
     --  By. Action is called according to the order of importation: if A
     --  imports B, directly or indirectly, Action will be called for A before
!    --  it is called for B. With_State may be used by Action to choose a
!    --  behavior or to report some global result.
  
  private
  
!    Initial_Buffer_Size : constant := 100;
!    --  Initial size for extensible buffer used below
  
!    Buffer : String_Access := new String (1 .. Initial_Buffer_Size);
!    --  An extensible character buffer to store names. Used in Prj.Part and
!    --  Prj.Strt.
  
!    Buffer_Last : Natural := 0;
!    --  The index of the last character in the Buffer
  
!    Current_Packages_To_Check : String_List_Access := All_Packages;
!    --  Global variable, set by Prj.Part.Parse, used by Prj.Dect.
  
!    procedure Add_To_Buffer (S : String);
     --  Append a String to the Buffer
  
  end Prj;
--- 945,1078 ----
           With_State : in out State);
     procedure For_Every_Project_Imported
       (By         : Project_Id;
+       In_Tree    : Project_Tree_Ref;
        With_State : in out State);
     --  Call Action for each project imported directly or indirectly by project
     --  By. Action is called according to the order of importation: if A
     --  imports B, directly or indirectly, Action will be called for A before
!    --  it is called for B. If two projects import each other directly or
!    --  indirectly (using at least one "limited with"), it is not specified
!    --  for which of these two projects Action will be called first. Projects
!    --  that are extended by other projects are not considered. With_State may
!    --  be used by Action to choose a behavior or to report some global result.
! 
!    ----------------------------------------------------------
!    -- Other multi-language stuff that may be modified soon --
!    ----------------------------------------------------------
! 
!    function Is_Present
!      (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Boolean;
!    --  Return True when Language is one of the languages used in
!    --  project In_Project.
! 
!    procedure Set
!      (Language   : Language_Index;
!       Present    : Boolean;
!       In_Project : in out Project_Data;
!       In_Tree    : Project_Tree_Ref);
!    --  Indicate if Language is or not a language used in project In_Project
! 
!    function Language_Processing_Data_Of
!      (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Language_Processing_Data;
!    --  Return the Language_Processing_Data for language Language in project
!    --  In_Project. Return the default when no Language_Processing_Data are
!    --  defined for the language.
! 
!    procedure Set
!      (Language_Processing : Language_Processing_Data;
!       For_Language        : Language_Index;
!       In_Project          : in out Project_Data;
!       In_Tree             : Project_Tree_Ref);
!    --  Set the Language_Processing_Data for language Language in project
!    --  In_Project.
! 
!    function Suffix_Of
!      (Language   : Language_Index;
!       In_Project : Project_Data;
!       In_Tree    : Project_Tree_Ref) return Name_Id;
!    --  Return the suffix for language Language in project In_Project. Return
!    --  No_Name when no suffix is defined for the language.
! 
!    procedure Set
!      (Suffix       : Name_Id;
!       For_Language : Language_Index;
!       In_Project   : in out Project_Data;
!       In_Tree      : Project_Tree_Ref);
!    --  Set the suffix for language Language in project In_Project
  
  private
  
!    All_Packages : constant String_List_Access := null;
  
!    No_Project_Tree : constant Project_Tree_Ref := null;
  
!    Ignored : constant Variable_Kind := Single;
  
!    Nil_Variable_Value : constant Variable_Value :=
!      (Project  => No_Project,
!       Kind     => Undefined,
!       Location => No_Location,
!       Default  => False);
  
!    Virtual_Prefix : constant String := "v$";
!    --  The prefix for virtual extending projects. Because of the '$', which is
!    --  normally forbidden for project names, there cannot be any name clash.
! 
!    Empty_Name : Name_Id;
!    --  Name_Id for an empty name (no characters). Initialized by the call
!    --  to procedure Initialize.
! 
!    procedure Add_To_Buffer
!      (S    : String;
!       To   : in out String_Access;
!       Last : in out Natural);
     --  Append a String to the Buffer
  
+    type Naming_Id is new Nat;
+ 
+    package Naming_Table is new GNAT.Dynamic_Tables
+      (Table_Component_Type => Naming_Data,
+       Table_Index_Type     => Naming_Id,
+       Table_Low_Bound      => 1,
+       Table_Initial        => 5,
+       Table_Increment      => 100);
+    --  Comment ???
+ 
+    package Path_File_Table is new GNAT.Dynamic_Tables
+      (Table_Component_Type => Name_Id,
+       Table_Index_Type     => Natural,
+       Table_Low_Bound      => 1,
+       Table_Initial        => 50,
+       Table_Increment      => 50);
+    --  Table storing all the temp path file names.
+    --  Used by Delete_All_Path_Files.
+ 
+    package Source_Path_Table is new GNAT.Dynamic_Tables
+      (Table_Component_Type => Name_Id,
+       Table_Index_Type     => Natural,
+       Table_Low_Bound      => 1,
+       Table_Initial        => 50,
+       Table_Increment      => 50);
+    --  A table to store the source dirs before creating the source path file
+ 
+    package Object_Path_Table is new GNAT.Dynamic_Tables
+      (Table_Component_Type => Name_Id,
+       Table_Index_Type     => Natural,
+       Table_Low_Bound      => 1,
+       Table_Initial        => 50,
+       Table_Increment      => 50);
+    --  A table to store the object dirs, before creating the object path file
+ 
+    type Private_Project_Tree_Data is record
+       Namings        : Naming_Table.Instance;
+       Path_Files     : Path_File_Table.Instance;
+       Source_Paths   : Source_Path_Table.Instance;
+       Object_Paths   : Object_Path_Table.Instance;
+       Default_Naming : Naming_Data;
+    end record;
+    --  Comment ???
  end Prj;
diff -Nrcpad gcc-4.0.2/gcc/ada/raise-gcc.c gcc-4.1.0/gcc/ada/raise-gcc.c
*** gcc-4.0.2/gcc/ada/raise-gcc.c	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/raise-gcc.c	Wed Nov 16 11:17:47 2005
***************
*** 0 ****
--- 1,1151 ----
+ /****************************************************************************
+  *                                                                          *
+  *                         GNAT COMPILER COMPONENTS                         *
+  *                                                                          *
+  *                            R A I S E - G C C                             *
+  *                                                                          *
+  *                          C Implementation File                           *
+  *                                                                          *
+  *             Copyright (C) 1992-2005, Free Software Foundation, Inc.      *
+  *                                                                          *
+  * GNAT is free software;  you can  redistribute it  and/or modify it under *
+  * terms of the  GNU General Public License as published  by the Free Soft- *
+  * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+  * for  more details.  You should have  received  a copy of the GNU General *
+  * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
+  * Boston, MA 02110-1301, USA.                                              *
+  *                                                                          *
+  * As a  special  exception,  if you  link  this file  with other  files to *
+  * produce an executable,  this file does not by itself cause the resulting *
+  * executable to be covered by the GNU General Public License. This except- *
+  * ion does not  however invalidate  any other reasons  why the  executable *
+  * file might be covered by the  GNU Public License.                        *
+  *                                                                          *
+  * GNAT was originally developed  by the GNAT team at  New York University. *
+  * Extensive contributions were provided by Ada Core Technologies Inc.      *
+  *                                                                          *
+  ****************************************************************************/
+ 
+ /* Code related to the integration of the GCC mechanism for exception
+    handling.  */
+ 
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ /* In the top-of-tree GCC, tconfig does not include tm.h, but in GCC 3.2
+    it does.  To avoid branching raise.c just for that purpose, we kludge by
+    looking for a symbol always defined by tm.h and if it's not defined,
+    we include it.  */
+ #ifndef FIRST_PSEUDO_REGISTER
+ #include "coretypes.h"
+ #include "tm.h"
+ #endif
+ #include "tsystem.h"
+ #include <sys/stat.h>
+ #include <stdarg.h>
+ typedef char bool;
+ # define true 1
+ # define false 0
+ #else
+ #include "config.h"
+ #include "system.h"
+ #endif
+ 
+ #include "adaint.h"
+ #include "raise.h"
+ 
+ /* The names of a couple of "standard" routines for unwinding/propagation
+    actually vary depending on the underlying GCC scheme for exception handling
+    (SJLJ or DWARF). We need a consistently named interface to import from
+    a-except, so wrappers are defined here.
+ 
+    Besides, eventhough the compiler is never setup to use the GCC propagation
+    circuitry, it still relies on exceptions internally and part of the sources
+    to handle to exceptions are shared with the run-time library.  We need
+    dummy definitions for the wrappers to satisfy the linker in this case.
+ 
+    The types to be used by those wrappers in the run-time library are target
+    types exported by unwind.h.  We used to piggyback on them for the compiler
+    stubs, but there is no guarantee that unwind.h is always in sight so we
+    define our own set below.  These are dummy types as the wrappers are never
+    called in the compiler case.  */
+ 
+ #ifdef IN_RTS
+ 
+ #include "unwind.h"
+ 
+ typedef struct _Unwind_Context _Unwind_Context;
+ typedef struct _Unwind_Exception _Unwind_Exception;
+ 
+ #else
+ 
+ typedef void _Unwind_Context;
+ typedef void _Unwind_Exception;
+ typedef int  _Unwind_Reason_Code;
+ 
+ #endif
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_RaiseException (_Unwind_Exception *);
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
+ 
+ 
+ #ifdef IN_RTS   /* For eh personality routine */
+ 
+ #include "dwarf2.h"
+ #include "unwind-dw2-fde.h"
+ #include "unwind-pe.h"
+ 
+ 
+ /* --------------------------------------------------------------
+    -- The DB stuff below is there for debugging purposes only. --
+    -------------------------------------------------------------- */
+ 
+ #define DB_PHASES     0x1
+ #define DB_CSITE      0x2
+ #define DB_ACTIONS    0x4
+ #define DB_REGIONS    0x8
+ 
+ #define DB_ERR        0x1000
+ 
+ /* The "action" stuff below is also there for debugging purposes only.  */
+ 
+ typedef struct
+ {
+   _Unwind_Action phase;
+   char * description;
+ } phase_descriptor;
+ 
+ static phase_descriptor phase_descriptors[]
+   = {{ _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
+      { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
+      { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
+      { _UA_FORCE_UNWIND,  "FORCE_UNWIND" },
+      { -1, 0}};
+ 
+ static int
+ db_accepted_codes (void)
+ {
+   static int accepted_codes = -1;
+ 
+   if (accepted_codes == -1)
+     {
+       char * db_env = (char *) getenv ("EH_DEBUG");
+ 
+       accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
+       /* Arranged for ERR stuff to always be visible when the variable
+ 	 is defined. One may just set the variable to 0 to see the ERR
+ 	 stuff only.  */
+     }
+ 
+   return accepted_codes;
+ }
+ 
+ #define DB_INDENT_INCREASE 0x01
+ #define DB_INDENT_DECREASE 0x02
+ #define DB_INDENT_OUTPUT   0x04
+ #define DB_INDENT_NEWLINE  0x08
+ #define DB_INDENT_RESET    0x10
+ 
+ #define DB_INDENT_UNIT     8
+ 
+ static void
+ db_indent (int requests)
+ {
+   static int current_indentation_level = 0;
+ 
+   if (requests & DB_INDENT_RESET)
+     {
+       current_indentation_level = 0;
+     }
+ 
+   if (requests & DB_INDENT_INCREASE)
+     {
+       current_indentation_level ++;
+     }
+ 
+   if (requests & DB_INDENT_DECREASE)
+     {
+       current_indentation_level --;
+     }
+ 
+   if (requests & DB_INDENT_NEWLINE)
+     {
+       fprintf (stderr, "\n");
+     }
+ 
+   if (requests & DB_INDENT_OUTPUT)
+     {
+       fprintf (stderr, "%*s",
+ 	       current_indentation_level * DB_INDENT_UNIT, " ");
+     }
+ 
+ }
+ 
+ static void ATTRIBUTE_PRINTF_2
+ db (int db_code, char * msg_format, ...)
+ {
+   if (db_accepted_codes () & db_code)
+     {
+       va_list msg_args;
+ 
+       db_indent (DB_INDENT_OUTPUT);
+ 
+       va_start (msg_args, msg_format);
+       vfprintf (stderr, msg_format, msg_args);
+       va_end (msg_args);
+     }
+ }
+ 
+ static void
+ db_phases (int phases)
+ {
+   phase_descriptor *a = phase_descriptors;
+ 
+   if (! (db_accepted_codes() & DB_PHASES))
+     return;
+ 
+   db (DB_PHASES, "\n");
+ 
+   for (; a->description != 0; a++)
+     if (phases & a->phase)
+       db (DB_PHASES, "%s ", a->description);
+ 
+   db (DB_PHASES, " :\n");
+ }
+ 
+ 
+ /* ---------------------------------------------------------------
+    --  Now come a set of useful structures and helper routines. --
+    --------------------------------------------------------------- */
+ 
+ /* There are three major runtime tables involved, generated by the
+    GCC back-end. Contents slightly vary depending on the underlying
+    implementation scheme (dwarf zero cost / sjlj).
+ 
+    =======================================
+    * Tables for the dwarf zero cost case *
+    =======================================
+ 
+    call_site []
+    -------------------------------------------------------------------
+    * region-start | region-length | landing-pad | first-action-index *
+    -------------------------------------------------------------------
+ 
+    Identify possible actions to be taken and where to resume control
+    for that when an exception propagates through a pc inside the region
+    delimited by start and length.
+ 
+    A null landing-pad indicates that nothing is to be done.
+ 
+    Otherwise, first-action-index provides an entry into the action[]
+    table which heads a list of possible actions to be taken (see below).
+ 
+    If it is determined that indeed an action should be taken, that
+    is, if one action filter matches the exception being propagated,
+    then control should be transfered to landing-pad.
+ 
+    A null first-action-index indicates that there are only cleanups
+    to run there.
+ 
+    action []
+    -------------------------------
+    * action-filter | next-action *
+    -------------------------------
+ 
+    This table contains lists (called action chains) of possible actions
+    associated with call-site entries described in the call-site [] table.
+    There is at most one action list per call-site entry.
+ 
+    A null action-filter indicates a cleanup.
+ 
+    Non null action-filters provide an index into the ttypes [] table
+    (see below), from which information may be retrieved to check if it
+    matches the exception being propagated.
+ 
+    action-filter > 0  means there is a regular handler to be run,
+ 
+    action-filter < 0  means there is a some "exception_specification"
+                       data to retrieve, which is only relevant for C++
+ 		      and should never show up for Ada.
+ 
+    next-action indexes the next entry in the list. 0 indicates there is
+    no other entry.
+ 
+    ttypes []
+    ---------------
+    * ttype-value *
+    ---------------
+ 
+    A null value indicates a catch-all handler in C++, and an "others"
+    handler in Ada.
+ 
+    Non null values are used to match the exception being propagated:
+    In C++ this is a pointer to some rtti data, while in Ada this is an
+    exception id.
+ 
+    The special id value 1 indicates an "all_others" handler.
+ 
+    For C++, this table is actually also used to store "exception
+    specification" data. The differentiation between the two kinds
+    of entries is made by the sign of the associated action filter,
+    which translates into positive or negative offsets from the
+    so called base of the table:
+ 
+    Exception Specification data is stored at positive offsets from
+    the ttypes table base, which Exception Type data is stored at
+    negative offsets:
+ 
+    ---------------------------------------------------------------------------
+ 
+    Here is a quick summary of the tables organization:
+ 
+ 	  +-- Unwind_Context (pc, ...)
+ 	  |
+ 	  |(pc)
+ 	  |
+ 	  |   CALL-SITE[]
+ 	  |
+ 	  |   +=============================================================+
+ 	  |   | region-start + length |  landing-pad   | first-action-index |
+ 	  |   +=============================================================+
+ 	  +-> |       pc range          0 => no-action   0 => cleanups only |
+ 	      |                         !0 => jump @              N --+     |
+ 	      +====================================================== | ====+
+                                                                       |
+                                                                       |
+        ACTION []                                                      |
+                                                                       |
+        +==========================================================+   |
+        |              action-filter           |   next-action     |   |
+        +==========================================================+   |
+        |  0 => cleanup                                            |   |
+        | >0 => ttype index for handler ------+  0 => end of chain | <-+
+        | <0 => ttype index for spec data     |                    |
+        +==================================== | ===================+
+                                              |
+                                              |
+        TTYPES []                             |
+ 					     |  Offset negated from
+ 		 +=====================+     |  the actual base.
+ 		 |     ttype-value     |     |
+     +============+=====================+     |
+     |            |  0 => "others"      |     |
+     |    ...     |  1 => "all others"  | <---+
+     |            |  X => exception id  |
+     |  handlers	 +---------------------+
+     |            |        ...          |
+     |    ...     |        ...          |
+     |            |        ...          |
+     +============+=====================+ <<------ Table base
+     |    ...     |        ...          |
+     |   specs    |        ...          | (should not see negative filter
+     |    ...     |        ...          |  values for Ada).
+     +============+=====================+
+ 
+ 
+    ============================
+    * Tables for the sjlj case *
+    ============================
+ 
+    So called "function contexts" are pushed on a context stack by calls to
+    _Unwind_SjLj_Register on function entry, and popped off at exit points by
+    calls to _Unwind_SjLj_Unregister. The current call_site for a function is
+    updated in the function context as the function's code runs along.
+ 
+    The generic unwinding engine in _Unwind_RaiseException walks the function
+    context stack and not the actual call chain.
+ 
+    The ACTION and TTYPES tables remain unchanged, which allows to search them
+    during the propagation phase to determine wether or not the propagated
+    exception is handled somewhere. When it is, we only "jump" up once directly
+    to the context where the handler will be found. Besides, this allows "break
+    exception unhandled" to work also
+ 
+    The CALL-SITE table is setup differently, though: the pc attached to the
+    unwind context is a direct index into the table, so the entries in this
+    table do not hold region bounds any more.
+ 
+    A special index (-1) is used to indicate that no action is possibly
+    connected with the context at hand, so null landing pads cannot appear
+    in the table.
+ 
+    Additionally, landing pad values in the table do not represent code address
+    to jump at, but so called "dispatch" indices used by a common landing pad
+    for the function to switch to the appropriate post-landing-pad.
+ 
+    +-- Unwind_Context (pc, ...)
+    |
+    | pc = call-site index
+    |  0 => terminate (should not see this for Ada)
+    | -1 => no-action
+    |
+    |   CALL-SITE[]
+    |
+    |   +=====================================+
+    |   |  landing-pad   | first-action-index |
+    |   +=====================================+
+    +-> |                  0 => cleanups only |
+        | dispatch index             N        |
+        +=====================================+
+ 
+ 
+    ===================================
+    * Basic organization of this unit *
+    ===================================
+ 
+    The major point of this unit is to provide an exception propagation
+    personality routine for Ada. This is __gnat_eh_personality.
+ 
+    It is provided with a pointer to the propagated exception, an unwind
+    context describing a location the propagation is going through, and a
+    couple of other arguments including a description of the current
+    propagation phase.
+ 
+    It shall return to the generic propagation engine what is to be performed
+    next, after possible context adjustments, depending on what it finds in the
+    traversed context (a handler for the exception, a cleanup, nothing, ...),
+    and on the propagation phase.
+ 
+    A number of structures and subroutines are used for this purpose, as
+    sketched below:
+ 
+    o region_descriptor: General data associated with the context (base pc,
+      call-site table, action table, ttypes table, ...)
+ 
+    o action_descriptor: Data describing the action to be taken for the
+      propagated exception in the provided context (kind of action: nothing,
+      handler, cleanup; pointer to the action table entry, ...).
+ 
+    raise
+      |
+     ... (a-except.adb)
+      |
+    Propagate_Exception (a-exexpr.adb)
+      |
+      |
+    _Unwind_RaiseException (libgcc)
+      |
+      |   (Ada frame)
+      |
+      +--> __gnat_eh_personality (context, exception)
+ 	   |
+ 	   +--> get_region_descriptor_for (context)
+ 	   |
+ 	   +--> get_action_descriptor_for (context, exception, region)
+ 	   |       |
+ 	   |       +--> get_call_site_action_for (context, region)
+ 	   |            (one version for each underlying scheme)
+            |
+ 	   +--> setup_to_install (context)
+ 
+    This unit is inspired from the C++ version found in eh_personality.cc,
+    part of libstdc++-v3.
+ 
+ */
+ 
+ 
+ /* This is an incomplete "proxy" of the structure of exception objects as
+    built by the GNAT runtime library. Accesses to other fields than the common
+    header are performed through subprogram calls to alleviate the need of an
+    exact counterpart here and potential alignment/size issues for the common
+    header. See a-exexpr.adb.  */
+ 
+ typedef struct
+ {
+   _Unwind_Exception common;
+   /* ABI header, maximally aligned. */
+ } _GNAT_Exception;
+ 
+ /* The two constants below are specific ttype identifiers for special
+    exception ids.  Their type should match what a-exexpr exports.  */
+ 
+ extern const int __gnat_others_value;
+ #define GNAT_OTHERS      ((_Unwind_Ptr) &__gnat_others_value)
+ 
+ extern const int __gnat_all_others_value;
+ #define GNAT_ALL_OTHERS  ((_Unwind_Ptr) &__gnat_all_others_value)
+ 
+ /* Describe the useful region data associated with an unwind context.  */
+ 
+ typedef struct
+ {
+   /* The base pc of the region.  */
+   _Unwind_Ptr base;
+ 
+   /* Pointer to the Language Specific Data for the region.  */
+   _Unwind_Ptr lsda;
+ 
+   /* Call-Site data associated with this region.  */
+   unsigned char call_site_encoding;
+   const unsigned char *call_site_table;
+ 
+   /* The base to which are relative landing pad offsets inside the call-site
+      entries .  */
+   _Unwind_Ptr lp_base;
+ 
+   /* Action-Table associated with this region.  */
+   const unsigned char *action_table;
+ 
+   /* Ttype data associated with this region.  */
+   unsigned char ttype_encoding;
+   const unsigned char *ttype_table;
+   _Unwind_Ptr ttype_base;
+ 
+ } region_descriptor;
+ 
+ static void
+ db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
+ {
+   _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+ 
+   if (! (db_accepted_codes () & DB_REGIONS))
+     return;
+ 
+   db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
+ 
+   if (region->lsda)
+     db (DB_REGIONS, "lsda @ 0x%x", region->lsda);
+   else
+     db (DB_REGIONS, "no lsda");
+ 
+   db (DB_REGIONS, "\n");
+ }
+ 
+ /* Retrieve the ttype entry associated with FILTER in the REGION's
+    ttype table.  */
+ 
+ static const _Unwind_Ptr
+ get_ttype_entry_for (region_descriptor *region, long filter)
+ {
+   _Unwind_Ptr ttype_entry;
+ 
+   filter *= size_of_encoded_value (region->ttype_encoding);
+   read_encoded_value_with_base
+     (region->ttype_encoding, region->ttype_base,
+      region->ttype_table - filter, &ttype_entry);
+ 
+   return ttype_entry;
+ }
+ 
+ /* Fill out the REGION descriptor for the provided UW_CONTEXT.  */
+ 
+ static void
+ get_region_description_for (_Unwind_Context *uw_context,
+                             region_descriptor *region)
+ {
+   const unsigned char * p;
+   _Unwind_Word tmp;
+   unsigned char lpbase_encoding;
+ 
+   /* Get the base address of the lsda information. If the provided context
+      is null or if there is no associated language specific data, there's
+      nothing we can/should do.  */
+   region->lsda
+     = (_Unwind_Ptr) (uw_context
+ 		     ? _Unwind_GetLanguageSpecificData (uw_context) : 0);
+ 
+   if (! region->lsda)
+     return;
+ 
+   /* Parse the lsda and fill the region descriptor.  */
+   p = (char *)region->lsda;
+ 
+   region->base = _Unwind_GetRegionStart (uw_context);
+ 
+   /* Find @LPStart, the base to which landing pad offsets are relative.  */
+   lpbase_encoding = *p++;
+   if (lpbase_encoding != DW_EH_PE_omit)
+     p = read_encoded_value
+       (uw_context, lpbase_encoding, p, &region->lp_base);
+   else
+     region->lp_base = region->base;
+ 
+   /* Find @TType, the base of the handler and exception spec type data.  */
+   region->ttype_encoding = *p++;
+   if (region->ttype_encoding != DW_EH_PE_omit)
+     {
+       p = read_uleb128 (p, &tmp);
+       region->ttype_table = p + tmp;
+     }
+    else
+      region->ttype_table = 0;
+ 
+   region->ttype_base
+     = base_of_encoded_value (region->ttype_encoding, uw_context);
+ 
+   /* Get the encoding and length of the call-site table; the action table
+      immediately follows.  */
+   region->call_site_encoding = *p++;
+   region->call_site_table = read_uleb128 (p, &tmp);
+ 
+   region->action_table = region->call_site_table + tmp;
+ }
+ 
+ 
+ /* Describe an action to be taken when propagating an exception up to
+    some context.  */
+ 
+ typedef enum
+ {
+   /* Found some call site base data, but need to analyze further
+      before being able to decide.  */
+   unknown,
+ 
+   /* There is nothing relevant in the context at hand. */
+   nothing,
+ 
+   /* There are only cleanups to run in this context.  */
+   cleanup,
+ 
+   /* There is a handler for the exception in this context.  */
+   handler
+ } action_kind;
+ 
+ /* filter value for cleanup actions.  */
+ const int cleanup_filter = 0;
+ 
+ typedef struct
+ {
+   /* The kind of action to be taken.  */
+   action_kind kind;
+ 
+   /* A pointer to the action record entry.  */
+   const unsigned char *table_entry;
+ 
+   /* Where we should jump to actually take an action (trigger a cleanup or an
+      exception handler).  */
+   _Unwind_Ptr landing_pad;
+ 
+   /* If we have a handler matching our exception, these are the filter to
+      trigger it and the corresponding id.  */
+   _Unwind_Sword ttype_filter;
+   _Unwind_Ptr   ttype_entry;
+ 
+ } action_descriptor;
+ 
+ static void
+ db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
+ {
+   _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
+ 
+   db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
+ 
+   switch (action->kind)
+      {
+      case unknown:
+        db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
+ 	   action->landing_pad, action->table_entry);
+        break;
+ 
+      case nothing:
+        db (DB_ACTIONS, "Nothing\n");
+        break;
+ 
+      case cleanup:
+        db (DB_ACTIONS, "Cleanup\n");
+        break;
+ 
+      case handler:
+        db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter);
+        break;
+ 
+      default:
+        db (DB_ACTIONS, "Err? Unexpected action kind !\n");
+        break;
+     }
+ 
+   return;
+ }
+ 
+ 
+ /* Search the call_site_table of REGION for an entry appropriate for the
+    UW_CONTEXT's ip. If one is found, store the associated landing_pad and
+    action_table entry, and set the ACTION kind to unknown for further
+    analysis. Otherwise, set the ACTION kind to nothing.
+ 
+    There are two variants of this routine, depending on the underlying
+    mechanism (dwarf/sjlj), which account for differences in the tables
+    organization.
+ */
+ 
+ #ifdef __USING_SJLJ_EXCEPTIONS__
+ 
+ #define __builtin_eh_return_data_regno(x) x
+ 
+ static void
+ get_call_site_action_for (_Unwind_Context *uw_context,
+                           region_descriptor *region,
+                           action_descriptor *action)
+ {
+   _Unwind_Ptr call_site
+     = _Unwind_GetIP (uw_context) - 1;
+   /* Subtract 1 because GetIP returns the actual call_site value + 1.  */
+ 
+   /* call_site is a direct index into the call-site table, with two special
+      values : -1 for no-action and 0 for "terminate". The latter should never
+      show up for Ada. To test for the former, beware that _Unwind_Ptr might be
+      unsigned.  */
+ 
+   if ((int)call_site < 0)
+     {
+       action->kind = nothing;
+       return;
+     }
+   else if (call_site == 0)
+     {
+       db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
+       action->kind = nothing;
+       return;
+     }
+   else
+     {
+       _Unwind_Word cs_lp, cs_action;
+ 
+       /* Let the caller know there may be an action to take, but let it
+ 	 determine the kind.  */
+       action->kind = unknown;
+ 
+       /* We have a direct index into the call-site table, but this table is
+ 	 made of leb128 values, the encoding length of which is variable. We
+ 	 can't merely compute an offset from the index, then, but have to read
+ 	 all the entries before the one of interest.  */
+ 
+       const unsigned char * p = region->call_site_table;
+ 
+       do {
+ 	p = read_uleb128 (p, &cs_lp);
+ 	p = read_uleb128 (p, &cs_action);
+       } while (--call_site);
+ 
+ 
+       action->landing_pad = cs_lp + 1;
+ 
+       if (cs_action)
+ 	action->table_entry = region->action_table + cs_action - 1;
+       else
+ 	action->table_entry = 0;
+ 
+       return;
+     }
+ }
+ 
+ #else
+ /* ! __USING_SJLJ_EXCEPTIONS__ */
+ 
+ static void
+ get_call_site_action_for (_Unwind_Context *uw_context,
+                           region_descriptor *region,
+                           action_descriptor *action)
+ {
+   _Unwind_Ptr ip
+     = _Unwind_GetIP (uw_context) - 1;
+   /* Subtract 1 because GetIP yields a call return address while we are
+      interested in information for the call point. This does not always yield
+      the exact call instruction address but always brings the ip back within
+      the corresponding region.
+ 
+      ??? When unwinding up from a signal handler triggered by a trap on some
+      instruction, we usually have the faulting instruction address here and
+      subtracting 1 might get us into the wrong region.  */
+ 
+   const unsigned char * p
+     = region->call_site_table;
+ 
+   /* Unless we are able to determine otherwise ... */
+   action->kind = nothing;
+ 
+   db (DB_CSITE, "\n");
+ 
+   while (p < region->action_table)
+     {
+       _Unwind_Ptr cs_start, cs_len, cs_lp;
+       _Unwind_Word cs_action;
+ 
+       /* Note that all call-site encodings are "absolute" displacements.  */
+       p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
+       p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
+       p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
+       p = read_uleb128 (p, &cs_action);
+ 
+       db (DB_CSITE,
+ 	  "c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n",
+ 	  region->base+cs_start, cs_start, cs_len,
+ 	  region->lp_base+cs_lp, cs_lp);
+ 
+       /* The table is sorted, so if we've passed the ip, stop.  */
+       if (ip < region->base + cs_start)
+  	break;
+ 
+       /* If we have a match, fill the ACTION fields accordingly.  */
+       else if (ip < region->base + cs_start + cs_len)
+ 	{
+ 	  /* Let the caller know there may be an action to take, but let it
+ 	     determine the kind.  */
+ 	  action->kind = unknown;
+ 
+ 	  if (cs_lp)
+ 	    action->landing_pad = region->lp_base + cs_lp;
+ 	  else
+ 	    action->landing_pad = 0;
+ 
+ 	  if (cs_action)
+ 	    action->table_entry = region->action_table + cs_action - 1;
+ 	  else
+ 	    action->table_entry = 0;
+ 
+ 	  db (DB_CSITE, "+++\n");
+ 	  return;
+ 	}
+     }
+ 
+   db (DB_CSITE, "---\n");
+ }
+ 
+ #endif
+ 
+ /* With CHOICE an exception choice representing an "exception - when"
+    argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
+    occurrence, return true iif the latter matches the former, that is, if
+    PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
+    This takes care of the special Non_Ada_Error case on VMS.  */
+ 
+ #define Is_Handled_By_Others  __gnat_is_handled_by_others
+ #define Language_For          __gnat_language_for
+ #define Import_Code_For       __gnat_import_code_for
+ #define EID_For               __gnat_eid_for
+ #define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
+ 
+ extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
+ extern char Language_For (_Unwind_Ptr eid);
+ 
+ extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
+ 
+ extern Exception_Id EID_For (_GNAT_Exception * e);
+ extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
+ 
+ static int
+ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
+ {
+   /* Pointer to the GNAT exception data corresponding to the propagated
+      occurrence.  */
+   _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
+ 
+   /* Base matching rules: An exception data (id) matches itself, "when
+      all_others" matches anything and "when others" matches anything unless
+      explicitly stated otherwise in the propagated occurrence.  */
+ 
+   bool is_handled =
+     choice == E
+     || choice == GNAT_ALL_OTHERS
+     || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
+ 
+   /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
+      may have different exception data pointers that should match for the
+      same condition code, if both an export and an import have been
+      registered.  The import code for both the choice and the propagated
+      occurrence are expected to have been masked off regarding severity
+      bits already (at registration time for the former and from within the
+      low level exception vector for the latter).  */
+ #ifdef VMS
+   #define Non_Ada_Error system__aux_dec__non_ada_error
+   extern struct Exception_Data Non_Ada_Error;
+ 
+   is_handled |=
+     (Language_For (E) == 'V'
+      && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
+      && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
+ 	  && Import_Code_For (choice) == Import_Code_For (E))
+ 	 || choice == (_Unwind_Ptr)&Non_Ada_Error));
+ #endif
+ 
+   return is_handled;
+ }
+ 
+ /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
+    UW_CONTEXT in REGION.  */
+ 
+ static void
+ get_action_description_for (_Unwind_Context *uw_context,
+                             _Unwind_Exception *uw_exception,
+                             region_descriptor *region,
+                             action_descriptor *action)
+ {
+   _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
+ 
+   /* Search the call site table first, which may get us a landing pad as well
+      as the head of an action record list.  */
+   get_call_site_action_for (uw_context, region, action);
+   db_action_for (action, uw_context);
+ 
+   /* If there is not even a call_site entry, we are done.  */
+   if (action->kind == nothing)
+     return;
+ 
+   /* Otherwise, check what we have at the place of the call site.  */
+ 
+   /* No landing pad => no cleanups or handlers.  */
+   if (action->landing_pad == 0)
+     {
+       action->kind = nothing;
+       return;
+     }
+ 
+   /* Landing pad + null table entry => only cleanups.  */
+   else if (action->table_entry == 0)
+     {
+       action->kind = cleanup;
+       action->ttype_filter = cleanup_filter;
+       /* The filter initialization is not strictly necessary, as cleanup-only
+ 	 landing pads don't look at the filter value.  It is there to ensure
+ 	 we don't pass random values and so trigger potential confusion when
+ 	 installing the context later on.  */
+       return;
+     }
+ 
+   /* Landing pad + Table entry => handlers + possible cleanups.  */
+   else
+     {
+       const unsigned char * p = action->table_entry;
+ 
+       _Unwind_Sword ar_filter, ar_disp;
+ 
+       action->kind = nothing;
+ 
+       while (1)
+ 	{
+ 	  p = read_sleb128 (p, &ar_filter);
+ 	  read_sleb128 (p, &ar_disp);
+ 	  /* Don't assign p here, as it will be incremented by ar_disp
+ 	     below.  */
+ 
+ 	  /* Null filters are for cleanups. */
+ 	  if (ar_filter == cleanup_filter)
+ 	    {
+ 	      action->kind = cleanup;
+ 	      action->ttype_filter = cleanup_filter;
+ 	      /* The filter initialization is required here, to ensure
+ 		 the target landing pad branches to the cleanup code if
+ 		 we happen not to find a matching handler.  */
+ 	    }
+ 
+ 	  /* Positive filters are for regular handlers.  */
+ 	  else if (ar_filter > 0)
+ 	    {
+ 	      /* See if the filter we have is for an exception which matches
+ 		 the one we are propagating.  */
+ 	      _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
+ 
+ 	      if (is_handled_by (choice, gnat_exception))
+ 		{
+ 		  action->kind = handler;
+ 		  action->ttype_filter = ar_filter;
+ 		  action->ttype_entry = choice;
+ 		  return;
+ 		}
+ 	    }
+ 
+ 	  /* Negative filter values are for C++ exception specifications.
+ 	     Should not be there for Ada :/  */
+ 	  else
+ 	    db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
+ 
+ 	  if (ar_disp == 0)
+ 	    return;
+ 
+ 	  p += ar_disp;
+ 	}
+     }
+ }
+ 
+ /* Setup in UW_CONTEXT the eh return target IP and data registers, which will
+    be restored with the others and retrieved by the landing pad once the jump
+    occurred.  */
+ 
+ static void
+ setup_to_install (_Unwind_Context *uw_context,
+                   _Unwind_Exception *uw_exception,
+                   _Unwind_Ptr uw_landing_pad,
+                   int uw_filter)
+ {
+ #ifndef EH_RETURN_DATA_REGNO
+   /* We should not be called if the appropriate underlying support is not
+      there.  */
+   abort ();
+ #else
+   /* 1/ exception object pointer, which might be provided back to
+      _Unwind_Resume (and thus to this personality routine) if we are jumping
+      to a cleanup.  */
+   _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
+ 		 (_Unwind_Word)uw_exception);
+ 
+   /* 2/ handler switch value register, which will also be used by the target
+      landing pad to decide what action it shall take.  */
+   _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
+ 		 (_Unwind_Word)uw_filter);
+ 
+   /* Setup the address we should jump at to reach the code where there is the
+      "something" we found.  */
+   _Unwind_SetIP (uw_context, uw_landing_pad);
+ #endif
+ }
+ 
+ /* The following is defined from a-except.adb. Its purpose is to enable
+    automatic backtraces upon exception raise, as provided through the
+    GNAT.Traceback facilities.  */
+ extern void __gnat_notify_handled_exception (void);
+ extern void __gnat_notify_unhandled_exception (void);
+ 
+ /* Below is the eh personality routine per se. We currently assume that only
+    GNU-Ada exceptions are met.  */
+ 
+ _Unwind_Reason_Code
+ __gnat_eh_personality (int uw_version,
+                        _Unwind_Action uw_phases,
+                        _Unwind_Exception_Class uw_exception_class,
+                        _Unwind_Exception *uw_exception,
+                        _Unwind_Context *uw_context)
+ {
+   _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
+ 
+   region_descriptor region;
+   action_descriptor action;
+ 
+   if (uw_version != 1)
+     return _URC_FATAL_PHASE1_ERROR;
+ 
+   db_indent (DB_INDENT_RESET);
+   db_phases (uw_phases);
+   db_indent (DB_INDENT_INCREASE);
+ 
+   /* Get the region description for the context we were provided with. This
+      will tell us if there is some lsda, call_site, action and/or ttype data
+      for the associated ip.  */
+   get_region_description_for (uw_context, &region);
+   db_region_for (&region, uw_context);
+ 
+   /* No LSDA => no handlers or cleanups => we shall unwind further up.  */
+   if (! region.lsda)
+     return _URC_CONTINUE_UNWIND;
+ 
+   /* Search the call-site and action-record tables for the action associated
+      with this IP.  */
+   get_action_description_for (uw_context, uw_exception, &region, &action);
+   db_action_for (&action, uw_context);
+ 
+   /* Whatever the phase, if there is nothing relevant in this frame,
+      unwinding should just go on.  */
+   if (action.kind == nothing)
+     return _URC_CONTINUE_UNWIND;
+ 
+   /* If we found something in search phase, we should return a code indicating
+      what to do next depending on what we found. If we only have cleanups
+      around, we shall try to unwind further up to find a handler, otherwise,
+      tell we have a handler, which will trigger the second phase.  */
+   if (uw_phases & _UA_SEARCH_PHASE)
+     {
+       if (action.kind == cleanup)
+ 	{
+ 	  Adjust_N_Cleanups_For (gnat_exception, 1);
+ 	  return _URC_CONTINUE_UNWIND;
+ 	}
+       else
+ 	{
+ 	  /* Trigger the appropriate notification routines before the second
+ 	     phase starts, which ensures the stack is still intact. */
+ 	  __gnat_notify_handled_exception ();
+ 
+ 	  return _URC_HANDLER_FOUND;
+ 	}
+     }
+ 
+   /* We found something in cleanup/handler phase, which might be the handler
+      or a cleanup for a handled occurrence, or a cleanup for an unhandled
+      occurrence (we are in a FORCED_UNWIND phase in this case). Install the
+      context to get there.  */
+ 
+   /* If we are going to install a cleanup context, decrement the cleanup
+      count.  This is required in a FORCED_UNWINDing phase (for an unhandled
+      exception), as this is used from the forced unwinding handler in
+      Ada.Exceptions.Exception_Propagation to decide wether unwinding should
+      proceed further or Unhandled_Exception_Terminate should be called.  */
+   if (action.kind == cleanup)
+     Adjust_N_Cleanups_For (gnat_exception, -1);
+ 
+   setup_to_install
+     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
+ 
+   return _URC_INSTALL_CONTEXT;
+ }
+ 
+ /* Define the consistently named wrappers imported by Propagate_Exception.  */
+ 
+ #ifdef __USING_SJLJ_EXCEPTIONS__
+ 
+ #undef _Unwind_RaiseException
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_RaiseException (_Unwind_Exception *e)
+ {
+   return _Unwind_SjLj_RaiseException (e);
+ }
+ 
+ 
+ #undef _Unwind_ForcedUnwind
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
+                             void * handler,
+                             void * argument)
+ {
+   return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
+ }
+ 
+ 
+ #else /* __USING_SJLJ_EXCEPTIONS__ */
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_RaiseException (_Unwind_Exception *e)
+ {
+   return _Unwind_RaiseException (e);
+ }
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
+                             void * handler,
+                             void * argument)
+ {
+   return _Unwind_ForcedUnwind (e, handler, argument);
+ }
+ 
+ #endif /* __USING_SJLJ_EXCEPTIONS__ */
+ 
+ #else
+ /* ! IN_RTS  */
+ 
+ /* Define the corresponding stubs for the compiler.  */
+ 
+ /* We don't want fancy_abort here.  */
+ #undef abort
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_RaiseException (_Unwind_Exception *e ATTRIBUTE_UNUSED)
+ {
+   abort ();
+ }
+ 
+ 
+ _Unwind_Reason_Code
+ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
+                             void * handler ATTRIBUTE_UNUSED,
+                             void * argument ATTRIBUTE_UNUSED)
+ {
+   abort ();
+ }
+ 
+ #endif /* IN_RTS */
diff -Nrcpad gcc-4.0.2/gcc/ada/raise.c gcc-4.1.0/gcc/ada/raise.c
*** gcc-4.0.2/gcc/ada/raise.c	Fri Nov 19 10:54:52 2004
--- gcc-4.1.0/gcc/ada/raise.c	Tue Nov 15 13:52:55 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *             Copyright (C) 1992-2004, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *             Copyright (C) 1992-2005, 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 30,52 ****
   *                                                                          *
   ****************************************************************************/
  
! /* Routines to support runtime exception handling */
  
  #ifdef IN_RTS
  #include "tconfig.h"
- /* In the top-of-tree GCC, tconfig does not include tm.h, but in GCC 3.2
-    it does.  To avoid branching raise.c just for that purpose, we kludge by
-    looking for a symbol always defined by tm.h and if it's not defined,
-    we include it.  */
- #ifndef FIRST_PSEUDO_REGISTER
- #include "coretypes.h"
- #include "tm.h"
- #endif
  #include "tsystem.h"
- #include <sys/stat.h>
- typedef char bool;
- # define true 1
- # define false 0
  #else
  #include "config.h"
  #include "system.h"
--- 30,44 ----
   *                                                                          *
   ****************************************************************************/
  
! /* Shared routines to support exception handling.
!    Note that _gnat_builtin_longjmp should disappear at some point, replaced
!    by direct call to __builtin_longjmp from Ada code.
!    __gnat_unhandled_terminate is code shared between all exception handling
!    mechanisms */
  
  #ifdef IN_RTS
  #include "tconfig.h"
  #include "tsystem.h"
  #else
  #include "config.h"
  #include "system.h"
*************** _gnat_builtin_longjmp (void *ptr, int fl
*** 72,1163 ****
  void
  __gnat_unhandled_terminate (void)
  {
-   /* Special termination handling for VMS */
- 
- #ifdef VMS
-     {
-       long prvhnd;
- 
-       /* Remove the exception vector so it won't intercept any errors
- 	 in the call to exit, and go into and endless loop */
- 
-       SYS$SETEXV (1, 0, 3, &prvhnd);
-       __gnat_os_exit (1);
-     }
- 
- /* Termination handling for all other systems. */
- 
- #elif !defined (__RT__)
-     __gnat_os_exit (1);
- #endif
- }
- 
- /* Below is the code related to the integration of the GCC mechanism for
-    exception handling.  */
- 
- #include "unwind.h"
- 
- /* The names of a couple of "standard" routines for unwinding/propagation
-    actually vary depending on the underlying GCC scheme for exception handling
-    (SJLJ or DWARF). We need a consistently named interface to import from
-    a-except, so stubs are defined here.  */
- 
- typedef struct _Unwind_Context _Unwind_Context;
- typedef struct _Unwind_Exception _Unwind_Exception;
- 
- _Unwind_Reason_Code
- __gnat_Unwind_RaiseException (_Unwind_Exception *);
- 
- _Unwind_Reason_Code
- __gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
- 
- 
- #ifdef IN_RTS   /* For eh personality routine */
- 
- #include "dwarf2.h"
- #include "unwind-dw2-fde.h"
- #include "unwind-pe.h"
- 
- 
- /* --------------------------------------------------------------
-    -- The DB stuff below is there for debugging purposes only. --
-    -------------------------------------------------------------- */
- 
- #define DB_PHASES     0x1
- #define DB_CSITE      0x2
- #define DB_ACTIONS    0x4
- #define DB_REGIONS    0x8
- 
- #define DB_ERR        0x1000
- 
- /* The "action" stuff below is also there for debugging purposes only.  */
- 
- typedef struct
- {
-   _Unwind_Action phase;
-   char * description;
- } phase_descriptor;
- 
- static phase_descriptor phase_descriptors[]
-   = {{ _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
-      { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
-      { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
-      { _UA_FORCE_UNWIND,  "FORCE_UNWIND" },
-      { -1, 0}};
- 
- static int
- db_accepted_codes (void)
- {
-   static int accepted_codes = -1;
- 
-   if (accepted_codes == -1)
-     {
-       char * db_env = (char *) getenv ("EH_DEBUG");
- 
-       accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
-       /* Arranged for ERR stuff to always be visible when the variable
- 	 is defined. One may just set the variable to 0 to see the ERR
- 	 stuff only.  */
-     }
- 
-   return accepted_codes;
- }
- 
- #define DB_INDENT_INCREASE 0x01
- #define DB_INDENT_DECREASE 0x02
- #define DB_INDENT_OUTPUT   0x04
- #define DB_INDENT_NEWLINE  0x08
- #define DB_INDENT_RESET    0x10
- 
- #define DB_INDENT_UNIT     8
- 
- static void
- db_indent (int requests)
- {
-   static int current_indentation_level = 0;
- 
-   if (requests & DB_INDENT_RESET)
-     {
-       current_indentation_level = 0;
-     }
- 
-   if (requests & DB_INDENT_INCREASE)
-     {
-       current_indentation_level ++;
-     }
- 
-   if (requests & DB_INDENT_DECREASE)
-     {
-       current_indentation_level --;
-     }
- 
-   if (requests & DB_INDENT_NEWLINE)
-     {
-       fprintf (stderr, "\n");
-     }
- 
-   if (requests & DB_INDENT_OUTPUT)
-     {
-       fprintf (stderr, "%*s",
- 	       current_indentation_level * DB_INDENT_UNIT, " ");
-     }
- 
- }
- 
- static void
- db (int db_code, char * msg_format, ...)
- {
-   if (db_accepted_codes () & db_code)
-     {
-       va_list msg_args;
- 
-       db_indent (DB_INDENT_OUTPUT);
- 
-       va_start (msg_args, msg_format);
-       vfprintf (stderr, msg_format, msg_args);
-       va_end (msg_args);
-     }
- }
- 
- static void
- db_phases (int phases)
- {
-   phase_descriptor *a = phase_descriptors;
- 
-   if (! (db_accepted_codes() & DB_PHASES))
-     return;
- 
-   db (DB_PHASES, "\n");
- 
-   for (; a->description != 0; a++)
-     if (phases & a->phase)
-       db (DB_PHASES, "%s ", a->description);
- 
-   db (DB_PHASES, " :\n");
- }
- 
- 
- /* ---------------------------------------------------------------
-    --  Now come a set of useful structures and helper routines. --
-    --------------------------------------------------------------- */
- 
- /* There are three major runtime tables involved, generated by the
-    GCC back-end. Contents slightly vary depending on the underlying
-    implementation scheme (dwarf zero cost / sjlj).
- 
-    =======================================
-    * Tables for the dwarf zero cost case *
-    =======================================
- 
-    call_site []
-    -------------------------------------------------------------------
-    * region-start | region-length | landing-pad | first-action-index *
-    -------------------------------------------------------------------
- 
-    Identify possible actions to be taken and where to resume control
-    for that when an exception propagates through a pc inside the region
-    delimited by start and length.
- 
-    A null landing-pad indicates that nothing is to be done.
- 
-    Otherwise, first-action-index provides an entry into the action[]
-    table which heads a list of possible actions to be taken (see below).
- 
-    If it is determined that indeed an action should be taken, that
-    is, if one action filter matches the exception beeing propagated,
-    then control should be transfered to landing-pad.
- 
-    A null first-action-index indicates that there are only cleanups
-    to run there.
- 
-    action []
-    -------------------------------
-    * action-filter | next-action *
-    -------------------------------
- 
-    This table contains lists (called action chains) of possible actions
-    associated with call-site entries described in the call-site [] table.
-    There is at most one action list per call-site entry.
- 
-    A null action-filter indicates a cleanup.
- 
-    Non null action-filters provide an index into the ttypes [] table
-    (see below), from which information may be retrieved to check if it
-    matches the exception beeing propagated.
- 
-    action-filter > 0  means there is a regular handler to be run,
- 
-    action-filter < 0  means there is a some "exception_specification"
-                       data to retrieve, which is only relevant for C++
- 		      and should never show up for Ada.
- 
-    next-action indexes the next entry in the list. 0 indicates there is
-    no other entry.
- 
-    ttypes []
-    ---------------
-    * ttype-value *
-    ---------------
- 
-    A null value indicates a catch-all handler in C++, and an "others"
-    handler in Ada.
- 
-    Non null values are used to match the exception beeing propagated:
-    In C++ this is a pointer to some rtti data, while in Ada this is an
-    exception id.
- 
-    The special id value 1 indicates an "all_others" handler.
- 
-    For C++, this table is actually also used to store "exception
-    specification" data. The differentiation between the two kinds
-    of entries is made by the sign of the associated action filter,
-    which translates into positive or negative offsets from the
-    so called base of the table:
- 
-    Exception Specification data is stored at positive offsets from
-    the ttypes table base, which Exception Type data is stored at
-    negative offsets:
- 
-    ---------------------------------------------------------------------------
- 
-    Here is a quick summary of the tables organization:
- 
- 	  +-- Unwind_Context (pc, ...)
- 	  |
- 	  |(pc)
- 	  |
- 	  |   CALL-SITE[]
- 	  |
- 	  |   +=============================================================+
- 	  |   | region-start + length |  landing-pad   | first-action-index |
- 	  |   +=============================================================+
- 	  +-> |       pc range          0 => no-action   0 => cleanups only |
- 	      |                         !0 => jump @              N --+     |
- 	      +====================================================== | ====+
-                                                                       |
-                                                                       |
-        ACTION []                                                      |
-                                                                       |
-        +==========================================================+   |
-        |              action-filter           |   next-action     |   |
-        +==========================================================+   |
-        |  0 => cleanup                                            |   |
-        | >0 => ttype index for handler ------+  0 => end of chain | <-+
-        | <0 => ttype index for spec data     |                    |
-        +==================================== | ===================+
-                                              |
-                                              |
-        TTYPES []                             |
- 					     |  Offset negated from
- 		 +=====================+     |  the actual base.
- 		 |     ttype-value     |     |
-     +============+=====================+     |
-     |            |  0 => "others"      |     |
-     |    ...     |  1 => "all others"  | <---+
-     |            |  X => exception id  |
-     |  handlers	 +---------------------+
-     |            |        ...          |
-     |    ...     |        ...          |
-     |            |        ...          |
-     +============+=====================+ <<------ Table base
-     |    ...     |        ...          |
-     |   specs    |        ...          | (should not see negative filter
-     |    ...     |        ...          |  values for Ada).
-     +============+=====================+
- 
- 
-    ============================
-    * Tables for the sjlj case *
-    ============================
- 
-    So called "function contexts" are pushed on a context stack by calls to
-    _Unwind_SjLj_Register on function entry, and popped off at exit points by
-    calls to _Unwind_SjLj_Unregister. The current call_site for a function is
-    updated in the function context as the function's code runs along.
- 
-    The generic unwinding engine in _Unwind_RaiseException walks the function
-    context stack and not the actual call chain.
- 
-    The ACTION and TTYPES tables remain unchanged, which allows to search them
-    during the propagation phase to determine wether or not the propagated
-    exception is handled somewhere. When it is, we only "jump" up once directly
-    to the context where the handler will be found. Besides, this allows "break
-    exception unhandled" to work also
- 
-    The CALL-SITE table is setup differently, though: the pc attached to the
-    unwind context is a direct index into the table, so the entries in this
-    table do not hold region bounds any more.
- 
-    A special index (-1) is used to indicate that no action is possibly
-    connected with the context at hand, so null landing pads cannot appear
-    in the table.
- 
-    Additionally, landing pad values in the table do not represent code address
-    to jump at, but so called "dispatch" indices used by a common landing pad
-    for the function to switch to the appropriate post-landing-pad.
- 
-    +-- Unwind_Context (pc, ...)
-    |
-    | pc = call-site index
-    |  0 => terminate (should not see this for Ada)
-    | -1 => no-action
-    |
-    |   CALL-SITE[]
-    |
-    |   +=====================================+
-    |   |  landing-pad   | first-action-index |
-    |   +=====================================+
-    +-> |                  0 => cleanups only |
-        | dispatch index             N        |
-        +=====================================+
- 
- 
-    ===================================
-    * Basic organization of this unit *
-    ===================================
- 
-    The major point of this unit is to provide an exception propagation
-    personality routine for Ada. This is __gnat_eh_personality.
- 
-    It is provided with a pointer to the propagated exception, an unwind
-    context describing a location the propagation is going through, and a
-    couple of other arguments including a description of the current
-    propagation phase.
- 
-    It shall return to the generic propagation engine what is to be performed
-    next, after possible context adjustments, depending on what it finds in the
-    traversed context (a handler for the exception, a cleanup, nothing, ...),
-    and on the propagation phase.
- 
-    A number of structures and subroutines are used for this purpose, as
-    sketched below:
- 
-    o region_descriptor: General data associated with the context (base pc,
-      call-site table, action table, ttypes table, ...)
- 
-    o action_descriptor: Data describing the action to be taken for the
-      propagated exception in the provided context (kind of action: nothing,
-      handler, cleanup; pointer to the action table entry, ...).
- 
-    raise
-      |
-     ... (a-except.adb)
-      |
-    Propagate_Exception (a-exexpr.adb)
-      |
-      |
-    _Unwind_RaiseException (libgcc)
-      |
-      |   (Ada frame)
-      |
-      +--> __gnat_eh_personality (context, exception)
- 	   |
- 	   +--> get_region_descriptor_for (context)
- 	   |
- 	   +--> get_action_descriptor_for (context, exception, region)
- 	   |       |
- 	   |       +--> get_call_site_action_for (context, region)
- 	   |            (one version for each underlying scheme)
-            |
- 	   +--> setup_to_install (context)
- 
-    This unit is inspired from the C++ version found in eh_personality.cc,
-    part of libstdc++-v3.
- 
- */
- 
- 
- /* This is an incomplete "proxy" of the structure of exception objects as
-    built by the GNAT runtime library. Accesses to other fields than the common
-    header are performed through subprogram calls to aleviate the need of an
-    exact counterpart here and potential alignment/size issues for the common
-    header. See a-exexpr.adb.  */
- 
- typedef struct
- {
-   _Unwind_Exception common;
-   /* ABI header, maximally aligned. */
- } _GNAT_Exception;
- 
- /* The two constants below are specific ttype identifiers for special
-    exception ids.  Their type should match what a-exexpr exports.  */
- 
- extern const int __gnat_others_value;
- #define GNAT_OTHERS      ((_Unwind_Ptr) &__gnat_others_value)
- 
- extern const int __gnat_all_others_value;
- #define GNAT_ALL_OTHERS  ((_Unwind_Ptr) &__gnat_all_others_value)
- 
- /* Describe the useful region data associated with an unwind context.  */
- 
- typedef struct
- {
-   /* The base pc of the region.  */
-   _Unwind_Ptr base;
- 
-   /* Pointer to the Language Specific Data for the region.  */
-   _Unwind_Ptr lsda;
- 
-   /* Call-Site data associated with this region.  */
-   unsigned char call_site_encoding;
-   const unsigned char *call_site_table;
- 
-   /* The base to which are relative landing pad offsets inside the call-site
-      entries .  */
-   _Unwind_Ptr lp_base;
- 
-   /* Action-Table associated with this region.  */
-   const unsigned char *action_table;
- 
-   /* Ttype data associated with this region.  */
-   unsigned char ttype_encoding;
-   const unsigned char *ttype_table;
-   _Unwind_Ptr ttype_base;
- 
- } region_descriptor;
- 
- static void
- db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
- {
-   _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
- 
-   if (! (db_accepted_codes () & DB_REGIONS))
-     return;
- 
-   db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
- 
-   if (region->lsda)
-     db (DB_REGIONS, "lsda @ 0x%x", region->lsda);
-   else
-     db (DB_REGIONS, "no lsda");
- 
-   db (DB_REGIONS, "\n");
- }
- 
- /* Retrieve the ttype entry associated with FILTER in the REGION's
-    ttype table.  */
- 
- static const _Unwind_Ptr
- get_ttype_entry_for (region_descriptor *region, long filter)
- {
-   _Unwind_Ptr ttype_entry;
- 
-   filter *= size_of_encoded_value (region->ttype_encoding);
-   read_encoded_value_with_base
-     (region->ttype_encoding, region->ttype_base,
-      region->ttype_table - filter, &ttype_entry);
- 
-   return ttype_entry;
- }
- 
- /* Fill out the REGION descriptor for the provided UW_CONTEXT.  */
- 
- static void
- get_region_description_for (_Unwind_Context *uw_context,
-                             region_descriptor *region)
- {
-   const unsigned char * p;
-   _Unwind_Word tmp;
-   unsigned char lpbase_encoding;
- 
-   /* Get the base address of the lsda information. If the provided context
-      is null or if there is no associated language specific data, there's
-      nothing we can/should do.  */
-   region->lsda
-     = (_Unwind_Ptr) (uw_context
- 		     ? _Unwind_GetLanguageSpecificData (uw_context) : 0);
- 
-   if (! region->lsda)
-     return;
- 
-   /* Parse the lsda and fill the region descriptor.  */
-   p = (char *)region->lsda;
- 
-   region->base = _Unwind_GetRegionStart (uw_context);
- 
-   /* Find @LPStart, the base to which landing pad offsets are relative.  */
-   lpbase_encoding = *p++;
-   if (lpbase_encoding != DW_EH_PE_omit)
-     p = read_encoded_value
-       (uw_context, lpbase_encoding, p, &region->lp_base);
-   else
-     region->lp_base = region->base;
- 
-   /* Find @TType, the base of the handler and exception spec type data.  */
-   region->ttype_encoding = *p++;
-   if (region->ttype_encoding != DW_EH_PE_omit)
-     {
-       p = read_uleb128 (p, &tmp);
-       region->ttype_table = p + tmp;
-     }
-    else
-      region->ttype_table = 0;
- 
-   region->ttype_base
-     = base_of_encoded_value (region->ttype_encoding, uw_context);
- 
-   /* Get the encoding and length of the call-site table; the action table
-      immediately follows.  */
-   region->call_site_encoding = *p++;
-   region->call_site_table = read_uleb128 (p, &tmp);
- 
-   region->action_table = region->call_site_table + tmp;
- }
- 
- 
- /* Describe an action to be taken when propagating an exception up to
-    some context.  */
- 
- typedef enum
- {
-   /* Found some call site base data, but need to analyze further
-      before beeing able to decide.  */
-   unknown,
- 
-   /* There is nothing relevant in the context at hand. */
-   nothing,
- 
-   /* There are only cleanups to run in this context.  */
-   cleanup,
- 
-   /* There is a handler for the exception in this context.  */
-   handler
- } action_kind;
- 
- 
- typedef struct
- {
-   /* The kind of action to be taken.  */
-   action_kind kind;
- 
-   /* A pointer to the action record entry.  */
-   const unsigned char *table_entry;
- 
-   /* Where we should jump to actually take an action (trigger a cleanup or an
-      exception handler).  */
-   _Unwind_Ptr landing_pad;
- 
-   /* If we have a handler matching our exception, these are the filter to
-      trigger it and the corresponding id.  */
-   _Unwind_Sword ttype_filter;
-   _Unwind_Ptr   ttype_entry;
- 
- } action_descriptor;
- 
- 
- static void
- db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
- {
-   _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
- 
-   db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
- 
-   switch (action->kind)
-      {
-      case unknown:
-        db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
- 	   action->landing_pad, action->table_entry);
-        break;
- 
-      case nothing:
-        db (DB_ACTIONS, "Nothing\n");
-        break;
- 
-      case cleanup:
-        db (DB_ACTIONS, "Cleanup\n");
-        break;
- 
-      case handler:
-        db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter);
-        break;
- 
-      default:
-        db (DB_ACTIONS, "Err? Unexpected action kind !\n");
-        break;
-     }
- 
-   return;
- }
- 
- 
- /* Search the call_site_table of REGION for an entry appropriate for the
-    UW_CONTEXT's ip. If one is found, store the associated landing_pad and
-    action_table entry, and set the ACTION kind to unknown for further
-    analysis. Otherwise, set the ACTION kind to nothing.
- 
-    There are two variants of this routine, depending on the underlying
-    mechanism (dwarf/sjlj), which account for differences in the tables
-    organization.
- */
- 
- #ifdef __USING_SJLJ_EXCEPTIONS__
- 
- #define __builtin_eh_return_data_regno(x) x
- 
- static void
- get_call_site_action_for (_Unwind_Context *uw_context,
-                           region_descriptor *region,
-                           action_descriptor *action)
- {
-   _Unwind_Ptr call_site
-     = _Unwind_GetIP (uw_context) - 1;
-   /* Subtract 1 because GetIP returns the actual call_site value + 1.  */
- 
-   /* call_site is a direct index into the call-site table, with two special
-      values : -1 for no-action and 0 for "terminate". The latter should never
-      show up for Ada. To test for the former, beware that _Unwind_Ptr might be
-      unsigned.  */
- 
-   if ((int)call_site < 0)
-     {
-       action->kind = nothing;
-       return;
-     }
-   else if (call_site == 0)
-     {
-       db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
-       action->kind = nothing;
-       return;
-     }
-   else
-     {
-       _Unwind_Word cs_lp, cs_action;
- 
-       /* Let the caller know there may be an action to take, but let it
- 	 determine the kind.  */
-       action->kind = unknown;
- 
-       /* We have a direct index into the call-site table, but this table is
- 	 made of leb128 values, the encoding length of which is variable. We
- 	 can't merely compute an offset from the index, then, but have to read
- 	 all the entries before the one of interest.  */
- 
-       const unsigned char * p = region->call_site_table;
- 
-       do {
- 	p = read_uleb128 (p, &cs_lp);
- 	p = read_uleb128 (p, &cs_action);
-       } while (--call_site);
- 
- 
-       action->landing_pad = cs_lp + 1;
- 
-       if (cs_action)
- 	action->table_entry = region->action_table + cs_action - 1;
-       else
- 	action->table_entry = 0;
- 
-       return;
-     }
- }
- 
- #else
- /* ! __USING_SJLJ_EXCEPTIONS__ */
- 
- static void
- get_call_site_action_for (_Unwind_Context *uw_context,
-                           region_descriptor *region,
-                           action_descriptor *action)
- {
-   _Unwind_Ptr ip
-     = _Unwind_GetIP (uw_context) - 1;
-   /* Substract 1 because GetIP yields a call return address while we are
-      interested in information for the call point. This does not always yield
-      the exact call instruction address but always brings the ip back within
-      the corresponding region.
- 
-      ??? When unwinding up from a signal handler triggered by a trap on some
-      instruction, we usually have the faulting instruction address here and
-      subtracting 1 might get us into the wrong region.  */
- 
-   const unsigned char * p
-     = region->call_site_table;
- 
-   /* Unless we are able to determine otherwise ... */
-   action->kind = nothing;
- 
-   db (DB_CSITE, "\n");
- 
-   while (p < region->action_table)
-     {
-       _Unwind_Ptr cs_start, cs_len, cs_lp;
-       _Unwind_Word cs_action;
- 
-       /* Note that all call-site encodings are "absolute" displacements.  */
-       p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
-       p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
-       p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
-       p = read_uleb128 (p, &cs_action);
- 
-       db (DB_CSITE,
- 	  "c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n",
- 	  region->base+cs_start, cs_start, cs_len,
- 	  region->lp_base+cs_lp, cs_lp);
- 
-       /* The table is sorted, so if we've passed the ip, stop.  */
-       if (ip < region->base + cs_start)
-  	break;
- 
-       /* If we have a match, fill the ACTION fields accordingly.  */
-       else if (ip < region->base + cs_start + cs_len)
- 	{
- 	  /* Let the caller know there may be an action to take, but let it
- 	     determine the kind.  */
- 	  action->kind = unknown;
- 
- 	  if (cs_lp)
- 	    action->landing_pad = region->lp_base + cs_lp;
- 	  else
- 	    action->landing_pad = 0;
- 
- 	  if (cs_action)
- 	    action->table_entry = region->action_table + cs_action - 1;
- 	  else
- 	    action->table_entry = 0;
- 
- 	  db (DB_CSITE, "+++\n");
- 	  return;
- 	}
-     }
- 
-   db (DB_CSITE, "---\n");
- }
- 
- #endif
- 
- /* With CHOICE an exception choice representing an "exception - when"
-    argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
-    occurrence, return true iif the latter matches the former, that is, if
-    PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
-    This takes care of the special Non_Ada_Error case on VMS.  */
- 
- #define Is_Handled_By_Others  __gnat_is_handled_by_others
- #define Language_For          __gnat_language_for
- #define Import_Code_For       __gnat_import_code_for
- #define EID_For               __gnat_eid_for
- #define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
- 
- extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
- extern char Language_For (_Unwind_Ptr eid);
- 
- extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
- 
- extern Exception_Id EID_For (_GNAT_Exception * e);
- extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
- 
- static int
- is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
- {
-   /* Pointer to the GNAT exception data corresponding to the propagated
-      occurrence.  */
-   _Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
- 
-   /* Base matching rules: An exception data (id) matches itself, "when
-      all_others" matches anything and "when others" matches anything unless
-      explicitely stated otherwise in the propagated occurrence.  */
- 
-   bool is_handled =
-     choice == E
-     || choice == GNAT_ALL_OTHERS
-     || (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
- 
-   /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
-      may have different exception data pointers that should match for the
-      same condition code, if both an export and an import have been
-      registered.  The import code for both the choice and the propagated
-      occurrence are expected to have been masked off regarding severity
-      bits already (at registration time for the former and from within the
-      low level exception vector for the latter).  */
  #ifdef VMS
!   #define Non_Ada_Error system__aux_dec__non_ada_error
!   extern struct Exception_Data Non_Ada_Error;
! 
!   is_handled |=
!     (Language_For (E) == 'V'
!      && choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
!      && ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
! 	  && Import_Code_For (choice) == Import_Code_For (E))
! 	 || choice == (_Unwind_Ptr)&Non_Ada_Error));
! #endif
! 
!   return is_handled;
! }
! 
! /* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
!    UW_CONTEXT in REGION.  */
! 
! static void
! get_action_description_for (_Unwind_Context *uw_context,
!                             _Unwind_Exception *uw_exception,
!                             region_descriptor *region,
!                             action_descriptor *action)
! {
!   _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
! 
!   /* Search the call site table first, which may get us a landing pad as well
!      as the head of an action record list.  */
!   get_call_site_action_for (uw_context, region, action);
!   db_action_for (action, uw_context);
! 
!   /* If there is not even a call_site entry, we are done.  */
!   if (action->kind == nothing)
!     return;
! 
!   /* Otherwise, check what we have at the place of the call site  */
! 
!   /* No landing pad => no cleanups or handlers.  */
!   if (action->landing_pad == 0)
!     {
!       action->kind = nothing;
!       return;
!     }
! 
!   /* Landing pad + null table entry => only cleanups.  */
!   else if (action->table_entry == 0)
!     {
!       action->kind = cleanup;
!       return;
!     }
! 
!   /* Landing pad + Table entry => handlers + possible cleanups.  */
!   else
!     {
!       const unsigned char * p = action->table_entry;
! 
!       _Unwind_Sword ar_filter, ar_disp;
! 
!       action->kind = nothing;
! 
!       while (1)
! 	{
! 	  p = read_sleb128 (p, &ar_filter);
! 	  read_sleb128 (p, &ar_disp);
! 	  /* Don't assign p here, as it will be incremented by ar_disp
! 	     below.  */
! 
! 	  /* Null filters are for cleanups. */
! 	  if (ar_filter == 0)
! 	    action->kind = cleanup;
! 
! 	  /* Positive filters are for regular handlers.  */
! 	  else if (ar_filter > 0)
! 	    {
! 	      /* See if the filter we have is for an exception which matches
! 		 the one we are propagating.  */
! 	      _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
! 
! 	      if (is_handled_by (choice, gnat_exception))
! 		{
! 		  action->ttype_filter = ar_filter;
! 		  action->ttype_entry = choice;
! 		  action->kind = handler;
! 		  return;
! 		}
! 	    }
! 
! 	  /* Negative filter values are for C++ exception specifications.
! 	     Should not be there for Ada :/  */
! 	  else
! 	    db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
! 
! 	  if (ar_disp == 0)
! 	    return;
! 
! 	  p += ar_disp;
! 	}
!     }
! }
! 
! /* Setup in UW_CONTEXT the eh return target IP and data registers, which will
!    be restored with the others and retrieved by the landing pad once the jump
!    occured.  */
! 
! static void
! setup_to_install (_Unwind_Context *uw_context,
!                   _Unwind_Exception *uw_exception,
!                   _Unwind_Ptr uw_landing_pad,
!                   int uw_filter)
! {
! #ifndef EH_RETURN_DATA_REGNO
!   /* We should not be called if the appropriate underlying support is not
!      there.  */
!   abort ();
! #else
!   /* 1/ exception object pointer, which might be provided back to
!      _Unwind_Resume (and thus to this personality routine) if we are jumping
!      to a cleanup.  */
!   _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
! 		 (_Unwind_Word)uw_exception);
  
!   /* 2/ handler switch value register, which will also be used by the target
!      landing pad to decide what action it shall take.  */
!   _Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
! 		 (_Unwind_Word)uw_filter);
  
!   /* Setup the address we should jump at to reach the code where there is the
!      "something" we found.  */
!   _Unwind_SetIP (uw_context, uw_landing_pad);
  #endif
- }
- 
- /* The following is defined from a-except.adb. Its purpose is to enable
-    automatic backtraces upon exception raise, as provided through the
-    GNAT.Traceback facilities.  */
- extern void __gnat_notify_handled_exception (void);
- extern void __gnat_notify_unhandled_exception (void);
- 
- /* Below is the eh personality routine per se. We currently assume that only
-    GNU-Ada exceptions are met.  */
- 
- _Unwind_Reason_Code
- __gnat_eh_personality (int uw_version,
-                        _Unwind_Action uw_phases,
-                        _Unwind_Exception_Class uw_exception_class,
-                        _Unwind_Exception *uw_exception,
-                        _Unwind_Context *uw_context)
- {
-   _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
- 
-   region_descriptor region;
-   action_descriptor action;
- 
-   if (uw_version != 1)
-     return _URC_FATAL_PHASE1_ERROR;
- 
-   db_indent (DB_INDENT_RESET);
-   db_phases (uw_phases);
-   db_indent (DB_INDENT_INCREASE);
- 
-   /* Get the region description for the context we were provided with. This
-      will tell us if there is some lsda, call_site, action and/or ttype data
-      for the associated ip.  */
-   get_region_description_for (uw_context, &region);
-   db_region_for (&region, uw_context);
- 
-   /* No LSDA => no handlers or cleanups => we shall unwind further up.  */
-   if (! region.lsda)
-     return _URC_CONTINUE_UNWIND;
- 
-   /* Search the call-site and action-record tables for the action associated
-      with this IP.  */
-   get_action_description_for (uw_context, uw_exception, &region, &action);
-   db_action_for (&action, uw_context);
- 
-   /* Whatever the phase, if there is nothing relevant in this frame,
-      unwinding should just go on.  */
-   if (action.kind == nothing)
-     return _URC_CONTINUE_UNWIND;
- 
-   /* If we found something in search phase, we should return a code indicating
-      what to do next depending on what we found. If we only have cleanups
-      around, we shall try to unwind further up to find a handler, otherwise,
-      tell we have a handler, which will trigger the second phase.  */
-   if (uw_phases & _UA_SEARCH_PHASE)
-     {
-       if (action.kind == cleanup)
- 	{
- 	  Adjust_N_Cleanups_For (gnat_exception, 1);
- 	  return _URC_CONTINUE_UNWIND;
- 	}
-       else
- 	{
- 	  /* Trigger the appropriate notification routines before the second
- 	     phase starts, which ensures the stack is still intact. */
- 	  __gnat_notify_handled_exception ();
- 
- 	  return _URC_HANDLER_FOUND;
- 	}
-     }
  
!   /* We found something in cleanup/handler phase, which might be the handler
!      or a cleanup for a handled occurrence, or a cleanup for an unhandled
!      occurrence (we are in a FORCED_UNWIND phase in this case). Install the
!      context to get there.  */
! 
!   /* If we are going to install a cleanup context, decrement the cleanup
!      count.  This is required in a FORCED_UNWINDing phase (for an unhandled
!      exception), as this is used from the forced unwinding handler in
!      Ada.Exceptions.Exception_Propagation to decide wether unwinding should
!      proceed further or Unhandled_Exception_Terminate should be called.  */
!   if (action.kind == cleanup)
!     Adjust_N_Cleanups_For (gnat_exception, -1);
! 
!   setup_to_install
!     (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
! 
!   return _URC_INSTALL_CONTEXT;
! }
! 
! /* Define the consistently named stubs imported by Propagate_Exception.  */
! 
! #ifdef __USING_SJLJ_EXCEPTIONS__
! 
! #undef _Unwind_RaiseException
! 
! _Unwind_Reason_Code
! __gnat_Unwind_RaiseException (_Unwind_Exception *e)
! {
!   return _Unwind_SjLj_RaiseException (e);
! }
! 
! 
! #undef _Unwind_ForcedUnwind
! 
! _Unwind_Reason_Code
! __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
!                             void * handler,
!                             void * argument)
! {
!   return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
! }
! 
! 
! #else /* __USING_SJLJ_EXCEPTIONS__ */
! 
! _Unwind_Reason_Code
! __gnat_Unwind_RaiseException (_Unwind_Exception *e)
! {
!   return _Unwind_RaiseException (e);
! }
! 
! _Unwind_Reason_Code
! __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
!                             void * handler,
!                             void * argument)
! {
!   return _Unwind_ForcedUnwind (e, handler, argument);
! }
! 
! #endif /* __USING_SJLJ_EXCEPTIONS__ */
! 
! #else
! /* ! IN_RTS  */
! 
! /* The calls to the GCC runtime interface for exception raising are currently
!    issued from a-exexpr.adb, which is used by both the runtime library and the
!    compiler.
! 
!    As the compiler binary is not linked against the GCC runtime library, we
!    need also need stubs for this interface in the compiler case. We should not
!    be using the GCC eh mechanism for the compiler, however, so expect these
!    functions never to be called.  */
! 
! /* We don't want fancy_abort here.  */
! #undef abort
! 
! _Unwind_Reason_Code
! __gnat_Unwind_RaiseException (_Unwind_Exception *e ATTRIBUTE_UNUSED)
! {
!   abort ();
! }
! 
! 
! _Unwind_Reason_Code
! __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
!                             void * handler ATTRIBUTE_UNUSED,
!                             void * argument ATTRIBUTE_UNUSED)
! {
!   abort ();
  }
- 
- #endif /* IN_RTS */
--- 64,79 ----
  void
  __gnat_unhandled_terminate (void)
  {
  #ifdef VMS
!   /* Special termination handling for VMS */
!   long prvhnd;
  
!   /* Remove the exception vector so it won't intercept any errors
!      in the call to exit, and go into and endless loop */
  
!   SYS$SETEXV (1, 0, 3, &prvhnd);
  #endif
  
!   /* Default termination handling */
!   __gnat_os_exit (1);
  }
diff -Nrcpad gcc-4.0.2/gcc/ada/raise.h gcc-4.1.0/gcc/ada/raise.h
*** gcc-4.0.2/gcc/ada/raise.h	Thu Feb 10 13:54:45 2005
--- gcc-4.1.0/gcc/ada/raise.h	Mon Sep  5 07:46:59 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 31,46 ****
   ****************************************************************************/
  
  
  typedef unsigned Exception_Code;
- /* C counterpart of what System.Standard_Library defines.  */
  
  struct Exception_Data
  {
!   char  Handled_By_Others;
    char Lang;
    int Name_Length;
!   char *Full_Name, Htable_Ptr;
    Exception_Code Import_Code;
  };
  
  typedef struct Exception_Data *Exception_Id;
--- 31,48 ----
   ****************************************************************************/
  
  
+ /* C counterparts of what System.Standard_Library defines.  */
+ 
  typedef unsigned Exception_Code;
  
  struct Exception_Data
  {
!   char Not_Handled_By_Others;
    char Lang;
    int Name_Length;
!   char *Full_Name, *Htable_Ptr;
    Exception_Code Import_Code;
+   void (*Raise_Hook)(void);
  };
  
  typedef struct Exception_Data *Exception_Id;
*************** extern void __gnat_initialize		(void *);
*** 70,74 ****
--- 72,77 ----
  extern void __gnat_init_float		(void);
  extern void __gnat_install_handler	(void);
  extern void __gnat_install_SEH_handler  (void *);
+ extern void __gnat_adjust_context_for_raise (int, void *);
  
  extern int gnat_exit_status;
diff -Nrcpad gcc-4.0.2/gcc/ada/repinfo.adb gcc-4.1.0/gcc/ada/repinfo.adb
*** gcc-4.0.2/gcc/ada/repinfo.adb	Wed Dec  8 11:26:04 2004
--- gcc-4.1.0/gcc/ada/repinfo.adb	Tue Nov 15 13:53:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Table;  use Table;
*** 48,53 ****
--- 48,55 ----
  with Uname;  use Uname;
  with Urealp; use Urealp;
  
+ with Ada.Unchecked_Conversion;
+ 
  package body Repinfo is
  
     SSU : constant := 8;
*************** package body Repinfo is
*** 61,77 ****
     -- Representation of gcc Expressions --
     ---------------------------------------
  
!    --    This table is used only if Frontend_Layout_On_Target is False,
!    --    so that gigi lays out dynamic size/offset fields using encoded
!    --    gcc expressions.
  
!    --    A table internal to this unit is used to hold the values of
!    --    back annotated expressions. This table is written out by -gnatt
!    --    and read back in for ASIS processing.
  
!    --    Node values are stored as Uint values which are the negative of
!    --    the node index in this table. Constants appear as non-negative
!    --    Uint values.
  
     type Exp_Node is record
        Expr : TCode;
--- 63,78 ----
     -- Representation of gcc Expressions --
     ---------------------------------------
  
!    --    This table is used only if Frontend_Layout_On_Target is False, so that
!    --    gigi lays out dynamic size/offset fields using encoded gcc
!    --    expressions.
  
!    --    A table internal to this unit is used to hold the values of back
!    --    annotated expressions. This table is written out by -gnatt and read
!    --    back in for ASIS processing.
  
!    --    Node values are stored as Uint values using the negative of the node
!    --    index in this table. Constants appear as non-negative Uint values.
  
     type Exp_Node is record
        Expr : TCode;
*************** package body Repinfo is
*** 104,131 ****
     --  Identifier casing for current unit
  
     Need_Blank_Line : Boolean;
!    --  Set True if a blank line is needed before outputting any
!    --  information for the current entity. Set True when a new
!    --  entity is processed, and false when the blank line is output.
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
     function Back_End_Layout return Boolean;
!    --  Test for layout mode, True = back end, False = front end. This
!    --  function is used rather than checking the configuration parameter
!    --  because we do not want Repinfo to depend on Targparm (for ASIS)
  
     procedure Blank_Line;
     --  Called before outputting anything for an entity. Ensures that
     --  a blank line precedes the output for a particular entity.
  
     procedure List_Entities (Ent : Entity_Id);
!    --  This procedure lists the entities associated with the entity E,
!    --  starting with the First_Entity and using the Next_Entity link.
!    --  If a nested package is found, entities within the package are
!    --  recursively processed.
  
     procedure List_Name (Ent : Entity_Id);
     --  List name of entity Ent in appropriate case. The name is listed with
--- 105,131 ----
     --  Identifier casing for current unit
  
     Need_Blank_Line : Boolean;
!    --  Set True if a blank line is needed before outputting any information for
!    --  the current entity. Set True when a new entity is processed, and false
!    --  when the blank line is output.
  
     -----------------------
     -- Local Subprograms --
     -----------------------
  
     function Back_End_Layout return Boolean;
!    --  Test for layout mode, True = back end, False = front end. This function
!    --  is used rather than checking the configuration parameter because we do
!    --  not want Repinfo to depend on Targparm (for ASIS)
  
     procedure Blank_Line;
     --  Called before outputting anything for an entity. Ensures that
     --  a blank line precedes the output for a particular entity.
  
     procedure List_Entities (Ent : Entity_Id);
!    --  This procedure lists the entities associated with the entity E, starting
!    --  with the First_Entity and using the Next_Entity link. If a nested
!    --  package is found, entities within the package are recursively processed.
  
     procedure List_Name (Ent : Entity_Id);
     --  List name of entity Ent in appropriate case. The name is listed with
*************** package body Repinfo is
*** 135,142 ****
     --  List representation info for array type Ent
  
     procedure List_Mechanisms (Ent : Entity_Id);
!    --  List mechanism information for parameters of Ent, which is a
!    --  subprogram, subprogram type, or an entry or entry family.
  
     procedure List_Object_Info (Ent : Entity_Id);
     --  List representation info for object Ent
--- 135,142 ----
     --  List representation info for array type Ent
  
     procedure List_Mechanisms (Ent : Entity_Id);
!    --  List mechanism information for parameters of Ent, which is subprogram,
!    --  subprogram type, or an entry or entry family.
  
     procedure List_Object_Info (Ent : Entity_Id);
     --  List representation info for object Ent
*************** package body Repinfo is
*** 155,166 ****
     --  Output given number of spaces
  
     procedure Write_Info_Line (S : String);
!    --  Routine to write a line to Repinfo output file. This routine is
!    --  passed as a special output procedure to Output.Set_Special_Output.
!    --  Note that Write_Info_Line is called with an EOL character at the
!    --  end of each line, as per the Output spec, but the internal call
!    --  to the appropriate routine in Osint requires that the end of line
!    --  sequence be stripped off.
  
     procedure Write_Mechanism (M : Mechanism_Type);
     --  Writes symbolic string for mechanism represented by M
--- 155,165 ----
     --  Output given number of spaces
  
     procedure Write_Info_Line (S : String);
!    --  Routine to write a line to Repinfo output file. This routine is passed
!    --  as a special output procedure to Output.Set_Special_Output. Note that
!    --  Write_Info_Line is called with an EOL character at the end of each line,
!    --  as per the Output spec, but the internal call to the appropriate routine
!    --  in Osint requires that the end of line sequence be stripped off.
  
     procedure Write_Mechanism (M : Mechanism_Type);
     --  Writes symbolic string for mechanism represented by M
*************** package body Repinfo is
*** 168,175 ****
     procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
     --  Given a representation value, write it out. No_Uint values or values
     --  dependent on discriminants are written as two question marks. If the
!    --  flag Paren is set, then the output is surrounded in parentheses if
!    --  it is other than a simple value.
  
     ---------------------
     -- Back_End_Layout --
--- 167,174 ----
     procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
     --  Given a representation value, write it out. No_Uint values or values
     --  dependent on discriminants are written as two question marks. If the
!    --  flag Paren is set, then the output is surrounded in parentheses if it is
!    --  other than a simple value.
  
     ---------------------
     -- Back_End_Layout --
*************** package body Repinfo is
*** 177,184 ****
  
     function Back_End_Layout return Boolean is
     begin
!       --  We have back end layout if the back end has made any entries in
!       --  the table of GCC expressions, otherwise we have front end layout.
  
        return Rep_Table.Last > 0;
     end Back_End_Layout;
--- 176,183 ----
  
     function Back_End_Layout return Boolean is
     begin
!       --  We have back end layout if the back end has made any entries in the
!       --  table of GCC expressions, otherwise we have front end layout.
  
        return Rep_Table.Last > 0;
     end Back_End_Layout;
*************** package body Repinfo is
*** 350,359 ****
           while Present (E) loop
              Need_Blank_Line := True;
  
!             --  We list entities that come from source (excluding private
!             --  or incomplete types or deferred constants, where we will
!             --  list the info for the full view). If debug flag A is set,
!             --  then all entities are listed
  
              if (Comes_From_Source (E)
                and then not Is_Incomplete_Or_Private_Type (E)
--- 349,358 ----
           while Present (E) loop
              Need_Blank_Line := True;
  
!             --  We list entities that come from source (excluding private or
!             --  incomplete types or deferred constants, where we will list the
!             --  info for the full view). If debug flag A is set, then all
!             --  entities are listed
  
              if (Comes_From_Source (E)
                and then not Is_Incomplete_Or_Private_Type (E)
*************** package body Repinfo is
*** 402,411 ****
  
                 end if;
  
!                --  Recurse into nested package, but not if they are
!                --  package renamings (in particular renamings of the
!                --  enclosing package, as for some Java bindings and
!                --  for generic instances).
  
                 if Ekind (E) = E_Package then
                    if No (Renamed_Object (E)) then
--- 401,409 ----
  
                 end if;
  
!                --  Recurse into nested package, but not if they are package
!                --  renamings (in particular renamings of the enclosing package,
!                --  as for some Java bindings and for generic instances).
  
                 if Ekind (E) = E_Package then
                    if No (Renamed_Object (E)) then
*************** package body Repinfo is
*** 438,447 ****
              E := Next_Entity (E);
           end loop;
  
!          --  For a package body, the entities of the visible subprograms
!          --  are declared in the corresponding spec. Iterate over its
!          --  entities in order to handle properly the subprogram bodies.
!          --  Skip bodies in subunits, which are listed independently.
  
           if Ekind (Ent) = E_Package_Body
             and then Present (Corresponding_Spec (Find_Declaration (Ent)))
--- 436,445 ----
              E := Next_Entity (E);
           end loop;
  
!          --  For a package body, the entities of the visible subprograms are
!          --  declared in the corresponding spec. Iterate over its entities in
!          --  order to handle properly the subprogram bodies. Skip bodies in
!          --  subunits, which are listed independently.
  
           if Ekind (Ent) = E_Package_Body
             and then Present (Corresponding_Spec (Find_Declaration (Ent)))
*************** package body Repinfo is
*** 583,588 ****
--- 581,589 ----
                       Write_Str ("not ");
                       Print_Expr (Node.Op1);
  
+                   when Bit_And_Expr =>
+                      Binop (" & ");
+ 
                    when Lt_Expr =>
                       Binop (" < ");
  
*************** package body Repinfo is
*** 801,809 ****
                 UI_Image (Sunit);
              end if;
  
!             --  If the record is not packed, then we know that all
!             --  fields whose position is not specified have a starting
!             --  normalized bit position of zero
  
              if Unknown_Normalized_First_Bit (Comp)
                and then not Is_Packed (Ent)
--- 802,810 ----
                 UI_Image (Sunit);
              end if;
  
!             --  If the record is not packed, then we know that all fields whose
!             --  position is not specified have a starting normalized bit
!             --  position of zero
  
              if Unknown_Normalized_First_Bit (Comp)
                and then not Is_Packed (Ent)
*************** package body Repinfo is
*** 885,895 ****
                 UI_Write (Fbit);
                 Write_Str (" .. ");
  
!                --  Allowing Uint_0 here is a kludge, really this should be
!                --  a fine Esize value but currently it means unknown, except
!                --  that we know after gigi has back annotated that a size of
!                --  zero is real, since otherwise gigi back annotates using
!                --  No_Uint as the value to indicate unknown).
  
                 if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
                   and then Known_Static_Normalized_First_Bit (Comp)
--- 886,896 ----
                 UI_Write (Fbit);
                 Write_Str (" .. ");
  
!                --  Allowing Uint_0 here is a kludge, really this should be a
!                --  fine Esize value but currently it means unknown, except that
!                --  we know after gigi has back annotated that a size of zero is
!                --  real, since otherwise gigi back annotates using No_Uint as
!                --  the value to indicate unknown).
  
                 if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
                   and then Known_Static_Normalized_First_Bit (Comp)
*************** package body Repinfo is
*** 916,923 ****
  
                    Write_Val (Esiz, Paren => True);
  
!                   --  If in front end layout mode, then dynamic size is
!                   --  stored in storage units, so renormalize for output
  
                    if not Back_End_Layout then
                       Write_Str (" * ");
--- 917,924 ----
  
                    Write_Val (Esiz, Paren => True);
  
!                   --  If in front end layout mode, then dynamic size is stored
!                   --  in storage units, so renormalize for output
  
                    if not Back_End_Layout then
                       Write_Str (" * ");
*************** package body Repinfo is
*** 1019,1026 ****
              Write_Line (";");
  
           --  For now, temporary case, to be removed when gigi properly back
!          --  annotates RM_Size, if RM_Size is not set, then list Esize as
!          --  Size. This avoids odd Object_Size output till we fix things???
  
           elsif Unknown_RM_Size (Ent) then
              Write_Str ("for ");
--- 1020,1027 ----
              Write_Line (";");
  
           --  For now, temporary case, to be removed when gigi properly back
!          --  annotates RM_Size, if RM_Size is not set, then list Esize as Size.
!          --  This avoids odd Object_Size output till we fix things???
  
           elsif Unknown_RM_Size (Ent) then
              Write_Str ("for ");
*************** package body Repinfo is
*** 1086,1091 ****
--- 1087,1100 ----
        function V (Val : Node_Ref_Or_Val) return Uint;
        --  Internal recursive routine to evaluate tree
  
+       function W (Val : Uint) return Word;
+       --  Convert Val to Word, assuming Val is always in the Int range. This is
+       --  a helper function for the evaluation of bitwise expressions like
+       --  Bit_And_Expr, for which there is no direct support in uintp. Uint
+       --  values out of the Int range are expected to be seen in such
+       --  expressions only with overflowing byte sizes around, introducing
+       --  inherent unreliabilties in computations anyway.
+ 
        -------
        -- B --
        -------
*************** package body Repinfo is
*** 1113,1118 ****
--- 1122,1144 ----
        end T;
  
        -------
+       -- W --
+       -------
+ 
+       --  We use an unchecked conversion to map Int values to their Word
+       --  bitwise equivalent, which we could not achieve with a normal type
+       --  conversion for negative Ints. We want bitwise equivalents because W
+       --  is used as a helper for bit operators like Bit_And_Expr, and can be
+       --  called for negative Ints in the context of aligning expressions like
+       --  X+Align & -Align.
+ 
+       function W (Val : Uint) return Word is
+          function To_Word is new Ada.Unchecked_Conversion (Int, Word);
+       begin
+          return To_Word (UI_To_Int (Val));
+       end W;
+ 
+       -------
        -- V --
        -------
  
*************** package body Repinfo is
*** 1203,1208 ****
--- 1229,1239 ----
                    when Truth_Not_Expr =>
                       return B (not T (Node.Op1));
  
+                   when Bit_And_Expr =>
+                      L := V (Node.Op1);
+                      R := V (Node.Op2);
+                      return UI_From_Int (Int (W (L) and W (R)));
+ 
                    when Lt_Expr =>
                       return B (V (Node.Op1) < V (Node.Op2));
  
diff -Nrcpad gcc-4.0.2/gcc/ada/repinfo.ads gcc-4.1.0/gcc/ada/repinfo.ads
*** gcc-4.0.2/gcc/ada/repinfo.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/repinfo.ads	Tue Nov 15 13:53:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  tree to fill in representation information, and also the routine used
  --  by -gnatR to print this information. This unit is used both in the
  --  compiler and in ASIS (it is used in ASIS as part of the implementation
! --  of the data decomposition annex.
  
  with Types; use Types;
  with Uintp; use Uintp;
--- 35,41 ----
  --  tree to fill in representation information, and also the routine used
  --  by -gnatR to print this information. This unit is used both in the
  --  compiler and in ASIS (it is used in ASIS as part of the implementation
! --  of the data decomposition annex).
  
  with Types; use Types;
  with Uintp; use Uintp;
*************** package Repinfo is
*** 55,61 ****
     --  For composite types, there are three cases:
  
     --    1. In some cases the front end knows the values statically,
!    --       for example in the ase where representation clauses or
     --       pragmas specify the values.
  
     --    2. If Backend_Layout is True, then the backend is responsible
--- 55,61 ----
     --  For composite types, there are three cases:
  
     --    1. In some cases the front end knows the values statically,
!    --       for example in the case where representation clauses or
     --       pragmas specify the values.
  
     --    2. If Backend_Layout is True, then the backend is responsible
*************** package Repinfo is
*** 128,134 ****
     --  Subtype used for values that can either be a Node_Ref (negative)
     --  or a value (non-negative)
  
!    type TCode is range 0 .. 27;
     --  Type used on Ada side to represent DEFTREECODE values defined in
     --  tree.def. Only a subset of these tree codes can actually appear.
     --  The names are the names from tree.def in Ada casing.
--- 128,134 ----
     --  Subtype used for values that can either be a Node_Ref (negative)
     --  or a value (non-negative)
  
!    type TCode is range 0 .. 28;
     --  Type used on Ada side to represent DEFTREECODE values defined in
     --  tree.def. Only a subset of these tree codes can actually appear.
     --  The names are the names from tree.def in Ada casing.
*************** package Repinfo is
*** 162,167 ****
--- 162,168 ----
     Ge_Expr          : constant TCode := 25; -- comparision >=           2
     Eq_Expr          : constant TCode := 26; -- comparision =            2
     Ne_Expr          : constant TCode := 27; -- comparision /=           2
+    Bit_And_Expr     : constant TCode := 28; -- Binary and               2
  
     --  The following entry is used to represent a discriminant value in
     --  the tree. It has a special tree code that does not correspond
diff -Nrcpad gcc-4.0.2/gcc/ada/repinfo.h gcc-4.1.0/gcc/ada/repinfo.h
*** gcc-4.0.2/gcc/ada/repinfo.h	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/repinfo.h	Tue Nov 15 13:53:22 2005
***************
*** 6,12 ****
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1999-2002 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- *
--- 6,12 ----
   *                                                                          *
   *                              C Header File                               *
   *                                                                          *
!  *          Copyright (C) 1999-2005 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** typedef char TCode;
*** 67,72 ****
--- 67,73 ----
  #define Ge_Expr          25
  #define Eq_Expr          26
  #define Ne_Expr          27
+ #define Bit_And_Expr     28
  
  /* Creates a node using the tree code defined by Expr and from 1-3
     operands as required (unused operands set as shown to No_Uint) Note
diff -Nrcpad gcc-4.0.2/gcc/ada/restrict.adb gcc-4.1.0/gcc/ada/restrict.adb
*** gcc-4.0.2/gcc/ada/restrict.adb	Mon Jan  3 15:32:17 2005
--- gcc-4.1.0/gcc/ada/restrict.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/restrict.ads gcc-4.1.0/gcc/ada/restrict.ads
*** gcc-4.0.2/gcc/ada/restrict.ads	Mon Jan  3 15:32:17 2005
--- gcc-4.1.0/gcc/ada/restrict.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/rident.ads gcc-4.1.0/gcc/ada/rident.ads
*** gcc-4.0.2/gcc/ada/rident.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/rident.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/rtsfind.adb gcc-4.1.0/gcc/ada/rtsfind.adb
*** gcc-4.0.2/gcc/ada/rtsfind.adb	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/rtsfind.adb	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Opt;      use Opt;
*** 43,48 ****
--- 43,49 ----
  with Restrict; use Restrict;
  with Sem;      use Sem;
  with Sem_Ch7;  use Sem_Ch7;
+ with Sem_Dist; use Sem_Dist;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
  with Stand;    use Stand;
*************** package body Rtsfind is
*** 170,176 ****
     --  is only effective in All_Errors mode.
  
     function RE_Chars (E : RE_Id) return Name_Id;
!    --  Given a RE_Id value returns the Chars of the corresponding entity.
  
     procedure RTE_Error_Msg (Msg : String);
     --  Generates a message by calling Error_Msg_N specifying Current_Error_Node
--- 171,177 ----
     --  is only effective in All_Errors mode.
  
     function RE_Chars (E : RE_Id) return Name_Id;
!    --  Given a RE_Id value returns the Chars of the corresponding entity
  
     procedure RTE_Error_Msg (Msg : String);
     --  Generates a message by calling Error_Msg_N specifying Current_Error_Node
*************** package body Rtsfind is
*** 517,523 ****
        --  Indicate those that must be restored.
  
        procedure Restore_Private_Visibility;
!       --  Restore the visibility of ancestors after compiling RTU.
  
        --------------------------------
        -- Restore_Private_Visibility --
--- 518,524 ----
        --  Indicate those that must be restored.
  
        procedure Restore_Private_Visibility;
!       --  Restore the visibility of ancestors after compiling RTU
  
        --------------------------------
        -- Restore_Private_Visibility --
*************** package body Rtsfind is
*** 838,857 ****
                       E = RE_Params_Stream_Type
                         or else
                       E = RE_Request_Access)
           then
!             declare
!                DSA_Implementation : constant Entity_Id :=
!                                       RTE (RE_DSA_Implementation);
!             begin
!                if Chars (Entity (Expression
!                                   (Parent (DSA_Implementation)))) = Name_No_DSA
!                then
!                   Set_Standard_Error;
!                   Write_Str ("distribution feature not supported");
!                   Write_Eol;
!                   raise Unrecoverable_Error;
!                end if;
!             end;
           end if;
        end Check_RPC;
  
--- 839,850 ----
                       E = RE_Params_Stream_Type
                         or else
                       E = RE_Request_Access)
+            and then Get_PCS_Name = Name_No_DSA
           then
!             Set_Standard_Error;
!             Write_Str ("distribution feature not supported");
!             Write_Eol;
!             raise Unrecoverable_Error;
           end if;
        end Check_RPC;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/rtsfind.ads gcc-4.1.0/gcc/ada/rtsfind.ads
*** gcc-4.0.2/gcc/ada/rtsfind.ads	Thu Feb 10 13:50:15 2005
--- gcc-4.1.0/gcc/ada/rtsfind.ads	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Rtsfind is
*** 108,114 ****
        --  package see declarations in the runtime entity table below.
  
        RTU_Null,
!       --  Used as a null entry. Will cause an error if referenced.
  
        --  Children of Ada
  
--- 108,114 ----
        --  package see declarations in the runtime entity table below.
  
        RTU_Null,
!       --  Used as a null entry. Will cause an error if referenced
  
        --  Children of Ada
  
*************** package Rtsfind is
*** 199,205 ****
        System_Compare_Array_Unsigned_64,
        System_Compare_Array_Unsigned_8,
        System_Exception_Table,
-       System_Exceptions,
        System_Exn_Int,
        System_Exn_LLF,
        System_Exn_LLI,
--- 199,204 ----
*************** package Rtsfind is
*** 210,218 ****
--- 209,222 ----
        System_Exp_Mod,
        System_Exp_Uns,
        System_Fat_Flt,
+       System_Fat_IEEE_Long_Float,
+       System_Fat_IEEE_Short_Float,
        System_Fat_LFlt,
        System_Fat_LLF,
        System_Fat_SFlt,
+       System_Fat_VAX_D_Float,
+       System_Fat_VAX_F_Float,
+       System_Fat_VAX_G_Float,
        System_Finalization_Implementation,
        System_Finalization_Root,
        System_Fore,
*************** package Rtsfind is
*** 484,514 ****
  
       RE_Stream_Access,                   -- Ada.Streams.Stream_IO
  
       RE_CW_Membership,                   -- Ada.Tags
       RE_DT_Entry_Size,                   -- Ada.Tags
       RE_DT_Prologue_Size,                -- Ada.Tags
       RE_External_Tag,                    -- Ada.Tags
!      RE_Get_Expanded_Name,               -- Ada.Tags
       RE_Get_External_Tag,                -- Ada.Tags
       RE_Get_Prim_Op_Address,             -- Ada.Tags
       RE_Get_RC_Offset,                   -- Ada.Tags
       RE_Get_Remotely_Callable,           -- Ada.Tags
-      RE_Get_TSD,                         -- Ada.Tags
       RE_Inherit_DT,                      -- Ada.Tags
       RE_Inherit_TSD,                     -- Ada.Tags
       RE_Internal_Tag,                    -- Ada.Tags
       RE_Register_Tag,                    -- Ada.Tags
       RE_Set_Expanded_Name,               -- Ada.Tags
       RE_Set_External_Tag,                -- Ada.Tags
       RE_Set_Prim_Op_Address,             -- Ada.Tags
       RE_Set_RC_Offset,                   -- Ada.Tags
       RE_Set_Remotely_Callable,           -- Ada.Tags
       RE_Set_TSD,                         -- Ada.Tags
       RE_Tag_Error,                       -- Ada.Tags
       RE_TSD_Entry_Size,                  -- Ada.Tags
       RE_TSD_Prologue_Size,               -- Ada.Tags
       RE_Tag,                             -- Ada.Tags
       RE_Address_Array,                   -- Ada.Tags
  
       RE_Abort_Task,                      -- Ada.Task_Identification
       RE_Current_Task,                    -- Ada.Task_Identification
--- 488,549 ----
  
       RE_Stream_Access,                   -- Ada.Streams.Stream_IO
  
+      RE_Addr_Ptr,                        -- Ada.Tags
       RE_CW_Membership,                   -- Ada.Tags
+      RE_IW_Membership,                   -- Ada.Tags
+      RE_Descendant_Tag,                  -- Ada.Tags
       RE_DT_Entry_Size,                   -- Ada.Tags
       RE_DT_Prologue_Size,                -- Ada.Tags
       RE_External_Tag,                    -- Ada.Tags
!      RE_Get_Access_Level,                -- Ada.Tags
!      RE_Get_Entry_Index,                 -- Ada.Tags
       RE_Get_External_Tag,                -- Ada.Tags
+      RE_Get_Offset_Index,                -- Ada.Tags
       RE_Get_Prim_Op_Address,             -- Ada.Tags
+      RE_Get_Prim_Op_Kind,                -- Ada.Tags
       RE_Get_RC_Offset,                   -- Ada.Tags
       RE_Get_Remotely_Callable,           -- Ada.Tags
       RE_Inherit_DT,                      -- Ada.Tags
       RE_Inherit_TSD,                     -- Ada.Tags
       RE_Internal_Tag,                    -- Ada.Tags
+      RE_Is_Descendant_At_Same_Level,     -- Ada.Tags
+      RE_Object_Specific_Data,            -- Ada.Tags
+      RE_POK_Function,                    -- Ada.Tags
+      RE_POK_Procedure,                   -- Ada.Tags
+      RE_POK_Protected_Entry,             -- Ada.Tags
+      RE_POK_Protected_Function,          -- Ada.Tags
+      RE_POK_Protected_Procedure,         -- Ada.Tags
+      RE_POK_Task_Entry,                  -- Ada.Tags
+      RE_POK_Task_Function,               -- Ada.Tags
+      RE_POK_Task_Procedure,              -- Ada.Tags
+      RE_Prim_Op_Kind,                    -- Ada.Tags
+      RE_Register_Interface_Tag,          -- Ada.Tags
       RE_Register_Tag,                    -- Ada.Tags
+      RE_Select_Specific_Data,            -- Ada.Tags
+      RE_Set_Access_Level,                -- Ada.Tags
+      RE_Set_Entry_Index,                 -- Ada.Tags
       RE_Set_Expanded_Name,               -- Ada.Tags
       RE_Set_External_Tag,                -- Ada.Tags
+      RE_Set_Num_Prim_Ops,                -- Ada.Tags
+      RE_Set_Offset_Index,                -- Ada.Tags
+      RE_Set_Offset_To_Top,               -- Ada.Tags
+      RE_Set_OSD,                         -- Ada.Tags
       RE_Set_Prim_Op_Address,             -- Ada.Tags
+      RE_Set_Prim_Op_Kind,                -- Ada.Tags
       RE_Set_RC_Offset,                   -- Ada.Tags
       RE_Set_Remotely_Callable,           -- Ada.Tags
+      RE_Set_SSD,                         -- Ada.Tags
       RE_Set_TSD,                         -- Ada.Tags
       RE_Tag_Error,                       -- Ada.Tags
       RE_TSD_Entry_Size,                  -- Ada.Tags
       RE_TSD_Prologue_Size,               -- Ada.Tags
+      RE_Interface_Tag,                   -- Ada.Tags
       RE_Tag,                             -- Ada.Tags
       RE_Address_Array,                   -- Ada.Tags
+      RE_Valid_Signature,                 -- Ada.Tags
+      RE_Primary_DT,                      -- Ada.Tags
+      RE_Secondary_DT,                    -- Ada.Tags
+      RE_Abstract_Interface,              -- Ada.Tags
  
       RE_Abort_Task,                      -- Ada.Task_Identification
       RE_Current_Task,                    -- Ada.Task_Identification
*************** package Rtsfind is
*** 536,547 ****
       RE_CPP_CW_Membership,               -- Interfaces.CPP
       RE_CPP_DT_Entry_Size,               -- Interfaces.CPP
       RE_CPP_DT_Prologue_Size,            -- Interfaces.CPP
-      RE_CPP_Get_Expanded_Name,           -- Interfaces.CPP
       RE_CPP_Get_External_Tag,            -- Interfaces.CPP
       RE_CPP_Get_Prim_Op_Address,         -- Interfaces.CPP
       RE_CPP_Get_RC_Offset,               -- Interfaces.CPP
       RE_CPP_Get_Remotely_Callable,       -- Interfaces.CPP
-      RE_CPP_Get_TSD,                     -- Interfaces.CPP
       RE_CPP_Inherit_DT,                  -- Interfaces.CPP
       RE_CPP_Inherit_TSD,                 -- Interfaces.CPP
       RE_CPP_Register_Tag,                -- Interfaces.CPP
--- 571,580 ----
*************** package Rtsfind is
*** 634,653 ****
  
       RE_Register_Exception,              -- System.Exception_Table
  
-      RE_All_Others_Id,                   -- System.Exceptions
-      RE_Handler_Record,                  -- System.Exceptions
-      RE_Handler_Record_Ptr,              -- System.Exceptions
-      RE_Others_Id,                       -- System.Exceptions
-      RE_Subprogram_Descriptor,           -- System.Exceptions
-      RE_Subprogram_Descriptor_0,         -- System.Exceptions
-      RE_Subprogram_Descriptor_1,         -- System.Exceptions
-      RE_Subprogram_Descriptor_2,         -- System.Exceptions
-      RE_Subprogram_Descriptor_3,         -- System.Exceptions
-      RE_Subprogram_Descriptor_List,      -- System.Exceptions
-      RE_Subprogram_Descriptor_Ptr,       -- System.Exceptions
-      RE_Subprogram_Descriptors_Record,   -- System.Exceptions
-      RE_Subprogram_Descriptors_Ptr,      -- System.Exceptions
- 
       RE_Exn_Integer,                     -- System.Exn_Int
  
       RE_Exn_Long_Long_Float,             -- System.Exn_LLF
--- 667,672 ----
*************** package Rtsfind is
*** 664,676 ****
  
       RE_Exp_Unsigned,                    -- System.Exp_Uns
  
!      RE_Fat_Float,                       -- System.Fat_Flt
  
!      RE_Fat_Long_Float,                  -- System.Fat_LFlt
  
!      RE_Fat_Long_Long_Float,             -- System.Fat_LLF
  
!      RE_Fat_Short_Float,                 -- System.Fat_SFlt
  
       RE_Attach_To_Final_List,            -- System.Finalization_Implementation
       RE_Finalize_List,                   -- System.Finalization_Implementation
--- 683,710 ----
  
       RE_Exp_Unsigned,                    -- System.Exp_Uns
  
!      RE_Attr_Float,                      -- System.Fat_Flt
  
!      RE_Attr_IEEE_Long,                  -- System.Fat_IEEE_Long_Float
!      RE_Fat_IEEE_Long,                   -- System.Fat_IEEE_Long_Float
  
!      RE_Attr_IEEE_Short,                 -- System.Fat_IEEE_Short_Float
!      RE_Fat_IEEE_Short,                  -- System.Fat_IEEE_Short_Float
  
!      RE_Attr_Long_Float,                 -- System.Fat_LFlt
! 
!      RE_Attr_Long_Long_Float,            -- System.Fat_LLF
! 
!      RE_Attr_Short_Float,                -- System.Fat_SFlt
! 
!      RE_Attr_VAX_D_Float,                -- System.Fat_VAX_D_Float
!      RE_Fat_VAX_D,                       -- System.Fat_VAX_D_Float
! 
!      RE_Attr_VAX_F_Float,                -- System.Fat_VAX_F_Float
!      RE_Fat_VAX_F,                       -- System.Fat_VAX_F_Float
! 
!      RE_Attr_VAX_G_Float,                -- System.Fat_VAX_G_Float
!      RE_Fat_VAX_G,                       -- System.Fat_VAX_G_Float
  
       RE_Attach_To_Final_List,            -- System.Finalization_Implementation
       RE_Finalize_List,                   -- System.Finalization_Implementation
*************** package Rtsfind is
*** 1149,1154 ****
--- 1183,1189 ----
  
       RE_TC_Alias,                        -- System.PolyORB_Interface
       RE_TC_Build,                        -- System.PolyORB_Interface
+      RE_Get_TC,                          -- System.PolyORB_Interface
       RE_Set_TC,                          -- System.PolyORB_Interface
       RE_TC_Any,                          -- System.PolyORB_Interface
       RE_TC_AD,                           -- System.PolyORB_Interface
*************** package Rtsfind is
*** 1217,1222 ****
--- 1252,1258 ----
       RE_Integer_Address,                 -- System.Storage_Elements
       RE_Storage_Offset,                  -- System.Storage_Elements
       RE_Storage_Array,                   -- System.Storage_Elements
+      RE_Storage_Element,                 -- System.Storage_Elements
       RE_To_Address,                      -- System.Storage_Elements
  
       RE_Root_Storage_Pool,               -- System.Storage_Pools
*************** package Rtsfind is
*** 1289,1294 ****
--- 1325,1331 ----
       RE_Task_Procedure_Access,           -- System.Tasking
  
       RO_ST_Task_Id,                      -- System.Tasking
+      RO_ST_Null_Task,                    -- System.Tasking
  
       RE_Call_Modes,                      -- System.Tasking
       RE_Simple_Call,                     -- System.Tasking
*************** package Rtsfind is
*** 1415,1420 ****
--- 1452,1463 ----
       RE_Le_G,                            -- System.Vax_Float_Operations
       RE_Lt_F,                            -- System.Vax_Float_Operations
       RE_Lt_G,                            -- System.Vax_Float_Operations
+      RE_Ne_F,                            -- System.Vax_Float_Operations
+      RE_Ne_G,                            -- System.Vax_Float_Operations
+ 
+      RE_Valid_D,                         -- System.Vax_Float_Operations
+      RE_Valid_F,                         -- System.Vax_Float_Operations
+      RE_Valid_G,                         -- System.Vax_Float_Operations
  
       RE_Version_String,                  -- System.Version_Control
       RE_Get_Version_String,              -- System.Version_Control
*************** package Rtsfind is
*** 1586,1616 ****
  
       RE_Stream_Access                    => Ada_Streams_Stream_IO,
  
       RE_CW_Membership                    => Ada_Tags,
       RE_DT_Entry_Size                    => Ada_Tags,
       RE_DT_Prologue_Size                 => Ada_Tags,
       RE_External_Tag                     => Ada_Tags,
!      RE_Get_Expanded_Name                => Ada_Tags,
       RE_Get_External_Tag                 => Ada_Tags,
       RE_Get_Prim_Op_Address              => Ada_Tags,
       RE_Get_RC_Offset                    => Ada_Tags,
       RE_Get_Remotely_Callable            => Ada_Tags,
-      RE_Get_TSD                          => Ada_Tags,
       RE_Inherit_DT                       => Ada_Tags,
       RE_Inherit_TSD                      => Ada_Tags,
       RE_Internal_Tag                     => Ada_Tags,
       RE_Register_Tag                     => Ada_Tags,
       RE_Set_Expanded_Name                => Ada_Tags,
       RE_Set_External_Tag                 => Ada_Tags,
       RE_Set_Prim_Op_Address              => Ada_Tags,
       RE_Set_RC_Offset                    => Ada_Tags,
       RE_Set_Remotely_Callable            => Ada_Tags,
       RE_Set_TSD                          => Ada_Tags,
       RE_Tag_Error                        => Ada_Tags,
       RE_TSD_Entry_Size                   => Ada_Tags,
       RE_TSD_Prologue_Size                => Ada_Tags,
       RE_Tag                              => Ada_Tags,
       RE_Address_Array                    => Ada_Tags,
  
       RE_Abort_Task                       => Ada_Task_Identification,
       RE_Current_Task                     => Ada_Task_Identification,
--- 1629,1690 ----
  
       RE_Stream_Access                    => Ada_Streams_Stream_IO,
  
+      RE_Addr_Ptr                         => Ada_Tags,
       RE_CW_Membership                    => Ada_Tags,
+      RE_IW_Membership                    => Ada_Tags,
+      RE_Descendant_Tag                   => Ada_Tags,
       RE_DT_Entry_Size                    => Ada_Tags,
       RE_DT_Prologue_Size                 => Ada_Tags,
       RE_External_Tag                     => Ada_Tags,
!      RE_Get_Access_Level                 => Ada_Tags,
!      RE_Get_Entry_Index                  => Ada_Tags,
       RE_Get_External_Tag                 => Ada_Tags,
+      RE_Get_Offset_Index                 => Ada_Tags,
       RE_Get_Prim_Op_Address              => Ada_Tags,
+      RE_Get_Prim_Op_Kind                 => Ada_Tags,
       RE_Get_RC_Offset                    => Ada_Tags,
       RE_Get_Remotely_Callable            => Ada_Tags,
       RE_Inherit_DT                       => Ada_Tags,
       RE_Inherit_TSD                      => Ada_Tags,
       RE_Internal_Tag                     => Ada_Tags,
+      RE_Is_Descendant_At_Same_Level      => Ada_Tags,
+      RE_Object_Specific_Data             => Ada_Tags,
+      RE_POK_Function                     => Ada_Tags,
+      RE_POK_Procedure                    => Ada_Tags,
+      RE_POK_Protected_Entry              => Ada_Tags,
+      RE_POK_Protected_Function           => Ada_Tags,
+      RE_POK_Protected_Procedure          => Ada_Tags,
+      RE_POK_Task_Entry                   => Ada_Tags,
+      RE_POK_Task_Function                => Ada_Tags,
+      RE_POK_Task_Procedure               => Ada_Tags,
+      RE_Prim_Op_Kind                     => Ada_Tags,
+      RE_Register_Interface_Tag           => Ada_Tags,
       RE_Register_Tag                     => Ada_Tags,
+      RE_Select_Specific_Data             => Ada_Tags,
+      RE_Set_Access_Level                 => Ada_Tags,
+      RE_Set_Entry_Index                  => Ada_Tags,
       RE_Set_Expanded_Name                => Ada_Tags,
       RE_Set_External_Tag                 => Ada_Tags,
+      RE_Set_Num_Prim_Ops                 => Ada_Tags,
+      RE_Set_Offset_Index                 => Ada_Tags,
+      RE_Set_Offset_To_Top                => Ada_Tags,
+      RE_Set_OSD                          => Ada_Tags,
       RE_Set_Prim_Op_Address              => Ada_Tags,
+      RE_Set_Prim_Op_Kind                 => Ada_Tags,
       RE_Set_RC_Offset                    => Ada_Tags,
       RE_Set_Remotely_Callable            => Ada_Tags,
+      RE_Set_SSD                          => Ada_Tags,
       RE_Set_TSD                          => Ada_Tags,
       RE_Tag_Error                        => Ada_Tags,
       RE_TSD_Entry_Size                   => Ada_Tags,
       RE_TSD_Prologue_Size                => Ada_Tags,
+      RE_Interface_Tag                    => Ada_Tags,
       RE_Tag                              => Ada_Tags,
       RE_Address_Array                    => Ada_Tags,
+      RE_Valid_Signature                  => Ada_Tags,
+      RE_Primary_DT                       => Ada_Tags,
+      RE_Secondary_DT                     => Ada_Tags,
+      RE_Abstract_Interface               => Ada_Tags,
  
       RE_Abort_Task                       => Ada_Task_Identification,
       RE_Current_Task                     => Ada_Task_Identification,
*************** package Rtsfind is
*** 1636,1647 ****
       RE_CPP_CW_Membership                => Interfaces_CPP,
       RE_CPP_DT_Entry_Size                => Interfaces_CPP,
       RE_CPP_DT_Prologue_Size             => Interfaces_CPP,
-      RE_CPP_Get_Expanded_Name            => Interfaces_CPP,
       RE_CPP_Get_External_Tag             => Interfaces_CPP,
       RE_CPP_Get_Prim_Op_Address          => Interfaces_CPP,
       RE_CPP_Get_RC_Offset                => Interfaces_CPP,
       RE_CPP_Get_Remotely_Callable        => Interfaces_CPP,
-      RE_CPP_Get_TSD                      => Interfaces_CPP,
       RE_CPP_Inherit_DT                   => Interfaces_CPP,
       RE_CPP_Inherit_TSD                  => Interfaces_CPP,
       RE_CPP_Register_Tag                 => Interfaces_CPP,
--- 1710,1719 ----
*************** package Rtsfind is
*** 1734,1753 ****
  
       RE_Register_Exception               => System_Exception_Table,
  
-      RE_All_Others_Id                    => System_Exceptions,
-      RE_Handler_Record                   => System_Exceptions,
-      RE_Handler_Record_Ptr               => System_Exceptions,
-      RE_Others_Id                        => System_Exceptions,
-      RE_Subprogram_Descriptor            => System_Exceptions,
-      RE_Subprogram_Descriptor_0          => System_Exceptions,
-      RE_Subprogram_Descriptor_1          => System_Exceptions,
-      RE_Subprogram_Descriptor_2          => System_Exceptions,
-      RE_Subprogram_Descriptor_3          => System_Exceptions,
-      RE_Subprogram_Descriptor_List       => System_Exceptions,
-      RE_Subprogram_Descriptor_Ptr        => System_Exceptions,
-      RE_Subprogram_Descriptors_Record    => System_Exceptions,
-      RE_Subprogram_Descriptors_Ptr       => System_Exceptions,
- 
       RE_Exn_Integer                      => System_Exn_Int,
  
       RE_Exn_Long_Long_Float              => System_Exn_LLF,
--- 1806,1811 ----
*************** package Rtsfind is
*** 1764,1776 ****
  
       RE_Exp_Unsigned                     => System_Exp_Uns,
  
!      RE_Fat_Float                        => System_Fat_Flt,
  
!      RE_Fat_Long_Float                   => System_Fat_LFlt,
  
!      RE_Fat_Long_Long_Float              => System_Fat_LLF,
  
!      RE_Fat_Short_Float                  => System_Fat_SFlt,
  
       RE_Attach_To_Final_List             => System_Finalization_Implementation,
       RE_Finalize_List                    => System_Finalization_Implementation,
--- 1822,1849 ----
  
       RE_Exp_Unsigned                     => System_Exp_Uns,
  
!      RE_Attr_Float                       => System_Fat_Flt,
  
!      RE_Attr_IEEE_Long                   => System_Fat_IEEE_Long_Float,
!      RE_Fat_IEEE_Long                    => System_Fat_IEEE_Long_Float,
  
!      RE_Attr_IEEE_Short                  => System_Fat_IEEE_Short_Float,
!      RE_Fat_IEEE_Short                   => System_Fat_IEEE_Short_Float,
  
!      RE_Attr_Long_Float                  => System_Fat_LFlt,
! 
!      RE_Attr_Long_Long_Float             => System_Fat_LLF,
! 
!      RE_Attr_Short_Float                 => System_Fat_SFlt,
! 
!      RE_Attr_VAX_D_Float                 => System_Fat_VAX_D_Float,
!      RE_Fat_VAX_D                        => System_Fat_VAX_D_Float,
! 
!      RE_Attr_VAX_F_Float                 => System_Fat_VAX_F_Float,
!      RE_Fat_VAX_F                        => System_Fat_VAX_F_Float,
! 
!      RE_Attr_VAX_G_Float                 => System_Fat_VAX_G_Float,
!      RE_Fat_VAX_G                        => System_Fat_VAX_G_Float,
  
       RE_Attach_To_Final_List             => System_Finalization_Implementation,
       RE_Finalize_List                    => System_Finalization_Implementation,
*************** package Rtsfind is
*** 2240,2245 ****
--- 2313,2319 ----
  
       RE_TC_Alias                         => System_PolyORB_Interface,
       RE_TC_Build                         => System_PolyORB_Interface,
+      RE_Get_TC                           => System_PolyORB_Interface,
       RE_Set_TC                           => System_PolyORB_Interface,
       RE_TC_Any                           => System_PolyORB_Interface,
       RE_TC_AD                            => System_PolyORB_Interface,
*************** package Rtsfind is
*** 2317,2322 ****
--- 2391,2397 ----
       RE_Integer_Address                  => System_Storage_Elements,
       RE_Storage_Offset                   => System_Storage_Elements,
       RE_Storage_Array                    => System_Storage_Elements,
+      RE_Storage_Element                  => System_Storage_Elements,
       RE_To_Address                       => System_Storage_Elements,
  
       RE_Root_Storage_Pool                => System_Storage_Pools,
*************** package Rtsfind is
*** 2388,2393 ****
--- 2463,2469 ----
       RE_Task_Procedure_Access            => System_Tasking,
  
       RO_ST_Task_Id                       => System_Tasking,
+      RO_ST_Null_Task                     => System_Tasking,
  
       RE_Call_Modes                       => System_Tasking,
       RE_Simple_Call                      => System_Tasking,
*************** package Rtsfind is
*** 2514,2519 ****
--- 2590,2601 ----
       RE_Le_G                             => System_Vax_Float_Operations,
       RE_Lt_F                             => System_Vax_Float_Operations,
       RE_Lt_G                             => System_Vax_Float_Operations,
+      RE_Ne_F                             => System_Vax_Float_Operations,
+      RE_Ne_G                             => System_Vax_Float_Operations,
+ 
+      RE_Valid_D                          => System_Vax_Float_Operations,
+      RE_Valid_F                          => System_Vax_Float_Operations,
+      RE_Valid_G                          => System_Vax_Float_Operations,
  
       RE_Version_String                   => System_Version_Control,
       RE_Get_Version_String               => System_Version_Control,
*************** package Rtsfind is
*** 2795,2801 ****
     --  not mean that an attempt to load it subsequently would fail.
  
     procedure Set_RTU_Loaded (N : Node_Id);
!    --  Register the predefined unit N as already loaded.
  
     procedure Text_IO_Kludge (Nam : Node_Id);
     --  In Ada 83, and hence for compatibility in Ada 9X, package Text_IO has
--- 2877,2883 ----
     --  not mean that an attempt to load it subsequently would fail.
  
     procedure Set_RTU_Loaded (N : Node_Id);
!    --  Register the predefined unit N as already loaded
  
     procedure Text_IO_Kludge (Nam : Node_Id);
     --  In Ada 83, and hence for compatibility in Ada 9X, package Text_IO has
diff -Nrcpad gcc-4.0.2/gcc/ada/s-addima.adb gcc-4.1.0/gcc/ada/s-addima.adb
*** gcc-4.0.2/gcc/ada/s-addima.adb	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-addima.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-addima.ads gcc-4.1.0/gcc/ada/s-addima.ads
*** gcc-4.0.2/gcc/ada/s-addima.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-addima.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-addope.adb gcc-4.1.0/gcc/ada/s-addope.adb
*** gcc-4.0.2/gcc/ada/s-addope.adb	Thu Apr 29 15:24:56 2004
--- gcc-4.1.0/gcc/ada/s-addope.adb	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-addope.ads gcc-4.1.0/gcc/ada/s-addope.ads
*** gcc-4.0.2/gcc/ada/s-addope.ads	Fri Apr 23 10:58:30 2004
--- gcc-4.1.0/gcc/ada/s-addope.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2004-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 47,53 ****
  --  operations may not be available if type Address is a signed integer.
  
  package System.Address_Operations is
! pragma Pure (Address_Operations);
  
     --  The semantics of the arithmetic operations are those that apply to
     --  a modular type with the same length as Address, i.e. they provide
--- 47,53 ----
  --  operations may not be available if type Address is a signed integer.
  
  package System.Address_Operations is
!    pragma Pure;
  
     --  The semantics of the arithmetic operations are those that apply to
     --  a modular type with the same length as Address, i.e. they provide
diff -Nrcpad gcc-4.0.2/gcc/ada/s-arit64.adb gcc-4.1.0/gcc/ada/s-arit64.adb
*** gcc-4.0.2/gcc/ada/s-arit64.adb	Mon Jan  3 15:40:46 2005
--- gcc-4.1.0/gcc/ada/s-arit64.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-arit64.ads gcc-4.1.0/gcc/ada/s-arit64.ads
*** gcc-4.0.2/gcc/ada/s-arit64.ads	Wed Oct 27 13:39:21 2004
--- gcc-4.1.0/gcc/ada/s-arit64.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with Interfaces;
  
  package System.Arith_64 is
! pragma Pure (Arith_64);
  
     subtype Int64 is Interfaces.Integer_64;
  
--- 38,44 ----
  with Interfaces;
  
  package System.Arith_64 is
!    pragma Pure;
  
     subtype Int64 is Interfaces.Integer_64;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-assert.adb gcc-4.1.0/gcc/ada/s-assert.adb
*** gcc-4.0.2/gcc/ada/s-assert.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-assert.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . A S S E R T I O N S                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --                     S Y S T E M . A S S E R T I O N S                    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-assert.ads gcc-4.1.0/gcc/ada/s-assert.ads
*** gcc-4.0.2/gcc/ada/s-assert.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-assert.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --                    S Y S T E M . A S S E R T I O N S                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --                    S Y S T E M . A S S E R T I O N S                     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-asthan-vms-alpha.adb gcc-4.1.0/gcc/ada/s-asthan-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/s-asthan-vms-alpha.adb	Thu Feb 10 13:55:33 2005
--- gcc-4.1.0/gcc/ada/s-asthan-vms-alpha.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-asthan.adb gcc-4.1.0/gcc/ada/s-asthan.adb
*** gcc-4.0.2/gcc/ada/s-asthan.adb	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-asthan.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-asthan.ads gcc-4.1.0/gcc/ada/s-asthan.ads
*** gcc-4.0.2/gcc/ada/s-asthan.ads	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-asthan.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                  S Y S T E M . A S T _ H A N D L I N G                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                  S Y S T E M . A S T _ H A N D L I N G                   --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
  
  --  Runtime support for Handling of AST's (Used on VMS implementations only)
  
- 
  with Ada.Task_Identification;
  with System;
  with System.Aux_DEC;
--- 33,38 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-atacco.adb gcc-4.1.0/gcc/ada/s-atacco.adb
*** gcc-4.0.2/gcc/ada/s-atacco.adb	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/s-atacco.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-atacco.ads gcc-4.1.0/gcc/ada/s-atacco.ads
*** gcc-4.0.2/gcc/ada/s-atacco.ads	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/s-atacco.ads	Mon Sep  5 07:51:25 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 39,51 ****
     type Object (<>) is limited private;
  
  package System.Address_To_Access_Conversions is
! pragma Preelaborate (Address_To_Access_Conversions);
! 
! pragma Elaborate_Body;
! --  This pragma Elaborate_Body is there to ensure the requirement of what is
! --  at the moment a dummy null body. The reason this null body is there is
! --  that we used to have a real body, and it causes bootstrap problems with
! --  old compilers if we try to remove the corresponding file.
  
     pragma Compile_Time_Warning
       (Object'Unconstrained_Array,
--- 39,50 ----
     type Object (<>) is limited private;
  
  package System.Address_To_Access_Conversions is
!    pragma Preelaborate;
!    pragma Elaborate_Body;
!    --  This pragma Elaborate_Body is there to ensure the requirement of what is
!    --  at the moment a dummy null body. The reason this null body is there is
!    --  that we used to have a real body, and it causes bootstrap problems with
!    --  old compilers if we try to remove the corresponding file.
  
     pragma Compile_Time_Warning
       (Object'Unconstrained_Array,
*************** pragma Elaborate_Body;
*** 62,67 ****
--- 61,73 ----
     type Object_Pointer is access all Object;
     for Object_Pointer'Size use Standard'Address_Size;
  
+    pragma No_Strict_Aliasing (Object_Pointer);
+    --  Strictly speaking, this routine should not be used to generate pointers
+    --  to other than proper values of the proper type, but in practice, this
+    --  is done all the time. This pragma stops the compiler from doing some
+    --  optimizations that may cause unexpected results based on the assumption
+    --  of no strict aliasing.
+ 
     function To_Pointer (Value : Address)        return Object_Pointer;
     function To_Address (Value : Object_Pointer) return Address;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-auxdec-empty.adb gcc-4.1.0/gcc/ada/s-auxdec-empty.adb
*** gcc-4.0.2/gcc/ada/s-auxdec-empty.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-auxdec-empty.adb	Thu Nov 17 11:13:18 2005
***************
*** 0 ****
--- 1,36 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                       S Y S T E M . A U X _ D E C                        --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --             Copyright (C) 2005 Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/Or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  Or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- Or FITNESS FOr A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- fOr  mOre details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, Or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package body System.Aux_DEC is
+ 
+ end System.Aux_DEC;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-auxdec-empty.ads gcc-4.1.0/gcc/ada/s-auxdec-empty.ads
*** gcc-4.0.2/gcc/ada/s-auxdec-empty.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-auxdec-empty.ads	Thu Nov 17 11:13:18 2005
***************
*** 0 ****
--- 1,49 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                       S Y S T E M . A U X _ D E C                        --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --             Copyright (C) 2005 Free Software Foundation, Inc.            --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS For A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package is to be used when the extra definitions in package
+ --  System for DEC Ada implementations are not supported by the target.
+ 
+ package System.Aux_DEC is
+    pragma Pure;
+    pragma Elaborate_Body;
+ 
+    type AST_Handler is limited private;
+    No_AST_Handler : constant AST_Handler;
+ 
+ private
+ 
+    type AST_Handler is new Integer;
+    No_AST_Handler : constant AST_Handler := 0;
+ 
+ end System.Aux_DEC;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-auxdec-vms_64.ads gcc-4.1.0/gcc/ada/s-auxdec-vms_64.ads
*** gcc-4.0.2/gcc/ada/s-auxdec-vms_64.ads	Fri Jun 11 10:47:36 2004
--- gcc-4.1.0/gcc/ada/s-auxdec-vms_64.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS For A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS For A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,48 ****
  with Unchecked_Conversion;
  
  package System.Aux_DEC is
! pragma Elaborate_Body (Aux_DEC);
  
     subtype Short_Address is Address
       range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
--- 42,48 ----
  with Unchecked_Conversion;
  
  package System.Aux_DEC is
!    pragma Preelaborate;
  
     subtype Short_Address is Address
       range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-auxdec.adb gcc-4.1.0/gcc/ada/s-auxdec.adb
*** gcc-4.0.2/gcc/ada/s-auxdec.adb	Mon Apr 19 15:20:04 2004
--- gcc-4.1.0/gcc/ada/s-auxdec.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- Or FITNESS FOr A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- fOr  mOre details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, Or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- Or FITNESS FOr A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- fOr  mOre details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, Or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-auxdec.ads gcc-4.1.0/gcc/ada/s-auxdec.ads
*** gcc-4.0.2/gcc/ada/s-auxdec.ads	Fri Jun 11 10:47:36 2004
--- gcc-4.1.0/gcc/ada/s-auxdec.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS For A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS For A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,46 ****
  with Unchecked_Conversion;
  
  package System.Aux_DEC is
! pragma Elaborate_Body (Aux_DEC);
  
     subtype Short_Address is Address;
     --  In some versions of System.Aux_DEC, notably that for VMS on the
--- 40,46 ----
  with Unchecked_Conversion;
  
  package System.Aux_DEC is
!    pragma Preelaborate;
  
     subtype Short_Address is Address;
     --  In some versions of System.Aux_DEC, notably that for VMS on the
diff -Nrcpad gcc-4.0.2/gcc/ada/s-bitops.adb gcc-4.1.0/gcc/ada/s-bitops.adb
*** gcc-4.0.2/gcc/ada/s-bitops.adb	Wed Oct 27 13:39:44 2004
--- gcc-4.1.0/gcc/ada/s-bitops.adb	Tue Nov 15 14:05:30 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                       S Y S T E M . B I T _ O P S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1996-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                       S Y S T E M . B I T _ O P S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Unchecked_Conversion;
*** 40,46 ****
  package body System.Bit_Ops is
  
     subtype Bits_Array is System.Unsigned_Types.Packed_Bytes1 (Positive);
!    --  Unconstrained array used to interprete the address values. We use the
     --  unaligned version always, since this will handle both the aligned and
     --  unaligned cases, and we always do these operations by bytes anyway.
     --  Note: we use a ones origin array here so that the computations of the
--- 40,46 ----
  package body System.Bit_Ops is
  
     subtype Bits_Array is System.Unsigned_Types.Packed_Bytes1 (Positive);
!    --  Constrained array used to interpret the address values. We use the
     --  unaligned version always, since this will handle both the aligned and
     --  unaligned cases, and we always do these operations by bytes anyway.
     --  Note: we use a ones origin array here so that the computations of the
*************** package body System.Bit_Ops is
*** 107,114 ****
       (Left  : Address;
        Llen  : Natural;
        Right : Address;
!       Rlen  : Natural)
!       return  Boolean
     is
        LeftB  : constant Bits := To_Bits (Left);
        RightB : constant Bits := To_Bits (Right);
--- 107,113 ----
       (Left  : Address;
        Llen  : Natural;
        Right : Address;
!       Rlen  : Natural) return Boolean
     is
        LeftB  : constant Bits := To_Bits (Left);
        RightB : constant Bits := To_Bits (Right);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-bitops.ads gcc-4.1.0/gcc/ada/s-bitops.ads
*** gcc-4.0.2/gcc/ada/s-bitops.ads	Wed Oct 27 13:39:44 2004
--- gcc-4.1.0/gcc/ada/s-bitops.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                       S Y S T E M . B I T _ O P S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                       S Y S T E M . B I T _ O P S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Bit_Ops is
*** 40,46 ****
     --  Note: in all the following routines, the System.Address parameters
     --  represent the address of the first byte of an array used to represent
     --  a packed array (of type System.Unsigned_Types.Packed_Bytes{1,2,4})
!    --  The length in bits is passed as a separate parameter.
  
     procedure Bit_And
       (Left   : System.Address;
--- 40,47 ----
     --  Note: in all the following routines, the System.Address parameters
     --  represent the address of the first byte of an array used to represent
     --  a packed array (of type System.Unsigned_Types.Packed_Bytes{1,2,4})
!    --  The length in bits is passed as a separate parameter. Note that all
!    --  addresses must be of byte aligned arrays.
  
     procedure Bit_And
       (Left   : System.Address;
*************** package System.Bit_Ops is
*** 57,64 ****
       (Left  : System.Address;
        Llen  : Natural;
        Right : System.Address;
!       Rlen  : Natural)
!       return  Boolean;
     --  Left and Right are the addresses of two bit packed arrays with Llen
     --  and Rlen being the respective length in bits. The routine compares the
     --  two bit strings for equality, being careful not to include the unused
--- 58,64 ----
       (Left  : System.Address;
        Llen  : Natural;
        Right : System.Address;
!       Rlen  : Natural) return Boolean;
     --  Left and Right are the addresses of two bit packed arrays with Llen
     --  and Rlen being the respective length in bits. The routine compares the
     --  two bit strings for equality, being careful not to include the unused
diff -Nrcpad gcc-4.0.2/gcc/ada/s-boarop.ads gcc-4.1.0/gcc/ada/s-boarop.ads
*** gcc-4.0.2/gcc/ada/s-boarop.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-boarop.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --      S Y S T E M . B O O L E A N _ A R R A Y _ O P E R A T I O N S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --      S Y S T E M . B O O L E A N _ A R R A Y _ O P E R A T I O N S       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  
  with System.Generic_Vector_Operations;
  with System.Vectors.Boolean_Operations;
  package System.Boolean_Array_Operations is
! pragma Pure (Boolean_Array_Operations);
     type Boolean_Array is array (Integer range <>) of Boolean;
  
     package Boolean_Operations renames System.Vectors.Boolean_Operations;
--- 35,44 ----
  
  with System.Generic_Vector_Operations;
  with System.Vectors.Boolean_Operations;
+ 
  package System.Boolean_Array_Operations is
!    pragma Pure;
! 
     type Boolean_Array is array (Integer range <>) of Boolean;
  
     package Boolean_Operations renames System.Vectors.Boolean_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-carsi8.adb gcc-4.1.0/gcc/ada/s-carsi8.adb
*** gcc-4.0.2/gcc/ada/s-carsi8.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-carsi8.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --         S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 8        --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --         S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 8        --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-carsi8.ads gcc-4.1.0/gcc/ada/s-carsi8.ads
*** gcc-4.0.2/gcc/ada/s-carsi8.ads	Wed Oct 27 13:39:44 2004
--- gcc-4.1.0/gcc/ada/s-carsi8.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --         S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 8        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --         S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 8        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-carun8.adb gcc-4.1.0/gcc/ada/s-carun8.adb
*** gcc-4.0.2/gcc/ada/s-carun8.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-carun8.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --       S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 8      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --       S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 8      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-carun8.ads gcc-4.1.0/gcc/ada/s-carun8.ads
*** gcc-4.0.2/gcc/ada/s-carun8.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-carun8.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --       S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 8      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --       S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 8      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi16.adb gcc-4.1.0/gcc/ada/s-casi16.adb
*** gcc-4.0.2/gcc/ada/s-casi16.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-casi16.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 16        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 16        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi16.ads gcc-4.1.0/gcc/ada/s-casi16.ads
*** gcc-4.0.2/gcc/ada/s-casi16.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-casi16.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 1 6       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 1 6       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi32.adb gcc-4.1.0/gcc/ada/s-casi32.adb
*** gcc-4.0.2/gcc/ada/s-casi32.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-casi32.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 3 2       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 3 2       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi32.ads gcc-4.1.0/gcc/ada/s-casi32.ads
*** gcc-4.0.2/gcc/ada/s-casi32.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-casi32.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 3 2       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 3 2       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi64.adb gcc-4.1.0/gcc/ada/s-casi64.adb
*** gcc-4.0.2/gcc/ada/s-casi64.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-casi64.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 6 4       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 6 4       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casi64.ads gcc-4.1.0/gcc/ada/s-casi64.ads
*** gcc-4.0.2/gcc/ada/s-casi64.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-casi64.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 6 4       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --        S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 6 4       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casuti.adb gcc-4.1.0/gcc/ada/s-casuti.adb
*** gcc-4.0.2/gcc/ada/s-casuti.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-casuti.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . C A S E _ U T I L                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . C A S E _ U T I L                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-casuti.ads gcc-4.1.0/gcc/ada/s-casuti.ads
*** gcc-4.0.2/gcc/ada/s-casuti.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-casuti.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . C A S E _ U T I L                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2002 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . C A S E _ U T I L                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,46 ****
  --  via GNAT.Case_Util, which imports all the entities from this package.
  
  package System.Case_Util is
! pragma Pure (Case_Util);
  
     --  Note: all the following functions handle the full Latin-1 set
  
--- 40,46 ----
  --  via GNAT.Case_Util, which imports all the entities from this package.
  
  package System.Case_Util is
!    pragma Pure;
  
     --  Note: all the following functions handle the full Latin-1 set
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun16.adb gcc-4.1.0/gcc/ada/s-caun16.adb
*** gcc-4.0.2/gcc/ada/s-caun16.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-caun16.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 16      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 16      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun16.ads gcc-4.1.0/gcc/ada/s-caun16.ads
*** gcc-4.0.2/gcc/ada/s-caun16.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-caun16.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 1 6     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 1 6     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun32.adb gcc-4.1.0/gcc/ada/s-caun32.adb
*** gcc-4.0.2/gcc/ada/s-caun32.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-caun32.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 3 2     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 3 2     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun32.ads gcc-4.1.0/gcc/ada/s-caun32.ads
*** gcc-4.0.2/gcc/ada/s-caun32.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-caun32.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 3 2     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 3 2     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun64.adb gcc-4.1.0/gcc/ada/s-caun64.adb
*** gcc-4.0.2/gcc/ada/s-caun64.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-caun64.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 6 4     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 6 4     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-caun64.ads gcc-4.1.0/gcc/ada/s-caun64.ads
*** gcc-4.0.2/gcc/ada/s-caun64.ads	Mon Apr 19 15:20:05 2004
--- gcc-4.1.0/gcc/ada/s-caun64.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 6 4     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --      S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 6 4     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-chepoo.ads gcc-4.1.0/gcc/ada/s-chepoo.ads
*** gcc-4.0.2/gcc/ada/s-chepoo.ads	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-chepoo.ads	Tue Nov 15 14:05:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --       Copyright (C) 1992-1996, 2005      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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Checked_Pools is
*** 41,72 ****
     --  called on each implicit or explicit dereference of a pointer which
     --  has such a storage pool
  
-    procedure Allocate
-      (Pool                     : in out Checked_Pool;
-       Storage_Address          : out Address;
-       Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-       Alignment                : in System.Storage_Elements.Storage_Count)
-    is abstract;
- 
-    procedure Deallocate
-      (Pool                     : in out Checked_Pool;
-       Storage_Address          : in Address;
-       Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
-       Alignment                : in System.Storage_Elements.Storage_Count)
-    is abstract;
- 
-    function Storage_Size
-      (Pool : Checked_Pool)
-       return System.Storage_Elements.Storage_Count
-    is abstract;
- 
     procedure Dereference
       (Pool                     : in out Checked_Pool;
        Storage_Address          : in Address;
        Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
        Alignment                : in System.Storage_Elements.Storage_Count)
     is abstract;
!    --  Called each time a pointer to a checked pool is dereferenced
  
  private
     type Checked_Pool is abstract
--- 41,58 ----
     --  called on each implicit or explicit dereference of a pointer which
     --  has such a storage pool
  
     procedure Dereference
       (Pool                     : in out Checked_Pool;
        Storage_Address          : in Address;
        Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
        Alignment                : in System.Storage_Elements.Storage_Count)
     is abstract;
!    --  Called implicitly each time a pointer to a checked pool is dereferenced
!    --  All parameters in the profile are compatible with the profile of
!    --  Allocate/Deallocate: the Storage_Address corresponds to the address of
!    --  the dereferenced object, Size_in_Storage_Elements is its dynamic size
!    --  (and thus may involve an implicit dispatching call to size) and
!    --  Alignment is the alignment of the object.
  
  private
     type Checked_Pool is abstract
diff -Nrcpad gcc-4.0.2/gcc/ada/s-crc32.adb gcc-4.1.0/gcc/ada/s-crc32.adb
*** gcc-4.0.2/gcc/ada/s-crc32.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-crc32.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-crc32.ads gcc-4.1.0/gcc/ada/s-crc32.ads
*** gcc-4.0.2/gcc/ada/s-crc32.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-crc32.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-crtl-vms64.ads gcc-4.1.0/gcc/ada/s-crtl-vms64.ads
*** gcc-4.0.2/gcc/ada/s-crtl-vms64.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-crtl-vms64.ads	Mon Sep  5 07:51:25 2005
***************
*** 0 ****
--- 1,184 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                        GNAT RUN-TIME COMPONENTS                          --
+ --                                                                          --
+ --                         S Y S T E M . C R T L                            --
+ --                                                                          --
+ --                                S p e c                                   --
+ --                                                                          --
+ --         Copyright (C) 2004-2005 Free Software Foundation, Inc.           --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package provides the low level interface to the C Run Time Library
+ --  on 64 bit VMS.  Note that routines that allocate memory remain 32bit.
+ 
+ with System.Parameters;
+ 
+ package System.CRTL is
+    pragma Preelaborate;
+ 
+    subtype chars is System.Address;
+    --  Pointer to null-terminated array of characters
+ 
+    subtype DIRs is System.Address;
+    --  Corresponds to the C type DIR*
+ 
+    subtype FILEs is System.Address;
+    --  Corresponds to the C type FILE*
+ 
+    subtype int is Integer;
+ 
+    type long is range -(2 ** (System.Parameters.long_bits - 1))
+       .. +(2 ** (System.Parameters.long_bits - 1)) - 1;
+ 
+    subtype off_t is Integer;
+ 
+    type size_t is mod 2 ** Standard'Address_Size;
+ 
+    function atoi (A : System.Address) return Integer;
+    pragma Import (C, atoi, "decc$atoi");
+ 
+    procedure clearerr (stream : FILEs);
+    pragma Import (C, clearerr, "decc$clearerr");
+ 
+    function closedir (directory : DIRs) return Integer;
+    pragma Import (C, closedir, "decc$closedir");
+ 
+    function dup  (handle : int) return int;
+    pragma Import (C, dup, "decc$dup");
+ 
+    function dup2 (from, to : int) return int;
+    pragma Import (C, dup2, "decc$dup2");
+ 
+    function fclose (stream : FILEs) return int;
+    pragma Import (C, fclose, "decc$fclose");
+ 
+    function fdopen (handle : int; mode : chars) return FILEs;
+    pragma Import (C, fdopen, "decc$fdopen");
+ 
+    function fflush (stream : FILEs) return int;
+    pragma Import (C, fflush, "decc$fflush");
+ 
+    function fgetc (stream : FILEs) return int;
+    pragma Import (C, fgetc, "decc$fgetc");
+ 
+    function fgets (strng : chars; n : int; stream : FILEs) return chars;
+    pragma Import (C, fgets, "decc$_fgets64");
+ 
+    function fopen (filename : chars; Mode : chars) return FILEs;
+    pragma Import (C, fopen, "decc$fopen");
+ 
+    function fputc (C : int; stream : FILEs) return int;
+    pragma Import (C, fputc, "decc$fputc");
+ 
+    function fputs (Strng : chars; Stream : FILEs) return int;
+    pragma Import (C, fputs, "decc$fputs");
+ 
+    procedure free (Ptr : System.Address);
+    pragma Import (C, free, "decc$free");
+ 
+    function freopen
+      (filename : chars;
+       mode     : chars;
+       stream   : FILEs)
+       return     FILEs;
+    pragma Import (C, freopen, "decc$freopen");
+ 
+    function fseek
+      (stream : FILEs;
+       offset : long;
+       origin : int)
+       return   int;
+    pragma Import (C, fseek, "decc$fseek");
+ 
+    function ftell (stream : FILEs) return long;
+    pragma Import (C, ftell, "decc$ftell");
+ 
+    function getenv (S : String) return System.Address;
+    pragma Import (C, getenv, "decc$getenv");
+ 
+    function isatty (handle : int) return int;
+    pragma Import (C, isatty, "decc$isatty");
+ 
+    function lseek (fd : int; offset : off_t; direction : int) return off_t;
+    pragma Import (C, lseek, "decc$lseek");
+ 
+    function malloc (Size : size_t) return System.Address;
+    pragma Import (C, malloc, "decc$malloc");
+ 
+    procedure memcpy (S1 : System.Address; S2 : System.Address; N : size_t);
+    pragma Import (C, memcpy, "decc$_memcpy64");
+ 
+    procedure memmove (S1 : System.Address; S2 : System.Address; N : size_t);
+    pragma Import (C, memmove, "decc$_memmove64");
+ 
+    procedure mktemp (template : chars);
+    pragma Import (C, mktemp, "decc$_mktemp64");
+ 
+    function opendir (file_name : String) return DIRs;
+    pragma Import (C, opendir, "decc$opendir");
+ 
+    function pclose (stream : System.Address) return int;
+    pragma Import (C, pclose, "decc$pclose");
+ 
+    function popen (command, mode : System.Address) return System.Address;
+    pragma Import (C, popen, "decc$popen");
+ 
+    function read (fd : int; buffer : chars; nbytes : int) return int;
+    pragma Import (C, read, "decc$read");
+ 
+    function realloc
+      (Ptr : System.Address; Size : size_t) return System.Address;
+    pragma Import (C, realloc, "decc$realloc");
+ 
+    procedure rewind (stream : FILEs);
+    pragma Import (C, rewind, "decc$rewind");
+ 
+    procedure rmdir (dir_name : String);
+    pragma Import (C, rmdir, "decc$rmdir");
+ 
+    function setvbuf
+      (stream : FILEs;
+       buffer : chars;
+       mode   : int;
+       size   : size_t)
+       return   int;
+    pragma Import (C, setvbuf, "decc$setvbuf");
+ 
+    procedure tmpnam (string : chars);
+    pragma Import (C, tmpnam, "decc$_tmpnam64");
+ 
+    function tmpfile return FILEs;
+    pragma Import (C, tmpfile, "decc$tmpfile");
+ 
+    function ungetc (c : int; stream : FILEs) return int;
+    pragma Import (C, ungetc, "decc$ungetc");
+ 
+    function unlink (filename : chars) return int;
+    pragma Import (C, unlink, "decc$unlink");
+ 
+    function write (fd : int; buffer : chars; nbytes : int) return int;
+    pragma Import (C, write, "decc$write");
+ end System.CRTL;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-crtl.ads gcc-4.1.0/gcc/ada/s-crtl.ads
*** gcc-4.0.2/gcc/ada/s-crtl.ads	Thu Feb 10 13:49:15 2005
--- gcc-4.1.0/gcc/ada/s-crtl.ads	Mon Sep  5 07:51:25 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,42 ****
  --  on non-VMS systems.
  
  with System.Parameters;
  package System.CRTL is
! pragma Preelaborate (CRTL);
  
     subtype chars is System.Address;
     --  Pointer to null-terminated array of characters
--- 35,43 ----
  --  on non-VMS systems.
  
  with System.Parameters;
+ 
  package System.CRTL is
!    pragma Preelaborate;
  
     subtype chars is System.Address;
     --  Pointer to null-terminated array of characters
*************** pragma Preelaborate (CRTL);
*** 139,144 ****
--- 140,151 ----
     function opendir (file_name : String) return DIRs;
     pragma Import (C, opendir, "opendir");
  
+    function pclose (stream : System.Address) return int;
+    pragma Import (C, pclose, "pclose");
+ 
+    function popen (command, mode : System.Address) return System.Address;
+    pragma Import (C, popen, "popen");
+ 
     function read (fd : int; buffer : chars; nbytes : int) return int;
     pragma Import (C, read, "read");
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-direio.adb gcc-4.1.0/gcc/ada/s-direio.adb
*** gcc-4.0.2/gcc/ada/s-direio.adb	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/s-direio.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . D I R E C T _ I O                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . D I R E C T _ I O                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-direio.ads gcc-4.1.0/gcc/ada/s-direio.ads
*** gcc-4.0.2/gcc/ada/s-direio.ads	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-direio.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . D I R E C T _ I O                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . D I R E C T _ I O                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-errrep.adb gcc-4.1.0/gcc/ada/s-errrep.adb
*** gcc-4.0.2/gcc/ada/s-errrep.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-errrep.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --               S Y S T E M . E R R O R _ R E P O R T I N G                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
  --               S Y S T E M . E R R O R _ R E P O R T I N G                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-errrep.ads gcc-4.1.0/gcc/ada/s-errrep.ads
*** gcc-4.0.2/gcc/ada/s-errrep.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-errrep.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --               S Y S T E M . E R R O R _ R E P O R T I N G                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --               S Y S T E M . E R R O R _ R E P O R T I N G                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-except.ads gcc-4.1.0/gcc/ada/s-except.ads
*** gcc-4.0.2/gcc/ada/s-except.ads	Thu Apr 24 17:54:08 2003
--- gcc-4.1.0/gcc/ada/s-except.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,203 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT RUN-TIME COMPONENTS                         --
- --                                                                          --
- --                    S Y S T E M . E X C E P T I O N S                     --
- --                                                                          --
- --                                 S p e c                                  --
- --                                                                          --
- --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This package contains definitions used for zero cost exception handling.
- --  See unit Ada.Exceptions for further details. Note that the reason that
- --  we separate out these definitions is to avoid problems with recursion
- --  in rtsfind. They must be in a unit which does not require any exception
- --  table generation of any kind.
- 
- with Ada.Exceptions;
- 
- with System;
- with System.Standard_Library;
- 
- with Unchecked_Conversion;
- 
- package System.Exceptions is
- 
-    package SSL renames System.Standard_Library;
-    package AEX renames Ada.Exceptions;
- 
-    --  The following section defines data structures used for zero cost
-    --  exception handling if System.Parameters.Zero_Cost_Exceptions is
-    --  set true (i.e. zero cost exceptions are implemented on this target).
- 
-    --  The approach is to build tables that describe the PC ranges that
-    --  are covered by various exception frames. When an exception occurs,
-    --  these tables are searched to determine the address of the applicable
-    --  handler for the current exception.
- 
-    subtype Handler_Loc is System.Address;
-    --  Code location representing entry address of a handler. Values of
-    --  this type are created using the N_Handler_Loc node, and then
-    --  passed to the Enter_Handler procedure to enter a handler.
- 
-    subtype Code_Loc is System.Address;
-    --  Code location used in building exception tables and for call
-    --  addresses when propagating an exception (also traceback table)
-    --  Values of this type are created by using Label'Address or
-    --  extracted from machine states using Get_Code_Loc.
- 
-    --------------------
-    -- Handler_Record --
-    --------------------
- 
-    --  A Handler record is built for each choice for each exception handler
-    --  in a frame.
- 
-    function To_Exception_Id is
-      new Unchecked_Conversion (SSL.Exception_Data_Ptr, AEX.Exception_Id);
- 
-    Others_Dummy_Exception : aliased SSL.Exception_Data;
-    Others_Id : constant AEX.Exception_Id :=
-                  To_Exception_Id (Others_Dummy_Exception'Access);
-    --  Dummy exception used to signal others exception
- 
-    All_Others_Dummy_Exception : aliased SSL.Exception_Data;
-    All_Others_Id : constant AEX.Exception_Id :=
-                      To_Exception_Id (All_Others_Dummy_Exception'Access);
-    --  Dummy exception used to signal all others exception (including
-    --  exceptions not normally handled by others, e.g. Abort_Signal)
- 
-    type Handler_Record is record
-       Lo : Code_Loc;
-       Hi : Code_Loc;
-       --  Range of PC values of code covered by this handler record. The
-       --  handler covers all code addresses that are greater than the Lo
-       --  value, and less than or equal to the Hi value.
- 
-       Id : AEX.Exception_Id;
-       --  Id of exception being handled, or one of the above special values
- 
-       Handler : Handler_Loc;
-       --  Address of label at start of handler
-    end record;
- 
-    type Handler_Record_Ptr is access all Handler_Record;
-    type Handler_Record_List is array (Natural range <>) of Handler_Record_Ptr;
- 
-    ---------------------------
-    -- Subprogram_Descriptor --
-    ---------------------------
- 
-    --  A Subprogram_Descriptor is built for each subprogram through which
-    --  exceptions may propagate, this includes all Ada subprograms,
-    --  and also all foreign language imported subprograms.
- 
-    subtype Subprogram_Info_Type is System.Address;
-    --  This type is used to represent a value that is used to unwind stack
-    --  frames. It references target dependent data that provides sufficient
-    --  information (e.g. about the location of the return point, use of a
-    --  frame pointer, save-over-call registers etc) to unwind the machine
-    --  state to the caller. For some targets, this is simply a pointer to
-    --  the entry point of the procedure (and the routine to pop the machine
-    --  state disassembles the code at the entry point to obtain the required
-    --  information). On other targets, it is a pointer to data created by the
-    --  backend or assembler to represent the required information.
- 
-    No_Info : constant Subprogram_Info_Type := System.Null_Address;
-    --  This is a special value used to indicate that it is not possible
-    --  to pop past this frame. This is used at the outer level (e.g. for
-    --  package elaboration procedures or the main procedure), and for any
-    --  other foreign language procedure for which propagation is known
-    --  to be impossible. An exception is considered unhandled if an
-    --  attempt is made to pop a frame whose Subprogram_Info_Type value
-    --  is set to No_Info.
- 
-    type Subprogram_Descriptor (Num_Handlers : Natural) is record
-       Code : Code_Loc;
-       --  This is a code location used to determine which procedure we are
-       --  in. Most usually it is simply the entry address for the procedure.
-       --  hA given address is considered to be within the procedure referenced
-       --  by a Subprogram_Descriptor record if this is the descriptor for
-       --  which the Code value is as large as possible without exceeding
-       --  the given value.
- 
-       Subprogram_Info : Subprogram_Info_Type;
-       --  This is a pointer to a target dependent data item that provides
-       --  sufficient information for unwinding the stack frame of this
-       --  procedure. A value of No_Info (zero) means that we are the
-       --  outer level procedure.
- 
-       Handler_Records : Handler_Record_List (1 .. Num_Handlers);
-       --  List of pointers to Handler_Records for this procedure. The array
-       --  is sorted inside out, i.e. entries for inner frames appear before
-       --  entries for outer handlers. This ensures that a serial search
-       --  finds the innermost applicable handler
-    end record;
- 
-    subtype Subprogram_Descriptor_0 is Subprogram_Descriptor (0);
-    subtype Subprogram_Descriptor_1 is Subprogram_Descriptor (1);
-    subtype Subprogram_Descriptor_2 is Subprogram_Descriptor (2);
-    subtype Subprogram_Descriptor_3 is Subprogram_Descriptor (3);
-    --  Predeclare commonly used subtypes for buildingt he tables
- 
-    type Subprogram_Descriptor_Ptr is access all Subprogram_Descriptor;
- 
-    type Subprogram_Descriptor_List
-      is array (Natural range <>) of Subprogram_Descriptor_Ptr;
- 
-    type Subprogram_Descriptors_Record (Count : Natural) is record
-       SDesc : Subprogram_Descriptor_List (1 .. Count);
-    end record;
- 
-    type Subprogram_Descriptors_Ptr is
-      access all Subprogram_Descriptors_Record;
- 
-    --------------------------
-    -- Unit Exception_Table --
-    --------------------------
- 
-    --  If a unit contains at least one subprogram, then a library level
-    --  declaration of the form:
- 
-    --    Tnn : aliased constant Subprogram_Descriptors :=
-    --            (Count => n,
-    --             SDesc =>
-    --              (SD1'Unrestricted_Access,
-    --               SD2'Unrestricted_Access,
-    --               ...
-    --               SDn'Unrestricted_Access));
-    --    pragma Export (Ada, Tnn, "__gnat_unit_name__SDP");
- 
-    --  is generated where the initializing expression is an array aggregate
-    --  whose elements are pointers to the generated subprogram descriptors
-    --  for the units.
- 
-    --  Note: the ALI file contains the designation UX in each unit entry
-    --  if a unit exception table is generated.
- 
-    --  The binder generates a list of addresses of pointers to these tables.
- 
- end System.Exceptions;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exctab.adb gcc-4.1.0/gcc/ada/s-exctab.adb
*** gcc-4.0.2/gcc/ada/s-exctab.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exctab.adb	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Exception_Table is
*** 43,51 ****
     procedure Set_HT_Link (T : Exception_Data_Ptr; Next : Exception_Data_Ptr);
     function  Get_HT_Link (T : Exception_Data_Ptr) return Exception_Data_Ptr;
  
!    function Hash (F : Big_String_Ptr) return HTable_Headers;
!    function Equal (A, B : Big_String_Ptr) return Boolean;
!    function Get_Key (T : Exception_Data_Ptr) return Big_String_Ptr;
  
     package Exception_HTable is new System.HTable.Static_HTable (
       Header_Num => HTable_Headers,
--- 43,51 ----
     procedure Set_HT_Link (T : Exception_Data_Ptr; Next : Exception_Data_Ptr);
     function  Get_HT_Link (T : Exception_Data_Ptr) return Exception_Data_Ptr;
  
!    function Hash (F : System.Address) return HTable_Headers;
!    function Equal (A, B : System.Address) return Boolean;
!    function Get_Key (T : Exception_Data_Ptr) return System.Address;
  
     package Exception_HTable is new System.HTable.Static_HTable (
       Header_Num => HTable_Headers,
*************** package body System.Exception_Table is
*** 54,60 ****
       Null_Ptr   => null,
       Set_Next   => Set_HT_Link,
       Next       => Get_HT_Link,
!      Key        => Big_String_Ptr,
       Get_Key    => Get_Key,
       Hash       => Hash,
       Equal      => Equal);
--- 54,60 ----
       Null_Ptr   => null,
       Set_Next   => Set_HT_Link,
       Next       => Get_HT_Link,
!      Key        => System.Address,
       Get_Key    => Get_Key,
       Hash       => Hash,
       Equal      => Equal);
*************** package body System.Exception_Table is
*** 63,77 ****
     -- Equal --
     -----------
  
!    function Equal (A, B : Big_String_Ptr) return Boolean is
!       J    : Integer := 1;
  
     begin
        loop
!          if A (J) /= B (J) then
              return False;
  
!          elsif A (J) = ASCII.NUL then
              return True;
  
           else
--- 63,79 ----
     -- Equal --
     -----------
  
!    function Equal (A, B : System.Address) return Boolean is
!       S1 : constant Big_String_Ptr := To_Ptr (A);
!       S2 : constant Big_String_Ptr := To_Ptr (B);
!       J : Integer := 1;
  
     begin
        loop
!          if S1 (J) /= S2 (J) then
              return False;
  
!          elsif S1 (J) = ASCII.NUL then
              return True;
  
           else
*************** package body System.Exception_Table is
*** 93,99 ****
     -- Get_Key --
     -------------
  
!    function Get_Key (T : Exception_Data_Ptr) return Big_String_Ptr is
     begin
        return T.Full_Name;
     end Get_Key;
--- 95,101 ----
     -- Get_Key --
     -------------
  
!    function Get_Key (T : Exception_Data_Ptr) return System.Address is
     begin
        return T.Full_Name;
     end Get_Key;
*************** package body System.Exception_Table is
*** 125,133 ****
     -- Hash --
     ----------
  
!    function Hash (F : Big_String_Ptr) return HTable_Headers is
        type S is mod 2**8;
  
        Size : constant S := S (HTable_Headers'Last - HTable_Headers'First + 1);
        Tmp  : S := 0;
        J    : Positive;
--- 127,136 ----
     -- Hash --
     ----------
  
!    function Hash (F : System.Address) return HTable_Headers is
        type S is mod 2**8;
  
+       Str  : constant Big_String_Ptr := To_Ptr (F);
        Size : constant S := S (HTable_Headers'Last - HTable_Headers'First + 1);
        Tmp  : S := 0;
        J    : Positive;
*************** package body System.Exception_Table is
*** 135,144 ****
     begin
        J := 1;
        loop
!          if F (J) = ASCII.NUL then
              return HTable_Headers'First + HTable_Headers'Base (Tmp mod Size);
           else
!             Tmp := Tmp xor S (Character'Pos (F (J)));
           end if;
           J := J + 1;
        end loop;
--- 138,147 ----
     begin
        J := 1;
        loop
!          if Str (J) = ASCII.NUL then
              return HTable_Headers'First + HTable_Headers'Base (Tmp mod Size);
           else
!             Tmp := Tmp xor S (Character'Pos (Str (J)));
           end if;
           J := J + 1;
        end loop;
*************** package body System.Exception_Table is
*** 161,167 ****
     begin
        Copy (X'Range) := X;
        Copy (Copy'Last) := ASCII.NUL;
!       Res := Exception_HTable.Get (To_Ptr (Copy'Address));
  
        --  If unknown exception, create it on the heap. This is a legitimate
        --  situation in the distributed case when an exception is defined only
--- 164,170 ----
     begin
        Copy (X'Range) := X;
        Copy (Copy'Last) := ASCII.NUL;
!       Res := Exception_HTable.Get (Copy'Address);
  
        --  If unknown exception, create it on the heap. This is a legitimate
        --  situation in the distributed case when an exception is defined only
*************** package body System.Exception_Table is
*** 175,181 ****
               (Not_Handled_By_Others => False,
                Lang                  => 'A',
                Name_Length           => Copy'Length,
!               Full_Name             => To_Ptr (Dyn_Copy.all'Address),
                HTable_Ptr            => null,
                Import_Code           => 0,
                Raise_Hook            => null);
--- 178,184 ----
               (Not_Handled_By_Others => False,
                Lang                  => 'A',
                Name_Length           => Copy'Length,
!               Full_Name             => Dyn_Copy.all'Address,
                HTable_Ptr            => null,
                Import_Code           => 0,
                Raise_Hook            => null);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exctab.ads gcc-4.1.0/gcc/ada/s-exctab.ads
*** gcc-4.0.2/gcc/ada/s-exctab.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exctab.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Standard_Library;
  
  package System.Exception_Table is
! pragma Elaborate_Body;
  
     package SSL renames System.Standard_Library;
  
--- 38,44 ----
  with System.Standard_Library;
  
  package System.Exception_Table is
!    pragma Elaborate_Body;
  
     package SSL renames System.Standard_Library;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnint.adb gcc-4.1.0/gcc/ada/s-exnint.adb
*** gcc-4.0.2/gcc/ada/s-exnint.adb	Mon Dec  1 13:29:27 2003
--- gcc-4.1.0/gcc/ada/s-exnint.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ I N T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ I N T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnint.ads gcc-4.1.0/gcc/ada/s-exnint.ads
*** gcc-4.0.2/gcc/ada/s-exnint.ads	Mon Dec  1 13:29:27 2003
--- gcc-4.1.0/gcc/ada/s-exnint.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Integer exponentiation (checks off)
  
  package System.Exn_Int is
! pragma Pure (Exn_Int);
  
     function Exn_Integer (Left : Integer; Right : Natural) return Integer;
  
--- 34,40 ----
  --  Integer exponentiation (checks off)
  
  package System.Exn_Int is
!    pragma Pure;
  
     function Exn_Integer (Left : Integer; Right : Natural) return Integer;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnllf.adb gcc-4.1.0/gcc/ada/s-exnllf.adb
*** gcc-4.0.2/gcc/ada/s-exnllf.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exnllf.adb	Tue Nov 15 14:05:30 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L F                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L F                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Exn_LLF is
*** 49,57 ****
     begin
        --  We use the standard logarithmic approach, Exp gets shifted right
        --  testing successive low order bits and Factor is the value of the
!       --  base raised to the next power of 2. For positive exponents we
!       --  multiply the result by this factor, for negative exponents, we
!       --  Division by this factor.
  
        if Exp >= 0 then
           loop
--- 49,57 ----
     begin
        --  We use the standard logarithmic approach, Exp gets shifted right
        --  testing successive low order bits and Factor is the value of the
!       --  base raised to the next power of 2. If the low order bit or Exp is
!       --  set, multiply the result by this factor. For negative exponents,
!       --  invert result upon return.
  
        if Exp >= 0 then
           loop
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnllf.ads gcc-4.1.0/gcc/ada/s-exnllf.ads
*** gcc-4.0.2/gcc/ada/s-exnllf.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exnllf.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L F                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L F                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Long_Long_Float exponentiation (checks off)
  
  package System.Exn_LLF is
! pragma Pure (Exn_LLF);
  
     function Exn_Long_Long_Float
       (Left  : Long_Long_Float;
--- 34,40 ----
  --  Long_Long_Float exponentiation (checks off)
  
  package System.Exn_LLF is
!    pragma Pure;
  
     function Exn_Long_Long_Float
       (Left  : Long_Long_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnlli.adb gcc-4.1.0/gcc/ada/s-exnlli.adb
*** gcc-4.0.2/gcc/ada/s-exnlli.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exnlli.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-exnlli.ads gcc-4.1.0/gcc/ada/s-exnlli.ads
*** gcc-4.0.2/gcc/ada/s-exnlli.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-exnlli.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X N _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Long_Long_Integer exponentiation (checks off)
  
  package System.Exn_LLI is
! pragma Pure (Exn_LLI);
  
     function Exn_Long_Long_Integer
       (Left  : Long_Long_Integer;
--- 34,40 ----
  --  Long_Long_Integer exponentiation (checks off)
  
  package System.Exn_LLI is
!    pragma Pure;
  
     function Exn_Long_Long_Integer
       (Left  : Long_Long_Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expint.adb gcc-4.1.0/gcc/ada/s-expint.adb
*** gcc-4.0.2/gcc/ada/s-expint.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-expint.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . E X P I N T                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . E X P I N T                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expint.ads gcc-4.1.0/gcc/ada/s-expint.ads
*** gcc-4.0.2/gcc/ada/s-expint.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-expint.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . E X P I N T                         --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . E X P I N T                         --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Integer exponentiation (checks on)
  
  package System.Exp_Int is
! pragma Pure (Exp_Int);
  
     function Exp_Integer
       (Left  : Integer;
--- 34,40 ----
  --  Integer exponentiation (checks on)
  
  package System.Exp_Int is
!    pragma Pure;
  
     function Exp_Integer
       (Left  : Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-explli.adb gcc-4.1.0/gcc/ada/s-explli.adb
*** gcc-4.0.2/gcc/ada/s-explli.adb	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-explli.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . E X P L L I                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . E X P L L I                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-explli.ads gcc-4.1.0/gcc/ada/s-explli.ads
*** gcc-4.0.2/gcc/ada/s-explli.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-explli.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Long_Long_Integer exponentiation
  
  package System.Exp_LLI is
! pragma Pure (Exp_LLI);
  
     function Exp_Long_Long_Integer
       (Left  : Long_Long_Integer;
--- 34,40 ----
  --  Long_Long_Integer exponentiation
  
  package System.Exp_LLI is
!    pragma Pure;
  
     function Exp_Long_Long_Integer
       (Left  : Long_Long_Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expllu.adb gcc-4.1.0/gcc/ada/s-expllu.adb
*** gcc-4.0.2/gcc/ada/s-expllu.adb	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-expllu.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . X P _ B M L                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . X P _ B M L                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expllu.ads gcc-4.1.0/gcc/ada/s-expllu.ads
*** gcc-4.0.2/gcc/ada/s-expllu.ads	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-expllu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  with System.Unsigned_Types;
  
  package System.Exp_LLU is
! pragma Pure (Exp_LLU);
  
     function Exp_Long_Long_Unsigned
       (Left  : System.Unsigned_Types.Long_Long_Unsigned;
--- 39,45 ----
  with System.Unsigned_Types;
  
  package System.Exp_LLU is
!    pragma Pure;
  
     function Exp_Long_Long_Unsigned
       (Left  : System.Unsigned_Types.Long_Long_Unsigned;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expmod.adb gcc-4.1.0/gcc/ada/s-expmod.adb
*** gcc-4.0.2/gcc/ada/s-expmod.adb	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-expmod.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ M O D                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ M O D                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expmod.ads gcc-4.1.0/gcc/ada/s-expmod.ads
*** gcc-4.0.2/gcc/ada/s-expmod.ads	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-expmod.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ M O D                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ M O D                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  accounting for the modulus value which is passed as the second argument.
  
  package System.Exp_Mod is
! pragma Pure (Exp_Mod);
  
     function Exp_Modular
       (Left    : Integer;
--- 36,42 ----
  --  accounting for the modulus value which is passed as the second argument.
  
  package System.Exp_Mod is
!    pragma Pure;
  
     function Exp_Modular
       (Left    : Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expuns.adb gcc-4.1.0/gcc/ada/s-expuns.adb
*** gcc-4.0.2/gcc/ada/s-expuns.adb	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-expuns.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ U N S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ U N S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-expuns.ads gcc-4.1.0/gcc/ada/s-expuns.ads
*** gcc-4.0.2/gcc/ada/s-expuns.ads	Tue Oct 21 13:42:13 2003
--- gcc-4.1.0/gcc/ada/s-expuns.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . E X P _ U N S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . E X P _ U N S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  with System.Unsigned_Types;
  
  package System.Exp_Uns is
! pragma Pure (Exp_Uns);
  
     function Exp_Unsigned
       (Left  : System.Unsigned_Types.Unsigned;
--- 39,45 ----
  with System.Unsigned_Types;
  
  package System.Exp_Uns is
!    pragma Pure;
  
     function Exp_Unsigned
       (Left  : System.Unsigned_Types.Unsigned;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatflt.ads gcc-4.1.0/gcc/ada/s-fatflt.ads
*** gcc-4.0.2/gcc/ada/s-fatflt.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-fatflt.ads	Tue Nov 15 13:57:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Fat_Gen;
  
  package System.Fat_Flt is
! pragma Pure (Fat_Flt);
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Fat_Float is new System.Fat_Gen (Float);
  
  end System.Fat_Flt;
--- 37,49 ----
  with System.Fat_Gen;
  
  package System.Fat_Flt is
!    pragma Pure;
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Attr_Float is new System.Fat_Gen (Float);
  
  end System.Fat_Flt;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatgen.adb gcc-4.1.0/gcc/ada/s-fatgen.adb
*** gcc-4.0.2/gcc/ada/s-fatgen.adb	Wed Oct 27 13:55:10 2004
--- gcc-4.1.0/gcc/ada/s-fatgen.adb	Tue Nov 15 13:56:51 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Fat_Gen is
*** 99,108 ****
     begin
        if Towards = X then
           return X;
- 
        elsif Towards > X then
           return Succ (X);
- 
        else
           return Pred (X);
        end if;
--- 99,106 ----
*************** package body System.Fat_Gen is
*** 114,127 ****
  
     function Ceiling (X : T) return T is
        XT : constant T := Truncation (X);
- 
     begin
        if X <= 0.0 then
           return XT;
- 
        elsif X = XT then
           return X;
- 
        else
           return XT + 1.0;
        end if;
--- 112,122 ----
*************** package body System.Fat_Gen is
*** 175,181 ****
           --  T'Machine_Emin - T'Machine_Mantissa, which would preserve
           --  monotonicity of the exponent function ???
  
!       --  Check for infinities, transfinites, whatnot.
  
        elsif X > T'Safe_Last then
           Frac := Invrad;
--- 170,176 ----
           --  T'Machine_Emin - T'Machine_Mantissa, which would preserve
           --  monotonicity of the exponent function ???
  
!       --  Check for infinities, transfinites, whatnot
  
        elsif X > T'Safe_Last then
           Frac := Invrad;
*************** package body System.Fat_Gen is
*** 193,199 ****
              Ax : T  := abs X;
              Ex : UI := 0;
  
!          --  Ax * Rad ** Ex is invariant.
  
           begin
              if Ax >= 1.0 then
--- 188,194 ----
              Ax : T  := abs X;
              Ex : UI := 0;
  
!          --  Ax * Rad ** Ex is invariant
  
           begin
              if Ax >= 1.0 then
*************** package body System.Fat_Gen is
*** 256,262 ****
     function Exponent (X : T) return UI is
        X_Frac : T;
        X_Exp  : UI;
- 
     begin
        Decompose (X, X_Frac, X_Exp);
        return X_Exp;
--- 251,256 ----
*************** package body System.Fat_Gen is
*** 268,281 ****
  
     function Floor (X : T) return T is
        XT : constant T := Truncation (X);
- 
     begin
        if X >= 0.0 then
           return XT;
- 
        elsif XT = X then
           return X;
- 
        else
           return XT - 1.0;
        end if;
--- 262,272 ----
*************** package body System.Fat_Gen is
*** 288,294 ****
     function Fraction (X : T) return T is
        X_Frac : T;
        X_Exp  : UI;
- 
     begin
        Decompose (X, X_Frac, X_Exp);
        return X_Frac;
--- 279,284 ----
*************** package body System.Fat_Gen is
*** 366,371 ****
--- 356,393 ----
        return Temp;
     end Machine;
  
+    ----------------------
+    -- Machine_Rounding --
+    ----------------------
+ 
+    --  For now, the implementation is identical to that of Rounding, which is
+    --  a permissible behavior, but is not the most efficient possible approach.
+ 
+    function Machine_Rounding (X : T) return T is
+       Result : T;
+       Tail   : T;
+ 
+    begin
+       Result := Truncation (abs X);
+       Tail   := abs X - Result;
+ 
+       if Tail >= 0.5  then
+          Result := Result + 1.0;
+       end if;
+ 
+       if X > 0.0 then
+          return Result;
+ 
+       elsif X < 0.0 then
+          return -Result;
+ 
+       --  For zero case, make sure sign of zero is preserved
+ 
+       else
+          return X;
+       end if;
+    end Machine_Rounding;
+ 
     -----------
     -- Model --
     -----------
*************** package body System.Fat_Gen is
*** 542,548 ****
           return X;
        end if;
  
!       --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n).
  
        declare
           Y  : T  := X;
--- 564,570 ----
           return X;
        end if;
  
!       --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n)
  
        declare
           Y  : T  := X;
*************** package body System.Fat_Gen is
*** 587,592 ****
--- 609,615 ----
                 end if;
  
                 --  0 <= Ex < Log_Power (N)
+ 
              end loop;
  
              --  Ex = 0
*************** package body System.Fat_Gen is
*** 652,658 ****
  
     --  The basic approach is to compute
  
!    --    T'Machine (RM1 + N) - RM1.
  
     --  where N >= 0.0 and RM1 = radix ** (mantissa - 1)
  
--- 675,681 ----
  
     --  The basic approach is to compute
  
!    --    T'Machine (RM1 + N) - RM1
  
     --  where N >= 0.0 and RM1 = radix ** (mantissa - 1)
  
*************** package body System.Fat_Gen is
*** 693,699 ****
              return X;
           end if;
        end if;
- 
     end Truncation;
  
     -----------------------
--- 716,721 ----
*************** package body System.Fat_Gen is
*** 727,739 ****
        else
           return X;
        end if;
- 
     end Unbiased_Rounding;
  
     -----------
     -- Valid --
     -----------
  
     function Valid (X : access T) return Boolean is
  
        IEEE_Emin : constant Integer := T'Machine_Emin - 1;
--- 749,764 ----
        else
           return X;
        end if;
     end Unbiased_Rounding;
  
     -----------
     -- Valid --
     -----------
  
+    --  Note: this routine does not work for VAX float. We compensate for this
+    --  in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
+    --  than the corresponding instantiation of this function.
+ 
     function Valid (X : access T) return Boolean is
  
        IEEE_Emin : constant Integer := T'Machine_Emin - 1;
*************** package body System.Fat_Gen is
*** 744,760 ****
        subtype IEEE_Exponent_Range is
          Integer range IEEE_Emin - 1 .. IEEE_Emax + 1;
  
!       --  The implementation of this floating point attribute uses
!       --  a representation type Float_Rep that allows direct access to
!       --  the exponent and mantissa parts of a floating point number.
  
        --  The Float_Rep type is an array of Float_Word elements. This
!       --  representation is chosen to make it possible to size the
!       --  type based on a generic parameter. Since the array size is
!       --  known at compile-time, efficient code can still be generated.
!       --  The size of Float_Word elements should be large enough to allow
!       --  accessing the exponent in one read, but small enough so that all
!       --  floating point object sizes are a multiple of the Float_Word'Size.
  
        --  The following conditions must be met for all possible
        --  instantiations of the attributes package:
--- 769,785 ----
        subtype IEEE_Exponent_Range is
          Integer range IEEE_Emin - 1 .. IEEE_Emax + 1;
  
!       --  The implementation of this floating point attribute uses a
!       --  representation type Float_Rep that allows direct access to the
!       --  exponent and mantissa parts of a floating point number.
  
        --  The Float_Rep type is an array of Float_Word elements. This
!       --  representation is chosen to make it possible to size the type based
!       --  on a generic parameter. Since the array size is known at compile
!       --  time, efficient code can still be generated. The size of Float_Word
!       --  elements should be large enough to allow accessing the exponent in
!       --  one read, but small enough so that all floating point object sizes
!       --  are a multiple of the Float_Word'Size.
  
        --  The following conditions must be met for all possible
        --  instantiations of the attributes package:
*************** package body System.Fat_Gen is
*** 764,779 ****
        --    - The exponent and sign are completely contained in a single
        --      component of Float_Rep, named Most_Significant_Word (MSW).
  
!       --    - The sign occupies the most significant bit of the MSW
!       --      and the exponent is in the following bits.
!       --      Unused bits (if any) are in the least significant part.
  
        type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
        type Rep_Index is range 0 .. 7;
  
!       Rep_Last : constant Rep_Index := (T'Size - 1) / Float_Word'Size;
  
!       type Float_Rep is array (Rep_Index range 0 .. Rep_Last) of Float_Word;
  
        pragma Suppress_Initialization (Float_Rep);
        --  This pragma supresses the generation of an initialization procedure
--- 789,814 ----
        --    - The exponent and sign are completely contained in a single
        --      component of Float_Rep, named Most_Significant_Word (MSW).
  
!       --    - The sign occupies the most significant bit of the MSW and the
!       --      exponent is in the following bits. Unused bits (if any) are in
!       --      the least significant part.
  
        type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
        type Rep_Index is range 0 .. 7;
  
!       Rep_Words : constant Positive :=
!          (T'Size + Float_Word'Size - 1) / Float_Word'Size;
!       Rep_Last  : constant Rep_Index := Rep_Index'Min
!         (Rep_Index (Rep_Words - 1), (T'Mantissa + 16) / Float_Word'Size);
!       --  Determine the number of Float_Words needed for representing the
!       --  entire floating-point value. Do not take into account excessive
!       --  padding, as occurs on IA-64 where 80 bits floats get padded to 128
!       --  bits. In general, the exponent field cannot be larger than 15 bits,
!       --  even for 128-bit floating-poin t types, so the final format size
!       --  won't be larger than T'Mantissa + 16.
  
!       type Float_Rep is
!          array (Rep_Index range 0 .. Rep_Index (Rep_Words - 1)) of Float_Word;
  
        pragma Suppress_Initialization (Float_Rep);
        --  This pragma supresses the generation of an initialization procedure
*************** package body System.Fat_Gen is
*** 784,809 ****
  
        Most_Significant_Word : constant Rep_Index :=
                                  Rep_Last * Standard'Default_Bit_Order;
!       --  Finding the location of the Exponent_Word is a bit tricky.
!       --  In general we assume Word_Order = Bit_Order.
!       --  This expression needs to be refined for VMS.
  
        Exponent_Factor : constant Float_Word :=
                            2**(Float_Word'Size - 1) /
                              Float_Word (IEEE_Emax - IEEE_Emin + 3) *
!                               Boolean'Pos (T'Size /= 96) +
!                                 Boolean'Pos (T'Size = 96);
!       --  Factor that the extracted exponent needs to be divided by
!       --  to be in range 0 .. IEEE_Emax - IEEE_Emin + 2.
!       --  Special kludge: Exponent_Factor is 0 for x86 double extended
!       --  as GCC adds 16 unused bits to the type.
  
        Exponent_Mask : constant Float_Word :=
                          Float_Word (IEEE_Emax - IEEE_Emin + 2) *
                            Exponent_Factor;
!       --  Value needed to mask out the exponent field.
!       --  This assumes that the range IEEE_Emin - 1 .. IEEE_Emax + 1
!       --  contains 2**N values, for some N in Natural.
  
        function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
  
--- 819,844 ----
  
        Most_Significant_Word : constant Rep_Index :=
                                  Rep_Last * Standard'Default_Bit_Order;
!       --  Finding the location of the Exponent_Word is a bit tricky. In general
!       --  we assume Word_Order = Bit_Order. This expression needs to be refined
!       --  for VMS.
  
        Exponent_Factor : constant Float_Word :=
                            2**(Float_Word'Size - 1) /
                              Float_Word (IEEE_Emax - IEEE_Emin + 3) *
!                               Boolean'Pos (Most_Significant_Word /= 2) +
!                                 Boolean'Pos (Most_Significant_Word = 2);
!       --  Factor that the extracted exponent needs to be divided by to be in
!       --  range 0 .. IEEE_Emax - IEEE_Emin + 2. Special kludge: Exponent_Factor
!       --  is 1 for x86/IA64 double extended as GCC adds unused bits to the
!       --  type.
  
        Exponent_Mask : constant Float_Word :=
                          Float_Word (IEEE_Emax - IEEE_Emin + 2) *
                            Exponent_Factor;
!       --  Value needed to mask out the exponent field. This assumes that the
!       --  range IEEE_Emin - 1 .. IEEE_Emax + contains 2**N values, for some N
!       --  in Natural.
  
        function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
  
*************** package body System.Fat_Gen is
*** 824,831 ****
               Integer ((R (Most_Significant_Word) and Exponent_Mask) /
                                                          Exponent_Factor)
                 - IEEE_Bias;
!       --  Mask/Shift T to only get bits from the exponent
!       --  Then convert biased value to integer value.
  
        SR : Float_Rep;
        --  Float_Rep representation of significant of X.all
--- 859,866 ----
               Integer ((R (Most_Significant_Word) and Exponent_Mask) /
                                                          Exponent_Factor)
                 - IEEE_Bias;
!       --  Mask/Shift T to only get bits from the exponent. Then convert biased
!       --  value to integer value.
  
        SR : Float_Rep;
        --  Float_Rep representation of significant of X.all
*************** package body System.Fat_Gen is
*** 833,840 ****
     begin
        if T'Denorm then
  
!          --  All denormalized numbers are valid, so only invalid numbers
!          --  are overflows and NaN's, both with exponent = Emax + 1.
  
           return E /= IEEE_Emax + 1;
  
--- 868,875 ----
     begin
        if T'Denorm then
  
!          --  All denormalized numbers are valid, so only invalid numbers are
!          --  overflows and NaN's, both with exponent = Emax + 1.
  
           return E /= IEEE_Emax + 1;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatgen.ads gcc-4.1.0/gcc/ada/s-fatgen.ads
*** gcc-4.0.2/gcc/ada/s-fatgen.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-fatgen.ads	Tue Nov 15 13:56:51 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** generic
*** 41,47 ****
      type T is digits <>;
  
  package System.Fat_Gen is
! pragma Pure (Fat_Gen);
  
     subtype UI is Integer;
     --  The runtime representation of universal integer for the purposes of
--- 41,47 ----
      type T is digits <>;
  
  package System.Fat_Gen is
!    pragma Pure;
  
     subtype UI is Integer;
     --  The runtime representation of universal integer for the purposes of
*************** pragma Pure (Fat_Gen);
*** 71,76 ****
--- 71,78 ----
  
     function Machine           (X : T)                       return T;
  
+    function Machine_Rounding  (X : T)                       return T;
+ 
     function Model             (X : T)                       return T;
  
     function Pred              (X : T)                       return T;
*************** pragma Pure (Fat_Gen);
*** 95,100 ****
--- 97,104 ----
     --  register, and the whole point of 'Valid is to prevent exceptions.
     --  Note that the object of type T must have the natural alignment
     --  for type T. See Unaligned_Valid for further discussion.
+    --
+    --  Note: this routine does not work for Vax_Float ???
  
     function Unaligned_Valid (A : System.Address) return Boolean;
     --  This version of Valid is used if the floating-point value to
*************** pragma Pure (Fat_Gen);
*** 112,122 ****
     --  not require strict alignment (e.g. the ia32/x86), since on a
     --  target not requiring strict alignment, it is fine to pass a
     --  non-aligned value to the standard Valid routine.
  
  private
     pragma Inline (Machine);
     pragma Inline (Model);
!    pragma Inline_Always (Valid);
!    pragma Inline_Always (Unaligned_Valid);
  
  end System.Fat_Gen;
--- 116,131 ----
     --  not require strict alignment (e.g. the ia32/x86), since on a
     --  target not requiring strict alignment, it is fine to pass a
     --  non-aligned value to the standard Valid routine.
+    --
+    --  Note: this routine does not work for Vax_Float ???
  
  private
     pragma Inline (Machine);
     pragma Inline (Model);
! 
!    --  Note: previously the validity checking subprograms (Unaligned_Valid and
!    --  Valid) were also inlined, but this was changed since there were some
!    --  problems with this inlining in optimized mode, and in any case it seems
!    --  better to avoid this inlining (space and robustness considerations).
  
  end System.Fat_Gen;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatlfl.ads gcc-4.1.0/gcc/ada/s-fatlfl.ads
*** gcc-4.0.2/gcc/ada/s-fatlfl.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-fatlfl.ads	Tue Nov 15 13:57:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Fat_Gen;
  
  package System.Fat_LFlt is
! pragma Pure (Fat_LFlt);
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Fat_Long_Float is new System.Fat_Gen (Long_Float);
  
  end System.Fat_LFlt;
--- 37,49 ----
  with System.Fat_Gen;
  
  package System.Fat_LFlt is
!    pragma Pure;
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Attr_Long_Float is new System.Fat_Gen (Long_Float);
  
  end System.Fat_LFlt;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatllf.ads gcc-4.1.0/gcc/ada/s-fatllf.ads
*** gcc-4.0.2/gcc/ada/s-fatllf.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-fatllf.ads	Tue Nov 15 13:57:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Fat_Gen;
  
  package System.Fat_LLF is
! pragma Pure (Fat_LLF);
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Fat_Long_Long_Float is new System.Fat_Gen (Long_Long_Float);
  
  end System.Fat_LLF;
--- 37,49 ----
  with System.Fat_Gen;
  
  package System.Fat_LLF is
!    pragma Pure;
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Attr_Long_Long_Float is new System.Fat_Gen (Long_Long_Float);
  
  end System.Fat_LLF;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fatsfl.ads gcc-4.1.0/gcc/ada/s-fatsfl.ads
*** gcc-4.0.2/gcc/ada/s-fatsfl.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-fatsfl.ads	Tue Nov 15 13:57:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Fat_Gen;
  
  package System.Fat_SFlt is
! pragma Pure (Fat_SFlt);
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Fat_Short_Float is new System.Fat_Gen (Short_Float);
  
  end System.Fat_SFlt;
--- 37,49 ----
  with System.Fat_Gen;
  
  package System.Fat_SFlt is
!    pragma Pure;
  
     --  Note the only entity from this package that is acccessed by Rtsfind
     --  is the name of the package instantiation. Entities within this package
     --  (i.e. the individual floating-point attribute routines) are accessed
     --  by name using selected notation.
  
!    package Attr_Short_Float is new System.Fat_Gen (Short_Float);
  
  end System.Fat_SFlt;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-ficobl.ads gcc-4.1.0/gcc/ada/s-ficobl.ads
*** gcc-4.0.2/gcc/ada/s-ficobl.ads	Tue Jul  6 13:57:31 2004
--- gcc-4.1.0/gcc/ada/s-ficobl.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fileio.adb gcc-4.1.0/gcc/ada/s-fileio.adb
*** gcc-4.0.2/gcc/ada/s-fileio.adb	Mon Jan  3 15:41:53 2005
--- gcc-4.1.0/gcc/ada/s-fileio.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fileio.ads gcc-4.1.0/gcc/ada/s-fileio.ads
*** gcc-4.0.2/gcc/ada/s-fileio.ads	Thu Apr  8 13:23:50 2004
--- gcc-4.1.0/gcc/ada/s-fileio.ads	Tue Nov 15 14:05:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.File_IO is
*** 139,145 ****
  
     procedure Chain_File (File : FCB.AFCB_Ptr);
     --  Used to chain the given file into the list of open files. Normally this
!    --  is done implicitly by Open. Chain_File is used for the spcial cases of
     --  the system files defined by Text_IO (stdin, stdout, stderr) which are
     --  not opened in the normal manner. Note that the caller is responsible
     --  for task lock out to protect the global data structures if this is
--- 139,145 ----
  
     procedure Chain_File (File : FCB.AFCB_Ptr);
     --  Used to chain the given file into the list of open files. Normally this
!    --  is done implicitly by Open. Chain_File is used for the special cases of
     --  the system files defined by Text_IO (stdin, stdout, stderr) which are
     --  not opened in the normal manner. Note that the caller is responsible
     --  for task lock out to protect the global data structures if this is
diff -Nrcpad gcc-4.0.2/gcc/ada/s-filofl.ads gcc-4.1.0/gcc/ada/s-filofl.ads
*** gcc-4.0.2/gcc/ada/s-filofl.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-filofl.ads	Tue Nov 15 13:57:25 2005
***************
*** 0 ****
--- 1,54 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --            S Y S T E M . F A T _ I E E E _ L O N G _ F L O A T           --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package contains an instantiation of the floating-point attribute
+ --  runtime routines for IEEE long float. This is used on VMS targest where
+ --  we can't just use Long_Float, since this may have been mapped to Vax_Float
+ --  using a Float_Representation configuration pragma.
+ 
+ with System.Fat_Gen;
+ 
+ package System.Fat_IEEE_Long_Float is
+    pragma Pure;
+ 
+    type Fat_IEEE_Long is digits 15;
+    pragma Float_Representation (IEEE_Float, Fat_IEEE_Long);
+ 
+    --  Note the only entity from this package that is acccessed by Rtsfind
+    --  is the name of the package instantiation. Entities within this package
+    --  (i.e. the individual floating-point attribute routines) are accessed
+    --  by name using selected notation.
+ 
+    package Attr_IEEE_Long is new System.Fat_Gen (Fat_IEEE_Long);
+ 
+ end System.Fat_IEEE_Long_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-finimp.adb gcc-4.1.0/gcc/ada/s-finimp.adb
*** gcc-4.0.2/gcc/ada/s-finimp.adb	Thu Feb 10 13:56:20 2005
--- gcc-4.1.0/gcc/ada/s-finimp.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Finalization_Impleme
*** 85,93 ****
       return SSE.Storage_Count;
     pragma Import (Ada, Parent_Size, "ada__tags__parent_size");
  
-    function Parent_Tag (T : Ada.Tags.Tag) return Ada.Tags.Tag;
-    pragma Import (Ada, Parent_Tag, "ada__tags__parent_tag");
- 
     function Get_Deep_Controller (Obj : System.Address) return RC_Ptr;
     --  Given the address (obj) of a tagged object, return a
     --  pointer to the record controller of this object.
--- 85,90 ----
*************** package body System.Finalization_Impleme
*** 383,401 ****
     procedure Finalize_Global_List is
     begin
        --  There are three case here:
        --  a. the application uses tasks, in which case Finalize_Global_Tasks
!       --     will defer abortion
        --  b. the application doesn't use tasks but uses other tasking
        --     constructs, such as ATCs and protected objects. In this case,
        --     the binder will call Finalize_Global_List instead of
        --     Finalize_Global_Tasks, letting abort undeferred, and leading
        --     to assertion failures in the GNULL
        --  c. the application doesn't use any tasking construct in which case
        --     deferring abort isn't necessary.
!       --
        --  Until another solution is found to deal with case b, we need to
        --  call abort_defer here to pass the checks, but we do not need to
!       --  undefer abortion, since Finalize_Global_List is the last procedure
        --  called before exiting the partition.
  
        SSL.Abort_Defer.all;
--- 380,401 ----
     procedure Finalize_Global_List is
     begin
        --  There are three case here:
+ 
        --  a. the application uses tasks, in which case Finalize_Global_Tasks
!       --     will defer abort.
! 
        --  b. the application doesn't use tasks but uses other tasking
        --     constructs, such as ATCs and protected objects. In this case,
        --     the binder will call Finalize_Global_List instead of
        --     Finalize_Global_Tasks, letting abort undeferred, and leading
        --     to assertion failures in the GNULL
+ 
        --  c. the application doesn't use any tasking construct in which case
        --     deferring abort isn't necessary.
! 
        --  Until another solution is found to deal with case b, we need to
        --  call abort_defer here to pass the checks, but we do not need to
!       --  undefer abort, since Finalize_Global_List is the last procedure
        --  called before exiting the partition.
  
        SSL.Abort_Defer.all;
*************** package body System.Finalization_Impleme
*** 470,476 ****
        --  when there are no controller at this level
  
        while Offset = -2 loop
!          The_Tag := Parent_Tag (The_Tag);
           Offset  := RC_Offset (The_Tag);
        end loop;
  
--- 470,476 ----
        --  when there are no controller at this level
  
        while Offset = -2 loop
!          The_Tag := Ada.Tags.Parent_Tag (The_Tag);
           Offset  := RC_Offset (The_Tag);
        end loop;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-finimp.ads gcc-4.1.0/gcc/ada/s-finimp.ads
*** gcc-4.0.2/gcc/ada/s-finimp.ads	Thu Jul 15 20:34:41 2004
--- gcc-4.1.0/gcc/ada/s-finimp.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  with System.Finalization_Root;
  
  package System.Finalization_Implementation is
! pragma Elaborate_Body (Finalization_Implementation);
  
     package SFR renames System.Finalization_Root;
  
--- 34,40 ----
  with System.Finalization_Root;
  
  package System.Finalization_Implementation is
!    pragma Elaborate_Body;
  
     package SFR renames System.Finalization_Root;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-finroo.adb gcc-4.1.0/gcc/ada/s-finroo.adb
*** gcc-4.0.2/gcc/ada/s-finroo.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-finroo.adb	Tue Nov 15 14:04:34 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Finalization_Root is
*** 73,80 ****
     --  Suppress warning for out paramater Item which is not assigned
     --  because it is pretty much empty.
  
!    procedure Read (Stream : access Ada.Streams.Root_Stream_Type'Class;
!                    Item : out Root_Controlled)
     is
     begin
        null;
--- 73,81 ----
     --  Suppress warning for out paramater Item which is not assigned
     --  because it is pretty much empty.
  
!    procedure Read
!      (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
!       Item   : out Root_Controlled)
     is
     begin
        null;
*************** package body System.Finalization_Root is
*** 87,94 ****
     --  Read and Write must be empty in order to avoid copying the
     --  finalization pointers.
  
!    procedure Write (Stream : access Ada.Streams.Root_Stream_Type'Class;
!                     Item : in Root_Controlled)
     is
     begin
        null;
--- 88,96 ----
     --  Read and Write must be empty in order to avoid copying the
     --  finalization pointers.
  
!    procedure Write
!      (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
!       Item   : in Root_Controlled)
     is
     begin
        null;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-finroo.ads gcc-4.1.0/gcc/ada/s-finroo.ads
*** gcc-4.0.2/gcc/ada/s-finroo.ads	Fri Mar  5 10:58:58 2004
--- gcc-4.1.0/gcc/ada/s-finroo.ads	Tue Nov 15 14:04:34 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Streams;
*** 37,43 ****
  with Unchecked_Conversion;
  
  package System.Finalization_Root is
! pragma Preelaborate (Finalization_Root);
  
     type Root_Controlled;
  
--- 37,43 ----
  with Unchecked_Conversion;
  
  package System.Finalization_Root is
!    pragma Preelaborate;
  
     type Root_Controlled;
  
*************** pragma Preelaborate (Finalization_Root);
*** 61,70 ****
     procedure Finalize   (Object : in out Root_Controlled);
     procedure Adjust     (Object : in out Root_Controlled);
  
!    procedure Write     (Stream : access Ada.Streams.Root_Stream_Type'Class;
!                         Item : in Root_Controlled);
!    procedure Read      (Stream : access Ada.Streams.Root_Stream_Type'Class;
!                         Item : out Root_Controlled);
  
     for Root_Controlled'Read use Read;
     for Root_Controlled'Write use Write;
--- 61,73 ----
     procedure Finalize   (Object : in out Root_Controlled);
     procedure Adjust     (Object : in out Root_Controlled);
  
!    procedure Write
!      (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
!       Item   : in Root_Controlled);
! 
!    procedure Read
!      (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
!       Item   : out Root_Controlled);
  
     for Root_Controlled'Read use Read;
     for Root_Controlled'Write use Write;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fishfl.ads gcc-4.1.0/gcc/ada/s-fishfl.ads
*** gcc-4.0.2/gcc/ada/s-fishfl.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-fishfl.ads	Tue Nov 15 13:57:25 2005
***************
*** 0 ****
--- 1,54 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --           S Y S T E M . F A T _ I E E E _ S H O R T _ F L O A T          --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package contains an instantiation of the floating-point attribute
+ --  runtime routines for IEEE short float. This is used on VMS targest where
+ --  we can't just use Float, since this may have been mapped to Vax_Float
+ --  using a Float_Representation configuration pragma.
+ 
+ with System.Fat_Gen;
+ 
+ package System.Fat_IEEE_Short_Float is
+    pragma Pure;
+ 
+    type Fat_IEEE_Short is digits 6;
+    pragma Float_Representation (IEEE_Float, Fat_IEEE_Short);
+ 
+    --  Note the only entity from this package that is acccessed by Rtsfind
+    --  is the name of the package instantiation. Entities within this package
+    --  (i.e. the individual floating-point attribute routines) are accessed
+    --  by name using selected notation.
+ 
+    package Attr_IEEE_Short is new System.Fat_Gen (Fat_IEEE_Short);
+ 
+ end System.Fat_IEEE_Short_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fore.adb gcc-4.1.0/gcc/ada/s-fore.adb
*** gcc-4.0.2/gcc/ada/s-fore.adb	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-fore.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          S Y S T E M . F O R E                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          S Y S T E M . F O R E                           --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fore.ads gcc-4.1.0/gcc/ada/s-fore.ads
*** gcc-4.0.2/gcc/ada/s-fore.ads	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-fore.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                          S Y S T E M . F O R E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                          S Y S T E M . F O R E                           --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains the routine used for the 'Fore attribute
  
  package System.Fore is
! pragma Pure (Fore);
  
     function Fore (Lo, Hi : Long_Long_Float) return Natural;
     --  Compute Fore attribute value for a fixed-point type. The parameters
--- 34,40 ----
  --  This package contains the routine used for the 'Fore attribute
  
  package System.Fore is
!    pragma Pure;
  
     function Fore (Lo, Hi : Long_Long_Float) return Natural;
     --  Compute Fore attribute value for a fixed-point type. The parameters
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fvadfl.ads gcc-4.1.0/gcc/ada/s-fvadfl.ads
*** gcc-4.0.2/gcc/ada/s-fvadfl.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-fvadfl.ads	Tue Nov 15 13:57:25 2005
***************
*** 0 ****
--- 1,56 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               S Y S T E M . F A T _ V A X _ D _ F L O A T                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package contains an instantiation of the floating-point attribute
+ --  runtime routines for VAX D-float for use on VMS targets.
+ 
+ with System.Fat_Gen;
+ 
+ package System.Fat_VAX_D_Float is
+    pragma Pure;
+ 
+    pragma Warnings (Off);
+    --  This unit is normally used only for VMS, but we compile it for other
+    --  targest for the convenience of testing vms code using -gnatdm.
+ 
+    type Fat_VAX_D is digits 9;
+    pragma Float_Representation (VAX_Float, Fat_VAX_D);
+ 
+    --  Note the only entity from this package that is acccessed by Rtsfind
+    --  is the name of the package instantiation. Entities within this package
+    --  (i.e. the individual floating-point attribute routines) are accessed
+    --  by name using selected notation.
+ 
+    package Attr_VAX_D_Float is new System.Fat_Gen (Fat_VAX_D);
+ 
+ end System.Fat_VAX_D_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fvaffl.ads gcc-4.1.0/gcc/ada/s-fvaffl.ads
*** gcc-4.0.2/gcc/ada/s-fvaffl.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-fvaffl.ads	Tue Nov 15 13:57:25 2005
***************
*** 0 ****
--- 1,56 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               S Y S T E M . F A T _ V A X _ F _ F L O A T                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package contains an instantiation of the floating-point attribute
+ --  runtime routines for VAX F-float for use on VMS targets.
+ 
+ with System.Fat_Gen;
+ 
+ package System.Fat_VAX_F_Float is
+    pragma Pure;
+ 
+    pragma Warnings (Off);
+    --  This unit is normally used only for VMS, but we compile it for other
+    --  targest for the convenience of testing vms code using -gnatdm.
+ 
+    type Fat_VAX_F is digits 6;
+    pragma Float_Representation (VAX_Float, Fat_VAX_F);
+ 
+    --  Note the only entity from this package that is acccessed by Rtsfind
+    --  is the name of the package instantiation. Entities within this package
+    --  (i.e. the individual floating-point attribute routines) are accessed
+    --  by name using selected notation.
+ 
+    package Attr_VAX_F_Float is new System.Fat_Gen (Fat_VAX_F);
+ 
+ end System.Fat_VAX_F_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-fvagfl.ads gcc-4.1.0/gcc/ada/s-fvagfl.ads
*** gcc-4.0.2/gcc/ada/s-fvagfl.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-fvagfl.ads	Tue Nov 15 13:57:25 2005
***************
*** 0 ****
--- 1,56 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --               S Y S T E M . F A T _ V A X _ G _ F L O A T                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This package contains an instantiation of the floating-point attribute
+ --  runtime routines for VAX F-float for use on VMS targets.
+ 
+ with System.Fat_Gen;
+ 
+ package System.Fat_VAX_G_Float is
+    pragma Pure;
+ 
+    pragma Warnings (Off);
+    --  This unit is normally used only for VMS, but we compile it for other
+    --  targest for the convenience of testing vms code using -gnatdm.
+ 
+    type Fat_VAX_G is digits 15;
+    pragma Float_Representation (VAX_Float, Fat_VAX_G);
+ 
+    --  Note the only entity from this package that is acccessed by Rtsfind
+    --  is the name of the package instantiation. Entities within this package
+    --  (i.e. the individual floating-point attribute routines) are accessed
+    --  by name using selected notation.
+ 
+    package Attr_VAX_G_Float is new System.Fat_Gen (Fat_VAX_G);
+ 
+ end System.Fat_VAX_G_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-geveop.adb gcc-4.1.0/gcc/ada/s-geveop.adb
*** gcc-4.0.2/gcc/ada/s-geveop.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-geveop.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --      S Y S T E M . G E N E R I C _ V E C T O R _ O P E R A T I O N S     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --      S Y S T E M . G E N E R I C _ V E C T O R _ O P E R A T I O N S     --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-geveop.ads gcc-4.1.0/gcc/ada/s-geveop.ads
*** gcc-4.0.2/gcc/ada/s-geveop.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-geveop.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --      S Y S T E M . G E N E R I C _ V E C T O R _ O P E R A T I O N S     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --      S Y S T E M . G E N E R I C _ V E C T O R _ O P E R A T I O N S     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,54 ****
  
  with System.Vectors;
  with System.Storage_Elements;
  generic
     type Element is (<>);
     type Index is (<>);
     type Element_Array is array (Index range <>) of Element;
  package System.Generic_Vector_Operations is
! pragma Pure (Generic_Vector_Operations);
  
     generic
        with function Element_Op (X, Y : Element) return Element;
--- 43,56 ----
  
  with System.Vectors;
  with System.Storage_Elements;
+ 
  generic
     type Element is (<>);
     type Index is (<>);
     type Element_Array is array (Index range <>) of Element;
+ 
  package System.Generic_Vector_Operations is
!    pragma Pure;
  
     generic
        with function Element_Op (X, Y : Element) return Element;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-gloloc-mingw.adb gcc-4.1.0/gcc/ada/s-gloloc-mingw.adb
*** gcc-4.0.2/gcc/ada/s-gloloc-mingw.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-gloloc-mingw.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2001 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This implementation is specific to NT.
  
  with GNAT.Task_Lock;
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This implementation is specific to NT
  
  with GNAT.Task_Lock;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-gloloc.adb gcc-4.1.0/gcc/ada/s-gloloc.adb
*** gcc-4.0.2/gcc/ada/s-gloloc.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-gloloc.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-gloloc.ads gcc-4.1.0/gcc/ada/s-gloloc.ads
*** gcc-4.0.2/gcc/ada/s-gloloc.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-gloloc.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-hibaen.ads gcc-4.1.0/gcc/ada/s-hibaen.ads
*** gcc-4.0.2/gcc/ada/s-hibaen.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-hibaen.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-htable.adb gcc-4.1.0/gcc/ada/s-htable.adb
*** gcc-4.0.2/gcc/ada/s-htable.adb	Tue Jul  6 13:57:31 2004
--- gcc-4.1.0/gcc/ada/s-htable.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . H T A B L E                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1995-2004 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . H T A B L E                         --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-htable.ads gcc-4.1.0/gcc/ada/s-htable.ads
*** gcc-4.0.2/gcc/ada/s-htable.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-htable.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . H T A B L E                         --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1995-2003 Ada Core Technologies, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . H T A B L E                         --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 1995-2005 AdaCore                      --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,46 ****
  --  complete control over allocation.
  
  package System.HTable is
! pragma Preelaborate (HTable);
  
     -------------------
     -- Simple_HTable --
--- 40,46 ----
  --  complete control over allocation.
  
  package System.HTable is
!    pragma Preelaborate;
  
     -------------------
     -- Simple_HTable --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgbiu.adb gcc-4.1.0/gcc/ada/s-imgbiu.adb
*** gcc-4.0.2/gcc/ada/s-imgbiu.adb	Thu Apr 24 17:54:09 2003
--- gcc-4.1.0/gcc/ada/s-imgbiu.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ B I U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ B I U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgbiu.ads gcc-4.1.0/gcc/ada/s-imgbiu.ads
*** gcc-4.0.2/gcc/ada/s-imgbiu.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgbiu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ B I U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ B I U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_BIU is
! pragma Pure (Img_BIU);
  
     procedure Set_Image_Based_Integer
       (V : Integer;
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_BIU is
!    pragma Pure;
  
     procedure Set_Image_Based_Integer
       (V : Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgboo.adb gcc-4.1.0/gcc/ada/s-imgboo.adb
*** gcc-4.0.2/gcc/ada/s-imgboo.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgboo.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ B O O L                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ B O O L                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgboo.ads gcc-4.1.0/gcc/ada/s-imgboo.ads
*** gcc-4.0.2/gcc/ada/s-imgboo.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgboo.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ B O O L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ B O O L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Boolean'Image
  
  package System.Img_Bool is
! pragma Pure (Img_Bool);
  
     function Image_Boolean (V : Boolean) return String;
     --  Computes Boolean'Image (V) and returns the result.
--- 34,40 ----
  --  Boolean'Image
  
  package System.Img_Bool is
!    pragma Pure;
  
     function Image_Boolean (V : Boolean) return String;
     --  Computes Boolean'Image (V) and returns the result.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgcha.adb gcc-4.1.0/gcc/ada/s-imgcha.adb
*** gcc-4.0.2/gcc/ada/s-imgcha.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgcha.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgcha.ads gcc-4.1.0/gcc/ada/s-imgcha.ads
*** gcc-4.0.2/gcc/ada/s-imgcha.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgcha.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,43 ****
  --  Character'Image
  
  package System.Img_Char is
! pragma Pure (Img_Char);
  
     function Image_Character (V : Character) return String;
     --  Computes Character'Image (V) and returns the result
  
- 
  end System.Img_Char;
--- 34,42 ----
  --  Character'Image
  
  package System.Img_Char is
!    pragma Pure;
  
     function Image_Character (V : Character) return String;
     --  Computes Character'Image (V) and returns the result
  
  end System.Img_Char;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgdec.adb gcc-4.1.0/gcc/ada/s-imgdec.adb
*** gcc-4.0.2/gcc/ada/s-imgdec.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-imgdec.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S Y S T E M . I M G _ D E C                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S Y S T E M . I M G _ D E C                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgdec.ads gcc-4.1.0/gcc/ada/s-imgdec.ads
*** gcc-4.0.2/gcc/ada/s-imgdec.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgdec.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ D E C                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ D E C                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  type does not exceed Integer'Size (also used for Text_IO.Decimal_IO output)
  
  package System.Img_Dec is
! pragma Preelaborate (Img_Dec);
  
     function Image_Decimal
       (V     : Integer;
--- 35,41 ----
  --  type does not exceed Integer'Size (also used for Text_IO.Decimal_IO output)
  
  package System.Img_Dec is
!    pragma Preelaborate;
  
     function Image_Decimal
       (V     : Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgenu.adb gcc-4.1.0/gcc/ada/s-imgenu.adb
*** gcc-4.0.2/gcc/ada/s-imgenu.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-imgenu.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgenu.ads gcc-4.1.0/gcc/ada/s-imgenu.ads
*** gcc-4.0.2/gcc/ada/s-imgenu.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgenu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ E N U M                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 2000 Free Software Foundation, Inc.             --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ E N U M                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  Special routines exist for the enumeration routines in these packages.
  
  package System.Img_Enum is
! pragma Pure (Img_Enum);
  
     function Image_Enumeration_8
       (Pos     : Natural;
--- 37,43 ----
  --  Special routines exist for the enumeration routines in these packages.
  
  package System.Img_Enum is
!    pragma Pure;
  
     function Image_Enumeration_8
       (Pos     : Natural;
*************** pragma Pure (Img_Enum);
*** 45,60 ****
        Indexes : System.Address)
        return    String;
     --  Used to compute Enum'Image (Str) where Enum is some enumeration type
!    --  other than those defined in package Standard. Names is a string with
!    --  a lower bound of 1 containing the characters of all the enumeration
!    --  literals concatenated together in sequence. Indexes is the address
!    --  of an array of type array (0 .. N) of Natural_8, where N is the
!    --  is the number of enumeration literals in the type. The Indexes values
!    --  are the starting subscript of each enumeration literal, indexed by Pos
!    --  values, with an extra entry at the end containing Names'Length + 1.
!    --  The reason that Indexes is passed by address is that the actual type
!    --  is created on the fly by the expander. The value returned is the
!    --  desired 'Image value.
  
     function Image_Enumeration_16
       (Pos     : Natural;
--- 45,59 ----
        Indexes : System.Address)
        return    String;
     --  Used to compute Enum'Image (Str) where Enum is some enumeration type
!    --  other than those defined in package Standard. Names is a string with a
!    --  lower bound of 1 containing the characters of all the enumeration
!    --  literals concatenated together in sequence. Indexes is the address of an
!    --  array of type array (0 .. N) of Natural_8, where N is the number of
!    --  enumeration literals in the type. The Indexes values are the starting
!    --  subscript of each enumeration literal, indexed by Pos values, with an
!    --  extra entry at the end containing Names'Length + 1. The reason that
!    --  Indexes is passed by address is that the actual type is created on the
!    --  fly by the expander. The value returned is the desired 'Image value.
  
     function Image_Enumeration_16
       (Pos     : Natural;
*************** pragma Pure (Img_Enum);
*** 72,76 ****
     --  Identical to Image_Enumeration_8 except that it handles types
     --  using array (0 .. Num) of Natural_32 for the Indexes table.
  
- 
  end System.Img_Enum;
--- 71,74 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgint.adb gcc-4.1.0/gcc/ada/s-imgint.adb
*** gcc-4.0.2/gcc/ada/s-imgint.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgint.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ I N T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ I N T                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Img_Int is
*** 58,66 ****
     -----------------------
  
     procedure Set_Image_Integer
!      (V  : Integer;
!       S  : out String;
!       P  : in out Natural)
     is
        procedure Set_Digits (T : Integer);
        --  Set digits of absolute value of T, which is zero or negative. We work
--- 58,66 ----
     -----------------------
  
     procedure Set_Image_Integer
!      (V : Integer;
!       S : out String;
!       P : in out Natural)
     is
        procedure Set_Digits (T : Integer);
        --  Set digits of absolute value of T, which is zero or negative. We work
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgint.ads gcc-4.1.0/gcc/ada/s-imgint.ads
*** gcc-4.0.2/gcc/ada/s-imgint.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgint.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  operations required in Text_IO.Integer_IO for such types.
  
  package System.Img_Int is
! pragma Pure (Img_Int);
  
     function Image_Integer (V : Integer) return String;
     --  Computes Integer'Image (V) and returns the result
--- 36,42 ----
  --  operations required in Text_IO.Integer_IO for such types.
  
  package System.Img_Int is
!    pragma Pure;
  
     function Image_Integer (V : Integer) return String;
     --  Computes Integer'Image (V) and returns the result
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllb.adb gcc-4.1.0/gcc/ada/s-imgllb.adb
*** gcc-4.0.2/gcc/ada/s-imgllb.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllb.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L B                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L B                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllb.ads gcc-4.1.0/gcc/ada/s-imgllb.ads
*** gcc-4.0.2/gcc/ada/s-imgllb.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllb.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L B                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L B                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_LLB is
! pragma Preelaborate (Img_LLB);
  
     procedure Set_Image_Based_Long_Long_Integer
       (V : Long_Long_Integer;
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_LLB is
!    pragma Preelaborate;
  
     procedure Set_Image_Based_Long_Long_Integer
       (V : Long_Long_Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imglld.adb gcc-4.1.0/gcc/ada/s-imglld.adb
*** gcc-4.0.2/gcc/ada/s-imglld.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imglld.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L D                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L D                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imglld.ads gcc-4.1.0/gcc/ada/s-imglld.ads
*** gcc-4.0.2/gcc/ada/s-imglld.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imglld.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L D                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L D                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  type does exceeds Integer'Size (also used for Text_IO.Decimal_IO output)
  
  package System.Img_LLD is
! pragma Preelaborate (Img_LLD);
  
     function Image_Long_Long_Decimal
       (V     : Long_Long_Integer;
--- 35,41 ----
  --  type does exceeds Integer'Size (also used for Text_IO.Decimal_IO output)
  
  package System.Img_LLD is
!    pragma Preelaborate;
  
     function Image_Long_Long_Decimal
       (V     : Long_Long_Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imglli.adb gcc-4.1.0/gcc/ada/s-imglli.adb
*** gcc-4.0.2/gcc/ada/s-imglli.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imglli.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imglli.ads gcc-4.1.0/gcc/ada/s-imglli.ads
*** gcc-4.0.2/gcc/ada/s-imglli.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imglli.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  operations required in Text_IO.Integer_IO for such types.
  
  package System.Img_LLI is
! pragma Preelaborate (Img_LLI);
  
     function Image_Long_Long_Integer (V : Long_Long_Integer) return String;
     --  Computes Long_Long_Integer'Image (V) and returns the result.
--- 36,42 ----
  --  operations required in Text_IO.Integer_IO for such types.
  
  package System.Img_LLI is
!    pragma Preelaborate;
  
     function Image_Long_Long_Integer (V : Long_Long_Integer) return String;
     --  Computes Long_Long_Integer'Image (V) and returns the result.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllu.adb gcc-4.1.0/gcc/ada/s-imgllu.adb
*** gcc-4.0.2/gcc/ada/s-imgllu.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllu.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllu.ads gcc-4.1.0/gcc/ada/s-imgllu.ads
*** gcc-4.0.2/gcc/ada/s-imgllu.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllu.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_LLU is
! pragma Pure (Img_LLU);
  
     function Image_Long_Long_Unsigned
       (V :    System.Unsigned_Types.Long_Long_Unsigned)
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_LLU is
!    pragma Pure;
  
     function Image_Long_Long_Unsigned
       (V :    System.Unsigned_Types.Long_Long_Unsigned)
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllw.adb gcc-4.1.0/gcc/ada/s-imgllw.adb
*** gcc-4.0.2/gcc/ada/s-imgllw.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllw.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L W                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L W                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgllw.ads gcc-4.1.0/gcc/ada/s-imgllw.ads
*** gcc-4.0.2/gcc/ada/s-imgllw.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgllw.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L W                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ L L W                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_LLW is
! pragma Pure (Img_LLW);
  
     procedure Set_Image_Width_Long_Long_Integer
       (V : Long_Long_Integer;
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_LLW is
!    pragma Pure;
  
     procedure Set_Image_Width_Long_Long_Integer
       (V : Long_Long_Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgrea.adb gcc-4.1.0/gcc/ada/s-imgrea.adb
*** gcc-4.0.2/gcc/ada/s-imgrea.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-imgrea.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgrea.ads gcc-4.1.0/gcc/ada/s-imgrea.ads
*** gcc-4.0.2/gcc/ada/s-imgrea.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgrea.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . I M G _ R E A L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . I M G _ R E A L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Image for fixed and float types (also used for Float_IO/Fixed_IO output)
  
  package System.Img_Real is
! pragma Preelaborate (Img_Real);
  
     function Image_Ordinary_Fixed_Point
       (V    : Long_Long_Float;
--- 34,40 ----
  --  Image for fixed and float types (also used for Float_IO/Fixed_IO output)
  
  package System.Img_Real is
!    pragma Preelaborate;
  
     function Image_Ordinary_Fixed_Point
       (V    : Long_Long_Float;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imguns.adb gcc-4.1.0/gcc/ada/s-imguns.adb
*** gcc-4.0.2/gcc/ada/s-imguns.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imguns.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ U N S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ U N S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imguns.ads gcc-4.1.0/gcc/ada/s-imguns.ads
*** gcc-4.0.2/gcc/ada/s-imguns.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imguns.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ U N S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ U N S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_Uns is
! pragma Pure (Img_Uns);
  
     function Image_Unsigned
       (V    : System.Unsigned_Types.Unsigned)
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_Uns is
!    pragma Pure;
  
     function Image_Unsigned
       (V    : System.Unsigned_Types.Unsigned)
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgwch.adb gcc-4.1.0/gcc/ada/s-imgwch.adb
*** gcc-4.0.2/gcc/ada/s-imgwch.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-imgwch.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
  with System.Img_Char; use System.Img_Char;
- with System.WCh_Con;  use System.WCh_Con;
- with System.WCh_WtS;  use System.WCh_WtS;
  
  package body System.Img_WChar is
  
--- 31,39 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ with Interfaces; use Interfaces;
+ 
  with System.Img_Char; use System.Img_Char;
  
  package body System.Img_WChar is
  
*************** package body System.Img_WChar is
*** 42,83 ****
     --------------------------
  
     function Image_Wide_Character
!      (V  : Wide_Character;
!       EM : WC_Encoding_Method) return String
     is
-       Val : constant Natural := Wide_Character'Pos (V);
-       WS  : Wide_String (1 .. 3);
- 
     begin
!       --  If in range of standard character, use standard character routine
! 
!       if Val < 16#80#
!         or else (Val <= 16#FF#
!                   and then EM not in WC_Upper_Half_Encoding_Method)
!       then
!          return Image_Character (Character'Val (Val));
! 
!       --  if the value is one of the last two characters in the type, use
!       --  their language-defined names (3.5.2(3)).
! 
!       elsif Val = 16#FFFE# then
!          return "FFFE";
! 
!       elsif Val = 16#FFFF# then
!          return "FFFF";
! 
!       --  Otherwise return an appropriate escape sequence (i.e. one matching
!       --  the convention implemented by Scn.Wide_Char). The easiest thing is
!       --  to build a wide string for the result, and then use the Wide_Value
!       --  function to build the resulting String.
! 
!       else
!          WS (1) := ''';
!          WS (2) := V;
!          WS (3) := ''';
! 
!          return Wide_String_To_String (WS, EM);
!       end if;
     end Image_Wide_Character;
  
     -------------------------------
--- 42,53 ----
     --------------------------
  
     function Image_Wide_Character
!      (V : Wide_Character) return String
     is
     begin
!       return
!         Image_Wide_Wide_Character
!           (Wide_Wide_Character'Val (Wide_Character'Pos (V)));
     end Image_Wide_Character;
  
     -------------------------------
*************** package body System.Img_WChar is
*** 85,114 ****
     -------------------------------
  
     function Image_Wide_Wide_Character
!      (V  : Wide_Wide_Character;
!       EM : WC_Encoding_Method) return String
     is
!       Val : constant Natural := Wide_Wide_Character'Pos (V);
!       WS  : Wide_Wide_String (1 .. 3);
  
     begin
!       --  If in range of standard Wide_Character, then we use the
!       --  Wide_Character routine
  
!       if Val <= 16#FFFF# then
!          return Image_Wide_Character (Wide_Character'Val (Val), EM);
  
!       --  Otherwise return an appropriate escape sequence (i.e. one matching
!       --  the convention implemented by Scn.Wide_Wide_Char). The easiest thing
!       --  is to build a wide string for the result, and then use the
!       --  Wide_Wide_Value function to build the resulting String.
  
        else
!          WS (1) := ''';
!          WS (2) := V;
!          WS (3) := ''';
  
!          return Wide_Wide_String_To_String (WS, EM);
        end if;
     end Image_Wide_Wide_Character;
  
--- 55,86 ----
     -------------------------------
  
     function Image_Wide_Wide_Character
!      (V : Wide_Wide_Character) return String
     is
!       Val : Unsigned_32 := Wide_Wide_Character'Pos (V);
  
     begin
!       --  If in range of standard Character, use Character routine
  
!       if Val <= 16#FF# then
!          return Image_Character (Character'Val (Wide_Wide_Character'Pos (V)));
  
!       --  Otherwise value returned is Hex_hhhhhhhh
  
        else
!          declare
!             Result : String (1 .. 12) := "Hex_hhhhhhhh";
!             Hex    : constant array (Unsigned_32 range 0 .. 15) of Character :=
!                        "0123456789ABCDEF";
  
!          begin
!             for J in reverse 5 .. 12 loop
!                Result (J) := Hex (Val mod 16);
!                Val := Val / 16;
!             end loop;
! 
!             return Result;
!          end;
        end if;
     end Image_Wide_Wide_Character;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgwch.ads gcc-4.1.0/gcc/ada/s-imgwch.ads
*** gcc-4.0.2/gcc/ada/s-imgwch.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-imgwch.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . I M G _ W C H A R                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . I M G _ W C H A R                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,59 ****
  
  --  Wide_[Wide_]Character'Image
  
- with System.WCh_Con;
- 
  package System.Img_WChar is
! pragma Pure (Img_WChar);
  
!    function Image_Wide_Character
!      (V  : Wide_Character;
!       EM : System.WCh_Con.WC_Encoding_Method) return String;
!    --  Computes Wide_Character'Image (V) and returns the computed result,
!    --  The argument EM is a constant representing the encoding method in use.
!    --  The encoding method used is guaranteed to be consistent across a
!    --  given program execution and to correspond to the method used in the
!    --  source programs.
  
!    function Image_Wide_Wide_Character
!      (V  : Wide_Wide_Character;
!       EM : System.WCh_Con.WC_Encoding_Method) return String;
!    --  Computes Wide_Wide_Character'Image (V) and returns the computed result,
!    --  The argument EM is a constant representing the encoding method in use.
!    --  The encoding method used is guaranteed to be consistent across a
!    --  given program execution and to correspond to the method used in the
!    --  source programs.
  
  end System.Img_WChar;
--- 33,45 ----
  
  --  Wide_[Wide_]Character'Image
  
  package System.Img_WChar is
!    pragma Pure;
  
!    function Image_Wide_Character (V : Wide_Character) return String;
!    --  Computes Wide_Character'Image (V) and returns the computed result
  
!    function Image_Wide_Wide_Character (V : Wide_Wide_Character) return String;
!    --  Computes Wide_Wide_Character'Image (V) and returns the computed result
  
  end System.Img_WChar;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgwiu.adb gcc-4.1.0/gcc/ada/s-imgwiu.adb
*** gcc-4.0.2/gcc/ada/s-imgwiu.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgwiu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ W I U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ W I U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-imgwiu.ads gcc-4.1.0/gcc/ada/s-imgwiu.ads
*** gcc-4.0.2/gcc/ada/s-imgwiu.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-imgwiu.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . I M G _ W I U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . I M G _ W I U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  with System.Unsigned_Types;
  
  package System.Img_WIU is
! pragma Pure (Img_WIU);
  
     procedure Set_Image_Width_Integer
       (V : Integer;
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Img_WIU is
!    pragma Pure;
  
     procedure Set_Image_Width_Integer
       (V : Integer;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-inmaop-dummy.adb gcc-4.1.0/gcc/ada/s-inmaop-dummy.adb
*** gcc-4.0.2/gcc/ada/s-inmaop-dummy.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-inmaop-dummy.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NO tasking version of this package.
  
  package body System.Interrupt_Management.Operations is
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NO tasking version of this package
  
  package body System.Interrupt_Management.Operations is
  
*************** package body System.Interrupt_Management
*** 191,194 ****
--- 191,203 ----
        null;
     end Interrupt_Self_Process;
  
+    --------------------------
+    -- Setup_Interrupt_Mask --
+    --------------------------
+ 
+    procedure Setup_Interrupt_Mask is
+    begin
+       null;
+    end Setup_Interrupt_Mask;
+ 
  end System.Interrupt_Management.Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-inmaop-posix.adb gcc-4.1.0/gcc/ada/s-inmaop-posix.adb
*** gcc-4.0.2/gcc/ada/s-inmaop-posix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-inmaop-posix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
! --                   SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,14 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
! --          S Y S T E M . I N T E R R U P T _ M A N A G E M E N T .         --
! --                            O P E R A T I O N S                           --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 18,25 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Interrupt_Management
*** 78,84 ****
     is
        Result : Interfaces.C.int;
        Mask   : aliased sigset_t;
- 
     begin
        Result := sigemptyset (Mask'Access);
        pragma Assert (Result = 0);
--- 79,84 ----
*************** package body System.Interrupt_Management
*** 97,103 ****
     is
        Mask   : aliased sigset_t;
        Result : Interfaces.C.int;
- 
     begin
        Result := sigemptyset (Mask'Access);
        pragma Assert (Result = 0);
--- 97,102 ----
*************** package body System.Interrupt_Management
*** 113,119 ****
  
     procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
        Result   : Interfaces.C.int;
- 
     begin
        Result := pthread_sigmask
          (SIG_SETMASK, +Interrupt_Mask_Ptr (Mask), null);
--- 112,117 ----
*************** package body System.Interrupt_Management
*** 125,131 ****
        OMask : access Interrupt_Mask)
     is
        Result  : Interfaces.C.int;
- 
     begin
        Result := pthread_sigmask
          (SIG_SETMASK, +Interrupt_Mask_Ptr (Mask), +Interrupt_Mask_Ptr (OMask));
--- 123,128 ----
*************** package body System.Interrupt_Management
*** 138,144 ****
  
     procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
        Result : Interfaces.C.int;
- 
     begin
        Result := pthread_sigmask
          (SIG_SETMASK, null, +Interrupt_Mask_Ptr (Mask));
--- 135,140 ----
*************** package body System.Interrupt_Management
*** 155,161 ****
     is
        Result : Interfaces.C.int;
        Sig    : aliased Signal;
- 
     begin
        Result := sigwait (Mask, Sig'Access);
  
--- 151,156 ----
*************** package body System.Interrupt_Management
*** 172,178 ****
  
     procedure Install_Default_Action (Interrupt : Interrupt_ID) is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigaction
          (Signal (Interrupt),
--- 167,172 ----
*************** package body System.Interrupt_Management
*** 186,192 ****
  
     procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigaction (Signal (Interrupt), Ignore_Action'Access, null);
        pragma Assert (Result = 0);
--- 180,185 ----
*************** package body System.Interrupt_Management
*** 198,204 ****
  
     procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigfillset (Mask);
        pragma Assert (Result = 0);
--- 191,196 ----
*************** package body System.Interrupt_Management
*** 210,216 ****
  
     procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigemptyset (Mask);
        pragma Assert (Result = 0);
--- 202,207 ----
*************** package body System.Interrupt_Management
*** 225,231 ****
        Interrupt : Interrupt_ID)
     is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigaddset (Mask, Signal (Interrupt));
        pragma Assert (Result = 0);
--- 216,221 ----
*************** package body System.Interrupt_Management
*** 240,246 ****
        Interrupt : Interrupt_ID)
     is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigdelset (Mask, Signal (Interrupt));
        pragma Assert (Result = 0);
--- 230,235 ----
*************** package body System.Interrupt_Management
*** 255,261 ****
        Interrupt : Interrupt_ID) return Boolean
     is
        Result : Interfaces.C.int;
- 
     begin
        Result := sigismember (Mask, Signal (Interrupt));
        pragma Assert (Result = 0 or else Result = 1);
--- 244,249 ----
*************** package body System.Interrupt_Management
*** 268,275 ****
  
     procedure Copy_Interrupt_Mask
       (X : out Interrupt_Mask;
!       Y : Interrupt_Mask)
!    is
     begin
        X := Y;
     end Copy_Interrupt_Mask;
--- 256,262 ----
  
     procedure Copy_Interrupt_Mask
       (X : out Interrupt_Mask;
!       Y : Interrupt_Mask) is
     begin
        X := Y;
     end Copy_Interrupt_Mask;
*************** package body System.Interrupt_Management
*** 280,299 ****
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
        Result : Interfaces.C.int;
- 
     begin
        Result := kill (getpid, Signal (Interrupt));
        pragma Assert (Result = 0);
     end Interrupt_Self_Process;
  
! begin
  
     declare
        mask    : aliased sigset_t;
        allmask : aliased sigset_t;
        Result  : Interfaces.C.int;
  
     begin
        for Sig in 1 .. Signal'Last loop
           Result := sigaction
             (Sig, null, Initial_Action (Sig)'Unchecked_Access);
--- 267,299 ----
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
        Result : Interfaces.C.int;
     begin
        Result := kill (getpid, Signal (Interrupt));
        pragma Assert (Result = 0);
     end Interrupt_Self_Process;
  
!    --------------------------
!    -- Setup_Interrupt_Mask --
!    --------------------------
! 
!    procedure Setup_Interrupt_Mask is
!    begin
!       --  Mask task for all signals. The original mask of the Environment task
!       --  will be recovered by Interrupt_Manager task during the elaboration
!       --  of s-interr.adb.
  
+       Set_Interrupt_Mask (All_Tasks_Mask'Access);
+    end Setup_Interrupt_Mask;
+ 
+ begin
     declare
        mask    : aliased sigset_t;
        allmask : aliased sigset_t;
        Result  : Interfaces.C.int;
  
     begin
+       Interrupt_Management.Initialize;
+ 
        for Sig in 1 .. Signal'Last loop
           Result := sigaction
             (Sig, null, Initial_Action (Sig)'Unchecked_Access);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-inmaop-vms.adb gcc-4.1.0/gcc/ada/s-inmaop-vms.adb
*** gcc-4.0.2/gcc/ada/s-inmaop-vms.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-inmaop-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T .        --
! --                           O P E R A T I O N S                            --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --                  SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Interrupt_Management
*** 268,276 ****
        X := Y;
     end Copy_Interrupt_Mask;
  
!    -------------------------
     -- Interrupt_Self_Process --
!    -------------------------
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
        Status : Cond_Value_Type;
--- 267,275 ----
        X := Y;
     end Copy_Interrupt_Mask;
  
!    ----------------------------
     -- Interrupt_Self_Process --
!    ----------------------------
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
        Status : Cond_Value_Type;
*************** package body System.Interrupt_Management
*** 285,291 ****
--- 284,300 ----
        pragma Assert ((Status and 1) = 1);
     end Interrupt_Self_Process;
  
+    --------------------------
+    -- Setup_Interrupt_Mask --
+    --------------------------
+ 
+    procedure Setup_Interrupt_Mask is
+    begin
+       null;
+    end Setup_Interrupt_Mask;
+ 
  begin
+    Interrupt_Management.Initialize;
     Environment_Mask := (others => False);
     All_Tasks_Mask := (others => True);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-inmaop.ads gcc-4.1.0/gcc/ada/s-inmaop.ads
*** gcc-4.0.2/gcc/ada/s-inmaop.ads	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/s-inmaop.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T .       --
  --                             O P E R A T I O N S                          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T .       --
  --                             O P E R A T I O N S                          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Interrupt_Management.Oper
*** 63,73 ****
  
     procedure Install_Default_Action (Interrupt : Interrupt_ID);
     pragma Inline (Install_Default_Action);
!    --  Set the sigaction of the Interrupt to default (SIG_DFL).
  
     procedure Install_Ignore_Action (Interrupt : Interrupt_ID);
     pragma Inline (Install_Ignore_Action);
!    --  Set the sigaction of the Interrupt to ignore (SIG_IGN).
  
     procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask);
     pragma Inline (Fill_Interrupt_Mask);
--- 63,73 ----
  
     procedure Install_Default_Action (Interrupt : Interrupt_ID);
     pragma Inline (Install_Default_Action);
!    --  Set the sigaction of the Interrupt to default (SIG_DFL)
  
     procedure Install_Ignore_Action (Interrupt : Interrupt_ID);
     pragma Inline (Install_Ignore_Action);
!    --  Set the sigaction of the Interrupt to ignore (SIG_IGN)
  
     procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask);
     pragma Inline (Fill_Interrupt_Mask);
*************** package System.Interrupt_Management.Oper
*** 97,120 ****
  
     procedure Copy_Interrupt_Mask (X : out Interrupt_Mask; Y : Interrupt_Mask);
     pragma Inline (Copy_Interrupt_Mask);
!    --  Assigment needed for limited private type Interrupt_Mask.
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID);
     pragma Inline (Interrupt_Self_Process);
     --  Raise an Interrupt process-level
  
!    --  The following objects serve as constants, but are initialized
!    --  in the body to aid portability.  These actually belong to the
!    --  System.Interrupt_Management but since Interrupt_Mask is a
!    --  private type we can not have them declared there.
  
     --  Why not make these deferred constants that are initialized using
     --  function calls in the private part???
  
     Environment_Mask : aliased Interrupt_Mask;
!    --  This mask represents the mask of Environment task when this package
!    --  is being elaborated, except the signals being
!    --  forced to be unmasked by RTS (items in Keep_Unmasked)
  
     All_Tasks_Mask : aliased Interrupt_Mask;
     --  This is the mask of all tasks created in RTS. Only one task in RTS
--- 97,125 ----
  
     procedure Copy_Interrupt_Mask (X : out Interrupt_Mask; Y : Interrupt_Mask);
     pragma Inline (Copy_Interrupt_Mask);
!    --  Assigment needed for limited private type Interrupt_Mask
  
     procedure Interrupt_Self_Process (Interrupt : Interrupt_ID);
     pragma Inline (Interrupt_Self_Process);
     --  Raise an Interrupt process-level
  
!    procedure Setup_Interrupt_Mask;
!    --  Mask Environment task for all signals
!    --  This function should be called by the elaboration of System.Interrupt
!    --  to set up proper signal masking in all tasks.
! 
!    --  The following objects serve as constants, but are initialized in the
!    --  body to aid portability. These should be in System.Interrupt_Management
!    --  but since Interrupt_Mask is private type we cannot have them declared
!    --  there.
  
     --  Why not make these deferred constants that are initialized using
     --  function calls in the private part???
  
     Environment_Mask : aliased Interrupt_Mask;
!    --  This mask represents the mask of Environment task when this package is
!    --  being elaborated, except the signals being forced to be unmasked by RTS
!    --  (items in Keep_Unmasked)
  
     All_Tasks_Mask : aliased Interrupt_Mask;
     --  This is the mask of all tasks created in RTS. Only one task in RTS
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr-dummy.adb gcc-4.1.0/gcc/ada/s-interr-dummy.adb
*** gcc-4.0.2/gcc/ada/s-interr-dummy.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-interr-dummy.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OS/2 version of this package.
! 
! --  This version is a stub, for systems that
! --  do not support interrupts (or signals).
  
  with Ada.Exceptions;
  
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This version is for systems that do not support interrupts (or signals)
  
  with Ada.Exceptions;
  
*************** package body System.Interrupts is
*** 93,100 ****
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID)
!       return      Parameterless_Handler
     is
     begin
        Unimplemented;
--- 90,96 ----
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler
     is
     begin
        Unimplemented;
*************** package body System.Interrupts is
*** 155,161 ****
        return   Boolean
     is
        pragma Warnings (Off, Object);
- 
     begin
        Unimplemented;
        return True;
--- 151,156 ----
*************** package body System.Interrupts is
*** 166,172 ****
        return   Boolean
     is
        pragma Warnings (Off, Object);
- 
     begin
        Unimplemented;
        return True;
--- 161,166 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr-sigaction.adb gcc-4.1.0/gcc/ada/s-interr-sigaction.adb
*** gcc-4.0.2/gcc/ada/s-interr-sigaction.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-interr-sigaction.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --              Copyright (C) 1998-2004 Free Software Fundation             --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005, Free Software Fundation                --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the IRIX & NT version of this package.
  
  with Ada.Task_Identification;
  --  used for Task_Id
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the IRIX & NT version of this package
  
  with Ada.Task_Identification;
  --  used for Task_Id
*************** package body System.Interrupts is
*** 120,134 ****
     --  that contain interrupt handlers.
  
     procedure Signal_Handler (Sig : Interrupt_ID);
!    --  This procedure is used to handle all the signals.
  
     --  Type and Head, Tail of the list containing Registered Interrupt
     --  Handlers. These definitions are used to register the handlers
     --  specified by the pragma Interrupt_Handler.
  
!    --
!    --  Handler Registration:
!    --
  
     type Registered_Handler;
     type R_Link is access all Registered_Handler;
--- 120,134 ----
     --  that contain interrupt handlers.
  
     procedure Signal_Handler (Sig : Interrupt_ID);
!    --  This procedure is used to handle all the signals
  
     --  Type and Head, Tail of the list containing Registered Interrupt
     --  Handlers. These definitions are used to register the handlers
     --  specified by the pragma Interrupt_Handler.
  
!    --------------------------
!    -- Handler Registration --
!    --------------------------
  
     type Registered_Handler;
     type R_Link is access all Registered_Handler;
*************** package body System.Interrupts is
*** 362,376 ****
  
        if not Restoration and then not Static
  
!          --  Tries to overwrite a static Interrupt Handler with a
!          --  dynamic Handler
  
!         and then (Descriptors (Interrupt).Static
  
!                      --  The new handler is not specified as an
!                      --  Interrupt Handler by a pragma.
  
!                      or else not Is_Registered (New_Handler))
        then
           Raise_Exception (Program_Error'Identity,
             "Trying to overwrite a static Interrupt Handler with a " &
--- 362,375 ----
  
        if not Restoration and then not Static
  
!          --  Tries to overwrite a static Interrupt Handler with dynamic handle
  
!         and then
!           (Descriptors (Interrupt).Static
  
!             --  New handler not specified as an Interrupt Handler by a pragma
  
!              or else not Is_Registered (New_Handler))
        then
           Raise_Exception (Program_Error'Identity,
             "Trying to overwrite a static Interrupt Handler with a " &
*************** package body System.Interrupts is
*** 569,578 ****
        Descriptors (Interrupt).T := T;
        Descriptors (Interrupt).E := E;
  
!       --  Indicate the attachment of Interrupt Entry in ATCB.
!       --  This is need so that when an Interrupt Entry task terminates
!       --  the binding can be cleaned. The call to unbinding must be
!       --  make by the task before it terminates.
  
        T.Interrupt_Entry := True;
     end Bind_Interrupt_To_Entry;
--- 568,577 ----
        Descriptors (Interrupt).T := T;
        Descriptors (Interrupt).E := E;
  
!       --  Indicate the attachment of Interrupt Entry in ATCB. This is needed so
!       --  that when an Interrupt Entry task terminates the binding can be
!       --  cleaned up. The call to unbinding must be make by the task before it
!       --  terminates.
  
        T.Interrupt_Entry := True;
     end Bind_Interrupt_To_Entry;
*************** package body System.Interrupts is
*** 597,603 ****
           end if;
        end loop;
  
!       --  Indicate in ATCB that no Interrupt Entries are attached.
  
        T.Interrupt_Entry := True;
     end Detach_Interrupt_Entries;
--- 596,602 ----
           end if;
        end loop;
  
!       --  Indicate in ATCB that no Interrupt Entries are attached
  
        T.Interrupt_Entry := True;
     end Detach_Interrupt_Entries;
*************** package body System.Interrupts is
*** 674,681 ****
  
           Initialization.Undefer_Abort (Self_Id);
  
!          --  Undefer abort here to allow a window for this task
!          --  to be aborted  at the time of system shutdown.
  
        end loop;
     end Server_Task;
--- 673,680 ----
  
           Initialization.Undefer_Abort (Self_Id);
  
!          --  Undefer abort here to allow a window for this task to be aborted
!          --  at the time of system shutdown.
  
        end loop;
     end Server_Task;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr-vms.adb gcc-4.1.0/gcc/ada/s-interr-vms.adb
*** gcc-4.0.2/gcc/ada/s-interr-vms.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-interr-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OpenVMS/Alpha version of this package.
  
  --  Invariants:
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OpenVMS/Alpha version of this package
  
  --  Invariants:
  
*************** package body System.Interrupts is
*** 140,148 ****
     -- Local Tasks --
     -----------------
  
!    --  WARNING: System.Tasking.Stages performs calls to this task
!    --  with low-level constructs. Do not change this spec without synchro-
!    --  nizing it.
  
     task Interrupt_Manager is
        entry Detach_Interrupt_Entries (T : Task_Id);
--- 140,147 ----
     -- Local Tasks --
     -----------------
  
!    --  WARNING: System.Tasking.Stages performs calls to this task with
!    --  low-level constructs. Do not change this spec without synchronizing it.
  
     task Interrupt_Manager is
        entry Detach_Interrupt_Entries (T : Task_Id);
*************** package body System.Interrupts is
*** 183,192 ****
  
     task type Server_Task (Interrupt : Interrupt_ID) is
        pragma Priority (System.Interrupt_Priority'Last);
!       --  Note: the above pragma Priority is strictly speaking improper
!       --  since it is outside the range of allowed priorities, but the
!       --  compiler treats system units specially and does not apply
!       --  this range checking rule to system units.
  
     end Server_Task;
  
--- 182,191 ----
  
     task type Server_Task (Interrupt : Interrupt_ID) is
        pragma Priority (System.Interrupt_Priority'Last);
!       --  Note: the above pragma Priority is strictly speaking improper since
!       --  it is outside the range of allowed priorities, but the compiler
!       --  treats system units specially and does not apply this range checking
!       --  rule to system units.
  
     end Server_Task;
  
*************** package body System.Interrupts is
*** 210,218 ****
                      (others => (null, Static => False));
     pragma Volatile_Components (User_Handler);
     --  Holds the protected procedure handler (if any) and its Static
!    --  information  for each interrupt. A handler is a Static one if
!    --  it is specified through the pragma Attach_Handler.
!    --  Attach_Handler. Otherwise, not static)
  
     User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
                    (others => (T => Null_Task, E => Null_Task_Entry));
--- 209,217 ----
                      (others => (null, Static => False));
     pragma Volatile_Components (User_Handler);
     --  Holds the protected procedure handler (if any) and its Static
!    --  information for each interrupt. A handler is a Static one if it is
!    --  specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
!    --  not static)
  
     User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
                    (others => (T => Null_Task, E => Null_Task_Entry));
*************** package body System.Interrupts is
*** 221,227 ****
  
     Blocked : constant array (Interrupt_ID'Range) of Boolean :=
       (others => False);
! --  ??? pragma Volatile_Components (Blocked);
     --  True iff the corresponding interrupt is blocked in the process level
  
     Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
--- 220,226 ----
  
     Blocked : constant array (Interrupt_ID'Range) of Boolean :=
       (others => False);
!    --  ??? pragma Volatile_Components (Blocked);
     --  True iff the corresponding interrupt is blocked in the process level
  
     Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
*************** package body System.Interrupts is
*** 238,250 ****
     Server_ID : array (Interrupt_ID'Range) of Task_Id :=
                   (others => Null_Task);
     pragma Atomic_Components (Server_ID);
!    --  Holds the Task_Id of the Server_Task for each interrupt.
!    --  Task_Id is needed to accomplish locking per Interrupt base. Also
!    --  is needed to decide whether to create a new Server_Task.
  
     --  Type and Head, Tail of the list containing Registered Interrupt
!    --  Handlers. These definitions are used to register the handlers
!    --  specified by the pragma Interrupt_Handler.
  
     type Registered_Handler;
     type R_Link is access all Registered_Handler;
--- 237,249 ----
     Server_ID : array (Interrupt_ID'Range) of Task_Id :=
                   (others => Null_Task);
     pragma Atomic_Components (Server_ID);
!    --  Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
!    --  needed to accomplish locking per Interrupt base. Also is needed to
!    --  decide whether to create a new Server_Task.
  
     --  Type and Head, Tail of the list containing Registered Interrupt
!    --  Handlers. These definitions are used to register the handlers specified
!    --  by the pragma Interrupt_Handler.
  
     type Registered_Handler;
     type R_Link is access all Registered_Handler;
*************** package body System.Interrupts is
*** 334,340 ****
        end loop;
  
        return False;
- 
     end Is_Registered;
  
     -----------------
--- 333,338 ----
*************** package body System.Interrupts is
*** 415,423 ****
             Interrupt_ID'Image (Interrupt) & " is reserved");
        end if;
  
!       --  ??? Since Parameterless_Handler is not Atomic, the
!       --  current implementation is wrong. We need a new service in
!       --  Interrupt_Manager to ensure atomicity.
  
        return User_Handler (Interrupt).H;
     end Current_Handler;
--- 413,421 ----
             Interrupt_ID'Image (Interrupt) & " is reserved");
        end if;
  
!       --  ??? Since Parameterless_Handler is not Atomic, the current
!       --  implementation is wrong. We need a new service in Interrupt_Manager
!       --  to ensure atomicity.
  
        return User_Handler (Interrupt).H;
     end Current_Handler;
*************** package body System.Interrupts is
*** 452,470 ****
     -- Exchange_Handler --
     ----------------------
  
!    --  Calling this procedure with New_Handler = null and Static = True
!    --  means we want to detach the current handler regardless of the
!    --  previous handler's binding status (ie. do not care if it is a
!    --  dynamic or static handler).
  
!    --  This option is needed so that during the finalization of a PO, we
!    --  can detach handlers attached through pragma Attach_Handler.
  
     procedure Exchange_Handler
       (Old_Handler : out Parameterless_Handler;
        New_Handler : Parameterless_Handler;
        Interrupt   : Interrupt_ID;
!       Static      : Boolean := False) is
     begin
        if Is_Reserved (Interrupt) then
           Raise_Exception (Program_Error'Identity, "Interrupt" &
--- 450,469 ----
     -- Exchange_Handler --
     ----------------------
  
!    --  Calling this procedure with New_Handler = null and Static = True means
!    --  we want to detach the current handler regardless of the previous
!    --  handler's binding status (ie. do not care if it is dynamic or static
!    --  handler).
  
!    --  This option is needed so that during the finalization of a PO, we can
!    --  detach handlers attached through pragma Attach_Handler.
  
     procedure Exchange_Handler
       (Old_Handler : out Parameterless_Handler;
        New_Handler : Parameterless_Handler;
        Interrupt   : Interrupt_ID;
!       Static      : Boolean := False)
!    is
     begin
        if Is_Reserved (Interrupt) then
           Raise_Exception (Program_Error'Identity, "Interrupt" &
*************** package body System.Interrupts is
*** 1152,1176 ****
     end Install_Handlers;
  
  --  Elaboration code for package System.Interrupts
  begin
  
     --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
  
     Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
  
!    --  During the elaboration of this package body we want RTS to
!    --  inherit the interrupt mask from the Environment Task.
  
!    --  The Environment Task should have gotten its mask from
!    --  the enclosing process during the RTS start up. (See
!    --  in s-inmaop.adb). Pass the Interrupt_Mask of the Environment
!    --  task to the Interrupt_Manager.
  
!    --  Note : At this point we know that all tasks (including
!    --  RTS internal servers) are masked for non-reserved signals
!    --  (see s-taprop.adb). Only the Interrupt_Manager will have
!    --  masks set up differently inheriting the original Environment
!    --  Task's mask.
  
     Interrupt_Manager.Initialize (IMOP.Environment_Mask);
  end System.Interrupts;
--- 1151,1174 ----
     end Install_Handlers;
  
  --  Elaboration code for package System.Interrupts
+ 
  begin
  
     --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
  
     Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
  
!    --  During the elaboration of this package body we want RTS to inherit the
!    --  interrupt mask from the Environment Task.
  
!    --  The Environment Task should have gotten its mask from the enclosing
!    --  process during the RTS start up. (See in s-inmaop.adb). Pass the
!    --  Interrupt_Mask of the Environment task to the Interrupt_Manager.
  
!    --  Note : At this point we know that all tasks (including RTS internal
!    --  servers) are masked for non-reserved signals (see s-taprop.adb). Only
!    --  the Interrupt_Manager will have masks set up differently inheriting the
!    --  original Environment Task's mask.
  
     Interrupt_Manager.Initialize (IMOP.Environment_Mask);
  end System.Interrupts;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr-vxworks.adb gcc-4.1.0/gcc/ada/s-interr-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-interr-vxworks.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-interr-vxworks.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,59 ****
  
  --  Invariants:
  
! --  All user-handleable signals are masked at all times in all
! --  tasks/threads except possibly for the Interrupt_Manager task.
  
! --  When a user task wants to have the effect of masking/unmasking an
! --  signal, it must call Block_Interrupt/Unblock_Interrupt, which
! --  will have the effect of unmasking/masking the signal in the
! --  Interrupt_Manager task.  These comments do not apply to vectored
! --  hardware interrupts, which may be masked or unmasked using routined
! --  interfaced to the relevant VxWorks system calls.
  
! --  Once we associate a Signal_Server_Task with an signal, the task never
! --  goes away, and we never remove the association. On the other hand, it
! --  is more convenient to terminate an associated Interrupt_Server_Task
! --  for a vectored hardware interrupt (since we use a binary semaphore
! --  for synchronization with the umbrella handler).
  
  --  There is no more than one signal per Signal_Server_Task and no more than
! --  one Signal_Server_Task per signal.  The same relation holds for hardware
! --  interrupts and Interrupt_Server_Task's at any given time.  That is,
! --  only one non-terminated Interrupt_Server_Task exists for a give
! --  interrupt at any time.
  
  --  Within this package, the lock L is used to protect the various status
  --  tables. If there is a Server_Task associated with a signal or interrupt,
--- 33,59 ----
  
  --  Invariants:
  
! --  All user-handleable signals are masked at all times in all tasks/threads
! --  except possibly for the Interrupt_Manager task.
  
! --  When a user task wants to have the effect of masking/unmasking an signal,
! --  it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
! --  of unmasking/masking the signal in the Interrupt_Manager task. These
! --  comments do not apply to vectored hardware interrupts, which may be masked
! --  or unmasked using routined interfaced to the relevant VxWorks system
! --  calls.
  
! --  Once we associate a Signal_Server_Task with an signal, the task never goes
! --  away, and we never remove the association. On the other hand, it is more
! --  convenient to terminate an associated Interrupt_Server_Task for a vectored
! --  hardware interrupt (since we use a binary semaphore for synchronization
! --  with the umbrella handler).
  
  --  There is no more than one signal per Signal_Server_Task and no more than
! --  one Signal_Server_Task per signal. The same relation holds for hardware
! --  interrupts and Interrupt_Server_Task's at any given time. That is, only
! --  one non-terminated Interrupt_Server_Task exists for a give interrupt at
! --  any time.
  
  --  Within this package, the lock L is used to protect the various status
  --  tables. If there is a Server_Task associated with a signal or interrupt,
*************** package body System.Interrupts is
*** 124,132 ****
     -- Local Tasks --
     -----------------
  
!    --  WARNING: System.Tasking.Stages performs calls to this task
!    --  with low-level constructs. Do not change this spec without synchro-
!    --  nizing it.
  
     task Interrupt_Manager is
        entry Detach_Interrupt_Entries (T : Task_Id);
--- 124,131 ----
     -- Local Tasks --
     -----------------
  
!    --  WARNING: System.Tasking.Stages performs calls to this task with
!    --  low-level constructs. Do not change this spec without synchronizing it.
  
     task Interrupt_Manager is
        entry Detach_Interrupt_Entries (T : Task_Id);
*************** package body System.Interrupts is
*** 331,337 ****
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler is
     begin
        Check_Reserved_Interrupt (Interrupt);
  
--- 330,337 ----
     ---------------------
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler
!    is
     begin
        Check_Reserved_Interrupt (Interrupt);
  
*************** package body System.Interrupts is
*** 386,392 ****
       (Old_Handler : out Parameterless_Handler;
        New_Handler : Parameterless_Handler;
        Interrupt   : Interrupt_ID;
!       Static      : Boolean := False) is
     begin
        Check_Reserved_Interrupt (Interrupt);
        Interrupt_Manager.Exchange_Handler
--- 386,393 ----
       (Old_Handler : out Parameterless_Handler;
        New_Handler : Parameterless_Handler;
        Interrupt   : Interrupt_ID;
!       Static      : Boolean := False)
!    is
     begin
        Check_Reserved_Interrupt (Interrupt);
        Interrupt_Manager.Exchange_Handler
*************** package body System.Interrupts is
*** 421,427 ****
     -- Finalize_Interrupt_Servers --
     --------------------------------
  
!    --  Restore default handlers for interrupt servers.
  
     --  This is called by the Interrupt_Manager task when it receives the abort
     --  signal during program finalization.
--- 422,428 ----
     -- Finalize_Interrupt_Servers --
     --------------------------------
  
!    --  Restore default handlers for interrupt servers
  
     --  This is called by the Interrupt_Manager task when it receives the abort
     --  signal during program finalization.
*************** package body System.Interrupts is
*** 456,462 ****
        return   Boolean
     is
        pragma Unreferenced (Object);
- 
     begin
        return True;
     end Has_Interrupt_Or_Attach_Handler;
--- 457,462 ----
*************** package body System.Interrupts is
*** 466,472 ****
        return   Boolean
     is
        pragma Unreferenced (Object);
- 
     begin
        return True;
     end Has_Interrupt_Or_Attach_Handler;
--- 466,471 ----
*************** package body System.Interrupts is
*** 500,508 ****
  
     procedure Install_Handlers
       (Object       : access Static_Interrupt_Protection;
!       New_Handlers : New_Handler_Array) is
     begin
        for N in New_Handlers'Range loop
           --  We need a lock around this ???
  
           Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
--- 499,509 ----
  
     procedure Install_Handlers
       (Object       : access Static_Interrupt_Protection;
!       New_Handlers : New_Handler_Array)
!    is
     begin
        for N in New_Handlers'Range loop
+ 
           --  We need a lock around this ???
  
           Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
*************** package body System.Interrupts is
*** 687,692 ****
--- 688,694 ----
  
     procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
        New_Node_Ptr : R_Link;
+ 
     begin
        --  This routine registers a handler as usable for dynamic
        --  interrupt handler association. Routines attaching and detaching
*************** package body System.Interrupts is
*** 727,733 ****
     ------------------
  
     function Unblocked_By
!      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id is
     begin
        Unimplemented ("Unblocked_By");
        return Null_Task;
--- 729,736 ----
     ------------------
  
     function Unblocked_By
!      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
!    is
     begin
        Unimplemented ("Unblocked_By");
        return Null_Task;
*************** package body System.Interrupts is
*** 836,843 ****
           --  status of the Current_Handler.
  
           if not Static and then User_Handler (Interrupt).Static then
!             --  Trying to detach a static Interrupt Handler.
!             --  raise Program_Error.
  
              Raise_Exception (Program_Error'Identity,
                "Trying to detach a static Interrupt Handler");
--- 839,847 ----
           --  status of the Current_Handler.
  
           if not Static and then User_Handler (Interrupt).Static then
! 
!             --  Trying to detach a static Interrupt Handler. raise
!             --  Program_Error.
  
              Raise_Exception (Program_Error'Identity,
                "Trying to detach a static Interrupt Handler");
*************** package body System.Interrupts is
*** 864,872 ****
           New_Handler : Parameterless_Handler;
           Interrupt   : Interrupt_ID;
           Static      : Boolean;
!          Restoration : Boolean := False) is
        begin
           if User_Entry (Interrupt).T /= Null_Task then
              --  If an interrupt entry is already installed, raise
              --  Program_Error. (propagate it to the caller).
  
--- 868,878 ----
           New_Handler : Parameterless_Handler;
           Interrupt   : Interrupt_ID;
           Static      : Boolean;
!          Restoration : Boolean := False)
!       is
        begin
           if User_Entry (Interrupt).T /= Null_Task then
+ 
              --  If an interrupt entry is already installed, raise
              --  Program_Error. (propagate it to the caller).
  
*************** package body System.Interrupts is
*** 909,915 ****
  
           if New_Handler = null then
  
!             --  The null handler means we are detaching the handler.
  
              User_Handler (Interrupt).Static := False;
  
--- 915,921 ----
  
           if New_Handler = null then
  
!             --  The null handler means we are detaching the handler
  
              User_Handler (Interrupt).Static := False;
  
*************** package body System.Interrupts is
*** 935,945 ****
--- 941,953 ----
           end if;
  
           if (New_Handler = null) and then Old_Handler /= null then
+ 
              --  Restore default handler
  
              Unbind_Handler (Interrupt);
  
           elsif Old_Handler = null then
+ 
              --  Save default handler
  
              Bind_Handler (Interrupt);
*************** package body System.Interrupts is
*** 1046,1052 ****
                       end if;
                    end loop;
  
!                   --  Indicate in ATCB that no interrupt entries are attached.
  
                    T.Interrupt_Entry := False;
                 end Detach_Interrupt_Entries;
--- 1054,1060 ----
                       end if;
                    end loop;
  
!                   --  Indicate in ATCB that no interrupt entries are attached
  
                    T.Interrupt_Entry := False;
                 end Detach_Interrupt_Entries;
*************** package body System.Interrupts is
*** 1140,1146 ****
     end Interrupt_Server_Task;
  
  begin
!    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
  
     Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
  end System.Interrupts;
--- 1148,1154 ----
     end Interrupt_Server_Task;
  
  begin
!    --  Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
  
     Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
  end System.Interrupts;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr.adb gcc-4.1.0/gcc/ada/s-interr.adb
*** gcc-4.0.2/gcc/ada/s-interr.adb	Tue Jul  6 13:57:32 2004
--- gcc-4.1.0/gcc/ada/s-interr.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Interrupts is
*** 157,176 ****
        entry Initialize (Mask : IMNG.Interrupt_Mask);
  
        entry Attach_Handler
!         (New_Handler : in Parameterless_Handler;
!          Interrupt   : in Interrupt_ID;
!          Static      : in Boolean;
!          Restoration : in Boolean := False);
  
        entry Exchange_Handler
          (Old_Handler : out Parameterless_Handler;
!          New_Handler : in Parameterless_Handler;
!          Interrupt   : in Interrupt_ID;
!          Static      : in Boolean);
  
        entry Detach_Handler
!         (Interrupt   : in Interrupt_ID;
!          Static      : in Boolean);
  
        entry Bind_Interrupt_To_Entry
          (T         : Task_Id;
--- 157,176 ----
        entry Initialize (Mask : IMNG.Interrupt_Mask);
  
        entry Attach_Handler
!         (New_Handler : Parameterless_Handler;
!          Interrupt   : Interrupt_ID;
!          Static      : Boolean;
!          Restoration : Boolean := False);
  
        entry Exchange_Handler
          (Old_Handler : out Parameterless_Handler;
!          New_Handler : Parameterless_Handler;
!          Interrupt   : Interrupt_ID;
!          Static      : Boolean);
  
        entry Detach_Handler
!         (Interrupt   : Interrupt_ID;
!          Static      : Boolean);
  
        entry Bind_Interrupt_To_Entry
          (T         : Task_Id;
*************** package body System.Interrupts is
*** 256,262 ****
     type R_Link is access all Registered_Handler;
  
     type Registered_Handler is record
!       H :    System.Address := System.Null_Address;
        Next : R_Link := null;
     end record;
  
--- 256,262 ----
     type R_Link is access all Registered_Handler;
  
     type Registered_Handler is record
!       H    : System.Address := System.Null_Address;
        Next : R_Link := null;
     end record;
  
*************** package body System.Interrupts is
*** 287,295 ****
     --  can detach handlers attached through pragma Attach_Handler.
  
     procedure Attach_Handler
!      (New_Handler : in Parameterless_Handler;
!       Interrupt   : in Interrupt_ID;
!       Static      : in Boolean := False)
     is
     begin
        if Is_Reserved (Interrupt) then
--- 287,295 ----
     --  can detach handlers attached through pragma Attach_Handler.
  
     procedure Attach_Handler
!      (New_Handler : Parameterless_Handler;
!       Interrupt   : Interrupt_ID;
!       Static      : Boolean := False)
     is
     begin
        if Is_Reserved (Interrupt) then
*************** package body System.Interrupts is
*** 352,360 ****
             Interrupt_ID'Image (Interrupt) & " is reserved");
        end if;
  
!       --  ??? Since Parameterless_Handler is not Atomic, the
!       --  current implementation is wrong. We need a new service in
!       --  Interrupt_Manager to ensure atomicity.
  
        return User_Handler (Interrupt).H;
     end Current_Handler;
--- 352,360 ----
             Interrupt_ID'Image (Interrupt) & " is reserved");
        end if;
  
!       --  ??? Since Parameterless_Handler is not Atomic, the current
!       --  implementation is wrong. We need a new service in Interrupt_Manager
!       --  to ensure atomicity.
  
        return User_Handler (Interrupt).H;
     end Current_Handler;
*************** package body System.Interrupts is
*** 632,646 ****
        New_Node_Ptr : R_Link;
  
     begin
!       --  This routine registers the Handler as usable for Dynamic
!       --  Interrupt Handler. Routines attaching and detaching Handler
!       --  dynamically should first consult if the Handler is rgistered.
!       --  A Program Error should be raised if it is not registered.
  
!       --  The pragma Interrupt_Handler can only appear in the library
!       --  level PO definition and instantiation. Therefore, we do not need
!       --  to implement Unregistering operation. Neither we need to
!       --  protect the queue structure using a Lock.
  
        pragma Assert (Handler_Addr /= System.Null_Address);
  
--- 632,646 ----
        New_Node_Ptr : R_Link;
  
     begin
!       --  This routine registers the Handler as usable for Dynamic Interrupt
!       --  Handler. Routines attaching and detaching Handler dynamically should
!       --  first consult if the Handler is registered. A Program Error should
!       --  be raised if it is not registered.
  
!       --  The pragma Interrupt_Handler can only appear in the library level PO
!       --  definition and instantiation. Therefore, we do not need to implement
!       --  Unregistering operation. Neither we need to protect the queue
!       --  structure using a Lock.
  
        pragma Assert (Handler_Addr /= System.Null_Address);
  
*************** package body System.Interrupts is
*** 1014,1023 ****
           begin
              select
                 accept Attach_Handler
!                   (New_Handler : in Parameterless_Handler;
!                    Interrupt   : in Interrupt_ID;
!                    Static      : in Boolean;
!                    Restoration : in Boolean := False)
                 do
                    Unprotected_Exchange_Handler
                      (Old_Handler, New_Handler, Interrupt, Static, Restoration);
--- 1014,1023 ----
           begin
              select
                 accept Attach_Handler
!                   (New_Handler : Parameterless_Handler;
!                    Interrupt   : Interrupt_ID;
!                    Static      : Boolean;
!                    Restoration : Boolean := False)
                 do
                    Unprotected_Exchange_Handler
                      (Old_Handler, New_Handler, Interrupt, Static, Restoration);
*************** package body System.Interrupts is
*** 1026,1034 ****
              or
                 accept Exchange_Handler
                    (Old_Handler : out Parameterless_Handler;
!                    New_Handler : in Parameterless_Handler;
!                    Interrupt   : in Interrupt_ID;
!                    Static      : in Boolean)
                 do
                    Unprotected_Exchange_Handler
                      (Old_Handler, New_Handler, Interrupt, Static);
--- 1026,1034 ----
              or
                 accept Exchange_Handler
                    (Old_Handler : out Parameterless_Handler;
!                    New_Handler : Parameterless_Handler;
!                    Interrupt   : Interrupt_ID;
!                    Static      : Boolean)
                 do
                    Unprotected_Exchange_Handler
                      (Old_Handler, New_Handler, Interrupt, Static);
*************** package body System.Interrupts is
*** 1036,1043 ****
  
              or
                 accept Detach_Handler
!                  (Interrupt   : in Interrupt_ID;
!                   Static      : in Boolean)
                 do
                    Unprotected_Detach_Handler (Interrupt, Static);
                 end Detach_Handler;
--- 1036,1043 ----
  
              or
                 accept Detach_Handler
!                  (Interrupt   : Interrupt_ID;
!                   Static      : Boolean)
                 do
                    Unprotected_Detach_Handler (Interrupt, Static);
                 end Detach_Handler;
*************** package body System.Interrupts is
*** 1438,1445 ****
  
           System.Tasking.Initialization.Undefer_Abort (Self_ID);
  
!          --  Undefer abort here to allow a window for this task
!          --  to be aborted  at the time of system shutdown.
  
        end loop;
     end Server_Task;
--- 1438,1450 ----
  
           System.Tasking.Initialization.Undefer_Abort (Self_ID);
  
!          if Self_ID.Pending_Action then
!             Initialization.Do_Pending_Action (Self_ID);
!          end if;
! 
!          --  Undefer abort here to allow a window for this task to be aborted
!          --  at the time of system shutdown. We also explicitely test for
!          --  Pending_Action in case System.Parameters.No_Abort is True.
  
        end loop;
     end Server_Task;
*************** begin
*** 1454,1469 ****
     --  During the elaboration of this package body we want the RTS
     --  to inherit the interrupt mask from the Environment Task.
  
!    --  The environment task should have gotten its mask from
!    --  the enclosing process during the RTS start up. (See
!    --  processing in s-inmaop.adb). Pass the Interrupt_Mask
!    --  of the environment task to the Interrupt_Manager.
  
!    --  Note : At this point we know that all tasks (including
!    --  RTS internal servers) are masked for non-reserved signals
!    --  (see s-taprop.adb). Only the Interrupt_Manager will have
!    --  masks set up differently inheriting the original environment
!    --  task's mask.
  
     Interrupt_Manager.Initialize (IMOP.Environment_Mask);
  end System.Interrupts;
--- 1459,1473 ----
     --  During the elaboration of this package body we want the RTS
     --  to inherit the interrupt mask from the Environment Task.
  
!    IMOP.Setup_Interrupt_Mask;
  
!    --  The environment task should have gotten its mask from the enclosing
!    --  process during the RTS start up. (See processing in s-inmaop.adb). Pass
!    --  the Interrupt_Mask of the environment task to the Interrupt_Manager.
! 
!    --  Note : At this point we know that all tasks are masked for non-reserved
!    --  signals. Only the Interrupt_Manager will have masks set up differently
!    --  inheriting the original environment task's mask.
  
     Interrupt_Manager.Initialize (IMOP.Environment_Mask);
  end System.Interrupts;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-interr.ads gcc-4.1.0/gcc/ada/s-interr.ads
*** gcc-4.0.2/gcc/ada/s-interr.ads	Tue Jul  6 13:57:32 2004
--- gcc-4.1.0/gcc/ada/s-interr.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . I N T E R R U P T S                    --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  --  It is made a child of System to allow visibility of various
  --  runtime system internal data and operations.
  
! --  See System.Interrupt_Management for core interrupt/signal interfaces.
  
  --  These two packages are separated in order to allow
  --  System.Interrupt_Management to be used without requiring the whole
--- 39,45 ----
  --  It is made a child of System to allow visibility of various
  --  runtime system internal data and operations.
  
! --  See System.Interrupt_Management for core interrupt/signal interfaces
  
  --  These two packages are separated in order to allow
  --  System.Interrupt_Management to be used without requiring the whole
*************** package System.Interrupts is
*** 95,102 ****
     function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean;
  
     function Current_Handler
!      (Interrupt : Interrupt_ID)
!       return Parameterless_Handler;
  
     --  Calling the following procedures with New_Handler = null
     --  and Static = true means that we want to modify the current handler
--- 95,101 ----
     function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean;
  
     function Current_Handler
!      (Interrupt : Interrupt_ID) return Parameterless_Handler;
  
     --  Calling the following procedures with New_Handler = null
     --  and Static = true means that we want to modify the current handler
*************** package System.Interrupts is
*** 119,126 ****
        Static    : Boolean := False);
  
     function Reference
!      (Interrupt : Interrupt_ID)
!      return       System.Address;
  
     --------------------------------
     -- Interrupt Entries Services --
--- 118,124 ----
        Static    : Boolean := False);
  
     function Reference
!      (Interrupt : Interrupt_ID) return System.Address;
  
     --------------------------------
     -- Interrupt Entries Services --
*************** package System.Interrupts is
*** 150,157 ****
     procedure Unblock_Interrupt (Interrupt : Interrupt_ID);
  
     function Unblocked_By
!      (Interrupt   : Interrupt_ID)
!       return System.Tasking.Task_Id;
     --  It returns the ID of the last Task which Unblocked this Interrupt.
     --  It returns Null_Task if no tasks have ever requested the
     --  Unblocking operation or the Interrupt is currently Blocked.
--- 148,154 ----
     procedure Unblock_Interrupt (Interrupt : Interrupt_ID);
  
     function Unblocked_By
!      (Interrupt : Interrupt_ID) return System.Tasking.Task_Id;
     --  It returns the ID of the last Task which Unblocked this Interrupt.
     --  It returns Null_Task if no tasks have ever requested the
     --  Unblocking operation or the Interrupt is currently Blocked.
*************** package System.Interrupts is
*** 185,222 ****
  
     --  There are two kinds of protected objects that deal with interrupts:
  
!    --  (1) Only Interrupt_Handler pragmas are used. We need to be able to
!    --  tell if an Interrupt_Handler applies to a given procedure, so
     --  Register_Interrupt_Handler has to be called for all the potential
!    --  handlers, it should be done by calling Register_Interrupt_Handler
!    --  with the handler code address. On finalization, which can happen only
!    --  has part of library level finalization since PO with
!    --  Interrupt_Handler pragmas can only be declared at library level,
!    --  nothing special needs to be done since the default handlers have been
!    --  restored as part of task completion which is done just before global
!    --  finalization.  Dynamic_Interrupt_Protection should be used in this
!    --  case.
  
     --  (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler
!    --  pragma. We need to attach the handlers to the given interrupts when
!    --  the objet is elaborated. This should be done by constructing an array
!    --  of pairs (interrupt, handler) from the pragmas and calling
!    --  Install_Handlers with it (types to be used are New_Handler_Item and
!    --  New_Handler_Array). On finalization, we need to restore the handlers
!    --  that were installed before the elaboration of the PO, so we need to
!    --  store these previous handlers. This is also done by Install_Handlers,
!    --  the room for these informations is provided by adding a discriminant
!    --  which is the number of Attach_Handler pragmas and an array of this
!    --  size in the protection type, Static_Interrupt_Protection.
  
     procedure Register_Interrupt_Handler
       (Handler_Addr : System.Address);
!    --  This routine should be called by the compiler to allow the
!    --  handler be used as an Interrupt Handler. That means call this
!    --  procedure for each pragma Interrup_Handler providing the
!    --  address of the handler (not including the pointer to the
!    --  actual PO, this way this routine is called only once for
!    --  each type definition of PO).
  
     type Static_Handler_Index is range 0 .. Integer'Last;
     subtype Positive_Static_Handler_Index is
--- 182,217 ----
  
     --  There are two kinds of protected objects that deal with interrupts:
  
!    --  (1) Only Interrupt_Handler pragmas are used. We need to be able to tell
!    --  if an Interrupt_Handler applies to a given procedure, so
     --  Register_Interrupt_Handler has to be called for all the potential
!    --  handlers, it should be done by calling Register_Interrupt_Handler with
!    --  the handler code address. On finalization, which can happen only has
!    --  part of library level finalization since PO with Interrupt_Handler
!    --  pragmas can only be declared at library level, nothing special needs to
!    --  be done since the default handlers have been restored as part of task
!    --  completion which is done just before global finalization.
!    --  Dynamic_Interrupt_Protection should be used in this case.
  
     --  (2) Attach_Handler pragmas are used, and possibly Interrupt_Handler
!    --  pragma. We need to attach the handlers to the given interrupts when the
!    --  objet is elaborated. This should be done by constructing an array of
!    --  pairs (interrupt, handler) from the pragmas and calling Install_Handlers
!    --  with it (types to be used are New_Handler_Item and New_Handler_Array).
!    --  On finalization, we need to restore the handlers that were installed
!    --  before the elaboration of the PO, so we need to store these previous
!    --  handlers. This is also done by Install_Handlers, the room for these
!    --  informations is provided by adding a discriminant which is the number
!    --  of Attach_Handler pragmas and an array of this size in the protection
!    --  type, Static_Interrupt_Protection.
  
     procedure Register_Interrupt_Handler
       (Handler_Addr : System.Address);
!    --  This routine should be called by the compiler to allow the handler be
!    --  used as an Interrupt Handler. That means call this procedure for each
!    --  pragma Interrup_Handler providing the address of the handler (not
!    --  including the pointer to the actual PO, this way this routine is called
!    --  only once for each type definition of PO).
  
     type Static_Handler_Index is range 0 .. Integer'Last;
     subtype Positive_Static_Handler_Index is
*************** package System.Interrupts is
*** 228,234 ****
        Handler   : Parameterless_Handler;
        Static    : Boolean;
     end record;
!    --  Contains all the information needed to restore a previous handler.
  
     type Previous_Handler_Array is array
       (Positive_Static_Handler_Index range <>) of Previous_Handler_Item;
--- 223,229 ----
        Handler   : Parameterless_Handler;
        Static    : Boolean;
     end record;
!    --  Contains all the information needed to restore a previous handler
  
     type Previous_Handler_Array is array
       (Positive_Static_Handler_Index range <>) of Previous_Handler_Item;
*************** package System.Interrupts is
*** 237,243 ****
        Interrupt : Interrupt_ID;
        Handler   : Parameterless_Handler;
     end record;
!    --  Contains all the information from an Attach_Handler pragma.
  
     type New_Handler_Array is
       array (Positive_Static_Handler_Index range <>) of New_Handler_Item;
--- 232,238 ----
        Interrupt : Interrupt_ID;
        Handler   : Parameterless_Handler;
     end record;
!    --  Contains all the information from an Attach_Handler pragma
  
     type New_Handler_Array is
       array (Positive_Static_Handler_Index range <>) of New_Handler_Item;
*************** package System.Interrupts is
*** 253,259 ****
  
     function Has_Interrupt_Or_Attach_Handler
       (Object : access Dynamic_Interrupt_Protection) return Boolean;
!    --  Returns True.
  
     --  Case (2)
  
--- 248,254 ----
  
     function Has_Interrupt_Or_Attach_Handler
       (Object : access Dynamic_Interrupt_Protection) return Boolean;
!    --  Returns True
  
     --  Case (2)
  
*************** package System.Interrupts is
*** 267,275 ****
       end record;
  
     function Has_Interrupt_Or_Attach_Handler
!      (Object : access Static_Interrupt_Protection)
!       return   Boolean;
!    --  Returns True.
  
     procedure Finalize (Object : in out Static_Interrupt_Protection);
     --  Restore previous handlers as required by C.3.1(12) then call
--- 262,269 ----
       end record;
  
     function Has_Interrupt_Or_Attach_Handler
!      (Object : access Static_Interrupt_Protection) return Boolean;
!    --  Returns True
  
     procedure Finalize (Object : in out Static_Interrupt_Protection);
     --  Restore previous handlers as required by C.3.1(12) then call
*************** package System.Interrupts is
*** 277,283 ****
  
     procedure Install_Handlers
       (Object       : access Static_Interrupt_Protection;
!       New_Handlers : in New_Handler_Array);
     --  Store the old handlers in Object.Previous_Handlers and install
     --  the new static handlers.
  
--- 271,277 ----
  
     procedure Install_Handlers
       (Object       : access Static_Interrupt_Protection;
!       New_Handlers : New_Handler_Array);
     --  Store the old handlers in Object.Previous_Handlers and install
     --  the new static handlers.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-dummy.adb gcc-4.1.0/gcc/ada/s-intman-dummy.adb
*** gcc-4.0.2/gcc/ada/s-intman-dummy.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-dummy.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,49 ****
  
  package body System.Interrupt_Management is
  
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
! 
!    --  Nothing needs to be done on this platform.
  
!    procedure Initialize_Interrupts is
     begin
        null;
!    end Initialize_Interrupts;
  
  end System.Interrupt_Management;
--- 35,47 ----
  
  package body System.Interrupt_Management is
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    procedure Initialize is
     begin
        null;
!    end Initialize;
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-irix-athread.adb gcc-4.1.0/gcc/ada/s-intman-irix-athread.adb
*** gcc-4.0.2/gcc/ada/s-intman-irix-athread.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-irix-athread.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  
  --  This is an Irix (old pthread library) version of this package.
  
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
  --  Make a careful study of all signals available under the OS,
  --  to see which need to be reserved, kept always unmasked,
  --  or kept always unmasked.
--- 34,39 ----
*************** with System.OS_Interface;
*** 49,54 ****
--- 46,52 ----
  
  with Interfaces.C;
  --  used for "int"
+ 
  package body System.Interrupt_Management is
  
     use System.OS_Interface;
*************** package body System.Interrupt_Management
*** 82,128 ****
     pragma Import
       (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
  
!    ----------------------
!    -- Notify_Exception --
!    ----------------------
! 
!    --  This function identifies the Ada exception to be raised using the
!    --  information when the system received a synchronous signal.
!    --  Since this function is machine and OS dependent, different code has to
!    --  be provided for different target.
!    --  On SGI, the signal handling is done is a-init.c, even when tasking is
!    --  involved.
! 
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
! 
!    --  Nothing needs to be done on this platform.
! 
!    procedure Initialize_Interrupts is
!    begin
!       null;
!    end Initialize_Interrupts;
  
! begin
!    declare
!       function State (Int : Interrupt_ID) return Character;
!       pragma Import (C, State, "__gnat_get_interrupt_state");
!       --  Get interrupt state.  Defined in a-init.c
!       --  The input argument is the interrupt number,
!       --  and the result is one of the following:
  
!       User    : constant Character := 'u';
!       Runtime : constant Character := 'r';
!       Default : constant Character := 's';
!       --    'n'   this interrupt not set by any Interrupt_State pragma
!       --    'u'   Interrupt_State pragma set state to User
!       --    'r'   Interrupt_State pragma set state to Runtime
!       --    's'   Interrupt_State pragma set state to System (use "default"
!       --           system handler)
  
        use Interfaces.C;
- 
     begin
        Abort_Task_Interrupt := Abort_Signal;
  
--- 80,106 ----
     pragma Import
       (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
  
!    function State (Int : Interrupt_ID) return Character;
!    pragma Import (C, State, "__gnat_get_interrupt_state");
!    --  Get interrupt state.  Defined in a-init.c
!    --  The input argument is the interrupt number,
!    --  and the result is one of the following:
  
!    User    : constant Character := 'u';
!    Runtime : constant Character := 'r';
!    Default : constant Character := 's';
!    --    'n'   this interrupt not set by any Interrupt_State pragma
!    --    'u'   Interrupt_State pragma set state to User
!    --    'r'   Interrupt_State pragma set state to Runtime
!    --    's'   Interrupt_State pragma set state to System (use "default"
!    --           system handler)
  
!    ----------------
!    -- Initialize --
!    ----------------
  
+    procedure Initialize is
        use Interfaces.C;
     begin
        Abort_Task_Interrupt := Abort_Signal;
  
*************** begin
*** 180,184 ****
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end;
  end System.Interrupt_Management;
--- 158,163 ----
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end Initialize;
! 
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-irix.adb gcc-4.1.0/gcc/ada/s-intman-irix.adb
*** gcc-4.0.2/gcc/ada/s-intman-irix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-irix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! ---                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  
  --  This is a SGI Pthread version of this package.
  
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
  --  Make a careful study of all signals available under the OS,
  --  to see which need to be reserved, kept always unmasked,
  --  or kept always unmasked.
--- 34,39 ----
*************** package body System.Interrupt_Management
*** 59,100 ****
        SIGSEGV, SIGSYS, SIGXCPU, SIGXFSZ, SIGPROF, SIGPTINTR, SIGPTRESCHED,
        SIGABRT, SIGPIPE);
  
-    ---------------------------
-    -- Initialize_Interrupts --
-    ---------------------------
- 
-    --  Nothing needs to be done on this platform
- 
-    procedure Initialize_Interrupts is
-    begin
-       null;
-    end Initialize_Interrupts;
- 
     Unreserve_All_Interrupts : Interfaces.C.int;
     pragma Import
       (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
  
!    use type Interfaces.C.int;
  
! begin
!    declare
!       function State (Int : Interrupt_ID) return Character;
!       pragma Import (C, State, "__gnat_get_interrupt_state");
  
!       --  Get interrupt state.  Defined in a-init.c
!       --  The input argument is the interrupt number,
!       --  and the result is one of the following:
  
!       User    : constant Character := 'u';
!       Runtime : constant Character := 'r';
!       Default : constant Character := 's';
!       --    'n'   this interrupt not set by any Interrupt_State pragma
!       --    'u'   Interrupt_State pragma set state to User
!       --    'r'   Interrupt_State pragma set state to Runtime
!       --    's'   Interrupt_State pragma set state to System (use "default"
!       --           system handler)
  
     begin
        Abort_Task_Interrupt := SIGABRT;
  
        --  Change this if you want to use another signal for task abort.
--- 56,95 ----
        SIGSEGV, SIGSYS, SIGXCPU, SIGXFSZ, SIGPROF, SIGPTINTR, SIGPTRESCHED,
        SIGABRT, SIGPIPE);
  
     Unreserve_All_Interrupts : Interfaces.C.int;
     pragma Import
       (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
  
!    function State (Int : Interrupt_ID) return Character;
!    pragma Import (C, State, "__gnat_get_interrupt_state");
  
!    --  Get interrupt state.  Defined in a-init.c
!    --  The input argument is the interrupt number,
!    --  and the result is one of the following:
  
!    User    : constant Character := 'u';
!    Runtime : constant Character := 'r';
!    Default : constant Character := 's';
!    --    'n'   this interrupt not set by any Interrupt_State pragma
!    --    'u'   Interrupt_State pragma set state to User
!    --    'r'   Interrupt_State pragma set state to Runtime
!    --    's'   Interrupt_State pragma set state to System (use "default"
!    --           system handler)
  
!    ----------------
!    -- Initialize --
!    ----------------
  
+    Initialized : Boolean := False;
+ 
+    procedure Initialize is
+       use type Interfaces.C.int;
     begin
+       if Initialized then
+          return;
+       end if;
+ 
+       Initialized := True;
        Abort_Task_Interrupt := SIGABRT;
  
        --  Change this if you want to use another signal for task abort.
*************** begin
*** 148,152 ****
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end;
  end System.Interrupt_Management;
--- 143,148 ----
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end Initialize;
! 
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-mingw.adb gcc-4.1.0/gcc/ada/s-intman-mingw.adb
*** gcc-4.0.2/gcc/ada/s-intman-mingw.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-mingw.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1991-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,78 ****
  
  --  This is the NT version of this package
  
- --  This file performs the system-dependent translation between machine
- --  exceptions and the Ada exceptions, if any, that should be raised when they
- --  occur.
- 
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
- --  See the other warnings in the package specification before making any
- --  modifications to this file.
- 
- --  Make a careful study of all signals available under the OS, to see which
- --  need to be reserved, kept always unmasked, or kept always unmasked. Be on
- --  the lookout for special signals that may be used by the thread library.
- 
  with System.OS_Interface; use System.OS_Interface;
  
  package body System.Interrupt_Management is
  
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
! 
!    --  Nothing needs to be done on this platform.
  
!    procedure Initialize_Interrupts is
     begin
!       null;
!    end Initialize_Interrupts;
  
! begin
!    --  "Reserve" all the interrupts, except those that are explicitely defined
  
!    for J in Interrupt_ID'Range loop
!       Reserve (J) := True;
!    end loop;
  
-    Reserve (SIGINT)  := False;
-    Reserve (SIGILL)  := False;
-    Reserve (SIGABRT) := False;
-    Reserve (SIGFPE)  := False;
-    Reserve (SIGSEGV) := False;
-    Reserve (SIGTERM) := False;
  end System.Interrupt_Management;
--- 33,61 ----
  
  --  This is the NT version of this package
  
  with System.OS_Interface; use System.OS_Interface;
  
  package body System.Interrupt_Management is
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    procedure Initialize is
     begin
!       --  "Reserve" all the interrupts, except those that are explicitely
!       --  defined.
  
!       for J in Interrupt_ID'Range loop
!          Reserve (J) := True;
!       end loop;
  
!       Reserve (SIGINT)  := False;
!       Reserve (SIGILL)  := False;
!       Reserve (SIGABRT) := False;
!       Reserve (SIGFPE)  := False;
!       Reserve (SIGSEGV) := False;
!       Reserve (SIGTERM) := False;
!    end Initialize;
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-posix.adb gcc-4.1.0/gcc/ada/s-intman-posix.adb
*** gcc-4.0.2/gcc/ada/s-intman-posix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-posix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,44 ****
  
  --  This is the POSIX threads version of this package
  
- --  PLEASE DO NOT add any dependences on other packages. ??? why not ???
- --  This package is designed to work with or without tasking support.
- 
- --  See the other warnings in the package specification before making
- --  any modifications to this file.
- 
  --  Make a careful study of all signals available under the OS, to see which
  --  need to be reserved, kept always unmasked, or kept always unmasked. Be on
  --  the lookout for special signals that may be used by the thread library.
--- 33,38 ----
*************** package body System.Interrupt_Management
*** 88,94 ****
     -- Local Subprograms --
     -----------------------
  
!    procedure Notify_Exception (signo : Signal);
     --  This function identifies the Ada exception to be raised using
     --  the information when the system received a synchronous signal.
     --  Since this function is machine and OS dependent, different code
--- 82,106 ----
     -- Local Subprograms --
     -----------------------
  
!    function State (Int : Interrupt_ID) return Character;
!    pragma Import (C, State, "__gnat_get_interrupt_state");
!    --  Get interrupt state. Defined in init.c
!    --  The input argument is the interrupt number,
!    --  and the result is one of the following:
! 
!    User    : constant Character := 'u';
!    Runtime : constant Character := 'r';
!    Default : constant Character := 's';
!    --    'n'   this interrupt not set by any Interrupt_State pragma
!    --    'u'   Interrupt_State pragma set state to User
!    --    'r'   Interrupt_State pragma set state to Runtime
!    --    's'   Interrupt_State pragma set state to System (use "default"
!    --           system handler)
! 
!    procedure Notify_Exception
!      (signo    : Signal;
!       siginfo  : System.Address;
!       ucontext : System.Address);
     --  This function identifies the Ada exception to be raised using
     --  the information when the system received a synchronous signal.
     --  Since this function is machine and OS dependent, different code
*************** package body System.Interrupt_Management
*** 101,107 ****
     Signal_Mask : aliased sigset_t;
     --  The set of signals handled by Notify_Exception
  
!    procedure Notify_Exception (signo : Signal) is
        Result  : Interfaces.C.int;
  
     begin
--- 113,136 ----
     Signal_Mask : aliased sigset_t;
     --  The set of signals handled by Notify_Exception
  
!    procedure Notify_Exception
!      (signo    : Signal;
!       siginfo  : System.Address;
!       ucontext : System.Address)
!    is
!       pragma Unreferenced (siginfo);
! 
!       --  The GCC unwinder requires adjustments to the signal's machine
!       --  context to be able to properly unwind through the signal handler.
!       --  This is achieved by the target specific subprogram below, provided
!       --  by init.c to be usable by the non-tasking handler also.
! 
!       procedure Adjust_Context_For_Raise
!         (signo    : Signal;
!          ucontext : System.Address);
!       pragma Import
!         (C, Adjust_Context_For_Raise, "__gnat_adjust_context_for_raise");
! 
        Result  : Interfaces.C.int;
  
     begin
*************** package body System.Interrupt_Management
*** 111,116 ****
--- 140,150 ----
        Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
        pragma Assert (Result = 0);
  
+       --  Perform the necessary context adjustments required by the GCC/ZCX
+       --  unwinder, harmless in the SJLJ case.
+ 
+       Adjust_Context_For_Raise (signo, ucontext);
+ 
        --  Check that treatment of exception propagation here
        --  is consistent with treatment of the abort signal in
        --  System.Task_Primitives.Operations.
*************** package body System.Interrupt_Management
*** 129,171 ****
        end case;
     end Notify_Exception;
  
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
! 
!    --  Nothing needs to be done on this platform.
! 
!    procedure Initialize_Interrupts is
!    begin
!       null;
!    end Initialize_Interrupts;
  
! -------------------------
! -- Package Elaboration --
! -------------------------
  
! begin
!    declare
        act     : aliased struct_sigaction;
        old_act : aliased struct_sigaction;
        Result  : System.OS_Interface.int;
  
!       function State (Int : Interrupt_ID) return Character;
!       pragma Import (C, State, "__gnat_get_interrupt_state");
!       --  Get interrupt state. Defined in a-init.c
!       --  The input argument is the interrupt number,
!       --  and the result is one of the following:
  
!       User    : constant Character := 'u';
!       Runtime : constant Character := 'r';
!       Default : constant Character := 's';
!       --    'n'   this interrupt not set by any Interrupt_State pragma
!       --    'u'   Interrupt_State pragma set state to User
!       --    'r'   Interrupt_State pragma set state to Runtime
!       --    's'   Interrupt_State pragma set state to System (use "default"
!       --           system handler)
  
-    begin
        --  Need to call pthread_init very early because it is doing signal
        --  initializations.
  
--- 163,186 ----
        end case;
     end Notify_Exception;
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    Initialized : Boolean := False;
  
!    procedure Initialize is
        act     : aliased struct_sigaction;
        old_act : aliased struct_sigaction;
        Result  : System.OS_Interface.int;
  
!    begin
!       if Initialized then
!          return;
!       end if;
  
!       Initialized := True;
  
        --  Need to call pthread_init very early because it is doing signal
        --  initializations.
  
*************** begin
*** 179,190 ****
  
        --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
        --  number argument to the handler when it is called. The set of extra
!       --  parameters typically includes a pointer to a structure describing
!       --  the interrupted context. Although the Notify_Exception handler does
!       --  not use this information, it is actually required for the GCC/ZCX
!       --  exception propagation scheme because on some targets (at least
!       --  alpha-tru64), the structure contents are not even filled when this
!       --  flag is not set.
  
        --  On some targets, we set sa_flags to SA_NODEFER so that during the
        --  handler execution we do not change the Signal_Mask to be masked for
--- 194,205 ----
  
        --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
        --  number argument to the handler when it is called. The set of extra
!       --  parameters includes a pointer to the interrupted context, which the
!       --  ZCX propagation scheme needs.
! 
!       --  Most man pages for sigaction mention that sa_sigaction should be set
!       --  instead of sa_handler when SA_SIGINFO is on.  In practice, the two
!       --  fields are actually union'ed and located at the same offset.
  
        --  On some targets, we set sa_flags to SA_NODEFER so that during the
        --  handler execution we do not change the Signal_Mask to be masked for
*************** begin
*** 281,285 ****
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end;
  end System.Interrupt_Management;
--- 296,301 ----
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end Initialize;
! 
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-solaris.adb gcc-4.1.0/gcc/ada/s-intman-solaris.adb
*** gcc-4.0.2/gcc/ada/s-intman-solaris.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-solaris.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,41 ****
  
  --  This is a Solaris version of this package.
  
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
  --  Make a careful study of all signals available under the OS,
  --  to see which need to be reserved, kept always unmasked,
  --  or kept always unmasked.
--- 33,38 ----
*************** package body System.Interrupt_Management
*** 63,68 ****
--- 60,80 ----
     pragma Import
       (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
  
+    function State (Int : Interrupt_ID) return Character;
+    pragma Import (C, State, "__gnat_get_interrupt_state");
+    --  Get interrupt state.  Defined in init.c
+    --  The input argument is the interrupt number,
+    --  and the result is one of the following:
+ 
+    User    : constant Character := 'u';
+    Runtime : constant Character := 'r';
+    Default : constant Character := 's';
+    --    'n'   this interrupt not set by any Interrupt_State pragma
+    --    'u'   Interrupt_State pragma set state to User
+    --    'r'   Interrupt_State pragma set state to Runtime
+    --    's'   Interrupt_State pragma set state to System (use "default"
+    --           system handler)
+ 
     ----------------------
     -- Notify_Exception --
     ----------------------
*************** package body System.Interrupt_Management
*** 86,93 ****
        info    : access siginfo_t;
        context : access ucontext_t)
     is
!       pragma Warnings (Off, context);
! 
     begin
        --  Check that treatment of exception propagation here
        --  is consistent with treatment of the abort signal in
--- 98,104 ----
        info    : access siginfo_t;
        context : access ucontext_t)
     is
!       pragma Unreferenced (context);
     begin
        --  Check that treatment of exception propagation here
        --  is consistent with treatment of the abort signal in
*************** package body System.Interrupt_Management
*** 121,164 ****
        end case;
     end Notify_Exception;
  
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
! 
!    --  Nothing needs to be done on this platform.
! 
!    procedure Initialize_Interrupts is
!    begin
!       null;
!    end Initialize_Interrupts;
  
! ----------------------------
! -- Package Initialization --
! ----------------------------
  
! begin
!    declare
        act     : aliased struct_sigaction;
        old_act : aliased struct_sigaction;
        mask    : aliased sigset_t;
        Result  : Interfaces.C.int;
  
-       function State (Int : Interrupt_ID) return Character;
-       pragma Import (C, State, "__gnat_get_interrupt_state");
-       --  Get interrupt state.  Defined in a-init.c
-       --  The input argument is the interrupt number,
-       --  and the result is one of the following:
-       --
-       User    : constant Character := 'u';
-       Runtime : constant Character := 'r';
-       Default : constant Character := 's';
-       --    'n'   this interrupt not set by any Interrupt_State pragma
-       --    'u'   Interrupt_State pragma set state to User
-       --    'r'   Interrupt_State pragma set state to Runtime
-       --    's'   Interrupt_State pragma set state to System (use "default"
-       --           system handler)
- 
     begin
        --  Need to call pthread_init very early because it is doing signal
        --  initializations.
  
--- 132,156 ----
        end case;
     end Notify_Exception;
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    Initialized : Boolean := False;
  
!    procedure Initialize is
        act     : aliased struct_sigaction;
        old_act : aliased struct_sigaction;
        mask    : aliased sigset_t;
        Result  : Interfaces.C.int;
  
     begin
+       if Initialized then
+          return;
+       end if;
+ 
+       Initialized := True;
+ 
        --  Need to call pthread_init very early because it is doing signal
        --  initializations.
  
*************** begin
*** 259,263 ****
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end;
  end System.Interrupt_Management;
--- 251,256 ----
        --  mark it as reserved.
  
        Reserve (0) := True;
!    end Initialize;
! 
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-vms.adb gcc-4.1.0/gcc/ada/s-intman-vms.adb
*** gcc-4.0.2/gcc/ada/s-intman-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-vms.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2002, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,60 ****
  
  --  This is a OpenVMS/Alpha version of this package.
  
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
- --  See the other warnings in the package specification before making
- --  any modifications to this file.
- 
  with System.OS_Interface;
  --  used for various Constants, Signal and types
  
  package body System.Interrupt_Management is
  
!    use System.OS_Interface;
!    use type unsigned_long;
  
!    ---------------------------
!    -- Initialize_Interrupts --
!    ---------------------------
  
!    procedure Initialize_Interrupts is
        Status : Cond_Value_Type;
  
     begin
        Sys_Crembx
          (Status => Status,
           Prmflg => False,
--- 33,66 ----
  
  --  This is a OpenVMS/Alpha version of this package.
  
  with System.OS_Interface;
  --  used for various Constants, Signal and types
  
  package body System.Interrupt_Management is
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    Initialized : Boolean := False;
  
!    procedure Initialize is
!       use System.OS_Interface;
!       use type unsigned_long;
        Status : Cond_Value_Type;
  
     begin
+       if Initialized then
+          return;
+       end if;
+ 
+       Initialized := True;
+       Abort_Task_Interrupt := Interrupt_ID_0;
+       --  Unused
+ 
+       Reserve := Reserve or Keep_Unmasked or Keep_Masked;
+       Reserve (Interrupt_ID_0) := True;
+ 
        Sys_Crembx
          (Status => Status,
           Prmflg => False,
*************** package body System.Interrupt_Management
*** 63,69 ****
           Bufquo => Interrupt_Bufquo,
           Lognam => "GNAT_Interrupt_Mailbox",
           Flags  => CMB_M_READONLY);
- 
        pragma Assert ((Status and 1) = 1);
  
        Sys_Assign
--- 69,74 ----
*************** package body System.Interrupt_Management
*** 71,88 ****
           Devnam => "GNAT_Interrupt_Mailbox",
           Chan   => Snd_Interrupt_Chan,
           Flags  => AGN_M_WRITEONLY);
- 
        pragma Assert ((Status and 1) = 1);
!    end Initialize_Interrupts;
! 
! begin
!    --  Unused
! 
!    Abort_Task_Interrupt := Interrupt_ID_0;
! 
!    Reserve := Reserve or Keep_Unmasked or Keep_Masked;
! 
!    Reserve (Interrupt_ID_0) := True;
  
-    Initialize_Interrupts;
  end System.Interrupt_Management;
--- 76,82 ----
           Devnam => "GNAT_Interrupt_Mailbox",
           Chan   => Snd_Interrupt_Chan,
           Flags  => AGN_M_WRITEONLY);
        pragma Assert ((Status and 1) = 1);
!    end Initialize;
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-vms.ads gcc-4.1.0/gcc/ada/s-intman-vms.ads
*** gcc-4.0.2/gcc/ada/s-intman-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-vms.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,68 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version of this package.
! --
! --  This package encapsulates and centralizes information about
! --  all uses of interrupts (or signals), including the
! --  target-dependent mapping of interrupts (or signals) to exceptions.
  
! --  PLEASE DO NOT add any with-clauses to this package.
! --  This is designed to work for both tasking and non-tasking systems,
! --  without pulling in any of the tasking support.
  
! --  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
! --  Elaboration of this package should happen early, as most other
! --  initializations depend on it.
! --  Forcing immediate elaboration of the body also helps to enforce
! --  the design assumption that this is a second-level
! --  package, just one level above System.OS_Interface, with no
! --  cross-dependences.
  
! --  PLEASE DO NOT put any subprogram declarations with arguments of
! --  type Interrupt_ID into the visible part of this package.
! --  The type Interrupt_ID is used to derive the type in Ada.Interrupts,
! --  and adding more operations to that type would be illegal according
! --  to the Ada Reference Manual.  (This is the reason why the signals sets
! --  below are implemented as visible arrays rather than functions.)
  
  with System.OS_Interface;
  --  used for Signal
  --           sigset_t
  
  package System.Interrupt_Management is
! 
!    pragma Elaborate_Body;
  
     type Interrupt_Mask is limited private;
  
--- 31,58 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the Alpha/VMS version of this package
  
! --  This package encapsulates and centralizes information about all uses of
! --  interrupts (or signals), including the target-dependent mapping of
! --  interrupts (or signals) to exceptions.
  
! --  PLEASE DO NOT add any with-clauses to this package
  
! --  PLEASE DO NOT put any subprogram declarations with arguments of type
! --  Interrupt_ID into the visible part of this package.
! 
! --  The type Interrupt_ID is used to derive the type in Ada.Interrupts, and
! --  adding more operations to that type would be illegal according to the Ada
! --  Reference Manual. (This is the reason why the signals sets below are
! --  implemented as visible arrays rather than functions.)
  
  with System.OS_Interface;
  --  used for Signal
  --           sigset_t
  
  package System.Interrupt_Management is
!    pragma Preelaborate;
  
     type Interrupt_Mask is limited private;
  
*************** package System.Interrupt_Management is
*** 70,127 ****
  
     type Interrupt_Set is array (Interrupt_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized
!    --  in the body to aid portability.  This permits us
!    --  to use more portable names for interrupts,
!    --  where distinct names may map to the same interrupt ID value.
!    --  For example, suppose SIGRARE is a signal that is not defined on
!    --  all systems, but is always reserved when it is defined.
!    --  If we have the convention that ID zero is not used for any "real"
!    --  signals, and SIGRARE = 0 when SIGRARE is not one of the locally
!    --  supported signals, we can write
     --     Reserved (SIGRARE) := true;
!    --  and the initialization code will be portable.
  
     Abort_Task_Interrupt : Interrupt_ID;
!    --  The interrupt that is used to implement task abortion,
!    --  if an interrupt is used for that purpose.
!    --  This is one of the reserved interrupts.
  
     Keep_Unmasked : Interrupt_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the interrupt I is
!    --  one that must be kept unmasked at all times,
!    --  except (perhaps) for short critical sections.
!    --  This includes interrupts that are mapped to exceptions
!    --  (see System.Interrupt_Exceptions.Is_Exception), but may also
!    --  include interrupts (e.g. timer) that need to be kept unmasked
!    --  for other reasons.
!    --  Where interrupts are implemented as OS signals, and signal masking
!    --  is per-task, the interrupt should be unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that
!    --  cannot be permitted to be attached to a user handler.
!    --  The possible reasons are many.  For example,
!    --  it may be mapped to an exception, used to implement task abortion,
!    --  or used to implement time delays.
  
     Keep_Masked : Interrupt_Set := (others => False);
     --  Keep_Masked (I) is true iff the interrupt I must always be masked.
!    --  Where interrupts are implemented as OS signals, and signal masking
!    --  is per-task, the interrupt should be masked in ALL TASKS.
!    --  There might not be any interrupts in this class, depending on
!    --  the environment.  For example, if interrupts are OS signals
!    --  and signal masking is per-task, use of the sigwait operation
!    --  requires the signal be masked in all tasks.
  
!    procedure Initialize_Interrupts;
!    --  On systems where there is no signal inheritance between tasks (e.g
!    --  VxWorks, GNU/LinuxThreads), this procedure is used to initialize
!    --  interrupts handling in each task. Otherwise this function should
!    --  only be called by initialize in this package body.
  
  private
- 
     use type System.OS_Interface.unsigned_long;
  
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
--- 60,110 ----
  
     type Interrupt_Set is array (Interrupt_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized in the
!    --  body to aid portability. This permits us to use more portable names for
!    --  interrupts, where distinct names may map to the same interrupt ID
!    --  value. For example, suppose SIGRARE is a signal that is not defined on
!    --  all systems, but is always reserved when it is defined. If we have the
!    --  convention that ID zero is not used for any "real" signals, and SIGRARE
!    --  = 0 when SIGRARE is not one of the locally supported signals, we can
!    --  write
! 
     --     Reserved (SIGRARE) := true;
! 
!    --  Then the initialization code will be portable
  
     Abort_Task_Interrupt : Interrupt_ID;
!    --  The interrupt that is used to implement task abort, if an interrupt is
!    --  used for that purpose. This is one of the reserved interrupts.
  
     Keep_Unmasked : Interrupt_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the interrupt I is one that must be kept
!    --  unmasked at all times, except (perhaps) for short critical sections.
!    --  This includes interrupts that are mapped to exceptions (see
!    --  System.Interrupt_Exceptions.Is_Exception), but may also include
!    --  interrupts (e.g. timer) that need to be kept unmasked for other
!    --  reasons. Where interrupts are implemented as OS signals, and signal
!    --  masking is per-task, the interrupt should be unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that cannot be permitted
!    --  to be attached to a user handler. The possible reasons are many. For
!    --  example it may be mapped to an exception used to implement task abort.
  
     Keep_Masked : Interrupt_Set := (others => False);
     --  Keep_Masked (I) is true iff the interrupt I must always be masked.
!    --  Where interrupts are implemented as OS signals, and signal masking is
!    --  per-task, the interrupt should be masked in ALL TASKS. There might not
!    --  be any interrupts in this class, depending on the environment. For
!    --  example, if interrupts are OS signals and signal masking is per-task,
!    --  use of the sigwait operation requires the signal be masked in all tasks.
  
!    procedure Initialize;
!    --  Initialize the various variables defined in this package.
!    --  This procedure must be called before accessing any object from this
!    --  package and can be called multiple times.
  
  private
     use type System.OS_Interface.unsigned_long;
  
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
*************** private
*** 136,142 ****
     Rcv_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
     Snd_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
     Interrupt_Mailbox  : Interrupt_ID := 0;
!    Interrupt_Bufquo   : System.OS_Interface.unsigned_long
!                         := 1000 * (Interrupt_ID'Size / 8);
  
  end System.Interrupt_Management;
--- 119,125 ----
     Rcv_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
     Snd_Interrupt_Chan : System.OS_Interface.unsigned_short := 0;
     Interrupt_Mailbox  : Interrupt_ID := 0;
!    Interrupt_Bufquo   : System.OS_Interface.unsigned_long :=
!                           1000 * (Interrupt_ID'Size / 8);
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-vxworks.adb gcc-4.1.0/gcc/ada/s-intman-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-intman-vxworks.adb	Wed Dec  8 11:24:38 2004
--- gcc-4.1.0/gcc/ada/s-intman-vxworks.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . I N T E R R U P T _ M A N A G E M E N T          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,47 ****
  
  --  This is the VxWorks version of this package.
  
- --  It is likely to need tailoring to fit each operating system
- --  and machine architecture.
- 
- --  PLEASE DO NOT add any dependences on other packages.
- --  This package is designed to work with or without tasking support.
- 
- --  See the other warnings in the package specification before making
- --  any modifications to this file.
- 
  --  Make a careful study of all signals available under the OS,
  --  to see which need to be reserved, kept always unmasked,
  --  or kept always unmasked.
--- 33,38 ----
*************** package body System.Interrupt_Management
*** 62,71 ****
     Exception_Signals : constant Signal_List (1 .. 4) :=
                           (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
  
-    --  Keep these variables global so that they are initialized only once
-    --  What are "these variables" ???, I see only one
- 
     Exception_Action : aliased struct_sigaction;
  
     procedure Map_And_Raise_Exception (signo : Signal);
     pragma Import (C, Map_And_Raise_Exception, "__gnat_map_signal");
--- 53,60 ----
     Exception_Signals : constant Signal_List (1 .. 4) :=
                           (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
  
     Exception_Action : aliased struct_sigaction;
+    --  Keep this variable global so that it is initialized only once
  
     procedure Map_And_Raise_Exception (signo : Signal);
     pragma Import (C, Map_And_Raise_Exception, "__gnat_map_signal");
*************** package body System.Interrupt_Management
*** 76,81 ****
--- 65,84 ----
     -- Local Subprograms --
     -----------------------
  
+    function State (Int : Interrupt_ID) return Character;
+    pragma Import (C, State, "__gnat_get_interrupt_state");
+    --  Get interrupt state.  Defined in init.c
+    --  The input argument is the interrupt number,
+    --  and the result is one of the following:
+ 
+    Runtime : constant Character := 'r';
+    Default : constant Character := 's';
+    --    'n'   this interrupt not set by any Interrupt_State pragma
+    --    'u'   Interrupt_State pragma set state to User
+    --    'r'   Interrupt_State pragma set state to Runtime
+    --    's'   Interrupt_State pragma set state to System (use "default"
+    --           system handler)
+ 
     procedure Notify_Exception (signo : Signal);
     --  Identify the Ada exception to be raised using
     --  the information when the system received a synchronous signal.
*************** package body System.Interrupt_Management
*** 108,114 ****
     procedure Initialize_Interrupts is
        Result  : int;
        old_act : aliased struct_sigaction;
- 
     begin
        for J in Exception_Signals'Range loop
           Result :=
--- 111,116 ----
*************** package body System.Interrupt_Management
*** 119,145 ****
        end loop;
     end Initialize_Interrupts;
  
! begin
!    declare
!       mask   : aliased sigset_t;
!       Result : int;
! 
!       function State (Int : Interrupt_ID) return Character;
!       pragma Import (C, State, "__gnat_get_interrupt_state");
!       --  Get interrupt state.  Defined in a-init.c
!       --  The input argument is the interrupt number,
!       --  and the result is one of the following:
  
!       Runtime : constant Character := 'r';
!       Default : constant Character := 's';
!       --    'n'   this interrupt not set by any Interrupt_State pragma
!       --    'u'   Interrupt_State pragma set state to User
!       --    'r'   Interrupt_State pragma set state to Runtime
!       --    's'   Interrupt_State pragma set state to System (use "default"
!       --           system handler)
  
     begin
!       --  Initialize signal handling
  
        --  Change this if you want to use another signal for task abort.
        --  SIGTERM might be a good one.
--- 121,141 ----
        end loop;
     end Initialize_Interrupts;
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    Initialized : Boolean := False;
  
+    procedure Initialize is
+       mask   : aliased sigset_t;
+       Result : int;
     begin
!       if Initialized then
!          return;
!       end if;
! 
!       Initialized := True;
  
        --  Change this if you want to use another signal for task abort.
        --  SIGTERM might be a good one.
*************** begin
*** 179,183 ****
        --  The abort signal must also be unmasked
  
        Keep_Unmasked (Abort_Task_Signal) := True;
!    end;
  end System.Interrupt_Management;
--- 175,180 ----
        --  The abort signal must also be unmasked
  
        Keep_Unmasked (Abort_Task_Signal) := True;
!    end Initialize;
! 
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman-vxworks.ads gcc-4.1.0/gcc/ada/s-intman-vxworks.ads
*** gcc-4.0.2/gcc/ada/s-intman-vxworks.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-intman-vxworks.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VxWorks version of this package.
  
  --  This package encapsulates and centralizes information about all
  --  uses of interrupts (or signals), including the target-dependent
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the VxWorks version of this package
  
  --  This package encapsulates and centralizes information about all
  --  uses of interrupts (or signals), including the target-dependent
***************
*** 40,52 ****
  --  Unlike the original design, System.Interrupt_Management can only
  --  be used for tasking systems.
  
- --  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
- --  Elaboration of this package should happen early, as most other
- --  initializations depend on it. Forcing immediate elaboration of
- --  the body also helps to enforce the design assumption that this
- --  is a second-level package, just one level above System.OS_Interface
- --  with no cross-dependencies.
- 
  --  PLEASE DO NOT put any subprogram declarations with arguments of
  --  type Interrupt_ID into the visible part of this package. The type
  --  Interrupt_ID is used to derive the type in Ada.Interrupts, and
--- 40,45 ----
*************** with Interfaces.C;
*** 61,68 ****
  --  used for int
  
  package System.Interrupt_Management is
! 
!    pragma Elaborate_Body;
  
     type Interrupt_Mask is limited private;
  
--- 54,60 ----
  --  used for int
  
  package System.Interrupt_Management is
!    pragma Preelaborate;
  
     type Interrupt_Mask is limited private;
  
*************** package System.Interrupt_Management is
*** 76,123 ****
  
     type Signal_Set is array (Signal_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized
!    --  in the body to aid portability.  This permits us to use more
!    --  portable names for interrupts, where distinct names may map to
!    --  the same interrupt ID value.
!    --
!    --  For example, suppose SIGRARE is a signal that is not defined on
!    --  all systems, but is always reserved when it is defined. If we
!    --  have the convention that ID zero is not used for any "real"
!    --  signals, and SIGRARE = 0 when SIGRARE is not one of the locally
!    --  supported signals, we can write
     --     Reserved (SIGRARE) := true;
     --  and the initialization code will be portable.
  
     Abort_Task_Signal : Signal_ID;
!    --  The signal that is used to implement task abortion if
!    --  an interrupt is used for that purpose. This is one of the
!    --  reserved signals.
  
     Keep_Unmasked : Signal_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the signal I is one that must
!    --  that must be kept unmasked at all times, except (perhaps) for
!    --  short critical sections. This includes signals that are
!    --  mapped to exceptions, but may also include interrupts
!    --  (e.g. timer) that need to be kept unmasked for other
!    --  reasons. Where signal masking is per-task, the signal should be
     --  unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that cannot be
!    --  permitted to be attached to a user handler. The possible reasons
!    --  are many. For example, it may be mapped to an exception used to
!    --  implement task abortion, or used to implement time delays.
  
     procedure Initialize_Interrupts;
!    --  On systems where there is no signal inheritance between tasks (e.g
!    --  VxWorks, GNU/LinuxThreads), this procedure is used to initialize
!    --  interrupts handling in each task. Otherwise this function should
!    --  only be called by initialize in this package body.
  
  private
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
!    --  In some implementation Interrupt_Mask can be represented
!    --  as a linked list.
  
  end System.Interrupt_Management;
--- 68,119 ----
  
     type Signal_Set is array (Signal_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized in the
!    --  body to aid portability. This permits us to use more portable names for
!    --  interrupts, where distinct names may map to the same interrupt ID
!    --  value.
! 
!    --  For example, suppose SIGRARE is a signal that is not defined on all
!    --  systems, but is always reserved when it is defined. If we have the
!    --  convention that ID zero is not used for any "real" signals, and SIGRARE
!    --  = 0 when SIGRARE is not one of the locally supported signals, we can
!    --  write:
! 
     --     Reserved (SIGRARE) := true;
+ 
     --  and the initialization code will be portable.
  
     Abort_Task_Signal : Signal_ID;
!    --  The signal that is used to implement task abort if an interrupt is used
!    --  for that purpose. This is one of the reserved signals.
  
     Keep_Unmasked : Signal_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the signal I is one that must that must
!    --  be kept unmasked at all times, except (perhaps) for short critical
!    --  sections. This includes signals that are mapped to exceptions, but may
!    --  also include interrupts (e.g. timer) that need to be kept unmasked for
!    --  other reasons. Where signal masking is per-task, the signal should be
     --  unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that cannot be permitted
!    --  to be attached to a user handler. The possible reasons are many. For
!    --  example, it may be mapped to an exception used to implement task abort,
!    --  or used to implement time delays.
  
     procedure Initialize_Interrupts;
!    --  Under VxWorks, there is no signal inheritance between tasks.
!    --  This procedure is used to initialize signal-to-exception mapping in
!    --  each task.
! 
!    procedure Initialize;
!    --  Initialize the various variables defined in this package.
!    --  This procedure must be called before accessing any object from this
!    --  package and can be called multiple times.
  
  private
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
!    --  In some implementation Interrupt_Mask can be represented as a linked
!    --  list.
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-intman.ads gcc-4.1.0/gcc/ada/s-intman.ads
*** gcc-4.0.2/gcc/ada/s-intman.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-intman.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --            S Y S T E M . I N T E R R U P T _ M A N A G E M E N T         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,56 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package encapsulates and centralizes information about all
! --  uses of interrupts (or signals), including the target-dependent
! --  mapping of interrupts (or signals) to exceptions.
! 
! --  Unlike the original design, System.Interrupt_Management can only
! --  be used for tasking systems.
  
! --  PLEASE DO NOT remove the Elaborate_Body pragma from this package.
! --  Elaboration of this package should happen early, as most other
! --  initializations depend on it. Forcing immediate elaboration of
! --  the body also helps to enforce the design assumption that this
! --  is a second-level package, just one level above System.OS_Interface
! --  with no cross-dependencies.
  
! --  PLEASE DO NOT put any subprogram declarations with arguments of
! --  type Interrupt_ID into the visible part of this package. The type
! --  Interrupt_ID is used to derive the type in Ada.Interrupts, and
! --  adding more operations to that type would be illegal according
! --  to the Ada Reference Manual. This is the reason why the signals
! --  sets are implemeneted using visible arrays rather than functions.
  
  with System.OS_Interface;
  --  used for sigset_t
--- 31,49 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package encapsulates and centralizes information about all uses of
! --  interrupts (or signals), including the target-dependent mapping of
! --  interrupts (or signals) to exceptions.
  
! --  Unlike the original design, System.Interrupt_Management can only be used
! --  for tasking systems.
  
! --  PLEASE DO NOT put any subprogram declarations with arguments of type
! --  Interrupt_ID into the visible part of this package. The type Interrupt_ID
! --  is used to derive the type in Ada.Interrupts, and adding more operations
! --  to that type would be illegal according to the Ada Reference Manual. This
! --  is the reason why the signals sets are implemeneted using visible arrays
! --  rather than functions.
  
  with System.OS_Interface;
  --  used for sigset_t
*************** with Interfaces.C;
*** 59,66 ****
  --  used for int
  
  package System.Interrupt_Management is
! 
!    pragma Elaborate_Body;
  
     type Interrupt_Mask is limited private;
  
--- 52,58 ----
  --  used for int
  
  package System.Interrupt_Management is
!    pragma Preelaborate;
  
     type Interrupt_Mask is limited private;
  
*************** package System.Interrupt_Management is
*** 69,117 ****
  
     type Interrupt_Set is array (Interrupt_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized
!    --  in the body to aid portability.  This permits us to use more
!    --  portable names for interrupts, where distinct names may map to
!    --  the same interrupt ID value.
!    --
!    --  For example, suppose SIGRARE is a signal that is not defined on
!    --  all systems, but is always reserved when it is defined. If we
!    --  have the convention that ID zero is not used for any "real"
!    --  signals, and SIGRARE = 0 when SIGRARE is not one of the locally
!    --  supported signals, we can write
!    --     Reserved (SIGRARE) := true;
     --  and the initialization code will be portable.
  
     Abort_Task_Interrupt : Interrupt_ID;
!    --  The interrupt that is used to implement task abortion if
!    --  an interrupt is used for that purpose. This is one of the
!    --  reserved interrupts.
  
     Keep_Unmasked : Interrupt_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the interrupt I is one that must
!    --  that must be kept unmasked at all times, except (perhaps) for
!    --  short critical sections. This includes interrupts that are
!    --  mapped to exceptions (see System.Interrupt_Exceptions.Is_Exception),
!    --  but may also include interrupts (e.g. timer) that need to be kept
!    --  unmasked for other reasons. Where interrupts are implemented as
!    --  OS signals, and signal masking is per-task, the interrupt should
!    --  be unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that cannot be
!    --  permitted to be attached to a user handler. The possible reasons
!    --  are many. For example, it may be mapped to an exception used to
!    --  implement task abortion, or used to implement time delays.
  
!    procedure Initialize_Interrupts;
!    --  On systems where there is no signal inheritance between tasks (e.g
!    --  VxWorks, GNU/LinuxThreads), this procedure is used to initialize
!    --  interrupts handling in each task. Otherwise this function should
!    --  only be called by initialize in this package body.
  
  private
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
!    --  In some implementation Interrupt_Mask can be represented
!    --  as a linked list.
  
  end System.Interrupt_Management;
--- 61,108 ----
  
     type Interrupt_Set is array (Interrupt_ID) of Boolean;
  
!    --  The following objects serve as constants, but are initialized in the
!    --  body to aid portability. This permits us to use more portable names for
!    --  interrupts, where distinct names may map to the same interrupt ID
!    --  value.
! 
!    --  For example, suppose SIGRARE is a signal that is not defined on all
!    --  systems, but is always reserved when it is defined. If we have the
!    --  convention that ID zero is not used for any "real" signals, and SIGRARE
!    --  = 0 when SIGRARE is not one of the locally supported signals, we can
!    --  write
! 
!    --     Reserved (SIGRARE) := True;
! 
     --  and the initialization code will be portable.
  
     Abort_Task_Interrupt : Interrupt_ID;
!    --  The interrupt that is used to implement task abort if an interrupt is
!    --  used for that purpose. This is one of the reserved interrupts.
  
     Keep_Unmasked : Interrupt_Set := (others => False);
!    --  Keep_Unmasked (I) is true iff the interrupt I is one that must that
!    --  must be kept unmasked at all times, except (perhaps) for short critical
!    --  sections. This includes interrupts that are mapped to exceptions (see
!    --  System.Interrupt_Exceptions.Is_Exception), but may also include
!    --  interrupts (e.g. timer) that need to be kept unmasked for other
!    --  reasons. Where interrupts are implemented as OS signals, and signal
!    --  masking is per-task, the interrupt should be unmasked in ALL TASKS.
  
     Reserve : Interrupt_Set := (others => False);
!    --  Reserve (I) is true iff the interrupt I is one that cannot be permitted
!    --  to be attached to a user handler. The possible reasons are many. For
!    --  example, it may be mapped to an exception used to implement task abort,
!    --  or used to implement time delays.
  
!    procedure Initialize;
!    --  Initialize the various variables defined in this package.
!    --  This procedure must be called before accessing any object from this
!    --  package, and can be called multiple times.
  
  private
     type Interrupt_Mask is new System.OS_Interface.sigset_t;
!    --  In some implementations Interrupt_Mask can be represented as a linked
!    --  list.
  
  end System.Interrupt_Management;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-io.adb gcc-4.1.0/gcc/ada/s-io.adb
*** gcc-4.0.2/gcc/ada/s-io.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-io.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                            S Y S T E M . I O                             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                            S Y S T E M . I O                             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-io.ads gcc-4.1.0/gcc/ada/s-io.ads
*** gcc-4.0.2/gcc/ada/s-io.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-io.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1998 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  --  for character, integer, string and a new line function
  
  package System.IO is
! pragma Preelaborate (IO);
  
     procedure Put (X : Integer);
  
--- 37,43 ----
  --  for character, integer, string and a new line function
  
  package System.IO is
!    pragma Preelaborate;
  
     procedure Put (X : Integer);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-maccod.ads gcc-4.1.0/gcc/ada/s-maccod.ads
*** gcc-4.0.2/gcc/ada/s-maccod.ads	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/s-maccod.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  for full details.
  
  package System.Machine_Code is
! pragma Pure (Machine_Code);
  
     type Asm_Input_Operand  is private;
     type Asm_Output_Operand is private;
--- 36,42 ----
  --  for full details.
  
  package System.Machine_Code is
!    pragma Pure;
  
     type Asm_Input_Operand  is private;
     type Asm_Output_Operand is private;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mantis.adb gcc-4.1.0/gcc/ada/s-mantis.adb
*** gcc-4.0.2/gcc/ada/s-mantis.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-mantis.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . M A N T I S S A                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . M A N T I S S A                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mantis.ads gcc-4.1.0/gcc/ada/s-mantis.ads
*** gcc-4.0.2/gcc/ada/s-mantis.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-mantis.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . M A N T I S S A                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . M A N T I S S A                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  fixed-point type with non-static bounds.
  
  package System.Mantissa is
! pragma Pure (Mantissa);
  
     function Mantissa_Value (First, Last : Integer) return Natural;
     --  Compute Mantissa value from the given arguments, which are the First
--- 35,41 ----
  --  fixed-point type with non-static bounds.
  
  package System.Mantissa is
!    pragma Pure;
  
     function Mantissa_Value (First, Last : Integer) return Natural;
     --  Compute Mantissa value from the given arguments, which are the First
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop-irix.adb gcc-4.1.0/gcc/ada/s-mastop-irix.adb
*** gcc-4.0.2/gcc/ada/s-mastop-irix.adb	Mon Jul 26 10:41:42 2004
--- gcc-4.1.0/gcc/ada/s-mastop-irix.adb	Mon Sep  5 07:46:59 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                         (Version for IRIX/MIPS)                          --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                         (Version for IRIX/MIPS)                          --
  --                                                                          --
! --          Copyright (C) 1999-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Unchecked_Conversion;
*** 44,50 ****
  package body System.Machine_State_Operations is
  
     use System.Storage_Elements;
-    use System.Exceptions;
  
     --  The exc_unwind function in libexc operats on a Sigcontext
  
--- 44,49 ----
*************** package body System.Machine_State_Operat
*** 182,247 ****
          (Memory.Alloc (Sigcontext'Max_Size_In_Storage_Elements));
     end Allocate_Machine_State;
  
-    -------------------
-    -- Enter_Handler --
-    -------------------
- 
-    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-       pragma Warnings (Off, M);
-       pragma Warnings (Off, Handler);
- 
-       LOADI : constant String (1 .. 2) := 'l' & LSC;
-       --  This is "lw" in o32 mode, and "ld" in n32/n64 mode
- 
-       LOADF : constant String (1 .. 4) := 'l' & LSC & "c1";
-       --  This is "lwc1" in o32 mode and "ldc1" in n32/n64 mode
- 
-    begin
-       --  Restore integer registers from machine state. Note that we know
-       --  that $4 points to M, and $5 points to Handler, since this is
-       --  the standard calling sequence
- 
-       Asm (LOADI & " $16,  16*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $17,  17*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $18,  18*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $19,  19*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $20,  20*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $21,  21*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $22,  22*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $23,  23*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $24,  24*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $25,  25*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $26,  26*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $27,  27*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $28,  28*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $29,  29*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $30,  30*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
-       Asm (LOADI & " $31,  31*8+" & Roff & "+" & SC_Regs_Pos & "($4)");
- 
-       --  Restore floating-point registers from machine state
- 
-       Asm (LOADF & " $f16, 16*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f17, 17*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f18, 18*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f19, 19*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f20, 20*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f21, 21*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f22, 22*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f23, 23*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f24, 24*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f25, 25*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f26, 26*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f27, 27*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f28, 28*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f29, 29*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f30, 30*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
-       Asm (LOADF & " $f31, 31*8+" & Roff & "+" & SC_Fpregs_Pos & "($4)");
- 
-       --  Jump directly to the handler
- 
-       Asm ("jr  $5");
-    end Enter_Handler;
- 
     ----------------
     -- Fetch_Code --
     ----------------
--- 181,186 ----
*************** package body System.Machine_State_Operat
*** 284,315 ****
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame
!      (M    : Machine_State;
!       Info : Subprogram_Info_Type)
!    is
!       pragma Warnings (Off, Info);
! 
        Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
  
        procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
        pragma Import (C, Exc_Unwind, "exc_unwind");
  
!       --  ??? Calling exc_unwind in the current setup does not work and
!       --  triggers the emission of system warning messages. Why it does
!       --  not work remains to be investigated. Part of the problem is
!       --  probably a section naming issue (e.g. .eh_frame/.debug_frame).
! 
!       --  Instead of letting the call take place for nothing and emit
!       --  messages we don't expect, we just arrange things to pretend it
!       --  occurred and failed.
! 
!       --  ??? Until this is fixed, we shall document that the backtrace
!       --  computation facility does not work, and we inhibit the pragma below
!       --  because we arrange for the call not to be emitted and the linker
!       --  complains when a library is linked in but resolves nothing.
! 
!       --  pragma Linker_Options ("-lexc");
  
     begin
        --  exc_unwind is apparently not thread-safe under IRIX, so protect it
--- 223,235 ----
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame (M : Machine_State) is
        Scp : constant Sigcontext_Ptr := To_Sigcontext_Ptr (M);
  
        procedure Exc_Unwind (Scp : Sigcontext_Ptr; Fde : Long_Integer := 0);
        pragma Import (C, Exc_Unwind, "exc_unwind");
  
!       pragma Linker_Options ("-lexc");
  
     begin
        --  exc_unwind is apparently not thread-safe under IRIX, so protect it
*************** package body System.Machine_State_Operat
*** 319,329 ****
  
        Lock_Task.all;
  
!       if False then
!          Exc_Unwind (Scp);
!       else
!          Scp.SC_PC := 0;
!       end if;
  
        Unlock_Task.all;
  
--- 239,245 ----
  
        Lock_Task.all;
  
!       Exc_Unwind (Scp);
  
        Unlock_Task.all;
  
*************** package body System.Machine_State_Operat
*** 425,446 ****
        --  This pop operation will properly set the PC value in the machine
        --  state, so there is no need to save PC in the above code.
  
!       Pop_Frame (M, Set_Machine_State'Address);
     end Set_Machine_State;
  
-    ------------------------------
-    -- Set_Signal_Machine_State --
-    ------------------------------
- 
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address)
-    is
-       pragma Warnings (Off, M);
-       pragma Warnings (Off, Context);
- 
-    begin
-       null;
-    end Set_Signal_Machine_State;
- 
  end System.Machine_State_Operations;
--- 341,347 ----
        --  This pop operation will properly set the PC value in the machine
        --  state, so there is no need to save PC in the above code.
  
!       Pop_Frame (M);
     end Set_Machine_State;
  
  end System.Machine_State_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop-tru64.adb gcc-4.1.0/gcc/ada/s-mastop-tru64.adb
*** gcc-4.0.2/gcc/ada/s-mastop-tru64.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-mastop-tru64.adb	Tue Nov 15 13:51:09 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                         (Version for Alpha/Dec Unix)                     --
  --                                                                          --
! --           Copyright (C) 1999-2003 Ada Core Technologies, 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                         (Version for Alpha/Dec Unix)                     --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Memory;
*** 39,46 ****
  
  package body System.Machine_State_Operations is
  
-    use System.Exceptions;
- 
     pragma Linker_Options ("-lexc");
     --  Needed for definitions of exc_capture_context and exc_virtual_unwind
  
--- 39,44 ----
*************** package body System.Machine_State_Operat
*** 59,76 ****
          (Memory.Alloc (Memory.size_t (c_machine_state_length)));
     end Allocate_Machine_State;
  
-    -------------------
-    -- Enter_Handler --
-    -------------------
- 
-    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-       procedure c_enter_handler (M : Machine_State; Handler : Handler_Loc);
-       pragma Import (C, c_enter_handler, "__gnat_enter_handler");
- 
-    begin
-       c_enter_handler (M, Handler);
-    end Enter_Handler;
- 
     ----------------
     -- Fetch_Code --
     ----------------
--- 57,62 ----
*************** package body System.Machine_State_Operat
*** 135,153 ****
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame
!      (M    : Machine_State;
!       Info : Subprogram_Info_Type)
!    is
!       pragma Warnings (Off, Info);
! 
!       procedure exc_virtual_unwind
!         (Fcn  : System.Address;
!          M    : Machine_State);
        pragma Import (C, exc_virtual_unwind, "exc_virtual_unwind");
  
     begin
!       exc_virtual_unwind (System.Null_Address, M);
     end Pop_Frame;
  
     -----------------------
--- 121,153 ----
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame (M : Machine_State) is
!       procedure exc_virtual_unwind (Fcn : System.Address; M : Machine_State);
        pragma Import (C, exc_virtual_unwind, "exc_virtual_unwind");
  
+       function exc_lookup_function (Loc : Code_Loc) return System.Address;
+       pragma Import (C, exc_lookup_function, "exc_lookup_function_entry");
+ 
+       procedure c_set_code_loc (M : Machine_State; Loc : Code_Loc);
+       pragma Import (C, c_set_code_loc, "__gnat_set_code_loc");
+ 
+       --  Look for a code-range descriptor table containing the PC of the
+       --  specified machine state. If we don't find any, attempting to unwind
+       --  further would fail so we set the machine state's code location to a
+       --  value indicating that the top of the call chain is reached. This
+       --  happens when the function at the address pointed to by PC has not
+       --  been registered with the unwinding machinery, as with the __istart
+       --  functions generated by the linker in presence of initialization
+       --  routines for example.
+ 
+       Prf : constant System.Address := exc_lookup_function (Get_Code_Loc (M));
+ 
     begin
!       if Prf = System.Null_Address then
!          c_set_code_loc (M, 0);
!       else
!          exc_virtual_unwind (Prf, M);
!       end if;
     end Pop_Frame;
  
     -----------------------
*************** package body System.Machine_State_Operat
*** 157,181 ****
     procedure Set_Machine_State (M : Machine_State) is
        procedure c_capture_context (M : Machine_State);
        pragma Import (C, c_capture_context, "exc_capture_context");
- 
     begin
        c_capture_context (M);
!       Pop_Frame (M, System.Null_Address);
     end Set_Machine_State;
  
-    ------------------------------
-    -- Set_Signal_Machine_State --
-    ------------------------------
- 
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address)
-    is
-       pragma Warnings (Off, M);
-       pragma Warnings (Off, Context);
- 
-    begin
-       null;
-    end Set_Signal_Machine_State;
- 
  end System.Machine_State_Operations;
--- 157,165 ----
     procedure Set_Machine_State (M : Machine_State) is
        procedure c_capture_context (M : Machine_State);
        pragma Import (C, c_capture_context, "exc_capture_context");
     begin
        c_capture_context (M);
!       Pop_Frame (M);
     end Set_Machine_State;
  
  end System.Machine_State_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop-vms.adb gcc-4.1.0/gcc/ada/s-mastop-vms.adb
*** gcc-4.0.2/gcc/ada/s-mastop-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-mastop-vms.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                         (Version for Alpha/VMS)                          --
  --                                                                          --
! --          Copyright (C) 2001-2002 Ada Core Technologies, 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- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                         (Version for Alpha/VMS)                          --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Unchecked_Conversion;
*** 41,50 ****
  
  package body System.Machine_State_Operations is
  
-    use System.Exceptions;
     subtype Cond_Value_Type is Unsigned_Longword;
  
!    --  Record layouts copied from Starlet.
  
     type ICB_Fflags_Bits_Type is record
        Exception_Frame : Boolean;
--- 41,49 ----
  
  package body System.Machine_State_Operations is
  
     subtype Cond_Value_Type is Unsigned_Longword;
  
!    --  Record layouts copied from Starlet
  
     type ICB_Fflags_Bits_Type is record
        Exception_Frame : Boolean;
*************** package body System.Machine_State_Operat
*** 95,101 ****
  
        Ireg : Unsigned_Quadword_Array (0 .. 30);
        Freg : Unsigned_Quadword_Array (0 .. 30);
!       --  The register contents areas. 31 for scalars, 31 for float.
  
        System_Defined : Unsigned_Quadword_Array (0 .. 1);
        --  The following is an "internal" area that's reserved for use by
--- 94,100 ----
  
        Ireg : Unsigned_Quadword_Array (0 .. 30);
        Freg : Unsigned_Quadword_Array (0 .. 30);
!       --  The register contents areas. 31 for scalars, 31 for float
  
        System_Defined : Unsigned_Quadword_Array (0 .. 1);
        --  The following is an "internal" area that's reserved for use by
*************** package body System.Machine_State_Operat
*** 148,202 ****
          (Memory.Alloc (Invo_Handle_Type'Max_Size_In_Storage_Elements));
     end Allocate_Machine_State;
  
-    -------------------
-    -- Enter_Handler --
-    -------------------
- 
-    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-       procedure Get_Invo_Context (
-          Result       : out Unsigned_Longword; -- return value
-          Invo_Handle  : Invo_Handle_Type;
-          Invo_Context : out Invo_Context_Blk_Type);
- 
-       pragma Interface (External, Get_Invo_Context);
- 
-       pragma Import_Valued_Procedure (Get_Invo_Context, "LIB$GET_INVO_CONTEXT",
-          (Unsigned_Longword, Invo_Handle_Type, Invo_Context_Blk_Type),
-          (Value, Value, Reference));
- 
-       ICB : Invo_Context_Blk_Type;
- 
-       procedure Goto_Unwind (
-          Status      : out Cond_Value_Type; -- return value
-          Target_Invo : Address := Address_Zero;
-          Target_PC   : Address := Address_Zero;
-          New_R0      : Unsigned_Quadword := Unsigned_Quadword'Null_Parameter;
-          New_R1      : Unsigned_Quadword := Unsigned_Quadword'Null_Parameter);
- 
-       pragma Interface (External, Goto_Unwind);
- 
-       pragma Import_Valued_Procedure
-         (Goto_Unwind, "SYS$GOTO_UNWIND",
-          (Cond_Value_Type, Address, Address,
-           Unsigned_Quadword, Unsigned_Quadword),
-          (Value, Reference, Reference,
-           Reference, Reference));
- 
-       Status : Cond_Value_Type;
- 
-    begin
-       Get_Invo_Context (Status, To_Invo_Handle_Access (M).all, ICB);
-       Goto_Unwind
-         (Status, System.Address (To_Invo_Handle_Access (M).all), Handler);
-    end Enter_Handler;
- 
     ----------------
     -- Fetch_Code --
     ----------------
  
     function Fetch_Code (Loc : Code_Loc) return Code_Loc is
     begin
!       --  The starting address is in the second longword pointed to by Loc.
  
        return Fetch (System.Aux_DEC."+" (Loc, 8));
     end Fetch_Code;
--- 147,159 ----
          (Memory.Alloc (Invo_Handle_Type'Max_Size_In_Storage_Elements));
     end Allocate_Machine_State;
  
     ----------------
     -- Fetch_Code --
     ----------------
  
     function Fetch_Code (Loc : Code_Loc) return Code_Loc is
     begin
!       --  The starting address is in the second longword pointed to by Loc
  
        return Fetch (System.Aux_DEC."+" (Loc, 8));
     end Fetch_Code;
*************** package body System.Machine_State_Operat
*** 261,272 ****
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame
!      (M    : Machine_State;
!       Info : Subprogram_Info_Type)
!    is
!       pragma Warnings (Off, Info);
! 
        procedure Get_Prev_Invo_Handle (
           Result : out Invo_Handle_Type; -- return value
           ICB    : in  Invo_Handle_Type);
--- 218,224 ----
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame (M : Machine_State) is
        procedure Get_Prev_Invo_Handle (
           Result : out Invo_Handle_Type; -- return value
           ICB    : in  Invo_Handle_Type);
*************** package body System.Machine_State_Operat
*** 311,317 ****
           (Invo_Handle_Type, Invo_Context_Blk_Type),
           (Value, Reference));
  
!       ICB : Invo_Context_Blk_Type;
        Invo_Handle : aliased Invo_Handle_Type;
  
     begin
--- 263,269 ----
           (Invo_Handle_Type, Invo_Context_Blk_Type),
           (Value, Reference));
  
!       ICB         : Invo_Context_Blk_Type;
        Invo_Handle : aliased Invo_Handle_Type;
  
     begin
*************** package body System.Machine_State_Operat
*** 321,339 ****
        Pop_Frame (M, System.Null_Address);
     end Set_Machine_State;
  
-    ------------------------------
-    -- Set_Signal_Machine_State --
-    ------------------------------
- 
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address)
-    is
-       pragma Warnings (Off, M);
-       pragma Warnings (Off, Context);
- 
-    begin
-       null;
-    end Set_Signal_Machine_State;
- 
  end System.Machine_State_Operations;
--- 273,276 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop-x86.adb gcc-4.1.0/gcc/ada/s-mastop-x86.adb
*** gcc-4.0.2/gcc/ada/s-mastop-x86.adb	Thu Jul 15 20:34:34 2004
--- gcc-4.1.0/gcc/ada/s-mastop-x86.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,594 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT COMPILER COMPONENTS                         --
- --                                                                          --
- --                     SYSTEM.MACHINE_STATE_OPERATIONS                      --
- --                                                                          --
- --                                 B o d y                                  --
- --                            (Version for x86)                             --
- --                                                                          --
- --           Copyright (C) 1999-2004 Ada Core Technologies, Inc.            --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  Note: it is very important that this unit not generate any exception
- --  tables of any kind. Otherwise we get a nasty rtsfind recursion problem.
- --  This means no subprograms, including implicitly generated ones.
- 
- with Unchecked_Conversion;
- with System.Storage_Elements;
- with System.Machine_Code; use System.Machine_Code;
- with System.Memory;
- 
- package body System.Machine_State_Operations is
- 
-    function "+" (Left, Right : Address) return Address;
-    pragma Import (Intrinsic, "+");
-    --  Provide addition operation on type Address (this may not be directly
-    --  available if type System.Address is non-private and the operations on
-    --  the type are made abstract to hide them from public users of System).
- 
-    use System.Exceptions;
- 
-    type Uns8  is mod 2 ** 8;
-    type Uns32 is mod 2 ** 32;
- 
-    type Bits5 is mod 2 ** 5;
-    type Bits6 is mod 2 ** 6;
- 
-    function To_Address is new Unchecked_Conversion (Uns32, Address);
- 
-    type Uns32_Ptr is access all Uns32;
-    function To_Uns32_Ptr is new Unchecked_Conversion (Uns32,   Uns32_Ptr);
- 
-    --  Note: the type Uns32 has an alignment of 4. However, in some cases
-    --  values of type Uns32_Ptr will not be aligned (notably in the case
-    --  where we get the immediate field from an instruction). However this
-    --  does not matter in practice, since the x86 does not require that
-    --  operands be aligned.
- 
-    ----------------------
-    -- General Approach --
-    ----------------------
- 
-    --  For the x86 version of this unit, the Subprogram_Info_Type values
-    --  are simply the starting code address for the subprogram. Popping
-    --  of stack frames works by analyzing the code in the prolog, and
-    --  deriving from this analysis the necessary information for restoring
-    --  the registers, including the return point.
- 
-    ---------------------------
-    -- Description of Prolog --
-    ---------------------------
- 
-    --  If a frame pointer is present, the prolog looks like
- 
-    --     pushl %ebp
-    --     movl  %esp,%ebp
-    --     subl  $nnn,%esp     omitted if nnn = 0
-    --     pushl %edi          omitted if edi not used
-    --     pushl %esi          omitted if esi not used
-    --     pushl %ebx          omitted if ebx not used
- 
-    --  If a frame pointer is not present, the prolog looks like
- 
-    --     subl  $nnn,%esp     omitted if nnn = 0
-    --     pushl %ebp          omitted if ebp not used
-    --     pushl %edi          omitted if edi not used
-    --     pushl %esi          omitted if esi not used
-    --     pushl %ebx          omitted if ebx not used
- 
-    --  Note: any or all of the save over call registers may be used and
-    --  if so, will be saved using pushl as shown above. The order of the
-    --  pushl instructions will be as shown above for gcc generated code,
-    --  but the code in this unit does not assume this.
- 
-    -------------------------
-    -- Description of Call --
-    -------------------------
- 
-    --  A call looks like:
- 
-    --     pushl ...           push parameters
-    --     pushl ...
-    --     call  ...           perform the call
-    --     addl  $nnn,%esp     omitted if no parameters
- 
-    --  Note that we are not absolutely guaranteed that the call is always
-    --  followed by an addl operation that readjusts %esp for this particular
-    --  call. There are two reasons for this:
- 
-    --    1) The addl can be delayed and combined in the case where more than
-    --       one call appears in sequence. This can be suppressed by using the
-    --       switch -fno-defer-pop and for Ada code, we automatically use
-    --       this switch, but we could still be dealing with C code that was
-    --       compiled without using this switch.
- 
-    --    2) Scheduling may result in moving the addl instruction away from
-    --       the call. It is not clear if this actually can happen at the
-    --       current time, but it is certainly conceptually possible.
- 
-    --  The addl after the call is important, since we need to be able to
-    --  restore the proper %esp value when we pop the stack. However, we do
-    --  not try to compensate for either of the above effects. As noted above,
-    --  case 1 does not occur for Ada code, and it does not appear in practice
-    --  that case 2 occurs with any significant frequency (we have never seen
-    --  an example so far for gcc generated code).
- 
-    --  Furthermore, it is only in the case of -fomit-frame-pointer that we
-    --  really get into trouble from not properly restoring %esp. If we have
-    --  a frame pointer, then the worst that happens is that %esp is slightly
-    --  more depressed than it should be. This could waste a bit of space on
-    --  the stack, and even in some cases cause a storage leak on the stack,
-    --  but it will not affect the functional correctness of the processing.
- 
-    ----------------------------------------
-    -- Definitions of Instruction Formats --
-    ----------------------------------------
- 
-    type Rcode is (eax, ecx, edx, ebx, esp, ebp, esi, edi);
-    pragma Warnings (Off, Rcode);
-    --  Code indicating which register is referenced in an instruction
- 
-    --  The following define the format of a pushl instruction
- 
-    Op_pushl : constant Bits5 := 2#01010#;
- 
-    type Ins_pushl is record
-       Op  : Bits5 := Op_pushl;
-       Reg : Rcode;
-    end record;
- 
-    for Ins_pushl use record
-       Op  at 0 range 3 .. 7;
-       Reg at 0 range 0 .. 2;
-    end record;
- 
-    Ins_pushl_ebp : constant Ins_pushl := (Op_pushl, Reg => ebp);
- 
-    type Ins_pushl_Ptr is access all Ins_pushl;
- 
-    --  For the movl %esp,%ebp instruction, we only need to know the length
-    --  because we simply skip past it when we analyze the prolog.
- 
-    Ins_movl_length : constant := 2;
- 
-    --  The following define the format of addl/subl esp instructions
- 
-    Op_Immed : constant Bits6 := 2#100000#;
- 
-    Op2_addl_Immed : constant Bits5 := 2#11100#;
-    pragma Unreferenced (Op2_addl_Immed);
- 
-    Op2_subl_Immed : constant Bits5 := 2#11101#;
- 
-    type Word_Byte is (Word, Byte);
-    pragma Unreferenced (Byte);
- 
-    type Ins_addl_subl_byte is record
-       Op   : Bits6;           -- Set to Op_Immed
-       w    : Word_Byte;       -- Word/Byte flag (set to 1 = byte)
-       s    : Boolean;         -- Sign extension bit (1 = extend)
-       Op2  : Bits5;           -- Secondary opcode
-       Reg  : Rcode;           -- Register
-       Imm8 : Uns8;            -- Immediate operand
-    end record;
- 
-    for Ins_addl_subl_byte use record
-       Op   at 0 range 2 .. 7;
-       w    at 0 range 1 .. 1;
-       s    at 0 range 0 .. 0;
-       Op2  at 1 range 3 .. 7;
-       Reg  at 1 range 0 .. 2;
-       Imm8 at 2 range 0 .. 7;
-    end record;
- 
-    type Ins_addl_subl_word is record
-       Op    : Bits6;          -- Set to Op_Immed
-       w     : Word_Byte;      -- Word/Byte flag (set to 0 = word)
-       s     : Boolean;        -- Sign extension bit (1 = extend)
-       Op2   : Bits5;          -- Secondary opcode
-       Reg   : Rcode;          -- Register
-       Imm32 : Uns32;          -- Immediate operand
-    end record;
- 
-    for Ins_addl_subl_word use record
-       Op    at 0 range 2 .. 7;
-       w     at 0 range 1 .. 1;
-       s     at 0 range 0 .. 0;
-       Op2   at 1 range 3 .. 7;
-       Reg   at 1 range 0 .. 2;
-       Imm32 at 2 range 0 .. 31;
-    end record;
- 
-    type Ins_addl_subl_byte_Ptr is access all Ins_addl_subl_byte;
-    type Ins_addl_subl_word_Ptr is access all Ins_addl_subl_word;
- 
-    ---------------------
-    -- Prolog Analysis --
-    ---------------------
- 
-    --  The analysis of the prolog answers the following questions:
- 
-    --    1. Is %ebp used as a frame pointer?
-    --    2. How far is SP depressed (i.e. what is the stack frame size)
-    --    3. Which registers are saved in the prolog, and in what order
- 
-    --  The following data structure stores the answers to these questions
- 
-    subtype SOC is Rcode range ebx .. edi;
-    --  Possible save over call registers
- 
-    SOC_Max : constant := 4;
-    --  Max number of SOC registers that can be pushed
- 
-    type SOC_Push_Regs_Type is array (1 .. 4) of Rcode;
-    --  Used to hold the register codes of pushed SOC registers
- 
-    type Prolog_Type is record
- 
-       Frame_Reg : Boolean;
-       --  This is set to True if %ebp is used as a frame register, and
-       --  False otherwise (in the False case, %ebp may be saved in the
-       --  usual manner along with the other SOC registers).
- 
-       Frame_Length : Uns32;
-       --  Amount by which ESP is decremented on entry, includes the effects
-       --  of push's of save over call registers as indicated above, e.g. if
-       --  the prolog of a routine is:
-       --
-       --    pushl %ebp
-       --    movl %esp,%ebp
-       --    subl $424,%esp
-       --    pushl %edi
-       --    pushl %esi
-       --    pushl %ebx
-       --
-       --  Then the value of Frame_Length would be 436 (424 + 3 * 4). A
-       --  precise definition is that it is:
-       --
-       --    %esp on entry   minus   %esp after last SOC push
-       --
-       --  That definition applies both in the frame pointer present and
-       --  the frame pointer absent cases.
- 
-       Num_SOC_Push : Integer range 0 .. SOC_Max;
-       --  Number of save over call registers actually saved by pushl
-       --  instructions (other than the initial pushl to save the frame
-       --  pointer if a frame pointer is in use).
- 
-       SOC_Push_Regs : SOC_Push_Regs_Type;
-       --  The First Num_SOC_Push entries of this array are used to contain
-       --  the codes for the SOC registers, in the order in which they were
-       --  pushed. Note that this array excludes %ebp if it is used as a frame
-       --  register, since although %ebp is still considered an SOC register
-       --  in this case, it is saved and restored by a separate mechanism.
-       --  Also we will never see %esp represented in this list. Again, it is
-       --  true that %esp is saved over call, but it is restored by a separate
-       --  mechanism.
- 
-    end record;
- 
-    procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type);
-    --  Given the address of the start of the prolog for a procedure,
-    --  analyze the instructions of the prolog, and set Prolog to contain
-    --  the information obtained from this analysis.
- 
-    ----------------------------------
-    -- Machine_State_Representation --
-    ----------------------------------
- 
-    --  The type Machine_State is defined in the body of Ada.Exceptions as
-    --  a Storage_Array of length 1 .. Machine_State_Length. But really it
-    --  has structure as defined here. We use the structureless declaration
-    --  in Ada.Exceptions to avoid this unit from being implementation
-    --  dependent. The actual definition of Machine_State is as follows:
- 
-    type SOC_Regs_Type is array (SOC) of Uns32;
- 
-    type MState is record
-       eip : Uns32;
-       --  The instruction pointer location (which is the return point
-       --  value from the next level down in all cases).
- 
-       Regs : SOC_Regs_Type;
-       --  Values of the save over call registers
-    end record;
- 
-    for MState use record
-       eip  at 0 range 0 .. 31;
-       Regs at 4 range 0 .. 5 * 32 - 1;
-    end record;
-    --  Note: the routines Enter_Handler, and Set_Machine_State reference
-    --  the fields in this structure non-symbolically.
- 
-    type MState_Ptr is access all MState;
- 
-    function To_MState_Ptr is
-      new Unchecked_Conversion (Machine_State, MState_Ptr);
- 
-    ----------------------------
-    -- Allocate_Machine_State --
-    ----------------------------
- 
-    function Allocate_Machine_State return Machine_State is
-       use System.Storage_Elements;
- 
-    begin
-       return Machine_State
-         (Memory.Alloc (MState'Max_Size_In_Storage_Elements));
-    end Allocate_Machine_State;
- 
-    --------------------
-    -- Analyze_Prolog --
-    --------------------
- 
-    procedure Analyze_Prolog (A : Address; Prolog : out Prolog_Type) is
-       Ptr : Address;
-       Ppl : Ins_pushl_Ptr;
-       Pas : Ins_addl_subl_byte_Ptr;
- 
-       function To_Ins_pushl_Ptr is
-         new Unchecked_Conversion (Address, Ins_pushl_Ptr);
- 
-       function To_Ins_addl_subl_byte_Ptr is
-         new Unchecked_Conversion (Address, Ins_addl_subl_byte_Ptr);
- 
-       function To_Ins_addl_subl_word_Ptr is
-         new Unchecked_Conversion (Address, Ins_addl_subl_word_Ptr);
- 
-    begin
-       Ptr := A;
-       Prolog.Frame_Length := 0;
- 
-       if Ptr = Null_Address then
-          Prolog.Num_SOC_Push := 0;
-          Prolog.Frame_Reg := True;
-          return;
-       end if;
- 
-       if To_Ins_pushl_Ptr (Ptr).all = Ins_pushl_ebp then
-          Ptr := Ptr + 1 + Ins_movl_length;
-          Prolog.Frame_Reg := True;
-       else
-          Prolog.Frame_Reg := False;
-       end if;
- 
-       Pas := To_Ins_addl_subl_byte_Ptr (Ptr);
- 
-       if Pas.Op = Op_Immed
-         and then Pas.Op2 = Op2_subl_Immed
-         and then Pas.Reg = esp
-       then
-          if Pas.w = Word then
-             Prolog.Frame_Length := Prolog.Frame_Length +
-                                      To_Ins_addl_subl_word_Ptr (Ptr).Imm32;
-             Ptr := Ptr + 6;
- 
-          else
-             Prolog.Frame_Length := Prolog.Frame_Length + Uns32 (Pas.Imm8);
-             Ptr := Ptr + 3;
- 
-             --  Note: we ignore sign extension, since a sign extended
-             --  value that was negative would imply a ludicrous frame size.
-          end if;
-       end if;
- 
-       --  Now scan push instructions for SOC registers
- 
-       Prolog.Num_SOC_Push := 0;
- 
-       loop
-          Ppl := To_Ins_pushl_Ptr (Ptr);
- 
-          if Ppl.Op = Op_pushl and then Ppl.Reg in SOC then
-             Prolog.Num_SOC_Push := Prolog.Num_SOC_Push + 1;
-             Prolog.SOC_Push_Regs (Prolog.Num_SOC_Push) := Ppl.Reg;
-             Prolog.Frame_Length := Prolog.Frame_Length + 4;
-             Ptr := Ptr + 1;
- 
-          else
-             exit;
-          end if;
-       end loop;
- 
-    end Analyze_Prolog;
- 
-    -------------------
-    -- Enter_Handler --
-    -------------------
- 
-    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-    begin
-       Asm ("mov %0,%%edx", Inputs => Machine_State'Asm_Input ("r", M));
-       Asm ("mov %0,%%eax", Inputs => Handler_Loc'Asm_Input ("r", Handler));
- 
-       Asm ("mov 4(%%edx),%%ebx");    -- M.Regs (ebx)
-       Asm ("mov 12(%%edx),%%ebp");   -- M.Regs (ebp)
-       Asm ("mov 16(%%edx),%%esi");   -- M.Regs (esi)
-       Asm ("mov 20(%%edx),%%edi");   -- M.Regs (edi)
-       Asm ("mov 8(%%edx),%%esp");    -- M.Regs (esp)
-       Asm ("jmp %*%%eax");
-    end Enter_Handler;
- 
-    ----------------
-    -- Fetch_Code --
-    ----------------
- 
-    function Fetch_Code (Loc : Code_Loc) return Code_Loc is
-    begin
-       return Loc;
-    end Fetch_Code;
- 
-    ------------------------
-    -- Free_Machine_State --
-    ------------------------
- 
-    procedure Free_Machine_State (M : in out Machine_State) is
-    begin
-       Memory.Free (Address (M));
-       M := Machine_State (Null_Address);
-    end Free_Machine_State;
- 
-    ------------------
-    -- Get_Code_Loc --
-    ------------------
- 
-    function Get_Code_Loc (M : Machine_State) return Code_Loc is
- 
-       Asm_Call_Size : constant := 2;
-       --  Minimum size for a call instruction under ix86. Using the minimum
-       --  size is safe here as the call point computed from the return point
-       --  will always be inside the call instruction.
- 
-       MS : constant MState_Ptr := To_MState_Ptr (M);
- 
-    begin
-       if MS.eip = 0 then
-          return To_Address (MS.eip);
-       else
-          --  When doing a call the return address is pushed to the stack.
-          --  We want to return the call point address, so we subtract
-          --  Asm_Call_Size from the return address. This value is set
-          --  to 5 as an asm call takes 5 bytes on x86 architectures.
- 
-          return To_Address (MS.eip - Asm_Call_Size);
-       end if;
-    end Get_Code_Loc;
- 
-    --------------------------
-    -- Machine_State_Length --
-    --------------------------
- 
-    function Machine_State_Length
-      return System.Storage_Elements.Storage_Offset
-    is
-    begin
-       return MState'Max_Size_In_Storage_Elements;
-    end Machine_State_Length;
- 
-    ---------------
-    -- Pop_Frame --
-    ---------------
- 
-    procedure Pop_Frame
-      (M    : Machine_State;
-       Info : Subprogram_Info_Type)
-    is
-       MS  : constant MState_Ptr := To_MState_Ptr (M);
-       PL  : Prolog_Type;
- 
-       SOC_Ptr : Uns32;
-       --  Pointer to stack location after last SOC push
- 
-       Rtn_Ptr : Uns32;
-       --  Pointer to stack location containing return address
- 
-    begin
-       Analyze_Prolog (Info, PL);
- 
-       --  Case of frame register, use EBP, safer than ESP
- 
-       if PL.Frame_Reg then
-          SOC_Ptr := MS.Regs (ebp) - PL.Frame_Length;
-          Rtn_Ptr := MS.Regs (ebp) + 4;
-          MS.Regs (ebp) := To_Uns32_Ptr (MS.Regs (ebp)).all;
- 
-       --  No frame pointer, use ESP, and hope we have it exactly right!
- 
-       else
-          SOC_Ptr := MS.Regs (esp);
-          Rtn_Ptr := SOC_Ptr + PL.Frame_Length;
-       end if;
- 
-       --  Get saved values of SOC registers
- 
-       for J in reverse 1 .. PL.Num_SOC_Push loop
-          MS.Regs (PL.SOC_Push_Regs (J)) := To_Uns32_Ptr (SOC_Ptr).all;
-          SOC_Ptr := SOC_Ptr + 4;
-       end loop;
- 
-       MS.eip := To_Uns32_Ptr (Rtn_Ptr).all;
-       MS.Regs (esp) := Rtn_Ptr + 4;
-    end Pop_Frame;
- 
-    -----------------------
-    -- Set_Machine_State --
-    -----------------------
- 
-    procedure Set_Machine_State (M : Machine_State) is
-       N : constant Asm_Output_Operand := No_Output_Operands;
- 
-    begin
-       Asm ("mov %0,%%edx", N, Machine_State'Asm_Input ("r", M));
- 
-       --  At this stage, we have the following situation (note that we
-       --  are assuming that the -fomit-frame-pointer switch has not been
-       --  used in compiling this procedure.
- 
-       --     (value of M)
-       --     return point
-       --     old ebp          <------ current ebp/esp value
- 
-       --  The values of registers ebx/esi/edi are unchanged from entry
-       --  so they have the values we want, and %edx points to the parameter
-       --  value M, so we can store these values directly.
- 
-       Asm ("mov %%ebx,4(%%edx)");    -- M.Regs (ebx)
-       Asm ("mov %%esi,16(%%edx)");   -- M.Regs (esi)
-       Asm ("mov %%edi,20(%%edx)");   -- M.Regs (edi)
- 
-       --  The desired value of ebp is the old value
- 
-       Asm ("mov 0(%%ebp),%%eax");
-       Asm ("mov %%eax,12(%%edx)");   -- M.Regs (ebp)
- 
-       --  The return point is the desired eip value
- 
-       Asm ("mov 4(%%ebp),%%eax");
-       Asm ("mov %%eax,(%%edx)");   -- M.eip
- 
-       --  Finally, the desired %esp value is the value at the point of
-       --  call to this routine *before* pushing the parameter value.
- 
-       Asm ("lea 12(%%ebp),%%eax");
-       Asm ("mov %%eax,8(%%edx)");   -- M.Regs (esp)
-    end Set_Machine_State;
- 
-    ------------------------------
-    -- Set_Signal_Machine_State --
-    ------------------------------
- 
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address)
-    is
-       pragma Warnings (Off, M);
-       pragma Warnings (Off, Context);
- 
-    begin
-       null;
-    end Set_Signal_Machine_State;
- 
- end System.Machine_State_Operations;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop.adb gcc-4.1.0/gcc/ada/s-mastop.adb
*** gcc-4.0.2/gcc/ada/s-mastop.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-mastop.adb	Mon Sep  5 07:46:59 2005
***************
*** 7,13 ****
  --                                 B o d y                                  --
  --                             (Dummy version)                              --
  --                                                                          --
! --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 7,13 ----
  --                                 B o d y                                  --
  --                             (Dummy version)                              --
  --                                                                          --
! --          Copyright (C) 1999-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Machine_State_Operat
*** 41,48 ****
  
     pragma Warnings (Off);
  
-    use System.Exceptions;
- 
     ----------------------------
     -- Allocate_Machine_State --
     ----------------------------
--- 41,46 ----
*************** package body System.Machine_State_Operat
*** 52,66 ****
        return Machine_State (Null_Address);
     end Allocate_Machine_State;
  
-    -------------------
-    -- Enter_Handler --
-    -------------------
- 
-    procedure Enter_Handler (M : Machine_State; Handler : Handler_Loc) is
-    begin
-       null;
-    end Enter_Handler;
- 
     ----------------
     -- Fetch_Code --
     ----------------
--- 50,55 ----
*************** package body System.Machine_State_Operat
*** 102,110 ****
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame
!      (M    : Machine_State;
!       Info : Subprogram_Info_Type) is
     begin
        null;
     end Pop_Frame;
--- 91,97 ----
     -- Pop_Frame --
     ---------------
  
!    procedure Pop_Frame (M : Machine_State) is
     begin
        null;
     end Pop_Frame;
*************** package body System.Machine_State_Operat
*** 118,133 ****
        null;
     end Set_Machine_State;
  
-    ------------------------------
-    -- Set_Signal_Machine_State --
-    ------------------------------
- 
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address)
-    is
-    begin
-       null;
-    end Set_Signal_Machine_State;
- 
  end System.Machine_State_Operations;
--- 105,108 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-mastop.ads gcc-4.1.0/gcc/ada/s-mastop.ads
*** gcc-4.0.2/gcc/ada/s-mastop.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-mastop.ads	Mon Sep  5 07:46:59 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 36,42 ****
  --  elaboration circularities with System.Exception_Tables.
  
  with System.Storage_Elements;
- with System.Exceptions;
  
  package System.Machine_State_Operations is
  
--- 36,41 ----
*************** package System.Machine_State_Operations 
*** 79,143 ****
     --  outer level, or some other frame for which no information can be
     --  provided.
  
!    procedure Pop_Frame
!      (M    : Machine_State;
!       Info : System.Exceptions.Subprogram_Info_Type);
     --  This procedure pops the machine state M so that it represents the
     --  call point, as though the current subprogram had returned. It
     --  changes only the value referenced by M, and does not affect
     --  the current stack environment.
-    --
-    --  The Info parameter represents information generated by the backend
-    --  (see description of Subprogram_Info node in sinfo.ads). This
-    --  information is stored as static data during compilation. The
-    --  caller then passes this information to Pop_Frame, which will
-    --  use it to determine what must be changed in the machine state
-    --  (e.g. which save-over-call registers must be restored, and from
-    --  where on the stack frame they must be restored).
-    --
-    --  A value of No_Info for Info means either that the backend provided
-    --  no information for current frame, or that the current frame is an
-    --  other language frame for which no information exists, or that this
-    --  is an outer level subprogram. In any case, Pop_Frame sets the code
-    --  location to Null_Address when it pops past such a frame, and this
-    --  is taken as an indication that the exception is unhandled.
- 
-    --  Note: at the current time, Info, if present is always a copy of
-    --  the entry point of the procedure, as found by searching the
-    --  subprogram table. For the case where a procedure is indeed in
-    --  the table (either it is an Ada procedure, or a foreign procedure
-    --  which is registered using pragma Propagate_Exceptions), then the
-    --  entry point information will indeed be correct. It may well be
-    --  possible for Pop_Frame to avoid using the Info parameter (for
-    --  example if it consults auxiliary Dwarf tables to do its job).
-    --  This is desirable if it can be done, because it means that it
-    --  will work fine to propagate exceptions through unregistered
-    --  foreign procedures. What will happen is that the search in the
-    --  Ada subprogram table will find a junk entry. Even if this junk
-    --  entry has an exception table, none of them will apply to the
-    --  current location, so they will be ignored, and then Pop_Frame
-    --  will be called to pop the frame. The Info parameter for this
-    --  call will be junk, but if it is not used that does not matter.
-    --  Note that the address recorded in the traceback table is of
-    --  the exception location, so the traceback will be correct even
-    --  in this case.
- 
-    procedure Enter_Handler
-      (M       : Machine_State;
-       Handler : System.Exceptions.Handler_Loc);
-    --  When Propagate_Handler locates an applicable exception handler, it
-    --  calls Enter_Handler, passing it two parameters. The first is the
-    --  machine state that corresponds to what is required for entry to
-    --  the handler, as computed by repeated Pop_Frame calls to reach the
-    --  handler to be entered. The second is the code location for the
-    --  handler itself which is the address of the label at the start of
-    --  the handler code.
-    --
-    --  Note: The machine state M is likely stored on the part of the
-    --  stack that will be popped by the call, so care must be taken
-    --  not to pop the stack until the Machine_State is entirely read.
-    --  The value passed as Handler was obtained from elaboration of
-    --  an N_Handler_Loc node by the backend.
  
     function Fetch_Code (Loc : Code_Loc) return Code_Loc;
     --  Some architectures (notably VMS) use a descriptor to describe
--- 78,88 ----
     --  outer level, or some other frame for which no information can be
     --  provided.
  
!    procedure Pop_Frame (M : Machine_State);
     --  This procedure pops the machine state M so that it represents the
     --  call point, as though the current subprogram had returned. It
     --  changes only the value referenced by M, and does not affect
     --  the current stack environment.
  
     function Fetch_Code (Loc : Code_Loc) return Code_Loc;
     --  Some architectures (notably VMS) use a descriptor to describe
*************** package System.Machine_State_Operations 
*** 150,163 ****
     --  This routine sets M from the current machine state. It is called
     --  when an exception is initially signalled to initialize the state.
  
-    procedure Set_Signal_Machine_State
-      (M       : Machine_State;
-       Context : System.Address);
-    --  This routine sets M from the machine state that corresponds to the
-    --  point in the code where a signal was raised. The parameter Context
-    --  is a pointer to a structure created by the operating system when a
-    --  signal is raised, and made available to the signal handler. The
-    --  format of this context block, and the manner in which it is made
-    --  available to the handler, are implementation dependent.
- 
  end System.Machine_State_Operations;
--- 95,98 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-memcop.ads gcc-4.1.0/gcc/ada/s-memcop.ads
*** gcc-4.0.2/gcc/ada/s-memcop.ads	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/s-memcop.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.CRTL;
*** 46,52 ****
  --  The above with is contrary to the intent ???
  
  package System.Memory_Copy is
! pragma Preelaborate;
  
     procedure memcpy (S1 : Address; S2 : Address; N : System.CRTL.size_t)
       renames System.CRTL.memcpy;
--- 46,52 ----
  --  The above with is contrary to the intent ???
  
  package System.Memory_Copy is
!    pragma Preelaborate;
  
     procedure memcpy (S1 : Address; S2 : Address; N : System.CRTL.size_t)
       renames System.CRTL.memcpy;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-memory-mingw.adb gcc-4.1.0/gcc/ada/s-memory-mingw.adb
*** gcc-4.0.2/gcc/ada/s-memory-mingw.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-memory-mingw.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-memory.adb gcc-4.1.0/gcc/ada/s-memory.adb
*** gcc-4.0.2/gcc/ada/s-memory.adb	Mon Dec 15 11:51:00 2003
--- gcc-4.1.0/gcc/ada/s-memory.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,47 ****
  
  --  This implementation assumes that the underlying malloc/free/realloc
  --  implementation is thread safe, and thus, no additional lock is required.
! --  Note that we still need to defer abortion because on most systems,
! --  an asynchronous signal (as used for implementing asynchronous abortion
! --  of task) cannot safely be handled while malloc is executing.
  
! --  If you are not using Ada constructs containing the "abort" keyword,
! --  then you can remove the calls to Abort_Defer.all and Abort_Undefer.all
! --  from this unit.
  
  with Ada.Exceptions;
  with System.Soft_Links;
--- 35,47 ----
  
  --  This implementation assumes that the underlying malloc/free/realloc
  --  implementation is thread safe, and thus, no additional lock is required.
! --  Note that we still need to defer abort because on most systems, an
! --  asynchronous signal (as used for implementing asynchronous abort of
! --  task) cannot safely be handled while malloc is executing.
  
! --  If you are not using Ada constructs containing the "abort" keyword, then
! --  you can remove the calls to Abort_Defer.all and Abort_Undefer.all from
! --  this unit.
  
  with Ada.Exceptions;
  with System.Soft_Links;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-memory.ads gcc-4.1.0/gcc/ada/s-memory.ads
*** gcc-4.0.2/gcc/ada/s-memory.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-memory.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-aix-fsu.ads gcc-4.1.0/gcc/ada/s-osinte-aix-fsu.ads
*** gcc-4.0.2/gcc/ada/s-osinte-aix-fsu.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-aix-fsu.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-aix.adb gcc-4.1.0/gcc/ada/s-osinte-aix.adb
*** gcc-4.0.2/gcc/ada/s-osinte-aix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-aix.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2002, Free Software Fundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2005, Free Software Fundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-aix.ads gcc-4.1.0/gcc/ada/s-osinte-aix.ads
*** gcc-4.0.2/gcc/ada/s-osinte-aix.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-aix.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-darwin.adb gcc-4.1.0/gcc/ada/s-osinte-darwin.adb
*** gcc-4.0.2/gcc/ada/s-osinte-darwin.adb	Mon Jan  3 15:40:15 2005
--- gcc-4.1.0/gcc/ada/s-osinte-darwin.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-darwin.ads gcc-4.1.0/gcc/ada/s-osinte-darwin.ads
*** gcc-4.0.2/gcc/ada/s-osinte-darwin.ads	Mon Jan  3 15:40:15 2005
--- gcc-4.1.0/gcc/ada/s-osinte-darwin.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-dummy.ads gcc-4.1.0/gcc/ada/s-osinte-dummy.ads
*** gcc-4.0.2/gcc/ada/s-osinte-dummy.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-dummy.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-freebsd.adb gcc-4.1.0/gcc/ada/s-osinte-freebsd.adb
*** gcc-4.0.2/gcc/ada/s-osinte-freebsd.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-freebsd.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
! --          Copyright (C) 1991-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Interface is
*** 85,91 ****
          ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
     end To_Timespec;
  
- 
     function To_Duration (TV : struct_timeval) return Duration is
     begin
        return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
--- 85,90 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-freebsd.ads gcc-4.1.0/gcc/ada/s-osinte-freebsd.ads
*** gcc-4.0.2/gcc/ada/s-osinte-freebsd.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-freebsd.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-fsu.adb gcc-4.1.0/gcc/ada/s-osinte-fsu.adb
*** gcc-4.0.2/gcc/ada/s-osinte-fsu.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-fsu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Interface is
*** 250,257 ****
  
     --  FSU_THREADS does not have pthread_setschedparam
  
!    --  This routine returns a non-negative value upon failure
!    --  but the error code can not be set conforming the POSIX standard.
  
     function pthread_setschedparam
       (thread : pthread_t;
--- 250,257 ----
  
     --  FSU_THREADS does not have pthread_setschedparam
  
!    --  This routine returns a non-negative value upon failure but the error
!    --  code cannot be set conforming the POSIX standard.
  
     function pthread_setschedparam
       (thread : pthread_t;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-hpux-dce.adb gcc-4.1.0/gcc/ada/s-osinte-hpux-dce.adb
*** gcc-4.0.2/gcc/ada/s-osinte-hpux-dce.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-hpux-dce.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-hpux-dce.ads gcc-4.1.0/gcc/ada/s-osinte-hpux-dce.ads
*** gcc-4.0.2/gcc/ada/s-osinte-hpux-dce.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-hpux-dce.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-hpux.ads gcc-4.1.0/gcc/ada/s-osinte-hpux.ads
*** gcc-4.0.2/gcc/ada/s-osinte-hpux.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-hpux.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-interix.ads gcc-4.1.0/gcc/ada/s-osinte-interix.ads
*** gcc-4.0.2/gcc/ada/s-osinte-interix.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-interix.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-irix-athread.ads gcc-4.1.0/gcc/ada/s-osinte-irix-athread.ads
*** gcc-4.0.2/gcc/ada/s-osinte-irix-athread.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-irix-athread.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-irix.adb gcc-4.1.0/gcc/ada/s-osinte-irix.adb
*** gcc-4.0.2/gcc/ada/s-osinte-irix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-irix.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2002, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-irix.ads gcc-4.1.0/gcc/ada/s-osinte-irix.ads
*** gcc-4.0.2/gcc/ada/s-osinte-irix.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-irix.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-linux-alpha.ads gcc-4.1.0/gcc/ada/s-osinte-linux-alpha.ads
*** gcc-4.0.2/gcc/ada/s-osinte-linux-alpha.ads	Thu Jan 20 18:27:10 2005
--- gcc-4.1.0/gcc/ada/s-osinte-linux-alpha.ads	Fri Jul  1 01:29:17 2005
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-linux-fsu.ads gcc-4.1.0/gcc/ada/s-osinte-linux-fsu.ads
*** gcc-4.0.2/gcc/ada/s-osinte-linux-fsu.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-linux-fsu.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-linux-hppa.ads gcc-4.1.0/gcc/ada/s-osinte-linux-hppa.ads
*** gcc-4.0.2/gcc/ada/s-osinte-linux-hppa.ads	Thu Apr  7 20:03:51 2005
--- gcc-4.1.0/gcc/ada/s-osinte-linux-hppa.ads	Fri Jan 20 14:32:10 2006
***************
*** 18,25 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 18,25 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 508,514 ****
        lock : lock_array;
     end record;
     pragma Convention (C, atomic_lock_t);
!    for atomic_lock_t'Alignment use 8 * 16;
  
     type struct_pthread_fast_lock is record
        spinlock : atomic_lock_t;
--- 508,517 ----
        lock : lock_array;
     end record;
     pragma Convention (C, atomic_lock_t);
!    --  ??? Alignment should be 16 but this is larger than BIGGEST_ALIGNMENT.
!    --  This causes an erroneous pointer value to sometimes be passed to free
!    --  during deallocation.  See PR ada/24533 for more details.
!    for atomic_lock_t'Alignment use 8;
  
     type struct_pthread_fast_lock is record
        spinlock : atomic_lock_t;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-linux.ads gcc-4.1.0/gcc/ada/s-osinte-linux.ads
*** gcc-4.0.2/gcc/ada/s-osinte-linux.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-linux.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-lynxos-3.adb gcc-4.1.0/gcc/ada/s-osinte-lynxos-3.adb
*** gcc-4.0.2/gcc/ada/s-osinte-lynxos-3.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-lynxos-3.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2003 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-lynxos-3.ads gcc-4.1.0/gcc/ada/s-osinte-lynxos-3.ads
*** gcc-4.0.2/gcc/ada/s-osinte-lynxos-3.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-lynxos-3.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-lynxos.adb gcc-4.1.0/gcc/ada/s-osinte-lynxos.adb
*** gcc-4.0.2/gcc/ada/s-osinte-lynxos.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-lynxos.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2002 Ada Core Technologies, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --                     Copyright (C) 2001-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-lynxos.ads gcc-4.1.0/gcc/ada/s-osinte-lynxos.ads
*** gcc-4.0.2/gcc/ada/s-osinte-lynxos.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-lynxos.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-mingw.ads gcc-4.1.0/gcc/ada/s-osinte-mingw.ads
*** gcc-4.0.2/gcc/ada/s-osinte-mingw.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-mingw.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Interfaces.C.Strings;
*** 45,51 ****
  with Unchecked_Conversion;
  
  package System.OS_Interface is
! pragma Preelaborate;
  
     pragma Linker_Options ("-mthreads");
  
--- 45,51 ----
  with Unchecked_Conversion;
  
  package System.OS_Interface is
!    pragma Preelaborate;
  
     pragma Linker_Options ("-mthreads");
  
*************** pragma Preelaborate;
*** 198,216 ****
     -----------------------
  
     type CRITICAL_SECTION is private;
-    type PCRITICAL_SECTION is access all CRITICAL_SECTION;
  
!    procedure InitializeCriticalSection (pCriticalSection : PCRITICAL_SECTION);
     pragma Import
       (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
  
!    procedure EnterCriticalSection (pCriticalSection : PCRITICAL_SECTION);
     pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
  
!    procedure LeaveCriticalSection (pCriticalSection : PCRITICAL_SECTION);
     pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
  
!    procedure DeleteCriticalSection (pCriticalSection : PCRITICAL_SECTION);
     pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
  
     -------------------------------------------------------------
--- 198,219 ----
     -----------------------
  
     type CRITICAL_SECTION is private;
  
!    procedure InitializeCriticalSection
!      (pCriticalSection : access CRITICAL_SECTION);
     pragma Import
       (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
  
!    procedure EnterCriticalSection
!      (pCriticalSection : access CRITICAL_SECTION);
     pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
  
!    procedure LeaveCriticalSection
!      (pCriticalSection : access CRITICAL_SECTION);
     pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
  
!    procedure DeleteCriticalSection
!      (pCriticalSection : access CRITICAL_SECTION);
     pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
  
     -------------------------------------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-os2.adb gcc-4.1.0/gcc/ada/s-osinte-os2.adb
*** gcc-4.0.2/gcc/ada/s-osinte-os2.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-os2.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-os2.ads gcc-4.1.0/gcc/ada/s-osinte-os2.ads
*** gcc-4.0.2/gcc/ada/s-osinte-os2.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-os2.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-posix.adb gcc-4.1.0/gcc/ada/s-osinte-posix.adb
*** gcc-4.0.2/gcc/ada/s-osinte-posix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-posix.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-rtems.adb gcc-4.1.0/gcc/ada/s-osinte-rtems.adb
*** gcc-4.0.2/gcc/ada/s-osinte-rtems.adb	Thu Jan 27 11:56:57 2005
--- gcc-4.1.0/gcc/ada/s-osinte-rtems.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-rtems.ads gcc-4.1.0/gcc/ada/s-osinte-rtems.ads
*** gcc-4.0.2/gcc/ada/s-osinte-rtems.ads	Thu Jan 27 11:56:57 2005
--- gcc-4.1.0/gcc/ada/s-osinte-rtems.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-solaris-fsu.ads gcc-4.1.0/gcc/ada/s-osinte-solaris-fsu.ads
*** gcc-4.0.2/gcc/ada/s-osinte-solaris-fsu.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-solaris-fsu.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-solaris-posix.ads gcc-4.1.0/gcc/ada/s-osinte-solaris-posix.ads
*** gcc-4.0.2/gcc/ada/s-osinte-solaris-posix.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-solaris-posix.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-solaris.adb gcc-4.1.0/gcc/ada/s-osinte-solaris.adb
*** gcc-4.0.2/gcc/ada/s-osinte-solaris.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-solaris.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-solaris.ads gcc-4.1.0/gcc/ada/s-osinte-solaris.ads
*** gcc-4.0.2/gcc/ada/s-osinte-solaris.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-solaris.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-tru64.adb gcc-4.1.0/gcc/ada/s-osinte-tru64.adb
*** gcc-4.0.2/gcc/ada/s-osinte-tru64.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-tru64.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2002, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix version of this package.
  
  --  This package encapsulates all direct interfaces to OS services
  --  that are needed by children of System.
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix version of this package
  
  --  This package encapsulates all direct interfaces to OS services
  --  that are needed by children of System.
*************** with System.Machine_Code; use System.Mac
*** 45,50 ****
--- 45,60 ----
  
  package body System.OS_Interface is
  
+    --------------------
+    -- Get_Stack_Base --
+    --------------------
+ 
+    function Get_Stack_Base (thread : pthread_t) return Address is
+       pragma Unreferenced (thread);
+    begin
+       return Null_Address;
+    end Get_Stack_Base;
+ 
     ------------------
     -- pthread_init --
     ------------------
*************** package body System.OS_Interface is
*** 68,73 ****
--- 78,108 ----
        return Self;
     end pthread_self;
  
+    ----------------------
+    -- Hide_Yellow_Zone --
+    ----------------------
+ 
+    procedure Hide_Yellow_Zone is
+       type Teb_Ptr is access all pthread_teb_t;
+       Teb : Teb_Ptr;
+       Res : Interfaces.C.int;
+       pragma Unreferenced (Res);
+ 
+    begin
+       --  Get the Thread Environment Block address
+ 
+       Asm ("call_pal 0x9e" & ASCII.LF & ASCII.HT &
+            "bis $31, $0, %0",
+            Outputs => Teb_Ptr'Asm_Output ("=r", Teb),
+            Clobber => "$0");
+ 
+       --  Stick a guard page right above the Yellow Zone if it exists
+ 
+       if Teb.all.stack_yellow /= Teb.all.stack_guard then
+          Res := mprotect (Teb.all.stack_yellow, Get_Page_Size, PROT_ON);
+       end if;
+    end Hide_Yellow_Zone;
+ 
     -----------------
     -- To_Duration --
     -----------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-tru64.ads gcc-4.1.0/gcc/ada/s-osinte-tru64.ads
*** gcc-4.0.2/gcc/ada/s-osinte-tru64.ads	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-osinte-tru64.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.OS_Interface is
*** 277,282 ****
--- 277,318 ----
  
     PTHREAD_EXPLICIT_SCHED : constant := 1;
  
+    -----------
+    -- Stack --
+    -----------
+ 
+    Stack_Base_Available : constant Boolean := False;
+    --  Indicates wether the stack base is available on this target.
+ 
+    function Get_Stack_Base (thread : pthread_t) return Address;
+    pragma Inline (Get_Stack_Base);
+    --  returns the stack base of the specified thread.
+    --  Only call this function when Stack_Base_Available is True.
+ 
+    function Get_Page_Size return size_t;
+    function Get_Page_Size return Address;
+    pragma Import (C, Get_Page_Size, "getpagesize");
+    --  returns the size of a page, or 0 if this is not relevant on this
+    --  target
+ 
+    PROT_NONE  : constant := 0;
+    PROT_READ  : constant := 1;
+    PROT_WRITE : constant := 2;
+    PROT_EXEC  : constant := 4;
+    PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
+ 
+    PROT_ON    : constant := PROT_READ;
+    PROT_OFF   : constant := PROT_ALL;
+ 
+    function mprotect (addr : Address; len : size_t; prot : int) return int;
+    pragma Import (C, mprotect);
+ 
+    procedure Hide_Yellow_Zone;
+    --  Every thread except the initial one features an overflow warning area
+    --  just above the overflow guard area on the stack. They are called
+    --  the Yellow Zone and the Red Zone respectively. This procedure hides
+    --  the former so that the latter could be exposed to stack probing.
+ 
     ---------------------------------------
     -- Nonstandard Thread Initialization --
     ---------------------------------------
*************** private
*** 490,495 ****
--- 526,559 ----
  
     type pthread_t is new System.Address;
  
+    type pthread_teb_t is record
+       reserved1     : System.Address;
+       reserved2     : System.Address;
+       size          : unsigned_short;
+       version       : unsigned_char;
+       reserved3     : unsigned_char;
+       external      : unsigned_char;
+       reserved4     : char_array (0 .. 1);
+       creator       : unsigned_char;
+       sequence      : unsigned_long;
+       reserved5     : unsigned_long_array (0 .. 1);
+       per_kt_area   : System.Address;
+       stack_base    : System.Address;
+       stack_reserve : System.Address;
+       stack_yellow  : System.Address;
+       stack_guard   : System.Address;
+       stack_size    : unsigned_long;
+       tsd_values    : System.Address;
+       tsd_count     : unsigned_long;
+       reserved6     : unsigned;
+       reserved7     : unsigned;
+       thread_flags  : unsigned;
+       thd_errno     : int;
+       stack_hiwater : System.Address;
+       home_rad      : unsigned_long;
+    end record;
+    pragma Convention (C, pthread_teb_t);
+ 
     type pthread_cond_t is record
        state     : unsigned;
        valid     : unsigned;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-unixware.adb gcc-4.1.0/gcc/ada/s-osinte-unixware.adb
*** gcc-4.0.2/gcc/ada/s-osinte-unixware.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-unixware.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2002 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-unixware.ads gcc-4.1.0/gcc/ada/s-osinte-unixware.ads
*** gcc-4.0.2/gcc/ada/s-osinte-unixware.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-unixware.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-vms.adb gcc-4.1.0/gcc/ada/s-osinte-vms.adb
*** gcc-4.0.2/gcc/ada/s-osinte-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-vms.ads gcc-4.1.0/gcc/ada/s-osinte-vms.ads
*** gcc-4.0.2/gcc/ada/s-osinte-vms.ads	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-osinte-vms.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2005, Free Software Foundation, Inc.      --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-vxworks.adb gcc-4.1.0/gcc/ada/s-osinte-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-osinte-vxworks.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osinte-vxworks.adb	Mon Sep  5 07:49:24 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
! --             Copyright (C) 1997-2002 Free Software Foundation             --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                   S Y S T E M . O S _ I N T E R F A C E                  --
  --                                                                          --
  --                                   B o d y                                --
  --                                                                          --
! --             Copyright (C) 1997-2005 Free Software Foundation             --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Interface is
*** 47,52 ****
--- 47,74 ----
     Low_Priority : constant := 255;
     --  VxWorks native (default) lowest scheduling priority.
  
+    ----------
+    -- kill --
+    ----------
+ 
+    function kill (pid : t_id; sig : Signal) return int is
+       function c_kill (pid : t_id; sig : Signal) return int;
+       pragma Import (C, c_kill, "kill");
+    begin
+       return c_kill (pid, sig);
+    end kill;
+ 
+    --------------------
+    -- Set_Time_Slice --
+    --------------------
+ 
+    function Set_Time_Slice (ticks : int) return int is
+       function kernelTimeSlice (ticks : int) return int;
+       pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
+    begin
+       return kernelTimeSlice (ticks);
+    end Set_Time_Slice;
+ 
     -------------
     -- sigwait --
     -------------
*************** package body System.OS_Interface is
*** 161,164 ****
--- 183,195 ----
        return int (Ticks);
     end To_Clock_Ticks;
  
+    ----------------
+    -- VX_FP_TASK --
+    ----------------
+ 
+    function VX_FP_TASK return int is
+    begin
+       return 16#0008#;
+    end VX_FP_TASK;
+ 
  end System.OS_Interface;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osinte-vxworks.ads gcc-4.1.0/gcc/ada/s-osinte-vxworks.ads
*** gcc-4.0.2/gcc/ada/s-osinte-vxworks.ads	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/s-osinte-vxworks.ads	Mon Sep  5 07:49:24 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                    S Y S T E M . O S _ I N T E R F A C E                 --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                    S Y S T E M . O S _ I N T E R F A C E                 --
  --                                                                          --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.VxWorks;
*** 46,56 ****
  package System.OS_Interface is
     pragma Preelaborate;
  
!    subtype int         is Interfaces.C.int;
!    subtype short       is Short_Integer;
!    type long           is new Long_Integer;
!    type unsigned_long  is mod 2 ** long'Size;
!    type size_t         is mod 2 ** Standard'Address_Size;
  
     -----------
     -- Errno --
--- 46,56 ----
  package System.OS_Interface is
     pragma Preelaborate;
  
!    subtype int        is Interfaces.C.int;
!    subtype short      is Short_Integer;
!    type long          is new Long_Integer;
!    type unsigned_long is mod 2 ** long'Size;
!    type size_t        is mod 2 ** Standard'Address_Size;
  
     -----------
     -- Errno --
*************** package System.OS_Interface is
*** 153,164 ****
     subtype Thread_Id is t_id;
  
     function kill (pid : t_id; sig : Signal) return int;
!    pragma Import (C, kill, "kill");
  
-    --  VxWorks doesn't have getpid; taskIdSelf is the equivalent
-    --  routine.
     function getpid return t_id;
     pragma Import (C, getpid, "taskIdSelf");
  
     ----------
     -- Time --
--- 153,163 ----
     subtype Thread_Id is t_id;
  
     function kill (pid : t_id; sig : Signal) return int;
!    pragma Inline (kill);
  
     function getpid return t_id;
     pragma Import (C, getpid, "taskIdSelf");
+    --  VxWorks doesn't have getpid; taskIdSelf is the equivalent routine.
  
     ----------
     -- Time --
*************** package System.OS_Interface is
*** 183,189 ****
     pragma Inline (To_Timespec);
  
     function To_Clock_Ticks (D : Duration) return int;
!    --  Convert a duration value (in seconds) into clock ticks.
  
     function clock_gettime
       (clock_id : clockid_t; tp : access timespec) return int;
--- 182,188 ----
     pragma Inline (To_Timespec);
  
     function To_Clock_Ticks (D : Duration) return int;
!    --  Convert a duration value (in seconds) into clock ticks
  
     function clock_gettime
       (clock_id : clockid_t; tp : access timespec) return int;
*************** package System.OS_Interface is
*** 230,235 ****
--- 229,243 ----
     function taskIsSuspended (tid : t_id) return int;
     pragma Import (C, taskIsSuspended, "taskIsSuspended");
  
+    function taskDelay (ticks : int) return int;
+    procedure taskDelay (ticks : int);
+    pragma Import (C, taskDelay, "taskDelay");
+ 
+    function sysClkRateGet return int;
+    pragma Import (C, sysClkRateGet, "sysClkRateGet");
+ 
+    --  VxWorks 5.x specific functions
+ 
     function taskVarAdd
       (tid : t_id; pVar : access System.Address) return int;
     pragma Import (C, taskVarAdd, "taskVarAdd");
*************** package System.OS_Interface is
*** 249,268 ****
        pVar : access System.Address) return int;
     pragma Import (C, taskVarGet, "taskVarGet");
  
!    function taskDelay (ticks : int) return int;
!    procedure taskDelay (ticks : int);
!    pragma Import (C, taskDelay, "taskDelay");
  
!    function sysClkRateGet return int;
!    pragma Import (C, sysClkRateGet, "sysClkRateGet");
  
     --  Option flags for taskSpawn
  
     VX_UNBREAKABLE    : constant := 16#0002#;
-    VX_FP_TASK        : constant := 16#0008#;
     VX_FP_PRIVATE_ENV : constant := 16#0080#;
     VX_NO_STACK_FILL  : constant := 16#0100#;
  
     function taskSpawn
       (name          : System.Address;  --  Pointer to task name
        priority      : int;
--- 257,282 ----
        pVar : access System.Address) return int;
     pragma Import (C, taskVarGet, "taskVarGet");
  
!    --  VxWorks 6.x specific functions
  
!    function tlsKeyCreate return int;
!    pragma Import (C, tlsKeyCreate, "tlsKeyCreate");
! 
!    function tlsValueGet (key : int) return System.Address;
!    pragma Import (C, tlsValueGet, "tlsValueGet");
! 
!    function tlsValueSet (key : int; value : System.Address) return STATUS;
!    pragma Import (C, tlsValueSet, "tlsValueSet");
  
     --  Option flags for taskSpawn
  
     VX_UNBREAKABLE    : constant := 16#0002#;
     VX_FP_PRIVATE_ENV : constant := 16#0080#;
     VX_NO_STACK_FILL  : constant := 16#0100#;
  
+    function VX_FP_TASK return int;
+    pragma Inline (VX_FP_TASK);
+ 
     function taskSpawn
       (name          : System.Address;  --  Pointer to task name
        priority      : int;
*************** package System.OS_Interface is
*** 284,291 ****
     procedure taskDelete (tid : t_id);
     pragma Import (C, taskDelete, "taskDelete");
  
!    function kernelTimeSlice (ticks : int) return int;
!    pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
  
     function taskPriorityGet (tid : t_id; pPriority : access int) return int;
     pragma Import (C, taskPriorityGet, "taskPriorityGet");
--- 298,307 ----
     procedure taskDelete (tid : t_id);
     pragma Import (C, taskDelete, "taskDelete");
  
!    function Set_Time_Slice (ticks : int) return int;
!    pragma Inline (Set_Time_Slice);
!    --  Calls kernelTimeSlice under VxWorks 5.x
!    --  Do nothing under VxWorks 6.x
  
     function taskPriorityGet (tid : t_id; pPriority : access int) return int;
     pragma Import (C, taskPriorityGet, "taskPriorityGet");
*************** package System.OS_Interface is
*** 293,299 ****
     function taskPrioritySet (tid : t_id; newPriority : int) return int;
     pragma Import (C, taskPrioritySet, "taskPrioritySet");
  
!    --  Semaphore creation flags.
  
     SEM_Q_FIFO         : constant := 0;
     SEM_Q_PRIORITY     : constant := 1;
--- 309,315 ----
     function taskPrioritySet (tid : t_id; newPriority : int) return int;
     pragma Import (C, taskPrioritySet, "taskPrioritySet");
  
!    --  Semaphore creation flags
  
     SEM_Q_FIFO         : constant := 0;
     SEM_Q_PRIORITY     : constant := 1;
*************** package System.OS_Interface is
*** 305,321 ****
     SEM_EMPTY : constant := 0;
     SEM_FULL  : constant := 1;
  
!    --  Semaphore take (semTake) time constants.
  
     WAIT_FOREVER : constant := -1;
     NO_WAIT      : constant := 0;
  
!    --  Error codes (errno).  The lower level 16 bits are the
!    --  error code, with the upper 16 bits representing the
!    --  module number in which the error occurred.  By convention,
!    --  the module number is 0 for UNIX errors.  VxWorks reserves
!    --  module numbers 1-500, with the remaining module numbers
!    --  being available for user applications.
  
     M_objLib                 : constant := 61 * 2**16;
     --  semTake() failure with ticks = NO_WAIT
--- 321,336 ----
     SEM_EMPTY : constant := 0;
     SEM_FULL  : constant := 1;
  
!    --  Semaphore take (semTake) time constants
  
     WAIT_FOREVER : constant := -1;
     NO_WAIT      : constant := 0;
  
!    --  Error codes (errno). The lower level 16 bits are the error code, with
!    --  the upper 16 bits representing the module number in which the error
!    --  occurred. By convention, the module number is 0 for UNIX errors. VxWorks
!    --  reserves module numbers 1-500, with the remaining module numbers being
!    --  available for user applications.
  
     M_objLib                 : constant := 61 * 2**16;
     --  semTake() failure with ticks = NO_WAIT
*************** package System.OS_Interface is
*** 326,364 ****
     type SEM_ID is new System.Address;
     --  typedef struct semaphore *SEM_ID;
  
!    --  We use two different kinds of VxWorks semaphores: mutex
!    --  and binary semaphores.  A null ID is returned when
!    --  a semaphore cannot be created.
  
     function semBCreate (options : int; initial_state : int) return SEM_ID;
     --  Create a binary semaphore. Return ID, or 0 if memory could not
     --  be allocated.
-    pragma Import (C, semBCreate, "semBCreate");
  
     function semMCreate (options : int) return SEM_ID;
     pragma Import (C, semMCreate, "semMCreate");
  
     function semDelete (Sem : SEM_ID) return int;
-    --  Delete a semaphore
     pragma Import (C, semDelete, "semDelete");
  
     function semGive (Sem : SEM_ID) return int;
     pragma Import (C, semGive, "semGive");
  
     function semTake (Sem : SEM_ID; timeout : int) return int;
     --  Attempt to take binary semaphore.  Error is returned if operation
     --  times out
-    pragma Import (C, semTake, "semTake");
  
     function semFlush (SemID : SEM_ID) return STATUS;
-    --  Release all threads blocked on the semaphore
     pragma Import (C, semFlush, "semFlush");
! 
!    function taskLock return int;
!    pragma Import (C, taskLock, "taskLock");
! 
!    function taskUnlock return int;
!    pragma Import (C, taskUnlock, "taskUnlock");
  
  private
     type sigset_t is new long;
--- 341,372 ----
     type SEM_ID is new System.Address;
     --  typedef struct semaphore *SEM_ID;
  
!    --  We use two different kinds of VxWorks semaphores: mutex and binary
!    --  semaphores. A null ID is returned when a semaphore cannot be created.
  
     function semBCreate (options : int; initial_state : int) return SEM_ID;
+    pragma Import (C, semBCreate, "semBCreate");
     --  Create a binary semaphore. Return ID, or 0 if memory could not
     --  be allocated.
  
     function semMCreate (options : int) return SEM_ID;
     pragma Import (C, semMCreate, "semMCreate");
  
     function semDelete (Sem : SEM_ID) return int;
     pragma Import (C, semDelete, "semDelete");
+    --  Delete a semaphore
  
     function semGive (Sem : SEM_ID) return int;
     pragma Import (C, semGive, "semGive");
  
     function semTake (Sem : SEM_ID; timeout : int) return int;
+    pragma Import (C, semTake, "semTake");
     --  Attempt to take binary semaphore.  Error is returned if operation
     --  times out
  
     function semFlush (SemID : SEM_ID) return STATUS;
     pragma Import (C, semFlush, "semFlush");
!    --  Release all threads blocked on the semaphore
  
  private
     type sigset_t is new long;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-mingw.adb gcc-4.1.0/gcc/ada/s-osprim-mingw.adb
*** gcc-4.0.2/gcc/ada/s-osprim-mingw.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-mingw.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
  
  --  This is the NT version of this package
  
- with Ada.Exceptions;
  with Interfaces.C;
  
  package body System.OS_Primitives is
--- 33,38 ----
*************** package body System.OS_Primitives is
*** 267,286 ****
        end if;
     end Timed_Delay;
  
! --  Package elaboration, get starting time as base
  
! begin
!    if not QueryPerformanceFrequency (Tick_Frequency'Access) then
!       Ada.Exceptions.Raise_Exception
!         (Program_Error'Identity,
!          "cannot get high performance counter frequency");
!    end if;
  
!    Get_Base_Time;
  
!    --  Keep base clock and ticks for the monotonic clock. These values should
!    --  never be changed to ensure proper behavior of the monotonic clock.
  
-    Base_Monotonic_Clock := Base_Clock;
-    Base_Monotonic_Ticks := Base_Ticks;
  end System.OS_Primitives;
--- 266,300 ----
        end if;
     end Timed_Delay;
  
!    ----------------
!    -- Initialize --
!    ----------------
  
!    Initialized : Boolean := False;
  
!    procedure Initialize is
!    begin
!       if Initialized then
!          return;
!       end if;
  
!       Initialized := True;
! 
!       --  Get starting time as base
! 
!       if not QueryPerformanceFrequency (Tick_Frequency'Access) then
!          raise Program_Error
!            with "cannot get high performance counter frequency";
!       end if;
! 
!       Get_Base_Time;
! 
!       --  Keep base clock and ticks for the monotonic clock. These values
!       --  should never be changed to ensure proper behavior of the monotonic
!       --  clock.
! 
!       Base_Monotonic_Clock := Base_Clock;
!       Base_Monotonic_Ticks := Base_Ticks;
!    end Initialize;
  
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-os2.adb gcc-4.1.0/gcc/ada/s-osprim-os2.adb
*** gcc-4.0.2/gcc/ada/s-osprim-os2.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-os2.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2001 Free Software Foundation, Inc.           --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 167,172 ****
        end if;
     end Timed_Delay;
  
! begin
!    Set_Epoch_Offset;
  end System.OS_Primitives;
--- 167,184 ----
        end if;
     end Timed_Delay;
  
!    ----------------
!    -- Initialize --
!    ----------------
! 
!    Initialized : Boolean := False;
! 
!    procedure Initialize is
!    begin
!       if not Initialized then
!          Initialized := True;
!          Set_Epoch_Offset;
!       end if;
!    end Initialize;
! 
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-posix.adb gcc-4.1.0/gcc/ada/s-osprim-posix.adb
*** gcc-4.0.2/gcc/ada/s-osprim-posix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-posix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 156,159 ****
--- 156,168 ----
        end if;
     end Timed_Delay;
  
+    ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize is
+    begin
+       null;
+    end Initialize;
+ 
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-solaris.adb gcc-4.1.0/gcc/ada/s-osprim-solaris.adb
*** gcc-4.0.2/gcc/ada/s-osprim-solaris.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-solaris.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 121,124 ****
--- 121,133 ----
        end if;
     end Timed_Delay;
  
+    ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize is
+    begin
+       null;
+    end Initialize;
+ 
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-unix.adb gcc-4.1.0/gcc/ada/s-osprim-unix.adb
*** gcc-4.0.2/gcc/ada/s-osprim-unix.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-unix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 121,124 ****
--- 121,133 ----
        end if;
     end Timed_Delay;
  
+    ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize is
+    begin
+       null;
+    end Initialize;
+ 
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-vms.adb gcc-4.1.0/gcc/ada/s-osprim-vms.adb
*** gcc-4.0.2/gcc/ada/s-osprim-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-vms.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 45,58 ****
     pragma Import (C, Get_GMToff, "get_gmtoff");
     --  Get the offset from GMT for this timezone
  
!    VMS_Epoch_Offset : constant Long_Integer :=
!                         10_000_000 *
!                           (3_506_716_800 + Long_Integer (Get_GMToff));
     --  The offset between the Unix Epoch and the VMS Epoch
  
     subtype Cond_Value_Type is System.Aux_DEC.Unsigned_Longword;
     --  Condition Value return type
  
     ----------------
     -- Sys_Schdwk --
     ----------------
--- 45,66 ----
     pragma Import (C, Get_GMToff, "get_gmtoff");
     --  Get the offset from GMT for this timezone
  
!    function VMS_Epoch_Offset return Long_Integer;
!    pragma Inline (VMS_Epoch_Offset);
     --  The offset between the Unix Epoch and the VMS Epoch
  
     subtype Cond_Value_Type is System.Aux_DEC.Unsigned_Longword;
     --  Condition Value return type
  
+    ----------------------
+    -- VMS_Epoch_Offset --
+    ----------------------
+ 
+    function VMS_Epoch_Offset return Long_Integer is
+    begin
+       return 10_000_000 * (3_506_716_800 + Long_Integer (Get_GMToff));
+    end VMS_Epoch_Offset;
+ 
     ----------------
     -- Sys_Schdwk --
     ----------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-vms.ads gcc-4.1.0/gcc/ada/s-osprim-vms.ads
*** gcc-4.0.2/gcc/ada/s-osprim-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-osprim-vms.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,45 ****
  --  delays in non tasking applications on Alpha/VMS
  
  --  The choice of the real clock/delay implementation (depending on whether
! --  tasking is involved or not) is done via soft links (see s-tasoli.ads)
  
  --  NEVER add any dependency to tasking packages here
  
  package System.OS_Primitives is
  
     subtype OS_Time is Long_Integer;
     --  System time on VMS is used for performance reasons.
--- 35,46 ----
  --  delays in non tasking applications on Alpha/VMS
  
  --  The choice of the real clock/delay implementation (depending on whether
! --  tasking is involved or not) is done via soft links (see s-soflin.ads)
  
  --  NEVER add any dependency to tasking packages here
  
  package System.OS_Primitives is
+    pragma Preelaborate;
  
     subtype OS_Time is Long_Integer;
     --  System time on VMS is used for performance reasons.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim-vxworks.adb gcc-4.1.0/gcc/ada/s-osprim-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-osprim-vxworks.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-osprim-vxworks.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.OS_Primitives is
*** 158,161 ****
--- 158,170 ----
        end if;
     end Timed_Delay;
  
+    ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize is
+    begin
+       null;
+    end Initialize;
+ 
  end System.OS_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-osprim.ads gcc-4.1.0/gcc/ada/s-osprim.ads
*** gcc-4.0.2/gcc/ada/s-osprim.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-osprim.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . O S _ P R I M I T I V E S                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,45 ****
  --  delays in non tasking applications.
  
  --  The choice of the real clock/delay implementation (depending on whether
! --  tasking is involved or not) is done via soft links (see s-tasoli.ads)
  
  --  NEVER add any dependency to tasking packages here
  
  package System.OS_Primitives is
  
     Max_Sensible_Delay : constant Duration :=
                            Duration'Min (183 * 24 * 60 * 60.0,
--- 35,46 ----
  --  delays in non tasking applications.
  
  --  The choice of the real clock/delay implementation (depending on whether
! --  tasking is involved or not) is done via soft links (see s-soflin.ads)
  
  --  NEVER add any dependency to tasking packages here
  
  package System.OS_Primitives is
+    pragma Preelaborate;
  
     Max_Sensible_Delay : constant Duration :=
                            Duration'Min (183 * 24 * 60 * 60.0,
*************** package System.OS_Primitives is
*** 53,58 ****
--- 54,64 ----
     --  occurs in high integrity mode with 32-bit words, and possibly on
     --  some specific ports of GNAT), Duration'Last is used instead.
  
+    procedure Initialize;
+    --  Initialize global settings related to this package.
+    --  This procedure should be called before any other subprograms in
+    --  this package. Note that this procedure can be called several times.
+ 
     function Clock return Duration;
     pragma Inline (Clock);
     --  Returns "absolute" time, represented as an offset
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack03.adb gcc-4.1.0/gcc/ada/s-pack03.adb
*** gcc-4.0.2/gcc/ada/s-pack03.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack03.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_03 is
*** 79,85 ****
  
     function Get_03 (Arr : System.Address; N : Natural) return Bits_03 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_03 is
*** 99,105 ****
  
     procedure Set_03 (Arr : System.Address; N : Natural; E : Bits_03) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack03.ads gcc-4.1.0/gcc/ada/s-pack03.ads
*** gcc-4.0.2/gcc/ada/s-pack03.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack03.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handing of packed arrays with Component_Size = 3
  
  package System.Pack_03 is
! pragma Preelaborate (Pack_03);
  
     Bits : constant := 3;
  
--- 34,40 ----
  --  Handing of packed arrays with Component_Size = 3
  
  package System.Pack_03 is
!    pragma Preelaborate;
  
     Bits : constant := 3;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack05.adb gcc-4.1.0/gcc/ada/s-pack05.adb
*** gcc-4.0.2/gcc/ada/s-pack05.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack05.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_05 is
*** 79,85 ****
  
     function Get_05 (Arr : System.Address; N : Natural) return Bits_05 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_05 is
*** 99,105 ****
  
     procedure Set_05 (Arr : System.Address; N : Natural; E : Bits_05) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack05.ads gcc-4.1.0/gcc/ada/s-pack05.ads
*** gcc-4.0.2/gcc/ada/s-pack05.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack05.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-0507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 5
  
  package System.Pack_05 is
! pragma Preelaborate (Pack_05);
  
     Bits : constant := 5;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 5
  
  package System.Pack_05 is
!    pragma Preelaborate;
  
     Bits : constant := 5;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack06.adb gcc-4.1.0/gcc/ada/s-pack06.adb
*** gcc-4.0.2/gcc/ada/s-pack06.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack06.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_06 is
*** 92,98 ****
  
     function Get_06 (Arr : System.Address; N : Natural) return Bits_06 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_06 is
*** 112,118 ****
  
     function GetU_06 (Arr : System.Address; N : Natural) return Bits_06 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack06.ads gcc-4.1.0/gcc/ada/s-pack06.ads
*** gcc-4.0.2/gcc/ada/s-pack06.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack06.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 6
  
  package System.Pack_06 is
! pragma Preelaborate (Pack_06);
  
     Bits : constant := 6;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 6
  
  package System.Pack_06 is
!    pragma Preelaborate;
  
     Bits : constant := 6;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack07.adb gcc-4.1.0/gcc/ada/s-pack07.adb
*** gcc-4.0.2/gcc/ada/s-pack07.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack07.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_07 is
*** 79,85 ****
  
     function Get_07 (Arr : System.Address; N : Natural) return Bits_07 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_07 is
*** 99,105 ****
  
     procedure Set_07 (Arr : System.Address; N : Natural; E : Bits_07) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack07.ads gcc-4.1.0/gcc/ada/s-pack07.ads
*** gcc-4.0.2/gcc/ada/s-pack07.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack07.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-0707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 7
  
  package System.Pack_07 is
! pragma Preelaborate (Pack_07);
  
     Bits : constant := 7;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 7
  
  package System.Pack_07 is
!    pragma Preelaborate;
  
     Bits : constant := 7;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack09.adb gcc-4.1.0/gcc/ada/s-pack09.adb
*** gcc-4.0.2/gcc/ada/s-pack09.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack09.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_09 is
*** 79,85 ****
  
     function Get_09 (Arr : System.Address; N : Natural) return Bits_09 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_09 is
*** 99,105 ****
  
     procedure Set_09 (Arr : System.Address; N : Natural; E : Bits_09) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack09.ads gcc-4.1.0/gcc/ada/s-pack09.ads
*** gcc-4.0.2/gcc/ada/s-pack09.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack09.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 0 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-0907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 9
  
  package System.Pack_09 is
! pragma Preelaborate (Pack_09);
  
     Bits : constant := 9;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 9
  
  package System.Pack_09 is
!    pragma Preelaborate;
  
     Bits : constant := 9;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack10.adb gcc-4.1.0/gcc/ada/s-pack10.adb
*** gcc-4.0.2/gcc/ada/s-pack10.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack10.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_10 is
*** 92,98 ****
  
     function Get_10 (Arr : System.Address; N : Natural) return Bits_10 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_10 is
*** 112,118 ****
  
     function GetU_10 (Arr : System.Address; N : Natural) return Bits_10 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack10.ads gcc-4.1.0/gcc/ada/s-pack10.ads
*** gcc-4.0.2/gcc/ada/s-pack10.ads	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack10.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 10
  
  package System.Pack_10 is
! pragma Preelaborate (Pack_10);
  
     Bits : constant := 10;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 10
  
  package System.Pack_10 is
!    pragma Preelaborate;
  
     Bits : constant := 10;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack11.adb gcc-4.1.0/gcc/ada/s-pack11.adb
*** gcc-4.0.2/gcc/ada/s-pack11.adb	Thu Apr 24 17:54:10 2003
--- gcc-4.1.0/gcc/ada/s-pack11.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_11 is
*** 79,85 ****
  
     function Get_11 (Arr : System.Address; N : Natural) return Bits_11 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_11 is
*** 99,105 ****
  
     procedure Set_11 (Arr : System.Address; N : Natural; E : Bits_11) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack11.ads gcc-4.1.0/gcc/ada/s-pack11.ads
*** gcc-4.0.2/gcc/ada/s-pack11.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack11.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 11
  
  package System.Pack_11 is
! pragma Preelaborate (Pack_11);
  
     Bits : constant := 11;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 11
  
  package System.Pack_11 is
!    pragma Preelaborate;
  
     Bits : constant := 11;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack12.adb gcc-4.1.0/gcc/ada/s-pack12.adb
*** gcc-4.0.2/gcc/ada/s-pack12.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack12.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_12 is
*** 92,98 ****
  
     function Get_12 (Arr : System.Address; N : Natural) return Bits_12 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_12 is
*** 112,118 ****
  
     function GetU_12 (Arr : System.Address; N : Natural) return Bits_12 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack12.ads gcc-4.1.0/gcc/ada/s-pack12.ads
*** gcc-4.0.2/gcc/ada/s-pack12.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack12.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 12
  
  package System.Pack_12 is
! pragma Preelaborate (Pack_12);
  
     Bits : constant := 12;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 12
  
  package System.Pack_12 is
!    pragma Preelaborate;
  
     Bits : constant := 12;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack13.adb gcc-4.1.0/gcc/ada/s-pack13.adb
*** gcc-4.0.2/gcc/ada/s-pack13.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack13.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_13 is
*** 79,85 ****
  
     function Get_13 (Arr : System.Address; N : Natural) return Bits_13 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_13 is
*** 99,105 ****
  
     procedure Set_13 (Arr : System.Address; N : Natural; E : Bits_13) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack13.ads gcc-4.1.0/gcc/ada/s-pack13.ads
*** gcc-4.0.2/gcc/ada/s-pack13.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack13.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 13
  
  package System.Pack_13 is
! pragma Preelaborate (Pack_13);
  
     Bits : constant := 13;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 13
  
  package System.Pack_13 is
!    pragma Preelaborate;
  
     Bits : constant := 13;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack14.adb gcc-4.1.0/gcc/ada/s-pack14.adb
*** gcc-4.0.2/gcc/ada/s-pack14.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack14.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_14 is
*** 92,98 ****
  
     function Get_14 (Arr : System.Address; N : Natural) return Bits_14 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_14 is
*** 112,118 ****
  
     function GetU_14 (Arr : System.Address; N : Natural) return Bits_14 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_14 is
*** 132,138 ****
  
     procedure Set_14 (Arr : System.Address; N : Natural; E : Bits_14) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_14 is
*** 152,158 ****
  
     procedure SetU_14 (Arr : System.Address; N : Natural; E : Bits_14) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack14.ads gcc-4.1.0/gcc/ada/s-pack14.ads
*** gcc-4.0.2/gcc/ada/s-pack14.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack14.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handing of packed arrays with Component_Size = 14
  
  package System.Pack_14 is
! pragma Preelaborate (Pack_14);
  
     Bits : constant := 14;
  
--- 34,40 ----
  --  Handing of packed arrays with Component_Size = 14
  
  package System.Pack_14 is
!    pragma Preelaborate;
  
     Bits : constant := 14;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack15.adb gcc-4.1.0/gcc/ada/s-pack15.adb
*** gcc-4.0.2/gcc/ada/s-pack15.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack15.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_15 is
*** 79,85 ****
  
     function Get_15 (Arr : System.Address; N : Natural) return Bits_15 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_15 is
*** 99,105 ****
  
     procedure Set_15 (Arr : System.Address; N : Natural; E : Bits_15) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack15.ads gcc-4.1.0/gcc/ada/s-pack15.ads
*** gcc-4.0.2/gcc/ada/s-pack15.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack15.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 15
  
  package System.Pack_15 is
! pragma Preelaborate (Pack_15);
  
     Bits : constant := 15;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 15
  
  package System.Pack_15 is
!    pragma Preelaborate;
  
     Bits : constant := 15;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack17.adb gcc-4.1.0/gcc/ada/s-pack17.adb
*** gcc-4.0.2/gcc/ada/s-pack17.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack17.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_17 is
*** 79,85 ****
  
     function Get_17 (Arr : System.Address; N : Natural) return Bits_17 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_17 is
*** 99,105 ****
  
     procedure Set_17 (Arr : System.Address; N : Natural; E : Bits_17) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack17.ads gcc-4.1.0/gcc/ada/s-pack17.ads
*** gcc-4.0.2/gcc/ada/s-pack17.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack17.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 17
  
  package System.Pack_17 is
! pragma Preelaborate (Pack_17);
  
     Bits : constant := 17;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 17
  
  package System.Pack_17 is
!    pragma Preelaborate;
  
     Bits : constant := 17;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack18.adb gcc-4.1.0/gcc/ada/s-pack18.adb
*** gcc-4.0.2/gcc/ada/s-pack18.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack18.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_18 is
*** 92,98 ****
  
     function Get_18 (Arr : System.Address; N : Natural) return Bits_18 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_18 is
*** 112,118 ****
  
     function GetU_18 (Arr : System.Address; N : Natural) return Bits_18 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_18 is
*** 132,138 ****
  
     procedure Set_18 (Arr : System.Address; N : Natural; E : Bits_18) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_18 is
*** 152,158 ****
  
     procedure SetU_18 (Arr : System.Address; N : Natural; E : Bits_18) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack18.ads gcc-4.1.0/gcc/ada/s-pack18.ads
*** gcc-4.0.2/gcc/ada/s-pack18.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack18.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 18
  
  package System.Pack_18 is
! pragma Preelaborate (Pack_18);
  
     Bits : constant := 18;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 18
  
  package System.Pack_18 is
!    pragma Preelaborate;
  
     Bits : constant := 18;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack19.adb gcc-4.1.0/gcc/ada/s-pack19.adb
*** gcc-4.0.2/gcc/ada/s-pack19.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack19.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_19 is
*** 79,85 ****
  
     function Get_19 (Arr : System.Address; N : Natural) return Bits_19 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_19 is
*** 99,105 ****
  
     procedure Set_19 (Arr : System.Address; N : Natural; E : Bits_19) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack19.ads gcc-4.1.0/gcc/ada/s-pack19.ads
*** gcc-4.0.2/gcc/ada/s-pack19.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack19.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 1 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 19
  
  package System.Pack_19 is
! pragma Preelaborate (Pack_19);
  
     Bits : constant := 19;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 19
  
  package System.Pack_19 is
!    pragma Preelaborate;
  
     Bits : constant := 19;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack20.adb gcc-4.1.0/gcc/ada/s-pack20.adb
*** gcc-4.0.2/gcc/ada/s-pack20.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack20.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_20 is
*** 92,98 ****
  
     function Get_20 (Arr : System.Address; N : Natural) return Bits_20 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_20 is
*** 112,118 ****
  
     function GetU_20 (Arr : System.Address; N : Natural) return Bits_20 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_20 is
*** 132,138 ****
  
     procedure Set_20 (Arr : System.Address; N : Natural; E : Bits_20) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_20 is
*** 152,158 ****
  
     procedure SetU_20 (Arr : System.Address; N : Natural; E : Bits_20) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack20.ads gcc-4.1.0/gcc/ada/s-pack20.ads
*** gcc-4.0.2/gcc/ada/s-pack20.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack20.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 20
  
  package System.Pack_20 is
! pragma Preelaborate (Pack_20);
  
     Bits : constant := 20;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 20
  
  package System.Pack_20 is
!    pragma Preelaborate;
  
     Bits : constant := 20;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack21.adb gcc-4.1.0/gcc/ada/s-pack21.adb
*** gcc-4.0.2/gcc/ada/s-pack21.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack21.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_21 is
*** 79,85 ****
  
     function Get_21 (Arr : System.Address; N : Natural) return Bits_21 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_21 is
*** 99,105 ****
  
     procedure Set_21 (Arr : System.Address; N : Natural; E : Bits_21) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack21.ads gcc-4.1.0/gcc/ada/s-pack21.ads
*** gcc-4.0.2/gcc/ada/s-pack21.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack21.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-2107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 21
  
  package System.Pack_21 is
! pragma Preelaborate (Pack_21);
  
     Bits : constant := 21;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 21
  
  package System.Pack_21 is
!    pragma Preelaborate;
  
     Bits : constant := 21;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack22.adb gcc-4.1.0/gcc/ada/s-pack22.adb
*** gcc-4.0.2/gcc/ada/s-pack22.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack22.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_22 is
*** 92,98 ****
  
     function Get_22 (Arr : System.Address; N : Natural) return Bits_22 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_22 is
*** 112,118 ****
  
     function GetU_22 (Arr : System.Address; N : Natural) return Bits_22 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_22 is
*** 132,138 ****
  
     procedure Set_22 (Arr : System.Address; N : Natural; E : Bits_22) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_22 is
*** 152,158 ****
  
     procedure SetU_22 (Arr : System.Address; N : Natural; E : Bits_22) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack22.ads gcc-4.1.0/gcc/ada/s-pack22.ads
*** gcc-4.0.2/gcc/ada/s-pack22.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack22.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 22
  
  package System.Pack_22 is
! pragma Preelaborate (Pack_22);
  
     Bits : constant := 22;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 22
  
  package System.Pack_22 is
!    pragma Preelaborate;
  
     Bits : constant := 22;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack23.adb gcc-4.1.0/gcc/ada/s-pack23.adb
*** gcc-4.0.2/gcc/ada/s-pack23.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack23.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_23 is
*** 79,85 ****
  
     function Get_23 (Arr : System.Address; N : Natural) return Bits_23 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_23 is
*** 99,105 ****
  
     procedure Set_23 (Arr : System.Address; N : Natural; E : Bits_23) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack23.ads gcc-4.1.0/gcc/ada/s-pack23.ads
*** gcc-4.0.2/gcc/ada/s-pack23.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack23.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-2307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 23
  
  package System.Pack_23 is
! pragma Preelaborate (Pack_23);
  
     Bits : constant := 23;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 23
  
  package System.Pack_23 is
!    pragma Preelaborate;
  
     Bits : constant := 23;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack24.adb gcc-4.1.0/gcc/ada/s-pack24.adb
*** gcc-4.0.2/gcc/ada/s-pack24.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack24.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_24 is
*** 92,98 ****
  
     function Get_24 (Arr : System.Address; N : Natural) return Bits_24 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_24 is
*** 112,118 ****
  
     function GetU_24 (Arr : System.Address; N : Natural) return Bits_24 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_24 is
*** 132,138 ****
  
     procedure Set_24 (Arr : System.Address; N : Natural; E : Bits_24) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_24 is
*** 152,158 ****
  
     procedure SetU_24 (Arr : System.Address; N : Natural; E : Bits_24) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack24.ads gcc-4.1.0/gcc/ada/s-pack24.ads
*** gcc-4.0.2/gcc/ada/s-pack24.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack24.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 24
  
  package System.Pack_24 is
! pragma Preelaborate (Pack_24);
  
     Bits : constant := 24;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 24
  
  package System.Pack_24 is
!    pragma Preelaborate;
  
     Bits : constant := 24;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack25.adb gcc-4.1.0/gcc/ada/s-pack25.adb
*** gcc-4.0.2/gcc/ada/s-pack25.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack25.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack25.ads gcc-4.1.0/gcc/ada/s-pack25.ads
*** gcc-4.0.2/gcc/ada/s-pack25.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack25.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-2507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 25
  
  package System.Pack_25 is
! pragma Preelaborate (Pack_25);
  
     Bits : constant := 25;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 25
  
  package System.Pack_25 is
!    pragma Preelaborate;
  
     Bits : constant := 25;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack26.adb gcc-4.1.0/gcc/ada/s-pack26.adb
*** gcc-4.0.2/gcc/ada/s-pack26.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack26.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_26 is
*** 92,98 ****
  
     function Get_26 (Arr : System.Address; N : Natural) return Bits_26 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_26 is
*** 112,118 ****
  
     function GetU_26 (Arr : System.Address; N : Natural) return Bits_26 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_26 is
*** 132,138 ****
  
     procedure Set_26 (Arr : System.Address; N : Natural; E : Bits_26) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_26 is
*** 152,158 ****
  
     procedure SetU_26 (Arr : System.Address; N : Natural; E : Bits_26) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack26.ads gcc-4.1.0/gcc/ada/s-pack26.ads
*** gcc-4.0.2/gcc/ada/s-pack26.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack26.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 26
  
  package System.Pack_26 is
! pragma Preelaborate (Pack_26);
  
     Bits : constant := 26;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 26
  
  package System.Pack_26 is
!    pragma Preelaborate;
  
     Bits : constant := 26;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack27.adb gcc-4.1.0/gcc/ada/s-pack27.adb
*** gcc-4.0.2/gcc/ada/s-pack27.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack27.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_27 is
*** 79,85 ****
  
     function Get_27 (Arr : System.Address; N : Natural) return Bits_27 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_27 is
*** 99,105 ****
  
     procedure Set_27 (Arr : System.Address; N : Natural; E : Bits_27) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack27.ads gcc-4.1.0/gcc/ada/s-pack27.ads
*** gcc-4.0.2/gcc/ada/s-pack27.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack27.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-2707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 27
  
  package System.Pack_27 is
! pragma Preelaborate (Pack_27);
  
     Bits : constant := 27;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 27
  
  package System.Pack_27 is
!    pragma Preelaborate;
  
     Bits : constant := 27;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack28.adb gcc-4.1.0/gcc/ada/s-pack28.adb
*** gcc-4.0.2/gcc/ada/s-pack28.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack28.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_28 is
*** 92,98 ****
  
     function Get_28 (Arr : System.Address; N : Natural) return Bits_28 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_28 is
*** 112,118 ****
  
     function GetU_28 (Arr : System.Address; N : Natural) return Bits_28 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_28 is
*** 132,138 ****
  
     procedure Set_28 (Arr : System.Address; N : Natural; E : Bits_28) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_28 is
*** 152,158 ****
  
     procedure SetU_28 (Arr : System.Address; N : Natural; E : Bits_28) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack28.ads gcc-4.1.0/gcc/ada/s-pack28.ads
*** gcc-4.0.2/gcc/ada/s-pack28.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack28.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 28
  
  package System.Pack_28 is
! pragma Preelaborate (Pack_28);
  
     Bits : constant := 28;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 28
  
  package System.Pack_28 is
!    pragma Preelaborate;
  
     Bits : constant := 28;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack29.adb gcc-4.1.0/gcc/ada/s-pack29.adb
*** gcc-4.0.2/gcc/ada/s-pack29.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack29.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_29 is
*** 79,85 ****
  
     function Get_29 (Arr : System.Address; N : Natural) return Bits_29 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_29 is
*** 99,105 ****
  
     procedure Set_29 (Arr : System.Address; N : Natural; E : Bits_29) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack29.ads gcc-4.1.0/gcc/ada/s-pack29.ads
*** gcc-4.0.2/gcc/ada/s-pack29.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack29.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 2 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-2907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 29
  
  package System.Pack_29 is
! pragma Preelaborate (Pack_29);
  
     Bits : constant := 29;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 29
  
  package System.Pack_29 is
!    pragma Preelaborate;
  
     Bits : constant := 29;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack30.adb gcc-4.1.0/gcc/ada/s-pack30.adb
*** gcc-4.0.2/gcc/ada/s-pack30.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack30.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_30 is
*** 92,98 ****
  
     function Get_30 (Arr : System.Address; N : Natural) return Bits_30 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_30 is
*** 112,118 ****
  
     function GetU_30 (Arr : System.Address; N : Natural) return Bits_30 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_30 is
*** 132,138 ****
  
     procedure Set_30 (Arr : System.Address; N : Natural; E : Bits_30) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_30 is
*** 152,158 ****
  
     procedure SetU_30 (Arr : System.Address; N : Natural; E : Bits_30) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack30.ads gcc-4.1.0/gcc/ada/s-pack30.ads
*** gcc-4.0.2/gcc/ada/s-pack30.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack30.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 30
  
  package System.Pack_30 is
! pragma Preelaborate (Pack_30);
  
     Bits : constant := 30;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 30
  
  package System.Pack_30 is
!    pragma Preelaborate;
  
     Bits : constant := 30;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack31.adb gcc-4.1.0/gcc/ada/s-pack31.adb
*** gcc-4.0.2/gcc/ada/s-pack31.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack31.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_31 is
*** 79,85 ****
  
     function Get_31 (Arr : System.Address; N : Natural) return Bits_31 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_31 is
*** 99,105 ****
  
     procedure Set_31 (Arr : System.Address; N : Natural; E : Bits_31) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack31.ads gcc-4.1.0/gcc/ada/s-pack31.ads
*** gcc-4.0.2/gcc/ada/s-pack31.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack31.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-3107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 31
  
  package System.Pack_31 is
! pragma Preelaborate (Pack_31);
  
     Bits : constant := 31;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 31
  
  package System.Pack_31 is
!    pragma Preelaborate;
  
     Bits : constant := 31;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack33.adb gcc-4.1.0/gcc/ada/s-pack33.adb
*** gcc-4.0.2/gcc/ada/s-pack33.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack33.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_33 is
*** 79,85 ****
  
     function Get_33 (Arr : System.Address; N : Natural) return Bits_33 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_33 is
*** 99,105 ****
  
     procedure Set_33 (Arr : System.Address; N : Natural; E : Bits_33) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack33.ads gcc-4.1.0/gcc/ada/s-pack33.ads
*** gcc-4.0.2/gcc/ada/s-pack33.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack33.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-3307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 33
  
  package System.Pack_33 is
! pragma Preelaborate (Pack_33);
  
     Bits : constant := 33;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 33
  
  package System.Pack_33 is
!    pragma Preelaborate;
  
     Bits : constant := 33;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack34.adb gcc-4.1.0/gcc/ada/s-pack34.adb
*** gcc-4.0.2/gcc/ada/s-pack34.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack34.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_34 is
*** 92,98 ****
  
     function Get_34 (Arr : System.Address; N : Natural) return Bits_34 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_34 is
*** 112,118 ****
  
     function GetU_34 (Arr : System.Address; N : Natural) return Bits_34 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_34 is
*** 132,138 ****
  
     procedure Set_34 (Arr : System.Address; N : Natural; E : Bits_34) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_34 is
*** 152,158 ****
  
     procedure SetU_34 (Arr : System.Address; N : Natural; E : Bits_34) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack34.ads gcc-4.1.0/gcc/ada/s-pack34.ads
*** gcc-4.0.2/gcc/ada/s-pack34.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack34.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 34
  
  package System.Pack_34 is
! pragma Preelaborate (Pack_34);
  
     Bits : constant := 34;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 34
  
  package System.Pack_34 is
!    pragma Preelaborate;
  
     Bits : constant := 34;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack35.adb gcc-4.1.0/gcc/ada/s-pack35.adb
*** gcc-4.0.2/gcc/ada/s-pack35.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack35.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_35 is
*** 79,85 ****
  
     function Get_35 (Arr : System.Address; N : Natural) return Bits_35 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_35 is
*** 99,105 ****
  
     procedure Set_35 (Arr : System.Address; N : Natural; E : Bits_35) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack35.ads gcc-4.1.0/gcc/ada/s-pack35.ads
*** gcc-4.0.2/gcc/ada/s-pack35.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack35.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-3507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 35
  
  package System.Pack_35 is
! pragma Preelaborate (Pack_35);
  
     Bits : constant := 35;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 35
  
  package System.Pack_35 is
!    pragma Preelaborate;
  
     Bits : constant := 35;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack36.adb gcc-4.1.0/gcc/ada/s-pack36.adb
*** gcc-4.0.2/gcc/ada/s-pack36.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack36.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_36 is
*** 92,98 ****
  
     function Get_36 (Arr : System.Address; N : Natural) return Bits_36 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_36 is
*** 112,118 ****
  
     function GetU_36 (Arr : System.Address; N : Natural) return Bits_36 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_36 is
*** 132,138 ****
  
     procedure Set_36 (Arr : System.Address; N : Natural; E : Bits_36) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_36 is
*** 152,158 ****
  
     procedure SetU_36 (Arr : System.Address; N : Natural; E : Bits_36) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack36.ads gcc-4.1.0/gcc/ada/s-pack36.ads
*** gcc-4.0.2/gcc/ada/s-pack36.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack36.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 36
  
  package System.Pack_36 is
! pragma Preelaborate (Pack_36);
  
     Bits : constant := 36;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 36
  
  package System.Pack_36 is
!    pragma Preelaborate;
  
     Bits : constant := 36;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack37.adb gcc-4.1.0/gcc/ada/s-pack37.adb
*** gcc-4.0.2/gcc/ada/s-pack37.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack37.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_37 is
*** 79,85 ****
  
     function Get_37 (Arr : System.Address; N : Natural) return Bits_37 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_37 is
*** 99,105 ****
  
     procedure Set_37 (Arr : System.Address; N : Natural; E : Bits_37) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack37.ads gcc-4.1.0/gcc/ada/s-pack37.ads
*** gcc-4.0.2/gcc/ada/s-pack37.ads	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack37.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-3707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 37
  
  package System.Pack_37 is
! pragma Preelaborate (Pack_37);
  
     Bits : constant := 37;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 37
  
  package System.Pack_37 is
!    pragma Preelaborate;
  
     Bits : constant := 37;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack38.adb gcc-4.1.0/gcc/ada/s-pack38.adb
*** gcc-4.0.2/gcc/ada/s-pack38.adb	Thu Apr 24 17:54:11 2003
--- gcc-4.1.0/gcc/ada/s-pack38.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_38 is
*** 92,98 ****
  
     function Get_38 (Arr : System.Address; N : Natural) return Bits_38 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_38 is
*** 112,118 ****
  
     function GetU_38 (Arr : System.Address; N : Natural) return Bits_38 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_38 is
*** 132,138 ****
  
     procedure Set_38 (Arr : System.Address; N : Natural; E : Bits_38) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_38 is
*** 152,158 ****
  
     procedure SetU_38 (Arr : System.Address; N : Natural; E : Bits_38) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack38.ads gcc-4.1.0/gcc/ada/s-pack38.ads
*** gcc-4.0.2/gcc/ada/s-pack38.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack38.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 38
  
  package System.Pack_38 is
! pragma Preelaborate (Pack_38);
  
     Bits : constant := 38;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 38
  
  package System.Pack_38 is
!    pragma Preelaborate;
  
     Bits : constant := 38;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack39.adb gcc-4.1.0/gcc/ada/s-pack39.adb
*** gcc-4.0.2/gcc/ada/s-pack39.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack39.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_39 is
*** 79,85 ****
  
     function Get_39 (Arr : System.Address; N : Natural) return Bits_39 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_39 is
*** 99,105 ****
  
     procedure Set_39 (Arr : System.Address; N : Natural; E : Bits_39) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack39.ads gcc-4.1.0/gcc/ada/s-pack39.ads
*** gcc-4.0.2/gcc/ada/s-pack39.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack39.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 3 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-3907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 39
  
  package System.Pack_39 is
! pragma Preelaborate (Pack_39);
  
     Bits : constant := 39;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 39
  
  package System.Pack_39 is
!    pragma Preelaborate;
  
     Bits : constant := 39;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack40.adb gcc-4.1.0/gcc/ada/s-pack40.adb
*** gcc-4.0.2/gcc/ada/s-pack40.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack40.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_40 is
*** 92,98 ****
  
     function Get_40 (Arr : System.Address; N : Natural) return Bits_40 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_40 is
*** 112,118 ****
  
     function GetU_40 (Arr : System.Address; N : Natural) return Bits_40 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_40 is
*** 132,138 ****
  
     procedure Set_40 (Arr : System.Address; N : Natural; E : Bits_40) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_40 is
*** 152,158 ****
  
     procedure SetU_40 (Arr : System.Address; N : Natural; E : Bits_40) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack40.ads gcc-4.1.0/gcc/ada/s-pack40.ads
*** gcc-4.0.2/gcc/ada/s-pack40.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack40.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 40
  
  package System.Pack_40 is
! pragma Preelaborate (Pack_40);
  
     Bits : constant := 40;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 40
  
  package System.Pack_40 is
!    pragma Preelaborate;
  
     Bits : constant := 40;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack41.adb gcc-4.1.0/gcc/ada/s-pack41.adb
*** gcc-4.0.2/gcc/ada/s-pack41.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack41.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_41 is
*** 79,85 ****
  
     function Get_41 (Arr : System.Address; N : Natural) return Bits_41 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_41 is
*** 99,105 ****
  
     procedure Set_41 (Arr : System.Address; N : Natural; E : Bits_41) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack41.ads gcc-4.1.0/gcc/ada/s-pack41.ads
*** gcc-4.0.2/gcc/ada/s-pack41.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack41.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-4107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 41
  
  package System.Pack_41 is
! pragma Preelaborate (Pack_41);
  
     Bits : constant := 41;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 41
  
  package System.Pack_41 is
!    pragma Preelaborate;
  
     Bits : constant := 41;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack42.adb gcc-4.1.0/gcc/ada/s-pack42.adb
*** gcc-4.0.2/gcc/ada/s-pack42.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack42.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_42 is
*** 92,98 ****
  
     function Get_42 (Arr : System.Address; N : Natural) return Bits_42 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_42 is
*** 112,118 ****
  
     function GetU_42 (Arr : System.Address; N : Natural) return Bits_42 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_42 is
*** 132,138 ****
  
     procedure Set_42 (Arr : System.Address; N : Natural; E : Bits_42) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_42 is
*** 152,158 ****
  
     procedure SetU_42 (Arr : System.Address; N : Natural; E : Bits_42) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack42.ads gcc-4.1.0/gcc/ada/s-pack42.ads
*** gcc-4.0.2/gcc/ada/s-pack42.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack42.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 42
  
  package System.Pack_42 is
! pragma Preelaborate (Pack_42);
  
     Bits : constant := 42;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 42
  
  package System.Pack_42 is
!    pragma Preelaborate;
  
     Bits : constant := 42;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack43.adb gcc-4.1.0/gcc/ada/s-pack43.adb
*** gcc-4.0.2/gcc/ada/s-pack43.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack43.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_43 is
*** 79,85 ****
  
     function Get_43 (Arr : System.Address; N : Natural) return Bits_43 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_43 is
*** 99,105 ****
  
     procedure Set_43 (Arr : System.Address; N : Natural; E : Bits_43) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack43.ads gcc-4.1.0/gcc/ada/s-pack43.ads
*** gcc-4.0.2/gcc/ada/s-pack43.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack43.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-4307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 43
  
  package System.Pack_43 is
! pragma Preelaborate (Pack_43);
  
     Bits : constant := 43;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 43
  
  package System.Pack_43 is
!    pragma Preelaborate;
  
     Bits : constant := 43;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack44.adb gcc-4.1.0/gcc/ada/s-pack44.adb
*** gcc-4.0.2/gcc/ada/s-pack44.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack44.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_44 is
*** 92,98 ****
  
     function Get_44 (Arr : System.Address; N : Natural) return Bits_44 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_44 is
*** 112,118 ****
  
     function GetU_44 (Arr : System.Address; N : Natural) return Bits_44 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_44 is
*** 132,138 ****
  
     procedure Set_44 (Arr : System.Address; N : Natural; E : Bits_44) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_44 is
*** 152,158 ****
  
     procedure SetU_44 (Arr : System.Address; N : Natural; E : Bits_44) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack44.ads gcc-4.1.0/gcc/ada/s-pack44.ads
*** gcc-4.0.2/gcc/ada/s-pack44.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack44.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 44
  
  package System.Pack_44 is
! pragma Preelaborate (Pack_44);
  
     Bits : constant := 44;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 44
  
  package System.Pack_44 is
!    pragma Preelaborate;
  
     Bits : constant := 44;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack45.adb gcc-4.1.0/gcc/ada/s-pack45.adb
*** gcc-4.0.2/gcc/ada/s-pack45.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack45.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_45 is
*** 79,85 ****
  
     function Get_45 (Arr : System.Address; N : Natural) return Bits_45 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_45 is
*** 99,105 ****
  
     procedure Set_45 (Arr : System.Address; N : Natural; E : Bits_45) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack45.ads gcc-4.1.0/gcc/ada/s-pack45.ads
*** gcc-4.0.2/gcc/ada/s-pack45.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack45.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-4507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 45
  
  package System.Pack_45 is
! pragma Preelaborate (Pack_45);
  
     Bits : constant := 45;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 45
  
  package System.Pack_45 is
!    pragma Preelaborate;
  
     Bits : constant := 45;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack46.adb gcc-4.1.0/gcc/ada/s-pack46.adb
*** gcc-4.0.2/gcc/ada/s-pack46.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack46.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_46 is
*** 92,98 ****
  
     function Get_46 (Arr : System.Address; N : Natural) return Bits_46 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_46 is
*** 112,118 ****
  
     function GetU_46 (Arr : System.Address; N : Natural) return Bits_46 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_46 is
*** 132,138 ****
  
     procedure Set_46 (Arr : System.Address; N : Natural; E : Bits_46) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_46 is
*** 152,158 ****
  
     procedure SetU_46 (Arr : System.Address; N : Natural; E : Bits_46) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack46.ads gcc-4.1.0/gcc/ada/s-pack46.ads
*** gcc-4.0.2/gcc/ada/s-pack46.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack46.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 46
  
  package System.Pack_46 is
! pragma Preelaborate (Pack_46);
  
     Bits : constant := 46;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 46
  
  package System.Pack_46 is
!    pragma Preelaborate;
  
     Bits : constant := 46;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack47.adb gcc-4.1.0/gcc/ada/s-pack47.adb
*** gcc-4.0.2/gcc/ada/s-pack47.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack47.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_47 is
*** 79,85 ****
  
     function Get_47 (Arr : System.Address; N : Natural) return Bits_47 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_47 is
*** 99,105 ****
  
     procedure Set_47 (Arr : System.Address; N : Natural; E : Bits_47) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack47.ads gcc-4.1.0/gcc/ada/s-pack47.ads
*** gcc-4.0.2/gcc/ada/s-pack47.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack47.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-4707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 47
  
  package System.Pack_47 is
! pragma Preelaborate (Pack_47);
  
     Bits : constant := 47;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 47
  
  package System.Pack_47 is
!    pragma Preelaborate;
  
     Bits : constant := 47;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack48.adb gcc-4.1.0/gcc/ada/s-pack48.adb
*** gcc-4.0.2/gcc/ada/s-pack48.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack48.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_48 is
*** 92,98 ****
  
     function Get_48 (Arr : System.Address; N : Natural) return Bits_48 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_48 is
*** 112,118 ****
  
     function GetU_48 (Arr : System.Address; N : Natural) return Bits_48 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_48 is
*** 132,138 ****
  
     procedure Set_48 (Arr : System.Address; N : Natural; E : Bits_48) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_48 is
*** 152,158 ****
  
     procedure SetU_48 (Arr : System.Address; N : Natural; E : Bits_48) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack48.ads gcc-4.1.0/gcc/ada/s-pack48.ads
*** gcc-4.0.2/gcc/ada/s-pack48.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack48.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 48
  
  package System.Pack_48 is
! pragma Preelaborate (Pack_48);
  
     Bits : constant := 48;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 48
  
  package System.Pack_48 is
!    pragma Preelaborate;
  
     Bits : constant := 48;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack49.adb gcc-4.1.0/gcc/ada/s-pack49.adb
*** gcc-4.0.2/gcc/ada/s-pack49.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack49.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_49 is
*** 79,85 ****
  
     function Get_49 (Arr : System.Address; N : Natural) return Bits_49 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_49 is
*** 99,105 ****
  
     procedure Set_49 (Arr : System.Address; N : Natural; E : Bits_49) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack49.ads gcc-4.1.0/gcc/ada/s-pack49.ads
*** gcc-4.0.2/gcc/ada/s-pack49.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack49.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 4 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-4907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 49
  
  package System.Pack_49 is
! pragma Preelaborate (Pack_49);
  
     Bits : constant := 49;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 49
  
  package System.Pack_49 is
!    pragma Preelaborate;
  
     Bits : constant := 49;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack50.adb gcc-4.1.0/gcc/ada/s-pack50.adb
*** gcc-4.0.2/gcc/ada/s-pack50.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack50.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_50 is
*** 92,98 ****
  
     function Get_50 (Arr : System.Address; N : Natural) return Bits_50 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_50 is
*** 112,118 ****
  
     function GetU_50 (Arr : System.Address; N : Natural) return Bits_50 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_50 is
*** 132,138 ****
  
     procedure Set_50 (Arr : System.Address; N : Natural; E : Bits_50) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_50 is
*** 152,158 ****
  
     procedure SetU_50 (Arr : System.Address; N : Natural; E : Bits_50) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack50.ads gcc-4.1.0/gcc/ada/s-pack50.ads
*** gcc-4.0.2/gcc/ada/s-pack50.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack50.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 50
  
  package System.Pack_50 is
! pragma Preelaborate (Pack_50);
  
     Bits : constant := 50;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 50
  
  package System.Pack_50 is
!    pragma Preelaborate;
  
     Bits : constant := 50;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack51.adb gcc-4.1.0/gcc/ada/s-pack51.adb
*** gcc-4.0.2/gcc/ada/s-pack51.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack51.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_51 is
*** 79,85 ****
  
     function Get_51 (Arr : System.Address; N : Natural) return Bits_51 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_51 is
*** 99,105 ****
  
     procedure Set_51 (Arr : System.Address; N : Natural; E : Bits_51) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack51.ads gcc-4.1.0/gcc/ada/s-pack51.ads
*** gcc-4.0.2/gcc/ada/s-pack51.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack51.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-5107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 51
  
  package System.Pack_51 is
! pragma Preelaborate (Pack_51);
  
     Bits : constant := 51;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 51
  
  package System.Pack_51 is
!    pragma Preelaborate;
  
     Bits : constant := 51;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack52.adb gcc-4.1.0/gcc/ada/s-pack52.adb
*** gcc-4.0.2/gcc/ada/s-pack52.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack52.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_52 is
*** 92,98 ****
  
     function Get_52 (Arr : System.Address; N : Natural) return Bits_52 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_52 is
*** 112,118 ****
  
     function GetU_52 (Arr : System.Address; N : Natural) return Bits_52 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_52 is
*** 132,138 ****
  
     procedure Set_52 (Arr : System.Address; N : Natural; E : Bits_52) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_52 is
*** 152,158 ****
  
     procedure SetU_52 (Arr : System.Address; N : Natural; E : Bits_52) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack52.ads gcc-4.1.0/gcc/ada/s-pack52.ads
*** gcc-4.0.2/gcc/ada/s-pack52.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack52.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 52
  
  package System.Pack_52 is
! pragma Preelaborate (Pack_52);
  
     Bits : constant := 52;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 52
  
  package System.Pack_52 is
!    pragma Preelaborate;
  
     Bits : constant := 52;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack53.adb gcc-4.1.0/gcc/ada/s-pack53.adb
*** gcc-4.0.2/gcc/ada/s-pack53.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack53.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_53 is
*** 79,85 ****
  
     function Get_53 (Arr : System.Address; N : Natural) return Bits_53 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_53 is
*** 99,105 ****
  
     procedure Set_53 (Arr : System.Address; N : Natural; E : Bits_53) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack53.ads gcc-4.1.0/gcc/ada/s-pack53.ads
*** gcc-4.0.2/gcc/ada/s-pack53.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack53.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-5307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 53
  
  package System.Pack_53 is
! pragma Preelaborate (Pack_53);
  
     Bits : constant := 53;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 53
  
  package System.Pack_53 is
!    pragma Preelaborate;
  
     Bits : constant := 53;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack54.adb gcc-4.1.0/gcc/ada/s-pack54.adb
*** gcc-4.0.2/gcc/ada/s-pack54.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack54.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 4                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_54 is
*** 92,98 ****
  
     function Get_54 (Arr : System.Address; N : Natural) return Bits_54 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_54 is
*** 112,118 ****
  
     function GetU_54 (Arr : System.Address; N : Natural) return Bits_54 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_54 is
*** 132,138 ****
  
     procedure Set_54 (Arr : System.Address; N : Natural; E : Bits_54) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_54 is
*** 152,158 ****
  
     procedure SetU_54 (Arr : System.Address; N : Natural; E : Bits_54) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack54.ads gcc-4.1.0/gcc/ada/s-pack54.ads
*** gcc-4.0.2/gcc/ada/s-pack54.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack54.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 4                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 54
  
  package System.Pack_54 is
! pragma Preelaborate (Pack_54);
  
     Bits : constant := 54;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 54
  
  package System.Pack_54 is
!    pragma Preelaborate;
  
     Bits : constant := 54;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack55.adb gcc-4.1.0/gcc/ada/s-pack55.adb
*** gcc-4.0.2/gcc/ada/s-pack55.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack55.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 5                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_55 is
*** 79,85 ****
  
     function Get_55 (Arr : System.Address; N : Natural) return Bits_55 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_55 is
*** 99,105 ****
  
     procedure Set_55 (Arr : System.Address; N : Natural; E : Bits_55) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack55.ads gcc-4.1.0/gcc/ada/s-pack55.ads
*** gcc-4.0.2/gcc/ada/s-pack55.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack55.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 5                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-5507, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 55
  
  package System.Pack_55 is
! pragma Preelaborate (Pack_55);
  
     Bits : constant := 55;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 55
  
  package System.Pack_55 is
!    pragma Preelaborate;
  
     Bits : constant := 55;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack56.adb gcc-4.1.0/gcc/ada/s-pack56.adb
*** gcc-4.0.2/gcc/ada/s-pack56.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack56.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 6                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_56 is
*** 92,98 ****
  
     function Get_56 (Arr : System.Address; N : Natural) return Bits_56 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_56 is
*** 112,118 ****
  
     function GetU_56 (Arr : System.Address; N : Natural) return Bits_56 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_56 is
*** 132,138 ****
  
     procedure Set_56 (Arr : System.Address; N : Natural; E : Bits_56) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_56 is
*** 152,158 ****
  
     procedure SetU_56 (Arr : System.Address; N : Natural; E : Bits_56) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack56.ads gcc-4.1.0/gcc/ada/s-pack56.ads
*** gcc-4.0.2/gcc/ada/s-pack56.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack56.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 6                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 56
  
  package System.Pack_56 is
! pragma Preelaborate (Pack_56);
  
     Bits : constant := 56;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 56
  
  package System.Pack_56 is
!    pragma Preelaborate;
  
     Bits : constant := 56;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack57.adb gcc-4.1.0/gcc/ada/s-pack57.adb
*** gcc-4.0.2/gcc/ada/s-pack57.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack57.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 7                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_57 is
*** 79,85 ****
  
     function Get_57 (Arr : System.Address; N : Natural) return Bits_57 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_57 is
*** 99,105 ****
  
     procedure Set_57 (Arr : System.Address; N : Natural; E : Bits_57) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack57.ads gcc-4.1.0/gcc/ada/s-pack57.ads
*** gcc-4.0.2/gcc/ada/s-pack57.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack57.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 7                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-5707, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 57
  
  package System.Pack_57 is
! pragma Preelaborate (Pack_57);
  
     Bits : constant := 57;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 57
  
  package System.Pack_57 is
!    pragma Preelaborate;
  
     Bits : constant := 57;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack58.adb gcc-4.1.0/gcc/ada/s-pack58.adb
*** gcc-4.0.2/gcc/ada/s-pack58.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack58.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 8                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_58 is
*** 92,98 ****
  
     function Get_58 (Arr : System.Address; N : Natural) return Bits_58 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_58 is
*** 112,118 ****
  
     function GetU_58 (Arr : System.Address; N : Natural) return Bits_58 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_58 is
*** 132,138 ****
  
     procedure Set_58 (Arr : System.Address; N : Natural; E : Bits_58) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_58 is
*** 152,158 ****
  
     procedure SetU_58 (Arr : System.Address; N : Natural; E : Bits_58) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack58.ads gcc-4.1.0/gcc/ada/s-pack58.ads
*** gcc-4.0.2/gcc/ada/s-pack58.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack58.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 8                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 58
  
  package System.Pack_58 is
! pragma Preelaborate (Pack_58);
  
     Bits : constant := 58;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 58
  
  package System.Pack_58 is
!    pragma Preelaborate;
  
     Bits : constant := 58;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack59.adb gcc-4.1.0/gcc/ada/s-pack59.adb
*** gcc-4.0.2/gcc/ada/s-pack59.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack59.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 9                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_59 is
*** 79,85 ****
  
     function Get_59 (Arr : System.Address; N : Natural) return Bits_59 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_59 is
*** 99,105 ****
  
     procedure Set_59 (Arr : System.Address; N : Natural; E : Bits_59) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack59.ads gcc-4.1.0/gcc/ada/s-pack59.ads
*** gcc-4.0.2/gcc/ada/s-pack59.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack59.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 5 9                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-5907, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 59
  
  package System.Pack_59 is
! pragma Preelaborate (Pack_59);
  
     Bits : constant := 59;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 59
  
  package System.Pack_59 is
!    pragma Preelaborate;
  
     Bits : constant := 59;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack60.adb gcc-4.1.0/gcc/ada/s-pack60.adb
*** gcc-4.0.2/gcc/ada/s-pack60.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack60.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 0                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_60 is
*** 92,98 ****
  
     function Get_60 (Arr : System.Address; N : Natural) return Bits_60 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_60 is
*** 112,118 ****
  
     function GetU_60 (Arr : System.Address; N : Natural) return Bits_60 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_60 is
*** 132,138 ****
  
     procedure Set_60 (Arr : System.Address; N : Natural; E : Bits_60) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_60 is
*** 152,158 ****
  
     procedure SetU_60 (Arr : System.Address; N : Natural; E : Bits_60) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack60.ads gcc-4.1.0/gcc/ada/s-pack60.ads
*** gcc-4.0.2/gcc/ada/s-pack60.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack60.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 0                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 60
  
  package System.Pack_60 is
! pragma Preelaborate (Pack_60);
  
     Bits : constant := 60;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 60
  
  package System.Pack_60 is
!    pragma Preelaborate;
  
     Bits : constant := 60;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack61.adb gcc-4.1.0/gcc/ada/s-pack61.adb
*** gcc-4.0.2/gcc/ada/s-pack61.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack61.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 1                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_61 is
*** 79,85 ****
  
     function Get_61 (Arr : System.Address; N : Natural) return Bits_61 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_61 is
*** 99,105 ****
  
     procedure Set_61 (Arr : System.Address; N : Natural; E : Bits_61) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack61.ads gcc-4.1.0/gcc/ada/s-pack61.ads
*** gcc-4.0.2/gcc/ada/s-pack61.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack61.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 1                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-6107, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 61
  
  package System.Pack_61 is
! pragma Preelaborate (Pack_61);
  
     Bits : constant := 61;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 61
  
  package System.Pack_61 is
!    pragma Preelaborate;
  
     Bits : constant := 61;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack62.adb gcc-4.1.0/gcc/ada/s-pack62.adb
*** gcc-4.0.2/gcc/ada/s-pack62.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack62.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 2                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_62 is
*** 92,98 ****
  
     function Get_62 (Arr : System.Address; N : Natural) return Bits_62 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 92,97 ----
*************** package body System.Pack_62 is
*** 112,118 ****
  
     function GetU_62 (Arr : System.Address; N : Natural) return Bits_62 is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 111,116 ----
*************** package body System.Pack_62 is
*** 132,138 ****
  
     procedure Set_62 (Arr : System.Address; N : Natural; E : Bits_62) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 130,135 ----
*************** package body System.Pack_62 is
*** 152,158 ****
  
     procedure SetU_62 (Arr : System.Address; N : Natural; E : Bits_62) is
        C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 149,154 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack62.ads gcc-4.1.0/gcc/ada/s-pack62.ads
*** gcc-4.0.2/gcc/ada/s-pack62.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack62.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 2                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 62
  
  package System.Pack_62 is
! pragma Preelaborate (Pack_62);
  
     Bits : constant := 62;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 62
  
  package System.Pack_62 is
!    pragma Preelaborate;
  
     Bits : constant := 62;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack63.adb gcc-4.1.0/gcc/ada/s-pack63.adb
*** gcc-4.0.2/gcc/ada/s-pack63.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack63.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 3                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Pack_63 is
*** 79,85 ****
  
     function Get_63 (Arr : System.Address; N : Natural) return Bits_63 is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => return C.E0;
--- 79,84 ----
*************** package body System.Pack_63 is
*** 99,105 ****
  
     procedure Set_63 (Arr : System.Address; N : Natural; E : Bits_63) is
        C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
- 
     begin
        case N07 (Uns (N) mod 8) is
           when 0 => C.E0 := E;
--- 98,103 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pack63.ads gcc-4.1.0/gcc/ada/s-pack63.ads
*** gcc-4.0.2/gcc/ada/s-pack63.ads	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pack63.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . P A C K _ 6 3                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-6307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  Handling of packed arrays with Component_Size = 63
  
  package System.Pack_63 is
! pragma Preelaborate (Pack_63);
  
     Bits : constant := 63;
  
--- 34,40 ----
  --  Handling of packed arrays with Component_Size = 63
  
  package System.Pack_63 is
!    pragma Preelaborate;
  
     Bits : constant := 63;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-ae653.ads gcc-4.1.0/gcc/ada/s-parame-ae653.ads
*** gcc-4.0.2/gcc/ada/s-parame-ae653.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-ae653.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default VxWorks AE 653 version of the package.`
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default VxWorks AE 653 version of the package
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
***************
*** 49,55 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 200,203 ****
--- 200,211 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 200;
+    --  This constant specifies the default number of characters to allow
+    --  in an exception message (200 is minimum required by RM 11.4.1(18)).
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-hpux.ads gcc-4.1.0/gcc/ada/s-parame-hpux.ads
*** gcc-4.0.2/gcc/ada/s-parame-hpux.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-hpux.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  ------------------------------------------------------------------------------
  
  --  This is the HP version of this package
- --  Blank line intentional so that it lines up exactly with default.
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 32,37 ----
***************
*** 50,56 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 199,202 ****
--- 198,209 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 200;
+    --  This constant specifies the default number of characters to allow
+    --  in an exception message (200 is minimum required by RM 11.4.1(18)).
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-linux.adb gcc-4.1.0/gcc/ada/s-parame-linux.adb
*** gcc-4.0.2/gcc/ada/s-parame-linux.adb	Wed Oct 27 12:28:07 2004
--- gcc-4.1.0/gcc/ada/s-parame-linux.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-mingw.adb gcc-4.1.0/gcc/ada/s-parame-mingw.adb
*** gcc-4.0.2/gcc/ada/s-parame-mingw.adb	Wed Oct 27 12:28:25 2004
--- gcc-4.1.0/gcc/ada/s-parame-mingw.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-os2.adb gcc-4.1.0/gcc/ada/s-parame-os2.adb
*** gcc-4.0.2/gcc/ada/s-parame-os2.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-os2.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-rtems.adb gcc-4.1.0/gcc/ada/s-parame-rtems.adb
*** gcc-4.0.2/gcc/ada/s-parame-rtems.adb	Thu Jan 27 11:56:57 2005
--- gcc-4.1.0/gcc/ada/s-parame-rtems.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-solaris.adb gcc-4.1.0/gcc/ada/s-parame-solaris.adb
*** gcc-4.0.2/gcc/ada/s-parame-solaris.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-solaris.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-vms-restrict.ads gcc-4.1.0/gcc/ada/s-parame-vms-restrict.ads
*** gcc-4.0.2/gcc/ada/s-parame-vms-restrict.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-vms-restrict.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the OpenVMS version for restricted tasking.
! 
! --  Blank line intentional so that it lines up exactly with default.
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the OpenVMS version for restricted tasking
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
***************
*** 51,57 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 200,203 ****
--- 198,211 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 512;
+    --  This constant specifies the maximum number of characters to allow in an
+    --  exception message (see RM 11.4.1(18)). The value for VMS exceeds the
+    --  default minimum of 200 to allow for the length of chained VMS condition
+    --  handling messages.
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-vms.ads gcc-4.1.0/gcc/ada/s-parame-vms.ads
*** gcc-4.0.2/gcc/ada/s-parame-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-vms.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the OpenVMS version.
! --  Blank line intentional so that it lines up exactly with default.
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the OpenVMS version
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
***************
*** 50,56 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 199,202 ****
--- 198,211 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 512;
+    --  This constant specifies the maximum number of characters to allow in an
+    --  exception message (see RM 11.4.1(18)). The value for VMS exceeds the
+    --  default minimum of 200 to allow for the length of chained VMS condition
+    --  handling messages.
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame-vxworks.ads gcc-4.1.0/gcc/ada/s-parame-vxworks.ads
*** gcc-4.0.2/gcc/ada/s-parame-vxworks.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-parame-vxworks.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default VxWorks version of the package.`
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default VxWorks version of the package`
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
***************
*** 49,55 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 200,203 ****
--- 200,211 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 200;
+    --  This constant specifies the default number of characters to allow
+    --  in an exception message (200 is minimum required by RM 11.4.1(18)).
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame.adb gcc-4.1.0/gcc/ada/s-parame.adb
*** gcc-4.0.2/gcc/ada/s-parame.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-parame.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parame.ads gcc-4.1.0/gcc/ada/s-parame.ads
*** gcc-4.0.2/gcc/ada/s-parame.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-parame.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the default version used for all systems for which no special
! --  target-specific version of this package is provided.
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  Default version used when no target-specific version is provided
  
  --  This package defines some system dependent parameters for GNAT. These
  --  are values that are referenced by the runtime library and are therefore
***************
*** 50,56 ****
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
! pragma Pure (Parameters);
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
--- 49,55 ----
  --  otherwise the relinking and rebinding capability would be deactivated.
  
  package System.Parameters is
!    pragma Pure;
  
     ---------------------------------------
     -- Task And Stack Allocation Control --
*************** pragma Pure (Parameters);
*** 199,202 ****
--- 198,209 ----
     --  predefined output or not (True means that traces are output).
     --  See System.Traces for more details.
  
+    ------------------------------
+    -- Exception Message Length --
+    ------------------------------
+ 
+    Default_Exception_Msg_Max_Length : constant := 200;
+    --  This constant specifies the default number of characters to allow
+    --  in an exception message (200 is minimum required by RM 11.4.1(18)).
+ 
  end System.Parameters;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parint.adb gcc-4.1.0/gcc/ada/s-parint.adb
*** gcc-4.0.2/gcc/ada/s-parint.adb	Mon Jan  3 15:37:33 2005
--- gcc-4.1.0/gcc/ada/s-parint.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                  B o d y                                 --
  --                   (Dummy body for non-distributed case)                  --
  --                                                                          --
! --          Copyright (C) 1995-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 7,13 ----
  --                                  B o d y                                 --
  --                   (Dummy body for non-distributed case)                  --
  --                                                                          --
! --          Copyright (C) 1995-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Partition_Interface 
*** 40,46 ****
  
     type String_Access is access String;
  
!    --  To have a minimal implementation of U'Partition_ID.
  
     type Pkg_Node;
     type Pkg_List is access Pkg_Node;
--- 40,46 ----
  
     type String_Access is access String;
  
!    --  To have a minimal implementation of U'Partition_ID
  
     type Pkg_Node;
     type Pkg_List is access Pkg_Node;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-parint.ads gcc-4.1.0/gcc/ada/s-parint.ads
*** gcc-4.0.2/gcc/ada/s-parint.ads	Mon Jan  3 15:37:33 2005
--- gcc-4.1.0/gcc/ada/s-parint.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1995-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 6,12 ----
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1995-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pooglo.adb gcc-4.1.0/gcc/ada/s-pooglo.adb
*** gcc-4.0.2/gcc/ada/s-pooglo.adb	Thu Apr 24 17:54:12 2003
--- gcc-4.1.0/gcc/ada/s-pooglo.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pooglo.ads gcc-4.1.0/gcc/ada/s-pooglo.ads
*** gcc-4.0.2/gcc/ada/s-pooglo.ads	Wed Oct 27 13:41:23 2004
--- gcc-4.1.0/gcc/ada/s-pooglo.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992-1994, 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Storage_Pools;
*** 36,44 ****
  with System.Storage_Elements;
  
  package System.Pool_Global is
! 
! pragma Elaborate_Body;
! --  Needed to ensure that library routines can execute allocators
  
     --  Allocation strategy:
  
--- 36,43 ----
  with System.Storage_Elements;
  
  package System.Pool_Global is
!    pragma Elaborate_Body;
!    --  Needed to ensure that library routines can execute allocators
  
     --  Allocation strategy:
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pooloc.adb gcc-4.1.0/gcc/ada/s-pooloc.adb
*** gcc-4.0.2/gcc/ada/s-pooloc.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-pooloc.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-pooloc.ads gcc-4.1.0/gcc/ada/s-pooloc.ads
*** gcc-4.0.2/gcc/ada/s-pooloc.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-pooloc.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1998, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Storage_Elements;
*** 35,43 ****
  with System.Pool_Global;
  
  package System.Pool_Local is
! 
! pragma Elaborate_Body;
! --  Needed to ensure that library routines can execute allocators
  
     ----------------------------
     -- Unbounded_Reclaim_Pool --
--- 35,42 ----
  with System.Pool_Global;
  
  package System.Pool_Local is
!    pragma Elaborate_Body;
!    --  Needed to ensure that library routines can execute allocators
  
     ----------------------------
     -- Unbounded_Reclaim_Pool --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-poosiz.adb gcc-4.1.0/gcc/ada/s-poosiz.adb
*** gcc-4.0.2/gcc/ada/s-poosiz.adb	Wed Dec  8 11:49:43 2004
--- gcc-4.1.0/gcc/ada/s-poosiz.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-poosiz.ads gcc-4.1.0/gcc/ada/s-poosiz.ads
*** gcc-4.0.2/gcc/ada/s-poosiz.ads	Wed Dec  8 11:49:43 2004
--- gcc-4.1.0/gcc/ada/s-poosiz.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Storage_Pools;
*** 35,43 ****
  with System.Storage_Elements;
  
  package System.Pool_Size is
! 
! pragma Elaborate_Body;
! --  Needed to ensure that library routines can execute allocators
  
     ------------------------
     -- Stack_Bounded_Pool --
--- 35,42 ----
  with System.Storage_Elements;
  
  package System.Pool_Size is
!    pragma Elaborate_Body;
!    --  Needed to ensure that library routines can execute allocators
  
     ------------------------
     -- Stack_Bounded_Pool --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-powtab.ads gcc-4.1.0/gcc/ada/s-powtab.ads
*** gcc-4.0.2/gcc/ada/s-powtab.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-powtab.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package provides a powers of ten table used for real conversions
  
  package System.Powten_Table is
! pragma Pure (Powten_Table);
  
     Maxpow : constant := 22;
     --  The number of entries in this table is chosen to include powers of ten
--- 34,40 ----
  --  This package provides a powers of ten table used for real conversions
  
  package System.Powten_Table is
!    pragma Pure;
  
     Maxpow : constant := 22;
     --  The number of entries in this table is chosen to include powers of ten
diff -Nrcpad gcc-4.0.2/gcc/ada/s-proinf-irix-athread.adb gcc-4.1.0/gcc/ada/s-proinf-irix-athread.adb
*** gcc-4.0.2/gcc/ada/s-proinf-irix-athread.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-proinf-irix-athread.adb	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-1999 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 46,52 ****
--- 46,54 ----
  --  then relink your application as usual.
  --
  
+ pragma Warnings (Off);
  with GNAT.OS_Lib;
+ pragma Warnings (On);
  
  package body System.Program_Info is
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-proinf-irix-athread.ads gcc-4.1.0/gcc/ada/s-proinf-irix-athread.ads
*** gcc-4.0.2/gcc/ada/s-proinf-irix-athread.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-proinf-irix-athread.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,96 ****
  --  to the run-time system at program startup for the SGI implementation.
  
  package System.Program_Info is
  
     function Initial_Sproc_Count return Integer;
-    --
     --  The number of sproc created at program startup for scheduling
     --  threads.
-    --
  
!    function Max_Sproc_Count     return Integer;
!    --
     --  The maximum number of sprocs that can be created by the program
     --  for servicing threads.  This limit includes both the pre-created
     --  sprocs and those explicitly created under program control.
-    --
  
!    function Sproc_Stack_Size    return Integer;
!    --
     --  The size, in bytes, of the sproc's initial stack.
-    --
  
     function Default_Time_Slice  return Duration;
-    --
     --  The default time quanta for round-robin scheduling of threads of
     --  equal priority.  This default value can be overridden on a per-task
     --  basis by specifying an alternate value via the implementation-defined
     --  Task_Info pragma. See s-tasinf.ads for more information.
-    --
  
!    function Default_Task_Stack  return Integer;
!    --
     --  The default stack size for each created thread.  This default value
     --  can be overriden on a per-task basis by the language-defined
     --  Storage_Size pragma.
-    --
  
!    function Stack_Guard_Pages   return Integer;
!    --
     --  The number of non-writable, guard pages to append to the bottom of
     --  each thread's stack.
-    --
  
     function Pthread_Sched_Signal return Integer;
-    --
     --  The signal used by the Pthreads library to affect scheduling actions
     --  in remote sprocs.
-    --
  
!    function Pthread_Arena_Size  return Integer;
!    --
     --  The size of the shared arena from which pthread locks are allocated.
     --  See the usinit(3p) man page for more information on shared arenas.
-    --
  
     function Os_Default_Priority return Integer;
-    --
     --  The default Irix Non-Degrading priority for each sproc created to
     --  service threads.
-    --
  
  end System.Program_Info;
--- 35,79 ----
  --  to the run-time system at program startup for the SGI implementation.
  
  package System.Program_Info is
+    pragma Preelaborate;
  
     function Initial_Sproc_Count return Integer;
     --  The number of sproc created at program startup for scheduling
     --  threads.
  
!    function Max_Sproc_Count return Integer;
     --  The maximum number of sprocs that can be created by the program
     --  for servicing threads.  This limit includes both the pre-created
     --  sprocs and those explicitly created under program control.
  
!    function Sproc_Stack_Size return Integer;
     --  The size, in bytes, of the sproc's initial stack.
  
     function Default_Time_Slice  return Duration;
     --  The default time quanta for round-robin scheduling of threads of
     --  equal priority.  This default value can be overridden on a per-task
     --  basis by specifying an alternate value via the implementation-defined
     --  Task_Info pragma. See s-tasinf.ads for more information.
  
!    function Default_Task_Stack return Integer;
     --  The default stack size for each created thread.  This default value
     --  can be overriden on a per-task basis by the language-defined
     --  Storage_Size pragma.
  
!    function Stack_Guard_Pages return Integer;
     --  The number of non-writable, guard pages to append to the bottom of
     --  each thread's stack.
  
     function Pthread_Sched_Signal return Integer;
     --  The signal used by the Pthreads library to affect scheduling actions
     --  in remote sprocs.
  
!    function Pthread_Arena_Size return Integer;
     --  The size of the shared arena from which pthread locks are allocated.
     --  See the usinit(3p) man page for more information on shared arenas.
  
     function Os_Default_Priority return Integer;
     --  The default Irix Non-Degrading priority for each sproc created to
     --  service threads.
  
  end System.Program_Info;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-proinf.adb gcc-4.1.0/gcc/ada/s-proinf.adb
*** gcc-4.0.2/gcc/ada/s-proinf.adb	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-proinf.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-proinf.ads gcc-4.1.0/gcc/ada/s-proinf.ads
*** gcc-4.0.2/gcc/ada/s-proinf.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-proinf.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1996-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1996-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,40 ****
--- 35,41 ----
  --  to the run-time system at program startup.
  
  package System.Program_Info is
+    pragma Preelaborate;
  
     function Default_Task_Stack return Integer;
     --  The default stack size for each created thread.  This default value
diff -Nrcpad gcc-4.0.2/gcc/ada/s-purexc.ads gcc-4.1.0/gcc/ada/s-purexc.ads
*** gcc-4.0.2/gcc/ada/s-purexc.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-purexc.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 2000-2002 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --                     Copyright (C) 2000-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  is for internal use only, it is not generally available to applications.
  
  package System.Pure_Exceptions is
! pragma Pure (Pure_Exceptions);
  
     type Exception_Type is limited null record;
     --  Type used to specify which exception to raise
--- 36,42 ----
  --  is for internal use only, it is not generally available to applications.
  
  package System.Pure_Exceptions is
!    pragma Pure;
  
     type Exception_Type is limited null record;
     --  Type used to specify which exception to raise
diff -Nrcpad gcc-4.0.2/gcc/ada/s-restri.adb gcc-4.1.0/gcc/ada/s-restri.adb
*** gcc-4.0.2/gcc/ada/s-restri.adb	Wed Feb  4 11:06:19 2004
--- gcc-4.1.0/gcc/ada/s-restri.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** begin
*** 145,148 ****
        end loop;
     end Acquire_Restrictions;
  end System.Restrictions;
- 
--- 145,147 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-restri.ads gcc-4.1.0/gcc/ada/s-restri.ads
*** gcc-4.0.2/gcc/ada/s-restri.ads	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-restri.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Restrictions is
*** 65,69 ****
     --  must be False, and Max_Tasks must not be set to zero.
  
  end System.Restrictions;
- 
- 
--- 65,67 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-rident.ads gcc-4.1.0/gcc/ada/s-rident.ads
*** gcc-4.0.2/gcc/ada/s-rident.ads	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/s-rident.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-rpc.adb gcc-4.1.0/gcc/ada/s-rpc.adb
*** gcc-4.0.2/gcc/ada/s-rpc.adb	Wed Apr 21 10:10:32 2004
--- gcc-4.1.0/gcc/ada/s-rpc.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-rpc.ads gcc-4.1.0/gcc/ada/s-rpc.ads
*** gcc-4.0.2/gcc/ada/s-rpc.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-rpc.ads	Fri Jul  1 01:29:17 2005
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-scaval.adb gcc-4.1.0/gcc/ada/s-scaval.adb
*** gcc-4.0.2/gcc/ada/s-scaval.adb	Thu Feb 10 13:50:17 2005
--- gcc-4.1.0/gcc/ada/s-scaval.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --                  S Y S T E M . S C A L A R _ V A L U E S                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --                  S Y S T E M . S C A L A R _ V A L U E S                 --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-scaval.ads gcc-4.1.0/gcc/ada/s-scaval.ads
*** gcc-4.0.2/gcc/ada/s-scaval.ads	Thu Feb 10 13:50:17 2005
--- gcc-4.1.0/gcc/ada/s-scaval.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --                  S Y S T E M . S C A L A R _ V A L U E S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --                  S Y S T E M . S C A L A R _ V A L U E S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-secsta.adb gcc-4.1.0/gcc/ada/s-secsta.adb
*** gcc-4.0.2/gcc/ada/s-secsta.adb	Mon Aug  9 12:24:21 2004
--- gcc-4.1.0/gcc/ada/s-secsta.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-secsta.ads gcc-4.1.0/gcc/ada/s-secsta.ads
*** gcc-4.0.2/gcc/ada/s-secsta.ads	Mon Aug  9 12:24:21 2004
--- gcc-4.1.0/gcc/ada/s-secsta.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sequio.adb gcc-4.1.0/gcc/ada/s-sequio.adb
*** gcc-4.0.2/gcc/ada/s-sequio.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-sequio.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 S Y S T E M . S E Q U E N T I A L _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 S Y S T E M . S E Q U E N T I A L _ I O                  --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sequio.ads gcc-4.1.0/gcc/ada/s-sequio.ads
*** gcc-4.0.2/gcc/ada/s-sequio.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sequio.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                 S Y S T E M . S E Q U E N T I A L _ I O                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                 S Y S T E M . S E Q U E N T I A L _ I O                  --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-shasto.adb gcc-4.1.0/gcc/ada/s-shasto.adb
*** gcc-4.0.2/gcc/ada/s-shasto.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-shasto.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-shasto.ads gcc-4.1.0/gcc/ada/s-shasto.ads
*** gcc-4.0.2/gcc/ada/s-shasto.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-shasto.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-soflin.adb gcc-4.1.0/gcc/ada/s-soflin.adb
*** gcc-4.0.2/gcc/ada/s-soflin.adb	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-soflin.adb	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 35,60 ****
  --  We must turn polling off for this unit, because otherwise we get
  --  an infinite loop from the code within the Poll routine itself.
  
- with System.Machine_State_Operations; use System.Machine_State_Operations;
- --  Used for Create_TSD, Destroy_TSD
- 
  with System.Parameters;
  --  Used for Sec_Stack_Ratio
  
  with System.Secondary_Stack;
  
  package body System.Soft_Links is
  
     package SST renames System.Secondary_Stack;
  
-    --  Allocate an exception stack for the main program to use.
-    --  We make sure that the stack has maximum alignment. Some systems require
-    --  this (e.g. Sun), and in any case it is a good idea for efficiency.
- 
     NT_Exc_Stack : array (0 .. 8192) of aliased Character;
     for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
  
     NT_TSD : TSD;
  
     --------------------
     -- Abort_Defer_NT --
--- 35,60 ----
  --  We must turn polling off for this unit, because otherwise we get
  --  an infinite loop from the code within the Poll routine itself.
  
  with System.Parameters;
  --  Used for Sec_Stack_Ratio
  
+ pragma Warnings (Off);
+ --  Disable warnings since System.Secondary_Stack is currently not
+ --  Preelaborate
  with System.Secondary_Stack;
+ pragma Warnings (On);
  
  package body System.Soft_Links is
  
     package SST renames System.Secondary_Stack;
  
     NT_Exc_Stack : array (0 .. 8192) of aliased Character;
     for NT_Exc_Stack'Alignment use Standard'Maximum_Alignment;
+    --  Allocate an exception stack for the main program to use.
+    --  This is currently only used under VMS.
  
     NT_TSD : TSD;
+    --  Note: we rely on the default initialization of NT_TSD.
  
     --------------------
     -- Abort_Defer_NT --
*************** package body System.Soft_Links is
*** 116,125 ****
           SST.SS_Init
             (New_TSD.Sec_Stack_Addr, SST.Default_Secondary_Stack_Size);
        end if;
- 
-       New_TSD.Machine_State_Addr :=
-         System.Address
-           (System.Machine_State_Operations.Allocate_Machine_State);
     end Create_TSD;
  
     -----------------------
--- 116,121 ----
*************** package body System.Soft_Links is
*** 138,145 ****
     procedure Destroy_TSD (Old_TSD : in out TSD) is
     begin
        SST.SS_Free (Old_TSD.Sec_Stack_Addr);
-       System.Machine_State_Operations.Free_Machine_State
-         (Machine_State (Old_TSD.Machine_State_Addr));
     end Destroy_TSD;
  
     ---------------------
--- 134,139 ----
*************** package body System.Soft_Links is
*** 166,179 ****
  
     function Get_Exc_Stack_Addr_NT return Address is
     begin
!       return NT_TSD.Exc_Stack_Addr;
     end Get_Exc_Stack_Addr_NT;
  
     -----------------------------
     -- Get_Exc_Stack_Addr_Soft --
     -----------------------------
  
!    function Get_Exc_Stack_Addr_Soft return  Address is
     begin
        return Get_Exc_Stack_Addr.all;
     end Get_Exc_Stack_Addr_Soft;
--- 160,173 ----
  
     function Get_Exc_Stack_Addr_NT return Address is
     begin
!       return NT_Exc_Stack (NT_Exc_Stack'Last)'Address;
     end Get_Exc_Stack_Addr_NT;
  
     -----------------------------
     -- Get_Exc_Stack_Addr_Soft --
     -----------------------------
  
!    function Get_Exc_Stack_Addr_Soft return Address is
     begin
        return Get_Exc_Stack_Addr.all;
     end Get_Exc_Stack_Addr_Soft;
*************** package body System.Soft_Links is
*** 205,228 ****
        return Get_Jmpbuf_Address.all;
     end Get_Jmpbuf_Address_Soft;
  
-    -------------------------------
-    -- Get_Machine_State_Addr_NT --
-    -------------------------------
- 
-    function Get_Machine_State_Addr_NT return  Address is
-    begin
-       return NT_TSD.Machine_State_Addr;
-    end Get_Machine_State_Addr_NT;
- 
-    ---------------------------------
-    -- Get_Machine_State_Addr_Soft --
-    ---------------------------------
- 
-    function Get_Machine_State_Addr_Soft return  Address is
-    begin
-       return Get_Machine_State_Addr.all;
-    end Get_Machine_State_Addr_Soft;
- 
     ---------------------------
     -- Get_Sec_Stack_Addr_NT --
     ---------------------------
--- 199,204 ----
*************** package body System.Soft_Links is
*** 260,285 ****
     end Null_Adafinal;
  
     ---------------------------
-    -- Set_Exc_Stack_Addr_NT --
-    ---------------------------
- 
-    procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address) is
-       pragma Warnings (Off, Self_ID);
- 
-    begin
-       NT_TSD.Exc_Stack_Addr := Addr;
-    end Set_Exc_Stack_Addr_NT;
- 
-    -----------------------------
-    -- Set_Exc_Stack_Addr_Soft --
-    -----------------------------
- 
-    procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address) is
-    begin
-       Set_Exc_Stack_Addr (Self_ID, Addr);
-    end Set_Exc_Stack_Addr_Soft;
- 
-    ---------------------------
     -- Set_Jmpbuf_Address_NT --
     ---------------------------
  
--- 236,241 ----
*************** package body System.Soft_Links is
*** 293,316 ****
        Set_Jmpbuf_Address (Addr);
     end Set_Jmpbuf_Address_Soft;
  
-    -------------------------------
-    -- Set_Machine_State_Addr_NT --
-    -------------------------------
- 
-    procedure Set_Machine_State_Addr_NT (Addr : Address) is
-    begin
-       NT_TSD.Machine_State_Addr := Addr;
-    end Set_Machine_State_Addr_NT;
- 
-    ---------------------------------
-    -- Set_Machine_State_Addr_Soft --
-    ---------------------------------
- 
-    procedure Set_Machine_State_Addr_Soft (Addr : Address) is
-    begin
-       Set_Machine_State_Addr (Addr);
-    end Set_Machine_State_Addr_Soft;
- 
     ---------------------------
     -- Set_Sec_Stack_Addr_NT --
     ---------------------------
--- 249,254 ----
*************** package body System.Soft_Links is
*** 365,377 ****
        return "main_task";
     end Task_Name_NT;
  
-    -------------------------
-    -- Package Elaboration --
-    -------------------------
- 
- begin
-    NT_TSD.Exc_Stack_Addr := NT_Exc_Stack (8192)'Address;
-    Ada.Exceptions.Save_Occurrence
-      (NT_TSD.Current_Excep, Ada.Exceptions.Null_Occurrence);
- 
  end System.Soft_Links;
--- 303,306 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-soflin.ads gcc-4.1.0/gcc/ada/s-soflin.ads
*** gcc-4.0.2/gcc/ada/s-soflin.ads	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/s-soflin.ads	Mon Sep  5 07:46:06 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,38 ****
  ------------------------------------------------------------------------------
  
  --  This package contains a set of subprogram access variables that access
! --  some low-level primitives that are called different depending wether
  --  tasking is involved or not (e.g. the Get/Set_Jmpbuf_Address that needs
  --  to provide a different value for each task). To avoid dragging in the
  --  tasking all the time, we use a system of soft links where the links are
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  --  This package contains a set of subprogram access variables that access
! --  some low-level primitives that are called different depending whether
  --  tasking is involved or not (e.g. the Get/Set_Jmpbuf_Address that needs
  --  to provide a different value for each task). To avoid dragging in the
  --  tasking all the time, we use a system of soft links where the links are
*************** with Ada.Exceptions;
*** 43,49 ****
  with System.Stack_Checking;
  
  package System.Soft_Links is
!    pragma Elaborate_Body;
  
     subtype EOA is Ada.Exceptions.Exception_Occurrence_Access;
     subtype EO is Ada.Exceptions.Exception_Occurrence;
--- 43,51 ----
  with System.Stack_Checking;
  
  package System.Soft_Links is
!    pragma Warnings (Off);
!    pragma Preelaborate_05;
!    pragma Warnings (On);
  
     subtype EOA is Ada.Exceptions.Exception_Occurrence_Access;
     subtype EO is Ada.Exceptions.Exception_Occurrence;
*************** package System.Soft_Links is
*** 52,58 ****
     pragma Import
       (Ada, Current_Target_Exception,
        "__gnat_current_target_exception");
!    --  Import this subprogram from the private part of Ada.Exceptions.
  
     --  First we have the access subprogram types used to establish the links.
     --  The approach is to establish variables containing access subprogram
--- 54,60 ----
     pragma Import
       (Ada, Current_Target_Exception,
        "__gnat_current_target_exception");
!    --  Import this subprogram from the private part of Ada.Exceptions
  
     --  First we have the access subprogram types used to establish the links.
     --  The approach is to establish variables containing access subprogram
*************** package System.Soft_Links is
*** 112,131 ****
     --  Declarations for the no tasking versions of the required routines
  
     procedure Abort_Defer_NT;
!    --  Defer task abortion (non-tasking case, does nothing)
  
     procedure Abort_Undefer_NT;
!    --  Undefer task abortion (non-tasking case, does nothing)
  
     procedure Abort_Handler_NT;
!    --  Handle task abortion (non-tasking case, does nothing). Currently,
!    --  only VMS uses this.
  
     procedure Update_Exception_NT (X : EO := Current_Target_Exception);
!    --  Handle exception setting. This routine is provided for targets
!    --  which have built-in exception handling such as the Java Virtual
!    --  Machine. Currently, only JGNAT uses this. See 4jexcept.ads for
!    --  an explanation on how this routine is used.
  
     function Check_Abort_Status_NT return Integer;
     --  Returns Boolean'Pos (True) iff abort signal should raise
--- 114,133 ----
     --  Declarations for the no tasking versions of the required routines
  
     procedure Abort_Defer_NT;
!    --  Defer task abort (non-tasking case, does nothing)
  
     procedure Abort_Undefer_NT;
!    --  Undefer task abort (non-tasking case, does nothing)
  
     procedure Abort_Handler_NT;
!    --  Handle task abort (non-tasking case, does nothing). Currently, only VMS
!    --  uses this.
  
     procedure Update_Exception_NT (X : EO := Current_Target_Exception);
!    --  Handle exception setting. This routine is provided for targets which
!    --  have built-in exception handling such as the Java Virtual Machine.
!    --  Currently, only JGNAT uses this. See 4jexcept.ads for an explanation on
!    --  how this routine is used.
  
     function Check_Abort_Status_NT return Integer;
     --  Returns Boolean'Pos (True) iff abort signal should raise
*************** package System.Soft_Links is
*** 143,156 ****
  
     Abort_Defer : No_Param_Proc := Abort_Defer_NT'Access;
     pragma Suppress (Access_Check, Abort_Defer);
!    --  Defer task abortion (task/non-task case as appropriate)
  
     Abort_Undefer : No_Param_Proc := Abort_Undefer_NT'Access;
     pragma Suppress (Access_Check, Abort_Undefer);
!    --  Undefer task abortion (task/non-task case as appropriate)
  
     Abort_Handler : No_Param_Proc := Abort_Handler_NT'Access;
!    --  Handle task abortion (task/non-task case as appropriate)
  
     Update_Exception : Special_EO_Call := Update_Exception_NT'Access;
     --  Handle exception setting and tasking polling when appropriate
--- 145,158 ----
  
     Abort_Defer : No_Param_Proc := Abort_Defer_NT'Access;
     pragma Suppress (Access_Check, Abort_Defer);
!    --  Defer task abort (task/non-task case as appropriate)
  
     Abort_Undefer : No_Param_Proc := Abort_Undefer_NT'Access;
     pragma Suppress (Access_Check, Abort_Undefer);
!    --  Undefer task abort (task/non-task case as appropriate)
  
     Abort_Handler : No_Param_Proc := Abort_Handler_NT'Access;
!    --  Handle task abort (task/non-task case as appropriate)
  
     Update_Exception : Special_EO_Call := Update_Exception_NT'Access;
     --  Handle exception setting and tasking polling when appropriate
*************** package System.Soft_Links is
*** 196,202 ****
     --  explicitly or implicitly during the critical locked region.
  
     Adafinal : No_Param_Proc := Null_Adafinal'Access;
!    --  Performs the finalization of the Ada Runtime.
  
     function  Get_Jmpbuf_Address_NT return  Address;
     procedure Set_Jmpbuf_Address_NT (Addr : Address);
--- 198,204 ----
     --  explicitly or implicitly during the critical locked region.
  
     Adafinal : No_Param_Proc := Null_Adafinal'Access;
!    --  Performs the finalization of the Ada Runtime
  
     function  Get_Jmpbuf_Address_NT return  Address;
     procedure Set_Jmpbuf_Address_NT (Addr : Address);
*************** package System.Soft_Links is
*** 210,230 ****
     Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
     Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
  
!    function  Get_Machine_State_Addr_NT return  Address;
!    procedure Set_Machine_State_Addr_NT (Addr : Address);
! 
!    Get_Machine_State_Addr : Get_Address_Call
!      := Get_Machine_State_Addr_NT'Access;
!    Set_Machine_State_Addr : Set_Address_Call
!      := Set_Machine_State_Addr_NT'Access;
! 
!    function  Get_Exc_Stack_Addr_NT return Address;
!    procedure Set_Exc_Stack_Addr_NT (Self_ID : Address; Addr : Address);
!    --  Self_ID is a Task_Id, but in the non-tasking case there is no
!    --  Task_Id type available, so make do with Address.
! 
     Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access;
-    Set_Exc_Stack_Addr : Set_Address_Call2 := Set_Exc_Stack_Addr_NT'Access;
  
     function  Get_Current_Excep_NT return EOA;
  
--- 212,219 ----
     Get_Sec_Stack_Addr : Get_Address_Call := Get_Sec_Stack_Addr_NT'Access;
     Set_Sec_Stack_Addr : Set_Address_Call := Set_Sec_Stack_Addr_NT'Access;
  
!    function Get_Exc_Stack_Addr_NT return Address;
     Get_Exc_Stack_Addr : Get_Address_Call := Get_Exc_Stack_Addr_NT'Access;
  
     function  Get_Current_Excep_NT return EOA;
  
*************** package System.Soft_Links is
*** 302,325 ****
        --  to the tasks requested stack size before the task can do
        --  its first stack check.
  
!       Jmpbuf_Address : Address := Null_Address;
        --  Address of jump buffer used to store the address of the
        --  current longjmp/setjmp buffer for exception management.
        --  These buffers are threaded into a stack, and the address
        --  here is the top of the stack. A null address means that
        --  no exception handler is currently active.
  
!       Sec_Stack_Addr : Address := Null_Address;
        --  Address of currently allocated secondary stack
  
-       Exc_Stack_Addr : Address := Null_Address;
-       --  Address of a task-specific stack used for the propagation of
-       --  exceptions in response to synchronous faults. This alternate
-       --  stack is necessary when propagating Storage_Error resulting
-       --  from a stack overflow, as the task's primary stack is full.
-       --  This is currently only used on the SGI, and this value stays
-       --  null on other platforms.
- 
        Current_Excep : aliased EO;
        --  Exception occurrence that contains the information for the
        --  current exception. Note that any exception in the same task
--- 291,308 ----
        --  to the tasks requested stack size before the task can do
        --  its first stack check.
  
!       pragma Warnings (Off);
!       Jmpbuf_Address : System.Address := System.Null_Address;
        --  Address of jump buffer used to store the address of the
        --  current longjmp/setjmp buffer for exception management.
        --  These buffers are threaded into a stack, and the address
        --  here is the top of the stack. A null address means that
        --  no exception handler is currently active.
  
!       Sec_Stack_Addr : System.Address := System.Null_Address;
!       pragma Warnings (On);
        --  Address of currently allocated secondary stack
  
        Current_Excep : aliased EO;
        --  Exception occurrence that contains the information for the
        --  current exception. Note that any exception in the same task
*************** package System.Soft_Links is
*** 328,336 ****
        --
        --  Also act as a list of the active exceptions in the case of the GCC
        --  exception mechanism, organized as a stack with the most recent first.
- 
-       Machine_State_Addr : Address := Null_Address;
-       --  Machine state address. Used by front-end zero cost exception
     end record;
  
     procedure Create_TSD (New_TSD : in out TSD);
--- 311,316 ----
*************** package System.Soft_Links is
*** 340,346 ****
  
     procedure Destroy_TSD (Old_TSD : in out TSD);
     pragma Inline (Destroy_TSD);
!    --  Called from s-tassta  just before a thread is destroyed to perform
     --  any required finalization.
  
     function Get_GNAT_Exception return Ada.Exceptions.Exception_Id;
--- 320,326 ----
  
     procedure Destroy_TSD (Old_TSD : in out TSD);
     pragma Inline (Destroy_TSD);
!    --  Called from s-tassta just before a thread is destroyed to perform
     --  any required finalization.
  
     function Get_GNAT_Exception return Ada.Exceptions.Exception_Id;
*************** package System.Soft_Links is
*** 364,377 ****
     pragma Inline (Get_Sec_Stack_Addr_Soft);
     pragma Inline (Set_Sec_Stack_Addr_Soft);
  
!    function  Get_Exc_Stack_Addr_Soft return Address;
!    procedure Set_Exc_Stack_Addr_Soft (Self_ID : Address; Addr : Address);
!    pragma Inline (Get_Exc_Stack_Addr_Soft);
!    pragma Inline (Set_Exc_Stack_Addr_Soft);
! 
!    function  Get_Machine_State_Addr_Soft return Address;
!    procedure Set_Machine_State_Addr_Soft (Addr : Address);
!    pragma Inline (Get_Machine_State_Addr_Soft);
!    pragma Inline (Set_Machine_State_Addr_Soft);
  
  end System.Soft_Links;
--- 344,349 ----
     pragma Inline (Get_Sec_Stack_Addr_Soft);
     pragma Inline (Set_Sec_Stack_Addr_Soft);
  
!    function Get_Exc_Stack_Addr_Soft return Address;
  
  end System.Soft_Links;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-solita.adb gcc-4.1.0/gcc/ada/s-solita.adb
*** gcc-4.0.2/gcc/ada/s-solita.adb	Mon Sep 13 10:18:42 2004
--- gcc-4.1.0/gcc/ada/s-solita.adb	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2004-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Task_Primitives.Operations;
*** 47,55 ****
  with System.Tasking;
  --  Used for Task_Id
  
- with Ada.Exceptions;
- --  Used for Raise_Exception
- 
  package body System.Soft_Links.Tasking is
  
     package STPO renames System.Task_Primitives.Operations;
--- 47,52 ----
*************** package body System.Soft_Links.Tasking i
*** 75,84 ****
     procedure Set_Sec_Stack_Addr (Addr : Address);
     --  Get/Set location of current task's secondary stack
  
-    function  Get_Machine_State_Addr return Address;
-    procedure Set_Machine_State_Addr (Addr : Address);
-    --  Get/Set the address for storing the current task's machine state
- 
     function Get_Current_Excep return SSL.EOA;
     --  Task-safe version of SSL.Get_Current_Excep
  
--- 72,77 ----
*************** package body System.Soft_Links.Tasking i
*** 99,109 ****
        return STPO.Self.Common.Compiler_Data.Jmpbuf_Address;
     end Get_Jmpbuf_Address;
  
-    function Get_Machine_State_Addr return Address is
-    begin
-       return STPO.Self.Common.Compiler_Data.Machine_State_Addr;
-    end Get_Machine_State_Addr;
- 
     function Get_Sec_Stack_Addr return  Address is
     begin
        return STPO.Self.Common.Compiler_Data.Sec_Stack_Addr;
--- 92,97 ----
*************** package body System.Soft_Links.Tasking i
*** 118,128 ****
        STPO.Self.Common.Compiler_Data.Jmpbuf_Address := Addr;
     end Set_Jmpbuf_Address;
  
-    procedure Set_Machine_State_Addr (Addr : Address) is
-    begin
-       STPO.Self.Common.Compiler_Data.Machine_State_Addr := Addr;
-    end Set_Machine_State_Addr;
- 
     procedure Set_Sec_Stack_Addr (Addr : Address) is
     begin
        STPO.Self.Common.Compiler_Data.Sec_Stack_Addr := Addr;
--- 106,111 ----
*************** package body System.Soft_Links.Tasking i
*** 143,154 ****
        if System.Tasking.Detect_Blocking
          and then Self_Id.Common.Protected_Action_Nesting > 0
        then
!          Ada.Exceptions.Raise_Exception
!            (Program_Error'Identity, "potentially blocking operation");
        else
           STPO.Timed_Delay (Self_Id, Time, Mode);
        end if;
- 
     end Timed_Delay_T;
  
     -----------------------------
--- 126,137 ----
        if System.Tasking.Detect_Blocking
          and then Self_Id.Common.Protected_Action_Nesting > 0
        then
!          raise Program_Error with "potentially blocking operation";
        else
+          Abort_Defer.all;
           STPO.Timed_Delay (Self_Id, Time, Mode);
+          Abort_Undefer.all;
        end if;
     end Timed_Delay_T;
  
     -----------------------------
*************** package body System.Soft_Links.Tasking i
*** 172,179 ****
           SSL.Set_Jmpbuf_Address     := Set_Jmpbuf_Address'Access;
           SSL.Get_Sec_Stack_Addr     := Get_Sec_Stack_Addr'Access;
           SSL.Set_Sec_Stack_Addr     := Set_Sec_Stack_Addr'Access;
-          SSL.Get_Machine_State_Addr := Get_Machine_State_Addr'Access;
-          SSL.Set_Machine_State_Addr := Set_Machine_State_Addr'Access;
           SSL.Get_Current_Excep      := Get_Current_Excep'Access;
           SSL.Timed_Delay            := Timed_Delay_T'Access;
  
--- 155,160 ----
*************** package body System.Soft_Links.Tasking i
*** 182,188 ****
  
           SSL.Set_Sec_Stack_Addr     (SSL.Get_Sec_Stack_Addr_NT);
           SSL.Set_Jmpbuf_Address     (SSL.Get_Jmpbuf_Address_NT);
-          SSL.Set_Machine_State_Addr (SSL.Get_Machine_State_Addr_NT);
        end if;
     end Init_Tasking_Soft_Links;
  
--- 163,168 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-solita.ads gcc-4.1.0/gcc/ada/s-solita.ads
*** gcc-4.0.2/gcc/ada/s-solita.ads	Mon Aug  9 12:24:25 2004
--- gcc-4.1.0/gcc/ada/s-solita.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco3.adb gcc-4.1.0/gcc/ada/s-sopco3.adb
*** gcc-4.0.2/gcc/ada/s-sopco3.adb	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco3.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco3.ads gcc-4.1.0/gcc/ada/s-sopco3.ads
*** gcc-4.0.2/gcc/ada/s-sopco3.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco3.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  --  This package contains the function for concatenating three strings
  
  package System.String_Ops_Concat_3 is
! pragma Pure (String_Ops_Concat_3);
  
     function Str_Concat_3 (S1, S2, S3 : String) return String;
!    --  Concatenate two strings and return resulting string
  
  end System.String_Ops_Concat_3;
--- 34,42 ----
  --  This package contains the function for concatenating three strings
  
  package System.String_Ops_Concat_3 is
!    pragma Pure;
  
     function Str_Concat_3 (S1, S2, S3 : String) return String;
!    --  Concatenate three strings and return resulting string
  
  end System.String_Ops_Concat_3;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco4.adb gcc-4.1.0/gcc/ada/s-sopco4.adb
*** gcc-4.0.2/gcc/ada/s-sopco4.adb	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco4.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco4.ads gcc-4.1.0/gcc/ada/s-sopco4.ads
*** gcc-4.0.2/gcc/ada/s-sopco4.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco4.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  --  This package contains the function for concatenating four strings
  
  package System.String_Ops_Concat_4 is
! pragma Pure (String_Ops_Concat_4);
  
     function Str_Concat_4 (S1, S2, S3, S4 : String) return String;
!    --  Concatenate two strings and return resulting string
  
  end System.String_Ops_Concat_4;
--- 34,42 ----
  --  This package contains the function for concatenating four strings
  
  package System.String_Ops_Concat_4 is
!    pragma Pure;
  
     function Str_Concat_4 (S1, S2, S3, S4 : String) return String;
!    --  Concatenate four strings and return resulting string
  
  end System.String_Ops_Concat_4;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco5.adb gcc-4.1.0/gcc/ada/s-sopco5.adb
*** gcc-4.0.2/gcc/ada/s-sopco5.adb	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco5.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-sopco5.ads gcc-4.1.0/gcc/ada/s-sopco5.ads
*** gcc-4.0.2/gcc/ada/s-sopco5.ads	Thu Apr 24 17:54:13 2003
--- gcc-4.1.0/gcc/ada/s-sopco5.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,42 ****
  --  This package contains the function for concatenating five strings
  
  package System.String_Ops_Concat_5 is
! pragma Pure (String_Ops_Concat_5);
  
     function Str_Concat_5 (S1, S2, S3, S4, S5 : String) return String;
!    --  Concatenate two strings and return resulting string
  
  end System.String_Ops_Concat_5;
--- 34,42 ----
  --  This package contains the function for concatenating five strings
  
  package System.String_Ops_Concat_5 is
!    pragma Pure;
  
     function Str_Concat_5 (S1, S2, S3, S4, S5 : String) return String;
!    --  Concatenate five strings and return resulting string
  
  end System.String_Ops_Concat_5;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stache.adb gcc-4.1.0/gcc/ada/s-stache.adb
*** gcc-4.0.2/gcc/ada/s-stache.adb	Mon Mar 22 14:06:28 2004
--- gcc-4.1.0/gcc/ada/s-stache.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . S T A C K _ C H E C K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . S T A C K _ C H E C K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 1999-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stache.ads gcc-4.1.0/gcc/ada/s-stache.ads
*** gcc-4.0.2/gcc/ada/s-stache.ads	Mon Mar 22 14:06:28 2004
--- gcc-4.1.0/gcc/ada/s-stache.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . S T A C K _ C H E C K I N G                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1999-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . S T A C K _ C H E C K I N G                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1999-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,46 ****
  with System.Storage_Elements;
  
  package System.Stack_Checking is
! 
     pragma Elaborate_Body;
     --  This unit has a junk null body. The reason is that historically we
     --  used to have a real body, and it causes bootstrapping path problems
--- 40,46 ----
  with System.Storage_Elements;
  
  package System.Stack_Checking is
!    pragma Preelaborate;
     pragma Elaborate_Body;
     --  This unit has a junk null body. The reason is that historically we
     --  used to have a real body, and it causes bootstrapping path problems
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stalib.adb gcc-4.1.0/gcc/ada/s-stalib.adb
*** gcc-4.0.2/gcc/ada/s-stalib.adb	Mon Jan  5 15:20:46 2004
--- gcc-4.1.0/gcc/ada/s-stalib.adb	Mon Aug 29 15:41:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1995-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1995-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,48 ****
  --  of System.Standard_Library, since this would cause order of elaboration
  --  problems (Elaborate_Body would have the same problem).
  
- pragma Warnings (Off);
- --  Kill warnings from unused withs
- 
  pragma Polling (Off);
  --  We must turn polling off for this unit, because otherwise we get
  --  elaboration circularities with Ada.Exceptions if polling is on.
  
  with System.Soft_Links;
  --  Referenced directly from generated code using external symbols so it
  --  must always be present in a build, even if no unit has a direct with
--- 36,48 ----
  --  of System.Standard_Library, since this would cause order of elaboration
  --  problems (Elaborate_Body would have the same problem).
  
  pragma Polling (Off);
  --  We must turn polling off for this unit, because otherwise we get
  --  elaboration circularities with Ada.Exceptions if polling is on.
  
+ pragma Warnings (Off);
+ --  Kill warnings from unused withs
+ 
  with System.Soft_Links;
  --  Referenced directly from generated code using external symbols so it
  --  must always be present in a build, even if no unit has a direct with
*************** with System.Memory;
*** 56,72 ****
  --  must always be present in a build, even if no unit has a direct with
  --  of this unit.
  
  package body System.Standard_Library is
  
     Runtime_Finalized : Boolean := False;
     --  Set to True when adafinal is called. Used to ensure that subsequent
     --  calls to adafinal after the first have no effect.
  
-    Inside_Elab_Final_Code : Integer := 0;
-    pragma Export (C, Inside_Elab_Final_Code, "__gnat_inside_elab_final_code");
-    --  ???This variable is obsolete since 2001-08-29 but cannot be removed
-    --  ???right away due to the bootstrap problems
- 
     --------------------------
     -- Abort_Undefer_Direct --
     --------------------------
--- 56,69 ----
  --  must always be present in a build, even if no unit has a direct with
  --  of this unit.
  
+ pragma Warnings (On);
+ 
  package body System.Standard_Library is
  
     Runtime_Finalized : Boolean := False;
     --  Set to True when adafinal is called. Used to ensure that subsequent
     --  calls to adafinal after the first have no effect.
  
     --------------------------
     -- Abort_Undefer_Direct --
     --------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stalib.ads gcc-4.1.0/gcc/ada/s-stalib.ads
*** gcc-4.0.2/gcc/ada/s-stalib.ads	Mon Apr 19 15:20:13 2004
--- gcc-4.1.0/gcc/ada/s-stalib.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System;
*** 54,64 ****
  with Unchecked_Conversion;
  
  package System.Standard_Library is
! 
!    pragma Suppress (All_Checks);
!    --  Suppress explicitely all the checks to work around the Solaris linker
!    --  bug when using gnatmake -f -a (but without -gnatp). This is not needed
!    --  with Solaris 2.6, so eventually can be removed ???
  
     type Big_String_Ptr is access all String (Positive);
     --  A non-fat pointer type for null terminated strings
--- 54,62 ----
  with Unchecked_Conversion;
  
  package System.Standard_Library is
!    pragma Warnings (Off);
!    pragma Preelaborate_05;
!    pragma Warnings (On);
  
     type Big_String_Ptr is access all String (Positive);
     --  A non-fat pointer type for null terminated strings
*************** package System.Standard_Library is
*** 137,144 ****
        Name_Length : Natural;
        --  Length of fully expanded name of exception
  
!       Full_Name : Big_String_Ptr;
        --  Fully expanded name of exception, null terminated
  
        HTable_Ptr : Exception_Data_Ptr;
        --  Hash table pointer used to link entries together in the hash table
--- 135,143 ----
        Name_Length : Natural;
        --  Length of fully expanded name of exception
  
!       Full_Name : System.Address;
        --  Fully expanded name of exception, null terminated
+       --  You can use To_Ptr to convert this to a string.
  
        HTable_Ptr : Exception_Data_Ptr;
        --  Hash table pointer used to link entries together in the hash table
*************** package System.Standard_Library is
*** 157,163 ****
        --  whenever the exception is raised. This call occurs immediately,
        --  before any other actions taken by the raise (and in particular
        --  before any unwinding of the stack occurs).
- 
     end record;
  
     --  Definitions for standard predefined exceptions defined in Standard,
--- 156,161 ----
*************** package System.Standard_Library is
*** 179,185 ****
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Constraint_Error_Name'Length,
!       Full_Name             => To_Ptr (Constraint_Error_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 177,183 ----
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Constraint_Error_Name'Length,
!       Full_Name             => Constraint_Error_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
*************** package System.Standard_Library is
*** 188,194 ****
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Numeric_Error_Name'Length,
!       Full_Name             => To_Ptr (Numeric_Error_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 186,192 ----
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Numeric_Error_Name'Length,
!       Full_Name             => Numeric_Error_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
*************** package System.Standard_Library is
*** 197,203 ****
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Program_Error_Name'Length,
!       Full_Name             => To_Ptr (Program_Error_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 195,201 ----
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Program_Error_Name'Length,
!       Full_Name             => Program_Error_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
*************** package System.Standard_Library is
*** 206,212 ****
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Storage_Error_Name'Length,
!       Full_Name             => To_Ptr (Storage_Error_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 204,210 ----
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Storage_Error_Name'Length,
!       Full_Name             => Storage_Error_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
*************** package System.Standard_Library is
*** 215,221 ****
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Tasking_Error_Name'Length,
!       Full_Name             => To_Ptr (Tasking_Error_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 213,219 ----
       (Not_Handled_By_Others => False,
        Lang                  => 'A',
        Name_Length           => Tasking_Error_Name'Length,
!       Full_Name             => Tasking_Error_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
*************** package System.Standard_Library is
*** 224,230 ****
       (Not_Handled_By_Others => True,
        Lang                  => 'A',
        Name_Length           => Abort_Signal_Name'Length,
!       Full_Name             => To_Ptr (Abort_Signal_Name'Address),
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
--- 222,228 ----
       (Not_Handled_By_Others => True,
        Lang                  => 'A',
        Name_Length           => Abort_Signal_Name'Length,
!       Full_Name             => Abort_Signal_Name'Address,
        HTable_Ptr            => null,
        Import_Code           => 0,
        Raise_Hook            => null);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stausa.adb gcc-4.1.0/gcc/ada/s-stausa.adb
*** gcc-4.0.2/gcc/ada/s-stausa.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-stausa.adb	Mon Jul  4 10:10:39 2005
***************
*** 0 ****
--- 1,96 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+ --                                                                          --
+ --                   S Y S T E M - S T A C K _ U S A G E                    --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --         Copyright (C) 2004-2005, Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNARL is free software; you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNARL; see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNARL was developed by the GNARL team at Florida State University.       --
+ -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ --  Dummy implementation.
+ 
+ package body System.Stack_Usage is
+ 
+    --------------------
+    -- Compute_Result --
+    --------------------
+ 
+    procedure Compute_Result (Analyzer : in out Stack_Analyzer) is
+       pragma Unreferenced (Analyzer);
+    begin
+       null;
+    end Compute_Result;
+ 
+    ----------------
+    -- Fill_Stack --
+    ----------------
+ 
+    procedure Fill_Stack (Analyzer : in out Stack_Analyzer) is
+       pragma Unreferenced (Analyzer);
+    begin
+       null;
+    end Fill_Stack;
+ 
+    -------------------------
+    -- Initialize_Analyzer --
+    -------------------------
+ 
+    procedure Initialize_Analyzer
+      (Analyzer  : in out Stack_Analyzer;
+       Task_Name : String;
+       Size      : Natural;
+       Bottom    : Stack_Address;
+       Pattern   : Word_32 := 16#DEAD_BEEF#)
+    is
+       pragma Unreferenced (Analyzer);
+       pragma Unreferenced (Task_Name);
+       pragma Unreferenced (Size);
+       pragma Unreferenced (Pattern);
+       pragma Unreferenced (Bottom);
+    begin
+       null;
+    end Initialize_Analyzer;
+ 
+    ---------------------
+    --  Output_Results --
+    ---------------------
+ 
+    procedure Output_Results is
+    begin
+       null;
+    end Output_Results;
+ 
+    -------------------
+    -- Report_Result --
+    -------------------
+ 
+    procedure Report_Result (Analyzer : Stack_Analyzer) is
+       pragma Unreferenced (Analyzer);
+    begin
+       null;
+    end Report_Result;
+ 
+ end System.Stack_Usage;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stausa.ads gcc-4.1.0/gcc/ada/s-stausa.ads
*** gcc-4.0.2/gcc/ada/s-stausa.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/s-stausa.ads	Mon Jul  4 10:10:39 2005
***************
*** 0 ****
--- 1,289 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+ --                                                                          --
+ --                   S Y S T E M - S T A C K _ U S A G E                    --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                                                                          --
+ --         Copyright (C) 2004-2005, Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNARL is free software; you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNARL; see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNARL was developed by the GNARL team at Florida State University.       --
+ -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ with System;
+ with System.Storage_Elements;
+ with System.Address_To_Access_Conversions;
+ 
+ package System.Stack_Usage is
+ 
+    package SSE renames System.Storage_Elements;
+ 
+    Byte_Size : constant := 8;
+    Word_32_Size : constant := 4 * Byte_Size;
+ 
+    type Word_32 is mod 2 ** Word_32_Size;
+    for Word_32'Alignment use 4;
+ 
+    subtype Stack_Address is SSE.Integer_Address;
+    --  Address on the stack.
+    --
+    --  NOTE:
+    --  *****
+    --
+    --  in this package, when comparing two addresses on the
+    --  stack, the comments use the terms "outer", "inner", "outermost"
+    --  and "innermost" instead of the ambigous "higher", "lower",
+    --  "highest" and "lowest". "inner" means "closer to the bottom of
+    --  stack" and is the contrary of "outer". "innermost" means "closest
+    --  address to the bottom of stack". The stack is growing from the
+    --  innermost addresses to the outermost addresses.
+ 
+    function To_Stack_Address (Value : Address) return Stack_Address
+      renames System.Storage_Elements.To_Integer;
+ 
+    type Stack_Analyzer is private;
+    --  Type of the stack analyzer tool. It is used to fill a portion of
+    --  the stack with Pattern, and to compute the stack used after some
+    --  execution.
+    --
+    --  USAGE:
+    --  ******
+    --
+    --  --  A typical use of the package is something like:
+    --
+    --  A : Stack_Analyzer;
+    --
+    --  task T is
+    --     pragma Storage_Size (A_Storage_Size);
+    --  end T;
+    --
+    --  [...]
+    --
+    --     Bottom_Of_Stack : aliased Integer;
+    --     --  Bottom_Of_Stack'Address will be used as an approximation of
+    --     --  the bottom of stack. A good practise is to avoid allocating
+    --     --  other local variables on this stack, as it would degrade
+    --     --  the quality of this approximation.
+    --
+    --  begin
+    --     Initialize_Analyzer (A,
+    --                          "Task t",
+    --                          A_Storage_Size - A_Guard,
+    --                          To_Stack_Address (Bottom_Of_Stack'Address));
+    --     Fill_Stack (A);
+    --     Some_User_Code;
+    --     Compute_Result (A);
+    --     Report_Result (A);
+    --  end T;
+    --
+    --
+    --  Errors:
+    --  *******
+    --
+    --  We are instrumenting the code to measure the stack used by the user
+    --  code. This method has a number of systematic errors, but several
+    --  methods can be used to evaluate or reduce those errors. Here are
+    --  those errors and the strategy that we use to deal with them:
+    --
+    --  * Bottom offset:
+    --   - Description: The procedure used to fill the stack with a given
+    --   pattern will itself have a stack frame. The value of the stack pointer
+    --   in this procedure is, therefore, different from the value before the
+    --   call to the instrumentation procedure.
+    --   - Strategy: The user of this package shall measure the bottom of stack
+    --   before the call to Fill_Stack and pass it in parameter.
+    --
+    --  * Instrumentation threshold at writing:
+    --   - Description: The procedure used to fill the stack with a given
+    --   pattern will itself have a stack frame.  Therefore, it will
+    --   fill the stack after this stack frame. This part of the stack will
+    --   appear as used in the final measure.
+    --   - Strategy: As the user pass the value of the bottom of stack to
+    --   the instrumentation to deal with the bottom offset error, and as
+    --   as the instrumentation procedure knows where the pattern filling
+    --   start on the stack, the difference between the two values is the
+    --   minimum stack usage that the method can measure. If, when the results
+    --   are computed, the pattern zone has been left untouched, we conclude
+    --   that the stack usage is inferior to this minimum stack usage.
+    --
+    --  * Instrumentation threshold at reading:
+    --   - Description: The procedure used to read the stack at the end of the
+    --   execution clobbers the stack by allocating its stack frame. If this
+    --   stack frame is bigger than the total stack used by the user code at
+    --   this point, it will increase the measured stack size.
+    --   - Strategy: We could augment this stack frame and see if it changes the
+    --   measure. However, this error should be negligeable.
+    --
+    --   * Pattern zone overflow:
+    --    - Description: The stack grows outer than the outermost bound of the
+    --    pattern zone. In that case, the outermost region modified in the
+    --    pattern is not the maximum value of the stack pointer during the
+    --    execution.
+    --    - Strategy: At the end of the execution, the difference between the
+    --    outermost memory region modified in the pattern zone and the
+    --    outermost bound of the pattern zone can be understood as the
+    --    biggest allocation that the method could have detect, provided
+    --    that there is no "Untouched allocated zone" error and no "Pattern
+    --    usage in user code" error. If no object in the user code is likely
+    --    to have this size, this is not likely to happen.
+    --
+    --   * Pattern usage in user code:
+    --    - Description: The pattern can be found in the object of the user
+    --    code. Therefore, the address space where this object has been
+    --    allocated will appear as untouched.
+    --    - Strategy: Choose a pattern that is uncommon. 16#0000_0000# is the
+    --    worst choice; 16#DEAD_BEEF# can be a good one. A good choice is an
+    --    address which is not a multiple of 2, and which is not in the
+    --    target address space. You can also change the pattern to see if
+    --    it changes the measure. Note that this error *very* rarely influence
+    --    the measure of the total stack usage: to have some influence, the
+    --    pattern has to be used in the object that has been allocated on the
+    --    outermost address of the used stack.
+    --
+    --   * Stack overflow:
+    --    - Description: The pattern zone does not fit on the stack.
+    --    This may lead to an erroneous execution.
+    --    - Strategy: Specify a storage size that is bigger than the
+    --    size of the pattern. 2 times bigger should be enough.
+    --
+    --   * Augmentation of the user stack frames:
+    --    - Description: The use of instrumentation object or procedure may
+    --    augment the stack frame of the caller.
+    --    - Strategy: Do *not* inline the instrumentation procedures. Do *not*
+    --    allocate the Stack_Analyzer object on the stack.
+    --
+    --   * Untouched allocated zone:
+    --    - Description: The user code may allocate objects that it will never
+    --    touch. In that case, the pattern will not be changed.
+    --    - Strategy: There are no way to detect this error. Fortunately, this
+    --    error is really rare, and it is most probably a bug in the user code,
+    --    e.g. some uninitialized variable. It is (most of the time) harmless:
+    --    it influences the measure only if the untouched allocated zone
+    --    happens to be located at the outermost value of the stack pointer
+    --    for the whole execution.
+ 
+    procedure Fill_Stack (Analyzer : in out Stack_Analyzer);
+    --  Fill an area of the stack with the pattern Analyzer.Pattern. The size
+    --  of this area is Analyzer.Size. After the call to this procedure,
+    --  the memory will look like that:
+    --
+    --                                                             Stack growing
+    --  ----------------------------------------------------------------------->
+    --  |<---------------------->|<----------------------------------->|
+    --  |  Stack frame           | Memory filled with Analyzer.Pattern |
+    --  |  of Fill_Stack         |                                     |
+    --  |  (deallocated at       |                                     |
+    --  |  the end of the call)  |                                     |
+    --  ^                        |                                     |
+    --  Analyzer.Bottom_Of_Stack ^                                     |
+    --                    Analyzer.Inner_Pattern_Mark                  ^
+    --                                            Analyzer.Outer_Pattern_Mark
+ 
+    procedure Compute_Result (Analyzer : in out Stack_Analyzer);
+    --  Read the patern zone and deduce the stack usage. It should
+    --  be called from the same frame as Fill_Stack. If Analyzer.Probe is not
+    --  null, an array of Word_32 with Analyzer.Probe elements is allocated on
+    --  Compute_Result's stack frame. Probe can be used to detect an
+    --  "instrumentation threshold at reading" error; See above.
+    --  After the call to this procedure, the memory will look like:
+    --
+    --                                                             Stack growing
+    --  ----------------------------------------------------------------------->
+    --  |<---------------------->|<-------------->|<--------->|<--------->|
+    --  |  Stack frame           | Array of       | used      |  Memory   |
+    --  |  of Compute_Result     | Analyzer.Probe | during    |   filled  |
+    --  |  (deallocated at       | elements       |  the      |    with   |
+    --  |  the end of the call)  |                | execution |  pattern  |
+    --  |                        ^                |           |           |
+    --  |                   Inner_Pattern_Mark    |           |           |
+    --  |                                                     |           |
+    --  |<---------------------------------------------------->           |
+    --                  Stack used                                        ^
+    --                                                     Outer_Pattern_Mark
+ 
+    procedure Report_Result (Analyzer : Stack_Analyzer);
+    --  Store the results of the computation in memory, at the address
+    --  corresponding to the symbol __gnat_stack_usage_results.
+ 
+    type Parameterless_Procedure is access procedure;
+ 
+    procedure Initialize_Analyzer
+      (Analyzer  : in out Stack_Analyzer;
+       Task_Name : String;
+       Size      : Natural;
+       Bottom    : Stack_Address;
+       Pattern   : Word_32 := 16#DEAD_BEEF#);
+    --  Should be called before any use of a Stack_Analyzer, to initialize it.
+    --  Size is the size of the pattern zone.
+    --  Bottom should be a close approximation of the caller base
+    --  frame address.
+ 
+    procedure Output_Results;
+    --  Print the results computed so far on the standard output. Should be
+    --  called when all tasks are dead.
+ 
+ private
+ 
+    package Word_32_Addr is
+       new System.Address_To_Access_Conversions (Word_32);
+ 
+    type Result_Array_Id is range 0 .. 1_023;
+ 
+    type Stack_Analyzer
+    is record
+       Size                   : Natural;
+       --  Size of the pattern zone.
+ 
+       Pattern                : Word_32 := 16#DEAD_BEEF#;
+       --  Pattern used to recognize untouched memory.
+ 
+       Inner_Pattern_Mark     : Stack_Address;
+       --  Innermost bound of the pattern area on the stack.
+ 
+       Outer_Pattern_Mark     : Stack_Address;
+       --  Outermost bound of the pattern area on the stack.
+ 
+       Outermost_Touched_Mark : Stack_Address;
+       --  Outermost address of the pattern area whose value it is pointing
+       --  at has been modified during execution. If the systematic error are
+       --  compensated, it is the outermost value of the stack pointer during
+       --  the execution.
+ 
+       Bottom_Of_Stack        : Stack_Address;
+       --  Address of the bottom of the stack, as given by the caller of
+       --  Initialize_Analyzer.
+ 
+       Array_Address          : Address;
+       --  Address of the array of Word_32 that represents the pattern zone.
+ 
+       First_Is_Outermost     : Boolean;
+       --  Set to true if the first element of the array of Word_32 that
+       --  represents the pattern zone is at the outermost address of the
+       --  pattern zone; false if it is the innermost address.
+ 
+       Result_Id              : Result_Array_Id;
+       --  Location in the result array of the result for the current task.
+    end record;
+ 
+ end System.Stack_Usage;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stchop-vxworks.adb gcc-4.1.0/gcc/ada/s-stchop-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-stchop-vxworks.adb	Fri Jun 11 10:47:39 2004
--- gcc-4.1.0/gcc/ada/s-stchop-vxworks.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1999-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1999-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stchop.adb gcc-4.1.0/gcc/ada/s-stchop.adb
*** gcc-4.0.2/gcc/ada/s-stchop.adb	Mon Jun  7 14:16:33 2004
--- gcc-4.1.0/gcc/ada/s-stchop.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1999-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1999-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stchop.ads gcc-4.1.0/gcc/ada/s-stchop.ads
*** gcc-4.0.2/gcc/ada/s-stchop.ads	Mon Jun  7 14:16:33 2004
--- gcc-4.1.0/gcc/ada/s-stchop.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --            Copyright (C) 1999-2004 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --            Copyright (C) 1999-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stoele.adb gcc-4.1.0/gcc/ada/s-stoele.adb
*** gcc-4.0.2/gcc/ada/s-stoele.adb	Fri Apr 23 10:58:31 2004
--- gcc-4.1.0/gcc/ada/s-stoele.adb	Tue Nov 15 14:04:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Storage_Elements is
*** 61,75 ****
        return To_Offset (To_Address (To_Integer (Left) - To_Integer (Right)));
     end "-";
  
!    function "mod" (Left : Address; Right : Storage_Offset)
!      return Storage_Offset is
     begin
        if Right >= 0 then
           return Storage_Offset
                    (To_Integer (Left) mod Integer_Address (Right));
        else
           return -Storage_Offset
!                   (To_Integer (Left) mod Integer_Address (-Right));
        end if;
     end "mod";
  
--- 61,77 ----
        return To_Offset (To_Address (To_Integer (Left) - To_Integer (Right)));
     end "-";
  
!    function "mod"
!      (Left  : Address;
!       Right : Storage_Offset) return Storage_Offset
!    is
     begin
        if Right >= 0 then
           return Storage_Offset
                    (To_Integer (Left) mod Integer_Address (Right));
        else
           return -Storage_Offset
!                   ((-To_Integer (Left)) mod Integer_Address (-Right));
        end if;
     end "mod";
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stoele.ads gcc-4.1.0/gcc/ada/s-stoele.ads
*** gcc-4.0.2/gcc/ada/s-stoele.ads	Mon Apr 19 15:20:14 2004
--- gcc-4.1.0/gcc/ada/s-stoele.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,54 ****
  --  It is a good idea to avoid use clauses for this package!
  
  package System.Storage_Elements is
! pragma Pure (Storage_Elements);
! --  Note that we take advantage of the implementation permission to make
! --  this unit Pure instead of Preelaborable; see RM 13.7.1(15).
  
! --  We also add the pragma Pure_Function to the operations in this package,
! --  because otherwise functions with parameters derived from Address are
! --  treated as non-pure by the back-end (see exp_ch6.adb). This is because
! --  in many cases such a parameter is used to hide read/out access to objects,
! --  and it would be unsafe to treat such functions as pure.
  
     type Storage_Offset is range
       -(2 ** (Integer'(Standard'Address_Size) - 1)) ..
--- 40,55 ----
  --  It is a good idea to avoid use clauses for this package!
  
  package System.Storage_Elements is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada 2005,
!    --  this is Pure in any case (AI-362).
  
!    --  We also add the pragma Pure_Function to the operations in this package,
!    --  because otherwise functions with parameters derived from Address are
!    --  treated as non-pure by the back-end (see exp_ch6.adb). This is because
!    --  in many cases such a parameter is used to hide read/out access to
!    --  objects, and it would be unsafe to treat such functions as pure.
  
     type Storage_Offset is range
       -(2 ** (Integer'(Standard'Address_Size) - 1)) ..
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stopoo.adb gcc-4.1.0/gcc/ada/s-stopoo.adb
*** gcc-4.0.2/gcc/ada/s-stopoo.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-stopoo.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stopoo.ads gcc-4.1.0/gcc/ada/s-stopoo.ads
*** gcc-4.0.2/gcc/ada/s-stopoo.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-stopoo.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Ada.Finalization;
*** 39,45 ****
  with System.Storage_Elements;
  
  package System.Storage_Pools is
!    pragma Preelaborate (System.Storage_Pools);
  
     type Root_Storage_Pool is abstract
       new Ada.Finalization.Limited_Controlled with private;
--- 39,45 ----
  with System.Storage_Elements;
  
  package System.Storage_Pools is
!    pragma Preelaborate;
  
     type Root_Storage_Pool is abstract
       new Ada.Finalization.Limited_Controlled with private;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stratt.adb gcc-4.1.0/gcc/ada/s-stratt.adb
*** gcc-4.0.2/gcc/ada/s-stratt.adb	Mon Jan  3 15:37:33 2005
--- gcc-4.1.0/gcc/ada/s-stratt.adb	Tue Nov 15 14:04:34 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Stream_Attributes is
*** 119,125 ****
     -- I_AD --
     ----------
  
!    function I_AD (Stream : access RST) return Fat_Pointer is
        T : S_AD;
        L : SEO;
  
--- 119,125 ----
     -- I_AD --
     ----------
  
!    function I_AD (Stream : not null access RST) return Fat_Pointer is
        T : S_AD;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 137,143 ****
     -- I_AS --
     ----------
  
!    function I_AS (Stream : access RST) return Thin_Pointer is
        T : S_AS;
        L : SEO;
  
--- 137,143 ----
     -- I_AS --
     ----------
  
!    function I_AS (Stream : not null access RST) return Thin_Pointer is
        T : S_AS;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 155,161 ****
     -- I_B --
     ---------
  
!    function I_B (Stream : access RST) return Boolean is
        T : S_B;
        L : SEO;
  
--- 155,161 ----
     -- I_B --
     ---------
  
!    function I_B (Stream : not null access RST) return Boolean is
        T : S_B;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 173,179 ****
     -- I_C --
     ---------
  
!    function I_C (Stream : access RST) return Character is
        T : S_C;
        L : SEO;
  
--- 173,179 ----
     -- I_C --
     ---------
  
!    function I_C (Stream : not null access RST) return Character is
        T : S_C;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 191,197 ****
     -- I_F --
     ---------
  
!    function I_F (Stream : access RST) return Float is
        T : S_F;
        L : SEO;
  
--- 191,197 ----
     -- I_F --
     ---------
  
!    function I_F (Stream : not null access RST) return Float is
        T : S_F;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 209,215 ****
     -- I_I --
     ---------
  
!    function I_I (Stream : access RST) return Integer is
        T : S_I;
        L : SEO;
  
--- 209,215 ----
     -- I_I --
     ---------
  
!    function I_I (Stream : not null access RST) return Integer is
        T : S_I;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 227,233 ****
     -- I_LF --
     ----------
  
!    function I_LF (Stream : access RST) return Long_Float is
        T : S_LF;
        L : SEO;
  
--- 227,233 ----
     -- I_LF --
     ----------
  
!    function I_LF (Stream : not null access RST) return Long_Float is
        T : S_LF;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 245,251 ****
     -- I_LI --
     ----------
  
!    function I_LI (Stream : access RST) return Long_Integer is
        T : S_LI;
        L : SEO;
  
--- 245,251 ----
     -- I_LI --
     ----------
  
!    function I_LI (Stream : not null access RST) return Long_Integer is
        T : S_LI;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 263,269 ****
     -- I_LLF --
     -----------
  
!    function I_LLF (Stream : access RST) return Long_Long_Float is
        T : S_LLF;
        L : SEO;
  
--- 263,269 ----
     -- I_LLF --
     -----------
  
!    function I_LLF (Stream : not null access RST) return Long_Long_Float is
        T : S_LLF;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 281,287 ****
     -- I_LLI --
     -----------
  
!    function I_LLI (Stream : access RST) return Long_Long_Integer is
        T : S_LLI;
        L : SEO;
  
--- 281,287 ----
     -- I_LLI --
     -----------
  
!    function I_LLI (Stream : not null access RST) return Long_Long_Integer is
        T : S_LLI;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 299,305 ****
     -- I_LLU --
     -----------
  
!    function I_LLU (Stream : access RST) return UST.Long_Long_Unsigned is
        T : S_LLU;
        L : SEO;
  
--- 299,307 ----
     -- I_LLU --
     -----------
  
!    function I_LLU
!      (Stream : not null access RST) return UST.Long_Long_Unsigned
!    is
        T : S_LLU;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 317,323 ****
     -- I_LU --
     ----------
  
!    function I_LU (Stream : access RST) return UST.Long_Unsigned is
        T : S_LU;
        L : SEO;
  
--- 319,325 ----
     -- I_LU --
     ----------
  
!    function I_LU (Stream : not null access RST) return UST.Long_Unsigned is
        T : S_LU;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 335,341 ****
     -- I_SF --
     ----------
  
!    function I_SF (Stream : access RST) return Short_Float is
        T : S_SF;
        L : SEO;
  
--- 337,343 ----
     -- I_SF --
     ----------
  
!    function I_SF (Stream : not null access RST) return Short_Float is
        T : S_SF;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 353,359 ****
     -- I_SI --
     ----------
  
!    function I_SI (Stream : access RST) return Short_Integer is
        T : S_SI;
        L : SEO;
  
--- 355,361 ----
     -- I_SI --
     ----------
  
!    function I_SI (Stream : not null access RST) return Short_Integer is
        T : S_SI;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 371,377 ****
     -- I_SSI --
     -----------
  
!    function I_SSI (Stream : access RST) return Short_Short_Integer is
        T : S_SSI;
        L : SEO;
  
--- 373,379 ----
     -- I_SSI --
     -----------
  
!    function I_SSI (Stream : not null access RST) return Short_Short_Integer is
        T : S_SSI;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 389,395 ****
     -- I_SSU --
     -----------
  
!    function I_SSU (Stream : access RST) return UST.Short_Short_Unsigned is
        T : S_SSU;
        L : SEO;
  
--- 391,399 ----
     -- I_SSU --
     -----------
  
!    function I_SSU
!      (Stream : not null access RST) return UST.Short_Short_Unsigned
!    is
        T : S_SSU;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 407,413 ****
     -- I_SU --
     ----------
  
!    function I_SU (Stream : access RST) return UST.Short_Unsigned is
        T : S_SU;
        L : SEO;
  
--- 411,417 ----
     -- I_SU --
     ----------
  
!    function I_SU (Stream : not null access RST) return UST.Short_Unsigned is
        T : S_SU;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 425,431 ****
     -- I_U --
     ---------
  
!    function I_U (Stream : access RST) return UST.Unsigned is
        T : S_U;
        L : SEO;
  
--- 429,435 ----
     -- I_U --
     ---------
  
!    function I_U (Stream : not null access RST) return UST.Unsigned is
        T : S_U;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 443,449 ****
     -- I_WC --
     ----------
  
!    function I_WC (Stream : access RST) return Wide_Character is
        T : S_WC;
        L : SEO;
  
--- 447,453 ----
     -- I_WC --
     ----------
  
!    function I_WC (Stream : not null access RST) return Wide_Character is
        T : S_WC;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 461,467 ****
     -- W_AD --
     ----------
  
!    procedure W_AD (Stream : access RST; Item : in Fat_Pointer) is
        T : constant S_AD := From_AD (Item);
  
     begin
--- 465,471 ----
     -- W_AD --
     ----------
  
!    procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer) is
        T : constant S_AD := From_AD (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 472,478 ****
     -- W_AS --
     ----------
  
!    procedure W_AS (Stream : access RST; Item : in Thin_Pointer) is
        T : constant S_AS := From_AS (Item);
  
     begin
--- 476,482 ----
     -- W_AS --
     ----------
  
!    procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer) is
        T : constant S_AS := From_AS (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 483,489 ****
     -- W_B --
     ---------
  
!    procedure W_B (Stream : access RST; Item : in Boolean) is
        T : S_B;
  
     begin
--- 487,493 ----
     -- W_B --
     ---------
  
!    procedure W_B (Stream : not null access RST; Item : in Boolean) is
        T : S_B;
  
     begin
*************** package body System.Stream_Attributes is
*** 495,501 ****
     -- W_C --
     ---------
  
!    procedure W_C (Stream : access RST; Item : in Character) is
        T : S_C;
  
     begin
--- 499,505 ----
     -- W_C --
     ---------
  
!    procedure W_C (Stream : not null access RST; Item : in Character) is
        T : S_C;
  
     begin
*************** package body System.Stream_Attributes is
*** 507,513 ****
     -- W_F --
     ---------
  
!    procedure W_F (Stream : access RST; Item : in Float) is
        T : constant S_F := From_F (Item);
  
     begin
--- 511,517 ----
     -- W_F --
     ---------
  
!    procedure W_F (Stream : not null access RST; Item : in Float) is
        T : constant S_F := From_F (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 518,524 ****
     -- W_I --
     ---------
  
!    procedure W_I (Stream : access RST; Item : in Integer) is
        T : constant S_I := From_I (Item);
  
     begin
--- 522,528 ----
     -- W_I --
     ---------
  
!    procedure W_I (Stream : not null access RST; Item : in Integer) is
        T : constant S_I := From_I (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 529,535 ****
     -- W_LF --
     ----------
  
!    procedure W_LF (Stream : access RST; Item : in Long_Float) is
        T : constant S_LF := From_LF (Item);
  
     begin
--- 533,539 ----
     -- W_LF --
     ----------
  
!    procedure W_LF (Stream : not null access RST; Item : in Long_Float) is
        T : constant S_LF := From_LF (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 540,546 ****
     -- W_LI --
     ----------
  
!    procedure W_LI (Stream : access RST; Item : in Long_Integer) is
        T : constant S_LI := From_LI (Item);
  
     begin
--- 544,550 ----
     -- W_LI --
     ----------
  
!    procedure W_LI (Stream : not null access RST; Item : in Long_Integer) is
        T : constant S_LI := From_LI (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 551,557 ****
     -- W_LLF --
     -----------
  
!    procedure W_LLF (Stream : access RST; Item : in Long_Long_Float) is
        T : constant S_LLF := From_LLF (Item);
  
     begin
--- 555,561 ----
     -- W_LLF --
     -----------
  
!    procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float) is
        T : constant S_LLF := From_LLF (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 562,568 ****
     -- W_LLI --
     -----------
  
!    procedure W_LLI (Stream : access RST; Item : in Long_Long_Integer) is
        T : constant S_LLI := From_LLI (Item);
  
     begin
--- 566,574 ----
     -- W_LLI --
     -----------
  
!    procedure W_LLI
!      (Stream : not null access RST; Item : in Long_Long_Integer)
!    is
        T : constant S_LLI := From_LLI (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 573,579 ****
     -- W_LLU --
     -----------
  
!    procedure W_LLU (Stream : access RST; Item : in UST.Long_Long_Unsigned) is
        T : constant S_LLU := From_LLU (Item);
  
     begin
--- 579,587 ----
     -- W_LLU --
     -----------
  
!    procedure W_LLU
!      (Stream : not null access RST; Item : in UST.Long_Long_Unsigned)
!    is
        T : constant S_LLU := From_LLU (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 584,590 ****
     -- W_LU --
     ----------
  
!    procedure W_LU (Stream : access RST; Item : in UST.Long_Unsigned) is
        T : constant S_LU := From_LU (Item);
  
     begin
--- 592,600 ----
     -- W_LU --
     ----------
  
!    procedure W_LU
!      (Stream : not null access RST; Item : in UST.Long_Unsigned)
!    is
        T : constant S_LU := From_LU (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 595,601 ****
     -- W_SF --
     ----------
  
!    procedure W_SF (Stream : access RST; Item : in Short_Float) is
        T : constant S_SF := From_SF (Item);
  
     begin
--- 605,611 ----
     -- W_SF --
     ----------
  
!    procedure W_SF (Stream : not null access RST; Item : in Short_Float) is
        T : constant S_SF := From_SF (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 606,612 ****
     -- W_SI --
     ----------
  
!    procedure W_SI (Stream : access RST; Item : in Short_Integer) is
        T : constant S_SI := From_SI (Item);
  
     begin
--- 616,622 ----
     -- W_SI --
     ----------
  
!    procedure W_SI (Stream : not null access RST; Item : in Short_Integer) is
        T : constant S_SI := From_SI (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 617,623 ****
     -- W_SSI --
     -----------
  
!    procedure W_SSI (Stream : access RST; Item : in Short_Short_Integer) is
        T : constant S_SSI := From_SSI (Item);
  
     begin
--- 627,635 ----
     -- W_SSI --
     -----------
  
!    procedure W_SSI
!      (Stream : not null access RST; Item : in Short_Short_Integer)
!    is
        T : constant S_SSI := From_SSI (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 628,634 ****
     -- W_SSU --
     -----------
  
!    procedure W_SSU (Stream : access RST; Item : in UST.Short_Short_Unsigned) is
        T : constant S_SSU := From_SSU (Item);
  
     begin
--- 640,648 ----
     -- W_SSU --
     -----------
  
!    procedure W_SSU
!      (Stream : not null access RST; Item : in UST.Short_Short_Unsigned)
!    is
        T : constant S_SSU := From_SSU (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 639,645 ****
     -- W_SU --
     ----------
  
!    procedure W_SU (Stream : access RST; Item : in UST.Short_Unsigned) is
        T : constant S_SU := From_SU (Item);
  
     begin
--- 653,661 ----
     -- W_SU --
     ----------
  
!    procedure W_SU
!      (Stream : not null access RST; Item : in UST.Short_Unsigned)
!    is
        T : constant S_SU := From_SU (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 650,656 ****
     -- W_U --
     ---------
  
!    procedure W_U (Stream : access RST; Item : in UST.Unsigned) is
        T : constant S_U := From_U (Item);
  
     begin
--- 666,672 ----
     -- W_U --
     ---------
  
!    procedure W_U (Stream : not null access RST; Item : in UST.Unsigned) is
        T : constant S_U := From_U (Item);
  
     begin
*************** package body System.Stream_Attributes is
*** 661,667 ****
     -- W_WC --
     ----------
  
!    procedure W_WC (Stream : access RST; Item : in Wide_Character) is
        T : constant S_WC := From_WC (Item);
  
     begin
--- 677,683 ----
     -- W_WC --
     ----------
  
!    procedure W_WC (Stream : not null access RST; Item : in Wide_Character) is
        T : constant S_WC := From_WC (Item);
  
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/s-stratt.ads gcc-4.1.0/gcc/ada/s-stratt.ads
*** gcc-4.0.2/gcc/ada/s-stratt.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-stratt.ads	Tue Nov 15 14:04:34 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Unsigned_Types;
*** 44,50 ****
  with Ada.Streams;
  
  package System.Stream_Attributes is
! pragma Preelaborate (Stream_Attributes);
  
     pragma Suppress (Accessibility_Check, Stream_Attributes);
     --  No need to check accessibility on arguments of subprograms
--- 44,50 ----
  with Ada.Streams;
  
  package System.Stream_Attributes is
!    pragma Preelaborate;
  
     pragma Suppress (Accessibility_Check, Stream_Attributes);
     --  No need to check accessibility on arguments of subprograms
*************** pragma Preelaborate (Stream_Attributes);
*** 101,125 ****
     --  is the same for all elementary types (no bounds or discriminants
     --  are involved).
  
!    function I_AD  (Stream : access RST) return Fat_Pointer;
!    function I_AS  (Stream : access RST) return Thin_Pointer;
!    function I_B   (Stream : access RST) return Boolean;
!    function I_C   (Stream : access RST) return Character;
!    function I_F   (Stream : access RST) return Float;
!    function I_I   (Stream : access RST) return Integer;
!    function I_LF  (Stream : access RST) return Long_Float;
!    function I_LI  (Stream : access RST) return Long_Integer;
!    function I_LLF (Stream : access RST) return Long_Long_Float;
!    function I_LLI (Stream : access RST) return Long_Long_Integer;
!    function I_LLU (Stream : access RST) return UST.Long_Long_Unsigned;
!    function I_LU  (Stream : access RST) return UST.Long_Unsigned;
!    function I_SF  (Stream : access RST) return Short_Float;
!    function I_SI  (Stream : access RST) return Short_Integer;
!    function I_SSI (Stream : access RST) return Short_Short_Integer;
!    function I_SSU (Stream : access RST) return UST.Short_Short_Unsigned;
!    function I_SU  (Stream : access RST) return UST.Short_Unsigned;
!    function I_U   (Stream : access RST) return UST.Unsigned;
!    function I_WC  (Stream : access RST) return Wide_Character;
  
     -----------------------
     -- Output Procedures --
--- 101,126 ----
     --  is the same for all elementary types (no bounds or discriminants
     --  are involved).
  
!    function I_AD  (Stream : not null access RST) return Fat_Pointer;
!    function I_AS  (Stream : not null access RST) return Thin_Pointer;
!    function I_B   (Stream : not null access RST) return Boolean;
!    function I_C   (Stream : not null access RST) return Character;
!    function I_F   (Stream : not null access RST) return Float;
!    function I_I   (Stream : not null access RST) return Integer;
!    function I_LF  (Stream : not null access RST) return Long_Float;
!    function I_LI  (Stream : not null access RST) return Long_Integer;
!    function I_LLF (Stream : not null access RST) return Long_Long_Float;
!    function I_LLI (Stream : not null access RST) return Long_Long_Integer;
!    function I_LLU (Stream : not null access RST) return UST.Long_Long_Unsigned;
!    function I_LU  (Stream : not null access RST) return UST.Long_Unsigned;
!    function I_SF  (Stream : not null access RST) return Short_Float;
!    function I_SI  (Stream : not null access RST) return Short_Integer;
!    function I_SSI (Stream : not null access RST) return Short_Short_Integer;
!    function I_SSU (Stream : not null access RST)
!      return UST.Short_Short_Unsigned;
!    function I_SU  (Stream : not null access RST) return UST.Short_Unsigned;
!    function I_U   (Stream : not null access RST) return UST.Unsigned;
!    function I_WC  (Stream : not null access RST) return Wide_Character;
  
     -----------------------
     -- Output Procedures --
*************** pragma Preelaborate (Stream_Attributes);
*** 130,154 ****
     --  between 'Write and 'Output because there are no discriminants
     --  or bounds to be written.
  
!    procedure W_AD  (Stream : access RST; Item : in Fat_Pointer);
!    procedure W_AS  (Stream : access RST; Item : in Thin_Pointer);
!    procedure W_B   (Stream : access RST; Item : in Boolean);
!    procedure W_C   (Stream : access RST; Item : in Character);
!    procedure W_F   (Stream : access RST; Item : in Float);
!    procedure W_I   (Stream : access RST; Item : in Integer);
!    procedure W_LF  (Stream : access RST; Item : in Long_Float);
!    procedure W_LI  (Stream : access RST; Item : in Long_Integer);
!    procedure W_LLF (Stream : access RST; Item : in Long_Long_Float);
!    procedure W_LLI (Stream : access RST; Item : in Long_Long_Integer);
!    procedure W_LLU (Stream : access RST; Item : in UST.Long_Long_Unsigned);
!    procedure W_LU  (Stream : access RST; Item : in UST.Long_Unsigned);
!    procedure W_SF  (Stream : access RST; Item : in Short_Float);
!    procedure W_SI  (Stream : access RST; Item : in Short_Integer);
!    procedure W_SSI (Stream : access RST; Item : in Short_Short_Integer);
!    procedure W_SSU (Stream : access RST; Item : in UST.Short_Short_Unsigned);
!    procedure W_SU  (Stream : access RST; Item : in UST.Short_Unsigned);
!    procedure W_U   (Stream : access RST; Item : in UST.Unsigned);
!    procedure W_WC  (Stream : access RST; Item : in Wide_Character);
  
     ----------------------------
     -- Composite Input/Output --
--- 131,159 ----
     --  between 'Write and 'Output because there are no discriminants
     --  or bounds to be written.
  
!    procedure W_AD  (Stream : not null access RST; Item : in Fat_Pointer);
!    procedure W_AS  (Stream : not null access RST; Item : in Thin_Pointer);
!    procedure W_B   (Stream : not null access RST; Item : in Boolean);
!    procedure W_C   (Stream : not null access RST; Item : in Character);
!    procedure W_F   (Stream : not null access RST; Item : in Float);
!    procedure W_I   (Stream : not null access RST; Item : in Integer);
!    procedure W_LF  (Stream : not null access RST; Item : in Long_Float);
!    procedure W_LI  (Stream : not null access RST; Item : in Long_Integer);
!    procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float);
!    procedure W_LLI (Stream : not null access RST; Item : in Long_Long_Integer);
!    procedure W_LLU (Stream : not null access RST;
!                     Item   : in UST.Long_Long_Unsigned);
!    procedure W_LU  (Stream : not null access RST; Item : in UST.Long_Unsigned);
!    procedure W_SF  (Stream : not null access RST; Item : in Short_Float);
!    procedure W_SI  (Stream : not null access RST; Item : in Short_Integer);
!    procedure W_SSI (Stream : not null access RST;
!                     Item   : in Short_Short_Integer);
!    procedure W_SSU (Stream : not null access RST;
!                     Item   : in UST.Short_Short_Unsigned);
!    procedure W_SU  (Stream : not null access RST;
!                     Item   : in UST.Short_Unsigned);
!    procedure W_U   (Stream : not null access RST; Item : in UST.Unsigned);
!    procedure W_WC  (Stream : not null access RST; Item : in Wide_Character);
  
     ----------------------------
     -- Composite Input/Output --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-strcom.adb gcc-4.1.0/gcc/ada/s-strcom.adb
*** gcc-4.0.2/gcc/ada/s-strcom.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-strcom.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --                S Y S T E M . S T R I N G _ C O M P A R E                 --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --                S Y S T E M . S T R I N G _ C O M P A R E                 --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-strcom.ads gcc-4.1.0/gcc/ada/s-strcom.ads
*** gcc-4.0.2/gcc/ada/s-strcom.ads	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-strcom.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                   GNU ADA RUNTIME LIBRARY COMPONENTS                     --
  --                                                                          --
  --                S Y S T E M . S T R I N G _ C O M P A R E                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                    GNAT RUN-TIME LIBRARY COMPONENTS                      --
  --                                                                          --
  --                S Y S T E M . S T R I N G _ C O M P A R E                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-strops.adb gcc-4.1.0/gcc/ada/s-strops.adb
*** gcc-4.0.2/gcc/ada/s-strops.adb	Thu Feb 10 13:50:17 2005
--- gcc-4.1.0/gcc/ada/s-strops.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                    S Y S T E M . S T R I N G _ O P S                     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                    S Y S T E M . S T R I N G _ O P S                     --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-strops.ads gcc-4.1.0/gcc/ada/s-strops.ads
*** gcc-4.0.2/gcc/ada/s-strops.ads	Thu Feb 10 13:50:17 2005
--- gcc-4.1.0/gcc/ada/s-strops.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                    S Y S T E M . S T R I N G _ O P S                     --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                    S Y S T E M . S T R I N G _ O P S                     --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  (other than runtime comparison, found in s-strcom.ads).
  
  package System.String_Ops is
! pragma Pure (String_Ops);
  
     function Str_Concat (X, Y : String) return String;
     --  Concatenate two strings and return resulting string
--- 35,41 ----
  --  (other than runtime comparison, found in s-strcom.ads).
  
  package System.String_Ops is
!    pragma Pure;
  
     function Str_Concat (X, Y : String) return String;
     --  Concatenate two strings and return resulting string
diff -Nrcpad gcc-4.0.2/gcc/ada/s-strxdr.adb gcc-4.1.0/gcc/ada/s-strxdr.adb
*** gcc-4.0.2/gcc/ada/s-strxdr.adb	Tue Oct 21 13:42:14 2003
--- gcc-4.1.0/gcc/ada/s-strxdr.adb	Tue Nov 15 14:04:34 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1996-2003 Free Software Foundation, Inc.           --
  --                                                                          --
  -- GARLIC 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --             S Y S T E M . S T R E A M _ A T T R I B U T E S              --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1996-2005 Free Software Foundation, Inc.           --
  --                                                                          --
  -- GARLIC 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- --
***************
*** 16,23 ****
  -- LITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public  --
  -- License  for more details.  You should have received  a copy of the GNU  --
  -- General Public License  distributed with GARLIC;  see file COPYING.  If  --
! -- not, write to the Free Software Foundation, 59 Temple Place - Suite 330, --
! -- Boston, MA 02111-1307, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- LITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public  --
  -- License  for more details.  You should have received  a copy of the GNU  --
  -- General Public License  distributed with GARLIC;  see file COPYING.  If  --
! -- not,  write to the Free Software Foundation,  51 Franklin Street, Fifth  --
! -- Floor, Boston, MA 02110-1301, USA.                                       --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,40 ****
--- 35,41 ----
  --  standard. It is especially useful for exchanging streams between two
  --  different systems with different basic type representations and endianess.
  
+ with Ada.IO_Exceptions;
  with Ada.Streams;              use Ada.Streams;
  with Ada.Unchecked_Conversion;
  
*************** package body System.Stream_Attributes is
*** 45,52 ****
  
     use UST;
  
!    Data_Error : exception;
!    --  Exception raised if insufficient data read.
  
     SU : constant := System.Storage_Unit;
     --  XXXXX pragma Assert (SU = 8);
--- 46,54 ----
  
     use UST;
  
!    Data_Error : exception renames Ada.IO_Exceptions.End_Error;
!    --  Exception raised if insufficient data read (End_Error is
!    --  mandated by AI95-00132).
  
     SU : constant := System.Storage_Unit;
     --  XXXXX pragma Assert (SU = 8);
*************** package body System.Stream_Attributes is
*** 277,283 ****
     -- I_AD --
     ----------
  
!    function I_AD (Stream : access RST) return Fat_Pointer is
        FP : Fat_Pointer;
  
     begin
--- 279,285 ----
     -- I_AD --
     ----------
  
!    function I_AD (Stream : not null access RST) return Fat_Pointer is
        FP : Fat_Pointer;
  
     begin
*************** package body System.Stream_Attributes is
*** 291,297 ****
     -- I_AS --
     ----------
  
!    function I_AS (Stream : access RST) return Thin_Pointer is
        S : XDR_S_TM;
        L : SEO;
        U : XDR_TM := 0;
--- 293,299 ----
     -- I_AS --
     ----------
  
!    function I_AS (Stream : not null access RST) return Thin_Pointer is
        S : XDR_S_TM;
        L : SEO;
        U : XDR_TM := 0;
*************** package body System.Stream_Attributes is
*** 314,320 ****
     -- I_B --
     ---------
  
!    function I_B (Stream : access RST) return Boolean is
     begin
        case I_SSU (Stream) is
           when 0      => return False;
--- 316,322 ----
     -- I_B --
     ---------
  
!    function I_B (Stream : not null access RST) return Boolean is
     begin
        case I_SSU (Stream) is
           when 0      => return False;
*************** package body System.Stream_Attributes is
*** 327,333 ****
     -- I_C --
     ---------
  
!    function I_C (Stream : access RST) return Character is
        S : XDR_S_C;
        L : SEO;
  
--- 329,335 ----
     -- I_C --
     ---------
  
!    function I_C (Stream : not null access RST) return Character is
        S : XDR_S_C;
        L : SEO;
  
*************** package body System.Stream_Attributes is
*** 348,354 ****
     -- I_F --
     ---------
  
!    function I_F (Stream : access RST) return Float is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 350,356 ----
     -- I_F --
     ---------
  
!    function I_F (Stream : not null access RST) return Float is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 429,435 ****
     -- I_I --
     ---------
  
!    function I_I (Stream : access RST) return Integer is
        S : XDR_S_I;
        L : SEO;
        U : XDR_U := 0;
--- 431,437 ----
     -- I_I --
     ---------
  
!    function I_I (Stream : not null access RST) return Integer is
        S : XDR_S_I;
        L : SEO;
        U : XDR_U := 0;
*************** package body System.Stream_Attributes is
*** 463,469 ****
     -- I_LF --
     ----------
  
!    function I_LF (Stream : access RST) return Long_Float is
        I       : constant Precision := Double;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 465,471 ----
     -- I_LF --
     ----------
  
!    function I_LF (Stream : not null access RST) return Long_Float is
        I       : constant Precision := Double;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 546,552 ****
     -- I_LI --
     ----------
  
!    function I_LI (Stream : access RST) return Long_Integer is
        S : XDR_S_LI;
        L : SEO;
        U : Unsigned := 0;
--- 548,554 ----
     -- I_LI --
     ----------
  
!    function I_LI (Stream : not null access RST) return Long_Integer is
        S : XDR_S_LI;
        L : SEO;
        U : Unsigned := 0;
*************** package body System.Stream_Attributes is
*** 592,598 ****
     -- I_LLF --
     -----------
  
!    function I_LLF (Stream : access RST) return Long_Long_Float is
        I       : constant Precision := Quadruple;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 594,600 ----
     -- I_LLF --
     -----------
  
!    function I_LLF (Stream : not null access RST) return Long_Long_Float is
        I       : constant Precision := Quadruple;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 681,687 ****
     -- I_LLI --
     -----------
  
!    function I_LLI (Stream : access RST) return Long_Long_Integer is
        S : XDR_S_LLI;
        L : SEO;
        U : Unsigned := 0;
--- 683,689 ----
     -- I_LLI --
     -----------
  
!    function I_LLI (Stream : not null access RST) return Long_Long_Integer is
        S : XDR_S_LLI;
        L : SEO;
        U : Unsigned := 0;
*************** package body System.Stream_Attributes is
*** 724,730 ****
     -- I_LLU --
     -----------
  
!    function I_LLU (Stream : access RST) return Long_Long_Unsigned is
        S : XDR_S_LLU;
        L : SEO;
        U : Unsigned := 0;
--- 726,732 ----
     -- I_LLU --
     -----------
  
!    function I_LLU (Stream : not null access RST) return Long_Long_Unsigned is
        S : XDR_S_LLU;
        L : SEO;
        U : Unsigned := 0;
*************** package body System.Stream_Attributes is
*** 761,767 ****
     -- I_LU --
     ----------
  
!    function I_LU (Stream : access RST) return Long_Unsigned is
        S : XDR_S_LU;
        L : SEO;
        U : Unsigned := 0;
--- 763,769 ----
     -- I_LU --
     ----------
  
!    function I_LU (Stream : not null access RST) return Long_Unsigned is
        S : XDR_S_LU;
        L : SEO;
        U : Unsigned := 0;
*************** package body System.Stream_Attributes is
*** 798,804 ****
     -- I_SF --
     ----------
  
!    function I_SF (Stream : access RST) return Short_Float is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 800,806 ----
     -- I_SF --
     ----------
  
!    function I_SF (Stream : not null access RST) return Short_Float is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 879,885 ****
     -- I_SI --
     ----------
  
!    function I_SI (Stream : access RST) return Short_Integer is
        S : XDR_S_SI;
        L : SEO;
        U : XDR_SU := 0;
--- 881,887 ----
     -- I_SI --
     ----------
  
!    function I_SI (Stream : not null access RST) return Short_Integer is
        S : XDR_S_SI;
        L : SEO;
        U : XDR_SU := 0;
*************** package body System.Stream_Attributes is
*** 912,918 ****
     -- I_SSI --
     -----------
  
!    function I_SSI (Stream : access RST) return Short_Short_Integer is
        S : XDR_S_SSI;
        L : SEO;
        U : XDR_SSU;
--- 914,920 ----
     -- I_SSI --
     -----------
  
!    function I_SSI (Stream : not null access RST) return Short_Short_Integer is
        S : XDR_S_SSI;
        L : SEO;
        U : XDR_SSU;
*************** package body System.Stream_Attributes is
*** 941,947 ****
     -- I_SSU --
     -----------
  
!    function I_SSU (Stream : access RST) return Short_Short_Unsigned is
        S : XDR_S_SSU;
        L : SEO;
        U : XDR_SSU := 0;
--- 943,949 ----
     -- I_SSU --
     -----------
  
!    function I_SSU (Stream : not null access RST) return Short_Short_Unsigned is
        S : XDR_S_SSU;
        L : SEO;
        U : XDR_SSU := 0;
*************** package body System.Stream_Attributes is
*** 962,968 ****
     -- I_SU --
     ----------
  
!    function I_SU (Stream : access RST) return Short_Unsigned is
        S : XDR_S_SU;
        L : SEO;
        U : XDR_SU := 0;
--- 964,970 ----
     -- I_SU --
     ----------
  
!    function I_SU (Stream : not null access RST) return Short_Unsigned is
        S : XDR_S_SU;
        L : SEO;
        U : XDR_SU := 0;
*************** package body System.Stream_Attributes is
*** 987,993 ****
     -- I_U --
     ---------
  
!    function I_U (Stream : access RST) return Unsigned is
        S : XDR_S_U;
        L : SEO;
        U : XDR_U := 0;
--- 989,995 ----
     -- I_U --
     ---------
  
!    function I_U (Stream : not null access RST) return Unsigned is
        S : XDR_S_U;
        L : SEO;
        U : XDR_U := 0;
*************** package body System.Stream_Attributes is
*** 1014,1020 ****
     -- I_WC --
     ----------
  
!    function I_WC (Stream : access RST) return Wide_Character is
        S : XDR_S_WC;
        L : SEO;
        U : XDR_WC := 0;
--- 1016,1022 ----
     -- I_WC --
     ----------
  
!    function I_WC (Stream : not null access RST) return Wide_Character is
        S : XDR_S_WC;
        L : SEO;
        U : XDR_WC := 0;
*************** package body System.Stream_Attributes is
*** 1039,1045 ****
     -- W_AD --
     ----------
  
!    procedure W_AD (Stream : access RST; Item : in Fat_Pointer) is
        S : XDR_S_TM;
        U : XDR_TM;
  
--- 1041,1047 ----
     -- W_AD --
     ----------
  
!    procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer) is
        S : XDR_S_TM;
        U : XDR_TM;
  
*************** package body System.Stream_Attributes is
*** 1069,1075 ****
     -- W_AS --
     ----------
  
!    procedure W_AS (Stream : access RST; Item : in Thin_Pointer) is
        S : XDR_S_TM;
        U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1));
  
--- 1071,1077 ----
     -- W_AS --
     ----------
  
!    procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer) is
        S : XDR_S_TM;
        U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1));
  
*************** package body System.Stream_Attributes is
*** 1090,1096 ****
     -- W_B --
     ---------
  
!    procedure W_B (Stream : access RST; Item : in Boolean) is
     begin
        if Item then
           W_SSU (Stream, 1);
--- 1092,1098 ----
     -- W_B --
     ---------
  
!    procedure W_B (Stream : not null access RST; Item : in Boolean) is
     begin
        if Item then
           W_SSU (Stream, 1);
*************** package body System.Stream_Attributes is
*** 1103,1109 ****
     -- W_C --
     ---------
  
!    procedure W_C (Stream : access RST; Item : in Character) is
        S : XDR_S_C;
  
        pragma Assert (C_L = 1);
--- 1105,1111 ----
     -- W_C --
     ---------
  
!    procedure W_C (Stream : not null access RST; Item : in Character) is
        S : XDR_S_C;
  
        pragma Assert (C_L = 1);
*************** package body System.Stream_Attributes is
*** 1121,1127 ****
     -- W_F --
     ---------
  
!    procedure W_F (Stream : access RST; Item : in Float) is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 1123,1129 ----
     -- W_F --
     ---------
  
!    procedure W_F (Stream : not null access RST; Item : in Float) is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 1203,1209 ****
     -- W_I --
     ---------
  
!    procedure W_I (Stream : access RST; Item : in Integer) is
        S : XDR_S_I;
        U : XDR_U;
  
--- 1205,1211 ----
     -- W_I --
     ---------
  
!    procedure W_I (Stream : not null access RST; Item : in Integer) is
        S : XDR_S_I;
        U : XDR_U;
  
*************** package body System.Stream_Attributes is
*** 1237,1243 ****
     -- W_LF --
     ----------
  
!    procedure W_LF (Stream : access RST; Item : in Long_Float) is
        I       : constant Precision := Double;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 1239,1245 ----
     -- W_LF --
     ----------
  
!    procedure W_LF (Stream : not null access RST; Item : in Long_Float) is
        I       : constant Precision := Double;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 1319,1325 ****
     -- W_LI --
     ----------
  
!    procedure W_LI (Stream : access RST; Item : in Long_Integer) is
        S : XDR_S_LI;
        U : Unsigned;
        X : Long_Unsigned;
--- 1321,1327 ----
     -- W_LI --
     ----------
  
!    procedure W_LI (Stream : not null access RST; Item : in Long_Integer) is
        S : XDR_S_LI;
        U : Unsigned;
        X : Long_Unsigned;
*************** package body System.Stream_Attributes is
*** 1365,1371 ****
     -- W_LLF --
     -----------
  
!    procedure W_LLF (Stream : access RST; Item : in Long_Long_Float) is
        I       : constant Precision := Quadruple;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 1367,1373 ----
     -- W_LLF --
     -----------
  
!    procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float) is
        I       : constant Precision := Quadruple;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 1460,1466 ****
     -- W_LLI --
     -----------
  
!    procedure W_LLI (Stream : access RST; Item : in Long_Long_Integer) is
        S : XDR_S_LLI;
        U : Unsigned;
        X : Long_Long_Unsigned;
--- 1462,1470 ----
     -- W_LLI --
     -----------
  
!    procedure W_LLI (Stream : not null access RST;
!                     Item   : in Long_Long_Integer)
!    is
        S : XDR_S_LLI;
        U : Unsigned;
        X : Long_Long_Unsigned;
*************** package body System.Stream_Attributes is
*** 1506,1512 ****
     -- W_LLU --
     -----------
  
!    procedure W_LLU (Stream : access RST; Item : in Long_Long_Unsigned) is
        S : XDR_S_LLU;
        U : Unsigned;
        X : Long_Long_Unsigned := Item;
--- 1510,1517 ----
     -- W_LLU --
     -----------
  
!    procedure W_LLU (Stream : not null access RST;
!                     Item   : in Long_Long_Unsigned) is
        S : XDR_S_LLU;
        U : Unsigned;
        X : Long_Long_Unsigned := Item;
*************** package body System.Stream_Attributes is
*** 1543,1549 ****
     -- W_LU --
     ----------
  
!    procedure W_LU (Stream : access RST; Item : in Long_Unsigned) is
        S : XDR_S_LU;
        U : Unsigned;
        X : Long_Unsigned := Item;
--- 1548,1554 ----
     -- W_LU --
     ----------
  
!    procedure W_LU (Stream : not null access RST; Item : in Long_Unsigned) is
        S : XDR_S_LU;
        U : Unsigned;
        X : Long_Unsigned := Item;
*************** package body System.Stream_Attributes is
*** 1579,1585 ****
     -- W_SF --
     ----------
  
!    procedure W_SF (Stream : access RST; Item : in Short_Float) is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
--- 1584,1590 ----
     -- W_SF --
     ----------
  
!    procedure W_SF (Stream : not null access RST; Item : in Short_Float) is
        I       : constant Precision := Single;
        E_Size  : Integer  renames Fields (I).E_Size;
        E_Bias  : Integer  renames Fields (I).E_Bias;
*************** package body System.Stream_Attributes is
*** 1661,1667 ****
     -- W_SI --
     ----------
  
!    procedure W_SI (Stream : access RST; Item : in Short_Integer) is
        S : XDR_S_SI;
        U : XDR_SU;
  
--- 1666,1672 ----
     -- W_SI --
     ----------
  
!    procedure W_SI (Stream : not null access RST; Item : in Short_Integer) is
        S : XDR_S_SI;
        U : XDR_SU;
  
*************** package body System.Stream_Attributes is
*** 1695,1701 ****
     -- W_SSI --
     -----------
  
!    procedure W_SSI (Stream : access RST; Item : in Short_Short_Integer) is
        S : XDR_S_SSI;
        U : XDR_SSU;
  
--- 1700,1709 ----
     -- W_SSI --
     -----------
  
!    procedure W_SSI
!      (Stream : not null access RST;
!       Item   : in Short_Short_Integer)
!    is
        S : XDR_S_SSI;
        U : XDR_SSU;
  
*************** package body System.Stream_Attributes is
*** 1722,1730 ****
     -- W_SSU --
     -----------
  
!    procedure W_SSU (Stream : access RST; Item : in Short_Short_Unsigned) is
        S : XDR_S_SSU;
-       U : XDR_SSU := XDR_SSU (Item);
  
     begin
        S (1) := SE (U);
--- 1730,1741 ----
     -- W_SSU --
     -----------
  
!    procedure W_SSU
!      (Stream : not null access RST;
!       Item   : in Short_Short_Unsigned)
!    is
!       U : constant XDR_SSU := XDR_SSU (Item);
        S : XDR_S_SSU;
  
     begin
        S (1) := SE (U);
*************** package body System.Stream_Attributes is
*** 1736,1742 ****
     -- W_SU --
     ----------
  
!    procedure W_SU (Stream : access RST; Item : in Short_Unsigned) is
        S : XDR_S_SU;
        U : XDR_SU := XDR_SU (Item);
  
--- 1747,1753 ----
     -- W_SU --
     ----------
  
!    procedure W_SU (Stream : not null access RST; Item : in Short_Unsigned) is
        S : XDR_S_SU;
        U : XDR_SU := XDR_SU (Item);
  
*************** package body System.Stream_Attributes is
*** 1761,1767 ****
     -- W_U --
     ---------
  
!    procedure W_U (Stream : access RST; Item : in Unsigned) is
        S : XDR_S_U;
        U : XDR_U := XDR_U (Item);
  
--- 1772,1778 ----
     -- W_U --
     ---------
  
!    procedure W_U (Stream : not null access RST; Item : in Unsigned) is
        S : XDR_S_U;
        U : XDR_U := XDR_U (Item);
  
*************** package body System.Stream_Attributes is
*** 1786,1792 ****
     -- W_WC --
     ----------
  
!    procedure W_WC (Stream : access RST; Item : in Wide_Character) is
        S : XDR_S_WC;
        U : XDR_WC;
  
--- 1797,1803 ----
     -- W_WC --
     ----------
  
!    procedure W_WC (Stream : not null access RST; Item : in Wide_Character) is
        S : XDR_S_WC;
        U : XDR_WC;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taasde.adb gcc-4.1.0/gcc/ada/s-taasde.adb
*** gcc-4.0.2/gcc/ada/s-taasde.adb	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-taasde.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.OS_Primitives;
*** 64,69 ****
--- 64,72 ----
  with Ada.Task_Identification;
  --  used for Task_Id type
  
+ with System.Interrupt_Management.Operations;
+ --  used for Setup_Interrupt_Mask
+ 
  with System.Parameters;
  --  used for Single_Lock
  --           Runtime_Traces
*************** package body System.Tasking.Async_Delays
*** 324,329 ****
--- 327,338 ----
     begin
        Timer_Server_ID := STPO.Self;
  
+       --  Since this package may be elaborated before System.Interrupt,
+       --  we need to call Setup_Interrupt_Mask explicitly to ensure that
+       --  this task has the proper signal mask.
+ 
+       Interrupt_Management.Operations.Setup_Interrupt_Mask;
+ 
        --  Initialize the timer queue to empty, and make the wakeup time of the
        --  header node be larger than any real wakeup time we will ever use.
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taasde.ads gcc-4.1.0/gcc/ada/s-taasde.ads
*** gcc-4.0.2/gcc/ada/s-taasde.ads	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-taasde.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the procedures to implements timeouts (delays)
! --  for asynchronous select statements.
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
--- 31,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the procedures to implements timeouts (delays) for
! --  asynchronous select statements.
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
*************** package System.Tasking.Async_Delays is
*** 100,107 ****
       (T : in Duration;
        D : Delay_Block_Access) return Boolean;
     --  Enqueue the specified relative delay. Returns True if the delay has
!    --  been enqueued, False if it has already expired.
!    --  If the delay has been enqueued, abortion is deferred.
  
     procedure Cancel_Async_Delay (D : Delay_Block_Access);
     --  Cancel the specified asynchronous delay
--- 100,107 ----
       (T : in Duration;
        D : Delay_Block_Access) return Boolean;
     --  Enqueue the specified relative delay. Returns True if the delay has
!    --  been enqueued, False if it has already expired. If the delay has been
!    --  enqueued, abort is deferred.
  
     procedure Cancel_Async_Delay (D : Delay_Block_Access);
     --  Cancel the specified asynchronous delay
*************** package System.Tasking.Async_Delays is
*** 117,126 ****
  private
  
     type Delay_Block is record
!       Self_Id     : Task_Id;
        --  ID of the calling task
  
!       Level       : ATC_Level_Base;
        --  Normally Level is the ATC nesting level of the
        --  async. select statement to which this delay belongs, but
        --  after a call has been dequeued we set it to
--- 117,126 ----
  private
  
     type Delay_Block is record
!       Self_Id : Task_Id;
        --  ID of the calling task
  
!       Level : ATC_Level_Base;
        --  Normally Level is the ATC nesting level of the
        --  async. select statement to which this delay belongs, but
        --  after a call has been dequeued we set it to
*************** private
*** 130,139 ****
        Resume_Time : Duration;
        --  The absolute wake up time, represented as Duration
  
!       Timed_Out   : Boolean := False;
        --  Set to true if the delay has timed out
  
!       Succ, Pred  : Delay_Block_Access;
        --  A double linked list
     end record;
  
--- 130,139 ----
        Resume_Time : Duration;
        --  The absolute wake up time, represented as Duration
  
!       Timed_Out : Boolean := False;
        --  Set to true if the delay has timed out
  
!       Succ, Pred : Delay_Block_Access;
        --  A double linked list
     end record;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tadeca.adb gcc-4.1.0/gcc/ada/s-tadeca.adb
*** gcc-4.0.2/gcc/ada/s-tadeca.adb	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tadeca.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASKING.ASYNC_DELAYS.ENQUEUE_CALENDAR              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S .        --
! --                      E N Q U E U E _ C A L E N D A R                     --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tadeca.ads gcc-4.1.0/gcc/ada/s-tadeca.ads
*** gcc-4.0.2/gcc/ada/s-tadeca.ads	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tadeca.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASKING.ASYNC_DELAYS.ENQUEUE_CALENDAR              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S .        --
! --                      E N Q U E U E _ C A L E N D A R                     --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tadert.adb gcc-4.1.0/gcc/ada/s-tadert.adb
*** gcc-4.0.2/gcc/ada/s-tadert.adb	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tadert.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                  SYSTEM.TASKING.ASYNC_DELAYS.ENQUEUE_RT                  --
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --          Copyright (C) 1998-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S .        --
! --                          E N Q U E U E _ R T                             --
  --                                                                          --
  --                                B o d y                                   --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tadert.ads gcc-4.1.0/gcc/ada/s-tadert.ads
*** gcc-4.0.2/gcc/ada/s-tadert.ads	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tadert.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                  SYSTEM.TASKING.ASYNC_DELAYS.ENQUEUE_RT                  --
  --                                                                          --
  --                                S p e c                                   --
  --                                                                          --
! --          Copyright (C) 1998-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --           S Y S T E M . T A S K I N G . A S Y N C _ D E L A Y S .        --
! --                          E N Q U E U E _ R T                             --
  --                                                                          --
  --                                S p e c                                   --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taenca.adb gcc-4.1.0/gcc/ada/s-taenca.adb
*** gcc-4.0.2/gcc/ada/s-taenca.adb	Fri Jun 11 10:47:39 2004
--- gcc-4.1.0/gcc/ada/s-taenca.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . E N T R Y _ C A L L S          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . E N T R Y _ C A L L S          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taenca.ads gcc-4.1.0/gcc/ada/s-taenca.ads
*** gcc-4.0.2/gcc/ada/s-taenca.ads	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-taenca.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . E N T R Y _ C A L L S          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . E N T R Y _ C A L L S          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprob.adb gcc-4.1.0/gcc/ada/s-taprob.adb
*** gcc-4.0.2/gcc/ada/s-taprob.adb	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/s-taprob.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S     --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S     --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking.Protected_Ob
*** 73,78 ****
--- 73,79 ----
        Ceiling_Priority : Integer)
     is
        Init_Priority : Integer := Ceiling_Priority;
+ 
     begin
        if Init_Priority = Unspecified_Priority then
           Init_Priority  := System.Priority'Last;
*************** package body System.Tasking.Protected_Ob
*** 80,85 ****
--- 81,87 ----
  
        Initialize_Lock (Init_Priority, Object.L'Access);
        Object.Ceiling := System.Any_Priority (Init_Priority);
+       Object.Owner := Null_Task;
     end Initialize_Protection;
  
     ----------
*************** package body System.Tasking.Protected_Ob
*** 90,104 ****
        Ceiling_Violation : Boolean;
  
     begin
!       --  The lock is made without defering abortion.
  
!       --  Therefore the abortion has to be deferred before calling this
!       --  routine. This means that the compiler has to generate a Defer_Abort
!       --  call before the call to Lock.
  
!       --  The caller is responsible for undeferring abortion, and compiler
        --  generated calls must be protected with cleanup handlers to ensure
!       --  that abortion is undeferred in all cases.
  
        Write_Lock (Object.L'Access, Ceiling_Violation);
  
--- 92,117 ----
        Ceiling_Violation : Boolean;
  
     begin
!       --  The lock is made without defering abort
  
!       --  Therefore the abort has to be deferred before calling this routine.
!       --  This means that the compiler has to generate a Defer_Abort call
!       --  before the call to Lock.
  
!       --  The caller is responsible for undeferring abort, and compiler
        --  generated calls must be protected with cleanup handlers to ensure
!       --  that abort is undeferred in all cases.
! 
!       --  If pragma Detect_Blocking is active then, as described in the ARM
!       --  9.5.1, par. 15, we must check whether this is an external call on a
!       --  protected subprogram with the same target object as that of the
!       --  protected action that is currently in progress (i.e., if the caller
!       --  is already the protected object's owner). If this is the case hence
!       --  Program_Error must be raised.
! 
!       if Detect_Blocking and then Object.Owner = Self then
!          raise Program_Error;
!       end if;
  
        Write_Lock (Object.L'Access, Ceiling_Violation);
  
*************** package body System.Tasking.Protected_Ob
*** 112,123 ****
  
        --  We are entering in a protected action, so that we increase the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
           begin
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
--- 125,142 ----
  
        --  We are entering in a protected action, so that we increase the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active), and update the protected object's owner.
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
           begin
+             --  Update the protected object's owner
+ 
+             Object.Owner := Self_Id;
+ 
+             --  Increase protected object nesting level
+ 
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
*************** package body System.Tasking.Protected_Ob
*** 132,137 ****
--- 151,175 ----
        Ceiling_Violation : Boolean;
  
     begin
+       --  If pragma Detect_Blocking is active then, as described in the ARM
+       --  9.5.1, par. 15, we must check whether this is an external call on
+       --  protected subprogram with the same target object as that of the
+       --  protected action that is currently in progress (i.e., if the caller
+       --  is already the protected object's owner). If this is the case hence
+       --  Program_Error must be raised.
+       --
+       --  Note that in this case (getting read access), several tasks may have
+       --  read ownership of the protected object, so that this method of
+       --  storing the (single) protected object's owner does not work reliably
+       --  for read locks. However, this is the approach taken for two major
+       --  reasosn: first, this function is not currently being used (it is
+       --  provided for possible future use), and second, it largely simplifies
+       --  the implementation.
+ 
+       if Detect_Blocking and then Object.Owner = Self then
+          raise Program_Error;
+       end if;
+ 
        Read_Lock (Object.L'Access, Ceiling_Violation);
  
        if Parameters.Runtime_Traces then
*************** package body System.Tasking.Protected_Ob
*** 142,155 ****
           raise Program_Error;
        end if;
  
!       --  We are entering in a protected action, so that we increase the
!       --  protected object nesting level (if pragma Detect_Blocking is
!       --  active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
           begin
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
--- 180,198 ----
           raise Program_Error;
        end if;
  
!       --  We are entering in a protected action, so we increase the protected
!       --  object nesting level (if pragma Detect_Blocking is active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
           begin
+             --  Update the protected object's owner
+ 
+             Object.Owner := Self_Id;
+ 
+             --  Increase protected object nesting level
+ 
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
*************** package body System.Tasking.Protected_Ob
*** 164,180 ****
     begin
        --  We are exiting from a protected action, so that we decrease the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
  
           begin
!             --  Cannot call this procedure without being within a protected
!             --  action.
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0);
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
--- 207,232 ----
     begin
        --  We are exiting from a protected action, so that we decrease the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active), and remove ownership of the protected object.
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
  
           begin
!             --  Calls to this procedure can only take place when being within
!             --  a protected action and when the caller is the protected
!             --  object's owner.
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0
!                              and then Object.Owner = Self_Id);
! 
!             --  Remove ownership of the protected object
! 
!             Object.Owner := Null_Task;
! 
!             --  We are exiting from a protected action, so we decrease the
!             --  protected object nesting level.
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
*************** package body System.Tasking.Protected_Ob
*** 189,195 ****
     end Unlock;
  
  begin
!    --  Ensure that tasking soft links are set when using protected objects
  
     System.Soft_Links.Tasking.Init_Tasking_Soft_Links;
  end System.Tasking.Protected_Objects;
--- 241,249 ----
     end Unlock;
  
  begin
!    --  Ensure that tasking is initialized, as well as tasking soft links
!    --  when using protected objects.
  
+    Tasking.Initialize;
     System.Soft_Links.Tasking.Init_Tasking_Soft_Links;
  end System.Tasking.Protected_Objects;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprob.ads gcc-4.1.0/gcc/ada/s-taprob.ads
*** gcc-4.0.2/gcc/ada/s-taprob.ads	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-taprob.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S     --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2003, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S     --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Tasking.Protected_Objects
*** 206,218 ****
  
  private
     type Protection is record
!       L       : aliased Task_Primitives.Lock;
        Ceiling : System.Any_Priority;
     end record;
  
     procedure Finalize_Protection (Object : in out Protection);
!    --  Clean up a Protection object; in particular, finalize the associated
!    --  Lock object. The compiler generates automatically calls to this
     --  procedure
  
  end System.Tasking.Protected_Objects;
--- 206,229 ----
  
  private
     type Protection is record
!       L : aliased Task_Primitives.Lock;
!       --  Lock used to ensure mutual exclusive access to the protected object
! 
        Ceiling : System.Any_Priority;
+       --  Ceiling priority associated to the protected object
+ 
+       Owner : Task_Id;
+       --  This field contains the protected object's owner. Null_Task
+       --  indicates that the protected object is not currently being used.
+       --  This information is used for detecting the type of potentially
+       --  blocking operations described in the ARM 9.5.1, par. 15 (external
+       --  calls on a protected subprogram with the same target object as that
+       --  of the protected action).
     end record;
  
     procedure Finalize_Protection (Object : in out Protection);
!    --  Clean up a Protection object (in particular, finalize the associated
!    --  Lock object). The compiler generates calls automatically to this
     --  procedure
  
  end System.Tasking.Protected_Objects;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-dummy.adb gcc-4.1.0/gcc/ada/s-taprop-dummy.adb
*** gcc-4.0.2/gcc/ada/s-taprop-dummy.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-dummy.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 40,49 ****
  --  Turn off polling, we do not want ATC polling to take place during
  --  tasking operations. It causes infinite loops and other problems.
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
  with System.Error_Reporting;
  --  used for Shutdown
  
--- 40,45 ----
*************** package body System.Task_Primitives.Oper
*** 55,63 ****
     pragma Warnings (Off);
     --  Turn off warnings since so many unreferenced parameters
  
-    No_Tasking : Boolean;
-    --  Comment required here ???
- 
     ----------------
     -- Abort_Task --
     ----------------
--- 51,56 ----
*************** package body System.Task_Primitives.Oper
*** 87,92 ****
--- 80,94 ----
        return True;
     end Check_No_Locks;
  
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       return False;
+    end Current_State;
+ 
     ----------------------
     -- Environment_Task --
     ----------------------
*************** package body System.Task_Primitives.Oper
*** 129,134 ****
--- 131,145 ----
        null;
     end Exit_Task;
  
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+    begin
+       null;
+    end Finalize;
+ 
     -------------------
     -- Finalize_Lock --
     -------------------
*************** package body System.Task_Primitives.Oper
*** 175,180 ****
--- 186,199 ----
     ----------------
  
     procedure Initialize (Environment_Task : Task_Id) is
+       No_Tasking : Boolean;
+    begin
+       No_Tasking :=
+         System.Error_Reporting.Shutdown
+           ("Tasking not implemented on this configuration");
+    end Initialize;
+ 
+    procedure Initialize (S : in out Suspension_Object) is
     begin
        null;
     end Initialize;
*************** package body System.Task_Primitives.Oper
*** 289,294 ****
--- 308,322 ----
        return Null_Task;
     end Self;
  
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+    begin
+       null;
+    end Set_False;
+ 
     ------------------
     -- Set_Priority --
     ------------------
*************** package body System.Task_Primitives.Oper
*** 302,307 ****
--- 330,344 ----
        null;
     end Set_Priority;
  
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+    begin
+       null;
+    end Set_True;
+ 
     -----------
     -- Sleep --
     -----------
*************** package body System.Task_Primitives.Oper
*** 332,337 ****
--- 369,383 ----
        return False;
     end Suspend_Task;
  
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+    begin
+       null;
+    end Suspend_Until_True;
+ 
     -----------------
     -- Timed_Delay --
     -----------------
*************** package body System.Task_Primitives.Oper
*** 429,439 ****
        null;
     end Yield;
  
- begin
-    --  Can't raise an exception because target independent packages try to
-    --  do an Abort_Defer, which gets a memory fault.
- 
-    No_Tasking :=
-      System.Error_Reporting.Shutdown
-        ("Tasking not implemented on this configuration");
  end System.Task_Primitives.Operations;
--- 475,478 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-hpux-dce.adb gcc-4.1.0/gcc/ada/s-taprop-hpux-dce.adb
*** gcc-4.0.2/gcc/ada/s-taprop-hpux-dce.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-hpux-dce.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,83 ****
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
- with Interfaces.C;
- --  used for int
- --           size_t
- 
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
  with System.Interrupt_Management.Operations;
  --  used for Set_Interrupt_Mask
  --           All_Tasks_Mask
  pragma Elaborate_All (System.Interrupt_Management.Operations);
  
  with System.Parameters;
  --  used for Size_Type
  
  with System.Task_Primitives.Interrupt_Operations;
  --  used for Get_Interrupt_ID
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
--- 43,74 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
+ pragma Warnings (Off);
  with System.Interrupt_Management.Operations;
  --  used for Set_Interrupt_Mask
  --           All_Tasks_Mask
  pragma Elaborate_All (System.Interrupt_Management.Operations);
  
+ pragma Warnings (On);
+ 
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
+ with Interfaces.C;
+ --  used for int
+ --           size_t
+ 
  with System.Parameters;
  --  used for Size_Type
  
  with System.Task_Primitives.Interrupt_Operations;
  --  used for Get_Interrupt_ID
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
*************** package body System.Task_Primitives.Oper
*** 91,97 ****
     use System.OS_Primitives;
  
     package PIO renames System.Task_Primitives.Interrupt_Operations;
-    package SSL renames System.Soft_Links;
  
     ----------------
     -- Local Data --
--- 82,87 ----
*************** package body System.Task_Primitives.Oper
*** 124,132 ****
     --  is not implemented for DCE threads. The HPUX 10 port is at this
     --  stage considered dead, and no further work is planned on it.
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set
- 
     Foreign_Task_Elaborated : aliased Boolean := True;
     --  Used to identified fake tasks (i.e., non-Ada Threads)
  
--- 114,119 ----
*************** package body System.Task_Primitives.Oper
*** 495,505 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  The little window between deferring abort and locking Self_ID is the
-       --  only reason to check for pending abort and priority change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 482,487 ----
*************** package body System.Task_Primitives.Oper
*** 550,556 ****
        end if;
  
        Result := sched_yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 532,537 ----
*************** package body System.Task_Primitives.Oper
*** 632,638 ****
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 613,619 ----
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 643,649 ****
  
        pragma Assert (Result = 0);
  
!       if FIFO_Within_Priorities then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
           --    If the task drops its priority due to the loss of inherited
--- 624,630 ----
  
        pragma Assert (Result = 0);
  
!       if Dispatching_Policy = 'F' then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
           --    If the task drops its priority due to the loss of inherited
*************** package body System.Task_Primitives.Oper
*** 910,915 ****
--- 891,1046 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1012,1017 ****
--- 1143,1150 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       Interrupt_Management.Initialize;
+ 
        --  Initialize the lock used to synchronize chain of all ATCBs
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-irix-athread.adb gcc-4.1.0/gcc/ada/s-taprop-irix-athread.adb
*** gcc-4.0.2/gcc/ada/s-taprop-irix-athread.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-irix-athread.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Interfaces.C;
*** 47,66 ****
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
- with System.Task_Info;
- 
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
  with System.Program_Info;
  --  used for Default_Task_Stack
  --           Default_Time_Slice
--- 47,65 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
+ with System.Task_Info;
+ 
  with System.Parameters;
  --  used for Size_Type
  
  with System.Program_Info;
  --  used for Default_Task_Stack
  --           Default_Time_Slice
*************** with System.Program_Info;
*** 68,84 ****
  --           Pthread_Sched_Signal
  --           Pthread_Arena_Size
  
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with System.Storage_Elements;
  --  used for To_Address
  
--- 67,72 ----
*************** package body System.Task_Primitives.Oper
*** 94,101 ****
     use System.Parameters;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     -----------------
     -- Local Data  --
     -----------------
--- 82,87 ----
*************** package body System.Task_Primitives.Oper
*** 433,444 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 419,424 ----
*************** package body System.Task_Primitives.Oper
*** 490,496 ****
        end if;
  
        pthread_yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 470,475 ----
*************** package body System.Task_Primitives.Oper
*** 820,825 ****
--- 799,985 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             Result := pthread_condattr_destroy (Cond_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_condattr_destroy (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 906,912 ****
--- 1066,1074 ----
  
     procedure Initialize (Environment_Task : Task_Id) is
     begin
+       Initialize_Athread_Library;
        Environment_Task_Id := Environment_Task;
+       Interrupt_Management.Initialize;
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
        --  Initialize the lock used to synchronize chain of all ATCBs.
*************** package body System.Task_Primitives.Oper
*** 945,952 ****
        end if;
     end Initialize_Athread_Library;
  
- --  Package initialization
- 
- begin
-    Initialize_Athread_Library;
  end System.Task_Primitives.Operations;
--- 1107,1110 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-irix.adb gcc-4.1.0/gcc/ada/s-taprop-irix.adb
*** gcc-4.0.2/gcc/ada/s-taprop-irix.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-irix.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Task_Info;
*** 49,82 ****
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
- with System.IO;
- --  used for Put_Line
- 
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
! with System.Interrupt_Management.Operations;
! --  used for Set_Interrupt_Mask
! --           All_Tasks_Mask
! pragma Elaborate_All (System.Interrupt_Management.Operations);
  
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
  with System.Program_Info;
  --  used for Default_Task_Stack
  --           Default_Time_Slice
--- 49,68 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
! with System.OS_Primitives;
! --  used for Delay_Modes
! 
! with System.IO;
! --  used for Put_Line
  
  with System.Parameters;
  --  used for Size_Type
  
  with System.Program_Info;
  --  used for Default_Task_Stack
  --           Default_Time_Slice
*************** with System.Program_Info;
*** 87,95 ****
  with System.OS_Interface;
  --  used for various type, constant, and operations
  
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
--- 73,78 ----
*************** package body System.Task_Primitives.Oper
*** 102,109 ****
     use System.OS_Primitives;
     use System.Parameters;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 85,90 ----
*************** package body System.Task_Primitives.Oper
*** 520,531 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  The little window between deferring abort and locking Self_ID is
-       --  the only reason we need to check for pending abort and priority
-       --  change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 501,506 ----
*************** package body System.Task_Primitives.Oper
*** 570,576 ****
        end if;
  
        Yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 545,550 ----
*************** package body System.Task_Primitives.Oper
*** 965,970 ****
--- 939,1125 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             Result := pthread_condattr_destroy (Cond_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_condattr_destroy (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1067,1072 ****
--- 1222,1229 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       Interrupt_Management.Initialize;
+ 
        --  Initialize the lock used to synchronize chain of all ATCBs.
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
*************** package body System.Task_Primitives.Oper
*** 1075,1084 ****
  
        Enter_Task (Environment_Task);
  
        --  Install the abort-signal handler
  
        if State (System.Interrupt_Management.Abort_Task_Interrupt)
!                                                         /= Default
        then
           act.sa_flags := 0;
           act.sa_handler := Abort_Handler'Address;
--- 1232,1253 ----
  
        Enter_Task (Environment_Task);
  
+       --  Prepare the set of signals that should unblocked in all tasks
+ 
+       Result := sigemptyset (Unblocked_Signal_Mask'Access);
+       pragma Assert (Result = 0);
+ 
+       for J in Interrupt_Management.Interrupt_ID loop
+          if System.Interrupt_Management.Keep_Unmasked (J) then
+             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+             pragma Assert (Result = 0);
+          end if;
+       end loop;
+ 
        --  Install the abort-signal handler
  
        if State (System.Interrupt_Management.Abort_Task_Interrupt)
!         /= Default
        then
           act.sa_flags := 0;
           act.sa_handler := Abort_Handler'Address;
*************** package body System.Task_Primitives.Oper
*** 1096,1133 ****
        end if;
     end Initialize;
  
- begin
-    declare
-       Result : Interfaces.C.int;
- 
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
- 
-       --  Pick the highest resolution Clock for Clock_Realtime
- 
-       --  ??? This code currently doesn't work (see c94007[ab] for example)
- 
-       --  if syssgi (SGI_CYCLECNTR_SIZE) = 64 then
-       --     Real_Time_Clock_Id := CLOCK_SGI_CYCLE;
-       --  else
-       --     Real_Time_Clock_Id := CLOCK_REALTIME;
-       --  end if;
-    end;
  end System.Task_Primitives.Operations;
--- 1265,1268 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-linux.adb gcc-4.1.0/gcc/ada/s-taprop-linux.adb
*** gcc-4.0.2/gcc/ada/s-taprop-linux.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-linux.adb	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 6,12 ----
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 40,88 ****
  --  Turn off polling, we do not want ATC polling to take place during
  --  tasking operations. It causes infinite loops and other problems.
  
- with System.Tasking.Debug;
- --  used for Known_Tasks
- 
  with Interfaces.C;
  --  used for int
  --           size_t
  
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
! with System.Interrupt_Management.Operations;
! --  used for Set_Interrupt_Mask
! --           All_Tasks_Mask
! pragma Elaborate_All (System.Interrupt_Management.Operations);
! 
! with System.Parameters;
! --  used for Size_Type
  
! with System.Tasking;
! --  used for Ada_Task_Control_Block
! --           Task_Id
  
  with Ada.Exceptions;
  --  used for Raise_Exception
  --           Raise_From_Signal_Handler
  --           Exception_Id
  
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
- with System.Soft_Links;
- --  used for Get_Machine_State_Addr
- 
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
--- 40,71 ----
  --  Turn off polling, we do not want ATC polling to take place during
  --  tasking operations. It causes infinite loops and other problems.
  
  with Interfaces.C;
  --  used for int
  --           size_t
  
+ with System.Parameters;
+ --  used for Size_Type
+ 
+ with System.Tasking.Debug;
+ --  used for Known_Tasks
+ 
  with System.Interrupt_Management;
  --  used for Keep_Unmasked
  --           Abort_Task_Interrupt
  --           Interrupt_ID
  
! with System.OS_Primitives;
! --  used for Delay_Modes
  
! with System.Soft_Links;
! --  used for Abort_Defer/Undefer
  
  with Ada.Exceptions;
  --  used for Raise_Exception
  --           Raise_From_Signal_Handler
  --           Exception_Id
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
*************** package body System.Task_Primitives.Oper
*** 95,102 ****
     use System.Parameters;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 78,83 ----
*************** package body System.Task_Primitives.Oper
*** 116,127 ****
     --  A variable to hold Task_Id for the environment task
  
     Unblocked_Signal_Mask : aliased sigset_t;
!    --  The set of signals that should unblocked in all tasks
  
     --  The followings are internal configuration constants needed
  
-    Priority_Ceiling_Emulation : constant Boolean := True;
- 
     Next_Serial_Number : Task_Serial_Number := 100;
     --  We start at 100, to reserve some special values for
     --  using in error checking.
--- 97,106 ----
     --  A variable to hold Task_Id for the environment task
  
     Unblocked_Signal_Mask : aliased sigset_t;
!    --  The set of signals that should be unblocked in all tasks
  
     --  The followings are internal configuration constants needed
  
     Next_Serial_Number : Task_Serial_Number := 100;
     --  We start at 100, to reserve some special values for
     --  using in error checking.
*************** package body System.Task_Primitives.Oper
*** 132,140 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set
- 
     --  The following are effectively constants, but they need to
     --  be initialized by calling a pthread_ function.
  
--- 111,116 ----
*************** package body System.Task_Primitives.Oper
*** 285,298 ****
       (Prio : System.Any_Priority;
        L    : access Lock)
     is
!       Result : Interfaces.C.int;
  
     begin
!       if Priority_Ceiling_Emulation then
!          L.Ceiling := Prio;
!       end if;
! 
!       Result := pthread_mutex_init (L.L'Access, Mutex_Attr'Access);
  
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
--- 261,271 ----
       (Prio : System.Any_Priority;
        L    : access Lock)
     is
!       pragma Unreferenced (Prio);
  
+       Result : Interfaces.C.int;
     begin
!       Result := pthread_mutex_init (L, Mutex_Attr'Access);
  
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
*************** package body System.Task_Primitives.Oper
*** 324,330 ****
     procedure Finalize_Lock (L : access Lock) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_mutex_destroy (L.L'Access);
        pragma Assert (Result = 0);
     end Finalize_Lock;
  
--- 297,303 ----
     procedure Finalize_Lock (L : access Lock) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_mutex_destroy (L);
        pragma Assert (Result = 0);
     end Finalize_Lock;
  
*************** package body System.Task_Primitives.Oper
*** 341,377 ****
  
     procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
        Result : Interfaces.C.int;
- 
     begin
!       if Priority_Ceiling_Emulation then
!          declare
!             Self_ID : constant Task_Id := Self;
! 
!          begin
!             if Self_ID.Common.LL.Active_Priority > L.Ceiling then
!                Ceiling_Violation := True;
!                return;
!             end if;
! 
!             L.Saved_Priority := Self_ID.Common.LL.Active_Priority;
! 
!             if Self_ID.Common.LL.Active_Priority < L.Ceiling then
!                Self_ID.Common.LL.Active_Priority := L.Ceiling;
!             end if;
! 
!             Result := pthread_mutex_lock (L.L'Access);
!             pragma Assert (Result = 0);
!             Ceiling_Violation := False;
!          end;
! 
!       else
!          Result := pthread_mutex_lock (L.L'Access);
!          Ceiling_Violation := Result = EINVAL;
  
!          --  Assume the cause of EINVAL is a priority ceiling violation
  
!          pragma Assert (Result = 0 or else Result = EINVAL);
!       end if;
     end Write_Lock;
  
     procedure Write_Lock
--- 314,326 ----
  
     procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_mutex_lock (L);
!       Ceiling_Violation := Result = EINVAL;
  
!       --  Assume the cause of EINVAL is a priority ceiling violation
  
!       pragma Assert (Result = 0 or else Result = EINVAL);
     end Write_Lock;
  
     procedure Write_Lock
*************** package body System.Task_Primitives.Oper
*** 410,434 ****
  
     procedure Unlock (L : access Lock) is
        Result : Interfaces.C.int;
- 
     begin
!       if Priority_Ceiling_Emulation then
!          declare
!             Self_ID : constant Task_Id := Self;
! 
!          begin
!             Result := pthread_mutex_unlock (L.L'Access);
!             pragma Assert (Result = 0);
! 
!             if Self_ID.Common.LL.Active_Priority > L.Saved_Priority then
!                Self_ID.Common.LL.Active_Priority := L.Saved_Priority;
!             end if;
!          end;
! 
!       else
!          Result := pthread_mutex_unlock (L.L'Access);
!          pragma Assert (Result = 0);
!       end if;
     end Unlock;
  
     procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
--- 359,367 ----
  
     procedure Unlock (L : access Lock) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_mutex_unlock (L);
!       pragma Assert (Result = 0);
     end Unlock;
  
     procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
*************** package body System.Task_Primitives.Oper
*** 558,571 ****
        Abs_Time   : Duration;
        Request    : aliased timespec;
        Result     : Interfaces.C.int;
-    begin
- 
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below! :(
- 
-       SSL.Abort_Defer.all;
  
        if Single_Lock then
           Lock_RTS;
        end if;
--- 491,498 ----
        Abs_Time   : Duration;
        Request    : aliased timespec;
        Result     : Interfaces.C.int;
  
+    begin
        if Single_Lock then
           Lock_RTS;
        end if;
*************** package body System.Task_Primitives.Oper
*** 616,622 ****
        end if;
  
        Result := sched_yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 543,548 ----
*************** package body System.Task_Primitives.Oper
*** 683,694 ****
     begin
        T.Common.Current_Priority := Prio;
  
-       if Priority_Ceiling_Emulation then
-          if T.Common.LL.Active_Priority < Prio then
-             T.Common.LL.Active_Priority := Prio;
-          end if;
-       end if;
- 
        --  Priorities are in range 1 .. 99 on GNU/Linux, so we map
        --  map 0 .. 31 to 1 .. 32
  
--- 609,614 ----
*************** package body System.Task_Primitives.Oper
*** 698,704 ****
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 618,624 ----
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 933,938 ****
--- 853,1008 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+ 
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+ 
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1022,1027 ****
--- 1092,1117 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       Interrupt_Management.Initialize;
+ 
+       --  Prepare the set of signals that should be unblocked in all tasks
+ 
+       Result := sigemptyset (Unblocked_Signal_Mask'Access);
+       pragma Assert (Result = 0);
+ 
+       for J in Interrupt_Management.Interrupt_ID loop
+          if System.Interrupt_Management.Keep_Unmasked (J) then
+             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+             pragma Assert (Result = 0);
+          end if;
+       end loop;
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+ 
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
        --  Initialize the global RTS lock
*************** package body System.Task_Primitives.Oper
*** 1051,1084 ****
        end if;
     end Initialize;
  
- begin
-    declare
-       Result : Interfaces.C.int;
- 
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
- 
-       Result := pthread_mutexattr_init (Mutex_Attr'Access);
-       pragma Assert (Result = 0);
- 
-       Result := pthread_condattr_init (Cond_Attr'Access);
-       pragma Assert (Result = 0);
-    end;
  end System.Task_Primitives.Operations;
--- 1141,1144 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-lynxos.adb gcc-4.1.0/gcc/ada/s-taprop-lynxos.adb
*** gcc-4.0.2/gcc/ada/s-taprop-lynxos.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-lynxos.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 44,49 ****
--- 44,57 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
+ with System.Interrupt_Management;
+ --  used for Keep_Unmasked
+ --           Abort_Task_Interrupt
+ --           Interrupt_ID
+ 
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
  with System.Task_Info;
  --  used for Task_Info_Type
  
*************** with Interfaces.C;
*** 51,84 ****
  --  used for int
  --           size_t
  
- with System.Interrupt_Management;
- --  used for Keep_Unmasked
- --           Abort_Task_Interrupt
- --           Interrupt_ID
- 
- with System.Interrupt_Management.Operations;
- --  used for Set_Interrupt_Mask
- --           All_Tasks_Mask
- pragma Elaborate_All (System.Interrupt_Management.Operations);
- 
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Deallocation;
  
  package body System.Task_Primitives.Operations is
--- 59,67 ----
*************** package body System.Task_Primitives.Oper
*** 90,97 ****
     use System.Parameters;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 73,78 ----
*************** package body System.Task_Primitives.Oper
*** 108,114 ****
     --  Key used to find the Ada Task_Id associated with a thread
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task.
  
     Locking_Policy : Character;
     pragma Import (C, Locking_Policy, "__gl_locking_policy");
--- 89,95 ----
     --  Key used to find the Ada Task_Id associated with a thread
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task
  
     Locking_Policy : Character;
     pragma Import (C, Locking_Policy, "__gl_locking_policy");
*************** package body System.Task_Primitives.Oper
*** 120,126 ****
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
  
!    --  The followings are internal configuration constants needed.
  
     Next_Serial_Number : Task_Serial_Number := 100;
     --  We start at 100, to reserve some special values for
--- 101,107 ----
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
  
!    --  The followings are internal configuration constants needed
  
     Next_Serial_Number : Task_Serial_Number := 100;
     --  We start at 100, to reserve some special values for
*************** package body System.Task_Primitives.Oper
*** 132,142 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set.
- 
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads).
  
     --------------------
     -- Local Packages --
--- 113,120 ----
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads)
  
     --------------------
     -- Local Packages --
*************** package body System.Task_Primitives.Oper
*** 146,152 ****
  
        procedure Initialize (Environment_Task : Task_Id);
        pragma Inline (Initialize);
!       --  Initialize various data needed by this package.
  
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
--- 124,130 ----
  
        procedure Initialize (Environment_Task : Task_Id);
        pragma Inline (Initialize);
!       --  Initialize various data needed by this package
  
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
*************** package body System.Task_Primitives.Oper
*** 154,176 ****
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task.
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task.
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific.
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and Initialize a new ATCB for the current Thread.
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
--- 132,154 ----
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and Initialize a new ATCB for the current Thread
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
*************** package body System.Task_Primitives.Oper
*** 180,186 ****
     -----------------------
  
     procedure Abort_Handler (Sig : Signal);
!    --  Signal handler used to implement asynchronous abort.
  
     procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority);
     --  This procedure calls the scheduler of the OS to set thread's priority
--- 158,164 ----
     -----------------------
  
     procedure Abort_Handler (Sig : Signal);
!    --  Signal handler used to implement asynchronous abort
  
     procedure Set_OS_Priority (T : Task_Id; Prio : System.Any_Priority);
     --  This procedure calls the scheduler of the OS to set thread's priority
*************** package body System.Task_Primitives.Oper
*** 565,576 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 543,548 ----
*************** package body System.Task_Primitives.Oper
*** 637,643 ****
        end if;
  
        Result := sched_yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 609,614 ----
*************** package body System.Task_Primitives.Oper
*** 708,714 ****
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 679,685 ----
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 1016,1029 ****
     procedure Abort_Task (T : Task_Id) is
        Result : Interfaces.C.int;
     begin
!       Result :=
!         pthread_kill
!           (T.Common.LL.Thread,
!            Signal (System.Interrupt_Management.Abort_Task_Interrupt));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
     -- Check_Exit --
     ----------------
  
--- 987,1180 ----
     procedure Abort_Task (T : Task_Id) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_kill (T.Common.LL.Thread,
!          Signal (System.Interrupt_Management.Abort_Task_Interrupt));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+ 
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             Result := pthread_condattr_destroy (Cond_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_condattr_destroy (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1127,1133 ****
     begin
        Environment_Task_Id := Environment_Task;
  
!       --  Initialize the lock used to synchronize chain of all ATCBs.
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
--- 1278,1298 ----
     begin
        Environment_Task_Id := Environment_Task;
  
!       Interrupt_Management.Initialize;
! 
!       --  Prepare the set of signals that should unblocked in all tasks
! 
!       Result := sigemptyset (Unblocked_Signal_Mask'Access);
!       pragma Assert (Result = 0);
! 
!       for J in Interrupt_Management.Interrupt_ID loop
!          if System.Interrupt_Management.Keep_Unmasked (J) then
!             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
!             pragma Assert (Result = 0);
!          end if;
!       end loop;
! 
!       --  Initialize the lock used to synchronize chain of all ATCBs
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
*************** package body System.Task_Primitives.Oper
*** 1138,1144 ****
        --  Install the abort-signal handler
  
        if State (System.Interrupt_Management.Abort_Task_Interrupt)
!                                                      /= Default
        then
           act.sa_flags := 0;
           act.sa_handler := Abort_Handler'Address;
--- 1303,1309 ----
        --  Install the abort-signal handler
  
        if State (System.Interrupt_Management.Abort_Task_Interrupt)
!         /= Default
        then
           act.sa_flags := 0;
           act.sa_handler := Abort_Handler'Address;
*************** package body System.Task_Primitives.Oper
*** 1157,1184 ****
        end if;
     end Initialize;
  
- begin
-    declare
-       Result : Interfaces.C.int;
- 
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
-    end;
  end System.Task_Primitives.Operations;
--- 1322,1325 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-mingw.adb gcc-4.1.0/gcc/ada/s-taprop-mingw.adb
*** gcc-4.0.2/gcc/ada/s-taprop-mingw.adb	Thu Feb 10 13:57:21 2005
--- gcc-4.1.0/gcc/ada/s-taprop-mingw.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,48 ****
--- 43,51 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
  with Interfaces.C;
  --  used for int
  --           size_t
*************** with System.OS_Interface;
*** 56,77 ****
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- --       to initialize TSD for a C thread, in function Self
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with System.Task_Info;
  --  used for Unspecified_Task_Info
  
--- 59,64 ----
*************** package body System.Task_Primitives.Oper
*** 92,99 ****
     --  permit to have more than 30 tasks running at the same time. Note that
     --  we set the stack size for non tasking programs on System unit.
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 79,84 ----
*************** package body System.Task_Primitives.Oper
*** 112,120 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set
- 
     Foreign_Task_Elaborated : aliased Boolean := True;
     --  Used to identified fake tasks (i.e., non-Ada Threads)
  
--- 97,102 ----
*************** package body System.Task_Primitives.Oper
*** 595,606 ****
        Timedout   : Boolean;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 577,582 ----
*************** package body System.Task_Primitives.Oper
*** 651,657 ****
        end if;
  
        Yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ------------
--- 627,632 ----
*************** package body System.Task_Primitives.Oper
*** 702,708 ****
          (T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio)));
        pragma Assert (Res = True);
  
!       if FIFO_Within_Priorities then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
           --    If the task drops its priority due to the loss of inherited
--- 677,683 ----
          (T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio)));
        pragma Assert (Res = True);
  
!       if Dispatching_Policy = 'F' then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
           --    If the task drops its priority due to the loss of inherited
*************** package body System.Task_Primitives.Oper
*** 883,889 ****
  
        Set_Priority (T, Priority);
  
!       if Time_Slice_Val = 0 or else FIFO_Within_Priorities then
           --  Here we need Annex E semantics so we disable the NT priority
           --  boost. A priority boost is temporarily given by the system to a
           --  thread when it is taken out of a wait state.
--- 858,864 ----
  
        Set_Priority (T, Priority);
  
!       if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
           --  Here we need Annex E semantics so we disable the NT priority
           --  boost. A priority boost is temporarily given by the system to a
           --  thread when it is taken out of a wait state.
*************** package body System.Task_Primitives.Oper
*** 997,1006 ****
  
     begin
        Environment_Task_Id := Environment_Task;
  
!       if Time_Slice_Val = 0 or else FIFO_Within_Priorities then
  
!          --  Here we need Annex E semantics, switch the current process to the
           --  High_Priority_Class.
  
           Discard :=
--- 972,982 ----
  
     begin
        Environment_Task_Id := Environment_Task;
+       OS_Primitives.Initialize;
  
!       if Time_Slice_Val = 0 or else Dispatching_Policy = 'F' then
  
!          --  Here we need Annex D semantics, switch the current process to the
           --  High_Priority_Class.
  
           Discard :=
*************** package body System.Task_Primitives.Oper
*** 1041,1046 ****
--- 1017,1156 ----
     end RT_Resolution;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       InitializeCriticalSection (S.L'Access);
+ 
+       --  Initialize internal condition variable
+ 
+       S.CV := CreateEvent (null, True, False, Null_Ptr);
+       pragma Assert (S.CV /= 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result : BOOL;
+    begin
+       --  Destroy internal mutex
+ 
+       DeleteCriticalSection (S.L'Access);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := CloseHandle (S.CV);
+       pragma Assert (Result = True);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+    begin
+       EnterCriticalSection (S.L'Access);
+ 
+       S.State := False;
+ 
+       LeaveCriticalSection (S.L'Access);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : BOOL;
+    begin
+       EnterCriticalSection (S.L'Access);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := SetEvent (S.CV);
+          pragma Assert (Result = True);
+       else
+          S.State := True;
+       end if;
+ 
+       LeaveCriticalSection (S.L'Access);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result      : DWORD;
+       Result_Bool : BOOL;
+    begin
+       EnterCriticalSection (S.L'Access);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          LeaveCriticalSection (S.L'Access);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+ 
+             LeaveCriticalSection (S.L'Access);
+          else
+             S.Waiting := True;
+ 
+             --  Must reset CV BEFORE L is unlocked.
+ 
+             Result_Bool := ResetEvent (S.CV);
+             pragma Assert (Result_Bool = True);
+ 
+             LeaveCriticalSection (S.L'Access);
+ 
+             Result := WaitForSingleObject (S.CV, Wait_Infinite);
+             pragma Assert (Result = 0);
+          end if;
+       end if;
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-os2.adb gcc-4.1.0/gcc/ada/s-taprop-os2.adb
*** gcc-4.0.2/gcc/ada/s-taprop-os2.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-os2.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S     --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S     --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,79 ****
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
! with Interfaces.C;
! --  used for size_t
! 
! with Interfaces.C.Strings;
! --  used for Null_Ptr
  
  with Interfaces.OS2Lib.Errors;
  with Interfaces.OS2Lib.Threads;
  with Interfaces.OS2Lib.Synchronization;
  
! with System.Parameters;
! --  used for Size_Type
  
! with System.Tasking;
! --  used for Task_Id
  
  with System.Parameters;
  --  used for Size_Type
  
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- --           Clock
- 
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
--- 43,65 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
! with System.OS_Primitives;
! --  used for Delay_Modes
! --           Clock
  
  with Interfaces.OS2Lib.Errors;
  with Interfaces.OS2Lib.Threads;
  with Interfaces.OS2Lib.Synchronization;
  
! with Interfaces.C;
! --  used for size_t
  
! with Interfaces.C.Strings;
! --  used for Null_Ptr
  
  with System.Parameters;
  --  used for Size_Type
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
*************** package body System.Task_Primitives.Oper
*** 82,88 ****
     package IC  renames Interfaces.C;
     package ICS renames Interfaces.C.Strings;
     package OSP renames System.OS_Primitives;
-    package SSL renames System.Soft_Links;
  
     use Interfaces.OS2Lib;
     use Interfaces.OS2Lib.Errors;
--- 68,73 ----
*************** package body System.Task_Primitives.Oper
*** 112,118 ****
     -- Local Data  --
     -----------------
  
!    --  The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr.
  
     --  This API reserves a small range of virtual addresses that is backed
     --  by different physical memory for each running thread. In this case we
--- 97,103 ----
     -- Local Data  --
     -----------------
  
!    --  The OS/2 DosAllocThreadLocalMemory API is used to allocate our TCB_Ptr
  
     --  This API reserves a small range of virtual addresses that is backed
     --  by different physical memory for each running thread. In this case we
*************** package body System.Task_Primitives.Oper
*** 141,147 ****
     --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task.
  
     -----------------------
     -- Local Subprograms --
--- 126,132 ----
     --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task
  
     -----------------------
     -- Local Subprograms --
*************** package body System.Task_Primitives.Oper
*** 223,229 ****
        Self_ID : Task_Id renames Thread_Local_Data_Ptr.Self_ID;
  
     begin
!       --  Check that the thread local data has been initialized.
  
        pragma Assert
          ((Thread_Local_Data_Ptr /= null
--- 208,214 ----
        Self_ID : Task_Id renames Thread_Local_Data_Ptr.Self_ID;
  
     begin
!       --  Check that the thread local data has been initialized
  
        pragma Assert
          ((Thread_Local_Data_Ptr /= null
*************** package body System.Task_Primitives.Oper
*** 458,464 ****
        Count : aliased ULONG; -- Used to store dummy result
  
     begin
!       --  Must reset Cond BEFORE L is unlocked.
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access));
--- 443,449 ----
        Count : aliased ULONG; -- Used to store dummy result
  
     begin
!       --  Must reset Cond BEFORE L is unlocked
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV, Count'Unchecked_Access));
*************** package body System.Task_Primitives.Oper
*** 475,481 ****
        Sem_Must_Not_Fail
          (DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT));
  
!       --  Since L was previously accquired, lock operation should not fail.
  
        if Single_Lock then
           Lock_RTS;
--- 460,466 ----
        Sem_Must_Not_Fail
          (DosWaitEventSem (Self_ID.Common.LL.CV, SEM_INDEFINITE_WAIT));
  
!       --  Since L was previously accquired, lock operation should not fail
  
        if Single_Lock then
           Lock_RTS;
*************** package body System.Task_Primitives.Oper
*** 516,522 ****
        Count      : aliased ULONG;  --  Used to store dummy result
  
     begin
!       --  Must reset Cond BEFORE Self_ID is unlocked.
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV,
--- 501,507 ----
        Count      : aliased ULONG;  --  Used to store dummy result
  
     begin
!       --  Must reset Cond BEFORE Self_ID is unlocked
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV,
*************** package body System.Task_Primitives.Oper
*** 599,617 ****
        Count      : aliased ULONG;  --  Used to store dummy result
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below! :(
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        else
           Write_Lock (Self_ID);
        end if;
  
!       --  Must reset Cond BEFORE Self_ID is unlocked.
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV,
--- 584,596 ----
        Count      : aliased ULONG;  --  Used to store dummy result
  
     begin
        if Single_Lock then
           Lock_RTS;
        else
           Write_Lock (Self_ID);
        end if;
  
!       --  Must reset Cond BEFORE Self_ID is unlocked
  
        Sem_Must_Not_Fail
          (DosResetEventSem (Self_ID.Common.LL.CV,
*************** package body System.Task_Primitives.Oper
*** 672,678 ****
        end if;
  
        System.OS_Interface.Yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ------------
--- 651,656 ----
*************** package body System.Task_Primitives.Oper
*** 767,773 ****
  
     procedure Enter_Task (Self_ID : Task_Id) is
     begin
!       --  Initialize thread local data. Must be done first.
  
        Thread_Local_Data_Ptr.Self_ID := Self_ID;
        Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
--- 745,751 ----
  
     procedure Enter_Task (Self_ID : Task_Id) is
     begin
!       --  Initialize thread local data. Must be done first
  
        Thread_Local_Data_Ptr.Self_ID := Self_ID;
        Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
*************** package body System.Task_Primitives.Oper
*** 927,933 ****
  
        T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper);
  
!       --  The OS implicitly gives the new task the priority of this task.
  
        T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority;
  
--- 905,911 ----
  
        T.Common.LL.Wrapper := To_PFNTHREAD (Wrapper);
  
!       --  The OS implicitly gives the new task the priority of this task
  
        T.Common.LL.Current_Priority := Self.Common.LL.Current_Priority;
  
*************** package body System.Task_Primitives.Oper
*** 1007,1018 ****
     begin
        null;
  
!       --  Task abortion not implemented yet.
        --  Should perform other action ???
  
     end Abort_Task;
  
     ----------------
     -- Check_Exit --
     ----------------
  
--- 985,1138 ----
     begin
        null;
  
!       --  Task abort not implemented yet.
        --  Should perform other action ???
  
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+       if DosCreateMutexSem
+         (ICS.Null_Ptr, S.L'Unchecked_Access, 0, False32) /= NO_ERROR
+       then
+          raise Storage_Error;
+       end if;
+ 
+       pragma Assert (S.L /= 0, "Error creating Mutex");
+ 
+       --  Initialize internal condition variable
+ 
+       if DosCreateEventSem
+         (ICS.Null_Ptr, S.CV'Unchecked_Access, 0, True32) /= NO_ERROR
+       then
+          Must_Not_Fail (DosCloseMutexSem (S.L));
+ 
+          raise Storage_Error;
+       end if;
+ 
+       pragma Assert (S.CV /= 0, "Error creating Condition Variable");
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+    begin
+       --  Destroy internal mutex
+ 
+       Must_Not_Fail (DosCloseMutexSem (S.L'Access));
+ 
+       --  Destroy internal condition variable
+ 
+       Must_Not_Fail (DosCloseEventSem (S.CV'Access));
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+    begin
+       Must_Not_Fail (DosRequestMutexSem (S.L, SEM_INDEFINITE_WAIT));
+ 
+       S.State := False;
+ 
+       Must_Not_Fail (DosReleaseMutexSem (S.L));
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+    begin
+       Must_Not_Fail (DosRequestMutexSem (S.L, SEM_INDEFINITE_WAIT));
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Sem_Must_Not_Fail (DosPostEventSem (S.CV));
+       else
+          S.State := True;
+       end if;
+ 
+       Must_Not_Fail (DosReleaseMutexSem (S.L));
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Count : aliased ULONG; -- Used to store dummy result
+    begin
+       Must_Not_Fail (DosRequestMutexSem (S.L, SEM_INDEFINITE_WAIT));
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Must_Not_Fail (DosReleaseMutexSem (S.L));
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+ 
+             Must_Not_Fail (DosReleaseMutexSem (S.L));
+          else
+             S.Waiting := True;
+ 
+             --  Must reset Cond BEFORE L is unlocked
+ 
+             Sem_Must_Not_Fail
+               (DosResetEventSem (S.CV, Count'Unchecked_Access));
+ 
+             Must_Not_Fail (DosReleaseMutexSem (S.L));
+ 
+             Sem_Must_Not_Fail
+               (DosWaitEventSem (S.CV, SEM_INDEFINITE_WAIT));
+          end if;
+       end if;
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1102,1111 ****
     begin
        Environment_Task_Id := Environment_Task;
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
!       --  Initialize the lock used to synchronize chain of all ATCBs.
  
!       --  Set ID of environment task.
  
        Thread_Local_Data_Ptr.Self_ID := Environment_Task;
        Environment_Task.Common.LL.Thread := 1; --  By definition
--- 1222,1245 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       OS_Primitives.Initialize;
+ 
+       --  Initialize pointer to task local data.
+       --  This is done once, for all tasks.
+ 
+       Must_Not_Fail (DosAllocThreadLocalMemory
+          ((Thread_Local_Data'Size + 31) / 32,  --  nr of 32-bit words
+           To_PPVOID (Thread_Local_Data_Ptr'Access)));
+ 
+       --  Initialize thread local data for main thread
+ 
+       Thread_Local_Data_Ptr.Self_ID := null;
+       Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
+ 
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
!       --  Initialize the lock used to synchronize chain of all ATCBs
  
!       --  Set ID of environment task
  
        Thread_Local_Data_Ptr.Self_ID := Environment_Task;
        Environment_Task.Common.LL.Thread := 1; --  By definition
*************** package body System.Task_Primitives.Oper
*** 1137,1152 ****
        --  initialization needed for the environment task.
     end Initialize;
  
- begin
-    --  Initialize pointer to task local data.
-    --  This is done once, for all tasks.
- 
-    Must_Not_Fail (DosAllocThreadLocalMemory
-       ((Thread_Local_Data'Size + 31) / 32,  --  nr of 32-bit words
-        To_PPVOID (Thread_Local_Data_Ptr'Access)));
- 
-    --  Initialize thread local data for main thread
- 
-    Thread_Local_Data_Ptr.Self_ID := null;
-    Thread_Local_Data_Ptr.Lock_Prio_Level := 0;
  end System.Task_Primitives.Operations;
--- 1271,1274 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-posix.adb gcc-4.1.0/gcc/ada/s-taprop-posix.adb
*** gcc-4.0.2/gcc/ada/s-taprop-posix.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-taprop-posix.adb	Tue Nov 15 13:52:20 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 49,54 ****
--- 49,62 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
+ with System.Interrupt_Management;
+ --  used for Keep_Unmasked
+ --           Abort_Task_Interrupt
+ --           Interrupt_ID
+ 
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
  with System.Task_Info;
  --  used for Task_Info_Type
  
*************** with Interfaces.C;
*** 56,89 ****
  --  used for int
  --           size_t
  
- with System.Interrupt_Management;
- --  used for Keep_Unmasked
- --           Abort_Task_Interrupt
- --           Interrupt_ID
- 
- with System.Interrupt_Management.Operations;
- --  used for Set_Interrupt_Mask
- --           All_Tasks_Mask
- pragma Elaborate_All (System.Interrupt_Management.Operations);
- 
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
  
--- 64,72 ----
*************** package body System.Task_Primitives.Oper
*** 96,103 ****
     use System.Parameters;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 79,84 ----
*************** package body System.Task_Primitives.Oper
*** 138,146 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set.
- 
     Foreign_Task_Elaborated : aliased Boolean := True;
     --  Used to identified fake tasks (i.e., non-Ada Threads).
  
--- 119,124 ----
*************** package body System.Task_Primitives.Oper
*** 334,339 ****
--- 312,318 ----
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
        if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Attributes'Access);
           raise Storage_Error;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 608,619 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below! :(
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 587,592 ----
*************** package body System.Task_Primitives.Oper
*** 678,684 ****
        end if;
  
        Result := sched_yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 651,656 ----
*************** package body System.Task_Primitives.Oper
*** 751,757 ****
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 723,729 ----
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 1037,1043 ****
  
     procedure Abort_Task (T : Task_Id) is
        Result : Interfaces.C.int;
- 
     begin
        Result := pthread_kill (T.Common.LL.Thread,
          Signal (System.Interrupt_Management.Abort_Task_Interrupt));
--- 1009,1014 ----
*************** package body System.Task_Primitives.Oper
*** 1045,1050 ****
--- 1016,1202 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             Result := pthread_condattr_destroy (Cond_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_condattr_destroy (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1148,1153 ****
--- 1300,1319 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       Interrupt_Management.Initialize;
+ 
+       --  Prepare the set of signals that should unblocked in all tasks
+ 
+       Result := sigemptyset (Unblocked_Signal_Mask'Access);
+       pragma Assert (Result = 0);
+ 
+       for J in Interrupt_Management.Interrupt_ID loop
+          if System.Interrupt_Management.Keep_Unmasked (J) then
+             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
+             pragma Assert (Result = 0);
+          end if;
+       end loop;
+ 
        --  Initialize the lock used to synchronize chain of all ATCBs.
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
*************** package body System.Task_Primitives.Oper
*** 1177,1203 ****
        end if;
     end Initialize;
  
- begin
-    declare
-       Result : Interfaces.C.int;
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
-    end;
  end System.Task_Primitives.Operations;
--- 1343,1346 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-solaris.adb gcc-4.1.0/gcc/ada/s-taprop-solaris.adb
*** gcc-4.0.2/gcc/ada/s-taprop-solaris.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-taprop-solaris.adb	Tue Nov 15 13:51:09 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,91 ****
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
! with Ada.Exceptions;
! --  used for Raise_Exception
  
  with GNAT.OS_Lib;
  --  used for String_Access, Getenv
  
  with Interfaces.C;
  --  used for int
  --           size_t
  
- with System.Interrupt_Management;
- --  used for Keep_Unmasked
- --           Abort_Task_Interrupt
- --           Interrupt_ID
- 
- with System.Interrupt_Management.Operations;
- --  used for Set_Interrupt_Mask
- --           All_Tasks_Mask
- pragma Elaborate_All (System.Interrupt_Management.Operations);
- 
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- --           ATCB components and types
- 
  with System.Task_Info;
  --  to initialize Task_Info for a C thread, in function Self
  
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- --       to initialize TSD for a C thread, in function Self
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Deallocation;
  
  package body System.Task_Primitives.Operations is
--- 43,72 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
! with System.Interrupt_Management;
! --  used for Keep_Unmasked
! --           Abort_Task_Interrupt
! --           Interrupt_ID
! 
! with System.OS_Primitives;
! --  used for Delay_Modes
  
+ pragma Warnings (Off);
  with GNAT.OS_Lib;
  --  used for String_Access, Getenv
  
+ pragma Warnings (On);
+ 
  with Interfaces.C;
  --  used for int
  --           size_t
  
  with System.Parameters;
  --  used for Size_Type
  
  with System.Task_Info;
  --  to initialize Task_Info for a C thread, in function Self
  
  with Unchecked_Deallocation;
  
  package body System.Task_Primitives.Operations is
*************** package body System.Task_Primitives.Oper
*** 95,105 ****
     use Interfaces.C;
     use System.OS_Interface;
     use System.Parameters;
-    use Ada.Exceptions;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 76,83 ----
*************** package body System.Task_Primitives.Oper
*** 285,291 ****
        Old_Set : aliased sigset_t;
  
        Result : Interfaces.C.int;
-       pragma Unreferenced (Result);
  
     begin
        --  It is not safe to raise an exception when using ZCX and the GCC
--- 263,268 ----
*************** package body System.Task_Primitives.Oper
*** 430,440 ****
     begin
        Environment_Task_Id := Environment_Task;
  
!       --  This is done in Enter_Task, but this is too late for the
        --  Environment Task, since we need to call Self in Check_Locks when
        --  the run time is compiled with assertions on.
  
!       Specific.Initialize (Environment_Task);
  
        --  Initialize the lock used to synchronize chain of all ATCBs.
  
--- 407,479 ----
     begin
        Environment_Task_Id := Environment_Task;
  
!       Interrupt_Management.Initialize;
! 
!       --  Prepare the set of signals that should unblocked in all tasks
! 
!       Result := sigemptyset (Unblocked_Signal_Mask'Access);
!       pragma Assert (Result = 0);
! 
!       for J in Interrupt_Management.Interrupt_ID loop
!          if System.Interrupt_Management.Keep_Unmasked (J) then
!             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
!             pragma Assert (Result = 0);
!          end if;
!       end loop;
! 
!       if Dispatching_Policy = 'F' then
!          declare
!             Result      : Interfaces.C.long;
!             Class_Info  : aliased struct_pcinfo;
!             Secs, Nsecs : Interfaces.C.long;
! 
!          begin
!             --  If a pragma Time_Slice is specified, takes the value in account
! 
!             if Time_Slice_Val > 0 then
!                --  Convert Time_Slice_Val (microseconds) into seconds and
!                --  nanoseconds
! 
!                Secs := Time_Slice_Val / 1_000_000;
!                Nsecs := (Time_Slice_Val rem 1_000_000) * 1_000;
! 
!             --  Otherwise, default to no time slicing (i.e run until blocked)
! 
!             else
!                Secs := RT_TQINF;
!                Nsecs := RT_TQINF;
!             end if;
! 
!             --  Get the real time class id.
! 
!             Class_Info.pc_clname (1) := 'R';
!             Class_Info.pc_clname (2) := 'T';
!             Class_Info.pc_clname (3) := ASCII.NUL;
! 
!             Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_GETCID,
!               Class_Info'Address);
! 
!             --  Request the real time class
! 
!             Prio_Param.pc_cid := Class_Info.pc_cid;
!             Prio_Param.rt_pri := pri_t (Class_Info.rt_maxpri);
!             Prio_Param.rt_tqsecs := Secs;
!             Prio_Param.rt_tqnsecs := Nsecs;
! 
!             Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_SETPARMS,
!               Prio_Param'Address);
! 
!             Using_Real_Time_Class := Result /= -1;
!          end;
!       end if;
! 
!       Specific.Initialize (Environment_Task);
! 
!       --  The following is done in Enter_Task, but this is too late for the
        --  Environment Task, since we need to call Self in Check_Locks when
        --  the run time is compiled with assertions on.
  
!       Specific.Set (Environment_Task);
  
        --  Initialize the lock used to synchronize chain of all ATCBs.
  
*************** package body System.Task_Primitives.Oper
*** 501,507 ****
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
        if Result = ENOMEM then
!          Raise_Exception (Storage_Error'Identity, "Failed to allocate a lock");
        end if;
     end Initialize_Lock;
  
--- 540,546 ----
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
        if Result = ENOMEM then
!          raise Storage_Error with "Failed to allocate a lock";
        end if;
     end Initialize_Lock;
  
*************** package body System.Task_Primitives.Oper
*** 518,524 ****
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
        if Result = ENOMEM then
!          Raise_Exception (Storage_Error'Identity, "Failed to allocate a lock");
        end if;
     end Initialize_Lock;
  
--- 557,563 ----
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
        if Result = ENOMEM then
!          raise Storage_Error with "Failed to allocate a lock";
        end if;
     end Initialize_Lock;
  
*************** package body System.Task_Primitives.Oper
*** 1060,1067 ****
  
        Result := thr_kill (T.Common.LL.Thread,
          Signal (System.Interrupt_Management.Abort_Task_Interrupt));
-       null;
- 
        pragma Assert (Result = 0);
     end Abort_Task;
  
--- 1099,1104 ----
*************** package body System.Task_Primitives.Oper
*** 1251,1262 ****
        Yielded    : Boolean := False;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below!
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 1288,1293 ----
*************** package body System.Task_Primitives.Oper
*** 1317,1324 ****
        if not Yielded then
           thr_yield;
        end if;
- 
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ------------
--- 1348,1353 ----
*************** package body System.Task_Primitives.Oper
*** 1353,1359 ****
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1382,1388 ----
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1390,1396 ****
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1419,1425 ----
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1469,1475 ****
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1498,1504 ----
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1588,1594 ****
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1617,1623 ----
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1617,1623 ****
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1646,1652 ----
     begin
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1632,1637 ****
--- 1661,1814 ----
     end Check_Finalize_Lock;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := mutex_init (S.L'Access, USYNC_THREAD, System.Null_Address);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error with "Failed to allocate a lock";
+       end if;
+ 
+       --  Initialize internal condition variable
+ 
+       Result := cond_init (S.CV'Access, USYNC_THREAD, 0);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1656,1662 ****
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level <= 0 then
           return False;
        end if;
  
--- 1833,1839 ----
  
        --  Check that caller is abort-deferred
  
!       if Self_ID.Deferral_Level = 0 then
           return False;
        end if;
  
*************** package body System.Task_Primitives.Oper
*** 1731,1813 ****
        end if;
     end Resume_Task;
  
- --  Package elaboration
- 
- begin
-    declare
-       Result : Interfaces.C.int;
- 
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
- 
-       --  We need the following code to support automatic creation of fake
-       --  ATCB's for C threads that call the Ada run-time system, even if
-       --  we use a faster way of getting Self for real Ada tasks.
- 
-       Result := thr_keycreate (ATCB_Key'Access, System.Null_Address);
-       pragma Assert (Result = 0);
-    end;
- 
-    if Dispatching_Policy = 'F' then
-       declare
-          Result      : Interfaces.C.long;
-          Class_Info  : aliased struct_pcinfo;
-          Secs, Nsecs : Interfaces.C.long;
- 
-       begin
-          --  If a pragma Time_Slice is specified, takes the value in account.
- 
-          if Time_Slice_Val > 0 then
-             --  Convert Time_Slice_Val (microseconds) into seconds and
-             --  nanoseconds
- 
-             Secs := Time_Slice_Val / 1_000_000;
-             Nsecs := (Time_Slice_Val rem 1_000_000) * 1_000;
- 
-          --  Otherwise, default to no time slicing (i.e run until blocked)
- 
-          else
-             Secs := RT_TQINF;
-             Nsecs := RT_TQINF;
-          end if;
- 
-          --  Get the real time class id.
- 
-          Class_Info.pc_clname (1) := 'R';
-          Class_Info.pc_clname (2) := 'T';
-          Class_Info.pc_clname (3) := ASCII.NUL;
- 
-          Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_GETCID,
-            Class_Info'Address);
- 
-          --  Request the real time class
- 
-          Prio_Param.pc_cid := Class_Info.pc_cid;
-          Prio_Param.rt_pri := pri_t (Class_Info.rt_maxpri);
-          Prio_Param.rt_tqsecs := Secs;
-          Prio_Param.rt_tqnsecs := Nsecs;
- 
-          Result := priocntl (PC_VERSION, P_LWPID, P_MYID, PC_SETPARMS,
-            Prio_Param'Address);
- 
-          Using_Real_Time_Class := Result /= -1;
-       end;
-    end if;
  end System.Task_Primitives.Operations;
--- 1908,1911 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-tru64.adb gcc-4.1.0/gcc/ada/s-taprop-tru64.adb
*** gcc-4.0.2/gcc/ada/s-taprop-tru64.adb	Tue Jul  6 13:57:29 2004
--- gcc-4.1.0/gcc/ada/s-taprop-tru64.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,48 ****
--- 43,56 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
+ with System.Interrupt_Management;
+ --  used for Keep_Unmasked
+ --           Abort_Task_Interrupt
+ --           Interrupt_ID
+ 
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
  with System.Task_Info;
  --  used for Task_Info_Type
  
*************** with Interfaces.C;
*** 53,87 ****
  --  used for int
  --           size_t
  
- with System.Interrupt_Management;
- --  used for Keep_Unmasked
- --           Abort_Task_Interrupt
- --           Interrupt_ID
- 
- with System.Interrupt_Management.Operations;
- --  used for Set_Interrupt_Mask
- --           All_Tasks_Mask
- pragma Elaborate_All (System.Interrupt_Management.Operations);
- 
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- --           ATCB components and types
- 
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
- with System.OS_Primitives;
- --  used for Delay_Modes
- 
  with Unchecked_Deallocation;
  
  package body System.Task_Primitives.Operations is
--- 61,69 ----
*************** package body System.Task_Primitives.Oper
*** 93,100 ****
     use System.Parameters;
     use System.OS_Primitives;
  
-    package SSL renames System.Soft_Links;
- 
     ----------------
     -- Local Data --
     ----------------
--- 75,80 ----
*************** package body System.Task_Primitives.Oper
*** 111,117 ****
     --  Key used to find the Ada Task_Id associated with a thread
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task.
  
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
--- 91,97 ----
     --  Key used to find the Ada Task_Id associated with a thread
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task
  
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
*************** package body System.Task_Primitives.Oper
*** 125,137 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set.
- 
     Curpid : pid_t;
  
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads).
  
     --------------------
     -- Local Packages --
--- 105,114 ----
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
     Curpid : pid_t;
  
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads)
  
     --------------------
     -- Local Packages --
*************** package body System.Task_Primitives.Oper
*** 141,147 ****
  
        procedure Initialize (Environment_Task : Task_Id);
        pragma Inline (Initialize);
!       --  Initialize various data needed by this package.
  
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
--- 118,124 ----
  
        procedure Initialize (Environment_Task : Task_Id);
        pragma Inline (Initialize);
!       --  Initialize various data needed by this package
  
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
*************** package body System.Task_Primitives.Oper
*** 149,171 ****
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task.
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task.
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific.
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and Initialize a new ATCB for the current Thread.
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
--- 126,148 ----
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and initialize a new ATCB for the current Thread
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
*************** package body System.Task_Primitives.Oper
*** 175,181 ****
     -----------------------
  
     procedure Abort_Handler (Sig : Signal);
!    --  Signal handler used to implement asynchronous abortion.
  
     -------------------
     -- Abort_Handler --
--- 152,158 ----
     -----------------------
  
     procedure Abort_Handler (Sig : Signal);
!    --  Signal handler used to implement asynchronous abort
  
     -------------------
     -- Abort_Handler --
*************** package body System.Task_Primitives.Oper
*** 338,344 ****
        Current_Prio   : System.Any_Priority;
  
     begin
!       --  Perform ceiling checks only when this is the locking policy in use.
  
        if Locking_Policy = 'C' then
           Self_ID := Self;
--- 315,321 ----
        Current_Prio   : System.Any_Priority;
  
     begin
!       --  Perform ceiling checks only when this is the locking policy in use
  
        if Locking_Policy = 'C' then
           Self_ID := Self;
*************** package body System.Task_Primitives.Oper
*** 440,446 ****
                       (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
        end if;
  
!       --  EINTR is not considered a failure.
  
        pragma Assert (Result = 0 or else Result = EINTR);
     end Sleep;
--- 417,423 ----
                       (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
        end if;
  
!       --  EINTR is not considered a failure
  
        pragma Assert (Result = 0 or else Result = EINTR);
     end Sleep;
*************** package body System.Task_Primitives.Oper
*** 532,543 ****
        Result     : Interfaces.C.int;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below! :(
- 
-       SSL.Abort_Defer.all;
- 
        if Single_Lock then
           Lock_RTS;
        end if;
--- 509,514 ----
*************** package body System.Task_Primitives.Oper
*** 590,596 ****
        end if;
  
        Yield;
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 561,566 ----
*************** package body System.Task_Primitives.Oper
*** 612,618 ****
  
     function RT_Resolution return Duration is
     begin
!       return 1.0 / 1024.0; --  Clock on DEC Alpha ticks at 1024 Hz
     end RT_Resolution;
  
     ------------
--- 582,592 ----
  
     function RT_Resolution return Duration is
     begin
!       --  Returned value must be an integral multiple of Duration'Small (1 ns)
!       --  The following is the best approximation of 1/1024. The clock on the
!       --  DEC Alpha ticks at 1024 Hz.
! 
!       return 0.000_976_563;
     end RT_Resolution;
  
     ------------
*************** package body System.Task_Primitives.Oper
*** 662,668 ****
           Result := pthread_setschedparam
                       (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
                       (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 636,642 ----
           Result := pthread_setschedparam
                       (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
                       (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 689,694 ****
--- 663,669 ----
  
     procedure Enter_Task (Self_ID : Task_Id) is
     begin
+       Hide_Yellow_Zone;
        Self_ID.Common.LL.Thread := pthread_self;
        Specific.Set (Self_ID);
  
*************** package body System.Task_Primitives.Oper
*** 815,820 ****
--- 790,800 ----
           Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
        end if;
  
+       --  Account for the Yellow Zone (2 pages) and the guard page
+       --  right above. See Hide_Yellow_Zone for the rationale.
+ 
+       Adjusted_Stack_Size := Adjusted_Stack_Size + 3 * Get_Page_Size;
+ 
        Result := pthread_attr_init (Attributes'Access);
        pragma Assert (Result = 0 or else Result = ENOMEM);
  
*************** package body System.Task_Primitives.Oper
*** 841,847 ****
           Result := pthread_attr_setschedpolicy
                       (Attributes'Access, System.OS_Interface.SCHED_RR);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_attr_setschedpolicy
                       (Attributes'Access, System.OS_Interface.SCHED_FIFO);
  
--- 821,827 ----
           Result := pthread_attr_setschedpolicy
                       (Attributes'Access, System.OS_Interface.SCHED_RR);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_attr_setschedpolicy
                       (Attributes'Access, System.OS_Interface.SCHED_FIFO);
  
*************** package body System.Task_Primitives.Oper
*** 962,975 ****
     procedure Abort_Task (T : Task_Id) is
        Result : Interfaces.C.int;
     begin
!       Result :=
!         pthread_kill
!           (T.Common.LL.Thread,
!            Signal (System.Interrupt_Management.Abort_Task_Interrupt));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
     -- Check_Exit --
     ----------------
  
--- 942,1118 ----
     procedure Abort_Task (T : Task_Id) is
        Result : Interfaces.C.int;
     begin
!       Result := pthread_kill (T.Common.LL.Thread,
!         Signal (System.Interrupt_Management.Abort_Task_Interrupt));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+ 
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1072,1078 ****
     begin
        Environment_Task_Id := Environment_Task;
  
!       --  Initialize the lock used to synchronize chain of all ATCBs.
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
--- 1215,1237 ----
     begin
        Environment_Task_Id := Environment_Task;
  
!       Interrupt_Management.Initialize;
! 
!       --  Prepare the set of signals that should unblocked in all tasks
! 
!       Result := sigemptyset (Unblocked_Signal_Mask'Access);
!       pragma Assert (Result = 0);
! 
!       for J in Interrupt_Management.Interrupt_ID loop
!          if System.Interrupt_Management.Keep_Unmasked (J) then
!             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
!             pragma Assert (Result = 0);
!          end if;
!       end loop;
! 
!       Curpid := getpid;
! 
!       --  Initialize the lock used to synchronize chain of all ATCBs
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
*************** package body System.Task_Primitives.Oper
*** 1101,1130 ****
        end if;
     end Initialize;
  
- begin
-    declare
-       Result : Interfaces.C.int;
- 
-    begin
-       --  Mask Environment task for all signals. The original mask of the
-       --  Environment task will be recovered by Interrupt_Server task
-       --  during the elaboration of s-interr.adb.
- 
-       System.Interrupt_Management.Operations.Set_Interrupt_Mask
-         (System.Interrupt_Management.Operations.All_Tasks_Mask'Access);
- 
-       --  Prepare the set of signals that should unblocked in all tasks
- 
-       Result := sigemptyset (Unblocked_Signal_Mask'Access);
-       pragma Assert (Result = 0);
- 
-       for J in Interrupt_Management.Interrupt_ID loop
-          if System.Interrupt_Management.Keep_Unmasked (J) then
-             Result := sigaddset (Unblocked_Signal_Mask'Access, Signal (J));
-             pragma Assert (Result = 0);
-          end if;
-       end loop;
-    end;
- 
-    Curpid := getpid;
  end System.Task_Primitives.Operations;
--- 1260,1263 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-vms.adb gcc-4.1.0/gcc/ada/s-taprop-vms.adb
*** gcc-4.0.2/gcc/ada/s-taprop-vms.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-taprop-vms.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 43,48 ****
--- 43,51 ----
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
+ with System.OS_Primitives;
+ --  used for Delay_Modes
+ 
  with Interfaces.C;
  --  used for int
  --           size_t
*************** with Interfaces.C;
*** 50,70 ****
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- 
  with System.Soft_Links;
! --  used for Defer/Undefer_Abort
! --           Set_Exc_Stack_Addr
! 
! --  Note that we do not use System.Tasking.Initialization directly since
! --  this is a higher level package that we shouldn't depend on. For example
! --  when using the restricted run time, it is replaced by
! --  System.Tasking.Restricted.Stages.
! 
! with System.OS_Primitives;
! --  used for Delay_Modes
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
--- 53,60 ----
  with System.Parameters;
  --  used for Size_Type
  
  with System.Soft_Links;
! --  used for Get_Exc_Stack_Addr
  
  with Unchecked_Conversion;
  with Unchecked_Deallocation;
*************** package body System.Task_Primitives.Oper
*** 105,113 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set.
- 
     Foreign_Task_Elaborated : aliased Boolean := True;
     --  Used to identified fake tasks (i.e., non-Ada Threads).
  
--- 95,100 ----
*************** package body System.Task_Primitives.Oper
*** 156,161 ****
--- 143,151 ----
  
     function To_Address is new Unchecked_Conversion (Task_Id, System.Address);
  
+    function Get_Exc_Stack_Addr return Address;
+    --  Replace System.Soft_Links.Get_Exc_Stack_Addr_NT
+ 
     procedure Timer_Sleep_AST (ID : Address);
     --  Signal the condition variable when AST fires.
  
*************** package body System.Task_Primitives.Oper
*** 492,508 ****
        Yielded    : Boolean := False;
  
     begin
-       --  Only the little window between deferring abort and
-       --  locking Self_ID is the reason we need to
-       --  check for pending abort and priority change below!
- 
        if Single_Lock then
           Lock_RTS;
        end if;
  
        --  More comments required in body below ???
  
-       SSL.Abort_Defer.all;
        Write_Lock (Self_ID);
  
        if Time /= 0.0 or else Mode /= Relative then
--- 482,493 ----
*************** package body System.Task_Primitives.Oper
*** 562,569 ****
           Result := sched_yield;
           pragma Assert (Result = 0);
        end if;
- 
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 547,552 ----
*************** package body System.Task_Primitives.Oper
*** 629,635 ****
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif FIFO_Within_Priorities or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
--- 612,618 ----
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_RR, Param'Access);
  
!       elsif Dispatching_Policy = 'F' or else Time_Slice_Val = 0 then
           Result := pthread_setschedparam
             (T.Common.LL.Thread, SCHED_FIFO, Param'Access);
  
*************** package body System.Task_Primitives.Oper
*** 749,757 ****
        if Result = 0 then
           Succeeded := True;
           Self_ID.Common.LL.Exc_Stack_Ptr := new Exc_Stack_T;
-          SSL.Set_Exc_Stack_Addr
-            (To_Address (Self_ID),
-             Self_ID.Common.LL.Exc_Stack_Ptr (Exc_Stack_T'Last)'Address);
  
        else
           if not Single_Lock then
--- 732,737 ----
*************** package body System.Task_Primitives.Oper
*** 766,771 ****
--- 746,760 ----
        pragma Assert (Result = 0);
     end Initialize_TCB;
  
+    ------------------------
+    -- Get_Exc_Stack_Addr --
+    ------------------------
+ 
+    function Get_Exc_Stack_Addr return Address is
+    begin
+       return Self.Common.LL.Exc_Stack_Ptr (Exc_Stack_T'Last)'Address;
+    end Get_Exc_Stack_Addr;
+ 
     -----------------
     -- Create_Task --
     -----------------
*************** package body System.Task_Primitives.Oper
*** 887,893 ****
  
     procedure Exit_Task is
     begin
!       Specific.Set (null);
     end Exit_Task;
  
     ----------------
--- 876,882 ----
  
     procedure Exit_Task is
     begin
!       null;
     end Exit_Task;
  
     ----------------
*************** package body System.Task_Primitives.Oper
*** 904,909 ****
--- 893,1079 ----
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Cond_Attr  : aliased pthread_condattr_t;
+       Result     : Interfaces.C.int;
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       Result := pthread_mutexattr_init (Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result = ENOMEM then
+          Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Storage_Error;
+       end if;
+ 
+       Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Initialize internal condition variable
+ 
+       Result := pthread_condattr_init (Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
+       pragma Assert (Result = 0 or else Result = ENOMEM);
+ 
+       if Result /= 0 then
+          Result := pthread_mutex_destroy (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          if Result = ENOMEM then
+             Result := pthread_condattr_destroy (Cond_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+             raise Storage_Error;
+          end if;
+       end if;
+ 
+       Result := pthread_condattr_destroy (Cond_Attr'Access);
+       pragma Assert (Result = 0);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := pthread_mutex_destroy (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := pthread_cond_destroy (S.CV'Access);
+       pragma Assert (Result = 0);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       S.State := False;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := pthread_cond_signal (S.CV'Access);
+          pragma Assert (Result = 0);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : Interfaces.C.int;
+    begin
+       Result := pthread_mutex_lock (S.L'Access);
+       pragma Assert (Result = 0);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := pthread_mutex_unlock (S.L'Access);
+          pragma Assert (Result = 0);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+          else
+             S.Waiting := True;
+             Result := pthread_cond_wait (S.CV'Access, S.L'Access);
+          end if;
+       end if;
+ 
+       Result := pthread_mutex_unlock (S.L'Access);
+       pragma Assert (Result = 0);
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 988,993 ****
--- 1158,1165 ----
     begin
        Environment_Task_Id := Environment_Task;
  
+       SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
+ 
        --  Initialize the lock used to synchronize chain of all ATCBs
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop-vxworks.adb gcc-4.1.0/gcc/ada/s-taprop-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-taprop-vxworks.adb	Tue Jul  6 13:57:30 2004
--- gcc-4.1.0/gcc/ada/s-taprop-vxworks.adb	Mon Sep  5 07:49:24 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --     S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S    --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 40,45 ****
--- 40,50 ----
  --  Turn off polling, we do not want ATC polling to take place during
  --  tasking operations. It causes infinite loops and other problems.
  
+ with System.Tasking;
+ --  used for Ada_Task_Control_Block
+ --           Task_Id
+ --           ATCB components and types
+ 
  with System.Tasking.Debug;
  --  used for Known_Tasks
  
*************** with System.Interrupt_Management;
*** 49,73 ****
  --           Signal_ID
  --           Initialize_Interrupts
  
- with System.Soft_Links;
- --  used for Defer/Undefer_Abort
- 
- --  Note that we do not use System.Tasking.Initialization directly since
- --  this is a higher level package that we shouldn't depend on. For example
- --  when using the restricted run time, it is replaced by
- --  System.Tasking.Restricted.Stages.
- 
  with System.OS_Interface;
  --  used for various type, constant, and operations
  
  with System.Parameters;
  --  used for Size_Type
  
- with System.Tasking;
- --  used for Ada_Task_Control_Block
- --           Task_Id
- --           ATCB components and types
- 
  with Interfaces.C;
  
  with Unchecked_Conversion;
--- 54,65 ----
*************** package body System.Task_Primitives.Oper
*** 81,88 ****
     use System.Parameters;
     use type Interfaces.C.int;
  
-    package SSL renames System.Soft_Links;
- 
     subtype int is System.OS_Interface.int;
  
     Relative : constant := 0;
--- 73,78 ----
*************** package body System.Task_Primitives.Oper
*** 91,120 ****
     -- Local Data --
     ----------------
  
!    --  The followings are logically constants, but need to be initialized
!    --  at run time.
  
     Single_RTS_Lock : aliased RTS_Lock;
!    --  This is a lock to allow only one thread of control in the RTS at
!    --  a time; it is used to execute in mutual exclusion from all other tasks.
     --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
  
-    ATCB_Key : aliased System.Address := System.Null_Address;
-    --  Key used to find the Ada Task_Id associated with a thread
- 
-    ATCB_Key_Addr : System.Address := ATCB_Key'Address;
-    pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr");
-    --  Exported to support the temporary AE653 task registration
-    --  implementation. This mechanism is used to minimize impact on other
-    --  targets.
- 
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task.
  
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
  
!    --  The followings are internal configuration constants needed.
  
     Time_Slice_Val : Integer;
     pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
--- 81,101 ----
     -- Local Data --
     ----------------
  
!    --  The followings are logically constants, but need to be initialized at
!    --  run time.
  
     Single_RTS_Lock : aliased RTS_Lock;
!    --  This is a lock to allow only one thread of control in the RTS at a
!    --  time; it is used to execute in mutual exclusion from all other tasks.
     --  Used mainly in Single_Lock mode, but also to protect All_Tasks_List
  
     Environment_Task_Id : Task_Id;
!    --  A variable to hold Task_Id for the environment task
  
     Unblocked_Signal_Mask : aliased sigset_t;
     --  The set of signals that should unblocked in all tasks
  
!    --  The followings are internal configuration constants needed
  
     Time_Slice_Val : Integer;
     pragma Import (C, Time_Slice_Val, "__gl_time_slice_val");
*************** package body System.Task_Primitives.Oper
*** 125,137 ****
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
-    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-    --  Indicates whether FIFO_Within_Priorities is set.
- 
     Mutex_Protocol : Priority_Type;
  
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads).
  
     --------------------
     -- Local Packages --
--- 106,115 ----
     Dispatching_Policy : Character;
     pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
  
     Mutex_Protocol : Priority_Type;
  
     Foreign_Task_Elaborated : aliased Boolean := True;
!    --  Used to identified fake tasks (i.e., non-Ada Threads)
  
     --------------------
     -- Local Packages --
*************** package body System.Task_Primitives.Oper
*** 139,167 ****
  
     package Specific is
  
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
        --  Does executing thread have a TCB?
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task.
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task.
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific.
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and Initialize a new ATCB for the current Thread.
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
--- 117,153 ----
  
     package Specific is
  
+       procedure Initialize;
+       pragma Inline (Initialize);
+       --  Initialize task specific data
+ 
        function Is_Valid_Task return Boolean;
        pragma Inline (Is_Valid_Task);
        --  Does executing thread have a TCB?
  
        procedure Set (Self_Id : Task_Id);
        pragma Inline (Set);
!       --  Set the self id for the current task
! 
!       procedure Delete;
!       pragma Inline (Delete);
!       --  Delete the task specific data associated with the current task
  
        function Self return Task_Id;
        pragma Inline (Self);
!       --  Return a pointer to the Ada Task Control Block of the calling task
  
     end Specific;
  
     package body Specific is separate;
!    --  The body of this package is target specific
  
     ---------------------------------
     -- Support for foreign threads --
     ---------------------------------
  
     function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
!    --  Allocate and Initialize a new ATCB for the current Thread
  
     function Register_Foreign_Thread
       (Thread : Thread_Id) return Task_Id is separate;
*************** package body System.Task_Primitives.Oper
*** 171,177 ****
     -----------------------
  
     procedure Abort_Handler (signo : Signal);
!    --  Handler for the abort (SIGABRT) signal to handle asynchronous abortion.
  
     procedure Install_Signal_Handlers;
     --  Install the default signal handlers for the current task
--- 157,163 ----
     -----------------------
  
     procedure Abort_Handler (signo : Signal);
!    --  Handler for the abort (SIGABRT) signal to handle asynchronous abort
  
     procedure Install_Signal_Handlers;
     --  Install the default signal handlers for the current task
*************** package body System.Task_Primitives.Oper
*** 298,304 ****
  
     procedure Finalize_Lock (L : access Lock) is
        Result : int;
- 
     begin
        Result := semDelete (L.Mutex);
        pragma Assert (Result = 0);
--- 284,289 ----
*************** package body System.Task_Primitives.Oper
*** 306,312 ****
  
     procedure Finalize_Lock (L : access RTS_Lock) is
        Result : int;
- 
     begin
        Result := semDelete (L.Mutex);
        pragma Assert (Result = 0);
--- 291,296 ----
*************** package body System.Task_Primitives.Oper
*** 318,324 ****
  
     procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean) is
        Result : int;
- 
     begin
        if L.Protocol = Prio_Protect
          and then int (Self.Common.Current_Priority) > L.Prio_Ceiling
--- 302,307 ----
*************** package body System.Task_Primitives.Oper
*** 338,344 ****
        Global_Lock : Boolean := False)
     is
        Result : int;
- 
     begin
        if not Single_Lock or else Global_Lock then
           Result := semTake (L.Mutex, WAIT_FOREVER);
--- 321,326 ----
*************** package body System.Task_Primitives.Oper
*** 348,354 ****
  
     procedure Write_Lock (T : Task_Id) is
        Result : int;
- 
     begin
        if not Single_Lock then
           Result := semTake (T.Common.LL.L.Mutex, WAIT_FOREVER);
--- 330,335 ----
*************** package body System.Task_Primitives.Oper
*** 370,377 ****
     ------------
  
     procedure Unlock (L : access Lock) is
!       Result  : int;
! 
     begin
        Result := semGive (L.Mutex);
        pragma Assert (Result = 0);
--- 351,357 ----
     ------------
  
     procedure Unlock (L : access Lock) is
!       Result : int;
     begin
        Result := semGive (L.Mutex);
        pragma Assert (Result = 0);
*************** package body System.Task_Primitives.Oper
*** 379,385 ****
  
     procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is
        Result : int;
- 
     begin
        if not Single_Lock or else Global_Lock then
           Result := semGive (L.Mutex);
--- 359,364 ----
*************** package body System.Task_Primitives.Oper
*** 389,395 ****
  
     procedure Unlock (T : Task_Id) is
        Result : int;
- 
     begin
        if not Single_Lock then
           Result := semGive (T.Common.LL.L.Mutex);
--- 368,373 ----
*************** package body System.Task_Primitives.Oper
*** 409,415 ****
     begin
        pragma Assert (Self_ID = Self);
  
!       --  Release the mutex before sleeping.
        if Single_Lock then
           Result := semGive (Single_RTS_Lock.Mutex);
        else
--- 387,394 ----
     begin
        pragma Assert (Self_ID = Self);
  
!       --  Release the mutex before sleeping
! 
        if Single_Lock then
           Result := semGive (Single_RTS_Lock.Mutex);
        else
*************** package body System.Task_Primitives.Oper
*** 418,432 ****
  
        pragma Assert (Result = 0);
  
!       --  Perform a blocking operation to take the CV semaphore.
!       --  Note that a blocking operation in VxWorks will reenable
!       --  task scheduling. When we are no longer blocked and control
!       --  is returned, task scheduling will again be disabled.
  
        Result := semTake (Self_ID.Common.LL.CV, WAIT_FOREVER);
        pragma Assert (Result = 0);
  
!       --  Take the mutex back.
        if Single_Lock then
           Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
        else
--- 397,412 ----
  
        pragma Assert (Result = 0);
  
!       --  Perform a blocking operation to take the CV semaphore. Note that a
!       --  blocking operation in VxWorks will reenable task scheduling. When we
!       --  are no longer blocked and control is returned, task scheduling will
!       --  again be disabled.
  
        Result := semTake (Self_ID.Common.LL.CV, WAIT_FOREVER);
        pragma Assert (Result = 0);
  
!       --  Take the mutex back
! 
        if Single_Lock then
           Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
        else
*************** package body System.Task_Primitives.Oper
*** 440,448 ****
     -- Timed_Sleep --
     -----------------
  
!    --  This is for use within the run-time system, so abort is
!    --  assumed to be already deferred, and the caller should be
!    --  holding its own ATCB lock.
  
     procedure Timed_Sleep
       (Self_ID  : Task_Id;
--- 420,427 ----
     -- Timed_Sleep --
     -----------------
  
!    --  This is for use within the run-time system, so abort is assumed to be
!    --  already deferred, and the caller should be holding its own ATCB lock.
  
     procedure Timed_Sleep
       (Self_ID  : Task_Id;
*************** package body System.Task_Primitives.Oper
*** 467,475 ****
        if Mode = Relative then
           Absolute := Orig + Time;
  
!          --  Systematically add one since the first tick will delay
!          --  *at most* 1 / Rate_Duration seconds, so we need to add one to
!          --  be on the safe side.
  
           Ticks := To_Clock_Ticks (Time);
  
--- 446,454 ----
        if Mode = Relative then
           Absolute := Orig + Time;
  
!          --  Systematically add one since the first tick will delay *at most*
!          --  1 / Rate_Duration seconds, so we need to add one to be on the
!          --  safe side.
  
           Ticks := To_Clock_Ticks (Time);
  
*************** package body System.Task_Primitives.Oper
*** 484,490 ****
  
        if Ticks > 0 then
           loop
!             --  Release the mutex before sleeping.
              if Single_Lock then
                 Result := semGive (Single_RTS_Lock.Mutex);
              else
--- 463,470 ----
  
        if Ticks > 0 then
           loop
!             --  Release the mutex before sleeping
! 
              if Single_Lock then
                 Result := semGive (Single_RTS_Lock.Mutex);
              else
*************** package body System.Task_Primitives.Oper
*** 493,506 ****
  
              pragma Assert (Result = 0);
  
!             --  Perform a blocking operation to take the CV semaphore.
!             --  Note that a blocking operation in VxWorks will reenable
!             --  task scheduling. When we are no longer blocked and control
!             --  is returned, task scheduling will again be disabled.
  
              Result := semTake (Self_ID.Common.LL.CV, Ticks);
  
              if Result = 0 then
                 --  Somebody may have called Wakeup for us
  
                 Wakeup := True;
--- 473,487 ----
  
              pragma Assert (Result = 0);
  
!             --  Perform a blocking operation to take the CV semaphore. Note
!             --  that a blocking operation in VxWorks will reenable task
!             --  scheduling. When we are no longer blocked and control is
!             --  returned, task scheduling will again be disabled.
  
              Result := semTake (Self_ID.Common.LL.CV, Ticks);
  
              if Result = 0 then
+ 
                 --  Somebody may have called Wakeup for us
  
                 Wakeup := True;
*************** package body System.Task_Primitives.Oper
*** 508,517 ****
              else
                 if errno /= S_objLib_OBJ_TIMEOUT then
                    Wakeup := True;
                 else
!                   --  If Ticks = int'last, it was most probably truncated
!                   --  so let's make another round after recomputing Ticks
!                   --  from the the absolute time.
  
                    if Ticks /= int'Last then
                       Timedout := True;
--- 489,499 ----
              else
                 if errno /= S_objLib_OBJ_TIMEOUT then
                    Wakeup := True;
+ 
                 else
!                   --  If Ticks = int'last, it was most probably truncated so
!                   --  let's make another round after recomputing Ticks from
!                   --  the the absolute time.
  
                    if Ticks /= int'Last then
                       Timedout := True;
*************** package body System.Task_Primitives.Oper
*** 525,531 ****
                 end if;
              end if;
  
!             --  Take the mutex back.
              if Single_Lock then
                 Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
              else
--- 507,514 ----
                 end if;
              end if;
  
!             --  Take the mutex back
! 
              if Single_Lock then
                 Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
              else
*************** package body System.Task_Primitives.Oper
*** 540,546 ****
        else
           Timedout := True;
  
!          --  Should never hold a lock while yielding.
           if Single_Lock then
              Result := semGive (Single_RTS_Lock.Mutex);
              taskDelay (0);
--- 523,530 ----
        else
           Timedout := True;
  
!          --  Should never hold a lock while yielding
! 
           if Single_Lock then
              Result := semGive (Single_RTS_Lock.Mutex);
              taskDelay (0);
*************** package body System.Task_Primitives.Oper
*** 558,570 ****
     -- Timed_Delay --
     -----------------
  
!    --  This is for use in implementing delay statements, so
!    --  we assume the caller is holding no locks.
  
     procedure Timed_Delay
!      (Self_ID  : Task_Id;
!       Time     : Duration;
!       Mode     : ST.Delay_Modes)
     is
        Orig     : constant Duration := Monotonic_Clock;
        Absolute : Duration;
--- 542,554 ----
     -- Timed_Delay --
     -----------------
  
!    --  This is for use in implementing delay statements, so we assume the
!    --  caller is holding no locks.
  
     procedure Timed_Delay
!      (Self_ID : Task_Id;
!       Time    : Duration;
!       Mode    : ST.Delay_Modes)
     is
        Orig     : constant Duration := Monotonic_Clock;
        Absolute : Duration;
*************** package body System.Task_Primitives.Oper
*** 574,590 ****
        Aborted  : Boolean := False;
  
     begin
-       SSL.Abort_Defer.all;
- 
        if Mode = Relative then
           Absolute := Orig + Time;
           Ticks    := To_Clock_Ticks (Time);
  
           if Ticks > 0 and then Ticks < int'Last then
  
!             --  The first tick will delay anytime between 0 and
!             --  1 / sysClkRateGet seconds, so we need to add one to
!             --  be on the safe side.
  
              Ticks := Ticks + 1;
           end if;
--- 558,571 ----
        Aborted  : Boolean := False;
  
     begin
        if Mode = Relative then
           Absolute := Orig + Time;
           Ticks    := To_Clock_Ticks (Time);
  
           if Ticks > 0 and then Ticks < int'Last then
  
!             --  First tick will delay anytime between 0 and 1 / sysClkRateGet
!             --  seconds, so we need to add one to be on the safe side.
  
              Ticks := Ticks + 1;
           end if;
*************** package body System.Task_Primitives.Oper
*** 595,601 ****
        end if;
  
        if Ticks > 0 then
!          --  Modifying State and Pending_Priority_Change, locking the TCB.
           if Single_Lock then
              Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
           else
--- 576,584 ----
        end if;
  
        if Ticks > 0 then
! 
!          --  Modifying State and Pending_Priority_Change, locking the TCB
! 
           if Single_Lock then
              Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
           else
*************** package body System.Task_Primitives.Oper
*** 630,635 ****
--- 613,619 ----
              Result := semTake (Self_ID.Common.LL.CV, Ticks);
  
              if Result /= 0 then
+ 
                 --  If Ticks = int'last, it was most probably truncated
                 --  so let's make another round after recomputing Ticks
                 --  from the the absolute time.
*************** package body System.Task_Primitives.Oper
*** 646,652 ****
              end if;
  
              --  Take back the lock after having slept, to protect further
!             --  access to Self_ID
  
              if Single_Lock then
                 Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
--- 630,636 ----
              end if;
  
              --  Take back the lock after having slept, to protect further
!             --  access to Self_ID.
  
              if Single_Lock then
                 Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER);
*************** package body System.Task_Primitives.Oper
*** 670,677 ****
        else
           taskDelay (0);
        end if;
- 
-       SSL.Abort_Undefer.all;
     end Timed_Delay;
  
     ---------------------
--- 654,659 ----
*************** package body System.Task_Primitives.Oper
*** 746,754 ****
            (T.Common.LL.Thread, To_VxWorks_Priority (int (Prio)));
        pragma Assert (Result = 0);
  
!       if FIFO_Within_Priorities then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
           --    If the task drops its priority due to the loss of inherited
           --    priority, it is added at the head of the ready queue for its
           --    new active priority.
--- 728,737 ----
            (T.Common.LL.Thread, To_VxWorks_Priority (int (Prio)));
        pragma Assert (Result = 0);
  
!       if Dispatching_Policy = 'F' then
  
           --  Annex D requirement [RM D.2.2 par. 9]:
+ 
           --    If the task drops its priority due to the loss of inherited
           --    priority, it is added at the head of the ready queue for its
           --    new active priority.
*************** package body System.Task_Primitives.Oper
*** 794,800 ****
     procedure Enter_Task (Self_ID : Task_Id) is
        procedure Init_Float;
        pragma Import (C, Init_Float, "__gnat_init_float");
!       --  Properly initializes the FPU for PPC/MIPS systems.
  
     begin
        Self_ID.Common.LL.Thread := taskIdSelf;
--- 777,783 ----
     procedure Enter_Task (Self_ID : Task_Id) is
        procedure Init_Float;
        pragma Import (C, Init_Float, "__gnat_init_float");
!       --  Properly initializes the FPU for PPC/MIPS systems
  
     begin
        Self_ID.Common.LL.Thread := taskIdSelf;
*************** package body System.Task_Primitives.Oper
*** 802,808 ****
  
        Init_Float;
  
!       --  Install the signal handlers.
        --  This is called for each task since there is no signal inheritance
        --  between VxWorks tasks.
  
--- 785,792 ----
  
        Init_Float;
  
!       --  Install the signal handlers
! 
        --  This is called for each task since there is no signal inheritance
        --  between VxWorks tasks.
  
*************** package body System.Task_Primitives.Oper
*** 892,919 ****
           Adjusted_Stack_Size := size_t (Stack_Size);
        end if;
  
!       --  Ask for 4 extra bytes of stack space so that the ATCB
!       --  pointer can be stored below the stack limit, plus extra
!       --  space for the frame of Task_Wrapper.  This is so the user
!       --  gets the amount of stack requested exclusive of the needs
!       --  of the runtime.
!       --
!       --  We also have to allocate n more bytes for the task name
!       --  storage and enough space for the Wind Task Control Block
!       --  which is around 0x778 bytes.  VxWorks also seems to carve out
!       --  additional space, so use 2048 as a nice round number.
!       --  We might want to increment to the nearest page size in
!       --  case we ever support VxVMI.
!       --
!       --  XXX - we should come back and visit this so we can
!       --        set the task name to something appropriate.
  
        Adjusted_Stack_Size := Adjusted_Stack_Size + 2048;
  
        --  Since the initial signal mask of a thread is inherited from the
!       --  creator, and the Environment task has all its signals masked, we
!       --  do not need to manipulate caller's signal mask at this point.
!       --  All tasks in RTS will have All_Tasks_Mask initially.
  
        if T.Common.Task_Image_Len = 0 then
           T.Common.LL.Thread := taskSpawn
--- 876,901 ----
           Adjusted_Stack_Size := size_t (Stack_Size);
        end if;
  
!       --  Ask for four extra bytes of stack space so that the ATCB pointer can
!       --  be stored below the stack limit, plus extra space for the frame of
!       --  Task_Wrapper. This is so the user gets the amount of stack requested
!       --  exclusive of the needs.
! 
!       --  We also have to allocate n more bytes for the task name storage and
!       --  enough space for the Wind Task Control Block which is around 0x778
!       --  bytes. VxWorks also seems to carve out additional space, so use 2048
!       --  as a nice round number. We might want to increment to the nearest
!       --  page size in case we ever support VxVMI.
! 
!       --  ??? - we should come back and visit this so we can set the task name
!       --        to something appropriate.
  
        Adjusted_Stack_Size := Adjusted_Stack_Size + 2048;
  
        --  Since the initial signal mask of a thread is inherited from the
!       --  creator, and the Environment task has all its signals masked, we do
!       --  not need to manipulate caller's signal mask at this point. All tasks
!       --  in RTS will have All_Tasks_Mask initially.
  
        if T.Common.Task_Image_Len = 0 then
           T.Common.LL.Thread := taskSpawn
*************** package body System.Task_Primitives.Oper
*** 926,931 ****
--- 908,914 ----
        else
           declare
              Name : aliased String (1 .. T.Common.Task_Image_Len + 1);
+ 
           begin
              Name (1 .. Name'Last - 1) :=
                T.Common.Task_Image (1 .. T.Common.Task_Image_Len);
*************** package body System.Task_Primitives.Oper
*** 981,988 ****
        Free (Tmp);
  
        if Is_Self then
!          Result := taskVarDelete (taskIdSelf, ATCB_Key'Access);
!          pragma Assert (Result /= ERROR);
        end if;
     end Finalize_TCB;
  
--- 964,970 ----
        Free (Tmp);
  
        if Is_Self then
!          Specific.Delete;
        end if;
     end Finalize_TCB;
  
*************** package body System.Task_Primitives.Oper
*** 1001,1014 ****
  
     procedure Abort_Task (T : Task_Id) is
        Result : int;
- 
     begin
        Result := kill (T.Common.LL.Thread,
!         Signal (Interrupt_Management.Abort_Task_Signal));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
     -- Check_Exit --
     ----------------
  
--- 983,1137 ----
  
     procedure Abort_Task (T : Task_Id) is
        Result : int;
     begin
        Result := kill (T.Common.LL.Thread,
!                       Signal (Interrupt_Management.Abort_Task_Signal));
        pragma Assert (Result = 0);
     end Abort_Task;
  
     ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize (S : in out Suspension_Object) is
+    begin
+       --  Initialize internal state. It is always initialized to False (ARM
+       --  D.10 par. 6).
+ 
+       S.State := False;
+       S.Waiting := False;
+ 
+       --  Initialize internal mutex
+ 
+       --  Use simpler binary semaphore instead of VxWorks
+       --  mutual exclusion semaphore, because we don't need
+       --  the fancier semantics and their overhead.
+ 
+       S.L := semBCreate (SEM_Q_FIFO, SEM_FULL);
+ 
+       --  Initialize internal condition variable
+ 
+       S.CV := semBCreate (SEM_Q_FIFO, SEM_EMPTY);
+    end Initialize;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize (S : in out Suspension_Object) is
+       Result : STATUS;
+    begin
+       --  Destroy internal mutex
+ 
+       Result := semDelete (S.L);
+       pragma Assert (Result = OK);
+ 
+       --  Destroy internal condition variable
+ 
+       Result := semDelete (S.CV);
+       pragma Assert (Result = OK);
+    end Finalize;
+ 
+    -------------------
+    -- Current_State --
+    -------------------
+ 
+    function Current_State (S : Suspension_Object) return Boolean is
+    begin
+       --  We do not want to use lock on this read operation. State is marked
+       --  as Atomic so that we ensure that the value retrieved is correct.
+ 
+       return S.State;
+    end Current_State;
+ 
+    ---------------
+    -- Set_False --
+    ---------------
+ 
+    procedure Set_False (S : in out Suspension_Object) is
+       Result  : STATUS;
+    begin
+       Result := semTake (S.L, WAIT_FOREVER);
+       pragma Assert (Result = OK);
+ 
+       S.State := False;
+ 
+       Result := semGive (S.L);
+       pragma Assert (Result = OK);
+    end Set_False;
+ 
+    --------------
+    -- Set_True --
+    --------------
+ 
+    procedure Set_True (S : in out Suspension_Object) is
+       Result : STATUS;
+    begin
+       Result := semTake (S.L, WAIT_FOREVER);
+       pragma Assert (Result = OK);
+ 
+       --  If there is already a task waiting on this suspension object then
+       --  we resume it, leaving the state of the suspension object to False,
+       --  as it is specified in ARM D.10 par. 9. Otherwise, it just leaves
+       --  the state to True.
+ 
+       if S.Waiting then
+          S.Waiting := False;
+          S.State := False;
+ 
+          Result := semGive (S.CV);
+          pragma Assert (Result = OK);
+       else
+          S.State := True;
+       end if;
+ 
+       Result := semGive (S.L);
+       pragma Assert (Result = OK);
+    end Set_True;
+ 
+    ------------------------
+    -- Suspend_Until_True --
+    ------------------------
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object) is
+       Result : STATUS;
+    begin
+       Result := semTake (S.L, WAIT_FOREVER);
+ 
+       if S.Waiting then
+          --  Program_Error must be raised upon calling Suspend_Until_True
+          --  if another task is already waiting on that suspension object
+          --  (ARM D.10 par. 10).
+ 
+          Result := semGive (S.L);
+          pragma Assert (Result = OK);
+ 
+          raise Program_Error;
+       else
+          --  Suspend the task if the state is False. Otherwise, the task
+          --  continues its execution, and the state of the suspension object
+          --  is set to False (ARM D.10 par. 9).
+ 
+          if S.State then
+             S.State := False;
+ 
+             Result := semGive (S.L);
+             pragma Assert (Result = 0);
+          else
+             S.Waiting := True;
+ 
+             --  Release the mutex before sleeping
+ 
+             Result := semGive (S.L);
+             pragma Assert (Result = OK);
+ 
+             Result := semTake (S.CV, WAIT_FOREVER);
+             pragma Assert (Result = 0);
+          end if;
+       end if;
+    end Suspend_Until_True;
+ 
+    ----------------
     -- Check_Exit --
     ----------------
  
*************** package body System.Task_Primitives.Oper
*** 1099,1106 ****
  
     procedure Initialize (Environment_Task : Task_Id) is
        Result : int;
- 
     begin
        if Locking_Policy = 'C' then
           Mutex_Protocol := Prio_Protect;
        elsif Locking_Policy = 'I' then
--- 1222,1233 ----
  
     procedure Initialize (Environment_Task : Task_Id) is
        Result : int;
     begin
+       Environment_Task_Id := Environment_Task;
+ 
+       Interrupt_Management.Initialize;
+       Specific.Initialize;
+ 
        if Locking_Policy = 'C' then
           Mutex_Protocol := Prio_Protect;
        elsif Locking_Policy = 'I' then
*************** package body System.Task_Primitives.Oper
*** 1110,1116 ****
        end if;
  
        if Time_Slice_Val > 0 then
!          Result := kernelTimeSlice
             (To_Clock_Ticks
               (Duration (Time_Slice_Val) / Duration (1_000_000.0)));
        end if;
--- 1237,1243 ----
        end if;
  
        if Time_Slice_Val > 0 then
!          Result := Set_Time_Slice
             (To_Clock_Ticks
               (Duration (Time_Slice_Val) / Duration (1_000_000.0)));
        end if;
*************** package body System.Task_Primitives.Oper
*** 1125,1133 ****
           end if;
        end loop;
  
!       Environment_Task_Id := Environment_Task;
! 
!       --  Initialize the lock used to synchronize chain of all ATCBs.
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
--- 1252,1258 ----
           end if;
        end loop;
  
!       --  Initialize the lock used to synchronize chain of all ATCBs
  
        Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taprop.ads gcc-4.1.0/gcc/ada/s-taprop.ads
*** gcc-4.0.2/gcc/ada/s-taprop.ads	Thu Feb 10 13:57:23 2005
--- gcc-4.1.0/gcc/ada/s-taprop.ads	Mon Sep  5 07:46:06 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.OS_Interface;
*** 44,51 ****
  --  used for Thread_Id
  
  package System.Task_Primitives.Operations is
  
-    pragma Elaborate_Body;
     package ST renames System.Tasking;
     package OSI renames System.OS_Interface;
  
--- 44,51 ----
  --  used for Thread_Id
  
  package System.Task_Primitives.Operations is
+    pragma Preelaborate;
  
     package ST renames System.Tasking;
     package OSI renames System.OS_Interface;
  
*************** package System.Task_Primitives.Operation
*** 82,104 ****
  
     procedure Enter_Task (Self_ID : ST.Task_Id);
     pragma Inline (Enter_Task);
!    --  Initialize data structures specific to the calling task.
!    --  Self must be the ID of the calling task.
!    --  It must be called (once) by the task immediately after creation,
!    --  while abortion is still deferred.
!    --  The effects of other operations defined below are not defined
!    --  unless the caller has previously called Initialize_Task.
  
     procedure Exit_Task;
     pragma Inline (Exit_Task);
!    --  Destroy the thread of control.
!    --  Self must be the ID of the calling task.
!    --  The effects of further calls to operations defined below
!    --  on the task are undefined thereafter.
  
     function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id;
     pragma Inline (New_ATCB);
!    --  Allocate a new ATCB with the specified number of entries.
  
     procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean);
     pragma Inline (Initialize_TCB);
--- 82,102 ----
  
     procedure Enter_Task (Self_ID : ST.Task_Id);
     pragma Inline (Enter_Task);
!    --  Initialize data structures specific to the calling task. Self must be
!    --  the ID of the calling task. It must be called (once) by the task
!    --  immediately after creation, while abort is still deferred. The effects
!    --  of other operations defined below are not defined unless the caller has
!    --  previously called Initialize_Task.
  
     procedure Exit_Task;
     pragma Inline (Exit_Task);
!    --  Destroy the thread of control. Self must be the ID of the calling task.
!    --  The effects of further calls to operations defined below on the task
!    --  are undefined thereafter.
  
     function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id;
     pragma Inline (New_ATCB);
!    --  Allocate a new ATCB with the specified number of entries
  
     procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean);
     pragma Inline (Initialize_TCB);
*************** package System.Task_Primitives.Operation
*** 106,124 ****
  
     procedure Finalize_TCB (T : ST.Task_Id);
     pragma Inline (Finalize_TCB);
!    --  Finalizes Private_Data of ATCB, and then deallocates it.
!    --  This is also responsible for recovering any storage or other resources
!    --  that were allocated by Create_Task (the one in this package).
!    --  This should only be called from Free_Task.
!    --  After it is called there should be no further
     --  reference to the ATCB that corresponds to T.
  
     procedure Abort_Task (T : ST.Task_Id);
     pragma Inline (Abort_Task);
!    --  Abort the task specified by T (the target task). This causes
!    --  the target task to asynchronously raise Abort_Signal if
!    --  abort is not deferred, or if it is blocked on an interruptible
!    --  system call.
     --
     --  precondition:
     --    the calling task is holding T's lock and has abort deferred
--- 104,120 ----
  
     procedure Finalize_TCB (T : ST.Task_Id);
     pragma Inline (Finalize_TCB);
!    --  Finalizes Private_Data of ATCB, and then deallocates it. This is also
!    --  responsible for recovering any storage or other resources that were
!    --  allocated by Create_Task (the one in this package). This should only be
!    --  called from Free_Task. After it is called there should be no further
     --  reference to the ATCB that corresponds to T.
  
     procedure Abort_Task (T : ST.Task_Id);
     pragma Inline (Abort_Task);
!    --  Abort the task specified by T (the target task). This causes the target
!    --  task to asynchronously raise Abort_Signal if abort is not deferred, or
!    --  if it is blocked on an interruptible system call.
     --
     --  precondition:
     --    the calling task is holding T's lock and has abort deferred
*************** package System.Task_Primitives.Operation
*** 130,136 ****
  
     function Self return ST.Task_Id;
     pragma Inline (Self);
!    --  Return a pointer to the Ada Task Control Block of the calling task.
  
     type Lock_Level is
       (PO_Level,
--- 126,132 ----
  
     function Self return ST.Task_Id;
     pragma Inline (Self);
!    --  Return a pointer to the Ada Task Control Block of the calling task
  
     type Lock_Level is
       (PO_Level,
*************** package System.Task_Primitives.Operation
*** 138,164 ****
        RTS_Lock_Level,
        ATCB_Level);
     --  Type used to describe kind of lock for second form of Initialize_Lock
!    --  call specified below.
!    --  See locking rules in System.Tasking (spec) for more details.
  
     procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
     procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
     pragma Inline (Initialize_Lock);
     --  Initialize a lock object.
     --
!    --  For Lock, Prio is the ceiling priority associated with the lock.
!    --  For RTS_Lock, the ceiling is implicitly Priority'Last.
     --
     --  If the underlying system does not support priority ceiling
     --  locking, the Prio parameter is ignored.
     --
!    --  The effect of either initialize operation is undefined unless L
!    --  is a lock object that has not been initialized, or which has been
!    --  finalized since it was last initialized.
     --
!    --  The effects of the other operations on lock objects
!    --  are undefined unless the lock object has been initialized
!    --  and has not since been finalized.
     --
     --  Initialization of the per-task lock is implicit in Create_Task.
     --
--- 134,160 ----
        RTS_Lock_Level,
        ATCB_Level);
     --  Type used to describe kind of lock for second form of Initialize_Lock
!    --  call specified below. See locking rules in System.Tasking (spec) for
!    --  more details.
  
     procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
     procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
     pragma Inline (Initialize_Lock);
     --  Initialize a lock object.
     --
!    --  For Lock, Prio is the ceiling priority associated with the lock. For
!    --  RTS_Lock, the ceiling is implicitly Priority'Last.
     --
     --  If the underlying system does not support priority ceiling
     --  locking, the Prio parameter is ignored.
     --
!    --  The effect of either initialize operation is undefined unless is a lock
!    --  object that has not been initialized, or which has been finalized since
!    --  it was last initialized.
     --
!    --  The effects of the other operations on lock objects are undefined
!    --  unless the lock object has been initialized and has not since been
!    --  finalized.
     --
     --  Initialization of the per-task lock is implicit in Create_Task.
     --
*************** package System.Task_Primitives.Operation
*** 230,318 ****
     --  read or write permission. (That is, matching pairs of Lock and Unlock
     --  operations on each lock object must be properly nested.)
  
!    --  For the operation on RTS_Lock, Global_Lock should be set to True
!    --  if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
     --
     --  Note that Write_Lock for RTS_Lock does not have an out-parameter.
!    --  RTS_Locks are used in situations where we have not made provision
!    --  for recovery from ceiling violations. We do not expect them to
!    --  occur inside the runtime system, because all RTS locks have ceiling
!    --  Priority'Last.
  
!    --  There is one way there can be a ceiling violation.
!    --  That is if the runtime system is called from a task that is
!    --  executing in the Interrupt_Priority range.
  
!    --  It is not clear what to do about ceiling violations due
!    --  to RTS calls done at interrupt priority. In general, it
!    --  is not acceptable to give all RTS locks interrupt priority,
!    --  since that whould give terrible performance on systems where
!    --  this has the effect of masking hardware interrupts, though we
!    --  could get away with allowing Interrupt_Priority'last where we
!    --  are layered on an OS that does not allow us to mask interrupts.
!    --  Ideally, we would like to raise Program_Error back at the
!    --  original point of the RTS call, but this would require a lot of
!    --  detailed analysis and recoding, with almost certain performance
!    --  penalties.
  
!    --  For POSIX systems, we considered just skipping setting a
!    --  priority ceiling on RTS locks. This would mean there is no
!    --  ceiling violation, but we would end up with priority inversions
!    --  inside the runtime system, resulting in failure to satisfy the
!    --  Ada priority rules, and possible missed validation tests.
!    --  This could be compensated-for by explicit priority-change calls
!    --  to raise the caller to Priority'Last whenever it first enters
!    --  the runtime system, but the expected overhead seems high, though
!    --  it might be lower than using locks with ceilings if the underlying
!    --  implementation of ceiling locks is an inefficient one.
  
!    --  This issue should be reconsidered whenever we get around to
!    --  checking for calls to potentially blocking operations from
!    --  within protected operations. If we check for such calls and
!    --  catch them on entry to the OS, it may be that we can eliminate
!    --  the possibility of ceiling violations inside the RTS. For this
!    --  to work, we would have to forbid explicitly setting the priority
!    --  of a task to anything in the Interrupt_Priority range, at least.
!    --  We would also have to check that there are no RTS-lock operations
!    --  done inside any operations that are not treated as potentially
!    --  blocking.
  
!    --  The latter approach seems to be the best, i.e. to check on entry
!    --  to RTS calls that may need to use locks that the priority is not
!    --  in the interrupt range. If there are RTS operations that NEED to
!    --  be called from interrupt handlers, those few RTS locks should then
!    --  be converted to PO-type locks, with ceiling Interrupt_Priority'Last.
  
!    --  For now, we will just shut down the system if there is a
!    --  ceiling violation.
  
     procedure Yield (Do_Yield : Boolean := True);
     pragma Inline (Yield);
!    --  Yield the processor. Add the calling task to the tail of the
!    --  ready queue for its active_priority.
!    --  The Do_Yield argument is only used in some very rare cases very
!    --  a yield should have an effect on a specific target and not on regular
!    --  ones.
  
     procedure Set_Priority
       (T : ST.Task_Id;
        Prio : System.Any_Priority;
        Loss_Of_Inheritance : Boolean := False);
     pragma Inline (Set_Priority);
!    --  Set the priority of the task specified by T to T.Current_Priority.
!    --  The priority set is what would correspond to the Ada concept of
!    --  "base priority" in the terms of the lower layer system, but
!    --  the operation may be used by the upper layer to implement
!    --  changes in "active priority" that are not due to lock effects.
!    --  The effect should be consistent with the Ada Reference Manual.
!    --  In particular, when a task lowers its priority due to the loss of
!    --  inherited priority, it goes at the head of the queue for its new
!    --  priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying
!    --  implementation to do it right when the OS doesn't.
  
     function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
     pragma Inline (Get_Priority);
!    --  Returns the priority last set by Set_Priority for this task.
  
     function Monotonic_Clock return Duration;
     pragma Inline (Monotonic_Clock);
--- 226,307 ----
     --  read or write permission. (That is, matching pairs of Lock and Unlock
     --  operations on each lock object must be properly nested.)
  
!    --  For the operation on RTS_Lock, Global_Lock should be set to True if L
!    --  is a global lock (Single_RTS_Lock, Global_Task_Lock).
     --
     --  Note that Write_Lock for RTS_Lock does not have an out-parameter.
!    --  RTS_Locks are used in situations where we have not made provision for
!    --  recovery from ceiling violations. We do not expect them to occur inside
!    --  the runtime system, because all RTS locks have ceiling Priority'Last.
  
!    --  There is one way there can be a ceiling violation. That is if the
!    --  runtime system is called from a task that is executing in the
!    --  Interrupt_Priority range.
  
!    --  It is not clear what to do about ceiling violations due to RTS calls
!    --  done at interrupt priority. In general, it is not acceptable to give
!    --  all RTS locks interrupt priority, since that whould give terrible
!    --  performance on systems where this has the effect of masking hardware
!    --  interrupts, though we could get away with allowing
!    --  Interrupt_Priority'last where we are layered on an OS that does not
!    --  allow us to mask interrupts. Ideally, we would like to raise
!    --  Program_Error back at the original point of the RTS call, but this
!    --  would require a lot of detailed analysis and recoding, with almost
!    --  certain performance penalties.
  
!    --  For POSIX systems, we considered just skipping setting priority ceiling
!    --  on RTS locks. This would mean there is no ceiling violation, but we
!    --  would end up with priority inversions inside the runtime system,
!    --  resulting in failure to satisfy the Ada priority rules, and possible
!    --  missed validation tests. This could be compensated-for by explicit
!    --  priority-change calls to raise the caller to Priority'Last whenever it
!    --  first enters the runtime system, but the expected overhead seems high,
!    --  though it might be lower than using locks with ceilings if the
!    --  underlying implementation of ceiling locks is an inefficient one.
  
!    --  This issue should be reconsidered whenever we get around to checking
!    --  for calls to potentially blocking operations from within protected
!    --  operations. If we check for such calls and catch them on entry to the
!    --  OS, it may be that we can eliminate the possibility of ceiling
!    --  violations inside the RTS. For this to work, we would have to forbid
!    --  explicitly setting the priority of a task to anything in the
!    --  Interrupt_Priority range, at least. We would also have to check that
!    --  there are no RTS-lock operations done inside any operations that are
!    --  not treated as potentially blocking.
  
!    --  The latter approach seems to be the best, i.e. to check on entry to RTS
!    --  calls that may need to use locks that the priority is not in the
!    --  interrupt range. If there are RTS operations that NEED to be called
!    --  from interrupt handlers, those few RTS locks should then be converted
!    --  to PO-type locks, with ceiling Interrupt_Priority'Last.
  
!    --  For now, we will just shut down the system if there is ceiling violation
  
     procedure Yield (Do_Yield : Boolean := True);
     pragma Inline (Yield);
!    --  Yield the processor. Add the calling task to the tail of the ready
!    --  queue for its active_priority. The Do_Yield argument is only used in
!    --  some very rare cases very a yield should have an effect on a specific
!    --  target and not on regular ones.
  
     procedure Set_Priority
       (T : ST.Task_Id;
        Prio : System.Any_Priority;
        Loss_Of_Inheritance : Boolean := False);
     pragma Inline (Set_Priority);
!    --  Set the priority of the task specified by T to T.Current_Priority. The
!    --  priority set is what would correspond to the Ada concept of "base
!    --  priority" in the terms of the lower layer system, but the operation may
!    --  be used by the upper layer to implement changes in "active priority"
!    --  that are not due to lock effects. The effect should be consistent with
!    --  the Ada Reference Manual. In particular, when a task lowers its
!    --  priority due to the loss of inherited priority, it goes at the head of
!    --  the queue for its new priority (RM D.2.2 par 9). Loss_Of_Inheritance
!    --  helps the underlying implementation to do it right when the OS doesn't.
  
     function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
     pragma Inline (Get_Priority);
!    --  Returns the priority last set by Set_Priority for this task
  
     function Monotonic_Clock return Duration;
     pragma Inline (Monotonic_Clock);
*************** package System.Task_Primitives.Operation
*** 343,359 ****
     --    and has abort deferred
     --
     --  postcondition:
!    --    The calling task is holding its own ATCB lock
!    --    and has abort deferred.
  
     --  The effect is to atomically unlock T's lock and wait, so that another
     --  task that is able to lock T's lock can be assured that the wait has
     --  actually commenced, and that a Wakeup operation will cause the waiting
!    --  task to become ready for execution once again. When Sleep returns,
!    --  the waiting task will again hold its own ATCB lock. The waiting task
!    --  may become ready for execution at any time (that is, spurious wakeups
!    --  are permitted), but it will definitely become ready for execution when
!    --  a Wakeup operation is performed for the same task.
  
     procedure Timed_Sleep
       (Self_ID  : ST.Task_Id;
--- 332,347 ----
     --    and has abort deferred
     --
     --  postcondition:
!    --    The calling task is holding its own ATCB lock and has abort deferred.
  
     --  The effect is to atomically unlock T's lock and wait, so that another
     --  task that is able to lock T's lock can be assured that the wait has
     --  actually commenced, and that a Wakeup operation will cause the waiting
!    --  task to become ready for execution once again. When Sleep returns, the
!    --  waiting task will again hold its own ATCB lock. The waiting task may
!    --  become ready for execution at any time (that is, spurious wakeups are
!    --  permitted), but it will definitely become ready for execution when a
!    --  Wakeup operation is performed for the same task.
  
     procedure Timed_Sleep
       (Self_ID  : ST.Task_Id;
*************** package System.Task_Primitives.Operation
*** 368,375 ****
       (Self_ID : ST.Task_Id;
        Time    : Duration;
        Mode    : ST.Delay_Modes);
!    --  Implement the semantics of the delay statement. It is assumed that
!    --  the caller is not abort-deferred and does not hold any locks.
  
     procedure Wakeup
       (T      : ST.Task_Id;
--- 356,363 ----
       (Self_ID : ST.Task_Id;
        Time    : Duration;
        Mode    : ST.Delay_Modes);
!    --  Implement the semantics of the delay statement.
!    --  The caller should be abort-deferred and should not hold any locks.
  
     procedure Wakeup
       (T      : ST.Task_Id;
*************** package System.Task_Primitives.Operation
*** 399,419 ****
     -- RTS Entrance/Exit --
     -----------------------
  
!    --  Following two routines are used for possible operations needed
!    --  to be setup/cleared upon entrance/exit of RTS while maintaining
!    --  a single thread of control in the RTS. Since we intend these
!    --  routines to be used for implementing the Single_Lock RTS,
!    --  Lock_RTS should follow the first Defer_Abortion operation
!    --  entering RTS. In the same fashion Unlock_RTS should preceed
!    --  the last Undefer_Abortion exiting RTS.
     --
     --  These routines also replace the functions Lock/Unlock_All_Tasks_List
  
     procedure Lock_RTS;
!    --  Take the global RTS lock.
  
     procedure Unlock_RTS;
!    --  Release the global RTS lock.
  
     --------------------
     -- Stack Checking --
--- 387,406 ----
     -- RTS Entrance/Exit --
     -----------------------
  
!    --  Following two routines are used for possible operations needed to be
!    --  setup/cleared upon entrance/exit of RTS while maintaining a single
!    --  thread of control in the RTS. Since we intend these routines to be used
!    --  for implementing the Single_Lock RTS, Lock_RTS should follow the first
!    --  Defer_Abortion operation entering RTS. In the same fashion Unlock_RTS
!    --  should preceed the last Undefer_Abortion exiting RTS.
     --
     --  These routines also replace the functions Lock/Unlock_All_Tasks_List
  
     procedure Lock_RTS;
!    --  Take the global RTS lock
  
     procedure Unlock_RTS;
!    --  Release the global RTS lock
  
     --------------------
     -- Stack Checking --
*************** package System.Task_Primitives.Operation
*** 424,453 ****
     --  an insufficient amount of stack space remains in the current task.
  
     --  The exact mechanism for a stack probe is target dependent. Typical
!    --  possibilities are to use a load from a non-existent page, a store
!    --  to a read-only page, or a comparison with some stack limit constant.
!    --  Where possible we prefer to use a trap on a bad page access, since
!    --  this has less overhead. The generation of stack probes is either
!    --  automatic if the ABI requires it (as on for example DEC Unix), or
!    --  is controlled by the gcc parameter -fstack-check.
  
!    --  When we are using bad-page accesses, we need a bad page, called a
!    --  guard page, at the end of each task stack. On some systems, this
!    --  is provided automatically, but on other systems, we need to create
!    --  the guard page ourselves, and the procedure Stack_Guard is provided
!    --  for this purpose.
  
     procedure Stack_Guard (T : ST.Task_Id; On : Boolean);
     --  Ensure guard page is set if one is needed and the underlying thread
     --  system does not provide it. The procedure is as follows:
     --
     --    1. When we create a task adjust its size so a guard page can
!    --       safely be set at the bottom of the stack
     --
     --    2. When the thread is created (and its stack allocated by the
     --       underlying thread system), get the stack base (and size, depending
!    --       how the stack is growing), and create the guard page taking care of
!    --       page boundaries issues.
     --
     --    3. When the task is destroyed, remove the guard page.
     --
--- 411,439 ----
     --  an insufficient amount of stack space remains in the current task.
  
     --  The exact mechanism for a stack probe is target dependent. Typical
!    --  possibilities are to use a load from a non-existent page, a store to a
!    --  read-only page, or a comparison with some stack limit constant. Where
!    --  possible we prefer to use a trap on a bad page access, since this has
!    --  less overhead. The generation of stack probes is either automatic if
!    --  the ABI requires it (as on for example DEC Unix), or is controlled by
!    --  the gcc parameter -fstack-check.
  
!    --  When we are using bad-page accesses, we need a bad page, called guard
!    --  page, at the end of each task stack. On some systems, this is provided
!    --  automatically, but on other systems, we need to create the guard page
!    --  ourselves, and the procedure Stack_Guard is provided for this purpose.
  
     procedure Stack_Guard (T : ST.Task_Id; On : Boolean);
     --  Ensure guard page is set if one is needed and the underlying thread
     --  system does not provide it. The procedure is as follows:
     --
     --    1. When we create a task adjust its size so a guard page can
!    --       safely be set at the bottom of the stack.
     --
     --    2. When the thread is created (and its stack allocated by the
     --       underlying thread system), get the stack base (and size, depending
!    --       how the stack is growing), and create the guard page taking care
!    --       of page boundaries issues.
     --
     --    3. When the task is destroyed, remove the guard page.
     --
*************** package System.Task_Primitives.Operation
*** 458,463 ****
--- 444,481 ----
     --  The call to Stack_Guard has no effect if guard pages are not used on
     --  the target, or if guard pages are automatically provided by the system.
  
+    ------------------------
+    -- Suspension objects --
+    ------------------------
+ 
+    --  These subprograms provide the functionality required for synchronizing
+    --  on a suspension object. Tasks can suspend execution and relinquish the
+    --  processors until the condition is signaled.
+ 
+    function Current_State (S : Suspension_Object) return Boolean;
+    --  Return the state of the suspension object
+ 
+    procedure Set_False (S : in out Suspension_Object);
+    --  Set the state of the suspension object to False
+ 
+    procedure Set_True (S : in out Suspension_Object);
+    --  Set the state of the suspension object to True. If a task were
+    --  suspended on the protected object then this task is released (and
+    --  the state of the suspension object remains set to False).
+ 
+    procedure Suspend_Until_True (S : in out Suspension_Object);
+    --  If the state of the suspension object is True then the calling task
+    --  continues its execution, and the state is set to False. If the state
+    --  of the object is False then the task is suspended on the suspension
+    --  object until a Set_True operation is executed. Program_Error is raised
+    --  if another task is already waiting on that suspension object.
+ 
+    procedure Initialize (S : in out Suspension_Object);
+    --  Initialize the suspension object
+ 
+    procedure Finalize (S : in out Suspension_Object);
+    --  Finalize the suspension object
+ 
     -----------------------------------------
     -- Runtime System Debugging Interfaces --
     -----------------------------------------
*************** package System.Task_Primitives.Operation
*** 467,477 ****
  
     function Check_Exit (Self_ID : ST.Task_Id) return Boolean;
     pragma Inline (Check_Exit);
!    --  Check that the current task is holding only Global_Task_Lock.
  
     function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean;
     pragma Inline (Check_No_Locks);
!    --  Check that current task is holding no locks.
  
     function Suspend_Task
       (T           : ST.Task_Id;
--- 485,495 ----
  
     function Check_Exit (Self_ID : ST.Task_Id) return Boolean;
     pragma Inline (Check_Exit);
!    --  Check that the current task is holding only Global_Task_Lock
  
     function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean;
     pragma Inline (Check_No_Locks);
!    --  Check that current task is holding no locks
  
     function Suspend_Task
       (T           : ST.Task_Id;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tarest.adb gcc-4.1.0/gcc/ada/s-tarest.adb
*** gcc-4.0.2/gcc/ada/s-tarest.adb	Mon Oct  4 14:51:17 2004
--- gcc-4.1.0/gcc/ada/s-tarest.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1999-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1999-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking.Restricted.S
*** 505,510 ****
--- 505,512 ----
  
     procedure Init_RTS is
     begin
+       Tasking.Initialize;
+ 
        --  Initialize lock used to implement mutual exclusion between all tasks
  
        STPO.Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tarest.ads gcc-4.1.0/gcc/ada/s-tarest.ads
*** gcc-4.0.2/gcc/ada/s-tarest.ads	Mon Oct  4 14:51:17 2004
--- gcc-4.1.0/gcc/ada/s-tarest.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --     S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasdeb.adb gcc-4.1.0/gcc/ada/s-tasdeb.adb
*** gcc-4.0.2/gcc/ada/s-tasdeb.adb	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-tasdeb.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                  S Y S T E M . T A S K I N G . D E B U G                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                  S Y S T E M . T A S K I N G . D E B U G                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasdeb.ads gcc-4.1.0/gcc/ada/s-tasdeb.ads
*** gcc-4.0.2/gcc/ada/s-tasdeb.ads	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-tasdeb.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                  S Y S T E M . T A S K I N G . D E B U G                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1997-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                  S Y S T E M . T A S K I N G . D E B U G                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1997-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Tasking;
*** 38,43 ****
--- 38,44 ----
  with System.OS_Interface;
  
  package System.Tasking.Debug is
+    pragma Preelaborate;
  
     ------------------------------------------
     -- Application-level debugging routines --
*************** package System.Tasking.Debug is
*** 66,72 ****
     -- General GDB support --
     -------------------------
  
!    Known_Tasks : array (0 .. 999) of Task_Id;
     --  Global array of tasks read by gdb, and updated by
     --  Create_Task and Finalize_TCB
  
--- 67,73 ----
     -- General GDB support --
     -------------------------
  
!    Known_Tasks : array (0 .. 999) of Task_Id := (others => null);
     --  Global array of tasks read by gdb, and updated by
     --  Create_Task and Finalize_TCB
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-irix-athread.adb gcc-4.1.0/gcc/ada/s-tasinf-irix-athread.adb
*** gcc-4.0.2/gcc/ada/s-tasinf-irix-athread.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-irix-athread.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-irix-athread.ads gcc-4.1.0/gcc/ada/s-tasinf-irix-athread.ads
*** gcc-4.0.2/gcc/ada/s-tasinf-irix-athread.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-irix-athread.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,51 ****
  --  This unit may be used directly from an application program by providing
  --  an appropriate WITH, and the interface can be expected to remain stable.
  
! --  This is the SGI (libathread) specific version of this module.
  
  with System.OS_Interface;
  
  package System.Task_Info is
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
--- 41,52 ----
  --  This unit may be used directly from an application program by providing
  --  an appropriate WITH, and the interface can be expected to remain stable.
  
! --  This is the SGI (libathread) specific version of this module
  
  with System.OS_Interface;
  
  package System.Task_Info is
+    pragma Preelaborate;
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
*************** package System.Task_Info is
*** 147,153 ****
     ANY_CPU : constant CPU_Number := CPU_Number'First;
  
     type Non_Degrading_Priority is range 0 .. 255;
!    --  Specification of IRIX Non Degrading Priorities.
     --
     --  WARNING: IRIX priorities have the reverse meaning of Ada priorities.
     --           The lower the priority value, the greater the greater the
--- 148,154 ----
     ANY_CPU : constant CPU_Number := CPU_Number'First;
  
     type Non_Degrading_Priority is range 0 .. 255;
!    --  Specification of IRIX Non Degrading Priorities
     --
     --  WARNING: IRIX priorities have the reverse meaning of Ada priorities.
     --           The lower the priority value, the greater the greater the
*************** package System.Task_Info is
*** 203,210 ****
        CPU             : CPU_Number             := ANY_CPU;
        Resident        : Page_Locking           := NOLOCK;
        NDPRI           : Non_Degrading_Priority := NDP_NONE) return sproc_t;
!    --  Allocates a sproc_t control structure and creates the
!    --  corresponding sproc.
  
     Invalid_CPU_Number : exception;
     Permission_Error   : exception;
--- 204,210 ----
        CPU             : CPU_Number             := ANY_CPU;
        Resident        : Page_Locking           := NOLOCK;
        NDPRI           : Non_Degrading_Priority := NDP_NONE) return sproc_t;
!    --  Allocates a sproc_t control structure and creates corresponding sproc
  
     Invalid_CPU_Number : exception;
     Permission_Error   : exception;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-irix.ads gcc-4.1.0/gcc/ada/s-tasinf-irix.ads
*** gcc-4.0.2/gcc/ada/s-tasinf-irix.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-irix.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 44,57 ****
  --  This is the IRIX (kernel threads) version of this package
  
  with Interfaces.C;
- with System.OS_Interface;
  
  package System.Task_Info is
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
-    package OSI renames System.OS_Interface;
- 
     -----------------------------------------
     -- Implementation of Task_Info Feature --
     -----------------------------------------
--- 44,55 ----
  --  This is the IRIX (kernel threads) version of this package
  
  with Interfaces.C;
  
  package System.Task_Info is
+    pragma Preelaborate;
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
     -----------------------------------------
     -- Implementation of Task_Info Feature --
     -----------------------------------------
*************** package System.Task_Info is
*** 91,117 ****
     subtype Thread_Scheduling_Priority is Integer range
       No_Specified_Priority .. 255;
  
!    function Min (Policy : Interfaces.C.int) return Interfaces.C.int
!      renames OSI.sched_get_priority_min;
! 
!    function Max (Policy : Interfaces.C.int) return Interfaces.C.int
!      renames OSI.sched_get_priority_max;
! 
!    subtype FIFO_Priority is Thread_Scheduling_Priority range
!       Thread_Scheduling_Priority (Min (OSI.SCHED_FIFO)) ..
!       Thread_Scheduling_Priority (Max (OSI.SCHED_FIFO));
  
!    subtype RR_Priority is Thread_Scheduling_Priority range
!       Thread_Scheduling_Priority (Min (OSI.SCHED_RR)) ..
!       Thread_Scheduling_Priority (Max (OSI.SCHED_RR));
  
!    subtype TS_Priority is Thread_Scheduling_Priority range
!       Thread_Scheduling_Priority (Min (OSI.SCHED_TS)) ..
!       Thread_Scheduling_Priority (Max (OSI.SCHED_TS));
  
!    subtype OTHER_Priority is Thread_Scheduling_Priority range
!       Thread_Scheduling_Priority (Min (OSI.SCHED_OTHER)) ..
!       Thread_Scheduling_Priority (Max (OSI.SCHED_OTHER));
  
     subtype CPU_Number is Integer range -1 .. Integer'Last;
     ANY_CPU : constant CPU_Number := CPU_Number'First;
--- 89,101 ----
     subtype Thread_Scheduling_Priority is Integer range
       No_Specified_Priority .. 255;
  
!    subtype FIFO_Priority is Thread_Scheduling_Priority range 0 .. 255;
  
!    subtype RR_Priority is Thread_Scheduling_Priority range 0 .. 255;
  
!    subtype TS_Priority is Thread_Scheduling_Priority range 1 .. 40;
  
!    subtype OTHER_Priority is Thread_Scheduling_Priority range 1 .. 40;
  
     subtype CPU_Number is Integer range -1 .. Integer'Last;
     ANY_CPU : constant CPU_Number := CPU_Number'First;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-solaris.adb gcc-4.1.0/gcc/ada/s-tasinf-solaris.adb
*** gcc-4.0.2/gcc/ada/s-tasinf-solaris.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-solaris.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-solaris.ads gcc-4.1.0/gcc/ada/s-tasinf-solaris.ads
*** gcc-4.0.2/gcc/ada/s-tasinf-solaris.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-solaris.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 46,51 ****
--- 46,52 ----
  with System.OS_Interface;
  
  package System.Task_Info is
+    pragma Preelaborate;
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf-tru64.ads gcc-4.1.0/gcc/ada/s-tasinf-tru64.ads
*** gcc-4.0.2/gcc/ada/s-tasinf-tru64.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tasinf-tru64.ads	Mon Sep  5 07:46:06 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (Compiler Interface)                           --
  --                                                                          --
! --         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- --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (Compiler Interface)                           --
  --                                                                          --
! --         Copyright (C) 1998-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 45,50 ****
--- 45,51 ----
  --  This is a DEC Unix 4.0d version of this package.
  
  package System.Task_Info is
+    pragma Preelaborate;
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf.adb gcc-4.1.0/gcc/ada/s-tasinf.adb
*** gcc-4.0.2/gcc/ada/s-tasinf.adb	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tasinf.adb	Fri Jul  1 01:29:17 2005
***************
*** 4,13 ****
  --                                                                          --
  --                     S Y S T E M . T A S K _ I N F O                      --
  --                                                                          --
! --                                 S p e c                                  --
  --                           (Compiler Interface)                           --
  --                                                                          --
! --          Copyright (C) 1998-2002 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- --
--- 4,13 ----
  --                                                                          --
  --                     S Y S T E M . T A S K _ I N F O                      --
  --                                                                          --
! --                                 B o d y                                  --
  --                           (Compiler Interface)                           --
  --                                                                          --
! --          Copyright (C) 1998-2005 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 40,44 ****
  --  implementation of the Task_Info pragma.
  
  package body System.Task_Info is
- 
  end System.Task_Info;
--- 40,43 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasinf.ads gcc-4.1.0/gcc/ada/s-tasinf.ads
*** gcc-4.0.2/gcc/ada/s-tasinf.ads	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tasinf.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,47 ****
--- 42,48 ----
  --  an appropriate WITH, and the interface can be expected to remain stable.
  
  package System.Task_Info is
+    pragma Preelaborate;
     pragma Elaborate_Body;
     --  To ensure that a body is allowed
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasini.adb gcc-4.1.0/gcc/ada/s-tasini.adb
*** gcc-4.0.2/gcc/ada/s-tasini.adb	Mon Jan  3 15:42:22 2005
--- gcc-4.1.0/gcc/ada/s-tasini.adb	Tue Nov 15 13:52:31 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . I N I T I A L I Z A T I O N        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . I N I T I A L I Z A T I O N        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 41,70 ****
  --  to poll it can cause infinite loops.
  
  with Ada.Exceptions;
! --  used for Exception_Occurrence_Access.
! 
! with System.Tasking;
! pragma Elaborate_All (System.Tasking);
! --  ensure that the first step initializations have been performed
  
  with System.Task_Primitives;
! --  used for Lock
  
  with System.Task_Primitives.Operations;
! --  used for Set_Priority
  --           Write_Lock
  --           Unlock
  --           Initialize_Lock
  
  with System.Soft_Links;
! --  used for the non-tasking routines (*_NT) that refer to global data.
  --  They are needed here before the tasking run time has been elaborated.
  
  with System.Soft_Links.Tasking;
  --  Used for Init_Tasking_Soft_Links
  
  with System.Tasking.Debug;
! --  used for Trace
  
  with System.Stack_Checking;
  
--- 41,66 ----
  --  to poll it can cause infinite loops.
  
  with Ada.Exceptions;
! --  Used for Exception_Occurrence_Access
  
  with System.Task_Primitives;
! --  Used for Lock
  
  with System.Task_Primitives.Operations;
! --  Used for Set_Priority
  --           Write_Lock
  --           Unlock
  --           Initialize_Lock
  
  with System.Soft_Links;
! --  Used for the non-tasking routines (*_NT) that refer to global data.
  --  They are needed here before the tasking run time has been elaborated.
  
  with System.Soft_Links.Tasking;
  --  Used for Init_Tasking_Soft_Links
  
  with System.Tasking.Debug;
! --  Used for Trace
  
  with System.Stack_Checking;
  
*************** package body System.Tasking.Initializati
*** 88,99 ****
     function Current_Target_Exception return AE.Exception_Occurrence;
     pragma Import
       (Ada, Current_Target_Exception, "__gnat_current_target_exception");
!    --  Import this subprogram from the private part of Ada.Exceptions.
  
     ----------------------------------------------------------------------
     -- Tasking versions of some services needed by non-tasking programs --
     ----------------------------------------------------------------------
  
     procedure Task_Lock;
     --  Locks out other tasks. Preceding a section of code by Task_Lock and
     --  following it by Task_Unlock creates a critical region. This is used
--- 84,101 ----
     function Current_Target_Exception return AE.Exception_Occurrence;
     pragma Import
       (Ada, Current_Target_Exception, "__gnat_current_target_exception");
!    --  Import this subprogram from the private part of Ada.Exceptions
  
     ----------------------------------------------------------------------
     -- Tasking versions of some services needed by non-tasking programs --
     ----------------------------------------------------------------------
  
+    procedure Abort_Defer;
+    --  NON-INLINE versions without Self_ID for soft links
+ 
+    procedure Abort_Undefer;
+    --  NON-INLINE versions without Self_ID for soft links
+ 
     procedure Task_Lock;
     --  Locks out other tasks. Preceding a section of code by Task_Lock and
     --  following it by Task_Unlock creates a critical region. This is used
*************** package body System.Tasking.Initializati
*** 107,119 ****
     --  all nested locks must be released before other tasks competing for the
     --  tasking lock are released.
  
-    function  Get_Exc_Stack_Addr return Address;
-    --  Get the exception stack for the current task
- 
-    procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address);
-    --  Self_ID is the Task_Id of the task that gets the exception stack.
-    --  For Self_ID = Null_Address, the current task gets the exception stack.
- 
     function Get_Stack_Info return Stack_Checking.Stack_Access;
     --  Get access to the current task's Stack_Info
  
--- 109,114 ----
*************** package body System.Tasking.Initializati
*** 132,144 ****
     -- Tasking Initialization --
     ----------------------------
  
-    procedure Gnat_Install_Locks (Lock, Unlock : SSL.No_Param_Proc);
-    pragma Import (C, Gnat_Install_Locks, "__gnatlib_install_locks");
-    --  Used by Init_RTS to install procedure Lock and Unlock for the
-    --  thread locking. This has no effect on GCC 2. For GCC 3,
-    --  it has an effect only if gcc is configured with
-    --  --enable_threads=gnat.
- 
     procedure Init_RTS;
     --  This procedure completes the initialization of the GNARL. The first
     --  part of the initialization is done in the body of System.Tasking.
--- 127,132 ----
*************** package body System.Tasking.Initializati
*** 150,156 ****
     -- Change_Base_Priority --
     --------------------------
  
!    --  Call only with abort deferred and holding Self_ID locked.
  
     procedure Change_Base_Priority (T : Task_Id) is
     begin
--- 138,144 ----
     -- Change_Base_Priority --
     --------------------------
  
!    --  Call only with abort deferred and holding Self_ID locked
  
     procedure Change_Base_Priority (T : Task_Id) is
     begin
*************** package body System.Tasking.Initializati
*** 237,249 ****
        Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
     end Defer_Abort_Nestable;
  
!    --------------------
!    -- Defer_Abortion --
!    --------------------
  
!    procedure Defer_Abortion is
        Self_ID : Task_Id;
- 
     begin
        if No_Abort and then not Dynamic_Priority_Support then
           return;
--- 225,236 ----
        Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
     end Defer_Abort_Nestable;
  
!    -----------------
!    -- Abort_Defer --
!    -----------------
  
!    procedure Abort_Defer is
        Self_ID : Task_Id;
     begin
        if No_Abort and then not Dynamic_Priority_Support then
           return;
*************** package body System.Tasking.Initializati
*** 251,257 ****
  
        Self_ID := STPO.Self;
        Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
!    end Defer_Abortion;
  
     -----------------------
     -- Do_Pending_Action --
--- 238,244 ----
  
        Self_ID := STPO.Self;
        Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
!    end Abort_Defer;
  
     -----------------------
     -- Do_Pending_Action --
*************** package body System.Tasking.Initializati
*** 269,275 ****
        --  while we had abort deferred below.
  
        loop
!          --  Temporarily defer abortion so that we can lock Self_ID.
  
           Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
  
--- 256,262 ----
        --  while we had abort deferred below.
  
        loop
!          --  Temporarily defer abort so that we can lock Self_ID
  
           Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
  
*************** package body System.Tasking.Initializati
*** 286,292 ****
              Unlock_RTS;
           end if;
  
!          --  Restore the original Deferral value.
  
           Self_ID.Deferral_Level := Self_ID.Deferral_Level - 1;
  
--- 273,279 ----
              Unlock_RTS;
           end if;
  
!          --  Restore the original Deferral value
  
           Self_ID.Deferral_Level := Self_ID.Deferral_Level - 1;
  
*************** package body System.Tasking.Initializati
*** 346,353 ****
  
     procedure Init_RTS is
        Self_Id : Task_Id;
- 
     begin
        --  Terminate run time (regular vs restricted) specific initialization
        --  of the environment task.
  
--- 333,341 ----
  
     procedure Init_RTS is
        Self_Id : Task_Id;
     begin
+       Tasking.Initialize;
+ 
        --  Terminate run time (regular vs restricted) specific initialization
        --  of the environment task.
  
*************** package body System.Tasking.Initializati
*** 381,411 ****
        --  the tasking version of the soft links can be used.
  
        if not No_Abort or else Dynamic_Priority_Support then
!          SSL.Abort_Defer   := Defer_Abortion'Access;
!          SSL.Abort_Undefer := Undefer_Abortion'Access;
        end if;
  
        SSL.Update_Exception   := Update_Exception'Access;
        SSL.Lock_Task          := Task_Lock'Access;
        SSL.Unlock_Task        := Task_Unlock'Access;
-       SSL.Get_Exc_Stack_Addr := Get_Exc_Stack_Addr'Access;
-       SSL.Set_Exc_Stack_Addr := Set_Exc_Stack_Addr'Access;
        SSL.Check_Abort_Status := Check_Abort_Status'Access;
        SSL.Get_Stack_Info     := Get_Stack_Info'Access;
        SSL.Task_Name          := Task_Name'Access;
  
-       SSL.Set_Exc_Stack_Addr (Null_Address, SSL.Get_Exc_Stack_Addr_NT);
- 
        --  Initialize the tasking soft links (if not done yet) that are common
        --  to the full and the restricted run times.
  
        SSL.Tasking.Init_Tasking_Soft_Links;
  
!       --  Install tasking locks in the GCC runtime.
! 
!       Gnat_Install_Locks (Task_Lock'Access, Task_Unlock'Access);
! 
!       --  Abortion is deferred in a new ATCB, so we need to undefer abortion
        --  at this stage to make the environment task abortable.
  
        Undefer_Abort (Environment_Task);
--- 369,391 ----
        --  the tasking version of the soft links can be used.
  
        if not No_Abort or else Dynamic_Priority_Support then
!          SSL.Abort_Defer   := Abort_Defer'Access;
!          SSL.Abort_Undefer := Abort_Undefer'Access;
        end if;
  
        SSL.Update_Exception   := Update_Exception'Access;
        SSL.Lock_Task          := Task_Lock'Access;
        SSL.Unlock_Task        := Task_Unlock'Access;
        SSL.Check_Abort_Status := Check_Abort_Status'Access;
        SSL.Get_Stack_Info     := Get_Stack_Info'Access;
        SSL.Task_Name          := Task_Name'Access;
  
        --  Initialize the tasking soft links (if not done yet) that are common
        --  to the full and the restricted run times.
  
        SSL.Tasking.Init_Tasking_Soft_Links;
  
!       --  Abort is deferred in a new ATCB, so we need to undefer abort
        --  at this stage to make the environment task abortable.
  
        Undefer_Abort (Environment_Task);
*************** package body System.Tasking.Initializati
*** 426,440 ****
     --  hurt to uncomment the above call, until the error is corrected for
     --  all targets.
  
!    --  See extended comments in package body System.Tasking.Abortion
!    --  for the overall design of the implementation of task abort.
  
!    --  If the task is sleeping it will be in an abort-deferred region,
!    --  and will not have Abort_Signal raised by Abort_Task.
!    --  Such an "abort deferral" is just to protect the RTS internals,
!    --  and not necessarily required to enforce Ada semantics.
!    --  Abort_Task should wake the task up and let it decide if it wants
!    --  to complete the aborted construct immediately.
  
     --  Note that the effect of the lowl-level Abort_Task is not persistent.
     --  If the target task is not blocked, this wakeup will be missed.
--- 406,421 ----
     --  hurt to uncomment the above call, until the error is corrected for
     --  all targets.
  
!    --  See extended comments in package body System.Tasking.Abort for the
!    --  overall design of the implementation of task abort.
!    --  ??? there is no such package ???
  
!    --  If the task is sleeping it will be in an abort-deferred region, and
!    --  will not have Abort_Signal raised by Abort_Task. Such an "abort
!    --  deferral" is just to protect the RTS internals, and not necessarily
!    --  required to enforce Ada semantics. Abort_Task should wake the task up
!    --  and let it decide if it wants to complete the aborted construct
!    --  immediately.
  
     --  Note that the effect of the lowl-level Abort_Task is not persistent.
     --  If the target task is not blocked, this wakeup will be missed.
*************** package body System.Tasking.Initializati
*** 452,465 ****
     --  implement delays). That still left the possibility of missed
     --  wakeups.
  
!    --  We cannot safely call Vulnerable_Complete_Activation here,
!    --  since that requires locking Self_ID.Parent. The anti-deadlock
!    --  lock ordering rules would then require us to release the lock
!    --  on Self_ID first, which would create a timing window for other
!    --  tasks to lock Self_ID. This is significant for tasks that may be
!    --  aborted before their execution can enter the task body, and so
!    --  they do not get a chance to call Complete_Task. The actual work
!    --  for this case is done in Terminate_Task.
  
     procedure Locked_Abort_To_Level
       (Self_ID : Task_Id;
--- 433,445 ----
     --  implement delays). That still left the possibility of missed
     --  wakeups.
  
!    --  We cannot safely call Vulnerable_Complete_Activation here, since that
!    --  requires locking Self_ID.Parent. The anti-deadlock lock ordering rules
!    --  would then require us to release the lock on Self_ID first, which would
!    --  create a timing window for other tasks to lock Self_ID. This is
!    --  significant for tasks that may be aborted before their execution can
!    --  enter the task body, and so they do not get a chance to call
!    --  Complete_Task. The actual work for this case is done in Terminate_Task.
  
     procedure Locked_Abort_To_Level
       (Self_ID : Task_Id;
*************** package body System.Tasking.Initializati
*** 694,705 ****
  
     --  Precondition : Self does not hold any locks!
  
!    --  Undefer_Abort is called on any abortion completion point (aka.
     --  synchronization point). It performs the following actions if they
     --  are pending: (1) change the base priority, (2) abort the task.
  
!    --  The priority change has to occur before abortion. Otherwise, it would
!    --  take effect no earlier than the next abortion completion point.
  
     procedure Undefer_Abort (Self_ID : Task_Id) is
     begin
--- 674,685 ----
  
     --  Precondition : Self does not hold any locks!
  
!    --  Undefer_Abort is called on any abort completion point (aka.
     --  synchronization point). It performs the following actions if they
     --  are pending: (1) change the base priority, (2) abort the task.
  
!    --  The priority change has to occur before abort. Otherwise, it would
!    --  take effect no earlier than the next abort completion point.
  
     procedure Undefer_Abort (Self_ID : Task_Id) is
     begin
*************** package body System.Tasking.Initializati
*** 757,772 ****
        end if;
     end Undefer_Abort_Nestable;
  
!    ----------------------
!    -- Undefer_Abortion --
!    ----------------------
! 
!    --  Phase out RTS-internal use of Undefer_Abortion
!    --  to reduce overhead due to multiple calls to Self.
  
!    procedure Undefer_Abortion is
        Self_ID : Task_Id;
- 
     begin
        if No_Abort and then not Dynamic_Priority_Support then
           return;
--- 737,748 ----
        end if;
     end Undefer_Abort_Nestable;
  
!    -------------------
!    -- Abort_Undefer --
!    -------------------
  
!    procedure Abort_Undefer is
        Self_ID : Task_Id;
     begin
        if No_Abort and then not Dynamic_Priority_Support then
           return;
*************** package body System.Tasking.Initializati
*** 800,812 ****
              Do_Pending_Action (Self_ID);
           end if;
        end if;
!    end Undefer_Abortion;
  
     ----------------------
     -- Update_Exception --
     ----------------------
  
!    --  Call only when holding no locks.
  
     procedure Update_Exception
       (X : AE.Exception_Occurrence := Current_Target_Exception)
--- 776,788 ----
              Do_Pending_Action (Self_ID);
           end if;
        end if;
!    end Abort_Undefer;
  
     ----------------------
     -- Update_Exception --
     ----------------------
  
!    --  Call only when holding no locks
  
     procedure Update_Exception
       (X : AE.Exception_Occurrence := Current_Target_Exception)
*************** package body System.Tasking.Initializati
*** 908,933 ****
     -- Soft-Link Bodies --
     ----------------------
  
-    function Get_Exc_Stack_Addr return Address is
-    begin
-       return STPO.Self.Common.Compiler_Data.Exc_Stack_Addr;
-    end Get_Exc_Stack_Addr;
- 
     function Get_Stack_Info return Stack_Checking.Stack_Access is
     begin
        return STPO.Self.Common.Compiler_Data.Pri_Stack_Info'Access;
     end Get_Stack_Info;
  
-    procedure Set_Exc_Stack_Addr (Self_ID : Address; Addr : Address) is
-       Me : Task_Id := To_Task_Id (Self_ID);
-    begin
-       if Me = Null_Task then
-          Me := STPO.Self;
-       end if;
- 
-       Me.Common.Compiler_Data.Exc_Stack_Addr := Addr;
-    end Set_Exc_Stack_Addr;
- 
     -----------------------
     -- Soft-Link Dummies --
     -----------------------
--- 884,894 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasini.ads gcc-4.1.0/gcc/ada/s-tasini.ads
*** gcc-4.0.2/gcc/ada/s-tasini.ads	Mon Jan  3 15:42:22 2005
--- gcc-4.1.0/gcc/ada/s-tasini.ads	Mon Sep  5 07:48:10 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . I N I T I A L I Z A T I O N        --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . I N I T I A L I Z A T I O N        --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,44 ****
  package System.Tasking.Initialization is
  
     procedure Remove_From_All_Tasks_List (T : Task_Id);
!    --  Remove T from All_Tasks_List.
!    --  Call this function with RTS_Lock taken.
  
     ---------------------------------
     -- Tasking-Specific Soft Links --
--- 37,43 ----
  package System.Tasking.Initialization is
  
     procedure Remove_From_All_Tasks_List (T : Task_Id);
!    --  Remove T from All_Tasks_List. Call this function with RTS_Lock taken
  
     ---------------------------------
     -- Tasking-Specific Soft Links --
*************** package System.Tasking.Initialization is
*** 47,53 ****
     --  These permit us to leave out certain portions of the tasking
     --  run-time system if they are not used.  They are only used internally
     --  by the tasking run-time system.
!    --  So far, the only example is support for Ada.Task_Attributes.
  
     type Proc_T is access procedure (T : Task_Id);
  
--- 46,53 ----
     --  These permit us to leave out certain portions of the tasking
     --  run-time system if they are not used.  They are only used internally
     --  by the tasking run-time system.
! 
!    --  So far, the only example is support for Ada.Task_Attributes
  
     type Proc_T is access procedure (T : Task_Id);
  
*************** package System.Tasking.Initialization is
*** 55,64 ****
     procedure Initialize_Attributes (T : Task_Id);
  
     Finalize_Attributes_Link : Proc_T := Finalize_Attributes'Access;
!    --  should be called with abortion deferred and T.L write-locked
  
     Initialize_Attributes_Link : Proc_T := Initialize_Attributes'Access;
!    --  should be called with abortion deferred, but holding no locks
  
     -------------------------
     -- Abort Defer/Undefer --
--- 55,64 ----
     procedure Initialize_Attributes (T : Task_Id);
  
     Finalize_Attributes_Link : Proc_T := Finalize_Attributes'Access;
!    --  should be called with abort deferred and T.L write-locked
  
     Initialize_Attributes_Link : Proc_T := Initialize_Attributes'Access;
!    --  should be called with abort deferred, but holding no locks
  
     -------------------------
     -- Abort Defer/Undefer --
*************** package System.Tasking.Initialization is
*** 68,110 ****
     --  in the calling task until a matching Undefer_Abort call is executed.
  
     --  Undefer_Abort DOES MORE than just undo the effects of one call to
!    --  Defer_Abort.  It is the universal "polling point" for deferred
     --  processing, including the following:
  
     --  1) base priority changes
  
     --  2) abort/ATC
  
!    --  Abort deferral MAY be nested (Self_ID.Deferral_Level is a count),
!    --  but to avoid waste and undetected errors, it generally SHOULD NOT
!    --  be nested.  The symptom of over-deferring abort is that an exception
!    --  may fail to be raised, or an abort may fail to take place.
  
!    --  Therefore, there are two sets of the inlinable defer/undefer
!    --  routines, which are the ones to be used inside GNARL.
!    --  One set allows nesting.  The other does not.  People who
!    --  maintain the GNARL should try to avoid using the nested versions,
!    --  or at least look very critically at the places where they are
!    --  used.
  
!    --  In general, any GNARL call that is potentially blocking, or
!    --  whose semantics require that it sometimes raise an exception,
!    --  or that is required to be an abort completion point, must be
!    --  made with abort Deferral_Level = 1.
  
!    --  In general, non-blocking GNARL calls, which may be made from inside
!    --  a protected action, are likely to need to allow nested abort
!    --  deferral.
  
     --  With some critical exceptions (which are supposed to be documented),
     --  internal calls to the tasking runtime system assume abort is already
     --  deferred, and do not modify the deferral level.
  
!    --  There is also a set of non-linable defer/undefer routines,
!    --  for direct call from the compiler. These are not in-lineable
!    --  because they may need to be called via pointers ("soft links").
!    --  For the sake of efficiency, the version with Self_ID as parameter
!    --  should used wherever possible. These are all nestable.
  
     --  Non-nestable inline versions
  
--- 68,108 ----
     --  in the calling task until a matching Undefer_Abort call is executed.
  
     --  Undefer_Abort DOES MORE than just undo the effects of one call to
!    --  Defer_Abort. It is the universal "polling point" for deferred
     --  processing, including the following:
  
     --  1) base priority changes
  
     --  2) abort/ATC
  
!    --  Abort deferral MAY be nested (Self_ID.Deferral_Level is a count), but
!    --  to avoid waste and undetected errors, it generally SHOULD NOT be
!    --  nested. The symptom of over-deferring abort is that an exception may
!    --  fail to be raised, or an abort may fail to take place.
  
!    --  Therefore, there are two sets of the inlinable defer/undefer routines,
!    --  which are the ones to be used inside GNARL. One set allows nesting. The
!    --  other does not. People who maintain the GNARL should try to avoid using
!    --  the nested versions, or at least look very critically at the places
!    --  where they are used.
  
!    --  In general, any GNARL call that is potentially blocking, or whose
!    --  semantics require that it sometimes raise an exception, or that is
!    --  required to be an abort completion point, must be made with abort
!    --  Deferral_Level = 1.
  
!    --  In general, non-blocking GNARL calls, which may be made from inside a
!    --  protected action, are likely to need to allow nested abort deferral.
  
     --  With some critical exceptions (which are supposed to be documented),
     --  internal calls to the tasking runtime system assume abort is already
     --  deferred, and do not modify the deferral level.
  
!    --  There is also a set of non-linable defer/undefer routines, for direct
!    --  call from the compiler. These are not in-lineable because they may need
!    --  to be called via pointers ("soft links"). For the sake of efficiency,
!    --  the version with Self_ID as parameter should used wherever possible.
!    --  These are all nestable.
  
     --  Non-nestable inline versions
  
*************** package System.Tasking.Initialization is
*** 122,143 ****
     procedure Undefer_Abort_Nestable (Self_ID : Task_Id);
     pragma Inline (Undefer_Abort_Nestable);
  
-    --  NON-INLINE versions without Self_ID for code generated by the
-    --  expander and for soft links
- 
-    procedure Defer_Abortion;
-    procedure Undefer_Abortion;
- 
-    --  ?????
-    --  Try to phase out all uses of the above versions.
- 
     procedure Do_Pending_Action (Self_ID : Task_Id);
!    --  Only call with no locks, and when Self_ID.Pending_Action = True
!    --  Perform necessary pending actions (e.g. abortion, priority change).
!    --  This procedure is usually called when needed as a result of
!    --  calling Undefer_Abort, although in the case of e.g. No_Abort
!    --  restriction, it can be necessary to force execution of pending
!    --  actions.
  
     function Check_Abort_Status return Integer;
     --  Returns Boolean'Pos (True) iff abort signal should raise
--- 120,131 ----
     procedure Undefer_Abort_Nestable (Self_ID : Task_Id);
     pragma Inline (Undefer_Abort_Nestable);
  
     procedure Do_Pending_Action (Self_ID : Task_Id);
!    --  Only call with no locks, and when Self_ID.Pending_Action = True Perform
!    --  necessary pending actions (e.g. abort, priority change). This procedure
!    --  is usually called when needed as a result of calling Undefer_Abort,
!    --  although in the case of e.g. No_Abort restriction, it can be necessary
!    --  to force execution of pending actions.
  
     function Check_Abort_Status return Integer;
     --  Returns Boolean'Pos (True) iff abort signal should raise
*************** package System.Tasking.Initialization is
*** 148,156 ****
     --------------------------
  
     procedure Change_Base_Priority (T : Task_Id);
!    --  Change the base priority of T.
!    --  Has to be called with the affected task's ATCB write-locked.
!    --  May temporariliy release the lock.
  
     procedure Poll_Base_Priority_Change (Self_ID : Task_Id);
     --  Has to be called with Self_ID's ATCB write-locked.
--- 136,143 ----
     --------------------------
  
     procedure Change_Base_Priority (T : Task_Id);
!    --  Change the base priority of T. Has to be called with the affected
!    --  task's ATCB write-locked. May temporariliy release the lock.
  
     procedure Poll_Base_Priority_Change (Self_ID : Task_Id);
     --  Has to be called with Self_ID's ATCB write-locked.
*************** package System.Tasking.Initialization is
*** 170,213 ****
     --  within the GNARL.
  
     procedure Final_Task_Unlock (Self_ID : Task_Id);
!    --  This version is only for use in Terminate_Task, when the task
!    --  is relinquishing further rights to its own ATCB.
!    --  There is a very interesting potential race condition there, where
!    --  the old task may run concurrently with a new task that is allocated
!    --  the old tasks (now reused) ATCB.  The critical thing here is to
!    --  not make any reference to the ATCB after the lock is released.
!    --  See also comments on Terminate_Task and Unlock.
  
     procedure Wakeup_Entry_Caller
       (Self_ID    : Task_Id;
        Entry_Call : Entry_Call_Link;
        New_State  : Entry_Call_State);
     pragma Inline (Wakeup_Entry_Caller);
!    --  This is called at the end of service of an entry call,
!    --  to abort the caller if he is in an abortable part, and
!    --  to wake up the caller if he is on Entry_Caller_Sleep.
!    --  Call it holding the lock of Entry_Call.Self.
     --
     --  Timed_Call or Simple_Call:
!    --    The caller is waiting on Entry_Caller_Sleep, in
!    --    Wait_For_Completion, or Wait_For_Completion_With_Timeout.
     --
     --  Conditional_Call:
     --    The caller might be in Wait_For_Completion,
!    --    waiting for a rendezvous (possibly requeued without abort)
!    --    to complete.
     --
     --  Asynchronous_Call:
!    --    The caller may be executing in the abortable part o
!    --    an async. select, or on a time delay,
!    --    if Entry_Call.State >= Was_Abortable.
  
     procedure Locked_Abort_To_Level
       (Self_ID : Task_Id;
        T       : Task_Id;
        L       : ATC_Level);
     pragma Inline (Locked_Abort_To_Level);
!    --  Abort a task to a specified ATC level.
!    --  Call this only with T locked.
  
  end System.Tasking.Initialization;
--- 157,197 ----
     --  within the GNARL.
  
     procedure Final_Task_Unlock (Self_ID : Task_Id);
!    --  This version is only for use in Terminate_Task, when the task is
!    --  relinquishing further rights to its own ATCB. There is a very
!    --  interesting potential race condition there, where the old task may run
!    --  concurrently with a new task that is allocated the old tasks (now
!    --  reused) ATCB. The critical thing here is to not make any reference to
!    --  the ATCB after the lock is released. See also comments on
!    --  Terminate_Task and Unlock.
  
     procedure Wakeup_Entry_Caller
       (Self_ID    : Task_Id;
        Entry_Call : Entry_Call_Link;
        New_State  : Entry_Call_State);
     pragma Inline (Wakeup_Entry_Caller);
!    --  This is called at the end of service of an entry call, to abort the
!    --  caller if he is in an abortable part, and to wake up the caller if he
!    --  is on Entry_Caller_Sleep. Call it holding the lock of Entry_Call.Self.
     --
     --  Timed_Call or Simple_Call:
!    --    The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion,
!    --    or Wait_For_Completion_With_Timeout.
     --
     --  Conditional_Call:
     --    The caller might be in Wait_For_Completion,
!    --    waiting for a rendezvous (possibly requeued without abort) to
!    --    complete.
     --
     --  Asynchronous_Call:
!    --    The caller may be executing in the abortable part an async. select,
!    --    or on a time delay, if Entry_Call.State >= Was_Abortable.
  
     procedure Locked_Abort_To_Level
       (Self_ID : Task_Id;
        T       : Task_Id;
        L       : ATC_Level);
     pragma Inline (Locked_Abort_To_Level);
!    --  Abort a task to a specified ATC level. Call this only with T locked
  
  end System.Tasking.Initialization;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taskin.adb gcc-4.1.0/gcc/ada/s-taskin.adb
*** gcc-4.0.2/gcc/ada/s-taskin.adb	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/s-taskin.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                        S Y S T E M . T A S K I N G                       --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                        S Y S T E M . T A S K I N G                       --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking is
*** 48,53 ****
--- 48,68 ----
  
     package STPO renames System.Task_Primitives.Operations;
  
+    ---------------------
+    -- Detect_Blocking --
+    ---------------------
+ 
+    function Detect_Blocking return Boolean is
+       GL_Detect_Blocking : Integer;
+       pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
+       --  Global variable exported by the binder generated file.
+       --  A value equal to 1 indicates that pragma Detect_Blocking is active,
+       --  while 0 is used for the pragma not being present.
+ 
+    begin
+       return GL_Detect_Blocking = 1;
+    end Detect_Blocking;
+ 
     ----------
     -- Self --
     ----------
*************** package body System.Tasking is
*** 116,123 ****
        All_Tasks_List := T;
     end Initialize_ATCB;
  
     Main_Task_Image : constant String := "main_task";
!    --  Image of environment task.
  
     Main_Priority : Integer;
     pragma Import (C, Main_Priority, "__gl_main_priority");
--- 131,142 ----
        All_Tasks_List := T;
     end Initialize_ATCB;
  
+    ----------------
+    -- Initialize --
+    ----------------
+ 
     Main_Task_Image : constant String := "main_task";
!    --  Image of environment task
  
     Main_Priority : Integer;
     pragma Import (C, Main_Priority, "__gl_main_priority");
*************** package body System.Tasking is
*** 125,150 ****
     --  Priority, because we use the value -1 to indicate the default
     --  main priority, and that is of course not in Priority'range.
  
!    ----------------------------
!    -- Tasking Initialization --
!    ----------------------------
! 
!    --  This block constitutes the first part of the initialization of the
!    --  GNARL. This includes creating data structures to make the initial thread
!    --  into the environment task. The last part of the initialization is done
!    --  in System.Tasking.Initialization or System.Tasking.Restricted.Stages.
!    --  All the initializations used to be in Tasking.Initialization, but this
!    --  is no longer possible with the run time simplification (including
!    --  optimized PO and the restricted run time) since one cannot rely on
!    --  System.Tasking.Initialization being present, as was done before.
  
! begin
!    declare
        T             : Task_Id;
        Success       : Boolean;
        Base_Priority : Any_Priority;
  
     begin
        --  Initialize Environment Task
  
        if Main_Priority = Unspecified_Priority then
--- 144,164 ----
     --  Priority, because we use the value -1 to indicate the default
     --  main priority, and that is of course not in Priority'range.
  
!    Initialized : Boolean := False;
!    --  Used to prevent multiple calls to Initialize
  
!    procedure Initialize is
        T             : Task_Id;
        Success       : Boolean;
        Base_Priority : Any_Priority;
  
     begin
+       if Initialized then
+          return;
+       end if;
+ 
+       Initialized := True;
+ 
        --  Initialize Environment Task
  
        if Main_Priority = Unspecified_Priority then
*************** begin
*** 170,174 ****
        --  in ravenscar mode. Rest of the initialization is done in Init_RTS.
  
        T.Entry_Calls (1).Self := T;
!    end;
  end System.Tasking;
--- 184,189 ----
        --  in ravenscar mode. Rest of the initialization is done in Init_RTS.
  
        T.Entry_Calls (1).Self := T;
!    end Initialize;
! 
  end System.Tasking;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taskin.ads gcc-4.1.0/gcc/ada/s-taskin.ads
*** gcc-4.0.2/gcc/ada/s-taskin.ads	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/s-taskin.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                        S Y S T E M . T A S K I N G                       --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . T A S K I N G                       --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides necessary type definitions for compiler interface.
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides necessary type definitions for compiler interface
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
*************** with System.Task_Primitives;
*** 54,59 ****
--- 54,60 ----
  with Unchecked_Conversion;
  
  package System.Tasking is
+    pragma Preelaborate;
  
     -------------------
     -- Locking Rules --
*************** package System.Tasking is
*** 62,74 ****
     --  The following rules must be followed at all times, to prevent
     --  deadlock and generally ensure correct operation of locking.
  
!    --  . Never lock a lock unless abort is deferred.
  
!    --  . Never undefer abort while holding a lock.
  
!    --  . Overlapping critical sections must be properly nested,
!    --    and locks must be released in LIFO order.
!    --    e.g., the following is not allowed:
  
     --         Lock (X);
     --         ...
--- 63,74 ----
     --  The following rules must be followed at all times, to prevent
     --  deadlock and generally ensure correct operation of locking.
  
!    --  Never lock a lock unless abort is deferred
  
!    --  Never undefer abort while holding a lock
  
!    --  Overlapping critical sections must be properly nested, and locks must
!    --  be released in LIFO order. e.g., the following is not allowed:
  
     --         Lock (X);
     --         ...
*************** package System.Tasking is
*** 80,86 ****
  
     --  Locks with lower (smaller) level number cannot be locked
     --  while holding a lock with a higher level number. (The level
-    --  number is the number at the left.)
  
     --  1. System.Tasking.PO_Simple.Protection.L (any PO lock)
     --  2. System.Tasking.Initialization.Global_Task_Lock (in body)
--- 80,85 ----
*************** package System.Tasking is
*** 94,106 ****
     --  clearly wrong since there can be calls to "new" inside protected
     --  operations. The new ordering prevents these failures.
  
!    --  Sometimes we need to hold two ATCB locks at the same time. To allow
!    --  us to order the locking, each ATCB is given a unique serial
!    --  number. If one needs to hold locks on several ATCBs at once,
!    --  the locks with lower serial numbers must be locked first.
  
!    --  We don't always need to check the serial numbers, since
!    --  the serial numbers are assigned sequentially, and so:
  
     --  . The parent of a task always has a lower serial number.
     --  . The activator of a task always has a lower serial number.
--- 93,105 ----
     --  clearly wrong since there can be calls to "new" inside protected
     --  operations. The new ordering prevents these failures.
  
!    --  Sometimes we need to hold two ATCB locks at the same time. To allow us
!    --  to order the locking, each ATCB is given a unique serial number. If one
!    --  needs to hold locks on several ATCBs at once, the locks with lower
!    --  serial numbers must be locked first.
  
!    --  We don't always need to check the serial numbers, since the serial
!    --  numbers are assigned sequentially, and so:
  
     --  . The parent of a task always has a lower serial number.
     --  . The activator of a task always has a lower serial number.
*************** package System.Tasking is
*** 157,169 ****
        --  alternatives have been awakened and have terminated themselves.
  
        Activator_Sleep,
!       --  Task is waiting for created tasks to complete activation.
  
        Acceptor_Sleep,
!       --  Task is waiting on an accept or selective wait statement.
  
        Entry_Caller_Sleep,
!       --  Task is waiting on an entry call.
  
        Async_Select_Sleep,
        --  Task is waiting to start the abortable part of an
--- 156,168 ----
        --  alternatives have been awakened and have terminated themselves.
  
        Activator_Sleep,
!       --  Task is waiting for created tasks to complete activation
  
        Acceptor_Sleep,
!       --  Task is waiting on an accept or selective wait statement
  
        Entry_Caller_Sleep,
!       --  Task is waiting on an entry call
  
        Async_Select_Sleep,
        --  Task is waiting to start the abortable part of an
*************** package System.Tasking is
*** 309,328 ****
        State : Entry_Call_State;
        pragma Atomic (State);
        --  Indicates part of the state of the call.
!       --  Protection:
!       --  If the call is not on a queue, it should
!       --  only be accessed by Self, and Self does not need any
!       --  lock to modify this field.
!       --  Once the call is on a queue, the value should be
!       --  something other than Done unless it is cancelled, and access is
!       --  controller by the "server" of the queue -- i.e., the lock
!       --  of Checked_To_Protection (Call_Target)
!       --  if the call record is on the queue of a PO, or the lock
!       --  of Called_Target if the call is on the queue of a task.
!       --  See comments on type declaration for more details.
  
        Uninterpreted_Data : System.Address;
!       --  Data passed by the compiler.
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id;
        --  The exception to raise once this call has been completed without
--- 308,327 ----
        State : Entry_Call_State;
        pragma Atomic (State);
        --  Indicates part of the state of the call.
!       --
!       --  Protection: If the call is not on a queue, it should only be
!       --  accessed by Self, and Self does not need any lock to modify this
!       --  field.
!       --
!       --  Once the call is on a queue, the value should be something other
!       --  than Done unless it is cancelled, and access is controller by the
!       --  "server" of the queue -- i.e., the lock of Checked_To_Protection
!       --  (Call_Target) if the call record is on the queue of a PO, or the
!       --  lock of Called_Target if the call is on the queue of a task. See
!       --  comments on type declaration for more details.
  
        Uninterpreted_Data : System.Address;
!       --  Data passed by the compiler
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id;
        --  The exception to raise once this call has been completed without
*************** package System.Tasking is
*** 344,357 ****
  
     type Access_Boolean is access all Boolean;
  
!    Detect_Blocking : constant Boolean;
!    --  Boolean constant set True iff Detect_Blocking is active
  
     ----------------------------------------------
     -- Ada_Task_Control_Block (ATCB) definition --
     ----------------------------------------------
  
!    --  Notes on protection (synchronization) of TRTS data structures.
  
     --  Any field of the TCB can be written by the activator of a task when the
     --  task is created, since no other task can access the new task's
--- 343,357 ----
  
     type Access_Boolean is access all Boolean;
  
!    function Detect_Blocking return Boolean;
!    pragma Inline (Detect_Blocking);
!    --  Return whether the Detect_Blocking pragma is enabled.
  
     ----------------------------------------------
     -- Ada_Task_Control_Block (ATCB) definition --
     ----------------------------------------------
  
!    --  Notes on protection (synchronization) of TRTS data structures
  
     --  Any field of the TCB can be written by the activator of a task when the
     --  task is created, since no other task can access the new task's
*************** package System.Tasking is
*** 360,366 ****
     --  The protection for each field is described in a comment starting with
     --  "Protection:".
  
!    --  When a lock is used to protect an ATCB field, this lock is simply named.
  
     --  Some protection is described in terms of tasks related to the
     --  ATCB being protected. These are:
--- 360,366 ----
     --  The protection for each field is described in a comment starting with
     --  "Protection:".
  
!    --  When a lock is used to protect an ATCB field, this lock is simply named
  
     --  Some protection is described in terms of tasks related to the
     --  ATCB being protected. These are:
*************** package System.Tasking is
*** 390,396 ****
        --  Encodes some basic information about the state of a task,
        --  including whether it has been activated, whether it is sleeping,
        --  and whether it is terminated.
!       --  Protection: Self.L.
  
        Parent : Task_Id;
        --  The task on which this task depends.
--- 390,397 ----
        --  Encodes some basic information about the state of a task,
        --  including whether it has been activated, whether it is sleeping,
        --  and whether it is terminated.
!       --
!       --  Protection: Self.L
  
        Parent : Task_Id;
        --  The task on which this task depends.
*************** package System.Tasking is
*** 399,405 ****
        Base_Priority : System.Any_Priority;
        --  Base priority, not changed during entry calls, only changed
        --  via dynamic priorities package.
!       --  Protection: Only written by Self, accessed by anyone.
  
        Current_Priority : System.Any_Priority;
        --  Active priority, except that the effects of protected object
--- 400,407 ----
        Base_Priority : System.Any_Priority;
        --  Base priority, not changed during entry calls, only changed
        --  via dynamic priorities package.
!       --
!       --  Protection: Only written by Self, accessed by anyone
  
        Current_Priority : System.Any_Priority;
        --  Active priority, except that the effects of protected object
*************** package System.Tasking is
*** 428,523 ****
  
        Protected_Action_Nesting : Natural;
        pragma Atomic (Protected_Action_Nesting);
!       --  The dynamic level of protected action nesting for this task.
!       --  This field is needed for checking whether potentially
!       --  blocking operations are invoked from protected actions.
!       --  pragma Atomic is used because it can be read/written from
!       --  protected interrupt handlers.
  
        Task_Image : String (1 .. 32);
        --  Hold a string that provides a readable id for task,
        --  built from the variable of which it is a value or component.
  
        Task_Image_Len : Natural;
!       --  Actual length of Task_Image.
  
        Call : Entry_Call_Link;
        --  The entry call that has been accepted by this task.
!       --  Protection: Self.L. Self will modify this field
!       --  when Self.Accepting is False, and will not need the mutex to do so.
!       --  Once a task sets Pending_ATC_Level = 0, no other task can access
!       --  this field.
  
        LL : aliased Task_Primitives.Private_Data;
!       --  Control block used by the underlying low-level tasking
!       --  service (GNULLI).
        --  Protection: This is used only by the GNULLI implementation, which
        --  takes care of all of its synchronization.
  
        Task_Arg : System.Address;
        --  The argument to task procedure. Provide a handle for discriminant
!       --  information.
!       --  Protection: Part of the synchronization between Self and
!       --  Activator. Activator writes it, once, before Self starts
!       --  executing. Thereafter, Self only reads it.
  
        Task_Entry_Point : Task_Procedure_Access;
        --  Information needed to call the procedure containing the code for
        --  the body of this task.
!       --  Protection: Part of the synchronization between Self and
!       --  Activator. Activator writes it, once, before Self starts
!       --  executing. Self reads it, once, as part of its execution.
  
        Compiler_Data : System.Soft_Links.TSD;
!       --  Task-specific data needed by the compiler to store
!       --  per-task structures.
!       --  Protection: Only accessed by Self.
  
        All_Tasks_Link : Task_Id;
!       --  Used to link this task to the list of all tasks in the system.
!       --  Protection: RTS_Lock.
  
        Activation_Link : Task_Id;
!       --  Used to link this task to a list of tasks to be activated.
!       --  Protection: Only used by Activator.
  
        Activator : Task_Id;
        --  The task that created this task, either by declaring it as a task
!       --  object or by executing a task allocator.
!       --  The value is null iff Self has completed activation.
!       --  Protection: Set by Activator before Self is activated, and
!       --  only read and modified by Self after that.
  
        Wait_Count : Integer;
!       --  This count is used by a task that is waiting for other tasks.
!       --  At all other times, the value should be zero.
!       --  It is used differently in several different states.
!       --  Since a task cannot be in more than one of these states at the
!       --  same time, a single counter suffices.
!       --  Protection: Self.L.
  
        --  Activator_Sleep
  
        --  This is the number of tasks that this task is activating, i.e. the
        --  children that have started activation but have not completed it.
!       --  Protection: Self.L and Created.L. Both mutexes must be locked,
!       --  since Self.Activation_Count and Created.State must be synchronized.
  
        --  Master_Completion_Sleep (phase 1)
  
!       --  This is the number dependent tasks of a master being
!       --  completed by Self that are not activated, not terminated, and
!       --  not waiting on a terminate alternative.
  
        --  Master_Completion_2_Sleep (phase 2)
  
!       --  This is the count of tasks dependent on a master being
!       --  completed by Self which are waiting on a terminate alternative.
  
        Elaborated : Access_Boolean;
        --  Pointer to a flag indicating that this task's body has been
        --  elaborated. The flag is created and managed by the
        --  compiler-generated code.
        --  Protection: The field itself is only accessed by Activator. The flag
        --  that it points to is updated by Master and read by Activator; access
        --  is assumed to be atomic.
--- 430,533 ----
  
        Protected_Action_Nesting : Natural;
        pragma Atomic (Protected_Action_Nesting);
!       --  The dynamic level of protected action nesting for this task. This
!       --  field is needed for checking whether potentially blocking operations
!       --  are invoked from protected actions. pragma Atomic is used because it
!       --  can be read/written from protected interrupt handlers.
  
        Task_Image : String (1 .. 32);
        --  Hold a string that provides a readable id for task,
        --  built from the variable of which it is a value or component.
  
        Task_Image_Len : Natural;
!       --  Actual length of Task_Image
  
        Call : Entry_Call_Link;
        --  The entry call that has been accepted by this task.
!       --
!       --  Protection: Self.L. Self will modify this field when Self.Accepting
!       --  is False, and will not need the mutex to do so. Once a task sets
!       --  Pending_ATC_Level = 0, no other task can access this field.
  
        LL : aliased Task_Primitives.Private_Data;
!       --  Control block used by the underlying low-level tasking service
!       --  (GNULLI).
!       --
        --  Protection: This is used only by the GNULLI implementation, which
        --  takes care of all of its synchronization.
  
        Task_Arg : System.Address;
        --  The argument to task procedure. Provide a handle for discriminant
!       --  information
!       --
!       --  Protection: Part of the synchronization between Self and Activator.
!       --  Activator writes it, once, before Self starts executing. Thereafter,
!       --  Self only reads it.
  
        Task_Entry_Point : Task_Procedure_Access;
        --  Information needed to call the procedure containing the code for
        --  the body of this task.
!       --
!       --  Protection: Part of the synchronization between Self and Activator.
!       --  Activator writes it, once, before Self starts executing. Self reads
!       --  it, once, as part of its execution.
  
        Compiler_Data : System.Soft_Links.TSD;
!       --  Task-specific data needed by the compiler to store per-task
!       --  structures.
!       --
!       --  Protection: Only accessed by Self
  
        All_Tasks_Link : Task_Id;
!       --  Used to link this task to the list of all tasks in the system
!       --
!       --  Protection: RTS_Lock
  
        Activation_Link : Task_Id;
!       --  Used to link this task to a list of tasks to be activated
!       --
!       --  Protection: Only used by Activator
  
        Activator : Task_Id;
        --  The task that created this task, either by declaring it as a task
!       --  object or by executing a task allocator. The value is null iff Self
!       --  has completed activation.
!       --
!       --  Protection: Set by Activator before Self is activated, and only read
!       --  and modified by Self after that.
  
        Wait_Count : Integer;
!       --  This count is used by a task that is waiting for other tasks. At all
!       --  other times, the value should be zero. It is used differently in
!       --  several different states. Since a task cannot be in more than one of
!       --  these states at the same time, a single counter suffices.
!       --
!       --  Protection: Self.L
  
        --  Activator_Sleep
  
        --  This is the number of tasks that this task is activating, i.e. the
        --  children that have started activation but have not completed it.
!       --
!       --  Protection: Self.L and Created.L. Both mutexes must be locked, since
!       --  Self.Activation_Count and Created.State must be synchronized.
  
        --  Master_Completion_Sleep (phase 1)
  
!       --  This is the number dependent tasks of a master being completed by
!       --  Self that are not activated, not terminated, and not waiting on a
!       --  terminate alternative.
  
        --  Master_Completion_2_Sleep (phase 2)
  
!       --  This is the count of tasks dependent on a master being completed by
!       --  Self which are waiting on a terminate alternative.
  
        Elaborated : Access_Boolean;
        --  Pointer to a flag indicating that this task's body has been
        --  elaborated. The flag is created and managed by the
        --  compiler-generated code.
+       --
        --  Protection: The field itself is only accessed by Activator. The flag
        --  that it points to is updated by Master and read by Activator; access
        --  is assumed to be atomic.
*************** package System.Tasking is
*** 539,544 ****
--- 549,555 ----
     --  restricted GNULL implementations to allocate an ATCB (see
     --  System.Task_Primitives.Operations.New_ATCB) that will take
     --  significantly less memory.
+ 
     --  Note that the restricted GNARLI should only access fields that are
     --  present in the Restricted_Ada_Task_Control_Block structure.
  
*************** package System.Tasking is
*** 564,570 ****
     -----------------------
  
     All_Tasks_List : Task_Id;
!    --  Global linked list of all tasks.
  
     ------------------------------------------
     -- Regular (non restricted) definitions --
--- 575,581 ----
     -----------------------
  
     All_Tasks_List : Task_Id;
!    --  Global linked list of all tasks
  
     ------------------------------------------
     -- Regular (non restricted) definitions --
*************** package System.Tasking is
*** 577,589 ****
     subtype Master_Level is Integer;
     subtype Master_ID is Master_Level;
  
!    --  Normally, a task starts out with internal master nesting level
!    --  one larger than external master nesting level. It is incremented
!    --  to one by Enter_Master, which is called in the task body only if
!    --  the compiler thinks the task may have dependent tasks. It is set to 1
!    --  for the environment task, the level 2 is reserved for server tasks of
!    --  the run-time system (the so called "independent tasks"), and the level
!    --  3 is for the library level tasks.
  
     Environment_Task_Level : constant Master_Level := 1;
     Independent_Task_Level : constant Master_Level := 2;
--- 588,600 ----
     subtype Master_Level is Integer;
     subtype Master_ID is Master_Level;
  
!    --  Normally, a task starts out with internal master nesting level one
!    --  larger than external master nesting level. It is incremented to one by
!    --  Enter_Master, which is called in the task body only if the compiler
!    --  thinks the task may have dependent tasks. It is set to for the
!    --  environment task, the level 2 is reserved for server tasks of the
!    --  run-time system (the so called "independent tasks"), and the level 3 is
!    --  for the library level tasks.
  
     Environment_Task_Level : constant Master_Level := 1;
     Independent_Task_Level : constant Master_Level := 2;
*************** package System.Tasking is
*** 596,602 ****
     Unspecified_Priority : constant Integer := System.Priority'First - 1;
  
     Priority_Not_Boosted : constant Integer := System.Priority'First - 1;
!    --  Definition of Priority actually has to come from the RTS configuration.
  
     subtype Rendezvous_Priority is Integer
       range Priority_Not_Boosted .. System.Any_Priority'Last;
--- 607,613 ----
     Unspecified_Priority : constant Integer := System.Priority'First - 1;
  
     Priority_Not_Boosted : constant Integer := System.Priority'First - 1;
!    --  Definition of Priority actually has to come from the RTS configuration
  
     subtype Rendezvous_Priority is Integer
       range Priority_Not_Boosted .. System.Any_Priority'Last;
*************** package System.Tasking is
*** 652,672 ****
  
        State : Entry_Call_State;
        pragma Atomic (State);
!       --  Indicates part of the state of the call.
!       --  Protection:
!       --  If the call is not on a queue, it should
!       --  only be accessed by Self, and Self does not need any
!       --  lock to modify this field.
!       --  Once the call is on a queue, the value should be
!       --  something other than Done unless it is cancelled, and access is
!       --  controller by the "server" of the queue -- i.e., the lock
!       --  of Checked_To_Protection (Call_Target)
!       --  if the call record is on the queue of a PO, or the lock
!       --  of Called_Target if the call is on the queue of a task.
!       --  See comments on type declaration for more details.
  
        Uninterpreted_Data : System.Address;
!       --  Data passed by the compiler.
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id;
        --  The exception to raise once this call has been completed without
--- 663,681 ----
  
        State : Entry_Call_State;
        pragma Atomic (State);
!       --  Indicates part of the state of the call
!       --
!       --  Protection: If the call is not on a queue, it should only be
!       --  accessed by Self, and Self does not need any lock to modify this
!       --  field. Once the call is on a queue, the value should be something
!       --  other than Done unless it is cancelled, and access is controller by
!       --  the "server" of the queue -- i.e., the lock of Checked_To_Protection
!       --  (Call_Target) if the call record is on the queue of a PO, or the
!       --  lock of Called_Target if the call is on the queue of a task. See
!       --  comments on type declaration for more details.
  
        Uninterpreted_Data : System.Address;
!       --  Data passed by the compiler
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id;
        --  The exception to raise once this call has been completed without
*************** package System.Tasking is
*** 693,734 ****
  
        Called_Task : Task_Id;
        pragma Atomic (Called_Task);
!       --  Use for task entry calls.
!       --  The value is null if the call record is not in use.
!       --  Conversely, unless State is Done and Onqueue is false,
        --  Called_Task points to an ATCB.
!       --  Protection:  Called_Task.L.
  
        Called_PO : System.Address;
        pragma Atomic (Called_PO);
!       --  Similar to Called_Task but for protected objects.
        --  Note that the previous implementation tried to merge both
        --  Called_Task and Called_PO but this ended up in many unexpected
        --  complications (e.g having to add a magic number in the ATCB, which
!       --  caused gdb lots of confusion) with no real gain since the Lock_Server
!       --  implementation still need to loop around chasing for pointer changes
!       --  even with a single pointer.
  
        Acceptor_Prev_Call : Entry_Call_Link;
!       --  For task entry calls only.
  
        Acceptor_Prev_Priority : Rendezvous_Priority := Priority_Not_Boosted;
!       --  For task entry calls only.
!       --  The priority of the most recent prior call being serviced.
!       --  For protected entry calls, this function should be performed by
!       --  GNULLI ceiling locking.
  
        Cancellation_Attempted : Boolean := False;
        pragma Atomic (Cancellation_Attempted);
        --  Cancellation of the call has been attempted.
!       --  If it has succeeded, State = Cancelled.
!       --  ?????
!       --  Consider merging this into State?
  
        Requeue_With_Abort : Boolean := False;
        --  Temporary to tell caller whether requeue is with abort.
!       --  ?????
!       --  Find a better way of doing this.
  
        Needs_Requeue : Boolean := False;
        --  Temporary to tell acceptor of task entry call that
--- 702,740 ----
  
        Called_Task : Task_Id;
        pragma Atomic (Called_Task);
!       --  Use for task entry calls. The value is null if the call record is
!       --  not in use. Conversely, unless State is Done and Onqueue is false,
        --  Called_Task points to an ATCB.
!       --
!       --  Protection:  Called_Task.L
  
        Called_PO : System.Address;
        pragma Atomic (Called_PO);
!       --  Similar to Called_Task but for protected objects
!       --
        --  Note that the previous implementation tried to merge both
        --  Called_Task and Called_PO but this ended up in many unexpected
        --  complications (e.g having to add a magic number in the ATCB, which
!       --  caused gdb lots of confusion) with no real gain since the
!       --  Lock_Server implementation still need to loop around chasing for
!       --  pointer changes even with a single pointer.
  
        Acceptor_Prev_Call : Entry_Call_Link;
!       --  For task entry calls only
  
        Acceptor_Prev_Priority : Rendezvous_Priority := Priority_Not_Boosted;
!       --  For task entry calls only. The priority of the most recent prior
!       --  call being serviced. For protected entry calls, this function should
!       --  be performed by GNULLI ceiling locking.
  
        Cancellation_Attempted : Boolean := False;
        pragma Atomic (Cancellation_Attempted);
        --  Cancellation of the call has been attempted.
!       --  Consider merging this into State???
  
        Requeue_With_Abort : Boolean := False;
        --  Temporary to tell caller whether requeue is with abort.
!       --  Find a better way of doing this ???
  
        Needs_Requeue : Boolean := False;
        --  Temporary to tell acceptor of task entry call that
*************** package System.Tasking is
*** 756,765 ****
  
     type Direct_Index is range 0 .. Parameters.Default_Attribute_Count;
     subtype Direct_Index_Range is Direct_Index range 1 .. Direct_Index'Last;
!    --  Attributes with indices in this range are stored directly in
!    --  the task control block. Such attributes must be Address-sized.
!    --  Other attributes will be held in dynamically allocated records
!    --  chained off of the task control block.
  
     type Direct_Attribute_Element is mod Memory_Size;
     pragma Atomic (Direct_Attribute_Element);
--- 762,771 ----
  
     type Direct_Index is range 0 .. Parameters.Default_Attribute_Count;
     subtype Direct_Index_Range is Direct_Index range 1 .. Direct_Index'Last;
!    --  Attributes with indices in this range are stored directly in the task
!    --  control block. Such attributes must be Address-sized. Other attributes
!    --  will be held in dynamically allocated records chained off of the task
!    --  control block.
  
     type Direct_Attribute_Element is mod Memory_Size;
     pragma Atomic (Direct_Attribute_Element);
*************** package System.Tasking is
*** 772,857 ****
     --  the usage of the direct attribute fields.
  
     type Task_Serial_Number is mod 2 ** 64;
!    --  Used to give each task a unique serial number.
  
     type Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is record
        Common : Common_ATCB;
        --  The common part between various tasking implementations
  
        Entry_Calls : Entry_Call_Array;
!       --  An array of entry calls.
        --  Protection: The elements of this array are on entry call queues
        --  associated with protected objects or task entries, and are protected
        --  by the protected object lock or Acceptor.L, respectively.
  
        New_Base_Priority : System.Any_Priority;
!       --  New value for Base_Priority (for dynamic priorities package).
!       --  Protection: Self.L.
  
        Global_Task_Lock_Nesting : Natural := 0;
        --  This is the current nesting level of calls to
!       --  System.Tasking.Stages.Lock_Task_T.
!       --  This allows a task to call Lock_Task_T multiple times without
!       --  deadlocking. A task only locks All_Task_Lock when its
!       --  All_Tasks_Nesting goes from 0 to 1, and only unlocked when it
!       --  goes from 1 to 0.
!       --  Protection: Only accessed by Self.
  
        Open_Accepts : Accept_List_Access;
        --  This points to the Open_Accepts array of accept alternatives passed
!       --  to the RTS by the compiler-generated code to Selective_Wait.
!       --  It is non-null iff this task is ready to accept an entry call.
!       --  Protection: Self.L.
  
        Chosen_Index : Select_Index;
        --  The index in Open_Accepts of the entry call accepted by a selective
        --  wait executed by this task.
!       --  Protection: Written by both Self and Caller. Usually protected
!       --  by Self.L. However, once the selection is known to have been
!       --  written it can be accessed without protection. This happens
!       --  after Self has updated it itself using information from a suspended
!       --  Caller, or after Caller has updated it and awakened Self.
  
        Master_of_Task : Master_Level;
        --  The task executing the master of this task, and the ID of this task's
        --  master (unique only among masters currently active within Parent).
!       --  Protection: Set by Activator before Self is activated, and
!       --  read after Self is activated.
  
        Master_Within : Master_Level;
        --  The ID of the master currently executing within this task; that is,
        --  the most deeply nested currently active master.
        --  Protection: Only written by Self, and only read by Self or by
!       --  dependents when Self is attempting to exit a master. Since Self
!       --  will not write this field until the master is complete, the
        --  synchronization should be adequate to prevent races.
  
        Alive_Count : Integer := 0;
        --  Number of tasks directly dependent on this task (including itself)
        --  that are still "alive", i.e. not terminated.
!       --  Protection: Self.L.
  
        Awake_Count : Integer := 0;
        --  Number of tasks directly dependent on this task (including itself)
        --  still "awake", i.e., are not terminated and not waiting on a
        --  terminate alternative.
        --  Invariant: Awake_Count <= Alive_Count
-       --  Protection: Self.L.
  
!       --  beginning of flags
  
        Aborting : Boolean := False;
        pragma Atomic (Aborting);
        --  Self is in the process of aborting. While set, prevents multiple
!       --  abortion signals from being sent by different aborter while abortion
        --  is acted upon. This is essential since an aborter which calls
        --  Abort_To_Level could set the Pending_ATC_Level to yet a lower level
        --  (than the current level), may be preempted and would send the
!       --  abortion signal when resuming execution. At this point, the abortee
!       --  may have completed abortion to the proper level such that the
!       --  signal (and resulting abortion exception) are not handled any more.
        --  In other words, the flag prevents a race between multiple aborters
!       --  and the abortee.
        --  Protection: protected by atomic access.
  
        ATC_Hack : Boolean := False;
--- 778,872 ----
     --  the usage of the direct attribute fields.
  
     type Task_Serial_Number is mod 2 ** 64;
!    --  Used to give each task a unique serial number
  
     type Ada_Task_Control_Block (Entry_Num : Task_Entry_Index) is record
        Common : Common_ATCB;
        --  The common part between various tasking implementations
  
        Entry_Calls : Entry_Call_Array;
!       --  An array of entry calls
!       --
        --  Protection: The elements of this array are on entry call queues
        --  associated with protected objects or task entries, and are protected
        --  by the protected object lock or Acceptor.L, respectively.
  
        New_Base_Priority : System.Any_Priority;
!       --  New value for Base_Priority (for dynamic priorities package)
!       --
!       --  Protection: Self.L
  
        Global_Task_Lock_Nesting : Natural := 0;
        --  This is the current nesting level of calls to
!       --  System.Tasking.Stages.Lock_Task_T. This allows a task to call
!       --  Lock_Task_T multiple times without deadlocking. A task only locks
!       --  All_Task_Lock when its All_Tasks_Nesting goes from 0 to 1, and only
!       --  unlocked when it goes from 1 to 0.
!       --
!       --  Protection: Only accessed by Self
  
        Open_Accepts : Accept_List_Access;
        --  This points to the Open_Accepts array of accept alternatives passed
!       --  to the RTS by the compiler-generated code to Selective_Wait. It is
!       --  non-null iff this task is ready to accept an entry call.
!       --
!       --  Protection: Self.L
  
        Chosen_Index : Select_Index;
        --  The index in Open_Accepts of the entry call accepted by a selective
        --  wait executed by this task.
!       --
!       --  Protection: Written by both Self and Caller. Usually protected by
!       --  Self.L. However, once the selection is known to have been written it
!       --  can be accessed without protection. This happens after Self has
!       --  updated it itself using information from a suspended Caller, or
!       --  after Caller has updated it and awakened Self.
  
        Master_of_Task : Master_Level;
        --  The task executing the master of this task, and the ID of this task's
        --  master (unique only among masters currently active within Parent).
!       --
!       --  Protection: Set by Activator before Self is activated, and read
!       --  after Self is activated.
  
        Master_Within : Master_Level;
        --  The ID of the master currently executing within this task; that is,
        --  the most deeply nested currently active master.
+       --
        --  Protection: Only written by Self, and only read by Self or by
!       --  dependents when Self is attempting to exit a master. Since Self will
!       --  not write this field until the master is complete, the
        --  synchronization should be adequate to prevent races.
  
        Alive_Count : Integer := 0;
        --  Number of tasks directly dependent on this task (including itself)
        --  that are still "alive", i.e. not terminated.
!       --
!       --  Protection: Self.L
  
        Awake_Count : Integer := 0;
        --  Number of tasks directly dependent on this task (including itself)
        --  still "awake", i.e., are not terminated and not waiting on a
        --  terminate alternative.
+       --
        --  Invariant: Awake_Count <= Alive_Count
  
!       --  Protection: Self.L
! 
!       --  Beginning of flags
  
        Aborting : Boolean := False;
        pragma Atomic (Aborting);
        --  Self is in the process of aborting. While set, prevents multiple
!       --  abort signals from being sent by different aborter while abort
        --  is acted upon. This is essential since an aborter which calls
        --  Abort_To_Level could set the Pending_ATC_Level to yet a lower level
        --  (than the current level), may be preempted and would send the
!       --  abort signal when resuming execution. At this point, the abortee
!       --  may have completed abort to the proper level such that the
!       --  signal (and resulting abort exception) are not handled any more.
        --  In other words, the flag prevents a race between multiple aborters
!       --
        --  Protection: protected by atomic access.
  
        ATC_Hack : Boolean := False;
*************** package System.Tasking is
*** 863,879 ****
        --  handler itself.
  
        Callable : Boolean := True;
!       --  It is OK to call entries of this task.
  
        Dependents_Aborted : Boolean := False;
!       --  This is set to True by whichever task takes responsibility
!       --  for aborting the dependents of this task.
!       --  Protection: Self.L.
  
        Interrupt_Entry : Boolean := False;
!       --  Indicates if one or more Interrupt Entries are attached to
!       --  the task. This flag is needed for cleaning up the Interrupt
!       --  Entry bindings.
  
        Pending_Action : Boolean := False;
        --  Unified flag indicating some action needs to be take when abort
--- 878,894 ----
        --  handler itself.
  
        Callable : Boolean := True;
!       --  It is OK to call entries of this task
  
        Dependents_Aborted : Boolean := False;
!       --  This is set to True by whichever task takes responsibility for
!       --  aborting the dependents of this task.
!       --
!       --  Protection: Self.L
  
        Interrupt_Entry : Boolean := False;
!       --  Indicates if one or more Interrupt Entries are attached to the task.
!       --  This flag is needed for cleaning up the Interrupt Entry bindings.
  
        Pending_Action : Boolean := False;
        --  Unified flag indicating some action needs to be take when abort
*************** package System.Tasking is
*** 884,948 ****
        --    (Abortable field may have changed and the Wait_Until_Abortable
        --     has to recheck the abortable status of the call.)
        --  . Exception_To_Raise is non-null
!       --  Protection: Self.L.
!       --  This should never be reset back to False outside of the
!       --  procedure Do_Pending_Action, which is called by Undefer_Abort.
!       --  It should only be set to True by Set_Priority and Abort_To_Level.
  
        Pending_Priority_Change : Boolean := False;
        --  Flag to indicate pending priority change (for dynamic priorities
!       --  package). The base priority is updated on the next abortion
        --  completion point (aka. synchronization point).
!       --  Protection: Self.L.
  
        Terminate_Alternative : Boolean := False;
!       --  Task is accepting Select with Terminate Alternative.
!       --  Protection: Self.L.
  
!       --  end of flags
  
!       --  beginning of counts
  
        ATC_Nesting_Level : ATC_Level := 1;
        --  The dynamic level of ATC nesting (currently executing nested
        --  asynchronous select statements) in this task.
!       --  Protection:  Self_ID.L.
!       --  Only Self reads or updates this field.
        --  Decrementing it deallocates an Entry_Calls component, and care must
!       --  be taken that all references to that component are eliminated
!       --  before doing the decrement. This in turn will require locking
!       --  a protected object (for a protected entry call) or the Acceptor's
!       --  lock (for a task entry call).
!       --  No other task should attempt to read or modify this value.
  
        Deferral_Level : Natural := 1;
        --  This is the number of times that Defer_Abortion has been called by
!       --  this task without a matching Undefer_Abortion call. Abortion is
!       --  only allowed when this zero.
!       --  It is initially 1, to protect the task at startup.
!       --  Protection: Only updated by Self; access assumed to be atomic.
  
        Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
!       --  The ATC level to which this task is currently being aborted.
!       --  If the value is zero, the entire task has "completed".
!       --  That may be via abort, exception propagation, or normal exit.
!       --  If the value is ATC_Level_Infinity, the task is not being
!       --  aborted to any level.
!       --  If the value is positive, the task has not completed.
!       --  This should ONLY be modified by
!       --  Abort_To_Level and Exit_One_ATC_Level.
!       --  Protection: Self.L.
  
        Serial_Number : Task_Serial_Number;
!       --  A growing number to provide some way to check locking
!       --  rules/ordering.
  
        Known_Tasks_Index : Integer := -1;
!       --  Index in the System.Tasking.Debug.Known_Tasks array.
  
        User_State : Long_Integer := 0;
!       --  User-writeable location, for use in debugging tasks;
!       --  also provides a simple task specific data.
  
        Direct_Attributes : Direct_Attribute_Array;
        --  For task attributes that have same size as Address
--- 899,966 ----
        --    (Abortable field may have changed and the Wait_Until_Abortable
        --     has to recheck the abortable status of the call.)
        --  . Exception_To_Raise is non-null
!       --
!       --  Protection: Self.L
!       --
!       --  This should never be reset back to False outside of the procedure
!       --  Do_Pending_Action, which is called by Undefer_Abort. It should only
!       --  be set to True by Set_Priority and Abort_To_Level.
  
        Pending_Priority_Change : Boolean := False;
        --  Flag to indicate pending priority change (for dynamic priorities
!       --  package). The base priority is updated on the next abort
        --  completion point (aka. synchronization point).
!       --
!       --  Protection: Self.L
  
        Terminate_Alternative : Boolean := False;
!       --  Task is accepting Select with Terminate Alternative
!       --
!       --  Protection: Self.L
  
!       --  End of flags
  
!       --  Beginning of counts
  
        ATC_Nesting_Level : ATC_Level := 1;
        --  The dynamic level of ATC nesting (currently executing nested
        --  asynchronous select statements) in this task.
! 
!       --  Protection: Self_ID.L. Only Self reads or updates this field.
        --  Decrementing it deallocates an Entry_Calls component, and care must
!       --  be taken that all references to that component are eliminated before
!       --  doing the decrement. This in turn will require locking a protected
!       --  object (for a protected entry call) or the Acceptor's lock (for a
!       --  task entry call). No other task should attempt to read or modify
!       --  this value.
  
        Deferral_Level : Natural := 1;
        --  This is the number of times that Defer_Abortion has been called by
!       --  this task without a matching Undefer_Abortion call. Abortion is only
!       --  allowed when this zero. It is initially 1, to protect the task at
!       --  startup.
! 
!       --  Protection: Only updated by Self; access assumed to be atomic
  
        Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
!       --  The ATC level to which this task is currently being aborted. If the
!       --  value is zero, the entire task has "completed". That may be via
!       --  abort, exception propagation, or normal exit. If the value is
!       --  ATC_Level_Infinity, the task is not being aborted to any level. If
!       --  the value is positive, the task has not completed. This should ONLY
!       --  be modified by Abort_To_Level and Exit_One_ATC_Level.
!       --
!       --  Protection: Self.L
  
        Serial_Number : Task_Serial_Number;
!       --  A growing number to provide some way to check locking  rules/ordering
  
        Known_Tasks_Index : Integer := -1;
!       --  Index in the System.Tasking.Debug.Known_Tasks array
  
        User_State : Long_Integer := 0;
!       --  User-writeable location, for use in debugging tasks; also provides a
!       --  simple task specific data.
  
        Direct_Attributes : Direct_Attribute_Array;
        --  For task attributes that have same size as Address
*************** package System.Tasking is
*** 951,968 ****
        --  Bit I is 1 iff Direct_Attributes (I) is defined
  
        Indirect_Attributes : Access_Address;
!       --  A pointer to chain of records for other attributes that
!       --  are not address-sized, including all tagged types.
  
        Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
!       --  An array of task entry queues.
        --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
        --  has exclusive access to this field.
     end record;
  
!    ---------------------
!    -- Initialize_ATCB --
!    ---------------------
  
     procedure Initialize_ATCB
       (Self_ID          : Task_Id;
--- 969,997 ----
        --  Bit I is 1 iff Direct_Attributes (I) is defined
  
        Indirect_Attributes : Access_Address;
!       --  A pointer to chain of records for other attributes that are not
!       --  address-sized, including all tagged types.
  
        Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
!       --  An array of task entry queues
!       --
        --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
        --  has exclusive access to this field.
     end record;
  
!    --------------------
!    -- Initialization --
!    --------------------
! 
!    procedure Initialize;
!    --  This procedure constitutes the first part of the initialization of the
!    --  GNARL. This includes creating data structures to make the initial thread
!    --  into the environment task. The last part of the initialization is done
!    --  in System.Tasking.Initialization or System.Tasking.Restricted.Stages.
!    --  All the initializations used to be in Tasking.Initialization, but this
!    --  is no longer possible with the run time simplification (including
!    --  optimized PO and the restricted run time) since one cannot rely on
!    --  System.Tasking.Initialization being present, as was done before.
  
     procedure Initialize_ATCB
       (Self_ID          : Task_Id;
*************** package System.Tasking is
*** 975,995 ****
        Stack_Size       : System.Parameters.Size_Type;
        T                : Task_Id;
        Success          : out Boolean);
!    --  Initialize fields of a TCB and link into global TCB structures
!    --  Call this only with abort deferred and holding RTS_Lock.
!    --  Need more documentation, mention T, and describe Success ???
  
  private
     Null_Task : constant Task_Id := null;
  
-    GL_Detect_Blocking : Integer;
-    pragma Import (C, GL_Detect_Blocking, "__gl_detect_blocking");
-    --  Global variable exported by the binder generated file. A value
-    --  equal to 1 indicates that pragma Detect_Blocking is active,
-    --  while 0 is used for the pragma not being present.
- 
-    Detect_Blocking : constant Boolean := GL_Detect_Blocking = 1;
- 
     type Activation_Chain is record
        T_ID : Task_Id;
     end record;
--- 1004,1016 ----
        Stack_Size       : System.Parameters.Size_Type;
        T                : Task_Id;
        Success          : out Boolean);
!    --  Initialize fields of a TCB and link into global TCB structures Call
!    --  this only with abort deferred and holding RTS_Lock. Need more
!    --  documentation, mention T, and describe Success ???
  
  private
     Null_Task : constant Task_Id := null;
  
     type Activation_Chain is record
        T_ID : Task_Id;
     end record;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-dummy.ads gcc-4.1.0/gcc/ada/s-taspri-dummy.ads
*** gcc-4.0.2/gcc/ada/s-taspri-dummy.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-dummy.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Task_Primitives is
*** 44,55 ****
  
     type RTS_Lock is new Integer;
  
     type Task_Body_Access is access procedure;
  
     type Private_Data is record
!       Thread      : aliased Integer;
!       CV          : aliased Integer;
!       L           : aliased RTS_Lock;
     end record;
  
  end System.Task_Primitives;
--- 44,57 ----
  
     type RTS_Lock is new Integer;
  
+    type Suspension_Object is new Integer;
+ 
     type Task_Body_Access is access procedure;
  
     type Private_Data is record
!       Thread : aliased Integer;
!       CV     : aliased Integer;
!       L      : aliased RTS_Lock;
     end record;
  
  end System.Task_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-hpux-dce.ads gcc-4.1.0/gcc/ada/s-taspri-hpux-dce.ads
*** gcc-4.0.2/gcc/ada/s-taspri-hpux-dce.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-hpux-dce.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a HP-UX version of this package.
  
! --  This package provides low-level support for most tasking features.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 31,39 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a HP-UX version of this package
  
! --  This package provides low-level support for most tasking features
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 45,68 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
     type Lock is record
--- 45,71 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
     type Lock is record
*************** private
*** 72,89 ****
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
     type Private_Data is record
!       Thread      : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
!       CV          : aliased System.OS_Interface.pthread_cond_t;
!       L           : aliased RTS_Lock;
!       --  protection for all components is lock L
     end record;
  
  end System.Task_Primitives;
--- 75,111 ----
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
+ 
+    type Suspension_Object is record
+       State   : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.pthread_mutex_t;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
!       Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the
!       --  same value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they
!       --  are updated in atomic fashion.
  
!       CV : aliased System.OS_Interface.pthread_cond_t;
! 
!       L : aliased RTS_Lock;
!       --  Protection for all components is lock L
     end record;
  
  end System.Task_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-linux.ads gcc-4.1.0/gcc/ada/s-taspri-linux.ads
*** gcc-4.0.2/gcc/ada/s-taspri-linux.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-linux.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,96 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
- --                                                                          --
- --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
- --                                                                          --
- --                                  S p e c                                 --
- --                                                                          --
- --           Copyright (C) 1991-2001 Free Software Foundation, Inc.         --
- --                                                                          --
- -- GNARL is free software; you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNARL; see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNARL was developed by the GNARL team at Florida State University.       --
- -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is the GNU/Linux (GNU/LinuxThreads) version of this package.
- 
- --  This package provides low-level support for most tasking features.
- 
- pragma Polling (Off);
- --  Turn off polling, we do not want ATC polling to take place during
- --  tasking operations. It causes infinite loops and other problems.
- 
- with System.OS_Interface;
- --  used for pthread_mutex_t
- --           pthread_cond_t
- --           pthread_t
- 
- package System.Task_Primitives is
- 
-    type Lock is limited private;
-    --  Should be used for implementation of protected objects.
- 
-    type RTS_Lock is limited private;
-    --  Should be used inside the runtime system.
-    --  The difference between Lock and the RTS_Lock is that the later
-    --  one serves only as a semaphore so that do not check for
-    --  ceiling violations.
- 
-    type Task_Body_Access is access procedure;
-    --  Pointer to the task body's entry point (or possibly a wrapper
-    --  declared local to the GNARL).
- 
-    type Private_Data is limited private;
-    --  Any information that the GNULLI needs maintained on a per-task
-    --  basis.  A component of this type is guaranteed to be included
-    --  in the Ada_Task_Control_Block.
- 
- private
- 
-    type Prio_Array_Type is array (System.Any_Priority) of Integer;
- 
-    type Lock is record
-       L          : aliased System.OS_Interface.pthread_mutex_t;
-       Ceiling    : System.Any_Priority := System.Any_Priority'First;
-       Saved_Priority : System.Any_Priority := System.Any_Priority'First;
-    end record;
- 
-    type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
-    type Private_Data is record
-       Thread      : aliased System.OS_Interface.pthread_t;
-       pragma Atomic (Thread);
-       --  Thread field may be updated by two different threads of control.
-       --  (See, Enter_Task and Create_Task in s-taprop.adb).
-       --  They put the same value (thr_self value). We do not want to
-       --  use lock on those operations and the only thing we have to
-       --  make sure is that they are updated in atomic fashion.
- 
-       CV          : aliased System.OS_Interface.pthread_cond_t;
-       L           : aliased RTS_Lock;
-       --  protection for all components is lock L
- 
-       Active_Priority : System.Any_Priority := System.Any_Priority'First;
-       --  Simulated active priority,
-       --  used only if Priority_Ceiling_Support is True.
-    end record;
- 
- end System.Task_Primitives;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-lynxos.ads gcc-4.1.0/gcc/ada/s-taspri-lynxos.ads
*** gcc-4.0.2/gcc/ada/s-taspri-lynxos.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-lynxos.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a LynxOS version of this package, derived from
! --  7staspri.ads
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 32,38 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a LynxOS version of this package, derived from s-taspri-posix.ads
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 45,68 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
--- 44,70 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
*************** private
*** 74,87 ****
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
  
     type Private_Data is record
        Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
        LWP : aliased System.Address;
        --  The purpose of this field is to provide a better tasking support on
--- 76,106 ----
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
  
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.pthread_mutex_t;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
        Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the
!       --  same value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they
!       --  are updated in atomic fashion.
  
        LWP : aliased System.Address;
        --  The purpose of this field is to provide a better tasking support on
*************** private
*** 90,96 ****
  
        CV : aliased System.OS_Interface.pthread_cond_t;
  
!       L  : aliased RTS_Lock;
        --  Protection for all components is lock L
     end record;
  
--- 109,115 ----
  
        CV : aliased System.OS_Interface.pthread_cond_t;
  
!       L : aliased RTS_Lock;
        --  Protection for all components is lock L
     end record;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-mingw.ads gcc-4.1.0/gcc/ada/s-taspri-mingw.ads
*** gcc-4.0.2/gcc/ada/s-taspri-mingw.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-mingw.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NT (native) version of this package.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a NT (native) version of this package
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 43,66 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
--- 43,69 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
*************** private
*** 74,79 ****
--- 77,99 ----
  
     type RTS_Lock is new System.OS_Interface.CRITICAL_SECTION;
  
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.CRITICAL_SECTION;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.HANDLE;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
        Thread : aliased System.OS_Interface.HANDLE;
        pragma Atomic (Thread);
*************** private
*** 84,91 ****
        --  make sure is that they are updated in atomic fashion.
  
        Thread_Id : aliased System.OS_Interface.DWORD;
!       --  The purpose of this field is to provide a better tasking support
!       --  in gdb.
  
        CV : aliased Condition_Variable;
        --  Condition Variable used to implement Sleep/Wakeup
--- 104,110 ----
        --  make sure is that they are updated in atomic fashion.
  
        Thread_Id : aliased System.OS_Interface.DWORD;
!       --  Used to provide a better tasking support in gdb
  
        CV : aliased Condition_Variable;
        --  Condition Variable used to implement Sleep/Wakeup
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-os2.ads gcc-4.1.0/gcc/ada/s-taspri-os2.ads
*** gcc-4.0.2/gcc/ada/s-taspri-os2.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-os2.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                S Y S T E M . T A S K _ P R I M I T I V E S               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                S Y S T E M . T A S K _ P R I M I T I V E S               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,40 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OS/2 version of this package.
  
! --  This package provides low-level support for most tasking features.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 32,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is an OS/2 version of this package
  
! --  This package provides low-level support for most tasking features
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with Interfaces.OS2Lib.Threads;
*** 44,56 ****
  with Interfaces.OS2Lib.Synchronization;
  
  package System.Task_Primitives is
- 
     pragma Preelaborate;
  
! --   type Lock is limited private;
     --  Should be used for implementation of protected objects.
  
! --   type RTS_Lock is limited private;
     --  Should be used inside the runtime system.
     --  The difference between Lock and the RTS_Lock is that the later
     --  one serves only as a semaphore so that do not check for
--- 44,55 ----
  with Interfaces.OS2Lib.Synchronization;
  
  package System.Task_Primitives is
     pragma Preelaborate;
  
!    type Lock is limited private;
     --  Should be used for implementation of protected objects.
  
!    type RTS_Lock is limited private;
     --  Should be used inside the runtime system.
     --  The difference between Lock and the RTS_Lock is that the later
     --  one serves only as a semaphore so that do not check for
*************** package System.Task_Primitives is
*** 60,71 ****
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
! --   type Private_Data is limited private;
     --  Any information that the GNULLI needs maintained on a per-task
     --  basis.  A component of this type is guaranteed to be included
     --  in the Ada_Task_Control_Block.
  
! --  private
  
     type Lock is record
        Mutex          : aliased Interfaces.OS2Lib.Synchronization.HMTX;
--- 59,70 ----
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
!    type Private_Data is limited private;
     --  Any information that the GNULLI needs maintained on a per-task
     --  basis.  A component of this type is guaranteed to be included
     --  in the Ada_Task_Control_Block.
  
! private
  
     type Lock is record
        Mutex          : aliased Interfaces.OS2Lib.Synchronization.HMTX;
*************** package System.Task_Primitives is
*** 76,89 ****
  
     type RTS_Lock is new Lock;
  
     type Private_Data is record
!       Thread          : aliased Interfaces.OS2Lib.Threads.TID;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
        CV : aliased Interfaces.OS2Lib.Synchronization.HEV;
  
--- 75,105 ----
  
     type RTS_Lock is new Lock;
  
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased Interfaces.OS2Lib.Synchronization.HMTX;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased Interfaces.OS2Lib.Synchronization.HEV;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
!       Thread : aliased Interfaces.OS2Lib.Threads.TID;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
!       --  value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they are
!       --  updated in atomic fashion.
  
        CV : aliased Interfaces.OS2Lib.Synchronization.HEV;
  
*************** package System.Task_Primitives is
*** 91,107 ****
        --  Protection for all components is lock L
  
        Current_Priority : Integer := -1;
!       --  The Current_Priority is the actual priority of a thread.
!       --  This field is needed because it is only possible to set a
!       --  delta priority in OS/2. The only places where this field should
!       --  be set are Set_Priority, Create_Task and Initialize (Environment).
  
        Wrapper : Interfaces.OS2Lib.Threads.PFNTHREAD;
!       --  This is the original wrapper passed by Operations.Create_Task.
!       --  When installing an exception handler in a thread, the thread
!       --  starts executing the Exception_Wrapper which calls Wrapper
!       --  when the handler has been installed. The handler is removed when
!       --  wrapper returns.
     end record;
  
  end System.Task_Primitives;
--- 107,122 ----
        --  Protection for all components is lock L
  
        Current_Priority : Integer := -1;
!       --  The Current_Priority is the actual priority of a thread. This field
!       --  is needed because it is only possible to set delta priority in OS/2.
!       --  The only places where this field should be set are Set_Priority,
!       --  Create_Task and Initialize (Environment).
  
        Wrapper : Interfaces.OS2Lib.Threads.PFNTHREAD;
!       --  This is the original wrapper passed by Operations.Create_Task. When
!       --  installing an exception handler in a thread, the thread starts
!       --  executing the Exception_Wrapper which calls Wrapper when the handler
!       --  has been installed. The handler is removed when wrapper returns.
     end record;
  
  end System.Task_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-posix.ads gcc-4.1.0/gcc/ada/s-taspri-posix.ads
*** gcc-4.0.2/gcc/ada/s-taspri-posix.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-posix.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2003, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a POSIX-like version of this package.
! --  Note: this file can only be used for POSIX compliant systems.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 32,40 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a POSIX-like version of this package
! 
! --  Note: this file can only be used for POSIX compliant systems
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 45,82 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
!    --  Pointer to the task body's entry point (or possibly a wrapper
!    --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
     type Lock is new System.OS_Interface.pthread_mutex_t;
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
  
     type Private_Data is record
        Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
        LWP : aliased System.Address;
        --  The purpose of this field is to provide a better tasking support on
--- 46,103 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
!    --  Pointer to the task body's entry point (or possibly a wrapper declared
!    --  local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
     type Lock is new System.OS_Interface.pthread_mutex_t;
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
  
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.pthread_mutex_t;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
        Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
!       --  value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they are
!       --  updated in atomic fashion.
  
        LWP : aliased System.Address;
        --  The purpose of this field is to provide a better tasking support on
*************** private
*** 84,91 ****
        --  On targets where lwp is not relevant, this is equivalent to Thread.
  
        CV : aliased System.OS_Interface.pthread_cond_t;
  
!       L  : aliased RTS_Lock;
        --  Protection for all components is lock L
     end record;
  
--- 105,113 ----
        --  On targets where lwp is not relevant, this is equivalent to Thread.
  
        CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Should be commented ??? (in all versions of taspri)
  
!       L : aliased RTS_Lock;
        --  Protection for all components is lock L
     end record;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-solaris.ads gcc-4.1.0/gcc/ada/s-taspri-solaris.ads
*** gcc-4.0.2/gcc/ada/s-taspri-solaris.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-solaris.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
  
  --  This is a Solaris version of this package
  
! --  This package provides low-level support for most tasking features.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 33,39 ----
  
  --  This is a Solaris version of this package
  
! --  This package provides low-level support for most tasking features
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** package System.Task_Primitives is
*** 55,80 ****
  
     type RTS_Lock is limited private;
     type RTS_Lock_Ptr is access all RTS_Lock;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     function To_Lock_Ptr is new Unchecked_Conversion (RTS_Lock_Ptr, Lock_Ptr);
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
     type Private_Task_Serial_Number is mod 2 ** 64;
!    --  Used to give each task a unique serial number.
  
     type Base_Lock is new System.OS_Interface.mutex_t;
  
--- 55,82 ----
  
     type RTS_Lock is limited private;
     type RTS_Lock_Ptr is access all RTS_Lock;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
  
     function To_Lock_Ptr is new Unchecked_Conversion (RTS_Lock_Ptr, Lock_Ptr);
  
+    type Suspension_Object is limited private;
+    --  Should be used for the implementation of Ada.Synchronous_Task_Control
+ 
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
     type Private_Task_Serial_Number is mod 2 ** 64;
!    --  Used to give each task a unique serial number
  
     type Base_Lock is new System.OS_Interface.mutex_t;
  
*************** private
*** 99,126 ****
  
     type RTS_Lock is new Lock;
  
!    --  Note that task support on gdb relies on the fact that the first
!    --  2 fields of Private_Data are Thread and LWP.
  
     type Private_Data is record
!       Thread      : aliased System.OS_Interface.thread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
        LWP : System.OS_Interface.lwpid_t;
!       --  The LWP id of the thread. Set by self in Enter_Task.
  
        CV : aliased System.OS_Interface.cond_t;
        L  : aliased RTS_Lock;
        --  Protection for all components is lock L
  
        Active_Priority : System.Any_Priority := System.Any_Priority'First;
!       --  Simulated active priority,
!       --  used only if Priority_Ceiling_Support is True.
  
        Locking : Lock_Ptr;
        Locks   : Lock_Ptr;
--- 101,144 ----
  
     type RTS_Lock is new Lock;
  
!    type Suspension_Object is record
!       State : Boolean;
!       pragma Atomic (State);
!       --  Boolean that indicates whether the object is open. This field is
!       --  marked Atomic to ensure that we can read its value without locking
!       --  the access to the Suspension_Object.
! 
!       Waiting : Boolean;
!       --  Flag showing if there is a task already suspended on this object
! 
!       L : aliased System.OS_Interface.mutex_t;
!       --  Protection for ensuring mutual exclusion on the Suspension_Object
! 
!       CV : aliased System.OS_Interface.cond_t;
!       --  Condition variable used to queue threads until condition is signaled
!    end record;
! 
!    --  Note that task support on gdb relies on the fact that the first two
!    --  fields of Private_Data are Thread and LWP.
  
     type Private_Data is record
!       Thread : aliased System.OS_Interface.thread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
!       --  value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they are
!       --  updated in atomic fashion.
  
        LWP : System.OS_Interface.lwpid_t;
!       --  The LWP id of the thread. Set by self in Enter_Task
  
        CV : aliased System.OS_Interface.cond_t;
        L  : aliased RTS_Lock;
        --  Protection for all components is lock L
  
        Active_Priority : System.Any_Priority := System.Any_Priority'First;
!       --  Simulated active priority, used iff Priority_Ceiling_Support is True
  
        Locking : Lock_Ptr;
        Locks   : Lock_Ptr;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-tru64.ads gcc-4.1.0/gcc/ada/s-taspri-tru64.ads
*** gcc-4.0.2/gcc/ada/s-taspri-tru64.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-tru64.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix 4.0 version of this package.
  
! --  This package provides low-level support for most tasking features.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 31,39 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is the DEC Unix 4.0 version of this package
  
! --  This package provides low-level support for most tasking features
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 49,93 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
     type Lock is record
!       L          : aliased System.OS_Interface.pthread_mutex_t;
!       Ceiling    : Interfaces.C.int;
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
     type Private_Data is record
!       Thread      : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
!       CV          : aliased System.OS_Interface.pthread_cond_t;
!       L           : aliased RTS_Lock;
!       --  protection for all components is lock L
     end record;
  
  end System.Task_Primitives;
--- 49,114 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included
  
  private
  
     type Lock is record
!       L       : aliased System.OS_Interface.pthread_mutex_t;
!       Ceiling : Interfaces.C.int;
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
+ 
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.pthread_mutex_t;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Condition variable used to queue threads until the is signaled
+    end record;
+ 
     type Private_Data is record
!       Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
!       --  value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they are
!       --  updated in atomic fashion.
  
!       CV : aliased System.OS_Interface.pthread_cond_t;
! 
!       L : aliased RTS_Lock;
!       --  Protection for all components is lock L
     end record;
  
  end System.Task_Primitives;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-vms.ads gcc-4.1.0/gcc/ada/s-taspri-vms.ads
*** gcc-4.0.2/gcc/ada/s-taspri-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-vms.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1991-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,39 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a OpenVMS/Alpha version of this package.
  
! --  This package provides low-level support for most tasking features.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 31,39 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a OpenVMS/Alpha version of this package
  
! --  This package provides low-level support for most tasking features
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** with System.OS_Interface;
*** 49,72 ****
  --           pthread_t
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
--- 49,75 ----
  --           pthread_t
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
*************** private
*** 81,101 ****
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
     type Private_Data is record
!       Thread      : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb).
!       --  They put the same value (thr_self value). We do not want to
!       --  use lock on those operations and the only thing we have to
!       --  make sure is that they are updated in atomic fashion.
  
!       CV          : aliased System.OS_Interface.pthread_cond_t;
!       L           : aliased RTS_Lock;
!       --  protection for all components is lock L
  
        Exc_Stack_Ptr : Exc_Stack_Ptr_T;
!       --  ??? This needs comments.
  
        AST_Pending : Boolean;
        --  Used to detect delay and sleep timeouts
--- 84,123 ----
     end record;
  
     type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
+ 
+    type Suspension_Object is record
+       State   : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.pthread_mutex_t;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.pthread_cond_t;
+       --  Condition variable used to queue threads until ondition is signaled
+    end record;
+ 
     type Private_Data is record
!       Thread : aliased System.OS_Interface.pthread_t;
        pragma Atomic (Thread);
        --  Thread field may be updated by two different threads of control.
!       --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the
!       --  same value (thr_self value). We do not want to use lock on those
!       --  operations and the only thing we have to make sure is that they
!       --  are updated in atomic fashion.
  
!       CV : aliased System.OS_Interface.pthread_cond_t;
! 
!       L : aliased RTS_Lock;
!       --  Protection for all components is lock L
  
        Exc_Stack_Ptr : Exc_Stack_Ptr_T;
!       --  ??? This needs comments
  
        AST_Pending : Boolean;
        --  Used to detect delay and sleep timeouts
diff -Nrcpad gcc-4.0.2/gcc/ada/s-taspri-vxworks.ads gcc-4.1.0/gcc/ada/s-taspri-vxworks.ads
*** gcc-4.0.2/gcc/ada/s-taspri-vxworks.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-taspri-vxworks.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K _ P R I M I T I V E S              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,37 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a VxWorks version of this package.
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This is a VxWorks version of this package
  
  pragma Polling (Off);
  --  Turn off polling, we do not want ATC polling to take place during
*************** pragma Polling (Off);
*** 40,77 ****
  with System.OS_Interface;
  
  package System.Task_Primitives is
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects.
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system.
!    --  The difference between Lock and the RTS_Lock is that the later
!    --  one serves only as a semaphore so that do not check for
!    --  ceiling violations.
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task
!    --  basis.  A component of this type is guaranteed to be included
!    --  in the Ada_Task_Control_Block.
  
  private
  
     type Priority_Type is (Prio_None, Prio_Protect, Prio_Inherit);
  
     type Lock is record
!       Mutex        : System.OS_Interface.SEM_ID;
!       Protocol     : Priority_Type;
        Prio_Ceiling : System.OS_Interface.int;
!       --  priority ceiling of lock
     end record;
  
     type RTS_Lock is new Lock;
  
     type Private_Data is record
        Thread : aliased System.OS_Interface.t_id := 0;
        pragma Atomic (Thread);
--- 40,98 ----
  with System.OS_Interface;
  
  package System.Task_Primitives is
+    pragma Preelaborate;
  
     type Lock is limited private;
!    --  Should be used for implementation of protected objects
  
     type RTS_Lock is limited private;
!    --  Should be used inside the runtime system. The difference between Lock
!    --  and the RTS_Lock is that the later one serves only as a semaphore so
!    --  that do not check for ceiling violations.
! 
!    type Suspension_Object is limited private;
!    --  Should be used for the implementation of Ada.Synchronous_Task_Control
  
     type Task_Body_Access is access procedure;
     --  Pointer to the task body's entry point (or possibly a wrapper
     --  declared local to the GNARL).
  
     type Private_Data is limited private;
!    --  Any information that the GNULLI needs maintained on a per-task basis.
!    --  A component of this type is guaranteed to be included in the
!    --  Ada_Task_Control_Block.
  
  private
  
     type Priority_Type is (Prio_None, Prio_Protect, Prio_Inherit);
  
     type Lock is record
!       Mutex    : System.OS_Interface.SEM_ID;
!       Protocol : Priority_Type;
! 
        Prio_Ceiling : System.OS_Interface.int;
!       --  Priority ceiling of lock
     end record;
  
     type RTS_Lock is new Lock;
  
+    type Suspension_Object is record
+       State : Boolean;
+       pragma Atomic (State);
+       --  Boolean that indicates whether the object is open. This field is
+       --  marked Atomic to ensure that we can read its value without locking
+       --  the access to the Suspension_Object.
+ 
+       Waiting : Boolean;
+       --  Flag showing if there is a task already suspended on this object
+ 
+       L : aliased System.OS_Interface.SEM_ID;
+       --  Protection for ensuring mutual exclusion on the Suspension_Object
+ 
+       CV : aliased System.OS_Interface.SEM_ID;
+       --  Condition variable used to queue threads until condition is signaled
+    end record;
+ 
     type Private_Data is record
        Thread : aliased System.OS_Interface.t_id := 0;
        pragma Atomic (Thread);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasque.adb gcc-4.1.0/gcc/ada/s-tasque.adb
*** gcc-4.0.2/gcc/ada/s-tasque.adb	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-tasque.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . Q U E U I N G              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . Q U E U I N G              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasque.ads gcc-4.1.0/gcc/ada/s-tasque.ads
*** gcc-4.0.2/gcc/ada/s-tasque.ads	Mon May 17 13:20:44 2004
--- gcc-4.1.0/gcc/ada/s-tasque.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . Q U E U I N G              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . Q U E U I N G              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasren.adb gcc-4.1.0/gcc/ada/s-tasren.adb
*** gcc-4.0.2/gcc/ada/s-tasren.adb	Mon Jan  3 15:42:23 2005
--- gcc-4.1.0/gcc/ada/s-tasren.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --            S Y S T E M . T A S K I N G . R E N D E Z V O U S             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
  --            S Y S T E M . T A S K I N G . R E N D E Z V O U S             --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking.Rendezvous i
*** 154,160 ****
  
     procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
     pragma Inline (Boost_Priority);
!    --  Call this only with abort deferred and holding lock of Acceptor.
  
     procedure Call_Synchronous
       (Acceptor              : Task_Id;
--- 154,160 ----
  
     procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
     pragma Inline (Boost_Priority);
!    --  Call this only with abort deferred and holding lock of Acceptor
  
     procedure Call_Synchronous
       (Acceptor              : Task_Id;
*************** package body System.Tasking.Rendezvous i
*** 255,261 ****
              Uninterpreted_Data :=
                Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
           else
!             --  Case of an aborted task.
  
              Uninterpreted_Data := System.Null_Address;
           end if;
--- 255,261 ----
              Uninterpreted_Data :=
                Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
           else
!             --  Case of an aborted task
  
              Uninterpreted_Data := System.Null_Address;
           end if;
*************** package body System.Tasking.Rendezvous i
*** 555,564 ****
     procedure Exceptional_Complete_Rendezvous
       (Ex : Ada.Exceptions.Exception_Id)
     is
!       Self_Id    : constant Task_Id := STPO.Self;
!       Entry_Call : Entry_Call_Link := Self_Id.Common.Call;
!       Caller     : Task_Id;
!       Called_PO  : STPE.Protection_Entries_Access;
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex;
        Ceiling_Violation  : Boolean;
--- 555,565 ----
     procedure Exceptional_Complete_Rendezvous
       (Ex : Ada.Exceptions.Exception_Id)
     is
!       Self_Id                : constant Task_Id := STPO.Self;
!       Entry_Call             : Entry_Call_Link := Self_Id.Common.Call;
!       Caller                 : Task_Id;
!       Called_PO              : STPE.Protection_Entries_Access;
!       Acceptor_Prev_Priority : Integer;
  
        Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex;
        Ceiling_Violation  : Boolean;
*************** package body System.Tasking.Rendezvous i
*** 701,707 ****
                (Self_Id, Entry_Call.Acceptor_Prev_Priority);
  
           else
!             --  The call does not need to be requeued.
  
              Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
              Entry_Call.Exception_To_Raise := Ex;
--- 702,708 ----
                (Self_Id, Entry_Call.Acceptor_Prev_Priority);
  
           else
!             --  The call does not need to be requeued
  
              Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
              Entry_Call.Exception_To_Raise := Ex;
*************** package body System.Tasking.Rendezvous i
*** 712,718 ****
  
              STPO.Write_Lock (Caller);
  
!             --  Done with Caller locked to make sure that Wakeup is not lost.
  
              if Ex /= Ada.Exceptions.Null_Id then
                 Transfer_Occurrence
--- 713,719 ----
  
              STPO.Write_Lock (Caller);
  
!             --  Done with Caller locked to make sure that Wakeup is not lost
  
              if Ex /= Ada.Exceptions.Null_Id then
                 Transfer_Occurrence
*************** package body System.Tasking.Rendezvous i
*** 720,734 ****
                    Self_Id.Common.Compiler_Data.Current_Excep);
              end if;
  
              Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
              STPO.Unlock (Caller);
  
              if Single_Lock then
                 Unlock_RTS;
              end if;
  
!             Entry_Calls.Reset_Priority
!               (Self_Id, Entry_Call.Acceptor_Prev_Priority);
           end if;
        end if;
  
--- 721,736 ----
                    Self_Id.Common.Compiler_Data.Current_Excep);
              end if;
  
+             Acceptor_Prev_Priority := Entry_Call.Acceptor_Prev_Priority;
              Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+ 
              STPO.Unlock (Caller);
  
              if Single_Lock then
                 Unlock_RTS;
              end if;
  
!             Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
           end if;
        end if;
  
*************** package body System.Tasking.Rendezvous i
*** 844,850 ****
        Queuing.Select_Task_Entry_Call
          (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
  
!       --  Determine the kind and disposition of the select.
  
        Treatment := Default_Treatment (Select_Mode);
        Self_Id.Chosen_Index := No_Rendezvous;
--- 846,852 ----
        Queuing.Select_Task_Entry_Call
          (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
  
!       --  Determine the kind and disposition of the select
  
        Treatment := Default_Treatment (Select_Mode);
        Self_Id.Chosen_Index := No_Rendezvous;
*************** package body System.Tasking.Rendezvous i
*** 865,871 ****
           end if;
        end if;
  
!       --  Handle the select according to the disposition selected above.
  
        case Treatment is
           when Accept_Alternative_Selected =>
--- 867,873 ----
           end if;
        end if;
  
!       --  Handle the select according to the disposition selected above
  
        case Treatment is
           when Accept_Alternative_Selected =>
*************** package body System.Tasking.Rendezvous i
*** 882,888 ****
              STPO.Unlock (Self_Id);
  
           when Accept_Alternative_Completed =>
!             --  Accept body is null, so rendezvous is over immediately.
  
              if Parameters.Runtime_Traces then
                 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
--- 884,891 ----
              STPO.Unlock (Self_Id);
  
           when Accept_Alternative_Completed =>
! 
!             --  Accept body is null, so rendezvous is over immediately
  
              if Parameters.Runtime_Traces then
                 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
*************** package body System.Tasking.Rendezvous i
*** 896,902 ****
              STPO.Unlock (Caller);
  
           when Accept_Alternative_Open =>
!             --  Wait for caller.
  
              Self_Id.Open_Accepts := Open_Accepts;
              pragma Debug
--- 899,906 ----
              STPO.Unlock (Caller);
  
           when Accept_Alternative_Open =>
! 
!             --  Wait for caller
  
              Self_Id.Open_Accepts := Open_Accepts;
              pragma Debug
*************** package body System.Tasking.Rendezvous i
*** 913,921 ****
  
              --  Self_Id.Common.Call should already be updated by the Caller if
              --  not aborted. It might also be ready to do rendezvous even if
!             --  this wakes up due to an abortion.
!             --  Therefore, if the call is not empty we need to do the
!             --  rendezvous if the accept body is not Null_Body.
  
              --  Aren't the first two conditions below redundant???
  
--- 917,925 ----
  
              --  Self_Id.Common.Call should already be updated by the Caller if
              --  not aborted. It might also be ready to do rendezvous even if
!             --  this wakes up due to an abort. Therefore, if the call is not
!             --  empty we need to do the rendezvous if the accept body is not
!             --  Null_Body.
  
              --  Aren't the first two conditions below redundant???
  
*************** package body System.Tasking.Rendezvous i
*** 949,955 ****
              Self_Id.Open_Accepts := Open_Accepts;
              Self_Id.Common.State := Acceptor_Sleep;
  
!             --  Notify ancestors that this task is on a terminate alternative.
  
              STPO.Unlock (Self_Id);
              Utilities.Make_Passive (Self_Id, Task_Completed => False);
--- 953,959 ----
              Self_Id.Open_Accepts := Open_Accepts;
              Self_Id.Common.State := Acceptor_Sleep;
  
!             --  Notify ancestors that this task is on a terminate alternative
  
              STPO.Unlock (Self_Id);
              Utilities.Make_Passive (Self_Id, Task_Completed => False);
*************** package body System.Tasking.Rendezvous i
*** 1154,1160 ****
  
        STPO.Write_Lock (Acceptor);
  
!       --  If the acceptor is not callable, abort the call and return False.
  
        if not Acceptor.Callable then
           STPO.Unlock (Acceptor);
--- 1158,1164 ----
  
        STPO.Write_Lock (Acceptor);
  
!       --  If the acceptor is not callable, abort the call and return False
  
        if not Acceptor.Callable then
           STPO.Unlock (Acceptor);
*************** package body System.Tasking.Rendezvous i
*** 1176,1210 ****
           return False;
        end if;
  
!       --  Try to serve the call immediately.
  
        if Acceptor.Open_Accepts /= null then
           for J in Acceptor.Open_Accepts'Range loop
              if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
  
!                --  Commit acceptor to rendezvous with us.
  
                 Acceptor.Chosen_Index := J;
                 Null_Body := Acceptor.Open_Accepts (J).Null_Body;
                 Acceptor.Open_Accepts := null;
  
!                --  Prevent abort while call is being served.
  
                 if Entry_Call.State = Now_Abortable then
                    Entry_Call.State := Was_Abortable;
                 end if;
  
                 if Acceptor.Terminate_Alternative then
!                   --  Cancel terminate alternative.
!                   --  See matching code in Selective_Wait and
!                   --  Vulnerable_Complete_Master.
  
                    Acceptor.Terminate_Alternative := False;
                    Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
  
                    if Acceptor.Awake_Count = 1 then
  
!                      --  Notify parent that acceptor is awake.
  
                       pragma Assert (Parent.Awake_Count > 0);
  
--- 1180,1214 ----
           return False;
        end if;
  
!       --  Try to serve the call immediately
  
        if Acceptor.Open_Accepts /= null then
           for J in Acceptor.Open_Accepts'Range loop
              if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
  
!                --  Commit acceptor to rendezvous with us
  
                 Acceptor.Chosen_Index := J;
                 Null_Body := Acceptor.Open_Accepts (J).Null_Body;
                 Acceptor.Open_Accepts := null;
  
!                --  Prevent abort while call is being served
  
                 if Entry_Call.State = Now_Abortable then
                    Entry_Call.State := Was_Abortable;
                 end if;
  
                 if Acceptor.Terminate_Alternative then
! 
!                   --  Cancel terminate alternative. See matching code in
!                   --  Selective_Wait and Vulnerable_Complete_Master.
  
                    Acceptor.Terminate_Alternative := False;
                    Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
  
                    if Acceptor.Awake_Count = 1 then
  
!                      --  Notify parent that acceptor is awake
  
                       pragma Assert (Parent.Awake_Count > 0);
  
*************** package body System.Tasking.Rendezvous i
*** 1220,1226 ****
                 end if;
  
                 if Null_Body then
!                   --  Rendezvous is over immediately.
  
                    STPO.Wakeup (Acceptor, Acceptor_Sleep);
                    STPO.Unlock (Acceptor);
--- 1224,1231 ----
                 end if;
  
                 if Null_Body then
! 
!                   --  Rendezvous is over immediately
  
                    STPO.Wakeup (Acceptor, Acceptor_Sleep);
                    STPO.Unlock (Acceptor);
*************** package body System.Tasking.Rendezvous i
*** 1237,1244 ****
                 else
                    Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
  
!                   --  For terminate_alternative, acceptor may not be
!                   --  asleep yet, so we skip the wakeup
  
                    if Acceptor.Common.State /= Runnable then
                       STPO.Wakeup (Acceptor, Acceptor_Sleep);
--- 1242,1249 ----
                 else
                    Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
  
!                   --  For terminate_alternative, acceptor may not be asleep
!                   --  yet, so we skip the wakeup
  
                    if Acceptor.Common.State /= Runnable then
                       STPO.Wakeup (Acceptor, Acceptor_Sleep);
*************** package body System.Tasking.Rendezvous i
*** 1255,1261 ****
              end if;
           end loop;
  
!          --  The acceptor is accepting, but not this entry.
        end if;
  
        --  If the acceptor was ready to accept this call,
--- 1260,1266 ----
              end if;
           end loop;
  
!          --  The acceptor is accepting, but not this entry
        end if;
  
        --  If the acceptor was ready to accept this call,
*************** package body System.Tasking.Rendezvous i
*** 1360,1370 ****
        else
           --  This is an asynchronous call
  
!          --  Abortion must already be deferred by the compiler-generated
!          --  code.  Without this, an abortion that occurs between the time
!          --  that this call is made and the time that the abortable part's
!          --  cleanup handler is set up might miss the cleanup handler and
!          --  leave the call pending.
  
           Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
           pragma Debug
--- 1365,1375 ----
        else
           --  This is an asynchronous call
  
!          --  Abort must already be deferred by the compiler-generated code.
!          --  Without this, an abort that occurs between the time that this
!          --  call is made and the time that the abortable part's cleanup
!          --  handler is set up might miss the cleanup handler and leave the
!          --  call pending.
  
           Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
           pragma Debug
*************** package body System.Tasking.Rendezvous i
*** 1421,1427 ****
              Unlock_RTS;
           end if;
  
!          --  Note: following assignment needs to be atomic.
  
           Rendezvous_Successful := Entry_Call.State = Done;
        end if;
--- 1426,1432 ----
              Unlock_RTS;
           end if;
  
!          --  Note: following assignment needs to be atomic
  
           Rendezvous_Successful := Entry_Call.State = Done;
        end if;
*************** package body System.Tasking.Rendezvous i
*** 1506,1512 ****
        Queuing.Select_Task_Entry_Call
          (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
  
!       --  Determine the kind and disposition of the select.
  
        Treatment := Default_Treatment (Select_Mode);
        Self_Id.Chosen_Index := No_Rendezvous;
--- 1511,1517 ----
        Queuing.Select_Task_Entry_Call
          (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
  
!       --  Determine the kind and disposition of the select
  
        Treatment := Default_Treatment (Select_Mode);
        Self_Id.Chosen_Index := No_Rendezvous;
*************** package body System.Tasking.Rendezvous i
*** 1528,1534 ****
           end if;
        end if;
  
!       --  Handle the select according to the disposition selected above.
  
        case Treatment is
           when Accept_Alternative_Selected =>
--- 1533,1539 ----
           end if;
        end if;
  
!       --  Handle the select according to the disposition selected above
  
        case Treatment is
           when Accept_Alternative_Selected =>
*************** package body System.Tasking.Rendezvous i
*** 1555,1561 ****
              STPO.Unlock (Caller);
  
           when Accept_Alternative_Open =>
!             --  Wait for caller.
  
              Self_Id.Open_Accepts := Open_Accepts;
  
--- 1560,1567 ----
              STPO.Unlock (Caller);
  
           when Accept_Alternative_Open =>
! 
!             --  Wait for caller
  
              Self_Id.Open_Accepts := Open_Accepts;
  
*************** package body System.Tasking.Rendezvous i
*** 1563,1571 ****
              --  Wakeup_Time is reached.
  
              --  Try to remove calls to Sleep in the loop below by letting the
!             --  caller a chance of getting ready immediately, using Unlock &
!             --  Yield.
!             --  See similar action in Wait_For_Completion & Wait_For_Call.
  
              if Single_Lock then
                 Unlock_RTS;
--- 1569,1576 ----
              --  Wakeup_Time is reached.
  
              --  Try to remove calls to Sleep in the loop below by letting the
!             --  caller a chance of getting ready immediately, using Unlock
!             --  Yield. See similar action in Wait_For_Completion/Wait_For_Call.
  
              if Single_Lock then
                 Unlock_RTS;
*************** package body System.Tasking.Rendezvous i
*** 1622,1630 ****
  
              --  Self_Id.Common.Call should already be updated by the Caller if
              --  not aborted. It might also be ready to do rendezvous even if
!             --  this wakes up due to an abortion.
!             --  Therefore, if the call is not empty we need to do the
!             --  rendezvous if the accept body is not Null_Body.
  
              if Self_Id.Chosen_Index /= No_Rendezvous
                and then Self_Id.Common.Call /= null
--- 1627,1635 ----
  
              --  Self_Id.Common.Call should already be updated by the Caller if
              --  not aborted. It might also be ready to do rendezvous even if
!             --  this wakes up due to an abort. Therefore, if the call is not
!             --  empty we need to do the rendezvous if the accept body is not
!             --  Null_Body.
  
              if Self_Id.Chosen_Index /= No_Rendezvous
                and then Self_Id.Common.Call /= null
*************** package body System.Tasking.Rendezvous i
*** 1648,1654 ****
              --  for several reasons:
              --  1) Delay is expired
              --  2) Pending_Action needs to be checked
!             --     (Abortion, Priority change)
              --  3) Spurious wakeup
  
              Self_Id.Open_Accepts := null;
--- 1653,1659 ----
              --  for several reasons:
              --  1) Delay is expired
              --  2) Pending_Action needs to be checked
!             --     (Abort, Priority change)
              --  3) Spurious wakeup
  
              Self_Id.Open_Accepts := null;
*************** package body System.Tasking.Rendezvous i
*** 1753,1759 ****
        Entry_Call.Called_PO := Null_Address;
        Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
  
!       --  Note: the caller will undefer abortion on return (see WARNING above)
  
        if Single_Lock then
           Lock_RTS;
--- 1758,1764 ----
        Entry_Call.Called_PO := Null_Address;
        Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
  
!       --  Note: the caller will undefer abort on return (see WARNING above)
  
        if Single_Lock then
           Lock_RTS;
*************** package body System.Tasking.Rendezvous i
*** 1820,1826 ****
           Write_Lock (Self_Id);
        end if;
  
!       --  Check if this task has been aborted while the lock was released.
  
        if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
           Self_Id.Open_Accepts := null;
--- 1825,1831 ----
           Write_Lock (Self_Id);
        end if;
  
!       --  Check if this task has been aborted while the lock was released
  
        if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
           Self_Id.Open_Accepts := null;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasren.ads gcc-4.1.0/gcc/ada/s-tasren.ads
*** gcc-4.0.2/gcc/ada/s-tasren.ads	Mon May 17 13:20:45 2004
--- gcc-4.1.0/gcc/ada/s-tasren.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . R E N D E Z V O U S            --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . R E N D E Z V O U S            --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasres.ads gcc-4.1.0/gcc/ada/s-tasres.ads
*** gcc-4.0.2/gcc/ada/s-tasres.ads	Tue Oct 21 13:42:15 2003
--- gcc-4.1.0/gcc/ada/s-tasres.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . R E S T R I C T E D            --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1998-1999, Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --             S Y S T E M . T A S K I N G . R E S T R I C T E D            --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1998-2005, Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tassta.adb gcc-4.1.0/gcc/ada/s-tassta.adb
*** gcc-4.0.2/gcc/ada/s-tassta.adb	Thu Feb 10 13:54:45 2005
--- gcc-4.1.0/gcc/ada/s-tassta.adb	Tue Nov 15 13:53:05 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . S T A G E S                --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . S T A G E S                --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Polling (Off);
*** 36,59 ****
  --  tasking operations. It causes infinite loops and other problems.
  
  with Ada.Exceptions;
! --  used for Raise_Exception
  
  with System.Tasking.Debug;
! --  used for enabling tasking facilities with gdb
  
  with System.Address_Image;
! --  used for the function itself.
  
  with System.Parameters;
! --  used for Size_Type
  --           Single_Lock
  --           Runtime_Traces
  
  with System.Task_Info;
! --  used for Task_Info_Type
  
  with System.Task_Primitives.Operations;
! --  used for Finalize_Lock
  --           Enter_Task
  --           Write_Lock
  --           Unlock
--- 36,59 ----
  --  tasking operations. It causes infinite loops and other problems.
  
  with Ada.Exceptions;
! --  Used for Raise_Exception
  
  with System.Tasking.Debug;
! --  Used for enabling tasking facilities with gdb
  
  with System.Address_Image;
! --  Used for the function itself
  
  with System.Parameters;
! --  Used for Size_Type
  --           Single_Lock
  --           Runtime_Traces
  
  with System.Task_Info;
! --  Used for Task_Info_Type
  
  with System.Task_Primitives.Operations;
! --  Used for Finalize_Lock
  --           Enter_Task
  --           Write_Lock
  --           Unlock
*************** with System.Task_Primitives.Operations;
*** 64,74 ****
  --           New_ATCB
  
  with System.Soft_Links;
! --  These are procedure pointers to non-tasking routines that use
! --  task specific data. In the absence of tasking, these routines
! --  refer to global data. In the presense of tasking, they must be
! --  replaced with pointers to task-specific versions.
! --  Also used for Create_TSD, Destroy_TSD, Get_Current_Excep
  
  with System.Tasking.Initialization;
  --  Used for Remove_From_All_Tasks_List
--- 64,74 ----
  --           New_ATCB
  
  with System.Soft_Links;
! --  These are procedure pointers to non-tasking routines that use task
! --  specific data. In the absence of tasking, these routines refer to global
! --  data. In the presense of tasking, they must be replaced with pointers to
! --  task-specific versions. Also used for Create_TSD, Destroy_TSD,
! --  Get_Current_Excep
  
  with System.Tasking.Initialization;
  --  Used for Remove_From_All_Tasks_List
*************** with System.Tasking.Initialization;
*** 79,85 ****
  --           Initialize_Attributes_Link
  
  pragma Elaborate_All (System.Tasking.Initialization);
! --  This insures that tasking is initialized if any tasks are created.
  
  with System.Tasking.Utilities;
  --  Used for Make_Passive
--- 79,85 ----
  --           Initialize_Attributes_Link
  
  pragma Elaborate_All (System.Tasking.Initialization);
! --  This insures that tasking is initialized if any tasks are created
  
  with System.Tasking.Utilities;
  --  Used for Make_Passive
*************** with System.Finalization_Implementation;
*** 98,119 ****
  --  Used for System.Finalization_Implementation.Finalize_Global_List
  
  with System.Secondary_Stack;
! --  used for SS_Init
  
  with System.Storage_Elements;
! --  used for Storage_Array
  
  with System.Restrictions;
! --  used for Abort_Allowed
  
  with System.Standard_Library;
! --  used for Exception_Trace
  
  with System.Traces.Tasking;
! --  used for Send_Trace_Info
  
  with Unchecked_Deallocation;
! --  To recover from failure of ATCB initialization.
  
  package body System.Tasking.Stages is
  
--- 98,119 ----
  --  Used for System.Finalization_Implementation.Finalize_Global_List
  
  with System.Secondary_Stack;
! --  Used for SS_Init
  
  with System.Storage_Elements;
! --  Used for Storage_Array
  
  with System.Restrictions;
! --  Used for Abort_Allowed
  
  with System.Standard_Library;
! --  Used for Exception_Trace
  
  with System.Traces.Tasking;
! --  Used for Send_Trace_Info
  
  with Unchecked_Deallocation;
! --  To recover from failure of ATCB initialization
  
  package body System.Tasking.Stages is
  
*************** package body System.Tasking.Stages is
*** 617,632 ****
             (Storage_Error'Identity, "Failed to initialize task");
        end if;
  
-       if not System.Restrictions.Abort_Allowed then
- 
-          --  If Abort is not allowed, reset the deferral level since it will
-          --  not get changed by the generated code. Keeping a default value
-          --  of one would prevent some operations (e.g. select or delay) to
-          --  proceed successfully.
- 
-          T.Deferral_Level := 0;
-       end if;
- 
        T.Master_of_Task := Master;
        T.Master_Within := T.Master_of_Task + 1;
  
--- 617,622 ----
*************** package body System.Tasking.Stages is
*** 787,797 ****
  
        Self_ID.Callable := False;
  
!       --  Exit level 2 master, for normal tasks in library-level packages.
  
        Complete_Master;
  
!       --  Force termination of "independent" library-level server tasks.
  
        Lock_RTS;
  
--- 777,787 ----
  
        Self_ID.Callable := False;
  
!       --  Exit level 2 master, for normal tasks in library-level packages
  
        Complete_Master;
  
!       --  Force termination of "independent" library-level server tasks
  
        Lock_RTS;
  
*************** package body System.Tasking.Stages is
*** 846,853 ****
        SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access;
        SSL.Get_Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT'Access;
        SSL.Set_Sec_Stack_Addr := SSL.Set_Sec_Stack_Addr_NT'Access;
-       SSL.Get_Exc_Stack_Addr := SSL.Get_Exc_Stack_Addr_NT'Access;
-       SSL.Set_Exc_Stack_Addr := SSL.Set_Exc_Stack_Addr_NT'Access;
        SSL.Check_Abort_Status := SSL.Check_Abort_Status_NT'Access;
        SSL.Get_Stack_Info     := SSL.Get_Stack_Info_NT'Access;
  
--- 836,841 ----
*************** package body System.Tasking.Stages is
*** 952,957 ****
--- 940,955 ----
        Lock_RTS;
        Unlock_RTS;
  
+       if not System.Restrictions.Abort_Allowed then
+ 
+          --  If Abort is not allowed, reset the deferral level since it will
+          --  not get changed by the generated code. Keeping a default value
+          --  of one would prevent some operations (e.g. select or delay) to
+          --  proceed successfully.
+ 
+          Self_ID.Deferral_Level := 0;
+       end if;
+ 
        begin
           --  We are separating the following portion of the code in order to
           --  place the exception handlers in a different block. In this way,
*************** package body System.Tasking.Stages is
*** 977,983 ****
           --  clean ups associated with the exception handler that need to
           --  access task specific data.
  
!          --  Defer abortion so that this task can't be aborted while exiting
  
           when Standard'Abort_Signal =>
              Initialization.Defer_Abort_Nestable (Self_ID);
--- 975,981 ----
           --  clean ups associated with the exception handler that need to
           --  access task specific data.
  
!          --  Defer abort so that this task can't be aborted while exiting
  
           when Standard'Abort_Signal =>
              Initialization.Defer_Abort_Nestable (Self_ID);
*************** package body System.Tasking.Stages is
*** 1135,1141 ****
        procedure To_Stderr (S : String);
        pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
  
-       use System.Task_Info;
        use System.Soft_Links;
        use System.Standard_Library;
  
--- 1133,1138 ----
*************** package body System.Tasking.Stages is
*** 1209,1215 ****
  
        --  The activator raises a Tasking_Error if any task it is activating
        --  is completed before the activation is done. However, if the reason
!       --  for the task completion is an abortion, we do not raise an exception.
        --  See RM 9.2(5).
  
        if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
--- 1206,1212 ----
  
        --  The activator raises a Tasking_Error if any task it is activating
        --  is completed before the activation is done. However, if the reason
!       --  for the task completion is an abort, we do not raise an exception.
        --  See RM 9.2(5).
  
        if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
*************** package body System.Tasking.Stages is
*** 1392,1398 ****
  
           pragma Assert (Self_ID.Common.Wait_Count = 0);
  
!          --  Force any remaining dependents to terminate, by aborting them.
  
           if not Single_Lock then
              Lock_RTS;
--- 1389,1395 ----
  
           pragma Assert (Self_ID.Common.Wait_Count = 0);
  
!          --  Force any remaining dependents to terminate by aborting them
  
           if not Single_Lock then
              Lock_RTS;
*************** package body System.Tasking.Stages is
*** 1461,1468 ****
           Unlock (Self_ID);
        end if;
  
!       --  We don't wake up for abortion here. We are already terminating
!       --  just as fast as we can, so there is no point.
  
        --  Remove terminated tasks from the list of Self_ID's dependents, but
        --  don't free their ATCBs yet, because of lock order restrictions,
--- 1458,1465 ----
           Unlock (Self_ID);
        end if;
  
!       --  We don't wake up for abort here. We are already terminating just as
!       --  fast as we can, so there is no point.
  
        --  Remove terminated tasks from the list of Self_ID's dependents, but
        --  don't free their ATCBs yet, because of lock order restrictions,
*************** package body System.Tasking.Stages is
*** 1687,1693 ****
  --  Package elaboration code
  
  begin
!    --  Establish the Adafinal softlink.
  
     --  This is not done inside the central RTS initialization routine
     --  to avoid with-ing this package from System.Tasking.Initialization.
--- 1684,1690 ----
  --  Package elaboration code
  
  begin
!    --  Establish the Adafinal softlink
  
     --  This is not done inside the central RTS initialization routine
     --  to avoid with-ing this package from System.Tasking.Initialization.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tassta.ads gcc-4.1.0/gcc/ada/s-tassta.ads
*** gcc-4.0.2/gcc/ada/s-tassta.ads	Mon May 17 13:20:45 2004
--- gcc-4.1.0/gcc/ada/s-tassta.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . S T A G E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T A S K I N G . S T A G E S                --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Tasking.Stages is
*** 121,129 ****
     --   activate_tasks (_chain'unchecked_access);
  
     procedure Abort_Tasks (Tasks : Task_List);
!    --  Compiler interface only. Do not call from within the RTS.
!    --  Initiate abortion, however, the actual abortion is done by abortee by
!    --  means of Abort_Handler and Abort_Undefer
     --
     --  source code:
     --     Abort T1, T2;
--- 121,129 ----
     --   activate_tasks (_chain'unchecked_access);
  
     procedure Abort_Tasks (Tasks : Task_List);
!    --  Compiler interface only. Do not call from within the RTS. Initiate
!    --  abort, however, the actual abort is done by abortee by means of
!    --  Abort_Handler and Abort_Undefer
     --
     --  source code:
     --     Abort T1, T2;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasuti.adb gcc-4.1.0/gcc/ada/s-tasuti.adb
*** gcc-4.0.2/gcc/ada/s-tasuti.adb	Mon May 17 13:20:46 2004
--- gcc-4.1.0/gcc/ada/s-tasuti.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --              S Y S T E M . T A S K I N G . U T I L I T I E S             --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --              S Y S T E M . T A S K I N G . U T I L I T I E S             --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking.Utilities is
*** 294,300 ****
  
        if Parent /= Environment_Task then
  
!          --  We can not lock three tasks at the same time, so defer the
           --  operations on the parent.
  
           Parent_Needs_Updating := True;
--- 294,300 ----
  
        if Parent /= Environment_Task then
  
!          --  We cannot lock three tasks at the same time, so defer the
           --  operations on the parent.
  
           Parent_Needs_Updating := True;
*************** package body System.Tasking.Utilities is
*** 382,388 ****
              pragma Assert (Self_ID.Awake_Count = 1);
           end if;
  
!       --  We are accepting with a terminate alternative.
  
        else
           if Self_ID.Open_Accepts = null then
--- 382,388 ----
              pragma Assert (Self_ID.Awake_Count = 1);
           end if;
  
!       --  We are accepting with a terminate alternative
  
        else
           if Self_ID.Open_Accepts = null then
*************** package body System.Tasking.Utilities is
*** 494,500 ****
        --  C has a parent, P.
  
        loop
!          --  Notify P that C has gone passive.
  
           P.Awake_Count := P.Awake_Count - 1;
  
--- 494,500 ----
        --  C has a parent, P.
  
        loop
!          --  Notify P that C has gone passive
  
           P.Awake_Count := P.Awake_Count - 1;
  
*************** package body System.Tasking.Utilities is
*** 516,522 ****
           Write_Lock (C);
        end loop;
  
!       --  P has non-passive dependents.
  
        if P.Common.State = Master_Completion_Sleep
          and then C.Master_of_Task = P.Master_Within
--- 516,522 ----
           Write_Lock (C);
        end loop;
  
!       --  P has non-passive dependents
  
        if P.Common.State = Master_Completion_Sleep
          and then C.Master_of_Task = P.Master_Within
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tasuti.ads gcc-4.1.0/gcc/ada/s-tasuti.ads
*** gcc-4.0.2/gcc/ada/s-tasuti.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tasuti.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --              S Y S T E M . T A S K I N G . U T I L I T I E S             --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --              S Y S T E M . T A S K I N G . U T I L I T I E S             --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Tasking.Utilities is
*** 72,80 ****
     --  the environment task (because every independent task depends on it),
     --  this counter is protected by the environment task's lock.
  
!    ------------------------------------
!    -- Task Abortion related routines --
!    ------------------------------------
  
     procedure Cancel_Queued_Entry_Calls (T : Task_Id);
     --  Cancel any entry calls queued on target task.
--- 72,80 ----
     --  the environment task (because every independent task depends on it),
     --  this counter is protected by the environment task's lock.
  
!    ---------------------------------
!    -- Task Abort Related Routines --
!    ---------------------------------
  
     procedure Cancel_Queued_Entry_Calls (T : Task_Id);
     --  Cancel any entry calls queued on target task.
*************** package System.Tasking.Utilities is
*** 93,105 ****
     --    (3) always aborts whole task
  
     procedure Abort_Tasks (Tasks : Task_List);
!    --  Abort_Tasks is called to initiate abortion, however, the actual
!    --  abortion is done by abortee by means of Abort_Handler
  
     procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean);
!    --  Update counts to indicate current task is either terminated
!    --  or accepting on a terminate alternative.
!    --  Call holding no locks except Global_Task_Lock when calling from
!    --  Terminate_Task, and RTS_Lock when Single_Lock is True.
  
  end System.Tasking.Utilities;
--- 93,105 ----
     --    (3) always aborts whole task
  
     procedure Abort_Tasks (Tasks : Task_List);
!    --  Abort_Tasks is called to initiate abort, however, the actual
!    --  aborti is done by aborted task by means of Abort_Handler
  
     procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean);
!    --  Update counts to indicate current task is either terminated or
!    --  accepting on a terminate alternative. Call holding no locks except
!    --  Global_Task_Lock when calling from Terminate_Task, and RTS_Lock when
!    --  Single_Lock is True.
  
  end System.Tasking.Utilities;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tataat.adb gcc-4.1.0/gcc/ada/s-tataat.adb
*** gcc-4.0.2/gcc/ada/s-tataat.adb	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tataat.adb	Mon Sep  5 07:48:10 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . T A S K _ A T T R I B U T E S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . T A S K _ A T T R I B U T E S      --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Tasking.Task_Attribu
*** 61,69 ****
  
     procedure Finalize (X : in out Instance) is
        Q, To_Be_Freed : Access_Node;
  
     begin
!       Defer_Abortion;
        Lock_RTS;
  
        --  Remove this instantiation from the list of all instantiations.
--- 61,70 ----
  
     procedure Finalize (X : in out Instance) is
        Q, To_Be_Freed : Access_Node;
+       Self_Id        : constant Task_Id := Self;
  
     begin
!       Defer_Abort (Self_Id);
        Lock_RTS;
  
        --  Remove this instantiation from the list of all instantiations.
*************** package body System.Tasking.Task_Attribu
*** 91,103 ****
  
           In_Use := In_Use and not (2**Natural (X.Index));
  
!          --  There is no need for finalization in this case,
!          --  since controlled types are too big to fit in the TCB.
  
        else
!          --  Remove nodes for this attribute from the lists of
!          --  all tasks, and deallocate the nodes.
!          --  Deallocation does finalization, if necessary.
  
           declare
              C : System.Tasking.Task_Id := All_Tasks_List;
--- 92,104 ----
  
           In_Use := In_Use and not (2**Natural (X.Index));
  
!          --  There is no need for finalization in this case, since controlled
!          --  types are too big to fit in the TCB.
  
        else
!          --  Remove nodes for this attribute from the lists of all tasks,
!          --  and deallocate the nodes. Deallocation does finalization, if
!          --  necessary.
  
           declare
              C : System.Tasking.Task_Id := All_Tasks_List;
*************** package body System.Tasking.Task_Attribu
*** 122,128 ****
                       P.Next := Q.Next;
                    end if;
  
!                   --  Can't Deallocate now since we are holding RTS_Lock.
  
                    Q.Next := To_Be_Freed;
                    To_Be_Freed := Q;
--- 123,129 ----
                       P.Next := Q.Next;
                    end if;
  
!                   --  Can't Deallocate now since we are holding RTS_Lock
  
                    Q.Next := To_Be_Freed;
                    To_Be_Freed := Q;
*************** package body System.Tasking.Task_Attribu
*** 142,148 ****
           X.Deallocate.all (Q);
        end loop;
  
!       Undefer_Abortion;
  
     exception
        when others =>
--- 143,149 ----
           X.Deallocate.all (Q);
        end loop;
  
!       Undefer_Abort (Self_Id);
  
     exception
        when others =>
*************** package body System.Tasking.Task_Attribu
*** 163,169 ****
        Q : Access_Node := To_Access_Node (T.Indirect_Attributes);
  
     begin
!       --  Deallocate all the indirect attributes of this task.
  
        while Q /= null loop
           P := Q;
--- 164,170 ----
        Q : Access_Node := To_Access_Node (T.Indirect_Attributes);
  
     begin
!       --  Deallocate all the indirect attributes of this task
  
        while Q /= null loop
           P := Q;
*************** package body System.Tasking.Task_Attribu
*** 183,197 ****
     -- Initialize Attributes --
     ---------------------------
  
!    --  This is to be called by System.Tasking.Stages.Create_Task.
  
     procedure Initialize_Attributes (T : Task_Id) is
!       P : Access_Instance;
     begin
!       Defer_Abortion;
        Lock_RTS;
  
!       --  Initialize all the direct-access attributes of this task.
  
        P := All_Attributes;
  
--- 184,200 ----
     -- Initialize Attributes --
     ---------------------------
  
!    --  This is to be called by System.Tasking.Stages.Create_Task
  
     procedure Initialize_Attributes (T : Task_Id) is
!       P       : Access_Instance;
!       Self_Id : constant Task_Id := Self;
! 
     begin
!       Defer_Abort (Self_Id);
        Lock_RTS;
  
!       --  Initialize all the direct-access attributes of this task
  
        P := All_Attributes;
  
*************** package body System.Tasking.Task_Attribu
*** 206,212 ****
        end loop;
  
        Unlock_RTS;
!       Undefer_Abortion;
  
     exception
        when others =>
--- 209,215 ----
        end loop;
  
        Unlock_RTS;
!       Undefer_Abort (Self_Id);
  
     exception
        when others =>
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tataat.ads gcc-4.1.0/gcc/ada/s-tataat.ads
*** gcc-4.0.2/gcc/ada/s-tataat.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tataat.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . T A S K _ A T T R I B U T E S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --             Copyright (C) 1995-2004, Ada Core Technologies               --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --         S Y S T E M . T A S K I N G . T A S K _ A T T R I B U T E S      --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
  --             Copyright (C) 1991-1994, Florida State University            --
! --                     Copyright (C) 1995-2005, AdaCore                     --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,44 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides support for the body of Ada.Task_Attributes.
  
  with Ada.Finalization;
! --  used for Limited_Controlled
  
  with System.Storage_Elements;
! --  used for Integer_Address
  
  package System.Tasking.Task_Attributes is
  
--- 32,44 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package provides support for the body of Ada.Task_Attributes
  
  with Ada.Finalization;
! --  Used for Limited_Controlled
  
  with System.Storage_Elements;
! --  Used for Integer_Address
  
  package System.Tasking.Task_Attributes is
  
*************** package System.Tasking.Task_Attributes i
*** 52,59 ****
  
     function To_Access_Node is new Unchecked_Conversion
       (Access_Address, Access_Node);
!    --  Used to fetch pointer to indirect attribute list. Declaration is
!    --  in spec to avoid any problems with aliasing assumptions.
  
     type Dummy_Wrapper;
     type Access_Dummy_Wrapper is access all Dummy_Wrapper;
--- 52,59 ----
  
     function To_Access_Node is new Unchecked_Conversion
       (Access_Address, Access_Node);
!    --  Used to fetch pointer to indirect attribute list. Declaration is in
!    --  spec to avoid any problems with aliasing assumptions.
  
     type Dummy_Wrapper;
     type Access_Dummy_Wrapper is access all Dummy_Wrapper;
*************** package System.Tasking.Task_Attributes i
*** 67,73 ****
     --  of type Wrapper, no Dummy_Wrapper objects are ever created.
  
     type Deallocator is access procedure (P : in out Access_Node);
!    --  Called to deallocate an Wrapper. P is a pointer to a Node within.
  
     type Instance;
  
--- 67,73 ----
     --  of type Wrapper, no Dummy_Wrapper objects are ever created.
  
     type Deallocator is access procedure (P : in out Access_Node);
!    --  Called to deallocate an Wrapper. P is a pointer to a Node within
  
     type Instance;
  
*************** package System.Tasking.Task_Attributes i
*** 78,88 ****
        Initial_Value : aliased System.Storage_Elements.Integer_Address;
  
        Index : Direct_Index;
!       --  The index of the TCB location used by this instantiation,
!       --  if it is stored in the TCB, otherwise zero.
  
        Next : Access_Instance;
!       --  Next instance in All_Attributes list.
     end record;
  
     procedure Finalize (X : in out Instance);
--- 78,88 ----
        Initial_Value : aliased System.Storage_Elements.Integer_Address;
  
        Index : Direct_Index;
!       --  The index of the TCB location used by this instantiation, if it is
!       --  stored in the TCB, otherwise zero.
  
        Next : Access_Instance;
!       --  Next instance in All_Attributes list
     end record;
  
     procedure Finalize (X : in out Instance);
*************** package System.Tasking.Task_Attributes i
*** 93,104 ****
        Next     : Access_Node;
     end record;
  
!    --  The following type is a stand-in for the actual
!    --  wrapper type, which is different for each instantiation
!    --  of Ada.Task_Attributes.
  
     type Dummy_Wrapper is record
!       Noed : aliased Node;
  
        Value : aliased Attribute;
        --  The generic formal type, may be controlled
--- 93,103 ----
        Next     : Access_Node;
     end record;
  
!    --  The following type is a stand-in for the actual wrapper type, which is
!    --  different for each instantiation of Ada.Task_Attributes.
  
     type Dummy_Wrapper is record
!       Dummy_Node : aliased Node;
  
        Value : aliased Attribute;
        --  The generic formal type, may be controlled
*************** package System.Tasking.Task_Attributes i
*** 110,132 ****
     --  Ensure that the designated object is always strictly enough aligned.
  
     In_Use : Direct_Index_Vector := 0;
!    --  is True for direct indices that are already used.
  
     All_Attributes : Access_Instance;
!    --  A linked list of all indirectly access attributes,
!    --  which includes all those that require finalization.
  
     procedure Initialize_Attributes (T : Task_Id);
!    --  Initialize all attributes created via Ada.Task_Attributes for T.
!    --  This must be called by the creator of the task, inside Create_Task,
!    --  via soft-link Initialize_Attributes_Link. On entry, abortion must
!    --  be deferred and the caller must hold no locks
  
     procedure Finalize_Attributes (T : Task_Id);
     --  Finalize all attributes created via Ada.Task_Attributes for T.
     --  This is to be called by the task after it is marked as terminated
     --  (and before it actually dies), inside Vulnerable_Free_Task, via the
!    --  soft-link Finalize_Attributes_Link. On entry, abortion must be deferred
     --  and T.L must be write-locked.
  
  end System.Tasking.Task_Attributes;
--- 109,131 ----
     --  Ensure that the designated object is always strictly enough aligned.
  
     In_Use : Direct_Index_Vector := 0;
!    --  Set True for direct indices that are already used (True??? type???)
  
     All_Attributes : Access_Instance;
!    --  A linked list of all indirectly access attributes, which includes all
!    --  those that require finalization.
  
     procedure Initialize_Attributes (T : Task_Id);
!    --  Initialize all attributes created via Ada.Task_Attributes for T. This
!    --  must be called by the creator of the task, inside Create_Task, via
!    --  soft-link Initialize_Attributes_Link. On entry, abort must be deferred
!    --  and the caller must hold no locks
  
     procedure Finalize_Attributes (T : Task_Id);
     --  Finalize all attributes created via Ada.Task_Attributes for T.
     --  This is to be called by the task after it is marked as terminated
     --  (and before it actually dies), inside Vulnerable_Free_Task, via the
!    --  soft-link Finalize_Attributes_Link. On entry, abort must be deferred
     --  and T.L must be write-locked.
  
  end System.Tasking.Task_Attributes;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tfsetr-default.adb gcc-4.1.0/gcc/ada/s-tfsetr-default.adb
*** gcc-4.0.2/gcc/ada/s-tfsetr-default.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tfsetr-default.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . T R A C E S . S E N D                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . T R A C E S . S E N D                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tfsetr-vxworks.adb gcc-4.1.0/gcc/ada/s-tfsetr-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-tfsetr-vxworks.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tfsetr-vxworks.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                     S Y S T E M . T R A C E S . S E N D                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                     S Y S T E M . T R A C E S . S E N D                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-thread.adb gcc-4.1.0/gcc/ada/s-thread.adb
*** gcc-4.0.2/gcc/ada/s-thread.adb	Thu Nov 20 09:54:02 2003
--- gcc-4.1.0/gcc/ada/s-thread.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpinop.adb gcc-4.1.0/gcc/ada/s-tpinop.adb
*** gcc-4.0.2/gcc/ada/s-tpinop.adb	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tpinop.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                S Y S T E M . T A S K _ P R I M I T I V E S .             --
  --                   I N T E R R U P T _ O P E R A T I O N S                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                S Y S T E M . T A S K _ P R I M I T I V E S .             --
  --                   I N T E R R U P T _ O P E R A T I O N S                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpinop.ads gcc-4.1.0/gcc/ada/s-tpinop.ads
*** gcc-4.0.2/gcc/ada/s-tpinop.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tpinop.ads	Thu Sep 22 10:28:14 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.INTERRUPT_OPERATIONS               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1998-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --               S Y S T E M . T A S K _ P R I M I T I V E S .              --
! --                  I N T E R R U P T _ O P E R A T I O N S                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 1998-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,39 ****
--- 34,42 ----
  
  with System.Interrupt_Management;
  with System.Tasking;
+ 
  package System.Task_Primitives.Interrupt_Operations is
+    pragma Preelaborate;
  
     package IM renames System.Interrupt_Management;
     package ST renames System.Tasking;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpoben.adb gcc-4.1.0/gcc/ada/s-tpoben.adb
*** gcc-4.0.2/gcc/ada/s-tpoben.adb	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/s-tpoben.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
! --                 SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
! --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .   --
! --                               E N T R I E S                              --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,69 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains all the simple primitives related to
! --  Protected_Objects with entries (i.e init, lock, unlock).
  
  --  The handling of protected objects with no entries is done in
  --  System.Tasking.Protected_Objects, the complex routines for protected
  --  objects with entries in System.Tasking.Protected_Objects.Operations.
  --  The split between Entries and Operations is needed to break circular
  --  dependencies inside the run time.
  
! --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  
  with Ada.Exceptions;
! --  used for Exception_Occurrence_Access
  --           Raise_Exception
  
  with System.Task_Primitives.Operations;
! --  used for Initialize_Lock
  --           Write_Lock
  --           Unlock
  --           Get_Priority
  --           Wakeup
  
  with System.Tasking.Initialization;
! --  used for Defer_Abort,
  --           Undefer_Abort,
  --           Change_Base_Priority
  
  pragma Elaborate_All (System.Tasking.Initialization);
! --  this insures that tasking is initialized if any protected objects are
  --  created.
  
  with System.Parameters;
! --  used for Single_Lock
  
  package body System.Tasking.Protected_Objects.Entries is
  
--- 32,71 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains all the simple primitives related to protected
! --  objects with entries (i.e init, lock, unlock).
  
  --  The handling of protected objects with no entries is done in
  --  System.Tasking.Protected_Objects, the complex routines for protected
  --  objects with entries in System.Tasking.Protected_Objects.Operations.
+ 
  --  The split between Entries and Operations is needed to break circular
  --  dependencies inside the run time.
  
! --  Note: the compiler generates direct calls to this interface, via Rtsfind
  
  with Ada.Exceptions;
! --  Used for Exception_Occurrence_Access
  --           Raise_Exception
  
  with System.Task_Primitives.Operations;
! --  Used for Initialize_Lock
  --           Write_Lock
  --           Unlock
  --           Get_Priority
  --           Wakeup
  
  with System.Tasking.Initialization;
! --  Used for Defer_Abort,
  --           Undefer_Abort,
  --           Change_Base_Priority
  
  pragma Elaborate_All (System.Tasking.Initialization);
! --  This insures that tasking is initialized if any protected objects are
  --  created.
  
  with System.Parameters;
! --  Used for Single_Lock
  
  package body System.Tasking.Protected_Objects.Entries is
  
*************** package body System.Tasking.Protected_Ob
*** 103,110 ****
        end if;
  
        if Ceiling_Violation then
!          --  Dip our own priority down to ceiling of lock.
!          --  See similar code in Tasking.Entry_Calls.Lock_Server.
  
           STPO.Write_Lock (Self_ID);
           Old_Base_Priority := Self_ID.Common.Base_Priority;
--- 105,113 ----
        end if;
  
        if Ceiling_Violation then
! 
!          --  Dip our own priority down to ceiling of lock. See similar code in
!          --  Tasking.Entry_Calls.Lock_Server.
  
           STPO.Write_Lock (Self_ID);
           Old_Base_Priority := Self_ID.Common.Base_Priority;
*************** package body System.Tasking.Protected_Ob
*** 130,136 ****
           Object.Pending_Action := True;
        end if;
  
!       --  Send program_error to all tasks still queued on this object.
  
        for E in Object.Entry_Queues'Range loop
           Entry_Call := Object.Entry_Queues (E).Head;
--- 133,139 ----
           Object.Pending_Action := True;
        end if;
  
!       --  Send program_error to all tasks still queued on this object
  
        for E in Object.Entry_Queues'Range loop
           Entry_Call := Object.Entry_Queues (E).Head;
*************** package body System.Tasking.Protected_Ob
*** 204,209 ****
--- 207,213 ----
        Initialize_Lock (Init_Priority, Object.L'Access);
        Initialization.Undefer_Abort (Self_ID);
        Object.Ceiling := System.Any_Priority (Init_Priority);
+       Object.Owner := Null_Task;
        Object.Compiler_Info := Compiler_Info;
        Object.Pending_Action := False;
        Object.Call_In_Progress := null;
*************** package body System.Tasking.Protected_Ob
*** 229,268 ****
             (Program_Error'Identity, "Protected Object is finalized");
        end if;
  
!       --  If pragma Detect_Blocking is active then Program_Error must
!       --  be raised if this potentially blocking operation is called from
!       --  a protected action, and the protected object nesting level
!       --  must be increased.
! 
!       if Detect_Blocking then
!          declare
!             Self_Id : constant Task_Id := STPO.Self;
!          begin
!             if Self_Id.Common.Protected_Action_Nesting > 0  then
!                Ada.Exceptions.Raise_Exception
!                  (Program_Error'Identity, "potentially blocking operation");
!             else
!                --  We are entering in a protected action, so that we
!                --  increase the protected object nesting level.
  
!                Self_Id.Common.Protected_Action_Nesting :=
!                  Self_Id.Common.Protected_Action_Nesting + 1;
!             end if;
!          end;
        end if;
  
!       --  The lock is made without defering abortion.
  
!       --  Therefore the abortion has to be deferred before calling this
!       --  routine. This means that the compiler has to generate a Defer_Abort
!       --  call before the call to Lock.
  
!       --  The caller is responsible for undeferring abortion, and compiler
        --  generated calls must be protected with cleanup handlers to ensure
!       --  that abortion is undeferred in all cases.
  
        pragma Assert (STPO.Self.Deferral_Level > 0);
        Write_Lock (Object.L'Access, Ceiling_Violation);
     end Lock_Entries;
  
     procedure Lock_Entries (Object : Protection_Entries_Access) is
--- 233,282 ----
             (Program_Error'Identity, "Protected Object is finalized");
        end if;
  
!       --  If pragma Detect_Blocking is active then, as described in the ARM
!       --  9.5.1, par. 15, we must check whether this is an external call on a
!       --  protected subprogram with the same target object as that of the
!       --  protected action that is currently in progress (i.e., if the caller
!       --  is already the protected object's owner). If this is the case hence
!       --  Program_Error must be raised.
  
!       if Detect_Blocking and then Object.Owner = Self then
!          raise Program_Error;
        end if;
  
!       --  The lock is made without defering abort
  
!       --  Therefore the abort has to be deferred before calling this routine.
!       --  This means that the compiler has to generate a Defer_Abort call
!       --  before the call to Lock.
  
!       --  The caller is responsible for undeferring abort, and compiler
        --  generated calls must be protected with cleanup handlers to ensure
!       --  that abort is undeferred in all cases.
  
        pragma Assert (STPO.Self.Deferral_Level > 0);
        Write_Lock (Object.L'Access, Ceiling_Violation);
+ 
+       --  We are entering in a protected action, so that we increase the
+       --  protected object nesting level (if pragma Detect_Blocking is
+       --  active), and update the protected object's owner.
+ 
+       if Detect_Blocking then
+          declare
+             Self_Id : constant Task_Id := Self;
+ 
+          begin
+             --  Update the protected object's owner
+ 
+             Object.Owner := Self_Id;
+ 
+             --  Increase protected object nesting level
+ 
+             Self_Id.Common.Protected_Action_Nesting :=
+               Self_Id.Common.Protected_Action_Nesting + 1;
+          end;
+       end if;
+ 
     end Lock_Entries;
  
     procedure Lock_Entries (Object : Protection_Entries_Access) is
*************** package body System.Tasking.Protected_Ob
*** 289,314 ****
             (Program_Error'Identity, "Protected Object is finalized");
        end if;
  
!       --  If pragma Detect_Blocking is active then Program_Error must be
!       --  raised if this potentially blocking operation is called from a
!       --  protected action, and the protected object nesting level must
!       --  be increased.
  
!       if Detect_Blocking then
!          declare
!             Self_Id : constant Task_Id := STPO.Self;
!          begin
!             if Self_Id.Common.Protected_Action_Nesting > 0  then
!                Ada.Exceptions.Raise_Exception
!                  (Program_Error'Identity, "potentially blocking operation");
!             else
!                --  We are entering in a protected action, so that we
!                --  increase the protected object nesting level.
  
!                Self_Id.Common.Protected_Action_Nesting :=
!                  Self_Id.Common.Protected_Action_Nesting + 1;
!             end if;
!          end;
        end if;
  
        Read_Lock (Object.L'Access, Ceiling_Violation);
--- 303,325 ----
             (Program_Error'Identity, "Protected Object is finalized");
        end if;
  
!       --  If pragma Detect_Blocking is active then, as described in the ARM
!       --  9.5.1, par. 15, we must check whether this is an external call on a
!       --  protected subprogram with the same target object as that of the
!       --  protected action that is currently in progress (i.e., if the caller
!       --  is already the protected object's owner). If this is the case hence
!       --  Program_Error must be raised.
  
!       --  Note that in this case (getting read access), several tasks may
!       --  have read ownership of the protected object, so that this method of
!       --  storing the (single) protected object's owner does not work
!       --  reliably for read locks. However, this is the approach taken for two
!       --  major reasosn: first, this function is not currently being used (it
!       --  is provided for possible future use), and second, it largely
!       --  simplifies the implementation.
  
!       if Detect_Blocking and then Object.Owner = Self then
!          raise Program_Error;
        end if;
  
        Read_Lock (Object.L'Access, Ceiling_Violation);
*************** package body System.Tasking.Protected_Ob
*** 316,321 ****
--- 327,352 ----
        if Ceiling_Violation then
           Raise_Exception (Program_Error'Identity, "Ceiling Violation");
        end if;
+ 
+       --  We are entering in a protected action, so that we increase the
+       --  protected object nesting level (if pragma Detect_Blocking is
+       --  active), and update the protected object's owner.
+ 
+       if Detect_Blocking then
+          declare
+             Self_Id : constant Task_Id := Self;
+ 
+          begin
+             --  Update the protected object's owner
+ 
+             Object.Owner := Self_Id;
+ 
+             --  Increase protected object nesting level
+ 
+             Self_Id.Common.Protected_Action_Nesting :=
+               Self_Id.Common.Protected_Action_Nesting + 1;
+          end;
+       end if;
     end Lock_Read_Only_Entries;
  
     --------------------
*************** package body System.Tasking.Protected_Ob
*** 326,341 ****
     begin
        --  We are exiting from a protected action, so that we decrease the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
           begin
!             --  Cannot call this procedure without being within a protected
!             --  action.
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0);
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
--- 357,379 ----
     begin
        --  We are exiting from a protected action, so that we decrease the
        --  protected object nesting level (if pragma Detect_Blocking is
!       --  active), and remove ownership of the protected object.
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
+ 
           begin
!             --  Calls to this procedure can only take place when being within
!             --  a protected action and when the caller is the protected
!             --  object's owner.
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0
!                              and then Object.Owner = Self_Id);
! 
!             --  Remove ownership of the protected object
! 
!             Object.Owner := Null_Task;
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpoben.ads gcc-4.1.0/gcc/ada/s-tpoben.ads
*** gcc-4.0.2/gcc/ada/s-tpoben.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-tpoben.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
! --                 SYSTEM.TASKING.PROTECTED_OBJECTS.ENTRIES                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
! --      S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .   --
! --                               E N T R I E S                              --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Tasking.Protected_Objects
*** 83,113 ****
        --  Note that you should never (un)lock Object.L directly, but instead
        --  use Lock_Entries/Unlock_Entries.
  
!       Compiler_Info     : System.Address;
!       Call_In_Progress  : Entry_Call_Link;
!       Ceiling           : System.Any_Priority;
        Old_Base_Priority : System.Any_Priority;
!       Pending_Action    : Boolean;
!       --  Flag indicating that priority has been dipped temporarily
!       --  in order to avoid violating the priority ceiling of the lock
!       --  associated with this protected object, in Lock_Server.
!       --  The flag tells Unlock_Server or Unlock_And_Update_Server to
!       --  restore the old priority to Old_Base_Priority. This is needed
!       --  because of situations (bad language design?) where one
!       --  needs to lock a PO but to do so would violate the priority
!       --  ceiling.  For example, this can happen when an entry call
!       --  has been requeued to a lower-priority object, and the caller
!       --  then tries to cancel the call while its own priority is higher
!       --  than the ceiling of the new PO.
!       Finalized         : Boolean := False;
!       --  Set to True by Finalize to make this routine idempotent.
  
!       Entry_Bodies      : Protected_Entry_Body_Access;
  
        --  The following function maps the entry index in a call (which denotes
        --  the queue to the proper entry) into the body of the entry.
  
!       Find_Body_Index   : Find_Body_Index_Access;
        Entry_Queues      : Protected_Entry_Queue_Array (1 .. Num_Entries);
     end record;
  
--- 84,132 ----
        --  Note that you should never (un)lock Object.L directly, but instead
        --  use Lock_Entries/Unlock_Entries.
  
!       Compiler_Info : System.Address;
!       --  Pointer to compiler-generated record representing protected object
! 
!       Call_In_Progress : Entry_Call_Link;
!       --  Pointer to the entry call being executed (if any)
! 
!       Ceiling : System.Any_Priority;
!       --  Ceiling priority associated with the protected object
! 
!       Owner : Task_Id;
!       --  This field contains the protected object's owner. Null_Task
!       --  indicates that the protected object is not currently being used.
!       --  This information is used for detecting the type of potentially
!       --  blocking operations described in the ARM 9.5.1, par. 15 (external
!       --  calls on a protected subprogram with the same target object as that
!       --  of the protected action).
! 
        Old_Base_Priority : System.Any_Priority;
!       --  Task's base priority when the protected operation was called
  
!       Pending_Action  : Boolean;
!       --  Flag indicating that priority has been dipped temporarily in order
!       --  to avoid violating the priority ceiling of the lock associated with
!       --  this protected object, in Lock_Server. The flag tells Unlock_Server
!       --  or Unlock_And_Update_Server to restore the old priority to
!       --  Old_Base_Priority. This is needed because of situations (bad
!       --  language design?) where one needs to lock a PO but to do so would
!       --  violate the priority ceiling. For example, this can happen when an
!       --  entry call has been requeued to a lower-priority object, and the
!       --  caller then tries to cancel the call while its own priority is
!       --  higher than the ceiling of the new PO.
! 
!       Finalized : Boolean := False;
!       --  Set to True by Finalize to make this routine idempotent
! 
!       Entry_Bodies : Protected_Entry_Body_Access;
!       --  Pointer to an array containing the executable code for all entry
!       --  bodies of a protected type.
  
        --  The following function maps the entry index in a call (which denotes
        --  the queue to the proper entry) into the body of the entry.
  
!       Find_Body_Index : Find_Body_Index_Access;
        Entry_Queues      : Protected_Entry_Queue_Array (1 .. Num_Entries);
     end record;
  
*************** package System.Tasking.Protected_Objects
*** 141,151 ****
     --  to keep track of the runtime state of a protected object.
  
     procedure Lock_Entries (Object : Protection_Entries_Access);
!    --  Lock a protected object for write access. Upon return, the caller
!    --  owns the lock to this object, and no other call to Lock or
!    --  Lock_Read_Only with the same argument will return until the
!    --  corresponding call to Unlock has been made by the caller.
!    --  Program_Error is raised in case of ceiling violation.
  
     procedure Lock_Entries
       (Object : Protection_Entries_Access; Ceiling_Violation : out Boolean);
--- 160,170 ----
     --  to keep track of the runtime state of a protected object.
  
     procedure Lock_Entries (Object : Protection_Entries_Access);
!    --  Lock a protected object for write access. Upon return, the caller owns
!    --  the lock to this object, and no other call to Lock or Lock_Read_Only
!    --  with the same argument will return until the corresponding call to
!    --  Unlock has been made by the caller. Program_Error is raised in case of
!    --  ceiling violation.
  
     procedure Lock_Entries
       (Object : Protection_Entries_Access; Ceiling_Violation : out Boolean);
*************** package System.Tasking.Protected_Objects
*** 153,176 ****
     --  raising Program_Error.
  
     procedure Lock_Read_Only_Entries (Object : Protection_Entries_Access);
!    --  Lock a protected object for read access. Upon return, the caller
!    --  owns the lock for read access, and no other calls to Lock with the
!    --  same argument will return until the corresponding call to Unlock
!    --  has been made by the caller. Other calls to Lock_Read_Only may (but
!    --  need not) return before the call to Unlock, and the corresponding
!    --  callers will also own the lock for read access.
     --
!    --  Note: we are not currently using this interface, it is provided
!    --  for possible future use. At the current time, everyone uses Lock
!    --  for both read and write locks.
  
     procedure Unlock_Entries (Object : Protection_Entries_Access);
!    --  Relinquish ownership of the lock for the object represented by
!    --  the Object parameter. If this ownership was for write access, or
!    --  if it was for read access where there are no other read access
!    --  locks outstanding, one (or more, in the case of Lock_Read_Only)
!    --  of the tasks waiting on this lock (if any) will be given the
!    --  lock and allowed to return from the Lock or Lock_Read_Only call.
  
  private
  
--- 172,195 ----
     --  raising Program_Error.
  
     procedure Lock_Read_Only_Entries (Object : Protection_Entries_Access);
!    --  Lock a protected object for read access. Upon return, the caller owns
!    --  the lock for read access, and no other calls to Lock with the same
!    --  argument will return until the corresponding call to Unlock has been
!    --  made by the caller. Other calls to Lock_Read_Only may (but need not)
!    --  return before the call to Unlock, and the corresponding callers will
!    --  also own the lock for read access.
     --
!    --  Note: we are not currently using this interface, it is provided for
!    --  possible future use. At the current time, everyone uses Lock for both
!    --  read and write locks.
  
     procedure Unlock_Entries (Object : Protection_Entries_Access);
!    --  Relinquish ownership of the lock for the object represented by the
!    --  Object parameter. If this ownership was for write access, or if it was
!    --  for read access where there are no other read access locks outstanding,
!    --  one (or more, in the case of Lock_Read_Only) of the tasks waiting on
!    --  this lock (if any) will be given the lock and allowed to return from
!    --  the Lock or Lock_Read_Only call.
  
  private
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpobop.adb gcc-4.1.0/gcc/ada/s-tpobop.adb
*** gcc-4.0.2/gcc/ada/s-tpobop.adb	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tpobop.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASKING.PROTECTED_OBJECTS.OPERATIONS               --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --     S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .    --
! --                             O P E R A T I O N S                          --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Parameters;
*** 93,98 ****
--- 94,102 ----
  with System.Traces.Tasking;
  --  used for Send_Trace_Info
  
+ with System.Restrictions;
+ --  used for Run_Time_Restrictions
+ 
  package body System.Tasking.Protected_Objects.Operations is
  
     package STPO renames System.Task_Primitives.Operations;
*************** package body System.Tasking.Protected_Ob
*** 102,107 ****
--- 106,113 ----
     use Ada.Exceptions;
     use Entries;
  
+    use System.Restrictions;
+    use System.Restrictions.Rident;
     use System.Traces;
     use System.Traces.Tasking;
  
*************** package body System.Tasking.Protected_Ob
*** 265,270 ****
--- 271,281 ----
       (Object : Protection_Entries_Access;
        Ex     : Ada.Exceptions.Exception_Id)
     is
+       procedure Transfer_Occurrence
+         (Target : Ada.Exceptions.Exception_Occurrence_Access;
+          Source : Ada.Exceptions.Exception_Occurrence);
+       pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
+ 
        Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress;
     begin
        pragma Debug
*************** package body System.Tasking.Protected_Ob
*** 278,283 ****
--- 289,300 ----
  
           Entry_Call.Exception_To_Raise := Ex;
  
+          if Ex /= Ada.Exceptions.Null_Id then
+             Transfer_Occurrence
+               (Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
+                STPO.Self.Common.Compiler_Data.Current_Excep);
+          end if;
+ 
           --  Wakeup_Entry_Caller will be called from PO_Do_Or_Queue or
           --  PO_Service_Entries on return.
        end if;
*************** package body System.Tasking.Protected_Ob
*** 352,360 ****
        elsif Entry_Call.Mode /= Conditional_Call
          or else not With_Abort
        then
-          Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
-          Update_For_Queue_To_PO (Entry_Call, With_Abort);
  
        else
           --  Conditional_Call and With_Abort
  
--- 369,400 ----
        elsif Entry_Call.Mode /= Conditional_Call
          or else not With_Abort
        then
  
+          if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
+               and then
+             Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
+               Queuing.Count_Waiting (Object.Entry_Queues (E))
+          then
+             --  This violates the Max_Entry_Queue_Length restriction,
+             --  raise Program_Error.
+ 
+             Entry_Call.Exception_To_Raise := Program_Error'Identity;
+ 
+             if Single_Lock then
+                STPO.Lock_RTS;
+             end if;
+ 
+             STPO.Write_Lock (Entry_Call.Self);
+             Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
+             STPO.Unlock (Entry_Call.Self);
+ 
+             if Single_Lock then
+                STPO.Unlock_RTS;
+             end if;
+          else
+             Queuing.Enqueue (Object.Entry_Queues (E), Entry_Call);
+             Update_For_Queue_To_PO (Entry_Call, With_Abort);
+          end if;
        else
           --  Conditional_Call and With_Abort
  
*************** package body System.Tasking.Protected_Ob
*** 537,542 ****
--- 577,593 ----
             (Storage_Error'Identity, "not enough ATC nesting levels");
        end if;
  
+       --  If pragma Detect_Blocking is active then Program_Error must be
+       --  raised if this potentially blocking operation is called from a
+       --  protected action.
+ 
+       if Detect_Blocking
+         and then Self_ID.Common.Protected_Action_Nesting > 0
+       then
+          Ada.Exceptions.Raise_Exception
+            (Program_Error'Identity, "potentially blocking operation");
+       end if;
+ 
        Initialization.Defer_Abort (Self_ID);
        Lock_Entries (Object, Ceiling_Violation);
  
*************** package body System.Tasking.Protected_Ob
*** 723,731 ****
                or else Entry_Call.Mode /= Conditional_Call
              then
                 E := Protected_Entry_Index (Entry_Call.E);
!                Queuing.Enqueue
!                  (New_Object.Entry_Queues (E), Entry_Call);
!                Update_For_Queue_To_PO (Entry_Call, With_Abort);
  
              else
                 PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
--- 774,807 ----
                or else Entry_Call.Mode /= Conditional_Call
              then
                 E := Protected_Entry_Index (Entry_Call.E);
! 
!                if Run_Time_Restrictions.Set (Max_Entry_Queue_Length)
!                     and then
!                   Run_Time_Restrictions.Value (Max_Entry_Queue_Length) <=
!                     Queuing.Count_Waiting (Object.Entry_Queues (E))
!                then
!                   --  This violates the Max_Entry_Queue_Length restriction,
!                   --  raise Program_Error.
! 
!                   Entry_Call.Exception_To_Raise := Program_Error'Identity;
! 
!                   if Single_Lock then
!                      STPO.Lock_RTS;
!                   end if;
! 
!                   STPO.Write_Lock (Entry_Call.Self);
!                   Initialization.Wakeup_Entry_Caller
!                     (Self_Id, Entry_Call, Done);
!                   STPO.Unlock (Entry_Call.Self);
! 
!                   if Single_Lock then
!                      STPO.Unlock_RTS;
!                   end if;
!                else
!                   Queuing.Enqueue
!                     (New_Object.Entry_Queues (E), Entry_Call);
!                   Update_For_Queue_To_PO (Entry_Call, With_Abort);
!                end if;
  
              else
                 PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call, With_Abort);
*************** package body System.Tasking.Protected_Ob
*** 889,894 ****
--- 965,981 ----
             "not enough ATC nesting levels");
        end if;
  
+       --  If pragma Detect_Blocking is active then Program_Error must be
+       --  raised if this potentially blocking operation is called from a
+       --  protected action.
+ 
+       if Detect_Blocking
+         and then Self_Id.Common.Protected_Action_Nesting > 0
+       then
+          Ada.Exceptions.Raise_Exception
+            (Program_Error'Identity, "potentially blocking operation");
+       end if;
+ 
        if Runtime_Traces then
           Send_Trace_Info (POT_Call, Entry_Index (E), Timeout);
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpobop.ads gcc-4.1.0/gcc/ada/s-tpobop.ads
*** gcc-4.0.2/gcc/ada/s-tpobop.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tpobop.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,13 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --    S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .     --
! --                            O P E R A T I O N S                           --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --     S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .    --
! --                             O P E R A T I O N S                          --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,50 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains all the extended primitives related to
! --  Protected_Objects with entries.
  --  The handling of protected objects with no entries is done in
  --  System.Tasking.Protected_Objects, the simple routines for protected
! --  objects with entries in System.Tasking.Protected_Objects.Entries.
! --  The split between Entries and Operations is needed to break circular
  --  dependencies inside the run time.
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
  
  with Ada.Exceptions;
! --  used for Exception_Id
  
  with System.Tasking.Protected_Objects.Entries;
  
--- 32,51 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains all the extended primitives related to protected
! --  objects with entries.
! 
  --  The handling of protected objects with no entries is done in
  --  System.Tasking.Protected_Objects, the simple routines for protected
! --  objects with entries in System.Tasking.Protected_Objects.Entries. The
! --  split between Entries and Operations is needed to break circular
  --  dependencies inside the run time.
  
  --  Note: the compiler generates direct calls to this interface, via Rtsfind.
  --  Any changes to this interface may require corresponding compiler changes.
  
  with Ada.Exceptions;
! --  Used for Exception_Id
  
  with System.Tasking.Protected_Objects.Entries;
  
*************** package System.Tasking.Protected_Objects
*** 108,114 ****
     --  barriers, so this routine keeps checking barriers until all of
     --  them are closed.
     --
!    --  This must be called with abortion deferred and with the corresponding
     --  object locked.
     --
     --  If Unlock_Object is set True, then Object is unlocked on return,
--- 109,115 ----
     --  barriers, so this routine keeps checking barriers until all of
     --  them are closed.
     --
!    --  This must be called with abort deferred and with the corresponding
     --  object locked.
     --
     --  If Unlock_Object is set True, then Object is unlocked on return,
*************** package System.Tasking.Protected_Objects
*** 173,179 ****
       (Object : Entries.Protection_Entries'Class;
        E      : Protected_Entry_Index)
        return   Natural;
!    --  Return the number of entry calls to E on Object.
  
     function Protected_Entry_Caller
       (Object : Entries.Protection_Entries'Class) return Task_Id;
--- 174,180 ----
       (Object : Entries.Protection_Entries'Class;
        E      : Protected_Entry_Index)
        return   Natural;
!    --  Return the number of entry calls to E on Object
  
     function Protected_Entry_Caller
       (Object : Entries.Protection_Entries'Class) return Task_Id;
*************** package System.Tasking.Protected_Objects
*** 181,187 ****
     --  being handled. This will only work if called from within an entry
     --  body, as required by the LRM (C.7.1(14)).
  
!    --  For internal use only:
  
     procedure PO_Do_Or_Queue
       (Self_ID    : Task_Id;
--- 182,188 ----
     --  being handled. This will only work if called from within an entry
     --  body, as required by the LRM (C.7.1(14)).
  
!    --  For internal use only
  
     procedure PO_Do_Or_Queue
       (Self_ID    : Task_Id;
*************** package System.Tasking.Protected_Objects
*** 189,195 ****
        Entry_Call : Entry_Call_Link;
        With_Abort : Boolean);
     --  This procedure either executes or queues an entry call, depending
!    --  on the status of the corresponding barrier. It assumes that abortion
     --  is deferred and that the specified object is locked.
  
  private
--- 190,196 ----
        Entry_Call : Entry_Call_Link;
        With_Abort : Boolean);
     --  This procedure either executes or queues an entry call, depending
!    --  on the status of the corresponding barrier. It assumes that abort
     --  is deferred and that the specified object is locked.
  
  private
*************** private
*** 201,210 ****
     pragma Volatile (Communication_Block);
  
     --  ?????
!    --  The Communication_Block seems to be a relic.
!    --  At the moment, the compiler seems to be generating
!    --  unnecessary conditional code based on this block.
!    --  See the code generated for async. select with task entry
     --  call for another way of solving this.
  
  end System.Tasking.Protected_Objects.Operations;
--- 202,210 ----
     pragma Volatile (Communication_Block);
  
     --  ?????
!    --  The Communication_Block seems to be a relic. At the moment, the
!    --  compiler seems to be generating unnecessary conditional code based on
!    --  this block. See the code generated for async. select with task entry
     --  call for another way of solving this.
  
  end System.Tasking.Protected_Objects.Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopde-vms.adb gcc-4.1.0/gcc/ada/s-tpopde-vms.adb
*** gcc-4.0.2/gcc/ada/s-tpopde-vms.adb	Thu Feb 10 13:49:28 2005
--- gcc-4.1.0/gcc/ada/s-tpopde-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,8 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                   SYSTEM.TASK_PRIMITIVES.OPERATIONS.DEC                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
--- 1,9 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                                   D E C                                  --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopde-vms.ads gcc-4.1.0/gcc/ada/s-tpopde-vms.ads
*** gcc-4.0.2/gcc/ada/s-tpopde-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-tpopde-vms.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                   SYSTEM.TASK_PRIMITIVES.OPERATIONS.DEC                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2000-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                                   D E C                                  --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2000-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-lynxos.adb gcc-4.1.0/gcc/ada/s-tpopsp-lynxos.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-lynxos.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tpopsp-lynxos.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC                --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                              S P E C I F I C                             --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-posix-foreign.adb gcc-4.1.0/gcc/ada/s-tpopsp-posix-foreign.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-posix-foreign.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tpopsp-posix-foreign.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC                --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                             S P E C I F I C                              --
  --                                                                          --
! --                                B o d y                                   --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-posix.adb gcc-4.1.0/gcc/ada/s-tpopsp-posix.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-posix.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tpopsp-posix.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC                --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --            Copyright (C) 1992-2004, Free Software Fundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                             S P E C I F I C                              --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 1992-2005, Free Software Fundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-rtems.adb gcc-4.1.0/gcc/ada/s-tpopsp-rtems.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-rtems.adb	Thu Jan 27 11:56:57 2005
--- gcc-4.1.0/gcc/ada/s-tpopsp-rtems.adb	Fri Jul  1 01:29:17 2005
***************
*** 19,26 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 19,26 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-solaris.adb gcc-4.1.0/gcc/ada/s-tpopsp-solaris.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-solaris.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tpopsp-solaris.adb	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC                --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                             S P E C I F I C                              --
  --                                                                          --
! --                                B o d y                                   --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Specific is
*** 41,49 ****
     ----------------
  
     procedure Initialize (Environment_Task : Task_Id) is
        Result : Interfaces.C.int;
     begin
!       Result := thr_setspecific (ATCB_Key, To_Address (Environment_Task));
        pragma Assert (Result = 0);
     end Initialize;
  
--- 42,51 ----
     ----------------
  
     procedure Initialize (Environment_Task : Task_Id) is
+       pragma Unreferenced (Environment_Task);
        Result : Interfaces.C.int;
     begin
!       Result := thr_keycreate (ATCB_Key'Access, System.Null_Address);
        pragma Assert (Result = 0);
     end Initialize;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tpopsp-vxworks.adb gcc-4.1.0/gcc/ada/s-tpopsp-vxworks.adb
*** gcc-4.0.2/gcc/ada/s-tpopsp-vxworks.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tpopsp-vxworks.adb	Mon Sep  5 07:49:24 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --                SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC                --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --                             S P E C I F I C                              --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --         Copyright (C) 1992-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,42 ****
--- 38,72 ----
  separate (System.Task_Primitives.Operations)
  package body Specific is
  
+    ATCB_Key : aliased System.Address := System.Null_Address;
+    --  Key used to find the Ada Task_Id associated with a thread
+ 
+    ATCB_Key_Addr : System.Address := ATCB_Key'Address;
+    pragma Export (Ada, ATCB_Key_Addr, "__gnat_ATCB_key_addr");
+    --  Exported to support the temporary AE653 task registration
+    --  implementation. This mechanism is used to minimize impact on other
+    --  targets.
+ 
+    ------------
+    -- Delete --
+    ------------
+ 
+    procedure Delete is
+       Result : STATUS;
+    begin
+       Result := taskVarDelete (taskIdSelf, ATCB_Key'Access);
+       pragma Assert (Result /= ERROR);
+    end Delete;
+ 
+    ----------------
+    -- Initialize --
+    ----------------
+ 
+    procedure Initialize is
+    begin
+       null;
+    end Initialize;
+ 
     -------------------
     -- Is_Valid_Task --
     -------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tporft.adb gcc-4.1.0/gcc/ada/s-tporft.adb
*** gcc-4.0.2/gcc/ada/s-tporft.adb	Thu Feb 10 13:56:32 2005
--- gcc-4.1.0/gcc/ada/s-tporft.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,10 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
! --         SYSTEM.TASK_PRIMITIVES.OPERATIONS.REGISTER_FOREIGN_THREAD        --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
  --          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
  --                                                                          --
--- 1,11 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
! --    S Y S T E M . T A S K _ P R I M I T I V E S . O P E R A T I O N S .   --
! --               R E G I S T E R _ F O R E I G N _ T H R E A D              --
  --                                                                          --
! --                                B o d y                                   --
  --                                                                          --
  --          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tposen.adb gcc-4.1.0/gcc/ada/s-tposen.adb
*** gcc-4.0.2/gcc/ada/s-tposen.adb	Fri Nov 19 11:25:38 2004
--- gcc-4.1.0/gcc/ada/s-tposen.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
! --              SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY               --
  --                                                                          --
! --                                  B o d y                                 --
  --                                                                          --
! --         Copyright (C) 1998-2004, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
! --     S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .    --
! --                          S I N G L E _ E N T R Y                         --
  --                                                                          --
! --                                B o d y                                   --
  --                                                                          --
! --         Copyright (C) 1998-2005, Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** pragma Style_Checks (All_Checks);
*** 37,52 ****
  
  --  This package provides an optimized version of Protected_Objects.Operations
  --  and Protected_Objects.Entries making the following assumptions:
! --
! --  PO have only one entry
! --  There is only one caller at a time (No_Entry_Queue)
! --  There is no dynamic priority support (No_Dynamic_Priorities)
! --  No Abort Statements
! --    (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0)
! --  PO are at library level
! --  No Requeue
! --  None of the tasks will terminate (no need for finalization)
! --
  --  This interface is intended to be used in the ravenscar and restricted
  --  profiles, the compiler is responsible for ensuring that the conditions
  --  mentioned above are respected, except for the No_Entry_Queue restriction
--- 38,53 ----
  
  --  This package provides an optimized version of Protected_Objects.Operations
  --  and Protected_Objects.Entries making the following assumptions:
! 
! --    PO has only one entry
! --    There is only one caller at a time (No_Entry_Queue)
! --    There is no dynamic priority support (No_Dynamic_Priorities)
! --    No Abort Statements
! --     (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0)
! --    PO are at library level
! --    No Requeue
! --    None of the tasks will terminate (no need for finalization)
! 
  --  This interface is intended to be used in the ravenscar and restricted
  --  profiles, the compiler is responsible for ensuring that the conditions
  --  mentioned above are respected, except for the No_Entry_Queue restriction
*************** package body System.Tasking.Protected_Ob
*** 333,338 ****
--- 334,340 ----
  
        STPO.Initialize_Lock (Init_Priority, Object.L'Access);
        Object.Ceiling := System.Any_Priority (Init_Priority);
+       Object.Owner := Null_Task;
        Object.Compiler_Info := Compiler_Info;
        Object.Call_In_Progress := null;
        Object.Entry_Body := Entry_Body;
*************** package body System.Tasking.Protected_Ob
*** 350,401 ****
        Ceiling_Violation : Boolean;
  
     begin
!       --  If pragma Detect_Blocking is active then the protected object
!       --  nesting level must be increased.
  
        if Detect_Blocking then
           declare
!             Self_Id : constant Task_Id := STPO.Self;
           begin
!             --  We are entering in a protected action, so that we
!             --  increase the protected object nesting level.
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
        end if;
- 
-       STPO.Write_Lock (Object.L'Access, Ceiling_Violation);
- 
-       if Ceiling_Violation then
-          raise Program_Error;
-       end if;
     end Lock_Entry;
  
     --------------------------
     -- Lock_Read_Only_Entry --
     --------------------------
  
!    --  Compiler interface only.
!    --  Do not call this procedure from within the runtime system.
  
     procedure Lock_Read_Only_Entry (Object : Protection_Entry_Access) is
        Ceiling_Violation : Boolean;
  
     begin
!       --  If pragma Detect_Blocking is active then the protected object
!       --  nesting level must be increased.
  
!       if Detect_Blocking then
!          declare
!             Self_Id : constant Task_Id := STPO.Self;
!          begin
!             --  We are entering in a protected action, so that we
!             --  increase the protected object nesting level.
  
!             Self_Id.Common.Protected_Action_Nesting :=
!               Self_Id.Common.Protected_Action_Nesting + 1;
!          end;
        end if;
  
        STPO.Read_Lock (Object.L'Access, Ceiling_Violation);
--- 352,424 ----
        Ceiling_Violation : Boolean;
  
     begin
!       --  If pragma Detect_Blocking is active then, as described in the ARM
!       --  9.5.1, par. 15, we must check whether this is an external call on a
!       --  protected subprogram with the same target object as that of the
!       --  protected action that is currently in progress (i.e., if the caller
!       --  is already the protected object's owner). If this is the case hence
!       --  Program_Error must be raised.
! 
!       if Detect_Blocking and then Object.Owner = Self then
!          raise Program_Error;
!       end if;
! 
!       STPO.Write_Lock (Object.L'Access, Ceiling_Violation);
! 
!       if Ceiling_Violation then
!          raise Program_Error;
!       end if;
! 
!       --  We are entering in a protected action, so that we increase the
!       --  protected object nesting level (if pragma Detect_Blocking is
!       --  active), and update the protected object's owner.
  
        if Detect_Blocking then
           declare
!             Self_Id : constant Task_Id := Self;
! 
           begin
!             --  Update the protected object's owner
! 
!             Object.Owner := Self_Id;
! 
!             --  Increase protected object nesting level
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting + 1;
           end;
        end if;
     end Lock_Entry;
  
     --------------------------
     -- Lock_Read_Only_Entry --
     --------------------------
  
!    --  Compiler interface only
! 
!    --  Do not call this procedure from within the runtime system
  
     procedure Lock_Read_Only_Entry (Object : Protection_Entry_Access) is
        Ceiling_Violation : Boolean;
  
     begin
!       --  If pragma Detect_Blocking is active then, as described in the ARM
!       --  9.5.1, par. 15, we must check whether this is an external call on a
!       --  protected subprogram with the same target object as that of the
!       --  protected action that is currently in progress (i.e., if the caller
!       --  is already the protected object's owner). If this is the case hence
!       --  Program_Error must be raised.
  
!       --  Note that in this case (getting read access), several tasks may
!       --  have read ownership of the protected object, so that this method of
!       --  storing the (single) protected object's owner does not work
!       --  reliably for read locks. However, this is the approach taken for two
!       --  major reasosn: first, this function is not currently being used (it
!       --  is provided for possible future use), and second, it largely
!       --  simplifies the implementation.
  
!       if Detect_Blocking and then Object.Owner = Self then
!          raise Program_Error;
        end if;
  
        STPO.Read_Lock (Object.L'Access, Ceiling_Violation);
*************** package body System.Tasking.Protected_Ob
*** 403,408 ****
--- 426,451 ----
        if Ceiling_Violation then
           raise Program_Error;
        end if;
+ 
+       --  We are entering in a protected action, so that we increase the
+       --  protected object nesting level (if pragma Detect_Blocking is
+       --  active), and update the protected object's owner.
+ 
+       if Detect_Blocking then
+          declare
+             Self_Id : constant Task_Id := Self;
+ 
+          begin
+             --  Update the protected object's owner
+ 
+             Object.Owner := Self_Id;
+ 
+             --  Increase protected object nesting level
+ 
+             Self_Id.Common.Protected_Action_Nesting :=
+               Self_Id.Common.Protected_Action_Nesting + 1;
+          end;
+       end if;
     end Lock_Read_Only_Entry;
  
     --------------------
*************** package body System.Tasking.Protected_Ob
*** 415,420 ****
--- 458,464 ----
        Entry_Call : Entry_Call_Link)
     is
        Barrier_Value : Boolean;
+ 
     begin
        --  When the Action procedure for an entry body returns, it must be
        --  completed (having called [Exceptional_]Complete_Entry_Body).
*************** package body System.Tasking.Protected_Ob
*** 423,428 ****
--- 467,473 ----
  
        if Barrier_Value then
           if Object.Call_In_Progress /= null then
+ 
              --  This violates the No_Entry_Queue restriction, send
              --  Program_Error to the caller.
  
*************** package body System.Tasking.Protected_Ob
*** 448,454 ****
           end if;
  
        elsif Entry_Call.Mode /= Conditional_Call then
!          Object.Entry_Queue := Entry_Call;
        else
           --  Conditional_Call
  
--- 493,509 ----
           end if;
  
        elsif Entry_Call.Mode /= Conditional_Call then
!          if Object.Entry_Queue /= null then
! 
!             --  This violates the No_Entry_Queue restriction, send
!             --  Program_Error to the caller.
! 
!             Send_Program_Error (Self_Id, Entry_Call);
!             return;
!          else
!             Object.Entry_Queue := Entry_Call;
!          end if;
! 
        else
           --  Conditional_Call
  
*************** package body System.Tasking.Protected_Ob
*** 692,707 ****
     procedure Unlock_Entry (Object : Protection_Entry_Access) is
     begin
        --  We are exiting from a protected action, so that we decrease the
!       --  protected object nesting level (if pragma Detect_Blocking is active).
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
  
           begin
!             --  Cannot call Unlock_Entry without being within protected action
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0);
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
--- 747,770 ----
     procedure Unlock_Entry (Object : Protection_Entry_Access) is
     begin
        --  We are exiting from a protected action, so that we decrease the
!       --  protected object nesting level (if pragma Detect_Blocking is
!       --  active), and remove ownership of the protected object.
  
        if Detect_Blocking then
           declare
              Self_Id : constant Task_Id := Self;
  
           begin
!             --  Calls to this procedure can only take place when being within
!             --  a protected action and when the caller is the protected
!             --  object's owner.
  
!             pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0
!                              and then Object.Owner = Self_Id);
! 
!             --  Remove ownership of the protected object
! 
!             Object.Owner := Null_Task;
  
              Self_Id.Common.Protected_Action_Nesting :=
                Self_Id.Common.Protected_Action_Nesting - 1;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tposen.ads gcc-4.1.0/gcc/ada/s-tposen.ads
*** gcc-4.0.2/gcc/ada/s-tposen.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tposen.ads	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
! --              SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,13 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
  --                                                                          --
! --     S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S .    --
! --                          S I N G L E _ E N T R Y                         --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Tasking.Protected_Objects
*** 277,288 ****
  
  private
     type Protection_Entry is record
!       L                 : aliased Task_Primitives.Lock;
!       Compiler_Info     : System.Address;
!       Call_In_Progress  : Entry_Call_Link;
!       Ceiling           : System.Any_Priority;
!       Entry_Body        : Entry_Body_Access;
!       Entry_Queue       : Entry_Call_Link;
     end record;
  
  end System.Tasking.Protected_Objects.Single_Entry;
--- 278,310 ----
  
  private
     type Protection_Entry is record
!       L : aliased Task_Primitives.Lock;
!       --  The underlying lock associated with a Protection_Entries. Note that
!       --  you should never (un)lock Object.L directly, but instead use
!       --  Lock_Entry/Unlock_Entry.
! 
!       Compiler_Info : System.Address;
!       --  Pointer to compiler-generated record representing protected object
! 
!       Call_In_Progress : Entry_Call_Link;
!       --  Pointer to the entry call being executed (if any)
! 
!       Ceiling : System.Any_Priority;
!       --  Ceiling priority associated to the protected object
! 
!       Owner : Task_Id;
!       --  This field contains the protected object's owner. Null_Task
!       --  indicates that the protected object is not currently being used.
!       --  This information is used for detecting the type of potentially
!       --  blocking operations described in the ARM 9.5.1, par. 15 (external
!       --  calls on a protected subprogram with the same target object as that
!       --  of the protected action).
! 
!       Entry_Body : Entry_Body_Access;
!       --  Pointer to executable code for the entry body of the protected type
! 
!       Entry_Queue : Entry_Call_Link;
!       --  Place to store the waiting entry call (if any)
     end record;
  
  end System.Tasking.Protected_Objects.Single_Entry;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traceb-hpux.adb gcc-4.1.0/gcc/ada/s-traceb-hpux.adb
*** gcc-4.0.2/gcc/ada/s-traceb-hpux.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-traceb-hpux.adb	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2003 Ada Core Technologies, 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- --
--- 7,13 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Traceback is
*** 359,365 ****
              return False;
           end if;
  
!          --  Now, safely call the unwinder and use the results.
  
           if U_get_previous_frame_x (Frame,
                                      Up_Frame'Access,
--- 359,365 ----
              return False;
           end if;
  
!          --  Now, safely call the unwinder and use the results
  
           if U_get_previous_frame_x (Frame,
                                      Up_Frame'Access,
*************** package body System.Traceback is
*** 510,516 ****
           Frame_Info_Offset  : constant := 8;
  
        begin
!          --  First try to locate the descriptor in the program's unwind table.
  
           UWD_Address := U_get_unwind_entry (Frame.cur_rlo,
                                              Frame.cur_rls,
--- 510,516 ----
           Frame_Info_Offset  : constant := 8;
  
        begin
!          --  First try to locate the descriptor in the program's unwind table
  
           UWD_Address := U_get_unwind_entry (Frame.cur_rlo,
                                              Frame.cur_rls,
*************** package body System.Traceback is
*** 562,568 ****
  
        Pop_Success := Pop_Frame (Frame'Access);
  
!       --  Skip the requested number of frames.
  
        for I in 1 .. Skip_Frames loop
           Pop_Success := Pop_Frame (Frame'Access);
--- 562,568 ----
  
        Pop_Success := Pop_Frame (Frame'Access);
  
!       --  Skip the requested number of frames
  
        for I in 1 .. Skip_Frames loop
           Pop_Success := Pop_Frame (Frame'Access);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traceb-mastop.adb gcc-4.1.0/gcc/ada/s-traceb-mastop.adb
*** gcc-4.0.2/gcc/ada/s-traceb-mastop.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-traceb-mastop.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 1999-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This version assumes that System.Machine_State_Operations.Pop_Frame can
! --  work with the Info parameter being null.
  
  with System.Machine_State_Operations;
  
--- 31,37 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This version uses System.Machine_State_Operations routines
  
  with System.Machine_State_Operations;
  
*************** package body System.Traceback is
*** 73,79 ****
           Code := Get_Code_Loc (M);
           exit when Code = Null_Address or else N_Skips = Skip_Frames;
  
!          Pop_Frame (M, System.Null_Address);
           N_Skips := N_Skips + 1;
        end loop;
  
--- 72,78 ----
           Code := Get_Code_Loc (M);
           exit when Code = Null_Address or else N_Skips = Skip_Frames;
  
!          Pop_Frame (M);
           N_Skips := N_Skips + 1;
        end loop;
  
*************** package body System.Traceback is
*** 90,96 ****
              Trace (Len) := Code;
           end if;
  
!          Pop_Frame (M, System.Null_Address);
        end loop;
  
        Free_Machine_State (M);
--- 89,95 ----
              Trace (Len) := Code;
           end if;
  
!          Pop_Frame (M);
        end loop;
  
        Free_Machine_State (M);
*************** package body System.Traceback is
*** 101,108 ****
     ------------------
  
     function C_Call_Chain
!      (Traceback   : System.Address;
!       Max_Len     : Natural) return Natural
     is
        Val : Natural;
     begin
--- 100,107 ----
     ------------------
  
     function C_Call_Chain
!      (Traceback : System.Address;
!       Max_Len   : Natural) return Natural
     is
        Val : Natural;
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traceb.adb gcc-4.1.0/gcc/ada/s-traceb.adb
*** gcc-4.0.2/gcc/ada/s-traceb.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-traceb.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traceb.ads gcc-4.1.0/gcc/ada/s-traceb.ads
*** gcc-4.0.2/gcc/ada/s-traceb.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-traceb.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Traceback is
*** 84,89 ****
        Max_Len   : Natural)
        return      Natural;
     pragma Export (C, C_Call_Chain, "system__traceback__c_call_chain");
!    --  Version that can be used directly from C.
  
  end System.Traceback;
--- 84,89 ----
        Max_Len   : Natural)
        return      Natural;
     pragma Export (C, C_Call_Chain, "system__traceback__c_call_chain");
!    --  Version that can be used directly from C
  
  end System.Traceback;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traces-default.adb gcc-4.1.0/gcc/ada/s-traces-default.adb
*** gcc-4.0.2/gcc/ada/s-traces-default.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-traces-default.adb	Tue Nov 15 13:52:10 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Traces is
*** 45,51 ****
     ----------------------
  
     procedure Send_Trace_Info (Id : Trace_T) is
!       Task_S  : String := SSL.Task_Name.all;
        Trace_S : String (1 .. 3 + Task_S'Length);
  
     begin
--- 45,51 ----
     ----------------------
  
     procedure Send_Trace_Info (Id : Trace_T) is
!       Task_S  : constant String := SSL.Task_Name.all;
        Trace_S : String (1 .. 3 + Task_S'Length);
  
     begin
*************** package body System.Traces is
*** 57,64 ****
     end Send_Trace_Info;
  
     procedure Send_Trace_Info (Id : Trace_T; Timeout : Duration) is
!       Task_S    : String := SSL.Task_Name.all;
!       Timeout_S : String := Duration'Image (Timeout);
        Trace_S   : String (1 .. 6 + Task_S'Length + Timeout_S'Length);
  
     begin
--- 57,64 ----
     end Send_Trace_Info;
  
     procedure Send_Trace_Info (Id : Trace_T; Timeout : Duration) is
!       Task_S    : constant String := SSL.Task_Name.all;
!       Timeout_S : constant String := Duration'Image (Timeout);
        Trace_S   : String (1 .. 6 + Task_S'Length + Timeout_S'Length);
  
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traces.adb gcc-4.1.0/gcc/ada/s-traces.adb
*** gcc-4.0.2/gcc/ada/s-traces.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-traces.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traces.ads gcc-4.1.0/gcc/ada/s-traces.ads
*** gcc-4.0.2/gcc/ada/s-traces.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-traces.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                         S Y S T E M . T R A C E S                        --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 55,60 ****
--- 55,61 ----
  --  To add a new target, just adapt System.Traces.Send to your own purpose.
  
  package System.Traces is
+    pragma Preelaborate;
  
     type Trace_T is
       (
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traent-vms.adb gcc-4.1.0/gcc/ada/s-traent-vms.adb
*** gcc-4.0.2/gcc/ada/s-traent-vms.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-traent-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2003 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Traceback_Entries is
*** 65,68 ****
     end TB_Entry_For;
  
  end System.Traceback_Entries;
- 
--- 65,67 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traent-vms.ads gcc-4.1.0/gcc/ada/s-traent-vms.ads
*** gcc-4.0.2/gcc/ada/s-traent-vms.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-traent-vms.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2003 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,43 ****
--- 38,44 ----
  --  This is the Alpha/OpenVMS version of this package
  
  package System.Traceback_Entries is
+    pragma Preelaborate;
  
     type Traceback_Entry is record
        PC : System.Address;
*************** package System.Traceback_Entries is
*** 56,59 ****
     function TB_Entry_For (PC : System.Address) return Traceback_Entry;
  
  end System.Traceback_Entries;
- 
--- 57,59 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traent.adb gcc-4.1.0/gcc/ada/s-traent.adb
*** gcc-4.0.2/gcc/ada/s-traent.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-traent.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2003 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- 
  package body System.Traceback_Entries is
  
     ------------
--- 35,40 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-traent.ads gcc-4.1.0/gcc/ada/s-traent.ads
*** gcc-4.0.2/gcc/ada/s-traent.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-traent.ads	Mon Sep  5 07:46:06 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2003 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 20,27 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 20,27 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,52 ****
  --  address of a call instruction part of the call-chain.
  
  package System.Traceback_Entries is
  
     subtype Traceback_Entry is System.Address;
!    --  This subtype defines what each traceback array entry contains.
  
     Null_TB_Entry : constant Traceback_Entry := System.Null_Address;
!    --  This is the value to be used when initializing an entry.
  
     function PC_For (TB_Entry : Traceback_Entry) return System.Address;
     pragma Inline (PC_For);
--- 41,53 ----
  --  address of a call instruction part of the call-chain.
  
  package System.Traceback_Entries is
+    pragma Preelaborate;
  
     subtype Traceback_Entry is System.Address;
!    --  This subtype defines what each traceback array entry contains
  
     Null_TB_Entry : constant Traceback_Entry := System.Null_Address;
!    --  This is the value to be used when initializing an entry
  
     function PC_For (TB_Entry : Traceback_Entry) return System.Address;
     pragma Inline (PC_For);
*************** package System.Traceback_Entries is
*** 55,62 ****
  
     function TB_Entry_For (PC : System.Address) return Traceback_Entry;
     pragma Inline (TB_Entry_For);
!    --  Returns an entry representing a frame for a call instruction at PC.
  
  end System.Traceback_Entries;
- 
- 
--- 56,61 ----
  
     function TB_Entry_For (PC : System.Address) return Traceback_Entry;
     pragma Inline (TB_Entry_For);
!    --  Returns an entry representing a frame for a call instruction at PC
  
  end System.Traceback_Entries;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-trafor-default.adb gcc-4.1.0/gcc/ada/s-trafor-default.adb
*** gcc-4.0.2/gcc/ada/s-trafor-default.adb	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-trafor-default.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . F O R M A T                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . F O R M A T                 --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-trafor-default.ads gcc-4.1.0/gcc/ada/s-trafor-default.ads
*** gcc-4.0.2/gcc/ada/s-trafor-default.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-trafor-default.ads	Tue Nov 15 13:52:10 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . F O R M A T                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --             Copyright (C) 2001 Free Software Foundation, Inc.            --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . F O R M A T                 --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,39 ****
--- 34,40 ----
  --  This package implements functions to format run-time traces
  
  package System.Traces.Format is
+    pragma Preelaborate;
  
     Max_Size : constant Integer := 128;
     --  Event messages' maximum size.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tratas-default.adb gcc-4.1.0/gcc/ada/s-tratas-default.adb
*** gcc-4.0.2/gcc/ada/s-tratas-default.adb	Mon May 17 13:20:42 2004
--- gcc-4.1.0/gcc/ada/s-tratas-default.adb	Tue Nov 15 13:52:10 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T R A C E S . T A S K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2004 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T R A C E S . T A S K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --           Copyright (C) 2001-2005 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.Traces;        use System.Tr
*** 39,47 ****
  
  package body System.Traces.Tasking is
  
-    use System.Tasking;
     use System.Traces;
-    use System.Traces.Format;
  
     package SSL renames System.Soft_Links;
  
--- 39,45 ----
*************** package body System.Traces.Tasking is
*** 60,67 ****
                      (1 .. Task_Name2.Common.Task_Image_Len);
        Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 58,65 ----
                      (1 .. Task_Name2.Common.Task_Image_Len);
        Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 108,120 ****
        Task2_S : constant String :=
                    Task_Name2.Common.Task_Image
                      (1 .. Task_Name2.Common.Task_Image_Len);
!       Entry_S   : String := Integer'Image (Integer (Entry_Number));
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Task2_S'Length + Entry_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Entry_S'Length;
!       L2 : Integer := Task_S'Length + Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 106,118 ----
        Task2_S : constant String :=
                    Task_Name2.Common.Task_Image
                      (1 .. Task_Name2.Common.Task_Image_Len);
!       Entry_S   : constant String := Integer'Image (Integer (Entry_Number));
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Task2_S'Length + Entry_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Entry_S'Length;
!       L2 : constant Integer := Task_S'Length + Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 156,167 ****
        Task2_S : constant String :=
                    Task_Name2.Common.Task_Image
                      (1 .. Task_Name2.Common.Task_Image_Len);
!       Entry_S   : String := Integer'Image (Integer (Entry_Number));
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Task2_S'Length + Entry_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 154,165 ----
        Task2_S : constant String :=
                    Task_Name2.Common.Task_Image
                      (1 .. Task_Name2.Common.Task_Image_Len);
!       Entry_S   : constant String := Integer'Image (Integer (Entry_Number));
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Task2_S'Length + Entry_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 183,193 ****
     end Send_Trace_Info;
  
     procedure Send_Trace_Info (Id : Trace_T; Entry_Number : Entry_Index) is
!       Task_S  : String := SSL.Task_Name.all;
!       Entry_S : String := Integer'Image (Integer (Entry_Number));
        Trace_S : String (1 .. 6 + Task_S'Length + Entry_S'Length);
  
!       L0 : Integer := Task_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 181,191 ----
     end Send_Trace_Info;
  
     procedure Send_Trace_Info (Id : Trace_T; Entry_Number : Entry_Index) is
!       Task_S  : constant String := SSL.Task_Name.all;
!       Entry_S : constant String := Integer'Image (Integer (Entry_Number));
        Trace_S : String (1 .. 6 + Task_S'Length + Entry_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 212,218 ****
                      (1 .. Task_Name2.Common.Task_Image_Len);
        Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
  
!       L0 : Integer := Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 210,216 ----
                      (1 .. Task_Name2.Common.Task_Image_Len);
        Trace_S : String (1 .. 6 + Task_S'Length + Task2_S'Length);
  
!       L0 : constant Integer := Task2_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 234,247 ****
        Acceptor_S : constant String :=
                       Acceptor.Common.Task_Image
                         (1 .. Acceptor.Common.Task_Image_Len);
!       Entry_S    : String := Integer'Image (Integer (Entry_Number));
!       Timeout_S  : String := Duration'Image (Timeout);
        Trace_S    : String (1 .. 12 + Task_S'Length + Acceptor_S'Length
                                     + Entry_S'Length + Timeout_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Acceptor_S'Length;
!       L2 : Integer := Task_S'Length + Acceptor_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 232,246 ----
        Acceptor_S : constant String :=
                       Acceptor.Common.Task_Image
                         (1 .. Acceptor.Common.Task_Image_Len);
!       Entry_S    : constant String := Integer'Image (Integer (Entry_Number));
!       Timeout_S  : constant String := Duration'Image (Timeout);
        Trace_S    : String (1 .. 12 + Task_S'Length + Acceptor_S'Length
                                     + Entry_S'Length + Timeout_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Acceptor_S'Length;
!       L2 : constant Integer :=
!              Task_S'Length + Acceptor_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 262,275 ****
        Entry_Number : Entry_Index;
        Timeout      : Duration)
     is
!       Task_S    : String := SSL.Task_Name.all;
!       Entry_S   : String := Integer'Image (Integer (Entry_Number));
!       Timeout_S : String := Duration'Image (Timeout);
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Entry_S'Length + Timeout_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 261,274 ----
        Entry_Number : Entry_Index;
        Timeout      : Duration)
     is
!       Task_S    : constant String := SSL.Task_Name.all;
!       Entry_S   : constant String := Integer'Image (Integer (Entry_Number));
!       Timeout_S : constant String := Duration'Image (Timeout);
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Entry_S'Length + Timeout_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Entry_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 288,301 ****
        Task_Name : Task_Id;
        Number    : Integer)
     is
!       Task_S    : String := SSL.Task_Name.all;
!       Number_S  : String := Integer'Image (Number);
!       Accepts_S : String := Extract_Accepts (Task_Name);
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Number_S'Length + Accepts_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Number_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 287,300 ----
        Task_Name : Task_Id;
        Number    : Integer)
     is
!       Task_S    : constant String := SSL.Task_Name.all;
!       Number_S  : constant String := Integer'Image (Number);
!       Accepts_S : constant String := Extract_Accepts (Task_Name);
        Trace_S   : String (1 .. 9 + Task_S'Length
                                   + Number_S'Length + Accepts_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Number_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
*************** package body System.Traces.Tasking is
*** 315,330 ****
        Number    : Integer;
        Timeout   : Duration)
     is
!       Task_S    : String := SSL.Task_Name.all;
!       Timeout_S : String := Duration'Image (Timeout);
!       Number_S  : String := Integer'Image (Number);
!       Accepts_S : String := Extract_Accepts (Task_Name);
        Trace_S   : String (1 .. 12 + Task_S'Length + Timeout_S'Length
                                    + Number_S'Length + Accepts_S'Length);
  
!       L0 : Integer := Task_S'Length;
!       L1 : Integer := Task_S'Length + Timeout_S'Length;
!       L2 : Integer := Task_S'Length + Timeout_S'Length + Number_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
--- 314,330 ----
        Number    : Integer;
        Timeout   : Duration)
     is
!       Task_S    : constant String := SSL.Task_Name.all;
!       Timeout_S : constant String := Duration'Image (Timeout);
!       Number_S  : constant String := Integer'Image (Number);
!       Accepts_S : constant String := Extract_Accepts (Task_Name);
        Trace_S   : String (1 .. 12 + Task_S'Length + Timeout_S'Length
                                    + Number_S'Length + Accepts_S'Length);
  
!       L0 : constant Integer := Task_S'Length;
!       L1 : constant Integer := Task_S'Length + Timeout_S'Length;
!       L2 : constant Integer :=
!              Task_S'Length + Timeout_S'Length + Number_S'Length;
  
     begin
        if Parameters.Runtime_Traces then
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tratas.adb gcc-4.1.0/gcc/ada/s-tratas.adb
*** gcc-4.0.2/gcc/ada/s-tratas.adb	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tratas.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                 S Y S T E M . T R A C E S . T A S K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 2001-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                 S Y S T E M . T R A C E S . T A S K I N G                --
  --                                                                          --
  --                                  B o d y                                 --
  --                                                                          --
! --          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-tratas.ads gcc-4.1.0/gcc/ada/s-tratas.ads
*** gcc-4.0.2/gcc/ada/s-tratas.ads	Mon May 17 13:20:48 2004
--- gcc-4.1.0/gcc/ada/s-tratas.ads	Mon Sep  5 07:46:06 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . T A S K I N G               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2001-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                  S Y S T E M . T R A C E S . T A S K I N G               --
  --                                                                          --
  --                                  S p e c                                 --
  --                                                                          --
! --          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,46 ****
--- 41,47 ----
  with System.Tasking;
  
  package System.Traces.Tasking is
+    pragma Preelaborate;
  
     package ST renames System.Tasking;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-unstyp.ads gcc-4.1.0/gcc/ada/s-unstyp.ads
*** gcc-4.0.2/gcc/ada/s-unstyp.ads	Fri Jun 11 10:47:39 2004
--- gcc-4.1.0/gcc/ada/s-unstyp.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --                S Y S T E M . U N S I G N E D _ T Y P E S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --                S Y S T E M . U N S I G N E D _ T Y P E S                 --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,44 ****
  --  used by the compiler in connection with packed array types.
  
  package System.Unsigned_Types is
! pragma Pure (Unsigned_Types);
  
     type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size;
     type Short_Unsigned       is mod 2 ** Short_Integer'Size;
--- 38,44 ----
  --  used by the compiler in connection with packed array types.
  
  package System.Unsigned_Types is
!    pragma Pure;
  
     type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size;
     type Short_Unsigned       is mod 2 ** Short_Integer'Size;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vaflop-vms-alpha.adb gcc-4.1.0/gcc/ada/s-vaflop-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/s-vaflop-vms-alpha.adb	Mon Jun  7 14:16:14 2004
--- gcc-4.1.0/gcc/ada/s-vaflop-vms-alpha.adb	Tue Nov 15 13:56:51 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2000 Free Software Foundation, Inc.          --
  --                       (Version for Alpha OpenVMS)                        --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 Free Software Foundation, Inc.          --
  --                       (Version for Alpha OpenVMS)                        --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
***************
*** 17,24 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 17,24 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Vax_Float_Operations
*** 618,621 ****
--- 618,660 ----
        return R1;
     end Sub_G;
  
+    -------------
+    -- Valid_D --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_D (Arg : D) return Boolean is
+       Val : constant T := G_To_T (D_To_G (Arg));
+    begin
+       return Val'Valid;
+    end Valid_D;
+ 
+    -------------
+    -- Valid_F --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_F (Arg : F) return Boolean is
+       Val : constant S := F_To_S (Arg);
+    begin
+       return Val'Valid;
+    end Valid_F;
+ 
+    -------------
+    -- Valid_G --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_G (Arg : G) return Boolean is
+       Val : constant T := G_To_T (Arg);
+    begin
+       return Val'Valid;
+    end Valid_G;
+ 
  end System.Vax_Float_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vaflop.adb gcc-4.1.0/gcc/ada/s-vaflop.adb
*** gcc-4.0.2/gcc/ada/s-vaflop.adb	Thu Feb 10 13:56:44 2005
--- gcc-4.1.0/gcc/ada/s-vaflop.adb	Tue Nov 15 13:51:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.IO; use System.IO;
*** 41,47 ****
  
  package body System.Vax_Float_Operations is
     pragma Warnings (Off);
!    --  Warnings about infinite recursion when the -gnatdm switch is used.
  
     -----------
     -- Abs_F --
--- 41,47 ----
  
  package body System.Vax_Float_Operations is
     pragma Warnings (Off);
!    --  Warnings about infinite recursion when the -gnatdm switch is used
  
     -----------
     -- Abs_F --
*************** package body System.Vax_Float_Operations
*** 310,315 ****
--- 310,333 ----
        return X * Y;
     end Mul_G;
  
+    ----------
+    -- Ne_F --
+    ----------
+ 
+    function Ne_F (X, Y : F) return Boolean is
+    begin
+       return X /= Y;
+    end Ne_F;
+ 
+    ----------
+    -- Ne_G --
+    ----------
+ 
+    function Ne_G (X, Y : G) return Boolean is
+    begin
+       return X /= Y;
+    end Ne_G;
+ 
     -----------
     -- Neg_F --
     -----------
*************** package body System.Vax_Float_Operations
*** 418,421 ****
--- 436,478 ----
        return G (X);
     end T_To_G;
  
+    -------------
+    -- Valid_D --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_D (Arg : D) return Boolean is
+       Val : constant T := G_To_T (D_To_G (Arg));
+    begin
+       return Val'Valid;
+    end Valid_D;
+ 
+    -------------
+    -- Valid_F --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_F (Arg : F) return Boolean is
+       Val : constant S := F_To_S (Arg);
+    begin
+       return Val'Valid;
+    end Valid_F;
+ 
+    -------------
+    -- Valid_G --
+    -------------
+ 
+    --  For now, convert to IEEE and do Valid test on result. This is not quite
+    --  accurate, but is good enough in practice.
+ 
+    function Valid_G (Arg : G) return Boolean is
+       Val : constant T := G_To_T (Arg);
+    begin
+       return Val'Valid;
+    end Valid_G;
+ 
  end System.Vax_Float_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vaflop.ads gcc-4.1.0/gcc/ada/s-vaflop.ads
*** gcc-4.0.2/gcc/ada/s-vaflop.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-vaflop.ads	Tue Nov 15 13:51:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-1998 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package System.Vax_Float_Operations is
*** 139,144 ****
--- 139,157 ----
     function Lt_G (X, Y : G) return Boolean;
     --  Compares for X < Y
  
+    function Ne_F (X, Y : F) return Boolean;
+    function Ne_G (X, Y : G) return Boolean;
+    --  Compares for X /= Y
+ 
+    ----------------------------------
+    -- Routines for Valid Attribute --
+    ----------------------------------
+ 
+    function Valid_D (Arg : D) return Boolean;
+    function Valid_F (Arg : F) return Boolean;
+    function Valid_G (Arg : G) return Boolean;
+    --  Test whether Arg has a valid representation
+ 
     ----------------------
     -- Debug Procedures --
     ----------------------
*************** private
*** 209,213 ****
--- 222,232 ----
     pragma Inline (Le_G);
     pragma Inline (Lt_F);
     pragma Inline (Lt_G);
+    pragma Inline (Ne_F);
+    pragma Inline (Ne_G);
+ 
+    pragma Inline (Valid_D);
+    pragma Inline (Valid_F);
+    pragma Inline (Valid_G);
  
  end System.Vax_Float_Operations;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valboo.adb gcc-4.1.0/gcc/ada/s-valboo.adb
*** gcc-4.0.2/gcc/ada/s-valboo.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valboo.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Bool is
*** 49,64 ****
  
        if S (F .. L) = "TRUE" then
           return True;
-       end if;
  
!       if S (F .. L) = "FALSE" then
           return False;
-       end if;
- 
-       raise Constraint_Error;
- 
-       --  Above should use elsif, but this doesn't work in GNAT version 1.81???
  
     end Value_Boolean;
  
  end System.Val_Bool;
--- 49,61 ----
  
        if S (F .. L) = "TRUE" then
           return True;
  
!       elsif S (F .. L) = "FALSE" then
           return False;
  
+       else
+          raise Constraint_Error;
+       end if;
     end Value_Boolean;
  
  end System.Val_Bool;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valboo.ads gcc-4.1.0/gcc/ada/s-valboo.ads
*** gcc-4.0.2/gcc/ada/s-valboo.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valboo.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,40 ****
  ------------------------------------------------------------------------------
  
  package System.Val_Bool is
! pragma Pure (Val_Bool);
  
     function Value_Boolean (Str : String) return Boolean;
!    --  Computes Boolean'Value (Str).
  
  end System.Val_Bool;
--- 32,40 ----
  ------------------------------------------------------------------------------
  
  package System.Val_Bool is
!    pragma Pure;
  
     function Value_Boolean (Str : String) return Boolean;
!    --  Computes Boolean'Value (Str)
  
  end System.Val_Bool;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valcha.adb gcc-4.1.0/gcc/ada/s-valcha.adb
*** gcc-4.0.2/gcc/ada/s-valcha.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valcha.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Char is
*** 69,75 ****
  
           raise Constraint_Error;
        end if;
- 
     end Value_Character;
  
  end System.Val_Char;
--- 69,74 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valcha.ads gcc-4.1.0/gcc/ada/s-valcha.ads
*** gcc-4.0.2/gcc/ada/s-valcha.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valcha.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2000 Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,40 ****
  ------------------------------------------------------------------------------
  
  package System.Val_Char is
! pragma Pure (Val_Char);
  
     function Value_Character (Str : String) return Character;
!    --  Computes Character'Value (Str).
  
  end System.Val_Char;
--- 32,40 ----
  ------------------------------------------------------------------------------
  
  package System.Val_Char is
!    pragma Pure;
  
     function Value_Character (Str : String) return Character;
!    --  Computes Character'Value (Str)
  
  end System.Val_Char;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valdec.adb gcc-4.1.0/gcc/ada/s-valdec.adb
*** gcc-4.0.2/gcc/ada/s-valdec.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valdec.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Dec is
*** 48,58 ****
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer)
!       return  Integer
     is
        Val : Long_Long_Float;
- 
     begin
        Val := Scan_Real (Str, Ptr, Max);
        return Integer (Val * 10.0 ** Scale);
--- 48,56 ----
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer) return Integer
     is
        Val : Long_Long_Float;
     begin
        Val := Scan_Real (Str, Ptr, Max);
        return Integer (Val * 10.0 ** Scale);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valdec.ads gcc-4.1.0/gcc/ada/s-valdec.ads
*** gcc-4.0.2/gcc/ada/s-valdec.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valdec.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --            Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,49 ****
  --  Decimal_IO, and the Value attribute for such decimal types.
  
  package System.Val_Dec is
! pragma Pure (Val_Dec);
  
     function Scan_Decimal
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer)
!       return  Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
--- 36,48 ----
  --  Decimal_IO, and the Value attribute for such decimal types.
  
  package System.Val_Dec is
!    pragma Pure;
  
     function Scan_Decimal
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer) return Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valenu.adb gcc-4.1.0/gcc/ada/s-valenu.adb
*** gcc-4.0.2/gcc/ada/s-valenu.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valenu.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valenu.ads gcc-4.1.0/gcc/ada/s-valenu.ads
*** gcc-4.0.2/gcc/ada/s-valenu.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valenu.ads	Mon Sep  5 07:51:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000, Free Software Foundation, Inc.         --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  --  details of the format of constructed image tables.
  
  package System.Val_Enum is
! pragma Pure (Val_Enum);
  
     function Value_Enumeration_8
       (Names   : String;
--- 36,42 ----
  --  details of the format of constructed image tables.
  
  package System.Val_Enum is
!    pragma Pure;
  
     function Value_Enumeration_8
       (Names   : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valint.adb gcc-4.1.0/gcc/ada/s-valint.adb
*** gcc-4.0.2/gcc/ada/s-valint.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valint.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Int is
*** 42,51 ****
     ------------------
  
     function Scan_Integer
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Integer
     is
        Uval : Unsigned;
        --  Unsigned result
--- 42,50 ----
     ------------------
  
     function Scan_Integer
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Integer
     is
        Uval : Unsigned;
        --  Unsigned result
*************** package body System.Val_Int is
*** 79,85 ****
        else
           return Integer (Uval);
        end if;
- 
     end Scan_Integer;
  
     -------------------
--- 78,83 ----
*************** package body System.Val_Int is
*** 89,95 ****
     function Value_Integer (Str : String) return Integer is
        V : Integer;
        P : aliased Integer := Str'First;
- 
     begin
        V := Scan_Integer (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
--- 87,92 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valint.ads gcc-4.1.0/gcc/ada/s-valint.ads
*** gcc-4.0.2/gcc/ada/s-valint.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valint.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . V A L _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . V A L _ I N T                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,47 ****
  --  in Text_IO.Integer_IO, and the Value attribute.
  
  package System.Val_Int is
! pragma Pure (Val_Int);
  
     function Scan_Integer
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
--- 35,46 ----
  --  in Text_IO.Integer_IO, and the Value attribute.
  
  package System.Val_Int is
!    pragma Pure;
  
     function Scan_Integer
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vallld.adb gcc-4.1.0/gcc/ada/s-vallld.adb
*** gcc-4.0.2/gcc/ada/s-vallld.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-vallld.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_LLD is
*** 47,57 ****
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer)
!       return  Long_Long_Integer
     is
        Val : Long_Long_Float;
- 
     begin
        Val := Scan_Real (Str, Ptr, Max);
        return Long_Long_Integer (Val * 10.0 ** Scale);
--- 47,55 ----
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer) return Long_Long_Integer
     is
        Val : Long_Long_Float;
     begin
        Val := Scan_Real (Str, Ptr, Max);
        return Long_Long_Integer (Val * 10.0 ** Scale);
*************** package body System.Val_LLD is
*** 65,72 ****
  
     function Value_Long_Long_Decimal
       (Str   : String;
!       Scale : Integer)
!       return  Long_Long_Integer
     is
     begin
        return Long_Long_Integer (Value_Real (Str) * 10.0 ** Scale);
--- 63,69 ----
  
     function Value_Long_Long_Decimal
       (Str   : String;
!       Scale : Integer) return Long_Long_Integer
     is
     begin
        return Long_Long_Integer (Value_Real (Str) * 10.0 ** Scale);
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vallld.ads gcc-4.1.0/gcc/ada/s-vallld.ads
*** gcc-4.0.2/gcc/ada/s-vallld.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-vallld.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,49 ****
  --  Decimal_IO, and the Value attribute for such decimal types.
  
  package System.Val_LLD is
! pragma Pure (Val_LLD);
  
     function Scan_Long_Long_Decimal
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer)
!       return  Long_Long_Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
--- 36,48 ----
  --  Decimal_IO, and the Value attribute for such decimal types.
  
  package System.Val_LLD is
!    pragma Pure;
  
     function Scan_Long_Long_Decimal
       (Str   : String;
        Ptr   : access Integer;
        Max   : Integer;
!       Scale : Integer) return Long_Long_Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
*************** pragma Pure (Val_LLD);
*** 73,80 ****
  
     function Value_Long_Long_Decimal
       (Str   : String;
!       Scale : Integer)
!       return  Long_Long_Integer;
     --  Used in computing X'Value (Str) where X is a decimal types whose size
     --  exceeds Standard.Integer'Size. Str is the string argument of the
     --  attribute. Constraint_Error is raised if the string is malformed
--- 72,78 ----
  
     function Value_Long_Long_Decimal
       (Str   : String;
!       Scale : Integer) return Long_Long_Integer;
     --  Used in computing X'Value (Str) where X is a decimal types whose size
     --  exceeds Standard.Integer'Size. Str is the string argument of the
     --  attribute. Constraint_Error is raised if the string is malformed
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vallli.adb gcc-4.1.0/gcc/ada/s-vallli.adb
*** gcc-4.0.2/gcc/ada/s-vallli.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-vallli.adb	Tue Nov 15 14:06:45 2005
***************
*** 4,12 ****
  --                                                                          --
  --                       S Y S T E M . V A L _ L L I                        --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 4,12 ----
  --                                                                          --
  --                       S Y S T E M . V A L _ L L I                        --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_LLI is
*** 44,51 ****
     function Scan_Long_Long_Integer
       (Str  : String;
        Ptr  : access Integer;
!       Max  : Integer)
!       return Long_Long_Integer
     is
        Uval : Long_Long_Unsigned;
        --  Unsigned result
--- 44,50 ----
     function Scan_Long_Long_Integer
       (Str  : String;
        Ptr  : access Integer;
!       Max  : Integer) return Long_Long_Integer
     is
        Uval : Long_Long_Unsigned;
        --  Unsigned result
*************** package body System.Val_LLI is
*** 80,86 ****
        else
           return Long_Long_Integer (Uval);
        end if;
- 
     end Scan_Long_Long_Integer;
  
     -----------------------------
--- 79,84 ----
*************** package body System.Val_LLI is
*** 90,101 ****
     function Value_Long_Long_Integer (Str : String) return Long_Long_Integer is
        V : Long_Long_Integer;
        P : aliased Integer := Str'First;
- 
     begin
        V := Scan_Long_Long_Integer (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
        return V;
- 
     end Value_Long_Long_Integer;
  
  end System.Val_LLI;
--- 88,97 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vallli.ads gcc-4.1.0/gcc/ada/s-vallli.ads
*** gcc-4.0.2/gcc/ada/s-vallli.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-vallli.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,47 ****
  --  values for use in Text_IO.Integer_IO, and the Value attribute.
  
  package System.Val_LLI is
! pragma Pure (Val_LLI);
  
     function Scan_Long_Long_Integer
       (Str  : String;
        Ptr  : access Integer;
!       Max  : Integer)
!       return Long_Long_Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
--- 35,46 ----
  --  values for use in Text_IO.Integer_IO, and the Value attribute.
  
  package System.Val_LLI is
!    pragma Pure;
  
     function Scan_Long_Long_Integer
       (Str  : String;
        Ptr  : access Integer;
!       Max  : Integer) return Long_Long_Integer;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valllu.adb gcc-4.1.0/gcc/ada/s-valllu.adb
*** gcc-4.0.2/gcc/ada/s-valllu.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valllu.adb	Tue Nov 15 14:06:45 2005
***************
*** 4,12 ****
  --                                                                          --
  --                       S Y S T E M . V A L _ L L U                        --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 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- --
--- 4,12 ----
  --                                                                          --
  --                       S Y S T E M . V A L _ L L U                        --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_LLU is
*** 41,50 ****
     -----------------------------
  
     function Scan_Long_Long_Unsigned
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Long_Long_Unsigned
     is
        P : Integer;
        --  Local copy of the pointer
--- 41,49 ----
     -----------------------------
  
     function Scan_Long_Long_Unsigned
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Long_Long_Unsigned
     is
        P : Integer;
        --  Local copy of the pointer
*************** package body System.Val_LLU is
*** 286,302 ****
     ------------------------------
  
     function Value_Long_Long_Unsigned
!      (Str : String)
!      return Long_Long_Unsigned
     is
        V : Long_Long_Unsigned;
        P : aliased Integer := Str'First;
- 
     begin
        V := Scan_Long_Long_Unsigned (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
        return V;
- 
     end Value_Long_Long_Unsigned;
  
  end System.Val_LLU;
--- 285,298 ----
     ------------------------------
  
     function Value_Long_Long_Unsigned
!      (Str : String) return Long_Long_Unsigned
     is
        V : Long_Long_Unsigned;
        P : aliased Integer := Str'First;
     begin
        V := Scan_Long_Long_Unsigned (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
        return V;
     end Value_Long_Long_Unsigned;
  
  end System.Val_LLU;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valllu.ads gcc-4.1.0/gcc/ada/s-valllu.ads
*** gcc-4.0.2/gcc/ada/s-valllu.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valllu.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Unsigned_Types;
  
  package System.Val_LLU is
! pragma Pure (Val_LLU);
  
     function Scan_Long_Long_Unsigned
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return System.Unsigned_Types.Long_Long_Unsigned;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
--- 37,48 ----
  with System.Unsigned_Types;
  
  package System.Val_LLU is
!    pragma Pure;
  
     function Scan_Long_Long_Unsigned
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return System.Unsigned_Types.Long_Long_Unsigned;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
*************** pragma Pure (Val_LLU);
*** 71,78 ****
     --  is greater than Max as required in this case.
  
     function Value_Long_Long_Unsigned
!      (Str : String)
!      return System.Unsigned_Types.Long_Long_Unsigned;
     --  Used in computing X'Value (Str) where X is a modular integer type whose
     --  modulus exceeds the range of System.Unsigned_Types.Unsigned. Str is the
     --  string argument of the attribute. Constraint_Error is raised if the
--- 70,76 ----
     --  is greater than Max as required in this case.
  
     function Value_Long_Long_Unsigned
!      (Str : String) return System.Unsigned_Types.Long_Long_Unsigned;
     --  Used in computing X'Value (Str) where X is a modular integer type whose
     --  modulus exceeds the range of System.Unsigned_Types.Unsigned. Str is the
     --  string argument of the attribute. Constraint_Error is raised if the
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valrea.adb gcc-4.1.0/gcc/ada/s-valrea.adb
*** gcc-4.0.2/gcc/ada/s-valrea.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-valrea.adb	Tue Nov 15 14:06:45 2005
***************
*** 4,12 ****
  --                                                                          --
  --                      S Y S T E M . V A L _ R E A L                       --
  --                                                                          --
! --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 4,12 ----
  --                                                                          --
  --                      S Y S T E M . V A L _ R E A L                       --
  --                                                                          --
! --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Real is
*** 41,50 ****
     ---------------
  
     function Scan_Real
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Long_Long_Float
     is
        procedure Reset;
        pragma Import (C, Reset, "__gnat_init_float");
--- 41,49 ----
     ---------------
  
     function Scan_Real
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Long_Long_Float
     is
        procedure Reset;
        pragma Import (C, Reset, "__gnat_init_float");
*************** package body System.Val_Real is
*** 101,106 ****
--- 100,109 ----
        --  return P points past the last character. On entry, the current
        --  character is known to be a digit, so a numeral is definitely present.
  
+       -----------
+       -- Scanf --
+       -----------
+ 
        procedure Scanf is
           Digit : Natural;
  
*************** package body System.Val_Real is
*** 331,337 ****
        if Base /= 10.0 then
           Uval := Uval * Base ** Scale;
  
!       --  For base 10, use power of ten table, repeatedly if necessary.
  
        elsif Scale > 0 then
           while Scale > Maxpow loop
--- 334,340 ----
        if Base /= 10.0 then
           Uval := Uval * Base ** Scale;
  
!       --  For base 10, use power of ten table, repeatedly if necessary
  
        elsif Scale > 0 then
           while Scale > Maxpow loop
*************** package body System.Val_Real is
*** 369,375 ****
              return Uval;
           end if;
        end if;
- 
     end Scan_Real;
  
     ----------------
--- 372,377 ----
*************** package body System.Val_Real is
*** 379,390 ****
     function Value_Real (Str : String) return Long_Long_Float is
        V : Long_Long_Float;
        P : aliased Integer := Str'First;
- 
     begin
        V := Scan_Real (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
        return V;
- 
     end Value_Real;
  
  end System.Val_Real;
--- 381,390 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valrea.ads gcc-4.1.0/gcc/ada/s-valrea.ads
*** gcc-4.0.2/gcc/ada/s-valrea.ads	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valrea.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,44 ****
  ------------------------------------------------------------------------------
  
  package System.Val_Real is
! pragma Pure (Val_Real);
  
     function Scan_Real
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Long_Long_Float;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
--- 32,43 ----
  ------------------------------------------------------------------------------
  
  package System.Val_Real is
!    pragma Pure;
  
     function Scan_Real
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Long_Long_Float;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  real literal according to the syntax described in (RM 3.5(43)). The
     --  substring scanned extends no further than Str (Max). There are three
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valuns.adb gcc-4.1.0/gcc/ada/s-valuns.adb
*** gcc-4.0.2/gcc/ada/s-valuns.adb	Thu Apr 24 17:54:14 2003
--- gcc-4.1.0/gcc/ada/s-valuns.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-1997 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Uns is
*** 41,50 ****
     -------------------
  
     function Scan_Unsigned
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return Unsigned
     is
        P : Integer;
        --  Local copy of the pointer
--- 41,49 ----
     -------------------
  
     function Scan_Unsigned
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return Unsigned
     is
        P : Integer;
        --  Local copy of the pointer
*************** package body System.Val_Uns is
*** 285,296 ****
     function Value_Unsigned (Str : String) return Unsigned is
        V : Unsigned;
        P : aliased Integer := Str'First;
- 
     begin
        V := Scan_Unsigned (Str, P'Access, Str'Last);
        Scan_Trailing_Blanks (Str, P);
        return V;
- 
     end Value_Unsigned;
  
  end System.Val_Uns;
--- 284,293 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valuns.ads gcc-4.1.0/gcc/ada/s-valuns.ads
*** gcc-4.0.2/gcc/ada/s-valuns.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-valuns.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,49 ****
  with System.Unsigned_Types;
  
  package System.Val_Uns is
! pragma Pure (Val_Uns);
  
     function Scan_Unsigned
!      (Str  : String;
!       Ptr  : access Integer;
!       Max  : Integer)
!       return System.Unsigned_Types.Unsigned;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
--- 37,48 ----
  with System.Unsigned_Types;
  
  package System.Val_Uns is
!    pragma Pure;
  
     function Scan_Unsigned
!      (Str : String;
!       Ptr : access Integer;
!       Max : Integer) return System.Unsigned_Types.Unsigned;
     --  This function scans the string starting at Str (Ptr.all) for a valid
     --  integer according to the syntax described in (RM 3.5(43)). The substring
     --  scanned extends no further than Str (Max). There are three cases for the
*************** pragma Pure (Val_Uns);
*** 71,78 ****
     --  is greater than Max as required in this case.
  
     function Value_Unsigned
!      (Str : String)
!      return System.Unsigned_Types.Unsigned;
     --  Used in computing X'Value (Str) where X is a modular integer type whose
     --  modulus does not exceed the range of System.Unsigned_Types.Unsigned. Str
     --  is the string argument of the attribute. Constraint_Error is raised if
--- 70,76 ----
     --  is greater than Max as required in this case.
  
     function Value_Unsigned
!      (Str : String) return System.Unsigned_Types.Unsigned;
     --  Used in computing X'Value (Str) where X is a modular integer type whose
     --  modulus does not exceed the range of System.Unsigned_Types.Unsigned. Str
     --  is the string argument of the attribute. Constraint_Error is raised if
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valuti.adb gcc-4.1.0/gcc/ada/s-valuti.adb
*** gcc-4.0.2/gcc/ada/s-valuti.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-valuti.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Val_Util is
*** 83,90 ****
       (Str  : String;
        Ptr  : access Integer;
        Max  : Integer;
!       Real : Boolean := False)
!       return Integer
     is
        P : Natural := Ptr.all;
        M : Boolean;
--- 83,89 ----
       (Str  : String;
        Ptr  : access Integer;
        Max  : Integer;
!       Real : Boolean := False) return Integer
     is
        P : Natural := Ptr.all;
        M : Boolean;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valuti.ads gcc-4.1.0/gcc/ada/s-valuti.ads
*** gcc-4.0.2/gcc/ada/s-valuti.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-valuti.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --   Copyright (C) 1992,1993,1994,1995,1996 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package provides some common utilities used by the s-valxxx files
  
  package System.Val_Util is
! pragma Pure (Val_Util);
  
     procedure Normalize_String
       (S    : in out String;
--- 34,40 ----
  --  This package provides some common utilities used by the s-valxxx files
  
  package System.Val_Util is
!    pragma Pure;
  
     procedure Normalize_String
       (S    : in out String;
*************** pragma Pure (Val_Util);
*** 74,81 ****
       (Str  : String;
        Ptr  : access Integer;
        Max  : Integer;
!       Real : Boolean := False)
!       return Integer;
     --  Called to scan a possible exponent. Str, Ptr, Max are as described above
     --  for Scan_Sign. If Ptr.all < Max and Str (Ptr.all) = 'E' or 'e', then an
     --  exponent is scanned out, with the exponent value returned in Exp, and
--- 74,80 ----
       (Str  : String;
        Ptr  : access Integer;
        Max  : Integer;
!       Real : Boolean := False) return Integer;
     --  Called to scan a possible exponent. Str, Ptr, Max are as described above
     --  for Scan_Sign. If Ptr.all < Max and Str (Ptr.all) = 'E' or 'e', then an
     --  exponent is scanned out, with the exponent value returned in Exp, and
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valwch.adb gcc-4.1.0/gcc/ada/s-valwch.adb
*** gcc-4.0.2/gcc/ada/s-valwch.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-valwch.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,40 ****
  
  with Interfaces;      use Interfaces;
  with System.Val_Util; use System.Val_Util;
- with System.WCh_Con;  use System.WCh_Con;
- with System.WCh_StW;  use System.WCh_StW;
  
  package body System.Val_WChar is
  
--- 33,38 ----
*************** package body System.Val_WChar is
*** 43,57 ****
     --------------------------
  
     function Value_Wide_Character
!       (Str : String;
!        EM  : WC_Encoding_Method) return Wide_Character
     is
!       WWC : constant Wide_Wide_Character :=
!               Value_Wide_Wide_Character (Str, EM);
!       WWV : constant Unsigned_32 := Wide_Wide_Character'Pos (WWC);
     begin
        if WWV > 16#FFFF# then
!          raise Constraint_Error;
        else
           return Wide_Character'Val (WWV);
        end if;
--- 41,54 ----
     --------------------------
  
     function Value_Wide_Character
!       (Str : String) return Wide_Character
     is
!       WWC : constant Wide_Wide_Character := Value_Wide_Wide_Character (Str);
!       WWV : constant Unsigned_32         := Wide_Wide_Character'Pos (WWC);
     begin
        if WWV > 16#FFFF# then
!          raise Constraint_Error
!            with "out of range character for Value attribute";
        else
           return Wide_Character'Val (WWV);
        end if;
*************** package body System.Val_WChar is
*** 62,69 ****
     -------------------------------
  
     function Value_Wide_Wide_Character
!       (Str : String;
!        EM  : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_Character
     is
        F : Natural;
        L : Natural;
--- 59,65 ----
     -------------------------------
  
     function Value_Wide_Wide_Character
!       (Str : String) return Wide_Wide_Character
     is
        F : Natural;
        L : Natural;
*************** package body System.Val_WChar is
*** 81,128 ****
           if L - F = 2 then
              return Wide_Wide_Character'Val (Character'Pos (S (F + 1)));
  
!          --  Otherwise must be a wide character in quotes. The easiest
!          --  thing is to convert the string to a wide wide string and then
!          --  pick up the single character that it should contain.
  
           else
!             declare
!                WS : constant Wide_Wide_String :=
!                       String_To_Wide_Wide_String (S (F + 1 .. L - 1), EM);
! 
!             begin
!                if WS'Length /= 1 then
!                   raise Constraint_Error;
!                else
!                   return WS (WS'First);
!                end if;
!             end;
           end if;
  
!       --  the last two values of the type have language-defined names:
  
!       elsif S = "FFFE" then
!          return Wide_Wide_Character'Val (16#FFFE#);
  
!       elsif S = "FFFF" then
!          return Wide_Wide_Character'Val (16#FFFF#);
  
!       --  Otherwise must be a control character
  
!       else
!          for C in Character'Val (16#00#) .. Character'Val (16#1F#) loop
!             if S (F .. L) = Character'Image (C) then
!                return Wide_Wide_Character'Val (Character'Pos (C));
              end if;
!          end loop;
  
!          for C in Character'Val (16#7F#) .. Character'Val (16#9F#) loop
!             if S (F .. L) = Character'Image (C) then
!                return Wide_Wide_Character'Val (Character'Pos (C));
!             end if;
!          end loop;
  
!          raise Constraint_Error;
        end if;
     end Value_Wide_Wide_Character;
  
--- 77,123 ----
           if L - F = 2 then
              return Wide_Wide_Character'Val (Character'Pos (S (F + 1)));
  
!             --  Otherwise something is very wrong
  
           else
!             raise Constraint_Error with "invalid string for Value attribute";
           end if;
  
!       --  Deal with Hex_hhhhhhhh cases for wide_[wide_]character cases
  
!       elsif Str'Length = 12 and then Str (1 .. 4) = "Hex_" then
!          declare
!             W : Unsigned_32 := 0;
  
!          begin
!             for J in 5 .. 12 loop
!                W := W * 16 + Character'Pos (Str (J));
  
!                if Str (J) in '0' .. '9' then
!                   W := W - Character'Pos ('0');
!                elsif Str (J) in 'A' .. 'F' then
!                   W := W - Character'Pos ('A') + 10;
!                elsif Str (J) in 'a' .. 'f' then
!                   W := W - Character'Pos ('a') + 10;
!                else
!                   raise Constraint_Error
!                     with "illegal hex character for Value attribute";
!                end if;
!             end loop;
  
!             if W > 16#7FFF_FFFF# then
!                raise Constraint_Error
!                  with "out of range value for Value attribute";
!             else
!                return Wide_Wide_Character'Val (W);
              end if;
!          end;
  
!       --  Otherwise must be one of the special names for Character
  
!       else
!          return
!            Wide_Wide_Character'Val (Character'Pos (Character'Value (Str)));
        end if;
     end Value_Wide_Wide_Character;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-valwch.ads gcc-4.1.0/gcc/ada/s-valwch.ads
*** gcc-4.0.2/gcc/ada/s-valwch.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-valwch.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,51 ****
  
  --  Processing for Wide_[Wide_]Value attribute
  
- with System.WCh_Con;
- 
  package System.Val_WChar is
! pragma Pure (Val_WChar);
  
     function Value_Wide_Character
!       (Str : String;
!        EM  : System.WCh_Con.WC_Encoding_Method) return Wide_Character;
!    --  Computes Wide_Character'Value (Str).
  
     function Value_Wide_Wide_Character
!       (Str : String;
!        EM  : System.WCh_Con.WC_Encoding_Method) return Wide_Wide_Character;
!    --  Computes Wide_Character'Value (Str).
  
  end System.Val_WChar;
--- 33,47 ----
  
  --  Processing for Wide_[Wide_]Value attribute
  
  package System.Val_WChar is
!    pragma Pure;
  
     function Value_Wide_Character
!       (Str : String) return Wide_Character;
!    --  Computes Wide_Character'Value (Str)
  
     function Value_Wide_Wide_Character
!       (Str : String) return Wide_Wide_Character;
!    --  Computes Wide_Character'Value (Str)
  
  end System.Val_WChar;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-veboop.adb gcc-4.1.0/gcc/ada/s-veboop.adb
*** gcc-4.0.2/gcc/ada/s-veboop.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-veboop.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --     S Y S T E M . V E C T O R S . B O O L E A N _ O P E R A T I O N S    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --     S Y S T E M . V E C T O R S . B O O L E A N _ O P E R A T I O N S    --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-veboop.ads gcc-4.1.0/gcc/ada/s-veboop.ads
*** gcc-4.0.2/gcc/ada/s-veboop.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-veboop.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --    S Y S T E M . V E C T O R S . B O O L E A N _ O P E R A T I O N S     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --    S Y S T E M . V E C T O R S . B O O L E A N _ O P E R A T I O N S     --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains functions for runtime operations on boolean vectors
  
  package System.Vectors.Boolean_Operations is
! pragma Pure (Boolean_Operations);
  
     --  Although in general the boolean operations on arrays of booleans are
     --  identical to operations on arrays of unsigned words of the same size,
--- 34,40 ----
  --  This package contains functions for runtime operations on boolean vectors
  
  package System.Vectors.Boolean_Operations is
!    pragma Pure;
  
     --  Although in general the boolean operations on arrays of booleans are
     --  identical to operations on arrays of unsigned words of the same size,
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vector.ads gcc-4.1.0/gcc/ada/s-vector.ads
*** gcc-4.0.2/gcc/ada/s-vector.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-vector.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                       S Y S T E M . V E C T O R S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --             Copyright (C) 2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
  --                                                                          --
  --                       S Y S T E M . V E C T O R S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2002-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 41,47 ****
  --  direct processor support for them.
  
  package System.Vectors is
! pragma Pure (Vectors);
  
     type Vector is mod 2**System.Word_Size;
     for Vector'Alignment use Integer'Min
--- 41,47 ----
  --  direct processor support for them.
  
  package System.Vectors is
!    pragma Pure;
  
     type Vector is mod 2**System.Word_Size;
     for Vector'Alignment use Integer'Min
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vercon.adb gcc-4.1.0/gcc/ada/s-vercon.adb
*** gcc-4.0.2/gcc/ada/s-vercon.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-vercon.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --               S Y S T E M . V E R S I O N _ C O N T R O L                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --               S Y S T E M . V E R S I O N _ C O N T R O L                --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 32,37 ****
--- 32,38 ----
  ------------------------------------------------------------------------------
  
  with System.Unsigned_Types; use System.Unsigned_Types;
+ 
  package body System.Version_Control is
  
     ------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vercon.ads gcc-4.1.0/gcc/ada/s-vercon.ads
*** gcc-4.0.2/gcc/ada/s-vercon.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-vercon.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUNTIME COMPONENTS                         --
  --                                                                          --
  --               S Y S T E M . V E R S I O N _ C O N T R O L                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --     Copyright (C) 1992,1993,1994,1995 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                          GNAT RUN-TIME COMPONENTS                        --
  --                                                                          --
  --               S Y S T E M . V E R S I O N _ C O N T R O L                --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 38,45 ****
  with System.Unsigned_Types;
  
  package System.Version_Control is
! 
!    pragma Pure (Version_Control);
  
     subtype Version_String is String (1 .. 8);
     --  Eight character string returned by Get_version_String;
--- 38,44 ----
  with System.Unsigned_Types;
  
  package System.Version_Control is
!    pragma Pure;
  
     subtype Version_String is String (1 .. 8);
     --  Eight character string returned by Get_version_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vmexta.adb gcc-4.1.0/gcc/ada/s-vmexta.adb
*** gcc-4.0.2/gcc/ada/s-vmexta.adb	Mon Mar 15 14:51:00 2004
--- gcc-4.1.0/gcc/ada/s-vmexta.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vmexta.ads gcc-4.1.0/gcc/ada/s-vmexta.ads
*** gcc-4.0.2/gcc/ada/s-vmexta.ads	Mon Mar 15 14:51:00 2004
--- gcc-4.1.0/gcc/ada/s-vmexta.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-alpha.ads gcc-4.1.0/gcc/ada/s-vxwork-alpha.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-alpha.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-alpha.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2001 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     package IC renames Interfaces.C;
  
--- 36,42 ----
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     package IC renames Interfaces.C;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-m68k.ads gcc-4.1.0/gcc/ada/s-vxwork-m68k.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-m68k.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-m68k.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2001 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     package IC renames Interfaces.C;
  
--- 36,42 ----
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     package IC renames Interfaces.C;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-mips.ads gcc-4.1.0/gcc/ada/s-vxwork-mips.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-mips.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-mips.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2001 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     package IC renames Interfaces.C;
  
--- 36,42 ----
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     package IC renames Interfaces.C;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-ppc.ads gcc-4.1.0/gcc/ada/s-vxwork-ppc.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-ppc.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-ppc.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2001 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     package IC renames Interfaces.C;
  
--- 36,42 ----
  with Interfaces.C;
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     package IC renames Interfaces.C;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-sparcv9.ads gcc-4.1.0/gcc/ada/s-vxwork-sparcv9.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-sparcv9.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-sparcv9.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2002 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with Interfaces;
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     --  Floating point context record. SPARCV9 version
  
--- 36,42 ----
  with Interfaces;
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     --  Floating point context record. SPARCV9 version
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-x86.ads gcc-4.1.0/gcc/ada/s-vxwork-x86.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-x86.ads	Mon Oct  4 15:00:43 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-x86.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2004 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
  --                                                                          --
  --                        S Y S T E M . V X W O R K S                       --
  --                                                                          --
  --                                   S p e c                                --
  --                                                                          --
! --            Copyright (C) 1998-2005 Free Software Foundation, Inc.        --
  --                                                                          --
  -- GNARL 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNARL; see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This is the x86 VxWorks version of this package
  
  package System.VxWorks is
!    pragma Preelaborate (System.VxWorks);
  
     --  Floating point context record. x86 version
  
--- 34,40 ----
  --  This is the x86 VxWorks version of this package
  
  package System.VxWorks is
!    pragma Preelaborate;
  
     --  Floating point context record. x86 version
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-vxwork-xscale.ads gcc-4.1.0/gcc/ada/s-vxwork-xscale.ads
*** gcc-4.0.2/gcc/ada/s-vxwork-xscale.ads	Fri May 14 10:02:00 2004
--- gcc-4.1.0/gcc/ada/s-vxwork-xscale.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,54 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
- --                                                                          --
- --                        S Y S T E M . V X W O R K S                       --
- --                                                                          --
- --                                   S p e c                                --
- --                                                                          --
- --            Copyright (C) 1998-2002 Free Software Foundation, Inc.        --
- --                                                                          --
- -- GNARL is free software; you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNARL; see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNARL was developed by the GNARL team at Florida State University.       --
- -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is the Xscale VxWorks version of this package.
- 
- package System.VxWorks is
-    pragma Preelaborate (System.VxWorks);
- 
-    --  Floating point context record. Xscale version
- 
-    --  There is no floating point unit on Xscale. The record definition
-    --  below matches what arch/arm/fppArmLib.h says.
- 
-    type FP_CONTEXT is record
-       Dummy : Integer;
-    end record;
- 
-    for FP_CONTEXT'Alignment use 4;
-    pragma Convention (C, FP_CONTEXT);
- 
-    Num_HW_Interrupts : constant := 256;
-    --  Number of entries in hardware interrupt vector table.
- 
- end System.VxWorks;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchcnv.adb gcc-4.1.0/gcc/ada/s-wchcnv.adb
*** gcc-4.0.2/gcc/ada/s-wchcnv.adb	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/s-wchcnv.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ C N V                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ C N V                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchcnv.ads gcc-4.1.0/gcc/ada/s-wchcnv.ads
*** gcc-4.0.2/gcc/ada/s-wchcnv.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/s-wchcnv.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ C N V                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --           Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ C N V                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  with System.WCh_Con;
  
  package System.WCh_Cnv is
!    pragma Pure (WCh_Cnv);
  
     type UTF_32_Code is range 0 .. 16#7FFF_FFFF#;
     for UTF_32_Code'Size use 32;
--- 37,43 ----
  with System.WCh_Con;
  
  package System.WCh_Cnv is
!    pragma Pure;
  
     type UTF_32_Code is range 0 .. 16#7FFF_FFFF#;
     for UTF_32_Code'Size use 32;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchcon.ads gcc-4.1.0/gcc/ada/s-wchcon.ads
*** gcc-4.0.2/gcc/ada/s-wchcon.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/s-wchcon.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  --  an appropriate WITH, and the interface can be expected to remain stable.
  
  package System.WCh_Con is
! pragma Pure (WCh_Con);
  
     -------------------------------------
     -- Wide_Character Encoding Methods --
--- 39,45 ----
  --  an appropriate WITH, and the interface can be expected to remain stable.
  
  package System.WCh_Con is
!    pragma Pure;
  
     -------------------------------------
     -- Wide_Character Encoding Methods --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchjis.adb gcc-4.1.0/gcc/ada/s-wchjis.adb
*** gcc-4.0.2/gcc/ada/s-wchjis.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-wchjis.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ J I S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ J I S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchjis.ads gcc-4.1.0/gcc/ada/s-wchjis.ads
*** gcc-4.0.2/gcc/ada/s-wchjis.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-wchjis.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ J I S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ J I S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 35,41 ****
  --  JIS codes and the two external forms we support (EUC and Shift-JIS)
  
  package System.WCh_JIS is
! pragma Pure (WCh_JIS);
  
     function EUC_To_JIS (EUC1, EUC2 : Character) return Wide_Character;
     --  Given the two bytes of a EUC representation, return the
--- 35,41 ----
  --  JIS codes and the two external forms we support (EUC and Shift-JIS)
  
  package System.WCh_JIS is
!    pragma Pure;
  
     function EUC_To_JIS (EUC1, EUC2 : Character) return Wide_Character;
     --  Given the two bytes of a EUC representation, return the
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchstw.adb gcc-4.1.0/gcc/ada/s-wchstw.adb
*** gcc-4.0.2/gcc/ada/s-wchstw.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wchstw.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ S T W                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ S T W                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.WCh_StW is
*** 65,71 ****
        --  if P > S'Last on entry.
  
        function Get_UTF_32 is new Char_Sequence_To_UTF_32 (In_Char);
!       --  Function to get next UFT_32 value.
  
        -------------
        -- In_Char --
--- 65,71 ----
        --  if P > S'Last on entry.
  
        function Get_UTF_32 is new Char_Sequence_To_UTF_32 (In_Char);
!       --  Function to get next UFT_32 value
  
        -------------
        -- In_Char --
*************** package body System.WCh_StW is
*** 81,86 ****
--- 81,88 ----
           end if;
        end In_Char;
  
+    --  Start of processing for Get_Next_Code
+ 
     begin
        --  Check for wide character encoding
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchstw.ads gcc-4.1.0/gcc/ada/s-wchstw.ads
*** gcc-4.0.2/gcc/ada/s-wchstw.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wchstw.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ S T W                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ S T W                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,43 ****
  with System.WCh_Con;
  
  package System.WCh_StW is
! pragma Pure (WCh_StW);
  
     function String_To_Wide_String
       (S  : String;
--- 37,43 ----
  with System.WCh_Con;
  
  package System.WCh_StW is
!    pragma Pure;
  
     function String_To_Wide_String
       (S  : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchwts.adb gcc-4.1.0/gcc/ada/s-wchwts.adb
*** gcc-4.0.2/gcc/ada/s-wchwts.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wchwts.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ W T S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ W T S                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wchwts.ads gcc-4.1.0/gcc/ada/s-wchwts.ads
*** gcc-4.0.2/gcc/ada/s-wchwts.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wchwts.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W C H _ W T S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W C H _ W T S                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 39,45 ****
  with System.WCh_Con;
  
  package System.WCh_WtS is
! pragma Pure (WCh_WtS);
  
     function Wide_String_To_String
       (S  : Wide_String;
--- 39,45 ----
  with System.WCh_Con;
  
  package System.WCh_WtS is
!    pragma Pure;
  
     function Wide_String_To_String
       (S  : Wide_String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widboo.adb gcc-4.1.0/gcc/ada/s-widboo.adb
*** gcc-4.0.2/gcc/ada/s-widboo.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widboo.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ B O O L                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ B O O L                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widboo.ads gcc-4.1.0/gcc/ada/s-widboo.ads
*** gcc-4.0.2/gcc/ada/s-widboo.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widboo.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ B O O L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ B O O L                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains the routine used for Boolean'Width
  
  package System.Wid_Bool is
! pragma Pure (Wid_Bool);
  
     function Width_Boolean (Lo, Hi : Boolean) return Natural;
     --  Compute Width attribute for non-static type derived from Boolean.
--- 34,40 ----
  --  This package contains the routine used for Boolean'Width
  
  package System.Wid_Bool is
!    pragma Pure;
  
     function Width_Boolean (Lo, Hi : Boolean) return Natural;
     --  Compute Width attribute for non-static type derived from Boolean.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widcha.adb gcc-4.1.0/gcc/ada/s-widcha.adb
*** gcc-4.0.2/gcc/ada/s-widcha.adb	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/s-widcha.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widcha.ads gcc-4.1.0/gcc/ada/s-widcha.ads
*** gcc-4.0.2/gcc/ada/s-widcha.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widcha.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains the routine used for Character'Width
  
  package System.Wid_Char is
! pragma Pure (Wid_Char);
  
     function Width_Character (Lo, Hi : Character) return Natural;
     --  Compute Width attribute for non-static type derived from Character.
--- 34,40 ----
  --  This package contains the routine used for Character'Width
  
  package System.Wid_Char is
!    pragma Pure;
  
     function Width_Character (Lo, Hi : Character) return Natural;
     --  Compute Width attribute for non-static type derived from Character.
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widenu.adb gcc-4.1.0/gcc/ada/s-widenu.adb
*** gcc-4.0.2/gcc/ada/s-widenu.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widenu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widenu.ads gcc-4.1.0/gcc/ada/s-widenu.ads
*** gcc-4.0.2/gcc/ada/s-widenu.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widenu.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W I D _ E N U M                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W I D _ E N U M                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains the routine used for Enumeration_Type'Width
  
  package System.Wid_Enum is
! pragma Pure (Wid_Enum);
  
     function Width_Enumeration_8
       (Names   : String;
--- 34,40 ----
  --  This package contains the routine used for Enumeration_Type'Width
  
  package System.Wid_Enum is
!    pragma Pure;
  
     function Width_Enumeration_8
       (Names   : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widlli.adb gcc-4.1.0/gcc/ada/s-widlli.adb
*** gcc-4.0.2/gcc/ada/s-widlli.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widlli.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L I                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widlli.ads gcc-4.1.0/gcc/ada/s-widlli.ads
*** gcc-4.0.2/gcc/ada/s-widlli.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widlli.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L I                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,42 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routine used for WIdth attribute for all
  --  non-static signed integer subtypes. Note we only have one routine,
  --  since this seems a fairly marginal function.
  
  package System.Wid_LLI is
! pragma Pure (Wid_LLI);
  
     function Width_Long_Long_Integer
       (Lo, Hi : Long_Long_Integer)
--- 31,42 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routine used for Width attribute for all
  --  non-static signed integer subtypes. Note we only have one routine,
  --  since this seems a fairly marginal function.
  
  package System.Wid_LLI is
!    pragma Pure;
  
     function Width_Long_Long_Integer
       (Lo, Hi : Long_Long_Integer)
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widllu.adb gcc-4.1.0/gcc/ada/s-widllu.adb
*** gcc-4.0.2/gcc/ada/s-widllu.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widllu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L U                        --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widllu.ads gcc-4.1.0/gcc/ada/s-widllu.ads
*** gcc-4.0.2/gcc/ada/s-widllu.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/s-widllu.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                       S Y S T E M . W I D _ L L U                        --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,44 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routine used for WIdth attribute for all
  --  non-static unsigned integer (modular integer) subtypes. Note we only
  --  have one routine, since this seems a fairly marginal function.
  
  with System.Unsigned_Types;
  
  package System.Wid_LLU is
! pragma Pure (Wid_LLU);
  
     function Width_Long_Long_Unsigned
       (Lo, Hi : System.Unsigned_Types.Long_Long_Unsigned)
--- 31,44 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This package contains the routine used for Width attribute for all
  --  non-static unsigned integer (modular integer) subtypes. Note we only
  --  have one routine, since this seems a fairly marginal function.
  
  with System.Unsigned_Types;
  
  package System.Wid_LLU is
!    pragma Pure;
  
     function Width_Long_Long_Unsigned
       (Lo, Hi : System.Unsigned_Types.Long_Long_Unsigned)
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widwch.adb gcc-4.1.0/gcc/ada/s-widwch.adb
*** gcc-4.0.2/gcc/ada/s-widwch.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-widwch.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . W I D _ W C H A R                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . W I D _ W C H A R                      --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,38 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with System.WCh_Con; use System.WCh_Con;
- 
  package body System.Wid_WChar is
  
     --------------------------
--- 31,36 ----
*************** package body System.Wid_WChar is
*** 40,47 ****
     --------------------------
  
     function Width_Wide_Character
!      (Lo, Hi : Wide_Character;
!       EM     : WC_Encoding_Method) return Natural
     is
        W : Natural;
        P : Natural;
--- 38,44 ----
     --------------------------
  
     function Width_Wide_Character
!      (Lo, Hi : Wide_Character) return Natural
     is
        W : Natural;
        P : Natural;
*************** package body System.Wid_WChar is
*** 52,87 ****
           P := Wide_Character'Pos (C);
  
           --  Here if we find a character in wide character range
  
           if P > 16#FF# then
  
!             case EM is
! 
!                when WCEM_Hex =>
!                   return Natural'Max (W, 5);
! 
!                when WCEM_Upper =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_Shift_JIS =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_EUC =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_UTF8 =>
!                   if Hi > Wide_Character'Val (16#07FF#) then
!                      return Natural'Max (W, 3);
!                   else
!                      return Natural'Max (W, 2);
!                   end if;
! 
!                when WCEM_Brackets =>
!                   return Natural'Max (W, 8);
! 
!             end case;
! 
!          --  If we are in character range then use length of character image
  
           else
              declare
--- 49,60 ----
           P := Wide_Character'Pos (C);
  
           --  Here if we find a character in wide character range
+          --  Width is max value (12) for Hex_hhhhhhhh
  
           if P > 16#FF# then
+             return 12;
  
!             --  If we are in character range then use length of character image
  
           else
              declare
*************** package body System.Wid_WChar is
*** 100,107 ****
     -------------------------------
  
     function Width_Wide_Wide_Character
!      (Lo, Hi : Wide_Wide_Character;
!       EM     : WC_Encoding_Method) return Natural
     is
        W : Natural;
        P : Natural;
--- 73,79 ----
     -------------------------------
  
     function Width_Wide_Wide_Character
!      (Lo, Hi : Wide_Wide_Character) return Natural
     is
        W : Natural;
        P : Natural;
*************** package body System.Wid_WChar is
*** 111,145 ****
        for C in Lo .. Hi loop
           P := Wide_Wide_Character'Pos (C);
  
!          --  Here if we find a character in wide wide character range
  
           if P > 16#FF# then
!             case EM is
!                when WCEM_Hex =>
!                   return Natural'Max (W, 5);
! 
!                when WCEM_Upper =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_Shift_JIS =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_EUC =>
!                   return Natural'Max (W, 2);
! 
!                when WCEM_UTF8 =>
!                   if Hi > Wide_Wide_Character'Val (16#FFFF#) then
!                      return Natural'Max (W, 4);
!                   elsif Hi > Wide_Wide_Character'Val (16#07FF#) then
!                      return Natural'Max (W, 3);
!                   else
!                      return Natural'Max (W, 2);
!                   end if;
! 
!                when WCEM_Brackets =>
!                   return Natural'Max (W, 10);
! 
!             end case;
  
           --  If we are in character range then use length of character image
  
--- 83,93 ----
        for C in Lo .. Hi loop
           P := Wide_Wide_Character'Pos (C);
  
!          --  Here if we find a character in wide wide character range.
!          --  Width is max value (12) for Hex_hhhhhhhh
  
           if P > 16#FF# then
!             W := 12;
  
           --  If we are in character range then use length of character image
  
diff -Nrcpad gcc-4.0.2/gcc/ada/s-widwch.ads gcc-4.1.0/gcc/ada/s-widwch.ads
*** gcc-4.0.2/gcc/ada/s-widwch.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-widwch.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . W I D _ W C H A R                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . W I D _ W C H A R                      --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 33,53 ****
  
  --  This package contains the routines used for Wide_[Wide_]Character'Width
  
- with System.WCh_Con;
- 
  package System.Wid_WChar is
! pragma Pure (Wid_WChar);
  
     function Width_Wide_Character
!      (Lo, Hi : Wide_Character;
!       EM     : System.WCh_Con.WC_Encoding_Method) return Natural;
     --  Compute Width attribute for non-static type derived from Wide_Character.
!    --  The arguments are the low and high bounds for the type. EM is the
!    --  wide-character encoding method.
  
     function Width_Wide_Wide_Character
!      (Lo, Hi : Wide_Wide_Character;
!       EM     : System.WCh_Con.WC_Encoding_Method) return Natural;
     --  Same function for type derived from Wide_Wide_Character
  
  end System.Wid_WChar;
--- 33,48 ----
  
  --  This package contains the routines used for Wide_[Wide_]Character'Width
  
  package System.Wid_WChar is
!    pragma Pure;
  
     function Width_Wide_Character
!      (Lo, Hi : Wide_Character) return Natural;
     --  Compute Width attribute for non-static type derived from Wide_Character.
!    --  The arguments are the low and high bounds for the type.
  
     function Width_Wide_Wide_Character
!      (Lo, Hi : Wide_Wide_Character) return Natural;
     --  Same function for type derived from Wide_Wide_Character
  
  end System.Wid_WChar;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdcha.adb gcc-4.1.0/gcc/ada/s-wwdcha.adb
*** gcc-4.0.2/gcc/ada/s-wwdcha.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wwdcha.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W W D _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W W D _ C H A R                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.WWd_Char is
*** 43,53 ****
     begin
        W := 0;
        for C in Lo .. Hi loop
!          declare
!             S : constant Wide_String := Character'Wide_Image (C);
!          begin
!             W := Natural'Max (W, S'Length);
!          end;
        end loop;
  
        return W;
--- 43,62 ----
     begin
        W := 0;
        for C in Lo .. Hi loop
!          --  For Character range, use length of image
! 
!          if Character'Pos (C) < 256 then
!             declare
!                S : constant Wide_String := Character'Wide_Image (C);
!             begin
!                W := Natural'Max (W, S'Length);
!             end;
! 
!             --  For wide character, always max out at 12 (Hex_hhhhhhhh)
! 
!          else
!             return 12;
!          end if;
        end loop;
  
        return W;
*************** package body System.WWd_Char is
*** 63,73 ****
     begin
        W := 0;
        for C in Lo .. Hi loop
!          declare
!             S : constant Wide_Wide_String := Character'Wide_Wide_Image (C);
!          begin
!             W := Natural'Max (W, S'Length);
!          end;
        end loop;
  
        return W;
--- 72,92 ----
     begin
        W := 0;
        for C in Lo .. Hi loop
! 
!          --  For Character range, use length of image
! 
!          if Character'Pos (C) < 256 then
!             declare
!                S : constant String := Character'Image (C);
!             begin
!                W := Natural'Max (W, S'Length);
!             end;
! 
!             --  For wide character, always max out at 12 (Hex_hhhhhhhh)
! 
!          else
!             return 12;
!          end if;
        end loop;
  
        return W;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdcha.ads gcc-4.1.0/gcc/ada/s-wwdcha.ads
*** gcc-4.0.2/gcc/ada/s-wwdcha.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wwdcha.ads	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W W D _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W W D _ C H A R                       --
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains the routine used for Character'Wide_[Wide_]Width
  
  package System.WWd_Char is
! pragma Pure (WWd_Char);
  
     function Wide_Width_Character (Lo, Hi : Character) return Natural;
     --  Compute Wide_Width attribute for non-static type derived from
--- 34,40 ----
  --  This package contains the routine used for Character'Wide_[Wide_]Width
  
  package System.WWd_Char is
!    pragma Pure;
  
     function Wide_Width_Character (Lo, Hi : Character) return Natural;
     --  Compute Wide_Width attribute for non-static type derived from
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdenu.adb gcc-4.1.0/gcc/ada/s-wwdenu.adb
*** gcc-4.0.2/gcc/ada/s-wwdenu.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wwdenu.adb	Tue Nov 15 14:06:45 2005
***************
*** 1,12 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                      S Y S T E M . W W D _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 1,12 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                      S Y S T E M . W W D _ E N U M                       --
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdenu.ads gcc-4.1.0/gcc/ada/s-wwdenu.ads
*** gcc-4.0.2/gcc/ada/s-wwdenu.ads	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/s-wwdenu.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 36,42 ****
  with System.WCh_Con;
  
  package System.WWd_Enum is
! pragma Pure (WWd_Enum);
  
     function Wide_Width_Enumeration_8
       (Names   : String;
--- 36,42 ----
  with System.WCh_Con;
  
  package System.WWd_Enum is
!    pragma Pure;
  
     function Wide_Width_Enumeration_8
       (Names   : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdwch.adb gcc-4.1.0/gcc/ada/s-wwdwch.adb
*** gcc-4.0.2/gcc/ada/s-wwdwch.adb	Thu Feb 10 13:50:24 2005
--- gcc-4.1.0/gcc/ada/s-wwdwch.adb	Fri Jul  1 01:29:17 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . W W D _ W C H A R                      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . W W D _ W C H A R                      --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body System.Wwd_WChar is
*** 59,65 ****
     function Wide_Wide_Width_Wide_Wide_Char
       (Lo, Hi : Wide_Wide_Character) return Natural
     is
-       W  : Natural := 0;
        LV : constant Unsigned_32 := Wide_Wide_Character'Pos (Lo);
        HV : constant Unsigned_32 := Wide_Wide_Character'Pos (Hi);
  
--- 59,64 ----
*************** package body System.Wwd_WChar is
*** 68,103 ****
  
        if LV > HV then
           return 0;
!       end if;
  
        --  If any characters in normal character range, then use normal
        --  Wide_Wide_Width attribute on this range to find out a starting point.
        --  Otherwise start with zero.
  
!       if LV <= 255 then
!          W :=
             System.WWd_Char.Wide_Wide_Width_Character
               (Lo => Character'Val (LV),
                Hi => Character'Val (Unsigned_32'Min (255, HV)));
-       else
-          W := 0;
        end if;
- 
-       --  Increase to at least 4 if FFFE or FFFF present. These correspond
-       --  to the special language defined names FFFE/FFFF for these values.
- 
-       if 16#FFFF# in LV .. HV or else 16#FFFE# in LV .. HV then
-          W := Natural'Max (W, 4);
-       end if;
- 
-       --  Increase to at least 3 if any wide characters, corresponding to
-       --  the normal ' character ' sequence. We know that the character fits.
- 
-       if HV > 255 then
-          W := Natural'Max (W, 3);
-       end if;
- 
-       return W;
     end Wide_Wide_Width_Wide_Wide_Char;
  
     -------------------------------
--- 67,88 ----
  
        if LV > HV then
           return 0;
! 
!       --  Return max value (12) for wide character (Hex_hhhhhhhh)
! 
!       elsif HV > 255 then
!          return 12;
  
        --  If any characters in normal character range, then use normal
        --  Wide_Wide_Width attribute on this range to find out a starting point.
        --  Otherwise start with zero.
  
!       else
!          return
             System.WWd_Char.Wide_Wide_Width_Character
               (Lo => Character'Val (LV),
                Hi => Character'Val (Unsigned_32'Min (255, HV)));
        end if;
     end Wide_Wide_Width_Wide_Wide_Char;
  
     -------------------------------
*************** package body System.Wwd_WChar is
*** 107,113 ****
     function Wide_Width_Wide_Character
       (Lo, Hi : Wide_Character) return Natural
     is
-       W  : Natural := 0;
        LV : constant Unsigned_32 := Wide_Character'Pos (Lo);
        HV : constant Unsigned_32 := Wide_Character'Pos (Hi);
  
--- 92,97 ----
*************** package body System.Wwd_WChar is
*** 116,177 ****
  
        if LV > HV then
           return 0;
!       end if;
  
        --  If any characters in normal character range, then use normal
        --  Wide_Wide_Width attribute on this range to find out a starting point.
        --  Otherwise start with zero.
  
!       if LV <= 255 then
!          W :=
             System.WWd_Char.Wide_Width_Character
               (Lo => Character'Val (LV),
                Hi => Character'Val (Unsigned_32'Min (255, HV)));
-       else
-          W := 0;
-       end if;
- 
-       --  Increase to at least 4 if FFFE or FFFF present. These correspond
-       --  to the special language defined names FFFE/FFFF for these values.
- 
-       if 16#FFFF# in LV .. HV or else 16#FFFE# in LV .. HV then
-          W := Natural'Max (W, 4);
-       end if;
- 
-       --  Increase to at least 3 if any wide characters, corresponding to
-       --  the normal 'character' sequence. We know that the character fits.
- 
-       if HV > 255 then
-          W := Natural'Max (W, 3);
        end if;
- 
-       return W;
     end Wide_Width_Wide_Character;
  
     ------------------------------------
     -- Wide_Width_Wide_Wide_Character --
     ------------------------------------
  
-    --  This is a nasty case, because we get into the business of representing
-    --  out of range wide wide characters as wide strings. Let's let image do
-    --  the work here. Too bad if this takes lots of time. It's silly anyway!
- 
     function Wide_Width_Wide_Wide_Character
       (Lo, Hi : Wide_Wide_Character) return Natural
     is
-       W : Natural;
- 
     begin
!       W := 0;
!       for J in Lo .. Hi loop
!          declare
!             S : constant Wide_String := Wide_Wide_Character'Wide_Image (J);
!          begin
!             W := Natural'Max (W, S'Length);
!          end;
!       end loop;
! 
!       return W;
     end Wide_Width_Wide_Wide_Character;
  
  end System.Wwd_WChar;
--- 100,132 ----
  
        if LV > HV then
           return 0;
! 
!       --  Return max value (12) for wide character (Hex_hhhhhhhh)
! 
!       elsif HV > 255 then
!          return 12;
  
        --  If any characters in normal character range, then use normal
        --  Wide_Wide_Width attribute on this range to find out a starting point.
        --  Otherwise start with zero.
  
!       else
!          return
             System.WWd_Char.Wide_Width_Character
               (Lo => Character'Val (LV),
                Hi => Character'Val (Unsigned_32'Min (255, HV)));
        end if;
     end Wide_Width_Wide_Character;
  
     ------------------------------------
     -- Wide_Width_Wide_Wide_Character --
     ------------------------------------
  
     function Wide_Width_Wide_Wide_Character
       (Lo, Hi : Wide_Wide_Character) return Natural
     is
     begin
!       return Wide_Wide_Width_Wide_Wide_Char (Lo, Hi);
     end Wide_Width_Wide_Wide_Character;
  
  end System.Wwd_WChar;
diff -Nrcpad gcc-4.0.2/gcc/ada/s-wwdwch.ads gcc-4.1.0/gcc/ada/s-wwdwch.ads
*** gcc-4.0.2/gcc/ada/s-wwdwch.ads	Thu Feb 10 13:50:24 2005
--- gcc-4.1.0/gcc/ada/s-wwdwch.ads	Mon Sep  5 07:51:25 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                     S Y S T E M . W W D _ W C H A R                      --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                     S Y S T E M . W W D _ W C H A R                      --
  --                                                                          --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 34,40 ****
  --  This package contains routines for [Wide_]Wide_Character'[Wide_]Wide_Width
  
  package System.Wwd_WChar is
! pragma Pure (Wwd_WChar);
  
     function Wide_Width_Wide_Character
       (Lo, Hi : Wide_Character) return Natural;
--- 34,40 ----
  --  This package contains routines for [Wide_]Wide_Character'[Wide_]Wide_Width
  
  package System.Wwd_WChar is
!    pragma Pure;
  
     function Wide_Width_Wide_Character
       (Lo, Hi : Wide_Character) return Natural;
diff -Nrcpad gcc-4.0.2/gcc/ada/scans.adb gcc-4.1.0/gcc/ada/scans.adb
*** gcc-4.0.2/gcc/ada/scans.adb	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/scans.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/scans.ads gcc-4.1.0/gcc/ada/scans.ads
*** gcc-4.0.2/gcc/ada/scans.ads	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/scans.ads	Tue Nov 15 13:59:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Scans is
*** 190,211 ****
  
        Tok_Dot_Dot,         -- ..           Sterm, Chtok
  
-       --  The following three entries are used only when scanning project
-       --  files.
- 
        Tok_Project,
        Tok_Extends,
        Tok_External,
!       Tok_Comment,
  
!       --  The following entry is used by the preprocessor and when scanning
!       --  project files.
  
        Tok_End_Of_Line,
! 
!       --  The following entry is used by the preprocessor
  
        Tok_Special,
  
        No_Token);
        --  No_Token is used for initializing Token values to indicate that
--- 190,216 ----
  
        Tok_Dot_Dot,         -- ..           Sterm, Chtok
  
        Tok_Project,
        Tok_Extends,
        Tok_External,
!       --  These three entries represent keywords for the project file language
!       --  and can be returned only in the case of scanning project files.
  
!       Tok_Comment,
!       --  This entry is used when scanning project files (where it represents
!       --  an entire comment), and in preprocessing with the -C switch set
!       --  (where it represents just the "--" of a comment). For the project
!       --  file case, the text of the comment is stored in
  
        Tok_End_Of_Line,
!       --  Represents an end of line. Not used during normal compilation scans
!       --  where end of line is ignored. Active for preprocessor scanning and
!       --  also when scanning project files (where it is neede because of ???)
  
        Tok_Special,
+       --  Used only in preprocessor scanning (to represent one of the
+       --  characters '#', '$', '?', '@', '`', '\', '^', '~', or '_'. The
+       --  character value itself is stored in Scans.Special_Character.
  
        No_Token);
        --  No_Token is used for initializing Token values to indicate that
*************** package Scans is
*** 394,400 ****
     --  We do things this way to minimize the impact on comment scanning.
  
     Character_Code : Char_Code;
!    --  Valid only when Token is Tok_Char_Literal.
  
     Real_Literal_Value : Ureal;
     --  Valid only when Token is Tok_Real_Literal
--- 399,405 ----
     --  We do things this way to minimize the impact on comment scanning.
  
     Character_Code : Char_Code;
!    --  Valid only when Token is Tok_Char_Literal
  
     Real_Literal_Value : Ureal;
     --  Valid only when Token is Tok_Real_Literal
*************** package Scans is
*** 411,421 ****
     --  Valid only when Token = Tok_String_Literal.
  
     Special_Character : Character;
!    --  Valid only when Token = Tok_Special
  
     Comment_Id : Name_Id := No_Name;
     --  Valid only when Token = Tok_Comment. Store the string that follows
!    --  the two '-' of a comment.
  
     --------------------------------------------------------
     -- Procedures for Saving and Restoring the Scan State --
--- 416,432 ----
     --  Valid only when Token = Tok_String_Literal.
  
     Special_Character : Character;
!    --  Valid only when Token = Tok_Special. Returns one of the characters
!    --  '#', '$', '?', '@', '`', '\', '^', '~', or '_'.
!    --
!    --  Why only this set? What about wide characters???
  
     Comment_Id : Name_Id := No_Name;
     --  Valid only when Token = Tok_Comment. Store the string that follows
!    --  the "--" of a comment when scanning project files.
!    --
!    --  Is it really right for this to be a Name rather than a String, what
!    --  about the case of Wide_Wide_Characters???
  
     --------------------------------------------------------
     -- Procedures for Saving and Restoring the Scan State --
diff -Nrcpad gcc-4.0.2/gcc/ada/scn.adb gcc-4.1.0/gcc/ada/scn.adb
*** gcc-4.0.2/gcc/ada/scn.adb	Thu Feb 10 13:50:28 2005
--- gcc-4.1.0/gcc/ada/scn.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Scn is
*** 45,52 ****
     --  keyword as an identifier once for a given keyword).
  
     procedure Check_End_Of_Line;
!    --  Called when end of line encountered. Checks that line is not
!    --  too long, and that other style checks for the end of line are met.
  
     function Determine_License return License_Type;
     --  Scan header of file and check that it has an appropriate GNAT-style
--- 45,52 ----
     --  keyword as an identifier once for a given keyword).
  
     procedure Check_End_Of_Line;
!    --  Called when end of line encountered. Checks that line is not too long,
!    --  and that other style checks for the end of line are met.
  
     function Determine_License return License_Type;
     --  Scan header of file and check that it has an appropriate GNAT-style
diff -Nrcpad gcc-4.0.2/gcc/ada/scn.ads gcc-4.1.0/gcc/ada/scn.ads
*** gcc-4.0.2/gcc/ada/scn.ads	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/scn.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/scng.adb gcc-4.1.0/gcc/ada/scng.adb
*** gcc-4.0.2/gcc/ada/scng.adb	Thu Feb 10 13:50:28 2005
--- gcc-4.1.0/gcc/ada/scng.adb	Tue Nov 15 13:59:30 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Widechar; use Widechar;
*** 40,45 ****
--- 40,47 ----
  with System.CRC32;
  with System.WCh_Con; use System.WCh_Con;
  
+ with GNAT.UTF_32; use GNAT.UTF_32;
+ 
  package body Scng is
  
     use ASCII;
*************** package body Scng is
*** 95,101 ****
     procedure Accumulate_Checksum (C : Char_Code) is
     begin
        if C > 16#FFFF# then
!          Accumulate_Checksum (Character'Val (C / 2 ** 16));
           Accumulate_Checksum (Character'Val ((C / 256) mod 256));
        else
           Accumulate_Checksum (Character'Val (C / 256));
--- 97,104 ----
     procedure Accumulate_Checksum (C : Char_Code) is
     begin
        if C > 16#FFFF# then
!          Accumulate_Checksum (Character'Val (C / 2 ** 24));
!          Accumulate_Checksum (Character'Val ((C / 2 ** 16) mod 256));
           Accumulate_Checksum (Character'Val ((C / 256) mod 256));
        else
           Accumulate_Checksum (Character'Val (C / 256));
*************** package body Scng is
*** 254,259 ****
--- 257,263 ----
        First_Non_Blank_Location  := Scan_Ptr;
  
        Initialize_Checksum;
+       Wide_Char_Byte_Count := 0;
  
        --  Do not call Scan, otherwise the License stuff does not work in Scn
  
*************** package body Scng is
*** 337,347 ****
        -----------------------
  
        procedure Check_End_Of_Line is
!          Len : constant Int := Int (Scan_Ptr) - Int (Current_Line_Start);
  
        begin
!          if Style_Check and Style_Check_Max_Line_Length then
              Style.Check_Line_Terminator (Len);
  
           --  If style checking is inactive, check maximum line length against
           --  standard value. Note that we take this from Opt.Max_Line_Length
--- 341,360 ----
        -----------------------
  
        procedure Check_End_Of_Line is
!          Len : constant Int :=
!                  Int (Scan_Ptr) -
!                  Int (Current_Line_Start) -
!                  Wide_Char_Byte_Count;
  
        begin
!          if Style_Check then
              Style.Check_Line_Terminator (Len);
+          end if;
+ 
+          --  Deal with checking maximum line length
+ 
+          if Style_Check and Style_Check_Max_Line_Length then
+             Style.Check_Line_Max_Length (Len);
  
           --  If style checking is inactive, check maximum line length against
           --  standard value. Note that we take this from Opt.Max_Line_Length
*************** package body Scng is
*** 353,358 ****
--- 366,375 ----
           elsif Len > Opt.Max_Line_Length then
              Error_Long_Line;
           end if;
+ 
+          --  Reset wide character byte count for next line
+ 
+          Wide_Char_Byte_Count := 0;
        end Check_End_Of_Line;
  
        -----------------------
*************** package body Scng is
*** 1102,1109 ****
  
                    Accumulate_Checksum (Code);
  
                    if Ada_Version >= Ada_05
!                     and then Is_UTF_32_Non_Graphic (Code)
                    then
                       Error_Msg
                         ("(Ada 2005) non-graphic character not permitted " &
--- 1119,1130 ----
  
                    Accumulate_Checksum (Code);
  
+                   --  In Ada 95 mode we allow any wide characters in a string
+                   --  but in Ada 2005, the set of characters allowed has been
+                   --  restricted to graphic characters.
+ 
                    if Ada_Version >= Ada_05
!                     and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
                    then
                       Error_Msg
                         ("(Ada 2005) non-graphic character not permitted " &
*************** package body Scng is
*** 1228,1233 ****
--- 1249,1255 ----
           when EOF =>
              if Scan_Ptr = Source_Last (Current_Source_File) then
                 Check_End_Of_Line;
+                if Style_Check then Style.Check_EOF; end if;
                 Token := Tok_EOF;
                 return;
              else
*************** package body Scng is
*** 1443,1448 ****
--- 1465,1481 ----
              else -- Source (Scan_Ptr + 1) = '-' then
                 if Style_Check then Style.Check_Comment; end if;
                 Scan_Ptr := Scan_Ptr + 2;
+ 
+                --  If we are in preprocessor mode with Replace_In_Comments set,
+                --  then we return the "--" as a token on its own.
+ 
+                if Replace_In_Comments then
+                   Token := Tok_Comment;
+                   return;
+                end if;
+ 
+                --  Otherwise scan out the comment
+ 
                 Start_Of_Comment := Scan_Ptr;
  
                 --  Loop to scan comment (this loop runs more than once only if
*************** package body Scng is
*** 1515,1521 ****
  
                          --  If UTF_32 terminator, terminate comment scan
  
!                         elsif Is_UTF_32_Line_Terminator (Code) then
                             Scan_Ptr := Wptr;
                             exit;
                          end if;
--- 1548,1554 ----
  
                          --  If UTF_32 terminator, terminate comment scan
  
!                         elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
                             Scan_Ptr := Wptr;
                             exit;
                          end if;
*************** package body Scng is
*** 1636,1645 ****
  
                    if Err then
                       Error_Illegal_Wide_Character;
!                      Code := Character'Pos (' ');
  
                    elsif Ada_Version >= Ada_05
!                     and then Is_UTF_32_Non_Graphic (Code)
                    then
                       Error_Msg
                         ("(Ada 2005) non-graphic character not permitted " &
--- 1669,1682 ----
  
                    if Err then
                       Error_Illegal_Wide_Character;
!                         Code := Character'Pos (' ');
! 
!                   --  In Ada 95 mode we allow any wide character in a character
!                   --  literal, but in Ada 2005, the set of characters allowed
!                   --  is restricted to graphic characters.
  
                    elsif Ada_Version >= Ada_05
!                     and then Is_UTF_32_Non_Graphic (UTF_32 (Code))
                    then
                       Error_Msg
                         ("(Ada 2005) non-graphic character not permitted " &
*************** package body Scng is
*** 1899,1905 ****
  
           --  Invalid control characters
  
!          when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | SO  |
                SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
                EM  | FS  | GS  | RS  | US  | DEL
           =>
--- 1936,1942 ----
  
           --  Invalid control characters
  
!          when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | ASCII.SO |
                SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
                EM  | FS  | GS  | RS  | US  | DEL
           =>
*************** package body Scng is
*** 1942,1947 ****
--- 1979,1985 ----
  
           declare
              Code : Char_Code;
+             Cat  : Category;
              Err  : Boolean;
  
           begin
*************** package body Scng is
*** 1953,1962 ****
              if Err then
                 Error_Illegal_Wide_Character;
                 goto Scan_Next_Character;
  
              --  If OK letter, reset scan ptr and go scan identifier
  
!             elsif Is_UTF_32_Letter (Code) then
                 Scan_Ptr := Wptr;
                 Name_Len := 0;
                 Underline_Found := False;
--- 1991,2003 ----
              if Err then
                 Error_Illegal_Wide_Character;
                 goto Scan_Next_Character;
+             end if;
+ 
+             Cat := Get_Category (UTF_32 (Code));
  
              --  If OK letter, reset scan ptr and go scan identifier
  
!             if Is_UTF_32_Letter (Cat) then
                 Scan_Ptr := Wptr;
                 Name_Len := 0;
                 Underline_Found := False;
*************** package body Scng is
*** 1965,1982 ****
              --  If OK wide space, ignore and keep scanning (we do not include
              --  any ignored spaces in checksum)
  
!             elsif Is_UTF_32_Space (Code) then
                 goto Scan_Next_Character;
  
              --  If OK wide line terminator, terminate current line
  
!             elsif Is_UTF_32_Line_Terminator (Code) then
                 Scan_Ptr := Wptr;
                 goto Scan_Line_Terminator;
  
              --  Punctuation is an error (at start of identifier)
  
!             elsif Is_UTF_32_Punctuation (Code) then
                 Error_Msg
                   ("identifier cannot start with punctuation", Wptr);
                 Scan_Ptr := Wptr;
--- 2006,2023 ----
              --  If OK wide space, ignore and keep scanning (we do not include
              --  any ignored spaces in checksum)
  
!             elsif Is_UTF_32_Space (Cat) then
                 goto Scan_Next_Character;
  
              --  If OK wide line terminator, terminate current line
  
!             elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
                 Scan_Ptr := Wptr;
                 goto Scan_Line_Terminator;
  
              --  Punctuation is an error (at start of identifier)
  
!             elsif Is_UTF_32_Punctuation (Cat) then
                 Error_Msg
                   ("identifier cannot start with punctuation", Wptr);
                 Scan_Ptr := Wptr;
*************** package body Scng is
*** 1986,1992 ****
  
              --  Mark character is an error (at start of identifer)
  
!             elsif Is_UTF_32_Mark (Code) then
                 Error_Msg
                   ("identifier cannot start with mark character", Wptr);
                 Scan_Ptr := Wptr;
--- 2027,2033 ----
  
              --  Mark character is an error (at start of identifer)
  
!             elsif Is_UTF_32_Mark (Cat) then
                 Error_Msg
                   ("identifier cannot start with mark character", Wptr);
                 Scan_Ptr := Wptr;
*************** package body Scng is
*** 1996,2002 ****
  
              --  Other format character is an error (at start of identifer)
  
!             elsif Is_UTF_32_Other (Code) then
                 Error_Msg
                   ("identifier cannot start with other format character", Wptr);
                 Scan_Ptr := Wptr;
--- 2037,2043 ----
  
              --  Other format character is an error (at start of identifer)
  
!             elsif Is_UTF_32_Other (Cat) then
                 Error_Msg
                   ("identifier cannot start with other format character", Wptr);
                 Scan_Ptr := Wptr;
*************** package body Scng is
*** 2008,2014 ****
              --  identifier or bad literal. Not worth doing too much to try to
              --  distinguish these cases, but we will do a little bit.
  
!             elsif Is_UTF_32_Digit (Code) then
                 Error_Msg
                   ("identifier cannot start with digit character", Wptr);
                 Scan_Ptr := Wptr;
--- 2049,2055 ----
              --  identifier or bad literal. Not worth doing too much to try to
              --  distinguish these cases, but we will do a little bit.
  
!             elsif Is_UTF_32_Digit (Cat) then
                 Error_Msg
                   ("identifier cannot start with digit character", Wptr);
                 Scan_Ptr := Wptr;
*************** package body Scng is
*** 2155,2163 ****
                 --  encoding into the name table entry for the identifier.
  
                 declare
!                   Code   : Char_Code;
!                   Err    : Boolean;
!                   Chr    : Character;
  
                 begin
                    Wptr := Scan_Ptr;
--- 2196,2205 ----
                 --  encoding into the name table entry for the identifier.
  
                 declare
!                   Code : Char_Code;
!                   Err  : Boolean;
!                   Chr  : Character;
!                   Cat  : Category;
  
                 begin
                    Wptr := Scan_Ptr;
*************** package body Scng is
*** 2198,2216 ****
                         ("wide character not allowed in identifier", Wptr);
                       end if;
  
                       --  If OK letter, store it folding to upper case. Note
                       --  that we include the folded letter in the checksum.
  
!                      if Is_UTF_32_Letter (Code) then
!                         Code := UTF_32_To_Upper_Case (Code);
                          Accumulate_Checksum (Code);
                          Store_Encoded_Character (Code);
                          Underline_Found := False;
  
                       --  If OK extended digit or mark, then store it
  
!                      elsif Is_UTF_32_Digit (Code)
!                        or else Is_UTF_32_Mark (Code)
                       then
                          Accumulate_Checksum (Code);
                          Store_Encoded_Character (Code);
--- 2240,2261 ----
                         ("wide character not allowed in identifier", Wptr);
                       end if;
  
+                      Cat := Get_Category (UTF_32 (Code));
+ 
                       --  If OK letter, store it folding to upper case. Note
                       --  that we include the folded letter in the checksum.
  
!                      if Is_UTF_32_Letter (Cat) then
!                         Code :=
!                           Char_Code (UTF_32_To_Upper_Case (UTF_32 (Code)));
                          Accumulate_Checksum (Code);
                          Store_Encoded_Character (Code);
                          Underline_Found := False;
  
                       --  If OK extended digit or mark, then store it
  
!                      elsif Is_UTF_32_Digit (Cat)
!                        or else Is_UTF_32_Mark (Cat)
                       then
                          Accumulate_Checksum (Code);
                          Store_Encoded_Character (Code);
*************** package body Scng is
*** 2219,2225 ****
                       --  Wide punctuation is also stored, but counts as an
                       --  underline character for error checking purposes.
  
!                      elsif Is_UTF_32_Punctuation (Code) then
                          Accumulate_Checksum (Code);
  
                          if Underline_Found then
--- 2264,2270 ----
                       --  Wide punctuation is also stored, but counts as an
                       --  underline character for error checking purposes.
  
!                      elsif Is_UTF_32_Punctuation (Cat) then
                          Accumulate_Checksum (Code);
  
                          if Underline_Found then
*************** package body Scng is
*** 2241,2252 ****
                       --  stored. It seems reasonable to exclude it from the
                       --  checksum.
  
!                      elsif Is_UTF_32_Other (Code) then
                          null;
  
                       --  Wide character in category Separator,Space terminates
  
!                      elsif Is_UTF_32_Space (Code) then
                          goto Scan_Identifier_Complete;
  
                       --  Any other wide character is not acceptable
--- 2286,2301 ----
                       --  stored. It seems reasonable to exclude it from the
                       --  checksum.
  
!                      --  Note that it is correct (see AI-395) to simply strip
!                      --  other format characters, before testing for double
!                      --  underlines, or for reserved words).
! 
!                      elsif Is_UTF_32_Other (Cat) then
                          null;
  
                       --  Wide character in category Separator,Space terminates
  
!                      elsif Is_UTF_32_Space (Cat) then
                          goto Scan_Identifier_Complete;
  
                       --  Any other wide character is not acceptable
*************** package body Scng is
*** 2300,2313 ****
              --  Ada 2005 (AI-284): Do not apply the style check in case of
              --  "pragma Interface"
  
              if Style_Check
                and then Source (Token_Ptr) <= 'Z'
                and then (Prev_Token /= Tok_Apostrophe
                            or else
!                             (Token /= Tok_Access
!                                and then Token /= Tok_Delta
!                                and then Token /= Tok_Digits
!                                and then Token /= Tok_Range))
                and then (Token /= Tok_Interface
                            or else
                              (Token = Tok_Interface
--- 2349,2366 ----
              --  Ada 2005 (AI-284): Do not apply the style check in case of
              --  "pragma Interface"
  
+             --  Ada 2005 (AI-340): Do not apply the style check in case of
+             --  MOD attribute.
+ 
              if Style_Check
                and then Source (Token_Ptr) <= 'Z'
                and then (Prev_Token /= Tok_Apostrophe
                            or else
!                             (Token /= Tok_Access and then
!                              Token /= Tok_Delta  and then
!                              Token /= Tok_Digits and then
!                              Token /= Tok_Mod    and then
!                              Token /= Tok_Range))
                and then (Token /= Tok_Interface
                            or else
                              (Token = Tok_Interface
diff -Nrcpad gcc-4.0.2/gcc/ada/scng.ads gcc-4.1.0/gcc/ada/scng.ads
*** gcc-4.0.2/gcc/ada/scng.ads	Mon Jan  3 15:32:18 2005
--- gcc-4.1.0/gcc/ada/scng.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sdefault.ads gcc-4.1.0/gcc/ada/sdefault.ads
*** gcc-4.0.2/gcc/ada/sdefault.ads	Thu Apr 24 17:54:15 2003
--- gcc-4.1.0/gcc/ada/sdefault.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/seh_init.c gcc-4.1.0/gcc/ada/seh_init.c
*** gcc-4.0.2/gcc/ada/seh_init.c	Thu Feb 10 13:54:45 2005
--- gcc-4.1.0/gcc/ada/seh_init.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 36,42 ****
  #ifdef IN_RTS
  #include "tconfig.h"
  #include "tsystem.h"
- #include <sys/stat.h>
  
  /* We don't have libiberty, so us malloc.  */
  #define xmalloc(S) malloc (S)
--- 36,41 ----
*************** EXCEPTION_DISPOSITION __gnat_SEH_error_h
*** 74,81 ****
  EXCEPTION_DISPOSITION
  __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
  			  void *EstablisherFrame,
! 			  struct _CONTEXT* ContextRecord,
! 			  void *DispatcherContext)
  {
    struct Exception_Data *exception;
    const char *msg;
--- 73,80 ----
  EXCEPTION_DISPOSITION
  __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
  			  void *EstablisherFrame,
! 			  struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
! 			  void *DispatcherContext ATTRIBUTE_UNUSED)
  {
    struct Exception_Data *exception;
    const char *msg;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem.adb gcc-4.1.0/gcc/ada/sem.adb
*** gcc-4.0.2/gcc/ada/sem.adb	Mon Jan  3 15:43:23 2005
--- gcc-4.1.0/gcc/ada/sem.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 27,33 ****
  with Atree;    use Atree;
  with Debug;    use Debug;
  with Debug_A;  use Debug_A;
- with Einfo;    use Einfo;
  with Errout;   use Errout;
  with Expander; use Expander;
  with Fname;    use Fname;
--- 27,32 ----
*************** with HLO;      use HLO;
*** 35,41 ****
  with Lib;      use Lib;
  with Lib.Load; use Lib.Load;
  with Nlists;   use Nlists;
- with Opt;      use Opt;
  with Sem_Attr; use Sem_Attr;
  with Sem_Ch2;  use Sem_Ch2;
  with Sem_Ch3;  use Sem_Ch3;
--- 34,39 ----
*************** package body Sem is
*** 648,654 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Analyze (N);
--- 646,651 ----
*************** package body Sem is
*** 658,664 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Analyze (N);
--- 655,660 ----
*************** package body Sem is
*** 689,695 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Analyze_List (L);
--- 685,690 ----
*************** package body Sem is
*** 699,705 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Analyze_List (L);
--- 694,699 ----
*************** package body Sem is
*** 930,936 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Insert_After_And_Analyze (N, M);
--- 924,929 ----
*************** package body Sem is
*** 940,946 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Insert_After_And_Analyze (N, M);
--- 933,938 ----
*************** package body Sem is
*** 992,998 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Insert_Before_And_Analyze (N, M);
--- 984,989 ----
*************** package body Sem is
*** 1002,1008 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Insert_Before_And_Analyze (N, M);
--- 993,998 ----
*************** package body Sem is
*** 1053,1059 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Insert_List_After_And_Analyze (N, L);
--- 1043,1048 ----
*************** package body Sem is
*** 1063,1069 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Insert_List_After_And_Analyze (N, L);
--- 1052,1057 ----
*************** package body Sem is
*** 1113,1119 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Insert_List_Before_And_Analyze (N, L);
--- 1101,1106 ----
*************** package body Sem is
*** 1123,1129 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Insert_List_Before_And_Analyze (N, L);
--- 1110,1115 ----
*************** package body Sem is
*** 1218,1224 ****
        S_New_Nodes_OK     : constant Int              := New_Nodes_OK;
        S_Outer_Gen_Scope  : constant Entity_Id        := Outer_Generic_Scope;
        S_Sem_Unit         : constant Unit_Number_Type := Current_Sem_Unit;
! 
        Generic_Main       : constant Boolean :=
                               Nkind (Unit (Cunit (Main_Unit)))
                                 in N_Generic_Declaration;
--- 1204,1210 ----
        S_New_Nodes_OK     : constant Int              := New_Nodes_OK;
        S_Outer_Gen_Scope  : constant Entity_Id        := Outer_Generic_Scope;
        S_Sem_Unit         : constant Unit_Number_Type := Current_Sem_Unit;
!       S_GNAT_Mode        : constant Boolean          := GNAT_Mode;
        Generic_Main       : constant Boolean :=
                               Nkind (Unit (Cunit (Main_Unit)))
                                 in N_Generic_Declaration;
*************** package body Sem is
*** 1270,1275 ****
--- 1256,1276 ----
        Compiler_State   := Analyzing;
        Current_Sem_Unit := Get_Cunit_Unit_Number (Comp_Unit);
  
+       --  Compile predefined units with GNAT_Mode set to True, to properly
+       --  process the categorization stuff. However, do not set set GNAT_Mode
+       --  to True for the renamings units (Text_IO, IO_Exceptions, Direct_IO,
+       --  Sequential_IO) as this would prevent pragma System_Extend to be
+       --  taken into account, for example when Text_IO is renaming DEC.Text_IO.
+ 
+       --  Cleaner might be to do the kludge at the point of excluding the
+       --  pragma (do not exclude for renamings ???)
+ 
+       GNAT_Mode :=
+         GNAT_Mode
+           or else Is_Predefined_File_Name
+                     (Unit_File_Name (Current_Sem_Unit),
+                      Renamings_Included => False);
+ 
        if Generic_Main then
           Expander_Mode_Save_And_Set (False);
        else
*************** package body Sem is
*** 1284,1290 ****
        Set_Comes_From_Source_Default (False);
        Save_Opt_Config_Switches (Save_Config_Switches);
        Set_Opt_Config_Switches
!         (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)));
  
        --  Only do analysis of unit that has not already been analyzed
  
--- 1285,1292 ----
        Set_Comes_From_Source_Default (False);
        Save_Opt_Config_Switches (Save_Config_Switches);
        Set_Opt_Config_Switches
!         (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)),
!          Current_Sem_Unit = Main_Unit);
  
        --  Only do analysis of unit that has not already been analyzed
  
*************** package body Sem is
*** 1315,1320 ****
--- 1317,1323 ----
        Inside_A_Generic       := S_Inside_A_Generic;
        New_Nodes_OK           := S_New_Nodes_OK;
        Outer_Generic_Scope    := S_Outer_Gen_Scope;
+       GNAT_Mode              := S_GNAT_Mode;
  
        Restore_Opt_Config_Switches (Save_Config_Switches);
        Expander_Mode_Restore;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem.ads gcc-4.1.0/gcc/ada/sem.ads
*** gcc-4.0.2/gcc/ada/sem.ads	Thu May 27 13:09:21 2004
--- gcc-4.1.0/gcc/ada/sem.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 79,85 ****
  --  terminates, the expression can be expanded since all the semantic
  --  information is available at that point.
  
! --  If we are not generating code then the expansion phase is a no-op.
  
  --  When generating code there are a number of exceptions to the basic
  --  Analysis-Resolution-Expansion model for expressions. The most prominent
--- 79,85 ----
  --  terminates, the expression can be expanded since all the semantic
  --  information is available at that point.
  
! --  If we are not generating code then the expansion phase is a no-op
  
  --  When generating code there are a number of exceptions to the basic
  --  Analysis-Resolution-Expansion model for expressions. The most prominent
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_aggr.adb gcc-4.1.0/gcc/ada/sem_aggr.adb
*** gcc-4.0.2/gcc/ada/sem_aggr.adb	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/sem_aggr.adb	Tue Nov 15 14:01:49 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Aggr is
*** 77,83 ****
     --  statement of variant part will usually be small and probably in near
     --  sorted order.
  
!    procedure Check_Can_Never_Be_Null (N : Node_Id; Expr : Node_Id);
     --  Ada 2005 (AI-231): Check bad usage of the null-exclusion issue
  
     ------------------------------------------------------
--- 77,83 ----
     --  statement of variant part will usually be small and probably in near
     --  sorted order.
  
!    procedure Check_Can_Never_Be_Null (Typ : Node_Id; Expr : Node_Id);
     --  Ada 2005 (AI-231): Check bad usage of the null-exclusion issue
  
     ------------------------------------------------------
*************** package body Sem_Aggr is
*** 468,479 ****
              Check_Unset_Reference (Exp);
           end if;
  
        --  Ada 2005 (AI-231): Generate conversion to the null-excluding
        --  type to force the corresponding run-time check
  
        elsif Is_Access_Type (Check_Typ)
!         and then Can_Never_Be_Null (Check_Typ)
!         and then not Can_Never_Be_Null (Exp_Typ)
        then
           Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
           Analyze_And_Resolve (Exp, Check_Typ);
--- 468,483 ----
              Check_Unset_Reference (Exp);
           end if;
  
+       --  Ada 2005 (AI-230): Generate a conversion to an anonymous access
+       --  component's type to force the appropriate accessibility checks.
+ 
        --  Ada 2005 (AI-231): Generate conversion to the null-excluding
        --  type to force the corresponding run-time check
  
        elsif Is_Access_Type (Check_Typ)
!         and then ((Is_Local_Anonymous_Access (Check_Typ))
!                     or else (Can_Never_Be_Null (Check_Typ)
!                                and then not Can_Never_Be_Null (Exp_Typ)))
        then
           Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
           Analyze_And_Resolve (Exp, Check_Typ);
*************** package body Sem_Aggr is
*** 491,504 ****
        return Entity_Id
     is
        Aggr_Dimension : constant Pos := Number_Dimensions (Typ);
!       --  Number of aggregate index dimensions.
  
        Aggr_Range : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
!       --  Constrained N_Range of each index dimension in our aggregate itype.
  
        Aggr_Low   : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
        Aggr_High  : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
!       --  Low and High bounds for each index dimension in our aggregate itype.
  
        Is_Fully_Positional : Boolean := True;
  
--- 495,508 ----
        return Entity_Id
     is
        Aggr_Dimension : constant Pos := Number_Dimensions (Typ);
!       --  Number of aggregate index dimensions
  
        Aggr_Range : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
!       --  Constrained N_Range of each index dimension in our aggregate itype
  
        Aggr_Low   : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
        Aggr_High  : array (1 .. Aggr_Dimension) of Node_Id := (others => Empty);
!       --  Low and High bounds for each index dimension in our aggregate itype
  
        Is_Fully_Positional : Boolean := True;
  
*************** package body Sem_Aggr is
*** 507,512 ****
--- 511,517 ----
        --  (sub-)aggregate N. This procedure collects the constrained N_Range
        --  nodes corresponding to each index dimension of our aggregate itype.
        --  These N_Range nodes are collected in Aggr_Range above.
+       --
        --  Likewise collect in Aggr_Low & Aggr_High above the low and high
        --  bounds of each index dimension. If, when collecting, two bounds
        --  corresponding to the same dimension are static and found to differ,
*************** package body Sem_Aggr is
*** 518,528 ****
  
        procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos) is
           This_Range : constant Node_Id := Aggregate_Bounds (N);
!          --  The aggregate range node of this specific sub-aggregate.
  
           This_Low  : constant Node_Id := Low_Bound (Aggregate_Bounds (N));
           This_High : constant Node_Id := High_Bound (Aggregate_Bounds (N));
!          --  The aggregate bounds of this specific sub-aggregate.
  
           Assoc : Node_Id;
           Expr  : Node_Id;
--- 523,533 ----
  
        procedure Collect_Aggr_Bounds (N : Node_Id; Dim : Pos) is
           This_Range : constant Node_Id := Aggregate_Bounds (N);
!          --  The aggregate range node of this specific sub-aggregate
  
           This_Low  : constant Node_Id := Low_Bound (Aggregate_Bounds (N));
           This_High : constant Node_Id := High_Bound (Aggregate_Bounds (N));
!          --  The aggregate bounds of this specific sub-aggregate
  
           Assoc : Node_Id;
           Expr  : Node_Id;
*************** package body Sem_Aggr is
*** 543,549 ****
  
                 elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then
                    Set_Raises_Constraint_Error (N);
!                   Error_Msg_N ("Sub-aggregate low bound mismatch?", N);
                    Error_Msg_N ("Constraint_Error will be raised at run-time?",
                                 N);
                 end if;
--- 548,554 ----
  
                 elsif Expr_Value (This_Low) /= Expr_Value (Aggr_Low (Dim)) then
                    Set_Raises_Constraint_Error (N);
!                   Error_Msg_N ("sub-aggregate low bound mismatch?", N);
                    Error_Msg_N ("Constraint_Error will be raised at run-time?",
                                 N);
                 end if;
*************** package body Sem_Aggr is
*** 557,563 ****
                   Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim))
                 then
                    Set_Raises_Constraint_Error (N);
!                   Error_Msg_N ("Sub-aggregate high bound mismatch?", N);
                    Error_Msg_N ("Constraint_Error will be raised at run-time?",
                                 N);
                 end if;
--- 562,568 ----
                   Expr_Value (This_High) /= Expr_Value (Aggr_High (Dim))
                 then
                    Set_Raises_Constraint_Error (N);
!                   Error_Msg_N ("sub-aggregate high bound mismatch?", N);
                    Error_Msg_N ("Constraint_Error will be raised at run-time?",
                                 N);
                 end if;
*************** package body Sem_Aggr is
*** 597,603 ****
        --  the final itype of the overall aggregate
  
        Index_Constraints : constant List_Id := New_List;
!       --  The list of index constraints of the aggregate itype.
  
     --  Start of processing for Array_Aggr_Subtype
  
--- 602,608 ----
        --  the final itype of the overall aggregate
  
        Index_Constraints : constant List_Id := New_List;
!       --  The list of index constraints of the aggregate itype
  
     --  Start of processing for Array_Aggr_Subtype
  
*************** package body Sem_Aggr is
*** 608,614 ****
        Set_Parent (Index_Constraints, N);
        Collect_Aggr_Bounds (N, 1);
  
!       --  Build the list of constrained indices of our aggregate itype.
  
        for J in 1 .. Aggr_Dimension loop
           Create_Index : declare
--- 613,619 ----
        Set_Parent (Index_Constraints, N);
        Collect_Aggr_Bounds (N, 1);
  
!       --  Build the list of constrained indices of our aggregate itype
  
        for J in 1 .. Aggr_Dimension loop
           Create_Index : declare
*************** package body Sem_Aggr is
*** 812,818 ****
           Next_Component (Comp);
        end loop;
  
!       --  On exit, all components have statically known sizes.
  
        Set_Size_Known_At_Compile_Time (T);
     end Check_Static_Discriminated_Subtype;
--- 817,823 ----
           Next_Component (Comp);
        end loop;
  
!       --  On exit, all components have statically known sizes
  
        Set_Size_Known_At_Compile_Time (T);
     end Check_Static_Discriminated_Subtype;
*************** package body Sem_Aggr is
*** 974,980 ****
              --  in which the array aggregate occurs. If the context does not
              --  permit it, or the aggregate type is unconstrained, an others
              --  choice is not allowed.
!             --
              --  Note that there is no node for Explicit_Actual_Parameter.
              --  To test for this context we therefore have to test for node
              --  N_Parameter_Association which itself appears only if there is a
--- 979,992 ----
              --  in which the array aggregate occurs. If the context does not
              --  permit it, or the aggregate type is unconstrained, an others
              --  choice is not allowed.
! 
!             --  If expansion is disabled (generic context, or semantics-only
!             --  mode) actual subtypes cannot be constructed, and the type of
!             --  an object may be its unconstrained nominal type. However, if
!             --  the context is an assignment, we assume that "others" is
!             --  allowed, because the target of the assignment will have a
!             --  constrained subtype when fully compiled.
! 
              --  Note that there is no node for Explicit_Actual_Parameter.
              --  To test for this context we therefore have to test for node
              --  N_Parameter_Association which itself appears only if there is a
*************** package body Sem_Aggr is
*** 983,995 ****
  
              Set_Etype (N, Aggr_Typ);  --  may be overridden later on
  
-             --  Ada 2005 (AI-231): Propagate the null_exclusion attribute to
-             --  the components of the array aggregate
- 
-             if Ada_Version >= Ada_05 then
-                Set_Can_Never_Be_Null (Aggr_Typ, Can_Never_Be_Null (Typ));
-             end if;
- 
              if Is_Constrained (Typ) and then
                (Pkind = N_Assignment_Statement      or else
                 Pkind = N_Parameter_Association     or else
--- 995,1000 ----
*************** package body Sem_Aggr is
*** 1014,1019 ****
--- 1019,1034 ----
                      Component_Typ  => Component_Type (Typ),
                      Others_Allowed => True);
  
+             elsif not Expander_Active
+               and then Pkind = N_Assignment_Statement
+             then
+                Aggr_Resolved :=
+                  Resolve_Array_Aggregate
+                    (N,
+                     Index          => First_Index (Aggr_Typ),
+                     Index_Constr   => First_Index (Typ),
+                     Component_Typ  => Component_Type (Typ),
+                     Others_Allowed => True);
              else
                 Aggr_Resolved :=
                   Resolve_Array_Aggregate
*************** package body Sem_Aggr is
*** 1033,1041 ****
              Set_Etype (N, Aggr_Subtyp);
           end Array_Aggregate;
  
        else
           Error_Msg_N ("illegal context for aggregate", N);
- 
        end if;
  
        --  If we can determine statically that the evaluation of the
--- 1048,1062 ----
              Set_Etype (N, Aggr_Subtyp);
           end Array_Aggregate;
  
+       elsif Is_Private_Type (Typ)
+         and then Present (Full_View (Typ))
+         and then In_Inlined_Body
+         and then Is_Composite_Type (Full_View (Typ))
+       then
+          Resolve (N, Full_View (Typ));
+ 
        else
           Error_Msg_N ("illegal context for aggregate", N);
        end if;
  
        --  If we can determine statically that the evaluation of the
*************** package body Sem_Aggr is
*** 1102,1108 ****
        --  warning if not and sets the Raises_Constraint_Error Flag in N.
  
        function Dynamic_Or_Null_Range (L, H : Node_Id) return Boolean;
!       --  Returns True if range L .. H is dynamic or null.
  
        procedure Get (Value : out Uint; From : Node_Id; OK : out Boolean);
        --  Given expression node From, this routine sets OK to False if it
--- 1123,1129 ----
        --  warning if not and sets the Raises_Constraint_Error Flag in N.
  
        function Dynamic_Or_Null_Range (L, H : Node_Id) return Boolean;
!       --  Returns True if range L .. H is dynamic or null
  
        procedure Get (Value : out Uint; From : Node_Id; OK : out Boolean);
        --  Given expression node From, this routine sets OK to False if it
*************** package body Sem_Aggr is
*** 1301,1307 ****
  
           if Range_Len < Len then
              Set_Raises_Constraint_Error (N);
!             Error_Msg_N ("Too many elements?", N);
              Error_Msg_N ("Constraint_Error will be raised at run-time?", N);
           end if;
        end Check_Length;
--- 1322,1328 ----
  
           if Range_Len < Len then
              Set_Raises_Constraint_Error (N);
!             Error_Msg_N ("too many elements?", N);
              Error_Msg_N ("Constraint_Error will be raised at run-time?", N);
           end if;
        end Check_Length;
*************** package body Sem_Aggr is
*** 1364,1373 ****
        is
           Nxt_Ind        : constant Node_Id := Next_Index (Index);
           Nxt_Ind_Constr : constant Node_Id := Next_Index (Index_Constr);
!          --  Index is the current index corresponding to the expresion.
  
           Resolution_OK : Boolean := True;
!          --  Set to False if resolution of the expression failed.
  
        begin
           --  If the array type against which we are resolving the aggregate
--- 1385,1394 ----
        is
           Nxt_Ind        : constant Node_Id := Next_Index (Index);
           Nxt_Ind_Constr : constant Node_Id := Next_Index (Index_Constr);
!          --  Index is the current index corresponding to the expresion
  
           Resolution_OK : Boolean := True;
!          --  Set to False if resolution of the expression failed
  
        begin
           --  If the array type against which we are resolving the aggregate
*************** package body Sem_Aggr is
*** 1392,1398 ****
                    --  aggregate must not be enclosed in parentheses.
  
                    if Paren_Count (Expr) /= 0 then
!                      Error_Msg_N ("No parenthesis allowed here", Expr);
                    end if;
  
                    Make_String_Into_Aggregate (Expr);
--- 1413,1419 ----
                    --  aggregate must not be enclosed in parentheses.
  
                    if Paren_Count (Expr) /= 0 then
!                      Error_Msg_N ("no parenthesis allowed here", Expr);
                    end if;
  
                    Make_String_Into_Aggregate (Expr);
*************** package body Sem_Aggr is
*** 1580,1586 ****
              --  in the current association.
  
           begin
!             --  STEP 2 (A): Check discrete choices validity.
  
              Assoc := First (Component_Associations (N));
              while Present (Assoc) loop
--- 1601,1607 ----
              --  in the current association.
  
           begin
!             --  STEP 2 (A): Check discrete choices validity
  
              Assoc := First (Component_Associations (N));
              while Present (Assoc) loop
*************** package body Sem_Aggr is
*** 1633,1639 ****
                    if Etype (Choice) = Any_Type then
                       return Failure;
  
!                   --  If the discrete choice raises CE get its original bounds.
  
                    elsif Nkind (Choice) = N_Raise_Constraint_Error then
                       Set_Raises_Constraint_Error (N);
--- 1654,1660 ----
                    if Etype (Choice) = Any_Type then
                       return Failure;
  
!                   --  If the discrete choice raises CE get its original bounds
  
                    elsif Nkind (Choice) = N_Raise_Constraint_Error then
                       Set_Raises_Constraint_Error (N);
*************** package body Sem_Aggr is
*** 1677,1683 ****
  
                 --  Ada 2005 (AI-231)
  
!                if Ada_Version >= Ada_05 then
                    Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
                 end if;
  
--- 1698,1706 ----
  
                 --  Ada 2005 (AI-231)
  
!                if Ada_Version >= Ada_05
!                  and then Nkind (Expression (Assoc)) = N_Null
!                then
                    Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
                 end if;
  
*************** package body Sem_Aggr is
*** 1807,1813 ****
  
              --  Ada 2005 (AI-231)
  
!             if Ada_Version >= Ada_05 then
                 Check_Can_Never_Be_Null (Etype (N), Expr);
              end if;
  
--- 1830,1838 ----
  
              --  Ada 2005 (AI-231)
  
!             if Ada_Version >= Ada_05
!               and then Nkind (Expr) = N_Null
!             then
                 Check_Can_Never_Be_Null (Etype (N), Expr);
              end if;
  
*************** package body Sem_Aggr is
*** 1823,1829 ****
  
              --  Ada 2005 (AI-231)
  
!             if Ada_Version >= Ada_05 then
                 Check_Can_Never_Be_Null
                   (Etype (N), Expression (Assoc));
              end if;
--- 1848,1856 ----
  
              --  Ada 2005 (AI-231)
  
!             if Ada_Version >= Ada_05
!               and then Nkind (Expression (Assoc)) = N_Null
!             then
                 Check_Can_Never_Be_Null
                   (Etype (N), Expression (Assoc));
              end if;
*************** package body Sem_Aggr is
*** 1885,1891 ****
           Check_Length (Aggr_Low, Aggr_High, Nb_Elements);
           Check_Length (Index_Typ_Low, Index_Typ_High, Nb_Elements);
           Check_Length (Index_Base_Low, Index_Base_High, Nb_Elements);
- 
        end if;
  
        if Raises_Constraint_Error (Aggr_Low)
--- 1912,1917 ----
*************** package body Sem_Aggr is
*** 2227,2244 ****
              return True;
           end if;
  
!          --  Now look to see if Discr was specified in the ancestor part.
! 
!          Orig_Discr := Original_Record_Component (Discr);
!          D          := First_Discriminant (Ancestor_Typ);
  
           if Ancestor_Is_Subtyp then
              D_Val := First_Elmt (Discriminant_Constraint (Entity (Ancestor)));
           end if;
  
           while Present (D) loop
!             --  If Ancestor has already specified Disc value than
!             --  insert its value in the final aggregate.
  
              if Original_Record_Component (D) = Orig_Discr then
                 if Ancestor_Is_Subtyp then
--- 2253,2271 ----
              return True;
           end if;
  
!          --  Now look to see if Discr was specified in the ancestor part
  
           if Ancestor_Is_Subtyp then
              D_Val := First_Elmt (Discriminant_Constraint (Entity (Ancestor)));
           end if;
  
+          Orig_Discr := Original_Record_Component (Discr);
+ 
+          D := First_Discriminant (Ancestor_Typ);
           while Present (D) loop
! 
!             --  If Ancestor has already specified Disc value than insert its
!             --  value in the final aggregate.
  
              if Original_Record_Component (D) = Orig_Discr then
                 if Ancestor_Is_Subtyp then
*************** package body Sem_Aggr is
*** 2307,2313 ****
                      ("initialization not allowed for limited types", N);
                    Explain_Limited_Type (Etype (Compon), Compon);
                 end if;
- 
              end if;
           end Check_Non_Limited_Type;
  
--- 2334,2339 ----
*************** package body Sem_Aggr is
*** 2502,2517 ****
  
              --  For each range in an array type where a discriminant has been
              --  replaced with the constraint, check that this range is within
!             --  the range of the base type. This checks is done in the
!             --  init proc for regular objects, but has to be done here for
              --  aggregates since no init proc is called for them.
  
              if Is_Array_Type (Expr_Type) then
                 declare
!                   Index          : Node_Id := First_Index (Expr_Type);
!                   --  Range of the current constrained index in the array.
  
!                   Orig_Index     : Node_Id := First_Index (Etype (Component));
                    --  Range corresponding to the range Index above in the
                    --  original unconstrained record type. The bounds of this
                    --  range may be governed by discriminants.
--- 2528,2543 ----
  
              --  For each range in an array type where a discriminant has been
              --  replaced with the constraint, check that this range is within
!             --  the range of the base type. This checks is done in the init
!             --  proc for regular objects, but has to be done here for
              --  aggregates since no init proc is called for them.
  
              if Is_Array_Type (Expr_Type) then
                 declare
!                   Index : Node_Id := First_Index (Expr_Type);
!                   --  Range of the current constrained index in the array
  
!                   Orig_Index : Node_Id := First_Index (Etype (Component));
                    --  Range corresponding to the range Index above in the
                    --  original unconstrained record type. The bounds of this
                    --  range may be governed by discriminants.
*************** package body Sem_Aggr is
*** 2693,2699 ****
  
                 --  Ada 2005 (AI-231)
  
!                if Ada_Version >= Ada_05 then
                    Check_Can_Never_Be_Null (Discrim, Positional_Expr);
                 end if;
  
--- 2719,2727 ----
  
                 --  Ada 2005 (AI-231)
  
!                if Ada_Version >= Ada_05
!                  and then Nkind (Positional_Expr) = N_Null
!                then
                    Check_Can_Never_Be_Null (Discrim, Positional_Expr);
                 end if;
  
*************** package body Sem_Aggr is
*** 2786,2792 ****
                  Subtype_Indication  => Indic);
              Set_Parent (Subtyp_Decl, Parent (N));
  
!             --  Itypes must be analyzed with checks off (see itypes.ads).
  
              Analyze (Subtyp_Decl, Suppress => All_Checks);
  
--- 2814,2820 ----
                  Subtype_Indication  => Indic);
              Set_Parent (Subtyp_Decl, Parent (N));
  
!             --  Itypes must be analyzed with checks off (see itypes.ads)
  
              Analyze (Subtyp_Decl, Suppress => All_Checks);
  
*************** package body Sem_Aggr is
*** 2880,2886 ****
                 end if;
              end loop;
  
!             --  Now collect components from all other ancestors.
  
              Parent_Elmt := First_Elmt (Parent_Typ_List);
              while Present (Parent_Elmt) loop
--- 2908,2914 ----
                 end if;
              end loop;
  
!             --  Now collect components from all other ancestors
  
              Parent_Elmt := First_Elmt (Parent_Typ_List);
              while Present (Parent_Elmt) loop
*************** package body Sem_Aggr is
*** 2930,2936 ****
  
           --  Ada 2005 (AI-231)
  
!          if Ada_Version >= Ada_05 then
              Check_Can_Never_Be_Null (Component, Positional_Expr);
           end if;
  
--- 2958,2966 ----
  
           --  Ada 2005 (AI-231)
  
!          if Ada_Version >= Ada_05
!            and then Nkind (Positional_Expr) = N_Null
!          then
              Check_Can_Never_Be_Null (Component, Positional_Expr);
           end if;
  
*************** package body Sem_Aggr is
*** 3083,3101 ****
     -- Check_Can_Never_Be_Null --
     -----------------------------
  
!    procedure Check_Can_Never_Be_Null (N : Node_Id; Expr : Node_Id) is
     begin
!       pragma Assert (Ada_Version >= Ada_05);
  
!       if Nkind (Expr) = N_Null
!         and then Can_Never_Be_Null (N)
        then
!          Apply_Compile_Time_Constraint_Error
!            (N      => Expr,
!             Msg    => "(Ada 2005) NULL not allowed in"
!                        & " null-excluding components?",
!             Reason => CE_Null_Not_Allowed,
!             Rep    => False);
        end if;
     end Check_Can_Never_Be_Null;
  
--- 3113,3150 ----
     -- Check_Can_Never_Be_Null --
     -----------------------------
  
!    procedure Check_Can_Never_Be_Null (Typ : Node_Id; Expr : Node_Id) is
!       Comp_Typ : Entity_Id;
! 
     begin
!       pragma Assert (Ada_Version >= Ada_05
!         and then Present (Expr)
!         and then Nkind (Expr) = N_Null);
  
!       case Ekind (Typ) is
!          when E_Array_Type  =>
!             Comp_Typ := Component_Type (Typ);
! 
!          when E_Component    |
!               E_Discriminant =>
!             Comp_Typ := Etype (Typ);
! 
!          when others =>
!             return;
!       end case;
! 
!       if Present (Expr)
!         and then Can_Never_Be_Null (Comp_Typ)
        then
!          Error_Msg_N
!            ("(Ada 2005) NULL not allowed in null-excluding components?", Expr);
!          Error_Msg_NEL
!            ("\& will be raised at run time!?",
!             Expr, Standard_Constraint_Error, Sloc (Expr));
! 
!          Set_Etype                    (Expr, Comp_Typ);
!          Set_Analyzed                 (Expr);
!          Install_Null_Excluding_Check (Expr);
        end if;
     end Check_Can_Never_Be_Null;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_aggr.ads gcc-4.1.0/gcc/ada/sem_aggr.ads
*** gcc-4.0.2/gcc/ada/sem_aggr.ads	Thu Apr 24 17:54:16 2003
--- gcc-4.1.0/gcc/ada/sem_aggr.ads	Tue Nov 15 17:21:54 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_attr.adb gcc-4.1.0/gcc/ada/sem_attr.adb
*** gcc-4.0.2/gcc/ada/sem_attr.adb	Thu Feb 10 13:50:23 2005
--- gcc-4.1.0/gcc/ada/sem_attr.adb	Tue Nov 15 13:56:51 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Checks;   use Checks;
*** 31,37 ****
  with Einfo;    use Einfo;
  with Errout;   use Errout;
  with Eval_Fat;
- with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
  with Expander; use Expander;
  with Freeze;   use Freeze;
--- 31,36 ----
*************** with Sem_Util; use Sem_Util;
*** 57,63 ****
  with Stand;    use Stand;
  with Sinfo;    use Sinfo;
  with Sinput;   use Sinput;
- with Snames;   use Snames;
  with Stand;
  with Stringt;  use Stringt;
  with Targparm; use Targparm;
--- 56,61 ----
*************** with Ttypef;   use Ttypef;
*** 66,72 ****
  with Tbuild;   use Tbuild;
  with Uintp;    use Uintp;
  with Urealp;   use Urealp;
- with Widechar; use Widechar;
  
  package body Sem_Attr is
  
--- 64,69 ----
*************** package body Sem_Attr is
*** 381,388 ****
              It    : Interp;
  
              function Get_Kind (E : Entity_Id) return Entity_Kind;
!             --  Distinguish between access to regular and protected
!             --  subprograms.
  
              --------------
              -- Get_Kind --
--- 378,384 ----
              It    : Interp;
  
              function Get_Kind (E : Entity_Id) return Entity_Kind;
!             --  Distinguish between access to regular/protected subprograms
  
              --------------
              -- Get_Kind --
*************** package body Sem_Attr is
*** 404,421 ****
              --  subprogram itself as the designated type. Type-checking in
              --  this case compares the signatures of the designated types.
  
              if not Is_Overloaded (P) then
!                Acc_Type :=
!                  New_Internal_Entity
!                    (Get_Kind (Entity (P)), Current_Scope, Loc, 'A');
!                Set_Etype (Acc_Type, Acc_Type);
!                Set_Directly_Designated_Type (Acc_Type, Entity (P));
!                Set_Etype (N, Acc_Type);
  
              else
                 Get_First_Interp (P, Index, It);
-                Set_Etype (N, Any_Type);
- 
                 while Present (It.Nam) loop
                    if not Is_Intrinsic_Subprogram (It.Nam) then
                       Acc_Type :=
--- 400,419 ----
              --  subprogram itself as the designated type. Type-checking in
              --  this case compares the signatures of the designated types.
  
+             Set_Etype (N, Any_Type);
+ 
              if not Is_Overloaded (P) then
!                if not Is_Intrinsic_Subprogram (Entity (P)) then
!                   Acc_Type :=
!                     New_Internal_Entity
!                       (Get_Kind (Entity (P)), Current_Scope, Loc, 'A');
!                   Set_Etype (Acc_Type, Acc_Type);
!                   Set_Directly_Designated_Type (Acc_Type, Entity (P));
!                   Set_Etype (N, Acc_Type);
!                end if;
  
              else
                 Get_First_Interp (P, Index, It);
                 while Present (It.Nam) loop
                    if not Is_Intrinsic_Subprogram (It.Nam) then
                       Acc_Type :=
*************** package body Sem_Attr is
*** 428,437 ****
  
                    Get_Next_Interp (Index, It);
                 end loop;
  
!                if Etype (N) = Any_Type then
!                   Error_Attr ("prefix of % attribute cannot be intrinsic", P);
!                end if;
              end if;
           end Build_Access_Subprogram_Type;
  
--- 426,435 ----
  
                    Get_Next_Interp (Index, It);
                 end loop;
+             end if;
  
!             if Etype (N) = Any_Type then
!                Error_Attr ("prefix of % attribute cannot be intrinsic", P);
              end if;
           end Build_Access_Subprogram_Type;
  
*************** package body Sem_Attr is
*** 457,462 ****
--- 455,466 ----
                 Check_Restriction (No_Implicit_Dynamic_Code, P);
              end if;
  
+             if Is_Always_Inlined (Entity (P)) then
+                Error_Attr
+                  ("prefix of % attribute cannot be Inline_Always subprogram",
+                   P);
+             end if;
+ 
              --  Build the appropriate subprogram type
  
              Build_Access_Subprogram_Type (P);
*************** package body Sem_Attr is
*** 488,496 ****
           --  accesses are allowed (references to the current type instance).
  
           if Is_Entity_Name (P) then
-             Scop := Current_Scope;
              Typ := Entity (P);
  
              if Is_Type (Typ) then
  
                 --  OK if we are within the scope of a limited type
--- 492,507 ----
           --  accesses are allowed (references to the current type instance).
  
           if Is_Entity_Name (P) then
              Typ := Entity (P);
  
+             --  The reference may appear in an aggregate that has been expanded
+             --  into a loop. Locate scope of type definition, if any.
+ 
+             Scop := Current_Scope;
+             while Ekind (Scop) = E_Loop loop
+                Scop := Scope (Scop);
+             end loop;
+ 
              if Is_Type (Typ) then
  
                 --  OK if we are within the scope of a limited type
*************** package body Sem_Attr is
*** 512,517 ****
--- 523,529 ----
                       loop
                          Q := Parent (Q);
                       end loop;
+ 
                       if Present (Q) then
                          Set_Has_Per_Object_Constraint (
                            Defining_Identifier (Q), True);
*************** package body Sem_Attr is
*** 581,591 ****
              declare
                 Index : Interp_Index;
                 It    : Interp;
- 
              begin
                 Set_Etype (N, Any_Type);
                 Get_First_Interp (P, Index, It);
- 
                 while Present (It.Typ) loop
                    Acc_Type := Build_Access_Object_Type (It.Typ);
                    Add_One_Interp (N, Acc_Type, Acc_Type);
--- 593,601 ----
*************** package body Sem_Attr is
*** 630,636 ****
           Index : Entity_Id;
  
           D : Int;
!          --  Dimension number for array attributes.
  
        begin
           --  Case of string literal or string literal subtype. These cases
--- 640,646 ----
           Index : Entity_Id;
  
           D : Int;
!          --  Dimension number for array attributes
  
        begin
           --  Case of string literal or string literal subtype. These cases
*************** package body Sem_Attr is
*** 703,709 ****
  
        procedure Check_Array_Type is
           D : Int;
!          --  Dimension number for array attributes.
  
        begin
           --  If the type is a string literal type, then this must be generated
--- 713,719 ----
  
        procedure Check_Array_Type is
           D : Int;
!          --  Dimension number for array attributes
  
        begin
           --  If the type is a string literal type, then this must be generated
*************** package body Sem_Attr is
*** 1096,1108 ****
        -------------------------------
  
        procedure Check_Not_Incomplete_Type is
        begin
           if not Is_Entity_Name (P)
             or else not Is_Type (Entity (P))
             or else In_Default_Expression
           then
              return;
- 
           else
              Check_Fully_Declared (P_Type, P);
           end if;
--- 1106,1169 ----
        -------------------------------
  
        procedure Check_Not_Incomplete_Type is
+          E   : Entity_Id;
+          Typ : Entity_Id;
+ 
        begin
+          --  Ada 2005 (AI-50217, AI-326): If the prefix is an explicit
+          --  dereference we have to check wrong uses of incomplete types
+          --  (other wrong uses are checked at their freezing point).
+ 
+          --  Example 1: Limited-with
+ 
+          --    limited with Pkg;
+          --    package P is
+          --       type Acc is access Pkg.T;
+          --       X : Acc;
+          --       S : Integer := X.all'Size;                    -- ERROR
+          --    end P;
+ 
+          --  Example 2: Tagged incomplete
+ 
+          --     type T is tagged;
+          --     type Acc is access all T;
+          --     X : Acc;
+          --     S : constant Integer := X.all'Size;             -- ERROR
+          --     procedure Q (Obj : Integer := X.all'Alignment); -- ERROR
+ 
+          if Ada_Version >= Ada_05
+            and then Nkind (P) = N_Explicit_Dereference
+          then
+             E := P;
+             while Nkind (E) = N_Explicit_Dereference loop
+                E := Prefix (E);
+             end loop;
+ 
+             if From_With_Type (Etype (E)) then
+                Error_Attr
+                  ("prefix of % attribute cannot be an incomplete type", P);
+ 
+             else
+                if Is_Access_Type (Etype (E)) then
+                   Typ := Directly_Designated_Type (Etype (E));
+                else
+                   Typ := Etype (E);
+                end if;
+ 
+                if Ekind (Typ) = E_Incomplete_Type
+                  and then not Present (Full_View (Typ))
+                then
+                   Error_Attr
+                     ("prefix of % attribute cannot be an incomplete type", P);
+                end if;
+             end if;
+          end if;
+ 
           if not Is_Entity_Name (P)
             or else not Is_Type (Entity (P))
             or else In_Default_Expression
           then
              return;
           else
              Check_Fully_Declared (P_Type, P);
           end if;
*************** package body Sem_Attr is
*** 1217,1223 ****
        procedure Check_Stream_Attribute (Nam : TSS_Name_Type) is
           Etyp : Entity_Id;
           Btyp : Entity_Id;
- 
        begin
           Validate_Non_Static_Attribute_Function_Call;
  
--- 1278,1283 ----
*************** package body Sem_Attr is
*** 1244,1260 ****
           Btyp := Implementation_Base_Type (P_Type);
  
           --  Stream attributes not allowed on limited types unless the
!          --  special OK_For_Stream flag is set.
  
!          if Is_Limited_Type (P_Type)
!            and then Comes_From_Source (N)
!            and then not Present (TSS (Btyp, Nam))
             and then not Has_Rep_Pragma (Btyp, Name_Stream_Convert)
           then
              Error_Msg_Name_1 := Aname;
!             Error_Msg_NE
!               ("limited type& has no% attribute", P, Btyp);
!             Explain_Limited_Type (P_Type, P);
           end if;
  
           --  Check for violation of restriction No_Stream_Attributes
--- 1304,1330 ----
           Btyp := Implementation_Base_Type (P_Type);
  
           --  Stream attributes not allowed on limited types unless the
!          --  attribute reference was generated by the expander (in which
!          --  case the underlying type will be used, as described in Sinfo),
!          --  or the attribute was specified explicitly for the type itself
!          --  or one of its ancestors (taking visibility rules into account if
!          --  in Ada 2005 mode), or a pragma Stream_Convert applies to Btyp
!          --  (with no visibility restriction).
  
!          if Comes_From_Source (N)
!            and then not Stream_Attribute_Available (P_Type, Nam)
             and then not Has_Rep_Pragma (Btyp, Name_Stream_Convert)
           then
              Error_Msg_Name_1 := Aname;
! 
!             if Is_Limited_Type (P_Type) then
!                Error_Msg_NE
!                  ("limited type& has no% attribute", P, P_Type);
!                Explain_Limited_Type (P_Type, P);
!             else
!                Error_Msg_NE
!                  ("attribute% for type& is not available", P, P_Type);
!             end if;
           end if;
  
           --  Check for violation of restriction No_Stream_Attributes
*************** package body Sem_Attr is
*** 1309,1321 ****
        begin
           Analyze (P);
  
           if Is_Task_Type (Etype (P))
             or else (Is_Access_Type (Etype (P))
!               and then Is_Task_Type (Designated_Type (Etype (P))))
           then
              Resolve (P);
           else
!             Error_Attr ("prefix of % attribute must be a task", P);
           end if;
        end Check_Task_Prefix;
  
--- 1379,1405 ----
        begin
           Analyze (P);
  
+          --  Ada 2005 (AI-345): Attribute 'Terminated can be applied to
+          --  task interface class-wide types.
+ 
           if Is_Task_Type (Etype (P))
             or else (Is_Access_Type (Etype (P))
!                       and then Is_Task_Type (Designated_Type (Etype (P))))
!            or else (Ada_Version >= Ada_05
!                       and then Ekind (Etype (P)) = E_Class_Wide_Type
!                       and then Is_Interface (Etype (P))
!                       and then Is_Task_Interface (Etype (P)))
           then
              Resolve (P);
+ 
           else
!             if Ada_Version >= Ada_05 then
!                Error_Attr ("prefix of % attribute must be a task or a task "
!                            & "interface class-wide object", P);
! 
!             else
!                Error_Attr ("prefix of % attribute must be a task", P);
!             end if;
           end if;
        end Check_Task_Prefix;
  
*************** package body Sem_Attr is
*** 1460,1469 ****
                 --  There is no clean way to check this. That's not surprising,
                 --  the front end should not be doing this kind of test ???. The
                 --  way we do it is test for either "86" or "pentium" being in
!                --  the string for the target name.
  
                 for J in T'First .. T'Last - 1 loop
!                   if T (J .. J + 1) = "86"
                      or else (J <= T'Last - 6
                                 and then T (J .. J + 6) = "pentium")
                    then
--- 1544,1557 ----
                 --  There is no clean way to check this. That's not surprising,
                 --  the front end should not be doing this kind of test ???. The
                 --  way we do it is test for either "86" or "pentium" being in
!                --  the string for the target name. However, we need to exclude
!                --  x86_64 for this check.
  
                 for J in T'First .. T'Last - 1 loop
!                   if (T (J .. J + 1) = "86"
!                       and then
!                         (J + 4 > T'Last
!                            or else T (J + 2 .. J + 4) /= "_64"))
                      or else (J <= T'Last - 6
                                 and then T (J .. J + 6) = "pentium")
                    then
*************** package body Sem_Attr is
*** 1622,1628 ****
           end if;
        end if;
  
!       if Is_Overloaded (P)
          and then Aname /= Name_Access
          and then Aname /= Name_Address
          and then Aname /= Name_Code_Address
--- 1710,1720 ----
           end if;
        end if;
  
!       --  Ada 2005 (AI-345): Ensure that the compiler gives exactly the current
!       --  output compiling in Ada 95 mode
! 
!       if Ada_Version < Ada_05
!         and then Is_Overloaded (P)
          and then Aname /= Name_Access
          and then Aname /= Name_Address
          and then Aname /= Name_Code_Address
*************** package body Sem_Attr is
*** 1630,1635 ****
--- 1722,1772 ----
          and then Aname /= Name_Unchecked_Access
        then
           Error_Attr ("ambiguous prefix for % attribute", P);
+ 
+       elsif Ada_Version >= Ada_05
+         and then Is_Overloaded (P)
+         and then Aname /= Name_Access
+         and then Aname /= Name_Address
+         and then Aname /= Name_Code_Address
+         and then Aname /= Name_Unchecked_Access
+       then
+          --  Ada 2005 (AI-345): Since protected and task types have primitive
+          --  entry wrappers, the attributes Count, Caller and AST_Entry require
+          --  a context check
+ 
+          if Ada_Version >= Ada_05
+            and then (Aname = Name_Count
+                       or else Aname = Name_Caller
+                       or else Aname = Name_AST_Entry)
+          then
+             declare
+                Count : Natural := 0;
+                I     : Interp_Index;
+                It    : Interp;
+ 
+             begin
+                Get_First_Interp (P, I, It);
+ 
+                while Present (It.Nam) loop
+                   if Comes_From_Source (It.Nam) then
+                      Count := Count + 1;
+                   else
+                      Remove_Interp (I);
+                   end if;
+ 
+                   Get_Next_Interp (I, It);
+                end loop;
+ 
+                if Count > 1 then
+                   Error_Attr ("ambiguous prefix for % attribute", P);
+                else
+                   Set_Is_Overloaded (P, False);
+                end if;
+             end;
+ 
+          else
+             Error_Attr ("ambiguous prefix for % attribute", P);
+          end if;
        end if;
  
        --  Remaining processing depends on attribute
*************** package body Sem_Attr is
*** 1685,1690 ****
--- 1822,1841 ----
  
                    Set_Address_Taken (Ent);
  
+                   --  An Address attribute is accepted when generated by
+                   --  the compiler for dispatching operation, and an error
+                   --  is issued once the subprogram is frozen (to avoid
+                   --  confusing errors about implicit uses of Address in
+                   --  the dispatch table initialization).
+ 
+                   if Is_Always_Inlined (Entity (P))
+                     and then Comes_From_Source (P)
+                   then
+                      Error_Attr
+                        ("prefix of % attribute cannot be Inline_Always" &
+                         " subprogram", P);
+                   end if;
+ 
                 elsif Is_Object (Ent)
                   or else Ekind (Ent) = E_Label
                 then
*************** package body Sem_Attr is
*** 1966,1972 ****
                      Attribute_Name => Name_Base),
                  Expression => Relocate_Node (E1)));
  
!             --  E1 may be overloaded, and its interpretations preserved.
  
              Save_Interps (E1, Expression (N));
              Analyze (N);
--- 2117,2123 ----
                      Attribute_Name => Name_Base),
                  Expression => Relocate_Node (E1)));
  
!             --  E1 may be overloaded, and its interpretations preserved
  
              Save_Interps (E1, Expression (N));
              Analyze (N);
*************** package body Sem_Attr is
*** 2406,2411 ****
--- 2557,2570 ----
                    if It.Nam = Ent then
                       null;
  
+                   --  Ada 2005 (AI-345): Do not consider primitive entry
+                   --  wrappers generated for task or protected types.
+ 
+                   elsif Ada_Version >= Ada_05
+                     and then not Comes_From_Source (It.Nam)
+                   then
+                      null;
+ 
                    else
                       Error_Attr ("ambiguous entry name", N);
                    end if;
*************** package body Sem_Attr is
*** 2654,2669 ****
           if Etype (P) =  Standard_Exception_Type then
              Set_Etype (N, RTE (RE_Exception_Id));
  
           elsif Is_Task_Type (Etype (P))
             or else (Is_Access_Type (Etype (P))
!               and then Is_Task_Type (Designated_Type (Etype (P))))
           then
              Resolve (P);
              Set_Etype (N, RTE (RO_AT_Task_Id));
  
           else
!             Error_Attr ("prefix of % attribute must be a task or an "
!               & "exception", P);
           end if;
  
        -----------
--- 2813,2840 ----
           if Etype (P) =  Standard_Exception_Type then
              Set_Etype (N, RTE (RE_Exception_Id));
  
+          --  Ada 2005 (AI-345): Attribute 'Identity may be applied to
+          --  task interface class-wide types.
+ 
           elsif Is_Task_Type (Etype (P))
             or else (Is_Access_Type (Etype (P))
!                       and then Is_Task_Type (Designated_Type (Etype (P))))
!            or else (Ada_Version >= Ada_05
!                       and then Ekind (Etype (P)) = E_Class_Wide_Type
!                       and then Is_Interface (Etype (P))
!                       and then Is_Task_Interface (Etype (P)))
           then
              Resolve (P);
              Set_Etype (N, RTE (RO_AT_Task_Id));
  
           else
!             if Ada_Version >= Ada_05 then
!                Error_Attr ("prefix of % attribute must be an exception, a "
!                          & "task or a task interface class-wide object", P);
!             else
!                Error_Attr ("prefix of % attribute must be a task or an "
!                          & "exception", P);
!             end if;
           end if;
  
        -----------
*************** package body Sem_Attr is
*** 2823,2828 ****
--- 2994,3008 ----
           Check_E0;
           Set_Etype (N, Universal_Integer);
  
+       ----------------------
+       -- Machine_Rounding --
+       ----------------------
+ 
+       when Attribute_Machine_Rounding =>
+          Check_Floating_Point_Type_1;
+          Set_Etype (N, P_Base_Type);
+          Resolve (E1, P_Base_Type);
+ 
        --------------------
        -- Machine_Rounds --
        --------------------
*************** package body Sem_Attr is
*** 3360,3366 ****
              Check_Object_Reference (P);
  
           elsif Is_Entity_Name (P)
!            and then Is_Type (Entity (P))
           then
              null;
  
--- 3540,3547 ----
              Check_Object_Reference (P);
  
           elsif Is_Entity_Name (P)
!            and then (Is_Type (Entity (P))
!                        or else Ekind (Entity (P)) = E_Enumeration_Literal)
           then
              null;
  
*************** package body Sem_Attr is
*** 3489,3495 ****
           if Is_Real_Type (P_Type) then
              null;
  
!          --  If not modular type, test for overflow check required.
  
           else
              if not Is_Modular_Integer_Type (P_Type)
--- 3670,3676 ----
           if Is_Real_Type (P_Type) then
              null;
  
!          --  If not modular type, test for overflow check required
  
           else
              if not Is_Modular_Integer_Type (P_Type)
*************** package body Sem_Attr is
*** 3934,3940 ****
        P     : constant Node_Id      := Prefix (N);
  
        C_Type : constant Entity_Id := Etype (N);
!       --  The type imposed by the context.
  
        E1 : Node_Id;
        --  First expression, or Empty if none
--- 4115,4121 ----
        P     : constant Node_Id      := Prefix (N);
  
        C_Type : constant Entity_Id := Etype (N);
!       --  The type imposed by the context
  
        E1 : Node_Id;
        --  First expression, or Empty if none
*************** package body Sem_Attr is
*** 4035,4040 ****
--- 4216,4225 ----
        --  used for First and Last of scalar types. Static is reset to False
        --  if the type or index type is not statically constrained.
  
+       function Statically_Denotes_Entity (N : Node_Id) return Boolean;
+       --  Verify that the prefix of a potentially static array attribute
+       --  satisfies the conditions of 4.9 (14).
+ 
        ---------------
        -- Aft_Value --
        ---------------
*************** package body Sem_Attr is
*** 4392,4397 ****
--- 4577,4601 ----
           end if;
        end Set_Bounds;
  
+       -------------------------------
+       -- Statically_Denotes_Entity --
+       -------------------------------
+ 
+       function Statically_Denotes_Entity (N : Node_Id) return Boolean is
+          E : Entity_Id;
+ 
+       begin
+          if not Is_Entity_Name (N) then
+             return False;
+          else
+             E := Entity (N);
+          end if;
+ 
+          return
+            Nkind (Parent (E)) /= N_Object_Renaming_Declaration
+              or else Statically_Denotes_Entity (Renamed_Object (E));
+       end Statically_Denotes_Entity;
+ 
     --  Start of processing for Eval_Attribute
  
     begin
*************** package body Sem_Attr is
*** 4650,4662 ****
        --  Array case. We enforce the constrained requirement of (RM 4.9(7-8))
        --  since we can't do anything with unconstrained arrays. In addition,
        --  only the First, Last and Length attributes are possibly static.
-       --  In addition Component_Size is possibly foldable, even though it
-       --  can never be static.
  
        --  Definite, Has_Access_Values, Has_Discriminants, Type_Class, and
        --  Unconstrained_Array are again exceptions, because they apply as
        --  well to unconstrained types.
  
        elsif Id = Attribute_Definite
                or else
              Id = Attribute_Has_Access_Values
--- 4854,4869 ----
        --  Array case. We enforce the constrained requirement of (RM 4.9(7-8))
        --  since we can't do anything with unconstrained arrays. In addition,
        --  only the First, Last and Length attributes are possibly static.
  
        --  Definite, Has_Access_Values, Has_Discriminants, Type_Class, and
        --  Unconstrained_Array are again exceptions, because they apply as
        --  well to unconstrained types.
  
+       --  In addition Component_Size is an exception since it is possibly
+       --  foldable, even though it is never static, and it does apply to
+       --  unconstrained arrays. Furthermore, it is essential to fold this
+       --  in the packed case, since otherwise the value will be incorrect.
+ 
        elsif Id = Attribute_Definite
                or else
              Id = Attribute_Has_Access_Values
*************** package body Sem_Attr is
*** 4666,4679 ****
              Id = Attribute_Type_Class
                or else
              Id = Attribute_Unconstrained_Array
        then
           Static := False;
  
        else
           if not Is_Constrained (P_Type)
!            or else (Id /= Attribute_Component_Size and then
!                     Id /= Attribute_First          and then
!                     Id /= Attribute_Last           and then
                      Id /= Attribute_Length)
           then
              Check_Expressions;
--- 4873,4887 ----
              Id = Attribute_Type_Class
                or else
              Id = Attribute_Unconstrained_Array
+               or else
+             Id = Attribute_Component_Size
        then
           Static := False;
  
        else
           if not Is_Constrained (P_Type)
!            or else (Id /= Attribute_First and then
!                     Id /= Attribute_Last  and then
                      Id /= Attribute_Length)
           then
              Check_Expressions;
*************** package body Sem_Attr is
*** 4689,4695 ****
           --  Again we compute the variable Static for easy reference later
           --  (note that no array attributes are static in Ada 83).
  
!          Static := Ada_Version >= Ada_95;
  
           declare
              N : Node_Id;
--- 4897,4904 ----
           --  Again we compute the variable Static for easy reference later
           --  (note that no array attributes are static in Ada 83).
  
!          Static := Ada_Version >= Ada_95
!                      and then Statically_Denotes_Entity (P);
  
           declare
              N : Node_Id;
*************** package body Sem_Attr is
*** 5313,5318 ****
--- 5522,5541 ----
              Fold_Uint (N, Uint_2, True);
           end if;
  
+       ----------------------
+       -- Machine_Rounding --
+       ----------------------
+ 
+       --  Note: for the folding case, it is fine to treat Machine_Rounding
+       --  exactly the same way as Rounding, since this is one of the allowed
+       --  behaviors, and performance is not an issue here. It might be a bit
+       --  better to give the same result as it would give at run-time, even
+       --  though the non-determinism is certainly permitted.
+ 
+       when Attribute_Machine_Rounding =>
+          Fold_Ureal (N,
+            Eval_Fat.Rounding (P_Root_Type, Expr_Value_R (E1)), Static);
+ 
        --------------------
        -- Machine_Rounds --
        --------------------
*************** package body Sem_Attr is
*** 6075,6081 ****
           end if;
  
           Rewrite (N, New_Occurrence_Of (RTE (Id), Loc));
- 
        end Type_Class;
  
        -----------------------
--- 6298,6303 ----
*************** package body Sem_Attr is
*** 6296,6314 ****
  
                       for J in UI_To_Int (Lo) .. UI_To_Int (Hi) loop
  
!                         --  Assume all wide-character escape sequences are
!                         --  same length, so we can quit when we reach one.
! 
!                         --  Is this right for UTF-8?
  
                          if J > 255 then
!                            if Id = Attribute_Wide_Width then
!                               W := Int'Max (W, 3);
!                               exit;
!                            else
!                               W := Int'Max (W, Length_Wide);
!                               exit;
!                            end if;
  
                          else
                             C := Character'Val (J);
--- 6518,6527 ----
  
                       for J in UI_To_Int (Lo) .. UI_To_Int (Hi) loop
  
!                         --  All wide characters look like Hex_hhhhhhhh
  
                          if J > 255 then
!                            W := 12;
  
                          else
                             C := Character'Val (J);
*************** package body Sem_Attr is
*** 6872,6880 ****
                 --  enclosing composite type.
  
                 if Ada_Version >= Ada_05
!                  and then Ekind (Btyp) = E_Anonymous_Access_Type
!                  and then (Is_Array_Type (Scope (Btyp))
!                              or else Ekind (Scope (Btyp)) = E_Record_Type)
                   and then Object_Access_Level (P) > Type_Access_Level (Btyp)
                 then
                    --  In an instance, this is a runtime check, but one we
--- 7085,7091 ----
                 --  enclosing composite type.
  
                 if Ada_Version >= Ada_05
!                  and then Is_Local_Anonymous_Access (Btyp)
                   and then Object_Access_Level (P) > Type_Access_Level (Btyp)
                 then
                    --  In an instance, this is a runtime check, but one we
*************** package body Sem_Attr is
*** 7088,7094 ****
                 Note_Possible_Modification (P);
              end if;
  
!             if Nkind (P) in  N_Subexpr
                and then Is_Overloaded (P)
              then
                 Get_First_Interp (P, Index, It);
--- 7299,7305 ----
                 Note_Possible_Modification (P);
              end if;
  
!             if Nkind (P) in N_Subexpr
                and then Is_Overloaded (P)
              then
                 Get_First_Interp (P, Index, It);
*************** package body Sem_Attr is
*** 7097,7103 ****
                 if Present (It.Nam) then
                    Error_Msg_Name_1 := Aname;
                    Error_Msg_N
!                     ("prefix of % attribute cannot be overloaded", N);
                    return;
                 end if;
              end if;
--- 7308,7314 ----
                 if Present (It.Nam) then
                    Error_Msg_Name_1 := Aname;
                    Error_Msg_N
!                     ("prefix of % attribute cannot be overloaded", P);
                    return;
                 end if;
              end if;
*************** package body Sem_Attr is
*** 7459,7462 ****
--- 7670,7784 ----
        Eval_Attribute (N);
     end Resolve_Attribute;
  
+    --------------------------------
+    -- Stream_Attribute_Available --
+    --------------------------------
+ 
+    function Stream_Attribute_Available
+      (Typ          : Entity_Id;
+       Nam          : TSS_Name_Type;
+       Partial_View : Node_Id := Empty) return Boolean
+    is
+       Etyp : Entity_Id := Typ;
+ 
+       function Has_Specified_Stream_Attribute
+         (Typ : Entity_Id;
+          Nam : TSS_Name_Type) return Boolean;
+       --  True iff there is a visible attribute definition clause specifying
+       --  attribute Nam for Typ.
+ 
+       ------------------------------------
+       -- Has_Specified_Stream_Attribute --
+       ------------------------------------
+ 
+       function Has_Specified_Stream_Attribute
+         (Typ : Entity_Id;
+          Nam : TSS_Name_Type) return Boolean
+       is
+       begin
+          return False
+            or else
+              (Nam = TSS_Stream_Input
+                and then Has_Specified_Stream_Input (Typ))
+            or else
+              (Nam = TSS_Stream_Output
+                and then Has_Specified_Stream_Output (Typ))
+            or else
+              (Nam = TSS_Stream_Read
+                and then Has_Specified_Stream_Read (Typ))
+            or else
+              (Nam = TSS_Stream_Write
+                and then Has_Specified_Stream_Write (Typ));
+       end Has_Specified_Stream_Attribute;
+ 
+    --  Start of processing for Stream_Attribute_Available
+ 
+    begin
+       --  We need some comments in this body ???
+ 
+       if Has_Specified_Stream_Attribute (Typ, Nam) then
+          return True;
+       end if;
+ 
+       if Is_Class_Wide_Type (Typ) then
+          return not Is_Limited_Type (Typ)
+            or else Stream_Attribute_Available (Etype (Typ), Nam);
+       end if;
+ 
+       if Nam = TSS_Stream_Input
+         and then Is_Abstract (Typ)
+         and then not Is_Class_Wide_Type (Typ)
+       then
+          return False;
+       end if;
+ 
+       if not (Is_Limited_Type (Typ)
+         or else (Present (Partial_View)
+                    and then Is_Limited_Type (Partial_View)))
+       then
+          return True;
+       end if;
+ 
+       --  In Ada 2005, Input can invoke Read, and Output can invoke Write
+ 
+       if Nam = TSS_Stream_Input
+         and then Ada_Version >= Ada_05
+         and then Stream_Attribute_Available (Etyp, TSS_Stream_Read)
+       then
+          return True;
+ 
+       elsif Nam = TSS_Stream_Output
+         and then Ada_Version >= Ada_05
+         and then Stream_Attribute_Available (Etyp, TSS_Stream_Write)
+       then
+          return True;
+       end if;
+ 
+       --  Case of Read and Write: check for attribute definition clause that
+       --  applies to an ancestor type.
+ 
+       while Etype (Etyp) /= Etyp loop
+          Etyp := Etype (Etyp);
+ 
+          if Has_Specified_Stream_Attribute (Etyp, Nam) then
+             return True;
+          end if;
+       end loop;
+ 
+       if Ada_Version < Ada_05 then
+ 
+          --  In Ada 95 mode, also consider a non-visible definition
+ 
+          declare
+             Btyp : constant Entity_Id := Implementation_Base_Type (Typ);
+          begin
+             return Btyp /= Typ
+               and then Stream_Attribute_Available
+                          (Btyp, Nam, Partial_View => Typ);
+          end;
+       end if;
+ 
+       return False;
+    end Stream_Attribute_Available;
+ 
  end Sem_Attr;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_attr.ads gcc-4.1.0/gcc/ada/sem_attr.ads
*** gcc-4.0.2/gcc/ada/sem_attr.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/sem_attr.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 31,38 ****
  
  --  This spec also documents all GNAT implementation defined pragmas
  
! with Snames; use Snames;
! with Types;  use Types;
  
  package Sem_Attr is
  
--- 31,39 ----
  
  --  This spec also documents all GNAT implementation defined pragmas
  
! with Exp_Tss; use Exp_Tss;
! with Snames;  use Snames;
! with Types;   use Types;
  
  package Sem_Attr is
  
*************** package Sem_Attr is
*** 54,73 ****
        ------------------
  
        Attribute_Abort_Signal => True,
!       --
!       --  Standard'Abort_Signal (Standard is the only allowed prefix)
!       --  provides the entity for the special exception used to signal
!       --  task abort or asynchronous transfer of control. Normally this
!       --  attribute should only be used in the tasking runtime (it is
!       --  highly peculiar, and completely outside the normal semantics
!       --  of Ada, for a user program to intercept the abort exception).
  
        ------------------
        -- Address_Size --
        ------------------
  
        Attribute_Address_Size => True,
-       --
        --  Standard'Address_Size (Standard is the only allowed prefix) is
        --  a static constant giving the number of bits in an Address. It
        --  is used primarily for constructing the definition of Memory_Size
--- 55,72 ----
        ------------------
  
        Attribute_Abort_Signal => True,
!       --  Standard'Abort_Signal (Standard is the only allowed prefix) provides
!       --  the entity for the special exception used to signal task abort or
!       --  asynchronous transfer of control. Normally this attribute should only
!       --  be used in the tasking runtime (it is highly peculiar, and completely
!       --  outside the normal semantics of Ada, for a user program to intercept
!       --  the abort exception).
  
        ------------------
        -- Address_Size --
        ------------------
  
        Attribute_Address_Size => True,
        --  Standard'Address_Size (Standard is the only allowed prefix) is
        --  a static constant giving the number of bits in an Address. It
        --  is used primarily for constructing the definition of Memory_Size
*************** package Sem_Attr is
*** 79,85 ****
        ---------------
  
        Attribute_Asm_Input => True,
-       --
        --  Used only in conjunction with the Asm and Asm_Volatile subprograms
        --  in package Machine_Code to construct machine instructions. See
        --  documentation in package Machine_Code in file s-maccod.ads.
--- 78,83 ----
*************** package Sem_Attr is
*** 89,95 ****
        ----------------
  
        Attribute_Asm_Output => True,
-       --
        --  Used only in conjunction with the Asm and Asm_Volatile subprograms
        --  in package Machine_Code to construct machine instructions. See
        --  documentation in package Machine_Code in file s-maccod.ads.
--- 87,92 ----
*************** package Sem_Attr is
*** 99,105 ****
        ---------------
  
        Attribute_AST_Entry => True,
-       --
        --  E'Ast_Entry, where E is a task entry, yields a value of the
        --  predefined type System.DEC.AST_Handler, that enables the given
        --  entry to be called when an AST occurs. If the name to which the
--- 96,101 ----
*************** package Sem_Attr is
*** 117,136 ****
        ---------
  
        Attribute_Bit => True,
!       --
!       --  Obj'Bit, where Obj is any object, yields the bit offset within
!       --  the storage unit (byte) that contains the first bit of storage
!       --  allocated for the object. The value of this attribute is of the
!       --  type Universal_Integer, and is always a non-negative number not
!       --  exceeding the value of System.Storage_Unit.
        --
        --  For an object that is a variable or a constant allocated in a
        --  register, the value is zero. (The use of this attribute does not
        --  force the allocation of a variable to memory).
        --
!       --  For an object that is a formal parameter, this attribute applies
!       --  to either the matching actual parameter or to a copy of the
!       --  matching actual parameter.
        --
        --  For an access object the value is zero. Note that Obj.all'Bit is
        --  subject to an Access_Check for the designated object. Similarly
--- 113,131 ----
        ---------
  
        Attribute_Bit => True,
!       --  Obj'Bit, where Obj is any object, yields the bit offset within the
!       --  storage unit (byte) that contains the first bit of storage allocated
!       --  for the object. The attribute value is of type Universal_Integer,
!       --  and is always a non-negative number not exceeding the value of
!       --  System.Storage_Unit.
        --
        --  For an object that is a variable or a constant allocated in a
        --  register, the value is zero. (The use of this attribute does not
        --  force the allocation of a variable to memory).
        --
!       --  For an object that is a formal parameter, this attribute applies to
!       --  either the matching actual parameter or to a copy of the matching
!       --  actual parameter.
        --
        --  For an access object the value is zero. Note that Obj.all'Bit is
        --  subject to an Access_Check for the designated object. Similarly
*************** package Sem_Attr is
*** 145,166 ****
        ------------------
  
        Attribute_Code_Address => True,
!       --
!       --  subp'Code_Address, where subp is a subprogram entity, gives the
!       --  address of the first generated instruction for a subprogram. This
!       --  is often, but not always the same as the 'Address value, which is
!       --  the address to be used in a call. The differences occur in the case
!       --  of a nested procedure (where Address yields the address of the
!       --  trampoline code used to load the static link), and on some systems
!       --  which use procedure descriptors (in which case Address yields the
!       --  address of the descriptor).
  
        -----------------------
        -- Default_Bit_Order --
        -----------------------
  
        Attribute_Default_Bit_Order => True,
-       --
        --  Standard'Default_Bit_Order (Standard is the only permissible prefix),
        --  provides the value System.Default_Bit_Order as a Pos value (0 for
        --  High_Order_First, 1 for Low_Order_First). This is used to construct
--- 140,159 ----
        ------------------
  
        Attribute_Code_Address => True,
!       --  The reference subp'Code_Address, where subp is a subprogram entity,
!       --  gives the address of the first generated instruction for the sub-
!       --  program. This is often, but not always the same as the 'Address
!       --  value, which is the address to be used in a call. The differences
!       --  occur in the case of a nested procedure (where Address yields the
!       --  address of the trampoline code used to load the static link), and on
!       --  some systems which use procedure descriptors (in which case Address
!       --  yields the address of the descriptor).
  
        -----------------------
        -- Default_Bit_Order --
        -----------------------
  
        Attribute_Default_Bit_Order => True,
        --  Standard'Default_Bit_Order (Standard is the only permissible prefix),
        --  provides the value System.Default_Bit_Order as a Pos value (0 for
        --  High_Order_First, 1 for Low_Order_First). This is used to construct
*************** package Sem_Attr is
*** 172,193 ****
        ---------------
  
        Attribute_Elab_Body => True,
!       --
!       --  This attribute can only be applied to a program unit name. It
!       --  returns the entity for the corresponding elaboration procedure
!       --  for elaborating the body of the referenced unit. This is used
!       --  in the main generated elaboration procedure by the binder, and
!       --  is not normally used in any other context, but there may be
!       --  specialized situations in which it is useful to be able to
!       --  call this elaboration procedure from Ada code, e.g. if it
!       --  is necessary to do selective reelaboration to fix some error.
  
        ---------------
        -- Elab_Spec --
        ---------------
  
        Attribute_Elab_Spec => True,
-       --
        --  This attribute can only be applied to a program unit name. It
        --  returns the entity for the corresponding elaboration procedure
        --  for elaborating the spec of the referenced unit. This is used
--- 165,184 ----
        ---------------
  
        Attribute_Elab_Body => True,
!       --  This attribute can only be applied to a program unit name. It returns
!       --  the entity for the corresponding elaboration procedure for elabor-
!       --  ating the body of the referenced unit. This is used in the main
!       --  generated elaboration procedure by the binder, and is not normally
!       --  used in any other context, but there may be specialized situations in
!       --  which it is useful to be able to call this elaboration procedure from
!       --  Ada code, e.g. if it is necessary to do selective reelaboration to
!       --  fix some error.
  
        ---------------
        -- Elab_Spec --
        ---------------
  
        Attribute_Elab_Spec => True,
        --  This attribute can only be applied to a program unit name. It
        --  returns the entity for the corresponding elaboration procedure
        --  for elaborating the spec of the referenced unit. This is used
*************** package Sem_Attr is
*** 202,208 ****
        ----------------
  
        Attribute_Elaborated => True,
-       --
        --  Lunit'Elaborated, where Lunit is a library unit, yields a boolean
        --  value indicating whether or not the body of the designated library
        --  unit has been elaborated yet.
--- 193,198 ----
*************** package Sem_Attr is
*** 212,218 ****
        --------------
  
        Attribute_Enum_Rep => True,
-       --
        --  For every enumeration subtype S, S'Enum_Rep denotes a function
        --  with the following specification:
        --
--- 202,207 ----
*************** package Sem_Attr is
*** 228,234 ****
        -----------------
  
        Attribute_Fixed_Value => True,
-       --
        --  For every fixed-point type S, S'Fixed_Value denotes a function
        --  with the following specification:
        --
--- 217,222 ----
*************** package Sem_Attr is
*** 238,255 ****
        --
        --    V = Arg * S'Small
        --
!       --  The effect is thus equivalent to first converting the argument
!       --  to the integer type used to represent S, and then doing an
!       --  unchecked conversion to the fixed-point type. This attribute is
!       --  primarily intended for use in implementation of the input-output
!       --  functions for fixed-point values.
  
        -----------------------
        -- Has_Discriminants --
        -----------------------
  
        Attribute_Has_Discriminants => True,
-       --
        --  Gtyp'Has_Discriminants, where Gtyp is a generic formal type, yields
        --  a Boolean value indicating whether or not the actual instantiation
        --  type has discriminants.
--- 226,242 ----
        --
        --    V = Arg * S'Small
        --
!       --  The effect is thus equivalent to first converting the argument to
!       --  the integer type used to represent S, and then doing an unchecked
!       --  conversion to the fixed-point type. This attribute is primarily
!       --  intended for use in implementation of the input-output functions for
!       --  fixed-point values.
  
        -----------------------
        -- Has_Discriminants --
        -----------------------
  
        Attribute_Has_Discriminants => True,
        --  Gtyp'Has_Discriminants, where Gtyp is a generic formal type, yields
        --  a Boolean value indicating whether or not the actual instantiation
        --  type has discriminants.
*************** package Sem_Attr is
*** 259,265 ****
        ---------
  
        Attribute_Img => True,
-       --
        --  The 'Img function is defined for any prefix, P, that denotes an
        --  object of scalar type T. P'Img is equivalent to T'Image (P). This
        --  is convenient for debugging. For example:
--- 246,251 ----
*************** package Sem_Attr is
*** 277,283 ****
        -------------------
  
        Attribute_Integer_Value => True,
-       --
        --  For every integer type S, S'Integer_Value denotes a function
        --  with the following specification:
        --
--- 263,268 ----
*************** package Sem_Attr is
*** 298,304 ****
        ------------------
  
        Attribute_Machine_Size => True,
-       --
        --  This attribute is identical to the Object_Size attribute. It is
        --  provided for compatibility with the DEC attribute of this name.
  
--- 283,288 ----
*************** package Sem_Attr is
*** 307,313 ****
        -----------------------
  
        Attribute_Maximum_Alignment => True,
-       --
        --  Standard'Maximum_Alignment (Standard is the only permissible prefix)
        --  provides the maximum useful alignment value for the target. This
        --  is a static value that can be used to specify the alignment for an
--- 291,296 ----
*************** package Sem_Attr is
*** 320,326 ****
        --------------------
  
        Attribute_Mechanism_Code => True,
-       --
        --  function'Mechanism_Code yeilds an integer code for the mechanism
        --  used for the result of function, and subprogram'Mechanism_Code (n)
        --  yields the mechanism used for formal parameter number n (a static
--- 303,308 ----
*************** package Sem_Attr is
*** 342,405 ****
        --------------------
  
        Attribute_Null_Parameter => True,
        --
!       --  A reference T'Null_Parameter denotes an (imaginary) object of
!       --  type or subtype T allocated at (machine) address zero. The
!       --  attribute is allowed only as the default expression of a formal
!       --  parameter, or as an actual expression of a subporgram call. In
!       --  either case, the subprogram must be imported.
!       --
!       --  The identity of the object is represented by the address zero
!       --  in the argument list, independent of the passing mechanism
!       --  (explicit or default).
        --
!       --  The reason that this capability is needed is that for a record
!       --  or other composite object passed by reference, there is no other
!       --  way of specifying that a zero address should be passed.
  
        -----------------
        -- Object_Size --
        -----------------
  
        Attribute_Object_Size => True,
-       --
        --  Type'Object_Size is the same as Type'Size for all types except
        --  fixed-point types and discrete types. For fixed-point types and
        --  discrete types, this attribute gives the size used for default
!       --  allocation of objects and components of the size. See section
!       --  in Einfo ("Handling of type'Size values") for further details.
  
        -------------------------
        -- Passed_By_Reference --
        -------------------------
  
        Attribute_Passed_By_Reference => True,
!       --
!       --  T'Passed_By_Reference for any subtype T returns a boolean value
!       --  that is true if the type is normally passed by reference and
!       --  false if the type is normally passed by copy in calls. For scalar
!       --  types, the result is always False and is static. For non-scalar
!       --  types, the result is non-static (since it is computed by Gigi).
  
        ------------------
        -- Range_Length --
        ------------------
  
        Attribute_Range_Length => True,
!       --
!       --  T'Range_Length for any discrete type T yields the number of
!       --  values represented by the subtype (zero for a null range). The
!       --  result is static for static subtypes. Note that Range_Length
!       --  applied to the index subtype of a one dimensional array always
!       --  gives the same result as Range applied to the array itself.
!       --  The result is of type universal integer.
  
        ------------------
        -- Storage_Unit --
        ------------------
  
        Attribute_Storage_Unit => True,
-       --
        --  Standard'Storage_Unit (Standard is the only permissible prefix)
        --  provides the value System.Storage_Unit, and is intended primarily
        --  for constructing this definition in package System (see note above
--- 324,382 ----
        --------------------
  
        Attribute_Null_Parameter => True,
+       --  A reference T'Null_Parameter denotes an (imaginary) object of type or
+       --  subtype T allocated at (machine) address zero. The attribute is
+       --  allowed only as the default expression of a formal parameter, or as
+       --  an actual expression of a subporgram call. In either case, the
+       --  subprogram must be imported.
        --
!       --  The identity of the object is represented by the address zero in the
!       --  argument list, independent of the passing mechanism (explicit or
!       --  default).
        --
!       --  The reason that this capability is needed is that for a record or
!       --  other composite object passed by reference, there is no other way of
!       --  specifying that a zero address should be passed.
  
        -----------------
        -- Object_Size --
        -----------------
  
        Attribute_Object_Size => True,
        --  Type'Object_Size is the same as Type'Size for all types except
        --  fixed-point types and discrete types. For fixed-point types and
        --  discrete types, this attribute gives the size used for default
!       --  allocation of objects and components of the size. See section in
!       --  Einfo ("Handling of type'Size values") for further details.
  
        -------------------------
        -- Passed_By_Reference --
        -------------------------
  
        Attribute_Passed_By_Reference => True,
!       --  T'Passed_By_Reference for any subtype T returns a boolean value that
!       --  is true if the type is normally passed by reference and false if the
!       --  type is normally passed by copy in calls. For scalar types, the
!       --  result is always False and is static. For non-scalar types, the
!       --  result is non-static (since it is computed by Gigi).
  
        ------------------
        -- Range_Length --
        ------------------
  
        Attribute_Range_Length => True,
!       --  T'Range_Length for any discrete type T yields the number of values
!       --  represented by the subtype (zero for a null range). The result is
!       --  static for static subtypes. Note that Range_Length applied to the
!       --  index subtype of a one dimensional array always gives the same result
!       --  as Range applied to the array itself. The result is of type universal
!       --  integer.
  
        ------------------
        -- Storage_Unit --
        ------------------
  
        Attribute_Storage_Unit => True,
        --  Standard'Storage_Unit (Standard is the only permissible prefix)
        --  provides the value System.Storage_Unit, and is intended primarily
        --  for constructing this definition in package System (see note above
*************** package Sem_Attr is
*** 410,445 ****
        -----------------
  
        Attribute_Target_Name => True,
!       --
!       --  Standard'Target_Name yields the string identifying the target
!       --  for the compilation, taken from Sdefault.Target_Name.
  
        ----------------
        -- To_Address --
        ----------------
  
        Attribute_To_Address => True,
!       --
!       --  System'To_Address (Address is the only permissible prefix)
!       --  is a function that takes any integer value, and converts it into
!       --  an address value. The semantics is to first convert the integer
!       --  value to type Integer_Address according to normal conversion
!       --  rules, and then to convert this to an address using the same
!       --  semantics as the System.Storage_Elements.To_Address function.
!       --  The important difference is that this is a static attribute
!       --  so it can be used in initializations in preealborate packages.
  
        ----------------
        -- Type_Class --
        ----------------
  
        Attribute_Type_Class => True,
!       --
!       --  T'Type_Class for any type or subtype T yields the value of the
!       --  type class for the full type of T. If T is a generic formal type,
!       --  then the value is the value for the corresponding actual subtype.
!       --  The value of this attribute is of type System.Aux_DEC.Type_Class,
!       --  which has the following definition:
        --
        --    type Type_Class is
        --      (Type_Class_Enumeration,
--- 387,419 ----
        -----------------
  
        Attribute_Target_Name => True,
!       --  Standard'Target_Name yields the string identifying the target for the
!       --  compilation, taken from Sdefault.Target_Name.
  
        ----------------
        -- To_Address --
        ----------------
  
        Attribute_To_Address => True,
!       --  System'To_Address (Address is the only permissible prefix) is a
!       --  function that takes any integer value, and converts it into an
!       --  address value. The semantics is to first convert the integer value to
!       --  type Integer_Address according to normal conversion rules, and then
!       --  to convert this to an address using the same semantics as the
!       --  System.Storage_Elements.To_Address function. The important difference
!       --  is that this is a static attribute so it can be used in
!       --  initializations in preealborate packages.
  
        ----------------
        -- Type_Class --
        ----------------
  
        Attribute_Type_Class => True,
!       --  T'Type_Class for any type or subtype T yields the value of the type
!       --  class for the full type of T. If T is a generic formal type, then the
!       --  value is the value for the corresponding actual subtype. The value of
!       --  this attribute is of type System.Aux_DEC.Type_Class, which has the
!       --  following definition:
        --
        --    type Type_Class is
        --      (Type_Class_Enumeration,
*************** package Sem_Attr is
*** 452,460 ****
        --       Type_Class_Task,
        --       Type_Class_Address);
        --
!       --  Protected types yield the value Type_Class_Task, which thus
!       --  applies to all concurrent types. This attribute is designed to
!       --  be compatible with the DEC Ada attribute of the same name.
        --
        --  Note: if pragma Extend_System is used to merge the definitions of
        --  Aux_DEC into System, then the type Type_Class can be referenced
--- 426,434 ----
        --       Type_Class_Task,
        --       Type_Class_Address);
        --
!       --  Protected types yield the value Type_Class_Task, which thus applies
!       --  to all concurrent types. This attribute is designed to be compatible
!       --  with the DEC Ada attribute of the same name.
        --
        --  Note: if pragma Extend_System is used to merge the definitions of
        --  Aux_DEC into System, then the type Type_Class can be referenced
*************** package Sem_Attr is
*** 465,471 ****
        -----------------
  
        Attribute_UET_Address => True,
-       --
        --  Unit'UET_Address, where Unit is a program unit, yields the address
        --  of the unit exception table for the specified unit. This is only
        --  used in the internal implementation of exception handling. See the
--- 439,444 ----
*************** package Sem_Attr is
*** 476,498 ****
        ------------------------------
  
        Attribute_Universal_Literal_String => True,
!       --
!       --  The prefix of 'Universal_Literal_String must be a named number.
!       --  The static result is the string consisting of the characters of
!       --  the number as defined in the original source. This allows the
!       --  user program to access the actual text of named numbers without
!       --  intermediate conversions and without the need to enclose the
!       --  strings in quotes (which would preclude their use as numbers).
!       --  This is used internally for the construction of values of the
!       --  floating-point attributes from the file ttypef.ads, but may
!       --  also be used by user programs.
  
        -------------------------
        -- Unrestricted_Access --
        -------------------------
  
        Attribute_Unrestricted_Access => True,
-       --
        --  The Unrestricted_Access attribute is similar to Access except that
        --  all accessibility and aliased view checks are omitted. This is very
        --  much a user-beware attribute. Basically its status is very similar
--- 449,469 ----
        ------------------------------
  
        Attribute_Universal_Literal_String => True,
!       --  The prefix of 'Universal_Literal_String must be a named number. The
!       --  static result is the string consisting of the characters of the
!       --  number as defined in the original source. This allows the user
!       --  program to access the actual text of named numbers without
!       --  intermediate conversions and without the need to enclose the strings
!       --  in quotes (which would preclude their use as numbers). This is used
!       --  internally for the construction of values of the floating-point
!       --  attributes from the file ttypef.ads, but may also be used by user
!       --  programs.
  
        -------------------------
        -- Unrestricted_Access --
        -------------------------
  
        Attribute_Unrestricted_Access => True,
        --  The Unrestricted_Access attribute is similar to Access except that
        --  all accessibility and aliased view checks are omitted. This is very
        --  much a user-beware attribute. Basically its status is very similar
*************** package Sem_Attr is
*** 510,541 ****
        ---------------
  
        Attribute_VADS_Size => True,
!       --
!       --  Typ'VADS_Size yields the Size value typically yielded by some
!       --  Ada 83 compilers. The differences between VADS_Size and Size
!       --  is that for scalar types for which no Size has been specified,
!       --  VADS_Size yields the Object_Size rather than the Value_Size.
!       --  For example, while Natural'Size is typically 31, the value of
!       --  Natural'VADS_Size is 32. For all other types, Size and VADS_Size
!       --  yield the same value.
  
        ----------------
        -- Value_Size --
        ----------------
  
        Attribute_Value_Size => True,
!       --
!       --  Type'Value_Size is the number of bits required to represent a
!       --  value of the given subtype. It is the same as Type'Size, but,
!       --  unlike Size, may be set for non-first subtypes. See section
!       --  in Einfo ("Handling of type'Size values") for further details.
  
        ---------------
        -- Word_Size --
        ---------------
  
        Attribute_Word_Size => True,
-       --
        --  Standard'Word_Size (Standard is the only permissible prefix)
        --  provides the value System.Word_Size, and is intended primarily
        --  for constructing this definition in package System (see note above
--- 481,508 ----
        ---------------
  
        Attribute_VADS_Size => True,
!       --  Typ'VADS_Size yields the Size value typically yielded by some Ada 83
!       --  compilers. The differences between VADS_Size and Size is that for
!       --  scalar types for which no Size has been specified, VADS_Size yields
!       --  the Object_Size rather than the Value_Size. For example, while
!       --  Natural'Size is typically 31, the value of Natural'VADS_Size is 32.
!       --  For all other types, Size and VADS_Size yield the same value.
  
        ----------------
        -- Value_Size --
        ----------------
  
        Attribute_Value_Size => True,
!       --  Type'Value_Size is the number of bits required to represent value of
!       --  the given subtype. It is the same as Type'Size, but, unlike Size, may
!       --  be set for non-first subtypes. See section in Einfo ("Handling of
!       --  type'Size values") for further details.
  
        ---------------
        -- Word_Size --
        ---------------
  
        Attribute_Word_Size => True,
        --  Standard'Word_Size (Standard is the only permissible prefix)
        --  provides the value System.Word_Size, and is intended primarily
        --  for constructing this definition in package System (see note above
*************** package Sem_Attr is
*** 554,567 ****
     --  other attributes).
  
     procedure Resolve_Attribute (N : Node_Id; Typ : Entity_Id);
!    --  Performs type resolution of attribute. If the attribute yields
!    --  a universal value, mark its type as that of the context. On
!    --  the other hand, if the context itself is universal (as in
!    --  T'Val (T'Pos (X)), mark the type as being the largest type of
!    --  that class that can be used at run-time. This is correct since
!    --  either the value gets folded (in which case it doesn't matter
!    --  what type of the class we give if, since the folding uses universal
!    --  arithmetic anyway) or it doesn't get folded (in which case it is
!    --  going to be dealt with at runtime, and the largest type is right).
  
  end Sem_Attr;
--- 521,546 ----
     --  other attributes).
  
     procedure Resolve_Attribute (N : Node_Id; Typ : Entity_Id);
!    --  Performs type resolution of attribute. If the attribute yields a
!    --  universal value, mark its type as that of the context. On the other
!    --  hand, if the context itself is universal (as in T'Val (T'Pos (X)), mark
!    --  the type as being the largest type of that class that can be used at
!    --  run-time. This is correct since either the value gets folded (in which
!    --  case it doesn't matter what type of the class we give if, since the
!    --  folding uses universal arithmetic anyway) or it doesn't get folded (in
!    --  which case it is going to be dealt with at runtime, and the largest type
!    --  is right).
! 
!    function Stream_Attribute_Available
!      (Typ          : Entity_Id;
!       Nam          : TSS_Name_Type;
!       Partial_View : Entity_Id := Empty) return Boolean;
!    --  For a limited type Typ, return True iff the given attribute is
!    --  available. For Ada 05, availability is defined by 13.13.2(36/1). For Ada
!    --  95, an attribute is considered to be available if it has been specified
!    --  using an attribute definition clause for the type, or for its full view,
!    --  or for an ancestor of either. Parameter Partial_View is used only
!    --  internally, when checking for an attribute definition clause that is not
!    --  visible (Ada 95 only).
  
  end Sem_Attr;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_case.adb gcc-4.1.0/gcc/ada/sem_case.adb
*** gcc-4.0.2/gcc/ada/sem_case.adb	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/sem_case.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Case is
*** 99,109 ****
        Msg_Sloc       : Source_Ptr)
     is
        function Lt_Choice (C1, C2 : Natural) return Boolean;
!       --  Comparison routine for comparing Choice_Table entries.
!       --  Use the lower bound of each Choice as the key.
  
        procedure Move_Choice (From : Natural; To : Natural);
!       --  Move routine for sorting the Choice_Table.
  
        procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
        procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
--- 99,109 ----
        Msg_Sloc       : Source_Ptr)
     is
        function Lt_Choice (C1, C2 : Natural) return Boolean;
!       --  Comparison routine for comparing Choice_Table entries. Use the lower
!       --  bound of each Choice as the key.
  
        procedure Move_Choice (From : Natural; To : Natural);
!       --  Move routine for sorting the Choice_Table
  
        procedure Issue_Msg (Value1 : Node_Id; Value2 : Node_Id);
        procedure Issue_Msg (Value1 : Node_Id; Value2 : Uint);
*************** package body Sem_Case is
*** 524,530 ****
          and then Comes_From_Source (Others_Choice)
          and then Is_Empty_List (Choice_List)
        then
!          Error_Msg_N ("?others choice is empty", Others_Choice);
        end if;
     end Expand_Others_Choice;
  
--- 524,531 ----
          and then Comes_From_Source (Others_Choice)
          and then Is_Empty_List (Choice_List)
        then
!          Error_Msg_N ("?OTHERS choice is redundant", Others_Choice);
!          Error_Msg_N ("\previous choices cover all values", Others_Choice);
        end if;
     end Expand_Others_Choice;
  
*************** package body Sem_Case is
*** 577,583 ****
  
           Bounds_Lo : Uint;
           Bounds_Hi : Uint;
!          --  The actual bounds of the above type.
  
           Expected_Type : Entity_Id;
           --  The expected type of each choice. Equal to Choice_Type, except
--- 578,584 ----
  
           Bounds_Lo : Uint;
           Bounds_Hi : Uint;
!          --  The actual bounds of the above type
  
           Expected_Type : Entity_Id;
           --  The expected type of each choice. Equal to Choice_Type, except
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_case.ads gcc-4.1.0/gcc/ada/sem_case.ads
*** gcc-4.0.2/gcc/ada/sem_case.ads	Tue Oct 21 13:42:18 2003
--- gcc-4.1.0/gcc/ada/sem_case.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --         Copyright (C) 1996-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,31 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Types; use Types;
- 
  --  Package containing the routines to process a list of discrete choices.
  --  Such lists can occur in two different constructs: case statements and
  --  record variants. We have factorized what used to be two very similar
--- 16,29 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  --  Package containing the routines to process a list of discrete choices.
  --  Such lists can occur in two different constructs: case statements and
  --  record variants. We have factorized what used to be two very similar
*************** with Types; use Types;
*** 33,38 ****
--- 31,38 ----
  --  aggregate case, since issues with nested aggregates make that case
  --  substantially different.
  
+ with Types; use Types;
+ 
  package Sem_Case is
  
     type Choice_Bounds is record
*************** package Sem_Case is
*** 63,72 ****
        --  to get to the actual list of discrete choices.
  
        with procedure Process_Empty_Choice (Choice : Node_Id);
!       --  Processing to carry out for an empty Choice.
  
        with procedure Process_Non_Static_Choice (Choice : Node_Id);
!       --  Processing to carry out for a non static Choice.
  
        with procedure Process_Associated_Node (A : Node_Id);
        --  Associated to each case alternative, aggregate component
--- 63,72 ----
        --  to get to the actual list of discrete choices.
  
        with procedure Process_Empty_Choice (Choice : Node_Id);
!       --  Processing to carry out for an empty Choice
  
        with procedure Process_Non_Static_Choice (Choice : Node_Id);
!       --  Processing to carry out for a non static Choice
  
        with procedure Process_Associated_Node (A : Node_Id);
        --  Associated to each case alternative, aggregate component
*************** package Sem_Case is
*** 96,106 ****
        --  On entry Choice_Table must be big enough to contain all the
        --  discrete choices encountered.
        --
!       --  On exit Choice_Table contains all the static and non empty
!       --  discrete choices in sorted order. Last_Choice gives the position
!       --  of the last valid choice in Choice_Table, Choice_Table'First
!       --  contains the first. We can have Last_Choice < Choice_Table'Last
!       --  for one (or several) of the following reasons:
        --
        --    (a) The list of choices contained a non static choice
        --
--- 96,106 ----
        --  On entry Choice_Table must be big enough to contain all the
        --  discrete choices encountered.
        --
!       --  On exit Choice_Table contains all the static and non empty discrete
!       --  choices in sorted order. Last_Choice gives the position of the last
!       --  valid choice in Choice_Table, Choice_Table'First contains the first.
!       --  We can have Last_Choice < Choice_Table'Last for one (or several) of
!       --  the following reasons:
        --
        --    (a) The list of choices contained a non static choice
        --
*************** package Sem_Case is
*** 113,121 ****
        --  In one of the bounds of a discrete choice raises a constraint
        --  error the flag Raise_CE is set.
        --
!       --  Finally Others_Present is set to True if an Others choice is
!       --  present in the list of choices, and in this case the call also
!       --  sets Others_Discrete_Choices in the N_Others_Choice node.
  
     end Generic_Choices_Processing;
  
--- 113,121 ----
        --  In one of the bounds of a discrete choice raises a constraint
        --  error the flag Raise_CE is set.
        --
!       --  Finally Others_Present is set to True if an Others choice is present
!       --  in the list of choices, and in this case the call also sets
!       --  Others_Discrete_Choices in the N_Others_Choice node.
  
     end Generic_Choices_Processing;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_cat.adb gcc-4.1.0/gcc/ada/sem_cat.adb
*** gcc-4.0.2/gcc/ada/sem_cat.adb	Thu Jul 15 20:34:37 2004
--- gcc-4.1.0/gcc/ada/sem_cat.adb	Mon Sep  5 07:58:38 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Exp_Tss;  use Exp_Tss;
*** 33,38 ****
--- 33,39 ----
  with Fname;    use Fname;
  with Lib;      use Lib;
  with Nlists;   use Nlists;
+ with Opt;      use Opt;
  with Sem;      use Sem;
  with Sem_Eval; use Sem_Eval;
  with Sem_Util; use Sem_Util;
*************** package body Sem_Cat is
*** 117,125 ****
     is
        N : constant Node_Id := Info_Node;
  
        type Categorization is
!          (Pure, Shared_Passive, Remote_Types,
!            Remote_Call_Interface, Pre_Elaborated, Normal);
  
        Unit_Category : Categorization;
        With_Category : Categorization;
--- 118,134 ----
     is
        N : constant Node_Id := Info_Node;
  
+       --  Here we define an enumeration type to represent categorization
+       --  types, ordered so that a unit with a given categorization can
+       --  only WITH units with lower or equal categorization type.
+ 
        type Categorization is
!         (Pure,
!          Shared_Passive,
!          Remote_Types,
!          Remote_Call_Interface,
!          Preelaborated,
!          Normal);
  
        Unit_Category : Categorization;
        With_Category : Categorization;
*************** package body Sem_Cat is
*** 135,141 ****
        function Get_Categorization (E : Entity_Id) return Categorization is
        begin
           if Is_Preelaborated (E) then
!             return Pre_Elaborated;
           elsif Is_Pure (E) then
              return Pure;
           elsif Is_Shared_Passive (E) then
--- 144,150 ----
        function Get_Categorization (E : Entity_Id) return Categorization is
        begin
           if Is_Preelaborated (E) then
!             return Preelaborated;
           elsif Is_Pure (E) then
              return Pure;
           elsif Is_Shared_Passive (E) then
*************** package body Sem_Cat is
*** 162,184 ****
        Unit_Category := Get_Categorization (Unit_Entity);
        With_Category := Get_Categorization (Depended_Entity);
  
        if With_Category > Unit_Category then
  
           if (Unit_Category = Remote_Types
!                  or else Unit_Category = Remote_Call_Interface)
             and then In_Package_Body (Unit_Entity)
           then
              null;
  
!          elsif Is_Subunit then
!             Error_Msg_NE ("subunit cannot depend on&"
!               & " (parent has wrong categorization)", N, Depended_Entity);
           else
!             Error_Msg_NE ("current unit cannot depend on&"
!               & " (wrong categorization)", N, Depended_Entity);
           end if;
        end if;
- 
     end Check_Categorization_Dependencies;
  
     -----------------------------------
--- 171,227 ----
        Unit_Category := Get_Categorization (Unit_Entity);
        With_Category := Get_Categorization (Depended_Entity);
  
+       --  These messages are wanings in GNAT mode, to allow it to be
+       --  judiciously turned off. Otherwise it is a real error.
+ 
+       Error_Msg_Warn := GNAT_Mode;
+ 
+       --  Check for possible error
+ 
        if With_Category > Unit_Category then
  
+          --  Special case: Remote_Types and Remote_Call_Interface are allowed
+          --  to be with'ed in package body.
+ 
           if (Unit_Category = Remote_Types
!                or else Unit_Category = Remote_Call_Interface)
             and then In_Package_Body (Unit_Entity)
           then
              null;
  
!          --  Here we have an error
! 
           else
!             if Is_Subunit then
!                Error_Msg_NE
!                  ("<subunit cannot depend on& " &
!                   "(parent has wrong categorization)", N, Depended_Entity);
! 
!             else
!                Error_Msg_NE
!                  ("<cannot depend on& " &
!                   "(wrong categorization)", N, Depended_Entity);
!             end if;
! 
!             --  Add further explanation for common cases
! 
!             case Unit_Category is
!                when Pure =>
!                   Error_Msg_NE
!                     ("\<pure unit cannot depend on non-pure unit",
!                     N, Depended_Entity);
! 
!                when Preelaborated =>
!                   Error_Msg_NE
!                     ("\<preelaborated unit cannot depend on " &
!                      "non-preelaborated unit",
!                      N, Depended_Entity);
! 
!                when others =>
!                   null;
!             end case;
           end if;
        end if;
     end Check_Categorization_Dependencies;
  
     -----------------------------------
*************** package body Sem_Cat is
*** 311,317 ****
                        Nkind (Unit (Cunit (Current_Sem_Unit)));
  
     begin
!       --  There are no restrictions on the body of a Remote Types unit.
  
        return Is_Remote_Types (Unit_Entity)
          and then (Ekind (Unit_Entity) = E_Package
--- 354,360 ----
                        Nkind (Unit (Cunit (Current_Sem_Unit)));
  
     begin
!       --  There are no restrictions on the body of a Remote Types unit
  
        return Is_Remote_Types (Unit_Entity)
          and then (Ekind (Unit_Entity) = E_Package
*************** package body Sem_Cat is
*** 624,650 ****
  
     begin
        case Nkind (Def) is
           when N_Access_To_Subprogram_Definition =>
  
              --  A pure library_item must not contain the declaration of a
              --  named access type, except within a subprogram, generic
              --  subprogram, task unit, or protected unit (RM 10.2.1(16)).
  
!             if Comes_From_Source (T)
!                and then In_Pure_Unit
!                and then not In_Subprogram_Task_Protected_Unit
              then
                 Error_Msg_N ("named access type not allowed in pure unit", T);
              end if;
  
!          when N_Access_To_Object_Definition =>
  
              if Comes_From_Source (T)
                and then In_Pure_Unit
                and then not In_Subprogram_Task_Protected_Unit
              then
!                Error_Msg_N
!                  ("named access type not allowed in pure unit", T);
              end if;
  
              --  Check for RCI or RT unit type declaration. It should not
--- 667,704 ----
  
     begin
        case Nkind (Def) is
+ 
+          --  Access to subprogram case
+ 
           when N_Access_To_Subprogram_Definition =>
  
              --  A pure library_item must not contain the declaration of a
              --  named access type, except within a subprogram, generic
              --  subprogram, task unit, or protected unit (RM 10.2.1(16)).
  
!             --  This test is skipped in Ada 2005 (see AI-366)
! 
!             if Ada_Version < Ada_05
!               and then Comes_From_Source (T)
!               and then In_Pure_Unit
!               and then not In_Subprogram_Task_Protected_Unit
              then
                 Error_Msg_N ("named access type not allowed in pure unit", T);
              end if;
  
!          --  Access to object case
  
+          when N_Access_To_Object_Definition =>
              if Comes_From_Source (T)
                and then In_Pure_Unit
                and then not In_Subprogram_Task_Protected_Unit
              then
!                --  We can't give the message yet, since the type is not frozen
!                --  and in Ada 2005 mode, access types are allowed in pure units
!                --  if the type has no storage pool (see AI-366). So we set a
!                --  flag which will be checked at freeze time.
! 
!                Set_Is_Pure_Unit_Access_Type (T);
              end if;
  
              --  Check for RCI or RT unit type declaration. It should not
*************** package body Sem_Cat is
*** 661,667 ****
  
              Validate_SP_Access_Object_Type_Decl (T);
  
!          when others => null;
        end case;
  
        --  Set categorization flag from package on entity as well, to allow
--- 715,722 ----
  
              Validate_SP_Access_Object_Type_Decl (T);
  
!          when others =>
!             null;
        end case;
  
        --  Set categorization flag from package on entity as well, to allow
*************** package body Sem_Cat is
*** 752,758 ****
           return;
        end if;
  
!       --  Body of RCI unit does not need validation.
  
        if Is_Remote_Call_Interface (E)
          and then (Nkind (N) = N_Package_Body
--- 807,813 ----
           return;
        end if;
  
!       --  Body of RCI unit does not need validation
  
        if Is_Remote_Call_Interface (E)
          and then (Nkind (N) = N_Package_Body
*************** package body Sem_Cat is
*** 784,793 ****
           end loop;
        end;
  
!       --  Child depends on parent; therefore parent should also
!       --  be categorized and satify the dependency hierarchy.
  
!       --  Check if N is a child spec.
  
        if (K in N_Generic_Declaration              or else
            K in N_Generic_Instantiation            or else
--- 839,848 ----
           end loop;
        end;
  
!       --  Child depends on parent; therefore parent should also be categorized
!       --  and satify the dependency hierarchy.
  
!       --  Check if N is a child spec
  
        if (K in N_Generic_Declaration              or else
            K in N_Generic_Instantiation            or else
*************** package body Sem_Cat is
*** 800,807 ****
        then
           Check_Categorization_Dependencies (E, Scope (E), N, False);
  
!          --  Verify that public child of an RCI library unit
!          --  must also be an RCI library unit (RM E.2.3(15)).
  
           if Is_Remote_Call_Interface (Scope (E))
             and then not Private_Present (P)
--- 855,862 ----
        then
           Check_Categorization_Dependencies (E, Scope (E), N, False);
  
!          --  Verify that public child of an RCI library unit must also be an
!          --  RCI library unit (RM E.2.3(15)).
  
           if Is_Remote_Call_Interface (Scope (E))
             and then not Private_Present (P)
*************** package body Sem_Cat is
*** 860,867 ****
              if Nkind (Item) /= N_Label
                and then Nkind (Item) /= N_Null_Statement
              then
                 Error_Msg_N
!                  ("statements not allowed in preelaborated unit", Item);
                 exit;
              end if;
  
--- 915,927 ----
              if Nkind (Item) /= N_Label
                and then Nkind (Item) /= N_Null_Statement
              then
+                --  In GNAT mode, this is a warning, allowing the run-time
+                --  to judiciously bypass this error condition.
+ 
+                Error_Msg_Warn := GNAT_Mode;
                 Error_Msg_N
!                  ("<statements not allowed in preelaborated unit", Item);
! 
                 exit;
              end if;
  
*************** package body Sem_Cat is
*** 1175,1181 ****
                    Error_Node := Param_Spec;
                 end if;
  
!                --  Report error only if declaration is in source program.
  
                 if Comes_From_Source
                   (Defining_Entity (Specification (N)))
--- 1235,1241 ----
                    Error_Node := Param_Spec;
                 end if;
  
!                --  Report error only if declaration is in source program
  
                 if Comes_From_Source
                   (Defining_Entity (Specification (N)))
*************** package body Sem_Cat is
*** 1312,1318 ****
           --  Profile must exist, otherwise not primitive operation
  
           Param_Spec := First (Profile);
- 
           while Present (Param_Spec) loop
  
              --  Now find out if this parameter is a controlling parameter
--- 1372,1377 ----
*************** package body Sem_Cat is
*** 1378,1384 ****
        --  entity is inside an RCI unit.
  
        Set_Is_Remote_Call_Interface (T);
- 
     end Validate_Remote_Access_Object_Type_Declaration;
  
     -----------------------------------------------
--- 1437,1442 ----
*************** package body Sem_Cat is
*** 1391,1410 ****
        E  : Entity_Id;
  
     begin
!       --  This subprogram enforces the checks in (RM E.2.2(8)) for
!       --  certain uses of class-wide limited private types.
  
        --    Storage_Pool and Storage_Size are not defined for such types
        --
        --    The expected type of allocator must not not be such a type.
  
!       --    The actual parameter of generic instantiation must not
!       --    be such a type if the formal parameter is of an access type.
  
        --  On entry, there are five cases
  
!       --    1. called from sem_attr Analyze_Attribute where attribute
!       --       name is either Storage_Pool or Storage_Size.
  
        --    2. called from exp_ch4 Expand_N_Allocator
  
--- 1449,1468 ----
        E  : Entity_Id;
  
     begin
!       --  This subprogram enforces the checks in (RM E.2.2(8)) for certain uses
!       --  of class-wide limited private types.
  
        --    Storage_Pool and Storage_Size are not defined for such types
        --
        --    The expected type of allocator must not not be such a type.
  
!       --    The actual parameter of generic instantiation must not be such a
!       --    type if the formal parameter is of an access type.
  
        --  On entry, there are five cases
  
!       --    1. called from sem_attr Analyze_Attribute where attribute name is
!       --       either Storage_Pool or Storage_Size.
  
        --    2. called from exp_ch4 Expand_N_Allocator
  
*************** package body Sem_Cat is
*** 1438,1446 ****
              return;
           end if;
  
!       --  This subprogram also enforces the checks in E.2.2(13).
!       --  A value of such type must not be dereferenced unless as a
!       --  controlling operand of a dispatching call.
  
        elsif K = N_Explicit_Dereference
          and then (Comes_From_Source (N)
--- 1496,1504 ----
              return;
           end if;
  
!       --  This subprogram also enforces the checks in E.2.2(13). A value of
!       --  such type must not be dereferenced unless as controlling operand of a
!       --  dispatching call.
  
        elsif K = N_Explicit_Dereference
          and then (Comes_From_Source (N)
*************** package body Sem_Cat is
*** 1467,1474 ****
           end if;
  
           --  If we are just within a procedure or function call and the
!          --  dereference has not been analyzed, return because this
!          --  procedure will be called again from sem_res Resolve_Actuals.
  
           if Is_Actual_Parameter (N)
             and then not Analyzed (N)
--- 1525,1532 ----
           end if;
  
           --  If we are just within a procedure or function call and the
!          --  dereference has not been analyzed, return because this procedure
!          --  will be called again from sem_res Resolve_Actuals.
  
           if Is_Actual_Parameter (N)
             and then not Analyzed (N)
*************** package body Sem_Cat is
*** 1476,1484 ****
              return;
           end if;
  
!          --  The following is to let the compiler generated tags check
!          --  pass through without error message. This is a bit kludgy
!          --  isn't there some better way of making this exclusion ???
  
           if (PK = N_Selected_Component
                and then Present (Parent (Parent (N)))
--- 1534,1542 ----
              return;
           end if;
  
!          --  The following is to let the compiler generated tags check pass
!          --  through without error message. This is a bit kludgy isn't there
!          --  some better way of making this exclusion ???
  
           if (PK = N_Selected_Component
                and then Present (Parent (Parent (N)))
*************** package body Sem_Cat is
*** 1522,1541 ****
        E : constant Entity_Id := Etype (Expression (N));
  
     begin
!       --  This test is required in the case where a conversion appears
!       --  inside a normal package, it does not necessarily have to be
!       --  inside an RCI, Remote_Types unit (RM E.2.2(9,12)).
  
        if Is_Remote_Access_To_Subprogram_Type (E)
          and then not Is_Remote_Access_To_Subprogram_Type (S)
        then
!          Error_Msg_N ("incorrect conversion of remote operand", N);
           return;
  
        elsif Is_Remote_Access_To_Class_Wide_Type (E)
          and then not Is_Remote_Access_To_Class_Wide_Type (S)
        then
!          Error_Msg_N ("incorrect conversion of remote operand", N);
           return;
        end if;
  
--- 1580,1608 ----
        E : constant Entity_Id := Etype (Expression (N));
  
     begin
!       --  This test is required in the case where a conversion appears inside a
!       --  normal package, it does not necessarily have to be inside an RCI,
!       --  Remote_Types unit (RM E.2.2(9,12)).
  
        if Is_Remote_Access_To_Subprogram_Type (E)
          and then not Is_Remote_Access_To_Subprogram_Type (S)
        then
!          Error_Msg_N
!            ("incorrect conversion of remote operand to local type", N);
!          return;
! 
!       elsif not Is_Remote_Access_To_Subprogram_Type (E)
!         and then Is_Remote_Access_To_Subprogram_Type (S)
!       then
!          Error_Msg_N
!            ("incorrect conversion of local operand to remote type", N);
           return;
  
        elsif Is_Remote_Access_To_Class_Wide_Type (E)
          and then not Is_Remote_Access_To_Class_Wide_Type (S)
        then
!          Error_Msg_N
!            ("incorrect conversion of remote operand to local type", N);
           return;
        end if;
  
*************** package body Sem_Cat is
*** 1607,1612 ****
--- 1674,1683 ----
        --  Return true if the protected type designated by T has
        --  entry declarations.
  
+       ----------------------------
+       -- Has_Entry_Declarations --
+       ----------------------------
+ 
        function Has_Entry_Declarations (E : Entity_Id) return Boolean is
           Ety : Entity_Id;
  
*************** package body Sem_Cat is
*** 1671,1684 ****
        E : Entity_Id;
  
        function Is_Primary (N : Node_Id) return Boolean;
!       --  Determine whether node is syntactically a primary in an expression.
  
        function Is_Primary (N : Node_Id) return Boolean is
           K : constant Node_Kind := Nkind (Parent (N));
  
        begin
           case K is
- 
              when N_Op | N_In | N_Not_In =>
                 return True;
  
--- 1742,1758 ----
        E : Entity_Id;
  
        function Is_Primary (N : Node_Id) return Boolean;
!       --  Determine whether node is syntactically a primary in an expression
! 
!       ----------------
!       -- Is_Primary --
!       ----------------
  
        function Is_Primary (N : Node_Id) return Boolean is
           K : constant Node_Kind := Nkind (Parent (N));
  
        begin
           case K is
              when N_Op | N_In | N_Not_In =>
                 return True;
  
*************** package body Sem_Cat is
*** 1722,1732 ****
        then
           return;
  
!       --  Filter out cases where primary is default in a component
!       --  declaration, discriminant specification, or actual in a record
!       --  type initialization call.
  
!       --  Initialization call of internal types.
  
        elsif Nkind (Parent (N)) = N_Procedure_Call_Statement then
  
--- 1796,1806 ----
        then
           return;
  
!       --  Filter out cases where primary is default in a component declaration,
!       --  discriminant specification, or actual in a record type initialization
!       --  call.
  
!       --  Initialization call of internal types
  
        elsif Nkind (Parent (N)) = N_Procedure_Call_Statement then
  
*************** package body Sem_Cat is
*** 1759,1765 ****
           --  We take the view that a constant defined in another preelaborated
           --  unit is preelaborable, even though it may have a private type and
           --  thus appear non-static in a client. This must be the intent of
!          --  the language, but currently is an RM gap.
  
           elsif Ekind (Entity (N)) = E_Constant
             and then not Is_Static_Expression (N)
--- 1833,1839 ----
           --  We take the view that a constant defined in another preelaborated
           --  unit is preelaborable, even though it may have a private type and
           --  thus appear non-static in a client. This must be the intent of
!          --  the language, but currently is an RM gap ???
  
           elsif Ekind (Entity (N)) = E_Constant
             and then not Is_Static_Expression (N)
*************** package body Sem_Cat is
*** 1782,1790 ****
                                                  (Renamed_Object (E))))))
              then
                 null;
              else
!                Flag_Non_Static_Expr
!                  ("non-static constant in preelaborated unit", N);
              end if;
           end if;
        end if;
--- 1856,1876 ----
                                                  (Renamed_Object (E))))))
              then
                 null;
+ 
+             --  This is the error case
+ 
              else
!                --  In GNAT mode, this is just a warning, to allow it to be
!                --  judiciously turned off. Otherwise it is a real error.
! 
!                if GNAT_Mode then
!                   Error_Msg_N
!                     ("?non-static constant in preelaborated unit", N);
!                else
!                   Flag_Non_Static_Expr
!                     ("non-static constant in preelaborated unit", N);
!                end if;
! 
              end if;
           end if;
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_cat.ads gcc-4.1.0/gcc/ada/sem_cat.ads
*** gcc-4.0.2/gcc/ada/sem_cat.ads	Tue Oct 21 13:42:19 2003
--- gcc-4.1.0/gcc/ada/sem_cat.ads	Tue Nov 15 14:05:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Cat is
*** 96,102 ****
     --  the checks cannot be made before knowing if the object is imported.
  
     procedure Validate_RCI_Declarations (P : Entity_Id);
!    --  Apply semantic checks given in  E2.3(10-14).
  
     procedure Validate_RCI_Subprogram_Declaration (N : Node_Id);
     --  Check for RCI unit subprogram declarations with respect to
--- 96,102 ----
     --  the checks cannot be made before knowing if the object is imported.
  
     procedure Validate_RCI_Declarations (P : Entity_Id);
!    --  Apply semantic checks given in  E2.3(10-14)
  
     procedure Validate_RCI_Subprogram_Declaration (N : Node_Id);
     --  Check for RCI unit subprogram declarations with respect to
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch10.adb gcc-4.1.0/gcc/ada/sem_ch10.adb
*** gcc-4.0.2/gcc/ada/sem_ch10.adb	Thu Feb 10 13:50:14 2005
--- gcc-4.1.0/gcc/ada/sem_ch10.adb	Tue Nov 15 14:02:01 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch10 is
*** 95,109 ****
     --  Verify that a stub is declared immediately within a compilation unit,
     --  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
!    --  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 Ada 2005 (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
     --  parents are made explicit, and with clauses are inserted in the context
     --  clause before the one for the child. If a parent in the with_clause
--- 95,101 ----
     --  Verify that a stub is declared immediately within a compilation unit,
     --  and not in an inner frame.
  
!    procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id);
     --  When a child unit appears in a context clause, the implicit withs on
     --  parents are made explicit, and with clauses are inserted in the context
     --  clause before the one for the child. If a parent in the with_clause
*************** package body Sem_Ch10 is
*** 123,131 ****
     --  If the main unit is a child unit, implicit withs are also added for
     --  all its ancestors.
  
     procedure Install_Context_Clauses (N : Node_Id);
!    --  Subsidiary to previous one. Process only with_ and use_clauses for
!    --  current unit and its library unit if any.
  
     procedure Install_Limited_Context_Clauses (N : Node_Id);
     --  Subsidiary to Install_Context. Process only limited with_clauses
--- 115,127 ----
     --  If the main unit is a child unit, implicit withs are also added for
     --  all its ancestors.
  
+    function In_Chain (E : Entity_Id) return Boolean;
+    --  Check that the shadow entity is not already in the homonym chain, for
+    --  example through a limited_with clause in a parent unit.
+ 
     procedure Install_Context_Clauses (N : Node_Id);
!    --  Subsidiary to Install_Context and Install_Parents. Process only with_
!    --  and use_clauses for current unit and its library unit if any.
  
     procedure Install_Limited_Context_Clauses (N : Node_Id);
     --  Subsidiary to Install_Context. Process only limited with_clauses
*************** package body Sem_Ch10 is
*** 138,144 ****
     procedure Install_Withed_Unit
       (With_Clause     : Node_Id;
        Private_With_OK : Boolean := False);
- 
     --  If the unit is not a child unit, make unit immediately visible.
     --  The caller ensures that the unit is not already currently installed.
     --  The flag Private_With_OK is set true in Install_Private_With_Clauses,
--- 134,139 ----
*************** package body Sem_Ch10 is
*** 803,816 ****
     ---------------------
  
     procedure Analyze_Context (N : Node_Id) is
        Item  : Node_Id;
  
     begin
!       --  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 (Ada 2005: AI-50217)
!       --  c) The third pass analyzes limited_with clauses (Ada 2005: AI-50217)
  
        Item := First (Context_Items (N));
        while Present (Item) loop
--- 798,810 ----
     ---------------------
  
     procedure Analyze_Context (N : Node_Id) is
+       Ukind : constant Node_Kind := Nkind (Unit (N));
        Item  : Node_Id;
  
     begin
!       --  Loop through context items. This is done in two:
!       --  a) The first  pass analyzes non-limited with-clauses
!       --  b) The second pass analyzes limited_with clauses (Ada 2005: AI-50217)
  
        Item := First (Context_Items (N));
        while Present (Item) loop
*************** package body Sem_Ch10 is
*** 821,827 ****
           if Nkind (Item) = N_With_Clause
             and then not Limited_Present (Item)
           then
- 
              --  Skip analyzing with clause if no unit, nothing to do (this
              --  happens for a with that references a non-existant unit)
  
--- 815,820 ----
*************** package body Sem_Ch10 is
*** 847,881 ****
           Next (Item);
        end loop;
  
!       --  Second pass: add implicit limited_with_clauses for parents of
!       --  child units mentioned in limited_with clauses.
  
        Item := First (Context_Items (N));
- 
        while Present (Item) loop
           if Nkind (Item) = N_With_Clause
             and then Limited_Present (Item)
-            and then  Nkind (Name (Item)) = N_Selected_Component
           then
!             Expand_Limited_With_Clause
!               (Nam => Prefix (Name (Item)), N  => Item);
!          end if;
  
!          Next (Item);
!       end loop;
  
!       --  Third pass: examine all limited_with clauses
  
!       Item := First (Context_Items (N));
  
!       while Present (Item) loop
!          if Nkind (Item) = N_With_Clause
!            and then Limited_Present (Item)
!          then
  
!             if Nkind (Unit (N)) /= N_Package_Declaration then
!                Error_Msg_N ("limited with_clause only allowed in"
!                             & " package specification", Item);
              end if;
  
              --  Skip analyzing with clause if no unit, see above
--- 840,969 ----
           Next (Item);
        end loop;
  
!       --  Second pass: examine all limited_with clauses
  
        Item := First (Context_Items (N));
        while Present (Item) loop
           if Nkind (Item) = N_With_Clause
             and then Limited_Present (Item)
           then
!             --  No need to check errors on implicitly generated limited-with
!             --  clauses.
  
!             if not Implicit_With (Item) then
  
!                --  Check compilation unit containing the limited-with clause
  
!                if Ukind /= N_Package_Declaration
!                  and then Ukind /= N_Subprogram_Declaration
!                  and then Ukind /= N_Package_Renaming_Declaration
!                  and then Ukind /= N_Subprogram_Renaming_Declaration
!                  and then Ukind not in N_Generic_Declaration
!                  and then Ukind not in N_Generic_Renaming_Declaration
!                  and then Ukind not in N_Generic_Instantiation
!                then
!                   Error_Msg_N ("limited with_clause not allowed here", Item);
  
!                --  Check wrong use of a limited with clause applied to the
!                --  compilation unit containing the limited-with clause.
  
!                --      limited with P.Q;
!                --      package P.Q is ...
! 
!                elsif Unit (Library_Unit (Item)) = Unit (N) then
!                   Error_Msg_N ("wrong use of limited-with clause", Item);
! 
!                --  Check wrong use of limited-with clause applied to some
!                --  immediate ancestor.
! 
!                elsif Is_Child_Spec (Unit (N)) then
!                   declare
!                      Lib_U : constant Entity_Id := Unit (Library_Unit (Item));
!                      P     : Node_Id;
! 
!                   begin
!                      P := Parent_Spec (Unit (N));
!                      loop
!                         if Unit (P) = Lib_U then
!                            Error_Msg_N ("limited with_clause of immediate "
!                                         & "ancestor not allowed", Item);
!                            exit;
!                         end if;
! 
!                         exit when not Is_Child_Spec (Unit (P));
!                         P := Parent_Spec (Unit (P));
!                      end loop;
!                   end;
!                end if;
! 
!                --  Check if the limited-withed unit is already visible through
!                --  some context clause of the current compilation unit or some
!                --  ancestor of the current compilation unit.
! 
!                declare
!                   Lim_Unit_Name : constant Node_Id := Name (Item);
!                   Comp_Unit     : Node_Id;
!                   It            : Node_Id;
!                   Unit_Name     : Node_Id;
! 
!                begin
!                   Comp_Unit := N;
!                   loop
!                      It := First (Context_Items (Comp_Unit));
!                      while Present (It) loop
!                         if Item /= It
!                           and then Nkind (It) = N_With_Clause
!                           and then not Limited_Present (It)
!                           and then
!                              (Nkind (Unit (Library_Unit (It)))
!                                = N_Package_Declaration
!                             or else
!                               Nkind (Unit (Library_Unit (It)))
!                                = N_Package_Renaming_Declaration)
!                         then
!                            if Nkind (Unit (Library_Unit (It)))
!                                 = N_Package_Declaration
!                            then
!                               Unit_Name := Name (It);
!                            else
!                               Unit_Name := Name (Unit (Library_Unit (It)));
!                            end if;
! 
!                            --  Check if the named package (or some ancestor)
!                            --  leaves visible the full-view of the unit given
!                            --  in the limited-with clause
! 
!                            loop
!                               if Designate_Same_Unit (Lim_Unit_Name,
!                                                       Unit_Name)
!                               then
!                                  Error_Msg_Sloc := Sloc (It);
!                                  Error_Msg_NE
!                                    ("unlimited view visible through the"
!                                     & " context clause found #",
!                                     Item, It);
!                                  Error_Msg_N
!                                    ("simultaneous visibility of the limited"
!                                     & " and unlimited views not allowed"
!                                     , Item);
!                                  exit;
! 
!                               elsif Nkind (Unit_Name) = N_Identifier then
!                                  exit;
!                               end if;
! 
!                               Unit_Name := Prefix (Unit_Name);
!                            end loop;
!                         end if;
! 
!                         Next (It);
!                      end loop;
! 
!                      exit when not Is_Child_Spec (Unit (Comp_Unit));
! 
!                      Comp_Unit := Parent_Spec (Unit (Comp_Unit));
!                   end loop;
!                end;
              end if;
  
              --  Skip analyzing with clause if no unit, see above
*************** package body Sem_Ch10 is
*** 910,916 ****
        Check_Stub_Level (N);
        Nam := Current_Entity_In_Scope (Id);
  
!       if No (Nam) or else not Is_Package (Nam) then
           Error_Msg_N ("missing specification for package stub", N);
  
        elsif Has_Completion (Nam)
--- 998,1004 ----
        Check_Stub_Level (N);
        Nam := Current_Entity_In_Scope (Id);
  
!       if No (Nam) or else not Is_Package_Or_Generic_Package (Nam) then
           Error_Msg_N ("missing specification for package stub", N);
  
        elsif Has_Completion (Nam)
*************** package body Sem_Ch10 is
*** 1241,1247 ****
          or else Nkind (Parent (N)) = N_Subprogram_Body
        then
           Decl := First (Declarations (Parent (N)));
- 
           while Present (Decl)
             and then Decl /= N
           loop
--- 1329,1334 ----
*************** package body Sem_Ch10 is
*** 1329,1357 ****
  
        begin
           Analyze_Context (N);
-          Item := First (Context_Items (N));
  
!          --  make withed units immediately visible. If child unit, make the
           --  ultimate parent immediately visible.
  
           while Present (Item) loop
- 
              if Nkind (Item) = N_With_Clause then
-                Unit_Name := Entity (Name (Item));
  
!                while Is_Child_Unit (Unit_Name) loop
!                   Set_Is_Visible_Child_Unit (Unit_Name);
!                   Unit_Name := Scope (Unit_Name);
!                end loop;
  
!                if not Is_Immediately_Visible (Unit_Name) then
!                   Set_Is_Immediately_Visible (Unit_Name);
!                   Set_Context_Installed (Item);
                 end if;
  
              elsif Nkind (Item) = N_Use_Package_Clause then
                 Nam := First (Names (Item));
- 
                 while Present (Nam) loop
                    Analyze (Nam);
                    Next (Nam);
--- 1416,1446 ----
  
        begin
           Analyze_Context (N);
  
!          --  Make withed units immediately visible. If child unit, make the
           --  ultimate parent immediately visible.
  
+          Item := First (Context_Items (N));
           while Present (Item) loop
              if Nkind (Item) = N_With_Clause then
  
!                --  Protect frontend against previous errors in context clauses
  
!                if Nkind (Name (Item)) /= N_Selected_Component then
!                   Unit_Name := Entity (Name (Item));
!                   while Is_Child_Unit (Unit_Name) loop
!                      Set_Is_Visible_Child_Unit (Unit_Name);
!                      Unit_Name := Scope (Unit_Name);
!                   end loop;
! 
!                   if not Is_Immediately_Visible (Unit_Name) then
!                      Set_Is_Immediately_Visible (Unit_Name);
!                      Set_Context_Installed (Item);
!                   end if;
                 end if;
  
              elsif Nkind (Item) = N_Use_Package_Clause then
                 Nam := First (Names (Item));
                 while Present (Nam) loop
                    Analyze (Nam);
                    Next (Nam);
*************** package body Sem_Ch10 is
*** 1359,1365 ****
  
              elsif Nkind (Item) = N_Use_Type_Clause then
                 Nam := First (Subtype_Marks (Item));
- 
                 while Present (Nam) loop
                    Analyze (Nam);
                    Next (Nam);
--- 1448,1453 ----
*************** package body Sem_Ch10 is
*** 1369,1384 ****
              Next (Item);
           end loop;
  
!          Item := First (Context_Items (N));
! 
!          --  reset visibility of withed units. They will be made visible
           --  again when we install the subunit context.
  
           while Present (Item) loop
  
!             if Nkind (Item) = N_With_Clause then
!                Unit_Name := Entity (Name (Item));
  
                 while Is_Child_Unit (Unit_Name) loop
                    Set_Is_Visible_Child_Unit (Unit_Name, False);
                    Unit_Name := Scope (Unit_Name);
--- 1457,1474 ----
              Next (Item);
           end loop;
  
!          --  Reset visibility of withed units. They will be made visible
           --  again when we install the subunit context.
  
+          Item := First (Context_Items (N));
           while Present (Item) loop
+             if Nkind (Item) = N_With_Clause
  
!                --  Protect frontend against previous errors in context clauses
  
+               and then Nkind (Name (Item)) /= N_Selected_Component
+             then
+                Unit_Name := Entity (Name (Item));
                 while Is_Child_Unit (Unit_Name) loop
                    Set_Is_Visible_Child_Unit (Unit_Name, False);
                    Unit_Name := Scope (Unit_Name);
*************** package body Sem_Ch10 is
*** 1392,1398 ****
  
              Next (Item);
           end loop;
- 
        end Analyze_Subunit_Context;
  
        ------------------------
--- 1482,1487 ----
*************** package body Sem_Ch10 is
*** 1422,1431 ****
              Set_Is_Immediately_Visible (Scop);
           end if;
  
!          E := First_Entity (Current_Scope);
  
           while Present (E) loop
!             Set_Is_Immediately_Visible (E);
              Next_Entity (E);
           end loop;
  
--- 1511,1527 ----
              Set_Is_Immediately_Visible (Scop);
           end if;
  
!          --  Make entities in scope visible again. For child units, restore
!          --  visibility only if they are actually in context.
  
+          E := First_Entity (Current_Scope);
           while Present (E) loop
!             if not Is_Child_Unit (E)
!               or else Is_Visible_Child_Unit (E)
!             then
!                Set_Is_Immediately_Visible (E);
!             end if;
! 
              Next_Entity (E);
           end loop;
  
*************** package body Sem_Ch10 is
*** 1445,1451 ****
  
        procedure Re_Install_Use_Clauses is
           U  : Node_Id;
- 
        begin
           for J in reverse 1 .. Num_Scopes loop
              U := Use_Clauses (J);
--- 1541,1546 ----
*************** package body Sem_Ch10 is
*** 1464,1472 ****
        begin
           Num_Scopes := Num_Scopes + 1;
           Use_Clauses (Num_Scopes) :=
!                Scope_Stack.Table (Scope_Stack.Last).First_Use_Clause;
!          E := First_Entity (Current_Scope);
  
           while Present (E) loop
              Set_Is_Immediately_Visible (E, False);
              Next_Entity (E);
--- 1559,1567 ----
        begin
           Num_Scopes := Num_Scopes + 1;
           Use_Clauses (Num_Scopes) :=
!            Scope_Stack.Table (Scope_Stack.Last).First_Use_Clause;
  
+          E := First_Entity (Current_Scope);
           while Present (E) loop
              Set_Is_Immediately_Visible (E, False);
              Next_Entity (E);
*************** package body Sem_Ch10 is
*** 1634,1639 ****
--- 1729,1735 ----
  
     begin
        if Limited_Present (N) then
+ 
           --  Ada 2005 (AI-50217): Build visibility structures but do not
           --  analyze unit
  
*************** package body Sem_Ch10 is
*** 1708,1714 ****
                       "and version-dependent?",
                       Name (N));
  
!                elsif U_Kind = Ada_05_Unit and then Ada_Version = Ada_95 then
                    Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
                 end if;
              end;
--- 1804,1813 ----
                       "and version-dependent?",
                       Name (N));
  
!                elsif U_Kind = Ada_05_Unit
!                  and then Ada_Version < Ada_05
!                  and then Warn_On_Ada_2005_Compatibility
!                then
                    Error_Msg_N ("& is an Ada 2005 unit?", Name (N));
                 end if;
              end;
*************** package body Sem_Ch10 is
*** 1744,1758 ****
  
           E_Name := Defining_Entity (Specification (Instance_Spec (U)));
  
!       elsif Unit_Kind = N_Procedure_Instantiation
!         or else Unit_Kind = N_Function_Instantiation
!       then
           --  Instantiation node is replaced with a package that contains
           --  renaming declarations and instance itself. The subprogram
           --  Instance is declared in the visible part of the wrapper package.
  
           E_Name := First_Entity (Defining_Entity (U));
- 
           while Present (E_Name) loop
              exit when Is_Subprogram (E_Name)
                and then Is_Generic_Instance (E_Name);
--- 1843,1855 ----
  
           E_Name := Defining_Entity (Specification (Instance_Spec (U)));
  
!       elsif Unit_Kind in N_Subprogram_Instantiation then
! 
           --  Instantiation node is replaced with a package that contains
           --  renaming declarations and instance itself. The subprogram
           --  Instance is declared in the visible part of the wrapper package.
  
           E_Name := First_Entity (Defining_Entity (U));
           while Present (E_Name) loop
              exit when Is_Subprogram (E_Name)
                and then Is_Generic_Instance (E_Name);
*************** package body Sem_Ch10 is
*** 1789,1797 ****
        Style_Check := Save_Style_Check;
        Cunit_Boolean_Restrictions_Restore (Save_C_Restrict);
  
!       --  Record the reference, but do NOT set the unit as referenced, we
!       --  want to consider the unit as unreferenced if this is the only
!       --  reference that occurs.
  
        Set_Entity_With_Style_Check (Name (N), E_Name);
        Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False);
--- 1886,1894 ----
        Style_Check := Save_Style_Check;
        Cunit_Boolean_Restrictions_Restore (Save_C_Restrict);
  
!       --  Record the reference, but do NOT set the unit as referenced, we want
!       --  to consider the unit as unreferenced if this is the only reference
!       --  that occurs.
  
        Set_Entity_With_Style_Check (Name (N), E_Name);
        Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False);
*************** package body Sem_Ch10 is
*** 1799,1805 ****
        if Is_Child_Unit (E_Name) then
           Pref     := Prefix (Name (N));
           Par_Name := Scope (E_Name);
- 
           while Nkind (Pref) = N_Selected_Component loop
              Change_Selected_Component_To_Expanded_Name (Pref);
              Set_Entity_With_Style_Check (Pref, Par_Name);
--- 1896,1901 ----
*************** package body Sem_Ch10 is
*** 1807,1815 ****
              Generate_Reference (Par_Name, Pref);
              Pref := Prefix (Pref);
  
!             --  If E_Name is the dummy entity for a nonexistent unit,
!             --  its scope is set to Standard_Standard, and no attempt
!             --  should be made to further unwind scopes.
  
              if Par_Name /= Standard_Standard then
                 Par_Name := Scope (Par_Name);
--- 1903,1911 ----
              Generate_Reference (Par_Name, Pref);
              Pref := Prefix (Pref);
  
!             --  If E_Name is the dummy entity for a nonexistent unit, its scope
!             --  is set to Standard_Standard, and no attempt should be made to
!             --  further unwind scopes.
  
              if Par_Name /= Standard_Standard then
                 Par_Name := Scope (Par_Name);
*************** package body Sem_Ch10 is
*** 1819,1830 ****
           if Present (Entity (Pref))
             and then not Analyzed (Parent (Parent (Entity (Pref))))
           then
!             --  If the entity is set without its unit being compiled,
!             --  the original parent is a renaming, and Par_Name is the
!             --  renamed entity. For visibility purposes, we need the
!             --  original entity, which must be analyzed now, because
!             --  Load_Unit retrieves directly the renamed unit, and the
!             --  renaming declaration itself has not been analyzed.
  
              Analyze (Parent (Parent (Entity (Pref))));
              pragma Assert (Renamed_Object (Entity (Pref)) = Par_Name);
--- 1915,1926 ----
           if Present (Entity (Pref))
             and then not Analyzed (Parent (Parent (Entity (Pref))))
           then
!             --  If the entity is set without its unit being compiled, the
!             --  original parent is a renaming, and Par_Name is the renamed
!             --  entity. For visibility purposes, we need the original entity,
!             --  which must be analyzed now because Load_Unit directly retrieves
!             --  the renamed unit, and the renaming declaration itself has not
!             --  been analyzed.
  
              Analyze (Parent (Parent (Entity (Pref))));
              pragma Assert (Renamed_Object (Entity (Pref)) = Par_Name);
*************** package body Sem_Ch10 is
*** 1836,1843 ****
        end if;
  
        --  If the withed unit is System, and a system extension pragma is
!       --  present, compile the extension now, rather than waiting for
!       --  a visibility check on a specific entity.
  
        if Chars (E_Name) = Name_System
          and then Scope (E_Name) = Standard_Standard
--- 1932,1939 ----
        end if;
  
        --  If the withed unit is System, and a system extension pragma is
!       --  present, compile the extension now, rather than waiting for a
!       --  visibility check on a specific entity.
  
        if Chars (E_Name) = Name_System
          and then Scope (E_Name) = Standard_Standard
*************** package body Sem_Ch10 is
*** 1856,1861 ****
--- 1952,1964 ----
        if Private_Present (N) then
           Set_Is_Immediately_Visible (E_Name, False);
        end if;
+ 
+       --  Check for with'ing obsolescent package. Exclude subprograms here
+       --  since we will catch those on the call rather than the WITH.
+ 
+       if Is_Package_Or_Generic_Package (E_Name) then
+          Check_Obsolescent (E_Name, N);
+       end if;
     end Analyze_With_Clause;
  
     ------------------------------
*************** package body Sem_Ch10 is
*** 1923,1933 ****
        --------------
  
        function In_Chain (E : Entity_Id) return Boolean is
!          H : Entity_Id := Current_Entity (E);
  
        begin
           while Present (H) loop
- 
              if H = E then
                 return True;
              else
--- 2026,2036 ----
        --------------
  
        function In_Chain (E : Entity_Id) return Boolean is
!          H : Entity_Id;
  
        begin
+          H := Current_Entity (E);
           while Present (H) loop
              if H = E then
                 return True;
              else
*************** package body Sem_Ch10 is
*** 2066,2074 ****
  
           Decl :=
             First (Visible_Declarations (Specification (Unit (Cunit (Unum)))));
- 
           while Present (Decl) loop
- 
              if Nkind (Decl) = N_Full_Type_Declaration
                and then Chars (Defining_Identifier (Decl)) = Chars (Sel)
              then
--- 2169,2175 ----
*************** package body Sem_Ch10 is
*** 2180,2186 ****
                  From_With_Type (Scope (Entity (Selector_Name (Name (Item)))))
              then
                 Error_Msg_Sloc := Sloc (Item);
!                Error_Msg_N ("Missing With_Clause for With_Type_Clause#", N);
              end if;
  
              Next (Item);
--- 2281,2287 ----
                  From_With_Type (Scope (Entity (Selector_Name (Name (Item)))))
              then
                 Error_Msg_Sloc := Sloc (Item);
!                Error_Msg_N ("missing With_Clause for With_Type_Clause#", N);
              end if;
  
              Next (Item);
*************** package body Sem_Ch10 is
*** 2365,2373 ****
             or else Kind = N_Subprogram_Body
             or else Kind = N_Task_Body
             or else Kind = N_Protected_Body)
- 
          and then (Nkind (Parent (Par)) = N_Compilation_Unit
!                    or else Nkind (Parent (Par)) = N_Subunit)
        then
           null;
  
--- 2466,2473 ----
             or else Kind = N_Subprogram_Body
             or else Kind = N_Task_Body
             or else Kind = N_Protected_Body)
          and then (Nkind (Parent (Par)) = N_Compilation_Unit
!                     or else Nkind (Parent (Par)) = N_Subunit)
        then
           null;
  
*************** package body Sem_Ch10 is
*** 2386,2398 ****
     -- Expand_With_Clause --
     ------------------------
  
!    procedure Expand_With_Clause (Nam : Node_Id; N : Node_Id) is
        Loc   : constant Source_Ptr := Sloc (Nam);
        Ent   : constant Entity_Id := Entity (Nam);
        Withn : Node_Id;
        P     : Node_Id;
  
        function Build_Unit_Name (Nam : Node_Id) return Node_Id;
  
        function Build_Unit_Name (Nam : Node_Id) return Node_Id is
           Result : Node_Id;
--- 2486,2503 ----
     -- Expand_With_Clause --
     ------------------------
  
!    procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id) is
        Loc   : constant Source_Ptr := Sloc (Nam);
        Ent   : constant Entity_Id := Entity (Nam);
        Withn : Node_Id;
        P     : Node_Id;
  
        function Build_Unit_Name (Nam : Node_Id) return Node_Id;
+       --  Comment requireed here ???
+ 
+       ---------------------
+       -- Build_Unit_Name --
+       ---------------------
  
        function Build_Unit_Name (Nam : Node_Id) return Node_Id is
           Result : Node_Id;
*************** package body Sem_Ch10 is
*** 2412,2417 ****
--- 2517,2524 ----
           end if;
        end Build_Unit_Name;
  
+    --  Start of processing for Expand_With_Clause
+ 
     begin
        New_Nodes_OK := New_Nodes_OK + 1;
        Withn :=
*************** package body Sem_Ch10 is
*** 2423,2512 ****
        Set_First_Name            (Withn, True);
        Set_Implicit_With         (Withn, True);
  
        Prepend (Withn, Context_Items (N));
        Mark_Rewrite_Insertion (Withn);
        Install_Withed_Unit (Withn);
  
        if Nkind (Nam) = N_Expanded_Name then
!          Expand_With_Clause (Prefix (Nam), N);
        end if;
  
        New_Nodes_OK := New_Nodes_OK - 1;
     end Expand_With_Clause;
  
-    --------------------------------
-    -- Expand_Limited_With_Clause --
-    --------------------------------
- 
-    procedure Expand_Limited_With_Clause (Nam : Node_Id; N : Node_Id) is
-       Loc   : constant Source_Ptr := Sloc (Nam);
-       Unum  : Unit_Number_Type;
-       Withn : Node_Id;
- 
-    begin
-       New_Nodes_OK := New_Nodes_OK + 1;
- 
-       if Nkind (Nam) = N_Identifier then
-          Withn :=
-            Make_With_Clause (Loc, Name => Nam);
-          Set_Limited_Present (Withn);
-          Set_First_Name      (Withn);
-          Set_Implicit_With   (Withn);
- 
-          --  Load the corresponding parent unit
- 
-          Unum :=
-            Load_Unit
-            (Load_Name  => Get_Spec_Name (Get_Unit_Name (Nam)),
-             Required   => True,
-             Subunit    => False,
-             Error_Node => Nam);
- 
-          if not Analyzed (Cunit (Unum)) then
-             Set_Library_Unit (Withn, Cunit (Unum));
-             Set_Corresponding_Spec
-               (Withn, Specification (Unit (Cunit (Unum))));
- 
-             Prepend (Withn, Context_Items (Parent (N)));
-             Mark_Rewrite_Insertion (Withn);
-          end if;
- 
-       else pragma Assert (Nkind (Nam) = N_Selected_Component);
-          Withn :=
-            Make_With_Clause
-            (Loc,
-             Name =>
-               Make_Selected_Component
-                 (Loc,
-                  Prefix        => Prefix (Nam),
-                  Selector_Name => Selector_Name (Nam)));
- 
-          Set_Parent (Withn, Parent (N));
-          Set_Limited_Present (Withn);
-          Set_First_Name      (Withn);
-          Set_Implicit_With   (Withn);
- 
-          Unum :=
-            Load_Unit
-              (Load_Name  => Get_Spec_Name (Get_Unit_Name (Nam)),
-               Required   => True,
-               Subunit    => False,
-               Error_Node => Nam);
- 
-          if not Analyzed (Cunit (Unum)) then
-             Set_Library_Unit (Withn, Cunit (Unum));
-             Set_Corresponding_Spec
-               (Withn, Specification (Unit (Cunit (Unum))));
-             Prepend (Withn, Context_Items (Parent (N)));
-             Mark_Rewrite_Insertion (Withn);
- 
-             Expand_Limited_With_Clause (Prefix (Nam), N);
-          end if;
-       end if;
- 
-       New_Nodes_OK := New_Nodes_OK - 1;
-    end Expand_Limited_With_Clause;
- 
     -----------------------
     -- Get_Parent_Entity --
     -----------------------
--- 2530,2554 ----
        Set_First_Name            (Withn, True);
        Set_Implicit_With         (Withn, True);
  
+       --  If the unit is a package declaration, a private_with_clause on a
+       --  child unit implies that the implicit with on the parent is also
+       --  private.
+ 
+       if Nkind (Unit (N)) = N_Package_Declaration then
+          Set_Private_Present       (Withn, Private_Present (Item));
+       end if;
+ 
        Prepend (Withn, Context_Items (N));
        Mark_Rewrite_Insertion (Withn);
        Install_Withed_Unit (Withn);
  
        if Nkind (Nam) = N_Expanded_Name then
!          Expand_With_Clause (Item, Prefix (Nam), N);
        end if;
  
        New_Nodes_OK := New_Nodes_OK - 1;
     end Expand_With_Clause;
  
     -----------------------
     -- Get_Parent_Entity --
     -----------------------
*************** package body Sem_Ch10 is
*** 2556,2570 ****
        -------------------------
  
        function Build_Ancestor_Name (P : Node_Id) return Node_Id is
!          P_Ref : constant Node_Id :=
                     New_Reference_To (Defining_Entity (P), Loc);
        begin
!          if No (Parent_Spec (P)) then
              return P_Ref;
           else
              return
                Make_Selected_Component (Loc,
!                 Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P))),
                  Selector_Name => P_Ref);
           end if;
        end Build_Ancestor_Name;
--- 2598,2623 ----
        -------------------------
  
        function Build_Ancestor_Name (P : Node_Id) return Node_Id is
!          P_Ref  : constant Node_Id :=
                     New_Reference_To (Defining_Entity (P), Loc);
+          P_Spec : Node_Id := P;
+ 
        begin
!          --  Ancestor may have been rewritten as a package body. Retrieve
!          --  the original spec to trace earlier ancestors.
! 
!          if Nkind (P) = N_Package_Body
!            and then Nkind (Original_Node (P)) = N_Package_Instantiation
!          then
!             P_Spec := Original_Node (P);
!          end if;
! 
!          if No (Parent_Spec (P_Spec)) then
              return P_Ref;
           else
              return
                Make_Selected_Component (Loc,
!                 Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P_Spec))),
                  Selector_Name => P_Ref);
           end if;
        end Build_Ancestor_Name;
*************** package body Sem_Ch10 is
*** 2602,2607 ****
--- 2655,2670 ----
           P_Unit := Original_Node (P_Unit);
        end if;
  
+       --  We add the implicit with if the child unit is the current unit
+       --  being compiled. If the current unit is a body, we do not want
+       --  to add an implicit_with a second time to the corresponding spec.
+ 
+       if Nkind (Child_Unit) = N_Package_Declaration
+         and then Child_Unit /= Unit (Cunit (Current_Sem_Unit))
+       then
+          return;
+       end if;
+ 
        New_Nodes_OK := New_Nodes_OK + 1;
        Withn := Make_With_Clause (Loc, Name => Build_Unit_Name);
  
*************** package body Sem_Ch10 is
*** 2624,2629 ****
--- 2687,2712 ----
        New_Nodes_OK := New_Nodes_OK - 1;
     end Implicit_With_On_Parent;
  
+    --------------
+    -- In_Chain --
+    --------------
+ 
+    function In_Chain (E : Entity_Id) return Boolean is
+       H : Entity_Id;
+ 
+    begin
+       H := Current_Entity (E);
+       while Present (H) loop
+          if H = E then
+             return True;
+          else
+             H := Homonym (H);
+          end if;
+       end loop;
+ 
+       return False;
+    end In_Chain;
+ 
     ---------------------
     -- Install_Context --
     ---------------------
*************** package body Sem_Ch10 is
*** 2706,2712 ****
  
              if Is_Child_Spec (Decl_Node) then
                 if Nkind (Name (Item)) = N_Expanded_Name then
!                   Expand_With_Clause (Prefix (Name (Item)), N);
                 else
                    --  if not an expanded name, the child unit must be a
                    --  renaming, nothing to do.
--- 2789,2795 ----
  
              if Is_Child_Spec (Decl_Node) then
                 if Nkind (Name (Item)) = N_Expanded_Name then
!                   Expand_With_Clause (Item, Prefix (Name (Item)), N);
                 else
                    --  if not an expanded name, the child unit must be a
                    --  renaming, nothing to do.
*************** package body Sem_Ch10 is
*** 2726,2735 ****
  
              if Sloc (Library_Unit (Item)) /= No_Location then
                 License_Check : declare
                    Withl : constant License_Type :=
!                             License (Source_Index
!                                        (Get_Source_Unit
!                                          (Library_Unit (Item))));
  
                    Unitl : constant License_Type :=
                             License (Source_Index (Current_Sem_Unit));
--- 2809,2820 ----
  
              if Sloc (Library_Unit (Item)) /= No_Location then
                 License_Check : declare
+ 
+                   Withu : constant Unit_Number_Type :=
+                             Get_Source_Unit (Library_Unit (Item));
+ 
                    Withl : constant License_Type :=
!                             License (Source_Index (Withu));
  
                    Unitl : constant License_Type :=
                             License (Source_Index (Current_Sem_Unit));
*************** package body Sem_Ch10 is
*** 2744,2778 ****
                    procedure License_Error is
                    begin
                       Error_Msg_N
!                        ("?license of with'ed unit & is incompatible",
                          Name (Item));
                    end License_Error;
  
                 --  Start of processing for License_Check
  
                 begin
!                   case Unitl is
!                      when Unknown =>
!                         null;
  
!                      when Restricted =>
!                         if Withl = GPL then
!                            License_Error;
!                         end if;
  
!                      when GPL =>
!                         if Withl = Restricted then
!                            License_Error;
!                         end if;
  
!                      when Modified_GPL =>
!                         if Withl = Restricted or else Withl = GPL then
!                            License_Error;
!                         end if;
  
!                      when Unrestricted =>
!                         null;
!                   end case;
                 end License_Check;
              end if;
  
--- 2829,2872 ----
                    procedure License_Error is
                    begin
                       Error_Msg_N
!                        ("?license of with'ed unit & may be inconsistent",
                          Name (Item));
                    end License_Error;
  
                 --  Start of processing for License_Check
  
                 begin
!                   --  Exclude license check if withed unit is an internal unit.
!                   --  This situation arises e.g. with the GPL version of GNAT.
  
!                   if Is_Internal_File_Name (Unit_File_Name (Withu)) then
!                      null;
  
!                      --  Otherwise check various cases
!                   else
!                      case Unitl is
!                         when Unknown =>
!                            null;
  
!                         when Restricted =>
!                            if Withl = GPL then
!                               License_Error;
!                            end if;
  
!                         when GPL =>
!                            if Withl = Restricted then
!                               License_Error;
!                            end if;
! 
!                         when Modified_GPL =>
!                            if Withl = Restricted or else Withl = GPL then
!                               License_Error;
!                            end if;
! 
!                         when Unrestricted =>
!                            null;
!                      end case;
!                   end if;
                 end License_Check;
              end if;
  
*************** package body Sem_Ch10 is
*** 2821,2827 ****
  
        if Nkind (Lib_Unit) = N_Package_Body
          or else (Nkind (Lib_Unit) = N_Subprogram_Body
!                   and then not Acts_As_Spec (N))
        then
           Install_Context (Library_Unit (N));
  
--- 2915,2921 ----
  
        if Nkind (Lib_Unit) = N_Package_Body
          or else (Nkind (Lib_Unit) = N_Subprogram_Body
!                    and then not Acts_As_Spec (N))
        then
           Install_Context (Library_Unit (N));
  
*************** package body Sem_Ch10 is
*** 2836,2851 ****
              --  context clause of the body are directly visible.
  
              declare
!                Lib_Spec : Node_Id := Unit (Library_Unit (N));
                 P        : Node_Id;
                 P_Name   : Entity_Id;
  
              begin
                 while Is_Child_Spec (Lib_Spec) loop
!                   P := Unit (Parent_Spec (Lib_Spec));
  
!                   if not (Private_Present (Parent (Lib_Spec))) then
!                      P_Name := Defining_Entity (P);
                       Install_Private_Declarations (P_Name);
                       Install_Private_With_Clauses (P_Name);
                       Set_Use (Private_Declarations (Specification (P)));
--- 2930,2948 ----
              --  context clause of the body are directly visible.
  
              declare
!                Lib_Spec : Node_Id;
                 P        : Node_Id;
                 P_Name   : Entity_Id;
  
              begin
+                Lib_Spec := Unit (Library_Unit (N));
                 while Is_Child_Spec (Lib_Spec) loop
!                   P      := Unit (Parent_Spec (Lib_Spec));
!                   P_Name := Defining_Entity (P);
  
!                   if not (Private_Present (Parent (Lib_Spec)))
!                     and then not In_Private_Part (P_Name)
!                   then
                       Install_Private_Declarations (P_Name);
                       Install_Private_With_Clauses (P_Name);
                       Set_Use (Private_Declarations (Specification (P)));
*************** package body Sem_Ch10 is
*** 2892,2901 ****
     procedure Install_Limited_Context_Clauses (N : Node_Id) is
        Item : Node_Id;
  
!       procedure Check_Parent (P : Node_Id; W : Node_Id);
        --  Check that the unlimited view of a given compilation_unit is not
!       --  already visible in the parents (neither immediately through the
!       --  context clauses, nor indirectly through "use + renamings").
  
        procedure Check_Private_Limited_Withed_Unit (N : Node_Id);
        --  Check that if a limited_with clause of a given compilation_unit
--- 2989,2997 ----
     procedure Install_Limited_Context_Clauses (N : Node_Id) is
        Item : Node_Id;
  
!       procedure Check_Renamings (P : Node_Id; W : Node_Id);
        --  Check that the unlimited view of a given compilation_unit is not
!       --  already visible through "use + renamings".
  
        procedure Check_Private_Limited_Withed_Unit (N : Node_Id);
        --  Check that if a limited_with clause of a given compilation_unit
*************** package body Sem_Ch10 is
*** 2903,2918 ****
        --  compilation_unit shall be the declaration of a private descendant
        --  of that library unit.
  
!       procedure Check_Withed_Unit (W : Node_Id);
!       --  Check that a limited with_clause does not appear in the same
!       --  context_clause as a nonlimited with_clause that mentions
!       --  the same library.
  
!       ------------------
!       -- Check_Parent --
!       ------------------
  
!       procedure Check_Parent (P : Node_Id; W : Node_Id) is
           Item   : Node_Id;
           Spec   : Node_Id;
           WEnt   : Entity_Id;
--- 2999,3018 ----
        --  compilation_unit shall be the declaration of a private descendant
        --  of that library unit.
  
!       procedure Expand_Limited_With_Clause
!         (Comp_Unit : Node_Id; Nam : Node_Id; N : Node_Id);
!       --  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 Ada 2005 (AI-50217).
  
!       ---------------------
!       -- Check_Renamings --
!       ---------------------
  
!       procedure Check_Renamings (P : Node_Id; W : Node_Id) is
           Item   : Node_Id;
           Spec   : Node_Id;
           WEnt   : Entity_Id;
*************** package body Sem_Ch10 is
*** 2923,2958 ****
        begin
           pragma Assert (Nkind (W) = N_With_Clause);
  
!          --  Step 1: Check if the unlimited view is installed in the parent
  
!          Item := First (Context_Items (P));
!          while Present (Item) loop
!             if Nkind (Item) = N_With_Clause
!               and then not Limited_Present (Item)
!               and then not Implicit_With (Item)
!               and then Library_Unit (Item) = Library_Unit (W)
!             then
!                Error_Msg_N ("unlimited view visible in ancestor", W);
!                return;
!             end if;
  
!             Next (Item);
!          end loop;
  
!          --  Step 2: Check "use + renamings"
  
           WEnt := Defining_Unit_Name (Specification (Unit (Library_Unit (W))));
           Spec := Specification (Unit (P));
  
-          --  We tried to traverse the list of entities corresponding to the
-          --  defining entity of the package spec. However, first_entity was
-          --  found to be 'empty'. Don't know why???
- 
-          --          Def  := Defining_Unit_Name (Spec);
-          --          Ent  := First_Entity (Def);
- 
-          --  As a workaround we traverse the list of visible declarations ???
- 
           Item := First (Visible_Declarations (Spec));
           while Present (Item) loop
  
--- 3023,3046 ----
        begin
           pragma Assert (Nkind (W) = N_With_Clause);
  
!          --  Protect the frontend against previous critical errors
  
!          case Nkind (Unit (Library_Unit (W))) is
!             when N_Subprogram_Declaration         |
!                  N_Package_Declaration            |
!                  N_Generic_Subprogram_Declaration |
!                  N_Generic_Package_Declaration    =>
!                null;
  
!             when others =>
!                return;
!          end case;
  
!          --  Check "use + renamings"
  
           WEnt := Defining_Unit_Name (Specification (Unit (Library_Unit (W))));
           Spec := Specification (Unit (P));
  
           Item := First (Visible_Declarations (Spec));
           while Present (Item) loop
  
*************** package body Sem_Ch10 is
*** 2961,2978 ****
                 --  Traverse the list of packages
  
                 Nam := First (Names (Item));
- 
                 while Present (Nam) loop
                    E := Entity (Nam);
  
                    pragma Assert (Present (Parent (E)));
  
!                   if Nkind (Parent (E))
!                     = N_Package_Renaming_Declaration
                      and then Renamed_Entity (E) = WEnt
                    then
!                      Error_Msg_N ("unlimited view visible through "
!                                   & "use_clause + renamings", W);
                       return;
  
                    elsif Nkind (Parent (E)) = N_Package_Specification then
--- 3049,3064 ----
                 --  Traverse the list of packages
  
                 Nam := First (Names (Item));
                 while Present (Nam) loop
                    E := Entity (Nam);
  
                    pragma Assert (Present (Parent (E)));
  
!                   if Nkind (Parent (E)) = N_Package_Renaming_Declaration
                      and then Renamed_Entity (E) = WEnt
                    then
!                      Error_Msg_N ("unlimited view visible through " &
!                                   "use clause and renamings", W);
                       return;
  
                    elsif Nkind (Parent (E)) = N_Package_Specification then
*************** package body Sem_Ch10 is
*** 2987,2994 ****
                       end loop;
  
                       if E2 = WEnt then
!                         Error_Msg_N ("unlimited view visible through "
!                                      & "use_clause ", W);
                          return;
                       end if;
  
--- 3073,3080 ----
                       end loop;
  
                       if E2 = WEnt then
!                         Error_Msg_N
!                           ("unlimited view visible through use clause ", W);
                          return;
                       end if;
  
*************** package body Sem_Ch10 is
*** 3004,3012 ****
           --  Recursive call to check all the ancestors
  
           if Is_Child_Spec (Unit (P)) then
!             Check_Parent (P => Parent_Spec (Unit (P)), W => W);
           end if;
!       end Check_Parent;
  
        ---------------------------------------
        -- Check_Private_Limited_Withed_Unit --
--- 3090,3098 ----
           --  Recursive call to check all the ancestors
  
           if Is_Child_Spec (Unit (P)) then
!             Check_Renamings (P => Parent_Spec (Unit (P)), W => W);
           end if;
!       end Check_Renamings;
  
        ---------------------------------------
        -- Check_Private_Limited_Withed_Unit --
*************** package body Sem_Ch10 is
*** 3049,3080 ****
           end if;
        end Check_Private_Limited_Withed_Unit;
  
!       -----------------------
!       -- Check_Withed_Unit --
!       -----------------------
  
!       procedure Check_Withed_Unit (W : Node_Id) is
!          Item : Node_Id;
  
        begin
!          --  A limited with_clause can not appear in the same context_clause
!          --  as a nonlimited with_clause which mentions the same library.
  
!          Item := First (Context_Items (N));
!          while Present (Item) loop
!             if Nkind (Item) = N_With_Clause
!               and then not Limited_Present (Item)
!               and then not Implicit_With (Item)
!               and then Library_Unit (Item) = Library_Unit (W)
!             then
!                Error_Msg_N ("limited and unlimited view "
!                             & "not allowed in the same context clauses", W);
!                return;
              end if;
  
!             Next (Item);
!          end loop;
!       end Check_Withed_Unit;
  
     --  Start of processing for Install_Limited_Context_Clauses
  
--- 3135,3247 ----
           end if;
        end Check_Private_Limited_Withed_Unit;
  
!       --------------------------------
!       -- Expand_Limited_With_Clause --
!       --------------------------------
  
!       procedure Expand_Limited_With_Clause
!         (Comp_Unit : Node_Id;
!          Nam       : Node_Id;
!          N         : Node_Id)
!       is
!          Loc   : constant Source_Ptr := Sloc (Nam);
!          Unum  : Unit_Number_Type;
!          Withn : Node_Id;
! 
!          function Previous_Withed_Unit (W : Node_Id) return Boolean;
!          --  Returns true if the context already includes a with_clause for
!          --  this unit. If the with_clause is non-limited, the unit is fully
!          --  visible and an implicit limited_with should not be created. If
!          --  there is already a limited_with clause for W, a second one is
!          --  simply redundant.
! 
!          --------------------------
!          -- Previous_Withed_Unit --
!          --------------------------
! 
!          function Previous_Withed_Unit (W : Node_Id) return Boolean is
!             Item : Node_Id;
! 
!          begin
!             --  A limited with_clause cannot appear in the same context_clause
!             --  as a nonlimited with_clause which mentions the same library.
! 
!             Item := First (Context_Items (Comp_Unit));
!             while Present (Item) loop
!                if Nkind (Item) = N_With_Clause
!                  and then Library_Unit (Item) = Library_Unit (W)
!                then
!                   return True;
!                end if;
! 
!                Next (Item);
!             end loop;
! 
!             return False;
!          end Previous_Withed_Unit;
! 
!       --  Start of processing for Expand_Limited_With_Clause
  
        begin
!          New_Nodes_OK := New_Nodes_OK + 1;
  
!          if Nkind (Nam) = N_Identifier then
!             Withn :=
!               Make_With_Clause (Loc,
!                 Name => Nam);
! 
!          else pragma Assert (Nkind (Nam) = N_Selected_Component);
!             Withn :=
!               Make_With_Clause (Loc,
!                 Name => Make_Selected_Component (Loc,
!                   Prefix        => Prefix (Nam),
!                   Selector_Name => Selector_Name (Nam)));
!             Set_Parent (Withn, Parent (N));
!          end if;
! 
!          Set_Limited_Present (Withn);
!          Set_First_Name      (Withn);
!          Set_Implicit_With   (Withn);
! 
!          Unum :=
!            Load_Unit
!              (Load_Name  => Get_Spec_Name (Get_Unit_Name (Nam)),
!               Required   => True,
!               Subunit    => False,
!               Error_Node => Nam);
! 
!          --  Do not generate a limited_with_clause on the current unit.
!          --  This path is taken when a unit has a limited_with clause on
!          --  one of its child units.
! 
!          if Unum = Current_Sem_Unit then
!             return;
!          end if;
! 
!          Set_Library_Unit (Withn, Cunit (Unum));
!          Set_Corresponding_Spec
!            (Withn, Specification (Unit (Cunit (Unum))));
! 
!          if not Previous_Withed_Unit (Withn) then
!             Prepend (Withn, Context_Items (Parent (N)));
!             Mark_Rewrite_Insertion (Withn);
! 
!             --  Add implicit limited_with_clauses for parents of child units
!             --  mentioned in limited_with clauses.
! 
!             if Nkind (Nam) = N_Selected_Component then
!                Expand_Limited_With_Clause (Comp_Unit, Prefix (Nam), N);
              end if;
  
!             Analyze (Withn);
! 
!             if not Limited_View_Installed (Withn) then
!                Install_Limited_Withed_Unit (Withn);
!             end if;
!          end if;
! 
!          New_Nodes_OK := New_Nodes_OK - 1;
!       end Expand_Limited_With_Clause;
  
     --  Start of processing for Install_Limited_Context_Clauses
  
*************** package body Sem_Ch10 is
*** 3084,3100 ****
           if Nkind (Item) = N_With_Clause
             and then Limited_Present (Item)
           then
!             Check_Withed_Unit (Item);
  
              if Private_Present (Library_Unit (Item)) then
                 Check_Private_Limited_Withed_Unit (Item);
              end if;
  
!             if Is_Child_Spec (Unit (N)) then
!                Check_Parent (Parent_Spec (Unit (N)), Item);
              end if;
  
!             Install_Limited_Withed_Unit (Item);
           end if;
  
           Next (Item);
--- 3251,3281 ----
           if Nkind (Item) = N_With_Clause
             and then Limited_Present (Item)
           then
!             if Nkind (Name (Item)) = N_Selected_Component then
!                Expand_Limited_With_Clause
!                  (Comp_Unit => N, Nam => Prefix (Name (Item)), N => Item);
!             end if;
  
              if Private_Present (Library_Unit (Item)) then
                 Check_Private_Limited_Withed_Unit (Item);
              end if;
  
!             if not Implicit_With (Item)
!               and then Is_Child_Spec (Unit (N))
!             then
!                Check_Renamings (Parent_Spec (Unit (N)), Item);
              end if;
  
!             --  A unit may have a limited with on itself if it has a
!             --  limited with_clause on one of its child units. In that
!             --  case it is already being compiled and it makes no sense
!             --  to install its limited view.
! 
!             if Library_Unit (Item) /= Cunit (Current_Sem_Unit)
!               and then not Limited_View_Installed (Item)
!             then
!                Install_Limited_Withed_Unit (Item);
!             end if;
           end if;
  
           Next (Item);
*************** package body Sem_Ch10 is
*** 3127,3133 ****
           Error_Msg_N
             ("child of a generic package must be a generic unit", Lib_Unit);
  
!       elsif not Is_Package (P_Name) then
           Error_Msg_N
             ("parent unit must be package or generic package", Lib_Unit);
           raise Unrecoverable_Error;
--- 3308,3314 ----
           Error_Msg_N
             ("child of a generic package must be a generic unit", Lib_Unit);
  
!       elsif not Is_Package_Or_Generic_Package (P_Name) then
           Error_Msg_N
             ("parent unit must be package or generic package", Lib_Unit);
           raise Unrecoverable_Error;
*************** package body Sem_Ch10 is
*** 3139,3154 ****
        --  Verify that a child of an instance is itself an instance, or
        --  the renaming of one. Given that an instance that is a unit is
        --  replaced with a package declaration, check against the original
!       --  node.
  
!       elsif Nkind (Original_Node (P)) = N_Package_Instantiation
!         and then Nkind (Lib_Unit)
!                    not in N_Renaming_Declaration
!         and then Nkind (Original_Node (Lib_Unit))
!                    not in N_Generic_Instantiation
!       then
!          Error_Msg_N
!            ("child of an instance must be an instance or renaming", Lib_Unit);
        end if;
  
        --  This is the recursive call that ensures all parents are loaded
--- 3320,3343 ----
        --  Verify that a child of an instance is itself an instance, or
        --  the renaming of one. Given that an instance that is a unit is
        --  replaced with a package declaration, check against the original
!       --  node. The parent may be currently being instantiated, in which
!       --  case it appears as a declaration, but the generic_parent is
!       --  already established indicating that we deal with an instance.
  
!       elsif Nkind (Original_Node (P)) = N_Package_Instantiation then
! 
!          if Nkind (Lib_Unit) in N_Renaming_Declaration
!            or else Nkind (Original_Node (Lib_Unit)) in N_Generic_Instantiation
!            or else
!              (Nkind (Lib_Unit) = N_Package_Declaration
!                 and then Present (Generic_Parent (Specification (Lib_Unit))))
!          then
!             null;
!          else
!             Error_Msg_N
!               ("child of an instance must be an instance or renaming",
!                 Lib_Unit);
!          end if;
        end if;
  
        --  This is the recursive call that ensures all parents are loaded
*************** package body Sem_Ch10 is
*** 3226,3238 ****
  
        if Nkind (Parent (Decl)) = N_Compilation_Unit then
           Item := First (Context_Items (Parent (Decl)));
- 
           while Present (Item) loop
              if Nkind (Item) = N_With_Clause
                and then Private_Present (Item)
              then
                 if Limited_Present (Item) then
!                   Install_Limited_Withed_Unit (Item);
                 else
                    Install_Withed_Unit (Item, Private_With_OK => True);
                 end if;
--- 3415,3428 ----
  
        if Nkind (Parent (Decl)) = N_Compilation_Unit then
           Item := First (Context_Items (Parent (Decl)));
           while Present (Item) loop
              if Nkind (Item) = N_With_Clause
                and then Private_Present (Item)
              then
                 if Limited_Present (Item) then
!                   if not Limited_View_Installed (Item) then
!                      Install_Limited_Withed_Unit (Item);
!                   end if;
                 else
                    Install_Withed_Unit (Item, Private_With_OK => True);
                 end if;
*************** package body Sem_Ch10 is
*** 3257,3265 ****
--- 3447,3463 ----
  
        Item := First (Context_Items (N));
        while Present (Item) loop
+ 
+          --  Do not install private_with_clauses if the unit is a package
+          --  declaration, unless it is itself a private child unit.
+ 
           if Nkind (Item) = N_With_Clause
             and then not Implicit_With (Item)
             and then not Limited_Present (Item)
+            and then
+               (not Private_Present (Item)
+                  or else Nkind (Unit (N)) /= N_Package_Declaration
+                  or else Private_Present (N))
           then
              Id := Entity (Name (Item));
  
*************** package body Sem_Ch10 is
*** 3282,3288 ****
  
                    begin
                       Clause := First (Context_Items (N));
- 
                       while Present (Clause) loop
                          if Nkind (Clause) = N_With_Clause
                            and then Entity (Name (Clause)) = Prev
--- 3480,3485 ----
*************** package body Sem_Ch10 is
*** 3318,3393 ****
     -------------------------------
  
     procedure Install_Limited_Withed_Unit (N : Node_Id) is
-       Unum             : constant Unit_Number_Type :=
-                            Get_Source_Unit (Library_Unit (N));
        P_Unit           : constant Entity_Id := Unit (Library_Unit (N));
        P                : Entity_Id;
        Is_Child_Package : Boolean := False;
  
!       Lim_Header       : Entity_Id;
!       Lim_Typ          : Entity_Id;
  
!       function In_Chain (E : Entity_Id) return Boolean;
!       --  Check that the shadow entity is not already in the homonym
!       --  chain, for example through a limited_with clause in a parent unit.
  
!       --------------
!       -- In_Chain --
!       --------------
  
!       function In_Chain (E : Entity_Id) return Boolean is
!          H : Entity_Id := Current_Entity (E);
  
        begin
!          while Present (H) loop
!             if H = E then
!                return True;
              else
!                H := Homonym (H);
              end if;
           end loop;
  
           return False;
!       end In_Chain;
  
     --  Start of processing for Install_Limited_Withed_Unit
  
     begin
!       --  In case of limited with_clause on subprograms, generics, instances,
!       --  or generic renamings, the corresponding error was previously posted
!       --  and we have nothing to do here.
! 
!       case Nkind (P_Unit) is
! 
!          when N_Package_Declaration =>
!             null;
  
!          when N_Subprogram_Declaration                 |
!               N_Generic_Package_Declaration            |
!               N_Generic_Subprogram_Declaration         |
!               N_Package_Instantiation                  |
!               N_Function_Instantiation                 |
!               N_Procedure_Instantiation                |
!               N_Generic_Package_Renaming_Declaration   |
!               N_Generic_Procedure_Renaming_Declaration |
!               N_Generic_Function_Renaming_Declaration =>
!             return;
  
!          when others =>
!             raise Program_Error;
!       end case;
  
        P := Defining_Unit_Name (Specification (P_Unit));
  
!       if Nkind (P) = N_Defining_Program_Unit_Name then
! 
!          --  Retrieve entity of child package
  
           Is_Child_Package := True;
           P := Defining_Identifier (P);
        end if;
  
!       --  A common usage of the limited-with is to have a limited-with
        --  in the package spec, and a normal with in its package body.
        --  For example:
  
--- 3515,3650 ----
     -------------------------------
  
     procedure Install_Limited_Withed_Unit (N : Node_Id) is
        P_Unit           : constant Entity_Id := Unit (Library_Unit (N));
        P                : Entity_Id;
        Is_Child_Package : Boolean := False;
  
!       Lim_Header : Entity_Id;
!       Lim_Typ    : Entity_Id;
  
!       function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean;
!       --  Check if some package installed though normal with-clauses has a
!       --  renaming declaration of package P. AARM 10.1.2(21/2).
  
!       ----------------------------------
!       -- Is_Visible_Through_Renamings --
!       ----------------------------------
  
!       function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean is
!          Kind     : constant Node_Kind :=
!                       Nkind (Unit (Cunit (Current_Sem_Unit)));
!          Aux_Unit : Node_Id;
!          Item     : Node_Id;
!          Decl     : Entity_Id;
  
        begin
!          --  Example of the error detected by this subprogram:
! 
!          --  package P is
!          --    type T is ...
!          --  end P;
! 
!          --  with P;
!          --  package Q is
!          --     package Ren_P renames P;
!          --  end Q;
! 
!          --  with Q;
!          --  package R is ...
! 
!          --  limited with P; -- ERROR
!          --  package R.C is ...
! 
!          Aux_Unit := Cunit (Current_Sem_Unit);
!          loop
!             Item := First (Context_Items (Aux_Unit));
!             while Present (Item) loop
!                if Nkind (Item) = N_With_Clause
!                  and then not Limited_Present (Item)
!                  and then Nkind (Unit (Library_Unit (Item)))
!                             = N_Package_Declaration
!                then
!                   Decl :=
!                     First (Visible_Declarations
!                             (Specification (Unit (Library_Unit (Item)))));
!                   while Present (Decl) loop
!                      if Nkind (Decl) = N_Package_Renaming_Declaration
!                        and then Entity (Name (Decl)) = P
!                      then
!                         --  Generate the error message only if the current unit
!                         --  is a package declaration; in case of subprogram
!                         --  bodies and package bodies we just return true to
!                         --  indicate that the limited view must not be
!                         --  installed.
! 
!                         if Kind = N_Package_Declaration then
!                            Error_Msg_Sloc := Sloc (Item);
!                            Error_Msg_NE
!                              ("unlimited view of & visible through the context"
!                               & " clause found #", N, P);
! 
!                            Error_Msg_Sloc := Sloc (Decl);
!                            Error_Msg_NE
!                              ("unlimited view of & visible through the"
!                               & " renaming found #", N, P);
! 
!                            Error_Msg_N
!                              ("simultaneous visibility of the limited and"
!                               & " unlimited views not allowed", N);
!                         end if;
! 
!                         return True;
!                      end if;
! 
!                      Next (Decl);
!                   end loop;
!                end if;
! 
!                Next (Item);
!             end loop;
! 
!             if Present (Library_Unit (Aux_Unit)) then
!                Aux_Unit := Library_Unit (Aux_Unit);
              else
!                Aux_Unit := Parent_Spec (Unit (Aux_Unit));
              end if;
+ 
+             exit when not Present (Aux_Unit);
           end loop;
  
           return False;
!       end Is_Visible_Through_Renamings;
  
     --  Start of processing for Install_Limited_Withed_Unit
  
     begin
!       pragma Assert (not Limited_View_Installed (N));
  
!       --  In case of limited with_clause on subprograms, generics, instances,
!       --  or renamings, the corresponding error was previously posted and we
!       --  have nothing to do here.
  
!       if Nkind (P_Unit) /= N_Package_Declaration then
!          return;
!       end if;
  
        P := Defining_Unit_Name (Specification (P_Unit));
  
!       --  Handle child packages
  
+       if Nkind (P) = N_Defining_Program_Unit_Name then
           Is_Child_Package := True;
           P := Defining_Identifier (P);
        end if;
  
!       --  Do not install the limited-view if the full-view is already visible
!       --  through renaming declarations.
! 
!       if Is_Visible_Through_Renamings (P) then
!          return;
!       end if;
! 
!       --  A common use of the limited-with is to have a limited-with
        --  in the package spec, and a normal with in its package body.
        --  For example:
  
*************** package body Sem_Ch10 is
*** 3397,3415 ****
        --       with X;          -- [2]
        --       package body A is ...
  
!       --  The compilation of A's body installs the entities of its
!       --  withed packages (the context clauses found at [2]) and
!       --  then the context clauses of its specification (found at [1]).
! 
!       --  As a consequence, at point [1] the specification of X has been
!       --  analyzed and it is immediately visible. According to the semantics
!       --  of the limited-with context clauses we don't install the limited
!       --  view because the full view of X supersedes its limited view.
  
!       if Analyzed (Cunit (Unum))
          and then (Is_Immediately_Visible (P)
!                    or else (Is_Child_Package
!                              and then Is_Visible_Child_Unit (P)))
        then
           --  Ada 2005 (AI-262): Install the private declarations of P
  
--- 3654,3670 ----
        --       with X;          -- [2]
        --       package body A is ...
  
!       --  The compilation of A's body installs the context clauses found at [2]
!       --  and then the context clauses of its specification (found at [1]). As
!       --  a consequence, at [1] the specification of X has been analyzed and it
!       --  is immediately visible. According to the semantics of limited-with
!       --  context clauses we don't install the limited view because the full
!       --  view of X supersedes its limited view.
  
!       if Analyzed (P_Unit)
          and then (Is_Immediately_Visible (P)
!                     or else (Is_Child_Package
!                                and then Is_Visible_Child_Unit (P)))
        then
           --  Ada 2005 (AI-262): Install the private declarations of P
  
*************** package body Sem_Ch10 is
*** 3418,3426 ****
           then
              declare
                 Id : Entity_Id;
              begin
                 Id := First_Private_Entity (P);
- 
                 while Present (Id) loop
                    if not Is_Internal (Id)
                      and then not Is_Child_Unit (Id)
--- 3673,3681 ----
           then
              declare
                 Id : Entity_Id;
+ 
              begin
                 Id := First_Private_Entity (P);
                 while Present (Id) loop
                    if not Is_Internal (Id)
                      and then not Is_Child_Unit (Id)
*************** package body Sem_Ch10 is
*** 3449,3462 ****
           Write_Eol;
        end if;
  
!       if not Analyzed (Cunit (Unum)) then
!          Set_Ekind (P, E_Package);
!          Set_Etype (P, Standard_Void_Type);
!          Set_Scope (P, Standard_Standard);
  
!          --  Place entity on visibility structure
  
-          if Current_Entity (P) /= P then
              Set_Homonym (P, Current_Entity (P));
              Set_Current_Entity (P);
  
--- 3704,3729 ----
           Write_Eol;
        end if;
  
!       --  If the unit has not been analyzed and the limited view has not been
!       --  already installed then we install it.
  
!       if not Analyzed (P_Unit) then
!          if not In_Chain (P) then
! 
!             --  Minimum decoration
! 
!             Set_Ekind (P, E_Package);
!             Set_Etype (P, Standard_Void_Type);
!             Set_Scope (P, Standard_Standard);
! 
!             if Is_Child_Package then
!                Set_Is_Child_Unit (P);
!                Set_Is_Visible_Child_Unit (P);
!                Set_Scope (P, Defining_Entity (Unit (Parent_Spec (P_Unit))));
!             end if;
! 
!             --  Place entity on visibility structure
  
              Set_Homonym (P, Current_Entity (P));
              Set_Current_Entity (P);
  
*************** package body Sem_Ch10 is
*** 3466,3542 ****
                 Write_Eol;
              end if;
  
!          end if;
  
!          if Is_Child_Package then
!             Set_Is_Child_Unit (P);
!             Set_Is_Visible_Child_Unit (P);
  
!             declare
!                Parent_Comp : Node_Id;
!                Parent_Id   : Entity_Id;
  
!             begin
!                Parent_Comp := Parent_Spec (Unit (Cunit (Unum)));
!                Parent_Id   := Defining_Entity (Unit (Parent_Comp));
  
!                Set_Scope (P, Parent_Id);
!             end;
           end if;
  
!       else
  
!          --  If the unit appears in a previous regular with_clause, the
!          --  regular entities must be unchained before the shadow ones
!          --  are made accessible.
  
           declare
!             Ent : Entity_Id;
           begin
!             Ent := First_Entity (P);
  
!             while Present (Ent) loop
!                Unchain (Ent);
!                Next_Entity (Ent);
              end loop;
           end;
  
!       end if;
  
!       --  The package must be visible while the with_type clause is active,
!       --  because references to the type P.T must resolve in the usual way.
  
!       Set_Is_Immediately_Visible (P);
  
!       --  Install each incomplete view. The first element of the limited view
!       --  is a header (an E_Package entity) that is used to reference the first
!       --  shadow entity in the private part of the package
  
!       Lim_Header := Limited_View (P);
!       Lim_Typ    := First_Entity (Lim_Header);
  
!       while Present (Lim_Typ) loop
  
!          exit when not Private_Present (N)
!                         and then Lim_Typ = First_Private_Entity (Lim_Header);
  
!          if not In_Chain (Lim_Typ) then
!             Set_Homonym (Lim_Typ, Current_Entity (Lim_Typ));
!             Set_Current_Entity (Lim_Typ);
  
!             if Debug_Flag_I then
!                Write_Str ("   (homonym) chain ");
!                Write_Name (Chars (Lim_Typ));
!                Write_Eol;
              end if;
-          end if;
  
!          Next_Entity (Lim_Typ);
!       end loop;
  
!       --  The context clause has installed a limited-view, mark it
!       --  accordingly, to uninstall it when the context is removed.
  
        Set_Limited_View_Installed (N);
        Set_From_With_Type (P);
     end Install_Limited_Withed_Unit;
--- 3733,3843 ----
                 Write_Eol;
              end if;
  
!             --  Install the incomplete view. The first element of the limited
!             --  view is a header (an E_Package entity) used to reference the
!             --  first shadow entity in the private part of the package.
  
!             Lim_Header := Limited_View (P);
!             Lim_Typ    := First_Entity (Lim_Header);
  
!             while Present (Lim_Typ)
!               and then Lim_Typ /= First_Private_Entity (Lim_Header)
!             loop
!                Set_Homonym (Lim_Typ, Current_Entity (Lim_Typ));
!                Set_Current_Entity (Lim_Typ);
  
!                if Debug_Flag_I then
!                   Write_Str ("   (homonym) chain ");
!                   Write_Name (Chars (Lim_Typ));
!                   Write_Eol;
!                end if;
  
!                Next_Entity (Lim_Typ);
!             end loop;
           end if;
  
!       --  If the unit appears in a previous regular with_clause, the regular
!       --  entities of the public part of the withed package must be replaced
!       --  by the shadow ones.
  
!       --  This code must be kept synchronized with the code that replaces the
!       --  the shadow entities by the real entities (see body of Remove_Limited
!       --  With_Clause); otherwise the contents of the homonym chains are not
!       --  consistent.
! 
!       else
!          --  Hide all the type entities of the public part of the package to
!          --  avoid its usage. This is needed to cover all the subtype decla-
!          --  rations because we do not remove them from the homonym chain.
  
           declare
!             E : Entity_Id;
! 
           begin
!             E := First_Entity (P);
!             while Present (E) and then E /= First_Private_Entity (P) loop
!                if Is_Type (E) then
!                   Set_Was_Hidden (E, Is_Hidden (E));
!                   Set_Is_Hidden (E);
!                end if;
  
!                Next_Entity (E);
              end loop;
           end;
  
!          --  Replace the real entities by the shadow entities of the limited
!          --  view. The first element of the limited view is a header that is
!          --  used to reference the first shadow entity in the private part
!          --  of the package.
  
!          Lim_Header := Limited_View (P);
  
!          Lim_Typ := First_Entity (Lim_Header);
!          while Present (Lim_Typ)
!            and then Lim_Typ /= First_Private_Entity (Lim_Header)
!          loop
!             pragma Assert (not In_Chain (Lim_Typ));
  
!             --  Do not unchain child units
  
!             if not Is_Child_Unit (Lim_Typ) then
!                declare
!                   Prev : Entity_Id;
  
!                begin
!                   Set_Homonym (Lim_Typ, Homonym (Non_Limited_View (Lim_Typ)));
!                   Prev := Current_Entity (Lim_Typ);
  
!                   if Prev = Non_Limited_View (Lim_Typ) then
!                      Set_Current_Entity (Lim_Typ);
!                   else
!                      while Present (Prev)
!                        and then Homonym (Prev) /= Non_Limited_View (Lim_Typ)
!                      loop
!                         Prev := Homonym (Prev);
!                      end loop;
  
!                      Set_Homonym (Prev, Lim_Typ);
!                   end if;
!                end;
  
!                if Debug_Flag_I then
!                   Write_Str ("   (homonym) chain ");
!                   Write_Name (Chars (Lim_Typ));
!                   Write_Eol;
!                end if;
              end if;
  
!             Next_Entity (Lim_Typ);
!          end loop;
!       end if;
  
!       --  The package must be visible while the limited-with clause is active
!       --  because references to the type P.T must resolve in the usual way.
!       --  In addition, we remember that the limited-view has been installed to
!       --  uninstall it at the point of context removal.
  
+       Set_Is_Immediately_Visible (P);
        Set_Limited_View_Installed (N);
        Set_From_With_Type (P);
     end Install_Limited_Withed_Unit;
*************** package body Sem_Ch10 is
*** 3559,3565 ****
        --  analyzing the private part of the package).
  
        if Private_Present (With_Clause)
!         and then Nkind (Cunit (Current_Sem_Unit)) = N_Package_Declaration
          and then not (Private_With_OK)
        then
           return;
--- 3860,3866 ----
        --  analyzing the private part of the package).
  
        if Private_Present (With_Clause)
!         and then Nkind (Unit (Parent (With_Clause))) = N_Package_Declaration
          and then not (Private_With_OK)
        then
           return;
*************** package body Sem_Ch10 is
*** 3590,3599 ****
  
        if P /= Standard_Standard then
  
!          --  If the unit is not analyzed after analysis of the with clause,
!          --  and it is an instantiation, then it awaits a body and is the main
!          --  unit. Its appearance in the context of some other unit indicates
!          --  a circular dependency (DEC suite perversity).
  
           if not Analyzed (Uname)
             and then Nkind (Parent (Uname)) = N_Package_Instantiation
--- 3891,3900 ----
  
        if P /= Standard_Standard then
  
!          --  If the unit is not analyzed after analysis of the with clause and
!          --  it is an instantiation then it awaits a body and is the main unit.
!          --  Its appearance in the context of some other unit indicates a
!          --  circular dependency (DEC suite perversity).
  
           if not Analyzed (Uname)
             and then Nkind (Parent (Uname)) = N_Package_Instantiation
*************** package body Sem_Ch10 is
*** 3604,3609 ****
--- 3905,3917 ----
           elsif not Is_Visible_Child_Unit (Uname) then
              Set_Is_Visible_Child_Unit (Uname);
  
+             --  If the child unit appears in the context of its parent, it is
+             --  immediately visible.
+ 
+             if In_Open_Scopes (Scope (Uname)) then
+                Set_Is_Immediately_Visible (Uname);
+             end if;
+ 
              if Is_Generic_Instance (Uname)
                and then Ekind (Uname) in Subprogram_Kind
              then
*************** package body Sem_Ch10 is
*** 3615,3622 ****
                     (Defining_Entity (Unit (Library_Unit (With_Clause)))));
              end if;
  
!             --  The parent unit may have been installed already, and
!             --  may have appeared in a use clause.
  
              if In_Use (Scope (Uname)) then
                 Set_Is_Potentially_Use_Visible (Uname);
--- 3923,3930 ----
                     (Defining_Entity (Unit (Library_Unit (With_Clause)))));
              end if;
  
!             --  The parent unit may have been installed already, and may have
!             --  appeared in a use clause.
  
              if In_Use (Scope (Uname)) then
                 Set_Is_Potentially_Use_Visible (Uname);
*************** package body Sem_Ch10 is
*** 3648,3654 ****
        --  instance I1 of a generic unit G1 has an explicit child unit I1.G2,
        --  G1 has a generic child also named G2, and the context includes with_
        --  clauses for both I1.G2 and for G1.G2, making an implicit declaration
!       --  of I1.G2 visible as well.
  
        if Is_Child_Unit (Uname)
          and then Is_Visible_Child_Unit (Uname)
--- 3956,3963 ----
        --  instance I1 of a generic unit G1 has an explicit child unit I1.G2,
        --  G1 has a generic child also named G2, and the context includes with_
        --  clauses for both I1.G2 and for G1.G2, making an implicit declaration
!       --  of I1.G2 visible as well. If the child unit is named Standard, do
!       --  not apply the check to the Standard package itself.
  
        if Is_Child_Unit (Uname)
          and then Is_Visible_Child_Unit (Uname)
*************** package body Sem_Ch10 is
*** 3662,3668 ****
  
           begin
              U2 := Homonym (Uname);
!             while Present (U2) loop
                 P2 := Scope (U2);
                 Decl2  := Unit_Declaration_Node (P2);
  
--- 3971,3979 ----
  
           begin
              U2 := Homonym (Uname);
!             while Present (U2)
!               and U2 /= Standard_Standard
!            loop
                 P2 := Scope (U2);
                 Decl2  := Unit_Declaration_Node (P2);
  
*************** package body Sem_Ch10 is
*** 3940,3946 ****
  
        begin
           Decl := First_Decl;
- 
           while Present (Decl) loop
  
              --  For each library_package_declaration in the environment, there
--- 4251,4256 ----
*************** package body Sem_Ch10 is
*** 3960,3966 ****
              if Nkind (Decl) = N_Full_Type_Declaration then
                 Is_Tagged :=
                    Nkind (Type_Definition (Decl)) = N_Record_Definition
!                   and then Tagged_Present (Type_Definition (Decl));
  
                 Comp_Typ := Defining_Identifier (Decl);
  
--- 4270,4276 ----
              if Nkind (Decl) = N_Full_Type_Declaration then
                 Is_Tagged :=
                    Nkind (Type_Definition (Decl)) = N_Record_Definition
!                     and then Tagged_Present (Type_Definition (Decl));
  
                 Comp_Typ := Defining_Identifier (Decl);
  
*************** package body Sem_Ch10 is
*** 3991,4003 ****
  
                 Set_Non_Limited_View (Lim_Typ, Comp_Typ);
  
!             elsif Nkind (Decl) = N_Private_Type_Declaration
!               and then Tagged_Present (Decl)
!             then
                 Comp_Typ := Defining_Identifier (Decl);
  
                 if not Analyzed_Unit then
!                   Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
                 end if;
  
                 Lim_Typ  := New_Internal_Shadow_Entity
--- 4301,4315 ----
  
                 Set_Non_Limited_View (Lim_Typ, Comp_Typ);
  
!             elsif Nkind (Decl) = N_Private_Type_Declaration then
                 Comp_Typ := Defining_Identifier (Decl);
  
                 if not Analyzed_Unit then
!                   if Tagged_Present (Decl) then
!                      Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
!                   else
!                      Decorate_Incomplete_Type (Comp_Typ, Scope);
!                   end if;
                 end if;
  
                 Lim_Typ  := New_Internal_Shadow_Entity
*************** package body Sem_Ch10 is
*** 4009,4016 ****
                 Set_Parent (Lim_Typ, Parent (Comp_Typ));
                 Set_From_With_Type (Lim_Typ);
  
!                Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
  
                 Set_Non_Limited_View (Lim_Typ, Comp_Typ);
  
              elsif Nkind (Decl) = N_Package_Declaration then
--- 4321,4353 ----
                 Set_Parent (Lim_Typ, Parent (Comp_Typ));
                 Set_From_With_Type (Lim_Typ);
  
!                if Tagged_Present (Decl) then
!                   Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
!                else
!                   Decorate_Incomplete_Type (Lim_Typ, Scope);
!                end if;
! 
!                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
! 
!             elsif Nkind (Decl) = N_Private_Extension_Declaration then
!                Comp_Typ := Defining_Identifier (Decl);
! 
!                if not Analyzed_Unit then
!                   Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope);
!                end if;
! 
!                --  Create shadow entity for type
! 
!                Lim_Typ := New_Internal_Shadow_Entity
!                  (Kind       => Ekind (Comp_Typ),
!                   Sloc_Value => Sloc (Comp_Typ),
!                   Id_Char    => 'Z');
  
+                Set_Chars  (Lim_Typ, Chars (Comp_Typ));
+                Set_Parent (Lim_Typ, Parent (Comp_Typ));
+                Set_From_With_Type (Lim_Typ);
+ 
+                Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
                 Set_Non_Limited_View (Lim_Typ, Comp_Typ);
  
              elsif Nkind (Decl) = N_Package_Declaration then
*************** package body Sem_Ch10 is
*** 4079,4098 ****
                           & "limited with_clauses", N);
              return;
  
!          when N_Package_Instantiation |
!               N_Function_Instantiation |
!               N_Procedure_Instantiation =>
              Error_Msg_N ("generic instantiations not allowed in "
                           & "limited with_clauses", N);
              return;
  
!          when N_Generic_Package_Renaming_Declaration |
!               N_Generic_Procedure_Renaming_Declaration |
!               N_Generic_Function_Renaming_Declaration =>
              Error_Msg_N ("generic renamings not allowed in "
                           & "limited with_clauses", N);
              return;
  
           when others =>
              raise Program_Error;
        end case;
--- 4416,4441 ----
                           & "limited with_clauses", N);
              return;
  
!          when N_Generic_Instantiation =>
              Error_Msg_N ("generic instantiations not allowed in "
                           & "limited with_clauses", N);
              return;
  
!          when N_Generic_Renaming_Declaration =>
              Error_Msg_N ("generic renamings not allowed in "
                           & "limited with_clauses", N);
              return;
  
+          when N_Subprogram_Renaming_Declaration =>
+             Error_Msg_N ("renamed subprograms not allowed in "
+                          & "limited with_clauses", N);
+             return;
+ 
+          when N_Package_Renaming_Declaration =>
+             Error_Msg_N ("renamed packages not allowed in "
+                          & "limited with_clauses", N);
+             return;
+ 
           when others =>
              raise Program_Error;
        end case;
*************** package body Sem_Ch10 is
*** 4186,4192 ****
             and then Present (Corresponding_Body (Unit_Declaration_Node (E)))
           then
              Ent := First_Entity (E);
- 
              while Present (Ent) loop
                 if Entity_Needs_Body (Ent) then
                    return True;
--- 4529,4534 ----
*************** package body Sem_Ch10 is
*** 4335,4348 ****
  
     procedure Remove_Limited_With_Clause (N : Node_Id) is
        P_Unit     : constant Entity_Id := Unit (Library_Unit (N));
!       P          : Entity_Id := Defining_Unit_Name (Specification (P_Unit));
        Lim_Typ    : Entity_Id;
  
     begin
!       if Nkind (P) = N_Defining_Program_Unit_Name then
  
!          --  Retrieve entity of Child package
  
           P := Defining_Identifier (P);
        end if;
  
--- 4677,4703 ----
  
     procedure Remove_Limited_With_Clause (N : Node_Id) is
        P_Unit     : constant Entity_Id := Unit (Library_Unit (N));
!       P          : Entity_Id;
!       Lim_Header : Entity_Id;
        Lim_Typ    : Entity_Id;
+       Prev       : Entity_Id;
  
     begin
!       pragma Assert (Limited_View_Installed (N));
  
!       --  In case of limited with_clause on subprograms, generics, instances,
!       --  or renamings, the corresponding error was previously posted and we
!       --  have nothing to do here.
! 
!       if Nkind (P_Unit) /= N_Package_Declaration then
!          return;
!       end if;
! 
!       P := Defining_Unit_Name (Specification (P_Unit));
  
+       --  Handle child packages
+ 
+       if Nkind (P) = N_Defining_Program_Unit_Name then
           P := Defining_Identifier (P);
        end if;
  
*************** package body Sem_Ch10 is
*** 4353,4418 ****
           Write_Eol;
        end if;
  
!       --  Remove all shadow entities from visibility. The first element of the
!       --  limited view is a header (an E_Package entity) that is used to
!       --  reference the first shadow entity in the private part of the package
! 
!       Lim_Typ    := First_Entity (Limited_View (P));
! 
!       while Present (Lim_Typ) loop
!          Unchain (Lim_Typ);
!          Next_Entity (Lim_Typ);
!       end loop;
! 
!       --  Indicate that the limited view of the package is not installed
  
!       Set_From_With_Type (P, False);
!       Set_Limited_View_Installed (N, False);
  
!       --  If the exporting package has previously been analyzed, it
!       --  has appeared in the closure already and should be left alone.
!       --  Otherwise, remove package itself from visibility.
  
        if not Analyzed (P_Unit) then
           Unchain (P);
-          Set_First_Entity (P, Empty);
-          Set_Last_Entity (P, Empty);
-          Set_Ekind (P, E_Void);
-          Set_Scope (P, Empty);
           Set_Is_Immediately_Visible (P, False);
  
!       else
  
!          --  Reinstall visible entities (entities removed from visibility in
!          --  Install_Limited_Withed to install the shadow entities).
  
           declare
!             Ent : Entity_Id;
  
           begin
!             Ent := First_Entity (P);
!             while Present (Ent) and then Ent /= First_Private_Entity (P) loop
  
!                --  Shadow entities have not been added to the list of
!                --  entities associated to the package spec. Therefore we
!                --  just have to re-chain all its visible entities.
  
!                if not Is_Class_Wide_Type (Ent) then
  
!                   Set_Homonym (Ent, Current_Entity (Ent));
!                   Set_Current_Entity (Ent);
  
!                   if Debug_Flag_I then
!                      Write_Str ("   (homonym) chain ");
!                      Write_Name (Chars (Ent));
!                      Write_Eol;
!                   end if;
                 end if;
  
!                Next_Entity (Ent);
!             end loop;
!          end;
        end if;
     end Remove_Limited_With_Clause;
  
     --------------------
--- 4708,4795 ----
           Write_Eol;
        end if;
  
!       --  Prepare the removal of the shadow entities from visibility. The
!       --  first element of the limited view is a header (an E_Package
!       --  entity) that is used to reference the first shadow entity in the
!       --  private part of the package
  
!       Lim_Header := Limited_View (P);
!       Lim_Typ    := First_Entity (Lim_Header);
  
!       --  Remove package and shadow entities from visibility if it has not
!       --  been analyzed
  
        if not Analyzed (P_Unit) then
           Unchain (P);
           Set_Is_Immediately_Visible (P, False);
  
!          while Present (Lim_Typ) loop
!             Unchain (Lim_Typ);
!             Next_Entity (Lim_Typ);
!          end loop;
  
!       --  Otherwise this package has already appeared in the closure and its
!       --  shadow entities must be replaced by its real entities. This code
!       --  must be kept synchronized with the complementary code in Install
!       --  Limited_Withed_Unit.
! 
!       else
!          --  Real entities that are type or subtype declarations were hidden
!          --  from visibility at the point of installation of the limited-view.
!          --  Now we recover the previous value of the hidden attribute.
  
           declare
!             E : Entity_Id;
  
           begin
!             E := First_Entity (P);
!             while Present (E) and then E /= First_Private_Entity (P) loop
!                if Is_Type (E) then
!                   Set_Is_Hidden (E, Was_Hidden (E));
!                end if;
  
!                Next_Entity (E);
!             end loop;
!          end;
  
!          while Present (Lim_Typ)
!            and then Lim_Typ /= First_Private_Entity (Lim_Header)
!          loop
!             pragma Assert (not In_Chain (Non_Limited_View (Lim_Typ)));
  
!             --  Child units have not been unchained
  
!             if not Is_Child_Unit (Non_Limited_View (Lim_Typ)) then
!                Prev := Current_Entity (Lim_Typ);
! 
!                if Prev = Lim_Typ then
!                   Set_Current_Entity (Non_Limited_View (Lim_Typ));
!                else
!                   while Present (Prev)
!                     and then Homonym (Prev) /= Lim_Typ
!                   loop
!                      Prev := Homonym (Prev);
!                   end loop;
! 
!                   pragma Assert (Present (Prev));
!                   Set_Homonym (Prev, Non_Limited_View (Lim_Typ));
                 end if;
  
!                --  We must also set the next homonym entity of the real entity
!                --  to handle the case in which the next homonym was a shadow
!                --  entity.
! 
!                Set_Homonym (Non_Limited_View (Lim_Typ), Homonym (Lim_Typ));
!             end if;
! 
!             Next_Entity (Lim_Typ);
!          end loop;
        end if;
+ 
+       --  Indicate that the limited view of the package is not installed
+ 
+       Set_From_With_Type         (P, False);
+       Set_Limited_View_Installed (N, False);
     end Remove_Limited_With_Clause;
  
     --------------------
*************** package body Sem_Ch10 is
*** 4449,4457 ****
           --  visible while the parent is in scope.
  
           E := First_Entity (P_Name);
- 
           while Present (E) loop
- 
              if Is_Child_Unit (E) then
                 Set_Is_Immediately_Visible (E, False);
              end if;
--- 4826,4832 ----
*************** package body Sem_Ch10 is
*** 4549,4555 ****
        --  If P is a child unit, remove parents as well
  
        P := Scope (P);
- 
        while Present (P)
          and then P /= Standard_Standard
        loop
--- 4924,4929 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch10.ads gcc-4.1.0/gcc/ada/sem_ch10.ads
*** gcc-4.0.2/gcc/ada/sem_ch10.ads	Fri Mar  5 10:58:57 2004
--- gcc-4.1.0/gcc/ada/sem_ch10.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch11.adb gcc-4.1.0/gcc/ada/sem_ch11.adb
*** gcc-4.0.2/gcc/ada/sem_ch11.adb	Mon Jan  3 15:32:17 2005
--- gcc-4.1.0/gcc/ada/sem_ch11.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch11 is
*** 363,369 ****
  
     procedure Analyze_Raise_Statement (N : Node_Id) is
        Exception_Id   : constant Node_Id := Name (N);
!       Exception_Name : Entity_Id := Empty;
        P              : Node_Id;
        Nkind_P        : Node_Kind;
  
--- 363,369 ----
  
     procedure Analyze_Raise_Statement (N : Node_Id) is
        Exception_Id   : constant Node_Id := Name (N);
!       Exception_Name : Entity_Id        := Empty;
        P              : Node_Id;
        Nkind_P        : Node_Kind;
  
*************** package body Sem_Ch11 is
*** 401,407 ****
                      ("?assignment to pass-by-copy formal may have no effect",
                        P);
                    Error_Msg_N
!                     ("\?RAISE statement is abnormal return" &
                       " ('R'M 6.4.1(17))", P);
                 end if;
              end if;
--- 401,407 ----
                      ("?assignment to pass-by-copy formal may have no effect",
                        P);
                    Error_Msg_N
!                     ("\?RAISE statement may result in abnormal return" &
                       " ('R'M 6.4.1(17))", P);
                 end if;
              end if;
*************** package body Sem_Ch11 is
*** 445,450 ****
--- 445,454 ----
              Error_Msg_N
                ("exception name expected in raise statement", Exception_Id);
           end if;
+ 
+          if Present (Expression (N)) then
+             Analyze_And_Resolve (Expression (N), Standard_String);
+          end if;
        end if;
     end Analyze_Raise_Statement;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch11.ads gcc-4.1.0/gcc/ada/sem_ch11.ads
*** gcc-4.0.2/gcc/ada/sem_ch11.ads	Thu Apr 24 17:54:16 2003
--- gcc-4.1.0/gcc/ada/sem_ch11.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch12.adb gcc-4.1.0/gcc/ada/sem_ch12.adb
*** gcc-4.0.2/gcc/ada/sem_ch12.adb	Thu Feb 10 13:50:44 2005
--- gcc-4.1.0/gcc/ada/sem_ch12.adb	Tue Nov 15 14:02:22 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Fname;    use Fname;
*** 33,43 ****
  with Fname.UF; use Fname.UF;
  with Freeze;   use Freeze;
  with Hostparm;
- with Inline;   use Inline;
  with Lib;      use Lib;
  with Lib.Load; use Lib.Load;
  with Lib.Xref; use Lib.Xref;
  with Nlists;   use Nlists;
  with Nmake;    use Nmake;
  with Opt;      use Opt;
  with Rident;   use Rident;
--- 33,43 ----
  with Fname.UF; use Fname.UF;
  with Freeze;   use Freeze;
  with Hostparm;
  with Lib;      use Lib;
  with Lib.Load; use Lib.Load;
  with Lib.Xref; use Lib.Xref;
  with Nlists;   use Nlists;
+ with Namet;    use Namet;
  with Nmake;    use Nmake;
  with Opt;      use Opt;
  with Rident;   use Rident;
*************** package body Sem_Ch12 is
*** 255,261 ****
     --  in-out, because in the case of an anonymous type the entity is
     --  actually created in the procedure.
  
!    --  The following procedures treat other kinds of formal parameters.
  
     procedure Analyze_Formal_Derived_Type
       (N   : Node_Id;
--- 255,265 ----
     --  in-out, because in the case of an anonymous type the entity is
     --  actually created in the procedure.
  
!    --  The following procedures treat other kinds of formal parameters
! 
!    procedure Analyze_Formal_Derived_Interface_Type
!      (T   : Entity_Id;
!       Def : Node_Id);
  
     procedure Analyze_Formal_Derived_Type
       (N   : Node_Id;
*************** package body Sem_Ch12 is
*** 272,277 ****
--- 276,282 ----
                                                  (T : Entity_Id; Def : Node_Id);
     procedure Analyze_Formal_Discrete_Type       (T : Entity_Id; Def : Node_Id);
     procedure Analyze_Formal_Floating_Type       (T : Entity_Id; Def : Node_Id);
+    procedure Analyze_Formal_Interface_Type      (T : Entity_Id; Def : Node_Id);
     procedure Analyze_Formal_Signed_Integer_Type (T : Entity_Id; Def : Node_Id);
     procedure Analyze_Formal_Modular_Type        (T : Entity_Id; Def : Node_Id);
     procedure Analyze_Formal_Ordinary_Fixed_Point_Type
*************** package body Sem_Ch12 is
*** 317,323 ****
     --  On return, the node N has been rewritten with the actual body.
  
     procedure Check_Formal_Packages (P_Id : Entity_Id);
!    --  Apply the following to all formal packages in generic associations.
  
     procedure Check_Formal_Package_Instance
       (Formal_Pack : Entity_Id;
--- 322,328 ----
     --  On return, the node N has been rewritten with the actual body.
  
     procedure Check_Formal_Packages (P_Id : Entity_Id);
!    --  Apply the following to all formal packages in generic associations
  
     procedure Check_Formal_Package_Instance
       (Formal_Pack : Entity_Id;
*************** package body Sem_Ch12 is
*** 391,401 ****
     --  (component or index type of an array type) and Gen_Scope is the scope of
     --  the analyzed formal array type.
  
-    function Get_Package_Instantiation_Node (A : Entity_Id) return Node_Id;
-    --  Given the entity of a unit that is an instantiation, retrieve the
-    --  original instance node. This is used when loading the instantiations
-    --  of the ancestors of a child generic that is being instantiated.
- 
     function In_Same_Declarative_Part
       (F_Node : Node_Id;
        Inst   : Node_Id) return Boolean;
--- 396,401 ----
*************** package body Sem_Ch12 is
*** 475,485 ****
     --  When compiling an instance of a child unit the parent (which is
     --  itself an instance) is an enclosing scope that must be made
     --  immediately visible. This procedure is also used to install the non-
!    --  generic parent of a generic child unit when compiling its body, so that
!    --  full views of types in the parent are made visible.
  
     procedure Remove_Parent (In_Body : Boolean := False);
!    --  Reverse effect after instantiation of child is complete.
  
     procedure Inline_Instance_Body
       (N        : Node_Id;
--- 475,485 ----
     --  When compiling an instance of a child unit the parent (which is
     --  itself an instance) is an enclosing scope that must be made
     --  immediately visible. This procedure is also used to install the non-
!    --  generic parent of a generic child unit when compiling its body, so
!    --  that full views of types in the parent are made visible.
  
     procedure Remove_Parent (In_Body : Boolean := False);
!    --  Reverse effect after instantiation of child is complete
  
     procedure Inline_Instance_Body
       (N        : Node_Id;
*************** package body Sem_Ch12 is
*** 490,497 ****
     --  that successive instantiations succeed.
  
     --  The functions Instantiate_XXX perform various legality checks and build
!    --  the declarations for instantiated generic parameters.
!    --  Need to describe what the parameters are ???
  
     function Instantiate_Object
       (Formal          : Node_Id;
--- 490,500 ----
     --  that successive instantiations succeed.
  
     --  The functions Instantiate_XXX perform various legality checks and build
!    --  the declarations for instantiated generic parameters. In all of these
!    --  Formal is the entity in the generic unit, Actual is the entity of
!    --  expression in the generic associations, and Analyzed_Formal is the
!    --  formal in the generic copy, which contains the semantic information to
!    --  be used to validate the actual.
  
     function Instantiate_Object
       (Formal          : Node_Id;
*************** package body Sem_Ch12 is
*** 680,691 ****
     --  that the visibility data structures be properly initialized. Once the
     --  generic is unit is validated, Set_Instance_Env completes Save_Env.
  
     type Instance_Env is record
!       Ada_Version         : Ada_Version_Type;
!       Instantiated_Parent : Assoc;
!       Exchanged_Views     : Elist_Id;
!       Hidden_Entities     : Elist_Id;
!       Current_Sem_Unit    : Unit_Number_Type;
     end record;
  
     package Instance_Envs is new Table.Table (
--- 683,708 ----
     --  that the visibility data structures be properly initialized. Once the
     --  generic is unit is validated, Set_Instance_Env completes Save_Env.
  
+    Parent_Unit_Visible : Boolean := False;
+    --  Parent_Unit_Visible is used when the generic is a child unit, and
+    --  indicates whether the ultimate parent of the generic is visible in the
+    --  instantiation environment. It is used to reset the visibility of the
+    --  parent at the end of the instantiation (see Remove_Parent).
+ 
+    Instance_Parent_Unit : Entity_Id := Empty;
+    --  This records the ultimate parent unit of an instance of a generic
+    --  child unit and is used in conjunction with Parent_Unit_Visible to
+    --  indicate the unit to which the Parent_Unit_Visible flag corresponds.
+ 
     type Instance_Env is record
!       Ada_Version          : Ada_Version_Type;
!       Ada_Version_Explicit : Ada_Version_Type;
!       Instantiated_Parent  : Assoc;
!       Exchanged_Views      : Elist_Id;
!       Hidden_Entities      : Elist_Id;
!       Current_Sem_Unit     : Unit_Number_Type;
!       Parent_Unit_Visible  : Boolean   := False;
!       Instance_Parent_Unit : Entity_Id := Empty;
     end record;
  
     package Instance_Envs is new Table.Table (
*************** package body Sem_Ch12 is
*** 1005,1011 ****
                         Instantiate_Type
                           (Formal, Match, Analyzed_Formal, Assoc));
  
!                      --  an instantiation is a freeze point for the actuals,
                       --  unless this is a rewritten formal package.
  
                       if Nkind (I_Node) /= N_Formal_Package_Declaration then
--- 1022,1028 ----
                         Instantiate_Type
                           (Formal, Match, Analyzed_Formal, Assoc));
  
!                      --  An instantiation is a freeze point for the actuals,
                       --  unless this is a rewritten formal package.
  
                       if Nkind (I_Node) /= N_Formal_Package_Declaration then
*************** package body Sem_Ch12 is
*** 1289,1294 ****
--- 1306,1331 ----
        Check_Restriction (No_Fixed_Point, Def);
     end Analyze_Formal_Decimal_Fixed_Point_Type;
  
+    -------------------------------------------
+    -- Analyze_Formal_Derived_Interface_Type --
+    -------------------------------------------
+ 
+    procedure Analyze_Formal_Derived_Interface_Type
+      (T : Entity_Id;
+       Def : Node_Id)
+    is
+    begin
+       Enter_Name (T);
+       Set_Ekind  (T, E_Record_Type);
+       Set_Etype  (T, T);
+       Analyze (Subtype_Indication (Def));
+       Analyze_Interface_Declaration (T, Def);
+       Make_Class_Wide_Type (T);
+       Set_Primitive_Operations (T, New_Elmt_List);
+       Analyze_List (Interface_List (Def));
+       Collect_Interfaces (Def, T);
+    end Analyze_Formal_Derived_Interface_Type;
+ 
     ---------------------------------
     -- Analyze_Formal_Derived_Type --
     ---------------------------------
*************** package body Sem_Ch12 is
*** 1442,1447 ****
--- 1479,1498 ----
        Check_Restriction (No_Floating_Point, Def);
     end Analyze_Formal_Floating_Type;
  
+    -----------------------------------
+    -- Analyze_Formal_Interface_Type;--
+    -----------------------------------
+ 
+    procedure Analyze_Formal_Interface_Type (T : Entity_Id; Def : Node_Id) is
+    begin
+       Enter_Name (T);
+       Set_Ekind  (T, E_Record_Type);
+       Set_Etype  (T, T);
+       Analyze_Interface_Declaration (T, Def);
+       Make_Class_Wide_Type (T);
+       Set_Primitive_Operations (T, New_Elmt_List);
+    end Analyze_Formal_Interface_Type;
+ 
     ---------------------------------
     -- Analyze_Formal_Modular_Type --
     ---------------------------------
*************** package body Sem_Ch12 is
*** 1512,1518 ****
           Set_Ekind (Id, K);
           Set_Etype (Id, T);
  
!       --  Case of generic IN OUT parameter.
  
        else
           --  If the formal has an unconstrained type, construct its
--- 1563,1569 ----
           Set_Ekind (Id, K);
           Set_Etype (Id, T);
  
!       --  Case of generic IN OUT parameter
  
        else
           --  If the formal has an unconstrained type, construct its
*************** package body Sem_Ch12 is
*** 1620,1625 ****
--- 1671,1682 ----
        Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
        Gen_Unit := Entity (Gen_Id);
  
+       --  Check for a formal package that is a package renaming
+ 
+       if Present (Renamed_Object (Gen_Unit)) then
+          Gen_Unit := Renamed_Object (Gen_Unit);
+       end if;
+ 
        if Ekind (Gen_Unit) /= E_Generic_Package then
           Error_Msg_N ("expect generic package name", Gen_Id);
           Restore_Env;
*************** package body Sem_Ch12 is
*** 1654,1665 ****
           end if;
        end if;
  
-       --  Check for a formal package that is a package renaming.
- 
-       if Present (Renamed_Object (Gen_Unit)) then
-          Gen_Unit := Renamed_Object (Gen_Unit);
-       end if;
- 
        --  The formal package is treated like a regular instance, but only
        --  the specification needs to be instantiated, to make entities visible.
  
--- 1711,1716 ----
*************** package body Sem_Ch12 is
*** 1686,1696 ****
--- 1737,1750 ----
           end if;
  
           Formal := New_Copy (Pack_Id);
+          Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
+ 
           New_N :=
             Copy_Generic_Node
               (Original_Node (Gen_Decl), Empty, Instantiating => True);
           Rewrite (N, New_N);
           Set_Defining_Unit_Name (Specification (New_N), Formal);
+          Set_Generic_Parent (Specification (N), Gen_Unit);
           Set_Instance_Env (Gen_Unit, Formal);
  
           Enter_Name (Formal);
*************** package body Sem_Ch12 is
*** 1748,1757 ****
           --  instantiation, the defining_unit_name we need is in the
           --  new tree and not in the original. (see Package_Instantiation).
           --  A generic formal package is an instance, and can be used as
!          --  an actual for an inner instance. Mark its generic parent.
  
           Set_Ekind (Formal, E_Package);
-          Set_Generic_Parent (Specification (N), Gen_Unit);
           Set_Has_Completion (Formal, True);
  
           Set_Ekind (Pack_Id, E_Package);
--- 1802,1810 ----
           --  instantiation, the defining_unit_name we need is in the
           --  new tree and not in the original. (see Package_Instantiation).
           --  A generic formal package is an instance, and can be used as
!          --  an actual for an inner instance.
  
           Set_Ekind (Formal, E_Package);
           Set_Has_Completion (Formal, True);
  
           Set_Ekind (Pack_Id, E_Package);
*************** package body Sem_Ch12 is
*** 1773,1779 ****
     begin
        New_Private_Type (N, T, Def);
  
!       --  Set the size to an arbitrary but legal value.
  
        Set_Size_Info (T, Standard_Integer);
        Set_RM_Size   (T, RM_Size (Standard_Integer));
--- 1826,1832 ----
     begin
        New_Private_Type (N, T, Def);
  
!       --  Set the size to an arbitrary but legal value
  
        Set_Size_Info (T, Standard_Integer);
        Set_RM_Size   (T, RM_Size (Standard_Integer));
*************** package body Sem_Ch12 is
*** 1996,2002 ****
              Defining_Identifier (First (Discriminant_Specifications (N))));
        end if;
  
!       --  Enter the new name, and branch to specific routine.
  
        case Nkind (Def) is
           when N_Formal_Private_Type_Definition         =>
--- 2049,2055 ----
              Defining_Identifier (First (Discriminant_Specifications (N))));
        end if;
  
!       --  Enter the new name, and branch to specific routine
  
        case Nkind (Def) is
           when N_Formal_Private_Type_Definition         =>
*************** package body Sem_Ch12 is
*** 2031,2036 ****
--- 2084,2098 ----
                N_Access_Procedure_Definition            =>
              Analyze_Generic_Access_Type (T, Def);
  
+          --  Ada 2005: a interface declaration is encoded as an abstract
+          --  record declaration or a abstract type derivation.
+ 
+          when N_Record_Definition                      =>
+             Analyze_Formal_Interface_Type (T, Def);
+ 
+          when N_Derived_Type_Definition                =>
+             Analyze_Formal_Derived_Interface_Type (T, Def);
+ 
           when N_Error                                  =>
              null;
  
*************** package body Sem_Ch12 is
*** 2159,2165 ****
        Id := Defining_Entity (N);
        Generate_Definition (Id);
  
!       --  Expansion is not applied to generic units.
  
        Start_Generic;
  
--- 2221,2227 ----
        Id := Defining_Entity (N);
        Generate_Definition (Id);
  
!       --  Expansion is not applied to generic units
  
        Start_Generic;
  
*************** package body Sem_Ch12 is
*** 2227,2232 ****
--- 2289,2295 ----
        Id          : Entity_Id;
        Formals     : List_Id;
        New_N       : Node_Id;
+       Result_Type : Entity_Id;
        Save_Parent : Node_Id;
  
     begin
*************** package body Sem_Ch12 is
*** 2270,2286 ****
  
        if Nkind (Spec) = N_Function_Specification then
           Set_Ekind (Id, E_Generic_Function);
!          Find_Type (Subtype_Mark (Spec));
!          Set_Etype (Id, Entity (Subtype_Mark (Spec)));
        else
           Set_Ekind (Id, E_Generic_Procedure);
           Set_Etype (Id, Standard_Void_Type);
        end if;
  
!       --  For a library unit, we have reconstructed the entity for the
!       --  unit, and must reset it in the library tables. We also need
!       --  to make sure that Body_Required is set properly in the original
!       --  compilation unit node.
  
        if Nkind (Parent (N)) = N_Compilation_Unit then
           Set_Cunit_Entity (Current_Sem_Unit, Id);
--- 2333,2355 ----
  
        if Nkind (Spec) = N_Function_Specification then
           Set_Ekind (Id, E_Generic_Function);
! 
!          if Nkind (Result_Definition (Spec)) = N_Access_Definition then
!             Result_Type := Access_Definition (Spec, Result_Definition (Spec));
!             Set_Etype (Id, Result_Type);
!          else
!             Find_Type (Result_Definition (Spec));
!             Set_Etype (Id, Entity (Result_Definition (Spec)));
!          end if;
! 
        else
           Set_Ekind (Id, E_Generic_Procedure);
           Set_Etype (Id, Standard_Void_Type);
        end if;
  
!       --  For a library unit, we have reconstructed the entity for the unit,
!       --  and must reset it in the library tables. We also make sure that
!       --  Body_Required is set properly in the original compilation unit node.
  
        if Nkind (Parent (N)) = N_Compilation_Unit then
           Set_Cunit_Entity (Current_Sem_Unit, Id);
*************** package body Sem_Ch12 is
*** 2302,2310 ****
     -- Analyze_Package_Instantiation --
     -----------------------------------
  
!    --  Note: this procedure is also used for formal package declarations,
!    --  in which case the argument N is an N_Formal_Package_Declaration
!    --  node. This should really be noted in the spec! ???
  
     procedure Analyze_Package_Instantiation (N : Node_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
--- 2371,2379 ----
     -- Analyze_Package_Instantiation --
     -----------------------------------
  
!    --  Note: this procedure is also used for formal package declarations, in
!    --  which case the argument N is an N_Formal_Package_Declaration node.
!    --  This should really be noted in the spec! ???
  
     procedure Analyze_Package_Instantiation (N : Node_Id) is
        Loc    : constant Source_Ptr := Sloc (N);
*************** package body Sem_Ch12 is
*** 2322,2327 ****
--- 2391,2397 ----
        Is_Actual_Pack : constant Boolean :=
                           Is_Internal (Defining_Entity (N));
  
+       Env_Installed    : Boolean := False;
        Parent_Installed : Boolean := False;
        Renaming_List    : List_Id;
        Unit_Renaming    : Node_Id;
*************** package body Sem_Ch12 is
*** 2385,2391 ****
  
        Text_IO_Kludge (Name (N));
  
!       --  Make node global for error reporting.
  
        Instantiation_Node := N;
  
--- 2455,2461 ----
  
        Text_IO_Kludge (Name (N));
  
!       --  Make node global for error reporting
  
        Instantiation_Node := N;
  
*************** package body Sem_Ch12 is
*** 2415,2420 ****
--- 2485,2491 ----
        Pre_Analyze_Actuals (N);
  
        Init_Env;
+       Env_Installed := True;
        Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
        Gen_Unit := Entity (Gen_Id);
  
*************** package body Sem_Ch12 is
*** 2467,2473 ****
  
        Set_Entity (Gen_Id, Gen_Unit);
  
!       --  If generic is a renaming, get original generic unit.
  
        if Present (Renamed_Object (Gen_Unit))
          and then Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Package
--- 2538,2544 ----
  
        Set_Entity (Gen_Id, Gen_Unit);
  
!       --  If generic is a renaming, get original generic unit
  
        if Present (Renamed_Object (Gen_Unit))
          and then Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Package
*************** package body Sem_Ch12 is
*** 2475,2481 ****
           Gen_Unit := Renamed_Object (Gen_Unit);
        end if;
  
!       --  Verify that there are no circular instantiations.
  
        if In_Open_Scopes (Gen_Unit) then
           Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
--- 2546,2552 ----
           Gen_Unit := Renamed_Object (Gen_Unit);
        end if;
  
!       --  Verify that there are no circular instantiations
  
        if In_Open_Scopes (Gen_Unit) then
           Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
*************** package body Sem_Ch12 is
*** 2505,2511 ****
  
           Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
  
!          --  Copy original generic tree, to produce text for instantiation.
  
           Act_Tree :=
             Copy_Generic_Node
--- 2576,2582 ----
  
           Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
  
!          --  Copy original generic tree, to produce text for instantiation
  
           Act_Tree :=
             Copy_Generic_Node
*************** package body Sem_Ch12 is
*** 2610,2626 ****
              --  generic is not a child unit of another generic, to avoid scope
              --  problems and the reinstallation of parent instances.
  
!             if Front_End_Inlining
!               and then Expander_Active
                and then (not Is_Child_Unit (Gen_Unit)
                           or else not Is_Generic_Unit (Scope (Gen_Unit)))
-               and then (Is_In_Main_Unit (N)
-                           or else In_Main_Context (Current_Scope))
-               and then Nkind (Parent (N)) /= N_Compilation_Unit
                and then Might_Inline_Subp
                and then not Is_Actual_Pack
              then
!                Inline_Now := True;
              end if;
  
              Needs_Body :=
--- 2681,2723 ----
              --  generic is not a child unit of another generic, to avoid scope
              --  problems and the reinstallation of parent instances.
  
!             if Expander_Active
                and then (not Is_Child_Unit (Gen_Unit)
                           or else not Is_Generic_Unit (Scope (Gen_Unit)))
                and then Might_Inline_Subp
                and then not Is_Actual_Pack
              then
!                if Front_End_Inlining
!                  and then (Is_In_Main_Unit (N)
!                             or else In_Main_Context (Current_Scope))
!                  and then Nkind (Parent (N)) /= N_Compilation_Unit
!                then
!                   Inline_Now := True;
! 
!                --  In configurable_run_time mode we force the inlining of
!                --  predefined subprogram marked Inline_Always, to minimize
!                --  the use of the run-time library.
! 
!                elsif Is_Predefined_File_Name
!                        (Unit_File_Name (Get_Source_Unit (Gen_Decl)))
!                  and then Configurable_Run_Time_Mode
!                  and then Nkind (Parent (N)) /= N_Compilation_Unit
!                then
!                   Inline_Now := True;
!                end if;
! 
!                --  If the current scope is itself an instance within a child
!                --  unit, and that unit itself is not an instance, it is
!                --  duplicated in the scope stack, and the unstacking mechanism
!                --  in Inline_Instance_Body will fail. This loses some rare
!                --  cases of optimization, and might be improved some day ????
! 
!                if Is_Generic_Instance (Current_Scope)
!                   and then Is_Child_Unit (Scope (Current_Scope))
!                   and then not Is_Generic_Instance (Scope (Current_Scope))
!                then
!                   Inline_Now := False;
!                end if;
              end if;
  
              Needs_Body :=
*************** package body Sem_Ch12 is
*** 2631,2637 ****
                             or else Might_Inline_Subp)
                  and then not Is_Actual_Pack
                  and then not Inline_Now
- 
                  and then (Operating_Mode = Generate_Code
                              or else (Operating_Mode = Check_Semantics
                                        and then ASIS_Mode));
--- 2728,2733 ----
*************** package body Sem_Ch12 is
*** 2647,2658 ****
              end if;
  
              --  If the current context is generic, and the package being
!             --  instantiated is declared within a formal package, there
!             --  is no body to instantiate until the enclosing generic is
!             --  instantiated, and there is an actual for the formal
!             --  package. If the formal package has parameters, we build a
!             --  regular package instance for it, that preceeds the original
!             --  formal package declaration.
  
              if In_Open_Scopes (Scope (Scope (Gen_Unit))) then
                 declare
--- 2743,2753 ----
              end if;
  
              --  If the current context is generic, and the package being
!             --  instantiated is declared within a formal package, there is no
!             --  body to instantiate until the enclosing generic is instantiated
!             --  and there is an actual for the formal package. If the formal
!             --  package has parameters, we build regular package instance for
!             --  it, that preceeds the original formal package declaration.
  
              if In_Open_Scopes (Scope (Scope (Gen_Unit))) then
                 declare
*************** package body Sem_Ch12 is
*** 2673,2681 ****
              end if;
           end;
  
!          --  If we are generating the calling stubs from the instantiation
!          --  of a generic RCI package, we will not use the body of the
!          --  generic package.
  
           if Distribution_Stub_Mode = Generate_Caller_Stub_Body
             and then Is_Compilation_Unit (Defining_Entity (N))
--- 2768,2776 ----
              end if;
           end;
  
!          --  If we are generating the calling stubs from the instantiation of
!          --  a generic RCI package, we will not use the body of the generic
!          --  package.
  
           if Distribution_Stub_Mode = Generate_Caller_Stub_Body
             and then Is_Compilation_Unit (Defining_Entity (N))
*************** package body Sem_Ch12 is
*** 2812,2826 ****
  
                 Set_Cunit_Entity (Current_Sem_Unit, Act_Decl_Id);
  
!                --  If this is the main unit, replace the main entity as well.
  
                 if Current_Sem_Unit = Main_Unit then
                    Main_Unit_Entity := Act_Decl_Id;
                 end if;
              end if;
  
              Set_Unit (Parent (N), Act_Decl);
              Set_Parent_Spec (Act_Decl, Parent_Spec (N));
              Analyze (Act_Decl);
              Set_Unit (Parent (N), N);
              Set_Body_Required (Parent (N), False);
--- 2907,2925 ----
  
                 Set_Cunit_Entity (Current_Sem_Unit, Act_Decl_Id);
  
!                --  If this is the main unit, replace the main entity as well
  
                 if Current_Sem_Unit = Main_Unit then
                    Main_Unit_Entity := Act_Decl_Id;
                 end if;
              end if;
  
+             --  There is a problem with inlining here
+             --  More comments needed??? what problem
+ 
              Set_Unit (Parent (N), Act_Decl);
              Set_Parent_Spec (Act_Decl, Parent_Spec (N));
+             Set_Package_Instantiation (Act_Decl_Id, N);
              Analyze (Act_Decl);
              Set_Unit (Parent (N), N);
              Set_Body_Required (Parent (N), False);
*************** package body Sem_Ch12 is
*** 2873,2878 ****
--- 2972,2978 ----
           end if;
  
           Restore_Env;
+          Env_Installed := False;
        end if;
  
        Validate_Categorization_Dependency (N, Act_Decl_Id);
*************** package body Sem_Ch12 is
*** 2906,2911 ****
--- 3006,3015 ----
           if Parent_Installed then
              Remove_Parent;
           end if;
+ 
+          if Env_Installed then
+             Restore_Env;
+          end if;
     end Analyze_Package_Instantiation;
  
     --------------------------
*************** package body Sem_Ch12 is
*** 2934,2956 ****
        S            : Entity_Id;
  
     begin
!       --  Case of generic unit defined in another unit. We must remove
!       --  the complete context of the current unit to install that of
!       --  the generic.
  
        if Gen_Comp /= Cunit_Entity (Current_Sem_Unit) then
           S := Current_Scope;
  
!          while Present (S)
!            and then S /= Standard_Standard
!          loop
!             Num_Scopes := Num_Scopes + 1;
  
!             Use_Clauses (Num_Scopes) :=
!               (Scope_Stack.Table
!                  (Scope_Stack.Last - Num_Scopes + 1).
!                     First_Use_Clause);
!             End_Use_Clauses (Use_Clauses (Num_Scopes));
  
              exit when Is_Generic_Instance (S)
                and then (In_Package_Body (S)
--- 3038,3066 ----
        S            : Entity_Id;
  
     begin
!       --  Case of generic unit defined in another unit. We must remove the
!       --  complete context of the current unit to install that of the generic.
  
        if Gen_Comp /= Cunit_Entity (Current_Sem_Unit) then
+ 
+          --  Add some comments for the following two loops ???
+ 
           S := Current_Scope;
+          while Present (S) and then S /= Standard_Standard loop
+             loop
+                Num_Scopes := Num_Scopes + 1;
  
!                Use_Clauses (Num_Scopes) :=
!                  (Scope_Stack.Table
!                     (Scope_Stack.Last - Num_Scopes + 1).
!                        First_Use_Clause);
!                End_Use_Clauses (Use_Clauses (Num_Scopes));
  
!                exit when Scope_Stack.Last - Num_Scopes + 1 = Scope_Stack.First
!                  or else Scope_Stack.Table
!                            (Scope_Stack.Last - Num_Scopes).Entity
!                              = Scope (S);
!             end loop;
  
              exit when Is_Generic_Instance (S)
                and then (In_Package_Body (S)
*************** package body Sem_Ch12 is
*** 2978,2989 ****
              S := Scope (S);
           end loop;
  
!          --  Remove context of current compilation unit, unless we
!          --  are within a nested package instantiation, in which case
!          --  the context has been removed previously.
  
!          --  If current scope is the body of a child unit, remove context
!          --  of spec as well.
  
           S := Current_Scope;
  
--- 3088,3099 ----
              S := Scope (S);
           end loop;
  
!          --  Remove context of current compilation unit, unless we are within a
!          --  nested package instantiation, in which case the context has been
!          --  removed previously.
  
!          --  If current scope is the body of a child unit, remove context of
!          --  spec as well.
  
           S := Current_Scope;
  
*************** package body Sem_Ch12 is
*** 3006,3012 ****
                 Removed := True;
  
                 --  Remove entities in current scopes from visibility, so
!                --  than instance body is compiled in a clean environment.
  
                 Save_Scope_Stack (Handle_Use => False);
  
--- 3116,3122 ----
                 Removed := True;
  
                 --  Remove entities in current scopes from visibility, so
!                --  that instance body is compiled in a clean environment.
  
                 Save_Scope_Stack (Handle_Use => False);
  
*************** package body Sem_Ch12 is
*** 3037,3042 ****
--- 3147,3153 ----
  
              S := Scope (S);
           end loop;
+          pragma Assert (Num_Inner < Num_Scopes);
  
           New_Scope (Standard_Standard);
           Scope_Stack.Table (Scope_Stack.Last).Is_Active_Stack_Base := True;
*************** package body Sem_Ch12 is
*** 3065,3071 ****
                 New_Scope (Curr_Scope);
                 Set_Is_Immediately_Visible (Curr_Scope);
  
!                --  Finally, restore inner scopes as well.
  
                 for J in reverse 1 .. Num_Inner loop
                    New_Scope (Inner_Scopes (J));
--- 3176,3182 ----
                 New_Scope (Curr_Scope);
                 Set_Is_Immediately_Visible (Curr_Scope);
  
!                --  Finally, restore inner scopes as well
  
                 for J in reverse 1 .. Num_Inner loop
                    New_Scope (Inner_Scopes (J));
*************** package body Sem_Ch12 is
*** 3073,3084 ****
              end if;
  
              Restore_Scope_Stack (Handle_Use => False);
           end if;
  
!          --  Restore use clauses. For a child unit, use clauses in the
!          --  parents are restored when installing the context, so only
!          --  those in inner scopes (and those local to the child unit itself)
!          --  need to be installed explicitly.
  
           if Is_Child_Unit (Curr_Unit)
             and then Removed
--- 3184,3217 ----
              end if;
  
              Restore_Scope_Stack (Handle_Use => False);
+ 
+             if Present (Curr_Scope)
+               and then
+                 (In_Private_Part (Curr_Scope)
+                   or else In_Package_Body (Curr_Scope))
+             then
+                --  Install private declaration of ancestor units, which
+                --  are currently available. Restore_Scope_Stack and
+                --  Install_Context only install the visible part of parents.
+ 
+                declare
+                   Par : Entity_Id;
+                begin
+                   Par := Scope (Curr_Scope);
+                   while (Present (Par))
+                     and then Par /= Standard_Standard
+                   loop
+                      Install_Private_Declarations (Par);
+                      Par := Scope (Par);
+                   end loop;
+                end;
+             end if;
           end if;
  
!          --  Restore use clauses. For a child unit, use clauses in the parents
!          --  are restored when installing the context, so only those in inner
!          --  scopes (and those local to the child unit itself) need to be
!          --  installed explicitly.
  
           if Is_Child_Unit (Curr_Unit)
             and then Removed
*************** package body Sem_Ch12 is
*** 3101,3107 ****
              Set_Is_Generic_Instance (Instances (J), True);
           end loop;
  
!       --  If generic unit is in current unit, current context is correct.
  
        else
           Instantiate_Package_Body
--- 3234,3240 ----
              Set_Is_Generic_Instance (Instances (J), True);
           end loop;
  
!       --  If generic unit is in current unit, current context is correct
  
        else
           Instantiate_Package_Body
*************** package body Sem_Ch12 is
*** 3139,3144 ****
--- 3272,3278 ----
        Act_Spec    : Node_Id;
        Act_Tree    : Node_Id;
  
+       Env_Installed    : Boolean := False;
        Gen_Unit         : Entity_Id;
        Gen_Decl         : Node_Id;
        Pack_Id          : Entity_Id;
*************** package body Sem_Ch12 is
*** 3280,3286 ****
              Set_Cunit_Entity (Current_Sem_Unit, Pack_Id);
           end if;
  
!          --  The instance is not a freezing point for the new subprogram.
  
           Set_Is_Frozen (Act_Decl_Id, False);
  
--- 3414,3420 ----
              Set_Cunit_Entity (Current_Sem_Unit, Pack_Id);
           end if;
  
!          --  The instance is not a freezing point for the new subprogram
  
           Set_Is_Frozen (Act_Decl_Id, False);
  
*************** package body Sem_Ch12 is
*** 3309,3320 ****
  
        Text_IO_Kludge (Gen_Id);
  
!       --  Make node global for error reporting.
  
        Instantiation_Node := N;
        Pre_Analyze_Actuals (N);
  
        Init_Env;
        Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
        Gen_Unit := Entity (Gen_Id);
  
--- 3443,3455 ----
  
        Text_IO_Kludge (Gen_Id);
  
!       --  Make node global for error reporting
  
        Instantiation_Node := N;
        Pre_Analyze_Actuals (N);
  
        Init_Env;
+       Env_Installed := True;
        Check_Generic_Child_Unit (Gen_Id, Parent_Installed);
        Gen_Unit := Entity (Gen_Id);
  
*************** package body Sem_Ch12 is
*** 3400,3413 ****
  
           Set_Instance_Env (Gen_Unit, Empty);
  
!          --  Initialize renamings map, for error checking.
  
           Generic_Renamings.Set_Last (0);
           Generic_Renamings_HTable.Reset;
  
           Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
  
!          --  Copy original generic tree, to produce text for instantiation.
  
           Act_Tree :=
             Copy_Generic_Node
--- 3535,3548 ----
  
           Set_Instance_Env (Gen_Unit, Empty);
  
!          --  Initialize renamings map, for error checking
  
           Generic_Renamings.Set_Last (0);
           Generic_Renamings_HTable.Reset;
  
           Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
  
!          --  Copy original generic tree, to produce text for instantiation
  
           Act_Tree :=
             Copy_Generic_Node
*************** package body Sem_Ch12 is
*** 3466,3471 ****
--- 3601,3630 ----
              Check_Elab_Instantiation (N);
           end if;
  
+          if Is_Dispatching_Operation (Act_Decl_Id)
+            and then Ada_Version >= Ada_05
+          then
+             declare
+                Formal : Entity_Id;
+ 
+             begin
+                Formal := First_Formal (Act_Decl_Id);
+                while Present (Formal) loop
+                   if Ekind (Etype (Formal)) = E_Anonymous_Access_Type
+                     and then Is_Controlling_Formal (Formal)
+                     and then not Can_Never_Be_Null (Formal)
+                   then
+                      Error_Msg_NE ("access parameter& is controlling,",
+                        N, Formal);
+                      Error_Msg_NE ("\corresponding parameter of & must be"
+                        & " explicitly null-excluding", N, Gen_Id);
+                   end if;
+ 
+                   Next_Formal (Formal);
+                end loop;
+             end;
+          end if;
+ 
           Check_Hidden_Child_Unit (N, Gen_Unit, Act_Decl_Id);
  
           --  Subject to change, pending on if other pragmas are inherited ???
*************** package body Sem_Ch12 is
*** 3473,3479 ****
           Validate_Categorization_Dependency (N, Act_Decl_Id);
  
           if not Is_Intrinsic_Subprogram (Act_Decl_Id) then
- 
              if not Generic_Separately_Compiled (Gen_Unit) then
                 Inherit_Context (Gen_Decl, N);
              end if;
--- 3632,3637 ----
*************** package body Sem_Ch12 is
*** 3487,3493 ****
                    or else Is_Inlined (Act_Decl_Id))
                and then (Operating_Mode = Generate_Code
                            or else (Operating_Mode = Check_Semantics
!                                     and then ASIS_Mode))
                and then (Expander_Active or else ASIS_Mode)
                and then not ABE_Is_Certain (N)
                and then not Is_Eliminated (Act_Decl_Id)
--- 3645,3651 ----
                    or else Is_Inlined (Act_Decl_Id))
                and then (Operating_Mode = Generate_Code
                            or else (Operating_Mode = Check_Semantics
!                                      and then ASIS_Mode))
                and then (Expander_Active or else ASIS_Mode)
                and then not ABE_Is_Certain (N)
                and then not Is_Eliminated (Act_Decl_Id)
*************** package body Sem_Ch12 is
*** 3526,3531 ****
--- 3684,3690 ----
           end if;
  
           Restore_Env;
+          Env_Installed := False;
           Generic_Renamings.Set_Last (0);
           Generic_Renamings_HTable.Reset;
        end if;
*************** package body Sem_Ch12 is
*** 3535,3540 ****
--- 3694,3703 ----
           if Parent_Installed then
              Remove_Parent;
           end if;
+ 
+          if Env_Installed then
+             Restore_Env;
+          end if;
     end Analyze_Subprogram_Instantiation;
  
     -------------------------
*************** package body Sem_Ch12 is
*** 3626,3632 ****
        Set_Library_Unit  (Decl_Cunit, Body_Cunit);
        Set_Library_Unit  (Body_Cunit, Decl_Cunit);
  
!       --  Preserve the private nature of the package if needed.
  
        Set_Private_Present (Decl_Cunit, Private_Present (Body_Cunit));
  
--- 3789,3795 ----
        Set_Library_Unit  (Decl_Cunit, Body_Cunit);
        Set_Library_Unit  (Body_Cunit, Decl_Cunit);
  
!       --  Preserve the private nature of the package if needed
  
        Set_Private_Present (Decl_Cunit, Private_Present (Body_Cunit));
  
*************** package body Sem_Ch12 is
*** 3730,3735 ****
--- 3893,3899 ----
          (E1, E2 : Entity_Id) return Boolean
        is
           Ent : Entity_Id;
+ 
        begin
           Ent := E2;
           while Present (Ent) loop
*************** package body Sem_Ch12 is
*** 3767,3773 ****
          (E1, E2 : Entity_Id) return Boolean
        is
           function Original_Entity (E : Entity_Id) return Entity_Id;
!          --  Follow chain of renamings to the ultimate ancestor.
  
           ---------------------
           -- Original_Entity --
--- 3931,3937 ----
          (E1, E2 : Entity_Id) return Boolean
        is
           function Original_Entity (E : Entity_Id) return Entity_Id;
!          --  Follow chain of renamings to the ultimate ancestor
  
           ---------------------
           -- Original_Entity --
*************** package body Sem_Ch12 is
*** 4147,4153 ****
        function Find_Generic_Child
          (Scop : Entity_Id;
           Id   : Node_Id) return Entity_Id;
!       --  Search generic parent for possible child unit with the given name.
  
        function In_Enclosing_Instance return Boolean;
        --  Within an instance of the parent, the child unit may be denoted
--- 4311,4317 ----
        function Find_Generic_Child
          (Scop : Entity_Id;
           Id   : Node_Id) return Entity_Id;
!       --  Search generic parent for possible child unit with the given name
  
        function In_Enclosing_Instance return Boolean;
        --  Within an instance of the parent, the child unit may be denoted
*************** package body Sem_Ch12 is
*** 4208,4215 ****
           Instance_Decl      : Node_Id;
  
        begin
!          Enclosing_Instance := Current_Scope;
  
           while Present (Enclosing_Instance) loop
              Instance_Decl := Unit_Declaration_Node (Enclosing_Instance);
  
--- 4372,4389 ----
           Instance_Decl      : Node_Id;
  
        begin
!          --  We do not inline any call that contains instantiations, except
!          --  for instantiations of Unchecked_Conversion, so if we are within
!          --  an inlined body the current instance does not require parents.
  
+          if In_Inlined_Body then
+             pragma Assert (Chars (Gen_Id) = Name_Unchecked_Conversion);
+             return False;
+          end if;
+ 
+          --  Loop to check enclosing scopes
+ 
+          Enclosing_Instance := Current_Scope;
           while Present (Enclosing_Instance) loop
              Instance_Decl := Unit_Declaration_Node (Enclosing_Instance);
  
*************** package body Sem_Ch12 is
*** 4314,4320 ****
                 Set_Entity (S, E);
                 Set_Etype (S, Etype (E));
  
!                --  Indicate that this is a reference to the parent.
  
                 if In_Extended_Main_Source_Unit (Gen_Id) then
                    Set_Is_Instantiated (Inst_Par);
--- 4488,4494 ----
                 Set_Entity (S, E);
                 Set_Etype (S, Etype (E));
  
!                --  Indicate that this is a reference to the parent
  
                 if In_Extended_Main_Source_Unit (Gen_Id) then
                    Set_Is_Instantiated (Inst_Par);
*************** package body Sem_Ch12 is
*** 4526,4532 ****
              elsif Nkind (Parent (N)) = N_Subtype_Declaration
                or else not In_Private_Part (Scope (Base_Type (T)))
              then
!                Append_Elmt (T, Exchanged_Views);
                 Exchange_Declarations (Etype (Get_Associated_Node (N)));
              end if;
  
--- 4700,4706 ----
              elsif Nkind (Parent (N)) = N_Subtype_Declaration
                or else not In_Private_Part (Scope (Base_Type (T)))
              then
!                Prepend_Elmt (T, Exchanged_Views);
                 Exchange_Declarations (Etype (Get_Associated_Node (N)));
              end if;
  
*************** package body Sem_Ch12 is
*** 4567,4573 ****
             and then not Is_Generic_Type (BT)
             and then not In_Open_Scopes (BT)
           then
!             Append_Elmt (Full_View (BT), Exchanged_Views);
              Exchange_Declarations (BT);
           end if;
        end if;
--- 4741,4747 ----
             and then not Is_Generic_Type (BT)
             and then not In_Open_Scopes (BT)
           then
!             Prepend_Elmt (Full_View (BT), Exchanged_Views);
              Exchange_Declarations (BT);
           end if;
        end if;
*************** package body Sem_Ch12 is
*** 4630,4636 ****
                 Next_Elmt (Elmt);
              end loop;
  
!             --  Indicate that Inner is being instantiated within  Scop.
  
              Append_Elmt (Inner, Inner_Instances (Scop));
           end if;
--- 4804,4810 ----
                 Next_Elmt (Elmt);
              end loop;
  
!             --  Indicate that Inner is being instantiated within Scop
  
              Append_Elmt (Inner, Inner_Instances (Scop));
           end if;
*************** package body Sem_Ch12 is
*** 4664,4678 ****
        --  value (Sloc, Uint, Char) in which case it need not be copied.
  
        procedure Copy_Descendants;
!       --  Common utility for various nodes.
  
        function Copy_Generic_Elist (E : Elist_Id) return Elist_Id;
!       --  Make copy of element list.
  
        function Copy_Generic_List
          (L         : List_Id;
           Parent_Id : Node_Id) return List_Id;
!       --  Apply Copy_Node recursively to the members of a node list.
  
        function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
        --  True if an identifier is part of the defining program unit name
--- 4838,4852 ----
        --  value (Sloc, Uint, Char) in which case it need not be copied.
  
        procedure Copy_Descendants;
!       --  Common utility for various nodes
  
        function Copy_Generic_Elist (E : Elist_Id) return Elist_Id;
!       --  Make copy of element list
  
        function Copy_Generic_List
          (L         : List_Id;
           Parent_Id : Node_Id) return List_Id;
!       --  Apply Copy_Node recursively to the members of a node list
  
        function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
        --  True if an identifier is part of the defining program unit name
*************** package body Sem_Ch12 is
*** 5164,5170 ****
  
           begin
              if Present (T) then
!                --  Retrieve the allocator node in the generic copy.
  
                 Acc_T := Etype (Parent (Parent (T)));
                 if Present (Acc_T)
--- 5338,5344 ----
  
           begin
              if Present (T) then
!                --  Retrieve the allocator node in the generic copy
  
                 Acc_T := Etype (Parent (Parent (T)));
                 if Present (Acc_T)
*************** package body Sem_Ch12 is
*** 5387,5393 ****
        --  node for it.
  
        function True_Parent (N : Node_Id) return Node_Id;
!       --  For a subunit, return parent of corresponding stub.
  
        -------------
        -- Earlier --
--- 5561,5567 ----
        --  node for it.
  
        function True_Parent (N : Node_Id) return Node_Id;
!       --  For a subunit, return parent of corresponding stub
  
        -------------
        -- Earlier --
*************** package body Sem_Ch12 is
*** 5400,5406 ****
           P2 : Node_Id := N2;
  
           procedure Find_Depth (P : in out Node_Id; D : in out Integer);
!          --  Find distance from given node to enclosing compilation unit.
  
           ----------------
           -- Find_Depth --
--- 5574,5580 ----
           P2 : Node_Id := N2;
  
           procedure Find_Depth (P : in out Node_Id; D : in out Integer);
!          --  Find distance from given node to enclosing compilation unit
  
           ----------------
           -- Find_Depth --
*************** package body Sem_Ch12 is
*** 5662,5667 ****
--- 5836,5859 ----
        Inst : Node_Id;
  
     begin
+       --  If the Package_Instantiation attribute has been set on the package
+       --  entity, then use it directly when it (or its Original_Node) refers
+       --  to an N_Package_Instantiation node. In principle it should be
+       --  possible to have this field set in all cases, which should be
+       --  investigated, and would allow this function to be significantly
+       --  simplified. ???
+ 
+       if Present (Package_Instantiation (A)) then
+          if Nkind (Package_Instantiation (A)) = N_Package_Instantiation then
+             return Package_Instantiation (A);
+ 
+          elsif Nkind (Original_Node (Package_Instantiation (A)))
+                  = N_Package_Instantiation
+          then
+             return Original_Node (Package_Instantiation (A));
+          end if;
+       end if;
+ 
        --  If the instantiation is a compilation unit that does not need a
        --  body then the instantiation node has been rewritten as a package
        --  declaration for the instance, and we return the original node.
*************** package body Sem_Ch12 is
*** 5780,5790 ****
        Saved : Instance_Env;
  
     begin
!       Saved.Ada_Version         := Ada_Version;
!       Saved.Instantiated_Parent := Current_Instantiated_Parent;
!       Saved.Exchanged_Views     := Exchanged_Views;
!       Saved.Hidden_Entities     := Hidden_Entities;
!       Saved.Current_Sem_Unit    := Current_Sem_Unit;
        Instance_Envs.Increment_Last;
        Instance_Envs.Table (Instance_Envs.Last) := Saved;
  
--- 5972,5985 ----
        Saved : Instance_Env;
  
     begin
!       Saved.Ada_Version          := Ada_Version;
!       Saved.Ada_Version_Explicit := Ada_Version_Explicit;
!       Saved.Instantiated_Parent  := Current_Instantiated_Parent;
!       Saved.Exchanged_Views      := Exchanged_Views;
!       Saved.Hidden_Entities      := Hidden_Entities;
!       Saved.Current_Sem_Unit     := Current_Sem_Unit;
!       Saved.Parent_Unit_Visible  := Parent_Unit_Visible;
!       Saved.Instance_Parent_Unit := Instance_Parent_Unit;
        Instance_Envs.Increment_Last;
        Instance_Envs.Table (Instance_Envs.Last) := Saved;
  
*************** package body Sem_Ch12 is
*** 5980,5986 ****
        Must_Delay : Boolean;
  
        function Enclosing_Subp (Id : Entity_Id) return Entity_Id;
!       --  Find subprogram (if any) that encloses instance and/or generic body.
  
        function True_Sloc (N : Node_Id) return Source_Ptr;
        --  If the instance is nested inside a generic unit, the Sloc of the
--- 6175,6181 ----
        Must_Delay : Boolean;
  
        function Enclosing_Subp (Id : Entity_Id) return Entity_Id;
!       --  Find subprogram (if any) that encloses instance and/or generic body
  
        function True_Sloc (N : Node_Id) return Source_Ptr;
        --  If the instance is nested inside a generic unit, the Sloc of the
*************** package body Sem_Ch12 is
*** 5988,5994 ****
        --  point of the current enclosing instance. Pending a better usage of
        --  Slocs to indicate instantiation places, we determine the place of
        --  origin of a node by finding the maximum sloc of any ancestor node.
!       --  Why is this not equivalent fo Top_Level_Location ???
  
        --------------------
        -- Enclosing_Subp --
--- 6183,6189 ----
        --  point of the current enclosing instance. Pending a better usage of
        --  Slocs to indicate instantiation places, we determine the place of
        --  origin of a node by finding the maximum sloc of any ancestor node.
!       --  Why is this not equivalent to Top_Level_Location ???
  
        --------------------
        -- Enclosing_Subp --
*************** package body Sem_Ch12 is
*** 6147,6153 ****
        --  for the unit itself.
  
        procedure Install_Noninstance_Specs (Par : Entity_Id);
!       --  Install the scopes of noninstance parent units ending with Par.
  
        procedure Install_Spec (Par : Entity_Id);
        --  The child unit is within the declarative part of the parent, so
--- 6342,6348 ----
        --  for the unit itself.
  
        procedure Install_Noninstance_Specs (Par : Entity_Id);
!       --  Install the scopes of noninstance parent units ending with Par
  
        procedure Install_Spec (Par : Entity_Id);
        --  The child unit is within the declarative part of the parent, so
*************** package body Sem_Ch12 is
*** 6162,6174 ****
  
        begin
           E := First_Entity (Par);
- 
           while Present (E) loop
- 
              if Ekind (E) = E_Package
                and then Nkind (Parent (E)) = N_Package_Renaming_Declaration
              then
!                --  If this is the renaming for the parent instance, done.
  
                 if Renamed_Object (E) = Par then
                    exit;
--- 6357,6367 ----
  
        begin
           E := First_Entity (Par);
           while Present (E) loop
              if Ekind (E) = E_Package
                and then Nkind (Parent (E)) = N_Package_Renaming_Declaration
              then
!                --  If this is the renaming for the parent instance, done
  
                 if Renamed_Object (E) = Par then
                    exit;
*************** package body Sem_Ch12 is
*** 6215,6226 ****
                    Specification (Unit_Declaration_Node (Par));
  
        begin
           New_Scope (Par);
           Set_Is_Immediately_Visible   (Par);
           Install_Visible_Declarations (Par);
-          Install_Private_Declarations (Par);
           Set_Use (Visible_Declarations (Spec));
!          Set_Use (Private_Declarations (Spec));
        end Install_Spec;
  
     --  Start of processing for Install_Parent
--- 6408,6450 ----
                    Specification (Unit_Declaration_Node (Par));
  
        begin
+          --  If this parent of the child instance is a top-level unit,
+          --  then record the unit and its visibility for later resetting
+          --  in Remove_Parent. We exclude units that are generic instances,
+          --  as we only want to record this information for the ultimate
+          --  top-level noninstance parent (is that always correct???).
+ 
+          if Scope (Par) = Standard_Standard
+            and then not Is_Generic_Instance (Par)
+          then
+             Parent_Unit_Visible := Is_Immediately_Visible (Par);
+             Instance_Parent_Unit := Par;
+          end if;
+ 
+          --  Open the parent scope and make it and its declarations visible.
+          --  If this point is not within a body, then only the visible
+          --  declarations should be made visible, and installation of the
+          --  private declarations is deferred until the appropriate point
+          --  within analysis of the spec being instantiated (see the handling
+          --  of parent visibility in Analyze_Package_Specification). This is
+          --  relaxed in the case where the parent unit is Ada.Tags, to avoid
+          --  private view problems that occur when compiling instantiations of
+          --  a generic child of that package (Generic_Dispatching_Constructor).
+          --  If the instance freezes a tagged type, inlinings of operations
+          --  from Ada.Tags may need the full view of type Tag. If inlining
+          --  took proper account of establishing visibility of inlined
+          --  subprograms' parents then it should be possible to remove this
+          --  special check. ???
+ 
           New_Scope (Par);
           Set_Is_Immediately_Visible   (Par);
           Install_Visible_Declarations (Par);
           Set_Use (Visible_Declarations (Spec));
! 
!          if In_Body or else Is_RTU (Par, Ada_Tags) then
!             Install_Private_Declarations (Par);
!             Set_Use (Private_Declarations (Spec));
!          end if;
        end Install_Spec;
  
     --  Start of processing for Install_Parent
*************** package body Sem_Ch12 is
*** 6465,6478 ****
                    Formal_Node : Node_Id;
                    Formal_Ent  : Entity_Id;
  
!                   Gen_Decl : constant Node_Id :=
!                                Unit_Declaration_Node
!                                  (Entity (Name (Orig_Node)));
! 
!                   Formals : constant List_Id :=
!                               Generic_Formal_Declarations (Gen_Decl);
  
                 begin
                    if Present (Formals) then
                       Formal_Node := First_Non_Pragma (Formals);
                    else
--- 6689,6713 ----
                    Formal_Node : Node_Id;
                    Formal_Ent  : Entity_Id;
  
!                   Gen_Decl : Node_Id;
!                   Formals  : List_Id;
  
                 begin
+                   --  The actual may be a renamed generic package, in which
+                   --  case we want to retrieve the original generic in order
+                   --  to traverse its formal part.
+ 
+                   if Present (Renamed_Entity (Entity (Name (Orig_Node)))) then
+                      Gen_Decl :=
+                        Unit_Declaration_Node (
+                          Renamed_Entity (Entity (Name (Orig_Node))));
+                   else
+                      Gen_Decl :=
+                         Unit_Declaration_Node (Entity (Name (Orig_Node)));
+                   end if;
+ 
+                   Formals := Generic_Formal_Declarations (Gen_Decl);
+ 
                    if Present (Formals) then
                       Formal_Node := First_Non_Pragma (Formals);
                    else
*************** package body Sem_Ch12 is
*** 6481,6487 ****
  
                    while Present (Actual_Ent)
                      and then Present (Formal_Node)
!                     and then Actual_Ent /= First_Private_Entity (Act_Ent)
                    loop
                       --  ???  Are the following calls also needed here:
                       --
--- 6716,6722 ----
  
                    while Present (Actual_Ent)
                      and then Present (Formal_Node)
!                     and then Actual_Ent /= First_Private_Entity (Act_Pkg)
                    loop
                       --  ???  Are the following calls also needed here:
                       --
*************** package body Sem_Ch12 is
*** 6533,6539 ****
           if No (Gen_Par) then
              return False;
  
!          --  Simplest case: the generic parent of the actual is the formal.
  
           elsif Gen_Par = Gen_Anc then
              return True;
--- 6768,6774 ----
           if No (Gen_Par) then
              return False;
  
!          --  Simplest case: the generic parent of the actual is the formal
  
           elsif Gen_Par = Gen_Anc then
              return True;
*************** package body Sem_Ch12 is
*** 6574,6582 ****
           while Present (E1)
             and then E1 /= First_Private_Entity (Form)
           loop
              if not Is_Internal (E1)
-               and then not Is_Class_Wide_Type (E1)
                and then Present (Parent (E1))
              then
                 while Present (E2)
                   and then Chars (E2) /= Chars (E1)
--- 6809,6821 ----
           while Present (E1)
             and then E1 /= First_Private_Entity (Form)
           loop
+             --  Could this test be a single condition???
+             --  Seems like it could, and isn't FPE (Form) a constant anyway???
+ 
              if not Is_Internal (E1)
                and then Present (Parent (E1))
+               and then not Is_Class_Wide_Type (E1)
+               and then not Is_Internal_Name (Chars (E1))
              then
                 while Present (E2)
                   and then Chars (E2) /= Chars (E1)
*************** package body Sem_Ch12 is
*** 6814,6829 ****
        New_Spec   : Node_Id;
  
        function From_Parent_Scope (Subp : Entity_Id) return Boolean;
!       --  If the generic is a child unit, the parent has been installed
!       --  on the scope stack, but a default subprogram cannot resolve to
!       --  something on the parent because that parent is not really part
!       --  of the visible context (it is there to resolve explicit local
!       --  entities). If the default has resolved in this way, we remove
!       --  the entity from immediate visibility and analyze the node again
!       --  to emit an error message or find another visible candidate.
  
        procedure Valid_Actual_Subprogram (Act : Node_Id);
!       --  Perform legality check and raise exception on failure.
  
        -----------------------
        -- From_Parent_Scope --
--- 7053,7068 ----
        New_Spec   : Node_Id;
  
        function From_Parent_Scope (Subp : Entity_Id) return Boolean;
!       --  If the generic is a child unit, the parent has been installed on the
!       --  scope stack, but a default subprogram cannot resolve to something on
!       --  the parent because that parent is not really part of the visible
!       --  context (it is there to resolve explicit local entities). If the
!       --  default has resolved in this way, we remove the entity from
!       --  immediate visibility and analyze the node again to emit an error
!       --  message or find another visible candidate.
  
        procedure Valid_Actual_Subprogram (Act : Node_Id);
!       --  Perform legality check and raise exception on failure
  
        -----------------------
        -- From_Parent_Scope --
*************** package body Sem_Ch12 is
*** 6883,6889 ****
     begin
        New_Spec := New_Copy_Tree (Specification (Formal));
  
!       --  Create new entity for the actual (New_Copy_Tree does not).
  
        Set_Defining_Unit_Name
          (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
--- 7122,7128 ----
     begin
        New_Spec := New_Copy_Tree (Specification (Formal));
  
!       --  Create new entity for the actual (New_Copy_Tree does not)
  
        Set_Defining_Unit_Name
          (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
*************** package body Sem_Ch12 is
*** 6939,6944 ****
--- 7178,7199 ----
              Nam := Make_Identifier (Loc, Chars (Formal_Sub));
           end if;
  
+       elsif Nkind (Specification (Formal)) = N_Procedure_Specification
+         and then Null_Present (Specification (Formal))
+       then
+          --  Generate null body for procedure, for use in the instance
+ 
+          Decl_Node :=
+            Make_Subprogram_Body (Loc,
+              Specification              => New_Spec,
+              Declarations               => New_List,
+              Handled_Statement_Sequence =>
+                Make_Handled_Sequence_Of_Statements (Loc,
+                  Statements => New_List (Make_Null_Statement (Loc))));
+ 
+          Set_Is_Intrinsic_Subprogram (Defining_Unit_Name (New_Spec));
+          return Decl_Node;
+ 
        else
           Error_Msg_Sloc := Sloc (Scope (Analyzed_S));
           Error_Msg_NE
*************** package body Sem_Ch12 is
*** 7075,7081 ****
        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
--- 7330,7337 ----
        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
*************** package body Sem_Ch12 is
*** 7088,7099 ****
  
        if Out_Present (Formal) then
  
!          --  An IN OUT generic actual must be a name. The instantiation is
!          --  a renaming declaration. The actual is the name being renamed.
!          --  We use the actual directly, rather than a copy, because it is not
           --  used further in the list of actuals, and because a copy or a use
!          --  of relocate_node is incorrect if the instance is nested within
!          --  a generic. In order to simplify ASIS searches, the Generic_Parent
           --  field links the declaration to the generic association.
  
           if No (Actual) then
--- 7344,7355 ----
  
        if Out_Present (Formal) then
  
!          --  An IN OUT generic actual must be a name. The instantiation is a
!          --  renaming declaration. The actual is the name being renamed. We
!          --  use the actual directly, rather than a copy, because it is not
           --  used further in the list of actuals, and because a copy or a use
!          --  of relocate_node is incorrect if the instance is nested within a
!          --  generic. In order to simplify ASIS searches, the Generic_Parent
           --  field links the declaration to the generic association.
  
           if No (Actual) then
*************** package body Sem_Ch12 is
*** 7121,7126 ****
--- 7377,7388 ----
           Append (Decl_Node, List);
           Analyze (Actual);
  
+          --  Return if the analysis of the actual reported some error
+ 
+          if Etype (Actual) = Any_Type then
+             return List;
+          end if;
+ 
           --  This check is performed here because Analyze_Object_Renaming
           --  will not check it when Comes_From_Source is False. Note
           --  though that the check for the actual being the name of an
*************** package body Sem_Ch12 is
*** 7160,7166 ****
  
              Prepend (Subt_Decl, List);
  
!             Append_Elmt (Full_View (Ftyp), Exchanged_Views);
              Exchange_Declarations (Ftyp);
           end if;
  
--- 7422,7428 ----
  
              Prepend (Subt_Decl, List);
  
!             Prepend_Elmt (Full_View (Ftyp), Exchanged_Views);
              Exchange_Declarations (Ftyp);
           end if;
  
*************** package body Sem_Ch12 is
*** 7230,7235 ****
--- 7492,7503 ----
  
              if Nkind (Actual) /= N_Allocator then
                 Analyze (Actual);
+ 
+                --  Return if the analysis of the actual reported some error
+ 
+                if Etype (Actual) = Any_Type then
+                   return List;
+                end if;
              end if;
  
              declare
*************** package body Sem_Ch12 is
*** 7240,7248 ****
              begin
                 Freeze_Before (Instantiation_Node, Typ);
  
!                --  If the actual is an aggregate, perform name resolution
!                --  on its components (the analysis of an aggregate does not
!                --  do it) to capture local names that may be hidden if the
                 --  generic is a child unit.
  
                 if Nkind (Actual) = N_Aggregate then
--- 7508,7516 ----
              begin
                 Freeze_Before (Instantiation_Node, Typ);
  
!                --  If the actual is an aggregate, perform name resolution on
!                --  its components (the analysis of an aggregate does not do
!                --  it) to capture local names that may be hidden if the
                 --  generic is a child unit.
  
                 if Nkind (Actual) = N_Aggregate then
*************** package body Sem_Ch12 is
*** 7252,7258 ****
  
           elsif Present (Expression (Formal)) then
  
!             --  Use default to construct declaration.
  
              Decl_Node :=
                Make_Object_Declaration (Sloc (Formal),
--- 7520,7526 ----
  
           elsif Present (Expression (Formal)) then
  
!             --  Use default to construct declaration
  
              Decl_Node :=
                Make_Object_Declaration (Sloc (Formal),
*************** package body Sem_Ch12 is
*** 7728,7734 ****
                Make_Subprogram_Body (Loc,
                   Specification              =>
                     Make_Procedure_Specification (Loc,
!                      Defining_Unit_Name         => New_Copy (Anon_Id),
                         Parameter_Specifications =>
                         New_Copy_List
                           (Parameter_Specifications (Parent (Anon_Id)))),
--- 7996,8003 ----
                Make_Subprogram_Body (Loc,
                   Specification              =>
                     Make_Procedure_Specification (Loc,
!                      Defining_Unit_Name         =>
!                        Make_Defining_Identifier (Loc, Chars (Anon_Id)),
                         Parameter_Specifications =>
                         New_Copy_List
                           (Parameter_Specifications (Parent (Anon_Id)))),
*************** package body Sem_Ch12 is
*** 7754,7764 ****
                Make_Subprogram_Body (Loc,
                  Specification =>
                    Make_Function_Specification (Loc,
!                      Defining_Unit_Name         => New_Copy (Anon_Id),
                         Parameter_Specifications =>
                         New_Copy_List
                           (Parameter_Specifications (Parent (Anon_Id))),
!                      Subtype_Mark =>
                         New_Occurrence_Of (Etype (Anon_Id), Loc)),
  
                    Declarations               => Empty_List,
--- 8023,8034 ----
                Make_Subprogram_Body (Loc,
                  Specification =>
                    Make_Function_Specification (Loc,
!                      Defining_Unit_Name         =>
!                        Make_Defining_Identifier (Loc, Chars (Anon_Id)),
                         Parameter_Specifications =>
                         New_Copy_List
                           (Parameter_Specifications (Parent (Anon_Id))),
!                      Result_Definition =>
                         New_Occurrence_Of (Etype (Anon_Id), Loc)),
  
                    Declarations               => Empty_List,
*************** package body Sem_Ch12 is
*** 7802,7807 ****
--- 8072,8079 ----
        procedure Validate_Access_Subprogram_Instance;
        procedure Validate_Access_Type_Instance;
        procedure Validate_Derived_Type_Instance;
+       procedure Validate_Derived_Interface_Type_Instance;
+       procedure Validate_Interface_Type_Instance;
        procedure Validate_Private_Type_Instance;
        --  These procedures perform validation tests for the named case
  
*************** package body Sem_Ch12 is
*** 8038,8043 ****
--- 8310,8353 ----
  
        end Validate_Array_Type_Instance;
  
+       -----------------------------------------------
+       --  Validate_Derived_Interface_Type_Instance --
+       -----------------------------------------------
+ 
+       procedure Validate_Derived_Interface_Type_Instance is
+          Par  : constant Entity_Id := Entity (Subtype_Indication (Def));
+          Elmt : Elmt_Id;
+ 
+       begin
+          --  First apply interface instance checks
+ 
+          Validate_Interface_Type_Instance;
+ 
+          --  Verify that immediate parent interface is an ancestor of
+          --  the actual.
+ 
+          if Present (Par)
+            and then  not Interface_Present_In_Ancestor (Act_T, Par)
+          then
+             Error_Msg_NE
+               ("interface actual must include progenitor&", Actual, Par);
+          end if;
+ 
+          --  Now verify that the actual includes all other ancestors of
+          --  the formal.
+ 
+          Elmt := First_Elmt (Abstract_Interfaces (A_Gen_T));
+          while Present (Elmt) loop
+             if not Interface_Present_In_Ancestor (Act_T, Node (Elmt)) then
+                Error_Msg_NE
+                  ("interface actual must include progenitor&",
+                     Actual, Node (Elmt));
+             end if;
+ 
+             Next_Elmt (Elmt);
+          end loop;
+       end Validate_Derived_Interface_Type_Instance;
+ 
        ------------------------------------
        -- Validate_Derived_Type_Instance --
        ------------------------------------
*************** package body Sem_Ch12 is
*** 8047,8064 ****
           Ancestor_Discr : Entity_Id;
  
        begin
!          --  If the parent type in the generic declaration is itself
!          --  a previous formal type, then it is local to the generic
!          --  and absent from the analyzed generic definition. In  that
!          --  case the ancestor is the instance of the formal (which must
!          --  have been instantiated previously), unless the ancestor is
!          --  itself a formal derived type. In this latter case (which is the
!          --  subject of Corrigendum 8652/0038 (AI-202) the ancestor of the
!          --  formals is the ancestor of its parent. Otherwise, the analyzed
!          --  generic carries the parent type. If the parent type is defined
!          --  in a previous formal package, then the scope of that formal
!          --  package is that of the generic type itself, and it has already
!          --  been mapped into the corresponding type in the actual package.
  
           --  Common case: parent type defined outside of the generic
  
--- 8357,8374 ----
           Ancestor_Discr : Entity_Id;
  
        begin
!          --  If the parent type in the generic declaration is itself a previous
!          --  formal type, then it is local to the generic and absent from the
!          --  analyzed generic definition. In that case the ancestor is the
!          --  instance of the formal (which must have been instantiated
!          --  previously), unless the ancestor is itself a formal derived type.
!          --  In this latter case (which is the subject of Corrigendum 8652/0038
!          --  (AI-202) the ancestor of the formals is the ancestor of its
!          --  parent. Otherwise, the analyzed generic carries the parent type.
!          --  If the parent type is defined in a previous formal package, then
!          --  the scope of that formal package is that of the generic type
!          --  itself, and it has already been mapped into the corresponding type
!          --  in the actual package.
  
           --  Common case: parent type defined outside of the generic
  
*************** package body Sem_Ch12 is
*** 8122,8128 ****
              Ancestor := Get_Instance_Of (Etype (Base_Type (A_Gen_T)));
           end if;
  
!          if not Is_Ancestor (Base_Type (Ancestor), Act_T) then
              Error_Msg_NE
                ("expect type derived from & in instantiation",
                 Actual, First_Subtype (Ancestor));
--- 8432,8449 ----
              Ancestor := Get_Instance_Of (Etype (Base_Type (A_Gen_T)));
           end if;
  
!          --  Ada 2005 (AI-251)
! 
!          if Ada_Version >= Ada_05
!            and then Is_Interface (Ancestor)
!          then
!             if not Interface_Present_In_Ancestor (Act_T, Ancestor) then
!                Error_Msg_NE
!                  ("(Ada 2005) expected type implementing & in instantiation",
!                   Actual, Ancestor);
!             end if;
! 
!          elsif not Is_Ancestor (Base_Type (Ancestor), Act_T) then
              Error_Msg_NE
                ("expect type derived from & in instantiation",
                 Actual, First_Subtype (Ancestor));
*************** package body Sem_Ch12 is
*** 8246,8251 ****
--- 8567,8599 ----
           end if;
        end Validate_Derived_Type_Instance;
  
+       --------------------------------------
+       -- Validate_Interface_Type_Instance --
+       --------------------------------------
+ 
+       procedure Validate_Interface_Type_Instance is
+       begin
+          if not Is_Interface (Act_T) then
+             Error_Msg_NE
+               ("actual for formal interface type must be an interface",
+                 Actual, Gen_T);
+ 
+          elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
+            or else
+              Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
+            or else
+              Is_Protected_Interface (A_Gen_T) /=
+                Is_Protected_Interface (Act_T)
+            or else
+              Is_Synchronized_Interface (A_Gen_T) /=
+                Is_Synchronized_Interface (Act_T)
+          then
+             Error_Msg_NE
+               ("actual for interface& does not match ('R'M 12.5.5(5))",
+                  Actual, Gen_T);
+          end if;
+       end Validate_Interface_Type_Instance;
+ 
        ------------------------------------
        -- Validate_Private_Type_Instance --
        ------------------------------------
*************** package body Sem_Ch12 is
*** 8302,8320 ****
  
                    Formal_Subt := Get_Instance_Of (Etype (Formal_Discr));
  
!                   --  access discriminants match if designated types do.
  
                    if Ekind (Base_Type (Formal_Subt)) = E_Anonymous_Access_Type
!                     and then (Ekind (Base_Type (Etype (Actual_Discr))))
!                       = E_Anonymous_Access_Type
!                     and then Get_Instance_Of (
!                       Designated_Type (Base_Type (Formal_Subt)))
!                       = Designated_Type (Base_Type (Etype (Actual_Discr)))
                    then
                       null;
  
                    elsif Base_Type (Formal_Subt) /=
!                                        Base_Type (Etype (Actual_Discr))
                    then
                       Error_Msg_NE
                         ("types of actual discriminants must match formal",
--- 8650,8669 ----
  
                    Formal_Subt := Get_Instance_Of (Etype (Formal_Discr));
  
!                   --  Access discriminants match if designated types do
  
                    if Ekind (Base_Type (Formal_Subt)) = E_Anonymous_Access_Type
!                     and then (Ekind (Base_Type (Etype (Actual_Discr)))) =
!                                 E_Anonymous_Access_Type
!                     and then
!                       Get_Instance_Of
!                         (Designated_Type (Base_Type (Formal_Subt))) =
!                            Designated_Type (Base_Type (Etype (Actual_Discr)))
                    then
                       null;
  
                    elsif Base_Type (Formal_Subt) /=
!                           Base_Type (Etype (Actual_Discr))
                    then
                       Error_Msg_NE
                         ("types of actual discriminants must match formal",
*************** package body Sem_Ch12 is
*** 8510,8515 ****
--- 8859,8870 ----
                N_Access_Procedure_Definition =>
              Validate_Access_Subprogram_Instance;
  
+          when N_Record_Definition           =>
+             Validate_Interface_Type_Instance;
+ 
+          when N_Derived_Type_Definition     =>
+             Validate_Derived_Interface_Type_Instance;
+ 
           when others =>
              raise Program_Error;
  
*************** package body Sem_Ch12 is
*** 8965,8980 ****
                    Install_Private_Declarations (P);
                 end if;
  
!             --  This looks incomplete: what about compilation units that
!             --  were made visible by Install_Parent but should not remain
!             --  visible??? Standard is on the scope stack.
  
!             elsif not In_Open_Scopes (Scope (P)) then
                 Set_Is_Immediately_Visible (P, False);
              end if;
           end loop;
  
!          --  Reset visibility of entities in the enclosing scope.
  
           Set_Is_Hidden_Open_Scope (Current_Scope, False);
           Hidden := First_Elmt (Hidden_Entities);
--- 9320,9341 ----
                    Install_Private_Declarations (P);
                 end if;
  
!             --  If the ultimate parent is a top-level unit recorded in
!             --  Instance_Parent_Unit, then reset its visibility to what
!             --  it was before instantiation. (It's not clear what the
!             --  purpose is of testing whether Scope (P) is In_Open_Scopes,
!             --  but that test was present before the ultimate parent test
!             --  was added.???)
  
!             elsif not In_Open_Scopes (Scope (P))
!               or else (P = Instance_Parent_Unit
!                         and then not Parent_Unit_Visible)
!             then
                 Set_Is_Immediately_Visible (P, False);
              end if;
           end loop;
  
!          --  Reset visibility of entities in the enclosing scope
  
           Set_Is_Hidden_Open_Scope (Current_Scope, False);
           Hidden := First_Elmt (Hidden_Entities);
*************** package body Sem_Ch12 is
*** 9008,9013 ****
--- 9369,9375 ----
  
     begin
        Ada_Version := Saved.Ada_Version;
+       Ada_Version_Explicit := Saved.Ada_Version_Explicit;
  
        if No (Current_Instantiated_Parent.Act_Id) then
  
*************** package body Sem_Ch12 is
*** 9020,9025 ****
--- 9382,9389 ----
        Exchanged_Views              := Saved.Exchanged_Views;
        Hidden_Entities              := Saved.Hidden_Entities;
        Current_Sem_Unit             := Saved.Current_Sem_Unit;
+       Parent_Unit_Visible          := Saved.Parent_Unit_Visible;
+       Instance_Parent_Unit         := Saved.Instance_Parent_Unit;
  
        Instance_Envs.Decrement_Last;
     end Restore_Env;
*************** package body Sem_Ch12 is
*** 9062,9069 ****
                 Set_Is_Hidden (Ent);
                 Set_Is_Potentially_Use_Visible (Ent, False);
  
                 if Ekind (Ent) = E_Package then
-                   --  Recurse.
                    Restore_Nested_Formal (Ent);
                 end if;
  
--- 9426,9434 ----
                 Set_Is_Hidden (Ent);
                 Set_Is_Potentially_Use_Visible (Ent, False);
  
+                --  If package, then recurse
+ 
                 if Ekind (Ent) = E_Package then
                    Restore_Nested_Formal (Ent);
                 end if;
  
*************** package body Sem_Ch12 is
*** 9428,9436 ****
                 Set_Etype  (N, Empty);
              end if;
  
!             if (Nkind (Parent (N)) = N_Package_Instantiation
!                  or else Nkind (Parent (N)) = N_Function_Instantiation
!                  or else Nkind (Parent (N)) = N_Procedure_Instantiation)
                and then N = Name (Parent (N))
              then
                 Save_Global_Defaults (Parent (N), Parent (N2));
--- 9793,9799 ----
                 Set_Etype  (N, Empty);
              end if;
  
!             if Nkind (Parent (N)) in N_Generic_Instantiation
                and then N = Name (Parent (N))
              then
                 Save_Global_Defaults (Parent (N), Parent (N2));
*************** package body Sem_Ch12 is
*** 9439,9445 ****
           elsif Nkind (Parent (N)) = N_Selected_Component
             and then Nkind (Parent (N2)) = N_Expanded_Name
           then
- 
              if Is_Global (Entity (Parent (N2))) then
                 Change_Selected_Component_To_Expanded_Name (Parent (N));
                 Set_Associated_Node (Parent (N), Parent (N2));
--- 9802,9807 ----
*************** package body Sem_Ch12 is
*** 9470,9480 ****
                 end if;
              end if;
  
!             if (Nkind (Parent (Parent (N))) = N_Package_Instantiation
!                  or else Nkind (Parent (Parent (N)))
!                    = N_Function_Instantiation
!                  or else Nkind (Parent (Parent (N)))
!                    = N_Procedure_Instantiation)
                and then Parent (N) = Name (Parent (Parent (N)))
              then
                 Save_Global_Defaults
--- 9832,9838 ----
                 end if;
              end if;
  
!             if Nkind (Parent (Parent (N))) in N_Generic_Instantiation
                and then Parent (N) = Name (Parent (Parent (N)))
              then
                 Save_Global_Defaults
*************** package body Sem_Ch12 is
*** 9579,9585 ****
              Next (Act2);
           end loop;
  
!          --  Find the associations added for default suprograms.
  
           if Present (Act2) then
              while Nkind (Act2) /= N_Generic_Association
--- 9937,9943 ----
              Next (Act2);
           end loop;
  
!          --  Find the associations added for default suprograms
  
           if Present (Act2) then
              while Nkind (Act2) /= N_Generic_Association
*************** package body Sem_Ch12 is
*** 9848,9854 ****
                    --  access to a composite type, or a parameterless function
                    --  call that returns an access type.
  
!                   --  Check whether corresponding entity in prefix is global.
  
                    if Is_Entity_Name (Prefix (N2))
                      and then Present (Entity (Prefix (N2)))
--- 10206,10212 ----
                    --  access to a composite type, or a parameterless function
                    --  call that returns an access type.
  
!                   --  Check whether corresponding entity in prefix is global
  
                    if Is_Entity_Name (Prefix (N2))
                      and then Present (Entity (Prefix (N2)))
*************** package body Sem_Ch12 is
*** 9898,9903 ****
--- 10256,10266 ----
  
           else
              declare
+                Loc  : constant Source_Ptr := Sloc (N);
+                Qual : Node_Id := Empty;
+                Typ  : Entity_Id := Empty;
+                Nam  : Node_Id;
+ 
                 use Atree.Unchecked_Access;
                 --  This code section is part of implementing an untyped tree
                 --  traversal, so it needs direct access to node fields.
*************** package body Sem_Ch12 is
*** 9909,9919 ****
                 then
                    N2 := Get_Associated_Node (N);
  
                    if No (N2)
!                     or else No (Etype (N2))
!                     or else not Is_Global (Etype (N2))
                    then
                       Set_Associated_Node (N, Empty);
                    end if;
  
                    Save_Global_Descendant (Field1 (N));
--- 10272,10337 ----
                 then
                    N2 := Get_Associated_Node (N);
  
+                   if No (N2) then
+                      Typ := Empty;
+                   else
+                      Typ := Etype (N2);
+ 
+                      --  In an instance within a generic, use the name of
+                      --  the actual and not the original generic parameter.
+                      --  If the actual is global in the current generic it
+                      --  must be preserved for its instantiation.
+ 
+                      if Nkind (Parent (Typ)) = N_Subtype_Declaration
+                        and then
+                          Present (Generic_Parent_Type (Parent (Typ)))
+                      then
+                         Typ := Base_Type (Typ);
+                         Set_Etype (N2, Typ);
+                      end if;
+                   end if;
+ 
                    if No (N2)
!                     or else No (Typ)
!                     or else not Is_Global (Typ)
                    then
                       Set_Associated_Node (N, Empty);
+ 
+                      --  If the aggregate is an actual in a call, it has been
+                      --  resolved in the current context, to some local type.
+                      --  The enclosing call may have been disambiguated by
+                      --  the aggregate, and this disambiguation might fail at
+                      --  instantiation time because the type to which the
+                      --  aggregate did resolve is not preserved. In order to
+                      --  preserve some of this information, we wrap the
+                      --  aggregate in a qualified expression, using the id of
+                      --  its type. For further disambiguation we qualify the
+                      --  type name with its scope (if visible) because both
+                      --  id's will have corresponding entities in an instance.
+                      --  This resolves most of the problems with missing type
+                      --  information on aggregates in instances.
+ 
+                      if Nkind (N2) = Nkind (N)
+                        and then
+                          (Nkind (Parent (N2)) = N_Procedure_Call_Statement
+                            or else Nkind (Parent (N2)) = N_Function_Call)
+                        and then Comes_From_Source (Typ)
+                      then
+                         if Is_Immediately_Visible (Scope (Typ)) then
+                            Nam := Make_Selected_Component (Loc,
+                              Prefix =>
+                                Make_Identifier (Loc, Chars (Scope (Typ))),
+                              Selector_Name =>
+                                Make_Identifier (Loc, Chars (Typ)));
+                         else
+                            Nam := Make_Identifier (Loc, Chars (Typ));
+                         end if;
+ 
+                         Qual :=
+                           Make_Qualified_Expression (Loc,
+                             Subtype_Mark => Nam,
+                             Expression => Relocate_Node (N));
+                      end if;
                    end if;
  
                    Save_Global_Descendant (Field1 (N));
*************** package body Sem_Ch12 is
*** 9921,9926 ****
--- 10339,10348 ----
                    Save_Global_Descendant (Field3 (N));
                    Save_Global_Descendant (Field5 (N));
  
+                   if Present (Qual) then
+                      Rewrite (N, Qual);
+                   end if;
+ 
                 --  All other cases than aggregates
  
                 else
*************** package body Sem_Ch12 is
*** 10005,10020 ****
       (Gen_Unit : Entity_Id;
        Act_Unit : Entity_Id)
     is
- 
     begin
        --  Regardless of the current mode, predefined units are analyzed in
        --  the most current Ada mode, and earlier version Ada checks do not
        --  apply to predefined units.
  
        if Is_Internal_File_Name
            (Fname => Unit_File_Name (Get_Source_Unit (Gen_Unit)),
             Renamings_Included => True) then
           Ada_Version := Ada_Version_Type'Last;
        end if;
  
        Current_Instantiated_Parent := (Gen_Unit, Act_Unit, Assoc_Null);
--- 10427,10444 ----
       (Gen_Unit : Entity_Id;
        Act_Unit : Entity_Id)
     is
     begin
        --  Regardless of the current mode, predefined units are analyzed in
        --  the most current Ada mode, and earlier version Ada checks do not
        --  apply to predefined units.
  
+       --  Why is this not using the routine Opt.Set_Opt_Config_Switches ???
+ 
        if Is_Internal_File_Name
            (Fname => Unit_File_Name (Get_Source_Unit (Gen_Unit)),
             Renamings_Included => True) then
           Ada_Version := Ada_Version_Type'Last;
+          Ada_Version_Explicit := Ada_Version_Explicit_Config;
        end if;
  
        Current_Instantiated_Parent := (Gen_Unit, Act_Unit, Assoc_Null);
*************** package body Sem_Ch12 is
*** 10040,10046 ****
        Priv_Elmt := First_Elmt (Private_Dependents (BT));
  
        if Present (Full_View (BT)) then
!          Append_Elmt (Full_View (BT), Exchanged_Views);
           Exchange_Declarations (BT);
        end if;
  
--- 10464,10470 ----
        Priv_Elmt := First_Elmt (Private_Dependents (BT));
  
        if Present (Full_View (BT)) then
!          Prepend_Elmt (Full_View (BT), Exchanged_Views);
           Exchange_Declarations (BT);
        end if;
  
*************** package body Sem_Ch12 is
*** 10059,10065 ****
           if Present (Full_View (Priv_Sub))
             and then not Is_Private_Type (Etype (Full_View (Priv_Sub)))
           then
!             Append_Elmt (Full_View (Priv_Sub), Exchanged_Views);
              Exchange_Declarations (Priv_Sub);
           end if;
  
--- 10483,10489 ----
           if Present (Full_View (Priv_Sub))
             and then not Is_Private_Type (Etype (Full_View (Priv_Sub)))
           then
!             Prepend_Elmt (Full_View (Priv_Sub), Exchanged_Views);
              Exchange_Declarations (Priv_Sub);
           end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch12.ads gcc-4.1.0/gcc/ada/sem_ch12.ads
*** gcc-4.0.2/gcc/ada/sem_ch12.ads	Tue Oct 21 13:42:19 2003
--- gcc-4.1.0/gcc/ada/sem_ch12.ads	Tue Nov 15 14:02:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Ch12 is
*** 39,45 ****
     procedure Analyze_Formal_Package                     (N : Node_Id);
  
     procedure Start_Generic;
!    --  Must be invoked before starting to process a generic spec or body.
  
     procedure End_Generic;
     --  Must be invoked just at the end of the end of the processing of a
--- 39,45 ----
     procedure Analyze_Formal_Package                     (N : Node_Id);
  
     procedure Start_Generic;
!    --  Must be invoked before starting to process a generic spec or body
  
     procedure End_Generic;
     --  Must be invoked just at the end of the end of the processing of a
*************** package Sem_Ch12 is
*** 70,75 ****
--- 70,80 ----
     --  Retrieve actual associated with given generic parameter.
     --  If A is uninstantiated or not a generic parameter, return A.
  
+    function Get_Package_Instantiation_Node (A : Entity_Id) return Node_Id;
+    --  Given the entity of a unit that is an instantiation, retrieve the
+    --  original instance node. This is used when loading the instantiations
+    --  of the ancestors of a child generic that is being instantiated.
+ 
     procedure Instantiate_Package_Body
       (Body_Info    : Pending_Body_Info;
        Inlined_Body : Boolean := False);
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch13.adb gcc-4.1.0/gcc/ada/sem_ch13.adb
*** gcc-4.0.2/gcc/ada/sem_ch13.adb	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/sem_ch13.adb	Mon Sep  5 07:59:42 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch13 is
*** 244,249 ****
--- 244,380 ----
        --  disallow Storage_Size for derived task types, but that is also
        --  clearly unintentional.
  
+       procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type);
+       --  Common processing for 'Read, 'Write, 'Input and 'Output attribute
+       --  definition clauses.
+ 
+       procedure Analyze_Stream_TSS_Definition (TSS_Nam : TSS_Name_Type) is
+          Subp : Entity_Id := Empty;
+          I    : Interp_Index;
+          It   : Interp;
+          Pnam : Entity_Id;
+ 
+          Is_Read : constant Boolean := (TSS_Nam = TSS_Stream_Read);
+ 
+          function Has_Good_Profile (Subp : Entity_Id) return Boolean;
+          --  Return true if the entity is a subprogram with an appropriate
+          --  profile for the attribute being defined.
+ 
+          ----------------------
+          -- Has_Good_Profile --
+          ----------------------
+ 
+          function Has_Good_Profile (Subp : Entity_Id) return Boolean is
+             F              : Entity_Id;
+             Is_Function    : constant Boolean := (TSS_Nam = TSS_Stream_Input);
+             Expected_Ekind : constant array (Boolean) of Entity_Kind :=
+                                (False => E_Procedure, True => E_Function);
+             Typ            : Entity_Id;
+ 
+          begin
+             if Ekind (Subp) /= Expected_Ekind (Is_Function) then
+                return False;
+             end if;
+ 
+             F := First_Formal (Subp);
+ 
+             if No (F)
+               or else Ekind (Etype (F)) /= E_Anonymous_Access_Type
+               or else Designated_Type (Etype (F)) /=
+                                Class_Wide_Type (RTE (RE_Root_Stream_Type))
+             then
+                return False;
+             end if;
+ 
+             if not Is_Function then
+                Next_Formal (F);
+ 
+                declare
+                   Expected_Mode : constant array (Boolean) of Entity_Kind :=
+                                     (False => E_In_Parameter,
+                                      True  => E_Out_Parameter);
+                begin
+                   if Parameter_Mode (F) /= Expected_Mode (Is_Read) then
+                      return False;
+                   end if;
+                end;
+ 
+                Typ := Etype (F);
+ 
+             else
+                Typ := Etype (Subp);
+             end if;
+ 
+             return Base_Type (Typ) = Base_Type (Ent)
+               and then No (Next_Formal (F));
+ 
+          end Has_Good_Profile;
+ 
+       --  Start of processing for Analyze_Stream_TSS_Definition
+ 
+       begin
+          FOnly := True;
+ 
+          if not Is_Type (U_Ent) then
+             Error_Msg_N ("local name must be a subtype", Nam);
+             return;
+          end if;
+ 
+          Pnam := TSS (Base_Type (U_Ent), TSS_Nam);
+ 
+          if Present (Pnam) and then Has_Good_Profile (Pnam) then
+             Error_Msg_Sloc := Sloc (Pnam);
+             Error_Msg_Name_1 := Attr;
+             Error_Msg_N ("% attribute already defined #", Nam);
+             return;
+          end if;
+ 
+          Analyze (Expr);
+ 
+          if Is_Entity_Name (Expr) then
+             if not Is_Overloaded (Expr) then
+                if Has_Good_Profile (Entity (Expr)) then
+                   Subp := Entity (Expr);
+                end if;
+ 
+             else
+                Get_First_Interp (Expr, I, It);
+ 
+                while Present (It.Nam) loop
+                   if Has_Good_Profile (It.Nam) then
+                      Subp := It.Nam;
+                      exit;
+                   end if;
+ 
+                   Get_Next_Interp (I, It);
+                end loop;
+             end if;
+          end if;
+ 
+          if Present (Subp) then
+             if Is_Abstract (Subp) then
+                Error_Msg_N ("stream subprogram must not be abstract", Expr);
+                return;
+             end if;
+ 
+             Set_Entity (Expr, Subp);
+             Set_Etype (Expr, Etype (Subp));
+ 
+             if TSS_Nam = TSS_Stream_Input then
+                New_Stream_Function (N, U_Ent, Subp, TSS_Nam);
+             else
+                New_Stream_Procedure (N, U_Ent, Subp, TSS_Nam,
+                                      Out_P => Is_Read);
+             end if;
+ 
+          else
+             Error_Msg_Name_1 := Attr;
+             Error_Msg_N ("incorrect expression for% attribute", Expr);
+          end if;
+       end Analyze_Stream_TSS_Definition;
+ 
+    --  Start of processing for Analyze_Attribute_Definition_Clause
+ 
     begin
        Analyze (Nam);
        Ent := Entity (Nam);
*************** package body Sem_Ch13 is
*** 252,277 ****
           return;
        end if;
  
!       --  Rep clause applies to full view of incomplete type or private type
!       --  if we have one (if not, this is a premature use of the type).
!       --  However, certain semantic checks need to be done on the specified
!       --  entity (i.e. the private view), so we save it in Ent.
  
        if Is_Private_Type (Ent)
          and then Is_Derived_Type (Ent)
          and then not Is_Tagged_Type (Ent)
          and then No (Full_View (Ent))
        then
!          --  If this is a private type whose completion is a derivation
!          --  from another private type, there is no full view, and the
!          --  attribute belongs to the type itself, not its underlying parent.
  
           U_Ent := Ent;
  
        elsif Ekind (Ent) = E_Incomplete_Type then
  
!          --  The attribute applies to the full view, set the entity
!          --  of the attribute definition accordingly.
  
           Ent := Underlying_Type (Ent);
           U_Ent := Ent;
--- 383,408 ----
           return;
        end if;
  
!       --  Rep clause applies to full view of incomplete type or private type if
!       --  we have one (if not, this is a premature use of the type). However,
!       --  certain semantic checks need to be done on the specified entity (i.e.
!       --  the private view), so we save it in Ent.
  
        if Is_Private_Type (Ent)
          and then Is_Derived_Type (Ent)
          and then not Is_Tagged_Type (Ent)
          and then No (Full_View (Ent))
        then
!          --  If this is a private type whose completion is a derivation from
!          --  another private type, there is no full view, and the attribute
!          --  belongs to the type itself, not its underlying parent.
  
           U_Ent := Ent;
  
        elsif Ekind (Ent) = E_Incomplete_Type then
  
!          --  The attribute applies to the full view, set the entity of the
!          --  attribute definition accordingly.
  
           Ent := Underlying_Type (Ent);
           U_Ent := Ent;
*************** package body Sem_Ch13 is
*** 668,761 ****
           -- Input --
           -----------
  
!          when Attribute_Input => Input : declare
!             Subp : Entity_Id := Empty;
!             I    : Interp_Index;
!             It   : Interp;
!             Pnam : Entity_Id;
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean;
!             --  Return true if the entity is a function with an appropriate
!             --  profile for the Input attribute.
! 
!             ----------------------
!             -- Has_Good_Profile --
!             ----------------------
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean is
!                F  : Entity_Id;
!                Ok : Boolean := False;
! 
!             begin
!                if Ekind (Subp) = E_Function then
!                   F := First_Formal (Subp);
! 
!                   if Present (F) and then No (Next_Formal (F)) then
!                      if Ekind (Etype (F)) = E_Anonymous_Access_Type
!                        and then
!                          Designated_Type (Etype (F)) =
!                            Class_Wide_Type (RTE (RE_Root_Stream_Type))
!                      then
!                         Ok := Base_Type (Etype (Subp)) = Base_Type (Ent);
!                      end if;
!                   end if;
!                end if;
! 
!                return Ok;
!             end Has_Good_Profile;
! 
!          --  Start of processing for Input attribute definition
! 
!          begin
!             FOnly := True;
! 
!             if not Is_Type (U_Ent) then
!                Error_Msg_N ("local name must be a subtype", Nam);
!                return;
! 
!             else
!                Pnam := TSS (Base_Type (U_Ent), TSS_Stream_Input);
! 
!                if Present (Pnam)
!                  and then Base_Type (Etype (Pnam)) = Base_Type (U_Ent)
!                then
!                   Error_Msg_Sloc := Sloc (Pnam);
!                   Error_Msg_N ("input attribute already defined #", Nam);
!                   return;
!                end if;
!             end if;
! 
!             Analyze (Expr);
! 
!             if Is_Entity_Name (Expr) then
!                if not Is_Overloaded (Expr) then
!                   if Has_Good_Profile (Entity (Expr)) then
!                      Subp := Entity (Expr);
!                   end if;
! 
!                else
!                   Get_First_Interp (Expr, I, It);
! 
!                   while Present (It.Nam) loop
!                      if Has_Good_Profile (It.Nam) then
!                         Subp := It.Nam;
!                         exit;
!                      end if;
! 
!                      Get_Next_Interp (I, It);
!                   end loop;
!                end if;
!             end if;
! 
!             if Present (Subp) then
!                Set_Entity (Expr, Subp);
!                Set_Etype (Expr, Etype (Subp));
!                New_Stream_Function (N, U_Ent, Subp,  TSS_Stream_Input);
!             else
!                Error_Msg_N ("incorrect expression for input attribute", Expr);
!                return;
!             end if;
!          end Input;
  
           -------------------
           -- Machine_Radix --
--- 799,807 ----
           -- Input --
           -----------
  
!          when Attribute_Input =>
!             Analyze_Stream_TSS_Definition (TSS_Stream_Input);
!             Set_Has_Specified_Stream_Input (Ent);
  
           -------------------
           -- Machine_Radix --
*************** package body Sem_Ch13 is
*** 831,1028 ****
           -- Output --
           ------------
  
!          when Attribute_Output => Output : declare
!             Subp : Entity_Id := Empty;
!             I    : Interp_Index;
!             It   : Interp;
!             Pnam : Entity_Id;
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean;
!             --  Return true if the entity is a procedure with an
!             --  appropriate profile for the output attribute.
! 
!             ----------------------
!             -- Has_Good_Profile --
!             ----------------------
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean is
!                F  : Entity_Id;
!                Ok : Boolean := False;
! 
!             begin
!                if Ekind (Subp) = E_Procedure then
!                   F := First_Formal (Subp);
! 
!                   if Present (F) then
!                      if Ekind (Etype (F)) = E_Anonymous_Access_Type
!                        and then
!                          Designated_Type (Etype (F)) =
!                            Class_Wide_Type (RTE (RE_Root_Stream_Type))
!                      then
!                         Next_Formal (F);
!                         Ok :=  Present (F)
!                           and then Parameter_Mode (F) = E_In_Parameter
!                           and then Base_Type (Etype (F)) = Base_Type (Ent)
!                           and then No (Next_Formal (F));
!                      end if;
!                   end if;
!                end if;
! 
!                return Ok;
!             end Has_Good_Profile;
! 
!          --  Start of processing for Output attribute definition
! 
!          begin
!             FOnly := True;
! 
!             if not Is_Type (U_Ent) then
!                Error_Msg_N ("local name must be a subtype", Nam);
!                return;
! 
!             else
!                Pnam := TSS (Base_Type (U_Ent), TSS_Stream_Output);
! 
!                if Present (Pnam)
!                  and then
!                    Base_Type (Etype (Next_Formal (First_Formal (Pnam))))
!                                                         = Base_Type (U_Ent)
!                then
!                   Error_Msg_Sloc := Sloc (Pnam);
!                   Error_Msg_N ("output attribute already defined #", Nam);
!                   return;
!                end if;
!             end if;
! 
!             Analyze (Expr);
! 
!             if Is_Entity_Name (Expr) then
!                if not Is_Overloaded (Expr) then
!                   if Has_Good_Profile (Entity (Expr)) then
!                      Subp := Entity (Expr);
!                   end if;
! 
!                else
!                   Get_First_Interp (Expr, I, It);
! 
!                   while Present (It.Nam) loop
!                      if Has_Good_Profile (It.Nam) then
!                         Subp := It.Nam;
!                         exit;
!                      end if;
! 
!                      Get_Next_Interp (I, It);
!                   end loop;
!                end if;
!             end if;
! 
!             if Present (Subp) then
!                Set_Entity (Expr, Subp);
!                Set_Etype (Expr, Etype (Subp));
!                New_Stream_Procedure (N, U_Ent, Subp, TSS_Stream_Output);
!             else
!                Error_Msg_N ("incorrect expression for output attribute", Expr);
!                return;
!             end if;
!          end Output;
  
           ----------
           -- Read --
           ----------
  
!          when Attribute_Read => Read : declare
!             Subp : Entity_Id := Empty;
!             I    : Interp_Index;
!             It   : Interp;
!             Pnam : Entity_Id;
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean;
!             --  Return true if the entity is a procedure with an appropriate
!             --  profile for the Read attribute.
! 
!             ----------------------
!             -- Has_Good_Profile --
!             ----------------------
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean is
!                F     : Entity_Id;
!                Ok    : Boolean := False;
! 
!             begin
!                if Ekind (Subp) = E_Procedure then
!                   F := First_Formal (Subp);
! 
!                   if Present (F) then
!                      if Ekind (Etype (F)) = E_Anonymous_Access_Type
!                        and then
!                          Designated_Type (Etype (F)) =
!                            Class_Wide_Type (RTE (RE_Root_Stream_Type))
!                      then
!                         Next_Formal (F);
!                         Ok :=  Present (F)
!                           and then Parameter_Mode (F) = E_Out_Parameter
!                           and then Base_Type (Etype (F)) = Base_Type (Ent)
!                           and then No (Next_Formal (F));
!                      end if;
!                   end if;
!                end if;
! 
!                return Ok;
!             end Has_Good_Profile;
! 
!          --  Start of processing for Read attribute definition
! 
!          begin
!             FOnly := True;
! 
!             if not Is_Type (U_Ent) then
!                Error_Msg_N ("local name must be a subtype", Nam);
!                return;
! 
!             else
!                Pnam := TSS (Base_Type (U_Ent), TSS_Stream_Read);
! 
!                if Present (Pnam)
!                  and then Base_Type (Etype (Next_Formal (First_Formal (Pnam))))
!                    = Base_Type (U_Ent)
!                then
!                   Error_Msg_Sloc := Sloc (Pnam);
!                   Error_Msg_N ("read attribute already defined #", Nam);
!                   return;
!                end if;
!             end if;
! 
!             Analyze (Expr);
! 
!             if Is_Entity_Name (Expr) then
!                if not Is_Overloaded (Expr) then
!                   if Has_Good_Profile (Entity (Expr)) then
!                      Subp := Entity (Expr);
!                   end if;
! 
!                else
!                   Get_First_Interp (Expr, I, It);
! 
!                   while Present (It.Nam) loop
!                      if Has_Good_Profile (It.Nam) then
!                         Subp := It.Nam;
!                         exit;
!                      end if;
! 
!                      Get_Next_Interp (I, It);
!                   end loop;
!                end if;
!             end if;
! 
!             if Present (Subp) then
!                Set_Entity (Expr, Subp);
!                Set_Etype (Expr, Etype (Subp));
!                New_Stream_Procedure (N, U_Ent, Subp, TSS_Stream_Read, True);
!             else
!                Error_Msg_N ("incorrect expression for read attribute", Expr);
!                return;
!             end if;
!          end Read;
  
           ----------
           -- Size --
--- 877,893 ----
           -- Output --
           ------------
  
!          when Attribute_Output =>
!             Analyze_Stream_TSS_Definition (TSS_Stream_Output);
!             Set_Has_Specified_Stream_Output (Ent);
  
           ----------
           -- Read --
           ----------
  
!          when Attribute_Read =>
!             Analyze_Stream_TSS_Definition (TSS_Stream_Read);
!             Set_Has_Specified_Stream_Read (Ent);
  
           ----------
           -- Size --
*************** package body Sem_Ch13 is
*** 1436,1536 ****
           -- Write --
           -----------
  
!          --  Write attribute definition clause
!          --  check for class-wide case will be performed later
! 
!          when Attribute_Write => Write : declare
!             Subp : Entity_Id := Empty;
!             I    : Interp_Index;
!             It   : Interp;
!             Pnam : Entity_Id;
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean;
!             --  Return true if the entity is a procedure with an
!             --  appropriate profile for the write attribute.
! 
!             ----------------------
!             -- Has_Good_Profile --
!             ----------------------
! 
!             function Has_Good_Profile (Subp : Entity_Id) return Boolean is
!                F     : Entity_Id;
!                Ok    : Boolean := False;
! 
!             begin
!                if Ekind (Subp) = E_Procedure then
!                   F := First_Formal (Subp);
! 
!                   if Present (F) then
!                      if Ekind (Etype (F)) = E_Anonymous_Access_Type
!                        and then
!                          Designated_Type (Etype (F)) =
!                            Class_Wide_Type (RTE (RE_Root_Stream_Type))
!                      then
!                         Next_Formal (F);
!                         Ok :=  Present (F)
!                           and then Parameter_Mode (F) = E_In_Parameter
!                           and then Base_Type (Etype (F)) = Base_Type (Ent)
!                           and then No (Next_Formal (F));
!                      end if;
!                   end if;
!                end if;
! 
!                return Ok;
!             end Has_Good_Profile;
! 
!          --  Start of processing for Write attribute definition
! 
!          begin
!             FOnly := True;
! 
!             if not Is_Type (U_Ent) then
!                Error_Msg_N ("local name must be a subtype", Nam);
!                return;
!             end if;
! 
!             Pnam := TSS (Base_Type (U_Ent), TSS_Stream_Write);
! 
!             if Present (Pnam)
!               and then Base_Type (Etype (Next_Formal (First_Formal (Pnam))))
!                 = Base_Type (U_Ent)
!             then
!                Error_Msg_Sloc := Sloc (Pnam);
!                Error_Msg_N ("write attribute already defined #", Nam);
!                return;
!             end if;
! 
!             Analyze (Expr);
! 
!             if Is_Entity_Name (Expr) then
!                if not Is_Overloaded (Expr) then
!                   if Has_Good_Profile (Entity (Expr)) then
!                      Subp := Entity (Expr);
!                   end if;
! 
!                else
!                   Get_First_Interp (Expr, I, It);
! 
!                   while Present (It.Nam) loop
!                      if Has_Good_Profile (It.Nam) then
!                         Subp := It.Nam;
!                         exit;
!                      end if;
! 
!                      Get_Next_Interp (I, It);
!                   end loop;
!                end if;
!             end if;
! 
!             if Present (Subp) then
!                Set_Entity (Expr, Subp);
!                Set_Etype (Expr, Etype (Subp));
!                New_Stream_Procedure (N, U_Ent, Subp, TSS_Stream_Write);
!             else
!                Error_Msg_N ("incorrect expression for write attribute", Expr);
!                return;
!             end if;
!          end Write;
  
           --  All other attributes cannot be set
  
--- 1301,1309 ----
           -- Write --
           -----------
  
!          when Attribute_Write =>
!             Analyze_Stream_TSS_Definition (TSS_Stream_Write);
!             Set_Has_Specified_Stream_Write (Ent);
  
           --  All other attributes cannot be set
  
*************** package body Sem_Ch13 is
*** 1715,1720 ****
--- 1488,1501 ----
           Error_Msg_N ("enumeration rep clause not allowed for this type", N);
           return;
  
+       --  Check that the expression is a proper aggregate (no parentheses)
+ 
+       elsif Paren_Count (Aggr) /= 0 then
+          Error_Msg
+            ("extra parentheses surrounding aggregate not allowed",
+             First_Sloc (Aggr));
+          return;
+ 
        --  All tests passed, so set rep clause in place
  
        else
*************** package body Sem_Ch13 is
*** 1727,1736 ****
        --  normal expansion activities, and a number of special semantic
        --  rules apply (including the component type being any integer type)
  
-       --  Badent signals that we found some incorrect entries processing
-       --  the list. The final checks for completeness and ordering are
-       --  skipped in this case.
- 
        Elit := First_Literal (Enumtype);
  
        --  First the positional entries if any
--- 1508,1513 ----
*************** package body Sem_Ch13 is
*** 1745,1753 ****
  
              Val := Static_Integer (Expr);
  
              if Val = No_Uint then
                 Err := True;
- 
              elsif Val < Lo or else Hi < Val then
                 Error_Msg_N ("value outside permitted range", Expr);
                 Err := True;
--- 1522,1533 ----
  
              Val := Static_Integer (Expr);
  
+             --  Err signals that we found some incorrect entries processing
+             --  the list. The final checks for completeness and ordering are
+             --  skipped in this case.
+ 
              if Val = No_Uint then
                 Err := True;
              elsif Val < Lo or else Hi < Val then
                 Error_Msg_N ("value outside permitted range", Expr);
                 Err := True;
*************** package body Sem_Ch13 is
*** 3351,3357 ****
                           New_Reference_To (
                             Designated_Type (Etype (F)), Loc)))),
  
!              Subtype_Mark =>
                 New_Reference_To (Etyp, Loc));
        end Build_Spec;
  
--- 3131,3137 ----
                           New_Reference_To (
                             Designated_Type (Etype (F)), Loc)))),
  
!              Result_Definition =>
                 New_Reference_To (Etyp, Loc));
        end Build_Spec;
  
*************** package body Sem_Ch13 is
*** 3373,3379 ****
            Specification => Build_Spec,
            Name => New_Reference_To (Subp, Loc));
  
!       if Is_Tagged_Type (Ent) and then not Is_Limited_Type (Ent) then
           Set_TSS (Base_Type (Ent), Subp_Id);
        else
           Insert_Action (N, Subp_Decl);
--- 3153,3159 ----
            Specification => Build_Spec,
            Name => New_Reference_To (Subp, Loc));
  
!       if Is_Tagged_Type (Ent) then
           Set_TSS (Base_Type (Ent), Subp_Id);
        else
           Insert_Action (N, Subp_Decl);
*************** package body Sem_Ch13 is
*** 3451,3457 ****
            Specification => Build_Spec,
            Name => New_Reference_To (Subp, Loc));
  
!       if Is_Tagged_Type (Ent) and then not Is_Limited_Type (Ent) then
           Set_TSS (Base_Type (Ent), Subp_Id);
        else
           Insert_Action (N, Subp_Decl);
--- 3231,3237 ----
            Specification => Build_Spec,
            Name => New_Reference_To (Subp, Loc));
  
!       if Is_Tagged_Type (Ent) then
           Set_TSS (Base_Type (Ent), Subp_Id);
        else
           Insert_Action (N, Subp_Decl);
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch13.ads gcc-4.1.0/gcc/ada/sem_ch13.ads
*** gcc-4.0.2/gcc/ada/sem_ch13.ads	Fri Nov 19 10:56:35 2004
--- gcc-4.1.0/gcc/ada/sem_ch13.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch2.adb gcc-4.1.0/gcc/ada/sem_ch2.adb
*** gcc-4.0.2/gcc/ada/sem_ch2.adb	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/sem_ch2.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch2.ads gcc-4.1.0/gcc/ada/sem_ch2.ads
*** gcc-4.0.2/gcc/ada/sem_ch2.ads	Thu Apr 24 17:54:16 2003
--- gcc-4.1.0/gcc/ada/sem_ch2.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch3.adb gcc-4.1.0/gcc/ada/sem_ch3.adb
*** gcc-4.0.2/gcc/ada/sem_ch3.adb	Thu Mar 17 19:53:06 2005
--- gcc-4.1.0/gcc/ada/sem_ch3.adb	Tue Nov 15 14:02:46 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch3 is
*** 76,102 ****
     -- Local Subprograms --
     -----------------------
  
     procedure Build_Derived_Type
       (N             : Node_Id;
        Parent_Type   : Entity_Id;
        Derived_Type  : Entity_Id;
        Is_Completion : Boolean;
        Derive_Subps  : Boolean := True);
!    --  Create and decorate a Derived_Type given the Parent_Type entity.
!    --  N is the N_Full_Type_Declaration node containing the derived type
!    --  definition. Parent_Type is the entity for the parent type in the derived
!    --  type definition and Derived_Type the actual derived type. Is_Completion
!    --  must be set to False if Derived_Type is the N_Defining_Identifier node
!    --  in N (ie Derived_Type = Defining_Identifier (N)). In this case N is not
!    --  the completion of a private type declaration. If Is_Completion is
!    --  set to True, N is the completion of a private type declaration and
!    --  Derived_Type is different from the defining identifier inside N (i.e.
!    --  Derived_Type /= Defining_Identifier (N)). Derive_Subps indicates whether
!    --  the parent subprograms should be derived. The only case where this
!    --  parameter is False is when Build_Derived_Type is recursively called to
!    --  process an implicit derived full type for a type derived from a private
!    --  type (in that case the subprograms must only be derived for the private
!    --  view of the type).
     --  ??? These flags need a bit of re-examination and re-documentation:
     --  ???  are they both necessary (both seem related to the recursion)?
  
--- 76,109 ----
     -- Local Subprograms --
     -----------------------
  
+    procedure Add_Interface_Tag_Components
+      (N : Node_Id; Typ : Entity_Id);
+    --  Ada 2005 (AI-251): Add the tag components corresponding to all the
+    --  abstract interface types implemented by a record type or a derived
+    --  record type.
+ 
     procedure Build_Derived_Type
       (N             : Node_Id;
        Parent_Type   : Entity_Id;
        Derived_Type  : Entity_Id;
        Is_Completion : Boolean;
        Derive_Subps  : Boolean := True);
!    --  Create and decorate a Derived_Type given the Parent_Type entity. N is
!    --  the N_Full_Type_Declaration node containing the derived type definition.
!    --  Parent_Type is the entity for the parent type in the derived type
!    --  definition and Derived_Type the actual derived type. Is_Completion must
!    --  be set to False if Derived_Type is the N_Defining_Identifier node in N
!    --  (ie Derived_Type = Defining_Identifier (N)). In this case N is not the
!    --  completion of a private type declaration. If Is_Completion is set to
!    --  True, N is the completion of a private type declaration and Derived_Type
!    --  is different from the defining identifier inside N (i.e. Derived_Type /=
!    --  Defining_Identifier (N)). Derive_Subps indicates whether the parent
!    --  subprograms should be derived. The only case where this parameter is
!    --  False is when Build_Derived_Type is recursively called to process an
!    --  implicit derived full type for a type derived from a private type (in
!    --  that case the subprograms must only be derived for the private view of
!    --  the type).
! 
     --  ??? These flags need a bit of re-examination and re-documentation:
     --  ???  are they both necessary (both seem related to the recursion)?
  
*************** package body Sem_Ch3 is
*** 154,160 ****
        Parent_Type  : Entity_Id;
        Derived_Type : Entity_Id;
        Derive_Subps : Boolean := True);
!    --  Subsidiary procedure to Build_Derived_Type and
     --  Analyze_Private_Extension_Declaration used for tagged and untagged
     --  record types. All parameters are as in Build_Derived_Type except that
     --  N, in addition to being an N_Full_Type_Declaration node, can also be an
--- 161,167 ----
        Parent_Type  : Entity_Id;
        Derived_Type : Entity_Id;
        Derive_Subps : Boolean := True);
!    --  Subsidiary procedure for Build_Derived_Type and
     --  Analyze_Private_Extension_Declaration used for tagged and untagged
     --  record types. All parameters are as in Build_Derived_Type except that
     --  N, in addition to being an N_Full_Type_Declaration node, can also be an
*************** package body Sem_Ch3 is
*** 164,169 ****
--- 171,185 ----
     --  False is for an implicit derived full type for a type derived from a
     --  private type (see Build_Derived_Type).
  
+    procedure Complete_Subprograms_Derivation
+      (Partial_View : Entity_Id;
+       Derived_Type : Entity_Id);
+    --  Ada 2005 (AI-251): Used to complete type derivation of private tagged
+    --  types implementing interfaces. In this case some interface primitives
+    --  may have been overriden with the partial-view and, instead of
+    --  re-calculating them, they are included in the list of primitive
+    --  operations of the full-view.
+ 
     function Inherit_Components
       (N             : Node_Id;
        Parent_Base   : Entity_Id;
*************** package body Sem_Ch3 is
*** 176,184 ****
     --  For more information on derived types and component inheritance please
     --  consult the comment above the body of Build_Derived_Record_Type.
     --
!    --    N is the original derived type declaration.
     --
!    --    Is_Tagged is set if we are dealing with tagged types.
     --
     --    If Inherit_Discr is set, Derived_Base inherits its discriminants
     --    from Parent_Base, otherwise no discriminants are inherited.
--- 192,200 ----
     --  For more information on derived types and component inheritance please
     --  consult the comment above the body of Build_Derived_Record_Type.
     --
!    --    N is the original derived type declaration
     --
!    --    Is_Tagged is set if we are dealing with tagged types
     --
     --    If Inherit_Discr is set, Derived_Base inherits its discriminants
     --    from Parent_Base, otherwise no discriminants are inherited.
*************** package body Sem_Ch3 is
*** 220,233 ****
        Derived_Def : Boolean := False) return Elist_Id;
     --  Validate discriminant constraints, and return the list of the
     --  constraints in order of discriminant declarations. T is the
!    --  discriminated unconstrained type. Def is the N_Subtype_Indication
!    --  node where the discriminants constraints for T are specified.
!    --  Derived_Def is True if we are building the discriminant constraints
!    --  in a derived type definition of the form "type D (...) is new T (xxx)".
!    --  In this case T is the parent type and Def is the constraint "(xxx)" on
!    --  T and this routine sets the Corresponding_Discriminant field of the
!    --  discriminants in the derived type D to point to the corresponding
!    --  discriminants in the parent type T.
  
     procedure Build_Discriminated_Subtype
       (T           : Entity_Id;
--- 236,249 ----
        Derived_Def : Boolean := False) return Elist_Id;
     --  Validate discriminant constraints, and return the list of the
     --  constraints in order of discriminant declarations. T is the
!    --  discriminated unconstrained type. Def is the N_Subtype_Indication node
!    --  where the discriminants constraints for T are specified. Derived_Def is
!    --  True if we are building the discriminant constraints in a derived type
!    --  definition of the form "type D (...) is new T (xxx)". In this case T is
!    --  the parent type and Def is the constraint "(xxx)" on T and this routine
!    --  sets the Corresponding_Discriminant field of the discriminants in the
!    --  derived type D to point to the corresponding discriminants in the parent
!    --  type T.
  
     procedure Build_Discriminated_Subtype
       (T           : Entity_Id;
*************** package body Sem_Ch3 is
*** 350,362 ****
     --  discriminant constraints for Typ.
  
     function Constrain_Component_Type
!      (Compon_Type     : Entity_Id;
        Constrained_Typ : Entity_Id;
        Related_Node    : Node_Id;
        Typ             : Entity_Id;
        Constraints     : Elist_Id) return Entity_Id;
     --  Given a discriminated base type Typ, a list of discriminant constraint
!    --  Constraints for Typ and the type of a component of Typ, Compon_Type,
     --  create and return the type corresponding to Compon_type where all
     --  discriminant references are replaced with the corresponding
     --  constraint. If no discriminant references occur in Compon_Typ then
--- 366,378 ----
     --  discriminant constraints for Typ.
  
     function Constrain_Component_Type
!      (Comp            : Entity_Id;
        Constrained_Typ : Entity_Id;
        Related_Node    : Node_Id;
        Typ             : Entity_Id;
        Constraints     : Elist_Id) return Entity_Id;
     --  Given a discriminated base type Typ, a list of discriminant constraint
!    --  Constraints for Typ and a component of Typ, with type Compon_Type,
     --  create and return the type corresponding to Compon_type where all
     --  discriminant references are replaced with the corresponding
     --  constraint. If no discriminant references occur in Compon_Typ then
*************** package body Sem_Ch3 is
*** 368,376 ****
       (Def_Id      : in out Entity_Id;
        S           : Node_Id;
        Related_Nod : Node_Id);
!    --  Apply a list of constraints to an access type. If Def_Id is empty,
!    --  it is an anonymous type created for a subtype indication. In that
!    --  case it is created in the procedure and attached to Related_Nod.
  
     procedure Constrain_Array
       (Def_Id      : in out Entity_Id;
--- 384,392 ----
       (Def_Id      : in out Entity_Id;
        S           : Node_Id;
        Related_Nod : Node_Id);
!    --  Apply a list of constraints to an access type. If Def_Id is empty, it is
!    --  an anonymous type created for a subtype indication. In that case it is
!    --  created in the procedure and attached to Related_Nod.
  
     procedure Constrain_Array
       (Def_Id      : in out Entity_Id;
*************** package body Sem_Ch3 is
*** 437,445 ****
     --  of For_Access.
  
     procedure Constrain_Enumeration (Def_Id : Node_Id; S : Node_Id);
!    --  Constrain an enumeration type with a range constraint. This is
!    --  identical to Constrain_Integer, but for the Ekind of the
!    --  resulting subtype.
  
     procedure Constrain_Float (Def_Id : Node_Id; S : Node_Id);
     --  Constrain a floating point type with either a digits constraint
--- 453,460 ----
     --  of For_Access.
  
     procedure Constrain_Enumeration (Def_Id : Node_Id; S : Node_Id);
!    --  Constrain an enumeration type with a range constraint. This is identical
!    --  to Constrain_Integer, but for the Ekind of the resulting subtype.
  
     procedure Constrain_Float (Def_Id : Node_Id; S : Node_Id);
     --  Constrain a floating point type with either a digits constraint
*************** package body Sem_Ch3 is
*** 481,489 ****
        Full        : Entity_Id;
        Full_Base   : Entity_Id;
        Related_Nod : Node_Id);
!    --  Complete the implicit full view of a private subtype by setting
!    --  the appropriate semantic fields. If the full view of the parent is
!    --  a record type, build constrained components of subtype.
  
     procedure Derived_Standard_Character
       (N             : Node_Id;
--- 496,510 ----
        Full        : Entity_Id;
        Full_Base   : Entity_Id;
        Related_Nod : Node_Id);
!    --  Complete the implicit full view of a private subtype by setting the
!    --  appropriate semantic fields. If the full view of the parent is a record
!    --  type, build constrained components of subtype.
! 
!    procedure Derive_Interface_Subprograms
!      (Derived_Type : Entity_Id);
!    --  Ada 2005 (AI-251): Subsidiary procedure to Build_Derived_Record_Type.
!    --  Traverse the list of implemented interfaces and derive all their
!    --  subprograms.
  
     procedure Derived_Standard_Character
       (N             : Node_Id;
*************** package body Sem_Ch3 is
*** 500,527 ****
     --  Build_Derived_Type to process the actual derived type definition.
     --  Parameters N and Is_Completion have the same meaning as in
     --  Build_Derived_Type. T is the N_Defining_Identifier for the entity
!    --  defined in the N_Full_Type_Declaration node N, that is T is the
!    --  derived type.
! 
!    function Find_Type_Of_Subtype_Indic (S : Node_Id) return Entity_Id;
!    --  Given a subtype indication S (which is really an N_Subtype_Indication
!    --  node or a plain N_Identifier), find the type of the subtype mark.
  
     procedure Enumeration_Type_Declaration (T : Entity_Id; Def : Node_Id);
!    --  Insert each literal in symbol table, as an overloadable identifier
!    --  Each enumeration type is mapped into a sequence of integers, and
!    --  each literal is defined as a constant with integer value. If any
!    --  of the literals are character literals, the type is a character
!    --  type, which means that strings are legal aggregates for arrays of
!    --  components of the type.
  
     function Expand_To_Stored_Constraint
       (Typ        : Entity_Id;
        Constraint : Elist_Id) return Elist_Id;
!    --  Given a Constraint (ie a list of expressions) on the discriminants of
!    --  Typ, expand it into a constraint on the stored discriminants and
!    --  return the new list of expressions constraining the stored
!    --  discriminants.
  
     function Find_Type_Of_Object
       (Obj_Def     : Node_Id;
--- 521,542 ----
     --  Build_Derived_Type to process the actual derived type definition.
     --  Parameters N and Is_Completion have the same meaning as in
     --  Build_Derived_Type. T is the N_Defining_Identifier for the entity
!    --  defined in the N_Full_Type_Declaration node N, that is T is the derived
!    --  type.
  
     procedure Enumeration_Type_Declaration (T : Entity_Id; Def : Node_Id);
!    --  Insert each literal in symbol table, as an overloadable identifier. Each
!    --  enumeration type is mapped into a sequence of integers, and each literal
!    --  is defined as a constant with integer value. If any of the literals are
!    --  character literals, the type is a character type, which means that
!    --  strings are legal aggregates for arrays of components of the type.
  
     function Expand_To_Stored_Constraint
       (Typ        : Entity_Id;
        Constraint : Elist_Id) return Elist_Id;
!    --  Given a Constraint (i.e. a list of expressions) on the discriminants of
!    --  Typ, expand it into a constraint on the stored discriminants and return
!    --  the new list of expressions constraining the stored discriminants.
  
     function Find_Type_Of_Object
       (Obj_Def     : Node_Id;
*************** package body Sem_Ch3 is
*** 541,549 ****
     function Is_Valid_Constraint_Kind
       (T_Kind          : Type_Kind;
        Constraint_Kind : Node_Kind) return Boolean;
!    --  Returns True if it is legal to apply the given kind of constraint
!    --  to the given kind of type (index constraint to an array type,
!    --  for example).
  
     procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id);
     --  Create new modular type. Verify that modulus is in  bounds and is
--- 556,563 ----
     function Is_Valid_Constraint_Kind
       (T_Kind          : Type_Kind;
        Constraint_Kind : Node_Kind) return Boolean;
!    --  Returns True if it is legal to apply the given kind of constraint to the
!    --  given kind of type (index constraint to an array type, for example).
  
     procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id);
     --  Create new modular type. Verify that modulus is in  bounds and is
*************** package body Sem_Ch3 is
*** 556,563 ****
     procedure Ordinary_Fixed_Point_Type_Declaration
       (T   : Entity_Id;
        Def : Node_Id);
!    --  Create a new ordinary fixed point type, and apply the constraint
!    --  to obtain subtype of it.
  
     procedure Prepare_Private_Subtype_Completion
       (Id          : Entity_Id;
--- 570,577 ----
     procedure Ordinary_Fixed_Point_Type_Declaration
       (T   : Entity_Id;
        Def : Node_Id);
!    --  Create a new ordinary fixed point type, and apply the constraint to
!    --  obtain subtype of it.
  
     procedure Prepare_Private_Subtype_Completion
       (Id          : Entity_Id;
*************** package body Sem_Ch3 is
*** 606,615 ****
        Prev : Entity_Id);
     --  Process a record type declaration (for both untagged and tagged
     --  records). Parameters T and N are exactly like in procedure
!    --  Derived_Type_Declaration, except that no flag Is_Completion is
!    --  needed for this routine. If this is the completion of an incomplete
!    --  type declaration, Prev is the entity of the incomplete declaration,
!    --  used for cross-referencing. Otherwise Prev = T.
  
     procedure Record_Type_Definition (Def : Node_Id; Prev_T : Entity_Id);
     --  This routine is used to process the actual record type definition
--- 620,629 ----
        Prev : Entity_Id);
     --  Process a record type declaration (for both untagged and tagged
     --  records). Parameters T and N are exactly like in procedure
!    --  Derived_Type_Declaration, except that no flag Is_Completion is needed
!    --  for this routine. If this is the completion of an incomplete type
!    --  declaration, Prev is the entity of the incomplete declaration, used for
!    --  cross-referencing. Otherwise Prev = T.
  
     procedure Record_Type_Definition (Def : Node_Id; Prev_T : Entity_Id);
     --  This routine is used to process the actual record type definition
*************** package body Sem_Ch3 is
*** 677,682 ****
--- 691,726 ----
           Error_Msg_N ("task entries cannot have access parameters", N);
        end if;
  
+       --  Ada 2005: for an object declaration or function with an anonymous
+       --  access result, the corresponding anonymous type is declared in the
+       --  current scope. For access formals, access components, and access
+       --  discriminants, the scope is that of the enclosing declaration,
+       --  as set above. This special-case handling of resetting the scope
+       --  is awkward, and it might be better to pass in the required scope
+       --  as a parameter. ???
+ 
+       if Nkind (Related_Nod) = N_Object_Declaration then
+          Set_Scope (Anon_Type, Current_Scope);
+ 
+       --  For the anonymous function result case, retrieve the scope of
+       --  the function specification's associated entity rather than using
+       --  the current scope. The current scope will be the function itself
+       --  if the formal part is currently being analyzed, but will be the
+       --  parent scope in the case of a parameterless function, and we
+       --  always want to use the function's parent scope.
+ 
+       elsif Nkind (Related_Nod) = N_Function_Specification
+          and then Nkind (Parent (N)) /= N_Parameter_Specification
+       then
+          Set_Scope (Anon_Type, Scope (Defining_Unit_Name (Related_Nod)));
+       end if;
+ 
+       if All_Present (N)
+         and then Ada_Version >= Ada_05
+       then
+          Error_Msg_N ("ALL is not permitted for anonymous access types", N);
+       end if;
+ 
        --  Ada 2005 (AI-254): In case of anonymous access to subprograms
        --  call the corresponding semantic routine
  
*************** package body Sem_Ch3 is
*** 731,743 ****
  
        Set_Is_Access_Constant (Anon_Type, Constant_Present (N));
  
!       --  The context is either a subprogram declaration or an access
!       --  discriminant, in a private or a full type declaration. In the case
!       --  of a subprogram, If the designated type is incomplete, the operation
!       --  will be a primitive operation of the full type, to be updated
!       --  subsequently. If the type is imported through a limited with clause,
!       --  it is not a primitive operation of the type (which is declared
!       --  elsewhere in some other scope).
  
        if Ekind (Desig_Type) = E_Incomplete_Type
          and then not From_With_Type (Desig_Type)
--- 775,787 ----
  
        Set_Is_Access_Constant (Anon_Type, Constant_Present (N));
  
!       --  The context is either a subprogram declaration, object declaration,
!       --  or an access discriminant, in a private or a full type declaration.
!       --  In the case of a subprogram, if the designated type is incomplete,
!       --  the operation will be a primitive operation of the full type, to be
!       --  updated subsequently. If the type is imported through a limited_with
!       --  clause, the subprogram is not a primitive operation of the type
!       --  (which is declared elsewhere in some other scope).
  
        if Ekind (Desig_Type) = E_Incomplete_Type
          and then not From_With_Type (Desig_Type)
*************** package body Sem_Ch3 is
*** 747,752 ****
--- 791,810 ----
           Set_Has_Delayed_Freeze (Current_Scope);
        end if;
  
+       --  Ada 2005: if the designated type is an interface that may contain
+       --  tasks, create a Master entity for the declaration. This must be done
+       --  before expansion of the full declaration, because the declaration
+       --  may include an expression that is an allocator, whose expansion needs
+       --  the proper Master for the created tasks.
+ 
+       if Nkind (Related_Nod) = N_Object_Declaration
+          and then Expander_Active
+          and then Is_Interface (Desig_Type)
+          and then Is_Limited_Record (Desig_Type)
+       then
+          Build_Class_Wide_Master (Anon_Type);
+       end if;
+ 
        return Anon_Type;
     end Access_Definition;
  
*************** package body Sem_Ch3 is
*** 760,777 ****
     is
        Formals : constant List_Id := Parameter_Specifications (T_Def);
        Formal  : Entity_Id;
  
        Desig_Type : constant Entity_Id :=
                       Create_Itype (E_Subprogram_Type, Parent (T_Def));
  
     begin
        if Nkind (T_Def) = N_Access_Function_Definition then
!          Analyze (Subtype_Mark (T_Def));
!          Set_Etype (Desig_Type, Entity (Subtype_Mark (T_Def)));
  
           if not (Is_Type (Etype (Desig_Type))) then
              Error_Msg_N
!              ("expect type in function specification", Subtype_Mark (T_Def));
           end if;
  
        else
--- 818,879 ----
     is
        Formals : constant List_Id := Parameter_Specifications (T_Def);
        Formal  : Entity_Id;
+       D_Ityp  : Node_Id;
  
        Desig_Type : constant Entity_Id :=
                       Create_Itype (E_Subprogram_Type, Parent (T_Def));
  
     begin
+       --  Associate the Itype node with the inner full-type declaration
+       --  or subprogram spec. This is required to handle nested anonymous
+       --  declarations. For example:
+ 
+       --      procedure P
+       --       (X : access procedure
+       --                     (Y : access procedure
+       --                                   (Z : access T)))
+ 
+       D_Ityp := Associated_Node_For_Itype (Desig_Type);
+       while Nkind (D_Ityp) /= N_Full_Type_Declaration
+          and then Nkind (D_Ityp) /= N_Procedure_Specification
+          and then Nkind (D_Ityp) /= N_Function_Specification
+          and then Nkind (D_Ityp) /= N_Object_Declaration
+          and then Nkind (D_Ityp) /= N_Object_Renaming_Declaration
+          and then Nkind (D_Ityp) /= N_Formal_Type_Declaration
+       loop
+          D_Ityp := Parent (D_Ityp);
+          pragma Assert (D_Ityp /= Empty);
+       end loop;
+ 
+       Set_Associated_Node_For_Itype (Desig_Type, D_Ityp);
+ 
+       if Nkind (D_Ityp) = N_Procedure_Specification
+         or else Nkind (D_Ityp) = N_Function_Specification
+       then
+          Set_Scope (Desig_Type, Scope (Defining_Unit_Name (D_Ityp)));
+ 
+       elsif Nkind (D_Ityp) = N_Full_Type_Declaration
+         or else Nkind (D_Ityp) = N_Object_Declaration
+         or else Nkind (D_Ityp) = N_Object_Renaming_Declaration
+         or else Nkind (D_Ityp) = N_Formal_Type_Declaration
+       then
+          Set_Scope (Desig_Type, Scope (Defining_Identifier (D_Ityp)));
+       end if;
+ 
        if Nkind (T_Def) = N_Access_Function_Definition then
!          if Nkind (Result_Definition (T_Def)) = N_Access_Definition then
!             Set_Etype
!               (Desig_Type,
!                Access_Definition (T_Def, Result_Definition (T_Def)));
!          else
!             Analyze (Result_Definition (T_Def));
!             Set_Etype (Desig_Type, Entity (Result_Definition (T_Def)));
!          end if;
  
           if not (Is_Type (Etype (Desig_Type))) then
              Error_Msg_N
!               ("expect type in function specification",
!                Result_Definition (T_Def));
           end if;
  
        else
*************** package body Sem_Ch3 is
*** 799,805 ****
  
        if Present (Formals) then
           Formal := First_Formal (Desig_Type);
- 
           while Present (Formal) loop
              if Ekind (Formal) /= E_In_Parameter
                and then Nkind (T_Def) = N_Access_Function_Definition
--- 901,906 ----
*************** package body Sem_Ch3 is
*** 880,885 ****
--- 981,1000 ----
  
        if Base_Type (Designated_Type (T)) = T then
           Error_Msg_N ("access type cannot designate itself", S);
+ 
+       --  In Ada 2005, the type may have a limited view through some unit
+       --  in its own context, allowing the following circularity that cannot
+       --  be detected earlier
+ 
+       elsif Is_Class_Wide_Type (Designated_Type (T))
+         and then Etype (Designated_Type (T)) = T
+       then
+          Error_Msg_N
+            ("access type cannot designate its own classwide type", S);
+ 
+          --  Clean up indication of tagged status to prevent cascaded errors
+ 
+          Set_Is_Tagged_Type (T, False);
        end if;
  
        Set_Etype (T, T);
*************** package body Sem_Ch3 is
*** 907,913 ****
           N_Desig : Entity_Id;
  
        begin
!          if From_With_Type (Desig) then
              Set_From_With_Type (T);
  
              if Ekind (Desig) = E_Incomplete_Type then
--- 1022,1030 ----
           N_Desig : Entity_Id;
  
        begin
!          if From_With_Type (Desig)
!            and then Ekind (Desig) /= E_Access_Type
!          then
              Set_From_With_Type (T);
  
              if Ekind (Desig) = E_Incomplete_Type then
*************** package body Sem_Ch3 is
*** 940,945 ****
--- 1057,1198 ----
        Set_Is_Access_Constant (T, Constant_Present (Def));
     end Access_Type_Declaration;
  
+    ----------------------------------
+    -- Add_Interface_Tag_Components --
+    ----------------------------------
+ 
+    procedure Add_Interface_Tag_Components
+      (N        : Node_Id;
+       Typ      : Entity_Id)
+    is
+       Loc      : constant Source_Ptr := Sloc (N);
+       Elmt     : Elmt_Id;
+       Ext      : Node_Id;
+       L        : List_Id;
+       Last_Tag : Node_Id;
+       Comp     : Node_Id;
+ 
+       procedure Add_Tag (Iface : Entity_Id);
+       --  Comment required ???
+ 
+       -------------
+       -- Add_Tag --
+       -------------
+ 
+       procedure Add_Tag (Iface : Entity_Id) is
+          Def      : Node_Id;
+          Tag      : Entity_Id;
+          Decl     : Node_Id;
+ 
+       begin
+          pragma Assert (Is_Tagged_Type (Iface)
+            and then Is_Interface (Iface));
+ 
+          Def :=
+            Make_Component_Definition (Loc,
+              Aliased_Present    => True,
+              Subtype_Indication =>
+                New_Occurrence_Of (RTE (RE_Interface_Tag), Loc));
+ 
+          Tag := Make_Defining_Identifier (Loc, New_Internal_Name ('V'));
+ 
+          Decl :=
+            Make_Component_Declaration (Loc,
+              Defining_Identifier  => Tag,
+              Component_Definition => Def);
+ 
+          Analyze_Component_Declaration (Decl);
+ 
+          Set_Analyzed (Decl);
+          Set_Ekind               (Tag, E_Component);
+          Set_Is_Limited_Record   (Tag);
+          Set_Is_Tag              (Tag);
+          Init_Component_Location (Tag);
+ 
+          pragma Assert (Is_Frozen (Iface));
+ 
+          Set_DT_Entry_Count    (Tag,
+            DT_Entry_Count (First_Entity (Iface)));
+ 
+          if not Present (Last_Tag) then
+             Prepend (Decl, L);
+          else
+             Insert_After (Last_Tag, Decl);
+          end if;
+ 
+          Last_Tag := Decl;
+       end Add_Tag;
+ 
+    --  Start of processing for Add_Interface_Tag_Components
+ 
+    begin
+       if Ekind (Typ) /= E_Record_Type
+         or else not Present (Abstract_Interfaces (Typ))
+         or else Is_Empty_Elmt_List (Abstract_Interfaces (Typ))
+       then
+          return;
+       end if;
+ 
+       if Present (Abstract_Interfaces (Typ)) then
+ 
+          --  Find the current last tag
+ 
+          if Nkind (Type_Definition (N)) = N_Derived_Type_Definition then
+             Ext := Record_Extension_Part (Type_Definition (N));
+          else
+             pragma Assert (Nkind (Type_Definition (N)) = N_Record_Definition);
+             Ext := Type_Definition (N);
+          end if;
+ 
+          Last_Tag := Empty;
+ 
+          if not (Present (Component_List (Ext))) then
+             Set_Null_Present (Ext, False);
+             L := New_List;
+             Set_Component_List (Ext,
+               Make_Component_List (Loc,
+                 Component_Items => L,
+                 Null_Present => False));
+          else
+             if Nkind (Type_Definition (N)) = N_Derived_Type_Definition then
+                L := Component_Items
+                       (Component_List
+                         (Record_Extension_Part
+                           (Type_Definition (N))));
+             else
+                L := Component_Items
+                       (Component_List
+                         (Type_Definition (N)));
+             end if;
+ 
+             --  Find the last tag component
+ 
+             Comp := First (L);
+             while Present (Comp) loop
+                if Is_Tag (Defining_Identifier (Comp)) then
+                   Last_Tag := Comp;
+                end if;
+ 
+                Next (Comp);
+             end loop;
+          end if;
+ 
+          --  At this point L references the list of components and Last_Tag
+          --  references the current last tag (if any). Now we add the tag
+          --  corresponding with all the interfaces that are not implemented
+          --  by the parent.
+ 
+          pragma Assert (Present
+                         (First_Elmt (Abstract_Interfaces (Typ))));
+ 
+          Elmt := First_Elmt (Abstract_Interfaces (Typ));
+          while Present (Elmt) loop
+             Add_Tag (Node (Elmt));
+             Next_Elmt (Elmt);
+          end loop;
+       end if;
+    end Add_Interface_Tag_Components;
+ 
     -----------------------------------
     -- Analyze_Component_Declaration --
     -----------------------------------
*************** package body Sem_Ch3 is
*** 973,984 ****
  
              when N_Index_Or_Discriminant_Constraint =>
                 declare
!                   IDC : Node_Id := First (Constraints (Constr));
  
                 begin
                    while Present (IDC) loop
  
!                      --  One per-object constraint is sufficent
  
                       if Contains_POC (IDC) then
                          return True;
--- 1226,1238 ----
  
              when N_Index_Or_Discriminant_Constraint =>
                 declare
!                   IDC : Node_Id;
  
                 begin
+                   IDC := First (Constraints (Constr));
                    while Present (IDC) loop
  
!                      --  One per-object constraint is sufficient
  
                       if Contains_POC (IDC) then
                          return True;
*************** package body Sem_Ch3 is
*** 1023,1034 ****
           T := Access_Definition
                  (Related_Nod => N,
                   N => Access_Definition (Component_Definition (N)));
! 
!          --  Ada 2005 (AI-230): In case of components that are anonymous
!          --  access types the level of accessibility depends on the enclosing
!          --  type declaration
! 
!          Set_Scope (T, Current_Scope); -- Ada 2005 (AI-230)
  
           --  Ada 2005 (AI-254)
  
--- 1277,1283 ----
           T := Access_Definition
                  (Related_Nod => N,
                   N => Access_Definition (Component_Definition (N)));
!          Set_Is_Local_Anonymous_Access (T);
  
           --  Ada 2005 (AI-254)
  
*************** package body Sem_Ch3 is
*** 1043,1053 ****
        end if;
  
        --  If the subtype is a constrained subtype of the enclosing record,
!       --  (which must have a partial view) the back-end does not handle
!       --  properly the recursion. Rewrite the component declaration with
!       --  an explicit subtype indication, which is acceptable to Gigi. We
!       --  can copy the tree directly because side effects have already been
!       --  removed from discriminant constraints.
  
        if Ekind (T) = E_Access_Subtype
          and then Is_Entity_Name (Subtype_Indication (Component_Definition (N)))
--- 1292,1302 ----
        end if;
  
        --  If the subtype is a constrained subtype of the enclosing record,
!       --  (which must have a partial view) the back-end does not properly
!       --  handle the recursion. Rewrite the component declaration with an
!       --  explicit subtype indication, which is acceptable to Gigi. We can copy
!       --  the tree directly because side effects have already been removed from
!       --  discriminant constraints.
  
        if Ekind (T) = E_Access_Subtype
          and then Is_Entity_Name (Subtype_Indication (Component_Definition (N)))
*************** package body Sem_Ch3 is
*** 1120,1135 ****
        --  out some static checks.
  
        if Ada_Version >= Ada_05
!         and then (Null_Exclusion_Present (Component_Definition (N))
!                     or else Can_Never_Be_Null (T))
        then
-          Set_Can_Never_Be_Null (Id);
           Null_Exclusion_Static_Checks (N);
        end if;
  
!       --  If this component is private (or depends on a private type),
!       --  flag the record type to indicate that some operations are not
!       --  available.
  
        P := Private_Component (T);
  
--- 1369,1381 ----
        --  out some static checks.
  
        if Ada_Version >= Ada_05
!         and then Can_Never_Be_Null (T)
        then
           Null_Exclusion_Static_Checks (N);
        end if;
  
!       --  If this component is private (or depends on a private type), flag the
!       --  record type to indicate that some operations are not available.
  
        P := Private_Component (T);
  
*************** package body Sem_Ch3 is
*** 1320,1325 ****
--- 1566,1581 ----
        Init_Size_Align (T);
        Set_Is_First_Subtype (T, True);
        Set_Etype (T, T);
+ 
+       --  Ada 2005 (AI-326): Minimum decoration to give support to tagged
+       --  incomplete types.
+ 
+       if Tagged_Present (N) then
+          Set_Is_Tagged_Type (T);
+          Make_Class_Wide_Type (T);
+          Set_Primitive_Operations (T, New_Elmt_List);
+       end if;
+ 
        New_Scope (T);
  
        Set_Stored_Constraint (T, No_Elist);
*************** package body Sem_Ch3 is
*** 1338,1349 ****
        Set_Is_Pure (T, F);
     end Analyze_Incomplete_Type_Decl;
  
     -----------------------------
     -- Analyze_Itype_Reference --
     -----------------------------
  
!    --  Nothing to do. This node is placed in the tree only for the benefit
!    --  of Gigi processing, and has no effect on the semantic processing.
  
     procedure Analyze_Itype_Reference (N : Node_Id) is
     begin
--- 1594,1632 ----
        Set_Is_Pure (T, F);
     end Analyze_Incomplete_Type_Decl;
  
+    -----------------------------------
+    -- Analyze_Interface_Declaration --
+    -----------------------------------
+ 
+    procedure Analyze_Interface_Declaration (T : Entity_Id; Def : Node_Id) is
+    begin
+       Set_Is_Tagged_Type      (T);
+ 
+       Set_Is_Limited_Record   (T, Limited_Present (Def)
+                                    or else Task_Present (Def)
+                                    or else Protected_Present (Def)
+                                    or else Synchronized_Present (Def));
+ 
+       --  Type is abstract if full declaration carries keyword, or if
+       --  previous partial view did.
+ 
+       Set_Is_Abstract  (T);
+       Set_Is_Interface (T);
+ 
+       Set_Is_Limited_Interface      (T, Limited_Present (Def));
+       Set_Is_Protected_Interface    (T, Protected_Present (Def));
+       Set_Is_Synchronized_Interface (T, Synchronized_Present (Def));
+       Set_Is_Task_Interface         (T, Task_Present (Def));
+       Set_Abstract_Interfaces       (T, New_Elmt_List);
+       Set_Primitive_Operations      (T, New_Elmt_List);
+    end Analyze_Interface_Declaration;
+ 
     -----------------------------
     -- Analyze_Itype_Reference --
     -----------------------------
  
!    --  Nothing to do. This node is placed in the tree only for the benefit of
!    --  back end processing, and has no effect on the semantic processing.
  
     procedure Analyze_Itype_Reference (N : Node_Id) is
     begin
*************** package body Sem_Ch3 is
*** 1402,1409 ****
  
        else
           T := Any_Type;
-          Get_First_Interp (E, Index, It);
  
           while Present (It.Typ) loop
              if (Is_Integer_Type (It.Typ)
                   or else Is_Real_Type (It.Typ))
--- 1685,1692 ----
  
        else
           T := Any_Type;
  
+          Get_First_Interp (E, Index, It);
           while Present (It.Typ) loop
              if (Is_Integer_Type (It.Typ)
                   or else Is_Real_Type (It.Typ))
*************** package body Sem_Ch3 is
*** 1433,1440 ****
  
        elsif Is_Real_Type (T) then
  
!          --  Because the real value is converted to universal_real, this
!          --  is a legal context for a universal fixed expression.
  
           if T = Universal_Fixed then
              declare
--- 1716,1723 ----
  
        elsif Is_Real_Type (T) then
  
!          --  Because the real value is converted to universal_real, this is a
!          --  legal context for a universal fixed expression.
  
           if T = Universal_Fixed then
              declare
*************** package body Sem_Ch3 is
*** 1452,1459 ****
           elsif T = Any_Fixed then
              Error_Msg_N ("illegal context for mixed mode operation", E);
  
!             --  Expression is of the form : universal_fixed * integer.
!             --  Try to resolve as universal_real.
  
              T := Universal_Real;
              Set_Etype (E, T);
--- 1735,1742 ----
           elsif T = Any_Fixed then
              Error_Msg_N ("illegal context for mixed mode operation", E);
  
!             --  Expression is of the form : universal_fixed * integer. Try to
!             --  resolve as universal_real.
  
              T := Universal_Real;
              Set_Etype (E, T);
*************** package body Sem_Ch3 is
*** 1508,1514 ****
        --  If the object is limited or aliased, and if the type is unconstrained
        --  and there is no expression, the discriminants cannot be modified and
        --  the subtype of the object is constrained by the defaults, so it is
!       --  worthile building the corresponding subtype.
  
        function Count_Tasks (T : Entity_Id) return Uint;
        --  This function is called when a library level object of type is
--- 1791,1797 ----
        --  If the object is limited or aliased, and if the type is unconstrained
        --  and there is no expression, the discriminants cannot be modified and
        --  the subtype of the object is constrained by the defaults, so it is
!       --  worthwhile building the corresponding subtype.
  
        function Count_Tasks (T : Entity_Id) return Uint;
        --  This function is called when a library level object of type is
*************** package body Sem_Ch3 is
*** 1660,1667 ****
              return;
           end if;
  
!       --  In the normal case, enter identifier at the start to catch
!       --  premature usage in the initialization expression.
  
        else
           Generate_Definition (Id);
--- 1943,1950 ----
              return;
           end if;
  
!       --  In the normal case, enter identifier at the start to catch premature
!       --  usage in the initialization expression.
  
        else
           Generate_Definition (Id);
*************** package body Sem_Ch3 is
*** 1680,1690 ****
        --  out some static checks
  
        if Ada_Version >= Ada_05
!         and then (Null_Exclusion_Present (N)
!                     or else Can_Never_Be_Null (T))
        then
!          Set_Can_Never_Be_Null (Id);
!          Null_Exclusion_Static_Checks (N);
        end if;
  
        Set_Is_Pure (Id, Is_Pure (Current_Scope));
--- 1963,1988 ----
        --  out some static checks
  
        if Ada_Version >= Ada_05
!         and then Can_Never_Be_Null (T)
        then
!          --  In case of aggregates we must also take care of the correct
!          --  initialization of nested aggregates bug this is done at the
!          --  point of the analysis of the aggregate (see sem_aggr.adb)
! 
!          if Present (Expression (N))
!            and then Nkind (Expression (N)) = N_Aggregate
!          then
!             null;
! 
!          else
!             declare
!                Save_Typ : constant Entity_Id := Etype (Id);
!             begin
!                Set_Etype (Id, T); --  Temp. decoration for static checks
!                Null_Exclusion_Static_Checks (N);
!                Set_Etype (Id, Save_Typ);
!             end;
!          end if;
        end if;
  
        Set_Is_Pure (Id, Is_Pure (Current_Scope));
*************** package body Sem_Ch3 is
*** 1697,1703 ****
        if Constant_Present (N)
          and then No (E)
        then
!          if not Is_Package (Current_Scope) then
              Error_Msg_N
                ("invalid context for deferred constant declaration ('R'M 7.4)",
                  N);
--- 1995,2001 ----
        if Constant_Present (N)
          and then No (E)
        then
!          if not Is_Package_Or_Generic_Package (Current_Scope) then
              Error_Msg_N
                ("invalid context for deferred constant declaration ('R'M 7.4)",
                  N);
*************** package body Sem_Ch3 is
*** 1742,1748 ****
  
           --  Protected objects with interrupt handlers must be at library level
  
!          if Has_Interrupt_Handler (T) then
              Error_Msg_N
                ("interrupt object can only be declared at library level", Id);
           end if;
--- 2040,2052 ----
  
           --  Protected objects with interrupt handlers must be at library level
  
!          --  Ada 2005: this test is not needed (and the corresponding clause
!          --  in the RM is removed) because accessibility checks are sufficient
!          --  to make handlers not at the library level illegal.
! 
!          if Has_Interrupt_Handler (T)
!            and then Ada_Version < Ada_05
!          then
              Error_Msg_N
                ("interrupt object can only be declared at library level", Id);
           end if;
*************** package body Sem_Ch3 is
*** 1957,1966 ****
           Act_T := Build_Default_Subtype;
           Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
  
!       elsif not Is_Constrained (T)
!         and then Has_Discriminants (T)
!         and then Constant_Present (N)
          and then Nkind (E) = N_Function_Call
        then
           --  The back-end has problems with constants of a discriminated type
           --  with defaults, if the initial value is a function call. We
--- 2261,2271 ----
           Act_T := Build_Default_Subtype;
           Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
  
!       elsif Present (Underlying_Type (T))
!         and then not Is_Constrained (Underlying_Type (T))
!         and then Has_Discriminants (Underlying_Type (T))
          and then Nkind (E) = N_Function_Call
+         and then Constant_Present (N)
        then
           --  The back-end has problems with constants of a discriminated type
           --  with defaults, if the initial value is a function call. We
*************** package body Sem_Ch3 is
*** 2046,2058 ****
              Validate_Controlled_Object (Id);
           end if;
  
!          --  Generate a warning when an initialization causes an obvious
!          --  ABE violation. If the init expression is a simple aggregate
!          --  there shouldn't be any initialize/adjust call generated. This
!          --  will be true as soon as aggregates are built in place when
!          --  possible. ??? at the moment we do not generate warnings for
!          --  temporaries created for those aggregates although a
!          --  Program_Error might be generated if compiled with -gnato
  
           if Is_Controlled (Etype (Id))
              and then Comes_From_Source (Id)
--- 2351,2364 ----
              Validate_Controlled_Object (Id);
           end if;
  
!          --  Generate a warning when an initialization causes an obvious ABE
!          --  violation. If the init expression is a simple aggregate there
!          --  shouldn't be any initialize/adjust call generated. This will be
!          --  true as soon as aggregates are built in place when possible.
! 
!          --  ??? at the moment we do not generate warnings for temporaries
!          --  created for those aggregates although Program_Error might be
!          --  generated if compiled with -gnato.
  
           if Is_Controlled (Etype (Id))
              and then Comes_From_Source (Id)
*************** package body Sem_Ch3 is
*** 2062,2068 ****
  
                 Implicit_Call : Entity_Id;
                 pragma Warnings (Off, Implicit_Call);
!                --  What is this about, it is never referenced ???
  
                 function Is_Aggr (N : Node_Id) return Boolean;
                 --  Check that N is an aggregate
--- 2368,2374 ----
  
                 Implicit_Call : Entity_Id;
                 pragma Warnings (Off, Implicit_Call);
!                --  ??? what is this for (never referenced!)
  
                 function Is_Aggr (N : Node_Id) return Boolean;
                 --  Check that N is an aggregate
*************** package body Sem_Ch3 is
*** 2088,2095 ****
                 end Is_Aggr;
  
              begin
!                --  If no underlying type, we already are in an error situation
!                --  don't try to add a warning since we do not have access
                 --  prim-op list.
  
                 if No (Underlying_Type (BT)) then
--- 2394,2401 ----
                 end Is_Aggr;
  
              begin
!                --  If no underlying type, we already are in an error situation.
!                --  Do not try to add a warning since we do not have access to
                 --  prim-op list.
  
                 if No (Underlying_Type (BT)) then
*************** package body Sem_Ch3 is
*** 2101,2113 ****
                 elsif Is_Generic_Type (BT) then
                    Implicit_Call := Empty;
  
!                --  if the init expression is not an aggregate, an adjust
!                --  call will be generated
  
                 elsif Present (E) and then not Is_Aggr (E) then
                    Implicit_Call := Find_Prim_Op (BT, Name_Adjust);
  
!                --  if no init expression and we are not in the deferred
                 --  constant case, an Initialize call will be generated
  
                 elsif No (E) and then not Constant_Present (N) then
--- 2407,2419 ----
                 elsif Is_Generic_Type (BT) then
                    Implicit_Call := Empty;
  
!                --  If the init expression is not an aggregate, an adjust call
!                --  will be generated
  
                 elsif Present (E) and then not Is_Aggr (E) then
                    Implicit_Call := Find_Prim_Op (BT, Name_Adjust);
  
!                --  If no init expression and we are not in the deferred
                 --  constant case, an Initialize call will be generated
  
                 elsif No (E) and then not Constant_Present (N) then
*************** package body Sem_Ch3 is
*** 2195,2201 ****
          and then Nkind (E) = N_Explicit_Dereference
          and then Nkind (Original_Node (E)) = N_Function_Call
          and then not Is_Library_Level_Entity (Id)
!         and then not Is_Constrained (T)
          and then not Is_Aliased (Id)
          and then not Is_Class_Wide_Type (T)
          and then not Is_Controlled (T)
--- 2501,2507 ----
          and then Nkind (E) = N_Explicit_Dereference
          and then Nkind (Original_Node (E)) = N_Function_Call
          and then not Is_Library_Level_Entity (Id)
!         and then not Is_Constrained (Underlying_Type (T))
          and then not Is_Aliased (Id)
          and then not Is_Class_Wide_Type (T)
          and then not Is_Controlled (T)
*************** package body Sem_Ch3 is
*** 2212,2219 ****
  
           Set_Renamed_Object (Id, E);
  
!          --  Force generation of debugging information for the constant
!          --  and for the renamed function call.
  
           Set_Needs_Debug_Info (Id);
           Set_Needs_Debug_Info (Entity (Prefix (E)));
--- 2518,2525 ----
  
           Set_Renamed_Object (Id, E);
  
!          --  Force generation of debugging information for the constant and for
!          --  the renamed function call.
  
           Set_Needs_Debug_Info (Id);
           Set_Needs_Debug_Info (Entity (Prefix (E)));
*************** package body Sem_Ch3 is
*** 2265,2270 ****
--- 2571,2597 ----
        Parent_Base : Entity_Id;
  
     begin
+       --  Ada 2005 (AI-251): Decorate all names in list of ancestor interfaces
+ 
+       if Is_Non_Empty_List (Interface_List (N)) then
+          declare
+             Intf : Node_Id;
+             T    : Entity_Id;
+ 
+          begin
+             Intf := First (Interface_List (N));
+             while Present (Intf) loop
+                T := Find_Type_Of_Subtype_Indic (Intf);
+ 
+                if not Is_Interface (T) then
+                   Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T);
+                end if;
+ 
+                Next (Intf);
+             end loop;
+          end;
+       end if;
+ 
        Generate_Definition (T);
        Enter_Name (T);
  
*************** package body Sem_Ch3 is
*** 2299,2305 ****
           return;
        end if;
  
!       if (not Is_Package (Current_Scope)
             and then Nkind (Parent (N)) /= N_Generic_Subprogram_Declaration)
          or else In_Private_Part (Current_Scope)
  
--- 2626,2632 ----
           return;
        end if;
  
!       if (not Is_Package_Or_Generic_Package (Current_Scope)
             and then Nkind (Parent (N)) /= N_Generic_Subprogram_Declaration)
          or else In_Private_Part (Current_Scope)
  
*************** package body Sem_Ch3 is
*** 2343,2359 ****
        Set_Is_Pure (Id, Is_Pure (Current_Scope));
        Init_Size_Align (Id);
  
!       --  The following guard condition on Enter_Name is to handle cases
!       --  where the defining identifier has already been entered into the
!       --  scope but the declaration as a whole needs to be analyzed.
  
        --  This case in particular happens for derived enumeration types. The
!       --  derived enumeration type is processed as an inserted enumeration
!       --  type declaration followed by a rewritten subtype declaration. The
!       --  defining identifier, however, is entered into the name scope very
!       --  early in the processing of the original type declaration and
!       --  therefore needs to be avoided here, when the created subtype
!       --  declaration is analyzed. (See Build_Derived_Types)
  
        --  This also happens when the full view of a private type is derived
        --  type with constraints. In this case the entity has been introduced
--- 2670,2686 ----
        Set_Is_Pure (Id, Is_Pure (Current_Scope));
        Init_Size_Align (Id);
  
!       --  The following guard condition on Enter_Name is to handle cases where
!       --  the defining identifier has already been entered into the scope but
!       --  the declaration as a whole needs to be analyzed.
  
        --  This case in particular happens for derived enumeration types. The
!       --  derived enumeration type is processed as an inserted enumeration type
!       --  declaration followed by a rewritten subtype declaration. The defining
!       --  identifier, however, is entered into the name scope very early in the
!       --  processing of the original type declaration and therefore needs to be
!       --  avoided here, when the created subtype declaration is analyzed. (See
!       --  Build_Derived_Types)
  
        --  This also happens when the full view of a private type is derived
        --  type with constraints. In this case the entity has been introduced
*************** package body Sem_Ch3 is
*** 2378,2387 ****
        Set_Is_Volatile       (Id, Is_Volatile       (T));
        Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
        Set_Is_Atomic         (Id, Is_Atomic         (T));
  
        --  In the case where there is no constraint given in the subtype
!       --  indication, Process_Subtype just returns the Subtype_Mark,
!       --  so its semantic attributes must be established here.
  
        if Nkind (Subtype_Indication (N)) /= N_Subtype_Indication then
           Set_Etype (Id, Base_Type (T));
--- 2705,2715 ----
        Set_Is_Volatile       (Id, Is_Volatile       (T));
        Set_Treat_As_Volatile (Id, Treat_As_Volatile (T));
        Set_Is_Atomic         (Id, Is_Atomic         (T));
+       Set_Is_Ada_2005       (Id, Is_Ada_2005       (T));
  
        --  In the case where there is no constraint given in the subtype
!       --  indication, Process_Subtype just returns the Subtype_Mark, so its
!       --  semantic attributes must be established here.
  
        if Nkind (Subtype_Indication (N)) /= N_Subtype_Indication then
           Set_Etype (Id, Base_Type (T));
*************** package body Sem_Ch3 is
*** 2505,2515 ****
                    Set_Class_Wide_Type (Id, Class_Wide_Type (T));
                 end if;
  
!                --  In general the attributes of the subtype of a private
!                --  type are the attributes of the partial view of parent.
!                --  However, the full view may be a discriminated type,
!                --  and the subtype must share the discriminant constraint
!                --  to generate correct calls to initialization procedures.
  
                 if Has_Discriminants (T) then
                    Set_Discriminant_Constraint
--- 2833,2843 ----
                    Set_Class_Wide_Type (Id, Class_Wide_Type (T));
                 end if;
  
!                --  In general the attributes of the subtype of a private type
!                --  are the attributes of the partial view of parent. However,
!                --  the full view may be a discriminated type, and the subtype
!                --  must share the discriminant constraint to generate correct
!                --  calls to initialization procedures.
  
                 if Has_Discriminants (T) then
                    Set_Discriminant_Constraint
*************** package body Sem_Ch3 is
*** 2538,2560 ****
                                       (Id, Is_Access_Constant    (T));
                 Set_Directly_Designated_Type
                                       (Id, Designated_Type       (T));
! 
!                --  Ada 2005 (AI-231): Propagate the null-excluding attribute
!                --  and carry out some static checks
! 
!                if Null_Exclusion_Present (N)
!                  or else Can_Never_Be_Null (T)
!                then
!                   Set_Can_Never_Be_Null (Id);
! 
!                   if Null_Exclusion_Present (N)
!                     and then Can_Never_Be_Null (T)
!                   then
!                      Error_Msg_N
!                        ("(Ada 2005) null exclusion not allowed if parent "
!                         & "is already non-null", Subtype_Indication (N));
!                   end if;
!                end if;
  
                 --  A Pure library_item must not contain the declaration of a
                 --  named access type, except within a subprogram, generic
--- 2866,2872 ----
                                       (Id, Is_Access_Constant    (T));
                 Set_Directly_Designated_Type
                                       (Id, Designated_Type       (T));
!                Set_Can_Never_Be_Null (Id, Can_Never_Be_Null     (T));
  
                 --  A Pure library_item must not contain the declaration of a
                 --  named access type, except within a subprogram, generic
*************** package body Sem_Ch3 is
*** 2584,2591 ****
                    Set_Stored_Constraint_From_Discriminant_Constraint (Id);
                 end if;
  
!             --  If the subtype name denotes an incomplete type
!             --  an error was already reported by Process_Subtype.
  
              when E_Incomplete_Type =>
                 Set_Etype (Id, Any_Type);
--- 2896,2903 ----
                    Set_Stored_Constraint_From_Discriminant_Constraint (Id);
                 end if;
  
!             --  If the subtype name denotes an incomplete type an error was
!             --  already reported by Process_Subtype.
  
              when E_Incomplete_Type =>
                 Set_Etype (Id, Any_Type);
*************** package body Sem_Ch3 is
*** 2736,2741 ****
--- 3048,3098 ----
                                         or else
                                       In_Package_Body (Current_Scope));
  
+       procedure Check_Ops_From_Incomplete_Type;
+       --  If there is a tagged incomplete partial view of the type, transfer
+       --  its operations to the full view, and indicate that the type of the
+       --  controlling parameter (s) is this full view.
+ 
+       ------------------------------------
+       -- Check_Ops_From_Incomplete_Type --
+       ------------------------------------
+ 
+       procedure Check_Ops_From_Incomplete_Type is
+          Elmt   : Elmt_Id;
+          Formal : Entity_Id;
+          Op     : Entity_Id;
+ 
+       begin
+          if Prev /= T
+            and then Ekind (Prev) = E_Incomplete_Type
+            and then Is_Tagged_Type (Prev)
+            and then Is_Tagged_Type (T)
+          then
+             Elmt := First_Elmt (Primitive_Operations (Prev));
+             while Present (Elmt) loop
+                Op := Node (Elmt);
+                Prepend_Elmt (Op, Primitive_Operations (T));
+ 
+                Formal := First_Formal (Op);
+                while Present (Formal) loop
+                   if Etype (Formal) = Prev then
+                      Set_Etype (Formal, T);
+                   end if;
+ 
+                   Next_Formal (Formal);
+                end loop;
+ 
+                if Etype (Op) = Prev then
+                   Set_Etype (Op, T);
+                end if;
+ 
+                Next_Elmt (Elmt);
+             end loop;
+          end if;
+       end Check_Ops_From_Incomplete_Type;
+ 
+    --  Start of processing for Analyze_Type_Declaration
+ 
     begin
        Prev := Find_Type_Name (N);
  
*************** package body Sem_Ch3 is
*** 2874,2879 ****
--- 3231,3237 ----
        --  Some common processing for all types
  
        Set_Depends_On_Private (T, Has_Private_Component (T));
+       Check_Ops_From_Incomplete_Type;
  
        --  Both the declared entity, and its anonymous base type if one
        --  was created, need freeze nodes allocated.
*************** package body Sem_Ch3 is
*** 3064,3069 ****
--- 3422,3428 ----
           Element_Type := Access_Definition
                             (Related_Nod => Related_Id,
                              N           => Access_Definition (Component_Def));
+          Set_Is_Local_Anonymous_Access (Element_Type);
  
           --  Ada 2005 (AI-230): In case of components that are anonymous
           --  access types the level of accessibility depends on the enclosing
*************** package body Sem_Ch3 is
*** 3155,3170 ****
        end if;
  
        --  Ada 2005 (AI-231): Propagate the null-excluding attribute to the
!       --  array to ensure that objects of this type are initialized.
  
        if Ada_Version >= Ada_05
!         and then (Null_Exclusion_Present (Component_Definition (Def))
!                     or else Can_Never_Be_Null (Element_Type))
        then
           Set_Can_Never_Be_Null (T);
  
           if Null_Exclusion_Present (Component_Definition (Def))
             and then Can_Never_Be_Null (Element_Type)
           then
              Error_Msg_N
                ("(Ada 2005) already a null-excluding type",
--- 3514,3533 ----
        end if;
  
        --  Ada 2005 (AI-231): Propagate the null-excluding attribute to the
!       --  array type to ensure that objects of this type are initialized.
  
        if Ada_Version >= Ada_05
!         and then Can_Never_Be_Null (Element_Type)
        then
           Set_Can_Never_Be_Null (T);
  
           if Null_Exclusion_Present (Component_Definition (Def))
             and then Can_Never_Be_Null (Element_Type)
+ 
+             --  No need to check itypes because in their case this check
+             --  was done at their point of creation
+ 
+            and then not Is_Itype (Element_Type)
           then
              Error_Msg_N
                ("(Ada 2005) already a null-excluding type",
*************** package body Sem_Ch3 is
*** 3217,3223 ****
  
        elsif Is_Abstract (Element_Type) then
           Error_Msg_N
!            ("The type of a component cannot be abstract",
              Subtype_Indication (Component_Def));
        end if;
  
--- 3580,3586 ----
  
        elsif Is_Abstract (Element_Type) then
           Error_Msg_N
!            ("the type of a component cannot be abstract",
              Subtype_Indication (Component_Def));
        end if;
  
*************** package body Sem_Ch3 is
*** 3243,3249 ****
        Acc  : Node_Id;
        Comp : Node_Id;
        Decl : Node_Id;
!       P    : Node_Id := Parent (N);
  
     begin
        Set_Is_Internal (Anon);
--- 3606,3612 ----
        Acc  : Node_Id;
        Comp : Node_Id;
        Decl : Node_Id;
!       P    : Node_Id;
  
     begin
        Set_Is_Internal (Anon);
*************** package body Sem_Ch3 is
*** 3276,3281 ****
--- 3639,3645 ----
  
        --  Insert the new declaration in the nearest enclosing scope
  
+       P := Parent (N);
        while Present (P) and then not Has_Declarations (P) loop
           P := Parent (P);
        end loop;
*************** package body Sem_Ch3 is
*** 3289,3295 ****
        end if;
  
        --  Replace the anonymous type with an occurrence of the new declaration.
!       --  In all cases the rewriten node does not have the null-exclusion
        --  attribute because (if present) it was already inherited by the
        --  anonymous entity (Anon). Thus, in case of components we do not
        --  inherit this attribute.
--- 3653,3659 ----
        end if;
  
        --  Replace the anonymous type with an occurrence of the new declaration.
!       --  In all cases the rewritten node does not have the null-exclusion
        --  attribute because (if present) it was already inherited by the
        --  anonymous entity (Anon). Thus, in case of components we do not
        --  inherit this attribute.
*************** package body Sem_Ch3 is
*** 3497,3513 ****
           end if;
        end if;
  
!       --  If the parent type is not a derived type itself, and is
!       --  declared in a closed scope (e.g., a subprogram), then we
!       --  need to explicitly introduce the new type's concatenation
!       --  operator since Derive_Subprograms will not inherit the
!       --  parent's operator. If the parent type is unconstrained, the
!       --  operator is of the unconstrained base type.
  
        if Number_Dimensions (Parent_Type) = 1
          and then not Is_Limited_Type (Parent_Type)
          and then not Is_Derived_Type (Parent_Type)
!         and then not Is_Package (Scope (Base_Type (Parent_Type)))
        then
           if not Is_Constrained (Parent_Type)
             and then Is_Constrained (Derived_Type)
--- 3861,3877 ----
           end if;
        end if;
  
!       --  If parent type is not a derived type itself, and is declared in
!       --  closed scope (e.g. a subprogram), then we must explicitly introduce
!       --  the new type's concatenation operator since Derive_Subprograms
!       --  will not inherit the parent's operator. If the parent type is
!       --  unconstrained, the operator is of the unconstrained base type.
  
        if Number_Dimensions (Parent_Type) = 1
          and then not Is_Limited_Type (Parent_Type)
          and then not Is_Derived_Type (Parent_Type)
!         and then not Is_Package_Or_Generic_Package
!                        (Scope (Base_Type (Parent_Type)))
        then
           if not Is_Constrained (Parent_Type)
             and then Is_Constrained (Derived_Type)
*************** package body Sem_Ch3 is
*** 3592,3610 ****
  
           elsif Present (Discriminant_Specifications (N)) then
  
!             --  Verify that new discriminants are used to constrain
!             --  the old ones.
  
-             Old_Disc   := First_Discriminant (Parent_Type);
-             New_Disc   := First_Discriminant (Derived_Type);
-             Disc_Spec  := First (Discriminant_Specifications (N));
              D_Constraint :=
                First
                  (Constraints
                    (Constraint (Subtype_Indication (Type_Definition (N)))));
  
              while Present (Old_Disc) and then Present (Disc_Spec) loop
- 
                 if Nkind (Discriminant_Type (Disc_Spec)) /=
                                                N_Access_Definition
                 then
--- 3956,3972 ----
  
           elsif Present (Discriminant_Specifications (N)) then
  
!             --  Verify that new discriminants are used to constrain old ones
  
              D_Constraint :=
                First
                  (Constraints
                    (Constraint (Subtype_Indication (Type_Definition (N)))));
  
+             Old_Disc  := First_Discriminant (Parent_Type);
+             New_Disc  := First_Discriminant (Derived_Type);
+             Disc_Spec := First (Discriminant_Specifications (N));
              while Present (Old_Disc) and then Present (Disc_Spec) loop
                 if Nkind (Discriminant_Type (Disc_Spec)) /=
                                                N_Access_Definition
                 then
*************** package body Sem_Ch3 is
*** 3755,3761 ****
  
           Literal := First_Literal (Parent_Type);
           Literals_List := New_List;
- 
           while Present (Literal)
             and then Ekind (Literal) = E_Enumeration_Literal
           loop
--- 4117,4122 ----
*************** package body Sem_Ch3 is
*** 3764,3770 ****
              --  overridden by an explicit representation clause. Indicate
              --  that there is no explicit representation given yet. These
              --  derived literals are implicit operations of the new type,
!             --  and can be overriden by explicit ones.
  
              if Nkind (Literal) = N_Defining_Character_Literal then
                 New_Lit :=
--- 4125,4131 ----
              --  overridden by an explicit representation clause. Indicate
              --  that there is no explicit representation given yet. These
              --  derived literals are implicit operations of the new type,
!             --  and can be overridden by explicit ones.
  
              if Nkind (Literal) = N_Defining_Character_Literal then
                 New_Lit :=
*************** package body Sem_Ch3 is
*** 4161,4166 ****
--- 4522,4528 ----
                 Full_Decl := New_Copy_Tree (N);
                 Full_Der  := New_Copy (Derived_Type);
                 Set_Comes_From_Source (Full_Decl, False);
+                Set_Comes_From_Source (Full_Der, False);
  
                 Insert_After (N, Full_Decl);
  
*************** package body Sem_Ch3 is
*** 4216,4223 ****
              --  view, the completion does not derive them anew.
  
              if not Is_Tagged_Type (Parent_Type) then
!                Build_Derived_Record_Type
!                  (Full_Decl, Parent_Type, Full_Der, False);
  
              else
                 --  If full view of parent is tagged, the completion
--- 4578,4595 ----
              --  view, the completion does not derive them anew.
  
              if not Is_Tagged_Type (Parent_Type) then
! 
!                --  If the parent is itself derived from another private type,
!                --  installing the private declarations has not affected its
!                --  privacy status, so use its own full view explicitly.
! 
!                if Is_Private_Type (Parent_Type) then
!                   Build_Derived_Record_Type
!                     (Full_Decl, Full_View (Parent_Type), Full_Der, False);
!                else
!                   Build_Derived_Record_Type
!                     (Full_Decl, Parent_Type, Full_Der, False);
!                end if;
  
              else
                 --  If full view of parent is tagged, the completion
*************** package body Sem_Ch3 is
*** 4930,4944 ****
        Last_Discrim : Entity_Id;
        Constrs      : Elist_Id;
  
!       Discs : Elist_Id := New_Elmt_List;
        --  An empty Discs list means that there were no constraints in the
        --  subtype indication or that there was an error processing it.
  
!       Assoc_List : Elist_Id;
!       New_Discrs : Elist_Id;
!       New_Base   : Entity_Id;
!       New_Decl   : Node_Id;
!       New_Indic  : Node_Id;
  
        Is_Tagged          : constant Boolean := Is_Tagged_Type (Parent_Type);
        Discriminant_Specs : constant Boolean :=
--- 5302,5316 ----
        Last_Discrim : Entity_Id;
        Constrs      : Elist_Id;
  
!       Discs        : Elist_Id := New_Elmt_List;
        --  An empty Discs list means that there were no constraints in the
        --  subtype indication or that there was an error processing it.
  
!       Assoc_List         : Elist_Id;
!       New_Discrs         : Elist_Id;
!       New_Base           : Entity_Id;
!       New_Decl           : Node_Id;
!       New_Indic          : Node_Id;
  
        Is_Tagged          : constant Boolean := Is_Tagged_Type (Parent_Type);
        Discriminant_Specs : constant Boolean :=
*************** package body Sem_Ch3 is
*** 4946,4957 ****
        Private_Extension  : constant Boolean :=
                               (Nkind (N) = N_Private_Extension_Declaration);
  
!       Constraint_Present : Boolean;
!       Inherit_Discrims   : Boolean := False;
! 
!       Save_Etype        : Entity_Id;
!       Save_Discr_Constr : Elist_Id;
!       Save_Next_Entity  : Entity_Id;
  
     begin
        if Ekind (Parent_Type) = E_Record_Type_With_Private
--- 5318,5331 ----
        Private_Extension  : constant Boolean :=
                               (Nkind (N) = N_Private_Extension_Declaration);
  
!       Constraint_Present     : Boolean;
!       Has_Interfaces         : Boolean := False;
!       Inherit_Discrims       : Boolean := False;
!       Last_Inherited_Prim_Op : Elmt_Id;
!       Tagged_Partial_View    : Entity_Id;
!       Save_Etype             : Entity_Id;
!       Save_Discr_Constr      : Elist_Id;
!       Save_Next_Entity       : Entity_Id;
  
     begin
        if Ekind (Parent_Type) = E_Record_Type_With_Private
*************** package body Sem_Ch3 is
*** 5065,5071 ****
                 begin
                    C1 := First_Elmt (New_Discrs);
                    C2 := First_Elmt (Discriminant_Constraint (Derived_Type));
- 
                    while Present (C1) and then Present (C2) loop
                       if not
                         Fully_Conformant_Expressions (Node (C1), Node (C2))
--- 5439,5444 ----
*************** package body Sem_Ch3 is
*** 5074,5079 ****
--- 5447,5453 ----
                            "constraint not conformant to previous declaration",
                               Node (C1));
                       end if;
+ 
                       Next_Elmt (C1);
                       Next_Elmt (C2);
                    end loop;
*************** package body Sem_Ch3 is
*** 5192,5198 ****
              Freeze_Before (N, Parent_Type);
           end if;
  
!          if Type_Access_Level (Derived_Type) /= Type_Access_Level (Parent_Type)
             and then not Is_Generic_Type (Derived_Type)
           then
              if Is_Controlled (Parent_Type) then
--- 5566,5620 ----
              Freeze_Before (N, Parent_Type);
           end if;
  
!          --  In Ada 2005 (AI-344), the restriction that a derived tagged type
!          --  cannot be declared at a deeper level than its parent type is
!          --  removed. The check on derivation within a generic body is also
!          --  relaxed, but there's a restriction that a derived tagged type
!          --  cannot be declared in a generic body if it's derived directly
!          --  or indirectly from a formal type of that generic.
! 
!          if Ada_Version >= Ada_05 then
!             if Present (Enclosing_Generic_Body (Derived_Type)) then
!                declare
!                   Ancestor_Type : Entity_Id;
! 
!                begin
!                   --  Check to see if any ancestor of the derived type is a
!                   --  formal type.
! 
!                   Ancestor_Type := Parent_Type;
!                   while not Is_Generic_Type (Ancestor_Type)
!                     and then Etype (Ancestor_Type) /= Ancestor_Type
!                   loop
!                      Ancestor_Type := Etype (Ancestor_Type);
!                   end loop;
! 
!                   --  If the derived type does have a formal type as an
!                   --  ancestor, then it's an error if the derived type is
!                   --  declared within the body of the generic unit that
!                   --  declares the formal type in its generic formal part. It's
!                   --  sufficient to check whether the ancestor type is declared
!                   --  inside the same generic body as the derived type (such as
!                   --  within a nested generic spec), in which case the
!                   --  derivation is legal. If the formal type is declared
!                   --  outside of that generic body, then it's guaranteed that
!                   --  the derived type is declared within the generic body of
!                   --  the generic unit declaring the formal type.
! 
!                   if Is_Generic_Type (Ancestor_Type)
!                     and then Enclosing_Generic_Body (Ancestor_Type) /=
!                                Enclosing_Generic_Body (Derived_Type)
!                   then
!                      Error_Msg_NE
!                        ("parent type of& must not be descendant of formal type"
!                           & " of an enclosing generic body",
!                             Indic, Derived_Type);
!                   end if;
!                end;
!             end if;
! 
!          elsif Type_Access_Level (Derived_Type) /=
!                  Type_Access_Level (Parent_Type)
             and then not Is_Generic_Type (Derived_Type)
           then
              if Is_Controlled (Parent_Type) then
*************** package body Sem_Ch3 is
*** 5222,5227 ****
--- 5644,5671 ----
           end if;
        end if;
  
+       --  Ada 2005 (AI-251)
+ 
+       if Ada_Version = Ada_05
+         and then Is_Tagged
+       then
+ 
+          --  "The declaration of a specific descendant of an interface type
+          --  freezes the interface type" (RM 13.14).
+ 
+          declare
+             Iface : Node_Id;
+          begin
+             if Is_Non_Empty_List (Interface_List (Type_Def)) then
+                Iface := First (Interface_List (Type_Def));
+                while Present (Iface) loop
+                   Freeze_Before (N, Etype (Iface));
+                   Next (Iface);
+                end loop;
+             end if;
+          end;
+       end if;
+ 
        --  STEP 1b : preliminary cleanup of the full view of private types
  
        --  If the type is already marked as having discriminants, then it's the
*************** package body Sem_Ch3 is
*** 5423,5428 ****
--- 5867,5883 ----
        Set_Is_Tagged_Type    (Derived_Type, Is_Tagged);
        Set_Stored_Constraint (Derived_Type, No_Elist);
  
+       --  Ada 2005 (AI-251): Private type-declarations can implement interfaces
+       --  but cannot be interfaces
+ 
+       if not Private_Extension
+          and then Ekind (Derived_Type) /= E_Private_Type
+          and then Ekind (Derived_Type) /= E_Limited_Private_Type
+       then
+          Set_Is_Interface (Derived_Type, Interface_Present (Type_Def));
+          Set_Abstract_Interfaces (Derived_Type, No_Elist);
+       end if;
+ 
        --  Fields inherited from the Parent_Type
  
        Set_Discard_Names
*************** package body Sem_Ch3 is
*** 5506,5511 ****
--- 5961,6030 ----
                (Derived_Type, Expand_To_Stored_Constraint (Parent_Base, Discs));
           end if;
  
+          --  Ada 2005 (AI-251): Look for the partial view of tagged types
+          --  declared in the private part. This will be used 1) to check that
+          --  the set of interfaces in both views is equal, and 2) to complete
+          --  the derivation of subprograms covering interfaces.
+ 
+          Tagged_Partial_View := Empty;
+ 
+          if Has_Private_Declaration (Derived_Type) then
+             Tagged_Partial_View := Next_Entity (Derived_Type);
+             loop
+                exit when Has_Private_Declaration (Tagged_Partial_View)
+                  and then Full_View (Tagged_Partial_View) = Derived_Type;
+ 
+                Next_Entity (Tagged_Partial_View);
+             end loop;
+          end if;
+ 
+          --  Ada 2005 (AI-251): Collect the whole list of implemented
+          --  interfaces.
+ 
+          if Ada_Version >= Ada_05 then
+             Set_Abstract_Interfaces (Derived_Type, New_Elmt_List);
+ 
+             if Nkind (N) = N_Private_Extension_Declaration then
+                Collect_Interfaces (N, Derived_Type);
+             else
+                Collect_Interfaces (Type_Definition (N), Derived_Type);
+             end if;
+ 
+             --  Ada 2005 (AI-251): The progenitor types specified in a private
+             --  extension declaration and the progenitor types specified in the
+             --  corresponding declaration of a record extension given in the
+             --  private part need not be the same; the only requirement is that
+             --  the private extension must be descended from each interface
+             --  from which the record extension is descended (AARM 7.3, 20.1/2)
+ 
+             if Has_Private_Declaration (Derived_Type) then
+                declare
+                   N_Partial : constant Node_Id := Parent (Tagged_Partial_View);
+                   Iface_Partial : Entity_Id;
+ 
+                begin
+                   if Nkind (N_Partial) = N_Private_Extension_Declaration
+                     and then not Is_Empty_List (Interface_List (N_Partial))
+                   then
+                      Iface_Partial := First (Interface_List (N_Partial));
+ 
+                      while Present (Iface_Partial) loop
+                         if not Interface_Present_In_Ancestor
+                                  (Derived_Type, Etype (Iface_Partial))
+                         then
+                            Error_Msg_N
+                              ("(Ada 2005) full type and private extension must"
+                               & " have the same progenitors", Derived_Type);
+                            exit;
+                         end if;
+ 
+                         Next (Iface_Partial);
+                      end loop;
+                   end if;
+                end;
+             end if;
+          end if;
+ 
        else
           Set_Is_Packed (Derived_Type, Is_Packed (Parent_Base));
           Set_Has_Non_Standard_Rep
*************** package body Sem_Ch3 is
*** 5595,5600 ****
--- 6114,6126 ----
  
           Expand_Record_Extension (Derived_Type, Type_Def);
  
+          --  Ada 2005 (AI-251): Addition of the Tag corresponding to all the
+          --  implemented interfaces if we are in expansion mode
+ 
+          if Expander_Active then
+             Add_Interface_Tag_Components (N, Derived_Type);
+          end if;
+ 
           --  Analyze the record extension
  
           Record_Type_Definition
*************** package body Sem_Ch3 is
*** 5612,5619 ****
        --  derived freeze if necessary.
  
        Set_Has_Delayed_Freeze (Derived_Type);
        if Derive_Subps then
!          Derive_Subprograms (Parent_Type, Derived_Type);
        end if;
  
        --  If we have a private extension which defines a constrained derived
--- 6138,6307 ----
        --  derived freeze if necessary.
  
        Set_Has_Delayed_Freeze (Derived_Type);
+ 
        if Derive_Subps then
! 
!          --  Ada 2005 (AI-251): Check if this tagged type implements abstract
!          --  interfaces
! 
!          Has_Interfaces := False;
! 
!          if Is_Tagged_Type (Derived_Type) then
!             declare
!                E : Entity_Id;
! 
!             begin
!                --  Handle private types
! 
!                if Present (Full_View (Derived_Type)) then
!                   E := Full_View (Derived_Type);
!                else
!                   E := Derived_Type;
!                end if;
! 
!                loop
!                   if Is_Interface (E)
!                     or else (Present (Abstract_Interfaces (E))
!                                and then
!                              not Is_Empty_Elmt_List (Abstract_Interfaces (E)))
!                   then
!                      Has_Interfaces := True;
!                      exit;
!                   end if;
! 
!                   exit when Etype (E) = E
! 
!                      --  Handle private types
! 
!                      or else (Present (Full_View (Etype (E)))
!                                and then Full_View (Etype (E)) = E)
! 
!                      --  Protect the frontend against wrong source
! 
!                     or else Etype (E) = Derived_Type;
! 
!                   --  Climb to the ancestor type handling private types
! 
!                   if Present (Full_View (Etype (E))) then
!                      E := Full_View (Etype (E));
!                   else
!                      E := Etype (E);
!                   end if;
!                end loop;
!             end;
!          end if;
! 
!          --  Ada 2005 (AI-251): Keep separate the management of tagged types
!          --  implementing interfaces
! 
!          if not Is_Tagged_Type (Derived_Type)
!            or else not Has_Interfaces
!          then
!             Derive_Subprograms (Parent_Type, Derived_Type);
! 
!          else
!             --  Ada 2005 (AI-251): Complete the decoration of tagged private
!             --  types that implement interfaces
! 
!             if Present (Tagged_Partial_View) then
!                Derive_Subprograms
!                  (Parent_Type, Derived_Type);
! 
!                Complete_Subprograms_Derivation
!                  (Partial_View => Tagged_Partial_View,
!                   Derived_Type => Derived_Type);
! 
!             --  Ada 2005 (AI-251): Derive the interface subprograms of all the
!             --  implemented interfaces and check if some of the subprograms
!             --  inherited from the ancestor cover some interface subprogram.
! 
!             else
!                Derive_Subprograms (Parent_Type, Derived_Type);
! 
!                declare
!                   Subp_Elmt         : Elmt_Id;
!                   First_Iface_Elmt  : Elmt_Id;
!                   Iface_Subp_Elmt   : Elmt_Id;
!                   Subp              : Entity_Id;
!                   Iface_Subp        : Entity_Id;
!                   Is_Interface_Subp : Boolean;
! 
!                begin
!                   --  Ada 2005 (AI-251): Remember the entity corresponding to
!                   --  the last inherited primitive operation. This is required
!                   --  to check if some of the inherited subprograms covers some
!                   --  of the new interfaces.
! 
!                   Last_Inherited_Prim_Op := No_Elmt;
! 
!                   Subp_Elmt :=
!                     First_Elmt (Primitive_Operations (Derived_Type));
!                   while Present (Subp_Elmt) loop
!                      Last_Inherited_Prim_Op := Subp_Elmt;
!                      Next_Elmt (Subp_Elmt);
!                   end loop;
! 
!                   --  Ada 2005 (AI-251): Derive subprograms in abstract
!                   --  interfaces.
! 
!                   Derive_Interface_Subprograms (Derived_Type);
! 
!                   --  Ada 2005 (AI-251): Check if some of the inherited
!                   --  subprograms cover some of the new interfaces.
! 
!                   if Present (Last_Inherited_Prim_Op) then
!                      First_Iface_Elmt := Next_Elmt (Last_Inherited_Prim_Op);
!                      Iface_Subp_Elmt  := First_Iface_Elmt;
!                      while Present (Iface_Subp_Elmt) loop
!                         Subp_Elmt := First_Elmt (Primitive_Operations
!                                                   (Derived_Type));
!                         while Subp_Elmt /= First_Iface_Elmt loop
!                            Subp       := Node (Subp_Elmt);
!                            Iface_Subp := Node (Iface_Subp_Elmt);
! 
!                            Is_Interface_Subp :=
!                              Present (Alias (Subp))
!                                and then Present (DTC_Entity (Alias (Subp)))
!                                and then Is_Interface (Scope
!                                                       (DTC_Entity
!                                                        (Alias (Subp))));
! 
!                            if Chars (Subp) = Chars (Iface_Subp)
!                              and then not Is_Interface_Subp
!                              and then not Is_Abstract (Subp)
!                              and then Type_Conformant (Iface_Subp, Subp)
!                            then
!                               Check_Dispatching_Operation
!                                 (Subp     => Subp,
!                                  Old_Subp => Iface_Subp);
! 
!                               --  Traverse the list of aliased subprograms
! 
!                               declare
!                                  E : Entity_Id;
! 
!                               begin
!                                  E := Alias (Subp);
!                                  while Present (Alias (E)) loop
!                                     E := Alias (E);
!                                  end loop;
! 
!                                  Set_Alias (Subp, E);
!                               end;
! 
!                               Set_Has_Delayed_Freeze (Subp);
!                               exit;
!                            end if;
! 
!                            Next_Elmt (Subp_Elmt);
!                         end loop;
! 
!                         Next_Elmt (Iface_Subp_Elmt);
!                      end loop;
!                   end if;
!                end;
!             end if;
!          end if;
        end if;
  
        --  If we have a private extension which defines a constrained derived
*************** package body Sem_Ch3 is
*** 5687,5696 ****
           --  from a private extension declaration.
  
           declare
!             Rep   : Node_Id := First_Rep_Item (Derived_Type);
              Found : Boolean := False;
  
           begin
              while Present (Rep) loop
                 if Rep = First_Rep_Item (Parent_Type) then
                    Found := True;
--- 6375,6385 ----
           --  from a private extension declaration.
  
           declare
!             Rep   : Node_Id;
              Found : Boolean := False;
  
           begin
+             Rep := First_Rep_Item (Derived_Type);
              while Present (Rep) loop
                 if Rep = First_Rep_Item (Parent_Type) then
                    Found := True;
*************** package body Sem_Ch3 is
*** 5800,5809 ****
        then
           CR_Disc := Make_Defining_Identifier (Sloc (Discrim), Chars (Discrim));
  
!          Set_Ekind     (CR_Disc, E_In_Parameter);
!          Set_Mechanism (CR_Disc, Default_Mechanism);
!          Set_Etype     (CR_Disc, Etype (Discrim));
!          Set_CR_Discriminant (Discrim, CR_Disc);
        end if;
     end Build_Discriminal;
  
--- 6489,6499 ----
        then
           CR_Disc := Make_Defining_Identifier (Sloc (Discrim), Chars (Discrim));
  
!          Set_Ekind            (CR_Disc, E_In_Parameter);
!          Set_Mechanism        (CR_Disc, Default_Mechanism);
!          Set_Etype            (CR_Disc, Etype (Discrim));
!          Set_Discriminal_Link (CR_Disc, Discrim);
!          Set_CR_Discriminant  (Discrim, CR_Disc);
        end if;
     end Build_Discriminal;
  
*************** package body Sem_Ch3 is
*** 6313,6319 ****
  
           if Has_Discriminants (Typ) then
              Disc := First_Discriminant (Typ);
- 
              while Present (Disc) loop
                 if Chars (Disc) = Chars (Id)
                   and then Present (Corresponding_Discriminant (Disc))
--- 7003,7008 ----
*************** package body Sem_Ch3 is
*** 6401,6415 ****
           Subp := Node (Elmt);
  
           --  Special exception, do not complain about failure to override the
!          --  stream routines _Input and _Output, since we always provide
           --  automatic overridings for these subprograms.
  
           if Is_Abstract (Subp)
             and then not Is_TSS (Subp, TSS_Stream_Input)
             and then not Is_TSS (Subp, TSS_Stream_Output)
             and then not Is_Abstract (T)
           then
              if Present (Alias (Subp)) then
                 --  Only perform the check for a derived subprogram when
                 --  the type has an explicit record extension. This avoids
                 --  incorrectly flagging abstract subprograms for the case
--- 7090,7110 ----
           Subp := Node (Elmt);
  
           --  Special exception, do not complain about failure to override the
!          --  stream routines _Input and _Output, as well as the primitive
!          --  operations used in dispatching selects since we always provide
           --  automatic overridings for these subprograms.
  
           if Is_Abstract (Subp)
             and then not Is_TSS (Subp, TSS_Stream_Input)
             and then not Is_TSS (Subp, TSS_Stream_Output)
             and then not Is_Abstract (T)
+            and then Chars (Subp) /= Name_uDisp_Asynchronous_Select
+            and then Chars (Subp) /= Name_uDisp_Conditional_Select
+            and then Chars (Subp) /= Name_uDisp_Get_Prim_Op_Kind
+            and then Chars (Subp) /= Name_uDisp_Timed_Select
           then
              if Present (Alias (Subp)) then
+ 
                 --  Only perform the check for a derived subprogram when
                 --  the type has an explicit record extension. This avoids
                 --  incorrectly flagging abstract subprograms for the case
*************** package body Sem_Ch3 is
*** 6423,6428 ****
--- 7118,7159 ----
                    Error_Msg_NE
                      ("type must be declared abstract or & overridden",
                       T, Subp);
+ 
+                   --  Traverse the whole chain of aliased subprograms to
+                   --  complete the error notification. This is useful for
+                   --  traceability of the chain of entities when the subprogram
+                   --  corresponds with interface subprogram (that may be
+                   --  defined in another package)
+ 
+                   if Ada_Version >= Ada_05
+                     and then Present (Alias (Subp))
+                   then
+                      declare
+                         E : Entity_Id;
+ 
+                      begin
+                         E := Subp;
+                         while Present (Alias (E)) loop
+                            Error_Msg_Sloc := Sloc (E);
+                            Error_Msg_NE ("\& has been inherited #", T, Subp);
+                            E := Alias (E);
+                         end loop;
+ 
+                         Error_Msg_Sloc := Sloc (E);
+                         Error_Msg_NE
+                           ("\& has been inherited from subprogram #", T, Subp);
+                      end;
+                   end if;
+ 
+                --  Ada 2005 (AI-345): Protected or task type implementing
+                --  abstract interfaces.
+ 
+                elsif Is_Concurrent_Record_Type (T)
+                    and then Present (Abstract_Interfaces (T))
+                then
+                   Error_Msg_NE
+                     ("interface subprogram & must be overridden",
+                      T, Subp);
                 end if;
              else
                 Error_Msg_NE
*************** package body Sem_Ch3 is
*** 6447,6456 ****
        Loc : Node_Id)
     is
     begin
!       --  A discriminant_specification for an access discriminant
!       --  shall appear only in the declaration for a task or protected
!       --  type, or for a type with the reserved word 'limited' in
!       --  its definition or in one of its ancestors. (RM 3.7(10))
  
        if Nkind (Discriminant_Type (D)) = N_Access_Definition
          and then not Is_Concurrent_Type (Current_Scope)
--- 7178,7187 ----
        Loc : Node_Id)
     is
     begin
!       --  A discriminant_specification for an access discriminant shall appear
!       --  only in the declaration for a task or protected type, or for a type
!       --  with the reserved word 'limited' in its definition or in one of its
!       --  ancestors. (RM 3.7(10))
  
        if Nkind (Discriminant_Type (D)) = N_Access_Definition
          and then not Is_Concurrent_Type (Current_Scope)
*************** package body Sem_Ch3 is
*** 6474,6479 ****
--- 7205,7215 ----
        --  ??? Also need to check components of record extensions, but not
        --  components of protected types (which are always limited).
  
+       --  Ada 2005: AI-363 relaxes this rule, to allow heap objects of such
+       --  types to be unconstrained. This is safe because it is illegal to
+       --  create access subtypes to such types with explicit discriminant
+       --  constraints.
+ 
        if not Is_Limited_Type (T) then
           if Ekind (T) = E_Record_Type then
              C := First_Component (T);
*************** package body Sem_Ch3 is
*** 6481,6487 ****
                 if Is_Aliased (C)
                   and then Has_Discriminants (Etype (C))
                   and then not Is_Constrained (Etype (C))
!                  and then not In_Instance
                 then
                    Error_Msg_N
                      ("aliased component must be constrained ('R'M 3.6(11))",
--- 7217,7224 ----
                 if Is_Aliased (C)
                   and then Has_Discriminants (Etype (C))
                   and then not Is_Constrained (Etype (C))
!                  and then not In_Instance_Body
!                  and then Ada_Version < Ada_05
                 then
                    Error_Msg_N
                      ("aliased component must be constrained ('R'M 3.6(11))",
*************** package body Sem_Ch3 is
*** 6495,6501 ****
              if Has_Aliased_Components (T)
                and then Has_Discriminants (Component_Type (T))
                and then not Is_Constrained (Component_Type (T))
!               and then not In_Instance
              then
                 Error_Msg_N
                   ("aliased component type must be constrained ('R'M 3.6(11))",
--- 7232,7239 ----
              if Has_Aliased_Components (T)
                and then Has_Discriminants (Component_Type (T))
                and then not Is_Constrained (Component_Type (T))
!               and then not In_Instance_Body
!               and then Ada_Version < Ada_05
              then
                 Error_Msg_N
                   ("aliased component type must be constrained ('R'M 3.6(11))",
*************** package body Sem_Ch3 is
*** 6534,6540 ****
  
                 begin
                    Var := First_Entity (Current_Scope);
- 
                    while Present (Var) loop
                       exit when Etype (Var) = E
                         and then Comes_From_Source (Var);
--- 7272,7277 ----
*************** package body Sem_Ch3 is
*** 6665,6671 ****
                 Post_Error;
              end if;
  
!          elsif Is_Package (E) then
              if Unit_Requires_Body (E) then
                 if not Has_Completion (E)
                   and then Nkind (Parent (Unit_Declaration_Node (E))) /=
--- 7402,7408 ----
                 Post_Error;
              end if;
  
!          elsif Is_Package_Or_Generic_Package (E) then
              if Unit_Requires_Body (E) then
                 if not Has_Completion (E)
                   and then Nkind (Parent (Unit_Declaration_Node (E))) /=
*************** package body Sem_Ch3 is
*** 6809,6818 ****
     -- Check_Or_Process_Discriminants --
     ------------------------------------
  
!    --  If an incomplete or private type declaration was already given for
!    --  the type, the discriminants may have already been processed if they
!    --  were present on the incomplete declaration. In this case a full
!    --  conformance check is performed otherwise just process them.
  
     procedure Check_Or_Process_Discriminants
       (N    : Node_Id;
--- 7546,7555 ----
     -- Check_Or_Process_Discriminants --
     ------------------------------------
  
!    --  If an incomplete or private type declaration was already given for the
!    --  type, the discriminants may have already been processed if they were
!    --  present on the incomplete declaration. In this case a full conformance
!    --  check is performed otherwise just process them.
  
     procedure Check_Or_Process_Discriminants
       (N    : Node_Id;
*************** package body Sem_Ch3 is
*** 6825,6834 ****
           --  Make the discriminants visible to component declarations
  
           declare
!             D    : Entity_Id := First_Discriminant (T);
              Prev : Entity_Id;
  
           begin
              while Present (D) loop
                 Prev := Current_Entity (D);
                 Set_Current_Entity (D);
--- 7562,7572 ----
           --  Make the discriminants visible to component declarations
  
           declare
!             D    : Entity_Id;
              Prev : Entity_Id;
  
           begin
+             D := First_Discriminant (T);
              while Present (D) loop
                 Prev := Current_Entity (D);
                 Set_Current_Entity (D);
*************** package body Sem_Ch3 is
*** 6840,6847 ****
  
                 if Ada_Version < Ada_05 then
  
!                   --  This restriction gets applied to the full type here; it
!                   --  has already been applied earlier to the partial view
  
                    Check_Access_Discriminant_Requires_Limited (Parent (D), N);
                 end if;
--- 7578,7585 ----
  
                 if Ada_Version < Ada_05 then
  
!                   --  This restriction gets applied to the full type here. It
!                   --  has already been applied earlier to the partial view.
  
                    Check_Access_Discriminant_Requires_Limited (Parent (D), N);
                 end if;
*************** package body Sem_Ch3 is
*** 6879,6884 ****
--- 7617,7713 ----
        Resolve (Bound, Standard_Float);
     end Check_Real_Bound;
  
+    ------------------------
+    -- Collect_Interfaces --
+    ------------------------
+ 
+    procedure Collect_Interfaces (N : Node_Id; Derived_Type : Entity_Id) is
+       Intf : Node_Id;
+ 
+       procedure Add_Interface (Iface : Entity_Id);
+       --  Add one interface
+ 
+       -------------------
+       -- Add_Interface --
+       -------------------
+ 
+       procedure Add_Interface (Iface : Entity_Id) is
+          Elmt : Elmt_Id;
+ 
+       begin
+          Elmt := First_Elmt (Abstract_Interfaces (Derived_Type));
+          while Present (Elmt) and then Node (Elmt) /= Iface loop
+             Next_Elmt (Elmt);
+          end loop;
+ 
+          if not Present (Elmt) then
+             Append_Elmt (Node => Iface,
+                          To   => Abstract_Interfaces (Derived_Type));
+          end if;
+       end Add_Interface;
+ 
+    --  Start of processing for Add_Interface
+ 
+    begin
+       pragma Assert (False
+          or else Nkind (N) = N_Derived_Type_Definition
+          or else Nkind (N) = N_Record_Definition
+          or else Nkind (N) = N_Private_Extension_Declaration);
+ 
+       --  Traverse the graph of ancestor interfaces
+ 
+       if Is_Non_Empty_List (Interface_List (N)) then
+          Intf := First (Interface_List (N));
+          while Present (Intf) loop
+ 
+             --  Protect against wrong uses. For example:
+             --    type I is interface;
+             --    type O is tagged null record;
+             --    type Wrong is new I and O with null record; -- ERROR
+ 
+             if Is_Interface (Etype (Intf)) then
+ 
+                --  Do not add the interface when the derived type already
+                --  implements this interface
+ 
+                if not Interface_Present_In_Ancestor (Derived_Type,
+                                                      Etype (Intf))
+                then
+                   Collect_Interfaces
+                      (Type_Definition (Parent (Etype (Intf))),
+                       Derived_Type);
+                   Add_Interface (Etype (Intf));
+                end if;
+             end if;
+ 
+             Next (Intf);
+          end loop;
+ 
+       --  A type extension may be written as a derivation from an interface.
+       --  The completion will have to implement the same, or derive from a
+       --  type that implements it as well.
+ 
+       elsif Nkind (N) = N_Private_Extension_Declaration
+         and then Is_Interface (Etype (Derived_Type))
+       then
+          Add_Interface (Etype (Derived_Type));
+       end if;
+ 
+       --  Same for task and protected types, that can derive directly from
+       --  an interface (and implement additional interfaces that will be
+       --  present in the interface list of the declaration).
+ 
+       if Nkind (N) = N_Task_Type_Declaration
+         or else Nkind (N) = N_Protected_Type_Declaration
+         or else Nkind (N) = N_Single_Protected_Declaration
+         or else Nkind (N) = N_Single_Task_Declaration
+       then
+          if Is_Interface (Etype (Derived_Type)) then
+             Add_Interface (Etype (Derived_Type));
+          end if;
+       end if;
+    end Collect_Interfaces;
+ 
     ------------------------------
     -- Complete_Private_Subtype --
     ------------------------------
*************** package body Sem_Ch3 is
*** 6900,6908 ****
        --  Next_Entity field of full to ensure that the calls to Copy_Node
        --  do not corrupt the entity chain.
  
!       --  Note that the type of the full view is the same entity as the
!       --  type of the partial view. In this fashion, the subtype has
!       --  access to the correct view of the parent.
  
        Save_Next_Entity := Next_Entity (Full);
        Save_Homonym     := Homonym (Priv);
--- 7729,7737 ----
        --  Next_Entity field of full to ensure that the calls to Copy_Node
        --  do not corrupt the entity chain.
  
!       --  Note that the type of the full view is the same entity as the type of
!       --  the partial view. In this fashion, the subtype has access to the
!       --  correct view of the parent.
  
        Save_Next_Entity := Next_Entity (Full);
        Save_Homonym     := Homonym (Priv);
*************** package body Sem_Ch3 is
*** 7010,7017 ****
        --  If the full base is itself derived from private, build a congruent
        --  subtype of its underlying type, for use by the back end. For a
        --  constrained record component, the declaration cannot be placed on
!       --  the component list, but it must neverthess be built an analyzed, to
!       --  supply enough information for gigi to compute the size of component.
  
        elsif Ekind (Full_Base) in Private_Kind
          and then Is_Derived_Type (Full_Base)
--- 7839,7846 ----
        --  If the full base is itself derived from private, build a congruent
        --  subtype of its underlying type, for use by the back end. For a
        --  constrained record component, the declaration cannot be placed on
!       --  the component list, but it must nevertheless be built an analyzed, to
!       --  supply enough information for Gigi to compute the size of component.
  
        elsif Ekind (Full_Base) in Private_Kind
          and then Is_Derived_Type (Full_Base)
*************** package body Sem_Ch3 is
*** 7090,7095 ****
--- 7919,8016 ----
        end if;
     end Complete_Private_Subtype;
  
+    -------------------------------------
+    -- Complete_Subprograms_Derivation --
+    -------------------------------------
+ 
+    procedure Complete_Subprograms_Derivation
+      (Partial_View : Entity_Id;
+       Derived_Type : Entity_Id)
+    is
+       Result  : constant Elist_Id := New_Elmt_List;
+       Elmt_P  : Elmt_Id;
+       Elmt_D  : Elmt_Id;
+       Found   : Boolean;
+       Prim_Op : Entity_Id;
+       E       : Entity_Id;
+ 
+    begin
+       --  Handle the case in which the full-view is a transitive
+       --  derivation of the ancestor of the partial view.
+ 
+       --   type I is interface;
+       --   type T is new I with ...
+ 
+       --   package H is
+       --      type DT is new I with private;
+       --   private
+       --      type DT is new T with ...
+       --   end;
+ 
+       if Etype (Partial_View) /= Etype (Derived_Type)
+         and then Is_Interface (Etype (Partial_View))
+         and then Is_Ancestor (Etype (Partial_View), Etype (Derived_Type))
+       then
+          return;
+       end if;
+ 
+       if Is_Tagged_Type (Partial_View) then
+          Elmt_P := First_Elmt (Primitive_Operations (Partial_View));
+       else
+          Elmt_P := No_Elmt;
+       end if;
+ 
+       --  Inherit primitives declared with the partial-view
+ 
+       while Present (Elmt_P) loop
+          Prim_Op := Node (Elmt_P);
+          Found   := False;
+          Elmt_D  := First_Elmt (Primitive_Operations (Derived_Type));
+          while Present (Elmt_D) loop
+             if Node (Elmt_D) = Prim_Op then
+                Found := True;
+                exit;
+             end if;
+ 
+             Next_Elmt (Elmt_D);
+          end loop;
+ 
+          if not Found then
+             Append_Elmt (Prim_Op, Result);
+ 
+             --  Search for entries associated with abstract interfaces that
+             --  have been covered by this primitive
+ 
+             Elmt_D := First_Elmt (Primitive_Operations (Derived_Type));
+             while Present (Elmt_D) loop
+                E := Node (Elmt_D);
+ 
+                if Chars (E) = Chars (Prim_Op)
+                  and then Is_Abstract (E)
+                  and then Present (Alias (E))
+                  and then Present (DTC_Entity (Alias (E)))
+                  and then Is_Interface (Scope (DTC_Entity (Alias (E))))
+                then
+                   Remove_Elmt (Primitive_Operations (Derived_Type), Elmt_D);
+                end if;
+ 
+                Next_Elmt (Elmt_D);
+             end loop;
+          end if;
+ 
+          Next_Elmt (Elmt_P);
+       end loop;
+ 
+       --  Append the entities of the full-view to the list of primitives
+       --  of derived_type.
+ 
+       Elmt_D := First_Elmt (Result);
+       while Present (Elmt_D) loop
+          Append_Elmt (Node (Elmt_D), Primitive_Operations (Derived_Type));
+          Next_Elmt (Elmt_D);
+       end loop;
+    end Complete_Subprograms_Derivation;
+ 
     ----------------------------
     -- Constant_Redeclaration --
     ----------------------------
*************** package body Sem_Ch3 is
*** 7104,7114 ****
        New_T   : Entity_Id;
  
        procedure Check_Recursive_Declaration (Typ : Entity_Id);
!       --  If deferred constant is an access type initialized with an
!       --  allocator, check whether there is an illegal recursion in the
!       --  definition, through a default value of some record subcomponent.
!       --  This is normally detected when generating init procs, but requires
!       --  this additional mechanism when expansion is disabled.
  
        ---------------------------------
        -- Check_Recursive_Declaration --
--- 8025,8035 ----
        New_T   : Entity_Id;
  
        procedure Check_Recursive_Declaration (Typ : Entity_Id);
!       --  If deferred constant is an access type initialized with an allocator,
!       --  check whether there is an illegal recursion in the definition,
!       --  through a default value of some record subcomponent. This is normally
!       --  detected when generating init procs, but requires this additional
!       --  mechanism when expansion is disabled.
  
        ---------------------------------
        -- Check_Recursive_Declaration --
*************** package body Sem_Ch3 is
*** 7189,7197 ****
        then
           Enter_Name (Id);
  
!       --  Verify that types of both declarations match
  
!       elsif Base_Type (Etype (Prev)) /= Base_Type (New_T) then
           Error_Msg_Sloc := Sloc (Prev);
           Error_Msg_N ("type does not match declaration#", N);
           Set_Full_View (Prev, Id);
--- 8110,8127 ----
        then
           Enter_Name (Id);
  
!       --  Verify that types of both declarations match, or else that both types
!       --  are anonymous access types whose designated subtypes statically match
!       --  (as allowed in Ada 2005 by AI-385).
  
!       elsif Base_Type (Etype (Prev)) /= Base_Type (New_T)
!         and then
!           (Ekind (Etype (Prev)) /= E_Anonymous_Access_Type
!              or else Ekind (Etype (New_T)) /= E_Anonymous_Access_Type
!              or else not Subtypes_Statically_Match
!                            (Designated_Type (Etype (Prev)),
!                             Designated_Type (Etype (New_T))))
!       then
           Error_Msg_Sloc := Sloc (Prev);
           Error_Msg_N ("type does not match declaration#", N);
           Set_Full_View (Prev, Id);
*************** package body Sem_Ch3 is
*** 7256,7261 ****
--- 8186,8209 ----
        Desig_Subtype : Entity_Id := Create_Itype (E_Void, Related_Nod);
        Constraint_OK : Boolean := True;
  
+       function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean;
+       --  Simple predicate to test for defaulted discriminants
+       --  Shouldn't this be in sem_util???
+ 
+       ---------------------------------
+       -- Has_Defaulted_Discriminants --
+       ---------------------------------
+ 
+       function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean is
+       begin
+          return Has_Discriminants (Typ)
+           and then Present (First_Discriminant (Typ))
+           and then Present
+             (Discriminant_Default_Value (First_Discriminant (Typ)));
+       end Has_Defaulted_Discriminants;
+ 
+    --  Start of processing for Constrain_Access
+ 
     begin
        if Is_Array_Type (Desig_Type) then
           Constrain_Array (Desig_Subtype, S, Related_Nod, Def_Id, 'P');
*************** package body Sem_Ch3 is
*** 7295,7300 ****
--- 8243,8251 ----
              --  a derivation from a private type) has no discriminants.
              --  (Defect Report 8652/0008, Technical Corrigendum 1, checked
              --  by ACATS B371001).
+             --  Rule updated for Ada 2005: the private type is said to have
+             --  a constrained partial view, given that objects of the type
+             --  can be declared.
  
              declare
                 Pack  : constant Node_Id :=
*************** package body Sem_Ch3 is
*** 7323,7330 ****
                       then
                          if No (Discriminant_Specifications (Decl)) then
                             Error_Msg_N
!                             ("cannot constrain general access type " &
!                                "if designated type has unconstrained view", S);
                          end if;
  
                          exit;
--- 8274,8282 ----
                       then
                          if No (Discriminant_Specifications (Decl)) then
                             Error_Msg_N
!                             ("cannot constrain general access type if " &
!                                "designated type has constrained partial view",
!                                 S);
                          end if;
  
                          exit;
*************** package body Sem_Ch3 is
*** 7375,7380 ****
--- 8327,8357 ----
        Set_Is_Access_Constant       (Def_Id, Is_Access_Constant (T));
  
        Conditional_Delay (Def_Id, T);
+ 
+       --  AI-363 : Subtypes of general access types whose designated types have
+       --  default discriminants are disallowed. In instances, the rule has to
+       --  be checked against the actual, of which T is the subtype. In a
+       --  generic body, the rule is checked assuming that the actual type has
+       --  defaulted discriminants.
+ 
+       if Ada_Version >=  Ada_05 then
+          if Ekind (Base_Type (T)) = E_General_Access_Type
+            and then Has_Defaulted_Discriminants (Desig_Type)
+          then
+             Error_Msg_N
+               ("access subype of general access type not allowed", S);
+             Error_Msg_N ("\ when discriminants have defaults", S);
+ 
+          elsif Is_Access_Type (T)
+            and then Is_Generic_Type (Desig_Type)
+            and then Has_Discriminants (Desig_Type)
+            and then In_Package_Body (Current_Scope)
+          then
+             Error_Msg_N ("access subtype not allowed in generic body", S);
+             Error_Msg_N
+               ("\ wben designated type is a discriminated formal", S);
+          end if;
+       end if;
     end Constrain_Access;
  
     ---------------------
*************** package body Sem_Ch3 is
*** 7414,7420 ****
  
        else
           S := First (Constraints (C));
- 
           while Present (S) loop
              Number_Of_Constraints := Number_Of_Constraints + 1;
              Next (S);
--- 8391,8396 ----
*************** package body Sem_Ch3 is
*** 7460,7465 ****
--- 8436,8443 ----
  
        if Constraint_OK then
           Set_First_Index (Def_Id, First (Constraints (C)));
+       else
+          Set_First_Index (Def_Id, First_Index (T));
        end if;
  
        Set_Is_Constrained     (Def_Id, True);
*************** package body Sem_Ch3 is
*** 7483,7495 ****
     ------------------------------
  
     function Constrain_Component_Type
!      (Compon_Type     : Entity_Id;
        Constrained_Typ : Entity_Id;
        Related_Node    : Node_Id;
        Typ             : Entity_Id;
        Constraints     : Elist_Id) return Entity_Id
     is
!       Loc : constant Source_Ptr := Sloc (Constrained_Typ);
  
        function Build_Constrained_Array_Type
          (Old_Type : Entity_Id) return Entity_Id;
--- 8461,8474 ----
     ------------------------------
  
     function Constrain_Component_Type
!      (Comp            : Entity_Id;
        Constrained_Typ : Entity_Id;
        Related_Node    : Node_Id;
        Typ             : Entity_Id;
        Constraints     : Elist_Id) return Entity_Id
     is
!       Loc         : constant Source_Ptr := Sloc (Constrained_Typ);
!       Compon_Type : constant Entity_Id := Etype (Comp);
  
        function Build_Constrained_Array_Type
          (Old_Type : Entity_Id) return Entity_Id;
*************** package body Sem_Ch3 is
*** 7763,7770 ****
        ---------------------
  
        function Get_Discr_Value (Discrim : Entity_Id) return Node_Id is
!          D : Entity_Id := First_Discriminant (Typ);
!          E : Elmt_Id   := First_Elmt (Constraints);
           G : Elmt_Id;
  
        begin
--- 8742,8749 ----
        ---------------------
  
        function Get_Discr_Value (Discrim : Entity_Id) return Node_Id is
!          D : Entity_Id;
!          E : Elmt_Id;
           G : Elmt_Id;
  
        begin
*************** package body Sem_Ch3 is
*** 7775,7780 ****
--- 8754,8761 ----
           --  case when constraining an inherited component whose constraint is
           --  given by a discriminant of the parent.
  
+          D := First_Discriminant (Typ);
+          E := First_Elmt (Constraints);
           while Present (D) loop
              if D = Entity (Discrim)
                or else Corresponding_Discriminant (D) = Entity (Discrim)
*************** package body Sem_Ch3 is
*** 7799,7805 ****
              D := First_Discriminant (Etype (Typ));
              E := First_Elmt (Constraints);
              G := First_Elmt (Stored_Constraint (Typ));
- 
              while Present (D) loop
                 if D = Entity (Discrim) then
                    return Node (E);
--- 8780,8785 ----
*************** package body Sem_Ch3 is
*** 7866,7872 ****
     --  Start of processing for Constrain_Component_Type
  
     begin
!       if Is_Array_Type (Compon_Type) then
           return Build_Constrained_Array_Type (Compon_Type);
  
        elsif Has_Discriminants (Compon_Type) then
--- 8846,8862 ----
     --  Start of processing for Constrain_Component_Type
  
     begin
!       if Nkind (Parent (Comp)) = N_Component_Declaration
!         and then Comes_From_Source (Parent (Comp))
!         and then Comes_From_Source
!           (Subtype_Indication (Component_Definition (Parent (Comp))))
!         and then
!           Is_Entity_Name
!             (Subtype_Indication (Component_Definition (Parent (Comp))))
!       then
!          return Compon_Type;
! 
!       elsif Is_Array_Type (Compon_Type) then
           return Build_Constrained_Array_Type (Compon_Type);
  
        elsif Has_Discriminants (Compon_Type) then
*************** package body Sem_Ch3 is
*** 7874,7882 ****
  
        elsif Is_Access_Type (Compon_Type) then
           return Build_Constrained_Access_Type (Compon_Type);
-       end if;
  
!       return Compon_Type;
     end Constrain_Component_Type;
  
     --------------------------
--- 8864,8873 ----
  
        elsif Is_Access_Type (Compon_Type) then
           return Build_Constrained_Access_Type (Compon_Type);
  
!       else
!          return Compon_Type;
!       end if;
     end Constrain_Component_Type;
  
     --------------------------
*************** package body Sem_Ch3 is
*** 7885,7891 ****
  
     --  For concurrent types, the associated record value type carries the same
     --  discriminants, so when we constrain a concurrent type, we must constrain
!    --  the value type as well.
  
     procedure Constrain_Concurrent
       (Def_Id      : in out Entity_Id;
--- 8876,8882 ----
  
     --  For concurrent types, the associated record value type carries the same
     --  discriminants, so when we constrain a concurrent type, we must constrain
!    --  the corresponding record type as well.
  
     procedure Constrain_Concurrent
       (Def_Id      : in out Entity_Id;
*************** package body Sem_Ch3 is
*** 8713,8719 ****
              Set_Etype
                (New_C,
                 Constrain_Component_Type
!                  (Etype (Old_C), Subt, Decl_Node, Typ, Constraints));
              Set_Is_Public (New_C, Is_Public (Subt));
  
              Next_Elmt (Comp);
--- 9704,9710 ----
              Set_Etype
                (New_C,
                 Constrain_Component_Type
!                  (Old_C, Subt, Decl_Node, Typ, Constraints));
              Set_Is_Public (New_C, Is_Public (Subt));
  
              Next_Elmt (Comp);
*************** package body Sem_Ch3 is
*** 8854,8862 ****
           Create_All_Components;
  
        else
!          --  If the discriminants are not static, or if this is a multi-level
!          --  type extension, we have to include all the components of the
!          --  parent type.
  
           Old_C := First_Component (Typ);
           while Present (Old_C) loop
--- 9845,9852 ----
           Create_All_Components;
  
        else
!          --  If discriminants are not static, or if this is a multi-level type
!          --  extension, we have to include all components of the parent type.
  
           Old_C := First_Component (Typ);
           while Present (Old_C) loop
*************** package body Sem_Ch3 is
*** 8865,8871 ****
              Set_Etype
                (New_C,
                 Constrain_Component_Type
!                  (Etype (Old_C), Subt, Decl_Node, Typ, Constraints));
              Set_Is_Public (New_C, Is_Public (Subt));
  
              Next_Component (Old_C);
--- 9855,9861 ----
              Set_Etype
                (New_C,
                 Constrain_Component_Type
!                  (Old_C, Subt, Decl_Node, Typ, Constraints));
              Set_Is_Public (New_C, Is_Public (Subt));
  
              Next_Component (Old_C);
*************** package body Sem_Ch3 is
*** 8913,8922 ****
        --  Check delta is power of 10, and determine scale value from it
  
        declare
!          Val : Ureal := Delta_Val;
  
        begin
           Scale_Val := Uint_0;
  
           if Val < Ureal_1 then
              while Val < Ureal_1 loop
--- 9903,9913 ----
        --  Check delta is power of 10, and determine scale value from it
  
        declare
!          Val : Ureal;
  
        begin
           Scale_Val := Uint_0;
+          Val := Delta_Val;
  
           if Val < Ureal_1 then
              while Val < Ureal_1 loop
*************** package body Sem_Ch3 is
*** 9034,9039 ****
--- 10025,10083 ----
        Set_Is_Constrained (T);
     end Decimal_Fixed_Point_Type_Declaration;
  
+    ---------------------------------
+    -- Derive_Interface_Subprogram --
+    ---------------------------------
+ 
+    procedure Derive_Interface_Subprograms (Derived_Type : Entity_Id) is
+ 
+       procedure Do_Derivation (T : Entity_Id);
+       --  This inner subprograms is used to climb to the ancestors.
+       --  It is needed to add the derivations to the Derived_Type.
+ 
+       procedure Do_Derivation (T : Entity_Id) is
+          Etyp : constant Entity_Id := Etype (T);
+          AI   : Elmt_Id;
+ 
+       begin
+          if Etyp /= T
+            and then Is_Interface (Etyp)
+          then
+             Do_Derivation (Etyp);
+          end if;
+ 
+          if Present (Abstract_Interfaces (T))
+            and then not Is_Empty_Elmt_List (Abstract_Interfaces (T))
+          then
+             AI := First_Elmt (Abstract_Interfaces (T));
+             while Present (AI) loop
+                if not Is_Ancestor (Node (AI), Derived_Type) then
+                   Derive_Subprograms
+                     (Parent_Type         => Node (AI),
+                      Derived_Type        => Derived_Type,
+                      No_Predefined_Prims => True);
+                end if;
+ 
+                Next_Elmt (AI);
+             end loop;
+          end if;
+       end Do_Derivation;
+ 
+    begin
+       Do_Derivation (Derived_Type);
+ 
+       --  At this point the list of primitive operations of Derived_Type
+       --  contains the entities corresponding to all the subprograms of all the
+       --  implemented interfaces. If N interfaces have subprograms with the
+       --  same profile we have N entities in this list because each one must be
+       --  allocated in its corresponding virtual table.
+ 
+       --  Its alias attribute references its original interface subprogram.
+       --  When overridden, the alias attribute is later saved in the
+       --  Abstract_Interface_Alias attribute.
+ 
+    end Derive_Interface_Subprograms;
+ 
     -----------------------
     -- Derive_Subprogram --
     -----------------------
*************** package body Sem_Ch3 is
*** 9078,9095 ****
           Prev : Entity_Id;
  
        begin
!          --  The visible operation that is overriden is a homonym of the
           --  parent subprogram. We scan the homonym chain to find the one
           --  whose alias is the subprogram we are deriving.
  
!          Prev := Homonym (Parent_Subp);
           while Present (Prev) loop
              if Is_Dispatching_Operation (Parent_Subp)
                and then Present (Prev)
                and then Ekind (Prev) = Ekind (Parent_Subp)
                and then Alias (Prev) = Parent_Subp
                and then Scope (Parent_Subp) = Scope (Prev)
!               and then not Is_Hidden (Prev)
              then
                 Visible_Subp := Prev;
                 return True;
--- 10122,10149 ----
           Prev : Entity_Id;
  
        begin
!          --  The visible operation that is overridden is a homonym of the
           --  parent subprogram. We scan the homonym chain to find the one
           --  whose alias is the subprogram we are deriving.
  
!          Prev := Current_Entity (Parent_Subp);
           while Present (Prev) loop
              if Is_Dispatching_Operation (Parent_Subp)
                and then Present (Prev)
                and then Ekind (Prev) = Ekind (Parent_Subp)
                and then Alias (Prev) = Parent_Subp
                and then Scope (Parent_Subp) = Scope (Prev)
!               and then
!                 (not Is_Hidden (Prev)
!                    or else
! 
!                   --  Ada 2005 (AI-251): Entities associated with overridden
!                   --  interface subprograms are always marked as hidden; in
!                   --  this case the field abstract_interface_alias references
!                   --  the original entity (cf. override_dispatching_operation).
! 
!                  (Atree.Present (Abstract_Interface_Alias (Prev))
!                     and then not Is_Hidden (Abstract_Interface_Alias (Prev))))
              then
                 Visible_Subp := Prev;
                 return True;
*************** package body Sem_Ch3 is
*** 9417,9431 ****
     ------------------------
  
     procedure Derive_Subprograms
!      (Parent_Type    : Entity_Id;
!       Derived_Type   : Entity_Id;
!       Generic_Actual : Entity_Id := Empty)
     is
        Op_List     : constant Elist_Id :=
                        Collect_Primitive_Operations (Parent_Type);
        Act_List    : Elist_Id;
        Act_Elmt    : Elmt_Id;
        Elmt        : Elmt_Id;
        Subp        : Entity_Id;
        New_Subp    : Entity_Id := Empty;
        Parent_Base : Entity_Id;
--- 10471,10487 ----
     ------------------------
  
     procedure Derive_Subprograms
!      (Parent_Type           : Entity_Id;
!       Derived_Type          : Entity_Id;
!       Generic_Actual        : Entity_Id := Empty;
!       No_Predefined_Prims   : Boolean   := False)
     is
        Op_List     : constant Elist_Id :=
                        Collect_Primitive_Operations (Parent_Type);
        Act_List    : Elist_Id;
        Act_Elmt    : Elmt_Id;
        Elmt        : Elmt_Id;
+       Is_Predef   : Boolean;
        Subp        : Entity_Id;
        New_Subp    : Entity_Id := Empty;
        Parent_Base : Entity_Id;
*************** package body Sem_Ch3 is
*** 9455,9461 ****
           Subp := Node (Elmt);
  
           if Ekind (Subp) /= E_Enumeration_Literal then
!             if No (Generic_Actual) then
                 Derive_Subprogram
                   (New_Subp, Subp, Derived_Type, Parent_Base);
  
--- 10511,10533 ----
           Subp := Node (Elmt);
  
           if Ekind (Subp) /= E_Enumeration_Literal then
!             Is_Predef :=
!               Is_Dispatching_Operation (Subp)
!                 and then Is_Predefined_Dispatching_Operation (Subp);
! 
!             if No_Predefined_Prims and then Is_Predef then
!                null;
! 
!             --  We don't need to derive alias entities associated with
!             --  abstract interfaces
! 
!             elsif Is_Dispatching_Operation (Subp)
!                and then Present (Alias (Subp))
!                and then Present (Abstract_Interface_Alias (Subp))
!             then
!                null;
! 
!             elsif No (Generic_Actual) then
                 Derive_Subprogram
                   (New_Subp, Subp, Derived_Type, Parent_Base);
  
*************** package body Sem_Ch3 is
*** 9554,9572 ****
        Is_Completion : Boolean)
     is
        Def          : constant Node_Id := Type_Definition (N);
        Indic        : constant Node_Id := Subtype_Indication (Def);
        Extension    : constant Node_Id := Record_Extension_Part (Def);
        Parent_Type  : Entity_Id;
        Parent_Scope : Entity_Id;
        Taggd        : Boolean;
  
     begin
        Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
  
        if Parent_Type = Any_Type
          or else Etype (Parent_Type) = Any_Type
          or else (Is_Class_Wide_Type (Parent_Type)
!                   and then Etype (Parent_Type) = T)
        then
           --  If Parent_Type is undefined or illegal, make new type into a
           --  subtype of Any_Type, and set a few attributes to prevent cascaded
--- 10626,10765 ----
        Is_Completion : Boolean)
     is
        Def          : constant Node_Id := Type_Definition (N);
+       Iface_Def    : Node_Id;
        Indic        : constant Node_Id := Subtype_Indication (Def);
        Extension    : constant Node_Id := Record_Extension_Part (Def);
        Parent_Type  : Entity_Id;
        Parent_Scope : Entity_Id;
        Taggd        : Boolean;
  
+       function Comes_From_Generic (Typ : Entity_Id) return Boolean;
+       --  Check whether the parent type is a generic formal, or derives
+       --  directly or indirectly from one.
+ 
+       ------------------------
+       -- Comes_From_Generic --
+       ------------------------
+ 
+       function Comes_From_Generic (Typ : Entity_Id) return Boolean is
+       begin
+          if Is_Generic_Type (Typ) then
+             return True;
+ 
+          elsif Is_Generic_Type (Root_Type (Parent_Type)) then
+             return True;
+ 
+          elsif Is_Private_Type (Typ)
+            and then Present (Full_View (Typ))
+            and then Is_Generic_Type (Root_Type (Full_View (Typ)))
+          then
+             return True;
+ 
+          elsif Is_Generic_Actual_Type (Typ) then
+             return True;
+ 
+          else
+             return False;
+          end if;
+       end Comes_From_Generic;
+ 
+    --  Start of processing for Derived_Type_Declaration
+ 
     begin
        Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
  
+       --  Ada 2005 (AI-251): In case of interface derivation check that the
+       --  parent is also an interface.
+ 
+       if Interface_Present (Def) then
+          if not Is_Interface (Parent_Type) then
+             Error_Msg_NE ("(Ada 2005) & must be an interface",
+                           Indic, Parent_Type);
+ 
+          else
+             Iface_Def := Type_Definition (Parent (Parent_Type));
+ 
+             --  Ada 2005 (AI-251): Limited interfaces can only inherit from
+             --  other limited interfaces.
+ 
+             if Limited_Present (Def) then
+                if Limited_Present (Iface_Def) then
+                   null;
+ 
+                elsif Protected_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) limited interface cannot" &
+                     " inherit from protected interface", Indic);
+ 
+                elsif Synchronized_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) limited interface cannot" &
+                     " inherit from synchronized interface", Indic);
+ 
+                elsif Task_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) limited interface cannot" &
+                     " inherit from task interface", Indic);
+ 
+                else
+                   Error_Msg_N ("(Ada 2005) limited interface cannot" &
+                     " inherit from non-limited interface", Indic);
+                end if;
+ 
+             --  Ada 2005 (AI-345): Non-limited interfaces can only inherit
+             --  from non-limited or limited interfaces.
+ 
+             elsif not Protected_Present (Def)
+               and then not Synchronized_Present (Def)
+               and then not Task_Present (Def)
+             then
+                if Limited_Present (Iface_Def) then
+                   null;
+ 
+                elsif Protected_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) non-limited interface cannot" &
+                     " inherit from protected interface", Indic);
+ 
+                elsif Synchronized_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) non-limited interface cannot" &
+                     " inherit from synchronized interface", Indic);
+ 
+                elsif Task_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) non-limited interface cannot" &
+                     " inherit from task interface", Indic);
+ 
+                else
+                   null;
+                end if;
+             end if;
+          end if;
+       end if;
+ 
+       --  Ada 2005 (AI-251): Decorate all the names in the list of ancestor
+       --  interfaces
+ 
+       if Is_Tagged_Type (Parent_Type)
+         and then Is_Non_Empty_List (Interface_List (Def))
+       then
+          declare
+             Intf : Node_Id;
+             T    : Entity_Id;
+ 
+          begin
+             Intf := First (Interface_List (Def));
+             while Present (Intf) loop
+                T := Find_Type_Of_Subtype_Indic (Intf);
+ 
+                if not Is_Interface (T) then
+                   Error_Msg_NE ("(Ada 2005) & must be an interface", Intf, T);
+                end if;
+ 
+                Next (Intf);
+             end loop;
+          end;
+       end if;
+ 
        if Parent_Type = Any_Type
          or else Etype (Parent_Type) = Any_Type
          or else (Is_Class_Wide_Type (Parent_Type)
!                    and then Etype (Parent_Type) = T)
        then
           --  If Parent_Type is undefined or illegal, make new type into a
           --  subtype of Any_Type, and set a few attributes to prevent cascaded
*************** package body Sem_Ch3 is
*** 9587,9601 ****
           end if;
  
           return;
- 
-       --  Ada 2005 (AI-231): Static check
- 
-       elsif Is_Access_Type (Parent_Type)
-         and then Null_Exclusion_Present (Type_Definition (N))
-         and then Can_Never_Be_Null (Parent_Type)
-       then
-          Error_Msg_N ("(Ada 2005) null exclusion not allowed if parent is "
-                       & "already non-null", Type_Definition (N));
        end if;
  
        --  Only composite types other than array types are allowed to have
--- 10780,10785 ----
*************** package body Sem_Ch3 is
*** 9635,9643 ****
           return;
  
        elsif (Is_Incomplete_Or_Private_Type (Parent_Type)
!               and then not Is_Generic_Type (Parent_Type)
!               and then not Is_Generic_Type (Root_Type (Parent_Type))
!               and then not Is_Generic_Actual_Type (Parent_Type))
          or else Has_Private_Component (Parent_Type)
        then
           --  The ancestor type of a formal type can be incomplete, in which
--- 10819,10825 ----
           return;
  
        elsif (Is_Incomplete_Or_Private_Type (Parent_Type)
!               and then not Comes_From_Generic (Parent_Type))
          or else Has_Private_Component (Parent_Type)
        then
           --  The ancestor type of a formal type can be incomplete, in which
*************** package body Sem_Ch3 is
*** 9656,9662 ****
                ("premature derivation of derived or private type", Indic);
  
              --  Flag the type itself as being in error, this prevents some
!             --  nasty problems with people looking at the malformed type.
  
              Set_Error_Posted (T);
  
--- 10838,10844 ----
                ("premature derivation of derived or private type", Indic);
  
              --  Flag the type itself as being in error, this prevents some
!             --  nasty problems with subsequent uses of the malformed type.
  
              Set_Error_Posted (T);
  
*************** package body Sem_Ch3 is
*** 9966,9971 ****
--- 11148,11161 ----
                     ("completion of nonlimited type cannot be limited", N);
                 end if;
  
+             --  Ada 2005 (AI-251): Private extension declaration of a
+             --  task type. This case arises with tasks implementing interfaces
+ 
+             elsif Nkind (N) = N_Task_Type_Declaration
+               or else Nkind (N) = N_Protected_Type_Declaration
+             then
+                null;
+ 
              elsif Nkind (N) /= N_Full_Type_Declaration
                or else Nkind (Type_Definition (N)) /= N_Derived_Type_Definition
              then
*************** package body Sem_Ch3 is
*** 10035,10040 ****
--- 11225,11232 ----
           if Is_Type (Prev)
             and then (Is_Tagged_Type (Prev)
                        or else Present (Class_Wide_Type (Prev)))
+            and then (Nkind (N) /= N_Task_Type_Declaration
+                       and then Nkind (N) /= N_Protected_Type_Declaration)
           then
              --  The full declaration is either a tagged record or an
              --  extension otherwise this is an error
*************** package body Sem_Ch3 is
*** 10140,10150 ****
             and then No (Expression (P))
           then
              null;
- 
           else
              Insert_Actions (Obj_Def, Freeze_Entity (T, Sloc (P)));
           end if;
  
        else
           T := Process_Subtype (Obj_Def, Related_Nod);
        end if;
--- 11332,11350 ----
             and then No (Expression (P))
           then
              null;
           else
              Insert_Actions (Obj_Def, Freeze_Entity (T, Sloc (P)));
           end if;
  
+       --  Ada 2005 AI-406: the object definition in an object declaration
+       --  can be an access definition.
+ 
+       elsif Def_Kind = N_Access_Definition then
+          T := Access_Definition (Related_Nod, Obj_Def);
+          Set_Is_Local_Anonymous_Access (T);
+ 
+       --  comment here, what cases ???
+ 
        else
           T := Process_Subtype (Obj_Def, Related_Nod);
        end if;
*************** package body Sem_Ch3 is
*** 10536,10545 ****
  
        if Base_Type (Scope (Discriminant)) = Base_Type (Typ_For_Constraint) then
           declare
!             D : Entity_Id := First_Discriminant (Typ_For_Constraint);
!             E : Elmt_Id   := First_Elmt (Constraint);
  
           begin
              while Present (D) loop
                 if Chars (D) = Chars (Discriminant) then
                    return Node (E);
--- 11736,11747 ----
  
        if Base_Type (Scope (Discriminant)) = Base_Type (Typ_For_Constraint) then
           declare
!             D : Entity_Id;
!             E : Elmt_Id;
  
           begin
+             D := First_Discriminant (Typ_For_Constraint);
+             E := First_Elmt (Constraint);
              while Present (D) loop
                 if Chars (D) = Chars (Discriminant) then
                    return Node (E);
*************** package body Sem_Ch3 is
*** 10558,10567 ****
  
        if  Nkind (Result) = N_Defining_Identifier then
           declare
!             D : Entity_Id := First_Discriminant (Typ_For_Constraint);
!             E : Elmt_Id   := First_Elmt (Constraint);
  
           begin
              while Present (D) loop
                 if Corresponding_Discriminant (D) = Discriminant then
                    return Node (E);
--- 11760,11771 ----
  
        if  Nkind (Result) = N_Defining_Identifier then
           declare
!             D : Entity_Id;
!             E : Elmt_Id;
  
           begin
+             D := First_Discriminant (Typ_For_Constraint);
+             E := First_Elmt (Constraint);
              while Present (D) loop
                 if Corresponding_Discriminant (D) = Discriminant then
                    return Node (E);
*************** package body Sem_Ch3 is
*** 10675,10682 ****
              then
                 Set_Etype (New_C, Etype (Old_C));
              else
!                Set_Etype (New_C, Constrain_Component_Type (Etype (Old_C),
!                  Derived_Base, N, Parent_Base, Discs));
              end if;
           end if;
  
--- 11879,11888 ----
              then
                 Set_Etype (New_C, Etype (Old_C));
              else
!                Set_Etype
!                  (New_C,
!                   Constrain_Component_Type
!                     (Old_C, Derived_Base, N, Parent_Base, Discs));
              end if;
           end if;
  
*************** package body Sem_Ch3 is
*** 10710,10716 ****
              while Present (Discrim) loop
                 Corr_Discrim := Corresponding_Discriminant (Discrim);
  
!                --  Corr_Discrimm could be missing in an error situation
  
                 if Present (Corr_Discrim)
                   and then Original_Record_Component (Corr_Discrim) = Old_C
--- 11916,11922 ----
              while Present (Discrim) loop
                 Corr_Discrim := Corresponding_Discriminant (Discrim);
  
!                --  Corr_Discrim could be missing in an error situation
  
                 if Present (Corr_Discrim)
                   and then Original_Record_Component (Corr_Discrim) = Old_C
*************** package body Sem_Ch3 is
*** 10805,10811 ****
  
        Component := First_Entity (Parent_Base);
        while Present (Component) loop
!          if Ekind (Component) /= E_Component
             or else Chars (Component) = Name_uParent
           then
              null;
--- 12011,12027 ----
  
        Component := First_Entity (Parent_Base);
        while Present (Component) loop
! 
!          --  Ada 2005 (AI-251): Do not inherit tags corresponding with the
!          --  interfaces of the parent
! 
!          if Ekind (Component) = E_Component
!            and then Is_Tag (Component)
!            and then Etype  (Component) = RTE (RE_Interface_Tag)
!          then
!             null;
! 
!          elsif Ekind (Component) /= E_Component
             or else Chars (Component) = Name_uParent
           then
              null;
*************** package body Sem_Ch3 is
*** 10914,10922 ****
        -------------------
  
        function Is_Local_Type (Typ : Entity_Id) return Boolean is
!          Scop : Entity_Id := Scope (Typ);
  
        begin
           while Present (Scop)
             and then Scop /= Standard_Standard
           loop
--- 12130,12139 ----
        -------------------
  
        function Is_Local_Type (Typ : Entity_Id) return Boolean is
!          Scop : Entity_Id;
  
        begin
+          Scop := Scope (Typ);
           while Present (Scop)
             and then Scop /= Standard_Standard
           loop
*************** package body Sem_Ch3 is
*** 11174,11180 ****
  
              begin
                 Get_First_Interp (I, Ind, It);
- 
                 while Present (It.Typ) loop
                    if Is_Discrete_Type (It.Typ) then
  
--- 12391,12396 ----
*************** package body Sem_Ch3 is
*** 11597,11606 ****
        --  of two that does not exceed the given delta value.
  
        declare
!          Tmp   : Ureal := Ureal_1;
!          Scale : Int   := 0;
  
        begin
           if Delta_Val < Ureal_1 then
              while Delta_Val < Tmp loop
                 Tmp := Tmp / Ureal_2;
--- 12813,12825 ----
        --  of two that does not exceed the given delta value.
  
        declare
!          Tmp   : Ureal;
!          Scale : Int;
  
        begin
+          Tmp := Ureal_1;
+          Scale := 0;
+ 
           if Delta_Val < Ureal_1 then
              while Delta_Val < Tmp loop
                 Tmp := Tmp / Ureal_2;
*************** package body Sem_Ch3 is
*** 11767,11772 ****
--- 12986,13003 ----
           if Nkind (Discriminant_Type (Discr)) = N_Access_Definition then
              Discr_Type := Access_Definition (N, Discriminant_Type (Discr));
  
+             --  Ada 2005 (AI-230): Access discriminants are now allowed for
+             --  nonlimited types, and are treated like other components of
+             --  anonymous access types in terms of accessibility.
+ 
+             if not Is_Concurrent_Type (Current_Scope)
+               and then not Is_Concurrent_Record_Type (Current_Scope)
+               and then not Is_Limited_Record (Current_Scope)
+               and then Ekind (Current_Scope) /= E_Limited_Private_Type
+             then
+                Set_Is_Local_Anonymous_Access (Discr_Type);
+             end if;
+ 
              --  Ada 2005 (AI-254)
  
              if Present (Access_To_Subprogram_Definition
*************** package body Sem_Ch3 is
*** 11852,11866 ****
              Default_Not_Present := True;
           end if;
  
!          --  Ada 2005 (AI-231): Set the null-excluding attribute and carry
!          --  out some static checks.
  
-          if Ada_Version >= Ada_05
-            and then (Null_Exclusion_Present (Discr)
-                        or else Can_Never_Be_Null (Discr_Type))
-          then
-             Set_Can_Never_Be_Null (Defining_Identifier (Discr));
-             Null_Exclusion_Static_Checks (Discr);
           end if;
  
           Next (Discr);
--- 13083,13117 ----
              Default_Not_Present := True;
           end if;
  
!          --  Ada 2005 (AI-231): Create an Itype that is a duplicate of
!          --  Discr_Type but with the null-exclusion attribute
! 
!          if Ada_Version >= Ada_05 then
! 
!             --  Ada 2005 (AI-231): Static checks
! 
!             if Can_Never_Be_Null (Discr_Type) then
!                Null_Exclusion_Static_Checks (Discr);
! 
!             elsif Is_Access_Type (Discr_Type)
!               and then Null_Exclusion_Present (Discr)
! 
!                --  No need to check itypes because in their case this check
!                --  was done at their point of creation
! 
!               and then not Is_Itype (Discr_Type)
!             then
!                if Can_Never_Be_Null (Discr_Type) then
!                   Error_Msg_N
!                     ("(Ada 2005) already a null-excluding type", Discr);
!                end if;
! 
!                Set_Etype (Defining_Identifier (Discr),
!                  Create_Null_Excluding_Itype
!                    (T           => Discr_Type,
!                     Related_Nod => Discr));
!             end if;
  
           end if;
  
           Next (Discr);
*************** package body Sem_Ch3 is
*** 11898,11904 ****
  
        Discr := First (Discriminant_Specifications (N));
        Discr_Number := Uint_1;
- 
        while Present (Discr) loop
           Id := Defining_Identifier (Discr);
           Set_Ekind (Id, E_Discriminant);
--- 13149,13154 ----
*************** package body Sem_Ch3 is
*** 11936,11941 ****
--- 13186,13224 ----
        Full_Parent : Entity_Id;
        Full_Indic  : Node_Id;
  
+       function Find_Ancestor_Interface
+         (Typ : Entity_Id) return Entity_Id;
+       --  Find an implemented interface in the derivation chain of Typ
+ 
+       -----------------------------
+       -- Find_Ancestor_Interface --
+       -----------------------------
+ 
+       function Find_Ancestor_Interface
+         (Typ : Entity_Id) return Entity_Id
+       is
+          T : Entity_Id;
+ 
+       begin
+          T := Typ;
+          while T /= Etype (T) loop
+             if Is_Interface (Etype (T)) then
+                return Etype (T);
+             end if;
+ 
+             T := Etype (T);
+ 
+             --  Protect us against erroneous code that has a large
+             --  chain of circularity dependencies
+ 
+             exit when T = Typ;
+          end loop;
+ 
+          return Empty;
+       end Find_Ancestor_Interface;
+ 
+    --  Start of processing for Process_Full_View
+ 
     begin
        --  First some sanity checks that must be done after semantic
        --  decoration of the full view and thus cannot be placed with other
*************** package body Sem_Ch3 is
*** 11972,11977 ****
--- 13255,13307 ----
           Error_Msg_N ("generic type cannot have a completion", Full_T);
        end if;
  
+       --  Ada 2005 (AI-396): A full view shall be a descendant of an
+       --  interface type if and only if the corresponding partial view
+       --  (if any) is also a descendant of the interface type, or if
+       --  the partial view is untagged.
+ 
+       if Ada_Version >= Ada_05
+         and then Is_Tagged_Type (Full_T)
+       then
+          declare
+             Iface     : Entity_Id;
+             Iface_Def : Node_Id;
+ 
+          begin
+             Iface := Find_Ancestor_Interface (Full_T);
+ 
+             if Present (Iface) then
+                Iface_Def := Type_Definition (Parent (Iface));
+ 
+                --  The full view derives from an interface descendant, but the
+                --  partial view does not share the same tagged type.
+ 
+                if Is_Tagged_Type (Priv_T)
+                  and then Etype (Priv_T) /= Etype (Full_T)
+                  and then Etype (Priv_T) /= Iface
+                then
+                   Error_Msg_N ("(Ada 2005) tagged partial view cannot be " &
+                                "completed by a type that implements an " &
+                                "interface", Priv_T);
+                end if;
+ 
+                --  The full view derives from a limited, protected,
+                --  synchronized or task interface descendant, but the
+                --  partial view is not labeled as limited.
+ 
+                if (Limited_Present               (Iface_Def)
+                     or else Protected_Present    (Iface_Def)
+                     or else Synchronized_Present (Iface_Def)
+                     or else Task_Present         (Iface_Def))
+                  and then not Limited_Present (Parent (Priv_T))
+                then
+                   Error_Msg_N ("(Ada 2005) non-limited private type cannot be "
+                                & "completed by a limited type", Priv_T);
+                end if;
+             end if;
+          end;
+       end if;
+ 
        if Is_Tagged_Type (Priv_T)
          and then Nkind (Parent (Priv_T)) = N_Private_Extension_Declaration
          and then Is_Derived_Type (Full_T)
*************** package body Sem_Ch3 is
*** 12035,12041 ****
              begin
                 Priv_Discr := First_Discriminant (Priv_Parent);
                 Full_Discr := First_Discriminant (Full_Parent);
- 
                 while Present (Priv_Discr) and then Present (Full_Discr) loop
                    if Original_Record_Component (Priv_Discr) =
                       Original_Record_Component (Full_Discr)
--- 13365,13370 ----
*************** package body Sem_Ch3 is
*** 12079,12085 ****
           then
              Error_Msg_N
                ("full view must define a constrained type if partial view"
!                & " has no discriminants", Full_T);
           end if;
  
           --  ??????? Do we implement the following properly ?????
--- 13408,13414 ----
           then
              Error_Msg_N
                ("full view must define a constrained type if partial view"
!                 & " has no discriminants", Full_T);
           end if;
  
           --  ??????? Do we implement the following properly ?????
*************** package body Sem_Ch3 is
*** 12099,12104 ****
--- 13428,13449 ----
           end if;
        end if;
  
+       --  Ada 2005 AI-363: if the full view has discriminants with
+       --  defaults, it is illegal to declare constrained access subtypes
+       --  whose designated type is the current type. This allows objects
+       --  of the type that are declared in the heap to be unconstrained.
+ 
+       if not Has_Unknown_Discriminants (Priv_T)
+         and then not Has_Discriminants (Priv_T)
+         and then Has_Discriminants (Full_T)
+         and then
+           Present
+             (Discriminant_Default_Value (First_Discriminant (Full_T)))
+       then
+          Set_Has_Constrained_Partial_View (Full_T);
+          Set_Has_Constrained_Partial_View (Priv_T);
+       end if;
+ 
        --  Create a full declaration for all its subtypes recorded in
        --  Private_Dependents and swap them similarly to the base type. These
        --  are subtypes that have been define before the full declaration of
*************** package body Sem_Ch3 is
*** 12216,12222 ****
                       then
  
                          --  Verify that it is not otherwise controlled by
!                         --  a formal or a return value ot type T.
  
                          Check_Controlling_Formals (D_Type, Prim);
                       end if;
--- 13561,13567 ----
                       then
  
                          --  Verify that it is not otherwise controlled by
!                         --  a formal or a return value of type T.
  
                          Check_Controlling_Formals (D_Type, Prim);
                       end if;
*************** package body Sem_Ch3 is
*** 12263,12277 ****
     begin
        if No (Private_Dependents (Inc_T)) then
           return;
- 
-       else
-          Inc_Elmt := First_Elmt (Private_Dependents (Inc_T));
- 
-          --  Itypes that may be generated by the completion of an incomplete
-          --  subtype are not used by the back-end and not attached to the tree.
-          --  They are created only for constraint-checking purposes.
        end if;
  
        while Present (Inc_Elmt) loop
           Priv_Dep := Node (Inc_Elmt);
  
--- 13608,13620 ----
     begin
        if No (Private_Dependents (Inc_T)) then
           return;
        end if;
  
+       --  Itypes that may be generated by the completion of an incomplete
+       --  subtype are not used by the back-end and not attached to the tree.
+       --  They are created only for constraint-checking purposes.
+ 
+       Inc_Elmt := First_Elmt (Private_Dependents (Inc_T));
        while Present (Inc_Elmt) loop
           Priv_Dep := Node (Inc_Elmt);
  
*************** package body Sem_Ch3 is
*** 12289,12297 ****
  
              begin
                 Formal := First_Formal (Priv_Dep);
- 
                 while Present (Formal) loop
- 
                    if Etype (Formal) = Inc_T then
                       Set_Etype (Formal, Full_T);
                    end if;
--- 13632,13638 ----
*************** package body Sem_Ch3 is
*** 12300,12308 ****
                 end loop;
              end;
  
!          elsif  Is_Overloadable (Priv_Dep) then
  
!             if Is_Tagged_Type (Full_T) then
  
                 --  Subprogram has an access parameter whose designated type
                 --  was incomplete. Reexamine declaration now, because it may
--- 13641,13654 ----
                 end loop;
              end;
  
!          elsif Is_Overloadable (Priv_Dep) then
  
!             --  A protected operation is never dispatching: only its
!             --  wrapper operation (which has convention Ada) is.
! 
!             if Is_Tagged_Type (Full_T)
!               and then Convention (Priv_Dep) /= Convention_Protected
!             then
  
                 --  Subprogram has an access parameter whose designated type
                 --  was incomplete. Reexamine declaration now, because it may
*************** package body Sem_Ch3 is
*** 12457,12468 ****
  
              if not R_Check_Off then
                 R_Checks := Range_Check (R, T);
-                Type_Decl := Parent (R);
  
                 --  Look up tree to find an appropriate insertion point.
                 --  This seems really junk code, and very brittle, couldn't
                 --  we just use an insert actions call of some kind ???
  
                 while Present (Type_Decl) and then not
                   (Nkind (Type_Decl) = N_Full_Type_Declaration
                      or else
--- 13803,13814 ----
  
              if not R_Check_Off then
                 R_Checks := Range_Check (R, T);
  
                 --  Look up tree to find an appropriate insertion point.
                 --  This seems really junk code, and very brittle, couldn't
                 --  we just use an insert actions call of some kind ???
  
+                Type_Decl := Parent (R);
                 while Present (Type_Decl) and then not
                   (Nkind (Type_Decl) = N_Full_Type_Declaration
                      or else
*************** package body Sem_Ch3 is
*** 12490,12498 ****
  
                    if Nkind (Type_Decl) = N_Loop_Statement then
                       declare
!                         Indic : Node_Id := Parent (R);
  
                       begin
                          while Present (Indic) and then not
                            (Nkind (Indic) = N_Subtype_Indication)
                          loop
--- 13836,13845 ----
  
                    if Nkind (Type_Decl) = N_Loop_Statement then
                       declare
!                         Indic : Node_Id;
  
                       begin
+                         Indic := Parent (R);
                          while Present (Indic) and then not
                            (Nkind (Indic) = N_Subtype_Indication)
                          loop
*************** package body Sem_Ch3 is
*** 12600,12608 ****
--- 13947,13958 ----
     is
        P               : Node_Id;
        Def_Id          : Entity_Id;
+       Error_Node      : Node_Id;
        Full_View_Id    : Entity_Id;
        Subtype_Mark_Id : Entity_Id;
  
+       May_Have_Null_Exclusion : Boolean;
+ 
        procedure Check_Incomplete (T : Entity_Id);
        --  Called to verify that an incomplete type is not used prematurely
  
*************** package body Sem_Ch3 is
*** 12626,12643 ****
  
           Find_Type (S);
           Check_Incomplete (S);
  
           --  Ada 2005 (AI-231): Static check
  
           if Ada_Version >= Ada_05
!            and then Present (Parent (S))
!            and then Null_Exclusion_Present (Parent (S))
!            and then Nkind (Parent (S)) /= N_Access_To_Object_Definition
             and then not Is_Access_Type (Entity (S))
           then
              Error_Msg_N
!               ("(Ada 2005) null-exclusion part requires an access type", S);
           end if;
           return Entity (S);
  
        --  Case of constraint present, so that we have an N_Subtype_Indication
--- 13976,14065 ----
  
           Find_Type (S);
           Check_Incomplete (S);
+          P := Parent (S);
  
           --  Ada 2005 (AI-231): Static check
  
           if Ada_Version >= Ada_05
!            and then Present (P)
!            and then Null_Exclusion_Present (P)
!            and then Nkind (P) /= N_Access_To_Object_Definition
             and then not Is_Access_Type (Entity (S))
           then
              Error_Msg_N
!               ("(Ada 2005) the null-exclusion part requires an access type",
!                S);
           end if;
+ 
+          May_Have_Null_Exclusion :=
+            Nkind (P) = N_Access_Definition
+            or else Nkind (P) = N_Access_Function_Definition
+            or else Nkind (P) = N_Access_Procedure_Definition
+            or else Nkind (P) = N_Access_To_Object_Definition
+            or else Nkind (P) = N_Allocator
+            or else Nkind (P) = N_Component_Definition
+            or else Nkind (P) = N_Derived_Type_Definition
+            or else Nkind (P) = N_Discriminant_Specification
+            or else Nkind (P) = N_Object_Declaration
+            or else Nkind (P) = N_Parameter_Specification
+            or else Nkind (P) = N_Subtype_Declaration;
+ 
+          --  Create an Itype that is a duplicate of Entity (S) but with the
+          --  null-exclusion attribute
+ 
+          if May_Have_Null_Exclusion
+            and then Is_Access_Type (Entity (S))
+            and then Null_Exclusion_Present (P)
+ 
+             --  No need to check the case of an access to object definition.
+             --  It is correct to define double not-null pointers.
+             --  Example:
+             --     type Not_Null_Int_Ptr is not null access Integer;
+             --     type Acc is not null access Not_Null_Int_Ptr;
+ 
+            and then Nkind (P) /= N_Access_To_Object_Definition
+          then
+             if Can_Never_Be_Null (Entity (S)) then
+                case Nkind (Related_Nod) is
+                   when N_Full_Type_Declaration =>
+                      if Nkind (Type_Definition (Related_Nod))
+                        in N_Array_Type_Definition
+                      then
+                         Error_Node :=
+                           Subtype_Indication
+                             (Component_Definition
+                              (Type_Definition (Related_Nod)));
+                      else
+                         Error_Node :=
+                           Subtype_Indication (Type_Definition (Related_Nod));
+                      end if;
+ 
+                   when N_Subtype_Declaration =>
+                      Error_Node := Subtype_Indication (Related_Nod);
+ 
+                   when N_Object_Declaration =>
+                      Error_Node := Object_Definition (Related_Nod);
+ 
+                   when N_Component_Declaration =>
+                      Error_Node :=
+                        Subtype_Indication (Component_Definition (Related_Nod));
+ 
+                   when others =>
+                      pragma Assert (False);
+                      Error_Node := Related_Nod;
+                end case;
+ 
+                Error_Msg_N
+                  ("(Ada 2005) already a null-excluding type", Error_Node);
+             end if;
+ 
+             Set_Etype  (S,
+               Create_Null_Excluding_Itype
+                 (T           => Entity (S),
+                  Related_Nod => P));
+             Set_Entity (S, Etype (S));
+          end if;
+ 
           return Entity (S);
  
        --  Case of constraint present, so that we have an N_Subtype_Indication
*************** package body Sem_Ch3 is
*** 12703,12709 ****
  
              Rewrite (S, New_Copy_Tree (Subtype_Mark (S)));
  
!             --  Set Ekind of orphan itype, to prevent cascaded errors.
  
              if Present (Def_Id) then
                 Set_Ekind (Def_Id, Ekind (Any_Type));
--- 14125,14131 ----
  
              Rewrite (S, New_Copy_Tree (Subtype_Mark (S)));
  
!             --  Set Ekind of orphan itype, to prevent cascaded errors
  
              if Present (Def_Id) then
                 Set_Ekind (Def_Id, Ekind (Any_Type));
*************** package body Sem_Ch3 is
*** 12803,12848 ****
        N    : Node_Id;
        Prev : Entity_Id)
     is
!       Def : constant Node_Id := Type_Definition (N);
  
        Is_Tagged : Boolean;
        Tag_Comp  : Entity_Id;
  
!    begin
!       --  The flag Is_Tagged_Type might have already been set by Find_Type_Name
!       --  if it detected an error for declaration T. This arises in the case of
!       --  private tagged types where the full view omits the word tagged.
  
!       Is_Tagged :=
!         Tagged_Present (Def)
!           or else (Serious_Errors_Detected > 0 and then Is_Tagged_Type (T));
  
!       --  Records constitute a scope for the component declarations within.
!       --  The scope is created prior to the processing of these declarations.
!       --  Discriminants are processed first, so that they are visible when
!       --  processing the other components. The Ekind of the record type itself
!       --  is set to E_Record_Type (subtypes appear as E_Record_Subtype).
  
!       --  Enter record scope
  
!       New_Scope (T);
  
        --  These flags must be initialized before calling Process_Discriminants
        --  because this routine makes use of them.
  
!       Set_Is_Tagged_Type     (T, Is_Tagged);
!       Set_Is_Limited_Record  (T, Limited_Present (Def));
  
!       --  Type is abstract if full declaration carries keyword, or if
!       --  previous partial view did.
  
!       Set_Is_Abstract (T, Is_Abstract (T) or else Abstract_Present (Def));
  
!       Set_Ekind       (T, E_Record_Type);
!       Set_Etype       (T, T);
!       Init_Size_Align (T);
  
!       Set_Stored_Constraint (T, No_Elist);
  
        --  If an incomplete or private type declaration was already given for
        --  the type, then this scope already exists, and the discriminants have
--- 14225,14599 ----
        N    : Node_Id;
        Prev : Entity_Id)
     is
!       Loc   : constant Source_Ptr := Sloc (N);
!       Def   : constant Node_Id    := Type_Definition (N);
!       Inc_T : Entity_Id := Empty;
  
        Is_Tagged : Boolean;
        Tag_Comp  : Entity_Id;
  
!       procedure Check_Anonymous_Access_Types (Comp_List : Node_Id);
!       --  Ada 2005 AI-382: an access component in a record declaration can
!       --  refer to the enclosing record, in which case it denotes the type
!       --  itself, and not the current instance of the type. We create an
!       --  anonymous access type for the component, and flag it as an access
!       --  to a component, so that accessibility checks are properly performed
!       --  on it. The declaration of the access type is placed ahead of that
!       --  of the record, to prevent circular order-of-elaboration issues in
!       --  Gigi. We create an incomplete type for the record declaration, which
!       --  is the designated type of the anonymous access.
  
!       procedure Make_Incomplete_Type_Declaration;
!       --  If the record type contains components that include an access to the
!       --  current record, create an incomplete type declaration for the record,
!       --  to be used as the designated type of the anonymous access. This is
!       --  done only once, and only if there is no previous partial view of the
!       --  type.
  
!       ----------------------------------
!       -- Check_Anonymous_Access_Types --
!       ----------------------------------
  
!       procedure Check_Anonymous_Access_Types (Comp_List : Node_Id) is
!          Anon_Access : Entity_Id;
!          Acc_Def     : Node_Id;
!          Comp        : Node_Id;
!          Decl        : Node_Id;
!          Type_Def    : Node_Id;
  
!          function Mentions_T (Acc_Def : Node_Id) return Boolean;
!          --  Check whether an access definition includes a reference to
!          --  the enclosing record type. The reference can be a subtype
!          --  mark in the access definition itself, or a 'Class attribute
!          --  reference, or recursively a reference appearing in a parameter
!          --  type in an access_to_subprogram definition.
! 
!          ----------------
!          -- Mentions_T --
!          ----------------
! 
!          function Mentions_T (Acc_Def : Node_Id) return Boolean is
!             Subt : Node_Id;
! 
!          begin
!             if No (Access_To_Subprogram_Definition (Acc_Def)) then
!                Subt := Subtype_Mark (Acc_Def);
! 
!                if Nkind (Subt) = N_Identifier then
!                   return Chars (Subt) = Chars (T);
!                elsif Nkind (Subt) = N_Attribute_Reference
!                   and then Attribute_Name (Subt) = Name_Class
!                then
!                   return (Chars (Prefix (Subt))) = Chars (T);
!                else
!                   return False;
!                end if;
! 
!             else
!                --  Component is an access_to_subprogram: examine its formals
! 
!                declare
!                   Param_Spec : Node_Id;
! 
!                begin
!                   Param_Spec :=
!                     First
!                       (Parameter_Specifications
!                         (Access_To_Subprogram_Definition (Acc_Def)));
!                   while Present (Param_Spec) loop
!                      if Nkind (Parameter_Type (Param_Spec))
!                           = N_Access_Definition
!                        and then Mentions_T (Parameter_Type (Param_Spec))
!                      then
!                         return True;
!                      end if;
  
+                      Next (Param_Spec);
+                   end loop;
+ 
+                   return False;
+                end;
+             end if;
+          end Mentions_T;
+ 
+       --  Start of processing for Check_Anonymous_Access_Types
+ 
+       begin
+          if No (Comp_List) then
+             return;
+          end if;
+ 
+          Comp := First (Component_Items (Comp_List));
+          while Present (Comp) loop
+             if Nkind (Comp) = N_Component_Declaration
+               and then
+                 Present (Access_Definition (Component_Definition (Comp)))
+               and then
+                 Mentions_T (Access_Definition (Component_Definition (Comp)))
+             then
+                Acc_Def :=
+                  Access_To_Subprogram_Definition
+                    (Access_Definition (Component_Definition (Comp)));
+ 
+                Make_Incomplete_Type_Declaration;
+                Anon_Access :=
+                  Make_Defining_Identifier (Loc,
+                    Chars => New_Internal_Name ('S'));
+ 
+                --  Create a declaration for the anonymous access type: either
+                --  an access_to_object or an access_to_subprogram.
+ 
+                if Present (Acc_Def) then
+                   if Nkind  (Acc_Def) = N_Access_Function_Definition then
+                      Type_Def :=
+                        Make_Access_Function_Definition (Loc,
+                          Parameter_Specifications =>
+                            Parameter_Specifications (Acc_Def),
+                          Result_Definition => Result_Definition (Acc_Def));
+                   else
+                      Type_Def :=
+                        Make_Access_Procedure_Definition (Loc,
+                          Parameter_Specifications =>
+                            Parameter_Specifications (Acc_Def));
+                   end if;
+ 
+                else
+                   Type_Def :=
+                     Make_Access_To_Object_Definition (Loc,
+                       Subtype_Indication =>
+                          Relocate_Node
+                            (Subtype_Mark
+                              (Access_Definition
+                                (Component_Definition (Comp)))));
+                end if;
+ 
+                Decl := Make_Full_Type_Declaration (Loc,
+                   Defining_Identifier => Anon_Access,
+                   Type_Definition => Type_Def);
+ 
+                Insert_Before (N, Decl);
+                Analyze (Decl);
+ 
+                Set_Access_Definition (Component_Definition (Comp), Empty);
+                Set_Subtype_Indication (Component_Definition (Comp),
+                   New_Occurrence_Of (Anon_Access, Loc));
+                Set_Ekind (Anon_Access, E_Anonymous_Access_Type);
+                Set_Is_Local_Anonymous_Access (Anon_Access);
+             end if;
+ 
+             Next (Comp);
+          end loop;
+ 
+          if Present (Variant_Part (Comp_List)) then
+             declare
+                V : Node_Id;
+             begin
+                V := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
+                while Present (V) loop
+                   Check_Anonymous_Access_Types (Component_List (V));
+                   Next_Non_Pragma (V);
+                end loop;
+             end;
+          end if;
+       end Check_Anonymous_Access_Types;
+ 
+       --------------------------------------
+       -- Make_Incomplete_Type_Declaration --
+       --------------------------------------
+ 
+       procedure Make_Incomplete_Type_Declaration is
+          Decl : Node_Id;
+          H    : Entity_Id;
+ 
+       begin
+          --  If there is a previous partial view, no need to create a new one
+ 
+          if Prev /= T then
+             return;
+ 
+          elsif No (Inc_T) then
+             Inc_T  := Make_Defining_Identifier (Loc, Chars (T));
+             Decl   := Make_Incomplete_Type_Declaration (Loc, Inc_T);
+ 
+             --  Type has already been inserted into the current scope.
+             --  Remove it, and add incomplete declaration for type, so
+             --  that subsequent anonymous access types can use it.
+ 
+             H := Current_Entity (T);
+ 
+             if H = T then
+                Set_Name_Entity_Id (Chars (T), Empty);
+             else
+                while Present (H)
+                  and then Homonym (H) /= T
+                loop
+                   H := Homonym (T);
+                end loop;
+ 
+                Set_Homonym (H, Homonym (T));
+             end if;
+ 
+             Insert_Before (N, Decl);
+             Analyze (Decl);
+             Set_Full_View (Inc_T, T);
+ 
+             if Tagged_Present (Def) then
+                Make_Class_Wide_Type (Inc_T);
+                Set_Class_Wide_Type (T, Class_Wide_Type (Inc_T));
+             end if;
+          end if;
+       end Make_Incomplete_Type_Declaration;
+ 
+    --  Start of processing for Record_Type_Declaration
+ 
+    begin
        --  These flags must be initialized before calling Process_Discriminants
        --  because this routine makes use of them.
  
!       Set_Ekind               (T, E_Record_Type);
!       Set_Etype               (T, T);
!       Init_Size_Align         (T);
!       Set_Abstract_Interfaces (T, No_Elist);
!       Set_Stored_Constraint   (T, No_Elist);
  
!       --  Normal case
  
!       if Ada_Version < Ada_05
!         or else not Interface_Present (Def)
!       then
!          --  The flag Is_Tagged_Type might have already been set by
!          --  Find_Type_Name if it detected an error for declaration T. This
!          --  arises in the case of private tagged types where the full view
!          --  omits the word tagged.
  
!          Is_Tagged :=
!            Tagged_Present (Def)
!              or else (Serious_Errors_Detected > 0 and then Is_Tagged_Type (T));
  
!          Set_Is_Tagged_Type      (T, Is_Tagged);
!          Set_Is_Limited_Record   (T, Limited_Present (Def));
! 
!          --  Type is abstract if full declaration carries keyword, or if
!          --  previous partial view did.
! 
!          Set_Is_Abstract         (T, Is_Abstract (T)
!                                       or else Abstract_Present (Def));
! 
!       else
!          Is_Tagged := True;
!          Analyze_Interface_Declaration (T, Def);
!       end if;
! 
!       --  First pass: if there are self-referential access components,
!       --  create the required anonymous access type declarations, and if
!       --  need be an incomplete type declaration for T itself.
! 
!       Check_Anonymous_Access_Types (Component_List (Def));
! 
!       if Ada_Version >= Ada_05
!         and then Present (Interface_List (Def))
!       then
!          declare
!             Iface     : Node_Id;
!             Iface_Def : Node_Id;
!             Iface_Typ : Entity_Id;
! 
!          begin
!             Iface := First (Interface_List (Def));
!             while Present (Iface) loop
!                Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
!                Iface_Def := Type_Definition (Parent (Iface_Typ));
! 
!                if not Is_Interface (Iface_Typ) then
!                   Error_Msg_NE ("(Ada 2005) & must be an interface",
!                                 Iface, Iface_Typ);
! 
!                else
!                   --  "The declaration of a specific descendant of an
!                   --  interface type freezes the interface type" RM 13.14
! 
!                   Freeze_Before (N, Iface_Typ);
! 
!                   --  Ada 2005 (AI-345): Protected interfaces can only
!                   --  inherit from limited, synchronized or protected
!                   --  interfaces.
! 
!                   if Protected_Present (Def) then
!                      if Limited_Present (Iface_Def)
!                        or else Synchronized_Present (Iface_Def)
!                        or else Protected_Present (Iface_Def)
!                      then
!                         null;
! 
!                      elsif Task_Present (Iface_Def) then
!                         Error_Msg_N ("(Ada 2005) protected interface cannot"
!                           & " inherit from task interface", Iface);
! 
!                      else
!                         Error_Msg_N ("(Ada 2005) protected interface cannot"
!                           & " inherit from non-limited interface", Iface);
!                      end if;
! 
!                   --  Ada 2005 (AI-345): Synchronized interfaces can only
!                   --  inherit from limited and synchronized.
! 
!                   elsif Synchronized_Present (Def) then
!                      if Limited_Present (Iface_Def)
!                        or else Synchronized_Present (Iface_Def)
!                      then
!                         null;
! 
!                      elsif Protected_Present (Iface_Def) then
!                         Error_Msg_N ("(Ada 2005) synchronized interface " &
!                           "cannot inherit from protected interface", Iface);
! 
!                      elsif Task_Present (Iface_Def) then
!                         Error_Msg_N ("(Ada 2005) synchronized interface " &
!                           "cannot inherit from task interface", Iface);
! 
!                      else
!                         Error_Msg_N ("(Ada 2005) synchronized interface " &
!                           "cannot inherit from non-limited interface",
!                           Iface);
!                      end if;
! 
!                   --  Ada 2005 (AI-345): Task interfaces can only inherit
!                   --  from limited, synchronized or task interfaces.
! 
!                   elsif Task_Present (Def) then
!                      if Limited_Present (Iface_Def)
!                        or else Synchronized_Present (Iface_Def)
!                        or else Task_Present (Iface_Def)
!                      then
!                         null;
! 
!                      elsif Protected_Present (Iface_Def) then
!                         Error_Msg_N ("(Ada 2005) task interface cannot" &
!                           " inherit from protected interface", Iface);
! 
!                      else
!                         Error_Msg_N ("(Ada 2005) task interface cannot" &
!                           " inherit from non-limited interface", Iface);
!                      end if;
!                   end if;
!                end if;
! 
!                Next (Iface);
!             end loop;
!             Set_Abstract_Interfaces (T, New_Elmt_List);
!             Collect_Interfaces (Def, T);
!          end;
!       end if;
! 
!       --  Records constitute a scope for the component declarations within.
!       --  The scope is created prior to the processing of these declarations.
!       --  Discriminants are processed first, so that they are visible when
!       --  processing the other components. The Ekind of the record type itself
!       --  is set to E_Record_Type (subtypes appear as E_Record_Subtype).
! 
!       --  Enter record scope
! 
!       New_Scope (T);
  
        --  If an incomplete or private type declaration was already given for
        --  the type, then this scope already exists, and the discriminants have
*************** package body Sem_Ch3 is
*** 12867,12877 ****
--- 14618,14634 ----
              Enter_Name (Tag_Comp);
  
              Set_Is_Tag                    (Tag_Comp);
+             Set_Is_Aliased                (Tag_Comp);
              Set_Ekind                     (Tag_Comp, E_Component);
              Set_Etype                     (Tag_Comp, RTE (RE_Tag));
              Set_DT_Entry_Count            (Tag_Comp, No_Uint);
              Set_Original_Record_Component (Tag_Comp, Tag_Comp);
              Init_Component_Location       (Tag_Comp);
+ 
+             --  Ada 2005 (AI-251): Addition of the Tag corresponding to all the
+             --  implemented interfaces
+ 
+             Add_Interface_Tag_Components (N, T);
           end if;
  
           Make_Class_Wide_Type (T);
*************** package body Sem_Ch3 is
*** 12895,12900 ****
--- 14652,14668 ----
        --  Exit from record scope
  
        End_Scope;
+ 
+       if Expander_Active
+         and then Is_Tagged
+         and then not Is_Empty_List (Interface_List (Def))
+       then
+          --  Ada 2005 (AI-251): Derive the interface subprograms of all the
+          --  implemented interfaces and check if some of the subprograms
+          --  inherited from the ancestor cover some interface subprogram.
+ 
+          Derive_Interface_Subprograms (T);
+       end if;
     end Record_Type_Declaration;
  
     ----------------------------
*************** package body Sem_Ch3 is
*** 13000,13006 ****
        begin
           if Nkind (N) = N_Discriminant_Specification then
              Comp := First_Discriminant (Typ);
- 
              while Present (Comp) loop
                 if Chars (Comp) = Chars (Defining_Identifier (N)) then
                    Set_Defining_Identifier (N, Comp);
--- 14768,14773 ----
*************** package body Sem_Ch3 is
*** 13012,13018 ****
  
           elsif Nkind (N) = N_Component_Declaration then
              Comp := First_Component (Typ);
- 
              while Present (Comp) loop
                 if Chars (Comp) = Chars (Defining_Identifier (N)) then
                    Set_Defining_Identifier (N, Comp);
--- 14779,14784 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch3.ads gcc-4.1.0/gcc/ada/sem_ch3.ads
*** gcc-4.0.2/gcc/ada/sem_ch3.ads	Mon Jun  7 14:16:26 2004
--- gcc-4.1.0/gcc/ada/sem_ch3.ads	Tue Nov 15 14:02:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Ch3  is
*** 62,67 ****
--- 62,70 ----
     --  Called to analyze a list of declarations (in what context ???). Also
     --  performs necessary freezing actions (more description needed ???)
  
+    procedure Analyze_Interface_Declaration (T : Entity_Id; Def : Node_Id);
+    --  Analyze an interface declaration or a formal interface declaration
+ 
     procedure Analyze_Per_Use_Expression (N : Node_Id; T : Entity_Id);
     --  Default and per object expressions do not freeze their components,
     --  and must be analyzed and resolved accordingly. The analysis is
*************** package Sem_Ch3  is
*** 97,108 ****
     --  rather than on the declarations that require completion in the package
     --  declaration.
  
     procedure Derive_Subprogram
!      (New_Subp       : in out Entity_Id;
!       Parent_Subp    : Entity_Id;
!       Derived_Type   : Entity_Id;
!       Parent_Type    : Entity_Id;
!       Actual_Subp    : Entity_Id := Empty);
     --  Derive the subprogram Parent_Subp from Parent_Type, and replace the
     --  subsidiary subtypes with the derived type to build the specification
     --  of the inherited subprogram (returned in New_Subp). For tagged types,
--- 100,120 ----
     --  rather than on the declarations that require completion in the package
     --  declaration.
  
+    procedure Collect_Interfaces
+      (N            : Node_Id;
+       Derived_Type : Entity_Id);
+    --  Ada 2005 (AI-251): Subsidiary procedure to Build_Derived_Record_Type
+    --  and Analyze_Formal_Interface_Type.
+    --  Collect the list of interfaces that are not already implemented by the
+    --  ancestors. This is the list of interfaces for which we must provide
+    --  additional tag components.
+ 
     procedure Derive_Subprogram
!      (New_Subp     : in out Entity_Id;
!       Parent_Subp  : Entity_Id;
!       Derived_Type : Entity_Id;
!       Parent_Type  : Entity_Id;
!       Actual_Subp  : Entity_Id := Empty);
     --  Derive the subprogram Parent_Subp from Parent_Type, and replace the
     --  subsidiary subtypes with the derived type to build the specification
     --  of the inherited subprogram (returned in New_Subp). For tagged types,
*************** package Sem_Ch3  is
*** 111,126 ****
     --  subprogram of the parent type.
  
     procedure Derive_Subprograms
!      (Parent_Type    : Entity_Id;
!       Derived_Type   : Entity_Id;
!       Generic_Actual : Entity_Id := Empty);
!    --  To complete type derivation, collect or retrieve the primitive
!    --  operations of the parent type, and replace the subsidiary subtypes
!    --  with the derived type, to build the specs of the inherited ops.
!    --  For generic actuals, the mapping of the primitive operations to those
!    --  of the parent type is also done by rederiving the operations within
!    --  the instance. For tagged types, the derived subprograms are aliased to
!    --  those of the actual, not those of the ancestor.
  
     function Find_Type_Name (N : Node_Id) return Entity_Id;
     --  Enter the identifier in a type definition, or find the entity already
--- 123,148 ----
     --  subprogram of the parent type.
  
     procedure Derive_Subprograms
!      (Parent_Type           : Entity_Id;
!       Derived_Type          : Entity_Id;
!       Generic_Actual        : Entity_Id := Empty;
!       No_Predefined_Prims   : Boolean   := False);
!    --  To complete type derivation, collect/retrieve the primitive operations
!    --  of the parent type, and replace the subsidiary subtypes with the derived
!    --  type, to build the specs of the inherited ops. For generic actuals, the
!    --  mapping of the primitive operations to those of the parent type is also
!    --  done by rederiving the operations within the instance. For tagged types,
!    --  the derived subprograms are aliased to those of the actual, not those of
!    --  the ancestor. The last two params are used in case of derivation from
!    --  abstract interface types: No_Predefined_Prims is used to avoid the
!    --  derivation of predefined primitives from an abstract interface.
!    --
!    --  Note: one might expect this to be private to the package body, but
!    --  there is one rather unusual usage in package Exp_Dist.
! 
!    function Find_Type_Of_Subtype_Indic (S : Node_Id) return Entity_Id;
!    --  Given a subtype indication S (which is really an N_Subtype_Indication
!    --  node or a plain N_Identifier), find the type of the subtype mark.
  
     function Find_Type_Name (N : Node_Id) return Entity_Id;
     --  Enter the identifier in a type definition, or find the entity already
*************** package Sem_Ch3  is
*** 209,220 ****
     function Replace_Anonymous_Access_To_Protected_Subprogram
       (N      : Node_Id;
        Prev_E : Entity_Id) return Entity_Id;
!    --  Ada 2005 (AI-254): Create and decorate an internal full type
!    --  declaration in the enclosing scope corresponding to an anonymous
!    --  access to protected subprogram. In addition, replace the anonymous
!    --  access by an occurrence of this internal type. Prev_Etype is used
!    --  to link the new internal entity with the anonymous entity. Return
!    --  the entity of this type declaration.
  
     procedure Set_Completion_Referenced (E : Entity_Id);
     --  If E is the completion of a private or incomplete  type declaration,
--- 231,242 ----
     function Replace_Anonymous_Access_To_Protected_Subprogram
       (N      : Node_Id;
        Prev_E : Entity_Id) return Entity_Id;
!    --  Ada 2005 (AI-254): Create and decorate an internal full type declaration
!    --  in the enclosing scope corresponding to an anonymous access to protected
!    --  subprogram. In addition, replace the anonymous access by an occurrence
!    --  of this internal type. Prev_Etype is used to link the new internal
!    --  entity with the anonymous entity. Return the entity of this type
!    --  declaration.
  
     procedure Set_Completion_Referenced (E : Entity_Id);
     --  If E is the completion of a private or incomplete  type declaration,
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch4.adb gcc-4.1.0/gcc/ada/sem_ch4.adb
*** gcc-4.0.2/gcc/ada/sem_ch4.adb	Thu Feb 10 13:55:59 2005
--- gcc-4.1.0/gcc/ada/sem_ch4.adb	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,31 ****
  ------------------------------------------------------------------------------
  
  with Atree;    use Atree;
- with Checks;   use Checks;
  with Debug;    use Debug;
  with Einfo;    use Einfo;
  with Elists;   use Elists;
--- 25,30 ----
*************** package body Sem_Ch4 is
*** 97,106 ****
     --  arguments, list possible interpretations.
  
     procedure Analyze_One_Call
!       (N       : Node_Id;
!        Nam     : Entity_Id;
!        Report  : Boolean;
!        Success : out Boolean);
     --  Check one interpretation of an overloaded subprogram name for
     --  compatibility with the types of the actuals in a call. If there is a
     --  single interpretation which does not match, post error if Report is
--- 96,106 ----
     --  arguments, list possible interpretations.
  
     procedure Analyze_One_Call
!       (N          : Node_Id;
!        Nam        : Entity_Id;
!        Report     : Boolean;
!        Success    : out Boolean;
!        Skip_First : Boolean := False);
     --  Check one interpretation of an overloaded subprogram name for
     --  compatibility with the types of the actuals in a call. If there is a
     --  single interpretation which does not match, post error if Report is
*************** package body Sem_Ch4 is
*** 111,116 ****
--- 111,123 ----
     --  subprogram type constructed for an access_to_subprogram. If the actuals
     --  are compatible with Nam, then Nam is added to the list of candidate
     --  interpretations for N, and Success is set to True.
+    --
+    --  The flag Skip_First is used when analyzing a call that was rewritten
+    --  from object notation. In this case the first actual may have to receive
+    --  an explicit dereference, depending on the first formal of the operation
+    --  being called. The caller will have verified that the object is legal
+    --  for the call. If the remaining parameters match, the first parameter
+    --  will rewritten as a dereference if needed, prior to completing analysis.
  
     procedure Check_Misspelled_Selector
       (Prefix : Entity_Id;
*************** package body Sem_Ch4 is
*** 216,223 ****
       (E : Entity_Id;
        P : Node_Id);
     --  Called when P is the prefix of an implicit dereference, denoting an
!    --  object E. If in semantics only mode (-gnatc), record that is a
!    --  reference to E. Normally, such a reference is generated only when the
     --  implicit dereference is expanded into an explicit one. E may be empty,
     --  in which case this procedure does nothing.
  
--- 223,230 ----
       (E : Entity_Id;
        P : Node_Id);
     --  Called when P is the prefix of an implicit dereference, denoting an
!    --  object E. If in semantics only mode (-gnatc or generic), record that is
!    --  a reference to E. Normally, such a reference is generated only when the
     --  implicit dereference is expanded into an explicit one. E may be empty,
     --  in which case this procedure does nothing.
  
*************** package body Sem_Ch4 is
*** 390,396 ****
  
        else
           declare
!             Def_Id : Entity_Id;
  
           begin
              --  If the allocator includes a N_Subtype_Indication then a
--- 397,404 ----
  
        else
           declare
!             Def_Id   : Entity_Id;
!             Base_Typ : Entity_Id;
  
           begin
              --  If the allocator includes a N_Subtype_Indication then a
*************** package body Sem_Ch4 is
*** 410,419 ****
                 --  access-to-composite type, but the constraint is ignored.
  
                 Find_Type (Subtype_Mark (E));
  
!                if Is_Elementary_Type (Entity (Subtype_Mark (E))) then
                    if not (Ada_Version = Ada_83
!                            and then Is_Access_Type (Entity (Subtype_Mark (E))))
                    then
                       Error_Msg_N ("constraint not allowed here", E);
  
--- 418,428 ----
                 --  access-to-composite type, but the constraint is ignored.
  
                 Find_Type (Subtype_Mark (E));
+                Base_Typ := Entity (Subtype_Mark (E));
  
!                if Is_Elementary_Type (Base_Typ) then
                    if not (Ada_Version = Ada_83
!                            and then Is_Access_Type (Base_Typ))
                    then
                       Error_Msg_N ("constraint not allowed here", E);
  
*************** package body Sem_Ch4 is
*** 431,436 ****
--- 440,456 ----
                    Rewrite (E, New_Copy_Tree (Subtype_Mark (E)));
                    Analyze_Allocator (N);
                    return;
+ 
+                --  Ada 2005, AI-363: if the designated type has a constrained
+                --  partial view, it cannot receive a discriminant constraint,
+                --  and the allocated object is unconstrained.
+ 
+                elsif Ada_Version >= Ada_05
+                  and then Has_Constrained_Partial_View (Base_Typ)
+                then
+                   Error_Msg_N
+                     ("constraint no allowed when type " &
+                       "has a constrained partial view", Constraint (E));
                 end if;
  
                 if Expander_Active then
*************** package body Sem_Ch4 is
*** 525,539 ****
           Check_Restriction (No_Local_Allocators, N);
        end if;
  
-       --  Ada 2005 (AI-231): Static checks
- 
-       if Ada_Version >= Ada_05
-         and then (Null_Exclusion_Present (N)
-                     or else Can_Never_Be_Null (Etype (N)))
-       then
-          Null_Exclusion_Static_Checks (N);
-       end if;
- 
        if Serious_Errors_Detected > Sav_Errs then
           Set_Error_Posted (N);
           Set_Etype (N, Any_Type);
--- 545,550 ----
*************** package body Sem_Ch4 is
*** 670,678 ****
           if Ekind (Etype (Nam)) = E_Subprogram_Type then
              Nam_Ent := Etype (Nam);
  
           elsif Is_Access_Type (Etype (Nam))
             and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
!            and then not Name_Denotes_Function
           then
              Nam_Ent := Designated_Type (Etype (Nam));
              Insert_Explicit_Dereference (Nam);
--- 681,698 ----
           if Ekind (Etype (Nam)) = E_Subprogram_Type then
              Nam_Ent := Etype (Nam);
  
+          --  If the prefix is an access_to_subprogram, this may be an indirect
+          --  call. This is the case if the name in the call is not an entity
+          --  name, or if it is a function name in the context of a procedure
+          --  call. In this latter case, we have a call to a parameterless
+          --  function that returns a pointer_to_procedure which is the entity
+          --  being called.
+ 
           elsif Is_Access_Type (Etype (Nam))
             and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
!            and then
!              (not Name_Denotes_Function
!                 or else Nkind (N) = N_Procedure_Call_Statement)
           then
              Nam_Ent := Designated_Type (Etype (Nam));
              Insert_Explicit_Dereference (Nam);
*************** package body Sem_Ch4 is
*** 758,763 ****
--- 778,797 ----
  
           Analyze_One_Call (N, Nam_Ent, True, Success);
  
+          --  If this is an indirect call, the return type of the access_to
+          --  subprogram may be an incomplete type. At the point of the call,
+          --  use the full type if available, and at the same time update
+          --  the return type of the access_to_subprogram.
+ 
+          if Success
+            and then  Nkind (Nam) = N_Explicit_Dereference
+            and then Ekind (Etype (N)) = E_Incomplete_Type
+            and then Present (Full_View (Etype (N)))
+          then
+             Set_Etype (N, Full_View (Etype (N)));
+             Set_Etype (Nam_Ent, Etype (N));
+          end if;
+ 
        else
           --  An overloaded selected component must denote overloaded
           --  operations of a concurrent type. The interpretations are
*************** package body Sem_Ch4 is
*** 1015,1024 ****
           end if;
  
        else
!          Op_Id  := Get_Name_Entity_Id (Name_Op_Concat);
           while Present (Op_Id) loop
              if Ekind (Op_Id) = E_Operator then
!                Find_Concatenation_Types (L, R, Op_Id, N);
              else
                 Analyze_User_Defined_Binary_Op (N, Op_Id);
              end if;
--- 1049,1067 ----
           end if;
  
        else
!          Op_Id := Get_Name_Entity_Id (Name_Op_Concat);
           while Present (Op_Id) loop
              if Ekind (Op_Id) = E_Operator then
! 
!                --  Do not consider operators declared in dead code, they can
!                --  not be part of the resolution.
! 
!                if Is_Eliminated (Op_Id) then
!                   null;
!                else
!                   Find_Concatenation_Types (L, R, Op_Id, N);
!                end if;
! 
              else
                 Analyze_User_Defined_Binary_Op (N, Op_Id);
              end if;
*************** package body Sem_Ch4 is
*** 1113,1121 ****
          and then Nkind (N) = N_Op_Ne
        then
           Op_Id := Get_Name_Entity_Id (Name_Op_Eq);
- 
           while Present (Op_Id) loop
- 
              if Ekind (Op_Id) = E_Operator then
                 Find_Equality_Types (L, R, Op_Id, N);
              else
--- 1156,1162 ----
*************** package body Sem_Ch4 is
*** 1173,1179 ****
  
           else
              Get_First_Interp (N, I, It);
- 
              while Present (It.Nam) loop
                 if Ekind (Base_Type (It.Typ)) /= E_Subprogram_Type
                   or else Etype (Base_Type (It.Typ)) = Standard_Void_Type
--- 1214,1219 ----
*************** package body Sem_Ch4 is
*** 1188,1194 ****
           end if;
        end Is_Function_Type;
  
!    --  Start of processing for Analyze_Explicit_Deference
  
     begin
        Analyze (P);
--- 1228,1234 ----
           end if;
        end Is_Function_Type;
  
!    --  Start of processing for Analyze_Explicit_Dereference
  
     begin
        Analyze (P);
*************** package body Sem_Ch4 is
*** 1231,1237 ****
  
        else
           Get_First_Interp (P, I, It);
- 
           while Present (It.Nam) loop
              T := It.Typ;
  
--- 1271,1276 ----
*************** package body Sem_Ch4 is
*** 1242,1249 ****
              Get_Next_Interp (I, It);
           end loop;
  
-          End_Interp_List;
- 
           --  Error if no interpretation of the prefix has an access type
  
           if Etype (N) = Any_Type then
--- 1281,1286 ----
*************** package body Sem_Ch4 is
*** 1272,1281 ****
        then
           --  Name is a function call with no actuals, in a context that
           --  requires deproceduring (including as an actual in an enclosing
!          --  function or procedure call). We can conceive of pathological cases
           --  where the prefix might include functions that return access to
           --  subprograms and others that return a regular type. Disambiguation
!          --  of those will have to take place in Resolve. See e.g. 7117-014.
  
           New_N :=
             Make_Function_Call (Loc,
--- 1309,1319 ----
        then
           --  Name is a function call with no actuals, in a context that
           --  requires deproceduring (including as an actual in an enclosing
!          --  function or procedure call). There are some pathological cases
           --  where the prefix might include functions that return access to
           --  subprograms and others that return a regular type. Disambiguation
!          --  of those has to take place in Resolve.
!          --  See e.g. 7117-014 and E317-001.
  
           New_N :=
             Make_Function_Call (Loc,
*************** package body Sem_Ch4 is
*** 1302,1307 ****
--- 1340,1364 ----
  
           Rewrite (N, New_N);
           Analyze (N);
+ 
+       elsif not Is_Function_Type
+         and then Is_Overloaded (N)
+       then
+          --  The prefix may include access to subprograms and other access
+          --  types. If the context selects the interpretation that is a call,
+          --  we cannot rewrite the node yet, but we include the result of
+          --  the call interpretation.
+ 
+          Get_First_Interp (N, I, It);
+          while Present (It.Nam) loop
+             if Ekind (Base_Type (It.Typ)) = E_Subprogram_Type
+                and then Etype (Base_Type (It.Typ)) /= Standard_Void_Type
+             then
+                Add_One_Interp (N, Etype (It.Typ), Etype (It.Typ));
+             end if;
+ 
+             Get_Next_Interp (I, It);
+          end loop;
        end if;
  
        --  A value of remote access-to-class-wide must not be dereferenced
*************** package body Sem_Ch4 is
*** 1461,1467 ****
              end if;
  
              Index := First_Index (Array_Type);
- 
              while Present (Index) and then Present (Exp) loop
                 if not Has_Compatible_Type (Exp, Etype (Index)) then
                    Wrong_Type (Exp, Etype (Index));
--- 1518,1523 ----
*************** package body Sem_Ch4 is
*** 1710,1716 ****
  
        else
           Op_Id := Get_Name_Entity_Id (Chars (N));
- 
           while Present (Op_Id) loop
              if Ekind (Op_Id) = E_Operator then
                 Find_Boolean_Types (L, R, Op_Id, N);
--- 1766,1771 ----
*************** package body Sem_Ch4 is
*** 1793,1799 ****
  
           else
              Get_First_Interp (L, Index, It);
- 
              while Present (It.Typ) loop
                 Try_One_Interp (It.Typ);
                 Get_Next_Interp (Index, It);
--- 1848,1853 ----
*************** package body Sem_Ch4 is
*** 1869,1878 ****
     ----------------------
  
     procedure Analyze_One_Call
!       (N       : Node_Id;
!        Nam     : Entity_Id;
!        Report  : Boolean;
!        Success : out Boolean)
     is
        Actuals    : constant List_Id   := Parameter_Associations (N);
        Prev_T     : constant Entity_Id := Etype (N);
--- 1923,1933 ----
     ----------------------
  
     procedure Analyze_One_Call
!       (N          : Node_Id;
!        Nam        : Entity_Id;
!        Report     : Boolean;
!        Success    : out Boolean;
!        Skip_First : Boolean := False)
     is
        Actuals    : constant List_Id   := Parameter_Associations (N);
        Prev_T     : constant Entity_Id := Etype (N);
*************** package body Sem_Ch4 is
*** 1942,1947 ****
--- 1997,2005 ----
              Is_Indexed :=
                Try_Indexed_Call (N, Nam, Designated_Type (Subp_Type));
  
+          --  The prefix can also be a parameterless function that returns an
+          --  access to subprogram. in which case this is an indirect call.
+ 
           elsif Is_Access_Type (Subp_Type)
             and then Ekind (Designated_Type (Subp_Type))  = E_Subprogram_Type
           then
*************** package body Sem_Ch4 is
*** 2052,2057 ****
--- 2110,2125 ----
  
           Actual := First_Actual (N);
           Formal := First_Formal (Nam);
+ 
+          --  If we are analyzing a call rewritten from object notation,
+          --  skip first actual, which may be rewritten later as an
+          --  explicit dereference.
+ 
+          if Skip_First then
+             Next_Actual (Actual);
+             Next_Formal (Formal);
+          end if;
+ 
           while Present (Actual) and then Present (Formal) loop
              if Nkind (Parent (Actual)) /= N_Parameter_Association
                or else Chars (Selector_Name (Parent (Actual))) = Chars (Formal)
*************** package body Sem_Ch4 is
*** 2072,2086 ****
                    end if;
  
                    if Report and not Is_Indexed then
                       Wrong_Type (Actual, Etype (Formal));
  
                       if Nkind (Actual) = N_Op_Eq
                         and then Nkind (Left_Opnd (Actual)) = N_Identifier
                       then
                          Formal := First_Formal (Nam);
- 
                          while Present (Formal) loop
- 
                             if Chars (Left_Opnd (Actual)) = Chars (Formal) then
                                Error_Msg_N
                                  ("possible misspelling of `='>`!", Actual);
--- 2140,2167 ----
                    end if;
  
                    if Report and not Is_Indexed then
+ 
+                      --  Ada 2005 (AI-251): Complete the error notification
+                      --  to help new Ada 2005 users
+ 
+                      if Is_Class_Wide_Type (Etype (Formal))
+                        and then Is_Interface (Etype (Etype (Formal)))
+                        and then not Interface_Present_In_Ancestor
+                                       (Typ   => Etype (Actual),
+                                        Iface => Etype (Etype (Formal)))
+                      then
+                         Error_Msg_NE
+                           ("(Ada 2005) does not implement interface }",
+                            Actual, Etype (Etype (Formal)));
+                      end if;
+ 
                       Wrong_Type (Actual, Etype (Formal));
  
                       if Nkind (Actual) = N_Op_Eq
                         and then Nkind (Left_Opnd (Actual)) = N_Identifier
                       then
                          Formal := First_Formal (Nam);
                          while Present (Formal) loop
                             if Chars (Left_Opnd (Actual)) = Chars (Formal) then
                                Error_Msg_N
                                  ("possible misspelling of `='>`!", Actual);
*************** package body Sem_Ch4 is
*** 2488,2504 ****
           return;
  
        else
-          --  Function calls that are prefixes of selected components must be
-          --  fully resolved in case we need to build an actual subtype, or
-          --  do some other operation requiring a fully resolved prefix.
- 
-          --  Note: Resolving all Nkinds of nodes here doesn't work.
-          --  (Breaks 2129-008) ???.
- 
-          if Nkind (Name) = N_Function_Call then
-             Resolve (Name);
-          end if;
- 
           Prefix_Type := Etype (Name);
        end if;
  
--- 2569,2574 ----
*************** package body Sem_Ch4 is
*** 2610,2615 ****
--- 2680,2704 ----
  
                 Resolve (Name);
  
+                --  Ada 2005 (AI-50217): Check wrong use of incomplete type.
+                --  Example:
+ 
+                --    limited with Pkg;
+                --    package Pkg is
+                --       type Acc_Inc is access Pkg.T;
+                --       X : Acc_Inc;
+                --       N : Natural := X.all.Comp; -- ERROR
+                --    end Pkg;
+ 
+                if Nkind (Name) = N_Explicit_Dereference
+                  and then From_With_Type (Etype (Prefix (Name)))
+                  and then not Is_Potentially_Use_Visible (Etype (Name))
+                then
+                   Error_Msg_NE
+                     ("premature usage of incomplete}", Prefix (Name),
+                      Etype (Prefix (Name)));
+                end if;
+ 
                 --  We never need an actual subtype for the case of a selection
                 --  for a indexed component of a non-packed array, since in
                 --  this case gigi generates all the checks and can find the
*************** package body Sem_Ch4 is
*** 2643,2656 ****
                 then
                    Set_Etype (N, Etype (Comp));
  
!                --  In all other cases, we currently build an actual subtype. It
!                --  seems likely that many of these cases can be avoided, but
!                --  right now, the front end makes direct references to the
                 --  bounds (e.g. in generating a length check), and if we do
                 --  not make an actual subtype, we end up getting a direct
!                --  reference to a discriminant which will not do.
  
!                else
                    Act_Decl :=
                      Build_Actual_Subtype_Of_Component (Etype (Comp), N);
                    Insert_Action (N, Act_Decl);
--- 2732,2751 ----
                 then
                    Set_Etype (N, Etype (Comp));
  
!                --  If full analysis is not enabled, we do not generate an
!                --  actual subtype, because in the absence of expansion
!                --  reference to a formal of a protected type, for example,
!                --  will not be properly transformed, and will lead to
!                --  out-of-scope references in gigi.
! 
!                --  In all other cases, we currently build an actual subtype.
!                --  It seems likely that many of these cases can be avoided,
!                --  but right now, the front end makes direct references to the
                 --  bounds (e.g. in generating a length check), and if we do
                 --  not make an actual subtype, we end up getting a direct
!                --  reference to a discriminant, which will not do.
  
!                elsif Full_Analysis then
                    Act_Decl :=
                      Build_Actual_Subtype_Of_Component (Etype (Comp), N);
                    Insert_Action (N, Act_Decl);
*************** package body Sem_Ch4 is
*** 2672,2677 ****
--- 2767,2777 ----
                          Set_Etype (N, Subt);
                       end;
                    end if;
+ 
+                --  If Full_Analysis not enabled, just set the Etype
+ 
+                else
+                   Set_Etype (N, Etype (Comp));
                 end if;
  
                 return;
*************** package body Sem_Ch4 is
*** 2688,2704 ****
           then
              return;
  
!             --  If the transformation fails, it will be necessary
!             --  to redo the analysis with all errors enabled, to indicate
!             --  candidate interpretations and reasons for each failure ???
  
           end if;
  
        elsif Is_Private_Type (Prefix_Type) then
  
!          --  Allow access only to discriminants of the type. If the
!          --  type has no full view, gigi uses the parent type for
!          --  the components, so we do the same here.
  
           if No (Full_View (Prefix_Type)) then
              Entity_List := Root_Type (Base_Type (Prefix_Type));
--- 2788,2804 ----
           then
              return;
  
!             --  If the transformation fails, it will be necessary to redo the
!             --  analysis with all errors enabled, to indicate candidate
!             --  interpretations and reasons for each failure ???
  
           end if;
  
        elsif Is_Private_Type (Prefix_Type) then
  
!          --  Allow access only to discriminants of the type. If the type has
!          --  no full view, gigi uses the parent type for the components, so we
!          --  do the same here.
  
           if No (Full_View (Prefix_Type)) then
              Entity_List := Root_Type (Base_Type (Prefix_Type));
*************** package body Sem_Ch4 is
*** 2738,2748 ****
        elsif Is_Concurrent_Type (Prefix_Type) then
  
           --  Prefix is concurrent type. Find visible operation with given name
!          --  For a task, this can only include entries or discriminants if
!          --  the task type is not an enclosing scope. If it is an enclosing
!          --  scope (e.g. in an inner task) then all entities are visible, but
!          --  the prefix must denote the enclosing scope, i.e. can only be
!          --  a direct name or an expanded name.
  
           Set_Etype (Sel,  Any_Type);
           In_Scope := In_Open_Scopes (Prefix_Type);
--- 2838,2848 ----
        elsif Is_Concurrent_Type (Prefix_Type) then
  
           --  Prefix is concurrent type. Find visible operation with given name
!          --  For a task, this can only include entries or discriminants if the
!          --  task type is not an enclosing scope. If it is an enclosing scope
!          --  (e.g. in an inner task) then all entities are visible, but the
!          --  prefix must denote the enclosing scope, i.e. can only be a direct
!          --  name or an expanded name.
  
           Set_Etype (Sel,  Any_Type);
           In_Scope := In_Open_Scopes (Prefix_Type);
*************** package body Sem_Ch4 is
*** 2771,2778 ****
                    Set_Original_Discriminant (Sel, Comp);
                 end if;
  
!                --  For access type case, introduce explicit deference for
!                --  more uniform treatment of entry calls.
  
                 if Is_Access_Type (Etype (Name)) then
                    Insert_Explicit_Dereference (Name);
--- 2871,2878 ----
                    Set_Original_Discriminant (Sel, Comp);
                 end if;
  
!                --  For access type case, introduce explicit deference for more
!                --  uniform treatment of entry calls.
  
                 if Is_Access_Type (Etype (Name)) then
                    Insert_Explicit_Dereference (Name);
*************** package body Sem_Ch4 is
*** 2800,2807 ****
  
        if Etype (N) = Any_Type then
  
!          --  If the prefix is a single concurrent object, use its name in
!          --  the error message, rather than that of its anonymous type.
  
           if Is_Concurrent_Type (Prefix_Type)
             and then Is_Internal_Name (Chars (Prefix_Type))
--- 2900,2907 ----
  
        if Etype (N) = Any_Type then
  
!          --  If the prefix is a single concurrent object, use its name in the
!          --  error message, rather than that of its anonymous type.
  
           if Is_Concurrent_Type (Prefix_Type)
             and then Is_Internal_Name (Chars (Prefix_Type))
*************** package body Sem_Ch4 is
*** 2819,2825 ****
             and then Prefix_Type /= Etype (Prefix_Type)
             and then Is_Record_Type (Etype (Prefix_Type))
           then
!             --  If this is a derived formal type, the parent may have a
              --  different visibility at this point. Try for an inherited
              --  component before reporting an error.
  
--- 2919,2925 ----
             and then Prefix_Type /= Etype (Prefix_Type)
             and then Is_Record_Type (Etype (Prefix_Type))
           then
!             --  If this is a derived formal type, the parent may have
              --  different visibility at this point. Try for an inherited
              --  component before reporting an error.
  
*************** package body Sem_Ch4 is
*** 2928,2934 ****
  
        else
           Get_First_Interp (L, Ind, It);
- 
           while Present (It.Typ) loop
              if Root_Type (It.Typ) = Standard_Boolean
                and then Has_Compatible_Type (R, It.Typ)
--- 3028,3033 ----
*************** package body Sem_Ch4 is
*** 3679,3685 ****
  
        else
           Get_First_Interp (L, Index1, It1);
- 
           while Present (It1.Typ) loop
              Check_Right_Argument (It1.Typ);
              Get_Next_Interp (Index1, It1);
--- 3778,3783 ----
*************** package body Sem_Ch4 is
*** 4172,4178 ****
           return False;
        end if;
  
!       --  Now test the entity we got to see if it a bad case
  
        case Ekind (Entity (Enode)) is
  
--- 4270,4276 ----
           return False;
        end if;
  
!       --  Now test the entity we got to see if it is a bad case
  
        case Ekind (Entity (Enode)) is
  
*************** package body Sem_Ch4 is
*** 4237,4243 ****
              end if;
  
              --  If either operand has no type, then don't complain further,
!             --  since this simply means that we have a propragated error.
  
              if R = Error
                or else Etype (R) = Any_Type
--- 4335,4341 ----
              end if;
  
              --  If either operand has no type, then don't complain further,
!             --  since this simply means that we have a propagated error.
  
              if R = Error
                or else Etype (R) = Any_Type
*************** package body Sem_Ch4 is
*** 4422,4429 ****
        Ref : Node_Id;
  
     begin
!       if Operating_Mode = Check_Semantics and then Present (E) then
! 
           --  We create a dummy reference to E to ensure that the reference
           --  is not considered as part of an assignment (an implicit
           --  dereference can never assign to its prefix). The Comes_From_Source
--- 4520,4528 ----
        Ref : Node_Id;
  
     begin
!       if Present (E)
!         and then (Operating_Mode = Check_Semantics or else not Expander_Active)
!       then
           --  We create a dummy reference to E to ensure that the reference
           --  is not considered as part of an assignment (an implicit
           --  dereference can never assign to its prefix). The Comes_From_Source
*************** package body Sem_Ch4 is
*** 4559,4565 ****
                       --  select the predefined operator and discard others.
  
                       Get_First_Interp (N, I, It);
- 
                       while Present (It.Nam) loop
                          if Scope (It.Nam) = Standard_Standard then
                             Set_Etype (N, Univ_Type);
--- 4658,4663 ----
*************** package body Sem_Ch4 is
*** 4648,4659 ****
  
     begin
        Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK);
        Actual := First_Actual (N);
        Formal := First_Formal (Designated_Type (Typ));
! 
!       while Present (Actual)
!         and then Present (Formal)
!       loop
           if not Has_Compatible_Type (Actual, Etype (Formal)) then
              return False;
           end if;
--- 4746,4755 ----
  
     begin
        Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK);
+ 
        Actual := First_Actual (N);
        Formal := First_Formal (Designated_Type (Typ));
!       while Present (Actual) and then Present (Formal) loop
           if not Has_Compatible_Type (Actual, Etype (Formal)) then
              return False;
           end if;
*************** package body Sem_Ch4 is
*** 4696,4704 ****
     begin
        Actual := First (Actuals);
        Index := First_Index (Typ);
!       while Present (Actual)
!         and then Present (Index)
!       loop
           --  If the parameter list has a named association, the expression
           --  is definitely a call and not an indexed component.
  
--- 4792,4799 ----
     begin
        Actual := First (Actuals);
        Index := First_Index (Typ);
!       while Present (Actual) and then Present (Index) loop
! 
           --  If the parameter list has a named association, the expression
           --  is definitely a call and not an indexed component.
  
*************** package body Sem_Ch4 is
*** 4745,4753 ****
        Subprog         : constant Node_Id    := Selector_Name (N);
  
        Actual          : Node_Id;
!       Call_Node       : Node_Id;
!       Call_Node_Case  : Node_Id := Empty;
!       First_Actual    : Node_Id;
        Node_To_Replace : Node_Id;
        Obj_Type        : Entity_Id := Etype (Obj);
  
--- 4840,4846 ----
        Subprog         : constant Node_Id    := Selector_Name (N);
  
        Actual          : Node_Id;
!       New_Call_Node  :  Node_Id := Empty;
        Node_To_Replace : Node_Id;
        Obj_Type        : Entity_Id := Etype (Obj);
  
*************** package body Sem_Ch4 is
*** 4755,4785 ****
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id;
           Subprog         : Node_Id);
!       --  Set Subprog as the name of Call_Node, replace Node_To_Replace with
!       --  Call_Node and reanalyze Node_To_Replace.
  
        procedure Transform_Object_Operation
          (Call_Node       : out Node_Id;
-          First_Actual    : Node_Id;
           Node_To_Replace : out Node_Id;
           Subprog         : Node_Id);
!       --  Transform Object.Operation (...) to Operation (Object, ...)
!       --  Call_Node is the resulting subprogram call node, First_Actual is
!       --  either the object Obj or an explicit dereference of Obj in certain
!       --  cases, Node_To_Replace is either N or the parent of N, and Subprog
!       --  is the subprogram we are trying to match.
  
        function Try_Class_Wide_Operation
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean;
!       --  Traverse all the ancestor types looking for a class-wide subprogram
!       --  that matches Subprog.
  
        function Try_Primitive_Operation
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean;
!       --  Traverse the list of primitive subprograms looking for a subprogram
!       --  than matches Subprog.
  
        -------------------------------
        -- Complete_Object_Operation --
--- 4848,4877 ----
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id;
           Subprog         : Node_Id);
!       --  Make Subprog the name of Call_Node, replace Node_To_Replace with
!       --  Call_Node, insert the object (or its dereference) as the first actual
!       --  in the call, and complete the analysis of the call.
  
        procedure Transform_Object_Operation
          (Call_Node       : out Node_Id;
           Node_To_Replace : out Node_Id;
           Subprog         : Node_Id);
!       --  Transform Obj.Operation (X, Y,,) into Operation (Obj, X, Y ..)
!       --  Call_Node is the resulting subprogram call,
!       --  Node_To_Replace is either N or the parent of N, and Subprog
!       --  is a reference to the subprogram we are trying to match.
  
        function Try_Class_Wide_Operation
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean;
!       --  Traverse all ancestor types looking for a class-wide subprogram
!       --  for which the current operation is a valid non-dispatching call.
  
        function Try_Primitive_Operation
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean;
!       --  Traverse the list of primitive subprograms looking for a dispatching
!       --  operation for which the current node is a valid call .
  
        -------------------------------
        -- Complete_Object_Operation --
*************** package body Sem_Ch4 is
*** 4790,4801 ****
           Node_To_Replace : Node_Id;
           Subprog         : Node_Id)
        is
        begin
!          Set_Name (Call_Node, New_Copy_Tree (Subprog));
!          Set_Analyzed (Call_Node, False);
           Rewrite (Node_To_Replace, Call_Node);
           Analyze (Node_To_Replace);
- 
        end Complete_Object_Operation;
  
        --------------------------------
--- 4882,4913 ----
           Node_To_Replace : Node_Id;
           Subprog         : Node_Id)
        is
+          First_Actual : Node_Id;
+ 
        begin
!          First_Actual := First (Parameter_Associations (Call_Node));
!          Set_Name (Call_Node, Subprog);
! 
!          if Nkind (N) = N_Selected_Component
!            and then not Inside_A_Generic
!          then
!             Set_Entity (Selector_Name (N), Entity (Subprog));
!          end if;
! 
!          --  If need be, rewrite first actual as an explicit dereference
! 
!          if not Is_Access_Type (Etype (First_Formal (Entity (Subprog))))
!            and then Is_Access_Type (Etype (Obj))
!          then
!             Rewrite (First_Actual,
!               Make_Explicit_Dereference (Sloc (Obj), Obj));
!             Analyze (First_Actual);
!          else
!             Rewrite (First_Actual, Obj);
!          end if;
! 
           Rewrite (Node_To_Replace, Call_Node);
           Analyze (Node_To_Replace);
        end Complete_Object_Operation;
  
        --------------------------------
*************** package body Sem_Ch4 is
*** 4804,4842 ****
  
        procedure Transform_Object_Operation
          (Call_Node       : out Node_Id;
-          First_Actual    : Node_Id;
           Node_To_Replace : out Node_Id;
           Subprog         : Node_Id)
        is
-          Actuals     : List_Id;
           Parent_Node : constant Node_Id := Parent (N);
  
        begin
!          Actuals := New_List (New_Copy_Tree (First_Actual));
  
           if (Nkind (Parent_Node) = N_Function_Call
                 or else
               Nkind (Parent_Node) = N_Procedure_Call_Statement)
  
!             --  Avoid recursive calls
  
!            and then N /= First (Parameter_Associations (Parent_Node))
           then
              Node_To_Replace := Parent_Node;
  
!             --  Copy list of actuals in full before attempting to resolve call.
!             --  This is necessary to ensure that the chaining of named actuals
!             --  that happens during matching is done on a separate copy.
  
!             declare
!                Actual : Node_Id;
!             begin
!                Actual := First (Parameter_Associations (Parent_Node));
!                while Present (Actual) loop
!                   Append (New_Copy_Tree (Actual), Actuals);
!                   Next (Actual);
!                end loop;
!             end;
  
              if Nkind (Parent_Node) = N_Procedure_Call_Statement then
                 Call_Node :=
--- 4916,4960 ----
  
        procedure Transform_Object_Operation
          (Call_Node       : out Node_Id;
           Node_To_Replace : out Node_Id;
           Subprog         : Node_Id)
        is
           Parent_Node : constant Node_Id := Parent (N);
  
+          Dummy : constant Node_Id := New_Copy (Obj);
+          --  Placeholder used as a first parameter in the call, replaced
+          --  eventually by the proper object.
+ 
+          Actuals : List_Id;
+          Actual  : Node_Id;
+ 
        begin
!          --  Common case covering 1) Call to a procedure and 2) Call to a
!          --  function that has some additional actuals.
  
           if (Nkind (Parent_Node) = N_Function_Call
                 or else
               Nkind (Parent_Node) = N_Procedure_Call_Statement)
  
!             --  N is a selected component node containing the name of the
!             --  subprogram. If N is not the name of the parent node we must
!             --  not replace the parent node by the new construct. This case
!             --  occurs when N is a parameterless call to a subprogram that
!             --  is an actual parameter of a call to another subprogram. For
!             --  example:
!             --            Some_Subprogram (..., Obj.Operation, ...)
  
!             and then Name (Parent_Node) = N
           then
              Node_To_Replace := Parent_Node;
  
!             Actuals := Parameter_Associations (Parent_Node);
  
!             if Present (Actuals) then
!                Prepend (Dummy, Actuals);
!             else
!                Actuals := New_List (Dummy);
!             end if;
  
              if Nkind (Parent_Node) = N_Procedure_Call_Statement then
                 Call_Node :=
*************** package body Sem_Ch4 is
*** 4845,4852 ****
                     Parameter_Associations => Actuals);
  
              else
-                pragma Assert (Nkind (Parent_Node) = N_Function_Call);
- 
                 Call_Node :=
                   Make_Function_Call (Loc,
                     Name => New_Copy_Tree (Subprog),
--- 4963,4968 ----
*************** package body Sem_Ch4 is
*** 4854,4869 ****
  
              end if;
  
!          --  Parameterless call
  
!          else
!             Node_To_Replace := N;
  
              Call_Node :=
                 Make_Function_Call (Loc,
                   Name => New_Copy_Tree (Subprog),
                   Parameter_Associations => Actuals);
  
           end if;
        end Transform_Object_Operation;
  
--- 4970,5007 ----
  
              end if;
  
!          --  Before analysis, the function call appears as an indexed component
!          --  if there are no named associations.
  
!          elsif Nkind (Parent_Node) =  N_Indexed_Component
!            and then N = Prefix (Parent_Node)
!          then
!             Node_To_Replace := Parent_Node;
! 
!             Actuals := Expressions (Parent_Node);
! 
!             Actual := First (Actuals);
!             while Present (Actual) loop
!                Analyze (Actual);
!                Next (Actual);
!             end loop;
! 
!             Prepend (Dummy, Actuals);
  
              Call_Node :=
                 Make_Function_Call (Loc,
                   Name => New_Copy_Tree (Subprog),
                   Parameter_Associations => Actuals);
  
+          --  Parameterless call:  Obj.F is rewritten as F (Obj)
+ 
+          else
+             Node_To_Replace := N;
+ 
+             Call_Node :=
+                Make_Function_Call (Loc,
+                  Name => New_Copy_Tree (Subprog),
+                  Parameter_Associations => New_List (Dummy));
           end if;
        end Transform_Object_Operation;
  
*************** package body Sem_Ch4 is
*** 4876,4891 ****
           Node_To_Replace : Node_Id) return Boolean
        is
           Anc_Type : Entity_Id;
-          Dummy    : Node_Id;
           Hom      : Entity_Id;
           Hom_Ref  : Node_Id;
           Success  : Boolean;
  
        begin
!          --  Loop through ancestor types, traverse their homonym chains and
!          --  gather all interpretations of the subprogram.
  
           Anc_Type := Obj_Type;
           loop
              Hom := Current_Entity (Subprog);
              while Present (Hom) loop
--- 5014,5033 ----
           Node_To_Replace : Node_Id) return Boolean
        is
           Anc_Type : Entity_Id;
           Hom      : Entity_Id;
           Hom_Ref  : Node_Id;
           Success  : Boolean;
  
        begin
!          --  Loop through ancestor types, traverse the homonym chain of the
!          --  subprogram, and try out those homonyms whose first formal has the
!          --  class-wide type of the ancestor.
! 
!          --  Should we verify that it is declared in the same package as the
!          --  ancestor type ???
  
           Anc_Type := Obj_Type;
+ 
           loop
              Hom := Current_Entity (Subprog);
              while Present (Hom) loop
*************** package body Sem_Ch4 is
*** 4898,4973 ****
                 then
                    Hom_Ref := New_Reference_To (Hom, Loc);
  
!                   --  When both the type of the object and the type of the
!                   --  first formal of the primitive operation are tagged
!                   --  access types, we use a node with the object as first
!                   --  actual.
! 
!                   if Is_Access_Type (Etype (Obj))
!                     and then Ekind (Etype (First_Formal (Hom))) =
!                                E_Anonymous_Access_Type
!                   then
!                      --  Allocate the node only once
! 
!                      if not Present (Call_Node_Case) then
!                         Transform_Object_Operation (
!                           Call_Node       => Call_Node_Case,
!                           First_Actual    => Obj,
!                           Node_To_Replace => Dummy,
!                           Subprog         => Subprog);
! 
!                         Set_Etype (Call_Node_Case, Any_Type);
!                         Set_Parent (Call_Node_Case, Parent (Node_To_Replace));
!                      end if;
! 
!                      Set_Name (Call_Node_Case, Hom_Ref);
! 
!                      Analyze_One_Call (
!                        N       => Call_Node_Case,
!                        Nam     => Hom,
!                        Report  => False,
!                        Success => Success);
! 
!                      if Success then
!                         Complete_Object_Operation (
!                           Call_Node       => Call_Node_Case,
!                           Node_To_Replace => Node_To_Replace,
!                           Subprog         => Hom_Ref);
  
!                         return True;
!                      end if;
  
!                   --  ??? comment required
  
!                   else
!                      Set_Name (Call_Node, Hom_Ref);
  
!                      Analyze_One_Call (
!                        N       => Call_Node,
!                        Nam     => Hom,
!                        Report  => False,
!                        Success => Success);
  
!                      if Success then
!                         Complete_Object_Operation (
!                           Call_Node       => Call_Node,
!                           Node_To_Replace => Node_To_Replace,
!                           Subprog         => Hom_Ref);
  
!                         return True;
!                      end if;
                    end if;
                 end if;
  
                 Hom := Homonym (Hom);
              end loop;
  
!             --  Climb to ancestor type if there is one
  
              exit when Etype (Anc_Type) = Anc_Type;
              Anc_Type := Etype (Anc_Type);
           end loop;
  
           return False;
        end Try_Class_Wide_Operation;
  
--- 5040,5081 ----
                 then
                    Hom_Ref := New_Reference_To (Hom, Loc);
  
!                   Set_Etype (Call_Node, Any_Type);
!                   Set_Parent (Call_Node, Parent (Node_To_Replace));
  
!                   Set_Name (Call_Node, Hom_Ref);
  
!                   Analyze_One_Call
!                     (N          => Call_Node,
!                      Nam        => Hom,
!                      Report     => False,
!                      Success    => Success,
!                      Skip_First => True);
  
!                   if Success then
  
!                      --  Reformat into the proper call
  
!                      Complete_Object_Operation
!                        (Call_Node       => Call_Node,
!                         Node_To_Replace => Node_To_Replace,
!                         Subprog         => Hom_Ref);
  
!                      return True;
                    end if;
                 end if;
  
                 Hom := Homonym (Hom);
              end loop;
  
!             --  Examine other ancestor types
  
              exit when Etype (Anc_Type) = Anc_Type;
              Anc_Type := Etype (Anc_Type);
           end loop;
  
+          --  Nothing matched
+ 
           return False;
        end Try_Class_Wide_Operation;
  
*************** package body Sem_Ch4 is
*** 4979,4990 ****
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean
        is
-          Dummy       : Node_Id;
           Elmt        : Elmt_Id;
           Prim_Op     : Entity_Id;
           Prim_Op_Ref : Node_Id;
           Success     : Boolean;
  
        begin
           --  Look for the subprogram in the list of primitive operations
  
--- 5087,5130 ----
          (Call_Node       : Node_Id;
           Node_To_Replace : Node_Id) return Boolean
        is
           Elmt        : Elmt_Id;
           Prim_Op     : Entity_Id;
           Prim_Op_Ref : Node_Id;
           Success     : Boolean;
  
+          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
+          --  Verify that the prefix, dereferenced if need be, is a valid
+          --  controlling argument in a call to Op. The remaining actuals
+          --  are checked in the subsequent call to Analyze_One_Call.
+ 
+          -----------------------------
+          -- Valid_First_Argument_Of --
+          -----------------------------
+ 
+          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean is
+             Typ : constant Entity_Id := Etype (First_Formal (Op));
+ 
+          begin
+             --  Simple case
+ 
+             return Base_Type (Obj_Type) = Typ
+ 
+             --  Prefix can be dereferenced
+ 
+               or else
+                 (Is_Access_Type (Obj_Type)
+                   and then Designated_Type (Obj_Type) = Typ)
+ 
+             --  Formal is an access parameter, for which the object
+             --  can provide an access.
+ 
+               or else
+                 (Ekind (Typ) = E_Anonymous_Access_Type
+                   and then Designated_Type (Typ) = Obj_Type);
+          end Valid_First_Argument_Of;
+ 
+       --  Start of processing for Try_Primitive_Operation
+ 
        begin
           --  Look for the subprogram in the list of primitive operations
  
*************** package body Sem_Ch4 is
*** 4994,5059 ****
  
              if Chars (Prim_Op) = Chars (Subprog)
                and then Present (First_Formal (Prim_Op))
              then
                 Prim_Op_Ref := New_Reference_To (Prim_Op, Loc);
  
!                --  When both the type of the object and the type of the first
!                --  formal of the primitive operation are tagged access types,
!                --  we use a node with the object as first actual.
! 
!                if Is_Access_Type (Etype (Obj))
!                  and then Ekind (Etype (First_Formal (Prim_Op))) =
!                             E_Anonymous_Access_Type
!                then
!                   --  Allocate the node only once
! 
!                   if not Present (Call_Node_Case) then
!                      Transform_Object_Operation (
!                        Call_Node       => Call_Node_Case,
!                        First_Actual    => Obj,
!                        Node_To_Replace => Dummy,
!                        Subprog         => Subprog);
! 
!                      Set_Etype (Call_Node_Case, Any_Type);
!                      Set_Parent (Call_Node_Case, Parent (Node_To_Replace));
!                   end if;
! 
!                   Set_Name (Call_Node_Case, Prim_Op_Ref);
! 
!                   Analyze_One_Call (
!                     N       => Call_Node_Case,
!                     Nam     => Prim_Op,
!                     Report  => False,
!                     Success => Success);
! 
!                   if Success then
!                      Complete_Object_Operation (
!                        Call_Node       => Call_Node_Case,
!                        Node_To_Replace => Node_To_Replace,
!                        Subprog         => Prim_Op_Ref);
! 
!                      return True;
!                   end if;
! 
!                --  Comment required ???
  
!                else
!                   Set_Name (Call_Node, Prim_Op_Ref);
  
!                   Analyze_One_Call (
!                     N       => Call_Node,
!                     Nam     => Prim_Op,
!                     Report  => False,
!                     Success => Success);
  
!                   if Success then
!                      Complete_Object_Operation (
!                        Call_Node       => Call_Node,
!                        Node_To_Replace => Node_To_Replace,
!                        Subprog         => Prim_Op_Ref);
  
!                      return True;
!                   end if;
                 end if;
              end if;
  
--- 5134,5162 ----
  
              if Chars (Prim_Op) = Chars (Subprog)
                and then Present (First_Formal (Prim_Op))
+               and then Valid_First_Argument_Of (Prim_Op)
              then
                 Prim_Op_Ref := New_Reference_To (Prim_Op, Loc);
  
!                Set_Etype (Call_Node, Any_Type);
!                Set_Parent (Call_Node, Parent (Node_To_Replace));
  
!                Set_Name (Call_Node, Prim_Op_Ref);
  
!                Analyze_One_Call
!                  (N          => Call_Node,
!                   Nam        => Prim_Op,
!                   Report     => False,
!                   Success    => Success,
!                   Skip_First => True);
  
!                if Success then
!                   Complete_Object_Operation
!                     (Call_Node       => Call_Node,
!                      Node_To_Replace => Node_To_Replace,
!                      Subprog         => Prim_Op_Ref);
  
!                   return True;
                 end if;
              end if;
  
*************** package body Sem_Ch4 is
*** 5078,5123 ****
           Obj_Type := Etype (Class_Wide_Type (Obj_Type));
        end if;
  
!       --  Analyze the actuals in case of subprogram call
  
        if Is_Subprg_Call and then N = Name (Parent (N)) then
           Actual := First (Parameter_Associations (Parent (N)));
           while Present (Actual) loop
!             Analyze (Actual);
!             Check_Parameterless_Call (Actual);
              Next (Actual);
           end loop;
        end if;
  
!       --  If the object is of an Access type, explicit dereference is
!       --  required.
! 
!       if Is_Access_Type (Etype (Obj)) then
!          First_Actual :=
!            Make_Explicit_Dereference (Sloc (Obj), Obj);
!          Set_Etype (First_Actual, Obj_Type);
!       else
!          First_Actual := Obj;
!       end if;
  
!       --  Build a subprogram call node
  
!       Transform_Object_Operation (
!         Call_Node       => Call_Node,
!         First_Actual    => First_Actual,
!         Node_To_Replace => Node_To_Replace,
!         Subprog         => Subprog);
  
!       Set_Etype (Call_Node, Any_Type);
!       Set_Parent (Call_Node, Parent (Node_To_Replace));
  
        return
           Try_Primitive_Operation
!            (Call_Node       => Call_Node,
              Node_To_Replace => Node_To_Replace)
          or else
           Try_Class_Wide_Operation
!            (Call_Node       => Call_Node,
              Node_To_Replace => Node_To_Replace);
     end Try_Object_Operation;
  
--- 5181,5232 ----
           Obj_Type := Etype (Class_Wide_Type (Obj_Type));
        end if;
  
!       --  The type may have be obtained through a limited_with clause,
!       --  in which case the primitive operations are available on its
!       --  non-limited view.
! 
!       if Ekind (Obj_Type) = E_Incomplete_Type
!         and then From_With_Type (Obj_Type)
!       then
!          Obj_Type := Non_Limited_View (Obj_Type);
!       end if;
! 
!       if not Is_Tagged_Type (Obj_Type) then
!          return False;
!       end if;
! 
!       --  Analyze the actuals if node is know to be a subprogram call
  
        if Is_Subprg_Call and then N = Name (Parent (N)) then
           Actual := First (Parameter_Associations (Parent (N)));
           while Present (Actual) loop
!             Analyze_Expression (Actual);
              Next (Actual);
           end loop;
        end if;
  
!       Analyze_Expression (Obj);
  
!       --  Build a subprogram call node, using a copy of Obj as its first
!       --  actual. This is a placeholder, to be replaced by an explicit
!       --  dereference when needed.
  
!       Transform_Object_Operation
!         (Call_Node       => New_Call_Node,
!          Node_To_Replace => Node_To_Replace,
!          Subprog         => Subprog);
  
!       Set_Etype (New_Call_Node, Any_Type);
!       Set_Parent (New_Call_Node, Parent (Node_To_Replace));
  
        return
           Try_Primitive_Operation
!            (Call_Node       => New_Call_Node,
              Node_To_Replace => Node_To_Replace)
+ 
          or else
           Try_Class_Wide_Operation
!            (Call_Node       => New_Call_Node,
              Node_To_Replace => Node_To_Replace);
     end Try_Object_Operation;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch4.ads gcc-4.1.0/gcc/ada/sem_ch4.ads
*** gcc-4.0.2/gcc/ada/sem_ch4.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_ch4.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch5.adb gcc-4.1.0/gcc/ada/sem_ch5.adb
*** gcc-4.0.2/gcc/ada/sem_ch5.adb	Thu Feb 10 13:50:41 2005
--- gcc-4.1.0/gcc/ada/sem_ch5.adb	Tue Nov 15 13:57:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch5 is
*** 71,85 ****
  
     procedure Analyze_Iteration_Scheme (N : Node_Id);
  
-    procedure Check_Possible_Current_Value_Condition (Cnode : Node_Id);
-    --  Cnode is N_If_Statement, N_Elsif_Part, or N_Iteration_Scheme
-    --  (the latter when a WHILE condition is present). This call checks
-    --  if Condition (Cnode) is of the form ([NOT] var op val), where var
-    --  is a simple object, val is known at compile time, and op is one
-    --  of the six relational operators. If this is the case, and the
-    --  Current_Value field of "var" is not set, then it is set to Cnode.
-    --  See Exp_Util.Set_Current_Value_Condition for further details.
- 
     ------------------------
     -- Analyze_Assignment --
     ------------------------
--- 71,76 ----
*************** package body Sem_Ch5 is
*** 339,344 ****
--- 330,358 ----
        --  to avoid scoping issues in the back-end.
  
        T1 := Etype (Lhs);
+ 
+       --  Ada 2005 (AI-50217, AI-326): Check wrong dereference of incomplete
+       --  type. For example:
+ 
+       --    limited with P;
+       --    package Pkg is
+       --      type Acc is access P.T;
+       --    end Pkg;
+ 
+       --    with Pkg; use Acc;
+       --    procedure Example is
+       --       A, B : Acc;
+       --    begin
+       --       A.all := B.all;  -- ERROR
+       --    end Example;
+ 
+       if Nkind (Lhs) = N_Explicit_Dereference
+         and then Ekind (T1) = E_Incomplete_Type
+       then
+          Error_Msg_N ("invalid use of incomplete type", Lhs);
+          return;
+       end if;
+ 
        Set_Assignment_Type (Lhs, T1);
  
        Resolve (Rhs, T1);
*************** package body Sem_Ch5 is
*** 352,364 ****
  
        T2 := Etype (Rhs);
  
!       if Covers (T1, T2) then
!          null;
!       else
           Wrong_Type (Rhs, Etype (Lhs));
           return;
        end if;
  
        Set_Assignment_Type (Rhs, T2);
  
        if Total_Errors_Detected /= 0 then
--- 366,387 ----
  
        T2 := Etype (Rhs);
  
!       if not Covers (T1, T2) then
           Wrong_Type (Rhs, Etype (Lhs));
           return;
        end if;
  
+       --  Ada 2005 (AI-326): In case of explicit dereference of incomplete
+       --  types, use the non-limited view if available
+ 
+       if Nkind (Rhs) = N_Explicit_Dereference
+         and then Ekind (T2) = E_Incomplete_Type
+         and then Is_Tagged_Type (T2)
+         and then Present (Non_Limited_View (T2))
+       then
+          T2 := Non_Limited_View (T2);
+       end if;
+ 
        Set_Assignment_Type (Rhs, T2);
  
        if Total_Errors_Detected /= 0 then
*************** package body Sem_Ch5 is
*** 400,419 ****
           Propagate_Tag (Lhs, Rhs);
        end if;
  
        --  Ada 2005 (AI-231)
  
        if Ada_Version >= Ada_05
!         and then Nkind (Rhs) = N_Null
!         and then Is_Access_Type (T1)
          and then not Assignment_OK (Lhs)
-         and then ((Is_Entity_Name (Lhs)
-                      and then Can_Never_Be_Null (Entity (Lhs)))
-                    or else Can_Never_Be_Null (Etype (Lhs)))
        then
!          Apply_Compile_Time_Constraint_Error
!            (N      => Lhs,
!             Msg    => "(Ada 2005) NULL not allowed in null-excluding objects?",
!             Reason => CE_Null_Not_Allowed);
        end if;
  
        if Is_Scalar_Type (T1) then
--- 423,457 ----
           Propagate_Tag (Lhs, Rhs);
        end if;
  
+       --  Ada 2005 (AI-230 and AI-385): When the lhs type is an anonymous
+       --  access type, apply an implicit conversion of the rhs to that type
+       --  to force appropriate static and run-time accessibility checks.
+ 
+       if Ada_Version >= Ada_05
+         and then Ekind (T1) = E_Anonymous_Access_Type
+       then
+          Rewrite (Rhs, Convert_To (T1, Relocate_Node (Rhs)));
+          Analyze_And_Resolve (Rhs, T1);
+       end if;
+ 
        --  Ada 2005 (AI-231)
  
        if Ada_Version >= Ada_05
!         and then Can_Never_Be_Null (T1)
          and then not Assignment_OK (Lhs)
        then
!          if Nkind (Rhs) = N_Null then
!             Apply_Compile_Time_Constraint_Error
!               (N   => Rhs,
!                Msg => "(Ada 2005) NULL not allowed in null-excluding objects?",
!                Reason => CE_Null_Not_Allowed);
!             return;
! 
!          elsif not Can_Never_Be_Null (T2) then
!             Rewrite (Rhs,
!               Convert_To (T1, Relocate_Node (Rhs)));
!             Analyze_And_Resolve (Rhs, T1);
!          end if;
        end if;
  
        if Is_Scalar_Type (T1) then
*************** package body Sem_Ch5 is
*** 505,511 ****
  
        Ent := Entity (Lhs);
  
!       --  Capture value if save to do so
  
        if Safe_To_Capture_Value (N, Ent) then
           Set_Current_Value (Ent, Rhs);
--- 543,549 ----
  
        Ent := Entity (Lhs);
  
!       --  Capture value if safe to do so
  
        if Safe_To_Capture_Value (N, Ent) then
           Set_Current_Value (Ent, Rhs);
*************** package body Sem_Ch5 is
*** 741,749 ****
     begin
        Unblocked_Exit_Count := 0;
        Exp := Expression (N);
!       Analyze_And_Resolve (Exp, Any_Discrete);
        Check_Unset_Reference (Exp);
-       Exp_Type  := Etype (Exp);
        Exp_Btype := Base_Type (Exp_Type);
  
        --  The expression must be of a discrete type which must be determinable
--- 779,808 ----
     begin
        Unblocked_Exit_Count := 0;
        Exp := Expression (N);
!       Analyze (Exp);
! 
!       --  The expression must be of any discrete type. In rare cases, the
!       --  expander constructs a case statement whose expression has a private
!       --  type whose full view is discrete. This can happen when generating
!       --  a stream operation for a variant type after the type is frozen,
!       --  when the partial of view of the type of the discriminant is private.
!       --  In that case, use the full view to analyze case alternatives.
! 
!       if not Is_Overloaded (Exp)
!         and then not Comes_From_Source (N)
!         and then Is_Private_Type (Etype (Exp))
!         and then Present (Full_View (Etype (Exp)))
!         and then Is_Discrete_Type (Full_View (Etype (Exp)))
!       then
!          Resolve (Exp, Etype (Exp));
!          Exp_Type := Full_View (Etype (Exp));
! 
!       else
!          Analyze_And_Resolve (Exp, Any_Discrete);
!          Exp_Type := Etype (Exp);
!       end if;
! 
        Check_Unset_Reference (Exp);
        Exp_Btype := Base_Type (Exp_Type);
  
        --  The expression must be of a discrete type which must be determinable
*************** package body Sem_Ch5 is
*** 1112,1118 ****
        --  If the iteration is given by a range, create temporaries and
        --  assignment statements block to capture the bounds and perform
        --  required finalization actions in case a bound includes a function
!       --  call that uses the temporary stack.
  
        procedure Check_Controlled_Array_Attribute (DS : Node_Id);
        --  If the bounds are given by a 'Range reference on a function call
--- 1171,1179 ----
        --  If the iteration is given by a range, create temporaries and
        --  assignment statements block to capture the bounds and perform
        --  required finalization actions in case a bound includes a function
!       --  call that uses the temporary stack. We first pre-analyze a copy of
!       --  the range in order to determine the expected type, and analyze and
!       --  resolve the original bounds.
  
        procedure Check_Controlled_Array_Attribute (DS : Node_Id);
        --  If the bounds are given by a 'Range reference on a function call
*************** package body Sem_Ch5 is
*** 1126,1138 ****
  
        procedure Process_Bounds (R : Node_Id) is
           Loc          : constant Source_Ptr := Sloc (N);
           Lo           : constant Node_Id := Low_Bound  (R);
           Hi           : constant Node_Id := High_Bound (R);
           New_Lo_Bound : Node_Id := Empty;
           New_Hi_Bound : Node_Id := Empty;
!          Typ          : constant Entity_Id := Etype (R);
  
!          function One_Bound (Bound : Node_Id) return Node_Id;
           --  Create one declaration followed by one assignment statement
           --  to capture the value of bound. We create a separate assignment
           --  in order to force the creation of a block in case the bound
--- 1187,1202 ----
  
        procedure Process_Bounds (R : Node_Id) is
           Loc          : constant Source_Ptr := Sloc (N);
+          R_Copy       : constant Node_Id := New_Copy_Tree (R);
           Lo           : constant Node_Id := Low_Bound  (R);
           Hi           : constant Node_Id := High_Bound (R);
           New_Lo_Bound : Node_Id := Empty;
           New_Hi_Bound : Node_Id := Empty;
!          Typ          : Entity_Id;
  
!          function One_Bound
!            (Original_Bound : Node_Id;
!             Analyzed_Bound : Node_Id) return Node_Id;
           --  Create one declaration followed by one assignment statement
           --  to capture the value of bound. We create a separate assignment
           --  in order to force the creation of a block in case the bound
*************** package body Sem_Ch5 is
*** 1142,1186 ****
           -- One_Bound --
           ---------------
  
!          function One_Bound (Bound : Node_Id) return Node_Id is
!             Assign   : Node_Id;
!             Id       : Entity_Id;
!             Decl     : Node_Id;
!             Decl_Typ : Entity_Id;
  
           begin
!             --  If the bound is a constant or an object, no need for a
!             --  separate declaration. If the bound is the result of previous
!             --  expansion it is already analyzed and should not be modified.
!             --  Note that the Bound will be resolved later, if needed, as
!             --  part of the call to Make_Index (literal bounds may need to
!             --  be resolved to type Integer).
  
!             if Nkind (Bound) = N_Integer_Literal
!               or else Is_Entity_Name (Bound)
!               or else Analyzed (Bound)
              then
!                return Bound;
              end if;
  
              Id :=
                Make_Defining_Identifier (Loc,
                  Chars => New_Internal_Name ('S'));
  
-             --  If the type of the discrete range is Universal_Integer, then
-             --  the bound's type must be resolved to Integer, so the object
-             --  used to hold the bound must also have type Integer.
- 
-             if Typ = Universal_Integer then
-                Decl_Typ := Standard_Integer;
-             else
-                Decl_Typ := Typ;
-             end if;
- 
              Decl :=
                Make_Object_Declaration (Loc,
                  Defining_Identifier => Id,
!                 Object_Definition   => New_Occurrence_Of (Decl_Typ, Loc));
  
              Insert_Before (Parent (N), Decl);
              Analyze (Decl);
--- 1206,1248 ----
           -- One_Bound --
           ---------------
  
!          function One_Bound
!            (Original_Bound : Node_Id;
!             Analyzed_Bound : Node_Id) return Node_Id
!          is
!             Assign : Node_Id;
!             Id     : Entity_Id;
!             Decl   : Node_Id;
  
           begin
!             --  If the bound is a constant or an object, no need for a separate
!             --  declaration. If the bound is the result of previous expansion
!             --  it is already analyzed and should not be modified. Note that
!             --  the Bound will be resolved later, if needed, as part of the
!             --  call to Make_Index (literal bounds may need to be resolved to
!             --  type Integer).
  
!             if Analyzed (Original_Bound) then
!                return Original_Bound;
! 
!             elsif Nkind (Analyzed_Bound) = N_Integer_Literal
!               or else Is_Entity_Name (Analyzed_Bound)
              then
!                Analyze_And_Resolve (Original_Bound, Typ);
!                return Original_Bound;
! 
!             else
!                Analyze_And_Resolve (Original_Bound, Typ);
              end if;
  
              Id :=
                Make_Defining_Identifier (Loc,
                  Chars => New_Internal_Name ('S'));
  
              Decl :=
                Make_Object_Declaration (Loc,
                  Defining_Identifier => Id,
!                 Object_Definition   => New_Occurrence_Of (Typ, Loc));
  
              Insert_Before (Parent (N), Decl);
              Analyze (Decl);
*************** package body Sem_Ch5 is
*** 1188,1213 ****
              Assign :=
                Make_Assignment_Statement (Loc,
                  Name        => New_Occurrence_Of (Id, Loc),
!                 Expression  => Relocate_Node (Bound));
  
-             Save_Interps (Bound, Expression (Assign));
              Insert_Before (Parent (N), Assign);
              Analyze (Assign);
  
!             Rewrite (Bound, New_Occurrence_Of (Id, Loc));
  
              if Nkind (Assign) = N_Assignment_Statement then
                 return Expression (Assign);
              else
!                return Bound;
              end if;
           end One_Bound;
  
        --  Start of processing for Process_Bounds
  
        begin
!          New_Lo_Bound := One_Bound (Lo);
!          New_Hi_Bound := One_Bound (Hi);
  
           --  Propagate staticness to loop range itself, in case the
           --  corresponding subtype is static.
--- 1250,1290 ----
              Assign :=
                Make_Assignment_Statement (Loc,
                  Name        => New_Occurrence_Of (Id, Loc),
!                 Expression  => Relocate_Node (Original_Bound));
  
              Insert_Before (Parent (N), Assign);
              Analyze (Assign);
  
!             Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
  
              if Nkind (Assign) = N_Assignment_Statement then
                 return Expression (Assign);
              else
!                return Original_Bound;
              end if;
           end One_Bound;
  
        --  Start of processing for Process_Bounds
  
        begin
!          --  Determine expected type of range by analyzing separate copy
! 
!          Set_Parent (R_Copy, Parent (R));
!          Pre_Analyze_And_Resolve (R_Copy);
!          Typ := Etype (R_Copy);
! 
!          --  If the type of the discrete range is Universal_Integer, then
!          --  the bound's type must be resolved to Integer, and any object
!          --  used to hold the bound must also have type Integer.
! 
!          if Typ = Universal_Integer then
!             Typ := Standard_Integer;
!          end if;
! 
!          Set_Etype (R, Typ);
! 
!          New_Lo_Bound := One_Bound (Lo, Low_Bound  (R_Copy));
!          New_Hi_Bound := One_Bound (Hi, High_Bound (R_Copy));
  
           --  Propagate staticness to loop range itself, in case the
           --  corresponding subtype is static.
*************** package body Sem_Ch5 is
*** 1332,1338 ****
                    if Nkind (DS) = N_Range
                      and then Expander_Active
                    then
-                      Pre_Analyze_And_Resolve (DS);
                       Process_Bounds (DS);
                    else
                       Analyze (DS);
--- 1409,1414 ----
*************** package body Sem_Ch5 is
*** 1441,1453 ****
                          --  of reversing the bounds incorrectly in the range.
  
                          elsif Reverse_Present (LP)
!                           and then Nkind (H) = N_Integer_Literal
                            and then (Intval (H) = Uint_0
                                        or else
                                      Intval (H) = Uint_1)
                            and then Lhi > Hhi
                          then
                             Error_Msg_N ("?loop range may be null", DS);
                          end if;
                       end;
                    end if;
--- 1517,1531 ----
                          --  of reversing the bounds incorrectly in the range.
  
                          elsif Reverse_Present (LP)
!                           and then Nkind (Original_Node (H)) =
!                                                           N_Integer_Literal
                            and then (Intval (H) = Uint_0
                                        or else
                                      Intval (H) = Uint_1)
                            and then Lhi > Hhi
                          then
                             Error_Msg_N ("?loop range may be null", DS);
+                            Error_Msg_N ("\?bounds may be wrong way round", DS);
                          end if;
                       end;
                    end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch5.ads gcc-4.1.0/gcc/ada/sem_ch5.ads
*** gcc-4.0.2/gcc/ada/sem_ch5.ads	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_ch5.ads	Tue Nov 15 13:57:37 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Ch5 is
*** 47,52 ****
--- 47,61 ----
     --  care of setting Reachable, since labels defined by the expander can
     --  be assumed to be reachable.
  
+    procedure Check_Possible_Current_Value_Condition (Cnode : Node_Id);
+    --  Cnode is N_If_Statement, N_Elsif_Part, or N_Iteration_Scheme
+    --  (the latter when a WHILE condition is present). This call checks
+    --  if Condition (Cnode) is of the form ([NOT] var op val), where var
+    --  is a simple object, val is known at compile time, and op is one
+    --  of the six relational operators. If this is the case, and the
+    --  Current_Value field of "var" is not set, then it is set to Cnode.
+    --  See Exp_Util.Set_Current_Value_Condition for further details.
+ 
     procedure Check_Unreachable_Code (N : Node_Id);
     --  This procedure is called with N being the node for a statement that
     --  is an unconditional transfer of control. It checks to see if the
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch6.adb gcc-4.1.0/gcc/ada/sem_ch6.adb
*** gcc-4.0.2/gcc/ada/sem_ch6.adb	Thu Feb 10 13:50:45 2005
--- gcc-4.1.0/gcc/ada/sem_ch6.adb	Tue Nov 15 14:02:58 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Elists;   use Elists;
*** 32,39 ****
--- 32,41 ----
  with Errout;   use Errout;
  with Expander; use Expander;
  with Exp_Ch7;  use Exp_Ch7;
+ with Exp_Tss;  use Exp_Tss;
  with Fname;    use Fname;
  with Freeze;   use Freeze;
+ with Itypes;   use Itypes;
  with Lib.Xref; use Lib.Xref;
  with Namet;    use Namet;
  with Lib;      use Lib;
*************** package body Sem_Ch6 is
*** 103,115 ****
     --  RM definitions of the corresponding terms.
  
     procedure Check_Conformance
!      (New_Id   : Entity_Id;
!       Old_Id   : Entity_Id;
!       Ctype    : Conformance_Type;
!       Errmsg   : Boolean;
!       Conforms : out Boolean;
!       Err_Loc  : Node_Id := Empty;
!       Get_Inst : Boolean := False);
     --  Given two entities, this procedure checks that the profiles associated
     --  with these entities meet the conformance criterion given by the third
     --  parameter. If they conform, Conforms is set True and control returns
--- 105,118 ----
     --  RM definitions of the corresponding terms.
  
     procedure Check_Conformance
!      (New_Id                   : Entity_Id;
!       Old_Id                   : Entity_Id;
!       Ctype                    : Conformance_Type;
!       Errmsg                   : Boolean;
!       Conforms                 : out Boolean;
!       Err_Loc                  : Node_Id := Empty;
!       Get_Inst                 : Boolean := False;
!       Skip_Controlling_Formals : Boolean := False);
     --  Given two entities, this procedure checks that the profiles associated
     --  with these entities meet the conformance criterion given by the third
     --  parameter. If they conform, Conforms is set True and control returns
*************** package body Sem_Ch6 is
*** 122,134 ****
     --  against a formal access-to-subprogram type so Get_Instance_Of must
     --  be called.
  
!    procedure Check_Overriding_Operation
!      (N    : Node_Id;
!       Subp : Entity_Id);
!    --  Check that a subprogram with a pragma Overriding or Optional_Overriding
!    --  is legal. This check is performed here rather than in Sem_Prag because
!    --  the pragma must follow immediately the declaration, and can be treated
!    --  as part of the declaration itself, as described in AI-218.
  
     procedure Check_Subprogram_Order (N : Node_Id);
     --  N is the N_Subprogram_Body node for a subprogram. This routine applies
--- 125,138 ----
     --  against a formal access-to-subprogram type so Get_Instance_Of must
     --  be called.
  
!    procedure Check_Overriding_Indicator
!      (Subp          : Entity_Id;
!       Does_Override : Boolean);
!    --  Verify the consistency of an overriding_indicator given for subprogram
!    --  declaration, body, renaming, or instantiation. The flag Does_Override
!    --  is set if the scope into which we are introducing the subprogram
!    --  contains a type-conformant subprogram that becomes hidden by the new
!    --  subprogram.
  
     procedure Check_Subprogram_Order (N : Node_Id);
     --  N is the N_Subprogram_Body node for a subprogram. This routine applies
*************** package body Sem_Ch6 is
*** 233,239 ****
        Analyze (P);
  
        --  A call of the form A.B (X) may be an Ada05 call, which is rewritten
!       --  as B(A, X). If the rewriting is successful, the call has been
        --  analyzed and we just return.
  
        if Nkind (P) = N_Selected_Component
--- 237,243 ----
        Analyze (P);
  
        --  A call of the form A.B (X) may be an Ada05 call, which is rewritten
!       --  as B (A, X). If the rewriting is successful, the call has been
        --  analyzed and we just return.
  
        if Nkind (P) = N_Selected_Component
*************** package body Sem_Ch6 is
*** 255,261 ****
  
        if Present (L) then
           Actual := First (L);
- 
           while Present (Actual) loop
              Analyze (Actual);
              Check_Parameterless_Call (Actual);
--- 259,264 ----
*************** package body Sem_Ch6 is
*** 515,520 ****
--- 518,531 ----
  
        Analyze (P);
  
+       --  If this is a call of the form Obj.Op, the call may have been
+       --  analyzed and possibly rewritten into a block, in which case
+       --  we are done.
+ 
+       if Analyzed (N) then
+          return;
+       end if;
+ 
        --  If error analyzing prefix, then set Any_Type as result and return
  
        if Etype (P) = Any_Type then
*************** package body Sem_Ch6 is
*** 679,685 ****
        --  Anything else is an error
  
        else
!          Error_Msg_N ("Invalid procedure or entry call", N);
        end if;
     end Analyze_Procedure_Call;
  
--- 690,696 ----
        --  Anything else is an error
  
        else
!          Error_Msg_N ("invalid procedure or entry call", N);
        end if;
     end Analyze_Procedure_Call;
  
*************** package body Sem_Ch6 is
*** 725,730 ****
--- 736,753 ----
              Set_Return_Type (N, R_Type);
              Analyze_And_Resolve (Expr, R_Type);
  
+             --  Ada 2005 (AI-318-02): When the result type is an anonymous
+             --  access type, apply an implicit conversion of the expression
+             --  to that type to force appropriate static and run-time
+             --  accessibility checks.
+ 
+             if Ada_Version >= Ada_05
+               and then Ekind (R_Type) = E_Anonymous_Access_Type
+             then
+                Rewrite (Expr, Convert_To (R_Type, Relocate_Node (Expr)));
+                Analyze_And_Resolve (Expr, R_Type);
+             end if;
+ 
              if (Is_Class_Wide_Type (Etype (Expr))
                   or else Is_Dynamically_Tagged (Expr))
                and then not Is_Class_Wide_Type (R_Type)
*************** package body Sem_Ch6 is
*** 735,740 ****
--- 758,779 ----
  
              Apply_Constraint_Check (Expr, R_Type);
  
+             --  Ada 2005 (AI-318-02): Return-by-reference types have been
+             --  removed and replaced by anonymous access results. This is
+             --  an incompatibility with Ada 95. Not clear whether this
+             --  should be enforced yet or perhaps controllable with a
+             --  special switch. ???
+ 
+             --  if Ada_Version >= Ada_05
+             --    and then Is_Limited_Type (R_Type)
+             --    and then Nkind (Expr) /= N_Aggregate
+             --    and then Nkind (Expr) /= N_Extension_Aggregate
+             --    and then Nkind (Expr) /= N_Function_Call
+             --  then
+             --     Error_Msg_N
+             --       ("(Ada 2005) illegal operand for limited return", N);
+             --  end if;
+ 
              --  ??? A real run-time accessibility check is needed in cases
              --  involving dereferences of access parameters. For now we just
              --  check the static cases.
*************** package body Sem_Ch6 is
*** 790,807 ****
        Typ        : Entity_Id := Empty;
  
     begin
!       if Subtype_Mark (N) /= Error then
!          Find_Type (Subtype_Mark (N));
!          Typ := Entity (Subtype_Mark (N));
!          Set_Etype (Designator, Typ);
  
!          if Ekind (Typ) = E_Incomplete_Type
!            or else (Is_Class_Wide_Type (Typ)
!                       and then
!                         Ekind (Root_Type (Typ)) = E_Incomplete_Type)
!          then
!             Error_Msg_N
!               ("invalid use of incomplete type", Subtype_Mark (N));
           end if;
  
        else
--- 829,865 ----
        Typ        : Entity_Id := Empty;
  
     begin
!       if Result_Definition (N) /= Error then
!          if Nkind (Result_Definition (N)) = N_Access_Definition then
!             Typ := Access_Definition (N, Result_Definition (N));
!             Set_Parent (Typ, Result_Definition (N));
!             Set_Is_Local_Anonymous_Access (Typ);
!             Set_Etype (Designator, Typ);
  
!             --  Ada 2005 (AI-231): Static checks
! 
!             --  Null_Exclusion_Static_Checks needs to be extended to handle
!             --  null exclusion checks for function specifications. ???
! 
!             --  if Null_Exclusion_Present (N) then
!             --     Null_Exclusion_Static_Checks (Param_Spec);
!             --  end if;
! 
!          --  Subtype_Mark case
! 
!          else
!             Find_Type (Result_Definition (N));
!             Typ := Entity (Result_Definition (N));
!             Set_Etype (Designator, Typ);
! 
!             if Ekind (Typ) = E_Incomplete_Type
!               or else (Is_Class_Wide_Type (Typ)
!                          and then
!                            Ekind (Root_Type (Typ)) = E_Incomplete_Type)
!             then
!                Error_Msg_N
!                  ("invalid use of incomplete type", Result_Definition (N));
!             end if;
           end if;
  
        else
*************** package body Sem_Ch6 is
*** 833,865 ****
        Missing_Ret  : Boolean;
        P_Ent        : Entity_Id;
  
!       procedure Check_Following_Pragma;
!       --  If front-end inlining is enabled, look ahead to recognize a pragma
!       --  that may appear after the body.
  
!       procedure Check_Following_Pragma is
!          Prag : Node_Id;
  
        begin
!          if Front_End_Inlining
!            and then Is_List_Member (N)
!            and then Present (Spec_Decl)
!            and then List_Containing (N) = List_Containing (Spec_Decl)
           then
              Prag := Next (N);
  
!             if Present (Prag)
!               and then Nkind (Prag) = N_Pragma
!               and then Get_Pragma_Id (Chars (Prag)) = Pragma_Inline
                and then
!               Chars
!                 (Expression (First (Pragma_Argument_Associations (Prag))))
!                    = Chars (Body_Id)
              then
!                Analyze (Prag);
              end if;
           end if;
!       end Check_Following_Pragma;
  
     --  Start of processing for Analyze_Subprogram_Body
  
--- 891,1043 ----
        Missing_Ret  : Boolean;
        P_Ent        : Entity_Id;
  
!       procedure Check_Inline_Pragma (Spec : in out Node_Id);
!       --  Look ahead to recognize a pragma that may appear after the body.
!       --  If there is a previous spec, check that it appears in the same
!       --  declarative part. If the pragma is Inline_Always, perform inlining
!       --  unconditionally, otherwise only if Front_End_Inlining is requested.
!       --  If the body acts as a spec, and inlining is required, we create a
!       --  subprogram declaration for it, in order to attach the body to inline.
  
!       procedure Copy_Parameter_List (Plist : List_Id);
!       --  Comment required ???
! 
!       procedure Verify_Overriding_Indicator;
!       --  If there was a previous spec, the entity has been entered in the
!       --  current scope previously. If the body itself carries an overriding
!       --  indicator, check that it is consistent with the known status of the
!       --  entity.
! 
!       -------------------------
!       -- Check_Inline_Pragma --
!       -------------------------
! 
!       procedure Check_Inline_Pragma (Spec : in out Node_Id) is
!          Prag  : Node_Id;
!          Plist : List_Id;
  
        begin
!          if not Expander_Active then
!             return;
!          end if;
! 
!          if Is_List_Member (N)
!            and then Present (Next (N))
!            and then Nkind (Next (N)) = N_Pragma
           then
              Prag := Next (N);
  
!             if Nkind (Prag) = N_Pragma
                and then
!                  (Get_Pragma_Id (Chars (Prag)) = Pragma_Inline_Always
!                   or else
!                     (Front_End_Inlining
!                      and then Get_Pragma_Id (Chars (Prag)) = Pragma_Inline))
!               and then
!                  Chars
!                    (Expression (First (Pragma_Argument_Associations (Prag))))
!                       = Chars (Body_Id)
              then
!                Prag := Next (N);
!             else
!                Prag := Empty;
              end if;
+          else
+             Prag := Empty;
           end if;
! 
!          if Present (Prag) then
!             if Present (Spec_Id) then
!                if List_Containing (N) =
!                  List_Containing (Unit_Declaration_Node (Spec_Id))
!                then
!                   Analyze (Prag);
!                end if;
! 
!             else
!                --  Create a subprogram declaration, to make treatment uniform.
! 
!                declare
!                   Subp : constant Entity_Id :=
!                     Make_Defining_Identifier (Loc, Chars (Body_Id));
!                   Decl : constant Node_Id :=
!                     Make_Subprogram_Declaration (Loc,
!                       Specification =>  New_Copy_Tree (Specification (N)));
!                begin
!                   Set_Defining_Unit_Name (Specification (Decl), Subp);
! 
!                   if Present (First_Formal (Body_Id)) then
!                      Plist := New_List;
!                      Copy_Parameter_List (Plist);
!                      Set_Parameter_Specifications
!                        (Specification (Decl), Plist);
!                   end if;
! 
!                   Insert_Before (N, Decl);
!                   Analyze (Decl);
!                   Analyze (Prag);
!                   Set_Has_Pragma_Inline (Subp);
! 
!                   if Get_Pragma_Id (Chars (Prag)) = Pragma_Inline_Always then
!                      Set_Is_Inlined (Subp);
!                      Set_Next_Rep_Item (Prag, First_Rep_Item (Subp));
!                      Set_First_Rep_Item (Subp, Prag);
!                   end if;
! 
!                   Spec := Subp;
!                end;
!             end if;
!          end if;
!       end Check_Inline_Pragma;
! 
!       -------------------------
!       -- Copy_Parameter_List --
!       -------------------------
! 
!       procedure Copy_Parameter_List (Plist : List_Id) is
!          Formal : Entity_Id;
! 
!       begin
!          Formal := First_Formal (Body_Id);
! 
!          while Present (Formal) loop
!             Append
!               (Make_Parameter_Specification (Loc,
!                 Defining_Identifier =>
!                   Make_Defining_Identifier (Sloc (Formal),
!                     Chars => Chars (Formal)),
!                 In_Present  => In_Present (Parent (Formal)),
!                 Out_Present => Out_Present (Parent (Formal)),
!              Parameter_Type =>
!                   New_Reference_To (Etype (Formal), Loc),
!                 Expression =>
!                   New_Copy_Tree (Expression (Parent (Formal)))),
!               Plist);
! 
!             Next_Formal (Formal);
!          end loop;
!       end Copy_Parameter_List;
! 
!       ---------------------------------
!       -- Verify_Overriding_Indicator --
!       ---------------------------------
! 
!       procedure Verify_Overriding_Indicator is
!       begin
!          if Must_Override (Body_Spec)
!            and then not Is_Overriding_Operation (Spec_Id)
!          then
!             Error_Msg_NE
!               ("subprogram& is not overriding", Body_Spec, Spec_Id);
! 
!          elsif Must_Not_Override (Body_Spec)
!               and then Is_Overriding_Operation (Spec_Id)
!          then
!             Error_Msg_NE
!               ("subprogram& overrides inherited operation",
!                  Body_Spec, Spec_Id);
!          end if;
!       end Verify_Overriding_Indicator;
  
     --  Start of processing for Analyze_Subprogram_Body
  
*************** package body Sem_Ch6 is
*** 983,988 ****
--- 1161,1168 ----
           end loop;
        end if;
  
+       Check_Inline_Pragma (Spec_Id);
+ 
        --  Case of fully private operation in the body of the protected type.
        --  We must create a declaration for the subprogram, in order to attach
        --  the protected subprogram that will be used in internal calls.
*************** package body Sem_Ch6 is
*** 1013,1034 ****
                 Plist := No_List;
              end if;
  
!             while Present (Formal) loop
!                Append
!                  (Make_Parameter_Specification (Loc,
!                    Defining_Identifier =>
!                      Make_Defining_Identifier (Sloc (Formal),
!                        Chars => Chars (Formal)),
!                    In_Present  => In_Present (Parent (Formal)),
!                    Out_Present => Out_Present (Parent (Formal)),
!                    Parameter_Type =>
!                      New_Reference_To (Etype (Formal), Loc),
!                    Expression =>
!                      New_Copy_Tree (Expression (Parent (Formal)))),
!                  Plist);
! 
!                Next_Formal (Formal);
!             end loop;
  
              if Nkind (Body_Spec) = N_Procedure_Specification then
                 New_Spec :=
--- 1193,1199 ----
                 Plist := No_List;
              end if;
  
!             Copy_Parameter_List (Plist);
  
              if Nkind (Body_Spec) = N_Procedure_Specification then
                 New_Spec :=
*************** package body Sem_Ch6 is
*** 1044,1050 ****
                        Make_Defining_Identifier (Sloc (Body_Id),
                          Chars => Chars (Body_Id)),
                      Parameter_Specifications => Plist,
!                     Subtype_Mark => New_Occurrence_Of (Etype (Body_Id), Loc));
              end if;
  
              Decl :=
--- 1209,1216 ----
                        Make_Defining_Identifier (Sloc (Body_Id),
                          Chars => Chars (Body_Id)),
                      Parameter_Specifications => Plist,
!                     Result_Definition =>
!                       New_Occurrence_Of (Etype (Body_Id), Loc));
              end if;
  
              Decl :=
*************** package body Sem_Ch6 is
*** 1066,1071 ****
--- 1232,1238 ----
  
        elsif Present (Spec_Id) then
           Spec_Decl := Unit_Declaration_Node (Spec_Id);
+          Verify_Overriding_Indicator;
        end if;
  
        --  Place subprogram on scope stack, and make formals visible. If there
*************** package body Sem_Ch6 is
*** 1073,1078 ****
--- 1240,1250 ----
  
        if Present (Spec_Id) then
           Generate_Reference (Spec_Id, Body_Id, 'b', Set_Ref => False);
+ 
+          if Is_Child_Unit (Spec_Id) then
+             Generate_Reference (Spec_Id, Scope (Spec_Id), 'k', False);
+          end if;
+ 
           if Style_Check then
              Style.Check_Identifier (Body_Id, Spec_Id);
           end if;
*************** package body Sem_Ch6 is
*** 1137,1142 ****
--- 1309,1335 ----
  
           if Nkind (N) /= N_Subprogram_Body_Stub then
              Set_Corresponding_Spec (N, Spec_Id);
+ 
+             --  Ada 2005 (AI-345): Restore the correct Etype: here we undo the
+             --  work done by Analyze_Subprogram_Specification to allow the
+             --  overriding of task, protected and interface primitives.
+ 
+             if Comes_From_Source (Spec_Id)
+               and then Present (First_Entity (Spec_Id))
+               and then Ekind (Etype (First_Entity (Spec_Id))) = E_Record_Type
+               and then Is_Tagged_Type (Etype (First_Entity (Spec_Id)))
+               and then Present (Abstract_Interfaces
+                                 (Etype (First_Entity (Spec_Id))))
+               and then Present (Corresponding_Concurrent_Type
+                                 (Etype (First_Entity (Spec_Id))))
+             then
+                Set_Etype (First_Entity (Spec_Id),
+                  Corresponding_Concurrent_Type
+                    (Etype (First_Entity (Spec_Id))));
+             end if;
+ 
+             --  Comment needed here, since this is not Ada 2005 stuff! ???
+ 
              Install_Formals (Spec_Id);
              Last_Formal := Last_Entity (Spec_Id);
              New_Scope (Spec_Id);
*************** package body Sem_Ch6 is
*** 1221,1234 ****
  
        elsif  Present (Spec_Id)
          and then Expander_Active
        then
!          Check_Following_Pragma;
! 
!          if Is_Always_Inlined (Spec_Id)
!            or else (Has_Pragma_Inline (Spec_Id) and then Front_End_Inlining)
!          then
!             Build_Body_To_Inline (N, Spec_Id);
!          end if;
        end if;
  
        --  Ada 2005 (AI-262): In library subprogram bodies, after the analysis
--- 1414,1424 ----
  
        elsif  Present (Spec_Id)
          and then Expander_Active
+         and then
+           (Is_Always_Inlined (Spec_Id)
+              or else (Has_Pragma_Inline (Spec_Id) and Front_End_Inlining))
        then
!          Build_Body_To_Inline (N, Spec_Id);
        end if;
  
        --  Ada 2005 (AI-262): In library subprogram bodies, after the analysis
*************** package body Sem_Ch6 is
*** 1501,1517 ****
  
        if Nkind (Parent (N)) = N_Compilation_Unit then
           Set_Body_Required (Parent (N), True);
        end if;
  
        Generate_Reference_To_Formals (Designator);
        Check_Eliminated (Designator);
  
!       if Comes_From_Source (N)
!         and then Is_List_Member (N)
        then
!          Check_Overriding_Operation (N, Designator);
        end if;
- 
     end Analyze_Subprogram_Declaration;
  
     --------------------------------------
--- 1691,1718 ----
  
        if Nkind (Parent (N)) = N_Compilation_Unit then
           Set_Body_Required (Parent (N), True);
+ 
+          if Ada_Version >= Ada_05
+            and then Nkind (Specification (N)) = N_Procedure_Specification
+            and then Null_Present (Specification (N))
+          then
+             Error_Msg_N
+               ("null procedure cannot be declared at library level", N);
+          end if;
        end if;
  
        Generate_Reference_To_Formals (Designator);
        Check_Eliminated (Designator);
  
!       --  Ada 2005: if procedure is declared with "is null" qualifier,
!       --  it requires no body.
! 
!       if Nkind (Specification (N)) = N_Procedure_Specification
!         and then Null_Present (Specification (N))
        then
!          Set_Has_Completion (Designator);
!          Set_Is_Inlined (Designator);
        end if;
     end Analyze_Subprogram_Declaration;
  
     --------------------------------------
*************** package body Sem_Ch6 is
*** 1526,1531 ****
--- 1727,1765 ----
        Designator : constant Entity_Id := Defining_Entity (N);
        Formals    : constant List_Id   := Parameter_Specifications (N);
  
+       function Has_Interface_Formals (T : List_Id) return Boolean;
+       --  Ada 2005 (AI-251): Returns true if some non class-wide interface
+       --  formal is found.
+ 
+       ---------------------------
+       -- Has_Interface_Formals --
+       ---------------------------
+ 
+       function Has_Interface_Formals (T : List_Id) return Boolean is
+          Param_Spec : Node_Id;
+          Formal     : Entity_Id;
+ 
+       begin
+          Param_Spec := First (T);
+ 
+          while Present (Param_Spec) loop
+             Formal := Defining_Identifier (Param_Spec);
+ 
+             if Is_Class_Wide_Type (Etype (Formal)) then
+                null;
+ 
+             elsif Is_Interface (Etype (Formal)) then
+                return True;
+             end if;
+ 
+             Next (Param_Spec);
+          end loop;
+ 
+          return False;
+       end Has_Interface_Formals;
+ 
+    --  Start of processing for Analyze_Subprogram_Specification
+ 
     begin
        Generate_Definition (Designator);
  
*************** package body Sem_Ch6 is
*** 1546,1551 ****
--- 1780,1809 ----
        if Present (Formals) then
           New_Scope (Designator);
           Process_Formals (Formals, N);
+ 
+          --  Ada 2005 (AI-345): Allow overriding primitives of protected
+          --  interfaces by means of normal subprograms. For this purpose
+          --  temporarily use the corresponding record type as the etype
+          --  of the first formal.
+ 
+          if Ada_Version >= Ada_05
+            and then Comes_From_Source (Designator)
+            and then Present (First_Entity (Designator))
+            and then (Ekind (Etype (First_Entity (Designator)))
+                              = E_Protected_Type
+                        or else
+                      Ekind (Etype (First_Entity (Designator)))
+                              = E_Task_Type)
+            and then Present (Corresponding_Record_Type
+                              (Etype (First_Entity (Designator))))
+            and then Present (Abstract_Interfaces
+                              (Corresponding_Record_Type
+                              (Etype (First_Entity (Designator)))))
+          then
+             Set_Etype (First_Entity (Designator),
+               Corresponding_Record_Type (Etype (First_Entity (Designator))));
+          end if;
+ 
           End_Scope;
  
        elsif Nkind (N) = N_Function_Specification then
*************** package body Sem_Ch6 is
*** 1573,1578 ****
--- 1831,1850 ----
           end if;
        end if;
  
+       if Ada_Version >= Ada_05
+         and then Comes_From_Source (N)
+         and then Nkind (Parent (N)) /= N_Abstract_Subprogram_Declaration
+         and then (Nkind (N) /= N_Procedure_Specification
+                     or else
+                   not Null_Present (N))
+         and then Has_Interface_Formals (Formals)
+       then
+          Error_Msg_Name_1 := Chars (Defining_Unit_Name
+                                     (Specification (Parent (N))));
+          Error_Msg_N
+            ("(Ada 2005) interface subprogram % must be abstract or null", N);
+       end if;
+ 
        return Designator;
     end Analyze_Subprogram_Specification;
  
*************** package body Sem_Ch6 is
*** 1640,1646 ****
              then
                 Conv := Current_Entity (Id);
  
!             elsif Nkind (Id) = N_Selected_Component
                and then Chars (Selector_Name (Id)) = Name_Unchecked_Conversion
              then
                 Conv := Current_Entity (Selector_Name (Id));
--- 1912,1919 ----
              then
                 Conv := Current_Entity (Id);
  
!             elsif (Nkind (Id) = N_Selected_Component
!                     or else Nkind (Id) = N_Expanded_Name)
                and then Chars (Selector_Name (Id)) = Name_Unchecked_Conversion
              then
                 Conv := Current_Entity (Selector_Name (Id));
*************** package body Sem_Ch6 is
*** 1649,1657 ****
                 return False;
              end if;
  
!             return
!               Present (Conv)
!               and then Scope (Conv) = Standard_Standard
                and then Is_Intrinsic_Subprogram (Conv);
           end Is_Unchecked_Conversion;
  
--- 1922,1930 ----
                 return False;
              end if;
  
!             return Present (Conv)
!               and then Is_Predefined_File_Name
!                          (Unit_File_Name (Get_Source_Unit (Conv)))
                and then Is_Intrinsic_Subprogram (Conv);
           end Is_Unchecked_Conversion;
  
*************** package body Sem_Ch6 is
*** 1948,1954 ****
        --  to be resolved.
  
        if Ekind (Subp) = E_Function then
!          Set_Subtype_Mark (Specification (Body_To_Analyze),
             New_Occurrence_Of (Etype (Subp), Sloc (N)));
        end if;
  
--- 2221,2227 ----
        --  to be resolved.
  
        if Ekind (Subp) = E_Function then
!          Set_Result_Definition (Specification (Body_To_Analyze),
             New_Occurrence_Of (Etype (Subp), Sloc (N)));
        end if;
  
*************** package body Sem_Ch6 is
*** 2018,2030 ****
     -----------------------
  
     procedure Check_Conformance
!      (New_Id   : Entity_Id;
!       Old_Id   : Entity_Id;
!       Ctype    : Conformance_Type;
!       Errmsg   : Boolean;
!       Conforms : out Boolean;
!       Err_Loc  : Node_Id := Empty;
!       Get_Inst : Boolean := False)
     is
        Old_Type   : constant Entity_Id := Etype (Old_Id);
        New_Type   : constant Entity_Id := Etype (New_Id);
--- 2291,2304 ----
     -----------------------
  
     procedure Check_Conformance
!      (New_Id                   : Entity_Id;
!       Old_Id                   : Entity_Id;
!       Ctype                    : Conformance_Type;
!       Errmsg                   : Boolean;
!       Conforms                 : out Boolean;
!       Err_Loc                  : Node_Id := Empty;
!       Get_Inst                 : Boolean := False;
!       Skip_Controlling_Formals : Boolean := False)
     is
        Old_Type   : constant Entity_Id := Etype (Old_Id);
        New_Type   : constant Entity_Id := Etype (New_Id);
*************** package body Sem_Ch6 is
*** 2106,2111 ****
--- 2380,2400 ----
              return;
           end if;
  
+          --  Ada 2005 (AI-231): In case of anonymous access types check the
+          --  null-exclusion and access-to-constant attributes must match.
+ 
+          if Ada_Version >= Ada_05
+            and then Ekind (Etype (Old_Type)) = E_Anonymous_Access_Type
+            and then
+              (Can_Never_Be_Null (Old_Type)
+                 /= Can_Never_Be_Null (New_Type)
+               or else Is_Access_Constant (Etype (Old_Type))
+                         /= Is_Access_Constant (Etype (New_Type)))
+          then
+             Conformance_Error ("return type does not match!", New_Id);
+             return;
+          end if;
+ 
        --  If either is a function/operator and the other isn't, error
  
        elsif Old_Type /= Standard_Void_Type
*************** package body Sem_Ch6 is
*** 2162,2167 ****
--- 2451,2463 ----
        New_Formal := First_Formal (New_Id);
  
        while Present (Old_Formal) and then Present (New_Formal) loop
+          if Is_Controlling_Formal (Old_Formal)
+            and then Is_Controlling_Formal (New_Formal)
+            and then Skip_Controlling_Formals
+          then
+             goto Skip_Controlling_Formal;
+          end if;
+ 
           if Ctype = Fully_Conformant then
  
              --  Names must match. Error message is more accurate if we do
*************** package body Sem_Ch6 is
*** 2213,2222 ****
  
           if Ctype = Fully_Conformant then
  
!             --  We have checked already that names match. Check default
!             --  expressions for in parameters
  
              if Parameter_Mode (Old_Formal) = E_In_Parameter then
                 declare
                    NewD : constant Boolean :=
                             Present (Default_Value (New_Formal));
--- 2509,2557 ----
  
           if Ctype = Fully_Conformant then
  
!             --  We have checked already that names match
  
              if Parameter_Mode (Old_Formal) = E_In_Parameter then
+ 
+                --  Ada 2005 (AI-231): In case of anonymous access types check
+                --  the null-exclusion and access-to-constant attributes must
+                --  match.
+ 
+                if Ada_Version >= Ada_05
+                  and then Ekind (Etype (Old_Formal)) = E_Anonymous_Access_Type
+                  and then
+                    (Can_Never_Be_Null (Old_Formal)
+                       /= Can_Never_Be_Null (New_Formal)
+                     or else Is_Access_Constant (Etype (Old_Formal))
+                               /= Is_Access_Constant (Etype (New_Formal)))
+                then
+                   --  It is allowed to omit the null-exclusion in case of
+                   --  stream attribute subprograms
+ 
+                   declare
+                      TSS_Name : TSS_Name_Type;
+ 
+                   begin
+                      Get_Name_String (Chars (New_Id));
+                      TSS_Name :=
+                        TSS_Name_Type
+                          (Name_Buffer
+                             (Name_Len - TSS_Name'Length + 1 .. Name_Len));
+ 
+                      if TSS_Name /= TSS_Stream_Read
+                        and then TSS_Name /= TSS_Stream_Write
+                        and then TSS_Name /= TSS_Stream_Input
+                        and then TSS_Name /= TSS_Stream_Output
+                      then
+                         Conformance_Error
+                           ("type of & does not match!", New_Formal);
+                         return;
+                      end if;
+                   end;
+                end if;
+ 
+                --  Check default expressions for in parameters
+ 
                 declare
                    NewD : constant Boolean :=
                             Present (Default_Value (New_Formal));
*************** package body Sem_Ch6 is
*** 2299,2304 ****
--- 2634,2643 ----
              end;
           end if;
  
+          --  This label is required when skipping controlling formals
+ 
+          <<Skip_Controlling_Formal>>
+ 
           Next_Formal (Old_Formal);
           Next_Formal (New_Formal);
        end loop;
*************** package body Sem_Ch6 is
*** 2311,2317 ****
           Conformance_Error ("too many parameters!", New_Formal);
           return;
        end if;
- 
     end Check_Conformance;
  
     ------------------------------
--- 2650,2655 ----
*************** package body Sem_Ch6 is
*** 2552,2558 ****
        Err_Loc : Node_Id := Empty)
     is
        Result : Boolean;
- 
     begin
        Check_Conformance
          (New_Id, Old_Id, Fully_Conformant, True, Result, Err_Loc);
--- 2890,2895 ----
*************** package body Sem_Ch6 is
*** 2576,2675 ****
     end Check_Mode_Conformant;
  
     --------------------------------
!    -- Check_Overriding_Operation --
     --------------------------------
  
!    procedure Check_Overriding_Operation
!      (N    : Node_Id;
!       Subp : Entity_Id)
     is
!       Arg1       : Node_Id;
!       Decl       : Node_Id;
!       Has_Pragma : Boolean := False;
  
     begin
!       --  See whether there is an overriding pragma immediately following
!       --  the declaration. Intervening pragmas, such as Inline, are allowed.
! 
!       Decl := Next (N);
!       while Present (Decl)
!         and then Nkind (Decl) = N_Pragma
!       loop
!          if Chars (Decl) = Name_Overriding
!            or else Chars (Decl) = Name_Optional_Overriding
!          then
!             --  For now disable the use of these pragmas, until the ARG
!             --  finalizes the design of this feature.
! 
!             Error_Msg_N ("?unrecognized pragma", Decl);
! 
!             if not Is_Overriding_Operation (Subp) then
! 
!                --  Before emitting an error message, check whether this
!                --  may override an operation that is not yet visible, as
!                --  in the case of a derivation of a private operation in
!                --  a child unit. Such an operation is introduced with a
!                --  different name, but its alias is the parent operation.
! 
!                declare
!                   E : Entity_Id;
! 
!                begin
!                   E := First_Entity (Current_Scope);
! 
!                   while Present (E) loop
!                      if Ekind (E) = Ekind (Subp)
!                        and then not Comes_From_Source (E)
!                        and then Present (Alias (E))
!                        and then Chars (Alias (E)) = Chars (Subp)
!                        and then In_Open_Scopes (Scope (Alias (E)))
!                      then
!                         exit;
!                      else
!                         Next_Entity (E);
!                      end if;
!                   end loop;
! 
!                   if No (E) then
!                      Error_Msg_NE
!                        ("& must override an inherited operation",
!                          Decl, Subp);
!                   end if;
!                end;
!             end if;
! 
!             --  Verify syntax of pragma
  
!             Arg1 := First (Pragma_Argument_Associations (Decl));
  
!             if Present (Arg1) then
!                if not Is_Entity_Name (Expression (Arg1)) then
!                   Error_Msg_N ("pragma applies to local subprogram", Decl);
  
!                elsif Chars (Expression (Arg1)) /= Chars (Subp) then
!                   Error_Msg_N
!                     ("pragma must apply to preceding subprogram", Decl);
  
!                elsif Present (Next (Arg1)) then
!                   Error_Msg_N ("illegal pragma format", Decl);
!                end if;
!             end if;
  
!             Set_Analyzed (Decl);
!             Has_Pragma := True;
!             exit;
           end if;
  
!          Next (Decl);
!       end loop;
! 
!       if not Has_Pragma
!         and then Explicit_Overriding
!         and then Is_Overriding_Operation (Subp)
!       then
!          Error_Msg_NE ("Missing overriding pragma for&", Subp, Subp);
        end if;
!    end Check_Overriding_Operation;
  
     -------------------
     -- Check_Returns --
--- 2913,2961 ----
     end Check_Mode_Conformant;
  
     --------------------------------
!    -- Check_Overriding_Indicator --
     --------------------------------
  
!    procedure Check_Overriding_Indicator
!      (Subp          : Entity_Id;
!       Does_Override : Boolean)
     is
!       Decl : Node_Id;
!       Spec : Node_Id;
  
     begin
!       if Ekind (Subp) = E_Enumeration_Literal then
  
!          --  No overriding indicator for literals
  
!          return;
  
!       else
!          Decl := Unit_Declaration_Node (Subp);
!       end if;
  
!       if Nkind (Decl) = N_Subprogram_Declaration
!         or else Nkind (Decl) = N_Subprogram_Body
!         or else Nkind (Decl) = N_Subprogram_Renaming_Declaration
!         or else Nkind (Decl) = N_Subprogram_Body_Stub
!       then
!          Spec := Specification (Decl);
!       else
!          return;
!       end if;
  
!       if not Does_Override then
!          if Must_Override (Spec) then
!             Error_Msg_NE ("subprogram& is not overriding", Spec, Subp);
           end if;
  
!       else
!          if Must_Not_Override (Spec) then
!             Error_Msg_NE
!               ("subprogram& overrides inherited operation", Spec, Subp);
!          end if;
        end if;
!    end Check_Overriding_Indicator;
  
     -------------------
     -- Check_Returns --
*************** package body Sem_Ch6 is
*** 3141,3151 ****
--- 3427,3445 ----
           then
              return True;
  
+          elsif From_With_Type (T2)
+            and then Ekind (T2) = E_Incomplete_Type
+            and then T1 = Non_Limited_View (T2)
+          then
+             return True;
+ 
           else
              return False;
           end if;
        end Base_Types_Match;
  
+       --  Start of processing for Conforming_Types
+ 
     begin
        --  The context is an instance association for a formal
        --  access-to-subprogram type; the formal parameter types require
*************** package body Sem_Ch6 is
*** 3186,3192 ****
             or else Subtypes_Statically_Match (Type_1, Full_View (Type_2));
        end if;
  
!       --  Ada 2005 (AI-254): Detect anonymous access to subprogram types
  
        Are_Anonymous_Access_To_Subprogram_Types :=
  
--- 3480,3487 ----
             or else Subtypes_Statically_Match (Type_1, Full_View (Type_2));
        end if;
  
!       --  Ada 2005 (AI-254): Anonymous access to subprogram types must be
!       --  treated recursively because they carry a signature.
  
        Are_Anonymous_Access_To_Subprogram_Types :=
  
*************** package body Sem_Ch6 is
*** 3227,3245 ****
              Desig_1 := Directly_Designated_Type (Type_1);
  
              --  An access parameter can designate an incomplete type
  
!             if Ekind (Desig_1) = E_Incomplete_Type
!               and then Present (Full_View (Desig_1))
!             then
!                Desig_1 := Full_View (Desig_1);
              end if;
  
              Desig_2 := Directly_Designated_Type (Type_2);
  
!             if Ekind (Desig_2) = E_Incomplete_Type
!               and then Present (Full_View (Desig_2))
!             then
!                Desig_2 := Full_View (Desig_2);
              end if;
  
              --  The context is an instance association for a formal
--- 3522,3548 ----
              Desig_1 := Directly_Designated_Type (Type_1);
  
              --  An access parameter can designate an incomplete type
+             --  If the incomplete type is the limited view of a type
+             --  from a limited_with_clause, check whether the non-limited
+             --  view is available.
  
!             if Ekind (Desig_1) = E_Incomplete_Type then
!                if Present (Full_View (Desig_1)) then
!                   Desig_1 := Full_View (Desig_1);
! 
!                elsif Present (Non_Limited_View (Desig_1)) then
!                   Desig_1 := Non_Limited_View (Desig_1);
!                end if;
              end if;
  
              Desig_2 := Directly_Designated_Type (Type_2);
  
!             if Ekind (Desig_2) = E_Incomplete_Type then
!                if Present (Full_View (Desig_2)) then
!                   Desig_2 := Full_View (Desig_2);
!                elsif Present (Non_Limited_View (Desig_2)) then
!                   Desig_2 := Non_Limited_View (Desig_2);
!                end if;
              end if;
  
              --  The context is an instance association for a formal
*************** package body Sem_Ch6 is
*** 3268,3277 ****
                      Etype (Base_Type (Desig_2)), Ctype);
  
              elsif Are_Anonymous_Access_To_Subprogram_Types then
!                return Ctype = Type_Conformant
!                         or else
                        Subtypes_Statically_Match (Desig_1, Desig_2);
  
              else
                 return Base_Type (Desig_1) = Base_Type (Desig_2)
                  and then (Ctype = Type_Conformant
--- 3571,3593 ----
                      Etype (Base_Type (Desig_2)), Ctype);
  
              elsif Are_Anonymous_Access_To_Subprogram_Types then
!                if Ada_Version < Ada_05 then
!                   return Ctype = Type_Conformant
!                     or else
                        Subtypes_Statically_Match (Desig_1, Desig_2);
  
+                --  We must check the conformance of the signatures themselves
+ 
+                else
+                   declare
+                      Conformant : Boolean;
+                   begin
+                      Check_Conformance
+                        (Desig_1, Desig_2, Ctype, False, Conformant);
+                      return Conformant;
+                   end;
+                end if;
+ 
              else
                 return Base_Type (Desig_1) = Base_Type (Desig_2)
                  and then (Ctype = Type_Conformant
*************** package body Sem_Ch6 is
*** 3285,3291 ****
        else
           return False;
        end if;
- 
     end Conforming_Types;
  
     --------------------------
--- 3601,3606 ----
*************** package body Sem_Ch6 is
*** 3642,3648 ****
  
     function Fully_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is
        Result : Boolean;
- 
     begin
        Check_Conformance (New_Id, Old_Id, Fully_Conformant, False, Result);
        return Result;
--- 3957,3962 ----
*************** package body Sem_Ch6 is
*** 4371,4398 ****
              Make_Function_Specification (Loc,
                Defining_Unit_Name => Op_Name,
                Parameter_Specifications => Formals,
!               Subtype_Mark => New_Reference_To (Standard_Boolean, Loc)));
  
        --  Insert inequality right after equality if it is explicit or after
!       --  the derived type when implicit. These entities are created only
!       --  for visibility purposes, and eventually replaced in the course of
        --  expansion, so they do not need to be attached to the tree and seen
        --  by the back-end. Keeping them internal also avoids spurious freezing
!       --  problems. The parent field is set simply to make analysis safe.
  
        if No (Alias (S)) then
!          Set_Parent (Decl, Parent (Unit_Declaration_Node (S)));
        else
!          Set_Parent (Decl, Parent (Parent (Etype (First_Formal (S)))));
        end if;
  
        Mark_Rewrite_Insertion (Decl);
        Set_Is_Intrinsic_Subprogram (Op_Name);
        Analyze (Decl);
        Set_Has_Completion (Op_Name);
        Set_Corresponding_Equality (Op_Name, S);
        Set_Is_Abstract (Op_Name, Is_Abstract (S));
- 
     end Make_Inequality_Operator;
  
     ----------------------
--- 4685,4718 ----
              Make_Function_Specification (Loc,
                Defining_Unit_Name => Op_Name,
                Parameter_Specifications => Formals,
!               Result_Definition => New_Reference_To (Standard_Boolean, Loc)));
  
        --  Insert inequality right after equality if it is explicit or after
!       --  the derived type when implicit. These entities are created only for
!       --  visibility purposes, and eventually replaced in the course of
        --  expansion, so they do not need to be attached to the tree and seen
        --  by the back-end. Keeping them internal also avoids spurious freezing
!       --  problems. The declaration is inserted in the tree for analysis, and
!       --  removed afterwards. If the equality operator comes from an explicit
!       --  declaration, attach the inequality immediately after. Else the
!       --  equality is inherited from a derived type declaration, so insert
!       --  inequality after that declaration.
  
        if No (Alias (S)) then
!          Insert_After (Unit_Declaration_Node (S), Decl);
!       elsif Is_List_Member (Parent (S)) then
!          Insert_After (Parent (S), Decl);
        else
!          Insert_After (Parent (Etype (First_Formal (S))), Decl);
        end if;
  
        Mark_Rewrite_Insertion (Decl);
        Set_Is_Intrinsic_Subprogram (Op_Name);
        Analyze (Decl);
+       Remove (Decl);
        Set_Has_Completion (Op_Name);
        Set_Corresponding_Equality (Op_Name, S);
        Set_Is_Abstract (Op_Name, Is_Abstract (S));
     end Make_Inequality_Operator;
  
     ----------------------
*************** package body Sem_Ch6 is
*** 4438,4449 ****
--- 4758,4775 ----
       (S            : Entity_Id;
        Derived_Type : Entity_Id := Empty)
     is
+       Does_Override : Boolean := False;
+       --  Set if the current scope has an operation that is type-conformant
+       --  with S, and becomes hidden by S.
+ 
        E : Entity_Id;
        --  Entity that S overrides
  
        Prev_Vis : Entity_Id := Empty;
        --  Needs comment ???
  
+       Is_Alias_Interface : Boolean := False;
+ 
        function Is_Private_Declaration (E : Entity_Id) return Boolean;
        --  Check that E is declared in the private part of the current package,
        --  or in the package body, where it may hide a previous declaration.
*************** package body Sem_Ch6 is
*** 4464,4470 ****
           Decl       : constant Node_Id := Unit_Declaration_Node (E);
  
        begin
!          if Is_Package (Current_Scope)
             and then In_Private_Part (Current_Scope)
           then
              Priv_Decls :=
--- 4790,4796 ----
           Decl       : constant Node_Id := Unit_Declaration_Node (E);
  
        begin
!          if Is_Package_Or_Generic_Package (Current_Scope)
             and then In_Private_Part (Current_Scope)
           then
              Priv_Decls :=
*************** package body Sem_Ch6 is
*** 4472,4478 ****
                  Specification (Unit_Declaration_Node (Current_Scope)));
  
              return In_Package_Body (Current_Scope)
!               or else List_Containing (Decl) = Priv_Decls
                or else (Nkind (Parent (Decl)) = N_Package_Specification
                           and then not Is_Compilation_Unit (
                             Defining_Entity (Parent (Decl)))
--- 4798,4806 ----
                  Specification (Unit_Declaration_Node (Current_Scope)));
  
              return In_Package_Body (Current_Scope)
!               or else
!                 (Is_List_Member (Decl)
!                    and then List_Containing (Decl) = Priv_Decls)
                or else (Nkind (Parent (Decl)) = N_Package_Specification
                           and then not Is_Compilation_Unit (
                             Defining_Entity (Parent (Decl)))
*************** package body Sem_Ch6 is
*** 4520,4527 ****
                   and then Is_Abstract (S)
                   and then (not Is_Overriding or else not Is_Abstract (E))
                 then
!                   Error_Msg_N ("abstract subprograms must be visible "
!                                 & "('R'M 3.9.3(10))!", S);
  
                 elsif Ekind (S) = E_Function
                   and then Is_Tagged_Type (T)
--- 4848,4864 ----
                   and then Is_Abstract (S)
                   and then (not Is_Overriding or else not Is_Abstract (E))
                 then
!                   if not Is_Interface (T) then
!                      Error_Msg_N ("abstract subprograms must be visible "
!                                    & "('R'M 3.9.3(10))!", S);
! 
!                   --  Ada 2005 (AI-251)
! 
!                   else
!                      Error_Msg_N ("primitive subprograms of interface types "
!                        & "declared in a visible part, must be declared in "
!                        & "the visible part ('R'M 3.9.4)!", S);
!                   end if;
  
                 elsif Ekind (S) = E_Function
                   and then Is_Tagged_Type (T)
*************** package body Sem_Ch6 is
*** 4648,4653 ****
--- 4985,4999 ----
           Check_Dispatching_Operation (S, Empty);
           Maybe_Primitive_Operation;
  
+          --  Ada 2005 (AI-397): Subprograms in the context of protected
+          --  types have their overriding indicators checked in Sem_Ch9.
+ 
+          if Ekind (S) not in Subprogram_Kind
+            or else Ekind (Scope (S)) /= E_Protected_Type
+          then
+             Check_Overriding_Indicator (S, False);
+          end if;
+ 
        --  If there is a homonym that is not overloadable, then we have an
        --  error, except for the special cases checked explicitly below.
  
*************** package body Sem_Ch6 is
*** 4671,4676 ****
--- 5017,5023 ----
              Enter_Overloaded_Entity (S);
              Set_Homonym (S, Homonym (E));
              Check_Dispatching_Operation (S, Empty);
+             Check_Overriding_Indicator (S, False);
  
           --  If the subprogram is implicit it is hidden by the previous
           --  declaration. However if it is dispatching, it must appear in the
*************** package body Sem_Ch6 is
*** 4704,4709 ****
--- 5051,5062 ----
        --  E exists and is overloadable
  
        else
+          Is_Alias_Interface :=
+             Present (Alias (S))
+             and then Is_Dispatching_Operation (Alias (S))
+             and then Present (DTC_Entity (Alias (S)))
+             and then Is_Interface (Scope (DTC_Entity (Alias (S))));
+ 
           --  Loop through E and its homonyms to determine if any of them is
           --  the candidate for overriding by S.
  
*************** package body Sem_Ch6 is
*** 4716,4723 ****
  
              --  Check if we have type conformance
  
!             elsif Type_Conformant (E, S) then
  
                 --  If the old and new entities have the same profile and one
                 --  is not the body of the other, then this is an error, unless
                 --  one of them is implicitly declared.
--- 5069,5081 ----
  
              --  Check if we have type conformance
  
!             --  Ada 2005 (AI-251): In case of overriding an interface
!             --  subprogram it is not an error that the old and new entities
!             --  have the same profile, and hence we skip this code.
  
+             elsif not Is_Alias_Interface
+               and then Type_Conformant (E, S)
+             then
                 --  If the old and new entities have the same profile and one
                 --  is not the body of the other, then this is an error, unless
                 --  one of them is implicitly declared.
*************** package body Sem_Ch6 is
*** 4750,4756 ****
                    --  the fact that the full view of a private extension
                    --  re-inherits. It has to be dealt with.
  
!                   if Is_Package (Current_Scope)
                      and then In_Private_Part (Current_Scope)
                    then
                       Check_Operation_From_Private_View (S, E);
--- 5108,5114 ----
                    --  the fact that the full view of a private extension
                    --  re-inherits. It has to be dealt with.
  
!                   if Is_Package_Or_Generic_Package (Current_Scope)
                      and then In_Private_Part (Current_Scope)
                    then
                       Check_Operation_From_Private_View (S, E);
*************** package body Sem_Ch6 is
*** 4760,4765 ****
--- 5118,5137 ----
                    --  the existing declaration, which is overriding.
  
                    Set_Is_Overriding_Operation (E);
+ 
+                   if Comes_From_Source (E) then
+                      Check_Overriding_Indicator (E, True);
+ 
+                      --  Indicate that E overrides the operation from which
+                      --  S is inherited.
+ 
+                      if  Present (Alias (S)) then
+                         Set_Overridden_Operation (E, Alias (S));
+                      else
+                         Set_Overridden_Operation (E, S);
+                      end if;
+                   end if;
+ 
                    return;
  
                    --  Within an instance, the renaming declarations for
*************** package body Sem_Ch6 is
*** 4803,4808 ****
--- 5175,5182 ----
                    --  replaced in the list of primitive operations of its type
                    --  (see Override_Dispatching_Operation).
  
+                   Does_Override := True;
+ 
                    declare
                       Prev : Entity_Id;
  
*************** package body Sem_Ch6 is
*** 4858,4864 ****
  
                          --  If the private operation is dispatching, we achieve
                          --  the overriding by keeping the implicit operation
!                         --  but setting its alias to be the overring one. In
                          --  this fashion the proper body is executed in all
                          --  cases, but the original signature is used outside
                          --  of the package.
--- 5232,5238 ----
  
                          --  If the private operation is dispatching, we achieve
                          --  the overriding by keeping the implicit operation
!                         --  but setting its alias to be the overriding one. In
                          --  this fashion the proper body is executed in all
                          --  cases, but the original signature is used outside
                          --  of the package.
*************** package body Sem_Ch6 is
*** 4910,4915 ****
--- 5284,5301 ----
  
                       Enter_Overloaded_Entity (S);
                       Set_Is_Overriding_Operation (S);
+                      Check_Overriding_Indicator (S, True);
+ 
+                      --  Indicate that S overrides the operation from which
+                      --  E is inherited.
+ 
+                      if Comes_From_Source (S) then
+                         if  Present (Alias (E)) then
+                            Set_Overridden_Operation (S, Alias (E));
+                         else
+                            Set_Overridden_Operation (S, E);
+                         end if;
+                      end if;
  
                       if Is_Dispatching_Operation (E) then
  
*************** package body Sem_Ch6 is
*** 4919,4925 ****
--- 5305,5350 ----
  
                          Set_Convention (S, Convention (E));
  
+                         --  AI-251: For an entity overriding an interface
+                         --  primitive check if the entity also covers other
+                         --  abstract subprograms in the same scope. This is
+                         --  required to handle the general case, that is,
+                         --  1) overriding other interface primitives, and
+                         --  2) overriding abstract subprograms inherited from
+                         --  some abstract ancestor type.
+ 
+                         if Has_Homonym (E)
+                           and then Present (Alias (E))
+                           and then Ekind (Alias (E)) /= E_Operator
+                           and then Present (DTC_Entity (Alias (E)))
+                           and then Is_Interface (Scope (DTC_Entity
+                                                         (Alias (E))))
+                         then
+                            declare
+                               E1 : Entity_Id;
+ 
+                            begin
+                               E1 := Homonym (E);
+                               while Present (E1) loop
+                                  if (Is_Overloadable (E1)
+                                        or else Ekind (E1) = E_Subprogram_Type)
+                                    and then Present (Alias (E1))
+                                    and then Ekind (Alias (E1)) /= E_Operator
+                                    and then Present (DTC_Entity (Alias (E1)))
+                                    and then Is_Abstract
+                                               (Scope (DTC_Entity (Alias (E1))))
+                                    and then Type_Conformant (E1, S)
+                                  then
+                                     Check_Dispatching_Operation (S, E1);
+                                  end if;
+ 
+                                  E1 := Homonym (E1);
+                               end loop;
+                            end;
+                         end if;
+ 
                          Check_Dispatching_Operation (S, E);
+ 
                       else
                          Check_Dispatching_Operation (S, Empty);
                       end if;
*************** package body Sem_Ch6 is
*** 4976,4981 ****
--- 5401,5407 ----
  
           Enter_Overloaded_Entity (S);
           Maybe_Primitive_Operation;
+          Check_Overriding_Indicator (S, Does_Override);
  
           --  If S is a derived operation for an untagged type then by
           --  definition it's not a dispatching operation (even if the parent
*************** package body Sem_Ch6 is
*** 5066,5077 ****
                          and then Ekind (Root_Type (Formal_Type)) =
                                                           E_Incomplete_Type)
              then
!                --  Ada 2005 (AI-50217): Incomplete tagged types that are made
!                --  visible by a limited with_clause are valid formal types.
  
!                if From_With_Type (Formal_Type)
!                  and then Is_Tagged_Type (Formal_Type)
!                then
                    null;
  
                 elsif Nkind (Parent (T)) /= N_Access_Function_Definition
--- 5492,5500 ----
                          and then Ekind (Root_Type (Formal_Type)) =
                                                           E_Incomplete_Type)
              then
!                --  Ada 2005 (AI-326): Tagged incomplete types allowed
  
!                if Is_Tagged_Type (Formal_Type) then
                    null;
  
                 elsif Nkind (Parent (T)) /= N_Access_Function_Definition
*************** package body Sem_Ch6 is
*** 5087,5157 ****
  
              --  Ada 2005 (AI-231): Create and decorate an internal subtype
              --  declaration corresponding to the null-excluding type of the
!             --  formal in the enclosing scope. In addition, replace the
!             --  parameter type of the formal to this internal subtype.
! 
!             if Null_Exclusion_Present (Param_Spec) then
!                declare
!                   Loc   : constant Source_Ptr := Sloc (Param_Spec);
! 
!                   Anon  : constant Entity_Id :=
!                             Make_Defining_Identifier (Loc,
!                               Chars => New_Internal_Name ('S'));
! 
!                   Curr_Scope : constant Scope_Stack_Entry :=
!                                  Scope_Stack.Table (Scope_Stack.Last);
! 
!                   Ptype : constant Node_Id := Parameter_Type (Param_Spec);
!                   Decl  : Node_Id;
!                   P     : Node_Id := Parent (Parent (Related_Nod));
! 
!                begin
!                   Set_Is_Internal (Anon);
! 
!                   Decl :=
!                     Make_Subtype_Declaration (Loc,
!                       Defining_Identifier      => Anon,
!                         Null_Exclusion_Present => True,
!                         Subtype_Indication     =>
!                           New_Occurrence_Of (Etype (Ptype), Loc));
! 
!                   --  Propagate the null-excluding attribute to the new entity
! 
!                   if Null_Exclusion_Present (Param_Spec) then
!                      Set_Null_Exclusion_Present (Param_Spec, False);
!                      Set_Can_Never_Be_Null (Anon);
!                   end if;
! 
!                   Mark_Rewrite_Insertion (Decl);
! 
!                   --  Insert the new declaration in the nearest enclosing scope
! 
!                   while not Has_Declarations (P) loop
!                      P := Parent (P);
!                   end loop;
! 
!                   Prepend (Decl, Declarations (P));
! 
!                   Rewrite (Ptype, New_Occurrence_Of (Anon, Loc));
!                   Mark_Rewrite_Insertion (Ptype);
! 
!                   --  Analyze the new declaration in the context of the
!                   --  enclosing scope
! 
!                   Scope_Stack.Decrement_Last;
!                   Analyze (Decl);
!                   Scope_Stack.Append (Curr_Scope);
! 
!                   Formal_Type := Anon;
!                end;
!             end if;
! 
!             --  Ada 2005 (AI-231): Static checks
  
!             if Null_Exclusion_Present (Param_Spec)
!               or else Can_Never_Be_Null (Entity (Ptype))
              then
!                Null_Exclusion_Static_Checks (Param_Spec);
              end if;
  
           --  An access formal type
--- 5510,5535 ----
  
              --  Ada 2005 (AI-231): Create and decorate an internal subtype
              --  declaration corresponding to the null-excluding type of the
!             --  formal in the enclosing scope. Finally, replace the parameter
!             --  type of the formal with the internal subtype.
  
!             if Ada_Version >= Ada_05
!               and then Is_Access_Type (Formal_Type)
!               and then Null_Exclusion_Present (Param_Spec)
              then
!                if Can_Never_Be_Null (Formal_Type)
!                  and then Comes_From_Source (Related_Nod)
!                then
!                   Error_Msg_N
!                     ("null exclusion must apply to a type that does not "
!                        & "exclude null ('R'M 3.10 (14)", Related_Nod);
!                end if;
! 
!                Formal_Type :=
!                  Create_Null_Excluding_Itype
!                    (T           => Formal_Type,
!                     Related_Nod => Related_Nod,
!                     Scope_Id    => Scope (Current_Scope));
              end if;
  
           --  An access formal type
*************** package body Sem_Ch6 is
*** 5190,5200 ****
  
              Analyze_Per_Use_Expression (Default, Formal_Type);
  
!             --  Check that the designated type of an access parameter's
!             --  default is not a class-wide type unless the parameter's
!             --  designated type is also class-wide.
  
              if Ekind (Formal_Type) = E_Anonymous_Access_Type
                and then Is_Class_Wide_Default (Default)
                and then not Is_Class_Wide_Type (Designated_Type (Formal_Type))
              then
--- 5568,5579 ----
  
              Analyze_Per_Use_Expression (Default, Formal_Type);
  
!             --  Check that the designated type of an access parameter's default
!             --  is not a class-wide type unless the parameter's designated type
!             --  is also class-wide.
  
              if Ekind (Formal_Type) = E_Anonymous_Access_Type
+               and then not From_With_Type (Formal_Type)
                and then Is_Class_Wide_Default (Default)
                and then not Is_Class_Wide_Type (Designated_Type (Formal_Type))
              then
*************** package body Sem_Ch6 is
*** 5203,5208 ****
--- 5582,5596 ----
              end if;
           end if;
  
+          --  Ada 2005 (AI-231): Static checks
+ 
+          if Ada_Version >= Ada_05
+            and then Is_Access_Type (Etype (Formal))
+            and then Can_Never_Be_Null (Etype (Formal))
+          then
+             Null_Exclusion_Static_Checks (Param_Spec);
+          end if;
+ 
        <<Continue>>
           Next (Param_Spec);
        end loop;
*************** package body Sem_Ch6 is
*** 5325,5342 ****
           elsif Is_Array_Type (T) then
              AS_Needed := True;
  
!          --  The only other case which needs an actual subtype is an
!          --  unconstrained record type which is an IN parameter (we cannot
!          --  generate actual subtypes for the OUT or IN OUT case, since an
!          --  assignment can change the discriminant values. However we exclude
!          --  the case of initialization procedures, since discriminants are
!          --  handled very specially in this context, see the section entitled
!          --  "Handling of Discriminants" in Einfo. We also exclude the case of
!          --  Discrim_SO_Functions (functions used in front end layout mode for
!          --  size/offset values), since in such functions only discriminants
!          --  are referenced, and not only are such subtypes not needed, but
!          --  they cannot always be generated, because of order of elaboration
!          --  issues.
  
           elsif Is_Record_Type (T)
             and then Ekind (Formal) = E_In_Parameter
--- 5713,5731 ----
           elsif Is_Array_Type (T) then
              AS_Needed := True;
  
!          --  The only other case needing an actual subtype is an unconstrained
!          --  record type which is an IN parameter (we cannot generate actual
!          --  subtypes for the OUT or IN OUT case, since an assignment can
!          --  change the discriminant values. However we exclude the case of
!          --  initialization procedures, since discriminants are handled very
!          --  specially in this context, see the section entitled "Handling of
!          --  Discriminants" in Einfo.
! 
!          --  We also exclude the case of Discrim_SO_Functions (functions used
!          --  in front end layout mode for size/offset values), since in such
!          --  functions only discriminants are referenced, and not only are such
!          --  subtypes not needed, but they cannot always be generated, because
!          --  of order of elaboration issues.
  
           elsif Is_Record_Type (T)
             and then Ekind (Formal) = E_In_Parameter
*************** package body Sem_Ch6 is
*** 5454,5468 ****
  
        if Nkind (Parameter_Type (Spec)) = N_Access_Definition then
  
!          --  Ada 2005 (AI-231): This behaviour has been modified in Ada 2005.
!          --  It is only forced if the null_exclusion appears.
  
           if Ada_Version < Ada_05
!            or else Null_Exclusion_Present (Spec)
           then
              Set_Is_Known_Non_Null (Formal_Id);
              Set_Can_Never_Be_Null (Formal_Id);
           end if;
        end if;
  
        Set_Mechanism (Formal_Id, Default_Mechanism);
--- 5843,5864 ----
  
        if Nkind (Parameter_Type (Spec)) = N_Access_Definition then
  
!          --  Ada 2005 (AI-231): In Ada95, access parameters are always non-
!          --  null; In Ada 2005, only if then null_exclusion is explicit.
  
           if Ada_Version < Ada_05
!            or else Can_Never_Be_Null (Etype (Formal_Id))
           then
              Set_Is_Known_Non_Null (Formal_Id);
              Set_Can_Never_Be_Null (Formal_Id);
           end if;
+ 
+       --  Ada 2005 (AI-231): Null-exclusion access subtype
+ 
+       elsif Is_Access_Type (Etype (Formal_Id))
+         and then Can_Never_Be_Null (Etype (Formal_Id))
+       then
+          Set_Is_Known_Non_Null (Formal_Id);
        end if;
  
        Set_Mechanism (Formal_Id, Default_Mechanism);
*************** package body Sem_Ch6 is
*** 5511,5517 ****
  
     function Subtype_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is
        Result : Boolean;
- 
     begin
        Check_Conformance (New_Id, Old_Id, Subtype_Conformant, False, Result);
        return Result;
--- 5907,5912 ----
*************** package body Sem_Ch6 is
*** 5521,5530 ****
     -- Type_Conformant --
     ---------------------
  
!    function Type_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is
        Result : Boolean;
     begin
!       Check_Conformance (New_Id, Old_Id, Type_Conformant, False, Result);
        return Result;
     end Type_Conformant;
  
--- 5916,5931 ----
     -- Type_Conformant --
     ---------------------
  
!    function Type_Conformant
!      (New_Id                   : Entity_Id;
!       Old_Id                   : Entity_Id;
!       Skip_Controlling_Formals : Boolean := False) return Boolean
!    is
        Result : Boolean;
     begin
!       Check_Conformance
!         (New_Id, Old_Id, Type_Conformant, False, Result,
!          Skip_Controlling_Formals => Skip_Controlling_Formals);
        return Result;
     end Type_Conformant;
  
*************** package body Sem_Ch6 is
*** 5540,5546 ****
  
     begin
        F := First_Formal (Designator);
- 
        while Present (F) loop
           N := N + 1;
  
--- 5941,5946 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch6.ads gcc-4.1.0/gcc/ada/sem_ch6.ads
*** gcc-4.0.2/gcc/ada/sem_ch6.ads	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_ch6.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Ch6 is
*** 143,153 ****
     procedure New_Overloaded_Entity
       (S            : Entity_Id;
        Derived_Type : Entity_Id := Empty);
!    --  Process new overloaded entity. Overloaded entities are created
!    --  by enumeration type declarations, subprogram specifications,
!    --  entry declarations, and (implicitly) by type derivations.
!    --  If Derived_Type is not Empty, then it indicates that this
!    --  is subprogram derived for that type.
  
     procedure Process_Formals (T : List_Id; Related_Nod : Node_Id);
     --  Enter the formals in the scope of the subprogram or entry, and
--- 143,152 ----
     procedure New_Overloaded_Entity
       (S            : Entity_Id;
        Derived_Type : Entity_Id := Empty);
!    --  Process new overloaded entity. Overloaded entities are created by
!    --  enumeration type declarations, subprogram specifications, entry
!    --  declarations, and (implicitly) by type derivations. Derived_Type non-
!    --  Empty indicates that this is subprogram derived for that type.
  
     procedure Process_Formals (T : List_Id; Related_Nod : Node_Id);
     --  Enter the formals in the scope of the subprogram or entry, and
*************** package Sem_Ch6 is
*** 168,178 ****
  
     function Subtype_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
     --  Determine whether two callable entities (subprograms, entries,
!    --  literals) are subtype conformant (RM6.3.1(16))
  
!    function Type_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
     --  Determine whether two callable entities (subprograms, entries,
!    --  literals) are type conformant (RM6.3.1(14))
  
     procedure Valid_Operator_Definition (Designator : Entity_Id);
     --  Verify that an operator definition has the proper number of formals
--- 167,180 ----
  
     function Subtype_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
     --  Determine whether two callable entities (subprograms, entries,
!    --  literals) are subtype conformant (RM6.3.1(16)).
  
!    function Type_Conformant
!      (New_Id                   : Entity_Id;
!       Old_Id                   : Entity_Id;
!       Skip_Controlling_Formals : Boolean := False) return Boolean;
     --  Determine whether two callable entities (subprograms, entries,
!    --  literals) are type conformant (RM6.3.1(14)).
  
     procedure Valid_Operator_Definition (Designator : Entity_Id);
     --  Verify that an operator definition has the proper number of formals
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch7.adb gcc-4.1.0/gcc/ada/sem_ch7.adb
*** gcc-4.0.2/gcc/ada/sem_ch7.adb	Thu Feb 10 13:56:10 2005
--- gcc-4.1.0/gcc/ada/sem_ch7.adb	Tue Nov 15 14:03:10 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Ch7 is
*** 195,201 ****
           Spec_Id := Current_Entity_In_Scope (Defining_Entity (N));
  
           if Present (Spec_Id)
!            and then Is_Package (Spec_Id)
           then
              Pack_Decl := Unit_Declaration_Node (Spec_Id);
  
--- 195,201 ----
           Spec_Id := Current_Entity_In_Scope (Defining_Entity (N));
  
           if Present (Spec_Id)
!            and then Is_Package_Or_Generic_Package (Spec_Id)
           then
              Pack_Decl := Unit_Declaration_Node (Spec_Id);
  
*************** package body Sem_Ch7 is
*** 213,219 ****
              return;
           end if;
  
!          if Is_Package (Spec_Id)
             and then
               (Scope (Spec_Id) = Standard_Standard
                 or else Is_Child_Unit (Spec_Id))
--- 213,219 ----
              return;
           end if;
  
!          if Is_Package_Or_Generic_Package (Spec_Id)
             and then
               (Scope (Spec_Id) = Standard_Standard
                 or else Is_Child_Unit (Spec_Id))
*************** package body Sem_Ch7 is
*** 623,628 ****
--- 623,639 ----
        PF : Boolean;
  
     begin
+       --  Ada 2005 (AI-217): Check if the package has been erroneously named
+       --  in a limited-with clause of its own context. In this case the error
+       --  has been previously notified by Analyze_Context.
+ 
+       --     limited with Pkg; -- ERROR
+       --     package Pkg is ...
+ 
+       if From_With_Type (Id) then
+          return;
+       end if;
+ 
        Generate_Definition (Id);
        Enter_Name (Id);
        Set_Ekind (Id, E_Package);
*************** package body Sem_Ch7 is
*** 702,707 ****
--- 713,726 ----
        --  the error message "Unchecked_Union may not complete discriminated
        --  partial view".
  
+       procedure Install_Parent_Private_Declarations (Inst_Id : Entity_Id);
+       --  Given the package entity of a generic package instantiation or
+       --  formal package whose corresponding generic is a child unit, installs
+       --  the private declarations of each of the child unit's parents.
+       --  This has to be done at the point of entering the instance package's
+       --  private part rather than being done in Sem_Ch12.Install_Parent
+       --  (which is where the parents' visible declarations are installed).
+ 
        ---------------------
        -- Clear_Constants --
        ---------------------
*************** package body Sem_Ch7 is
*** 870,875 ****
--- 889,958 ----
           end loop;
        end Inspect_Unchecked_Union_Completion;
  
+       -----------------------------------------
+       -- Install_Parent_Private_Declarations --
+       -----------------------------------------
+ 
+       procedure Install_Parent_Private_Declarations (Inst_Id : Entity_Id) is
+          Inst_Par  : Entity_Id := Inst_Id;
+          Gen_Par   : Entity_Id;
+          Inst_Node : Node_Id;
+ 
+       begin
+          Gen_Par :=
+            Generic_Parent (Specification (Unit_Declaration_Node (Inst_Par)));
+          while Present (Gen_Par) and then Is_Child_Unit (Gen_Par) loop
+             Inst_Node := Get_Package_Instantiation_Node (Inst_Par);
+ 
+             if (Nkind (Inst_Node) = N_Package_Instantiation
+                   or else Nkind (Inst_Node) = N_Formal_Package_Declaration)
+               and then Nkind (Name (Inst_Node)) = N_Expanded_Name
+             then
+                Inst_Par := Entity (Prefix (Name (Inst_Node)));
+ 
+                if Present (Renamed_Entity (Inst_Par)) then
+                   Inst_Par := Renamed_Entity (Inst_Par);
+                end if;
+ 
+                Gen_Par :=
+                  Generic_Parent
+                    (Specification (Unit_Declaration_Node (Inst_Par)));
+ 
+                --  Install the private declarations and private use clauses
+                --  of a parent instance of the child instance.
+ 
+                if Present (Gen_Par) then
+                   Install_Private_Declarations (Inst_Par);
+                   Set_Use (Private_Declarations
+                              (Specification
+                                 (Unit_Declaration_Node (Inst_Par))));
+ 
+                --  If we've reached the end of the generic instance parents,
+                --  then finish off by looping through the nongeneric parents
+                --  and installing their private declarations.
+ 
+                else
+                   while Present (Inst_Par)
+                     and then Inst_Par /= Standard_Standard
+                     and then (not In_Open_Scopes (Inst_Par)
+                                 or else not In_Private_Part (Inst_Par))
+                   loop
+                      Install_Private_Declarations (Inst_Par);
+                      Set_Use (Private_Declarations
+                                 (Specification
+                                    (Unit_Declaration_Node (Inst_Par))));
+                      Inst_Par := Scope (Inst_Par);
+                   end loop;
+ 
+                   exit;
+                end if;
+ 
+             else
+                exit;
+             end if;
+          end loop;
+       end Install_Parent_Private_Declarations;
+ 
     --  Start of processing for Analyze_Package_Specification
  
     begin
*************** package body Sem_Ch7 is
*** 963,968 ****
--- 1046,1065 ----
           Install_Private_With_Clauses (Id);
        end if;
  
+       --  If this is a package associated with a generic instance or formal
+       --  package, then the private declarations of each of the generic's
+       --  parents must be installed at this point.
+ 
+       if Is_Generic_Instance (Id)
+         or else
+           (Nkind (Unit_Declaration_Node (Id)) = N_Generic_Package_Declaration
+              and then
+            Nkind (Original_Node (Unit_Declaration_Node (Id)))
+              = N_Formal_Package_Declaration)
+       then
+          Install_Parent_Private_Declarations (Id);
+       end if;
+ 
        --  Analyze private part if present. The flag In_Private_Part is
        --  reset in End_Package_Scope.
  
*************** package body Sem_Ch7 is
*** 1114,1161 ****
        Found_Explicit : Boolean;
        Decl_Privates  : Boolean;
  
-       function Has_Overriding_Pragma (Subp : Entity_Id) return Boolean;
-       --  Check whether a pragma Overriding has been provided for a primitive
-       --  operation that is found to be overriding in the private part.
- 
        function Is_Primitive_Of (T : Entity_Id; S : Entity_Id) return Boolean;
        --  Check whether an inherited subprogram is an operation of an
        --  untagged derived type.
  
-       ---------------------------
-       -- Has_Overriding_Pragma --
-       ---------------------------
- 
-       function Has_Overriding_Pragma (Subp : Entity_Id) return Boolean is
-          Decl : constant Node_Id := Unit_Declaration_Node (Subp);
-          Prag : Node_Id;
- 
-       begin
-          if No (Decl)
-            or else Nkind (Decl) /= N_Subprogram_Declaration
-            or else No (Next (Decl))
-          then
-             return False;
- 
-          else
-             Prag := Next (Decl);
- 
-             while Present (Prag)
-               and then Nkind (Prag) = N_Pragma
-             loop
-                if Chars (Prag) = Name_Overriding
-                  or else Chars (Prag) = Name_Optional_Overriding
-                then
-                   return True;
-                else
-                   Next (Prag);
-                end if;
-             end loop;
-          end if;
- 
-          return False;
-       end Has_Overriding_Pragma;
- 
        ---------------------
        -- Is_Primitive_Of --
        ---------------------
--- 1211,1220 ----
*************** package body Sem_Ch7 is
*** 1238,1257 ****
                             Replace_Elmt (Op_Elmt, New_Op);
                             Remove_Elmt (Op_List, Op_Elmt_2);
                             Found_Explicit := True;
                             Decl_Privates  := True;
  
-                            --  If explicit_overriding is in effect, check that
-                            --  the overriding operation is properly labelled.
- 
-                            if Explicit_Overriding
-                              and then Comes_From_Source (New_Op)
-                               and then not Has_Overriding_Pragma (New_Op)
-                            then
-                               Error_Msg_NE
-                                 ("Missing overriding pragma for&",
-                                   New_Op, New_Op);
-                            end if;
- 
                             exit;
                          end if;
  
--- 1297,1305 ----
                             Replace_Elmt (Op_Elmt, New_Op);
                             Remove_Elmt (Op_List, Op_Elmt_2);
                             Found_Explicit := True;
+                            Set_Is_Overriding_Operation (New_Op);
                             Decl_Privates  := True;
  
                             exit;
                          end if;
  
*************** package body Sem_Ch7 is
*** 1506,1517 ****
     ----------------------------------
  
     procedure Install_Visible_Declarations (P : Entity_Id) is
!       Id : Entity_Id;
  
     begin
        Id := First_Entity (P);
  
!       while Present (Id) and then Id /= First_Private_Entity (P) loop
           Install_Package_Entity (Id);
           Next_Entity (Id);
        end loop;
--- 1554,1575 ----
     ----------------------------------
  
     procedure Install_Visible_Declarations (P : Entity_Id) is
!       Id          : Entity_Id;
!       Last_Entity : Entity_Id;
  
     begin
+       pragma Assert
+         (Is_Package_Or_Generic_Package (P) or else Is_Record_Type (P));
+ 
+       if Is_Package_Or_Generic_Package (P) then
+          Last_Entity := First_Private_Entity (P);
+       else
+          Last_Entity := Empty;
+       end if;
+ 
        Id := First_Entity (P);
  
!       while Present (Id) and then Id /= Last_Entity loop
           Install_Package_Entity (Id);
           Next_Entity (Id);
        end loop;
*************** package body Sem_Ch7 is
*** 1683,1690 ****
           Set_RM_Size (Priv, RM_Size (Full));
           Set_Size_Known_At_Compile_Time (Priv, Size_Known_At_Compile_Time
                                                                        (Full));
!          Set_Is_Volatile       (Priv, Is_Volatile       (Full));
!          Set_Treat_As_Volatile (Priv, Treat_As_Volatile (Full));
  
           if Referenced (Full) then
              Set_Referenced (Priv);
--- 1741,1754 ----
           Set_RM_Size (Priv, RM_Size (Full));
           Set_Size_Known_At_Compile_Time (Priv, Size_Known_At_Compile_Time
                                                                        (Full));
!          Set_Is_Volatile        (Priv, Is_Volatile        (Full));
!          Set_Treat_As_Volatile  (Priv, Treat_As_Volatile  (Full));
!          Set_Is_Ada_2005        (Priv, Is_Ada_2005        (Full));
! 
!          if Is_Unchecked_Union (Full) then
!             Set_Is_Unchecked_Union (Base_Type (Priv));
!          end if;
!          --  Why is atomic not copied here ???
  
           if Referenced (Full) then
              Set_Referenced (Priv);
*************** package body Sem_Ch7 is
*** 1706,1713 ****
             and then not Error_Posted (Full)
           then
              if Priv_Is_Base_Type then
!                Set_Access_Disp_Table (Priv, Access_Disp_Table
!                                                            (Base_Type (Full)));
              end if;
  
              Set_First_Entity (Priv, First_Entity (Full));
--- 1770,1805 ----
             and then not Error_Posted (Full)
           then
              if Priv_Is_Base_Type then
! 
!                --  Ada 2005 (AI-345): The full view of a type implementing
!                --  an interface can be a task type.
! 
!                --    type T is new I with private;
!                --  private
!                --    task type T is new I with ...
! 
!                if Is_Interface (Etype (Priv))
!                  and then Is_Concurrent_Type (Base_Type (Full))
!                then
!                   --  Protect the frontend against previous errors
! 
!                   if Present (Corresponding_Record_Type
!                                (Base_Type (Full)))
!                   then
!                      Set_Access_Disp_Table
!                        (Priv, Access_Disp_Table
!                                (Corresponding_Record_Type (Base_Type (Full))));
! 
!                   --  Generic context, or previous errors
! 
!                   else
!                      null;
!                   end if;
! 
!                else
!                   Set_Access_Disp_Table
!                     (Priv, Access_Disp_Table (Base_Type (Full)));
!                end if;
              end if;
  
              Set_First_Entity (Priv, First_Entity (Full));
*************** package body Sem_Ch7 is
*** 1936,1942 ****
                 Next_Elmt (Priv_Elmt);
              end loop;
  
!             --  Now restore the type itself to its private view.
  
              Exchange_Declarations (Id);
  
--- 2028,2034 ----
                 Next_Elmt (Priv_Elmt);
              end loop;
  
!             --  Now restore the type itself to its private view
  
              Exchange_Declarations (Id);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch7.ads gcc-4.1.0/gcc/ada/sem_ch7.ads
*** gcc-4.0.2/gcc/ada/sem_ch7.ads	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_ch7.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,31 ****
  ------------------------------------------------------------------------------
  
  with Types; use Types;
! package Sem_Ch7  is
  
     procedure Analyze_Package_Body                       (N : Node_Id);
     procedure Analyze_Package_Declaration                (N : Node_Id);
--- 25,32 ----
  ------------------------------------------------------------------------------
  
  with Types; use Types;
! 
! package Sem_Ch7 is
  
     procedure Analyze_Package_Body                       (N : Node_Id);
     procedure Analyze_Package_Declaration                (N : Node_Id);
*************** package Sem_Ch7  is
*** 33,39 ****
     procedure Analyze_Private_Type_Declaration           (N : Node_Id);
  
     procedure End_Package_Scope (P : Entity_Id);
!    --  Calls Uninstall_Declarations, and then pops the scope stack.
  
     procedure Exchange_Declarations (Id : Entity_Id);
     --  Exchange private and full declaration on entry/exit from a package
--- 34,40 ----
     procedure Analyze_Private_Type_Declaration           (N : Node_Id);
  
     procedure End_Package_Scope (P : Entity_Id);
!    --  Calls Uninstall_Declarations, and then pops the scope stack
  
     procedure Exchange_Declarations (Id : Entity_Id);
     --  Exchange private and full declaration on entry/exit from a package
*************** package Sem_Ch7  is
*** 74,77 ****
--- 75,79 ----
     --  visible entities at the end of their homonym chains. For compilation
     --  units, make all entities invisible. In both cases, exchange private
     --  and visible declarations to restore order of elaboration.
+ 
  end Sem_Ch7;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch8.adb gcc-4.1.0/gcc/ada/sem_ch8.adb
*** gcc-4.0.2/gcc/ada/sem_ch8.adb	Thu Feb 10 13:50:38 2005
--- gcc-4.1.0/gcc/ada/sem_ch8.adb	Tue Nov 15 14:03:22 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Debug;    use Debug;
*** 29,34 ****
--- 29,35 ----
  with Einfo;    use Einfo;
  with Elists;   use Elists;
  with Errout;   use Errout;
+ with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
  with Fname;    use Fname;
  with Freeze;   use Freeze;
*************** with Sem_Ch4;  use Sem_Ch4;
*** 50,55 ****
--- 51,57 ----
  with Sem_Ch6;  use Sem_Ch6;
  with Sem_Ch12; use Sem_Ch12;
  with Sem_Disp; use Sem_Disp;
+ with Sem_Dist; use Sem_Dist;
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
  with Sem_Type; use Sem_Type;
*************** package body Sem_Ch8 is
*** 422,429 ****
     --  an instance of the parent.
  
     procedure Chain_Use_Clause (N : Node_Id);
!    --  Chain use clause onto list of uses clauses headed by First_Use_Clause
!    --  in the top scope table entry.
  
     function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;
     --  Find a type derived from Character or Wide_Character in the prefix of N.
--- 424,436 ----
     --  an instance of the parent.
  
     procedure Chain_Use_Clause (N : Node_Id);
!    --  Chain use clause onto list of uses clauses headed by First_Use_Clause in
!    --  the proper scope table entry. This is usually the current scope, but it
!    --  will be an inner scope when installing the use clauses of the private
!    --  declarations of a parent unit prior to compiling the private part of a
!    --  child unit. This chain is traversed when installing/removing use clauses
!    --  when compiling a subunit or instantiating a generic body on the fly,
!    --  when it is necessary to save and restore full environments.
  
     function Has_Implicit_Character_Literal (N : Node_Id) return Boolean;
     --  Find a type derived from Character or Wide_Character in the prefix of N.
*************** package body Sem_Ch8 is
*** 471,476 ****
--- 478,488 ----
     --  True if it is of a task type, a protected type, or else an access
     --  to one of these types.
  
+    procedure Note_Redundant_Use (Clause : Node_Id);
+    --  Mark the name in a use clause  as redundant if the corresponding
+    --  entity is already use-visible. Emit a warning if the use clause
+    --  comes from source and the proper warnings are enabled.
+ 
     procedure Premature_Usage (N : Node_Id);
     --  Diagnose usage of an entity before it is visible
  
*************** package body Sem_Ch8 is
*** 724,729 ****
--- 736,751 ----
        end if;
  
        T2 := Etype (Nam);
+ 
+       --  (Ada 2005: AI-326): Handle wrong use of incomplete type
+ 
+       if Nkind (Nam) = N_Explicit_Dereference
+         and then Ekind (Etype (T2)) = E_Incomplete_Type
+       then
+          Error_Msg_N ("invalid use of incomplete type", Id);
+          return;
+       end if;
+ 
        Set_Ekind (Id, E_Variable);
        Init_Size_Align (Id);
  
*************** package body Sem_Ch8 is
*** 756,764 ****
                      (Attribute_Name (Original_Node (Nam))))
  
              --  Weird but legal, equivalent to renaming a function call
  
          or else (Is_Entity_Name (Nam)
!                   and then Ekind (Entity (Nam)) = E_Enumeration_Literal)
  
          or else (Nkind (Nam) = N_Type_Conversion
                      and then Is_Tagged_Type (Entity (Subtype_Mark (Nam))))
--- 778,790 ----
                      (Attribute_Name (Original_Node (Nam))))
  
              --  Weird but legal, equivalent to renaming a function call
+             --  Illegal if the literal is the result of constant-folding
+             --  an attribute reference that is not a function.
  
          or else (Is_Entity_Name (Nam)
!                   and then Ekind (Entity (Nam)) = E_Enumeration_Literal
!                   and then
!                     Nkind (Original_Node (Nam)) /= N_Attribute_Reference)
  
          or else (Nkind (Nam) = N_Type_Conversion
                      and then Is_Tagged_Type (Entity (Subtype_Mark (Nam))))
*************** package body Sem_Ch8 is
*** 821,827 ****
           Error_Msg_N
             ("expect package name in renaming", Name (N));
  
!       --  Ada 2005 (AI-50217): Limited withed packages can not be renamed
  
        elsif Ekind (Old_P) = E_Package
          and then From_With_Type (Old_P)
--- 847,853 ----
           Error_Msg_N
             ("expect package name in renaming", Name (N));
  
!       --  Ada 2005 (AI-50217): Limited withed packages cannot be renamed
  
        elsif Ekind (Old_P) = E_Package
          and then From_With_Type (Old_P)
*************** package body Sem_Ch8 is
*** 859,865 ****
           if Present (Renamed_Object (Old_P)) then
              Set_Renamed_Object (New_P,  Renamed_Object (Old_P));
           else
!             Set_Renamed_Object (New_P,  Old_P);
           end if;
  
           Set_Has_Completion (New_P);
--- 885,891 ----
           if Present (Renamed_Object (Old_P)) then
              Set_Renamed_Object (New_P,  Renamed_Object (Old_P));
           else
!             Set_Renamed_Object (New_P, Old_P);
           end if;
  
           Set_Has_Completion (New_P);
*************** package body Sem_Ch8 is
*** 1035,1040 ****
--- 1061,1071 ----
              Check_Subtype_Conformant (New_S, Old_S, N);
              Generate_Reference (New_S, Defining_Entity (N), 'b');
              Style.Check_Identifier (Defining_Entity (N), New_S);
+ 
+          else
+             --  Only mode conformance required for a renaming_as_declaration
+ 
+             Check_Mode_Conformant (New_S, Old_S, N);
           end if;
  
           Inherit_Renamed_Profile (New_S, Old_S);
*************** package body Sem_Ch8 is
*** 1099,1110 ****
     procedure Analyze_Subprogram_Renaming (N : Node_Id) is
        Spec        : constant Node_Id          := Specification (N);
        Save_AV     : constant Ada_Version_Type := Ada_Version;
        Nam         : constant Node_Id          := Name (N);
        New_S       : Entity_Id;
!       Old_S       : Entity_Id  := Empty;
        Rename_Spec : Entity_Id;
!       Is_Actual   : Boolean    := False;
!       Inst_Node   : Node_Id    := Empty;
  
        function Original_Subprogram (Subp : Entity_Id) return Entity_Id;
        --  Find renamed entity when the declaration is a renaming_as_body
--- 1130,1143 ----
     procedure Analyze_Subprogram_Renaming (N : Node_Id) is
        Spec        : constant Node_Id          := Specification (N);
        Save_AV     : constant Ada_Version_Type := Ada_Version;
+       Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit;
        Nam         : constant Node_Id          := Name (N);
        New_S       : Entity_Id;
!       Old_S       : Entity_Id                 := Empty;
        Rename_Spec : Entity_Id;
!       Formal_Spec : constant Node_Id          := Corresponding_Formal_Spec (N);
!       Is_Actual   : constant Boolean          := Present (Formal_Spec);
!       Inst_Node   : Node_Id                   := Empty;
  
        function Original_Subprogram (Subp : Entity_Id) return Entity_Id;
        --  Find renamed entity when the declaration is a renaming_as_body
*************** package body Sem_Ch8 is
*** 1166,1173 ****
        --  is missing an argument when it is analyzed.
  
        if Nkind (Nam) = N_Attribute_Reference then
!          Attribute_Renaming (N);
!          return;
        end if;
  
        --  Check whether this declaration corresponds to the instantiation
--- 1199,1279 ----
        --  is missing an argument when it is analyzed.
  
        if Nkind (Nam) = N_Attribute_Reference then
! 
!          --  In the case of an abstract formal subprogram association,
!          --  rewrite an actual given by a stream attribute as the name
!          --  of the corresponding stream primitive of the type.
! 
!          --  In a generic context the stream operations are not generated,
!          --  and this must be treated as a normal attribute reference, to
!          --  be expanded in subsequent instantiations.
! 
!          if Is_Actual and then Is_Abstract (Formal_Spec)
!            and then Expander_Active
!          then
!             declare
!                Stream_Prim : Entity_Id;
!                Prefix_Type : constant Entity_Id := Entity (Prefix (Nam));
! 
!             begin
!                --  The class-wide forms of the stream attributes are not
!                --  primitive dispatching operations (even though they
!                --  internally dispatch to a stream attribute).
! 
!                if Is_Class_Wide_Type (Prefix_Type) then
!                   Error_Msg_N
!                     ("attribute must be a primitive dispatching operation",
!                      Nam);
!                   return;
!                end if;
! 
!                --  Retrieve the primitive subprogram associated with the
!                --  attribute. This can only be a stream attribute, since
!                --  those are the only ones that are dispatching (and the
!                --  actual for an abstract formal subprogram must be a
!                --  dispatching operation).
! 
!                case Attribute_Name (Nam) is
!                   when Name_Input  =>
!                      Stream_Prim :=
!                        Find_Prim_Op (Prefix_Type, TSS_Stream_Input);
!                   when Name_Output =>
!                      Stream_Prim :=
!                        Find_Prim_Op (Prefix_Type, TSS_Stream_Output);
!                   when Name_Read   =>
!                      Stream_Prim :=
!                        Find_Prim_Op (Prefix_Type, TSS_Stream_Read);
!                   when Name_Write  =>
!                      Stream_Prim :=
!                        Find_Prim_Op (Prefix_Type, TSS_Stream_Write);
!                   when others      =>
!                      Error_Msg_N
!                        ("attribute must be a primitive dispatching operation",
!                         Nam);
!                      return;
!                end case;
! 
!                --  Rewrite the attribute into the name of its corresponding
!                --  primitive dispatching subprogram. We can then proceed with
!                --  the usual processing for subprogram renamings.
! 
!                declare
!                   Prim_Name : constant Node_Id :=
!                                 Make_Identifier (Sloc (Nam),
!                                   Chars => Chars (Stream_Prim));
!                begin
!                   Set_Entity (Prim_Name, Stream_Prim);
!                   Rewrite (Nam, Prim_Name);
!                   Analyze (Nam);
!                end;
!             end;
! 
!          --  Normal processing for a renaming of an attribute
! 
!          else
!             Attribute_Renaming (N);
!             return;
!          end if;
        end if;
  
        --  Check whether this declaration corresponds to the instantiation
*************** package body Sem_Ch8 is
*** 1182,1190 ****
        --  is determined in Find_Renamed_Entity. If the entity is an operator,
        --  Find_Renamed_Entity applies additional visibility checks.
  
!       if Present (Corresponding_Formal_Spec (N)) then
!          Is_Actual := True;
!          Inst_Node := Unit_Declaration_Node (Corresponding_Formal_Spec (N));
  
           if Is_Entity_Name (Nam)
             and then Present (Entity (Nam))
--- 1288,1295 ----
        --  is determined in Find_Renamed_Entity. If the entity is an operator,
        --  Find_Renamed_Entity applies additional visibility checks.
  
!       if Is_Actual then
!          Inst_Node := Unit_Declaration_Node (Formal_Spec);
  
           if Is_Entity_Name (Nam)
             and then Present (Entity (Nam))
*************** package body Sem_Ch8 is
*** 1269,1281 ****
           --  for it at the freezing point.
  
           Set_Corresponding_Spec (N, Rename_Spec);
!          Set_Corresponding_Body (Unit_Declaration_Node (Rename_Spec), New_S);
  
!          --  The body is created when the entity is frozen. If the context
!          --  is generic, freeze_all is not invoked, so we need to indicate
!          --  that the entity has a completion.
  
!          Set_Has_Completion (Rename_Spec, Inside_A_Generic);
  
           if Ada_Version = Ada_83 and then Comes_From_Source (N) then
              Error_Msg_N ("(Ada 83) renaming cannot serve as a body", N);
--- 1374,1411 ----
           --  for it at the freezing point.
  
           Set_Corresponding_Spec (N, Rename_Spec);
!          if Nkind (Unit_Declaration_Node (Rename_Spec)) =
!                                      N_Abstract_Subprogram_Declaration
!          then
!             --  Input and Output stream functions are abstract if the object
!             --  type is abstract. However, these functions may receive explicit
!             --  declarations in representation clauses, making the attribute
!             --  subprograms usable  as defaults in subsequent type extensions.
!             --  In this case we rewrite the declaration to make the subprogram
!             --  non-abstract. We remove the previous declaration, and insert
!             --  the new one at the point of the renaming, to prevent premature
!             --  access to unfrozen types. The new declaration reuses the
!             --  specification of the previous one, and must not be analyzed.
  
!             pragma Assert (Is_TSS (Rename_Spec, TSS_Stream_Output)
!                            or else Is_TSS (Rename_Spec, TSS_Stream_Input));
  
!             declare
!                Old_Decl : constant Node_Id :=
!                             Unit_Declaration_Node (Rename_Spec);
!                New_Decl : constant Node_Id :=
!                             Make_Subprogram_Declaration (Sloc (N),
!                               Specification =>
!                                 Relocate_Node (Specification (Old_Decl)));
!             begin
!                Remove (Old_Decl);
!                Insert_After (N, New_Decl);
!                Set_Is_Abstract (Rename_Spec, False);
!                Set_Analyzed (New_Decl);
!             end;
!          end if;
! 
!          Set_Corresponding_Body (Unit_Declaration_Node (Rename_Spec), New_S);
  
           if Ada_Version = Ada_83 and then Comes_From_Source (N) then
              Error_Msg_N ("(Ada 83) renaming cannot serve as a body", N);
*************** package body Sem_Ch8 is
*** 1285,1299 ****
           Check_Fully_Conformant (New_S, Rename_Spec);
           Set_Public_Status (New_S);
  
!          --  Indicate that the entity in the declaration functions like
!          --  the corresponding body, and is not a new entity.
  
           Set_Ekind (New_S, E_Subprogram_Body);
           New_S := Rename_Spec;
  
        else
           Generate_Definition (New_S);
           New_Overloaded_Entity (New_S);
           if Is_Entity_Name (Nam)
             and then Is_Intrinsic_Subprogram (Entity (Nam))
           then
--- 1415,1447 ----
           Check_Fully_Conformant (New_S, Rename_Spec);
           Set_Public_Status (New_S);
  
!          --  Indicate that the entity in the declaration functions like the
!          --  corresponding body, and is not a new entity. The body will be
!          --  constructed later at the freeze point, so indicate that the
!          --  completion has not been seen yet.
  
           Set_Ekind (New_S, E_Subprogram_Body);
           New_S := Rename_Spec;
+          Set_Has_Completion (Rename_Spec, False);
+ 
+          --  Ada 2005: check overriding indicator
+ 
+          if Must_Override (Specification (N))
+            and then not Is_Overriding_Operation (Rename_Spec)
+          then
+             Error_Msg_NE ("subprogram& is not overriding", N, Rename_Spec);
+ 
+          elsif Must_Not_Override (Specification (N))
+            and then Is_Overriding_Operation (Rename_Spec)
+          then
+             Error_Msg_NE
+               ("subprogram& overrides inherited operation", N, Rename_Spec);
+          end if;
  
        else
           Generate_Definition (New_S);
           New_Overloaded_Entity (New_S);
+ 
           if Is_Entity_Name (Nam)
             and then Is_Intrinsic_Subprogram (Entity (Nam))
           then
*************** package body Sem_Ch8 is
*** 1303,1312 ****
           end if;
        end if;
  
!       --  There is no need for elaboration checks on the new entity, which
!       --  may be called before the next freezing point where the body will
!       --  appear. Elaboration checks refer to the real entity, not the one
!       --  created by the renaming declaration.
  
        Set_Kill_Elaboration_Checks (New_S, True);
  
--- 1451,1460 ----
           end if;
        end if;
  
!       --  There is no need for elaboration checks on the new entity, which may
!       --  be called before the next freezing point where the body will appear.
!       --  Elaboration checks refer to the real entity, not the one created by
!       --  the renaming declaration.
  
        Set_Kill_Elaboration_Checks (New_S, True);
  
*************** package body Sem_Ch8 is
*** 1317,1324 ****
        elsif Nkind (Nam) = N_Selected_Component then
  
           --  Renamed entity is an entry or protected subprogram. For those
!          --  cases an explicit body is built (at the point of freezing of
!          --  this entity) that contains a call to the renamed entity.
  
           Analyze_Renamed_Entry (N, New_S, Present (Rename_Spec));
           return;
--- 1465,1472 ----
        elsif Nkind (Nam) = N_Selected_Component then
  
           --  Renamed entity is an entry or protected subprogram. For those
!          --  cases an explicit body is built (at the point of freezing of this
!          --  entity) that contains a call to the renamed entity.
  
           Analyze_Renamed_Entry (N, New_S, Present (Rename_Spec));
           return;
*************** package body Sem_Ch8 is
*** 1348,1367 ****
  
        end if;
  
!       --  Most common case: subprogram renames subprogram. No body is
!       --  generated in this case, so we must indicate that the declaration
!       --  is complete as is.
  
        if No (Rename_Spec) then
           Set_Has_Completion (New_S);
        end if;
  
!       --  Find the renamed entity that matches the given specification.
!       --  Disable Ada_83 because there is no requirement of full conformance
!       --  between renamed entity and new entity, even though the same circuit
!       --  is used.
  
        Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
  
        if No (Old_S) then
           Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
--- 1496,1518 ----
  
        end if;
  
!       --  Most common case: subprogram renames subprogram. No body is generated
!       --  in this case, so we must indicate the declaration is complete as is.
  
        if No (Rename_Spec) then
           Set_Has_Completion (New_S);
        end if;
  
!       --  Find the renamed entity that matches the given specification. Disable
!       --  Ada_83 because there is no requirement of full conformance between
!       --  renamed entity and new entity, even though the same circuit is used.
! 
!       --  This is a bit of a kludge, which introduces a really irregular use of
!       --  Ada_Version[_Explicit]. Would be nice to find cleaner way to do this
!       --  ???
  
        Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
+       Ada_Version_Explicit := Ada_Version;
  
        if No (Old_S) then
           Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
*************** package body Sem_Ch8 is
*** 1378,1388 ****
              Generate_Reference (Old_S, Nam);
           end if;
  
!          --  For a renaming-as-body, require subtype conformance,
!          --  but if the declaration being completed has not been
!          --  frozen, then inherit the convention of the renamed
!          --  subprogram prior to checking conformance (unless the
!          --  renaming has an explicit convention established; the
           --  rule stated in the RM doesn't seem to address this ???).
  
           if Present (Rename_Spec) then
--- 1529,1538 ----
              Generate_Reference (Old_S, Nam);
           end if;
  
!          --  For a renaming-as-body, require subtype conformance, but if the
!          --  declaration being completed has not been frozen, then inherit the
!          --  convention of the renamed subprogram prior to checking conformance
!          --  (unless the renaming has an explicit convention established; the
           --  rule stated in the RM doesn't seem to address this ???).
  
           if Present (Rename_Spec) then
*************** package body Sem_Ch8 is
*** 1407,1412 ****
--- 1557,1578 ----
  
              Check_Frozen_Renaming (N, Rename_Spec);
  
+             --  Check explicitly that renamed entity is not intrinsic, because
+             --  in in a generic the renamed body is not built. In this case,
+             --  the renaming_as_body is a completion.
+ 
+             if Inside_A_Generic then
+                if Is_Frozen (Rename_Spec)
+                  and then Is_Intrinsic_Subprogram (Old_S)
+                then
+                   Error_Msg_N
+                     ("subprogram in renaming_as_body cannot be intrinsic",
+                        Name (N));
+                end if;
+ 
+                Set_Has_Completion (Rename_Spec);
+             end if;
+ 
           elsif Ekind (Old_S) /= E_Operator then
              Check_Mode_Conformant (New_S, Old_S);
  
*************** package body Sem_Ch8 is
*** 1434,1448 ****
                 Set_Alias (New_S, Old_S);
              end if;
  
!             --  Note that we do not set Is_Intrinsic_Subprogram if we have
!             --  a renaming as body, since the entity in this case is not an
!             --  intrinsic (it calls an intrinsic, but we have a real body
!             --  for this call, and it is in this body that the required
!             --  intrinsic processing will take place).
  
!             --  Also, if this is a renaming of inequality, the renamed
!             --  operator is intrinsic, but what matters is the corresponding
!             --  equality operator, which may be user-defined.
  
              Set_Is_Intrinsic_Subprogram
                (New_S,
--- 1600,1614 ----
                 Set_Alias (New_S, Old_S);
              end if;
  
!             --  Note that we do not set Is_Intrinsic_Subprogram if we have a
!             --  renaming as body, since the entity in this case is not an
!             --  intrinsic (it calls an intrinsic, but we have a real body for
!             --  this call, and it is in this body that the required intrinsic
!             --  processing will take place).
  
!             --  Also, if this is a renaming of inequality, the renamed operator
!             --  is intrinsic, but what matters is the corresponding equality
!             --  operator, which may be user-defined.
  
              Set_Is_Intrinsic_Subprogram
                (New_S,
*************** package body Sem_Ch8 is
*** 1463,1471 ****
              --  indicate that the renaming is an abstract dispatching operation
              --  with a controlling type.
  
!             if Is_Actual
!               and then Is_Abstract (Corresponding_Formal_Spec (N))
!             then
                 --  Mark the renaming as abstract here, so Find_Dispatching_Type
                 --  see it as corresponding to a generic association for a
                 --  formal abstract subprogram
--- 1629,1635 ----
              --  indicate that the renaming is an abstract dispatching operation
              --  with a controlling type.
  
!             if Is_Actual and then Is_Abstract (Formal_Spec) then
                 --  Mark the renaming as abstract here, so Find_Dispatching_Type
                 --  see it as corresponding to a generic association for a
                 --  formal abstract subprogram
*************** package body Sem_Ch8 is
*** 1514,1522 ****
           Set_Is_Abstract (New_S, Is_Abstract (Old_S));
           Check_Library_Unit_Renaming (N, Old_S);
  
!          --  Pathological case: procedure renames entry in the scope of
!          --  its task. Entry is given by simple name, but body must be built
!          --  for procedure. Of course if called it will deadlock.
  
           if Ekind (Old_S) = E_Entry then
              Set_Has_Completion (New_S, False);
--- 1678,1686 ----
           Set_Is_Abstract (New_S, Is_Abstract (Old_S));
           Check_Library_Unit_Renaming (N, Old_S);
  
!          --  Pathological case: procedure renames entry in the scope of its
!          --  task. Entry is given by simple name, but body must be built for
!          --  procedure. Of course if called it will deadlock.
  
           if Ekind (Old_S) = E_Entry then
              Set_Has_Completion (New_S, False);
*************** package body Sem_Ch8 is
*** 1533,1539 ****
  
              if (Ekind (Old_S) = E_Procedure or else Ekind (Old_S) = E_Function)
                and then Is_Abstract (Old_S)
!               and then not Is_Abstract (Corresponding_Formal_Spec (N))
              then
                 Error_Msg_N
                   ("abstract subprogram not allowed as generic actual", Nam);
--- 1697,1703 ----
  
              if (Ekind (Old_S) = E_Procedure or else Ekind (Old_S) = E_Function)
                and then Is_Abstract (Old_S)
!               and then not Is_Abstract (Formal_Spec)
              then
                 Error_Msg_N
                   ("abstract subprogram not allowed as generic actual", Nam);
*************** package body Sem_Ch8 is
*** 1541,1551 ****
           end if;
  
        else
!          --  A common error is to assume that implicit operators for types
!          --  are defined in Standard, or in the scope of a subtype. In those
!          --  cases where the renamed entity is given with an expanded name,
!          --  it is worth mentioning that operators for the type are not
!          --  declared in the scope given by the prefix.
  
           if Nkind (Nam) = N_Expanded_Name
             and then Nkind (Selector_Name (Nam)) = N_Operator_Symbol
--- 1705,1715 ----
           end if;
  
        else
!          --  A common error is to assume that implicit operators for types are
!          --  defined in Standard, or in the scope of a subtype. In those cases
!          --  where the renamed entity is given with an expanded name, it is
!          --  worth mentioning that operators for the type are not declared in
!          --  the scope given by the prefix.
  
           if Nkind (Nam) = N_Expanded_Name
             and then Nkind (Selector_Name (Nam)) = N_Operator_Symbol
*************** package body Sem_Ch8 is
*** 1595,1601 ****
--- 1759,1811 ----
           end if;
        end if;
  
+       --  Ada 2005 AI 404: if the new subprogram is dispatching, verify that
+       --  controlling access parameters are known non-null for the renamed
+       --  subprogram. Test also applies to a subprogram instantiation that
+       --  is dispatching.
+ 
+       if Ada_Version >= Ada_05
+         and then not Is_Dispatching_Operation (Old_S)
+         and then Is_Dispatching_Operation (New_S)
+       then
+          declare
+             Old_F : Entity_Id;
+             New_F : Entity_Id;
+ 
+          begin
+             Old_F := First_Formal (Old_S);
+             New_F := First_Formal (New_S);
+             while Present (Old_F) loop
+                if Ekind (Etype (Old_F)) = E_Anonymous_Access_Type
+                  and then Is_Controlling_Formal (New_F)
+                  and then not Can_Never_Be_Null (Old_F)
+                then
+                   Error_Msg_N ("access parameter is controlling,", New_F);
+                   Error_Msg_NE ("\corresponding parameter of& " &
+                     " must be explicitly null excluding", New_F, Old_S);
+                end if;
+ 
+                Next_Formal (Old_F);
+                Next_Formal (New_F);
+             end loop;
+          end;
+       end if;
+ 
+       --  A useful warning, suggested by Ada Bug Finder (Ada-Europe 2005)
+ 
+       if Comes_From_Source (N)
+         and then Present (Old_S)
+         and then Nkind (Old_S) = N_Defining_Operator_Symbol
+         and then Nkind (New_S) = N_Defining_Operator_Symbol
+         and then Chars (Old_S) /= Chars (New_S)
+       then
+          Error_Msg_NE
+            ("?& is being renamed as a different operator",
+              New_S, Old_S);
+       end if;
+ 
        Ada_Version := Save_AV;
+       Ada_Version_Explicit := Save_AV_Exp;
     end Analyze_Subprogram_Renaming;
  
     -------------------------
*************** package body Sem_Ch8 is
*** 1619,1627 ****
        Set_Hidden_By_Use_Clause (N, No_Elist);
  
        --  Use clause is not allowed in a spec of a predefined package
!       --  declaration except that packages whose file name starts a-n
!       --  are OK (these are children of Ada.Numerics, and such packages
!       --  are never loaded by Rtsfind).
  
        if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
          and then Name_Buffer (1 .. 3) /= "a-n"
--- 1829,1837 ----
        Set_Hidden_By_Use_Clause (N, No_Elist);
  
        --  Use clause is not allowed in a spec of a predefined package
!       --  declaration except that packages whose file name starts a-n are OK
!       --  (these are children of Ada.Numerics, and such packages are never
!       --  loaded by Rtsfind).
  
        if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
          and then Name_Buffer (1 .. 3) /= "a-n"
*************** package body Sem_Ch8 is
*** 1729,1735 ****
  
              if Nkind (Parent (N)) = N_Compilation_Unit then
                 if  Nkind (Id) = N_Identifier then
!                   Error_Msg_N ("Type is not directly visible", Id);
  
                 elsif Is_Child_Unit (Scope (Entity (Id)))
                   and then Scope (Entity (Id)) /= System_Aux_Id
--- 1939,1945 ----
  
              if Nkind (Parent (N)) = N_Compilation_Unit then
                 if  Nkind (Id) = N_Identifier then
!                   Error_Msg_N ("type is not directly visible", Id);
  
                 elsif Is_Child_Unit (Scope (Entity (Id)))
                   and then Scope (Entity (Id)) /= System_Aux_Id
*************** package body Sem_Ch8 is
*** 1755,1767 ****
           return False;
  
        elsif In_Use (Pack) then
!          Set_Redundant_Use (Pack_Name, True);
           return False;
  
        elsif Present (Renamed_Object (Pack))
          and then In_Use (Renamed_Object (Pack))
        then
!          Set_Redundant_Use (Pack_Name, True);
           return False;
  
        else
--- 1965,1977 ----
           return False;
  
        elsif In_Use (Pack) then
!          Note_Redundant_Use (Pack_Name);
           return False;
  
        elsif Present (Renamed_Object (Pack))
          and then In_Use (Renamed_Object (Pack))
        then
!          Note_Redundant_Use (Pack_Name);
           return False;
  
        else
*************** package body Sem_Ch8 is
*** 1926,1934 ****
              return;
           end if;
  
!          Find_Type (Subtype_Mark (Spec));
!          Rewrite (Subtype_Mark (Spec),
!              New_Reference_To (Base_Type (Entity (Subtype_Mark (Spec))), Loc));
  
           Body_Node :=
             Make_Subprogram_Body (Loc,
--- 2136,2145 ----
              return;
           end if;
  
!          Find_Type (Result_Definition (Spec));
!          Rewrite (Result_Definition (Spec),
!              New_Reference_To (
!                Base_Type (Entity (Result_Definition (Spec))), Loc));
  
           Body_Node :=
             Make_Subprogram_Body (Loc,
*************** package body Sem_Ch8 is
*** 1982,1991 ****
     ----------------------
  
     procedure Chain_Use_Clause (N : Node_Id) is
     begin
        Set_Next_Use_Clause (N,
!         Scope_Stack.Table (Scope_Stack.Last).First_Use_Clause);
!       Scope_Stack.Table (Scope_Stack.Last).First_Use_Clause := N;
     end Chain_Use_Clause;
  
     ---------------------------
--- 2193,2230 ----
     ----------------------
  
     procedure Chain_Use_Clause (N : Node_Id) is
+       Pack : Entity_Id;
+       Level : Int := Scope_Stack.Last;
+ 
     begin
+       if not Is_Compilation_Unit (Current_Scope)
+         or else not Is_Child_Unit (Current_Scope)
+       then
+          null;   --  Common case
+ 
+       elsif Defining_Entity (Parent (N)) = Current_Scope then
+          null;   --  Common case for compilation unit
+ 
+       else
+          --  If declaration appears in some other scope, it must be in some
+          --  parent unit when compiling a child.
+ 
+          Pack := Defining_Entity (Parent (N));
+          if not In_Open_Scopes (Pack) then
+             null;  --  default as well
+ 
+          else
+             --  Find entry for parent unit in scope stack
+ 
+             while Scope_Stack.Table (Level).Entity /= Pack loop
+                Level := Level - 1;
+             end loop;
+          end if;
+       end if;
+ 
        Set_Next_Use_Clause (N,
!         Scope_Stack.Table (Level).First_Use_Clause);
!       Scope_Stack.Table (Level).First_Use_Clause := N;
     end Chain_Use_Clause;
  
     ---------------------------
*************** package body Sem_Ch8 is
*** 2050,2055 ****
--- 2289,2299 ----
          and then Item /= N
        loop
           if Nkind (Item) = N_With_Clause
+ 
+             --  Protect the frontend against previously reported
+             --  critical errors
+ 
+            and then Nkind (Name (Item)) /= N_Selected_Component
             and then Entity (Name (Item)) = Pack
           then
              Par := Nam;
*************** package body Sem_Ch8 is
*** 2311,2316 ****
--- 2555,2561 ----
  
              elsif not Redundant_Use (Pack_Name) then
                 Set_In_Use (Pack, False);
+                Set_Current_Use_Clause (Pack, Empty);
                 Id := First_Entity (Pack);
  
                 while Present (Id) loop
*************** package body Sem_Ch8 is
*** 2345,2350 ****
--- 2590,2596 ----
  
                 if Present (Renamed_Object (Pack)) then
                    Set_In_Use (Renamed_Object (Pack), False);
+                   Set_Current_Use_Clause (Renamed_Object (Pack), Empty);
                 end if;
  
                 if Chars (Pack) = Name_System
*************** package body Sem_Ch8 is
*** 2787,2800 ****
                 Case_Str : constant String    := Name_Buffer (1 .. Name_Len);
                 Case_Stm : constant Node_Id   := Parent (Parent (N));
                 Case_Typ : constant Entity_Id := Etype (Expression (Case_Stm));
  
                 Lit : Node_Id;
  
              begin
                 if Is_Enumeration_Type (Case_Typ)
!                  and then Case_Typ /= Standard_Character
!                  and then Case_Typ /= Standard_Wide_Character
!                  and then Case_Typ /= Standard_Wide_Wide_Character
                 then
                    Lit := First_Literal (Case_Typ);
                    Get_Name_String (Chars (Lit));
--- 3033,3047 ----
                 Case_Str : constant String    := Name_Buffer (1 .. Name_Len);
                 Case_Stm : constant Node_Id   := Parent (Parent (N));
                 Case_Typ : constant Entity_Id := Etype (Expression (Case_Stm));
+                Case_Rtp : constant Entity_Id := Root_Type (Case_Typ);
  
                 Lit : Node_Id;
  
              begin
                 if Is_Enumeration_Type (Case_Typ)
!                  and then Case_Rtp /= Standard_Character
!                  and then Case_Rtp /= Standard_Wide_Character
!                  and then Case_Rtp /= Standard_Wide_Wide_Character
                 then
                    Lit := First_Literal (Case_Typ);
                    Get_Name_String (Chars (Lit));
*************** package body Sem_Ch8 is
*** 3134,3139 ****
--- 3381,3409 ----
                 Nvis_Messages;
                 return;
  
+             elsif
+               Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
+             then
+                --  A use-clause in the body of a system file creates conflict
+                --  with some entity in a user scope, while rtsfind is active.
+                --  Keep only the entity coming from another predefined unit.
+ 
+                E2 := E;
+                while Present (E2) loop
+                   if Is_Predefined_File_Name
+                     (Unit_File_Name (Get_Source_Unit (Sloc (E2))))
+                   then
+                      E := E2;
+                      goto Found;
+                   end if;
+ 
+                   E2 := Homonym (E2);
+                end loop;
+ 
+                --  Entity must exist because predefined unit is correct
+ 
+                raise Program_Error;
+ 
              else
                 Nvis_Messages;
                 return;
*************** package body Sem_Ch8 is
*** 3173,3187 ****
           E2 := Homonym (E);
           while Present (E2) loop
              if Is_Immediately_Visible (E2) then
!                for J in Level + 1 .. Scope_Stack.Last loop
!                   if Scope_Stack.Table (J).Entity = Scope (E2)
!                     or else Scope_Stack.Table (J).Entity = E2
!                   then
!                      Level := J;
!                      E := E2;
!                      exit;
!                   end if;
!                end loop;
              end if;
  
              E2 := Homonym (E2);
--- 3443,3481 ----
           E2 := Homonym (E);
           while Present (E2) loop
              if Is_Immediately_Visible (E2) then
! 
!                --  If a generic package contains a local declaration that
!                --  has the same name as the generic, there may be a visibility
!                --  conflict in an instance, where the local declaration must
!                --  also hide the name of the corresponding package renaming.
!                --  We check explicitly for a package declared by a renaming,
!                --  whose renamed entity is an instance that is on the scope
!                --  stack, and that contains a homonym in the same scope. Once
!                --  we have found it, we know that the package renaming is not
!                --  immediately visible, and that the identifier denotes the
!                --  other entity (and its homonyms if overloaded).
! 
!                if Scope (E) = Scope (E2)
!                  and then Ekind (E) = E_Package
!                  and then Present (Renamed_Object (E))
!                  and then Is_Generic_Instance (Renamed_Object (E))
!                  and then In_Open_Scopes (Renamed_Object (E))
!                  and then Comes_From_Source (N)
!                then
!                   Set_Is_Immediately_Visible (E, False);
!                   E := E2;
! 
!                else
!                   for J in Level + 1 .. Scope_Stack.Last loop
!                      if Scope_Stack.Table (J).Entity = Scope (E2)
!                        or else Scope_Stack.Table (J).Entity = E2
!                      then
!                         Level := J;
!                         E := E2;
!                         exit;
!                      end if;
!                   end loop;
!                end if;
              end if;
  
              E2 := Homonym (E2);
*************** package body Sem_Ch8 is
*** 3198,3203 ****
--- 3492,3498 ----
           if Comes_From_Source (N)
             and then Is_Remote_Access_To_Subprogram_Type (E)
             and then Expander_Active
+            and then Get_PCS_Name /= Name_No_DSA
           then
              Rewrite (N,
                New_Occurrence_Of (Equivalent_Type (E), Sloc (N)));
*************** package body Sem_Ch8 is
*** 3464,3471 ****
              if Present (Candidate) then
  
                 if Is_Child_Unit (Candidate) then
!                   Error_Msg_N
!                     ("missing with_clause for child unit &", Selector);
                 else
                    Error_Msg_NE ("& is not a visible entity of&", N, Selector);
                 end if;
--- 3759,3781 ----
              if Present (Candidate) then
  
                 if Is_Child_Unit (Candidate) then
! 
!                   --  If the candidate is a private child unit and we are
!                   --  in the visible part of a public unit, specialize the
!                   --  error message. There might be a private with_clause for
!                   --  it, but it is not currently active.
! 
!                   if Is_Private_Descendant (Candidate)
!                     and then Ekind (Current_Scope) = E_Package
!                     and then not In_Private_Part (Current_Scope)
!                     and then not Is_Private_Descendant (Current_Scope)
!                   then
!                      Error_Msg_N ("private child unit& is not visible here",
!                        Selector);
!                   else
!                      Error_Msg_N
!                        ("missing with_clause for child unit &", Selector);
!                   end if;
                 else
                    Error_Msg_NE ("& is not a visible entity of&", N, Selector);
                 end if;
*************** package body Sem_Ch8 is
*** 3503,3509 ****
                               and then Chars (P) = Chars (Selector)
                             then
                                Id := S;
!                               goto found;
                             end if;
                          end if;
  
--- 3813,3819 ----
                               and then Chars (P) = Chars (Selector)
                             then
                                Id := S;
!                               goto Found;
                             end if;
                          end if;
  
*************** package body Sem_Ch8 is
*** 3573,3582 ****
           end if;
        end if;
  
!       <<found>>
        if Comes_From_Source (N)
          and then Is_Remote_Access_To_Subprogram_Type (Id)
        then
           Id := Equivalent_Type (Id);
           Set_Chars (Selector, Chars (Id));
        end if;
--- 3883,3898 ----
           end if;
        end if;
  
!       <<Found>>
        if Comes_From_Source (N)
          and then Is_Remote_Access_To_Subprogram_Type (Id)
+         and then Present (Equivalent_Type (Id))
        then
+          --  If we are not actually generating distribution code (i.e.
+          --  the current PCS is the dummy non-distributed version), then
+          --  the Equivalent_Type will be missing, and Id should be treated
+          --  as a regular access-to-subprogram type.
+ 
           Id := Equivalent_Type (Id);
           Set_Chars (Selector, Chars (Id));
        end if;
*************** package body Sem_Ch8 is
*** 4317,4323 ****
  
              T := Base_Type (Entity (Prefix (N)));
  
!             --  Case of non-tagged type
  
              if not Is_Tagged_Type (T) then
                 if Ekind (T) = E_Incomplete_Type then
--- 4633,4641 ----
  
              T := Base_Type (Entity (Prefix (N)));
  
!             --  Case type is not known to be tagged. Its appearance in
!             --  the prefix of the 'Class attribute indicates that the full
!             --  view will be tagged.
  
              if not Is_Tagged_Type (T) then
                 if Ekind (T) = E_Incomplete_Type then
*************** package body Sem_Ch8 is
*** 4326,4331 ****
--- 4644,4650 ----
                    --  type. The full type will have to be tagged, of course.
  
                    Set_Is_Tagged_Type (T);
+                   Set_Primitive_Operations (T, New_Elmt_List);
                    Make_Class_Wide_Type (T);
                    Set_Entity (N, Class_Wide_Type (T));
                    Set_Etype  (N, Class_Wide_Type (T));
*************** package body Sem_Ch8 is
*** 4883,4894 ****
                 if Ekind (Id) = E_Package then
  
                    if In_Use (Id) then
!                      Set_Redundant_Use (P, True);
  
                    elsif Present (Renamed_Object (Id))
                      and then In_Use (Renamed_Object (Id))
                    then
!                      Set_Redundant_Use (P, True);
  
                    elsif Force_Installation or else Applicable_Use (P) then
                       Use_One_Package (Id, U);
--- 5202,5213 ----
                 if Ekind (Id) = E_Package then
  
                    if In_Use (Id) then
!                      Note_Redundant_Use (P);
  
                    elsif Present (Renamed_Object (Id))
                      and then In_Use (Renamed_Object (Id))
                    then
!                      Note_Redundant_Use (P);
  
                    elsif Force_Installation or else Applicable_Use (P) then
                       Use_One_Package (Id, U);
*************** package body Sem_Ch8 is
*** 5059,5064 ****
--- 5378,5551 ----
        end if;
     end New_Scope;
  
+    ------------------------
+    -- Note_Redundant_Use --
+    ------------------------
+ 
+    procedure Note_Redundant_Use (Clause : Node_Id) is
+       Pack_Name : constant Entity_Id := Entity (Clause);
+       Cur_Use   : constant Node_Id   := Current_Use_Clause (Pack_Name);
+       Decl      : constant Node_Id   := Parent (Clause);
+ 
+       Prev_Use   : Node_Id := Empty;
+       Redundant  : Node_Id := Empty;
+       --  The Use_Clause which is actually redundant. In the simplest case
+       --  it is Pack itself, but when we compile a body we install its
+       --  context before that of its spec, in which case it is the use_clause
+       --  in the spec that will appear to be redundant, and we want the
+       --  warning to be placed on the body. Similar complications appear when
+       --  the redundancy is between a child unit and one of its ancestors.
+ 
+    begin
+       Set_Redundant_Use (Clause, True);
+ 
+       if not Comes_From_Source (Clause)
+         or else In_Instance
+         or else not Warn_On_Redundant_Constructs
+       then
+          return;
+       end if;
+ 
+       if not Is_Compilation_Unit (Current_Scope) then
+ 
+          --  If the use_clause is in an inner scope, it is made redundant
+          --  by some clause in the current context.
+ 
+          Redundant := Clause;
+          Prev_Use  := Cur_Use;
+ 
+       elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
+          declare
+             Cur_Unit : constant Unit_Number_Type := Get_Source_Unit (Cur_Use);
+             New_Unit : constant Unit_Number_Type := Get_Source_Unit (Clause);
+             Scop     : Entity_Id;
+ 
+          begin
+             if Cur_Unit = New_Unit then
+ 
+                --  Redundant clause in same body
+ 
+                Redundant := Clause;
+                Prev_Use  := Cur_Use;
+ 
+             elsif Cur_Unit = Current_Sem_Unit then
+ 
+                --  If the new clause is not in the current unit it has been
+                --  analyzed first, and it makes the other one redundant.
+                --  However, if the new clause appears in a subunit, Cur_Unit
+                --  is still the parent, and in that case the redundant one
+                --  is the one appearing in the subunit.
+ 
+                if Nkind (Unit (Cunit (New_Unit))) = N_Subunit then
+                   Redundant := Clause;
+                   Prev_Use  := Cur_Use;
+ 
+                --  Most common case: redundant clause in body,
+                --  original clause in spec. Current scope is spec entity.
+ 
+                elsif
+                  Current_Scope =
+                    Defining_Entity (
+                      Unit (Library_Unit (Cunit (Current_Sem_Unit))))
+                then
+                   Redundant := Cur_Use;
+                   Prev_Use  := Clause;
+ 
+                else
+                   --  The new clause may appear in an unrelated unit, when
+                   --  the parents of a generic are being installed prior to
+                   --  instantiation. In this case there must be no warning.
+                   --  We detect this case by checking whether the current top
+                   --  of the stack is related to the current compilation.
+ 
+                   Scop := Current_Scope;
+                   while Present (Scop)
+                     and then Scop /= Standard_Standard
+                   loop
+                      if Is_Compilation_Unit (Scop)
+                        and then not Is_Child_Unit (Scop)
+                      then
+                         return;
+ 
+                      elsif Scop = Cunit_Entity (Current_Sem_Unit) then
+                         exit;
+                      end if;
+ 
+                      Scop := Scope (Scop);
+                   end loop;
+ 
+                   Redundant := Cur_Use;
+                   Prev_Use  := Clause;
+                end if;
+ 
+             elsif New_Unit = Current_Sem_Unit then
+                Redundant := Clause;
+                Prev_Use  := Cur_Use;
+ 
+             else
+                --  Neither is the current unit, so they appear in parent or
+                --  sibling units. Warning will be emitted elsewhere.
+ 
+                return;
+             end if;
+          end;
+ 
+       elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
+         and then Present (Parent_Spec (Unit (Cunit (Current_Sem_Unit))))
+       then
+          --  Use_clause is in child unit of current unit, and the child
+          --  unit appears in the context of the body of the parent, so it
+          --  has been installed first, even though it is the redundant one.
+          --  Depending on their placement in the context, the visible or the
+          --  private parts of the two units, either might appear as redundant,
+          --  but the message has to be on the current unit.
+ 
+          if Get_Source_Unit (Cur_Use) = Current_Sem_Unit then
+             Redundant := Cur_Use;
+             Prev_Use  := Clause;
+          else
+             Redundant := Clause;
+             Prev_Use  := Cur_Use;
+          end if;
+ 
+          --  If the new use clause appears in the private part of a parent unit
+          --  it may appear to be redudant w.r.t. a use clause in a child unit,
+          --  but the previous use clause was needed in the visible part of the
+          --  child, and no warning should be emitted.
+ 
+          if Nkind (Parent (Decl)) = N_Package_Specification
+            and then
+              List_Containing (Decl) = Private_Declarations (Parent (Decl))
+          then
+             declare
+                Par : constant Entity_Id := Defining_Entity (Parent (Decl));
+                Spec : constant Node_Id  :=
+                         Specification (Unit (Cunit (Current_Sem_Unit)));
+ 
+             begin
+                if Is_Compilation_Unit (Par)
+                  and then Par /= Cunit_Entity (Current_Sem_Unit)
+                  and then Parent (Cur_Use) = Spec
+                  and then
+                    List_Containing (Cur_Use) = Visible_Declarations (Spec)
+                then
+                   return;
+                end if;
+             end;
+          end if;
+ 
+       else
+          null;
+       end if;
+ 
+       if Present (Redundant) then
+          Error_Msg_Sloc := Sloc (Prev_Use);
+          Error_Msg_NE (
+            "& is already use_visible through declaration #?",
+               Redundant, Pack_Name);
+       end if;
+    end Note_Redundant_Use;
+ 
     ---------------
     -- Pop_Scope --
     ---------------
*************** package body Sem_Ch8 is
*** 5525,5530 ****
--- 6012,6018 ----
        end if;
  
        Set_In_Use (P);
+       Set_Current_Use_Clause (P, N);
  
        --  Ada 2005 (AI-50217): Check restriction
  
*************** package body Sem_Ch8 is
*** 5553,5558 ****
--- 6041,6047 ----
  
        if Present (Renamed_Object (P)) then
           Set_In_Use (Renamed_Object (P));
+          Set_Current_Use_Clause (Renamed_Object (P), N);
           Real_P := Renamed_Object (P);
        else
           Real_P := P;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch8.ads gcc-4.1.0/gcc/ada/sem_ch8.ads
*** gcc-4.0.2/gcc/ada/sem_ch8.ads	Fri Jun 25 16:39:31 2004
--- gcc-4.1.0/gcc/ada/sem_ch8.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch9.adb gcc-4.1.0/gcc/ada/sem_ch9.adb
*** gcc-4.0.2/gcc/ada/sem_ch9.adb	Wed Dec  8 11:47:21 2004
--- gcc-4.1.0/gcc/ada/sem_ch9.adb	Tue Nov 15 13:54:36 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Atree;    use Atree;
*** 28,35 ****
  with Checks;   use Checks;
  with Einfo;    use Einfo;
  with Errout;   use Errout;
! with Exp_Ch9;
  with Elists;   use Elists;
  with Itypes;   use Itypes;
  with Lib.Xref; use Lib.Xref;
  with Nlists;   use Nlists;
--- 28,36 ----
  with Checks;   use Checks;
  with Einfo;    use Einfo;
  with Errout;   use Errout;
! with Exp_Ch9;  use Exp_Ch9;
  with Elists;   use Elists;
+ with Freeze;   use Freeze;
  with Itypes;   use Itypes;
  with Lib.Xref; use Lib.Xref;
  with Nlists;   use Nlists;
*************** package body Sem_Ch9 is
*** 67,72 ****
--- 68,78 ----
     --  count the entries (checking the static requirement), and compare with
     --  the given maximum.
  
+    procedure Check_Overriding_Indicator (Def : Node_Id);
+    --  Ada 2005 (AI-397): Check the overriding indicator of entries and
+    --  subprograms of protected or task types. Def is the definition of
+    --  the protected or task type.
+ 
     function Find_Concurrent_Spec (Body_Id : Entity_Id) return Entity_Id;
     --  Find entity in corresponding task or protected declaration. Use full
     --  view if first declaration was for an incomplete type.
*************** package body Sem_Ch9 is
*** 88,98 ****
        while Present (T_Name) loop
           Analyze (T_Name);
  
!          if not Is_Task_Type (Etype (T_Name)) then
!             Error_Msg_N ("expect task name for ABORT", T_Name);
!             return;
!          else
              Resolve (T_Name);
           end if;
  
           Next (T_Name);
--- 94,115 ----
        while Present (T_Name) loop
           Analyze (T_Name);
  
!          if Is_Task_Type (Etype (T_Name))
!            or else (Ada_Version >= Ada_05
!                       and then Ekind (Etype (T_Name)) = E_Class_Wide_Type
!                       and then Is_Interface (Etype (T_Name))
!                       and then Is_Task_Interface (Etype (T_Name)))
!          then
              Resolve (T_Name);
+          else
+             if Ada_Version >= Ada_05 then
+                Error_Msg_N ("expect task name or task interface class-wide "
+                           & "object for ABORT", T_Name);
+             else
+                Error_Msg_N ("expect task name for ABORT", T_Name);
+             end if;
+ 
+             return;
           end if;
  
           Next (T_Name);
*************** package body Sem_Ch9 is
*** 292,300 ****
  
           begin
              E1 := First_Entity (Current_Scope);
- 
              while Present (E1) loop
- 
                 if Ekind (E1) = E_Procedure
                   and then Chars (E1) = Chars (Entry_Nam)
                   and then Type_Conformant (E1, Entry_Nam)
--- 309,315 ----
*************** package body Sem_Ch9 is
*** 362,368 ****
  
           begin
              Decl := First (Declarations (N));
- 
              while Present (Decl) loop
                 Analyze (Decl);
  
--- 377,382 ----
*************** package body Sem_Ch9 is
*** 384,389 ****
--- 398,404 ----
        --  In the case of a select alternative of a selective accept,
        --  the expander references the address declaration even if there
        --  is no statement list.
+ 
        --  We also need to create the renaming declarations for the local
        --  variables that will replace references to the formals within
        --  the accept.
*************** package body Sem_Ch9 is
*** 434,447 ****
     ---------------------------------
  
     procedure Analyze_Asynchronous_Select (N : Node_Id) is
     begin
        Tasking_Used := True;
        Check_Restriction (Max_Asynchronous_Select_Nesting, N);
        Check_Restriction (No_Select_Statements, N);
  
!       --  Analyze the statements. We analyze statements in the abortable part
!       --  first, because this is the section that is executed first, and that
!       --  way our remembering of saved values and checks is accurate.
  
        Analyze_Statements (Statements (Abortable_Part (N)));
        Analyze (Triggering_Alternative (N));
--- 449,497 ----
     ---------------------------------
  
     procedure Analyze_Asynchronous_Select (N : Node_Id) is
+       Param   : Node_Id;
+       Trigger : Node_Id;
+ 
     begin
        Tasking_Used := True;
        Check_Restriction (Max_Asynchronous_Select_Nesting, N);
        Check_Restriction (No_Select_Statements, N);
  
!       if Ada_Version >= Ada_05 then
!          Trigger := Triggering_Statement (Triggering_Alternative (N));
! 
!          Analyze (Trigger);
! 
!          --  The trigger is a dispatching procedure. Postpone the analysis
!          --  of the triggering and abortable statements until the expansion
!          --  of this asynchronous select in Expand_N_Asynchronous_Select.
!          --  This action is required since the code replication in Expand-
!          --  _N_Asynchronous_Select of an already analyzed statement list
!          --  causes Gigi aborts.
! 
!          if Expander_Active
!            and then Nkind (Trigger) = N_Procedure_Call_Statement
!            and then Present (Parameter_Associations (Trigger))
!          then
!             Param := First (Parameter_Associations (Trigger));
! 
!             if Is_Controlling_Actual (Param)
!               and then Is_Interface (Etype (Param))
!             then
!                if Is_Limited_Record (Etype (Param)) then
!                   return;
!                else
!                   Error_Msg_N
!                    ("dispatching operation of limited or synchronized " &
!                     "interface required ('R'M 9.7.2(3))!", N);
!                end if;
!             end if;
!          end if;
!       end if;
! 
!       --  Analyze the statements. We analyze statements in the abortable part,
!       --  because this is the section that is executed first, and that way our
!       --  remembering of saved values and checks is accurate.
  
        Analyze_Statements (Statements (Abortable_Part (N)));
        Analyze (Triggering_Alternative (N));
*************** package body Sem_Ch9 is
*** 456,461 ****
--- 506,521 ----
        Check_Restriction (No_Select_Statements, N);
        Tasking_Used := True;
        Analyze (Entry_Call_Alternative (N));
+ 
+       if List_Length (Else_Statements (N)) = 1
+         and then Nkind (First (Else_Statements (N))) in N_Delay_Statement
+       then
+          Error_Msg_N
+            ("suspicious form of conditional entry call?", N);
+          Error_Msg_N
+            ("\`SELECT OR` may be intended rather than `SELECT ELSE`", N);
+       end if;
+ 
        Analyze_Statements (Else_Statements (N));
     end Analyze_Conditional_Entry_Call;
  
*************** package body Sem_Ch9 is
*** 485,503 ****
  
           if Nkind (Delay_Statement (N)) = N_Delay_Relative_Statement then
              Pre_Analyze_And_Resolve (Expr, Standard_Duration);
- 
           else
              Pre_Analyze_And_Resolve (Expr);
           end if;
  
!          if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement and then
!             not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time)     and then
!             not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
           then
              Error_Msg_N ("expect Time types for `DELAY UNTIL`", Expr);
           end if;
  
           Check_Restriction (No_Fixed_Point, Expr);
        else
           Analyze (Delay_Statement (N));
        end if;
--- 545,563 ----
  
           if Nkind (Delay_Statement (N)) = N_Delay_Relative_Statement then
              Pre_Analyze_And_Resolve (Expr, Standard_Duration);
           else
              Pre_Analyze_And_Resolve (Expr);
           end if;
  
!          if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement
!            and then not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time)
!            and then not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
           then
              Error_Msg_N ("expect Time types for `DELAY UNTIL`", Expr);
           end if;
  
           Check_Restriction (No_Fixed_Point, Expr);
+ 
        else
           Analyze (Delay_Statement (N));
        end if;
*************** package body Sem_Ch9 is
*** 626,632 ****
                       then
                          Set_Etype (Def, Empty);
                          Set_Analyzed (Def, False);
!                         Set_Discrete_Subtype_Definition (Index_Spec, Def);
                          Set_Analyzed (Low_Bound (Def), False);
                          Set_Analyzed (High_Bound (Def), False);
  
--- 686,698 ----
                       then
                          Set_Etype (Def, Empty);
                          Set_Analyzed (Def, False);
! 
!                         --  Keep the original subtree to ensure tree is
!                         --  properly formed (e.g. for ASIS use)
! 
!                         Rewrite
!                           (Discrete_Subtype_Definition (Index_Spec), Def);
! 
                          Set_Analyzed (Low_Bound (Def), False);
                          Set_Analyzed (High_Bound (Def), False);
  
*************** package body Sem_Ch9 is
*** 677,688 ****
        --  The entity for the protected subprogram corresponding to the entry
        --  has been created. We retain the name of this entity in the entry
        --  body, for use when the corresponding subprogram body is created.
!       --  Note that entry bodies have to corresponding_spec, and there is no
        --  easy link back in the tree between the entry body and the entity for
!       --  the entry itself.
  
!       Set_Protected_Body_Subprogram (Id,
!         Protected_Body_Subprogram (Entry_Name));
  
        if Present (Decls) then
           Analyze_Declarations (Decls);
--- 743,758 ----
        --  The entity for the protected subprogram corresponding to the entry
        --  has been created. We retain the name of this entity in the entry
        --  body, for use when the corresponding subprogram body is created.
!       --  Note that entry bodies have no corresponding_spec, and there is no
        --  easy link back in the tree between the entry body and the entity for
!       --  the entry itself, which is why we must propagate some attributes
!       --  explicitly from spec to body.
  
!       Set_Protected_Body_Subprogram
!         (Id, Protected_Body_Subprogram (Entry_Name));
! 
!       Set_Entry_Parameters_Type
!         (Id, Entry_Parameters_Type (Entry_Name));
  
        if Present (Decls) then
           Analyze_Declarations (Decls);
*************** package body Sem_Ch9 is
*** 701,706 ****
--- 771,779 ----
  
        --  At the same time, we set the flags on the spec entities to suppress
        --  any warnings on the spec formals, since we also scan the spec.
+       --  Finally, we propagate the Entry_Component attribute to the body
+       --  formals, for use in the renaming declarations created later for the
+       --  formals (see exp_ch9.Add_Formal_Renamings).
  
        declare
           E1  : Entity_Id;
*************** package body Sem_Ch9 is
*** 730,735 ****
--- 803,809 ----
  
              Set_Referenced (E2, Referenced (E1));
              Set_Referenced (E1);
+             Set_Entry_Component (E2, Entry_Component (E1));
  
           <<Continue>>
              Next_Entity (E1);
*************** package body Sem_Ch9 is
*** 1005,1013 ****
        end if;
  
        E := First_Entity (Current_Scope);
- 
        while Present (E) loop
- 
           if Ekind (E) = E_Function
             or else Ekind (E) = E_Procedure
           then
--- 1079,1085 ----
*************** package body Sem_Ch9 is
*** 1024,1029 ****
--- 1096,1102 ----
  
        Check_Max_Entries (N, Max_Protected_Entries);
        Process_End_Label (N, 'e', Current_Scope);
+       Check_Overriding_Indicator (N);
     end Analyze_Protected_Definition;
  
     ----------------------------
*************** package body Sem_Ch9 is
*** 1031,1039 ****
     ----------------------------
  
     procedure Analyze_Protected_Type (N : Node_Id) is
!       E      : Entity_Id;
!       T      : Entity_Id;
!       Def_Id : constant Entity_Id := Defining_Identifier (N);
  
     begin
        if No_Run_Time_Mode then
--- 1104,1115 ----
     ----------------------------
  
     procedure Analyze_Protected_Type (N : Node_Id) is
!       E         : Entity_Id;
!       T         : Entity_Id;
!       Def_Id    : constant Entity_Id := Defining_Identifier (N);
!       Iface     : Node_Id;
!       Iface_Def : Node_Id;
!       Iface_Typ : Entity_Id;
  
     begin
        if No_Run_Time_Mode then
*************** package body Sem_Ch9 is
*** 1052,1064 ****
        end if;
  
        Set_Ekind              (T, E_Protected_Type);
        Init_Size_Align        (T);
        Set_Etype              (T, T);
-       Set_Is_First_Subtype   (T, True);
        Set_Has_Delayed_Freeze (T, True);
        Set_Stored_Constraint  (T, No_Elist);
        New_Scope (T);
  
        if Present (Discriminant_Specifications (N)) then
           if Has_Discriminants (T) then
  
--- 1128,1184 ----
        end if;
  
        Set_Ekind              (T, E_Protected_Type);
+       Set_Is_First_Subtype   (T, True);
        Init_Size_Align        (T);
        Set_Etype              (T, T);
        Set_Has_Delayed_Freeze (T, True);
        Set_Stored_Constraint  (T, No_Elist);
        New_Scope (T);
  
+       --  Ada 2005 (AI-345)
+ 
+       if Present (Interface_List (N)) then
+          Set_Is_Tagged_Type (T);
+ 
+          Iface := First (Interface_List (N));
+          while Present (Iface) loop
+             Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
+             Iface_Def := Type_Definition (Parent (Iface_Typ));
+ 
+             if not Is_Interface (Iface_Typ) then
+                Error_Msg_NE ("(Ada 2005) & must be an interface",
+                              Iface, Iface_Typ);
+ 
+             else
+                --  Ada 2005 (AI-251): "The declaration of a specific
+                --  descendant of an interface type freezes the interface
+                --  type" RM 13.14
+ 
+                Freeze_Before (N, Etype (Iface));
+ 
+                --  Ada 2005 (AI-345): Protected types can only implement
+                --  limited, synchronized or protected interfaces.
+ 
+                if Limited_Present (Iface_Def)
+                  or else Synchronized_Present (Iface_Def)
+                  or else Protected_Present (Iface_Def)
+                then
+                   null;
+ 
+                elsif Task_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) protected type cannot implement a "
+                     & "task interface", Iface);
+ 
+                else
+                   Error_Msg_N ("(Ada 2005) protected type cannot implement a "
+                     & "non-limited interface", Iface);
+                end if;
+             end if;
+ 
+             Next (Iface);
+          end loop;
+       end if;
+ 
        if Present (Discriminant_Specifications (N)) then
           if Has_Discriminants (T) then
  
*************** package body Sem_Ch9 is
*** 1071,1076 ****
--- 1191,1198 ----
           end if;
        end if;
  
+       Set_Is_Constrained (T, not Has_Discriminants (T));
+ 
        Analyze (Protected_Definition (N));
  
        --  Protected types with entries are controlled (because of the
*************** package body Sem_Ch9 is
*** 1092,1098 ****
        --  illegal uses. Now it can be set correctly.
  
        E := First_Entity (Current_Scope);
- 
        while Present (E) loop
           if Ekind (E) = E_Void then
              Set_Ekind (E, E_Component);
--- 1214,1219 ----
*************** package body Sem_Ch9 is
*** 1119,1127 ****
     ---------------------
  
     procedure Analyze_Requeue (N : Node_Id) is
        Entry_Name : Node_Id := Name (N);
        Entry_Id   : Entity_Id;
-       Found      : Boolean;
        I          : Interp_Index;
        It         : Interp;
        Enclosing  : Entity_Id;
--- 1240,1248 ----
     ---------------------
  
     procedure Analyze_Requeue (N : Node_Id) is
+       Count      : Natural := 0;
        Entry_Name : Node_Id := Name (N);
        Entry_Id   : Entity_Id;
        I          : Interp_Index;
        It         : Interp;
        Enclosing  : Entity_Id;
*************** package body Sem_Ch9 is
*** 1199,1228 ****
        --  Overloaded case, find right interpretation
  
        if Is_Overloaded (Entry_Name) then
-          Get_First_Interp (Entry_Name, I, It);
-          Found := False;
           Entry_Id := Empty;
  
           while Present (It.Nam) loop
              if No (First_Formal (It.Nam))
                or else Subtype_Conformant (Enclosing, It.Nam)
              then
!                if not Found then
!                   Found := True;
                    Entry_Id := It.Nam;
                 else
!                   Error_Msg_N ("ambiguous entry name in requeue", N);
!                   return;
                 end if;
              end if;
  
              Get_Next_Interp (I, It);
           end loop;
  
!          if not Found then
!             Error_Msg_N ("no entry matches context",  N);
              return;
           else
              Set_Entity (Entry_Name, Entry_Id);
           end if;
  
--- 1320,1356 ----
        --  Overloaded case, find right interpretation
  
        if Is_Overloaded (Entry_Name) then
           Entry_Id := Empty;
  
+          Get_First_Interp (Entry_Name, I, It);
           while Present (It.Nam) loop
              if No (First_Formal (It.Nam))
                or else Subtype_Conformant (Enclosing, It.Nam)
              then
!                --  Ada 2005 (AI-345): Since protected and task types have
!                --  primitive entry wrappers, we only consider source entries.
! 
!                if Comes_From_Source (It.Nam) then
!                   Count := Count + 1;
                    Entry_Id := It.Nam;
                 else
!                   Remove_Interp (I);
                 end if;
              end if;
  
              Get_Next_Interp (I, It);
           end loop;
  
!          if Count = 0 then
!             Error_Msg_N ("no entry matches context", N);
              return;
+ 
+          elsif Count > 1 then
+             Error_Msg_N ("ambiguous entry name in requeue", N);
+             return;
+ 
           else
+             Set_Is_Overloaded (Entry_Name, False);
              Set_Entity (Entry_Name, Entry_Id);
           end if;
  
*************** package body Sem_Ch9 is
*** 1285,1293 ****
              --  Processing for parameters accessed by the requeue
  
              declare
!                Ent : Entity_Id := First_Formal (Enclosing);
  
              begin
                 while Present (Ent) loop
  
                    --  For OUT or IN OUT parameter, the effect of the requeue
--- 1413,1422 ----
              --  Processing for parameters accessed by the requeue
  
              declare
!                Ent : Entity_Id;
  
              begin
+                Ent := First_Formal (Enclosing);
                 while Present (Ent) loop
  
                    --  For OUT or IN OUT parameter, the effect of the requeue
*************** package body Sem_Ch9 is
*** 1336,1341 ****
--- 1465,1472 ----
        Check_Restriction (No_Select_Statements, N);
        Tasking_Used := True;
  
+       --  Loop to analyze alternatives
+ 
        Alt := First (Alts);
        while Present (Alt) loop
           Alt_Count := Alt_Count + 1;
*************** package body Sem_Ch9 is
*** 1361,1367 ****
  
           elsif Nkind (Alt) = N_Terminate_Alternative then
              if Terminate_Present then
!                Error_Msg_N ("Only one terminate alternative allowed", N);
              else
                 Terminate_Present := True;
                 Check_Restriction (No_Terminate_Alternatives, N);
--- 1492,1498 ----
  
           elsif Nkind (Alt) = N_Terminate_Alternative then
              if Terminate_Present then
!                Error_Msg_N ("only one terminate alternative allowed", N);
              else
                 Terminate_Present := True;
                 Check_Restriction (No_Terminate_Alternatives, N);
*************** package body Sem_Ch9 is
*** 1462,1472 ****
        T_Decl :=
          Make_Protected_Type_Declaration (Loc,
           Defining_Identifier => T,
!          Protected_Definition => Relocate_Node (Protected_Definition (N)));
  
        O_Decl :=
          Make_Object_Declaration (Loc,
            Defining_Identifier => O_Name,
            Object_Definition   => Make_Identifier (Loc,  Chars (T)));
  
        Rewrite (N, T_Decl);
--- 1593,1608 ----
        T_Decl :=
          Make_Protected_Type_Declaration (Loc,
           Defining_Identifier => T,
!          Protected_Definition => Relocate_Node (Protected_Definition (N)),
!          Interface_List       => Interface_List (N));
! 
!       --  Ada 2005 (AI-399): Mark the object as aliased. Required to use
!       --  the attribute 'access
  
        O_Decl :=
          Make_Object_Declaration (Loc,
            Defining_Identifier => O_Name,
+           Aliased_Present     => Ada_Version >= Ada_05,
            Object_Definition   => Make_Identifier (Loc,  Chars (T)));
  
        Rewrite (N, T_Decl);
*************** package body Sem_Ch9 is
*** 1489,1495 ****
        --  expanded twice, with disastrous result.
  
        Analyze_Protected_Type (N);
- 
     end Analyze_Single_Protected;
  
     -------------------------
--- 1625,1630 ----
*************** package body Sem_Ch9 is
*** 1518,1528 ****
        T_Decl :=
          Make_Task_Type_Declaration (Loc,
            Defining_Identifier => T,
!           Task_Definition     => Relocate_Node (Task_Definition (N)));
  
        O_Decl :=
          Make_Object_Declaration (Loc,
            Defining_Identifier => O_Name,
            Object_Definition   => Make_Identifier (Loc, Chars (T)));
  
        Rewrite (N, T_Decl);
--- 1653,1668 ----
        T_Decl :=
          Make_Task_Type_Declaration (Loc,
            Defining_Identifier => T,
!           Task_Definition     => Relocate_Node (Task_Definition (N)),
!           Interface_List      => Interface_List (N));
! 
!       --  Ada 2005 (AI-399): Mark the object as aliased. Required to use
!       --  the attribute 'access
  
        O_Decl :=
          Make_Object_Declaration (Loc,
            Defining_Identifier => O_Name,
+           Aliased_Present     => Ada_Version >= Ada_05,
            Object_Definition   => Make_Identifier (Loc, Chars (T)));
  
        Rewrite (N, T_Decl);
*************** package body Sem_Ch9 is
*** 1644,1650 ****
  
        begin
           Ent := First_Entity (Spec_Id);
- 
           while Present (Ent) loop
              if Is_Entry (Ent)
                and then not Entry_Accepted (Ent)
--- 1784,1789 ----
*************** package body Sem_Ch9 is
*** 1690,1695 ****
--- 1829,1835 ----
  
        Check_Max_Entries (N, Max_Task_Entries);
        Process_End_Label (N, 'e', Current_Scope);
+       Check_Overriding_Indicator (N);
     end Analyze_Task_Definition;
  
     -----------------------
*************** package body Sem_Ch9 is
*** 1697,1704 ****
     -----------------------
  
     procedure Analyze_Task_Type (N : Node_Id) is
!       T      : Entity_Id;
!       Def_Id : constant Entity_Id := Defining_Identifier (N);
  
     begin
        Check_Restriction (No_Tasking, N);
--- 1837,1847 ----
     -----------------------
  
     procedure Analyze_Task_Type (N : Node_Id) is
!       T         : Entity_Id;
!       Def_Id    : constant Entity_Id := Defining_Identifier (N);
!       Iface     : Node_Id;
!       Iface_Def : Node_Id;
!       Iface_Typ : Entity_Id;
  
     begin
        Check_Restriction (No_Tasking, N);
*************** package body Sem_Ch9 is
*** 1720,1725 ****
--- 1863,1911 ----
        Set_Stored_Constraint  (T, No_Elist);
        New_Scope (T);
  
+       --  Ada 2005 (AI-345)
+ 
+       if Present (Interface_List (N)) then
+          Set_Is_Tagged_Type (T);
+ 
+          Iface := First (Interface_List (N));
+          while Present (Iface) loop
+             Iface_Typ := Find_Type_Of_Subtype_Indic (Iface);
+             Iface_Def := Type_Definition (Parent (Iface_Typ));
+ 
+             if not Is_Interface (Iface_Typ) then
+                Error_Msg_NE ("(Ada 2005) & must be an interface",
+                              Iface, Iface_Typ);
+ 
+             else
+                --  Ada 2005 (AI-251): The declaration of a specific descendant
+                --  of an interface type freezes the interface type (RM 13.14).
+ 
+                Freeze_Before (N, Etype (Iface));
+ 
+                --  Ada 2005 (AI-345): Task types can only implement limited,
+                --  synchronized or task interfaces.
+ 
+                if Limited_Present (Iface_Def)
+                  or else Synchronized_Present (Iface_Def)
+                  or else Task_Present (Iface_Def)
+                then
+                   null;
+ 
+                elsif Protected_Present (Iface_Def) then
+                   Error_Msg_N ("(Ada 2005) task type cannot implement a " &
+                     "protected interface", Iface);
+ 
+                else
+                   Error_Msg_N ("(Ada 2005) task type cannot implement a " &
+                     "non-limited interface", Iface);
+                end if;
+             end if;
+ 
+             Next (Iface);
+          end loop;
+       end if;
+ 
        if Present (Discriminant_Specifications (N)) then
           if Ada_Version = Ada_83 and then Comes_From_Source (N) then
              Error_Msg_N ("(Ada 83) task discriminant not allowed!", N);
*************** package body Sem_Ch9 is
*** 1736,1741 ****
--- 1922,1929 ----
           end if;
        end if;
  
+       Set_Is_Constrained (T, not Has_Discriminants (T));
+ 
        if Present (Task_Definition (N)) then
           Analyze_Task_Definition (Task_Definition (N));
        end if;
*************** package body Sem_Ch9 is
*** 1800,1812 ****
        end if;
  
        Analyze (Trigger);
        if Comes_From_Source (Trigger)
!         and then Nkind (Trigger) /= N_Delay_Until_Statement
!         and then Nkind (Trigger) /= N_Delay_Relative_Statement
          and then Nkind (Trigger) /= N_Entry_Call_Statement
        then
!          Error_Msg_N
!           ("triggering statement must be delay or entry call", Trigger);
        end if;
  
        if Is_Non_Empty_List (Statements (N)) then
--- 1988,2016 ----
        end if;
  
        Analyze (Trigger);
+ 
        if Comes_From_Source (Trigger)
!         and then Nkind (Trigger) not in N_Delay_Statement
          and then Nkind (Trigger) /= N_Entry_Call_Statement
        then
!          if Ada_Version < Ada_05 then
!             Error_Msg_N
!              ("triggering statement must be delay or entry call", Trigger);
! 
!          --  Ada 2005 (AI-345): If a procedure_call_statement is used for a
!          --  procedure_or_entry_call, the procedure_name or pro- cedure_prefix
!          --  of the procedure_call_statement shall denote an entry renamed by a
!          --  procedure, or (a view of) a primitive subprogram of a limited
!          --  interface whose first parameter is a controlling parameter.
! 
!          elsif Nkind (Trigger) = N_Procedure_Call_Statement
!            and then not Is_Renamed_Entry (Entity (Name (Trigger)))
!            and then not Is_Controlling_Limited_Procedure
!                           (Entity (Name (Trigger)))
!          then
!             Error_Msg_N ("triggering statement must be delay, procedure " &
!                          "or entry call", Trigger);
!          end if;
        end if;
  
        if Is_Non_Empty_List (Statements (N)) then
*************** package body Sem_Ch9 is
*** 1901,1906 ****
--- 2105,2363 ----
        end if;
     end Check_Max_Entries;
  
+    --------------------------------
+    -- Check_Overriding_Indicator --
+    --------------------------------
+ 
+    procedure Check_Overriding_Indicator (Def : Node_Id) is
+       Aliased_Hom : Entity_Id;
+       Decl        : Node_Id;
+       Def_Id      : Entity_Id;
+       Hom         : Entity_Id;
+       Ifaces      : constant List_Id := Interface_List (Parent (Def));
+       Overrides   : Boolean;
+       Spec        : Node_Id;
+       Vis_Decls   : constant List_Id := Visible_Declarations (Def);
+ 
+       function Matches_Prefixed_View_Profile
+         (Ifaces       : List_Id;
+          Entry_Params : List_Id;
+          Proc_Params  : List_Id) return Boolean;
+       --  Ada 2005 (AI-397): Determine if an entry parameter profile matches
+       --  the prefixed view profile of an abstract procedure. Also determine
+       --  whether the abstract procedure belongs to an implemented interface.
+ 
+       -----------------------------------
+       -- Matches_Prefixed_View_Profile --
+       -----------------------------------
+ 
+       function Matches_Prefixed_View_Profile
+         (Ifaces       : List_Id;
+          Entry_Params : List_Id;
+          Proc_Params  : List_Id) return Boolean
+       is
+          Entry_Param    : Node_Id;
+          Proc_Param     : Node_Id;
+          Proc_Param_Typ : Entity_Id;
+ 
+          function Includes_Interface
+            (Iface  : Entity_Id;
+             Ifaces : List_Id) return Boolean;
+          --  Determine if an interface is contained in a list of interfaces
+ 
+          ------------------------
+          -- Includes_Interface --
+          ------------------------
+ 
+          function Includes_Interface
+            (Iface  : Entity_Id;
+             Ifaces : List_Id) return Boolean
+          is
+             Ent : Entity_Id;
+ 
+          begin
+             Ent := First (Ifaces);
+             while Present (Ent) loop
+                if Etype (Ent) = Iface then
+                   return True;
+                end if;
+ 
+                Next (Ent);
+             end loop;
+ 
+             return False;
+          end Includes_Interface;
+ 
+       --  Start of processing for Matches_Prefixed_View_Profile
+ 
+       begin
+          Proc_Param := First (Proc_Params);
+          Proc_Param_Typ := Etype (Parameter_Type (Proc_Param));
+ 
+          --  The first parameter of the abstract procedure must be of an
+          --  interface type. The task or protected type must also implement
+          --  that interface.
+ 
+          if not Is_Interface (Proc_Param_Typ)
+            or else not Includes_Interface (Proc_Param_Typ, Ifaces)
+          then
+             return False;
+          end if;
+ 
+          Entry_Param := First (Entry_Params);
+          Proc_Param  := Next (Proc_Param);
+          while Present (Entry_Param) and then Present (Proc_Param) loop
+ 
+             --  The two parameters must be mode conformant and have the exact
+             --  same types.
+ 
+             if Ekind (Defining_Identifier (Entry_Param)) /=
+                Ekind (Defining_Identifier (Proc_Param))
+               or else Etype (Parameter_Type (Entry_Param)) /=
+                       Etype (Parameter_Type (Proc_Param))
+             then
+                return False;
+             end if;
+ 
+             Next (Entry_Param);
+             Next (Proc_Param);
+          end loop;
+ 
+          --  One of the lists is longer than the other
+ 
+          if Present (Entry_Param) or else Present (Proc_Param) then
+             return False;
+          end if;
+ 
+          return True;
+       end Matches_Prefixed_View_Profile;
+ 
+    --  Start of processing for Check_Overriding_Indicator
+ 
+    begin
+       if Present (Ifaces) then
+          Decl := First (Vis_Decls);
+          while Present (Decl) loop
+ 
+             --  Consider entries with either "overriding" or "not overriding"
+             --  indicator present.
+ 
+             if Nkind (Decl) = N_Entry_Declaration
+               and then (Must_Override (Decl)
+                           or else
+                         Must_Not_Override (Decl))
+             then
+                Def_Id := Defining_Identifier (Decl);
+ 
+                Overrides := False;
+ 
+                Hom := Homonym (Def_Id);
+                while Present (Hom) loop
+ 
+                   --  The current entry may override a procedure from an
+                   --  implemented interface.
+ 
+                   if Ekind (Hom) = E_Procedure
+                     and then (Is_Abstract (Hom)
+                                 or else
+                               Null_Present (Parent (Hom)))
+                   then
+                      Aliased_Hom := Hom;
+                      while Present (Alias (Aliased_Hom)) loop
+                         Aliased_Hom := Alias (Aliased_Hom);
+                      end loop;
+ 
+                      if Matches_Prefixed_View_Profile (Ifaces,
+                           Parameter_Specifications (Decl),
+                           Parameter_Specifications (Parent (Aliased_Hom)))
+                      then
+                         Overrides := True;
+                         exit;
+                      end if;
+                   end if;
+ 
+                   Hom := Homonym (Hom);
+                end loop;
+ 
+                if Overrides then
+                   if Must_Not_Override (Decl) then
+                      Error_Msg_NE ("entry& is overriding", Def_Id, Def_Id);
+                   end if;
+                else
+                   if Must_Override (Decl) then
+                      Error_Msg_NE ("entry& is not overriding", Def_Id, Def_Id);
+                   end if;
+                end if;
+ 
+             --  Consider subprograms with either "overriding" or "not
+             --  overriding" indicator present.
+ 
+             elsif Nkind (Decl) = N_Subprogram_Declaration
+               and then (Must_Override (Specification (Decl))
+                           or else
+                         Must_Not_Override (Specification (Decl)))
+             then
+                Spec := Specification (Decl);
+                Def_Id := Defining_Unit_Name (Spec);
+ 
+                Overrides := False;
+ 
+                Hom := Homonym (Def_Id);
+                while Present (Hom) loop
+ 
+                   --  Function
+ 
+                   if Ekind (Def_Id) = E_Function
+                     and then Ekind (Hom) = E_Function
+                     and then Is_Abstract (Hom)
+                     and then Matches_Prefixed_View_Profile (Ifaces,
+                                Parameter_Specifications (Spec),
+                                Parameter_Specifications (Parent (Hom)))
+                     and then Etype (Result_Definition (Spec)) =
+                              Etype (Result_Definition (Parent (Hom)))
+                   then
+                      Overrides := True;
+                      exit;
+ 
+                   --  Procedure
+ 
+                   elsif Ekind (Def_Id) = E_Procedure
+                     and then Ekind (Hom) = E_Procedure
+                     and then (Is_Abstract (Hom)
+                                 or else
+                               Null_Present (Parent (Hom)))
+                     and then Matches_Prefixed_View_Profile (Ifaces,
+                                Parameter_Specifications (Spec),
+                                Parameter_Specifications (Parent (Hom)))
+                   then
+                      Overrides := True;
+                      exit;
+                   end if;
+ 
+                   Hom := Homonym (Hom);
+                end loop;
+ 
+                if Overrides then
+                   if Must_Not_Override (Spec) then
+                      Error_Msg_NE
+                        ("subprogram& is overriding", Def_Id, Def_Id);
+                   end if;
+                else
+                   if Must_Override (Spec) then
+                      Error_Msg_NE
+                        ("subprogram& is not overriding", Def_Id, Def_Id);
+                   end if;
+                end if;
+             end if;
+ 
+             Next (Decl);
+          end loop;
+ 
+       --  The protected or task type is not implementing an interface,
+       --  we need to check for the presence of "overriding" entries or
+       --  subprograms and flag them as erroneous.
+ 
+       else
+          Decl := First (Vis_Decls);
+          while Present (Decl) loop
+             if Nkind (Decl) = N_Entry_Declaration
+               and then Must_Override (Decl)
+             then
+                Def_Id := Defining_Identifier (Decl);
+                Error_Msg_NE ("entry& is not overriding", Def_Id, Def_Id);
+ 
+             elsif Nkind (Decl) = N_Subprogram_Declaration
+               and then Must_Override (Specification (Decl))
+             then
+                Def_Id := Defining_Identifier (Specification (Decl));
+                Error_Msg_NE ("subprogram& is not overriding", Def_Id, Def_Id);
+             end if;
+ 
+             Next (Decl);
+          end loop;
+       end if;
+    end Check_Overriding_Indicator;
+ 
     --------------------------
     -- Find_Concurrent_Spec --
     --------------------------
*************** package body Sem_Ch9 is
*** 1929,1935 ****
  
     begin
        E := First_Entity (Spec);
- 
        while Present (E) loop
           Prev := Current_Entity (E);
           Set_Current_Entity (E);
--- 2386,2391 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_ch9.ads gcc-4.1.0/gcc/ada/sem_ch9.ads
*** gcc-4.0.2/gcc/ada/sem_ch9.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_ch9.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_disp.adb gcc-4.1.0/gcc/ada/sem_disp.adb
*** gcc-4.0.2/gcc/ada/sem_disp.adb	Thu Feb 10 13:50:45 2005
--- gcc-4.1.0/gcc/ada/sem_disp.adb	Tue Nov 15 13:57:25 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Einfo;    use Einfo;
*** 31,36 ****
--- 31,37 ----
  with Exp_Disp; use Exp_Disp;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Tss;  use Exp_Tss;
+ with Exp_Util; use Exp_Util;
  with Errout;   use Errout;
  with Hostparm; use Hostparm;
  with Nlists;   use Nlists;
*************** package body Sem_Disp is
*** 114,119 ****
--- 115,129 ----
              if Ctrl_Type = Typ then
                 Set_Is_Controlling_Formal (Formal);
  
+                --  Ada 2005 (AI-231):Anonymous access types used in controlling
+                --  parameters exclude null because it is necessary to read the
+                --  tag to dispatch, and null has no tag.
+ 
+                if Ekind (Etype (Formal)) = E_Anonymous_Access_Type then
+                   Set_Can_Never_Be_Null (Etype (Formal));
+                   Set_Is_Known_Non_Null (Etype (Formal));
+                end if;
+ 
                 --  Check that the parameter's nominal subtype statically
                 --  matches the first subtype.
  
*************** package body Sem_Disp is
*** 219,230 ****
  
        elsif Ekind (T) = E_Anonymous_Access_Type
          and then Is_Tagged_Type (Designated_Type (T))
-         and then Ekind (Designated_Type (T)) /= E_Incomplete_Type
        then
!          if Is_First_Subtype (Designated_Type (T)) then
!             Tagged_Type := Designated_Type (T);
!          else
!             Tagged_Type := Base_Type (Designated_Type (T));
           end if;
        end if;
  
--- 229,253 ----
  
        elsif Ekind (T) = E_Anonymous_Access_Type
          and then Is_Tagged_Type (Designated_Type (T))
        then
!          if Ekind (Designated_Type (T)) /= E_Incomplete_Type then
!             if Is_First_Subtype (Designated_Type (T)) then
!                Tagged_Type := Designated_Type (T);
!             else
!                Tagged_Type := Base_Type (Designated_Type (T));
!             end if;
! 
!          --  Ada 2005 (AI-50217)
! 
!          elsif From_With_Type (Designated_Type (T))
!            and then Present (Non_Limited_View (Designated_Type (T)))
!          then
!             if Is_First_Subtype (Non_Limited_View (Designated_Type (T))) then
!                Tagged_Type := Non_Limited_View (Designated_Type (T));
!             else
!                Tagged_Type := Base_Type (Non_Limited_View
!                                          (Designated_Type (T)));
!             end if;
           end if;
        end if;
  
*************** package body Sem_Disp is
*** 522,527 ****
--- 545,565 ----
        Set_Is_Dispatching_Operation (Subp, False);
        Tagged_Type := Find_Dispatching_Type (Subp);
  
+       --  Ada 2005 (AI-345)
+ 
+       if Ada_Version = Ada_05
+         and then Present (Tagged_Type)
+         and then Is_Concurrent_Type (Tagged_Type)
+       then
+          --  Protect the frontend against previously detected errors
+ 
+          if not Present (Corresponding_Record_Type (Tagged_Type)) then
+             return;
+          end if;
+ 
+          Tagged_Type := Corresponding_Record_Type (Tagged_Type);
+       end if;
+ 
        --  If Subp is derived from a dispatching operation then it should
        --  always be treated as dispatching. In this case various checks
        --  below will be bypassed. Makes sure that late declarations for
*************** package body Sem_Disp is
*** 554,561 ****
        --  where it can be a dispatching op is when it overrides an operation
        --  before the freezing point of the type.
  
!       elsif ((not Is_Package (Scope (Subp)))
!               or else In_Package_Body (Scope (Subp)))
          and then not Has_Dispatching_Parent
        then
           if not Comes_From_Source (Subp)
--- 592,599 ----
        --  where it can be a dispatching op is when it overrides an operation
        --  before the freezing point of the type.
  
!       elsif ((not Is_Package_Or_Generic_Package (Scope (Subp)))
!                or else In_Package_Body (Scope (Subp)))
          and then not Has_Dispatching_Parent
        then
           if not Comes_From_Source (Subp)
*************** package body Sem_Disp is
*** 574,581 ****
           elsif Present (Old_Subp)
             and then Is_Dispatching_Operation (Old_Subp)
           then
!             if Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Body
!               and then Comes_From_Source (Subp)
              then
                 declare
                    Subp_Body : constant Node_Id := Unit_Declaration_Node (Subp);
--- 612,621 ----
           elsif Present (Old_Subp)
             and then Is_Dispatching_Operation (Old_Subp)
           then
!             if Comes_From_Source (Subp)
!               and then
!                 (Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Body
!                   or else Nkind (Unit_Declaration_Node (Subp)) in N_Body_Stub)
              then
                 declare
                    Subp_Body : constant Node_Id := Unit_Declaration_Node (Subp);
*************** package body Sem_Disp is
*** 756,769 ****
                    then
                       Old_Spec := Corresponding_Spec (Old_Bod);
                       Set_Has_Completion             (Old_Spec, False);
- 
-                      if Exception_Mechanism = Front_End_ZCX_Exceptions then
-                         Set_Has_Subprogram_Descriptor (Old_Spec, False);
-                         Set_Handler_Records           (Old_Spec, No_List);
-                         Set_Is_Eliminated             (Old_Spec);
-                      end if;
                    end if;
- 
                 end if;
              end loop;
  
--- 796,802 ----
*************** package body Sem_Disp is
*** 947,953 ****
                 Set_Alias (Old_Subp, Alias (Subp));
  
                 --  The derived subprogram should inherit the abstractness
- 
                 --  of the parent subprogram (except in the case of a function
                 --  returning the type). This sets the abstractness properly
                 --  for cases where a private extension may have inherited
--- 980,985 ----
*************** package body Sem_Disp is
*** 1140,1145 ****
--- 1172,1205 ----
        New_Op      : Entity_Id)
     is
        Op_Elmt : Elmt_Id := First_Elmt (Primitive_Operations (Tagged_Type));
+       Elmt    : Elmt_Id;
+       Found   : Boolean;
+ 
+       function Is_Interface_Subprogram (Op : Entity_Id) return Boolean;
+       --  Comment requjired ???
+ 
+       -----------------------------
+       -- Is_Interface_Subprogram --
+       -----------------------------
+ 
+       function Is_Interface_Subprogram (Op : Entity_Id) return Boolean is
+          Aux : Entity_Id;
+ 
+       begin
+          Aux := Op;
+          while Present (Alias (Aux))
+             and then Present (DTC_Entity (Alias (Aux)))
+          loop
+             if Is_Interface (Scope (DTC_Entity (Alias (Aux)))) then
+                return True;
+             end if;
+             Aux := Alias (Aux);
+          end loop;
+ 
+          return False;
+       end Is_Interface_Subprogram;
+ 
+    --  Start of processing for Override_Dispatching_Operation
  
     begin
        --  Patch the primitive operation list
*************** package body Sem_Disp is
*** 1157,1165 ****
           return;
        end if;
  
!       Replace_Elmt (Op_Elmt, New_Op);
  
!       if (not Is_Package (Current_Scope))
          or else not In_Private_Part (Current_Scope)
        then
           --  Not a private primitive
--- 1217,1270 ----
           return;
        end if;
  
!       --  Ada 2005 (AI-251): Do not replace subprograms inherited from
!       --  abstract interfaces. They will be used later to generate the
!       --  corresponding thunks to initialize the Vtable (see subprogram
!       --  Freeze_Subprogram). The inherited operation itself must also
!       --  become hidden, to avoid spurious ambiguities;  name resolution
!       --  must pick up only the operation that implements it,
  
!       if Is_Interface_Subprogram (Prev_Op) then
!          Set_DT_Position              (Prev_Op, DT_Position (Alias (Prev_Op)));
!          Set_Is_Abstract              (Prev_Op, Is_Abstract (New_Op));
!          Set_Is_Overriding_Operation  (Prev_Op);
!          Set_Abstract_Interface_Alias (Prev_Op, Alias (Prev_Op));
!          Set_Alias                    (Prev_Op, New_Op);
!          Set_Is_Internal              (Prev_Op);
!          Set_Is_Hidden                (Prev_Op);
! 
!          --  Override predefined primitive operations
! 
!          if Is_Predefined_Dispatching_Operation (Prev_Op) then
!             Replace_Elmt (Op_Elmt, New_Op);
!             return;
!          end if;
! 
!          --  Check if this primitive operation was previously added for another
!          --  interface.
! 
!          Elmt  := First_Elmt (Primitive_Operations (Tagged_Type));
!          Found := False;
!          while Present (Elmt) loop
!             if Node (Elmt) = New_Op then
!                Found := True;
!                exit;
!             end if;
! 
!             Next_Elmt (Elmt);
!          end loop;
! 
!          if not Found then
!             Append_Elmt (New_Op, Primitive_Operations (Tagged_Type));
!             --  Replace_Elmt (Op_Elmt, New_Op); -- why is this commented out???
!          end if;
!          return;
! 
!       else
!          Replace_Elmt (Op_Elmt, New_Op);
!       end if;
! 
!       if (not Is_Package_Or_Generic_Package (Current_Scope))
          or else not In_Private_Part (Current_Scope)
        then
           --  Not a private primitive
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_disp.ads gcc-4.1.0/gcc/ada/sem_disp.ads
*** gcc-4.0.2/gcc/ada/sem_disp.ads	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_disp.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_dist.adb gcc-4.1.0/gcc/ada/sem_dist.adb
*** gcc-4.0.2/gcc/ada/sem_dist.adb	Fri Nov 19 10:56:15 2004
--- gcc-4.1.0/gcc/ada/sem_dist.adb	Mon Sep  5 07:50:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Sem;      use Sem;
*** 39,45 ****
  with Sem_Res;  use Sem_Res;
  with Sem_Util; use Sem_Util;
  with Sinfo;    use Sinfo;
- with Snames;   use Snames;
  with Stand;    use Stand;
  with Stringt;  use Stringt;
  with Tbuild;   use Tbuild;
--- 39,44 ----
*************** package body Sem_Dist is
*** 51,60 ****
     -----------------------
  
     procedure RAS_E_Dereference (Pref : Node_Id);
!    --  Handles explicit dereference of Remote Access to Subprograms.
  
     function Full_Qualified_Name (E : Entity_Id) return String_Id;
!    --  returns the full qualified name of the entity in lower case.
  
     -------------------------
     -- Add_Stub_Constructs --
--- 50,59 ----
     -----------------------
  
     procedure RAS_E_Dereference (Pref : Node_Id);
!    --  Handles explicit dereference of Remote Access to Subprograms
  
     function Full_Qualified_Name (E : Entity_Id) return String_Id;
!    --  returns the full qualified name of the entity in lower case
  
     -------------------------
     -- Add_Stub_Constructs --
*************** package body Sem_Dist is
*** 168,181 ****
           Ent := Defining_Identifier (Ent);
        end if;
  
!       --  Compute recursively the qualification. Only "Standard" has no scope.
  
        if Present (Scope (Scope (Ent))) then
           Parent_Name := Full_Qualified_Name (Scope (Ent));
        end if;
  
!       --  Every entity should have a name except some expanded blocks
!       --  don't bother about those.
  
        if Chars (Ent) = No_Name then
           return Parent_Name;
--- 167,180 ----
           Ent := Defining_Identifier (Ent);
        end if;
  
!       --  Compute recursively the qualification (only "Standard" has no scope)
  
        if Present (Scope (Scope (Ent))) then
           Parent_Name := Full_Qualified_Name (Scope (Ent));
        end if;
  
!       --  Every entity should have a name except some expanded blocks. Do not
!       --  bother about those.
  
        if Chars (Ent) = No_Name then
           return Parent_Name;
*************** package body Sem_Dist is
*** 199,204 ****
--- 198,215 ----
        return End_String;
     end Full_Qualified_Name;
  
+    ------------------
+    -- Get_PCS_Name --
+    ------------------
+ 
+    function Get_PCS_Name return PCS_Names is
+       PCS_Name : constant PCS_Names :=
+                    Chars (Entity (Expression
+                                     (Parent (RTE (RE_DSA_Implementation)))));
+    begin
+       return PCS_Name;
+    end Get_PCS_Name;
+ 
     ------------------------
     -- Is_All_Remote_Call --
     ------------------------
*************** package body Sem_Dist is
*** 273,279 ****
           Ety := Scope (Ety);
        end loop;
  
!       --  Retrieve the proper function to call.
  
        if Is_Remote_Call_Interface (Ety) then
           Get_Pt_Id := New_Occurrence_Of
--- 284,290 ----
           Ety := Scope (Ety);
        end loop;
  
!       --  Retrieve the proper function to call
  
        if Is_Remote_Call_Interface (Ety) then
           Get_Pt_Id := New_Occurrence_Of
*************** package body Sem_Dist is
*** 341,347 ****
  
        Remote_Subp := Entity (Prefix (N));
  
!       if not Expander_Active then
           return;
        end if;
  
--- 352,358 ----
  
        Remote_Subp := Entity (Prefix (N));
  
!       if not Expander_Active or else Get_PCS_Name = Name_No_DSA then
           return;
        end if;
  
*************** package body Sem_Dist is
*** 413,419 ****
                             (Loc, New_External_Name (
                                     Chars (User_Type), 'R'));
  
- 
        Full_Obj_Type  : constant Entity_Id :=
                           Make_Defining_Identifier
                             (Loc, Chars (Obj_Type));
--- 424,429 ----
*************** package body Sem_Dist is
*** 429,442 ****
        Fat_Type_Decl  : Node_Id;
  
     begin
  
!       --  The tagged private type, primitive operation and RACW
!       --  type associated with a RAS need to all be declared in
!       --  a subpackage of the one that contains the RAS declaration,
!       --  because the primitive of the object type, and the associated
!       --  primitive of the stub type, need to be dispatching operations
!       --  of these types, and the profile of the RAS might contain
!       --  tagged types declared in the same scope.
  
        Append_To (Vis_Decls,
          Make_Private_Type_Declaration (Loc,
--- 439,478 ----
        Fat_Type_Decl  : Node_Id;
  
     begin
+       Is_Degenerate := False;
+       Parameter := First (Parameter_Specifications (Type_Def));
+       while Present (Parameter) loop
+          if Nkind (Parameter_Type (Parameter)) = N_Access_Definition then
+             Error_Msg_N ("formal parameter& has anonymous access type?",
+               Defining_Identifier (Parameter));
+             Is_Degenerate := True;
+             exit;
+          end if;
  
!          Next (Parameter);
!       end loop;
! 
!       if Is_Degenerate then
!          Error_Msg_NE
!            ("remote access-to-subprogram type& can only be null?",
!             Defining_Identifier (Parameter), User_Type);
! 
!          --  The only legal value for a RAS with a formal parameter of an
!          --  anonymous access type is null, because it cannot be subtype-
!          --  conformant with any legal remote subprogram declaration. In this
!          --  case, we cannot generate a corresponding primitive operation.
!       end if;
! 
!       if Get_PCS_Name = Name_No_DSA then
!          return;
!       end if;
! 
!       --  The tagged private type, primitive operation and RACW type associated
!       --  with a RAS need to all be declared in a subpackage of the one that
!       --  contains the RAS declaration, because the primitive of the object
!       --  type, and the associated primitive of the stub type, need to be
!       --  dispatching operations of these types, and the profile of the RAS
!       --  might contain tagged types declared in the same scope.
  
        Append_To (Vis_Decls,
          Make_Private_Type_Declaration (Loc,
*************** package body Sem_Dist is
*** 457,485 ****
                Null_Present     => True,
                Component_List   => Empty)));
  
!       Is_Degenerate := False;
!       Parameter := First (Parameter_Specifications (Type_Def));
!       Parameters : while Present (Parameter) loop
!          if Nkind (Parameter_Type (Parameter)) = N_Access_Definition then
!             Error_Msg_N ("formal parameter& has anonymous access type?",
!               Defining_Identifier (Parameter));
!             Is_Degenerate := True;
!             exit Parameters;
!          end if;
!          Next (Parameter);
!       end loop Parameters;
! 
!       if Is_Degenerate then
!          Error_Msg_NE (
!            "remote access-to-subprogram type& can only be null?",
!            Defining_Identifier (Parameter), User_Type);
!          --  The only legal value for a RAS with a formal parameter of an
!          --  anonymous access type is null, because it cannot be
!          --  subtype-Conformant with any legal remote subprogram declaration.
!          --  In this case, we cannot generate a corresponding primitive
!          --  operation.
! 
!       else
           Append_To (Vis_Decls,
             Make_Abstract_Subprogram_Declaration (Loc,
               Specification => Build_RAS_Primitive_Specification (
--- 493,499 ----
                Null_Present     => True,
                Component_List   => Empty)));
  
!       if not Is_Degenerate then
           Append_To (Vis_Decls,
             Make_Abstract_Subprogram_Declaration (Loc,
               Specification => Build_RAS_Primitive_Specification (
*************** package body Sem_Dist is
*** 590,601 ****
           end if;
  
        else
!          --  Context is not a call.
  
           return;
        end if;
  
!       if not Expander_Active then
           return;
        end if;
  
--- 604,615 ----
           end if;
  
        else
!          --  Context is not a call
  
           return;
        end if;
  
!       if not Expander_Active or else Get_PCS_Name = Name_No_DSA then
           return;
        end if;
  
*************** package body Sem_Dist is
*** 685,691 ****
        Target_Type : Entity_Id;
  
     begin
!       if not Expander_Active then
           return False;
  
        elsif Ekind (Typ) = E_Access_Subprogram_Type
--- 699,705 ----
        Target_Type : Entity_Id;
  
     begin
!       if not Expander_Active or else Get_PCS_Name = Name_No_DSA then
           return False;
  
        elsif Ekind (Typ) = E_Access_Subprogram_Type
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_dist.ads gcc-4.1.0/gcc/ada/sem_dist.ads
*** gcc-4.0.2/gcc/ada/sem_dist.ads	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/sem_dist.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,40 ****
  
  --  Semantic processing for distribution annex facilities
  
! with Types; use Types;
  
  package Sem_Dist is
  
     procedure Add_Stub_Constructs (N : Node_Id);
     --  Create the stubs constructs for a remote call interface package
!    --  specification or body or for a shared passive specification. For
!    --  caller stubs, expansion takes place directly in the specification and
!    --  no additional compilation unit is created.
  
     function Build_RAS_Primitive_Specification
       (Subp_Spec          : Node_Id;
--- 26,45 ----
  
  --  Semantic processing for distribution annex facilities
  
! with Snames; use Snames;
! with Types;  use Types;
  
  package Sem_Dist is
  
+    function Get_PCS_Name return PCS_Names;
+    --  Return the name of a literal of type System.Partition_Interface.
+    --  DSA_Implementation_Type indicating what PCS is currently in use.
+ 
     procedure Add_Stub_Constructs (N : Node_Id);
     --  Create the stubs constructs for a remote call interface package
!    --  specification or body or for a shared passive specification. For caller
!    --  stubs, expansion takes place directly in the specification and no
!    --  additional compilation unit is created.
  
     function Build_RAS_Primitive_Specification
       (Subp_Spec          : Node_Id;
*************** package Sem_Dist is
*** 59,93 ****
     --  whose return type is New_Type.
  
     procedure Process_Remote_AST_Declaration (N : Node_Id);
!    --  Given N, an access to subprogram type declaration node in RCI or
!    --  remote types unit, build a new record (fat pointer) type declaration
!    --  using the old Defining_Identifier of N and a link to the old
!    --  declaration node N whose Defining_Identifier is changed.
!    --  We also construct declarations of two subprograms in the unit
!    --  specification which handle remote access to subprogram type
!    --  (fat pointer) dereference and the unit receiver that handles
!    --  remote calls (from remote access to subprogram type values.)
  
     function Remote_AST_E_Dereference (P : Node_Id) return Boolean;
     --  If the prefix of an explicit dereference is a record type that
!    --  represent the fat pointer for an Remote access to subprogram, in
!    --  the context of a call, rewrite the enclosing call node into a
!    --  remote call, the first actual of which is the fat pointer. Return
!    --  true if the context is correct and the transformation took place.
  
     function Remote_AST_I_Dereference (P : Node_Id) return Boolean;
     --  If P is a record type that represents the fat pointer for a remote
!    --  access to subprogram, and P is the prefix of a call, insert an
!    --  explicit dereference and perform the transformation described for
!    --  the previous function.
  
     function Remote_AST_Null_Value
       (N   : Node_Id;
        Typ : Entity_Id) return Boolean;
!    --  If N is a null value and Typ a remote access to subprogram type,
!    --  this function will check if null needs to be replaced with an
!    --  aggregate and will return True in this case. Otherwise, it will
!    --  return False.
  
     function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id;
     --  Return the N_Package_Specification corresponding to a scope E
--- 64,96 ----
     --  whose return type is New_Type.
  
     procedure Process_Remote_AST_Declaration (N : Node_Id);
!    --  Given N, an access to subprogram type declaration node in RCI or remote
!    --  types unit, build a new record (fat pointer) type declaration using the
!    --  old Defining_Identifier of N and a link to the old declaration node N
!    --  whose Defining_Identifier is changed. We also construct declarations of
!    --  two subprograms in the unit specification which handle remote access to
!    --  subprogram type (fat pointer) dereference and the unit receiver that
!    --  handles remote calls (from remote access to subprogram type values.)
  
     function Remote_AST_E_Dereference (P : Node_Id) return Boolean;
     --  If the prefix of an explicit dereference is a record type that
!    --  represent the fat pointer for an Remote access to subprogram, in the
!    --  context of a call, rewrite the enclosing call node into remote call,
!    --  the first actual of which is the fat pointer. Return true if the
!    --  context is correct and the transformation took place.
  
     function Remote_AST_I_Dereference (P : Node_Id) return Boolean;
     --  If P is a record type that represents the fat pointer for a remote
!    --  access to subprogram, and P is the prefix of a call, insert an explicit
!    --  dereference and perform the transformation described for the previous
!    --  function.
  
     function Remote_AST_Null_Value
       (N   : Node_Id;
        Typ : Entity_Id) return Boolean;
!    --  If N is a null value and Typ a remote access to subprogram type, this
!    --  function will check if null needs to be replaced with an aggregate and
!    --  will return True in this case. Otherwise, it will return False.
  
     function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id;
     --  Return the N_Package_Specification corresponding to a scope E
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_elab.adb gcc-4.1.0/gcc/ada/sem_elab.adb
*** gcc-4.0.2/gcc/ada/sem_elab.adb	Thu Feb 10 13:55:59 2005
--- gcc-4.1.0/gcc/ada/sem_elab.adb	Tue Nov 15 13:56:27 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Elab is
*** 117,123 ****
  
        Outer_Scope : Entity_Id;
        --  Save scope of outer level call
- 
     end record;
  
     package Delay_Check is new Table.Table (
--- 117,122 ----
*************** package body Sem_Elab is
*** 166,171 ****
--- 165,177 ----
     --  then the original call was an inner call, and we are not interested
     --  in calls that go outside this scope.
  
+    procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id);
+    --  Analysis of construct N shows that we should set Elaborate_All_Desirable
+    --  for the WITH clause for unit U (which will always be present). A special
+    --  case is when N is a function or procedure instantiation, in which case
+    --  it is sufficient to set Elaborate_Desirable, since in this case there is
+    --  no possibility of transitive elaboration issues.
+ 
     procedure Check_A_Call
       (N                 : Node_Id;
        E                 : Entity_Id;
*************** package body Sem_Elab is
*** 296,312 ****
     --  convention Stubbed.
  
     procedure Supply_Bodies (L : List_Id);
!    --  Calls Supply_Bodies for all elements of the given list L.
  
     function Within (E1, E2 : Entity_Id) return Boolean;
!    --  Given two scopes E1 and E2, returns True if E1 is equal to E2, or
!    --  is one of its contained scopes, False otherwise.
  
     function Within_Elaborate_All (E : Entity_Id) return Boolean;
     --  Before emitting a warning on a scope E for a missing elaborate_all,
!    --  check whether E may be in the context of a directly visible unit
!    --  U to which the pragma applies. This prevents spurious warnings when
!    --  the called entity is renamed within U.
  
     ------------------
     -- Check_A_Call --
--- 302,425 ----
     --  convention Stubbed.
  
     procedure Supply_Bodies (L : List_Id);
!    --  Calls Supply_Bodies for all elements of the given list L
  
     function Within (E1, E2 : Entity_Id) return Boolean;
!    --  Given two scopes E1 and E2, returns True if E1 is equal to E2, or is one
!    --  of its contained scopes, False otherwise.
  
     function Within_Elaborate_All (E : Entity_Id) return Boolean;
     --  Before emitting a warning on a scope E for a missing elaborate_all,
!    --  check whether E may be in the context of a directly visible unit U to
!    --  which the pragma applies. This prevents spurious warnings when the
!    --  called entity is renamed within U.
! 
!    --------------------------------------
!    -- Activate_Elaborate_All_Desirable --
!    --------------------------------------
! 
!    procedure Activate_Elaborate_All_Desirable (N : Node_Id; U : Entity_Id) is
!       UN  : constant Unit_Number_Type := Get_Code_Unit (N);
!       CU  : constant Node_Id          := Cunit (UN);
!       UE  : constant Entity_Id        := Cunit_Entity (UN);
!       Unm : constant Unit_Name_Type   := Unit_Name (UN);
!       CI  : constant List_Id          := Context_Items (CU);
!       Itm : Node_Id;
!       Ent : Entity_Id;
! 
!       procedure Set_Elab_Flag (Itm : Node_Id);
!       --  Sets Elaborate_[All_]Desirable as appropriate on Itm
! 
!       -------------------
!       -- Set_Elab_Flag --
!       -------------------
! 
!       procedure Set_Elab_Flag (Itm : Node_Id) is
!       begin
!          if Nkind (N) in N_Subprogram_Instantiation then
!             Set_Elaborate_Desirable (Itm);
!          else
!             Set_Elaborate_All_Desirable (Itm);
!          end if;
!       end Set_Elab_Flag;
! 
!    --  Start of processing for Activate_Elaborate_All_Desirable
! 
!    begin
!       Itm := First (CI);
!       while Present (Itm) loop
!          if Nkind (Itm) = N_With_Clause then
!             Ent := Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));
! 
!             --  If we find it, then mark elaborate all desirable and return
! 
!             if U = Ent then
!                Set_Elab_Flag (Itm);
!                return;
!             end if;
!          end if;
! 
!          Next (Itm);
!       end loop;
! 
!       --  If we fall through then the with clause is not present in the
!       --  current unit. One legitimate possibility is that the with clause
!       --  is present in the spec when we are a body.
! 
!       if Is_Body_Name (Unm) then
!          declare
!             UEs : constant Entity_Id        := Spec_Entity (UE);
!             UNs : constant Unit_Number_Type := Get_Source_Unit (UEs);
!             CUs : constant Node_Id          := Cunit (UNs);
!             CIs : constant List_Id          := Context_Items (CUs);
! 
!          begin
!             Itm := First (CIs);
!             while Present (Itm) loop
!                if Nkind (Itm) = N_With_Clause then
!                   Ent :=
!                     Cunit_Entity (Get_Cunit_Unit_Number (Library_Unit (Itm)));
! 
!                   if U = Ent then
! 
!                      --  If we find it, we have to create an implicit copy
!                      --  of the with clause for the body, just so that it
!                      --  can be marked as elaborate desirable (it would be
!                      --  wrong to put it on the spec item, since it is the
!                      --  body that has possible elaboration problems, not
!                      --  the spec.
! 
!                      declare
!                         CW : constant Node_Id :=
!                                Make_With_Clause (Sloc (Itm),
!                                  Name => Name (Itm));
! 
!                      begin
!                         Set_Library_Unit  (CW, Library_Unit (Itm));
!                         Set_Implicit_With (CW, True);
! 
!                         --  Set elaborate all desirable on copy and then
!                         --  append the copy to the list of body with's
!                         --  and we are done.
! 
!                         Set_Elab_Flag (CW);
!                         Append_To (CI, CW);
!                         return;
!                      end;
!                   end if;
!                end if;
! 
!                Next (Itm);
!             end loop;
!          end;
!       end if;
! 
!       --  Here if we do not find with clause on spec or body. We just ignore
!       --  this case, it means that the elaboration involves some other unit
!       --  than the unit being compiled, and will be caught elsewhere.
! 
!       null;
!    end Activate_Elaborate_All_Desirable;
  
     ------------------
     -- Check_A_Call --
*************** package body Sem_Elab is
*** 370,376 ****
  
        if (Nkind (N) = N_Function_Call
             or else Nkind (N) = N_Procedure_Call_Statement)
!         and then  No_Elaboration_Check (N)
        then
           return;
        end if;
--- 483,489 ----
  
        if (Nkind (N) = N_Function_Call
             or else Nkind (N) = N_Procedure_Call_Statement)
!         and then No_Elaboration_Check (N)
        then
           return;
        end if;
*************** package body Sem_Elab is
*** 710,717 ****
              end if;
  
              Error_Msg_Qual_Level := Nat'Last;
!             Error_Msg_NE
!               ("\missing pragma Elaborate_All for&?", N, W_Scope);
              Error_Msg_Qual_Level := 0;
              Output_Calls (N);
  
--- 823,837 ----
              end if;
  
              Error_Msg_Qual_Level := Nat'Last;
! 
!             if Nkind (N) in N_Subprogram_Instantiation then
!                Error_Msg_NE
!                  ("\missing pragma Elaborate for&?", N, W_Scope);
!             else
!                Error_Msg_NE
!                  ("\missing pragma Elaborate_All for&?", N, W_Scope);
!             end if;
! 
              Error_Msg_Qual_Level := 0;
              Output_Calls (N);
  
*************** package body Sem_Elab is
*** 893,899 ****
          ("\?Program_Error will be raised at run time", N);
        Insert_Elab_Check (N);
        Set_ABE_Is_Certain (N);
- 
     end Check_Bad_Instantiation;
  
     ---------------------
--- 1013,1018 ----
*************** package body Sem_Elab is
*** 963,969 ****
        then
           return;
  
!       --  Nothing to do if this is a call already rewritten for elab checking.
  
        elsif Nkind (Parent (N)) = N_Conditional_Expression then
           return;
--- 1082,1088 ----
        then
           return;
  
!       --  Nothing to do if this is a call already rewritten for elab checking
  
        elsif Nkind (Parent (N)) = N_Conditional_Expression then
           return;
*************** package body Sem_Elab is
*** 1051,1076 ****
                and then In_Preelaborated_Unit
                and then not In_Inlined_Body
              then
                 Error_Msg_N
!                  ("non-static call not allowed in preelaborated unit", N);
                 return;
              end if;
  
!          --  Second case, we are inside a subprogram or concurrent unit
!          --  i.e, we are not in elaboration code.
  
           else
              --  In this case, the issue is whether we are inside the
!             --  declarative part of the unit in which we live, or inside
!             --  its statements. In the latter case, there is no issue of
!             --  ABE calls at this level (a call from outside to the unit
!             --  in which we live might cause an ABE, but that will be
!             --  detected when we analyze that outer level call, as it
!             --  recurses into the called unit).
  
!             --  Climb up the tree, doing this test, and also testing
!             --  for being inside a default expression, which, as
!             --  discussed above, is not checked at this stage.
  
              declare
                 P : Node_Id;
--- 1170,1198 ----
                and then In_Preelaborated_Unit
                and then not In_Inlined_Body
              then
+                --  This is a warning in GNAT mode allowing such calls to be
+                --  used in the predefined library with appropriate care.
+ 
+                Error_Msg_Warn := GNAT_Mode;
                 Error_Msg_N
!                  ("<non-static call not allowed in preelaborated unit", N);
                 return;
              end if;
  
!          --  Second case, we are inside a subprogram or concurrent unit, which
!          --  means we are not in elaboration code.
  
           else
              --  In this case, the issue is whether we are inside the
!             --  declarative part of the unit in which we live, or inside its
!             --  statements. In the latter case, there is no issue of ABE calls
!             --  at this level (a call from outside to the unit in which we live
!             --  might cause an ABE, but that will be detected when we analyze
!             --  that outer level call, as it recurses into the called unit).
  
!             --  Climb up the tree, doing this test, and also testing for being
!             --  inside a default expression, which, as discussed above, is not
!             --  checked at this stage.
  
              declare
                 P : Node_Id;
*************** package body Sem_Elab is
*** 1079,1087 ****
              begin
                 P := N;
                 loop
!                   --  If we find a parentless subtree, it seems safe to
!                   --  assume that we are not in a declarative part and
!                   --  that no checking is required.
  
                    if No (P) then
                       return;
--- 1201,1209 ----
              begin
                 P := N;
                 loop
!                   --  If we find a parentless subtree, it seems safe to assume
!                   --  that we are not in a declarative part and that no
!                   --  checking is required.
  
                    if No (P) then
                       return;
*************** package body Sem_Elab is
*** 1097,1104 ****
  
                    exit when Nkind (P) = N_Subunit;
  
!                   --  Filter out case of default expressions, where
!                   --  we do not do the check at this stage.
  
                    if Nkind (P) = N_Parameter_Specification
                         or else
--- 1219,1226 ----
  
                    exit when Nkind (P) = N_Subunit;
  
!                   --  Filter out case of default expressions, where we do not
!                   --  do the check at this stage.
  
                    if Nkind (P) = N_Parameter_Specification
                         or else
*************** package body Sem_Elab is
*** 1107,1119 ****
                       return;
                    end if;
  
!                   if Nkind (P) = N_Subprogram_Body
!                        or else
!                      Nkind (P) = N_Protected_Body
                         or else
                       Nkind (P) = N_Task_Body
                         or else
                       Nkind (P) = N_Block_Statement
                    then
                       if L = Declarations (P) then
                          exit;
--- 1229,1247 ----
                       return;
                    end if;
  
!                   --  A protected body has no elaboration code and contains
!                   --  only other bodies.
! 
!                   if Nkind (P) = N_Protected_Body then
!                      return;
! 
!                   elsif Nkind (P) = N_Subprogram_Body
                         or else
                       Nkind (P) = N_Task_Body
                         or else
                       Nkind (P) = N_Block_Statement
+                        or else
+                      Nkind (P) = N_Entry_Body
                    then
                       if L = Declarations (P) then
                          exit;
*************** package body Sem_Elab is
*** 1127,1137 ****
                       elsif Dynamic_Elaboration_Checks then
  
                          --  This is a rather new check, going into version
!                         --  3.14a1 for the first time (V1.80 of this unit),
!                         --  so we provide a debug flag to enable it. That
!                         --  way we have an easy work around for regressions
!                         --  that are caused by this new check. This debug
!                         --  flag can be removed later.
  
                          if Debug_Flag_DD then
                             return;
--- 1255,1265 ----
                       elsif Dynamic_Elaboration_Checks then
  
                          --  This is a rather new check, going into version
!                         --  3.14a1 for the first time (V1.80 of this unit), so
!                         --  we provide a debug flag to enable it. That way we
!                         --  have an easy work around for regressions that are
!                         --  caused by this new check. This debug flag can be
!                         --  removed later.
  
                          if Debug_Flag_DD then
                             return;
*************** package body Sem_Elab is
*** 1372,1378 ****
           return;
        end if;
  
!       --  Nothing to do if the instantiation is not in the main unit.
  
        if not In_Extended_Main_Code_Unit (N) then
           return;
--- 1500,1506 ----
           return;
        end if;
  
!       --  Nothing to do if the instantiation is not in the main unit
  
        if not In_Extended_Main_Code_Unit (N) then
           return;
*************** package body Sem_Elab is
*** 1507,1513 ****
        else
           Check_Internal_Call_Continue (N, E, Outer_Scope, Orig_Ent);
        end if;
- 
     end Check_Internal_Call;
  
     ----------------------------------
--- 1635,1640 ----
*************** package body Sem_Elab is
*** 1658,1666 ****
           --  does not normally visit subprogram bodies.
  
           declare
!             Decl : Node_Id := First (Declarations (Sbody));
! 
           begin
              while Present (Decl) loop
                 Traverse (Decl);
                 Next (Decl);
--- 1785,1793 ----
           --  does not normally visit subprogram bodies.
  
           declare
!             Decl : Node_Id;
           begin
+             Decl := First (Declarations (Sbody));
              while Present (Decl) loop
                 Traverse (Decl);
                 Next (Decl);
*************** package body Sem_Elab is
*** 1827,1833 ****
             and then Has_Task (Base_Type (Typ))
           then
              Comp := First_Component (Typ);
- 
              while Present (Comp) loop
                 Add_Task_Proc (Etype (Comp));
                 Comp := Next_Component (Comp);
--- 1954,1959 ----
*************** package body Sem_Elab is
*** 1871,1880 ****
                 end if;
  
              else
!                Elmt := First_Elmt (Inter_Procs);
! 
!                --  No need for multiple entries of the same type.
  
                 while Present (Elmt) loop
                    if Node (Elmt) = Proc then
                       return;
--- 1997,2005 ----
                 end if;
  
              else
!                --  No need for multiple entries of the same type
  
+                Elmt := First_Elmt (Inter_Procs);
                 while Present (Elmt) loop
                    if Node (Elmt) = Proc then
                       return;
*************** package body Sem_Elab is
*** 1896,1904 ****
        begin
           if Present (Decls) then
              Decl := First (Decls);
- 
              while Present (Decl) loop
- 
                 if Nkind (Decl) = N_Object_Declaration
                   and then Has_Task (Etype (Defining_Identifier (Decl)))
                 then
--- 2021,2027 ----
*************** package body Sem_Elab is
*** 1915,1923 ****
        ----------------
  
        function Outer_Unit (E : Entity_Id) return Entity_Id is
!          Outer : Entity_Id := E;
  
        begin
           while Present (Outer) loop
              if Elaboration_Checks_Suppressed (Outer) then
                 Cunit_SC := True;
--- 2038,2047 ----
        ----------------
  
        function Outer_Unit (E : Entity_Id) return Entity_Id is
!          Outer : Entity_Id;
  
        begin
+          Outer := E;
           while Present (Outer) loop
              if Elaboration_Checks_Suppressed (Outer) then
                 Cunit_SC := True;
*************** package body Sem_Elab is
*** 1937,1943 ****
     begin
        Enclosing := Outer_Unit (Current_Scope);
  
!       --  Find all tasks declared in the current unit.
  
        if Nkind (N) = N_Package_Body then
           P := Unit_Declaration_Node (Corresponding_Spec (N));
--- 2061,2067 ----
     begin
        Enclosing := Outer_Unit (Current_Scope);
  
!       --  Find all tasks declared in the current unit
  
        if Nkind (N) = N_Package_Body then
           P := Unit_Declaration_Node (Corresponding_Spec (N));
*************** package body Sem_Elab is
*** 1967,1973 ****
        --  the task body to be elaborated before the current one.
  
        Elmt := First_Elmt (Inter_Procs);
- 
        while Present (Elmt) loop
           Ent := Node (Elmt);
           Task_Scope := Outer_Unit (Scope (Ent));
--- 2091,2096 ----
*************** package body Sem_Elab is
*** 2011,2017 ****
                    " requires pragma Elaborate_All on &?", N, Ent);
              end if;
  
!             Set_Elaborate_All_Desirable (Task_Scope);
              Set_Suppress_Elaboration_Warnings (Task_Scope);
           end if;
  
--- 2134,2140 ----
                    " requires pragma Elaborate_All on &?", N, Ent);
              end if;
  
!             Activate_Elaborate_All_Desirable (N, Task_Scope);
              Set_Suppress_Elaboration_Warnings (Task_Scope);
           end if;
  
*************** package body Sem_Elab is
*** 2022,2029 ****
        --  the task procedure bodies, which are available.
  
        In_Task_Activation := True;
-       Elmt := First_Elmt (Intra_Procs);
  
        while Present (Elmt) loop
           Ent := Node (Elmt);
           Check_Internal_Call_Continue (N, Ent, Enclosing, Ent);
--- 2145,2152 ----
        --  the task procedure bodies, which are available.
  
        In_Task_Activation := True;
  
+       Elmt := First_Elmt (Intra_Procs);
        while Present (Elmt) loop
           Ent := Node (Elmt);
           Check_Internal_Call_Continue (N, Ent, Enclosing, Ent);
*************** package body Sem_Elab is
*** 2057,2063 ****
          or else
            (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
        then
!          Set_Elaborate_All_Desirable (Scop);
           Set_Suppress_Elaboration_Warnings (Scop, True);
           return;
        end if;
--- 2180,2186 ----
          or else
            (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
        then
!          Activate_Elaborate_All_Desirable (Call, Scop);
           Set_Suppress_Elaboration_Warnings (Scop, True);
           return;
        end if;
*************** package body Sem_Elab is
*** 2074,2086 ****
           null;  --  detailed processing follows.
  
        else
!          Set_Elaborate_All_Desirable (Scop);
           Set_Suppress_Elaboration_Warnings (Scop, True);
           return;
        end if;
  
        --  If the unit is not in the context, there must be an intermediate
!       --  unit that is, on which we need to place to elaboration flag.
  
        if Is_Init_Proc (Subp)
          or else Init_Call
--- 2197,2210 ----
           null;  --  detailed processing follows.
  
        else
!          Activate_Elaborate_All_Desirable (Call, Scop);
           Set_Suppress_Elaboration_Warnings (Scop, True);
           return;
        end if;
  
        --  If the unit is not in the context, there must be an intermediate
!       --  unit that is, on which we need to place to elaboration flag. This
!       --  happens with init proc calls.
  
        if Is_Init_Proc (Subp)
          or else Init_Call
*************** package body Sem_Elab is
*** 2095,2116 ****
                       Etype (First (Parameter_Associations (Call)));
           begin
              Elab_Unit := Scope (Typ);
- 
              while (Present (Elab_Unit))
                and then not Is_Compilation_Unit (Elab_Unit)
              loop
                 Elab_Unit := Scope (Elab_Unit);
              end loop;
           end;
-       elsif Nkind (Original_Node (Call)) = N_Selected_Component then
  
!          --  If original node uses selected component notation, the
!          --  prefix is visible and determines the scope that must be
!          --  elaborated. After rewriting, the prefix is the first actual
!          --  in the call.
  
           Elab_Unit := Scope (Etype (First (Parameter_Associations (Call))));
  
        else
           --  Using previously computed scope. If the elaboration check is
           --  done after analysis, the scope is not visible any longer, but
--- 2219,2240 ----
                       Etype (First (Parameter_Associations (Call)));
           begin
              Elab_Unit := Scope (Typ);
              while (Present (Elab_Unit))
                and then not Is_Compilation_Unit (Elab_Unit)
              loop
                 Elab_Unit := Scope (Elab_Unit);
              end loop;
           end;
  
!       --  If original node uses selected component notation, the prefix is
!       --  visible and determines the scope that must be elaborated. After
!       --  rewriting, the prefix is the first actual in the call.
  
+       elsif Nkind (Original_Node (Call)) = N_Selected_Component then
           Elab_Unit := Scope (Etype (First (Parameter_Associations (Call))));
  
+       --  Not one of special cases above
+ 
        else
           --  Using previously computed scope. If the elaboration check is
           --  done after analysis, the scope is not visible any longer, but
*************** package body Sem_Elab is
*** 2119,2125 ****
           Elab_Unit := Scop;
        end if;
  
!       Set_Elaborate_All_Desirable (Elab_Unit);
        Set_Suppress_Elaboration_Warnings (Elab_Unit, True);
     end Set_Elaboration_Constraint;
  
--- 2243,2249 ----
           Elab_Unit := Scop;
        end if;
  
!       Activate_Elaborate_All_Desirable (Call, Elab_Unit);
        Set_Suppress_Elaboration_Warnings (Elab_Unit, True);
     end Set_Elaboration_Constraint;
  
*************** package body Sem_Elab is
*** 2265,2271 ****
  
           --  Otherwise look and see if we are embedded in a further package
  
!          elsif Is_Package (Scop) then
  
              --  If so, get the body of the enclosing package, and look in
              --  its package body for the package body we are looking for.
--- 2389,2395 ----
  
           --  Otherwise look and see if we are embedded in a further package
  
!          elsif Is_Package_Or_Generic_Package (Scop) then
  
              --  If so, get the body of the enclosing package, and look in
              --  its package body for the package body we are looking for.
*************** package body Sem_Elab is
*** 2308,2323 ****
           --  Case of entity is in other than a package spec, in this case
           --  the body, if present, must be in the same declarative part.
  
!          if not Is_Package (Scop) then
              declare
                 P : Node_Id;
  
              begin
-                P := Declaration_Node (Ent);
- 
                 --  Declaration node may get us a spec, so if so, go to
                 --  the parent declaration.
  
                 while not Is_List_Member (P) loop
                    P := Parent (P);
                 end loop;
--- 2432,2446 ----
           --  Case of entity is in other than a package spec, in this case
           --  the body, if present, must be in the same declarative part.
  
!          if not Is_Package_Or_Generic_Package (Scop) then
              declare
                 P : Node_Id;
  
              begin
                 --  Declaration node may get us a spec, so if so, go to
                 --  the parent declaration.
  
+                P := Declaration_Node (Ent);
                 while not Is_List_Member (P) loop
                    P := Parent (P);
                 end loop;
*************** package body Sem_Elab is
*** 2529,2546 ****
     ----------------------------
  
     function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean is
!       S1 : Entity_Id := Scop1;
!       S2 : Entity_Id := Scop2;
  
     begin
        while S1 /= Standard_Standard
          and then (Ekind (S1) = E_Package
                      or else
                    Ekind (S1) = E_Block)
        loop
           S1 := Scope (S1);
        end loop;
  
        while S2 /= Standard_Standard
          and then (Ekind (S2) = E_Package
                      or else
--- 2652,2677 ----
     ----------------------------
  
     function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean is
!       S1 : Entity_Id;
!       S2 : Entity_Id;
  
     begin
+       --  Find elaboration scope for Scop1
+ 
+       S1 := Scop1;
        while S1 /= Standard_Standard
          and then (Ekind (S1) = E_Package
                      or else
+                   Ekind (S1) = E_Protected_Type
+                     or else
                    Ekind (S1) = E_Block)
        loop
           S1 := Scope (S1);
        end loop;
  
+       --  Find elaboration scope for Scop2
+ 
+       S2 := Scop2;
        while S2 /= Standard_Standard
          and then (Ekind (S2) = E_Package
                      or else
*************** package body Sem_Elab is
*** 2603,2609 ****
        if Nkind (N) = N_Subprogram_Declaration then
           declare
              Ent : constant Entity_Id := Defining_Unit_Name (Specification (N));
- 
           begin
              Set_Is_Imported (Ent);
              Set_Convention  (Ent, Convention_Stubbed);
--- 2734,2739 ----
*************** package body Sem_Elab is
*** 2612,2618 ****
        elsif Nkind (N) = N_Package_Declaration then
           declare
              Spec : constant Node_Id := Specification (N);
- 
           begin
              New_Scope (Defining_Unit_Name (Spec));
              Supply_Bodies (Visible_Declarations (Spec));
--- 2742,2747 ----
*************** package body Sem_Elab is
*** 2624,2630 ****
  
     procedure Supply_Bodies (L : List_Id) is
        Elmt : Node_Id;
- 
     begin
        if Present (L) then
           Elmt := First (L);
--- 2753,2758 ----
*************** package body Sem_Elab is
*** 2644,2650 ****
  
     begin
        Scop := E1;
- 
        loop
           if Scop = E2 then
              return True;
--- 2772,2777 ----
*************** package body Sem_Elab is
*** 2672,2696 ****
  
     begin
        Item := First (Context_Items (Cunit (Current_Sem_Unit)));
- 
        while Present (Item) loop
           if Nkind (Item) = N_Pragma
             and then Get_Pragma_Id (Chars (Item)) = Pragma_Elaborate_All
           then
!             if Error_Posted (Item) then
! 
!                --  Some previous error on the pragma itself
  
                 return False;
              end if;
  
              Elab_Id :=
!               Entity (
!                 Expression (First (Pragma_Argument_Associations (Item))));
  
!             Par   := Parent (Unit_Declaration_Node (Elab_Id));
!             Item2 := First (Context_Items (Par));
  
              while Present (Item2) loop
                 if Nkind (Item2) = N_With_Clause
                   and then Entity (Name (Item2)) = E
--- 2799,2821 ----
  
     begin
        Item := First (Context_Items (Cunit (Current_Sem_Unit)));
        while Present (Item) loop
           if Nkind (Item) = N_Pragma
             and then Get_Pragma_Id (Chars (Item)) = Pragma_Elaborate_All
           then
!             --  Return if some previous error on the pragma itself
  
+             if Error_Posted (Item) then
                 return False;
              end if;
  
              Elab_Id :=
!               Entity
!                 (Expression (First (Pragma_Argument_Associations (Item))));
  
!             Par := Parent (Unit_Declaration_Node (Elab_Id));
  
+             Item2 := First (Context_Items (Par));
              while Present (Item2) loop
                 if Nkind (Item2) = N_With_Clause
                   and then Entity (Name (Item2)) = E
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_elab.ads gcc-4.1.0/gcc/ada/sem_elab.ads
*** gcc-4.0.2/gcc/ada/sem_elab.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_elab.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_elim.adb gcc-4.1.0/gcc/ada/sem_elim.adb
*** gcc-4.0.2/gcc/ada/sem_elim.adb	Mon Jan  3 15:36:25 2005
--- gcc-4.1.0/gcc/ada/sem_elim.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_elim.ads gcc-4.1.0/gcc/ada/sem_elim.ads
*** gcc-4.0.2/gcc/ada/sem_elim.ads	Mon Apr 19 15:20:06 2004
--- gcc-4.1.0/gcc/ada/sem_elim.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1997-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Elim is
*** 58,63 ****
     --  subprogram. N is the node for the call, and E is the entity of
     --  the subprogram being eliminated.
  
- 
- 
  end Sem_Elim;
--- 58,61 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_eval.adb gcc-4.1.0/gcc/ada/sem_eval.adb
*** gcc-4.0.2/gcc/ada/sem_eval.adb	Thu Feb 10 13:50:38 2005
--- gcc-4.1.0/gcc/ada/sem_eval.adb	Tue Nov 15 14:03:33 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Elists;   use Elists;
*** 32,37 ****
--- 32,38 ----
  with Errout;   use Errout;
  with Eval_Fat; use Eval_Fat;
  with Exp_Util; use Exp_Util;
+ with Lib;      use Lib;
  with Nmake;    use Nmake;
  with Nlists;   use Nlists;
  with Opt;      use Opt;
*************** package body Sem_Eval is
*** 377,384 ****
  
     function Compile_Time_Compare
       (L, R : Node_Id;
!       Rec  : Boolean := False)
!       return Compare_Result
     is
        Ltyp : constant Entity_Id := Etype (L);
        Rtyp : constant Entity_Id := Etype (R);
--- 378,384 ----
  
     function Compile_Time_Compare
       (L, R : Node_Id;
!       Rec  : Boolean := False) return Compare_Result
     is
        Ltyp : constant Entity_Id := Etype (L);
        Rtyp : constant Entity_Id := Etype (R);
*************** package body Sem_Eval is
*** 795,800 ****
--- 795,828 ----
        end if;
     end Compile_Time_Compare;
  
+    -------------------------------
+    -- Compile_Time_Known_Bounds --
+    -------------------------------
+ 
+    function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean is
+       Indx : Node_Id;
+       Typ  : Entity_Id;
+ 
+    begin
+       if not Is_Array_Type (T) then
+          return False;
+       end if;
+ 
+       Indx := First_Index (T);
+       while Present (Indx) loop
+          Typ := Underlying_Type (Etype (Indx));
+          if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
+             return False;
+          elsif not Compile_Time_Known_Value (Type_High_Bound (Typ)) then
+             return False;
+          else
+             Next_Index (Indx);
+          end if;
+       end loop;
+ 
+       return True;
+    end Compile_Time_Known_Bounds;
+ 
     ------------------------------
     -- Compile_Time_Known_Value --
     ------------------------------
*************** package body Sem_Eval is
*** 2172,2177 ****
--- 2200,2225 ----
                 return;
              end if;
           end;
+ 
+       --  Another special case: comparisons against null for pointers that
+       --  are known to be non-null. This is useful when migrating from Ada95
+       --  code when non-null restrictions are added to type declarations and
+       --  parameter specifications.
+ 
+       elsif Is_Access_Type (Typ)
+         and then Comes_From_Source (N)
+         and then
+           ((Is_Entity_Name (Left)
+              and then Is_Known_Non_Null (Entity (Left))
+              and then Nkind (Right) = N_Null)
+           or else
+             (Is_Entity_Name (Right)
+               and then Is_Known_Non_Null (Entity (Right))
+               and then Nkind (Left) = N_Null))
+       then
+          Fold_Uint (N, Test (Nkind (N) = N_Op_Ne), False);
+          Warn_On_Known_Condition (N);
+          return;
        end if;
  
        --  Can only fold if type is scalar (don't fold string ops)
*************** package body Sem_Eval is
*** 3116,3123 ****
     function In_Subrange_Of
       (T1        : Entity_Id;
        T2        : Entity_Id;
!       Fixed_Int : Boolean := False)
!       return      Boolean
     is
        L1 : Node_Id;
        H1 : Node_Id;
--- 3164,3170 ----
     function In_Subrange_Of
       (T1        : Entity_Id;
        T2        : Entity_Id;
!       Fixed_Int : Boolean := False) return Boolean
     is
        L1 : Node_Id;
        H1 : Node_Id;
*************** package body Sem_Eval is
*** 3219,3226 ****
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False)
!       return      Boolean
     is
        Val  : Uint;
        Valr : Ureal;
--- 3266,3272 ----
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False) return Boolean
     is
        Val  : Uint;
        Valr : Ureal;
*************** package body Sem_Eval is
*** 3400,3407 ****
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False)
!       return      Boolean
     is
        Val  : Uint;
        Valr : Ureal;
--- 3446,3452 ----
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False) return Boolean
     is
        Val  : Uint;
        Valr : Ureal;
*************** package body Sem_Eval is
*** 3691,3699 ****
     ------------------------------------
  
     function Subtypes_Statically_Compatible
!      (T1   : Entity_Id;
!       T2   : Entity_Id)
!       return Boolean
     is
     begin
        if Is_Scalar_Type (T1) then
--- 3736,3743 ----
     ------------------------------------
  
     function Subtypes_Statically_Compatible
!      (T1 : Entity_Id;
!       T2 : Entity_Id) return Boolean
     is
     begin
        if Is_Scalar_Type (T1) then
*************** package body Sem_Eval is
*** 3883,3890 ****
        --  Type with discriminants
  
        elsif Has_Discriminants (T1) or else Has_Discriminants (T2) then
           if Has_Discriminants (T1) /= Has_Discriminants (T2) then
!             return False;
           end if;
  
           declare
--- 3927,3960 ----
        --  Type with discriminants
  
        elsif Has_Discriminants (T1) or else Has_Discriminants (T2) then
+ 
+          --  Because of view exchanges in multiple instantiations, conformance
+          --  checking might try to match a partial view of a type with no
+          --  discriminants with a full view that has defaulted discriminants.
+          --  In such a case, use the discriminant constraint of the full view,
+          --  which must exist because we know that the two subtypes have the
+          --  same base type.
+ 
           if Has_Discriminants (T1) /= Has_Discriminants (T2) then
!             if In_Instance then
!                if Is_Private_Type (T2)
!                  and then Present (Full_View (T2))
!                  and then Has_Discriminants (Full_View (T2))
!                then
!                   return Subtypes_Statically_Match (T1, Full_View (T2));
! 
!                elsif Is_Private_Type (T1)
!                  and then Present (Full_View (T1))
!                  and then Has_Discriminants (Full_View (T1))
!                then
!                   return Subtypes_Statically_Match (Full_View (T1), T2);
! 
!                else
!                   return False;
!                end if;
!             else
!                return False;
!             end if;
           end if;
  
           declare
*************** package body Sem_Eval is
*** 3935,3945 ****
           return True;
  
        --  A definite type does not match an indefinite or classwide type
  
        elsif
           Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
        then
!          return False;
  
        --  Array type
  
--- 4005,4025 ----
           return True;
  
        --  A definite type does not match an indefinite or classwide type
+       --  However, a generic type with unknown discriminants may be
+       --  instantiated with a type with no discriminants, and conformance
+       --  checking on an inherited operation may compare the actual with
+       --  the subtype that renames it in the instance.
  
        elsif
           Has_Unknown_Discriminants (T1) /= Has_Unknown_Discriminants (T2)
        then
!          if Is_Generic_Actual_Type (T1)
!            and then Etype (T1) = T2
!          then
!             return True;
!          else
!             return False;
!          end if;
  
        --  Array type
  
*************** package body Sem_Eval is
*** 4014,4026 ****
     is
     begin
        Stat := False;
  
        --  If operand is Any_Type, just propagate to result and do not
        --  try to fold, this prevents cascaded errors.
  
        if Etype (Op1) = Any_Type then
           Set_Etype (N, Any_Type);
-          Fold := False;
           return;
  
        --  If operand raises constraint error, then replace node N with the
--- 4094,4110 ----
     is
     begin
        Stat := False;
+       Fold := False;
+ 
+       if Debug_Flag_Dot_F and then In_Extended_Main_Source_Unit (N) then
+          return;
+       end if;
  
        --  If operand is Any_Type, just propagate to result and do not
        --  try to fold, this prevents cascaded errors.
  
        if Etype (Op1) = Any_Type then
           Set_Etype (N, Any_Type);
           return;
  
        --  If operand raises constraint error, then replace node N with the
*************** package body Sem_Eval is
*** 4030,4036 ****
  
        elsif Raises_Constraint_Error (Op1) then
           Rewrite_In_Raise_CE (N, Op1);
-          Fold := False;
           return;
  
        --  If the operand is not static, then the result is not static, and
--- 4114,4119 ----
*************** package body Sem_Eval is
*** 4049,4055 ****
          and then Is_Generic_Type (Etype (Op1))
        then
           Check_Non_Static_Context (Op1);
-          Fold := False;
           return;
  
        --  Here we have the case of an operand whose type is OK, which is
--- 4132,4137 ----
*************** package body Sem_Eval is
*** 4076,4088 ****
  
     begin
        Stat := False;
  
        --  If either operand is Any_Type, just propagate to result and
        --  do not try to fold, this prevents cascaded errors.
  
        if Etype (Op1) = Any_Type or else Etype (Op2) = Any_Type then
           Set_Etype (N, Any_Type);
-          Fold := False;
           return;
  
        --  If left operand raises constraint error, then replace node N with
--- 4158,4174 ----
  
     begin
        Stat := False;
+       Fold := False;
+ 
+       if Debug_Flag_Dot_F and then In_Extended_Main_Source_Unit (N) then
+          return;
+       end if;
  
        --  If either operand is Any_Type, just propagate to result and
        --  do not try to fold, this prevents cascaded errors.
  
        if Etype (Op1) = Any_Type or else Etype (Op2) = Any_Type then
           Set_Etype (N, Any_Type);
           return;
  
        --  If left operand raises constraint error, then replace node N with
*************** package body Sem_Eval is
*** 4097,4103 ****
  
           Rewrite_In_Raise_CE (N, Op1);
           Set_Is_Static_Expression (N, Rstat);
-          Fold := False;
           return;
  
        --  Similar processing for the case of the right operand. Note that
--- 4183,4188 ----
*************** package body Sem_Eval is
*** 4111,4117 ****
  
           Rewrite_In_Raise_CE (N, Op2);
           Set_Is_Static_Expression (N, Rstat);
-          Fold := False;
           return;
  
        --  Exclude expressions of a generic modular type, as above
--- 4196,4201 ----
*************** package body Sem_Eval is
*** 4120,4126 ****
          and then Is_Generic_Type (Etype (Op1))
        then
           Check_Non_Static_Context (Op1);
-          Fold := False;
           return;
  
        --  If result is not static, then check non-static contexts on operands
--- 4204,4209 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_eval.ads gcc-4.1.0/gcc/ada/sem_eval.ads
*** gcc-4.0.2/gcc/ada/sem_eval.ads	Thu Feb 10 13:57:01 2005
--- gcc-4.1.0/gcc/ada/sem_eval.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Eval is
*** 137,144 ****
     subtype Compare_LE is Compare_Result range LT .. EQ;
     function Compile_Time_Compare
       (L, R : Node_Id;
!       Rec  : Boolean := False)
!       return Compare_Result;
     --  Given two expression nodes, finds out whether it can be determined
     --  at compile time how the runtime values will compare. An Unknown
     --  result means that the result of a comparison cannot be determined at
--- 137,143 ----
     subtype Compare_LE is Compare_Result range LT .. EQ;
     function Compile_Time_Compare
       (L, R : Node_Id;
!       Rec  : Boolean := False) return Compare_Result;
     --  Given two expression nodes, finds out whether it can be determined
     --  at compile time how the runtime values will compare. An Unknown
     --  result means that the result of a comparison cannot be determined at
*************** package Sem_Eval is
*** 194,202 ****
     --  range is not static, or because one or the other bound raises CE).
  
     function Subtypes_Statically_Compatible
!      (T1   : Entity_Id;
!       T2   : Entity_Id)
!       return Boolean;
     --  Returns true if the subtypes are unconstrained or the constraint on
     --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
     --  Otherwise returns false.
--- 193,200 ----
     --  range is not static, or because one or the other bound raises CE).
  
     function Subtypes_Statically_Compatible
!      (T1 : Entity_Id;
!       T2 : Entity_Id) return Boolean;
     --  Returns true if the subtypes are unconstrained or the constraint on
     --  on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
     --  Otherwise returns false.
*************** package Sem_Eval is
*** 222,227 ****
--- 220,230 ----
     --  whose constituent expressions are either compile time known values
     --  or compile time known aggregates.
  
+    function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
+    --  If T is an array whose index bounds are all known at compile time,
+    --  then True is returned, if T is not an array, or one or more of its
+    --  index bounds is not known at compile time, then False is returned.
+ 
     function Expr_Value (N : Node_Id) return Uint;
     --  Returns the folded value of the expression N. This function is called
     --  in instances where it has already been determined that the expression
*************** package Sem_Eval is
*** 330,337 ****
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False)
!       return      Boolean;
     --  Returns True if it can be guaranteed at compile time that expression
     --  N is known to be in range of the subtype Typ. If the values of N or
     --  of either bouds of Type are unknown at compile time, False will
--- 333,339 ----
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False) return Boolean;
     --  Returns True if it can be guaranteed at compile time that expression
     --  N is known to be in range of the subtype Typ. If the values of N or
     --  of either bouds of Type are unknown at compile time, False will
*************** package Sem_Eval is
*** 353,360 ****
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False)
!       return      Boolean;
     --  Returns True if it can be guaranteed at compile time that expression
     --  N is known to be out of range of the subtype Typ.  True is returned
     --  if Typ is a scalar type, at least one of whose bounds is known at
--- 355,361 ----
       (N         : Node_Id;
        Typ       : Entity_Id;
        Fixed_Int : Boolean := False;
!       Int_Real  : Boolean := False) return Boolean;
     --  Returns True if it can be guaranteed at compile time that expression
     --  N is known to be out of range of the subtype Typ.  True is returned
     --  if Typ is a scalar type, at least one of whose bounds is known at
*************** package Sem_Eval is
*** 367,374 ****
     function In_Subrange_Of
       (T1        : Entity_Id;
        T2        : Entity_Id;
!       Fixed_Int : Boolean := False)
!       return      Boolean;
     --  Returns True if it can be guaranteed at compile time that the range
     --  of values for scalar type T1 are always in the range of scalar type
     --  T2.  A result of False does not mean that T1 is not in T2's subrange,
--- 368,374 ----
     function In_Subrange_Of
       (T1        : Entity_Id;
        T2        : Entity_Id;
!       Fixed_Int : Boolean := False) return Boolean;
     --  Returns True if it can be guaranteed at compile time that the range
     --  of values for scalar type T1 are always in the range of scalar type
     --  T2.  A result of False does not mean that T1 is not in T2's subrange,
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_intr.adb gcc-4.1.0/gcc/ada/sem_intr.adb
*** gcc-4.0.2/gcc/ada/sem_intr.adb	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_intr.adb	Tue Nov 15 13:58:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Intr is
*** 132,137 ****
--- 132,146 ----
                ("argument in call to & must be 31 characters or less", N, Nam);
           end if;
  
+       --  Check for the case of freeing a non-null object which will raise
+       --  Constaint_Error. Issue warning here, do the expansion in Exp_Intr.
+ 
+       elsif Cnam = Name_Free
+         and then Can_Never_Be_Null (Etype (Arg1))
+       then
+          Error_Msg_N
+            ("freeing `NOT NULL` object will raise Constraint_Error?", N);
+ 
        --  For now, no other special checks are required
  
        else
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_intr.ads gcc-4.1.0/gcc/ada/sem_intr.ads
*** gcc-4.0.2/gcc/ada/sem_intr.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_intr.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_maps.adb gcc-4.1.0/gcc/ada/sem_maps.adb
*** gcc-4.0.2/gcc/ada/sem_maps.adb	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_maps.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Maps is
*** 48,54 ****
  
     procedure Write_Map (E : Entity_Id);
     pragma Warnings (Off, Write_Map);
!    --  For debugging purposes.
  
     ---------------------
     -- Add_Association --
--- 48,54 ----
  
     procedure Write_Map (E : Entity_Id);
     pragma Warnings (Off, Write_Map);
!    --  For debugging purposes
  
     ---------------------
     -- Add_Association --
*************** package body Sem_Maps is
*** 72,78 ****
  
        if Headers_Table.Table (Offh + J) /= No_Assoc then
  
!          --  Place new association at head of chain.
  
           Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
        end if;
--- 72,78 ----
  
        if Headers_Table.Table (Offh + J) /= No_Assoc then
  
!          --  Place new association at head of chain
  
           Associations_Table.Table (K).Next := Headers_Table.Table (Offh + J);
        end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_maps.ads gcc-4.1.0/gcc/ada/sem_maps.ads
*** gcc-4.0.2/gcc/ada/sem_maps.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_maps.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 36,42 ****
  --  Map composition of renaming maps takes place for nested instantiations,
  --  for generic child units, and for formal packages.
  
! --  For additional details, see the documentation in sem_ch12.
  
  with Table;
  with Types; use Types;
--- 36,42 ----
  --  Map composition of renaming maps takes place for nested instantiations,
  --  for generic child units, and for formal packages.
  
! --  For additional details, see the documentation in sem_ch12
  
  with Table;
  with Types; use Types;
*************** package Sem_Maps is
*** 58,81 ****
     --  and New_Map (e2) = e3, then the image of e1 under the result is e3.
  
     function Copy (M : Map) return Map;
!    --  Full copy of contents and headers.
  
     function Lookup (M : Map; E : Entity_Id) return Entity_Id;
!    --  Retrieve image of E under M, Empty if undefined.
  
     procedure Add_Association
       (M    : in out Map;
        O_Id : Entity_Id;
        N_Id : Entity_Id;
        Kind : Scope_Kind := S_Local);
!    --  Update M in place. On entry M (O_Id) must not be defined.
  
     procedure Update_Association
       (M    : in out Map;
        O_Id : Entity_Id;
        N_Id : Entity_Id;
        Kind : Scope_Kind := S_Local);
!    --  Update the entry in M for O_Id.
  
     function Build_Instance_Map (M : Map) return Map;
     --  Copy renaming map of generic, and create new entities for all the
--- 58,81 ----
     --  and New_Map (e2) = e3, then the image of e1 under the result is e3.
  
     function Copy (M : Map) return Map;
!    --  Full copy of contents and headers
  
     function Lookup (M : Map; E : Entity_Id) return Entity_Id;
!    --  Retrieve image of E under M, Empty if undefined
  
     procedure Add_Association
       (M    : in out Map;
        O_Id : Entity_Id;
        N_Id : Entity_Id;
        Kind : Scope_Kind := S_Local);
!    --  Update M in place. On entry M (O_Id) must not be defined
  
     procedure Update_Association
       (M    : in out Map;
        O_Id : Entity_Id;
        N_Id : Entity_Id;
        Kind : Scope_Kind := S_Local);
!    --  Update the entry in M for O_Id
  
     function Build_Instance_Map (M : Map) return Map;
     --  Copy renaming map of generic, and create new entities for all the
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_mech.adb gcc-4.1.0/gcc/ada/sem_mech.adb
*** gcc-4.0.2/gcc/ada/sem_mech.adb	Tue Oct 21 13:42:20 2003
--- gcc-4.1.0/gcc/ada/sem_mech.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_mech.ads gcc-4.1.0/gcc/ada/sem_mech.ads
*** gcc-4.0.2/gcc/ada/sem_mech.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_mech.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_prag.adb gcc-4.1.0/gcc/ada/sem_prag.adb
*** gcc-4.0.2/gcc/ada/sem_prag.adb	Thu Feb 10 13:50:26 2005
--- gcc-4.1.0/gcc/ada/sem_prag.adb	Tue Nov 15 13:51:09 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Sem_Ch3;  use Sem_Ch3;
*** 55,60 ****
--- 55,61 ----
  with Sem_Ch8;  use Sem_Ch8;
  with Sem_Ch13; use Sem_Ch13;
  with Sem_Disp; use Sem_Disp;
+ with Sem_Dist; use Sem_Dist;
  with Sem_Elim; use Sem_Elim;
  with Sem_Eval; use Sem_Eval;
  with Sem_Intr; use Sem_Intr;
*************** with Sem_Res;  use Sem_Res;
*** 63,68 ****
--- 64,70 ----
  with Sem_Type; use Sem_Type;
  with Sem_Util; use Sem_Util;
  with Sem_VFpt; use Sem_VFpt;
+ with Sem_Warn; use Sem_Warn;
  with Stand;    use Stand;
  with Sinfo;    use Sinfo;
  with Sinfo.CN; use Sinfo.CN;
*************** package body Sem_Prag is
*** 235,242 ****
  
        Pragma_Exit : exception;
        --  This exception is used to exit pragma processing completely. It
!       --  is used when an error is detected, and in other situations where
!       --  it is known that no further processing is required.
  
        Arg_Count : Nat;
        --  Number of pragma argument associations
--- 237,245 ----
  
        Pragma_Exit : exception;
        --  This exception is used to exit pragma processing completely. It
!       --  is used when an error is detected, and no further processing is
!       --  required. It is also used if an earlier error has left the tree
!       --  in a state where the pragma should not be processed.
  
        Arg_Count : Nat;
        --  Number of pragma argument associations
*************** package body Sem_Prag is
*** 248,253 ****
--- 251,260 ----
        --  First four pragma arguments (pragma argument association nodes,
        --  or Empty if the corresponding argument does not exist).
  
+       type Name_List is array (Natural range <>) of Name_Id;
+       type Args_List is array (Natural range <>) of Node_Id;
+       --  Types used for arguments to Check_Arg_Order and Gather_Associations
+ 
        procedure Check_Ada_83_Warning;
        --  Issues a warning message for the current pragma if operating in Ada
        --  83 mode (used for language pragmas that are not a standard part of
*************** package body Sem_Prag is
*** 321,326 ****
--- 328,338 ----
        --  valid task dispatching policy name. If not give error and raise
        --  Pragma_Exit.
  
+       procedure Check_Arg_Order (Names : Name_List);
+       --  Checks for an instance of two arguments with identifiers for the
+       --  current pragma which are not in the sequence indicated by Names,
+       --  and if so, generates a fatal message about bad order of arguments.
+ 
        procedure Check_At_Least_N_Arguments (N : Nat);
        --  Check there are at least N arguments present
  
*************** package body Sem_Prag is
*** 442,449 ****
        --  unit pragma that is not a compilation unit pragma, then the
        --  identifier must be visible.
  
!       type Name_List is array (Natural range <>) of Name_Id;
!       type Args_List is array (Natural range <>) of Node_Id;
        procedure Gather_Associations
          (Names : Name_List;
           Args  : out Args_List);
--- 454,466 ----
        --  unit pragma that is not a compilation unit pragma, then the
        --  identifier must be visible.
  
!       function Find_Unique_Parameterless_Procedure
!         (Name : Entity_Id;
!          Arg  : Node_Id) return Entity_Id;
!       --  Used for a procedure pragma to find the unique parameterless
!       --  procedure identified by Name, returns it if it exists, otherwise
!       --  errors out and uses Arg as the pragma argument for the message.
! 
        procedure Gather_Associations
          (Names : Name_List;
           Args  : out Args_List);
*************** package body Sem_Prag is
*** 898,903 ****
--- 915,956 ----
           end if;
        end Check_Arg_Is_Task_Dispatching_Policy;
  
+       ---------------------
+       -- Check_Arg_Order --
+       ---------------------
+ 
+       procedure Check_Arg_Order (Names : Name_List) is
+          Arg : Node_Id;
+ 
+          Highest_So_Far : Natural := 0;
+          --  Highest index in Names seen do far
+ 
+       begin
+          Arg := Arg1;
+          for J in 1 .. Arg_Count loop
+             if Chars (Arg) /= No_Name then
+                for K in Names'Range loop
+                   if Chars (Arg) = Names (K) then
+                      if K < Highest_So_Far then
+                         Error_Msg_Name_1 := Chars (N);
+                         Error_Msg_N
+                           ("parameters out of order for pragma%", Arg);
+                         Error_Msg_Name_1 := Names (K);
+                         Error_Msg_Name_2 := Names (Highest_So_Far);
+                         Error_Msg_N ("\% must appear before %", Arg);
+                         raise Pragma_Exit;
+ 
+                      else
+                         Highest_So_Far := K;
+                      end if;
+                   end if;
+                end loop;
+             end if;
+ 
+             Arg := Next (Arg);
+          end loop;
+       end Check_Arg_Order;
+ 
        --------------------------------
        -- Check_At_Least_N_Arguments --
        --------------------------------
*************** package body Sem_Prag is
*** 1031,1137 ****
  
        procedure Check_Interrupt_Or_Attach_Handler is
           Arg1_X : constant Node_Id := Expression (Arg1);
  
        begin
           Analyze (Arg1_X);
  
!          if not Is_Entity_Name (Arg1_X) then
!             Error_Pragma_Arg
!               ("argument of pragma% must be entity name", Arg1);
! 
!          elsif Prag_Id = Pragma_Interrupt_Handler then
              Check_Restriction (No_Dynamic_Attachment, N);
           end if;
  
!          declare
!             Handler_Proc : Entity_Id := Empty;
!             Proc_Scope   : Entity_Id;
!             Found        : Boolean := False;
! 
!          begin
!             if not Is_Overloaded (Arg1_X) then
!                Handler_Proc := Entity (Arg1_X);
! 
!             else
!                declare
!                   It    : Interp;
!                   Index : Interp_Index;
! 
!                begin
!                   Get_First_Interp (Arg1_X, Index, It);
!                   while Present (It.Nam) loop
!                      Handler_Proc := It.Nam;
! 
!                      if Ekind (Handler_Proc) = E_Procedure
!                        and then No (First_Formal (Handler_Proc))
!                      then
!                         if not Found then
!                            Found := True;
!                            Set_Entity (Arg1_X, Handler_Proc);
!                            Set_Is_Overloaded (Arg1_X, False);
!                         else
!                            Error_Pragma_Arg
!                              ("ambiguous handler name for pragma% ", Arg1);
!                         end if;
!                      end if;
! 
!                      Get_Next_Interp (Index, It);
!                   end loop;
! 
!                   if not Found then
!                      Error_Pragma_Arg
!                        ("argument of pragma% must be parameterless procedure",
!                         Arg1);
!                   else
!                      Handler_Proc := Entity (Arg1_X);
!                   end if;
!                end;
!             end if;
! 
!             Proc_Scope := Scope (Handler_Proc);
! 
!             --  On AAMP only, a pragma Interrupt_Handler is supported for
!             --  nonprotected parameterless procedures.
  
!             if AAMP_On_Target
!               and then Prag_Id = Pragma_Interrupt_Handler
!             then
!                if Ekind (Handler_Proc) /= E_Procedure then
!                   Error_Pragma_Arg
!                     ("argument of pragma% must be a procedure", Arg1);
!                end if;
  
!             elsif Ekind (Handler_Proc) /= E_Procedure
!               or else Ekind (Proc_Scope) /= E_Protected_Type
!             then
                 Error_Pragma_Arg
                   ("argument of pragma% must be protected procedure", Arg1);
              end if;
  
!             if (not AAMP_On_Target or else Prag_Id = Pragma_Attach_Handler)
!               and then Ekind (Proc_Scope) = E_Protected_Type
!             then
!                if Parent (N) /=
!                     Protected_Definition (Parent (Proc_Scope))
!                then
!                   Error_Pragma ("pragma% must be in protected definition");
!                end if;
!             end if;
! 
!             if not Is_Library_Level_Entity (Proc_Scope)
!               or else (AAMP_On_Target
!                         and then not Is_Library_Level_Entity (Handler_Proc))
!             then
!                Error_Pragma_Arg
!                  ("pragma% requires library-level entity", Arg1);
              end if;
  
!             if Present (First_Formal (Handler_Proc)) then
!                Error_Pragma_Arg
!                  ("argument of pragma% must be parameterless procedure",
!                   Arg1);
!             end if;
!          end;
        end Check_Interrupt_Or_Attach_Handler;
  
        -------------------------------------------
--- 1084,1124 ----
  
        procedure Check_Interrupt_Or_Attach_Handler is
           Arg1_X : constant Node_Id := Expression (Arg1);
+          Handler_Proc, Proc_Scope : Entity_Id;
  
        begin
           Analyze (Arg1_X);
  
!          if Prag_Id = Pragma_Interrupt_Handler then
              Check_Restriction (No_Dynamic_Attachment, N);
           end if;
  
!          Handler_Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1);
!          Proc_Scope := Scope (Handler_Proc);
  
!          --  On AAMP only, a pragma Interrupt_Handler is supported for
!          --  nonprotected parameterless procedures.
  
!          if not AAMP_On_Target
!            or else Prag_Id = Pragma_Attach_Handler
!          then
!             if Ekind (Proc_Scope) /= E_Protected_Type then
                 Error_Pragma_Arg
                   ("argument of pragma% must be protected procedure", Arg1);
              end if;
  
!             if Parent (N) /= Protected_Definition (Parent (Proc_Scope)) then
!                Error_Pragma ("pragma% must be in protected definition");
              end if;
+          end if;
  
!          if not Is_Library_Level_Entity (Proc_Scope)
!            or else (AAMP_On_Target
!                      and then not Is_Library_Level_Entity (Handler_Proc))
!          then
!             Error_Pragma_Arg
!               ("argument for pragma% must be library level entity", Arg1);
!          end if;
        end Check_Interrupt_Or_Attach_Handler;
  
        -------------------------------------------
*************** package body Sem_Prag is
*** 1346,1360 ****
  
                    Analyze (Expression (Arg1));
  
!                   if        Unit_Kind = N_Generic_Subprogram_Declaration
                      or else Unit_Kind = N_Subprogram_Declaration
                    then
                       Unit_Name := Defining_Entity (Unit_Node);
  
!                   elsif     Unit_Kind = N_Function_Instantiation
!                     or else Unit_Kind = N_Package_Instantiation
!                     or else Unit_Kind = N_Procedure_Instantiation
!                   then
                       Unit_Name := Defining_Entity (Unit_Node);
  
                    else
--- 1333,1344 ----
  
                    Analyze (Expression (Arg1));
  
!                   if Unit_Kind = N_Generic_Subprogram_Declaration
                      or else Unit_Kind = N_Subprogram_Declaration
                    then
                       Unit_Name := Defining_Entity (Unit_Node);
  
!                   elsif Unit_Kind in N_Generic_Instantiation then
                       Unit_Name := Defining_Entity (Unit_Node);
  
                    else
*************** package body Sem_Prag is
*** 1570,1578 ****
           else
              Analyze (Id);
           end if;
- 
        end Find_Program_Unit_Name;
  
        -------------------------
        -- Gather_Associations --
        -------------------------
--- 1554,1627 ----
           else
              Analyze (Id);
           end if;
        end Find_Program_Unit_Name;
  
+       -----------------------------------------
+       -- Find_Unique_Parameterless_Procedure --
+       -----------------------------------------
+ 
+       function Find_Unique_Parameterless_Procedure
+         (Name : Entity_Id;
+          Arg  : Node_Id) return Entity_Id
+       is
+          Proc : Entity_Id := Empty;
+ 
+       begin
+          --  The body of this procedure needs some comments ???
+ 
+          if not Is_Entity_Name (Name) then
+             Error_Pragma_Arg
+               ("argument of pragma% must be entity name", Arg);
+ 
+          elsif not Is_Overloaded (Name) then
+             Proc := Entity (Name);
+ 
+             if Ekind (Proc) /= E_Procedure
+                  or else Present (First_Formal (Proc)) then
+                Error_Pragma_Arg
+                  ("argument of pragma% must be parameterless procedure", Arg);
+             end if;
+ 
+          else
+             declare
+                Found : Boolean := False;
+                It    : Interp;
+                Index : Interp_Index;
+ 
+             begin
+                Get_First_Interp (Name, Index, It);
+                while Present (It.Nam) loop
+                   Proc := It.Nam;
+ 
+                   if Ekind (Proc) = E_Procedure
+                     and then No (First_Formal (Proc))
+                   then
+                      if not Found then
+                         Found := True;
+                         Set_Entity (Name, Proc);
+                         Set_Is_Overloaded (Name, False);
+                      else
+                         Error_Pragma_Arg
+                           ("ambiguous handler name for pragma% ", Arg);
+                      end if;
+                   end if;
+ 
+                   Get_Next_Interp (Index, It);
+                end loop;
+ 
+                if not Found then
+                   Error_Pragma_Arg
+                     ("argument of pragma% must be parameterless procedure",
+                      Arg);
+                else
+                   Proc := Entity (Name);
+                end if;
+             end;
+          end if;
+ 
+          return Proc;
+       end Find_Unique_Parameterless_Procedure;
+ 
        -------------------------
        -- Gather_Associations --
        -------------------------
*************** package body Sem_Prag is
*** 1964,1971 ****
  
        begin
           Check_At_Least_N_Arguments (2);
-          Check_Arg_Is_Identifier (Arg1);
           Check_Optional_Identifier (Arg1, Name_Convention);
           Cname := Chars (Expression (Arg1));
  
           --  C_Pass_By_Copy is treated as a synonym for convention C
--- 2013,2020 ----
  
        begin
           Check_At_Least_N_Arguments (2);
           Check_Optional_Identifier (Arg1, Name_Convention);
+          Check_Arg_Is_Identifier (Arg1);
           Cname := Chars (Expression (Arg1));
  
           --  C_Pass_By_Copy is treated as a synonym for convention C
*************** package body Sem_Prag is
*** 1995,2002 ****
              C := Convention_C;
           end if;
  
-          Check_Arg_Is_Local_Name (Arg2);
           Check_Optional_Identifier (Arg2, Name_Entity);
  
           Id := Expression (Arg2);
           Analyze (Id);
--- 2044,2051 ----
              C := Convention_C;
           end if;
  
           Check_Optional_Identifier (Arg2, Name_Entity);
+          Check_Arg_Is_Local_Name (Arg2);
  
           Id := Expression (Arg2);
           Analyze (Id);
*************** package body Sem_Prag is
*** 2091,2097 ****
             and then Ekind (E) /= E_Variable
             and then not
               (Is_Access_Type (E)
!               and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
           then
              Error_Pragma_Arg
                ("second argument of pragma% must be subprogram (type)",
--- 2140,2146 ----
             and then Ekind (E) /= E_Variable
             and then not
               (Is_Access_Type (E)
!                 and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
           then
              Error_Pragma_Arg
                ("second argument of pragma% must be subprogram (type)",
*************** package body Sem_Prag is
*** 2124,2130 ****
              Comp_Unit := Get_Source_Unit (E);
              Set_Convention_From_Pragma (E);
  
!             --  Treat a pragma Import as an implicit body, for GPS use.
  
              if Prag_Id = Pragma_Import then
                    Generate_Reference (E, Id, 'b');
--- 2173,2179 ----
              Comp_Unit := Get_Source_Unit (E);
              Set_Convention_From_Pragma (E);
  
!             --  Treat a pragma Import as an implicit body, for GPS use
  
              if Prag_Id = Pragma_Import then
                    Generate_Reference (E, Id, 'b');
*************** package body Sem_Prag is
*** 3288,3294 ****
--- 3337,3347 ----
                 Subp := Entity (Subp_Id);
  
                 if Subp = Any_Id then
+ 
+                   --  If previous error, avoid cascaded errors
+ 
                    Applies := True;
+                   Effective := True;
  
                 else
                    Make_Inline (Subp);
*************** package body Sem_Prag is
*** 3730,3738 ****
              --  suppress check for any check id value.
  
              if C = All_Checks then
                 for J in Scope_Suppress'Range loop
!                   Scope_Suppress (J) := Suppress_Case;
                 end loop;
              else
                 Scope_Suppress (C) := Suppress_Case;
              end if;
--- 3783,3803 ----
              --  suppress check for any check id value.
  
              if C = All_Checks then
+ 
+                --  For All_Checks, we set all specific checks with the
+                --  exception of Elaboration_Check, which is handled specially
+                --  because of not wanting All_Checks to have the effect of
+                --  deactivating static elaboration order processing.
+ 
                 for J in Scope_Suppress'Range loop
!                   if J /= Elaboration_Check then
!                      Scope_Suppress (J) := Suppress_Case;
!                   end if;
                 end loop;
+ 
+             --  If not All_Checks, just set appropriate entry. Note that we
+             --  will set Elaboration_Check if this is explicitly specified.
+ 
              else
                 Scope_Suppress (C) := Suppress_Case;
              end if;
*************** package body Sem_Prag is
*** 4205,4211 ****
           if Warn_On_Unrecognized_Pragma then
              Error_Pragma ("unrecognized pragma%!?");
           else
!             raise Pragma_Exit;
           end if;
        else
           Prag_Id := Get_Pragma_Id (Chars (N));
--- 4270,4276 ----
           if Warn_On_Unrecognized_Pragma then
              Error_Pragma ("unrecognized pragma%!?");
           else
!             return;
           end if;
        else
           Prag_Id := Get_Pragma_Id (Chars (N));
*************** package body Sem_Prag is
*** 4285,4290 ****
--- 4350,4356 ----
           when Pragma_Ada_83 =>
              GNAT_Pragma;
              Ada_Version := Ada_83;
+             Ada_Version_Explicit := Ada_Version;
              Check_Arg_Count (0);
  
           ------------
*************** package body Sem_Prag is
*** 4299,4304 ****
--- 4365,4371 ----
           when Pragma_Ada_95 =>
              GNAT_Pragma;
              Ada_Version := Ada_95;
+             Ada_Version_Explicit := Ada_Version;
              Check_Arg_Count (0);
  
           ------------
*************** package body Sem_Prag is
*** 4328,4335 ****
                 Set_Is_Ada_2005 (Entity (E_Id));
  
              else
-                Ada_Version := Ada_05;
                 Check_Arg_Count (0);
              end if;
           end;
  
--- 4395,4403 ----
                 Set_Is_Ada_2005 (Entity (E_Id));
  
              else
                 Check_Arg_Count (0);
+                Ada_Version := Ada_05;
+                Ada_Version_Explicit := Ada_Version;
              end if;
           end;
  
*************** package body Sem_Prag is
*** 4352,4358 ****
  
              Lib_Entity := Find_Lib_Unit_Name;
  
!             --  This pragma should only apply to a RCI unit (RM E.2.3(23)).
  
              if Present (Lib_Entity)
                and then not Debug_Flag_U
--- 4420,4426 ----
  
              Lib_Entity := Find_Lib_Unit_Name;
  
!             --  This pragma should only apply to a RCI unit (RM E.2.3(23))
  
              if Present (Lib_Entity)
                and then not Debug_Flag_U
*************** package body Sem_Prag is
*** 4412,4425 ****
           -- Assert --
           ------------
  
!          --  pragma Assert (Boolean_EXPRESSION [, static_string_EXPRESSION]);
  
           when Pragma_Assert =>
!             GNAT_Pragma;
!             Check_No_Identifiers;
  
              if Arg_Count > 1 then
!                Check_Arg_Count (2);
                 Check_Arg_Is_Static_Expression (Arg2, Standard_String);
              end if;
  
--- 4480,4496 ----
           -- Assert --
           ------------
  
!          --  pragma Assert ([Check =>] Boolean_EXPRESSION
!          --                 [, [Message =>] Static_String_EXPRESSION]);
  
           when Pragma_Assert =>
!             Check_At_Least_N_Arguments (1);
!             Check_At_Most_N_Arguments (2);
!             Check_Arg_Order ((Name_Check, Name_Message));
!             Check_Optional_Identifier (Arg1, Name_Check);
  
              if Arg_Count > 1 then
!                Check_Optional_Identifier (Arg2, Name_Message);
                 Check_Arg_Is_Static_Expression (Arg2, Standard_String);
              end if;
  
*************** package body Sem_Prag is
*** 4456,4461 ****
--- 4527,4543 ----
                 Analyze_And_Resolve (Expression (Arg1), Any_Boolean);
              end if;
  
+          ----------------------
+          -- Assertion_Policy --
+          ----------------------
+ 
+          --  pragma Assertion_Policy (Check | Ignore)
+ 
+          when Pragma_Assertion_Policy =>
+             Check_Arg_Count (1);
+             Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
+             Assertions_Enabled := Chars (Expression (Arg1)) = Name_Check;
+ 
           ---------------
           -- AST_Entry --
           ---------------
*************** package body Sem_Prag is
*** 4605,4617 ****
                 Error_Pragma_Arg
                   ("pragma% cannot be applied to function", Arg1);
  
!             elsif Ekind (Nm) = E_Record_Type
!               and then Present (Corresponding_Remote_Type (Nm))
!             then
!                --  A record type that is the Equivalent_Type for
!                --  a remote access-to-subprogram type.
  
!                N := Declaration_Node (Corresponding_Remote_Type (Nm));
  
                 if Nkind (N) = N_Full_Type_Declaration
                   and then Nkind (Type_Definition (N)) =
--- 4687,4706 ----
                 Error_Pragma_Arg
                   ("pragma% cannot be applied to function", Arg1);
  
!             elsif Is_Remote_Access_To_Subprogram_Type (Nm) then
  
!                if Is_Record_Type (Nm) then
!                   --  A record type that is the Equivalent_Type for
!                   --  a remote access-to-subprogram type.
! 
!                   N := Declaration_Node (Corresponding_Remote_Type (Nm));
! 
!                else
!                   --  A non-expanded RAS type (case where distribution is
!                   --  not enabled).
! 
!                   N := Declaration_Node (Nm);
!                end if;
  
                 if Nkind (N) = N_Full_Type_Declaration
                   and then Nkind (Type_Definition (N)) =
*************** package body Sem_Prag is
*** 4622,4630 ****
  
                    if Is_Asynchronous (Nm)
                      and then Expander_Active
                    then
!                      RACW_Type_Is_Asynchronous (
!                        Underlying_RACW_Type (Nm));
                    end if;
  
                 else
--- 4711,4719 ----
  
                    if Is_Asynchronous (Nm)
                      and then Expander_Active
+                     and then Get_PCS_Name /= Name_No_DSA
                    then
!                      RACW_Type_Is_Asynchronous (Underlying_RACW_Type (Nm));
                    end if;
  
                 else
*************** package body Sem_Prag is
*** 5057,5062 ****
--- 5146,5152 ----
              C : Convention_Id;
              E : Entity_Id;
           begin
+             Check_Arg_Order ((Name_Convention, Name_Entity));
              Check_Ada_83_Warning;
              Check_Arg_Count (2);
              Process_Convention (C, E);
*************** package body Sem_Prag is
*** 5075,5080 ****
--- 5165,5171 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Name, Name_Convention));
              Check_Arg_Count (2);
              Check_Optional_Identifier (Arg1, Name_Name);
              Check_Optional_Identifier (Arg2, Name_Convention);
*************** package body Sem_Prag is
*** 5179,5185 ****
  
                 if Expander_Active and then Typ = Root_Type (Typ) then
  
!                   Tag_C := Tag_Component (Typ);
                    C := First_Entity (Typ);
  
                    if C = Tag_C then
--- 5270,5276 ----
  
                 if Expander_Active and then Typ = Root_Type (Typ) then
  
!                   Tag_C := First_Tag_Component (Typ);
                    C := First_Entity (Typ);
  
                    if C = Tag_C then
*************** package body Sem_Prag is
*** 5268,5284 ****
  
           begin
              GNAT_Pragma;
  
              if Arg_Count = 3 then
!                Check_Optional_Identifier (Arg2, "vtable_ptr");
  
                 --  We allow Entry_Count as well as Position for the third
                 --  parameter for back compatibility with versions of GNAT
                 --  before version 3.12. The documentation has always said
                 --  Position, but the code up to 3.12 said Entry_Count.
  
!                if Chars (Arg3) /= Name_Position then
!                   Check_Optional_Identifier (Arg3, "entry_count");
                 end if;
  
              else
--- 5359,5376 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Vtable_Ptr, Name_Position));
  
              if Arg_Count = 3 then
!                Check_Optional_Identifier (Arg2, Name_Vtable_Ptr);
  
                 --  We allow Entry_Count as well as Position for the third
                 --  parameter for back compatibility with versions of GNAT
                 --  before version 3.12. The documentation has always said
                 --  Position, but the code up to 3.12 said Entry_Count.
  
!                if Chars (Arg3) /= Name_Entry_Count then
!                   Check_Optional_Identifier (Arg3, Name_Position);
                 end if;
  
              else
*************** package body Sem_Prag is
*** 5313,5319 ****
              --    . DT_Position will be set at the freezing point
  
              if Arg_Count = 1 then
!                Set_DTC_Entity (Subp, Tag_Component (Typ));
                 return;
              end if;
  
--- 5405,5411 ----
              --    . DT_Position will be set at the freezing point
  
              if Arg_Count = 1 then
!                Set_DTC_Entity (Subp, First_Tag_Component (Typ));
                 return;
              end if;
  
*************** package body Sem_Prag is
*** 5385,5394 ****
  
           begin
              GNAT_Pragma;
              Check_Arg_Count (3);
              Check_Optional_Identifier (Arg1, Name_Entity);
!             Check_Optional_Identifier (Arg2, "vtable_ptr");
!             Check_Optional_Identifier (Arg3, "entry_count");
              Check_Arg_Is_Local_Name (Arg1);
  
              --  First argument is a record type name
--- 5477,5487 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Vtable_Ptr, Name_Entry_Count));
              Check_Arg_Count (3);
              Check_Optional_Identifier (Arg1, Name_Entity);
!             Check_Optional_Identifier (Arg2, Name_Vtable_Ptr);
!             Check_Optional_Identifier (Arg3, Name_Entry_Count);
              Check_Arg_Is_Local_Name (Arg1);
  
              --  First argument is a record type name
*************** package body Sem_Prag is
*** 5431,5439 ****
              --  If it is the first pragma Vtable, This becomes the default tag
  
              elsif (not Is_Tag (DTC))
!               and then DT_Entry_Count (Tag_Component (Typ)) = No_Uint
              then
!                Set_Is_Tag (Tag_Component (Typ), False);
                 Set_Is_Tag (DTC, True);
                 Set_DT_Entry_Count (DTC, No_Uint);
              end if;
--- 5524,5532 ----
              --  If it is the first pragma Vtable, This becomes the default tag
  
              elsif (not Is_Tag (DTC))
!               and then DT_Entry_Count (First_Tag_Component (Typ)) = No_Uint
              then
!                Set_Is_Tag (First_Tag_Component (Typ), False);
                 Set_Is_Tag (DTC, True);
                 Set_DT_Entry_Count (DTC, No_Uint);
              end if;
*************** package body Sem_Prag is
*** 5489,5500 ****
  
              Rewrite (N, Make_Implicit_If_Statement (N,
                Condition => New_Occurrence_Of (Boolean_Literals (
!                 Assertions_Enabled and Expander_Active), Loc),
                Then_Statements => New_List (
                  Relocate_Node (Debug_Statement (N)))));
              Analyze (N);
           end Debug;
  
           ---------------------
           -- Detect_Blocking --
           ---------------------
--- 5582,5605 ----
  
              Rewrite (N, Make_Implicit_If_Statement (N,
                Condition => New_Occurrence_Of (Boolean_Literals (
!                 Debug_Pragmas_Enabled and Expander_Active), Loc),
                Then_Statements => New_List (
                  Relocate_Node (Debug_Statement (N)))));
              Analyze (N);
           end Debug;
  
+          ------------------
+          -- Debug_Policy --
+          ------------------
+ 
+          --  pragma Debug_Policy (Check | Ignore)
+ 
+          when Pragma_Debug_Policy =>
+             GNAT_Pragma;
+             Check_Arg_Count (1);
+             Check_Arg_Is_One_Of (Arg1, Name_Check, Name_Ignore);
+             Debug_Pragmas_Enabled := Chars (Expression (Arg1)) = Name_Check;
+ 
           ---------------------
           -- Detect_Blocking --
           ---------------------
*************** package body Sem_Prag is
*** 5791,5797 ****
                 Error_Pragma ("pragma% must refer to a spec, not a body");
              else
                 Set_Body_Required (Cunit_Node, True);
!                Set_Has_Pragma_Elaborate_Body     (Cunit_Ent);
  
                 --  If we are in dynamic elaboration mode, then we suppress
                 --  elaboration warnings for the unit, since it is definitely
--- 5896,5902 ----
                 Error_Pragma ("pragma% must refer to a spec, not a body");
              else
                 Set_Body_Required (Cunit_Node, True);
!                Set_Has_Pragma_Elaborate_Body (Cunit_Ent);
  
                 --  If we are in dynamic elaboration mode, then we suppress
                 --  elaboration warnings for the unit, since it is definitely
*************** package body Sem_Prag is
*** 5897,5903 ****
                  Present (Source_Location)
              then
                 Error_Pragma
!                  ("parameter profile and source location can not " &
                    "be used together in pragma%");
              end if;
  
--- 6002,6008 ----
                  Present (Source_Location)
              then
                 Error_Pragma
!                  ("parameter profile and source location cannot " &
                    "be used together in pragma%");
              end if;
  
*************** package body Sem_Prag is
*** 5935,5940 ****
--- 6040,6050 ----
  
           begin
              Check_Ada_83_Warning;
+             Check_Arg_Order
+               ((Name_Convention,
+                 Name_Entity,
+                 Name_External_Name,
+                 Name_Link_Name));
              Check_At_Least_N_Arguments (2);
              Check_At_Most_N_Arguments  (4);
              Process_Convention (C, Def_Id);
*************** package body Sem_Prag is
*** 6178,6183 ****
--- 6288,6294 ----
  
           when Pragma_Export_Value =>
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Value, Name_Link_Name));
              Check_Arg_Count (2);
  
              Check_Optional_Identifier (Arg1, Name_Value);
*************** package body Sem_Prag is
*** 6307,6312 ****
--- 6418,6425 ----
                 Ada_Version := Ada_Version_Type'Min (Ada_Version, Ada_95);
              end if;
  
+             Ada_Version_Explicit := Ada_Version;
+ 
           --------------
           -- External --
           --------------
*************** package body Sem_Prag is
*** 6320,6328 ****
           when Pragma_External => External : declare
              C      : Convention_Id;
              Def_Id : Entity_Id;
- 
           begin
              GNAT_Pragma;
              Check_At_Least_N_Arguments (2);
              Check_At_Most_N_Arguments  (4);
              Process_Convention (C, Def_Id);
--- 6433,6445 ----
           when Pragma_External => External : declare
              C      : Convention_Id;
              Def_Id : Entity_Id;
           begin
              GNAT_Pragma;
+             Check_Arg_Order
+               ((Name_Convention,
+                 Name_Entity,
+                 Name_External_Name,
+                 Name_Link_Name));
              Check_At_Least_N_Arguments (2);
              Check_At_Most_N_Arguments  (4);
              Process_Convention (C, Def_Id);
*************** package body Sem_Prag is
*** 6425,6431 ****
           -- Float_Representation --
           --------------------------
  
!          --  pragma Float_Representation (VAX_Float | IEEE_Float);
  
           when Pragma_Float_Representation => Float_Representation : declare
              Argx : Node_Id;
--- 6542,6550 ----
           -- Float_Representation --
           --------------------------
  
!          --  pragma Float_Representation (FLOAT_REP[, float_type_LOCAL_NAME]);
! 
!          --  FLOAT_REP ::= VAX_Float | IEEE_Float
  
           when Pragma_Float_Representation => Float_Representation : declare
              Argx : Node_Id;
*************** package body Sem_Prag is
*** 6458,6466 ****
              --  One argument case
  
              if Arg_Count = 1 then
- 
                 if Chars (Expression (Arg1)) = Name_VAX_Float then
- 
                    if Opt.Float_Format = 'I' then
                       Error_Pragma ("'I'E'E'E format previously specified");
                    end if;
--- 6577,6583 ----
*************** package body Sem_Prag is
*** 6496,6502 ****
                 --  Two arguments, VAX_Float case
  
                 if Chars (Expression (Arg1)) = Name_VAX_Float then
- 
                    case Digs is
                       when  6 => Set_F_Float (Ent);
                       when  9 => Set_D_Float (Ent);
--- 6613,6618 ----
*************** package body Sem_Prag is
*** 6642,6647 ****
--- 6758,6768 ----
  
           when Pragma_Import =>
              Check_Ada_83_Warning;
+             Check_Arg_Order
+               ((Name_Convention,
+                 Name_Entity,
+                 Name_External_Name,
+                 Name_Link_Name));
              Check_At_Least_N_Arguments (2);
              Check_At_Most_N_Arguments  (4);
              Process_Import_Or_Interface;
*************** package body Sem_Prag is
*** 7026,7031 ****
--- 7147,7154 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order
+               ((Name_Entity, Name_External_Name, Name_Link_Name));
              Check_At_Least_N_Arguments (2);
              Check_At_Most_N_Arguments  (3);
              Id := Expression (Arg1);
*************** package body Sem_Prag is
*** 7207,7216 ****
  
           begin
              GNAT_Pragma;
              Check_Arg_Count (2);
  
              Check_Optional_Identifier (Arg1, Name_Name);
!             Check_Optional_Identifier (Arg2, "state");
              Check_Arg_Is_Identifier (Arg2);
  
              --  First argument is identifier
--- 7330,7340 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Name, Name_State));
              Check_Arg_Count (2);
  
              Check_Optional_Identifier (Arg1, Name_Name);
!             Check_Optional_Identifier (Arg2, Name_State);
              Check_Arg_Is_Identifier (Arg2);
  
              --  First argument is identifier
*************** package body Sem_Prag is
*** 7447,7453 ****
           -- License --
           -------------
  
!          --  pragma License (RESTRICTED | UNRESRICTED | GPL | MODIFIED_GPL);
  
           when Pragma_License =>
              GNAT_Pragma;
--- 7571,7577 ----
           -- License --
           -------------
  
!          --  pragma License (RESTRICTED | UNRESTRICTED | GPL | MODIFIED_GPL);
  
           when Pragma_License =>
              GNAT_Pragma;
*************** package body Sem_Prag is
*** 7563,7575 ****
  
           --  pragma Linker_Alias (
           --      [Entity =>]  LOCAL_NAME
!          --      [Alias  =>]  static_string_EXPRESSION);
  
           when Pragma_Linker_Alias =>
              GNAT_Pragma;
              Check_Arg_Count (2);
              Check_Optional_Identifier (Arg1, Name_Entity);
!             Check_Optional_Identifier (Arg2, "alias");
              Check_Arg_Is_Library_Level_Local_Name (Arg1);
              Check_Arg_Is_Static_Expression (Arg2, Standard_String);
  
--- 7687,7700 ----
  
           --  pragma Linker_Alias (
           --      [Entity =>]  LOCAL_NAME
!          --      [Target =>]  static_string_EXPRESSION);
  
           when Pragma_Linker_Alias =>
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Target));
              Check_Arg_Count (2);
              Check_Optional_Identifier (Arg1, Name_Entity);
!             Check_Optional_Identifier (Arg2, Name_Target);
              Check_Arg_Is_Library_Level_Local_Name (Arg1);
              Check_Arg_Is_Static_Expression (Arg2, Standard_String);
  
*************** package body Sem_Prag is
*** 7584,7589 ****
--- 7709,7760 ----
                 Set_Has_Gigi_Rep_Item (Entity (Expression (Arg1)));
              end if;
  
+          ------------------------
+          -- Linker_Constructor --
+          ------------------------
+ 
+          --  pragma Linker_Constructor (procedure_LOCAL_NAME);
+ 
+          --  Code is shared with Linker_Destructor
+ 
+          -----------------------
+          -- Linker_Destructor --
+          -----------------------
+ 
+          --  pragma Linker_Destructor (procedure_LOCAL_NAME);
+ 
+          when Pragma_Linker_Constructor |
+               Pragma_Linker_Destructor =>
+          Linker_Constructor : declare
+             Arg1_X : Node_Id;
+             Proc   : Entity_Id;
+ 
+          begin
+             GNAT_Pragma;
+             Check_Arg_Count (1);
+             Check_No_Identifiers;
+             Check_Arg_Is_Local_Name (Arg1);
+             Arg1_X := Expression (Arg1);
+             Analyze (Arg1_X);
+             Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1);
+ 
+             if not Is_Library_Level_Entity (Proc) then
+                Error_Pragma_Arg
+                 ("argument for pragma% must be library level entity", Arg1);
+             end if;
+ 
+             --  The only processing required is to link this item on to the
+             --  list of rep items for the given entity. This is accomplished
+             --  by the call to Rep_Item_Too_Late (when no error is detected
+             --  and False is returned).
+ 
+             if Rep_Item_Too_Late (Proc, N) then
+                return;
+             else
+                Set_Has_Gigi_Rep_Item (Proc);
+             end if;
+          end Linker_Constructor;
+ 
           --------------------
           -- Linker_Options --
           --------------------
*************** package body Sem_Prag is
*** 7628,7633 ****
--- 7799,7805 ----
  
           when Pragma_Linker_Section =>
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Section));
              Check_Arg_Count (2);
              Check_Optional_Identifier (Arg1, Name_Entity);
              Check_Optional_Identifier (Arg2, Name_Section);
*************** package body Sem_Prag is
*** 7746,7762 ****
  
           begin
              GNAT_Pragma;
  
              if Arg_Count = 3 then
!                Check_Optional_Identifier (Arg3, "info");
                 Check_Arg_Is_Static_Expression (Arg3, Standard_String);
              else
                 Check_Arg_Count (2);
              end if;
  
-             Check_Arg_Is_Local_Name (Arg1);
-             Check_Optional_Identifier (Arg2, "attribute_name");
              Check_Optional_Identifier (Arg1, Name_Entity);
              Check_Arg_Is_Static_Expression (Arg2, Standard_String);
              Def_Id := Entity (Expression (Arg1));
  
--- 7918,7935 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Attribute_Name, Name_Info));
  
              if Arg_Count = 3 then
!                Check_Optional_Identifier (Arg3, Name_Info);
                 Check_Arg_Is_Static_Expression (Arg3, Standard_String);
              else
                 Check_Arg_Count (2);
              end if;
  
              Check_Optional_Identifier (Arg1, Name_Entity);
+             Check_Optional_Identifier (Arg2, Name_Attribute_Name);
+             Check_Arg_Is_Local_Name (Arg1);
              Check_Arg_Is_Static_Expression (Arg2, Standard_String);
              Def_Id := Entity (Expression (Arg1));
  
*************** package body Sem_Prag is
*** 7940,7945 ****
--- 8113,8120 ----
           -- No_Strict_Aliasing --
           ------------------------
  
+          --  pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)];
+ 
           when Pragma_No_Strict_Aliasing => No_Strict_Alias : declare
              E_Id : Entity_Id;
  
*************** package body Sem_Prag is
*** 7970,7984 ****
           -- Obsolescent --
           -----------------
  
!          --  pragma Obsolescent [(static_string_EXPRESSION)];
  
           when Pragma_Obsolescent => Obsolescent : declare
!             Subp : Node_Or_Entity_Id;
!             S    : String_Id;
  
           begin
              GNAT_Pragma;
!             Check_At_Most_N_Arguments (1);
              Check_No_Identifiers;
  
              --  Check OK placement
--- 8145,8182 ----
           -- Obsolescent --
           -----------------
  
!             --  pragma Obsolescent [(static_string_EXPRESSION [, Ada_05])];
  
           when Pragma_Obsolescent => Obsolescent : declare
!             Subp   : Node_Or_Entity_Id;
!             S      : String_Id;
!             Active : Boolean := True;
! 
!             procedure Check_Obsolete_Subprogram;
!             --  Checks if Subp is a subprogram declaration node, and if so
!             --  replaces Subp by the defining entity of the subprogram. If not,
!             --  issues an error message
! 
!             ------------------------------
!             -- Check_Obsolete_Subprogram--
!             ------------------------------
! 
!             procedure Check_Obsolete_Subprogram is
!             begin
!                if Nkind (Subp) /= N_Subprogram_Declaration then
!                   Error_Pragma
!                     ("pragma% misplaced, must immediately " &
!                      "follow subprogram/package declaration");
!                else
!                   Subp := Defining_Entity (Subp);
!                end if;
!             end Check_Obsolete_Subprogram;
! 
!          --  Start of processing for pragma Obsolescent
  
           begin
              GNAT_Pragma;
!             Check_At_Most_N_Arguments (2);
              Check_No_Identifiers;
  
              --  Check OK placement
*************** package body Sem_Prag is
*** 7988,7993 ****
--- 8186,8192 ----
  
              if Present (Prev (N)) then
                 Subp := Prev (N);
+                Check_Obsolete_Subprogram;
  
              --  Second possibility, stand alone subprogram declaration with the
              --  pragma immediately following the declaration.
*************** package body Sem_Prag is
*** 7996,8036 ****
                and then Nkind (Parent (N)) = N_Compilation_Unit_Aux
              then
                 Subp := Unit (Parent (Parent (N)));
  
!             --  Any other possibility is a misplacement
  
              else
!                Subp := Empty;
              end if;
  
!             --  Check correct placement
  
!             if Nkind (Subp) /= N_Subprogram_Declaration then
!                Error_Pragma
!                  ("pragma% misplaced, must immediately " &
!                   "follow subprogram spec");
  
!             --  If OK placement, set flag and acquire argument
  
!             else
!                Subp := Defining_Entity (Subp);
!                Set_Is_Obsolescent (Subp);
  
!                if Arg_Count = 1 then
!                   Check_Arg_Is_Static_Expression (Arg1, Standard_String);
!                   S := Strval (Expression (Arg1));
  
!                   for J in 1 .. String_Length (S) loop
!                      if not In_Character_Range (Get_String_Char (S, J)) then
                          Error_Pragma_Arg
!                           ("pragma% argument does not allow wide characters",
!                            Arg1);
                       end if;
-                   end loop;
  
!                   Set_Obsolescent_Warning (Subp, Expression (Arg1));
                 end if;
              end if;
           end Obsolescent;
  
           -----------------
--- 8195,8264 ----
                and then Nkind (Parent (N)) = N_Compilation_Unit_Aux
              then
                 Subp := Unit (Parent (Parent (N)));
+                Check_Obsolete_Subprogram;
  
!             --  Only other possibility is library unit placement for package
  
              else
!                Subp := Find_Lib_Unit_Name;
! 
!                if Ekind (Subp) /= E_Package
!                  and then Ekind (Subp) /= E_Generic_Package
!                then
!                   Check_Obsolete_Subprogram;
!                end if;
              end if;
  
!             --  If OK placement, acquire arguments
  
!             if Arg_Count >= 1 then
  
!                --  Deal with static string argument
  
!                Check_Arg_Is_Static_Expression (Arg1, Standard_String);
!                S := Strval (Expression (Arg1));
  
!                for J in 1 .. String_Length (S) loop
!                   if not In_Character_Range (Get_String_Char (S, J)) then
!                      Error_Pragma_Arg
!                        ("pragma% argument does not allow wide characters",
!                         Arg1);
!                   end if;
!                end loop;
  
!                Set_Obsolescent_Warning (Subp, Expression (Arg1));
! 
!                --  Check for Ada_05 parameter
! 
!                if Arg_Count /= 1 then
!                   Check_Arg_Count (2);
! 
!                   declare
!                      Argx : constant Node_Id := Get_Pragma_Arg (Arg2);
! 
!                   begin
!                      Check_Arg_Is_Identifier (Argx);
! 
!                      if Chars (Argx) /= Name_Ada_05 then
!                         Error_Msg_Name_2 := Name_Ada_05;
                          Error_Pragma_Arg
!                           ("only allowed argument for pragma% is %", Argx);
                       end if;
  
!                      if Ada_Version_Explicit < Ada_05
!                        or else not Warn_On_Ada_2005_Compatibility
!                      then
!                         Active := False;
!                      end if;
!                   end;
                 end if;
              end if;
+ 
+             --  Set flag if pragma active
+ 
+             if Active then
+                Set_Is_Obsolescent (Subp);
+             end if;
           end Obsolescent;
  
           -----------------
*************** package body Sem_Prag is
*** 8140,8154 ****
              if Has_Pragma_Pack (Typ) then
                 Error_Pragma ("duplicate pragma%, only one allowed");
  
!             --  Array type. We set the Has_Pragma_Pack flag, and Is_Packed,
!             --  but not Has_Non_Standard_Rep, because we don't actually know
!             --  till freeze time if the array can have packed representation.
!             --  That's because in the general case we do not know enough about
!             --  the component type until it in turn is frozen, which certainly
!             --  happens before the array type is frozen, but not necessarily
!             --  till that point (i.e. right now it may be unfrozen).
  
              elsif Is_Array_Type (Typ) then
                 if Has_Aliased_Components (Base_Type (Typ)) then
                    Error_Pragma
                      ("pragma% ignored, cannot pack aliased components?");
--- 8368,8379 ----
              if Has_Pragma_Pack (Typ) then
                 Error_Pragma ("duplicate pragma%, only one allowed");
  
!             --  Array type
  
              elsif Is_Array_Type (Typ) then
+ 
+                --  Pack not allowed for aliased or atomic components
+ 
                 if Has_Aliased_Components (Base_Type (Typ)) then
                    Error_Pragma
                      ("pragma% ignored, cannot pack aliased components?");
*************** package body Sem_Prag is
*** 8157,8171 ****
                   or else Is_Atomic (Component_Type (Typ))
                 then
                    Error_Pragma
!                     ("?pragma% ignored, cannot pack atomic components");
  
!                elsif not Rep_Item_Too_Late (Typ, N) then
!                   Set_Is_Packed            (Base_Type (Typ));
!                   Set_Has_Pragma_Pack      (Base_Type (Typ));
!                   Set_Has_Non_Standard_Rep (Base_Type (Typ));
                 end if;
  
!             --  Record type. For record types, the pack is always effective
  
              else pragma Assert (Is_Record_Type (Typ));
                 if not Rep_Item_Too_Late (Typ, N) then
--- 8382,8417 ----
                   or else Is_Atomic (Component_Type (Typ))
                 then
                    Error_Pragma
!                        ("?pragma% ignored, cannot pack atomic components");
!                end if;
  
!                --  If we had an explicit component size given, then we do not
!                --  let Pack override this given size. We also give a warning
!                --  that Pack is being ignored unless we can tell for sure that
!                --  the Pack would not have had any effect anyway.
! 
!                if Has_Component_Size_Clause (Typ) then
!                   if Known_Static_RM_Size (Component_Type (Typ))
!                     and then
!                       RM_Size (Component_Type (Typ)) = Component_Size (Typ)
!                   then
!                      null;
!                   else
!                      Error_Pragma
!                        ("?pragma% ignored, explicit component size given");
!                   end if;
! 
!                --  If no prior array component size given, Pack is effective
! 
!                else
!                   if not Rep_Item_Too_Late (Typ, N) then
!                      Set_Is_Packed            (Base_Type (Typ));
!                      Set_Has_Pragma_Pack      (Base_Type (Typ));
!                      Set_Has_Non_Standard_Rep (Base_Type (Typ));
!                   end if;
                 end if;
  
!             --  For record types, the pack is always effective
  
              else pragma Assert (Is_Record_Type (Typ));
                 if not Rep_Item_Too_Late (Typ, N) then
*************** package body Sem_Prag is
*** 8222,8325 ****
              Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
              Polling_Required := (Chars (Expression (Arg1)) = Name_On);
  
!          ---------------------
!          -- Persistent_Data --
!          ---------------------
! 
!          when Pragma_Persistent_Data => declare
!             Ent : Entity_Id;
! 
!          begin
!             --  Register the pragma as applying to the compilation unit.
!             --  Individual Persistent_Object pragmas for relevant objects
!             --  are generated the end of the compilation.
! 
!             GNAT_Pragma;
!             Check_Valid_Configuration_Pragma;
!             Check_Arg_Count (0);
!             Ent := Find_Lib_Unit_Name;
!             Set_Is_Preelaborated (Ent);
!          end;
! 
!          -----------------------
!          -- Persistent_Object --
!          -----------------------
  
!          when Pragma_Persistent_Object => declare
              Decl : Node_Id;
              Ent  : Entity_Id;
!             MA   : Node_Id;
!             Str  : String_Id;
  
           begin
              GNAT_Pragma;
!             Check_Arg_Count (1);
!             Check_Arg_Is_Library_Level_Local_Name (Arg1);
  
!             if not Is_Entity_Name (Expression (Arg1))
!               or else
!                (Ekind (Entity (Expression (Arg1))) /= E_Variable
!                  and then Ekind (Entity (Expression (Arg1))) /= E_Constant)
!             then
!                Error_Pragma_Arg ("pragma only applies to objects", Arg1);
!             end if;
  
!             Ent := Entity (Expression (Arg1));
!             Decl := Parent (Ent);
  
!             if Nkind (Decl) /= N_Object_Declaration then
!                return;
!             end if;
  
!             --  Placement of the object depends on whether there is
!             --  an initial value or none. If the No_Initialization flag
!             --  is set, the initialization has been transformed into
!             --  assignments, which is disallowed elaboration code.
  
!             if No_Initialization (Decl) then
!                Error_Msg_N
!                  ("initialization for persistent object"
!                    &  "must be static expression", Decl);
!                return;
!             end if;
  
!             if No (Expression (Decl)) then
!                Start_String;
!                Store_String_Chars ("section ("".persistent.bss"")");
!                Str := End_String;
  
!             else
!                if not Is_OK_Static_Expression (Expression (Decl)) then
!                   Flag_Non_Static_Expr
!                     ("initialization for persistent object"
!                       &  "must be static expression!", Expression (Decl));
!                   return;
                 end if;
  
!                Start_String;
!                Store_String_Chars ("section ("".persistent.data"")");
!                Str := End_String;
!             end if;
  
!             MA :=
!                Make_Pragma
!                  (Sloc (N),
!                   Name_Machine_Attribute,
!                   New_List
!                     (Make_Pragma_Argument_Association
!                        (Sloc => Sloc (Arg1),
!                         Expression => New_Occurrence_Of (Ent, Sloc (Ent))),
!                      Make_Pragma_Argument_Association
!                        (Sloc => Sloc (Arg1),
!                         Expression =>
!                           Make_String_Literal
!                             (Sloc => Sloc (Arg1),
!                              Strval => Str))));
  
!             Insert_After (N, MA);
!             Analyze (MA);
!             Set_Has_Gigi_Rep_Item (Ent);
!          end;
  
           ------------------
           -- Preelaborate --
--- 8468,8530 ----
              Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
              Polling_Required := (Chars (Expression (Arg1)) = Name_On);
  
!          --------------------
!          -- Persistent_BSS --
!          --------------------
  
!          when Pragma_Persistent_BSS => Persistent_BSS :  declare
              Decl : Node_Id;
              Ent  : Entity_Id;
!             Prag : Node_Id;
  
           begin
              GNAT_Pragma;
!             Check_At_Most_N_Arguments (1);
  
!             --  Case of application to specific object (one argument)
  
!             if Arg_Count = 1 then
!                Check_Arg_Is_Library_Level_Local_Name (Arg1);
  
!                if not Is_Entity_Name (Expression (Arg1))
!                  or else
!                   (Ekind (Entity (Expression (Arg1))) /= E_Variable
!                     and then Ekind (Entity (Expression (Arg1))) /= E_Constant)
!                then
!                   Error_Pragma_Arg ("pragma% only applies to objects", Arg1);
!                end if;
  
!                Ent := Entity (Expression (Arg1));
!                Decl := Parent (Ent);
  
!                if Rep_Item_Too_Late (Ent, N) then
!                   return;
!                end if;
  
!                if Present (Expression (Decl)) then
!                   Error_Pragma_Arg
!                     ("object for pragma% cannot have initialization", Arg1);
!                end if;
  
!                if not Is_Potentially_Persistent_Type (Etype (Ent)) then
!                   Error_Pragma_Arg
!                     ("object type for pragma% is not potentially persistent",
!                      Arg1);
                 end if;
  
!                Prag :=
!                  Make_Linker_Section_Pragma
!                    (Ent, Sloc (N), ".persistent.bss");
!                Insert_After (N, Prag);
!                Analyze (Prag);
  
!             --  Case of use as configuration pragma with no arguments
  
!             else
!                Check_Valid_Configuration_Pragma;
!                Persistent_BSS_Mode := True;
!             end if;
!          end Persistent_BSS;
  
           ------------------
           -- Preelaborate --
*************** package body Sem_Prag is
*** 8349,8355 ****
  
              if Present (Ent)
                and then not (Pk = N_Package_Specification
!                              and then Present (Generic_Parent (Pa)))
              then
                 if not Debug_Flag_U then
                    Set_Is_Preelaborated (Ent);
--- 8554,8560 ----
  
              if Present (Ent)
                and then not (Pk = N_Package_Specification
!                               and then Present (Generic_Parent (Pa)))
              then
                 if not Debug_Flag_U then
                    Set_Is_Preelaborated (Ent);
*************** package body Sem_Prag is
*** 8358,8363 ****
--- 8563,8606 ----
              end if;
           end Preelaborate;
  
+          ---------------------
+          -- Preelaborate_05 --
+          ---------------------
+ 
+          --  pragma Preelaborate_05 [(library_unit_NAME)];
+ 
+          --  This pragma is useable only in GNAT_Mode, where it is used like
+          --  pragma Preelaborate but it is only effective in Ada 2005 mode
+          --  (otherwise it is ignored). This is used to implement AI-362 which
+          --  recategorizes some run-time packages in Ada 2005 mode.
+ 
+          when Pragma_Preelaborate_05 => Preelaborate_05 : declare
+             Ent : Entity_Id;
+ 
+          begin
+             GNAT_Pragma;
+             Check_Valid_Library_Unit_Pragma;
+ 
+             if not GNAT_Mode then
+                Error_Pragma ("pragma% only available in GNAT mode");
+             end if;
+ 
+             if Nkind (N) = N_Null_Statement then
+                return;
+             end if;
+ 
+             --  This is one of the few cases where we need to test the value of
+             --  Ada_Version_Explicit rather than Ada_Version (which is always
+             --  set to Ada_05 in a predefined unit), we need to know the
+             --  explicit version set to know if this pragma is active.
+ 
+             if Ada_Version_Explicit >= Ada_05 then
+                Ent := Find_Lib_Unit_Name;
+                Set_Is_Preelaborated (Ent);
+                Set_Suppress_Elaboration_Warnings (Ent);
+             end if;
+          end Preelaborate_05;
+ 
           --------------
           -- Priority --
           --------------
*************** package body Sem_Prag is
*** 8666,8671 ****
--- 8909,8915 ----
  
           when Pragma_Pure => Pure : declare
              Ent : Entity_Id;
+ 
           begin
              Check_Ada_83_Warning;
              Check_Valid_Library_Unit_Pragma;
*************** package body Sem_Prag is
*** 8679,8684 ****
--- 8923,8968 ----
              Set_Suppress_Elaboration_Warnings (Ent);
           end Pure;
  
+          -------------
+          -- Pure_05 --
+          -------------
+ 
+          --  pragma Pure_05 [(library_unit_NAME)];
+ 
+          --  This pragma is useable only in GNAT_Mode, where it is used like
+          --  pragma Pure but it is only effective in Ada 2005 mode (otherwise
+          --  it is ignored). It may be used after a pragma Preelaborate, in
+          --  which case it overrides the effect of the pragma Preelaborate.
+          --  This is used to implement AI-362 which recategorizes some run-time
+          --  packages in Ada 2005 mode.
+ 
+          when Pragma_Pure_05 => Pure_05 : declare
+             Ent : Entity_Id;
+ 
+          begin
+             GNAT_Pragma;
+             Check_Valid_Library_Unit_Pragma;
+ 
+             if not GNAT_Mode then
+                Error_Pragma ("pragma% only available in GNAT mode");
+             end if;
+             if Nkind (N) = N_Null_Statement then
+                return;
+             end if;
+ 
+             --  This is one of the few cases where we need to test the value of
+             --  Ada_Version_Explicit rather than Ada_Version (which is always
+             --  set to Ada_05 in a predefined unit), we need to know the
+             --  explicit version set to know if this pragma is active.
+ 
+             if Ada_Version_Explicit >= Ada_05 then
+                Ent := Find_Lib_Unit_Name;
+                Set_Is_Preelaborated (Ent, False);
+                Set_Is_Pure (Ent);
+                Set_Suppress_Elaboration_Warnings (Ent);
+             end if;
+          end Pure_05;
+ 
           -------------------
           -- Pure_Function --
           -------------------
*************** package body Sem_Prag is
*** 9177,9182 ****
--- 9461,9467 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Read, Name_Write));
              Check_Arg_Count (3);
              Check_Optional_Identifier (Arg1, Name_Entity);
              Check_Optional_Identifier (Arg2, Name_Read);
*************** package body Sem_Prag is
*** 9381,9388 ****
           when Pragma_Suppress_Debug_Info =>
              GNAT_Pragma;
              Check_Arg_Count (1);
-             Check_Arg_Is_Local_Name (Arg1);
              Check_Optional_Identifier (Arg1, Name_Entity);
              Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
  
           ----------------------------------
--- 9666,9673 ----
           when Pragma_Suppress_Debug_Info =>
              GNAT_Pragma;
              Check_Arg_Count (1);
              Check_Optional_Identifier (Arg1, Name_Entity);
+             Check_Arg_Is_Local_Name (Arg1);
              Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)));
  
           ----------------------------------
*************** package body Sem_Prag is
*** 9620,9625 ****
--- 9905,9911 ----
  
           begin
              GNAT_Pragma;
+             Check_Arg_Order ((Name_Entity, Name_Secondary_Stack_Size));
              Check_At_Least_N_Arguments (1);
              Check_At_Most_N_Arguments (2);
              Check_Optional_Identifier (Arg1, Name_Entity);
*************** package body Sem_Prag is
*** 9652,9659 ****
                   ("pragma% requires separate spec and must come before body");
  
              elsif Rep_Item_Too_Early (E, N)
!                  or else
!                Rep_Item_Too_Late (E, N)
              then
                 raise Pragma_Exit;
  
--- 9938,9944 ----
                   ("pragma% requires separate spec and must come before body");
  
              elsif Rep_Item_Too_Early (E, N)
!               or else Rep_Item_Too_Late (E, N)
              then
                 raise Pragma_Exit;
  
*************** package body Sem_Prag is
*** 10091,10106 ****
           --------------
  
           --  pragma Warnings (On | Off, [LOCAL_NAME])
  
           when Pragma_Warnings => Warnings : begin
              GNAT_Pragma;
              Check_At_Least_N_Arguments (1);
-             Check_At_Most_N_Arguments (2);
              Check_No_Identifiers;
  
!             --  One argument case was processed by parser in Par.Prag
  
!             if Arg_Count /= 1 then
                 Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
                 Check_Arg_Count (2);
  
--- 10376,10433 ----
           --------------
  
           --  pragma Warnings (On | Off, [LOCAL_NAME])
+          --  pragma Warnings (static_string_EXPRESSION);
  
           when Pragma_Warnings => Warnings : begin
              GNAT_Pragma;
              Check_At_Least_N_Arguments (1);
              Check_No_Identifiers;
  
!             --  One argument case
  
!             if Arg_Count = 1 then
!                declare
!                   Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
! 
!                begin
!                   --  On/Off one argument case was processed by parser
! 
!                   if Nkind (Argx) = N_Identifier
!                     and then
!                       (Chars (Argx) = Name_On
!                          or else
!                        Chars (Argx) = Name_Off)
!                   then
!                      null;
! 
!                   else
!                      Check_Arg_Is_Static_Expression (Arg1, Standard_String);
! 
!                      declare
!                         Lit : constant Node_Id   := Expr_Value_S (Argx);
!                         Str : constant String_Id := Strval (Lit);
!                         C   : Char_Code;
! 
!                      begin
!                         for J in 1 .. String_Length (Str) loop
!                            C := Get_String_Char (Str, J);
! 
!                            if In_Character_Range (C)
!                              and then Set_Warning_Switch (Get_Character (C))
!                            then
!                               null;
!                            else
!                               Error_Pragma_Arg
!                                 ("invalid warning switch character", Arg1);
!                            end if;
!                         end loop;
!                      end;
!                   end if;
!                end;
! 
!             --  Two argument case
! 
!             elsif Arg_Count /= 1 then
                 Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
                 Check_Arg_Count (2);
  
*************** package body Sem_Prag is
*** 10117,10123 ****
                    --  is a conversion. Retrieve the real entity name.
  
                    if (In_Instance_Body
!                        or else In_Inlined_Body)
                      and then Nkind (E_Id) = N_Unchecked_Type_Conversion
                    then
                       E_Id := Expression (E_Id);
--- 10444,10450 ----
                    --  is a conversion. Retrieve the real entity name.
  
                    if (In_Instance_Body
!                       or else In_Inlined_Body)
                      and then Nkind (E_Id) = N_Unchecked_Type_Conversion
                    then
                       E_Id := Expression (E_Id);
*************** package body Sem_Prag is
*** 10135,10142 ****
                       return;
                    else
                       loop
!                         Set_Warnings_Off (E,
!                           (Chars (Expression (Arg1)) = Name_Off));
  
                          if Is_Enumeration_Type (E) then
                             declare
--- 10462,10469 ----
                       return;
                    else
                       loop
!                         Set_Warnings_Off
!                           (E, (Chars (Expression (Arg1)) = Name_Off));
  
                          if Is_Enumeration_Type (E) then
                             declare
*************** package body Sem_Prag is
*** 10155,10160 ****
--- 10482,10491 ----
                       end loop;
                    end if;
                 end;
+ 
+                --  More than two arguments
+             else
+                Check_At_Most_N_Arguments (2);
              end if;
           end Warnings;
  
*************** package body Sem_Prag is
*** 10320,10325 ****
--- 10651,10657 ----
        Pragma_All_Calls_Remote             => -1,
        Pragma_Annotate                     => -1,
        Pragma_Assert                       => -1,
+       Pragma_Assertion_Policy             =>  0,
        Pragma_Asynchronous                 => -1,
        Pragma_Atomic                       =>  0,
        Pragma_Atomic_Components            =>  0,
*************** package body Sem_Prag is
*** 10338,10343 ****
--- 10670,10676 ----
        Pragma_Convention                   =>  0,
        Pragma_Convention_Identifier        =>  0,
        Pragma_Debug                        => -1,
+       Pragma_Debug_Policy                 =>  0,
        Pragma_Detect_Blocking              => -1,
        Pragma_Discard_Names                =>  0,
        Pragma_Elaborate                    => -1,
*************** package body Sem_Prag is
*** 10382,10387 ****
--- 10715,10722 ----
        Pragma_License                      => -1,
        Pragma_Link_With                    => -1,
        Pragma_Linker_Alias                 => -1,
+       Pragma_Linker_Constructor           => -1,
+       Pragma_Linker_Destructor            => -1,
        Pragma_Linker_Options               => -1,
        Pragma_Linker_Section               => -1,
        Pragma_List                         => -1,
*************** package body Sem_Prag is
*** 10402,10417 ****
        Pragma_Page                         => -1,
        Pragma_Passive                      => -1,
        Pragma_Polling                      => -1,
!       Pragma_Persistent_Data              => -1,
!       Pragma_Persistent_Object            => -1,
        Pragma_Preelaborate                 => -1,
        Pragma_Priority                     => -1,
        Pragma_Profile                      =>  0,
        Pragma_Profile_Warnings             =>  0,
        Pragma_Propagate_Exceptions         => -1,
        Pragma_Psect_Object                 => -1,
!       Pragma_Pure                         =>  0,
!       Pragma_Pure_Function                =>  0,
        Pragma_Queuing_Policy               => -1,
        Pragma_Ravenscar                    => -1,
        Pragma_Remote_Call_Interface        => -1,
--- 10737,10753 ----
        Pragma_Page                         => -1,
        Pragma_Passive                      => -1,
        Pragma_Polling                      => -1,
!       Pragma_Persistent_BSS               =>  0,
        Pragma_Preelaborate                 => -1,
+       Pragma_Preelaborate_05              => -1,
        Pragma_Priority                     => -1,
        Pragma_Profile                      =>  0,
        Pragma_Profile_Warnings             =>  0,
        Pragma_Propagate_Exceptions         => -1,
        Pragma_Psect_Object                 => -1,
!       Pragma_Pure                         => -1,
!       Pragma_Pure_05                      => -1,
!       Pragma_Pure_Function                => -1,
        Pragma_Queuing_Policy               => -1,
        Pragma_Ravenscar                    => -1,
        Pragma_Remote_Call_Interface        => -1,
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_prag.ads gcc-4.1.0/gcc/ada/sem_prag.ads
*** gcc-4.0.2/gcc/ada/sem_prag.ads	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/sem_prag.ads	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,89 ****
  --  (logically this processing belongs in chapter 4)
  
  with Types; use Types;
  package Sem_Prag is
  
     procedure Analyze_Pragma (N : Node_Id);
     --  Analyze procedure for pragma reference node N
  
     function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
!    --  N is a pragma appearing in a configuration pragma file. Most
!    --  such pragmas are analyzed when the file is read, before parsing
!    --  and analyzing the main unit. However, the analysis of certain
!    --  pragmas results in adding information to the compiled main unit,
!    --  and this cannot be done till the main unit is processed. Such
!    --  pragmas return True from this function and in Frontend pragmas
!    --  where Delay_Config_Pragma_Analyze is True have their analysis
!    --  delayed until after the main program is parsed and analyzed.
  
     function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean;
     --  The node N is a node for an entity and the issue is whether the
!    --  occurrence is a reference for the purposes of giving warnings
!    --  about unreferenced variables. This function returns True if the
!    --  reference is not a reference from this point of view (e.g. the
!    --  occurrence in a pragma Pack) and False if it is a real reference
!    --  (e.g. the occcurrence in a pragma Export);
  
     function Is_Pragma_String_Literal (Par : Node_Id) return Boolean;
!    --  Given an N_Pragma_Argument_Association node, Par, which has the form
!    --  of an operator symbol, determines whether or not it should be treated
!    --  as an string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol.
!    --  If True is returned, the argument is converted to a string literal. If
     --  False is returned, then the argument is treated as an entity reference
     --  to the operator.
  
     function Is_Config_Static_String (Arg : Node_Id) return Boolean;
!    --  This is called for a configuration pragma that requires either a
!    --  string literal or a concatenation of string literals. We cannot
!    --  use normal static string processing because it is too early in
!    --  the case of the pragma appearing in a configuration pragmas file.
!    --  If Arg is of an appropriate form, then this call obtains the string
!    --  (doing any necessary concatenations) and places it in Name_Buffer,
!    --  setting Name_Len to its length, and then returns True. If it is
!    --  not of the correct form, then an appropriate error message is
!    --  posted, and False is returned.
  
     procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
!    --  Called at the start of processing compilation unit N to deal with
!    --  any special issues regarding pragmas. In particular, we have to
!    --  deal with Suppress_All at this stage, since it appears after the
!    --  unit instead of before.
  
     procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
!    --  This routine is used to set an encoded interface name. The node
!    --  S is an N_String_Literal node for the external name to be set, and
!    --  E is an entity whose Interface_Name field is to be set. In the
!    --  normal case where S contains a name that is a valid C identifier,
!    --  then S is simply set as the value of the Interface_Name. Otherwise
!    --  it is encoded. See the body for details of the encoding. This
!    --  encoding is only done on VMS systems, since it seems pretty silly,
!    --  but is needed to pass some dubious tests in the test suite.
  
  end Sem_Prag;
--- 28,89 ----
  --  (logically this processing belongs in chapter 4)
  
  with Types; use Types;
+ 
  package Sem_Prag is
  
     procedure Analyze_Pragma (N : Node_Id);
     --  Analyze procedure for pragma reference node N
  
     function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
!    --  N is a pragma appearing in a configuration pragma file. Most such
!    --  pragmas are analyzed when the file is read, before parsing and analyzing
!    --  the main unit. However, the analysis of certain pragmas results in
!    --  adding information to the compiled main unit, and this cannot be done
!    --  till the main unit is processed. Such pragmas return True from this
!    --  function and in Frontend pragmas where Delay_Config_Pragma_Analyze is
!    --  True have their analysis delayed until after the main program is parsed
!    --  and analyzed.
  
     function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean;
     --  The node N is a node for an entity and the issue is whether the
!    --  occurrence is a reference for the purposes of giving warnings about
!    --  unreferenced variables. This function returns True if the reference is
!    --  not a reference from this point of view (e.g. the occurrence in a pragma
!    --  Pack) and False if it is a real reference (e.g. the occcurrence in a
!    --  pragma Export);
  
     function Is_Pragma_String_Literal (Par : Node_Id) return Boolean;
!    --  Given an N_Pragma_Argument_Association node, Par, which has the form of
!    --  an operator symbol, determines whether or not it should be treated as an
!    --  string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol. If
!    --  True is returned, the argument is converted to a string literal. If
     --  False is returned, then the argument is treated as an entity reference
     --  to the operator.
  
     function Is_Config_Static_String (Arg : Node_Id) return Boolean;
!    --  This is called for a configuration pragma that requires either string
!    --  literal or a concatenation of string literals. We cannot use normal
!    --  static string processing because it is too early in the case of the
!    --  pragma appearing in a configuration pragmas file. If Arg is of an
!    --  appropriate form, then this call obtains the string (doing any necessary
!    --  concatenations) and places it in Name_Buffer, setting Name_Len to its
!    --  length, and then returns True. If it is not of the correct form, then an
!    --  appropriate error message is posted, and False is returned.
  
     procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
!    --  Called at the start of processing compilation unit N to deal with any
!    --  special issues regarding pragmas. In particular, we have to deal with
!    --  Suppress_All at this stage, since it appears after the unit instead of
!    --  before.
  
     procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
!    --  This routine is used to set an encoded interface name. The node S is an
!    --  N_String_Literal node for the external name to be set, and E is an
!    --  entity whose Interface_Name field is to be set. In the normal case where
!    --  S contains a name that is a valid C identifier, then S is simply set as
!    --  the value of the Interface_Name. Otherwise it is encoded. See the body
!    --  for details of the encoding. This encoding is only done on VMS systems,
!    --  since it seems pretty silly, but is needed to pass some dubious tests in
!    --  the test suite.
  
  end Sem_Prag;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_res.adb gcc-4.1.0/gcc/ada/sem_res.adb
*** gcc-4.0.2/gcc/ada/sem_res.adb	Thu Feb 10 13:50:35 2005
--- gcc-4.1.0/gcc/ada/sem_res.adb	Tue Nov 15 14:03:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Debug_A;  use Debug_A;
*** 31,36 ****
--- 31,37 ----
  with Einfo;    use Einfo;
  with Errout;   use Errout;
  with Expander; use Expander;
+ with Exp_Disp; use Exp_Disp;
  with Exp_Ch7;  use Exp_Ch7;
  with Exp_Tss;  use Exp_Tss;
  with Exp_Util; use Exp_Util;
*************** package body Sem_Res is
*** 169,174 ****
--- 170,177 ----
  
     procedure Resolve_Actuals (N : Node_Id; Nam : Entity_Id);
     --  Resolve actuals of call, and add default expressions for missing ones.
+    --  N is the Node_Id for the subprogram call, and Nam is the entity of the
+    --  called subprogram.
  
     procedure Resolve_Entry_Call (N : Node_Id; Typ : Entity_Id);
     --  Called from Resolve_Call, when the prefix denotes an entry or element
*************** package body Sem_Res is
*** 182,188 ****
     --  to the corresponding predefined operator, with suitable conversions.
  
     procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
!    --  Ditto, for unary operators (only arithmetic ones).
  
     procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id);
     --  If an operator node resolves to a call to a user-defined operator,
--- 185,191 ----
     --  to the corresponding predefined operator, with suitable conversions.
  
     procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
!    --  Ditto, for unary operators (only arithmetic ones)
  
     procedure Rewrite_Operator_As_Call (N : Node_Id; Nam : Entity_Id);
     --  If an operator node resolves to a call to a user-defined operator,
*************** package body Sem_Res is
*** 241,254 ****
             ("\possible interpretations: Character, Wide_Character!", C);
  
           E := Current_Entity (C);
! 
!          if Present (E) then
! 
!             while Present (E) loop
!                Error_Msg_NE ("\possible interpretation:}!", C, Etype (E));
!                E := Homonym (E);
!             end loop;
!          end if;
        end if;
     end Ambiguous_Character;
  
--- 244,253 ----
             ("\possible interpretations: Character, Wide_Character!", C);
  
           E := Current_Entity (C);
!          while Present (E) loop
!             Error_Msg_NE ("\possible interpretation:}!", C, Etype (E));
!             E := Homonym (E);
!          end loop;
        end if;
     end Ambiguous_Character;
  
*************** package body Sem_Res is
*** 281,287 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Analyze_And_Resolve (N, Typ);
--- 280,285 ----
*************** package body Sem_Res is
*** 323,329 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Analyze_And_Resolve (N);
--- 321,326 ----
*************** package body Sem_Res is
*** 355,361 ****
  
     procedure Check_Direct_Boolean_Op (N : Node_Id) is
     begin
!       if Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean then
           Check_Restriction (No_Direct_Boolean_Operators, N);
        end if;
     end Check_Direct_Boolean_Op;
--- 352,360 ----
  
     procedure Check_Direct_Boolean_Op (N : Node_Id) is
     begin
!       if Nkind (N) in N_Op
!         and then Root_Type (Etype (Left_Opnd (N))) = Standard_Boolean
!       then
           Check_Restriction (No_Direct_Boolean_Operators, N);
        end if;
     end Check_Direct_Boolean_Op;
*************** package body Sem_Res is
*** 371,384 ****
        D    : Node_Id;
  
     begin
!       --  Any use in a default expression is legal.
  
        if In_Default_Expression then
           null;
  
        elsif Nkind (PN) = N_Range then
  
!          --  Discriminant cannot be used to constrain a scalar type.
  
           P := Parent (PN);
  
--- 370,383 ----
        D    : Node_Id;
  
     begin
!       --  Any use in a default expression is legal
  
        if In_Default_Expression then
           null;
  
        elsif Nkind (PN) = N_Range then
  
!          --  Discriminant cannot be used to constrain a scalar type
  
           P := Parent (PN);
  
*************** package body Sem_Res is
*** 536,541 ****
--- 535,546 ----
           if Paren_Count (N) > 0 then
              Error_Msg_N
                ("discriminant in constraint must appear alone",  N);
+ 
+          elsif Nkind (N) = N_Expanded_Name
+            and then Comes_From_Source (N)
+          then
+             Error_Msg_N
+               ("discriminant must appear alone as a direct name", N);
           end if;
  
           return;
*************** package body Sem_Res is
*** 546,552 ****
        else
           D := PN;
           P := Parent (PN);
- 
           while Nkind (P) /= N_Component_Declaration
             and then Nkind (P) /= N_Subtype_Indication
             and then Nkind (P) /= N_Entry_Declaration
--- 551,556 ----
*************** package body Sem_Res is
*** 626,632 ****
  
           F := First_Formal (Subp);
           A := First_Actual (N);
- 
           while Present (F) and then Present (A) loop
              if not Is_Entity_Name (A)
                or else Entity (A) /= F
--- 630,635 ----
*************** package body Sem_Res is
*** 680,691 ****
              if Nkind (Parent (N)) = N_Return_Statement
                and then Same_Argument_List
              then
!                exit when not Is_List_Member (Parent (N))
!                  or else (Nkind (Prev (Parent (N))) /= N_Raise_Statement
!                             and then
!                           (Nkind (Prev (Parent (N))) not in N_Raise_xxx_Error
!                              or else
!                            Present (Condition (Prev (Parent (N))))));
              end if;
  
              return False;
--- 683,712 ----
              if Nkind (Parent (N)) = N_Return_Statement
                and then Same_Argument_List
              then
!                exit when not Is_List_Member (Parent (N));
! 
!                --  OK, return statement is in a statement list, look for raise
! 
!                declare
!                   Nod : Node_Id;
! 
!                begin
!                   --  Skip past N_Freeze_Entity nodes generated by expansion
! 
!                   Nod := Prev (Parent (N));
!                   while Present (Nod)
!                     and then Nkind (Nod) = N_Freeze_Entity
!                   loop
!                      Prev (Nod);
!                   end loop;
! 
!                   --  If no raise statement, give warning
! 
!                   exit when Nkind (Nod) /= N_Raise_Statement
!                     and then
!                       (Nkind (Nod) not in N_Raise_xxx_Error
!                          or else Present (Condition (Nod)));
!                end;
              end if;
  
              return False;
*************** package body Sem_Res is
*** 732,740 ****
  
           elsif Is_Record_Type (T) then
              Comp := First_Component (T);
- 
              while Present (Comp) loop
- 
                 if Ekind (Comp) = E_Component
                   and then Nkind (Parent (Comp)) = N_Component_Declaration
                 then
--- 753,759 ----
*************** package body Sem_Res is
*** 787,792 ****
--- 806,847 ----
     procedure Check_Parameterless_Call (N : Node_Id) is
        Nam : Node_Id;
  
+       function Prefix_Is_Access_Subp return Boolean;
+       --  If the prefix is of an access_to_subprogram type, the node must be
+       --  rewritten as a call. Ditto if the prefix is overloaded and all its
+       --  interpretations are access to subprograms.
+ 
+       ---------------------------
+       -- Prefix_Is_Access_Subp --
+       ---------------------------
+ 
+       function Prefix_Is_Access_Subp return Boolean is
+          I   : Interp_Index;
+          It  : Interp;
+ 
+       begin
+          if not Is_Overloaded (N) then
+             return
+               Ekind (Etype (N)) = E_Subprogram_Type
+                 and then Base_Type (Etype (Etype (N))) /= Standard_Void_Type;
+          else
+             Get_First_Interp (N, I, It);
+             while Present (It.Typ) loop
+                if Ekind (It.Typ) /= E_Subprogram_Type
+                  or else Base_Type (Etype (It.Typ)) = Standard_Void_Type
+                then
+                   return False;
+                end if;
+ 
+                Get_Next_Interp (I, It);
+             end loop;
+ 
+             return True;
+          end if;
+       end Prefix_Is_Access_Subp;
+ 
+    --  Start of processing for Check_Parameterless_Call
+ 
     begin
        --  Defend against junk stuff if errors already detected
  
*************** package body Sem_Res is
*** 832,840 ****
        --  procedure or entry.
  
        or else
!         (Nkind (N) = N_Explicit_Dereference
!           and then Ekind (Etype (N)) = E_Subprogram_Type
!           and then Base_Type (Etype (Etype (N))) /= Standard_Void_Type)
  
        --  Rewrite as call if it is a selected component which is a function,
        --  this is the case of a call to a protected function (which may be
--- 887,893 ----
        --  procedure or entry.
  
        or else
!         (Nkind (N) = N_Explicit_Dereference and then Prefix_Is_Access_Subp)
  
        --  Rewrite as call if it is a selected component which is a function,
        --  this is the case of a call to a protected function (which may be
*************** package body Sem_Res is
*** 858,864 ****
           then
              Nam := New_Copy (N);
  
!             --  If overloaded, overload set belongs to new copy.
  
              Save_Interps (N, Nam);
  
--- 911,917 ----
           then
              Nam := New_Copy (N);
  
!             --  If overloaded, overload set belongs to new copy
  
              Save_Interps (N, Nam);
  
*************** package body Sem_Res is
*** 952,960 ****
  
           else
              Get_First_Interp (Nod, I, It);
- 
              while Present (It.Typ) loop
- 
                 if Scope (Base_Type (It.Typ)) = S then
                    return True;
                 end if;
--- 1005,1011 ----
*************** package body Sem_Res is
*** 1022,1030 ****
  
           else
              E := First_Entity (Pack);
- 
              while Present (E) loop
- 
                 if Test (E)
                   and then not In_Decl
                 then
--- 1073,1079 ----
*************** package body Sem_Res is
*** 1091,1096 ****
--- 1140,1152 ----
           then
              null;
  
+          --  Visibility does not need to be checked in an instance: if the
+          --  operator was not visible in the generic it has been diagnosed
+          --  already, else there is an implicit copy of it in the instance.
+ 
+          elsif In_Instance then
+             null;
+ 
           elsif (Op_Name =  Name_Op_Multiply
                or else Op_Name = Name_Op_Divide)
             and then Is_Fixed_Point_Type (Etype (Left_Opnd  (Op_Node)))
*************** package body Sem_Res is
*** 1320,1326 ****
        Full_Analysis := Save_Full_Analysis;
     end Pre_Analyze_And_Resolve;
  
!    --  Version without context type.
  
     procedure Pre_Analyze_And_Resolve (N : Node_Id) is
        Save_Full_Analysis : constant Boolean := Full_Analysis;
--- 1376,1382 ----
        Full_Analysis := Save_Full_Analysis;
     end Pre_Analyze_And_Resolve;
  
!    --  Version without context type
  
     procedure Pre_Analyze_And_Resolve (N : Node_Id) is
        Save_Full_Analysis : constant Boolean := Full_Analysis;
*************** package body Sem_Res is
*** 1534,1550 ****
              Is_Remote : Boolean := True;
  
           begin
!             --  Check that Typ is a fat pointer with a reference to a RAS as
!             --  original access type.
! 
!             if
!               (Ekind (Typ) = E_Access_Subprogram_Type
!                  and then Present (Equivalent_Type (Typ)))
!               or else
!                 (Ekind (Typ) = E_Record_Type
!                    and then Present (Corresponding_Remote_Type (Typ)))
  
!             then
                 --  Prefix (N) must statically denote a remote subprogram
                 --  declared in a package specification.
  
--- 1590,1598 ----
              Is_Remote : Boolean := True;
  
           begin
!             --  Check that Typ is a remote access-to-subprogram type
  
!             if Is_Remote_Access_To_Subprogram_Type (Typ) then
                 --  Prefix (N) must statically denote a remote subprogram
                 --  declared in a package specification.
  
*************** package body Sem_Res is
*** 1581,1586 ****
--- 1629,1635 ----
                      or else Attr = Attribute_Unchecked_Access
                      or else Attr = Attribute_Unrestricted_Access)
                   and then Expander_Active
+                  and then Get_PCS_Name /= Name_No_DSA
                 then
                    Check_Subtype_Conformant
                      (New_Id  => Entity (Prefix (N)),
*************** package body Sem_Res is
*** 1635,1644 ****
        --  is compatible with the context (i.e. the type passed to Resolve)
  
        else
-          Get_First_Interp (N, I, It);
- 
           --  Loop through possible interpretations
  
           Interp_Loop : while Present (It.Typ) loop
  
              --  We are only interested in interpretations that are compatible
--- 1684,1692 ----
        --  is compatible with the context (i.e. the type passed to Resolve)
  
        else
           --  Loop through possible interpretations
  
+          Get_First_Interp (N, I, It);
           Interp_Loop : while Present (It.Typ) loop
  
              --  We are only interested in interpretations that are compatible
*************** package body Sem_Res is
*** 1689,1698 ****
                         or else Nkind (N) = N_Procedure_Call_Statement
                       then
                          declare
!                            A : Node_Id := First_Actual (N);
                             E : Node_Id;
  
                          begin
                             while Present (A) loop
                                E := A;
  
--- 1737,1747 ----
                         or else Nkind (N) = N_Procedure_Call_Statement
                       then
                          declare
!                            A : Node_Id;
                             E : Node_Id;
  
                          begin
+                            A := First_Actual (N);
                             while Present (A) loop
                                E := A;
  
*************** package body Sem_Res is
*** 2020,2026 ****
  
                       elsif Nkind (Name (N)) = N_Selected_Component then
  
!                         --  Protected operation: retrieve operation name.
  
                          Subp_Name := Selector_Name (Name (N));
                       else
--- 2069,2075 ----
  
                       elsif Nkind (Name (N)) = N_Selected_Component then
  
!                         --  Protected operation: retrieve operation name
  
                          Subp_Name := Selector_Name (Name (N));
                       else
*************** package body Sem_Res is
*** 2039,2048 ****
  
                       begin
                          Error_Msg_N ("\possible interpretations:", N);
-                         Get_First_Interp (Name (N), Index, It);
  
                          while Present (It.Nam) loop
- 
                                Error_Msg_Sloc := Sloc (It.Nam);
                                Error_Msg_Node_2 := It.Typ;
                                Error_Msg_NE ("\&  declared#, type&",
--- 2088,2096 ----
  
                       begin
                          Error_Msg_N ("\possible interpretations:", N);
  
+                         Get_First_Interp (Name (N), Index, It);
                          while Present (It.Nam) loop
                                Error_Msg_Sloc := Sloc (It.Nam);
                                Error_Msg_Node_2 := It.Typ;
                                Error_Msg_NE ("\&  declared#, type&",
*************** package body Sem_Res is
*** 2092,2098 ****
              if Typ = Any_Real
                and then Expr_Type = Any_Fixed
              then
!                Error_Msg_N ("Illegal context for mixed mode operation", N);
                 Set_Etype (N, Universal_Real);
                 Ctx_Type := Universal_Real;
              end if;
--- 2140,2146 ----
              if Typ = Any_Real
                and then Expr_Type = Any_Fixed
              then
!                Error_Msg_N ("illegal context for mixed mode operation", N);
                 Set_Etype (N, Universal_Real);
                 Ctx_Type := Universal_Real;
              end if;
*************** package body Sem_Res is
*** 2291,2297 ****
        if Suppress = All_Checks then
           declare
              Svg : constant Suppress_Array := Scope_Suppress;
- 
           begin
              Scope_Suppress := (others => True);
              Resolve (N, Typ);
--- 2339,2344 ----
*************** package body Sem_Res is
*** 2301,2307 ****
        else
           declare
              Svg : constant Boolean := Scope_Suppress (Suppress);
- 
           begin
              Scope_Suppress (Suppress) := True;
              Resolve (N, Typ);
--- 2348,2353 ----
*************** package body Sem_Res is
*** 2411,2417 ****
              else
                 Set_Parent (Actval, N);
  
!                --  See note above concerning aggregates.
  
                 if Nkind (Actval) = N_Aggregate
                   and then Has_Discriminants (Etype (Actval))
--- 2457,2463 ----
              else
                 Set_Parent (Actval, N);
  
!                --  See note above concerning aggregates
  
                 if Nkind (Actval) = N_Aggregate
                   and then Has_Discriminants (Etype (Actval))
*************** package body Sem_Res is
*** 2522,2528 ****
     begin
        A := First_Actual (N);
        F := First_Formal (Nam);
- 
        while Present (F) loop
           if No (A) and then Needs_No_Actuals (Nam) then
              null;
--- 2568,2573 ----
*************** package body Sem_Res is
*** 2546,2557 ****
              --  If the formal is Out or In_Out, do not resolve and expand the
              --  conversion, because it is subsequently expanded into explicit
              --  temporaries and assignments. However, the object of the
!             --  conversion can be resolved. An exception is the case of
!             --  a tagged type conversion with a class-wide actual. In that
!             --  case we want the tag check to occur and no temporary will
!             --  will be needed (no representation change can occur) and
!             --  the parameter is passed by reference, so we go ahead and
!             --  resolve the type conversion.
  
              if Ekind (F) /= E_In_Parameter
                and then Nkind (A) = N_Type_Conversion
--- 2591,2605 ----
              --  If the formal is Out or In_Out, do not resolve and expand the
              --  conversion, because it is subsequently expanded into explicit
              --  temporaries and assignments. However, the object of the
!             --  conversion can be resolved. An exception is the case of a
!             --  tagged type conversion with a class-wide actual. In that case
!             --  we want the tag check to occur and no temporary will be needed
!             --  (no representation change can occur) and the parameter is
!             --  passed by reference, so we go ahead and resolve the type
!             --  conversion. Another excpetion is the case of reference to a
!             --  component or subcomponent of a bit-packed array, in which case
!             --  we want to defer expansion to the point the in and out
!             --  assignments are performed.
  
              if Ekind (F) /= E_In_Parameter
                and then Nkind (A) = N_Type_Conversion
*************** package body Sem_Res is
*** 2563,2571 ****
                    if Has_Aliased_Components (Etype (Expression (A)))
                      /= Has_Aliased_Components (Etype (F))
                    then
!                      Error_Msg_N
!                        ("both component types in a view conversion must be"
!                          & " aliased, or neither", A);
  
                    elsif not Same_Ancestor (Etype (F), Etype (Expression (A)))
                      and then
--- 2611,2633 ----
                    if Has_Aliased_Components (Etype (Expression (A)))
                      /= Has_Aliased_Components (Etype (F))
                    then
!                      if Ada_Version < Ada_05 then
!                         Error_Msg_N
!                           ("both component types in a view conversion must be"
!                             & " aliased, or neither", A);
! 
!                      --  Ada 2005: rule is relaxed (see AI-363)
! 
!                      elsif Has_Aliased_Components (Etype (F))
!                        and then
!                          not Has_Aliased_Components (Etype (Expression (A)))
!                      then
!                         Error_Msg_N
!                           ("view conversion operand must have aliased " &
!                            "components", N);
!                         Error_Msg_N
!                           ("\since target type has aliased components", N);
!                      end if;
  
                    elsif not Same_Ancestor (Etype (F), Etype (Expression (A)))
                      and then
*************** package body Sem_Res is
*** 2573,2585 ****
                          or else Is_By_Reference_Type (Etype (Expression (A))))
                    then
                       Error_Msg_N
!                        ("view conversion between unrelated by_reference "
!                          & "array types not allowed (\A\I-00246)?", A);
                    end if;
                 end if;
  
!                if Conversion_OK (A)
!                  or else Valid_Conversion (A, Etype (A), Expression (A))
                 then
                    Resolve (Expression (A));
                 end if;
--- 2635,2648 ----
                          or else Is_By_Reference_Type (Etype (Expression (A))))
                    then
                       Error_Msg_N
!                        ("view conversion between unrelated by reference " &
!                         "array types not allowed (\'A'I-00246)", A);
                    end if;
                 end if;
  
!                if (Conversion_OK (A)
!                      or else Valid_Conversion (A, Etype (A), Expression (A)))
!                  and then not Is_Ref_To_Bit_Packed_Array (Expression (A))
                 then
                    Resolve (Expression (A));
                 end if;
*************** package body Sem_Res is
*** 2593,2611 ****
                       or else Is_Limited_Type (Etype (Expression (A))))
                 then
                    Error_Msg_N
!                     ("Conversion between unrelated limited array types "
!                         & "not allowed (\A\I-00246)?", A);
! 
!                   --  Disable explanation (which produces additional errors)
!                   --  until AI is approved and warning becomes an error.
  
!                   --  if Is_Limited_Type (Etype (F)) then
!                   --     Explain_Limited_Type (Etype (F), A);
!                   --  end if;
  
!                   --  if Is_Limited_Type (Etype (Expression (A))) then
!                   --     Explain_Limited_Type (Etype (Expression (A)), A);
!                   --  end if;
                 end if;
  
                 Resolve (A, Etype (F));
--- 2656,2671 ----
                       or else Is_Limited_Type (Etype (Expression (A))))
                 then
                    Error_Msg_N
!                     ("conversion between unrelated limited array types " &
!                      "not allowed (\A\I-00246)", A);
  
!                   if Is_Limited_Type (Etype (F)) then
!                      Explain_Limited_Type (Etype (F), A);
!                   end if;
  
!                   if Is_Limited_Type (Etype (Expression (A))) then
!                      Explain_Limited_Type (Etype (Expression (A)), A);
!                   end if;
                 end if;
  
                 Resolve (A, Etype (F));
*************** package body Sem_Res is
*** 2641,2649 ****
                    Check_Unset_Reference (A);
                 end if;
  
!                --  In Ada 83 we cannot pass an OUT parameter as an IN
!                --  or IN OUT actual to a nested call, since this is a
!                --  case of reading an out parameter, which is not allowed.
  
                 if Ada_Version = Ada_83
                   and then Is_Entity_Name (A)
--- 2701,2709 ----
                    Check_Unset_Reference (A);
                 end if;
  
!                --  In Ada 83 we cannot pass an OUT parameter as an IN or IN OUT
!                --  actual to a nested call, since this is case of reading an
!                --  out parameter, which is not allowed.
  
                 if Ada_Version = Ada_83
                   and then Is_Entity_Name (A)
*************** package body Sem_Res is
*** 2718,2733 ****
  
                 if Ada_Version >= Ada_05
                   and then Is_Access_Type (F_Typ)
!                  and then (Can_Never_Be_Null (F)
!                            or else Can_Never_Be_Null (F_Typ))
                 then
!                   if Nkind (A) = N_Null then
!                      Apply_Compile_Time_Constraint_Error
!                        (N      => A,
!                         Msg    => "(Ada 2005) NULL not allowed in "
!                                    & "null-excluding formal?",
!                         Reason => CE_Null_Not_Allowed);
!                   end if;
                 end if;
              end if;
  
--- 2778,2791 ----
  
                 if Ada_Version >= Ada_05
                   and then Is_Access_Type (F_Typ)
!                  and then Can_Never_Be_Null (F_Typ)
!                  and then Nkind (A) = N_Null
                 then
!                   Apply_Compile_Time_Constraint_Error
!                     (N      => A,
!                      Msg    => "(Ada 2005) NULL not allowed in "
!                                & "null-excluding formal?",
!                      Reason => CE_Null_Not_Allowed);
                 end if;
              end if;
  
*************** package body Sem_Res is
*** 2962,2968 ****
              if Has_Discriminants (Subtyp) then
                 Discrim := First_Discriminant (Base_Type (Subtyp));
                 Constr := First (Constraints (Constraint (Original_Node (E))));
- 
                 while Present (Discrim) and then Present (Constr) loop
                    if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then
                       if Nkind (Constr) = N_Discriminant_Association then
--- 3020,3025 ----
*************** package body Sem_Res is
*** 3008,3019 ****
           end if;
        end if;
  
        --  Check for allocation from an empty storage pool
  
        if No_Pool_Assigned (Typ) then
           declare
              Loc : constant Source_Ptr := Sloc (N);
- 
           begin
              Error_Msg_N ("?allocation from empty storage pool!", N);
              Error_Msg_N ("?Storage_Error will be raised at run time!", N);
--- 3065,3115 ----
           end if;
        end if;
  
+       --  Ada 2005 (AI-344): A class-wide allocator requires an accessibility
+       --  check that the level of the type of the created object is not deeper
+       --  than the level of the allocator's access type, since extensions can
+       --  now occur at deeper levels than their ancestor types. This is a
+       --  static accessibility level check; a run-time check is also needed in
+       --  the case of an initialized allocator with a class-wide argument (see
+       --  Expand_Allocator_Expression).
+ 
+       if Ada_Version >= Ada_05
+         and then Is_Class_Wide_Type (Designated_Type (Typ))
+       then
+          declare
+             Exp_Typ   : Entity_Id;
+ 
+          begin
+             if Nkind (E) = N_Qualified_Expression then
+                Exp_Typ := Etype (E);
+             elsif Nkind (E) = N_Subtype_Indication then
+                Exp_Typ := Entity (Subtype_Mark (Original_Node (E)));
+             else
+                Exp_Typ := Entity (E);
+             end if;
+ 
+             if Type_Access_Level (Exp_Typ) > Type_Access_Level (Typ) then
+                if In_Instance_Body then
+                   Error_Msg_N ("?type in allocator has deeper level than" &
+                                " designated class-wide type", E);
+                   Error_Msg_N ("?Program_Error will be raised at run time", E);
+                   Rewrite (N,
+                     Make_Raise_Program_Error (Sloc (N),
+                       Reason => PE_Accessibility_Check_Failed));
+                   Set_Etype (N, Typ);
+                else
+                   Error_Msg_N ("type in allocator has deeper level than" &
+                                " designated class-wide type", E);
+                end if;
+             end if;
+          end;
+       end if;
+ 
        --  Check for allocation from an empty storage pool
  
        if No_Pool_Assigned (Typ) then
           declare
              Loc : constant Source_Ptr := Sloc (N);
           begin
              Error_Msg_N ("?allocation from empty storage pool!", N);
              Error_Msg_N ("?Storage_Error will be raised at run time!", N);
*************** package body Sem_Res is
*** 3021,3026 ****
--- 3117,3133 ----
                Make_Raise_Storage_Error (Loc,
                  Reason => SE_Empty_Storage_Pool));
           end;
+ 
+       --  If the context is an unchecked conversion, as may happen within
+       --  an inlined subprogram, the allocator is being resolved with its
+       --  own anonymous type. In that case, if the target type has a specific
+       --  storage pool, it must be inherited explicitly by the allocator type.
+ 
+       elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion
+         and then No (Associated_Storage_Pool (Typ))
+       then
+          Set_Associated_Storage_Pool
+            (Typ, Associated_Storage_Pool (Etype (Parent (N))));
        end if;
     end Resolve_Allocator;
  
*************** package body Sem_Res is
*** 3070,3078 ****
                or else T = Universal_Real;
           else
              Get_First_Interp (N, Index, It);
- 
              while Present (It.Typ) loop
- 
                 if Base_Type (It.Typ) = Base_Type (Standard_Integer)
                   or else It.Typ = Universal_Integer
                   or else It.Typ = Universal_Real
--- 3177,3183 ----
*************** package body Sem_Res is
*** 3099,3106 ****
           if Universal_Interpretation (N) = Universal_Integer then
  
              --  A universal integer literal is resolved as standard integer
!             --  except in the case of a fixed-point result, where we leave
!             --  it as universal (to be handled by Exp_Fixd later on)
  
              if Is_Fixed_Point_Type (T) then
                 Resolve (N, Universal_Integer);
--- 3204,3211 ----
           if Universal_Interpretation (N) = Universal_Integer then
  
              --  A universal integer literal is resolved as standard integer
!             --  except in the case of a fixed-point result, where we leave it
!             --  as universal (to be handled by Exp_Fixd later on)
  
              if Is_Fixed_Point_Type (T) then
                 Resolve (N, Universal_Integer);
*************** package body Sem_Res is
*** 3131,3143 ****
           elsif Etype (N) = T
             and then B_Typ /= Universal_Fixed
           then
!             --  Not a mixed-mode operation. Resolve with context.
  
              Resolve (N, B_Typ);
  
           elsif Etype (N) = Any_Fixed then
  
!             --  N may itself be a mixed-mode operation, so use context type.
  
              Resolve (N, B_Typ);
  
--- 3236,3248 ----
           elsif Etype (N) = T
             and then B_Typ /= Universal_Fixed
           then
!             --  Not a mixed-mode operation, resolve with context
  
              Resolve (N, B_Typ);
  
           elsif Etype (N) = Any_Fixed then
  
!             --  N may itself be a mixed-mode operation, so use context type
  
              Resolve (N, B_Typ);
  
*************** package body Sem_Res is
*** 3160,3166 ****
              --  interpretation or an integer interpretation, but not both.
  
              Get_First_Interp (N, Index, It);
- 
              while Present (It.Typ) loop
                 if Base_Type (It.Typ) = Base_Type (Standard_Integer) then
  
--- 3265,3270 ----
*************** package body Sem_Res is
*** 3182,3192 ****
                 Get_Next_Interp (Index, It);
              end loop;
  
!             --  Reanalyze the literal with the fixed type of the context.
!             --  If context is Universal_Fixed, we are within a conversion,
!             --  leave the literal as a universal real because there is no
!             --  usable fixed type, and the target of the conversion plays
!             --  no role in the resolution.
  
              declare
                 Op2 : Node_Id;
--- 3286,3296 ----
                 Get_Next_Interp (Index, It);
              end loop;
  
!             --  Reanalyze the literal with the fixed type of the context. If
!             --  context is Universal_Fixed, we are within a conversion, leave
!             --  the literal as a universal real because there is no usable
!             --  fixed type, and the target of the conversion plays no role in
!             --  the resolution.
  
              declare
                 Op2 : Node_Id;
*************** package body Sem_Res is
*** 3436,3449 ****
        It      : Interp;
        Norm_OK : Boolean;
        Scop    : Entity_Id;
-       W       : Node_Id;
  
     begin
!       --  The context imposes a unique interpretation with type Typ on
!       --  a procedure or function call. Find the entity of the subprogram
!       --  that yields the expected type, and propagate the corresponding
!       --  formal constraints on the actuals. The caller has established
!       --  that an interpretation exists, and emitted an error if not unique.
  
        --  First deal with the case of a call to an access-to-subprogram,
        --  dereference made explicit in Analyze_Call.
--- 3540,3552 ----
        It      : Interp;
        Norm_OK : Boolean;
        Scop    : Entity_Id;
  
     begin
!       --  The context imposes a unique interpretation with type Typ on a
!       --  procedure or function call. Find the entity of the subprogram that
!       --  yields the expected type, and propagate the corresponding formal
!       --  constraints on the actuals. The caller has established that an
!       --  interpretation exists, and emitted an error if not unique.
  
        --  First deal with the case of a call to an access-to-subprogram,
        --  dereference made explicit in Analyze_Call.
*************** package body Sem_Res is
*** 3453,3465 ****
              Nam := Etype (Subp);
  
           else
!             --  Find the interpretation whose type (a subprogram type)
!             --  has a return type that is compatible with the context.
!             --  Analysis of the node has established that one exists.
  
-             Get_First_Interp (Subp,  I, It);
              Nam := Empty;
  
              while Present (It.Typ) loop
                 if Covers (Typ, Etype (It.Typ)) then
                    Nam := It.Typ;
--- 3556,3568 ----
              Nam := Etype (Subp);
  
           else
!             --  Find the interpretation whose type (a subprogram type) has a
!             --  return type that is compatible with the context. Analysis of
!             --  the node has established that one exists.
  
              Nam := Empty;
  
+             Get_First_Interp (Subp,  I, It);
              while Present (It.Typ) loop
                 if Covers (Typ, Etype (It.Typ)) then
                    Nam := It.Typ;
*************** package body Sem_Res is
*** 3480,3497 ****
              Resolve (Subp, Nam);
           end if;
  
!          --  For an indirect call, we always invalidate checks, since we
!          --  do not know whether the subprogram is local or global. Yes
!          --  we could do better here, e.g. by knowing that there are no
!          --  local subprograms, but it does not seem worth the effort.
!          --  Similarly, we kill al knowledge of current constant values.
  
           Kill_Current_Values;
  
!       --  If this is a procedure call which is really an entry call, do
!       --  the conversion of the procedure call to an entry call. Protected
!       --  operations use the same circuitry because the name in the call
!       --  can be an arbitrary expression with special resolution rules.
  
        elsif Nkind (Subp) = N_Selected_Component
          or else Nkind (Subp) = N_Indexed_Component
--- 3583,3600 ----
              Resolve (Subp, Nam);
           end if;
  
!          --  For an indirect call, we always invalidate checks, since we do not
!          --  know whether the subprogram is local or global. Yes we could do
!          --  better here, e.g. by knowing that there are no local subprograms,
!          --  but it does not seem worth the effort. Similarly, we kill al
!          --  knowledge of current constant values.
  
           Kill_Current_Values;
  
!       --  If this is a procedure call which is really an entry call, do the
!       --  conversion of the procedure call to an entry call. Protected
!       --  operations use the same circuitry because the name in the call can be
!       --  an arbitrary expression with special resolution rules.
  
        elsif Nkind (Subp) = N_Selected_Component
          or else Nkind (Subp) = N_Indexed_Component
*************** package body Sem_Res is
*** 3518,3527 ****
  
        else
           pragma Assert (Is_Overloaded (Subp));
!          Nam := Empty;  --  We know that it will be assigned in loop below.
  
           Get_First_Interp (Subp,  I, It);
- 
           while Present (It.Typ) loop
              if Covers (Typ, It.Typ) then
                 Nam := It.Nam;
--- 3621,3629 ----
  
        else
           pragma Assert (Is_Overloaded (Subp));
!          Nam := Empty;  --  We know that it will be assigned in loop below
  
           Get_First_Interp (Subp,  I, It);
           while Present (It.Typ) loop
              if Covers (Typ, It.Typ) then
                 Nam := It.Nam;
*************** package body Sem_Res is
*** 3562,3573 ****
           Error_Msg_N ("cannot call thread body directly", N);
        end if;
  
!       --  If the subprogram is not global, then kill all checks. This is
!       --  a bit conservative, since in many cases we could do better, but
!       --  it is not worth the effort. Similarly, we kill constant values.
!       --  However we do not need to do this for internal entities (unless
!       --  they are inherited user-defined subprograms), since they are not
!       --  in the business of molesting global values.
  
        if not Is_Library_Level_Entity (Nam)
          and then (Comes_From_Source (Nam)
--- 3664,3675 ----
           Error_Msg_N ("cannot call thread body directly", N);
        end if;
  
!       --  If the subprogram is not global, then kill all checks. This is a bit
!       --  conservative, since in many cases we could do better, but it is not
!       --  worth the effort. Similarly, we kill constant values. However we do
!       --  not need to do this for internal entities (unless they are inherited
!       --  user-defined subprograms), since they are not in the business of
!       --  molesting global values.
  
        if not Is_Library_Level_Entity (Nam)
          and then (Comes_From_Source (Nam)
*************** package body Sem_Res is
*** 3577,3625 ****
           Kill_Current_Values;
        end if;
  
!       --  Check for call to obsolescent subprogram
! 
!       if Warn_On_Obsolescent_Feature
!         and then Is_Subprogram (Nam)
!         and then Is_Obsolescent (Nam)
!       then
!          Error_Msg_NE ("call to obsolescent subprogram&?", N, Nam);
! 
!          --  Output additional warning if present
! 
!          W := Obsolescent_Warning (Nam);
! 
!          if Present (W) then
!             Name_Buffer (1) := '|';
!             Name_Buffer (2) := '?';
!             Name_Len := 2;
! 
!             --  Add characters to message, protecting all of them
! 
!             for J in 1 .. String_Length (Strval (W)) loop
!                Add_Char_To_Name_Buffer (''');
!                Add_Char_To_Name_Buffer
!                  (Get_Character (Get_String_Char (Strval (W), J)));
!             end loop;
  
!             Error_Msg_N (Name_Buffer (1 .. Name_Len), N);
!          end if;
!       end if;
  
!       --  Check that a procedure call does not occur in the context
!       --  of the entry call statement of a conditional or timed
!       --  entry call. Note that the case of a call to a subprogram
!       --  renaming of an entry will also be rejected. The test
!       --  for N not being an N_Entry_Call_Statement is defensive,
!       --  covering the possibility that the processing of entry
!       --  calls might reach this point due to later modifications
!       --  of the code above.
  
        if Nkind (Parent (N)) = N_Entry_Call_Alternative
          and then Nkind (N) /= N_Entry_Call_Statement
          and then Entry_Call_Statement (Parent (N)) = N
        then
!          Error_Msg_N ("entry call required in select statement", N);
        end if;
  
        --  Check that this is not a call to a protected procedure or
--- 3679,3718 ----
           Kill_Current_Values;
        end if;
  
!       --  Check for call to subprogram marked Is_Obsolescent
  
!       Check_Obsolescent (Nam, N);
  
!       --  Check that a procedure call does not occur in the context of the
!       --  entry call statement of a conditional or timed entry call. Note that
!       --  the case of a call to a subprogram renaming of an entry will also be
!       --  rejected. The test for N not being an N_Entry_Call_Statement is
!       --  defensive, covering the possibility that the processing of entry
!       --  calls might reach this point due to later modifications of the code
!       --  above.
  
        if Nkind (Parent (N)) = N_Entry_Call_Alternative
          and then Nkind (N) /= N_Entry_Call_Statement
          and then Entry_Call_Statement (Parent (N)) = N
        then
!          if Ada_Version < Ada_05 then
!             Error_Msg_N ("entry call required in select statement", N);
! 
!          --  Ada 2005 (AI-345): If a procedure_call_statement is used
!          --  for a procedure_or_entry_call, the procedure_name or pro-
!          --  cedure_prefix of the procedure_call_statement shall denote
!          --  an entry renamed by a procedure, or (a view of) a primitive
!          --  subprogram of a limited interface whose first parameter is
!          --  a controlling parameter.
! 
!          elsif Nkind (N) = N_Procedure_Call_Statement
!            and then not Is_Renamed_Entry (Nam)
!            and then not Is_Controlling_Limited_Procedure (Nam)
!          then
!             Error_Msg_N
!              ("entry call, entry renaming or dispatching primitive " &
!               "of limited or synchronized interface required", N);
!          end if;
        end if;
  
        --  Check that this is not a call to a protected procedure or
*************** package body Sem_Res is
*** 3635,3668 ****
           Error_Msg_N ("\cannot call operation that may modify it", N);
        end if;
  
!       --  Freeze the subprogram name if not in default expression. Note
!       --  that we freeze procedure calls as well as function calls.
!       --  Procedure calls are not frozen according to the rules (RM
!       --  13.14(14)) because it is impossible to have a procedure call to
!       --  a non-frozen procedure in pure Ada, but in the code that we
!       --  generate in the expander, this rule needs extending because we
!       --  can generate procedure calls that need freezing.
  
        if Is_Entity_Name (Subp) and then not In_Default_Expression then
           Freeze_Expression (Subp);
        end if;
  
!       --  For a predefined operator, the type of the result is the type
!       --  imposed by context, except for a predefined operation on universal
!       --  fixed. Otherwise The type of the call is the type returned by the
!       --  subprogram being called.
  
        if Is_Predefined_Op (Nam) then
           if Etype (N) /= Universal_Fixed then
              Set_Etype (N, Typ);
           end if;
  
!       --  If the subprogram returns an array type, and the context
!       --  requires the component type of that array type, the node is
!       --  really an indexing of the parameterless call. Resolve as such.
!       --  A pathological case occurs when the type of the component is
!       --  an access to the array type. In this case the call is truly
!       --  ambiguous.
  
        elsif Needs_No_Actuals (Nam)
          and then
--- 3728,3760 ----
           Error_Msg_N ("\cannot call operation that may modify it", N);
        end if;
  
!       --  Freeze the subprogram name if not in default expression. Note that we
!       --  freeze procedure calls as well as function calls. Procedure calls are
!       --  not frozen according to the rules (RM 13.14(14)) because it is
!       --  impossible to have a procedure call to a non-frozen procedure in pure
!       --  Ada, but in the code that we generate in the expander, this rule
!       --  needs extending because we can generate procedure calls that need
!       --  freezing.
  
        if Is_Entity_Name (Subp) and then not In_Default_Expression then
           Freeze_Expression (Subp);
        end if;
  
!       --  For a predefined operator, the type of the result is the type imposed
!       --  by context, except for a predefined operation on universal fixed.
!       --  Otherwise The type of the call is the type returned by the subprogram
!       --  being called.
  
        if Is_Predefined_Op (Nam) then
           if Etype (N) /= Universal_Fixed then
              Set_Etype (N, Typ);
           end if;
  
!       --  If the subprogram returns an array type, and the context requires the
!       --  component type of that array type, the node is really an indexing of
!       --  the parameterless call. Resolve as such. A pathological case occurs
!       --  when the type of the component is an access to the array type. In
!       --  this case the call is truly ambiguous.
  
        elsif Needs_No_Actuals (Nam)
          and then
*************** package body Sem_Res is
*** 3733,3742 ****
        Set_Is_Overloaded (Subp, False);
        Set_Is_Overloaded (N, False);
  
!       --  If we are calling the current subprogram from immediately within
!       --  its body, then that is the case where we can sometimes detect
!       --  cases of infinite recursion statically. Do not try this in case
!       --  restriction No_Recursion is in effect anyway.
  
        Scop := Current_Scope;
  
--- 3825,3834 ----
        Set_Is_Overloaded (Subp, False);
        Set_Is_Overloaded (N, False);
  
!       --  If we are calling the current subprogram from immediately within its
!       --  body, then that is the case where we can sometimes detect cases of
!       --  infinite recursion statically. Do not try this in case restriction
!       --  No_Recursion is in effect anyway.
  
        Scop := Current_Scope;
  
*************** package body Sem_Res is
*** 3956,3962 ****
  
        else
           C := Current_Entity (N);
- 
           while Present (C) loop
              if Etype (C) = B_Typ then
                 Set_Entity_With_Style_Check (N, C);
--- 4048,4053 ----
*************** package body Sem_Res is
*** 3991,3998 ****
        T : Entity_Id;
  
     begin
-       Check_Direct_Boolean_Op (N);
- 
        --  If this is an intrinsic operation which is not predefined, use
        --  the types of its declared arguments to resolve the possibly
        --  overloaded operands. Otherwise the operands are unambiguous and
--- 4082,4087 ----
*************** package body Sem_Res is
*** 4000,4005 ****
--- 4089,4095 ----
  
        if Scope (Entity (N)) /= Standard_Standard then
           T := Etype (First_Entity (Entity (N)));
+ 
        else
           T := Find_Unique_Type (L, R);
  
*************** package body Sem_Res is
*** 4032,4037 ****
--- 4122,4128 ----
              Check_Unset_Reference (R);
              Generate_Operator_Reference (N, T);
              Eval_Relational_Op (N);
+             Check_Direct_Boolean_Op (N);
           end if;
        end if;
     end Resolve_Comparison_Op;
*************** package body Sem_Res is
*** 4186,4192 ****
              null;
           else
              Error_Msg_N
!                ("Invalid use of subtype mark in expression or call", N);
           end if;
  
        --  Check discriminant use if entity is discriminant in current scope,
--- 4277,4283 ----
              null;
           else
              Error_Msg_N
!                ("invalid use of subtype mark in expression or call", N);
           end if;
  
        --  Check discriminant use if entity is discriminant in current scope,
*************** package body Sem_Res is
*** 4382,4388 ****
                 --  the type in the same declarative part.
  
                 Tsk := Next_Entity (S);
- 
                 while Etype (Tsk) /= S loop
                    Next_Entity (Tsk);
                 end loop;
--- 4473,4478 ----
*************** package body Sem_Res is
*** 4422,4430 ****
  
           begin
              Get_First_Interp (Pref, I, It);
- 
              while Present (It.Typ) loop
- 
                 if Scope (Ent) = It.Typ then
                    Set_Etype (Pref, It.Typ);
                    exit;
--- 4512,4518 ----
*************** package body Sem_Res is
*** 4493,4501 ****
  
           begin
              Get_First_Interp (Selector_Name (Entry_Name), I, It);
- 
              while Present (It.Typ) loop
- 
                 if Covers (Typ, It.Typ) then
                    Set_Entity (Selector_Name (Entry_Name), It.Nam);
                    Set_Etype  (Entry_Name, It.Typ);
--- 4581,4587 ----
*************** package body Sem_Res is
*** 4512,4518 ****
  
        if Nkind (Entry_Name) = N_Selected_Component then
  
!          --  Simple entry call.
  
           Nam := Entity (Selector_Name (Entry_Name));
           Obj := Prefix (Entry_Name);
--- 4598,4604 ----
  
        if Nkind (Entry_Name) = N_Selected_Component then
  
!          --  Simple entry call
  
           Nam := Entity (Selector_Name (Entry_Name));
           Obj := Prefix (Entry_Name);
*************** package body Sem_Res is
*** 4520,4526 ****
  
        else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);
  
!          --  Call to member of entry family.
  
           Nam := Entity (Selector_Name (Prefix (Entry_Name)));
           Obj := Prefix (Prefix (Entry_Name));
--- 4606,4612 ----
  
        else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);
  
!          --  Call to member of entry family
  
           Nam := Entity (Selector_Name (Prefix (Entry_Name)));
           Obj := Prefix (Prefix (Entry_Name));
*************** package body Sem_Res is
*** 4609,4615 ****
           elsif Ekind (Scope (Nam)) = E_Task_Type
             and then not In_Open_Scopes (Scope (Nam))
           then
!             Error_Msg_N ("Task has no entry with this name", Entry_Name);
           end if;
        end if;
  
--- 4695,4701 ----
           elsif Ekind (Scope (Nam)) = E_Task_Type
             and then not In_Open_Scopes (Scope (Nam))
           then
!             Error_Msg_N ("task has no entry with this name", Entry_Name);
           end if;
        end if;
  
*************** package body Sem_Res is
*** 4647,4653 ****
           Set_Analyzed (N, True);
  
        --  Protected functions can return on the secondary stack, in which
!       --  case we must trigger the transient scope mechanism
  
        elsif Expander_Active
          and then Requires_Transient_Scope (Etype (Nam))
--- 4733,4739 ----
           Set_Analyzed (N, True);
  
        --  Protected functions can return on the secondary stack, in which
!       --  case we must trigger the transient scope mechanism.
  
        elsif Expander_Active
          and then Requires_Transient_Scope (Etype (Nam))
*************** package body Sem_Res is
*** 4687,4693 ****
        function Find_Unique_Access_Type return Entity_Id is
           Acc : Entity_Id;
           E   : Entity_Id;
!          S   : Entity_Id := Current_Scope;
  
        begin
           if Ekind (Etype (R)) =  E_Allocator_Type then
--- 4773,4779 ----
        function Find_Unique_Access_Type return Entity_Id is
           Acc : Entity_Id;
           E   : Entity_Id;
!          S   : Entity_Id;
  
        begin
           if Ekind (Etype (R)) =  E_Allocator_Type then
*************** package body Sem_Res is
*** 4700,4710 ****
              return Empty;
           end if;
  
           while S /= Standard_Standard loop
              E := First_Entity (S);
- 
              while Present (E) loop
- 
                 if Is_Type (E)
                   and then Is_Access_Type (E)
                   and then Ekind (E) /= E_Allocator_Type
--- 4786,4795 ----
              return Empty;
           end if;
  
+          S := Current_Scope;
           while S /= Standard_Standard loop
              E := First_Entity (S);
              while Present (E) loop
                 if Is_Type (E)
                   and then Is_Access_Type (E)
                   and then Ekind (E) /= E_Allocator_Type
*************** package body Sem_Res is
*** 4725,4732 ****
     --  Start of processing for Resolve_Equality_Op
  
     begin
-       Check_Direct_Boolean_Op (N);
- 
        Set_Etype (N, Base_Type (Typ));
        Generate_Reference (T, N, ' ');
  
--- 4810,4815 ----
*************** package body Sem_Res is
*** 4735,4746 ****
        end if;
  
        if T /= Any_Type then
- 
           if T = Any_String
             or else T = Any_Composite
             or else T = Any_Character
           then
- 
              if T = Any_Character then
                 Ambiguous_Character (L);
              else
--- 4818,4827 ----
*************** package body Sem_Res is
*** 4795,4800 ****
--- 4876,4883 ----
           then
              Error_Msg_NE ("cannot call abstract subprogram &!", N, Entity (N));
           end if;
+ 
+          Check_Direct_Boolean_Op (N);
        end if;
     end Resolve_Equality_Op;
  
*************** package body Sem_Res is
*** 4803,4837 ****
     ----------------------------------
  
     procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id) is
!       P  : constant Node_Id := Prefix (N);
!       I  : Interp_Index;
!       It : Interp;
  
     begin
!       --  Now that we know the type, check that this is not a
!       --  dereference of an uncompleted type. Note that this
!       --  is not entirely correct, because dereferences of
!       --  private types are legal in default expressions.
!       --  This consideration also applies to similar checks
!       --  for allocators, qualified expressions, and type
!       --  conversions. ???
  
!       Check_Fully_Declared (Typ, N);
  
        if Is_Overloaded (P) then
  
!          --  Use the context type to select the prefix that has the
!          --  correct designated type.
  
           Get_First_Interp (P, I, It);
           while Present (It.Typ) loop
              exit when Is_Access_Type (It.Typ)
                and then Covers (Typ, Designated_Type (It.Typ));
- 
              Get_Next_Interp (I, It);
           end loop;
  
!          Resolve (P, It.Typ);
           Set_Etype (N, Designated_Type (It.Typ));
  
        else
--- 4886,4979 ----
     ----------------------------------
  
     procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id) is
!       Loc   : constant Source_Ptr := Sloc (N);
!       New_N : Node_Id;
!       P     : constant Node_Id := Prefix (N);
!       I     : Interp_Index;
!       It    : Interp;
  
     begin
!       --  Now that we know the type, check that this is not dereference of an
!       --  uncompleted type. Note that this is not entirely correct, because
!       --  dereferences of private types are legal in default expressions. This
!       --  exception is taken care of in Check_Fully_Declared.
  
!       --  This consideration also applies to similar checks for allocators,
!       --  qualified expressions, and type conversions.
! 
!       --  An additional exception concerns other per-object expressions that
!       --  are not directly related to component declarations, in particular
!       --  representation pragmas for tasks. These will be per-object
!       --  expressions if they depend on discriminants or some global entity.
!       --  If the task has access discriminants, the designated type may be
!       --  incomplete at the point the expression is resolved. This resolution
!       --  takes place within the body of the initialization procedure, where
!       --  the discriminant is replaced by its discriminal.
! 
!       if Is_Entity_Name (Prefix (N))
!         and then Ekind (Entity (Prefix (N))) = E_In_Parameter
!       then
!          null;
! 
!       --  Ada 2005 (AI-326): Tagged incomplete types allowed. The wrong usages
!       --  are handled by Analyze_Access_Attribute, Analyze_Assignment, Analyze_
!       --  Object_Renaming, and Freeze_Entity.
! 
!       elsif Ada_Version >= Ada_05
!         and then Is_Entity_Name (Prefix (N))
!         and then Ekind (Directly_Designated_Type (Etype (Prefix (N))))
!                    = E_Incomplete_Type
!         and then Is_Tagged_Type (Directly_Designated_Type (Etype (Prefix (N))))
!       then
!          null;
!       else
!          Check_Fully_Declared (Typ, N);
!       end if;
  
        if Is_Overloaded (P) then
  
!          --  Use the context type to select the prefix that has the correct
!          --  designated type.
  
           Get_First_Interp (P, I, It);
           while Present (It.Typ) loop
              exit when Is_Access_Type (It.Typ)
                and then Covers (Typ, Designated_Type (It.Typ));
              Get_Next_Interp (I, It);
           end loop;
  
!          if Present (It.Typ) then
!             Resolve (P, It.Typ);
!          else
!             --  If no interpretation covers the designated type of the prefix,
!             --  this is the pathological case where not all implementations of
!             --  the prefix allow the interpretation of the node as a call. Now
!             --  that the expected type is known, Remove other interpretations
!             --  from prefix, rewrite it as a call, and resolve again, so that
!             --  the proper call node is generated.
! 
!             Get_First_Interp (P, I, It);
!             while Present (It.Typ) loop
!                if Ekind (It.Typ) /= E_Access_Subprogram_Type then
!                   Remove_Interp (I);
!                end if;
! 
!                Get_Next_Interp (I, It);
!             end loop;
! 
!             New_N :=
!               Make_Function_Call (Loc,
!                 Name =>
!                   Make_Explicit_Dereference (Loc,
!                     Prefix => P),
!                 Parameter_Associations => New_List);
! 
!             Save_Interps (N, New_N);
!             Rewrite (N, New_N);
!             Analyze_And_Resolve (N, Typ);
!             return;
!          end if;
! 
           Set_Etype (N, Designated_Type (It.Typ));
  
        else
*************** package body Sem_Res is
*** 4842,4855 ****
           Apply_Access_Check (N);
        end if;
  
!       --  If the designated type is a packed unconstrained array type,
!       --  and the explicit dereference is not in the context of an
!       --  attribute reference, then we must compute and set the actual
!       --  subtype, since it is needed by Gigi. The reason we exclude
!       --  the attribute case is that this is handled fine by Gigi, and
!       --  in fact we use such attributes to build the actual subtype.
!       --  We also exclude generated code (which builds actual subtypes
!       --  directly if they are needed).
  
        if Is_Array_Type (Etype (N))
          and then Is_Packed (Etype (N))
--- 4984,4996 ----
           Apply_Access_Check (N);
        end if;
  
!       --  If the designated type is a packed unconstrained array type, and the
!       --  explicit dereference is not in the context of an attribute reference,
!       --  then we must compute and set the actual subtype, since it is needed
!       --  by Gigi. The reason we exclude the attribute case is that this is
!       --  handled fine by Gigi, and in fact we use such attributes to build the
!       --  actual subtype. We also exclude generated code (which builds actual
!       --  subtypes directly if they are needed).
  
        if Is_Array_Type (Etype (N))
          and then Is_Packed (Etype (N))
*************** package body Sem_Res is
*** 4860,4868 ****
           Set_Etype (N, Get_Actual_Subtype (N));
        end if;
  
!       --  Note: there is no Eval processing required for an explicit
!       --  deference, because the type is known to be an allocators, and
!       --  allocator expressions can never be static.
  
     end Resolve_Explicit_Dereference;
  
--- 5001,5009 ----
           Set_Etype (N, Get_Actual_Subtype (N));
        end if;
  
!       --  Note: there is no Eval processing required for an explicit deference,
!       --  because the type is known to be an allocators, and allocator
!       --  expressions can never be static.
  
     end Resolve_Explicit_Dereference;
  
*************** package body Sem_Res is
*** 4879,4886 ****
     begin
        if Is_Overloaded (Name) then
  
!          --  Use the context type to select the prefix that yields the
!          --  correct component type.
  
           declare
              I     : Interp_Index;
--- 5020,5027 ----
     begin
        if Is_Overloaded (Name) then
  
!          --  Use the context type to select the prefix that yields the correct
!          --  component type.
  
           declare
              I     : Interp_Index;
*************** package body Sem_Res is
*** 4891,4899 ****
  
           begin
              Get_First_Interp (P, I, It);
- 
              while Present (It.Typ) loop
- 
                 if (Is_Array_Type (It.Typ)
                       and then Covers (Typ, Component_Type (It.Typ)))
                   or else (Is_Access_Type (It.Typ)
--- 5032,5038 ----
*************** package body Sem_Res is
*** 4941,4957 ****
           Array_Type := Designated_Type (Array_Type);
        end if;
  
!       --  If name was overloaded, set component type correctly now.
  
        Set_Etype (N, Component_Type (Array_Type));
  
        Index := First_Index (Array_Type);
        Expr  := First (Expressions (N));
  
!       --  The prefix may have resolved to a string literal, in which case
!       --  its etype has a special representation. This is only possible
!       --  currently if the prefix is a static concatenation, written in
!       --  functional notation.
  
        if Ekind (Array_Type) = E_String_Literal_Subtype then
           Resolve (Expr, Standard_Positive);
--- 5080,5096 ----
           Array_Type := Designated_Type (Array_Type);
        end if;
  
!       --  If name was overloaded, set component type correctly now
  
        Set_Etype (N, Component_Type (Array_Type));
  
        Index := First_Index (Array_Type);
        Expr  := First (Expressions (N));
  
!       --  The prefix may have resolved to a string literal, in which case its
!       --  etype has a special representation. This is only possible currently
!       --  if the prefix is a static concatenation, written in functional
!       --  notation.
  
        if Ekind (Array_Type) = E_String_Literal_Subtype then
           Resolve (Expr, Standard_Positive);
*************** package body Sem_Res is
*** 4997,5003 ****
  
     begin
        Op := Entity (N);
- 
        while Scope (Op) /= Standard_Standard loop
           Op := Homonym (Op);
           pragma Assert (Present (Op));
--- 5136,5141 ----
*************** package body Sem_Res is
*** 5006,5014 ****
        Set_Entity (N, Op);
        Set_Is_Overloaded (N, False);
  
!       --  If the operand type is private, rewrite with suitable
!       --  conversions on the operands and the result, to expose
!       --  the proper underlying numeric type.
  
        if Is_Private_Type (Typ) then
           Arg1 := Unchecked_Convert_To (Btyp, Left_Opnd  (N));
--- 5144,5152 ----
        Set_Entity (N, Op);
        Set_Is_Overloaded (N, False);
  
!       --  If the operand type is private, rewrite with suitable conversions on
!       --  the operands and the result, to expose the proper underlying numeric
!       --  type.
  
        if Is_Private_Type (Typ) then
           Arg1 := Unchecked_Convert_To (Btyp, Left_Opnd  (N));
*************** package body Sem_Res is
*** 5075,5081 ****
  
     begin
        Op := Entity (N);
- 
        while Scope (Op) /= Standard_Standard loop
           Op := Homonym (Op);
           pragma Assert (Present (Op));
--- 5213,5218 ----
*************** package body Sem_Res is
*** 5106,5116 ****
        B_Typ : Entity_Id;
  
     begin
!       Check_Direct_Boolean_Op (N);
! 
!       --  Predefined operations on scalar types yield the base type. On
!       --  the other hand, logical operations on arrays yield the type of
!       --  the arguments (and the context).
  
        if Is_Array_Type (Typ) then
           B_Typ := Typ;
--- 5243,5251 ----
        B_Typ : Entity_Id;
  
     begin
!       --  Predefined operations on scalar types yield the base type. On the
!       --  other hand, logical operations on arrays yield the type of the
!       --  arguments (and the context).
  
        if Is_Array_Type (Typ) then
           B_Typ := Typ;
*************** package body Sem_Res is
*** 5150,5155 ****
--- 5285,5291 ----
        Set_Etype (N, B_Typ);
        Generate_Operator_Reference (N, B_Typ);
        Eval_Logical_Op (N);
+       Check_Direct_Boolean_Op (N);
     end Resolve_Logical_Op;
  
     ---------------------------
*************** package body Sem_Res is
*** 5179,5184 ****
--- 5315,5342 ----
          and then Is_Overloaded (L)
        then
           T := Etype (R);
+ 
+       --  Ada 2005 (AI-251): Give support to the following case:
+ 
+       --      type I is interface;
+       --      type T is tagged ...
+ 
+       --      function Test (O : in I'Class) is
+       --      begin
+       --         return O in T'Class.
+       --      end Test;
+ 
+       --  In this case we have nothing else to do; the membership test will be
+       --  done at run-time.
+ 
+       elsif Ada_Version >= Ada_05
+         and then Is_Class_Wide_Type (Etype (L))
+         and then Is_Interface (Etype (L))
+         and then Is_Class_Wide_Type (Etype (R))
+         and then not Is_Interface (Etype (R))
+       then
+          return;
+ 
        else
           T := Intersect_Types (L, R);
        end if;
*************** package body Sem_Res is
*** 5208,5215 ****
  
     procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is
     begin
!       --  Handle restriction against anonymous null access values
!       --  This restriction can be turned off using -gnatdh.
  
        --  Ada 2005 (AI-231): Remove restriction
  
--- 5366,5373 ----
  
     procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is
     begin
!       --  Handle restriction against anonymous null access values This
!       --  restriction can be turned off using -gnatdh.
  
        --  Ada 2005 (AI-231): Remove restriction
  
*************** package body Sem_Res is
*** 5247,5253 ****
           return;
        end if;
  
!       --  The null literal takes its type from the context.
  
        Set_Etype (N, Typ);
     end Resolve_Null;
--- 5405,5411 ----
           return;
        end if;
  
!       --  The null literal takes its type from the context
  
        Set_Etype (N, Typ);
     end Resolve_Null;
*************** package body Sem_Res is
*** 5302,5328 ****
                   and then Has_Compatible_Type (Arg, Typ)
                   and then Etype (Arg) /= Any_Type
                 then
-                   Error_Msg_N ("ambiguous operand for concatenation!", Arg);
  
                    declare
!                      I  : Interp_Index;
!                      It : Interp;
  
                    begin
                       Get_First_Interp (Arg, I, It);
  
!                      while Present (It.Nam) loop
  
!                         if Base_Type (Etype (It.Nam)) = Base_Type (Typ)
!                           or else Base_Type (Etype (It.Nam)) =
!                             Base_Type (Component_Type (Typ))
!                         then
                             Error_Msg_Sloc := Sloc (It.Nam);
-                            Error_Msg_N ("\possible interpretation#", Arg);
-                         end if;
  
!                         Get_Next_Interp (I, It);
!                      end loop;
                    end;
                 end if;
  
--- 5460,5506 ----
                   and then Has_Compatible_Type (Arg, Typ)
                   and then Etype (Arg) /= Any_Type
                 then
  
                    declare
!                      I    : Interp_Index;
!                      It   : Interp;
!                      Func : Entity_Id;
  
                    begin
                       Get_First_Interp (Arg, I, It);
+                      Func := It.Nam;
+                      Get_Next_Interp (I, It);
  
!                      --  Special-case the error message when the overloading
!                      --  is caused by a function that yields and array and
!                      --  can be called without parameters.
  
!                      if It.Nam = Func then
!                         Error_Msg_Sloc := Sloc (Func);
!                         Error_Msg_N ("\ambiguous call to function#", Arg);
!                         Error_Msg_NE
!                           ("\interpretation as call yields&", Arg, Typ);
!                         Error_Msg_NE
!                           ("\interpretation as indexing of call yields&",
!                             Arg, Component_Type (Typ));
! 
!                      else
!                         Error_Msg_N ("ambiguous operand for concatenation!",
!                           Arg);
!                         Get_First_Interp (Arg, I, It);
!                         while Present (It.Nam) loop
                             Error_Msg_Sloc := Sloc (It.Nam);
  
!                            if Base_Type (It.Typ) = Base_Type (Typ)
!                              or else Base_Type (It.Typ) =
!                                Base_Type (Component_Type (Typ))
!                            then
!                               Error_Msg_N ("\possible interpretation#", Arg);
!                            end if;
! 
!                            Get_Next_Interp (I, It);
!                         end loop;
!                      end if;
                    end;
                 end if;
  
*************** package body Sem_Res is
*** 5356,5364 ****
           Explain_Limited_Type (Btyp, N);
        end if;
  
!       --  If the operands are themselves concatenations, resolve them as
!       --  such directly. This removes several layers of recursion and allows
!       --  GNAT to handle larger multiple concatenations.
  
        if Nkind (Op1) = N_Op_Concat
          and then not Is_Array_Type (Component_Type (Typ))
--- 5534,5542 ----
           Explain_Limited_Type (Btyp, N);
        end if;
  
!       --  If the operands are themselves concatenations, resolve them as such
!       --  directly. This removes several layers of recursion and allows GNAT to
!       --  handle larger multiple concatenations.
  
        if Nkind (Op1) = N_Op_Concat
          and then not Is_Array_Type (Component_Type (Typ))
*************** package body Sem_Res is
*** 5407,5414 ****
  
     begin
        --  Catch attempts to do fixed-point exponentation with universal
!       --  operands, which is a case where the illegality is not caught
!       --  during normal operator analysis.
  
        if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
           Error_Msg_N ("exponentiation not available for fixed point", N);
--- 5585,5592 ----
  
     begin
        --  Catch attempts to do fixed-point exponentation with universal
!       --  operands, which is a case where the illegality is not caught during
!       --  normal operator analysis.
  
        if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
           Error_Msg_N ("exponentiation not available for fixed point", N);
*************** package body Sem_Res is
*** 5499,5507 ****
     --  Start of processing for Resolve_Op_Not
  
     begin
!       --  Predefined operations on scalar types yield the base type. On
!       --  the other hand, logical operations on arrays yield the type of
!       --  the arguments (and the context).
  
        if Is_Array_Type (Typ) then
           B_Typ := Typ;
--- 5677,5685 ----
     --  Start of processing for Resolve_Op_Not
  
     begin
!       --  Predefined operations on scalar types yield the base type. On the
!       --  other hand, logical operations on arrays yield the type of the
!       --  arguments (and the context).
  
        if Is_Array_Type (Typ) then
           B_Typ := Typ;
*************** package body Sem_Res is
*** 5570,5578 ****
        Resolve (Expr, Target_Typ);
  
        --  A qualified expression requires an exact match of the type,
!       --  class-wide matching is not allowed.
  
!       if Is_Class_Wide_Type (Target_Typ)
          and then Base_Type (Etype (Expr)) /= Base_Type (Target_Typ)
        then
           Wrong_Type (Expr, Target_Typ);
--- 5748,5763 ----
        Resolve (Expr, Target_Typ);
  
        --  A qualified expression requires an exact match of the type,
!       --  class-wide matching is not allowed. However, if the qualifying
!       --  type is specific and the expression has a class-wide type, it
!       --  may still be okay, since it can be the result of the expansion
!       --  of a call to a dispatching function, so we also have to check
!       --  class-wideness of the type of the expression's original node.
  
!       if (Is_Class_Wide_Type (Target_Typ)
!            or else
!              (Is_Class_Wide_Type (Etype (Expr))
!                and then Is_Class_Wide_Type (Etype (Original_Node (Expr)))))
          and then Base_Type (Etype (Expr)) /= Base_Type (Target_Typ)
        then
           Wrong_Type (Expr, Target_Typ);
*************** package body Sem_Res is
*** 5608,5619 ****
        Check_Unset_Reference (H);
  
        --  We have to check the bounds for being within the base range as
!       --  required for a non-static context. Normally this is automatic
!       --  and done as part of evaluating expressions, but the N_Range
!       --  node is an exception, since in GNAT we consider this node to
!       --  be a subexpression, even though in Ada it is not. The circuit
!       --  in Sem_Eval could check for this, but that would put the test
!       --  on the main evaluation path for expressions.
  
        Check_Non_Static_Context (L);
        Check_Non_Static_Context (H);
--- 5793,5804 ----
        Check_Unset_Reference (H);
  
        --  We have to check the bounds for being within the base range as
!       --  required for a non-static context. Normally this is automatic and
!       --  done as part of evaluating expressions, but the N_Range node is an
!       --  exception, since in GNAT we consider this node to be a subexpression,
!       --  even though in Ada it is not. The circuit in Sem_Eval could check for
!       --  this, but that would put the test on the main evaluation path for
!       --  expressions.
  
        Check_Non_Static_Context (L);
        Check_Non_Static_Context (H);
*************** package body Sem_Res is
*** 5674,5679 ****
--- 5859,5874 ----
                    Error_Msg_N ("value has extraneous low order digits", N);
                 end if;
  
+                --  Generate a warning if literal from source
+ 
+                if Is_Static_Expression (N)
+                  and then Warn_On_Bad_Fixed_Value
+                then
+                   Error_Msg_N
+                     ("static fixed-point value is not a multiple of Small?",
+                      N);
+                end if;
+ 
                 --  Replace literal by a value that is the exact representation
                 --  of a value of the type, i.e. a multiple of the small value,
                 --  by truncation, since Machine_Rounds is false for all GNAT
*************** package body Sem_Res is
*** 5779,5787 ****
  
              if Is_Record_Type (T) then
                 Comp := First_Entity (T);
- 
                 while Present (Comp) loop
- 
                    if Chars (Comp) = Chars (S)
                      and then Covers (Etype (Comp), Typ)
                    then
--- 5974,5980 ----
*************** package body Sem_Res is
*** 5809,5815 ****
                                --  Find the component with the right name.
  
                                Comp1 := First_Entity (It1.Typ);
- 
                                while Present (Comp1)
                                  and then Chars (Comp1) /= Chars (S)
                                loop
--- 6002,6007 ----
*************** package body Sem_Res is
*** 5953,5961 ****
  
           begin
              Get_First_Interp (P, I,  It);
- 
              while Present (It.Typ) loop
- 
                 if (Is_Array_Type (It.Typ)
                      and then Covers (Typ,  It.Typ))
                   or else (Is_Access_Type (It.Typ)
--- 6145,6151 ----
*************** package body Sem_Res is
*** 6316,6323 ****
     -----------------------------
  
     procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id) is
!       Target_Type : constant Entity_Id := Etype (N);
!       Conv_OK     : constant Boolean   := Conversion_OK (N);
        Operand     : Node_Id;
        Opnd_Type   : Entity_Id;
        Rop         : Node_Id;
--- 6506,6513 ----
     -----------------------------
  
     procedure Resolve_Type_Conversion (N : Node_Id; Typ : Entity_Id) is
!       Conv_OK     : constant Boolean := Conversion_OK (N);
!       Target_Type : Entity_Id := Etype (N);
        Operand     : Node_Id;
        Opnd_Type   : Entity_Id;
        Rop         : Node_Id;
*************** package body Sem_Res is
*** 6347,6361 ****
             and then (Etype (Right_Opnd (Operand)) = Universal_Real
                       or else Etype (Left_Opnd (Operand)) = Universal_Real)
           then
              if Unique_Fixed_Point_Type (N) = Any_Type then
!                return;    --  expression is ambiguous.
!             else
!                --  If nothing else, the available fixed type is Duration.
  
                 Set_Etype (Operand, Standard_Duration);
              end if;
  
!             --  Resolve the real operand with largest available precision.
  
              if Etype (Right_Opnd (Operand)) = Universal_Real then
                 Rop := New_Copy_Tree (Right_Opnd (Operand));
--- 6537,6554 ----
             and then (Etype (Right_Opnd (Operand)) = Universal_Real
                       or else Etype (Left_Opnd (Operand)) = Universal_Real)
           then
+             --  Return if expression is ambiguous
+ 
              if Unique_Fixed_Point_Type (N) = Any_Type then
!                return;
! 
!             --  If nothing else, the available fixed type is Duration
  
+             else
                 Set_Etype (Operand, Standard_Duration);
              end if;
  
!             --  Resolve the real operand with largest available precision
  
              if Etype (Right_Opnd (Operand)) = Universal_Real then
                 Rop := New_Copy_Tree (Right_Opnd (Operand));
*************** package body Sem_Res is
*** 6363,6369 ****
                 Rop := New_Copy_Tree (Left_Opnd (Operand));
              end if;
  
!             Resolve (Rop, Standard_Long_Long_Float);
  
              --  If the operand is a literal (it could be a non-static and
              --  illegal exponentiation) check whether the use of Duration
--- 6556,6562 ----
                 Rop := New_Copy_Tree (Left_Opnd (Operand));
              end if;
  
!             Resolve (Rop, Universal_Real);
  
              --  If the operand is a literal (it could be a non-static and
              --  illegal exponentiation) check whether the use of Duration
*************** package body Sem_Res is
*** 6450,6455 ****
--- 6643,6695 ----
                ("?useless conversion, & has this type", N, Entity (Orig_N));
           end if;
        end if;
+ 
+       --  Ada 2005 (AI-251): Handle conversions to abstract interface types
+ 
+       if Ada_Version >= Ada_05 then
+          if Is_Access_Type (Target_Type) then
+             Target_Type := Directly_Designated_Type (Target_Type);
+          end if;
+ 
+          if Is_Class_Wide_Type (Target_Type) then
+             Target_Type := Etype (Target_Type);
+          end if;
+ 
+          if Is_Interface (Target_Type) then
+             if Is_Access_Type (Opnd_Type) then
+                Opnd_Type := Directly_Designated_Type (Opnd_Type);
+             end if;
+ 
+             if Is_Class_Wide_Type (Opnd_Type) then
+                Opnd_Type := Etype (Opnd_Type);
+             end if;
+ 
+             if not Interface_Present_In_Ancestor
+                      (Typ   => Opnd_Type,
+                       Iface => Target_Type)
+             then
+                Error_Msg_NE
+                  ("(Ada 2005) does not implement interface }",
+                   Operand, Target_Type);
+ 
+             else
+                --  If a conversion to an interface type appears as an actual in
+                --  a source call, it will be expanded when the enclosing call
+                --  itself is examined in Expand_Interface_Formals. Otherwise,
+                --  generate the proper conversion code now, using the tag of
+                --  the interface.
+ 
+                if (Nkind (Parent (N)) = N_Procedure_Call_Statement
+                      or else Nkind (Parent (N)) = N_Function_Call)
+                  and then Comes_From_Source (N)
+                then
+                   null;
+                else
+                   Expand_Interface_Conversion (N);
+                end if;
+             end if;
+          end if;
+       end if;
     end Resolve_Type_Conversion;
  
     ----------------------
*************** package body Sem_Res is
*** 6464,6486 ****
        Hi    : Uint;
  
     begin
-       --  Generate warning for expressions like abs (x mod 2)
- 
-       if Warn_On_Redundant_Constructs
-         and then Nkind (N) = N_Op_Abs
-       then
-          Determine_Range (Right_Opnd (N), OK, Lo, Hi);
- 
-          if OK and then Hi >= Lo and then Lo >= 0 then
-             Error_Msg_N
-              ("?abs applied to known non-negative value has no effect", N);
-          end if;
-       end if;
- 
        --  Generate warning for expressions like -5 mod 3
  
        if Paren_Count (N) = 0
          and then Nkind (N) = N_Op_Minus
          and then Nkind (Right_Opnd (N)) = N_Op_Mod
          and then Comes_From_Source (N)
        then
--- 6704,6714 ----
        Hi    : Uint;
  
     begin
        --  Generate warning for expressions like -5 mod 3
  
        if Paren_Count (N) = 0
          and then Nkind (N) = N_Op_Minus
+         and then Paren_Count (Right_Opnd (N)) = 0
          and then Nkind (Right_Opnd (N)) = N_Op_Mod
          and then Comes_From_Source (N)
        then
*************** package body Sem_Res is
*** 6506,6511 ****
--- 6734,6752 ----
        Set_Etype (N, B_Typ);
        Resolve (R, B_Typ);
  
+       --  Generate warning for expressions like abs (x mod 2)
+ 
+       if Warn_On_Redundant_Constructs
+         and then Nkind (N) = N_Op_Abs
+       then
+          Determine_Range (Right_Opnd (N), OK, Lo, Hi);
+ 
+          if OK and then Hi >= Lo and then Lo >= 0 then
+             Error_Msg_N
+              ("?abs applied to known non-negative value has no effect", N);
+          end if;
+       end if;
+ 
        Check_Unset_Reference (R);
        Generate_Operator_Reference (N, B_Typ);
        Eval_Unary_Op (N);
*************** package body Sem_Res is
*** 6548,6554 ****
        Opnd_Type : constant Entity_Id := Etype (Operand);
  
     begin
!       --  Resolve operand using its own type.
  
        Resolve (Operand, Opnd_Type);
        Eval_Unchecked_Conversion (N);
--- 6789,6795 ----
        Opnd_Type : constant Entity_Id := Etype (Operand);
  
     begin
!       --  Resolve operand using its own type
  
        Resolve (Operand, Opnd_Type);
        Eval_Unchecked_Conversion (N);
*************** package body Sem_Res is
*** 6770,6776 ****
        Scop : Entity_Id;
  
        procedure Fixed_Point_Error;
!       --  If true ambiguity, give details.
  
        procedure Fixed_Point_Error is
        begin
--- 7011,7021 ----
        Scop : Entity_Id;
  
        procedure Fixed_Point_Error;
!       --  If true ambiguity, give details
! 
!       -----------------------
!       -- Fixed_Point_Error --
!       -----------------------
  
        procedure Fixed_Point_Error is
        begin
*************** package body Sem_Res is
*** 6779,6796 ****
           Error_Msg_NE ("\possible interpretation as}", N, T2);
        end Fixed_Point_Error;
  
     begin
        --  The operations on Duration are visible, so Duration is always a
        --  possible interpretation.
  
        T1 := Standard_Duration;
  
!       --  Look for fixed-point types in enclosing scopes.
  
        Scop := Current_Scope;
        while Scop /= Standard_Standard loop
           T2 := First_Entity (Scop);
- 
           while Present (T2) loop
              if Is_Fixed_Point_Type (T2)
                and then Current_Entity (T2) = T2
--- 7024,7042 ----
           Error_Msg_NE ("\possible interpretation as}", N, T2);
        end Fixed_Point_Error;
  
+    --  Start of processing for Unique_Fixed_Point_Type
+ 
     begin
        --  The operations on Duration are visible, so Duration is always a
        --  possible interpretation.
  
        T1 := Standard_Duration;
  
!       --  Look for fixed-point types in enclosing scopes
  
        Scop := Current_Scope;
        while Scop /= Standard_Standard loop
           T2 := First_Entity (Scop);
           while Present (T2) loop
              if Is_Fixed_Point_Type (T2)
                and then Current_Entity (T2) = T2
*************** package body Sem_Res is
*** 6810,6823 ****
           Scop := Scope (Scop);
        end loop;
  
!       --  Look for visible fixed type declarations in the context.
  
        Item := First (Context_Items (Cunit (Current_Sem_Unit)));
        while Present (Item) loop
           if Nkind (Item) = N_With_Clause then
              Scop := Entity (Name (Item));
              T2 := First_Entity (Scop);
- 
              while Present (T2) loop
                 if Is_Fixed_Point_Type (T2)
                   and then Scope (Base_Type (T2)) = Scop
--- 7056,7068 ----
           Scop := Scope (Scop);
        end loop;
  
!       --  Look for visible fixed type declarations in the context
  
        Item := First (Context_Items (Cunit (Current_Sem_Unit)));
        while Present (Item) loop
           if Nkind (Item) = N_With_Clause then
              Scop := Entity (Name (Item));
              T2 := First_Entity (Scop);
              while Present (T2) loop
                 if Is_Fixed_Point_Type (T2)
                   and then Scope (Base_Type (T2)) = Scop
*************** package body Sem_Res is
*** 6896,6910 ****
           Opnd_Type   : Entity_Id) return Boolean
        is
        begin
!          --  Upward conversions are allowed (RM 4.6(22)).
  
           if Covers (Target_Type, Opnd_Type)
             or else Is_Ancestor (Target_Type, Opnd_Type)
           then
              return True;
  
!          --  Downward conversion are allowed if the operand is
!          --  is class-wide (RM 4.6(23)).
  
           elsif Is_Class_Wide_Type (Opnd_Type)
                and then Covers (Opnd_Type, Target_Type)
--- 7141,7155 ----
           Opnd_Type   : Entity_Id) return Boolean
        is
        begin
!          --  Upward conversions are allowed (RM 4.6(22))
  
           if Covers (Target_Type, Opnd_Type)
             or else Is_Ancestor (Target_Type, Opnd_Type)
           then
              return True;
  
!          --  Downward conversion are allowed if the operand is class-wide
!          --  (RM 4.6(23)).
  
           elsif Is_Class_Wide_Type (Opnd_Type)
                and then Covers (Opnd_Type, Target_Type)
*************** package body Sem_Res is
*** 6917,6922 ****
--- 7162,7174 ----
              return
                Conversion_Check (False,
                  "downward conversion of tagged objects not allowed");
+ 
+          --  Ada 2005 (AI-251): The conversion of a tagged type to an
+          --  abstract interface type is always valid
+ 
+          elsif Is_Interface (Target_Type) then
+             return True;
+ 
           else
              Error_Msg_NE
                ("invalid tagged conversion, not compatible with}",
*************** package body Sem_Res is
*** 6943,6958 ****
              --  in this context, but which cannot be removed by type checking,
              --  because the context does not impose a type.
  
              Get_First_Interp (Operand, I, It);
  
!             while Present (It.Typ) loop
  
!                if It.Typ = Standard_Void_Type then
!                   Remove_Interp (I);
!                end if;
  
!                Get_Next_Interp (I, It);
!             end loop;
  
              Get_First_Interp (Operand, I, It);
              I1  := I;
--- 7195,7236 ----
              --  in this context, but which cannot be removed by type checking,
              --  because the context does not impose a type.
  
+             --  When compiling for VMS, spurious ambiguities can be produced
+             --  when arithmetic operations have a literal operand and return
+             --  System.Address or a descendant of it. These ambiguities are
+             --  otherwise resolved by the context, but for conversions there
+             --  is no context type and the removal of the spurious operations
+             --  must be done explicitly here.
+ 
+             --  The node may be labelled overloaded, but still contain only
+             --  one interpretation because others were discarded in previous
+             --  filters. If this is the case, retain the single interpretation
+             --  if legal.
+ 
              Get_First_Interp (Operand, I, It);
+             Opnd_Type := It.Typ;
+             Get_Next_Interp (I, It);
  
!             if Present (It.Typ)
!               and then Opnd_Type /= Standard_Void_Type
!             then
!                --  More than one candidate interpretation is available
  
!                Get_First_Interp (Operand, I, It);
!                while Present (It.Typ) loop
!                   if It.Typ = Standard_Void_Type then
!                      Remove_Interp (I);
!                   end if;
  
!                   if Present (System_Aux_Id)
!                     and then Is_Descendent_Of_Address (It.Typ)
!                   then
!                      Remove_Interp (I);
!                   end if;
! 
!                   Get_Next_Interp (I, It);
!                end loop;
!             end if;
  
              Get_First_Interp (Operand, I, It);
              I1  := I;
*************** package body Sem_Res is
*** 7081,7086 ****
--- 7359,7452 ----
  
           return True;
  
+       --  Ada 2005 (AI-251)
+ 
+       elsif (Ekind (Target_Type) = E_General_Access_Type
+                or else Ekind (Target_Type) = E_Anonymous_Access_Type)
+         and then Is_Interface (Directly_Designated_Type (Target_Type))
+       then
+          --  Check the static accessibility rule of 4.6(17). Note that the
+          --  check is not enforced when within an instance body, since the RM
+          --  requires such cases to be caught at run time.
+ 
+          if Ekind (Target_Type) /= E_Anonymous_Access_Type then
+             if Type_Access_Level (Opnd_Type) >
+                Type_Access_Level (Target_Type)
+             then
+                --  In an instance, this is a run-time check, but one we know
+                --  will fail, so generate an appropriate warning. The raise
+                --  will be generated by Expand_N_Type_Conversion.
+ 
+                if In_Instance_Body then
+                   Error_Msg_N
+                     ("?cannot convert local pointer to non-local access type",
+                      Operand);
+                   Error_Msg_N
+                     ("?Program_Error will be raised at run time", Operand);
+ 
+                else
+                   Error_Msg_N
+                     ("cannot convert local pointer to non-local access type",
+                      Operand);
+                   return False;
+                end if;
+ 
+             --  Special accessibility checks are needed in the case of access
+             --  discriminants declared for a limited type.
+ 
+             elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type
+               and then not Is_Local_Anonymous_Access (Opnd_Type)
+             then
+                --  When the operand is a selected access discriminant the check
+                --  needs to be made against the level of the object denoted by
+                --  the prefix of the selected name. (Object_Access_Level
+                --  handles checking the prefix of the operand for this case.)
+ 
+                if Nkind (Operand) = N_Selected_Component
+                  and then Object_Access_Level (Operand)
+                    > Type_Access_Level (Target_Type)
+                then
+                   --  In an instance, this is a run-time check, but one we
+                   --  know will fail, so generate an appropriate warning.
+                   --  The raise will be generated by Expand_N_Type_Conversion.
+ 
+                   if In_Instance_Body then
+                      Error_Msg_N
+                        ("?cannot convert access discriminant to non-local" &
+                         " access type", Operand);
+                      Error_Msg_N
+                        ("?Program_Error will be raised at run time", Operand);
+ 
+                   else
+                      Error_Msg_N
+                        ("cannot convert access discriminant to non-local" &
+                         " access type", Operand);
+                      return False;
+                   end if;
+                end if;
+ 
+                --  The case of a reference to an access discriminant from
+                --  within a limited type declaration (which will appear as
+                --  a discriminal) is always illegal because the level of the
+                --  discriminant is considered to be deeper than any (namable)
+                --  access type.
+ 
+                if Is_Entity_Name (Operand)
+                  and then not Is_Local_Anonymous_Access (Opnd_Type)
+                  and then (Ekind (Entity (Operand)) = E_In_Parameter
+                             or else Ekind (Entity (Operand)) = E_Constant)
+                  and then Present (Discriminal_Link (Entity (Operand)))
+                then
+                   Error_Msg_N
+                     ("discriminant has deeper accessibility level than target",
+                      Operand);
+                   return False;
+                end if;
+             end if;
+          end if;
+ 
+          return True;
+ 
        elsif (Ekind (Target_Type) = E_General_Access_Type
          or else Ekind (Target_Type) = E_Anonymous_Access_Type)
            and then
*************** package body Sem_Res is
*** 7100,7110 ****
              return False;
           end if;
  
!          --  Check the static accessibility rule of 4.6(17). Note that
!          --  the check is not enforced when within an instance body, since
!          --  the RM requires such cases to be caught at run time.
  
!          if Ekind (Target_Type) /= E_Anonymous_Access_Type then
              if Type_Access_Level (Opnd_Type)
                > Type_Access_Level (Target_Type)
              then
--- 7466,7478 ----
              return False;
           end if;
  
!          --  Check the static accessibility rule of 4.6(17). Note that the
!          --  check is not enforced when within an instance body, since the RM
!          --  requires such cases to be caught at run time.
  
!          if Ekind (Target_Type) /= E_Anonymous_Access_Type
!            or else Is_Local_Anonymous_Access (Target_Type)
!          then
              if Type_Access_Level (Opnd_Type)
                > Type_Access_Level (Target_Type)
              then
*************** package body Sem_Res is
*** 7126,7138 ****
                    return False;
                 end if;
  
!             elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type then
  
!                --  When the operand is a selected access discriminant
!                --  the check needs to be made against the level of the
!                --  object denoted by the prefix of the selected name.
!                --  (Object_Access_Level handles checking the prefix
!                --  of the operand for this case.)
  
                 if Nkind (Operand) = N_Selected_Component
                   and then Object_Access_Level (Operand)
--- 7494,7510 ----
                    return False;
                 end if;
  
!             --  Special accessibility checks are needed in the case of access
!             --  discriminants declared for a limited type.
  
!             elsif Ekind (Opnd_Type) = E_Anonymous_Access_Type
!               and then not Is_Local_Anonymous_Access (Opnd_Type)
!             then
! 
!                --  When the operand is a selected access discriminant the check
!                --  needs to be made against the level of the object denoted by
!                --  the prefix of the selected name. (Object_Access_Level
!                --  handles checking the prefix of the operand for this case.)
  
                 if Nkind (Operand) = N_Selected_Component
                   and then Object_Access_Level (Operand)
*************** package body Sem_Res is
*** 7157,7167 ****
                    end if;
                 end if;
  
!                --  The case of a reference to an access discriminant
!                --  from within a type declaration (which will appear
!                --  as a discriminal) is always illegal because the
!                --  level of the discriminant is considered to be
!                --  deeper than any (namable) access type.
  
                 if Is_Entity_Name (Operand)
                   and then (Ekind (Entity (Operand)) = E_In_Parameter
--- 7529,7539 ----
                    end if;
                 end if;
  
!                --  The case of a reference to an access discriminant from
!                --  within a limited type declaration (which will appear as
!                --  a discriminal) is always illegal because the level of the
!                --  discriminant is considered to be deeper than any (namable)
!                --  access type.
  
                 if Is_Entity_Name (Operand)
                   and then (Ekind (Entity (Operand)) = E_In_Parameter
*************** package body Sem_Res is
*** 7217,7235 ****
        elsif (Ekind (Target_Type) = E_Access_Subprogram_Type
                 or else
               Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
          and then Conversion_Check
                     (Ekind (Base_Type (Opnd_Type)) = E_Access_Subprogram_Type,
                      "illegal operand for access subprogram conversion")
        then
           --  Check that the designated types are subtype conformant
  
!          if not Subtype_Conformant (Designated_Type (Opnd_Type),
!                                     Designated_Type (Target_Type))
!          then
!             Error_Msg_N
!               ("operand type is not subtype conformant with target type",
!                Operand);
!          end if;
  
           --  Check the static accessibility rule of 4.6(20)
  
--- 7589,7604 ----
        elsif (Ekind (Target_Type) = E_Access_Subprogram_Type
                 or else
               Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
+         and then No (Corresponding_Remote_Type (Opnd_Type))
          and then Conversion_Check
                     (Ekind (Base_Type (Opnd_Type)) = E_Access_Subprogram_Type,
                      "illegal operand for access subprogram conversion")
        then
           --  Check that the designated types are subtype conformant
  
!          Check_Subtype_Conformant (New_Id  => Designated_Type (Target_Type),
!                                    Old_Id  => Designated_Type (Opnd_Type),
!                                    Err_Loc => N);
  
           --  Check the static accessibility rule of 4.6(20)
  
*************** package body Sem_Res is
*** 7249,7258 ****
                 O_Gen : constant Node_Id :=
                           Enclosing_Generic_Body (Opnd_Type);
  
!                T_Gen : Node_Id :=
!                          Enclosing_Generic_Body (Target_Type);
  
              begin
                 while Present (T_Gen) and then T_Gen /= O_Gen loop
                    T_Gen := Enclosing_Generic_Body (T_Gen);
                 end loop;
--- 7618,7627 ----
                 O_Gen : constant Node_Id :=
                           Enclosing_Generic_Body (Opnd_Type);
  
!                T_Gen : Node_Id;
  
              begin
+                T_Gen := Enclosing_Generic_Body (Target_Type);
                 while Present (T_Gen) and then T_Gen /= O_Gen loop
                    T_Gen := Enclosing_Generic_Body (T_Gen);
                 end loop;
*************** package body Sem_Res is
*** 7285,7291 ****
        elsif Is_Tagged_Type (Target_Type) then
           return Valid_Tagged_Conversion (Target_Type, Opnd_Type);
  
!       --  Types derived from the same root type are convertible.
  
        elsif Root_Type (Target_Type) = Root_Type (Opnd_Type) then
           return True;
--- 7654,7660 ----
        elsif Is_Tagged_Type (Target_Type) then
           return Valid_Tagged_Conversion (Target_Type, Opnd_Type);
  
!       --  Types derived from the same root type are convertible
  
        elsif Root_Type (Target_Type) = Root_Type (Opnd_Type) then
           return True;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_res.ads gcc-4.1.0/gcc/ada/sem_res.ads
*** gcc-4.0.2/gcc/ada/sem_res.ads	Mon Jan  5 15:20:46 2004
--- gcc-4.1.0/gcc/ada/sem_res.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_smem.adb gcc-4.1.0/gcc/ada/sem_smem.adb
*** gcc-4.0.2/gcc/ada/sem_smem.adb	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_smem.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_smem.ads gcc-4.1.0/gcc/ada/sem_smem.ads
*** gcc-4.0.2/gcc/ada/sem_smem.ads	Thu Apr 24 17:54:17 2003
--- gcc-4.1.0/gcc/ada/sem_smem.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_type.adb gcc-4.1.0/gcc/ada/sem_type.adb
*** gcc-4.0.2/gcc/ada/sem_type.adb	Mon Sep 13 10:18:41 2004
--- gcc-4.1.0/gcc/ada/sem_type.adb	Tue Nov 15 14:03:56 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Atree;    use Atree;
*** 28,33 ****
--- 28,35 ----
  with Alloc;
  with Debug;    use Debug;
  with Einfo;    use Einfo;
+ with Elists;   use Elists;
+ with Nlists;   use Nlists;
  with Errout;   use Errout;
  with Lib;      use Lib;
  with Opt;      use Opt;
*************** package body Sem_Type is
*** 159,165 ****
     procedure New_Interps (N : Node_Id);
     --  Initialize collection of interpretations for the given node, which is
     --  either an overloaded entity, or an operation whose arguments have
!    --  multiple intepretations. Interpretations can be added to only one
     --  node at a time.
  
     function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
--- 161,167 ----
     procedure New_Interps (N : Node_Id);
     --  Initialize collection of interpretations for the given node, which is
     --  either an overloaded entity, or an operation whose arguments have
!    --  multiple interpretations. Interpretations can be added to only one
     --  node at a time.
  
     function Specific_Type (T1, T2 : Entity_Id) return Entity_Id;
*************** package body Sem_Type is
*** 374,379 ****
--- 376,392 ----
          and then not Is_Dispatching_Operation (E)
        then
           return;
+ 
+       --  An inherited interface operation that is implemented by some
+       --  derived type does not participate in overload resolution, only
+       --  the implementation operation does.
+ 
+       elsif Is_Hidden (E)
+         and then Is_Subprogram (E)
+         and then Present (Abstract_Interface_Alias (E))
+       then
+          Add_One_Interp (N, Abstract_Interface_Alias (E), T);
+          return;
        end if;
  
        --  If this is the first interpretation of N, N has type Any_Type.
*************** package body Sem_Type is
*** 421,427 ****
  
           else
              --  Overloaded prefix in indexed or selected component,
!             --  or call whose name is an expresion or another call.
  
              Add_Entry (Etype (N), Etype (N));
           end if;
--- 434,440 ----
  
           else
              --  Overloaded prefix in indexed or selected component,
!             --  or call whose name is an expression or another call.
  
              Add_Entry (Etype (N), Etype (N));
           end if;
*************** package body Sem_Type is
*** 529,535 ****
                    end if;
                 end loop;
  
!                --  On exit, we know that current homograph is not hidden.
  
                 Add_One_Interp (N, H, Etype (H));
  
--- 542,548 ----
                    end if;
                 end loop;
  
!                --  On exit, we know that current homograph is not hidden
  
                 Add_One_Interp (N, H, Etype (H));
  
*************** package body Sem_Type is
*** 585,590 ****
--- 598,606 ----
  
     function Covers (T1, T2 : Entity_Id) return Boolean is
  
+       BT1 : Entity_Id;
+       BT2 : Entity_Id;
+ 
        function Full_View_Covers (Typ1, Typ2 : Entity_Id) return Boolean;
        --  In an instance the proper view may not always be correct for
        --  private types, but private and full view are compatible. This
*************** package body Sem_Type is
*** 609,617 ****
     --  Start of processing for Covers
  
     begin
!       --  If either operand missing, then this is an error, but ignore
!       --  it (and pretend we have a cover) if errors already detected,
!       --  since this may simply mean we have malformed trees.
  
        if No (T1) or else No (T2) then
           if Total_Errors_Detected /= 0 then
--- 625,633 ----
     --  Start of processing for Covers
  
     begin
!       --  If either operand missing, then this is an error, but ignore it (and
!       --  pretend we have a cover) if errors already detected, since this may
!       --  simply mean we have malformed trees.
  
        if No (T1) or else No (T2) then
           if Total_Errors_Detected /= 0 then
*************** package body Sem_Type is
*** 619,624 ****
--- 635,644 ----
           else
              raise Program_Error;
           end if;
+ 
+       else
+          BT1 := Base_Type (T1);
+          BT2 := Base_Type (T2);
        end if;
  
        --  Simplest case: same types are compatible, and types that have the
*************** package body Sem_Type is
*** 626,632 ****
        --  actuals  belong to their class but are not compatible with other
        --  types of their class, and in particular with other generic actuals.
        --  They are however compatible with their own subtypes, and itypes
!       --  with the same base are compatible as well. Similary, constrained
        --  subtypes obtained from expressions of an unconstrained nominal type
        --  are compatible with the base type (may lead to spurious ambiguities
        --  in obscure cases ???)
--- 646,652 ----
        --  actuals  belong to their class but are not compatible with other
        --  types of their class, and in particular with other generic actuals.
        --  They are however compatible with their own subtypes, and itypes
!       --  with the same base are compatible as well. Similarly, constrained
        --  subtypes obtained from expressions of an unconstrained nominal type
        --  are compatible with the base type (may lead to spurious ambiguities
        --  in obscure cases ???)
*************** package body Sem_Type is
*** 639,645 ****
        if T1 = T2 then
           return True;
  
!       elsif Base_Type (T1) = Base_Type (T2) then
           if not Is_Generic_Actual_Type (T1) then
              return True;
           else
--- 659,668 ----
        if T1 = T2 then
           return True;
  
!       elsif  BT1 = BT2
!         or else BT1 = T2
!         or else BT2 = T1
!       then
           if not Is_Generic_Actual_Type (T1) then
              return True;
           else
*************** package body Sem_Type is
*** 676,681 ****
--- 699,756 ----
        then
           return True;
  
+       --  Ada 2005 (AI-345): A class-wide abstract interface type T1 covers a
+       --  task_type or protected_type implementing T1
+ 
+       elsif Ada_Version >= Ada_05
+         and then Is_Class_Wide_Type (T1)
+         and then Is_Interface (Etype (T1))
+         and then Is_Concurrent_Type (T2)
+         and then Interface_Present_In_Ancestor
+                    (Typ   => Base_Type (T2),
+                     Iface => Etype (T1))
+       then
+          return True;
+ 
+       --  Ada 2005 (AI-251): A class-wide abstract interface type T1 covers an
+       --  object T2 implementing T1
+ 
+       elsif Ada_Version >= Ada_05
+         and then Is_Class_Wide_Type (T1)
+         and then Is_Interface (Etype (T1))
+         and then Is_Tagged_Type (T2)
+       then
+          if Interface_Present_In_Ancestor (Typ => T2,
+                                            Iface => Etype (T1))
+          then
+             return True;
+ 
+          elsif Present (Abstract_Interfaces (T2)) then
+ 
+             --  Ada 2005 (AI-251): A class-wide abstract interface type T1
+             --  covers an object T2 that implements a direct derivation of T1.
+ 
+             declare
+                E : Elmt_Id := First_Elmt (Abstract_Interfaces (T2));
+             begin
+                while Present (E) loop
+                   if Is_Ancestor (Etype (T1), Node (E)) then
+                      return True;
+                   end if;
+ 
+                   Next_Elmt (E);
+                end loop;
+             end;
+ 
+             --  We should also check the case in which T1 is an ancestor of
+             --  some implemented interface???
+ 
+             return False;
+ 
+          else
+             return False;
+          end if;
+ 
        --  In a dispatching call the actual may be class-wide
  
        elsif Is_Class_Wide_Type (T2)
*************** package body Sem_Type is
*** 700,707 ****
        then
           return True;
  
!       --  If the expected type is an anonymous access, the designated
!       --  type must cover that of the expression.
  
        elsif Ekind (T1) = E_Anonymous_Access_Type
          and then Is_Access_Type (T2)
--- 775,782 ----
        then
           return True;
  
!       --  If the expected type is an anonymous access, the designated type must
!       --  cover that of the expression.
  
        elsif Ekind (T1) = E_Anonymous_Access_Type
          and then Is_Access_Type (T2)
*************** package body Sem_Type is
*** 712,720 ****
        --  An Access_To_Subprogram is compatible with itself, or with an
        --  anonymous type created for an attribute reference Access.
  
!       elsif (Ekind (Base_Type (T1)) = E_Access_Subprogram_Type
                 or else
!              Ekind (Base_Type (T1)) = E_Access_Protected_Subprogram_Type)
          and then Is_Access_Type (T2)
          and then (not Comes_From_Source (T1)
                     or else not Comes_From_Source (T2))
--- 787,795 ----
        --  An Access_To_Subprogram is compatible with itself, or with an
        --  anonymous type created for an attribute reference Access.
  
!       elsif (Ekind (BT1) = E_Access_Subprogram_Type
                 or else
!              Ekind (BT1) = E_Access_Protected_Subprogram_Type)
          and then Is_Access_Type (T2)
          and then (not Comes_From_Source (T1)
                     or else not Comes_From_Source (T2))
*************** package body Sem_Type is
*** 732,740 ****
        --  with itself, or with an anonymous type created for an attribute
        --  reference Access.
  
!       elsif (Ekind (Base_Type (T1)) = E_Anonymous_Access_Subprogram_Type
                 or else
!              Ekind (Base_Type (T1))
                        = E_Anonymous_Access_Protected_Subprogram_Type)
          and then Is_Access_Type (T2)
          and then (not Comes_From_Source (T1)
--- 807,815 ----
        --  with itself, or with an anonymous type created for an attribute
        --  reference Access.
  
!       elsif (Ekind (BT1) = E_Anonymous_Access_Subprogram_Type
                 or else
!              Ekind (BT1)
                        = E_Anonymous_Access_Protected_Subprogram_Type)
          and then Is_Access_Type (T2)
          and then (not Comes_From_Source (T1)
*************** package body Sem_Type is
*** 768,781 ****
           return Covers (Corresponding_Remote_Type (T2), T1);
  
        elsif Ekind (T2) = E_Access_Attribute_Type
!         and then (Ekind (Base_Type (T1)) = E_General_Access_Type
!               or else Ekind (Base_Type (T1)) = E_Access_Type)
          and then Covers (Designated_Type (T1), Designated_Type (T2))
        then
           --  If the target type is a RACW type while the source is an access
           --  attribute type, we are building a RACW that may be exported.
  
!          if Is_Remote_Access_To_Class_Wide_Type (Base_Type (T1)) then
              Set_Has_RACW (Current_Sem_Unit);
           end if;
  
--- 843,856 ----
           return Covers (Corresponding_Remote_Type (T2), T1);
  
        elsif Ekind (T2) = E_Access_Attribute_Type
!         and then (Ekind (BT1) = E_General_Access_Type
!                     or else Ekind (BT1) = E_Access_Type)
          and then Covers (Designated_Type (T1), Designated_Type (T2))
        then
           --  If the target type is a RACW type while the source is an access
           --  attribute type, we are building a RACW that may be exported.
  
!          if Is_Remote_Access_To_Class_Wide_Type (BT1) then
              Set_Has_RACW (Current_Sem_Unit);
           end if;
  
*************** package body Sem_Type is
*** 789,796 ****
              (From_With_Type (Designated_Type (T1))
                and then Covers (Designated_Type (T2), Designated_Type (T1)));
  
!       --  A boolean operation on integer literals is compatible with a
!       --  modular context.
  
        elsif T2 = Any_Modular
          and then Is_Modular_Integer_Type (T1)
--- 864,871 ----
              (From_With_Type (Designated_Type (T1))
                and then Covers (Designated_Type (T2), Designated_Type (T1)));
  
!       --  A boolean operation on integer literals is compatible with modular
!       --  context.
  
        elsif T2 = Any_Modular
          and then Is_Modular_Integer_Type (T1)
*************** package body Sem_Type is
*** 802,811 ****
        elsif Base_Type (T2) = Any_Type then
           return True;
  
!       --  A packed array type covers its corresponding non-packed type.
!       --  This is not legitimate Ada, but allows the omission of a number
!       --  of otherwise useless unchecked conversions, and since this can
!       --  only arise in (known correct) expanded code, no harm is done
  
        elsif Is_Array_Type (T2)
          and then Is_Packed (T2)
--- 877,886 ----
        elsif Base_Type (T2) = Any_Type then
           return True;
  
!       --  A packed array type covers its corresponding non-packed type. This is
!       --  not legitimate Ada, but allows the omission of a number of otherwise
!       --  useless unchecked conversions, and since this can only arise in
!       --  (known correct) expanded code, no harm is done
  
        elsif Is_Array_Type (T2)
          and then Is_Packed (T2)
*************** package body Sem_Type is
*** 838,844 ****
                                and then
                                  Designated_Type (T1) = Designated_Type (T2))
                     or else (T1 = Any_Access
!                               and then Is_Access_Type (Underlying_Type (T2))))
        then
           return True;
  
--- 913,922 ----
                                and then
                                  Designated_Type (T1) = Designated_Type (T2))
                     or else (T1 = Any_Access
!                               and then Is_Access_Type (Underlying_Type (T2)))
!                    or else (T2 = Any_Composite
!                               and then
!                                 Is_Composite_Type (Underlying_Type (T1))))
        then
           return True;
  
*************** package body Sem_Type is
*** 901,914 ****
        User_Subp   : Entity_Id;
  
        function Inherited_From_Actual (S : Entity_Id) return Boolean;
!       --  Determine whether one of the candidates is an operation inherited
!       --  by a type that is derived from an actual in an instantiation.
  
        function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
!       --  Determine whether a subprogram is an actual in an enclosing
!       --  instance. An overloading between such a subprogram and one
!       --  declared outside the instance is resolved in favor of the first,
!       --  because it resolved in the generic.
  
        function Matches (Actual, Formal : Node_Id) return Boolean;
        --  Look for exact type match in an instance, to remove spurious
--- 979,999 ----
        User_Subp   : Entity_Id;
  
        function Inherited_From_Actual (S : Entity_Id) return Boolean;
!       --  Determine whether one of the candidates is an operation inherited by
!       --  a type that is derived from an actual in an instantiation.
! 
!       function In_Generic_Actual (Exp : Node_Id) return Boolean;
!       --  Determine whether the expression is part of a generic actual. At
!       --  the time the actual is resolved the scope is already that of the
!       --  instance, but conceptually the resolution of the actual takes place
!       --  in the enclosing context, and no special disambiguation rules should
!       --  be applied.
  
        function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
!       --  Determine whether a subprogram is an actual in an enclosing instance.
!       --  An overloading between such a subprogram and one declared outside the
!       --  instance is resolved in favor of the first, because it resolved in
!       --  the generic.
  
        function Matches (Actual, Formal : Node_Id) return Boolean;
        --  Look for exact type match in an instance, to remove spurious
*************** package body Sem_Type is
*** 918,939 ****
        --  Comment required ???
  
        function Remove_Conversions return Interp;
!       --  Last chance for pathological cases involving comparisons on
!       --  literals, and user overloadings of the same operator. Such
!       --  pathologies have been removed from the ACVC, but still appear in
!       --  two DEC tests, with the following notable quote from Ben Brosgol:
        --
        --  [Note: I disclaim all credit/responsibility/blame for coming up with
!       --  this example;  Robert Dewar brought it to our attention, since it
!       --  is apparently found in the ACVC 1.5. I did not attempt to find
!       --  the reason in the Reference Manual that makes the example legal,
!       --  since I was too nauseated by it to want to pursue it further.]
        --
        --  Accordingly, this is not a fully recursive solution, but it handles
        --  DEC tests c460vsa, c460vsb. It also handles ai00136a, which pushes
        --  pathology in the other direction with calls whose multiple overloaded
        --  actuals make them truly unresolvable.
  
        ---------------------------
        -- Inherited_From_Actual --
        ---------------------------
--- 1003,1052 ----
        --  Comment required ???
  
        function Remove_Conversions return Interp;
!       --  Last chance for pathological cases involving comparisons on literals,
!       --  and user overloadings of the same operator. Such pathologies have
!       --  been removed from the ACVC, but still appear in two DEC tests, with
!       --  the following notable quote from Ben Brosgol:
        --
        --  [Note: I disclaim all credit/responsibility/blame for coming up with
!       --  this example; Robert Dewar brought it to our attention, since it is
!       --  apparently found in the ACVC 1.5. I did not attempt to find the
!       --  reason in the Reference Manual that makes the example legal, since I
!       --  was too nauseated by it to want to pursue it further.]
        --
        --  Accordingly, this is not a fully recursive solution, but it handles
        --  DEC tests c460vsa, c460vsb. It also handles ai00136a, which pushes
        --  pathology in the other direction with calls whose multiple overloaded
        --  actuals make them truly unresolvable.
  
+       ------------------------
+       --  In_Generic_Actual --
+       ------------------------
+ 
+       function In_Generic_Actual (Exp : Node_Id) return Boolean is
+          Par : constant Node_Id := Parent (Exp);
+ 
+       begin
+          if No (Par) then
+             return False;
+ 
+          elsif Nkind (Par) in N_Declaration then
+             if Nkind (Par) = N_Object_Declaration
+               or else Nkind (Par) = N_Object_Renaming_Declaration
+             then
+                return Present (Corresponding_Generic_Association (Par));
+             else
+                return False;
+             end if;
+ 
+          elsif Nkind (Par) in N_Statement_Other_Than_Procedure_Call then
+             return False;
+ 
+          else
+             return In_Generic_Actual (Parent (Par));
+          end if;
+       end In_Generic_Actual;
+ 
        ---------------------------
        -- Inherited_From_Actual --
        ---------------------------
*************** package body Sem_Type is
*** 1039,1047 ****
                   and then Etype (F1) = Standard_Boolean
                 then
                    --  If the two candidates are the original ones, the
!                   --  ambiguity is real. Otherwise keep the original,
!                   --  further calls to Disambiguate will take care of
!                   --  others in the list of candidates.
  
                    if It1 /= No_Interp then
                       if It = Disambiguate.It1
--- 1152,1160 ----
                   and then Etype (F1) = Standard_Boolean
                 then
                    --  If the two candidates are the original ones, the
!                   --  ambiguity is real. Otherwise keep the original, further
!                   --  calls to Disambiguate will take care of others in the
!                   --  list of candidates.
  
                    if It1 /= No_Interp then
                       if It = Disambiguate.It1
*************** package body Sem_Type is
*** 1079,1087 ****
                 Get_Next_Interp (I, It);
           end loop;
  
!          --  After some error, a formal may have Any_Type and yield
!          --  a spurious match. To avoid cascaded errors if possible,
!          --  check for such a formal in either candidate.
  
           if Serious_Errors_Detected > 0 then
              declare
--- 1192,1200 ----
                 Get_Next_Interp (I, It);
           end loop;
  
!          --  After some error, a formal may have Any_Type and yield a spurious
!          --  match. To avoid cascaded errors if possible, check for such a
!          --  formal in either candidate.
  
           if Serious_Errors_Detected > 0 then
              declare
*************** package body Sem_Type is
*** 1206,1214 ****
           elsif Chars (Nam1) /= Name_Op_Not
             and then (Typ = Standard_Boolean or else Typ = Any_Boolean)
           then
!             --  Equality or comparison operation. Choose predefined operator
!             --  if arguments are universal. The node may be an operator, a
!             --  name, or a function call, so unpack arguments accordingly.
  
              declare
                 Arg1, Arg2 : Node_Id;
--- 1319,1327 ----
           elsif Chars (Nam1) /= Name_Op_Not
             and then (Typ = Standard_Boolean or else Typ = Any_Boolean)
           then
!             --  Equality or comparison operation. Choose predefined operator if
!             --  arguments are universal. The node may be an operator, name, or
!             --  a function call, so unpack arguments accordingly.
  
              declare
                 Arg1, Arg2 : Node_Id;
*************** package body Sem_Type is
*** 1282,1291 ****
              end if;
  
           --  If the ambiguity occurs within an instance, it is due to several
!          --  formal types with the same actual. Look for an exact match
!          --  between the types of the formals of the overloadable entities,
!          --  and the actuals in the call, to recover the unambiguous match
!          --  in the original generic.
  
           --  The ambiguity can also be due to an overloading between a formal
           --  subprogram and a subprogram declared outside the generic. If the
--- 1395,1404 ----
              end if;
  
           --  If the ambiguity occurs within an instance, it is due to several
!          --  formal types with the same actual. Look for an exact match between
!          --  the types of the formals of the overloadable entities, and the
!          --  actuals in the call, to recover the unambiguous match in the
!          --  original generic.
  
           --  The ambiguity can also be due to an overloading between a formal
           --  subprogram and a subprogram declared outside the generic. If the
*************** package body Sem_Type is
*** 1297,1303 ****
           --  case the resolution was to the explicit declaration in the
           --  generic, and remains so in the instance.
  
!          elsif In_Instance then
              if Nkind (N) = N_Function_Call
                or else Nkind (N) = N_Procedure_Call_Statement
              then
--- 1410,1418 ----
           --  case the resolution was to the explicit declaration in the
           --  generic, and remains so in the instance.
  
!          elsif In_Instance
!            and then not In_Generic_Actual (N)
!          then
              if Nkind (N) = N_Function_Call
                or else Nkind (N) = N_Procedure_Call_Statement
              then
*************** package body Sem_Type is
*** 1393,1401 ****
              return It2;
           end if;
  
!       --  Otherwise, the predefined operator has precedence, or if the
!       --  user-defined operation is directly visible we have a true ambiguity.
!       --  If this is a fixed-point multiplication and division in Ada83 mode,
        --  exclude the universal_fixed operator, which often causes ambiguities
        --  in legacy code.
  
--- 1508,1516 ----
              return It2;
           end if;
  
!       --  Otherwise, the predefined operator has precedence, or if the user-
!       --  defined operation is directly visible we have a true ambiguity. If
!       --  this is a fixed-point multiplication and division in Ada83 mode,
        --  exclude the universal_fixed operator, which often causes ambiguities
        --  in legacy code.
  
*************** package body Sem_Type is
*** 1443,1450 ****
  
     function Entity_Matches_Spec (Old_S, New_S : Entity_Id) return Boolean is
     begin
!       --  Simple case: same entity kinds, type conformance is required.
!       --  A parameterless function can also rename a literal.
  
        if Ekind (Old_S) = Ekind (New_S)
          or else (Ekind (New_S) = E_Function
--- 1558,1565 ----
  
     function Entity_Matches_Spec (Old_S, New_S : Entity_Id) return Boolean is
     begin
!       --  Simple case: same entity kinds, type conformance is required. A
!       --  parameterless function can also rename a literal.
  
        if Ekind (Old_S) = Ekind (New_S)
          or else (Ekind (New_S) = E_Function
*************** package body Sem_Type is
*** 1510,1517 ****
           null;
        end if;
  
!       --  If one of the operands is Universal_Fixed, the type of the
!       --  other operand provides the context.
  
        if Etype (R) = Universal_Fixed then
           return T;
--- 1625,1632 ----
           null;
        end if;
  
!       --  If one of the operands is Universal_Fixed, the type of the other
!       --  operand provides the context.
  
        if Etype (R) = Universal_Fixed then
           return T;
*************** package body Sem_Type is
*** 1619,1624 ****
--- 1734,1749 ----
        then
           return
             Covers (Typ, Etype (N))
+ 
+             --  Ada 2005 (AI-345) The context may be a synchronized interface.
+             --  If the type is already frozen use the corresponding_record
+             --  to check whether it is a proper descendant.
+ 
+            or else
+              (Is_Concurrent_Type (Etype (N))
+                 and then Present (Corresponding_Record_Type (Etype (N)))
+                 and then Covers (Typ, Corresponding_Record_Type (Etype (N))))
+ 
             or else
               (not Is_Tagged_Type (Typ)
                  and then Ekind (Typ) /= E_Anonymous_Access_Type
*************** package body Sem_Type is
*** 1631,1636 ****
--- 1756,1771 ----
                    and then
                      (Scope (It.Nam) /= Standard_Standard
                         or else not Is_Invisible_Operator (N, Base_Type (Typ))))
+ 
+                --  Ada 2005 (AI-345)
+ 
+               or else
+                 (Is_Concurrent_Type (It.Typ)
+                   and then Present (Corresponding_Record_Type
+                                                              (Etype (It.Typ)))
+                   and then Covers (Typ, Corresponding_Record_Type
+                                                              (Etype (It.Typ))))
+ 
                or else (not Is_Tagged_Type (Typ)
                           and then Ekind (Typ) /= E_Anonymous_Access_Type
                           and then Covers (It.Typ, Typ))
*************** package body Sem_Type is
*** 1663,1669 ****
  
     function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean is
        Btyp : constant Entity_Id := Base_Type (Etype (First_Formal (F)));
- 
     begin
        return Operator_Matches_Spec (Op, F)
          and then (In_Open_Scopes (Scope (F))
--- 1798,1803 ----
*************** package body Sem_Type is
*** 1684,1689 ****
--- 1818,1955 ----
        Headers := (others => No_Entry);
     end Init_Interp_Tables;
  
+    -----------------------------------
+    -- Interface_Present_In_Ancestor --
+    -----------------------------------
+ 
+    function Interface_Present_In_Ancestor
+      (Typ   : Entity_Id;
+       Iface : Entity_Id) return Boolean
+    is
+       Target_Typ : Entity_Id;
+ 
+       function Iface_Present_In_Ancestor (Typ : Entity_Id) return Boolean;
+       --  Returns True if Typ or some ancestor of Typ implements Iface
+ 
+       function Iface_Present_In_Ancestor (Typ : Entity_Id) return Boolean is
+          E    : Entity_Id;
+          AI   : Entity_Id;
+          Elmt : Elmt_Id;
+ 
+       begin
+          if Typ = Iface then
+             return True;
+          end if;
+ 
+          --  Handle private types
+ 
+          if Present (Full_View (Typ))
+            and then not Is_Concurrent_Type (Full_View (Typ))
+          then
+             E := Full_View (Typ);
+          else
+             E := Typ;
+          end if;
+ 
+          loop
+             if Present (Abstract_Interfaces (E))
+               and then Present (Abstract_Interfaces (E))
+               and then not Is_Empty_Elmt_List (Abstract_Interfaces (E))
+             then
+                Elmt := First_Elmt (Abstract_Interfaces (E));
+                while Present (Elmt) loop
+                   AI := Node (Elmt);
+ 
+                   if AI = Iface or else Is_Ancestor (Iface, AI) then
+                      return True;
+                   end if;
+ 
+                   Next_Elmt (Elmt);
+                end loop;
+             end if;
+ 
+             exit when Etype (E) = E
+ 
+                --  Handle private types
+ 
+                or else (Present (Full_View (Etype (E)))
+                          and then Full_View (Etype (E)) = E);
+ 
+             --  Check if the current type is a direct derivation of the
+             --  interface
+ 
+             if Etype (E) = Iface then
+                return True;
+             end if;
+ 
+             --  Climb to the immediate ancestor handling private types
+ 
+             if Present (Full_View (Etype (E))) then
+                E := Full_View (Etype (E));
+             else
+                E := Etype (E);
+             end if;
+          end loop;
+ 
+          return False;
+       end Iface_Present_In_Ancestor;
+ 
+    --  Start of processing for Interface_Present_In_Ancestor
+ 
+    begin
+       if Is_Access_Type (Typ) then
+          Target_Typ := Etype (Directly_Designated_Type (Typ));
+       else
+          Target_Typ := Typ;
+       end if;
+ 
+       --  In case of concurrent types we can't use the Corresponding Record_Typ
+       --  to look for the interface because it is built by the expander (and
+       --  hence it is not always available). For this reason we traverse the
+       --  list of interfaces (available in the parent of the concurrent type)
+ 
+       if Is_Concurrent_Type (Target_Typ) then
+          if Present (Interface_List (Parent (Target_Typ))) then
+             declare
+                AI : Node_Id;
+             begin
+                AI := First (Interface_List (Parent (Target_Typ)));
+                while Present (AI) loop
+                   if Etype (AI) = Iface then
+                      return True;
+ 
+                   elsif Present (Abstract_Interfaces (Etype (AI)))
+                      and then Iface_Present_In_Ancestor (Etype (AI))
+                   then
+                      return True;
+                   end if;
+ 
+                   Next (AI);
+                end loop;
+             end;
+          end if;
+ 
+          return False;
+       end if;
+ 
+       if Is_Class_Wide_Type (Target_Typ) then
+          Target_Typ := Etype (Target_Typ);
+       end if;
+ 
+       if Ekind (Target_Typ) = E_Incomplete_Type then
+          pragma Assert (Present (Non_Limited_View (Target_Typ)));
+          Target_Typ := Non_Limited_View (Target_Typ);
+ 
+          --  Protect the frontend against previously detected errors
+ 
+          if Ekind (Target_Typ) = E_Incomplete_Type then
+             return False;
+          end if;
+       end if;
+ 
+       return Iface_Present_In_Ancestor (Target_Typ);
+    end Interface_Present_In_Ancestor;
+ 
     ---------------------
     -- Intersect_Types --
     ---------------------
*************** package body Sem_Type is
*** 1756,1761 ****
--- 2022,2035 ----
           elsif Nkind (Parent (L)) = N_Range then
              Error_Msg_N ("incompatible types given in constraint", Parent (L));
  
+          --  Ada 2005 (AI-251): Complete the error notification
+ 
+          elsif Is_Class_Wide_Type (Etype (R))
+              and then Is_Interface (Etype (Class_Wide_Type (Etype (R))))
+          then
+             Error_Msg_NE ("(Ada 2005) does not implement interface }",
+                           L, Etype (Class_Wide_Type (Etype (R))));
+ 
           else
              Error_Msg_N ("incompatible types", Parent (L));
           end if;
*************** package body Sem_Type is
*** 1920,1926 ****
           Headers (Hash (N)) := Interp_Map.Last;
  
        else
!          --   Place node at end of chain, or locate its previous entry.
  
           loop
              if Interp_Map.Table (Map_Ptr).Node = N then
--- 2194,2200 ----
           Headers (Hash (N)) := Interp_Map.Last;
  
        else
!          --   Place node at end of chain, or locate its previous entry
  
           loop
              if Interp_Map.Table (Map_Ptr).Node = N then
*************** package body Sem_Type is
*** 1939,1945 ****
              end if;
           end loop;
  
!          --  Chain the new node.
  
           Interp_Map.Increment_Last;
           Interp_Map.Table (Map_Ptr).Next := Interp_Map.Last;
--- 2213,2219 ----
              end if;
           end loop;
  
!          --  Chain the new node
  
           Interp_Map.Increment_Last;
           Interp_Map.Table (Map_Ptr).Next := Interp_Map.Last;
*************** package body Sem_Type is
*** 2249,2256 ****
--- 2523,2551 ----
        elsif T2 = Any_Modular and then Is_Modular_Integer_Type (T1) then
           return T1;
  
+       --  ----------------------------------------------------------
        --  Special cases for equality operators (all other predefined
        --  operators can never apply to tagged types)
+       --  ----------------------------------------------------------
+ 
+       --  Ada 2005 (AI-251): T1 and T2 are class-wide types, and T2 is an
+       --  interface
+ 
+       elsif Is_Class_Wide_Type (T1)
+         and then Is_Class_Wide_Type (T2)
+         and then Is_Interface (Etype (T2))
+       then
+          return T1;
+ 
+       --  Ada 2005 (AI-251): T1 is a concrete type that implements the
+       --  class-wide interface T2
+ 
+       elsif Is_Class_Wide_Type (T2)
+         and then Is_Interface (Etype (T2))
+         and then Interface_Present_In_Ancestor (Typ => T1,
+                                                 Iface => Etype (T2))
+       then
+          return T1;
  
        elsif Is_Class_Wide_Type (T1)
          and then Is_Ancestor (Root_Type (T1), T2)
*************** package body Sem_Type is
*** 2292,2298 ****
        then
           return T1;
  
!       --  If none of the above cases applies, types are not compatible.
  
        else
           return Any_Type;
--- 2587,2593 ----
        then
           return T1;
  
!       --  If none of the above cases applies, types are not compatible
  
        else
           return Any_Type;
*************** package body Sem_Type is
*** 2304,2314 ****
     -----------------------
  
     --  In addition to booleans and arrays of booleans, we must include
!    --  aggregates as valid boolean arguments, because in the first pass
!    --  of resolution their components are not examined. If it turns out not
!    --  to be an aggregate of booleans, this will be diagnosed in Resolve.
!    --  Any_Composite must be checked for prior to the array type checks
!    --  because Any_Composite does not have any associated indexes.
  
     function Valid_Boolean_Arg (T : Entity_Id) return Boolean is
     begin
--- 2599,2609 ----
     -----------------------
  
     --  In addition to booleans and arrays of booleans, we must include
!    --  aggregates as valid boolean arguments, because in the first pass of
!    --  resolution their components are not examined. If it turns out not to be
!    --  an aggregate of booleans, this will be diagnosed in Resolve.
!    --  Any_Composite must be checked for prior to the array type checks because
!    --  Any_Composite does not have any associated indexes.
  
     function Valid_Boolean_Arg (T : Entity_Id) return Boolean is
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_type.ads gcc-4.1.0/gcc/ada/sem_type.ads
*** gcc-4.0.2/gcc/ada/sem_type.ads	Tue Jul  6 13:57:31 2004
--- gcc-4.1.0/gcc/ada/sem_type.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Type is
*** 91,97 ****
     -----------------
  
     procedure Init_Interp_Tables;
!    --  Invoked by gnatf when processing multiple files.
  
     procedure Collect_Interps (N : Node_Id);
     --  Invoked when the name N has more than one visible interpretation.
--- 91,97 ----
     -----------------
  
     procedure Init_Interp_Tables;
!    --  Invoked by gnatf when processing multiple files
  
     procedure Collect_Interps (N : Node_Id);
     --  Invoked when the name N has more than one visible interpretation.
*************** package Sem_Type is
*** 131,137 ****
     --  of the operands of N, to check visibility.
  
     procedure End_Interp_List;
!    --  End the list of interpretations of current node.
  
     procedure Get_First_Interp
       (N  : Node_Id;
--- 131,137 ----
     --  of the operands of N, to check visibility.
  
     procedure End_Interp_List;
!    --  End the list of interpretations of current node
  
     procedure Get_First_Interp
       (N  : Node_Id;
*************** package Sem_Type is
*** 203,208 ****
--- 203,215 ----
     --  matches the signature of the operator, and is declared in an
     --  open scope, or in the scope of the result type.
  
+    function Interface_Present_In_Ancestor
+      (Typ   : Entity_Id;
+       Iface : Entity_Id) return Boolean;
+    --  Ada 2005 (AI-251): Typ must be a tagged record type/subtype and Iface
+    --  must be an abstract interface type. This function is used to check if
+    --  some ancestor of Typ implements Iface.
+ 
     function Intersect_Types (L, R : Node_Id) return Entity_Id;
     --  Find the common interpretation to two analyzed nodes. If one of the
     --  interpretations is universal, choose the non-universal one. If either
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_util.adb gcc-4.1.0/gcc/ada/sem_util.adb
*** gcc-4.0.2/gcc/ada/sem_util.adb	Thu Feb 10 13:50:38 2005
--- gcc-4.1.0/gcc/ada/sem_util.adb	Tue Nov 15 14:04:10 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Nlists;   use Nlists;
*** 41,46 ****
--- 41,48 ----
  with Nmake;    use Nmake;
  with Output;   use Output;
  with Opt;      use Opt;
+ with Restrict; use Restrict;
+ with Rident;   use Rident;
  with Rtsfind;  use Rtsfind;
  with Scans;    use Scans;
  with Scn;      use Scn;
*************** package body Sem_Util is
*** 415,423 ****
  
        if Ekind (Deaccessed_T) = E_Array_Subtype then
           Id := First_Index (Deaccessed_T);
-          Indx_Type := Underlying_Type (Etype (Id));
  
           while Present (Id) loop
  
              if Denotes_Discriminant (Type_Low_Bound  (Indx_Type)) or else
                 Denotes_Discriminant (Type_High_Bound (Indx_Type))
--- 417,425 ----
  
        if Ekind (Deaccessed_T) = E_Array_Subtype then
           Id := First_Index (Deaccessed_T);
  
           while Present (Id) loop
+             Indx_Type := Underlying_Type (Etype (Id));
  
              if Denotes_Discriminant (Type_Low_Bound  (Indx_Type)) or else
                 Denotes_Discriminant (Type_High_Bound (Indx_Type))
*************** package body Sem_Util is
*** 863,868 ****
--- 865,916 ----
        end if;
     end Check_Fully_Declared;
  
+    -----------------------
+    -- Check_Obsolescent --
+    -----------------------
+ 
+    procedure Check_Obsolescent (Nam : Entity_Id; N : Node_Id) is
+       W : Node_Id;
+ 
+    begin
+       --  Note that we always allow obsolescent references in the compiler
+       --  itself and the run time, since we assume that we know what we are
+       --  doing in such cases. For example the calls in Ada.Characters.Handling
+       --  to its own obsolescent subprograms are just fine.
+ 
+       if Is_Obsolescent (Nam) and then not GNAT_Mode then
+          Check_Restriction (No_Obsolescent_Features, N);
+ 
+          if Warn_On_Obsolescent_Feature then
+             if Is_Package_Or_Generic_Package (Nam) then
+                Error_Msg_NE ("with of obsolescent package&?", N, Nam);
+             else
+                Error_Msg_NE ("call to obsolescent subprogram&?", N, Nam);
+             end if;
+ 
+             --  Output additional warning if present
+ 
+             W := Obsolescent_Warning (Nam);
+ 
+             if Present (W) then
+                Name_Buffer (1) := '|';
+                Name_Buffer (2) := '?';
+                Name_Len := 2;
+ 
+                --  Add characters to message, and output message
+ 
+                for J in 1 .. String_Length (Strval (W)) loop
+                   Add_Char_To_Name_Buffer (''');
+                   Add_Char_To_Name_Buffer
+                     (Get_Character (Get_String_Char (Strval (W), J)));
+                end loop;
+ 
+                Error_Msg_N (Name_Buffer (1 .. Name_Len), N);
+             end if;
+          end if;
+       end if;
+    end Check_Obsolescent;
+ 
     ------------------------------------------
     -- Check_Potentially_Blocking_Operation --
     ------------------------------------------
*************** package body Sem_Util is
*** 955,965 ****
              null;
           end if;
  
!       elsif (Is_Package (B_Scope)
!                and then Nkind (
!                  Parent (Declaration_Node (First_Subtype (T))))
!                    /=  N_Package_Body)
! 
          or else Is_Derived_Type (B_Type)
        then
           --  The primitive operations appear after the base type, except
--- 1003,1012 ----
              null;
           end if;
  
!       elsif (Is_Package_Or_Generic_Package (B_Scope)
!               and then
!                 Nkind (Parent (Declaration_Node (First_Subtype (T)))) /=
!                                                             N_Package_Body)
          or else Is_Derived_Type (B_Type)
        then
           --  The primitive operations appear after the base type, except
*************** package body Sem_Util is
*** 1618,1623 ****
--- 1665,1690 ----
        E : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
        S : constant Entity_Id := Current_Scope;
  
+       function Is_Private_Component_Renaming (N : Node_Id) return Boolean;
+       --  Recognize a renaming declaration that is introduced for private
+       --  components of a protected type. We treat these as weak declarations
+       --  so that they are overridden by entities with the same name that
+       --  come from source, such as formals or local variables of a given
+       --  protected declaration.
+ 
+       -----------------------------------
+       -- Is_Private_Component_Renaming --
+       -----------------------------------
+ 
+       function Is_Private_Component_Renaming (N : Node_Id) return Boolean is
+       begin
+          return not Comes_From_Source (N)
+            and then not Comes_From_Source (Current_Scope)
+            and then Nkind (N) = N_Object_Renaming_Declaration;
+       end Is_Private_Component_Renaming;
+ 
+    --  Start of processing for Enter_Name
+ 
     begin
        Generate_Definition (Def_Id);
  
*************** package body Sem_Util is
*** 1742,1747 ****
--- 1809,1817 ----
           then
              return;
  
+          elsif Is_Private_Component_Renaming (Parent (Def_Id)) then
+             return;
+ 
           --  In the body or private part of an instance, a type extension
           --  may introduce a component with the same name as that of an
           --  actual. The legality rule is not enforced, but the semantics
*************** package body Sem_Util is
*** 2206,2221 ****
  
        while Present (Comp_Item) loop
  
!          --  Skip the tag of a tagged record, as well as all items
!          --  that are not user components (anonymous types, rep clauses,
!          --  Parent field, controller field).
  
!          if Nkind (Comp_Item) = N_Component_Declaration
!            and then Chars (Defining_Identifier (Comp_Item)) /= Name_uTag
!            and then Chars (Defining_Identifier (Comp_Item)) /= Name_uParent
!            and then Chars (Defining_Identifier (Comp_Item)) /= Name_uController
!          then
!             Append_Elmt (Defining_Identifier (Comp_Item), Into);
           end if;
  
           Next (Comp_Item);
--- 2276,2296 ----
  
        while Present (Comp_Item) loop
  
!          --  Skip the tag of a tagged record, the interface tags, as well
!          --  as all items that are not user components (anonymous types,
!          --  rep clauses, Parent field, controller field).
  
!          if Nkind (Comp_Item) = N_Component_Declaration then
!             declare
!                Comp : constant Entity_Id := Defining_Identifier (Comp_Item);
!             begin
!                if not Is_Tag (Comp)
!                  and then Chars (Comp) /= Name_uParent
!                  and then Chars (Comp) /= Name_uController
!                then
!                   Append_Elmt (Comp, Into);
!                end if;
!             end;
           end if;
  
           Next (Comp_Item);
*************** package body Sem_Util is
*** 2697,2703 ****
  
     function Get_Task_Body_Procedure (E : Entity_Id) return Node_Id is
     begin
!       return Task_Body_Procedure (Declaration_Node (Root_Type (E)));
     end Get_Task_Body_Procedure;
  
     -----------------------
--- 2772,2784 ----
  
     function Get_Task_Body_Procedure (E : Entity_Id) return Node_Id is
     begin
!       --  Note: A task type may be the completion of a private type with
!       --  discriminants. when performing elaboration checks on a task
!       --  declaration, the current view of the type may be the private one,
!       --  and the procedure that holds the body of the task is held in its
!       --  underlying type.
! 
!       return Task_Body_Procedure (Underlying_Type (Root_Type (E)));
     end Get_Task_Body_Procedure;
  
     -----------------------
*************** package body Sem_Util is
*** 2767,2772 ****
--- 2848,2900 ----
          or else K = N_Package_Specification;
     end Has_Declarations;
  
+    -------------------------------------------
+    -- Has_Discriminant_Dependent_Constraint --
+    -------------------------------------------
+ 
+    function Has_Discriminant_Dependent_Constraint
+      (Comp : Entity_Id) return Boolean
+    is
+       Comp_Decl  : constant Node_Id := Parent (Comp);
+       Subt_Indic : constant Node_Id :=
+                      Subtype_Indication (Component_Definition (Comp_Decl));
+       Constr     : Node_Id;
+       Assn       : Node_Id;
+ 
+    begin
+       if Nkind (Subt_Indic) = N_Subtype_Indication then
+          Constr := Constraint (Subt_Indic);
+ 
+          if Nkind (Constr) = N_Index_Or_Discriminant_Constraint then
+             Assn := First (Constraints (Constr));
+             while Present (Assn) loop
+                case Nkind (Assn) is
+                   when N_Subtype_Indication |
+                        N_Range              |
+                        N_Identifier
+                   =>
+                      if Depends_On_Discriminant (Assn) then
+                         return True;
+                      end if;
+ 
+                   when N_Discriminant_Association =>
+                      if Depends_On_Discriminant (Expression (Assn)) then
+                         return True;
+                      end if;
+ 
+                   when others =>
+                      null;
+ 
+                end case;
+ 
+                Next (Assn);
+             end loop;
+          end if;
+       end if;
+ 
+       return False;
+    end Has_Discriminant_Dependent_Constraint;
+ 
     --------------------
     -- Has_Infinities --
     --------------------
*************** package body Sem_Util is
*** 3123,3129 ****
     function In_Visible_Part (Scope_Id : Entity_Id) return Boolean is
     begin
        return
!         Is_Package (Scope_Id)
            and then In_Open_Scopes (Scope_Id)
            and then not In_Package_Body (Scope_Id)
            and then not In_Private_Part (Scope_Id);
--- 3251,3257 ----
     function In_Visible_Part (Scope_Id : Entity_Id) return Boolean is
     begin
        return
!         Is_Package_Or_Generic_Package (Scope_Id)
            and then In_Open_Scopes (Scope_Id)
            and then not In_Package_Body (Scope_Id)
            and then not In_Private_Part (Scope_Id);
*************** package body Sem_Util is
*** 3136,3141 ****
--- 3264,3270 ----
     procedure Insert_Explicit_Dereference (N : Node_Id) is
        New_Prefix : constant Node_Id := Relocate_Node (N);
        Ent        : Entity_Id := Empty;
+       Pref       : Node_Id;
        I          : Interp_Index;
        It         : Interp;
        T          : Entity_Id;
*************** package body Sem_Util is
*** 3174,3181 ****
  
           if Is_Entity_Name (New_Prefix) then
              Ent := Entity (New_Prefix);
!          elsif Nkind (New_Prefix) = N_Selected_Component then
!             Ent := Entity (Selector_Name (New_Prefix));
           end if;
  
           if Present (Ent) then
--- 3303,3328 ----
  
           if Is_Entity_Name (New_Prefix) then
              Ent := Entity (New_Prefix);
! 
!          --  For a retrieval of a subcomponent of some composite object,
!          --  retrieve the ultimate entity if there is one.
! 
!          elsif Nkind (New_Prefix) = N_Selected_Component
!            or else Nkind (New_Prefix) = N_Indexed_Component
!          then
!             Pref := Prefix (New_Prefix);
! 
!             while Present (Pref)
!               and then
!                 (Nkind (Pref) = N_Selected_Component
!                   or else Nkind (Pref) = N_Indexed_Component)
!             loop
!                Pref := Prefix (Pref);
!             end loop;
! 
!             if Present (Pref) and then Is_Entity_Name (Pref) then
!                Ent := Entity (Pref);
!             end if;
           end if;
  
           if Present (Ent) then
*************** package body Sem_Util is
*** 3366,3371 ****
--- 3513,3557 ----
        end if;
     end Is_Atomic_Object;
  
+    --------------------------------------
+    -- Is_Controlling_Limited_Procedure --
+    --------------------------------------
+ 
+    function Is_Controlling_Limited_Procedure
+      (Proc_Nam : Entity_Id) return Boolean
+    is
+       Param_Typ : Entity_Id := Empty;
+ 
+    begin
+       if Ekind (Proc_Nam) = E_Procedure
+         and then Present (Parameter_Specifications (Parent (Proc_Nam)))
+       then
+          Param_Typ := Etype (Parameter_Type (First (
+                         Parameter_Specifications (Parent (Proc_Nam)))));
+ 
+       --  In this case where an Itype was created, the procedure call has been
+       --  rewritten.
+ 
+       elsif Present (Associated_Node_For_Itype (Proc_Nam))
+         and then Present (Original_Node (Associated_Node_For_Itype (Proc_Nam)))
+         and then
+           Present (Parameter_Associations
+                      (Associated_Node_For_Itype (Proc_Nam)))
+       then
+          Param_Typ :=
+            Etype (First (Parameter_Associations
+                           (Associated_Node_For_Itype (Proc_Nam))));
+       end if;
+ 
+       if Present (Param_Typ) then
+          return
+            Is_Interface (Param_Typ)
+              and then Is_Limited_Record (Param_Typ);
+       end if;
+ 
+       return False;
+    end Is_Controlling_Limited_Procedure;
+ 
     ----------------------------------------------
     -- Is_Dependent_Component_Of_Mutable_Object --
     ----------------------------------------------
*************** package body Sem_Util is
*** 3378,3435 ****
        P_Aliased   : Boolean := False;
        Comp        : Entity_Id;
  
-       function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean;
-       --  Returns True if and only if Comp has a constrained subtype
-       --  that depends on a discriminant.
- 
        function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
        --  Returns True if and only if Comp is declared within a variant part
  
-       ------------------------------
-       -- Has_Dependent_Constraint --
-       ------------------------------
- 
-       function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is
-          Comp_Decl  : constant Node_Id := Parent (Comp);
-          Subt_Indic : constant Node_Id :=
-                         Subtype_Indication (Component_Definition (Comp_Decl));
-          Constr     : Node_Id;
-          Assn       : Node_Id;
- 
-       begin
-          if Nkind (Subt_Indic) = N_Subtype_Indication then
-             Constr := Constraint (Subt_Indic);
- 
-             if Nkind (Constr) = N_Index_Or_Discriminant_Constraint then
-                Assn := First (Constraints (Constr));
-                while Present (Assn) loop
-                   case Nkind (Assn) is
-                      when N_Subtype_Indication |
-                           N_Range              |
-                           N_Identifier
-                      =>
-                         if Depends_On_Discriminant (Assn) then
-                            return True;
-                         end if;
- 
-                      when N_Discriminant_Association =>
-                         if Depends_On_Discriminant (Expression (Assn)) then
-                            return True;
-                         end if;
- 
-                      when others =>
-                         null;
- 
-                   end case;
- 
-                   Next (Assn);
-                end loop;
-             end if;
-          end if;
- 
-          return False;
-       end Has_Dependent_Constraint;
- 
        --------------------------------
        -- Is_Declared_Within_Variant --
        --------------------------------
--- 3564,3572 ----
*************** package body Sem_Util is
*** 3437,3443 ****
        function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean is
           Comp_Decl : constant Node_Id   := Parent (Comp);
           Comp_List : constant Node_Id   := Parent (Comp_Decl);
- 
        begin
           return Nkind (Parent (Comp_List)) = N_Variant;
        end Is_Declared_Within_Variant;
--- 3574,3579 ----
*************** package body Sem_Util is
*** 3478,3485 ****
  
              end if;
  
              if Is_Access_Type (Prefix_Type)
!               or else Nkind (P) = N_Explicit_Dereference
              then
                 return False;
              end if;
--- 3614,3634 ----
  
              end if;
  
+             --  A heap object is constrained by its initial value
+ 
+             --  Ada 2005 AI-363:if the designated type is a type with a
+             --  constrained partial view, the resulting heap object is not
+             --  constrained, and a renaming of the component is now unsafe.
+ 
              if Is_Access_Type (Prefix_Type)
!               and then
!                  not Has_Constrained_Partial_View
!                    (Designated_Type (Prefix_Type))
!             then
!                return False;
! 
!             elsif Nkind (P) = N_Explicit_Dereference
!               and then not Has_Constrained_Partial_View (Prefix_Type)
              then
                 return False;
              end if;
*************** package body Sem_Util is
*** 3498,3504 ****
                              and then In_Package_Body (Current_Scope)))
  
                and then (Is_Declared_Within_Variant (Comp)
!                           or else Has_Dependent_Constraint (Comp))
                and then not P_Aliased
              then
                 return True;
--- 3647,3653 ----
                              and then In_Package_Body (Current_Scope)))
  
                and then (Is_Declared_Within_Variant (Comp)
!                           or else Has_Discriminant_Dependent_Constraint (Comp))
                and then not P_Aliased
              then
                 return True;
*************** package body Sem_Util is
*** 3532,3538 ****
  
     function Is_Dereferenced (N : Node_Id) return Boolean is
        P : constant Node_Id := Parent (N);
- 
     begin
        return
           (Nkind (P) = N_Selected_Component
--- 3681,3686 ----
*************** package body Sem_Util is
*** 3642,3648 ****
        S : constant Ureal := Small_Value (T);
        M : Urealp.Save_Mark;
        R : Boolean;
- 
     begin
        M := Urealp.Mark;
        R := (U = UR_Trunc (U / S) * S);
--- 3790,3795 ----
*************** package body Sem_Util is
*** 3916,3922 ****
  
     function Is_Inherited_Operation (E : Entity_Id) return Boolean is
        Kind : constant Node_Kind := Nkind (Parent (E));
- 
     begin
        pragma Assert (Is_Overloadable (E));
        return Kind = N_Full_Type_Declaration
--- 4063,4068 ----
*************** package body Sem_Util is
*** 3959,3972 ****
           declare
              Ent : constant Entity_Id := Entity (Expr);
              Sub : constant Entity_Id := Enclosing_Subprogram (Ent);
- 
           begin
              if Ekind (Ent) /= E_Variable
                   and then
                 Ekind (Ent) /= E_In_Out_Parameter
              then
                 return False;
- 
              else
                 return Present (Sub) and then Sub = Current_Subprogram;
              end if;
--- 4105,4116 ----
*************** package body Sem_Util is
*** 4040,4051 ****
        else
           case Nkind (N) is
              when N_Indexed_Component | N_Slice =>
!                return Is_Object_Reference (Prefix (N));
  
!             --  In Ada95, a function call is a constant object
  
              when N_Function_Call =>
!                return True;
  
              --  A reference to the stream attribute Input is a function call
  
--- 4184,4198 ----
        else
           case Nkind (N) is
              when N_Indexed_Component | N_Slice =>
!                return
!                  Is_Object_Reference (Prefix (N))
!                    or else Is_Access_Type (Etype (Prefix (N)));
  
!             --  In Ada95, a function call is a constant object; a procedure
!             --  call is not.
  
              when N_Function_Call =>
!                return Etype (N) /= Standard_Void_Type;
  
              --  A reference to the stream attribute Input is a function call
  
*************** package body Sem_Util is
*** 4055,4061 ****
              when N_Selected_Component =>
                 return
                   Is_Object_Reference (Selector_Name (N))
!                    and then Is_Object_Reference (Prefix (N));
  
              when N_Explicit_Dereference =>
                 return True;
--- 4202,4210 ----
              when N_Selected_Component =>
                 return
                   Is_Object_Reference (Selector_Name (N))
!                    and then
!                      (Is_Object_Reference (Prefix (N))
!                         or else Is_Access_Type (Etype (Prefix (N))));
  
              when N_Explicit_Dereference =>
                 return True;
*************** package body Sem_Util is
*** 4102,4111 ****
           return True;
  
        --  Unchecked conversions are allowed only if they come from the
!       --  generated code, which sometimes uses unchecked conversions for
!       --  out parameters in cases where code generation is unaffected.
!       --  We tell source unchecked conversions by seeing if they are
!       --  rewrites of an original UC function call, or of an explicit
        --  conversion of a function call.
  
        elsif Nkind (AV) = N_Unchecked_Type_Conversion then
--- 4251,4260 ----
           return True;
  
        --  Unchecked conversions are allowed only if they come from the
!       --  generated code, which sometimes uses unchecked conversions for out
!       --  parameters in cases where code generation is unaffected. We tell
!       --  source unchecked conversions by seeing if they are rewrites of an
!       --  original Unchecked_Conversion function call, or of an explicit
        --  conversion of a function call.
  
        elsif Nkind (AV) = N_Unchecked_Type_Conversion then
*************** package body Sem_Util is
*** 4267,4273 ****
        elsif Is_Private_Type (Typ) then
           declare
              U : constant Entity_Id := Underlying_Type (Typ);
- 
           begin
              if No (U) then
                 return True;
--- 4416,4421 ----
*************** package body Sem_Util is
*** 4283,4288 ****
--- 4431,4500 ----
        end if;
     end Is_Partially_Initialized_Type;
  
+    ------------------------------------
+    -- Is_Potentially_Persistent_Type --
+    ------------------------------------
+ 
+    function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean is
+       Comp : Entity_Id;
+       Indx : Node_Id;
+ 
+    begin
+       --  For private type, test corrresponding full type
+ 
+       if Is_Private_Type (T) then
+          return Is_Potentially_Persistent_Type (Full_View (T));
+ 
+       --  Scalar types are potentially persistent
+ 
+       elsif Is_Scalar_Type (T) then
+          return True;
+ 
+       --  Record type is potentially persistent if not tagged and the types of
+       --  all it components are potentially persistent, and no component has
+       --  an initialization expression.
+ 
+       elsif Is_Record_Type (T)
+         and then not Is_Tagged_Type (T)
+         and then not Is_Partially_Initialized_Type (T)
+       then
+          Comp := First_Component (T);
+          while Present (Comp) loop
+             if not Is_Potentially_Persistent_Type (Etype (Comp)) then
+                return False;
+             else
+                Next_Entity (Comp);
+             end if;
+          end loop;
+ 
+          return True;
+ 
+       --  Array type is potentially persistent if its component type is
+       --  potentially persistent and if all its constraints are static.
+ 
+       elsif Is_Array_Type (T) then
+          if not Is_Potentially_Persistent_Type (Component_Type (T)) then
+             return False;
+          end if;
+ 
+          Indx := First_Index (T);
+          while Present (Indx) loop
+             if not Is_OK_Static_Subtype (Etype (Indx)) then
+                return False;
+             else
+                Next_Index (Indx);
+             end if;
+          end loop;
+ 
+          return True;
+ 
+       --  All other types are not potentially persistent
+ 
+       else
+          return False;
+       end if;
+    end Is_Potentially_Persistent_Type;
+ 
     -----------------------------
     -- Is_RCI_Pkg_Spec_Or_Body --
     -----------------------------
*************** package body Sem_Util is
*** 4303,4308 ****
--- 4515,4521 ----
           if Nkind (The_Unit) /= N_Package_Declaration then
              return False;
           end if;
+ 
           return Is_Remote_Call_Interface (Defining_Entity (The_Unit));
        end Is_RCI_Pkg_Decl_Cunit;
  
*************** package body Sem_Util is
*** 4325,4332 ****
        D : Entity_Id;
  
        function Comes_From_Limited_Private_Type_Declaration
!         (E    : Entity_Id)
!          return Boolean;
        --  Check that the type is declared by a limited type declaration,
        --  or else is derived from a Remote_Type ancestor through private
        --  extensions.
--- 4538,4544 ----
        D : Entity_Id;
  
        function Comes_From_Limited_Private_Type_Declaration
!         (E : Entity_Id) return Boolean;
        --  Check that the type is declared by a limited type declaration,
        --  or else is derived from a Remote_Type ancestor through private
        --  extensions.
*************** package body Sem_Util is
*** 4335,4344 ****
        -- Comes_From_Limited_Private_Type_Declaration --
        -------------------------------------------------
  
!       function Comes_From_Limited_Private_Type_Declaration (E : in Entity_Id)
!         return Boolean
        is
           N : constant Node_Id := Declaration_Node (E);
        begin
           if Nkind (N) = N_Private_Type_Declaration
             and then Limited_Present (N)
--- 4547,4557 ----
        -- Comes_From_Limited_Private_Type_Declaration --
        -------------------------------------------------
  
!       function Comes_From_Limited_Private_Type_Declaration
!         (E : Entity_Id) return Boolean
        is
           N : constant Node_Id := Declaration_Node (E);
+ 
        begin
           if Nkind (N) = N_Private_Type_Declaration
             and then Limited_Present (N)
*************** package body Sem_Util is
*** 4415,4421 ****
  
        elsif Nkind (Name (N)) = N_Explicit_Dereference
          and then Is_Remote_Access_To_Subprogram_Type
!           (Etype (Prefix (Name (N))))
        then
           --  The dereference of a RAS is a remote call
  
--- 4628,4634 ----
  
        elsif Nkind (Name (N)) = N_Explicit_Dereference
          and then Is_Remote_Access_To_Subprogram_Type
!                    (Etype (Prefix (Name (N))))
        then
           --  The dereference of a RAS is a remote call
  
*************** package body Sem_Util is
*** 4437,4453 ****
     end Is_Remote_Call;
  
     ----------------------
     -- Is_Selector_Name --
     ----------------------
  
     function Is_Selector_Name (N : Node_Id) return Boolean is
- 
     begin
        if not Is_List_Member (N) then
           declare
              P : constant Node_Id   := Parent (N);
              K : constant Node_Kind := Nkind (P);
- 
           begin
              return
                (K = N_Expanded_Name          or else
--- 4650,4716 ----
     end Is_Remote_Call;
  
     ----------------------
+    -- Is_Renamed_Entry --
+    ----------------------
+ 
+    function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean is
+       Orig_Node : Node_Id := Empty;
+       Subp_Decl : Node_Id := Parent (Parent (Proc_Nam));
+ 
+       function Is_Entry (Nam : Node_Id) return Boolean;
+       --  Determine whether Nam is an entry. Traverse selectors
+       --  if there are nested selected components.
+ 
+       --------------
+       -- Is_Entry --
+       --------------
+ 
+       function Is_Entry (Nam : Node_Id) return Boolean is
+       begin
+          if Nkind (Nam) = N_Selected_Component then
+             return Is_Entry (Selector_Name (Nam));
+          end if;
+ 
+          return Ekind (Entity (Nam)) = E_Entry;
+       end Is_Entry;
+ 
+    --  Start of processing for Is_Renamed_Entry
+ 
+    begin
+       if Present (Alias (Proc_Nam)) then
+          Subp_Decl := Parent (Parent (Alias (Proc_Nam)));
+       end if;
+ 
+       --  Look for a rewritten subprogram renaming declaration
+ 
+       if Nkind (Subp_Decl) = N_Subprogram_Declaration
+         and then Present (Original_Node (Subp_Decl))
+       then
+          Orig_Node := Original_Node (Subp_Decl);
+       end if;
+ 
+       --  The rewritten subprogram is actually an entry
+ 
+       if Present (Orig_Node)
+         and then Nkind (Orig_Node) = N_Subprogram_Renaming_Declaration
+         and then Is_Entry (Name (Orig_Node))
+       then
+          return True;
+       end if;
+ 
+       return False;
+    end Is_Renamed_Entry;
+ 
+    ----------------------
     -- Is_Selector_Name --
     ----------------------
  
     function Is_Selector_Name (N : Node_Id) return Boolean is
     begin
        if not Is_List_Member (N) then
           declare
              P : constant Node_Id   := Parent (N);
              K : constant Node_Kind := Nkind (P);
           begin
              return
                (K = N_Expanded_Name          or else
*************** package body Sem_Util is
*** 4461,4467 ****
           declare
              L : constant List_Id := List_Containing (N);
              P : constant Node_Id := Parent (L);
- 
           begin
              return (Nkind (P) = N_Discriminant_Association
                       and then Selector_Names (P) = L)
--- 4724,4729 ----
*************** package body Sem_Util is
*** 4566,4574 ****
              return False;
           else
              S := Current_Scope;
- 
              while Present (S) and then S /= Prot loop
- 
                 if Ekind (S) = E_Function
                   and then Scope (S) = Prot
                 then
--- 4828,4834 ----
*************** package body Sem_Util is
*** 4629,4634 ****
--- 4889,4899 ----
        then
           return Is_Variable_Prefix (Original_Node (Prefix (N)));
  
+       --  A function call is never a variable
+ 
+       elsif Nkind (N) = N_Function_Call then
+          return False;
+ 
        --  All remaining checks use the original node
  
        elsif Is_Entity_Name (Orig_Node) then
*************** package body Sem_Util is
*** 4667,4673 ****
              when N_Explicit_Dereference =>
                 declare
                    Typ : constant Entity_Id := Etype (Prefix (Orig_Node));
- 
                 begin
                    return Is_Access_Type (Typ)
                      and then not Is_Access_Constant (Root_Type (Typ))
--- 4932,4937 ----
*************** package body Sem_Util is
*** 5277,5282 ****
--- 5541,5553 ----
           if Is_Entity_Name (Exp) then
              Ent := Entity (Exp);
  
+             --  If the entity is missing, it is an undeclared identifier,
+             --  and there is nothing to annotate.
+ 
+             if No (Ent) then
+                return;
+             end if;
+ 
           elsif Nkind (Exp) = N_Explicit_Dereference then
              declare
                 P : constant Node_Id := Prefix (Exp);
*************** package body Sem_Util is
*** 5883,5889 ****
              begin
                 Comp := First_Entity (Typ);
                 while Present (Comp) loop
!                   if Requires_Transient_Scope (Etype (Comp)) then
                       return True;
                    else
                       Next_Entity (Comp);
--- 6154,6162 ----
              begin
                 Comp := First_Entity (Typ);
                 while Present (Comp) loop
!                   if Ekind (Comp) = E_Component
!                      and then Requires_Transient_Scope (Etype (Comp))
!                   then
                       return True;
                    else
                       Next_Entity (Comp);
*************** package body Sem_Util is
*** 5986,5993 ****
  
        --  Skip volatile and aliased variables, since funny things might
        --  be going on in these cases which we cannot necessarily track.
  
!       if Treat_As_Volatile (Ent) or else Is_Aliased (Ent) then
           return False;
        end if;
  
--- 6259,6272 ----
  
        --  Skip volatile and aliased variables, since funny things might
        --  be going on in these cases which we cannot necessarily track.
+       --  Also skip any variable for which an address clause is given.
  
!       --  Should we have a flag Has_Address_Clause ???
! 
!       if Treat_As_Volatile (Ent)
!         or else Is_Aliased (Ent)
!         or else Present (Address_Clause (Ent))
!       then
           return False;
        end if;
  
*************** package body Sem_Util is
*** 6020,6047 ****
        --  or an exception handler).
  
        declare
!          P : Node_Id;
  
        begin
!          P := Parent (N);
           while Present (P) loop
              if Nkind (P) = N_If_Statement
!                  or else
!                Nkind (P) = N_Case_Statement
!                  or else
!                Nkind (P) = N_Exception_Handler
!                  or else
!                Nkind (P) = N_Selective_Accept
!                  or else
!                Nkind (P) = N_Conditional_Entry_Call
!                  or else
!                Nkind (P) = N_Timed_Entry_Call
!                  or else
!                Nkind (P) = N_Asynchronous_Select
              then
                 return False;
              else
!                P := Parent (P);
              end if;
           end loop;
        end;
--- 6299,6325 ----
        --  or an exception handler).
  
        declare
!          Desc : Node_Id;
!          P    : Node_Id;
  
        begin
!          Desc := N;
!          P    := Parent (N);
           while Present (P) loop
              if Nkind (P) = N_If_Statement
!               or else  Nkind (P) = N_Case_Statement
!               or else (Nkind (P) = N_And_Then and then Desc = Right_Opnd (P))
!               or else (Nkind (P) = N_Or_Else and then Desc = Right_Opnd (P))
!               or else  Nkind (P) = N_Exception_Handler
!               or else  Nkind (P) = N_Selective_Accept
!               or else  Nkind (P) = N_Conditional_Entry_Call
!               or else  Nkind (P) = N_Timed_Entry_Call
!               or else  Nkind (P) = N_Asynchronous_Select
              then
                 return False;
              else
!                Desc := P;
!                P    := Parent (P);
              end if;
           end loop;
        end;
*************** package body Sem_Util is
*** 6188,6199 ****
              return;
           end if;
  
-          Val_Actual := Val;
- 
           --  A special situation arises for derived operations, where we want
           --  to do the check against the parent (since the Sloc of the derived
           --  operation points to the derived type declaration itself).
  
           while not Comes_From_Source (Val_Actual)
             and then Nkind (Val_Actual) in N_Entity
             and then (Ekind (Val_Actual) = E_Enumeration_Literal
--- 6466,6476 ----
              return;
           end if;
  
           --  A special situation arises for derived operations, where we want
           --  to do the check against the parent (since the Sloc of the derived
           --  operation points to the derived type declaration itself).
  
+          Val_Actual := Val;
           while not Comes_From_Source (Val_Actual)
             and then Nkind (Val_Actual) in N_Entity
             and then (Ekind (Val_Actual) = E_Enumeration_Literal
*************** package body Sem_Util is
*** 6244,6263 ****
        S : constant Entity_Id := Current_Scope;
  
     begin
!       if S = Standard_Standard
!         or else (Is_Public (S)
!                   and then (Ekind (S) = E_Package
!                              or else Is_Record_Type (S)
!                              or else Ekind (S) = E_Void))
        then
           Set_Is_Public (Id);
  
        --  The bounds of an entry family declaration can generate object
        --  declarations that are visible to the back-end, e.g. in the
        --  the declaration of a composite type that contains tasks.
  
!       elsif Is_Public (S)
!         and then Is_Concurrent_Type (S)
          and then not Has_Completion (S)
          and then Nkind (Parent (Id)) = N_Object_Declaration
        then
--- 6521,6557 ----
        S : constant Entity_Id := Current_Scope;
  
     begin
!       --  Everything in the scope of Standard is public
! 
!       if S = Standard_Standard then
!          Set_Is_Public (Id);
! 
!       --  Entity is definitely not public if enclosing scope is not public
! 
!       elsif not Is_Public (S) then
!          return;
! 
!       --  An object declaration that occurs in a handled sequence of statements
!       --  is the declaration for a temporary object generated by the expander.
!       --  It never needs to be made public and furthermore, making it public
!       --  can cause back end problems if it is of variable size.
! 
!       elsif Nkind (Parent (Id)) = N_Object_Declaration
!         and then
!           Nkind (Parent (Parent (Id))) = N_Handled_Sequence_Of_Statements
        then
+          return;
+ 
+       --  Entities in public packages or records are public
+ 
+       elsif Ekind (S) = E_Package or Is_Record_Type (S) then
           Set_Is_Public (Id);
  
        --  The bounds of an entry family declaration can generate object
        --  declarations that are visible to the back-end, e.g. in the
        --  the declaration of a composite type that contains tasks.
  
!       elsif Is_Concurrent_Type (S)
          and then not Has_Completion (S)
          and then Nkind (Parent (Id)) = N_Object_Declaration
        then
*************** package body Sem_Util is
*** 6334,6340 ****
     function Statically_Different (E1, E2 : Node_Id) return Boolean is
        R1 : constant Node_Id := Get_Referenced_Object (E1);
        R2 : constant Node_Id := Get_Referenced_Object (E2);
- 
     begin
        return     Is_Entity_Name (R1)
          and then Is_Entity_Name (R2)
--- 6628,6633 ----
*************** package body Sem_Util is
*** 6380,6386 ****
     -----------------------
  
     procedure Transfer_Entities (From : Entity_Id; To : Entity_Id) is
!       Ent      : Entity_Id := First_Entity (From);
  
     begin
        if No (Ent) then
--- 6673,6679 ----
     -----------------------
  
     procedure Transfer_Entities (From : Entity_Id; To : Entity_Id) is
!       Ent : Entity_Id := First_Entity (From);
  
     begin
        if No (Ent) then
*************** package body Sem_Util is
*** 6413,6419 ****
  
                 begin
                    Comp := First_Entity (Ent);
- 
                    while Present (Comp) loop
                       Set_Is_Public (Comp);
                       Next_Entity (Comp);
--- 6706,6711 ----
*************** package body Sem_Util is
*** 6446,6455 ****
        --  the level is the same as that of the enclosing component type.
  
        Btyp := Base_Type (Typ);
        if Ekind (Btyp) in Access_Kind then
           if Ekind (Btyp) = E_Anonymous_Access_Type
!            and then not Is_Array_Type (Scope (Btyp))      -- Ada 2005 (AI-230)
!            and then Ekind (Scope (Btyp)) /= E_Record_Type -- Ada 2005 (AI-230)
           then
              return Scope_Depth (Standard_Standard);
           end if;
--- 6738,6747 ----
        --  the level is the same as that of the enclosing component type.
  
        Btyp := Base_Type (Typ);
+ 
        if Ekind (Btyp) in Access_Kind then
           if Ekind (Btyp) = E_Anonymous_Access_Type
!            and then not Is_Local_Anonymous_Access (Typ) -- Ada 2005 (AI-230)
           then
              return Scope_Depth (Standard_Standard);
           end if;
*************** package body Sem_Util is
*** 6526,6534 ****
  
        else
           Get_First_Interp (Opnd, Index, It);
- 
           while Present (It.Typ) loop
- 
              if It.Typ = Universal_Integer
                or else It.Typ = Universal_Real
              then
--- 6818,6824 ----
*************** package body Sem_Util is
*** 6571,6580 ****
        Expec_Type : constant Entity_Id := First_Subtype (Expected_Type);
  
        function Has_One_Matching_Field return Boolean;
!       --  Determines whether Expec_Type is a record type with a single
!       --  component or discriminant whose type matches the found type or
!       --  is a one dimensional array whose component type matches the
!       --  found type.
  
        function Has_One_Matching_Field return Boolean is
           E : Entity_Id;
--- 6861,6873 ----
        Expec_Type : constant Entity_Id := First_Subtype (Expected_Type);
  
        function Has_One_Matching_Field return Boolean;
!       --  Determines if Expec_Type is a record type with a single component or
!       --  discriminant whose type matches the found type or is one dimensional
!       --  array whose component type matches the found type.
! 
!       ----------------------------
!       -- Has_One_Matching_Field --
!       ----------------------------
  
        function Has_One_Matching_Field return Boolean is
           E : Entity_Id;
*************** package body Sem_Util is
*** 6592,6598 ****
  
           else
              E := First_Entity (Expec_Type);
- 
              loop
                 if No (E) then
                    return False;
--- 6885,6890 ----
*************** package body Sem_Util is
*** 6738,6756 ****
                 Found_Scope := Scope (Found_Scope);
  
                 exit when Expec_Scope = Standard_Standard
!                            or else
!                          Found_Scope = Standard_Standard
!                            or else
!                          not Comes_From_Source (Expec_Scope)
!                            or else
!                          not Comes_From_Source (Found_Scope);
              end loop;
           end;
  
!          Error_Msg_NE ("expected}!", Expr, Expec_Type);
  
           if Is_Entity_Name (Expr)
!            and then Is_Package (Entity (Expr))
           then
              Error_Msg_N ("found package name!", Expr);
  
--- 7030,7052 ----
                 Found_Scope := Scope (Found_Scope);
  
                 exit when Expec_Scope = Standard_Standard
!                  or else Found_Scope = Standard_Standard
!                  or else not Comes_From_Source (Expec_Scope)
!                  or else not Comes_From_Source (Found_Scope);
              end loop;
           end;
  
!          if Is_Record_Type (Expec_Type)
!            and then Present (Corresponding_Remote_Type (Expec_Type))
!          then
!             Error_Msg_NE ("expected}!", Expr,
!                           Corresponding_Remote_Type (Expec_Type));
!          else
!             Error_Msg_NE ("expected}!", Expr, Expec_Type);
!          end if;
  
           if Is_Entity_Name (Expr)
!            and then Is_Package_Or_Generic_Package (Entity (Expr))
           then
              Error_Msg_N ("found package name!", Expr);
  
*************** package body Sem_Util is
*** 6773,6781 ****
             and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
             and then No (Parameter_Associations (Expr))
           then
!                Error_Msg_N
!                  ("found function name, possibly missing Access attribute!",
!                    Expr);
  
           --  Catch common error: a prefix or infix operator which is not
           --  directly visible because the type isn't.
--- 7069,7077 ----
             and then Etype (Designated_Type (Expec_Type)) = Etype (Expr)
             and then No (Parameter_Associations (Expr))
           then
!             Error_Msg_N
!               ("found function name, possibly missing Access attribute!",
!                Expr);
  
           --  Catch common error: a prefix or infix operator which is not
           --  directly visible because the type isn't.
*************** package body Sem_Util is
*** 6787,6794 ****
              and then not In_Use (Expec_Type)
              and then Has_Compatible_Type (Right_Opnd (Expr), Expec_Type)
           then
!             Error_Msg_N (
!               "operator of the type is not directly visible!", Expr);
  
           elsif Ekind (Found_Type) = E_Void
             and then Present (Parent (Found_Type))
--- 7083,7090 ----
              and then not In_Use (Expec_Type)
              and then Has_Compatible_Type (Right_Opnd (Expr), Expec_Type)
           then
!             Error_Msg_N
!               ("operator of the type is not directly visible!", Expr);
  
           elsif Ekind (Found_Type) = E_Void
             and then Present (Parent (Found_Type))
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_util.ads gcc-4.1.0/gcc/ada/sem_util.ads
*** gcc-4.0.2/gcc/ada/sem_util.ads	Fri Nov 19 10:56:15 2004
--- gcc-4.1.0/gcc/ada/sem_util.ads	Tue Nov 15 14:04:10 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sem_Util is
*** 108,113 ****
--- 108,119 ----
     --  place error message on node N. Used in  object declarations, type
     --  conversions, qualified expressions.
  
+    procedure Check_Obsolescent (Nam : Entity_Id; N : Node_Id);
+    --  Nam is either a subprogram or a (generic) package entity. This procedure
+    --  checks if the Is_Obsolescent flag is set and if so, outputs appropriate
+    --  diagnostics (it also checks the appropriate restriction). N is the node
+    --  to which error messages are attached.
+ 
     procedure Check_Potentially_Blocking_Operation (N : Node_Id);
     --  N is one of the statement forms that is a potentially blocking
     --  operation. If it appears within a protected action, emit warning.
*************** package Sem_Util is
*** 370,375 ****
--- 376,386 ----
     function Has_Declarations (N : Node_Id) return Boolean;
     --  Determines if the node can have declarations
  
+    function Has_Discriminant_Dependent_Constraint
+      (Comp : Entity_Id) return Boolean;
+    --  Returns True if and only if Comp has a constrained subtype
+    --  that depends on a discriminant.
+ 
     function Has_Infinities (E : Entity_Id) return Boolean;
     --  Determines if the range of the floating-point type E includes
     --  infinities. Returns False if E is not a floating-point type.
*************** package Sem_Util is
*** 391,397 ****
     --  to check if '=' has to be expanded into a bunch component comparaisons.
  
     function In_Instance return Boolean;
!    --  Returns True if the current scope is within a generic instance.
  
     function In_Instance_Body return Boolean;
     --  Returns True if current scope is within the body of an instance, where
--- 402,408 ----
     --  to check if '=' has to be expanded into a bunch component comparaisons.
  
     function In_Instance return Boolean;
!    --  Returns True if the current scope is within a generic instance
  
     function In_Instance_Body return Boolean;
     --  Returns True if current scope is within the body of an instance, where
*************** package Sem_Util is
*** 436,442 ****
     --  synthesized attribute.
  
     function Is_Actual_Parameter (N : Node_Id) return Boolean;
!    --  Determines if N is an actual parameter in a subprogram call.
  
     function Is_Aliased_View (Obj : Node_Id) return Boolean;
     --  Determine if Obj is an aliased view, i.e. the name of an
--- 447,453 ----
     --  synthesized attribute.
  
     function Is_Actual_Parameter (N : Node_Id) return Boolean;
!    --  Determines if N is an actual parameter in a subprogram call
  
     function Is_Aliased_View (Obj : Node_Id) return Boolean;
     --  Determine if Obj is an aliased view, i.e. the name of an
*************** package Sem_Util is
*** 451,456 ****
--- 462,472 ----
     --  Determines if the given node denotes an atomic object in the sense
     --  of the legality checks described in RM C.6(12).
  
+    function Is_Controlling_Limited_Procedure
+      (Proc_Nam : Entity_Id) return Boolean;
+    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure
+    --  of a limited interface with a controlling first parameter.
+ 
     function Is_Dependent_Component_Of_Mutable_Object
       (Object : Node_Id) return Boolean;
     --  Returns True if Object is the name of a subcomponent that
*************** package Sem_Util is
*** 534,539 ****
--- 550,563 ----
     --  one field has an initialization expression). Note that initialization
     --  resulting from the use of pragma Normalized_Scalars does not count.
  
+    function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean;
+    --  Determines if type T is a potentially persistent type. A potentially
+    --  persistent type is defined (recursively) as a scalar type, a non-tagged
+    --  record whose components are all of a potentially persistent type, or an
+    --  array with all static constraints whose component type is potentially
+    --  persistent. A private type is potentially persistent if the full type
+    --  is potentially persistent.
+ 
     function Is_RCI_Pkg_Spec_Or_Body (Cunit : Node_Id) return Boolean;
     --  Return True if a compilation unit is the specification or the
     --  body of a remote call interface package.
*************** package Sem_Util is
*** 542,552 ****
     --  Return True if E is a remote access-to-class-wide-limited_private type
  
     function Is_Remote_Access_To_Subprogram_Type (E : Entity_Id) return Boolean;
!    --  Return True if E is a remote access to subprogram type.
  
     function Is_Remote_Call (N : Node_Id) return Boolean;
     --  Return True if N denotes a potentially remote call
  
     function Is_Selector_Name (N : Node_Id) return Boolean;
     --  Given an N_Identifier node N, determines if it is a Selector_Name.
     --  As described in Sinfo, Selector_Names are special because they
--- 566,579 ----
     --  Return True if E is a remote access-to-class-wide-limited_private type
  
     function Is_Remote_Access_To_Subprogram_Type (E : Entity_Id) return Boolean;
!    --  Return True if E is a remote access to subprogram type
  
     function Is_Remote_Call (N : Node_Id) return Boolean;
     --  Return True if N denotes a potentially remote call
  
+    function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean;
+    --  Return True if Proc_Nam is a procedure renaming of an entry
+ 
     function Is_Selector_Name (N : Node_Id) return Boolean;
     --  Given an N_Identifier node N, determines if it is a Selector_Name.
     --  As described in Sinfo, Selector_Names are special because they
*************** package Sem_Util is
*** 642,648 ****
     --  the call order, so this does not correspond to simply taking the
     --  next entry of the Parameter_Associations list. The argument is an
     --  actual previously returned by a call to First_Actual or Next_Actual.
!    --  Note tha the result produced is always an expression, not a parameter
     --  assciation node, even if named notation was used.
  
     procedure Normalize_Actuals
--- 669,675 ----
     --  the call order, so this does not correspond to simply taking the
     --  next entry of the Parameter_Associations list. The argument is an
     --  actual previously returned by a call to First_Actual or Next_Actual.
!    --  Note that the result produced is always an expression, not a parameter
     --  assciation node, even if named notation was used.
  
     procedure Normalize_Actuals
*************** package Sem_Util is
*** 722,729 ****
  
     function Safe_To_Capture_Value
       (N    : Node_Id;
!       Ent  : Entity_Id)
!       return Boolean;
     --  The caller is interested in capturing a value (either the current
     --  value, or an indication that the value is non-null) for the given
     --  entity Ent. This value can only be captured if sequential execution
--- 749,755 ----
  
     function Safe_To_Capture_Value
       (N    : Node_Id;
!       Ent  : Entity_Id) return Boolean;
     --  The caller is interested in capturing a value (either the current
     --  value, or an indication that the value is non-null) for the given
     --  entity Ent. This value can only be captured if sequential execution
*************** package Sem_Util is
*** 783,797 ****
     --  Set the flag Is_Transient of the current scope
  
     procedure Set_Size_Info (T1, T2 : Entity_Id);
!    --  Copies the Esize field and Has_Biased_Representation flag from
!    --  (sub)type entity T2 to (sub)type entity T1. Also copies the
!    --  Is_Unsigned_Type flag in the fixed-point and discrete cases,
!    --  and also copies the alignment value from T2 to T1. It does NOT
!    --  copy the RM_Size field, which must be separately set if this
!    --  is required to be copied also.
  
     function Scope_Is_Transient  return Boolean;
!    --  True if the current scope is transient.
  
     function Static_Integer (N : Node_Id) return Uint;
     --  This function analyzes the given expression node and then resolves it
--- 809,822 ----
     --  Set the flag Is_Transient of the current scope
  
     procedure Set_Size_Info (T1, T2 : Entity_Id);
!    --  Copies the Esize field and Has_Biased_Representation flag from sub(type)
!    --  entity T2 to (sub)type entity T1. Also copies the Is_Unsigned_Type flag
!    --  in the fixed-point and discrete cases, and also copies the alignment
!    --  value from T2 to T1. It does NOT copy the RM_Size field, which must be
!    --  separately set if this is required to be copied also.
  
     function Scope_Is_Transient  return Boolean;
!    --  True if the current scope is transient
  
     function Static_Integer (N : Node_Id) return Uint;
     --  This function analyzes the given expression node and then resolves it
*************** package Sem_Util is
*** 804,813 ****
     --  E1 and E2 refer to different objects
  
     function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
!    --  Return the accessibility level of the view denoted by Subp.
  
     procedure Trace_Scope (N : Node_Id; E : Entity_Id; Msg : String);
!    --  Print debugging information on entry to each unit being analyzed.
  
     procedure Transfer_Entities (From : Entity_Id; To : Entity_Id);
     --  Move a list of entities from one scope to another, and recompute
--- 829,838 ----
     --  E1 and E2 refer to different objects
  
     function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
!    --  Return the accessibility level of the view denoted by Subp
  
     procedure Trace_Scope (N : Node_Id; E : Entity_Id; Msg : String);
!    --  Print debugging information on entry to each unit being analyzed
  
     procedure Transfer_Entities (From : Entity_Id; To : Entity_Id);
     --  Move a list of entities from one scope to another, and recompute
*************** package Sem_Util is
*** 817,830 ****
     --  Return the accessibility level of Typ
  
     function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
!    --  Unit_Id is the simple name of a program unit, this function returns
!    --  the corresponding xxx_Declaration node for the entity. Also applies
!    --  to the body entities for subprograms, tasks and protected units, in
!    --  which case it returns the subprogram, task or protected body node
!    --  for it. The unit may be a child unit with any number of ancestors.
  
     function Universal_Interpretation (Opnd : Node_Id) return Entity_Id;
!    --  Yields universal_Integer or Universal_Real if this is a candidate.
  
     function Within_Init_Proc return Boolean;
     --  Determines if Current_Scope is within an init proc
--- 842,855 ----
     --  Return the accessibility level of Typ
  
     function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
!    --  Unit_Id is the simple name of a program unit, this function returns the
!    --  corresponding xxx_Declaration node for the entity. Also applies to the
!    --  body entities for subprograms, tasks and protected units, in which case
!    --  it returns the subprogram, task or protected body node for it. The unit
!    --  may be a child unit with any number of ancestors.
  
     function Universal_Interpretation (Opnd : Node_Id) return Entity_Id;
!    --  Yields universal_Integer or Universal_Real if this is a candidate
  
     function Within_Init_Proc return Boolean;
     --  Determines if Current_Scope is within an init proc
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_vfpt.adb gcc-4.1.0/gcc/ada/sem_vfpt.adb
*** gcc-4.0.2/gcc/ada/sem_vfpt.adb	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sem_vfpt.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_vfpt.ads gcc-4.1.0/gcc/ada/sem_vfpt.ads
*** gcc-4.0.2/gcc/ada/sem_vfpt.ads	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sem_vfpt.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_warn.adb gcc-4.1.0/gcc/ada/sem_warn.adb
*** gcc-4.0.2/gcc/ada/sem_warn.adb	Wed Dec  8 11:26:46 2004
--- gcc-4.1.0/gcc/ada/sem_warn.adb	Tue Nov 15 14:04:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sem_Warn is
*** 294,300 ****
                        or else List_Containing (Prev)
                          /= Generic_Formal_Declarations (P);
  
!                --  if we reach a subprogram body, entity is not referenceable
                 --  unless it is the defining entity of the body. This will
                 --  happen, e.g. when a function is an attribute renaming that
                 --  is rewritten as a body.
--- 294,313 ----
                        or else List_Containing (Prev)
                          /= Generic_Formal_Declarations (P);
  
!                --  Similarly, the generic formals of a generic subprogram
!                --  are not accessible.
! 
!                when N_Generic_Subprogram_Declaration  =>
!                   if Is_List_Member (Prev)
!                     and then List_Containing (Prev) =
!                                Generic_Formal_Declarations (P)
!                   then
!                      return False;
!                   else
!                      P := Parent (P);
!                   end if;
! 
!                --  If we reach a subprogram body, entity is not referenceable
                 --  unless it is the defining entity of the body. This will
                 --  happen, e.g. when a function is an attribute renaming that
                 --  is rewritten as a body.
*************** package body Sem_Warn is
*** 451,458 ****
                   and then Is_True_Constant (E1)
                   and then not Generic_Package_Spec_Entity (E1)
                 then
!                   Error_Msg_N
!                     ("& is not modified, could be declared constant?", E1);
                 end if;
  
                 --  Check for unset reference, note that we exclude access
--- 464,483 ----
                   and then Is_True_Constant (E1)
                   and then not Generic_Package_Spec_Entity (E1)
                 then
!                   --  A special case, if this variable is volatile and not
!                   --  imported, it is not helpful to tell the programmer
!                   --  to mark the variable as constant, since this would be
!                   --  illegal by virtue of RM C.6(13).
! 
!                   if (Is_Volatile (E1) or else Has_Volatile_Components (E1))
!                     and then not Is_Imported (E1)
!                   then
!                      Error_Msg_N
!                        ("& is not modified, volatile has no effect?", E1);
!                   else
!                      Error_Msg_N
!                        ("& is not modified, could be declared constant?", E1);
!                   end if;
                 end if;
  
                 --  Check for unset reference, note that we exclude access
*************** package body Sem_Warn is
*** 1565,1570 ****
--- 1590,1781 ----
        end loop;
     end Output_Unreferenced_Messages;
  
+    ------------------------
+    -- Set_Warning_Switch --
+    ------------------------
+ 
+    function Set_Warning_Switch (C : Character) return Boolean is
+    begin
+       case C is
+          when 'a' =>
+             Check_Unreferenced              := True;
+             Check_Unreferenced_Formals      := True;
+             Check_Withs                     := True;
+             Constant_Condition_Warnings     := True;
+             Implementation_Unit_Warnings    := True;
+             Ineffective_Inline_Warnings     := True;
+             Warn_On_Ada_2005_Compatibility  := True;
+             Warn_On_Bad_Fixed_Value         := True;
+             Warn_On_Constant                := True;
+             Warn_On_Export_Import           := True;
+             Warn_On_Modified_Unread         := True;
+             Warn_On_No_Value_Assigned       := True;
+             Warn_On_Obsolescent_Feature     := True;
+             Warn_On_Redundant_Constructs    := True;
+             Warn_On_Unchecked_Conversion    := True;
+             Warn_On_Unrecognized_Pragma     := True;
+ 
+          when 'A' =>
+             Check_Unreferenced              := False;
+             Check_Unreferenced_Formals      := False;
+             Check_Withs                     := False;
+             Constant_Condition_Warnings     := False;
+             Elab_Warnings                   := False;
+             Implementation_Unit_Warnings    := False;
+             Ineffective_Inline_Warnings     := False;
+             Warn_On_Ada_2005_Compatibility  := False;
+             Warn_On_Bad_Fixed_Value         := False;
+             Warn_On_Constant                := False;
+             Warn_On_Dereference             := False;
+             Warn_On_Export_Import           := False;
+             Warn_On_Hiding                  := False;
+             Warn_On_Modified_Unread         := False;
+             Warn_On_No_Value_Assigned       := False;
+             Warn_On_Obsolescent_Feature     := False;
+             Warn_On_Redundant_Constructs    := False;
+             Warn_On_Unchecked_Conversion    := False;
+             Warn_On_Unrecognized_Pragma     := False;
+ 
+          when 'b' =>
+             Warn_On_Bad_Fixed_Value         := True;
+ 
+          when 'B' =>
+             Warn_On_Bad_Fixed_Value         := False;
+ 
+          when 'c' =>
+             Constant_Condition_Warnings     := True;
+ 
+          when 'C' =>
+             Constant_Condition_Warnings     := False;
+ 
+          when 'd' =>
+             Warn_On_Dereference             := True;
+ 
+          when 'D' =>
+             Warn_On_Dereference             := False;
+ 
+          when 'e' =>
+             Warning_Mode                    := Treat_As_Error;
+ 
+          when 'f' =>
+             Check_Unreferenced_Formals      := True;
+ 
+          when 'F' =>
+             Check_Unreferenced_Formals      := False;
+ 
+          when 'g' =>
+             Warn_On_Unrecognized_Pragma     := True;
+ 
+          when 'G' =>
+             Warn_On_Unrecognized_Pragma     := False;
+ 
+          when 'h' =>
+             Warn_On_Hiding                  := True;
+ 
+          when 'H' =>
+             Warn_On_Hiding                  := False;
+ 
+          when 'i' =>
+             Implementation_Unit_Warnings    := True;
+ 
+          when 'I' =>
+             Implementation_Unit_Warnings    := False;
+ 
+          when 'j' =>
+             Warn_On_Obsolescent_Feature     := True;
+ 
+          when 'J' =>
+             Warn_On_Obsolescent_Feature     := False;
+ 
+          when 'k' =>
+             Warn_On_Constant                := True;
+ 
+          when 'K' =>
+             Warn_On_Constant                := False;
+ 
+          when 'l' =>
+             Elab_Warnings                   := True;
+ 
+          when 'L' =>
+             Elab_Warnings                   := False;
+ 
+          when 'm' =>
+             Warn_On_Modified_Unread         := True;
+ 
+          when 'M' =>
+             Warn_On_Modified_Unread         := False;
+ 
+          when 'n' =>
+             Warning_Mode                    := Normal;
+ 
+          when 'o' =>
+             Address_Clause_Overlay_Warnings := True;
+ 
+          when 'O' =>
+             Address_Clause_Overlay_Warnings := False;
+ 
+          when 'p' =>
+             Ineffective_Inline_Warnings     := True;
+ 
+          when 'P' =>
+             Ineffective_Inline_Warnings     := False;
+ 
+          when 'r' =>
+             Warn_On_Redundant_Constructs    := True;
+ 
+          when 'R' =>
+             Warn_On_Redundant_Constructs    := False;
+ 
+          when 's' =>
+             Warning_Mode                    := Suppress;
+ 
+          when 'u' =>
+             Check_Unreferenced              := True;
+             Check_Withs                     := True;
+             Check_Unreferenced_Formals      := True;
+ 
+          when 'U' =>
+             Check_Unreferenced              := False;
+             Check_Withs                     := False;
+             Check_Unreferenced_Formals      := False;
+ 
+          when 'v' =>
+             Warn_On_No_Value_Assigned       := True;
+ 
+          when 'V' =>
+             Warn_On_No_Value_Assigned       := False;
+ 
+          when 'x' =>
+             Warn_On_Export_Import           := True;
+ 
+          when 'X' =>
+             Warn_On_Export_Import           := False;
+ 
+          when 'y' =>
+             Warn_On_Ada_2005_Compatibility  := True;
+ 
+          when 'Y' =>
+             Warn_On_Ada_2005_Compatibility  := False;
+ 
+          when 'z' =>
+             Warn_On_Unchecked_Conversion    := True;
+ 
+          when 'Z' =>
+             Warn_On_Unchecked_Conversion    := False;
+ 
+             --  Allow and ignore 'w' so that the old
+             --  format (e.g. -gnatwuwl) will work.
+ 
+          when 'w' =>
+             null;
+ 
+          when others =>
+             return False;
+       end case;
+ 
+       return True;
+    end Set_Warning_Switch;
+ 
     -----------------------------
     -- Warn_On_Known_Condition --
     -----------------------------
*************** package body Sem_Warn is
*** 1627,1640 ****
           end loop;
  
           --  Here we issue the warning unless some sub-operand has warnings
!          --  set off, in which case we suppress the warning for the node.
  
           if not Operand_Has_Warnings_Suppressed (C) then
!             if Entity (C) = Standard_True then
!                Error_Msg_N ("condition is always True?", C);
!             else
!                Error_Msg_N ("condition is always False?", C);
!             end if;
           end if;
        end if;
     end Warn_On_Known_Condition;
--- 1838,1876 ----
           end loop;
  
           --  Here we issue the warning unless some sub-operand has warnings
!          --  set off, in which case we suppress the warning for the node. If
!          --  the original expression is an inequality, it has been expanded
!          --  into a negation, and the value of the original expression is the
!          --  negation of the equality. If the expression is an entity that
!          --  appears within a negation, it is clearer to flag the negation
!          --  itself, and report on its constant value.
  
           if not Operand_Has_Warnings_Suppressed (C) then
!             declare
!                True_Branch : Boolean := Entity (C) = Standard_True;
!                Cond        : Node_Id := C;
! 
!             begin
!                if Present (Parent (C))
!                  and then Nkind (Parent (C)) = N_Op_Not
!                then
!                   True_Branch := not True_Branch;
!                   Cond        := Parent (C);
!                end if;
! 
!                if True_Branch then
!                   if Is_Entity_Name (Original_Node (C))
!                     and then Nkind (Cond) /= N_Op_Not
!                   then
!                      Error_Msg_NE
!                       ("object & is always True?", Cond, Original_Node (C));
!                   else
!                      Error_Msg_N ("condition is always True?", Cond);
!                   end if;
!                else
!                   Error_Msg_N ("condition is always False?", Cond);
!                end if;
!             end;
           end if;
        end if;
     end Warn_On_Known_Condition;
diff -Nrcpad gcc-4.0.2/gcc/ada/sem_warn.ads gcc-4.1.0/gcc/ada/sem_warn.ads
*** gcc-4.0.2/gcc/ada/sem_warn.ads	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sem_warn.ads	Tue Nov 15 14:04:22 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Types; use Types;
*** 32,37 ****
--- 32,46 ----
  
  package Sem_Warn is
  
+    --------------------
+    -- Initialization --
+    --------------------
+ 
+    function Set_Warning_Switch (C : Character) return Boolean;
+    --  This function sets the warning switch or switches corresponding to
+    --  the given character. It is used for processing a -gnatw switch on the
+    --  command line, or a string literal in pragma Warnings.
+ 
     ------------------------------------------
     -- Routines to Handle Unused References --
     ------------------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/sequenio.ads gcc-4.1.0/gcc/ada/sequenio.ads
*** gcc-4.0.2/gcc/ada/sequenio.ads	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sequenio.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                        S E Q U E N T I A L  _ I O                        --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                        S E Q U E N T I A L  _ I O                        --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/sfn_scan.adb gcc-4.1.0/gcc/ada/sfn_scan.adb
*** gcc-4.0.2/gcc/ada/sfn_scan.adb	Mon Mar 29 12:03:22 2004
--- gcc-4.1.0/gcc/ada/sfn_scan.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/sfn_scan.ads gcc-4.1.0/gcc/ada/sfn_scan.ads
*** gcc-4.0.2/gcc/ada/sfn_scan.ads	Mon Mar 29 12:03:22 2004
--- gcc-4.1.0/gcc/ada/sfn_scan.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2000-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinfo-cn.adb gcc-4.1.0/gcc/ada/sinfo-cn.adb
*** gcc-4.0.2/gcc/ada/sinfo-cn.adb	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sinfo-cn.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinfo-cn.ads gcc-4.1.0/gcc/ada/sinfo-cn.ads
*** gcc-4.0.2/gcc/ada/sinfo-cn.ads	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sinfo-cn.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinfo.adb gcc-4.1.0/gcc/ada/sinfo.adb
*** gcc-4.0.2/gcc/ada/sinfo.adb	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/sinfo.adb	Tue Nov 15 13:56:27 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Sinfo is
*** 175,180 ****
--- 175,189 ----
        return Flag4 (N);
     end Acts_As_Spec;
  
+    function Actual_Designated_Subtype
+      (N : Node_Id) return Node_Id is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Explicit_Dereference
+         or else NT (N).Nkind = N_Free_Statement);
+       return Node2 (N);
+    end Actual_Designated_Subtype;
+ 
     function Aggregate_Bounds
        (N : Node_Id) return Node_Id is
     begin
*************** package body Sinfo is
*** 314,321 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_Association
!         or else NT (N).Nkind = N_Formal_Package_Declaration
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        return Flag15 (N);
     end Box_Present;
  
--- 323,331 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_Association
!         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Package_Declaration);
        return Flag15 (N);
     end Box_Present;
  
*************** package body Sinfo is
*** 628,634 ****
        (N : Node_Id) return Node_Id is
     begin
        pragma Assert (False
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        return Node2 (N);
     end Default_Name;
  
--- 638,645 ----
        (N : Node_Id) return Node_Id is
     begin
        pragma Assert (False
!         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration);
        return Node2 (N);
     end Default_Name;
  
*************** package body Sinfo is
*** 874,879 ****
--- 885,898 ----
        return Flag13 (N);
     end Do_Tag_Check;
  
+    function Elaborate_All_Desirable
+       (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_With_Clause);
+       return Flag9 (N);
+    end Elaborate_All_Desirable;
+ 
     function Elaborate_All_Present
        (N : Node_Id) return Boolean is
     begin
*************** package body Sinfo is
*** 882,887 ****
--- 901,914 ----
        return Flag14 (N);
     end Elaborate_All_Present;
  
+    function Elaborate_Desirable
+       (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_With_Clause);
+       return Flag11 (N);
+    end Elaborate_Desirable;
+ 
     function Elaborate_Present
        (N : Node_Id) return Boolean is
     begin
*************** package body Sinfo is
*** 1056,1062 ****
          or else NT (N).Nkind = N_Label
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Subtype_Declaration);
!       return Flag11 (N);
     end Exception_Junk;
  
     function Expansion_Delayed
--- 1083,1089 ----
          or else NT (N).Nkind = N_Label
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Subtype_Declaration);
!       return Flag7 (N);
     end Exception_Junk;
  
     function Expansion_Delayed
*************** package body Sinfo is
*** 1110,1115 ****
--- 1137,1143 ----
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Pragma_Argument_Association
          or else NT (N).Nkind = N_Qualified_Expression
+         or else NT (N).Nkind = N_Raise_Statement
          or else NT (N).Nkind = N_Return_Statement
          or else NT (N).Nkind = N_Type_Conversion
          or else NT (N).Nkind = N_Unchecked_Expression
*************** package body Sinfo is
*** 1403,1408 ****
--- 1431,1460 ----
        return Flag16 (N);
     end Implicit_With;
  
+    function Interface_List
+       (N : Node_Id) return List_Id is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+         or else NT (N).Nkind = N_Private_Extension_Declaration
+         or else NT (N).Nkind = N_Protected_Type_Declaration
+         or else NT (N).Nkind = N_Record_Definition
+         or else NT (N).Nkind = N_Single_Protected_Declaration
+         or else NT (N).Nkind = N_Single_Task_Declaration
+         or else NT (N).Nkind = N_Task_Type_Declaration);
+       return List2 (N);
+    end Interface_List;
+ 
+    function Interface_Present
+       (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       return Flag16 (N);
+    end Interface_Present;
+ 
     function In_Present
        (N : Node_Id) return Boolean is
     begin
*************** package body Sinfo is
*** 1639,1645 ****
--- 1691,1699 ----
        (N : Node_Id) return Boolean is
     begin
        pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Formal_Private_Type_Definition
+         or else NT (N).Nkind = N_Private_Extension_Declaration
          or else NT (N).Nkind = N_Private_Type_Declaration
          or else NT (N).Nkind = N_Record_Definition
          or else NT (N).Nkind = N_With_Clause);
*************** package body Sinfo is
*** 1719,1724 ****
--- 1773,1802 ----
        return Flag8 (N);
     end Must_Not_Freeze;
  
+    function Must_Not_Override
+       (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Entry_Declaration
+         or else NT (N).Nkind = N_Function_Instantiation
+         or else NT (N).Nkind = N_Function_Specification
+         or else NT (N).Nkind = N_Procedure_Instantiation
+         or else NT (N).Nkind = N_Procedure_Specification);
+       return Flag15 (N);
+    end Must_Not_Override;
+ 
+    function Must_Override
+       (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Entry_Declaration
+         or else NT (N).Nkind = N_Function_Instantiation
+         or else NT (N).Nkind = N_Function_Specification
+         or else NT (N).Nkind = N_Procedure_Instantiation
+         or else NT (N).Nkind = N_Procedure_Specification);
+       return Flag14 (N);
+    end Must_Override;
+ 
     function Name
        (N : Node_Id) return Node_Id is
     begin
*************** package body Sinfo is
*** 1846,1851 ****
--- 1924,1930 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_List
+         or else NT (N).Nkind = N_Procedure_Specification
          or else NT (N).Nkind = N_Record_Definition);
        return Flag13 (N);
     end Null_Present;
*************** package body Sinfo is
*** 1862,1871 ****
          or else NT (N).Nkind = N_Component_Definition
          or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Discriminant_Specification
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Subtype_Declaration);
!       return Flag9 (N);
     end Null_Exclusion_Present;
  
     function Null_Record_Present
--- 1941,1951 ----
          or else NT (N).Nkind = N_Component_Definition
          or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Discriminant_Specification
+         or else NT (N).Nkind = N_Function_Specification
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Subtype_Declaration);
!       return Flag11 (N);
     end Null_Exclusion_Present;
  
     function Null_Record_Present
*************** package body Sinfo is
*** 1885,1898 ****
        return Node4 (N);
     end Object_Definition;
  
-    function OK_For_Stream
-       (N : Node_Id) return Boolean is
-    begin
-       pragma Assert (False
-         or else NT (N).Nkind = N_Attribute_Reference);
-       return Flag4 (N);
-    end OK_For_Stream;
- 
     function Original_Discriminant
        (N : Node_Id) return Node_Id is
     begin
--- 1965,1970 ----
*************** package body Sinfo is
*** 2121,2128 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Function_Definition
!         or else NT (N).Nkind = N_Access_Procedure_Definition);
!       return Flag15 (N);
     end Protected_Present;
  
     function Raises_Constraint_Error
--- 2193,2202 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Function_Definition
!         or else NT (N).Nkind = N_Access_Procedure_Definition
!         or else NT (N).Nkind = N_Derived_Type_Definition
!         or else NT (N).Nkind = N_Record_Definition);
!       return Flag6 (N);
     end Protected_Present;
  
     function Raises_Constraint_Error
*************** package body Sinfo is
*** 2196,2201 ****
--- 2270,2284 ----
        return Flag13 (N);
     end Redundant_Use;
  
+    function Result_Definition
+      (N : Node_Id) return Node_Id is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Access_Function_Definition
+         or else NT (N).Nkind = N_Function_Specification);
+       return Node4 (N);
+    end Result_Definition;
+ 
     function Return_Type
        (N : Node_Id) return Node_Id is
     begin
*************** package body Sinfo is
*** 2296,2309 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
          or else NT (N).Nkind = N_Generic_Package_Declaration
          or else NT (N).Nkind = N_Generic_Subprogram_Declaration
          or else NT (N).Nkind = N_Package_Declaration
          or else NT (N).Nkind = N_Subprogram_Body
          or else NT (N).Nkind = N_Subprogram_Body_Stub
          or else NT (N).Nkind = N_Subprogram_Declaration
!         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        return Node1 (N);
     end Specification;
  
--- 2379,2393 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
+         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
          or else NT (N).Nkind = N_Generic_Package_Declaration
          or else NT (N).Nkind = N_Generic_Subprogram_Declaration
          or else NT (N).Nkind = N_Package_Declaration
          or else NT (N).Nkind = N_Subprogram_Body
          or else NT (N).Nkind = N_Subprogram_Body_Stub
          or else NT (N).Nkind = N_Subprogram_Declaration
!         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration);
        return Node1 (N);
     end Specification;
  
*************** package body Sinfo is
*** 2367,2376 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Definition
-         or else NT (N).Nkind = N_Access_Function_Definition
          or else NT (N).Nkind = N_Formal_Derived_Type_Definition
          or else NT (N).Nkind = N_Formal_Object_Declaration
-         or else NT (N).Nkind = N_Function_Specification
          or else NT (N).Nkind = N_Object_Renaming_Declaration
          or else NT (N).Nkind = N_Qualified_Expression
          or else NT (N).Nkind = N_Subtype_Indication
--- 2451,2458 ----
*************** package body Sinfo is
*** 2388,2398 ****
--- 2470,2490 ----
        return List2 (N);
     end Subtype_Marks;
  
+    function Synchronized_Present
+      (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       return Flag7 (N);
+    end Synchronized_Present;
+ 
     function Tagged_Present
        (N : Node_Id) return Boolean is
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Formal_Private_Type_Definition
+         or else NT (N).Nkind = N_Incomplete_Type_Declaration
          or else NT (N).Nkind = N_Private_Type_Declaration
          or else NT (N).Nkind = N_Record_Definition
          or else NT (N).Nkind = N_With_Type_Clause);
*************** package body Sinfo is
*** 2407,2420 ****
        return Node2 (N);
     end Target_Type;
  
-    function Task_Body_Procedure
-       (N : Node_Id) return Entity_Id is
-    begin
-       pragma Assert (False
-         or else NT (N).Nkind = N_Task_Type_Declaration);
-       return Node2 (N);
-    end Task_Body_Procedure;
- 
     function Task_Definition
        (N : Node_Id) return Node_Id is
     begin
--- 2499,2504 ----
*************** package body Sinfo is
*** 2424,2429 ****
--- 2508,2522 ----
        return Node3 (N);
     end Task_Definition;
  
+    function Task_Present
+      (N : Node_Id) return Boolean is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       return Flag5 (N);
+    end Task_Present;
+ 
     function Then_Actions
        (N : Node_Id) return List_Id is
     begin
*************** package body Sinfo is
*** 2677,2682 ****
--- 2770,2784 ----
        Set_Flag4 (N, Val);
     end Set_Acts_As_Spec;
  
+    procedure Set_Actual_Designated_Subtype
+      (N : Node_Id; Val : Node_Id) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Explicit_Dereference
+         or else NT (N).Nkind = N_Free_Statement);
+       Set_Node2 (N, Val);
+    end Set_Actual_Designated_Subtype;
+ 
     procedure Set_Aggregate_Bounds
        (N : Node_Id; Val : Node_Id) is
     begin
*************** package body Sinfo is
*** 2816,2823 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_Association
!         or else NT (N).Nkind = N_Formal_Package_Declaration
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        Set_Flag15 (N, Val);
     end Set_Box_Present;
  
--- 2918,2926 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_Association
!         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Package_Declaration);
        Set_Flag15 (N, Val);
     end Set_Box_Present;
  
*************** package body Sinfo is
*** 3130,3136 ****
        (N : Node_Id; Val : Node_Id) is
     begin
        pragma Assert (False
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        Set_Node2_With_Parent (N, Val);
     end Set_Default_Name;
  
--- 3233,3240 ----
        (N : Node_Id; Val : Node_Id) is
     begin
        pragma Assert (False
!         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
!         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration);
        Set_Node2_With_Parent (N, Val);
     end Set_Default_Name;
  
*************** package body Sinfo is
*** 3376,3381 ****
--- 3480,3493 ----
        Set_Flag13 (N, Val);
     end Set_Do_Tag_Check;
  
+    procedure Set_Elaborate_All_Desirable
+       (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_With_Clause);
+       Set_Flag9 (N, Val);
+    end Set_Elaborate_All_Desirable;
+ 
     procedure Set_Elaborate_All_Present
        (N : Node_Id; Val : Boolean := True) is
     begin
*************** package body Sinfo is
*** 3384,3389 ****
--- 3496,3509 ----
        Set_Flag14 (N, Val);
     end Set_Elaborate_All_Present;
  
+    procedure Set_Elaborate_Desirable
+       (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_With_Clause);
+       Set_Flag11 (N, Val);
+    end Set_Elaborate_Desirable;
+ 
     procedure Set_Elaborate_Present
        (N : Node_Id; Val : Boolean := True) is
     begin
*************** package body Sinfo is
*** 3549,3555 ****
          or else NT (N).Nkind = N_Label
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Subtype_Declaration);
!       Set_Flag11 (N, Val);
     end Set_Exception_Junk;
  
     procedure Set_Expansion_Delayed
--- 3669,3675 ----
          or else NT (N).Nkind = N_Label
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Subtype_Declaration);
!       Set_Flag7 (N, Val);
     end Set_Exception_Junk;
  
     procedure Set_Expansion_Delayed
*************** package body Sinfo is
*** 3603,3608 ****
--- 3723,3729 ----
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Pragma_Argument_Association
          or else NT (N).Nkind = N_Qualified_Expression
+         or else NT (N).Nkind = N_Raise_Statement
          or else NT (N).Nkind = N_Return_Statement
          or else NT (N).Nkind = N_Type_Conversion
          or else NT (N).Nkind = N_Unchecked_Expression
*************** package body Sinfo is
*** 3896,3901 ****
--- 4017,4046 ----
        Set_Flag16 (N, Val);
     end Set_Implicit_With;
  
+    procedure Set_Interface_List
+       (N : Node_Id; Val : List_Id) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Formal_Derived_Type_Definition
+         or else NT (N).Nkind = N_Private_Extension_Declaration
+         or else NT (N).Nkind = N_Protected_Type_Declaration
+         or else NT (N).Nkind = N_Record_Definition
+         or else NT (N).Nkind = N_Single_Protected_Declaration
+         or else NT (N).Nkind = N_Single_Task_Declaration
+         or else NT (N).Nkind = N_Task_Type_Declaration);
+       Set_List2_With_Parent (N, Val);
+    end Set_Interface_List;
+ 
+    procedure Set_Interface_Present
+       (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       Set_Flag16 (N, Val);
+    end Set_Interface_Present;
+ 
     procedure Set_In_Present
        (N : Node_Id; Val : Boolean := True) is
     begin
*************** package body Sinfo is
*** 4132,4138 ****
--- 4277,4285 ----
        (N : Node_Id; Val : Boolean := True) is
     begin
        pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Formal_Private_Type_Definition
+         or else NT (N).Nkind = N_Private_Extension_Declaration
          or else NT (N).Nkind = N_Private_Type_Declaration
          or else NT (N).Nkind = N_Record_Definition
          or else NT (N).Nkind = N_With_Clause);
*************** package body Sinfo is
*** 4212,4217 ****
--- 4359,4388 ----
        Set_Flag8 (N, Val);
     end Set_Must_Not_Freeze;
  
+    procedure Set_Must_Not_Override
+       (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Entry_Declaration
+         or else NT (N).Nkind = N_Function_Instantiation
+         or else NT (N).Nkind = N_Function_Specification
+         or else NT (N).Nkind = N_Procedure_Instantiation
+         or else NT (N).Nkind = N_Procedure_Specification);
+       Set_Flag15 (N, Val);
+    end Set_Must_Not_Override;
+ 
+    procedure Set_Must_Override
+       (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Entry_Declaration
+         or else NT (N).Nkind = N_Function_Instantiation
+         or else NT (N).Nkind = N_Function_Specification
+         or else NT (N).Nkind = N_Procedure_Instantiation
+         or else NT (N).Nkind = N_Procedure_Specification);
+       Set_Flag14 (N, Val);
+    end Set_Must_Override;
+ 
     procedure Set_Name
        (N : Node_Id; Val : Node_Id) is
     begin
*************** package body Sinfo is
*** 4339,4344 ****
--- 4510,4516 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Component_List
+         or else NT (N).Nkind = N_Procedure_Specification
          or else NT (N).Nkind = N_Record_Definition);
        Set_Flag13 (N, Val);
     end Set_Null_Present;
*************** package body Sinfo is
*** 4355,4364 ****
          or else NT (N).Nkind = N_Component_Definition
          or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Discriminant_Specification
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Subtype_Declaration);
!       Set_Flag9 (N, Val);
     end Set_Null_Exclusion_Present;
  
     procedure Set_Null_Record_Present
--- 4527,4537 ----
          or else NT (N).Nkind = N_Component_Definition
          or else NT (N).Nkind = N_Derived_Type_Definition
          or else NT (N).Nkind = N_Discriminant_Specification
+         or else NT (N).Nkind = N_Function_Specification
          or else NT (N).Nkind = N_Object_Declaration
          or else NT (N).Nkind = N_Parameter_Specification
          or else NT (N).Nkind = N_Subtype_Declaration);
!       Set_Flag11 (N, Val);
     end Set_Null_Exclusion_Present;
  
     procedure Set_Null_Record_Present
*************** package body Sinfo is
*** 4378,4391 ****
        Set_Node4_With_Parent (N, Val);
     end Set_Object_Definition;
  
-    procedure Set_OK_For_Stream
-       (N : Node_Id; Val : Boolean := True) is
-    begin
-       pragma Assert (False
-         or else NT (N).Nkind = N_Attribute_Reference);
-       Set_Flag4 (N, Val);
-    end Set_OK_For_Stream;
- 
     procedure Set_Original_Discriminant
        (N : Node_Id; Val : Node_Id) is
     begin
--- 4551,4556 ----
*************** package body Sinfo is
*** 4614,4621 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Function_Definition
!         or else NT (N).Nkind = N_Access_Procedure_Definition);
!       Set_Flag15 (N, Val);
     end Set_Protected_Present;
  
     procedure Set_Raises_Constraint_Error
--- 4779,4788 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Function_Definition
!         or else NT (N).Nkind = N_Access_Procedure_Definition
!         or else NT (N).Nkind = N_Derived_Type_Definition
!         or else NT (N).Nkind = N_Record_Definition);
!       Set_Flag6 (N, Val);
     end Set_Protected_Present;
  
     procedure Set_Raises_Constraint_Error
*************** package body Sinfo is
*** 4689,4694 ****
--- 4856,4870 ----
        Set_Flag13 (N, Val);
     end Set_Redundant_Use;
  
+    procedure Set_Result_Definition
+      (N : Node_Id; Val : Node_Id) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Access_Function_Definition
+         or else NT (N).Nkind = N_Function_Specification);
+       Set_Node4_With_Parent (N, Val);
+    end Set_Result_Definition;
+ 
     procedure Set_Return_Type
        (N : Node_Id; Val : Node_Id) is
     begin
*************** package body Sinfo is
*** 4789,4802 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
          or else NT (N).Nkind = N_Generic_Package_Declaration
          or else NT (N).Nkind = N_Generic_Subprogram_Declaration
          or else NT (N).Nkind = N_Package_Declaration
          or else NT (N).Nkind = N_Subprogram_Body
          or else NT (N).Nkind = N_Subprogram_Body_Stub
          or else NT (N).Nkind = N_Subprogram_Declaration
!         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
!         or else NT (N).Nkind in N_Formal_Subprogram_Declaration);
        Set_Node1_With_Parent (N, Val);
     end Set_Specification;
  
--- 4965,4979 ----
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Abstract_Subprogram_Declaration
+         or else NT (N).Nkind = N_Formal_Abstract_Subprogram_Declaration
+         or else NT (N).Nkind = N_Formal_Concrete_Subprogram_Declaration
          or else NT (N).Nkind = N_Generic_Package_Declaration
          or else NT (N).Nkind = N_Generic_Subprogram_Declaration
          or else NT (N).Nkind = N_Package_Declaration
          or else NT (N).Nkind = N_Subprogram_Body
          or else NT (N).Nkind = N_Subprogram_Body_Stub
          or else NT (N).Nkind = N_Subprogram_Declaration
!         or else NT (N).Nkind = N_Subprogram_Renaming_Declaration);
        Set_Node1_With_Parent (N, Val);
     end Set_Specification;
  
*************** package body Sinfo is
*** 4860,4869 ****
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Access_Definition
-         or else NT (N).Nkind = N_Access_Function_Definition
          or else NT (N).Nkind = N_Formal_Derived_Type_Definition
          or else NT (N).Nkind = N_Formal_Object_Declaration
-         or else NT (N).Nkind = N_Function_Specification
          or else NT (N).Nkind = N_Object_Renaming_Declaration
          or else NT (N).Nkind = N_Qualified_Expression
          or else NT (N).Nkind = N_Subtype_Indication
--- 5037,5044 ----
*************** package body Sinfo is
*** 4881,4891 ****
--- 5056,5076 ----
        Set_List2_With_Parent (N, Val);
     end Set_Subtype_Marks;
  
+    procedure Set_Synchronized_Present
+      (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       Set_Flag7 (N, Val);
+    end Set_Synchronized_Present;
+ 
     procedure Set_Tagged_Present
        (N : Node_Id; Val : Boolean := True) is
     begin
        pragma Assert (False
          or else NT (N).Nkind = N_Formal_Private_Type_Definition
+         or else NT (N).Nkind = N_Incomplete_Type_Declaration
          or else NT (N).Nkind = N_Private_Type_Declaration
          or else NT (N).Nkind = N_Record_Definition
          or else NT (N).Nkind = N_With_Type_Clause);
*************** package body Sinfo is
*** 4900,4913 ****
        Set_Node2 (N, Val); -- semantic field, no parent set
     end Set_Target_Type;
  
-    procedure Set_Task_Body_Procedure
-       (N : Node_Id; Val : Entity_Id) is
-    begin
-       pragma Assert (False
-         or else NT (N).Nkind = N_Task_Type_Declaration);
-       Set_Node2 (N, Val); -- semantic field, no parent set
-    end Set_Task_Body_Procedure;
- 
     procedure Set_Task_Definition
        (N : Node_Id; Val : Node_Id) is
     begin
--- 5085,5090 ----
*************** package body Sinfo is
*** 4917,4922 ****
--- 5094,5108 ----
        Set_Node3_With_Parent (N, Val);
     end Set_Task_Definition;
  
+    procedure Set_Task_Present
+      (N : Node_Id; Val : Boolean := True) is
+    begin
+       pragma Assert (False
+         or else NT (N).Nkind = N_Derived_Type_Definition
+         or else NT (N).Nkind = N_Record_Definition);
+       Set_Flag5 (N, Val);
+    end Set_Task_Present;
+ 
     procedure Set_Then_Actions
        (N : Node_Id; Val : List_Id) is
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/sinfo.ads gcc-4.1.0/gcc/ada/sinfo.ads
*** gcc-4.0.2/gcc/ada/sinfo.ads	Thu Feb 10 13:50:43 2005
--- gcc-4.1.0/gcc/ada/sinfo.ads	Tue Nov 15 13:56:27 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Sinfo is
*** 90,100 ****
     --     node in the checks.
     --    Add an appropriate section to the case statement in sprint.adb
     --    Add an appropriate section to the case statement in sem.adb
!    --    Add an appropraite section to the case statement in exp_util.adb
     --     (Insert_Actions procedure)
!    --    For a subexpression, add an appropriate sections to the case
     --     statement in sem_eval.adb
!    --    For a subexpression, add an appropriate sections to the case
     --     statement in sem_res.adb
  
     --  Finally, four utility programs must be run:
--- 90,100 ----
     --     node in the checks.
     --    Add an appropriate section to the case statement in sprint.adb
     --    Add an appropriate section to the case statement in sem.adb
!    --    Add an appropriate section to the case statement in exp_util.adb
     --     (Insert_Actions procedure)
!    --    For a subexpression, add an appropriate section to the case
     --     statement in sem_eval.adb
!    --    For a subexpression, add an appropriate section to the case
     --     statement in sem_res.adb
  
     --  Finally, four utility programs must be run:
*************** package Sinfo is
*** 457,483 ****
  
     --  The following flag fields appear in all nodes
  
!    --  Analyzed
     --    This flag is used to indicate that a node (and all its children
     --    have been analyzed. It is used to avoid reanalysis of a node that
     --    has already been analyzed, both for efficiency and functional
     --    correctness reasons.
  
!    --  Error_Posted
     --    This flag is used to avoid multiple error messages being posted
     --    on or referring to the same node. This flag is set if an error
     --    message refers to a node or is posted on its source location,
     --    and has the effect of inhibiting further messages involving
     --    this same node.
  
!    --  Comes_From_Source
!    --    This flag is on for any nodes built by the scanner or parser from
!    --    the source program, and off for any nodes built by the analyzer or
!    --    expander. It indicates that a node comes from the original source.
!    --    This flag is defined in Atree.
  
!    --  Has_Dynamic_Length_Check and Has_Dynamic_Range_Check also appear on
!    --  all nodes. They are fully described in the next section.
  
     ------------------------------------
     -- Description of Semantic Fields --
--- 457,492 ----
  
     --  The following flag fields appear in all nodes
  
!    --  Analyzed (Flag1)
     --    This flag is used to indicate that a node (and all its children
     --    have been analyzed. It is used to avoid reanalysis of a node that
     --    has already been analyzed, both for efficiency and functional
     --    correctness reasons.
  
!    --  Comes_From_Source (Flag2)
!    --    This flag is on for any nodes built by the scanner or parser from
!    --    the source program, and off for any nodes built by the analyzer or
!    --    expander. It indicates that a node comes from the original source.
!    --    This flag is defined in Atree.
! 
!    --  Error_Posted (Flag3)
     --    This flag is used to avoid multiple error messages being posted
     --    on or referring to the same node. This flag is set if an error
     --    message refers to a node or is posted on its source location,
     --    and has the effect of inhibiting further messages involving
     --    this same node.
  
!    --  Has_Dynamic_Length_Check (Flag10-Sem)
!    --    This flag is present on all nodes. It is set to indicate that one
!    --    of the routines in unit Checks has generated a length check action
!    --    which has been inserted at the flagged node. This is used to avoid
!    --    the generation of duplicate checks.
  
!    --  Has_Dynamic_Range_Check (Flag12-Sem)
!    --    This flag is present on all nodes. It is set to indicate that one
!    --    of the routines in unit Checks has generated a range check action
!    --    which has been inserted at the flagged node. This is used to avoid
!    --    the generation of duplicate checks.
  
     ------------------------------------
     -- Description of Semantic Fields --
*************** package Sinfo is
*** 535,540 ****
--- 544,558 ----
     --    compilation unit node at the library level for such a subprogram
     --    (see further description in spec of Lib package).
  
+    --  Actual_Designated_Subtype (Node2-Sem)
+    --    Present in N_Free_Statement and N_Explicit_Dereference nodes. If
+    --    GIGI needs to known the dynamic constrained subtype of the designated
+    --    object, this attribute is set to that type. This is done for
+    --    N_Free_Statements for access-to-classwide types and access to
+    --    unconstrained packed array types, and for N_Explicit_Dereference
+    --    when the designated type is an unconstrained packed array and the
+    --    dereference is the prefix of a 'Size attribute reference.
+ 
     --  Aggregate_Bounds (Node3-Sem)
     --    Present in array N_Aggregate nodes. If the aggregate contains
     --    component associations this field points to an N_Range node whose
*************** package Sinfo is
*** 831,843 ****
     --    yet decided how this flag is used (TBD ???).
  
     --  Elaborate_Present (Flag4-Sem)
!    --    This flag is set in the N_With_Clause node to indicate that a
!    --    pragma Elaborate pragma appears for the with'ed units.
  
     --  Elaborate_All_Present (Flag14-Sem)
     --    This flag is set in the N_With_Clause node to indicate that a
     --    pragma Elaborate_All pragma appears for the with'ed units.
  
     --  Elaboration_Boolean (Node2-Sem)
     --    This field is present in function and procedure specification
     --    nodes. If set, it points to the entity for a Boolean flag that
--- 849,871 ----
     --    yet decided how this flag is used (TBD ???).
  
     --  Elaborate_Present (Flag4-Sem)
!    --    This flag is set in the N_With_Clause node to indicate that pragma
!    --    Elaborate pragma appears for the with'ed units.
! 
!    --  Elaborate_All_Desirable (Flag9-Sem)
!    --    This flag is set in the N_With_Clause mode to indicate that the static
!    --    elaboration processing has determined that an Elaborate_All pragma is
!    --    desirable for correct elaboration for this unit.
  
     --  Elaborate_All_Present (Flag14-Sem)
     --    This flag is set in the N_With_Clause node to indicate that a
     --    pragma Elaborate_All pragma appears for the with'ed units.
  
+    --  Elaborate_Desirable (Flag11-Sem)
+    --    This flag is set in the N_With_Clause mode to indicate that the static
+    --    elaboration processing has determined that an Elaborate pragma is
+    --    desirable for correct elaboration for this unit.
+ 
     --  Elaboration_Boolean (Node2-Sem)
     --    This field is present in function and procedure specification
     --    nodes. If set, it points to the entity for a Boolean flag that
*************** package Sinfo is
*** 897,903 ****
     --    Note: if the Is_Overloaded flag is set, then Etype points to
     --    an essentially arbitrary choice from the possible set of types.
  
!    --  Exception_Junk (Flag11-Sem)
     --    This flag is set in a various nodes appearing in a statement
     --    sequence to indicate that the corresponding node is an artifact
     --    of the generated code for exception handling, and should be
--- 925,931 ----
     --    Note: if the Is_Overloaded flag is set, then Etype points to
     --    an essentially arbitrary choice from the possible set of types.
  
!    --  Exception_Junk (Flag7-Sem)
     --    This flag is set in a various nodes appearing in a statement
     --    sequence to indicate that the corresponding node is an artifact
     --    of the generated code for exception handling, and should be
*************** package Sinfo is
*** 1008,1025 ****
     --    handler is deleted during optimization. For further details on why
     --    this is required, see Exp_Ch11.Remove_Handler_Entries.
  
-    --  Has_Dynamic_Length_Check (Flag10-Sem)
-    --    This flag is present on all nodes. It is set to indicate that one
-    --    of the routines in unit Checks has generated a length check action
-    --    which has been inserted at the flagged node. This is used to avoid
-    --    the generation of duplicate checks.
- 
-    --  Has_Dynamic_Range_Check (Flag12-Sem)
-    --    This flag is present on all nodes. It is set to indicate that one
-    --    of the routines in unit Checks has generated a range check action
-    --    which has been inserted at the flagged node. This is used to avoid
-    --    the generation of duplicate checks.
- 
     --  Has_No_Elaboration_Code (Flag17-Sem)
     --    A flag that appears in the N_Compilation_Unit node to indicate
     --    whether or not elaboration code is present for this unit. It is
--- 1036,1041 ----
*************** package Sinfo is
*** 1120,1125 ****
--- 1136,1146 ----
     --    suppress any warnings that would otherwise be issued inside the
     --    loop since they are probably not useful.
  
+    --  Is_Overloaded (Flag5-Sem)
+    --    A flag present in all expression nodes. Used temporarily during
+    --    overloading determination. The setting of this flag is not
+    --    relevant once overloading analysis is complete.
+ 
     --  Is_Power_Of_2_For_Shift (Flag13-Sem)
     --    A flag present only in N_Op_Expon nodes. It is set when the
     --    exponentiation is of the forma 2 ** N, where the type of N is
*************** package Sinfo is
*** 1317,1332 ****
     --    is used for properly setting out of range values for use by pragmas
     --    Initialize_Scalars and Normalize_Scalars.
  
-    --  OK_For_Stream (Flag4-Sem)
-    --    Present in N_Attribute_Definition clauses for stream attributes. If
-    --    set, indicates that the attribute is permitted even though the type
-    --    involved is a limited type. In the case of a protected type, the
-    --    result is to stream all components (including discriminants) in
-    --    lexical order. For other limited types, the effect is simply to
-    --    use the corresponding stream routine for the full type. This flag
-    --    is used for internally generated code, where the streaming of these
-    --    types is required, even though not normally allowed by the language.
- 
     --  Original_Discriminant (Node2-Sem)
     --    Present in identifiers. Used in references to discriminants that
     --    appear in generic units. Because the names of the discriminants
--- 1338,1343 ----
*************** package Sinfo is
*** 1430,1436 ****
     --    be rounded to the nearest integer (breaking ties away from zero),
     --    rather than truncated towards zero as usual. These rounded integer
     --    operations are the result of expansion of rounded fixed-point
!    --    divide, conersion and multiplication operations.
  
     --  Scope (Node3-Sem)
     --    Present in defining identifiers, defining character literals and
--- 1441,1447 ----
     --    be rounded to the nearest integer (breaking ties away from zero),
     --    rather than truncated towards zero as usual. These rounded integer
     --    operations are the result of expansion of rounded fixed-point
!    --    divide, conversion and multiplication operations.
  
     --  Scope (Node3-Sem)
     --    Present in defining identifiers, defining character literals and
*************** package Sinfo is
*** 1477,1488 ****
     --    target type entity for the unchecked conversion instantiation
     --    which gigi must do size validation for.
  
-    --  Task_Body_Procedure (Node2-Sem)
-    --    Present in task type declaration nodes. Points to the entity for
-    --    the task body procedure (as further described in Exp_Ch9, task
-    --    bodies are expanded into procedures). A convenient function to
-    --    retrieve this field is Sem_Util.Get_Task_Body_Procedure.
- 
     --  Then_Actions (List3-Sem)
     --    This field is present in conditional expression nodes. During code
     --    expansion we use the Insert_Actions procedure (in Exp_Util) to insert
--- 1488,1493 ----
*************** package Sinfo is
*** 1888,1894 ****
        --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
        --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
        --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
!       --  | DERIVED_TYPE_DEFINITION
  
        --------------------------------
        -- 3.2.2  Subtype Declaration --
--- 1893,1899 ----
        --    ENUMERATION_TYPE_DEFINITION  | INTEGER_TYPE_DEFINITION
        --  | REAL_TYPE_DEFINITION         | ARRAY_TYPE_DEFINITION
        --  | RECORD_TYPE_DEFINITION       | ACCESS_TYPE_DEFINITION
!       --  | DERIVED_TYPE_DEFINITION      | INTERFACE_TYPE_DEFINITION
  
        --------------------------------
        -- 3.2.2  Subtype Declaration --
*************** package Sinfo is
*** 1903,1912 ****
        --  N_Subtype_Declaration
        --  Sloc points to SUBTYPE
        --  Defining_Identifier (Node1)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Subtype_Indication (Node5)
        --  Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
!       --  Exception_Junk (Flag11-Sem)
  
        -------------------------------
        -- 3.2.2  Subtype Indication --
--- 1908,1917 ----
        --  N_Subtype_Declaration
        --  Sloc points to SUBTYPE
        --  Defining_Identifier (Node1)
!       --  Null_Exclusion_Present (Flag11)
        --  Subtype_Indication (Node5)
        --  Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
!       --  Exception_Junk (Flag7-Sem)
  
        -------------------------------
        -- 3.2.2  Subtype Indication --
*************** package Sinfo is
*** 1974,1979 ****
--- 1979,1986 ----
        --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
        --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
        --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+       --      ACCESS_DEFINITION [:= EXPRESSION];
+       --  | DEFINING_IDENTIFIER_LIST : [aliased] [constant]
        --      ARRAY_TYPE_DEFINITION [:= EXPRESSION];
        --  | SINGLE_TASK_DECLARATION
        --  | SINGLE_PROTECTED_DECLARATION
*************** package Sinfo is
*** 2010,2022 ****
        --  extra temporary (with Is_True_Constant set False), and initialize
        --  this temporary as required (the temporary itself is not atomic).
  
        --  N_Object_Declaration
        --  Sloc points to first identifier
        --  Defining_Identifier (Node1)
        --  Aliased_Present (Flag4) set if ALIASED appears
        --  Constant_Present (Flag17) set if CONSTANT appears
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
!       --  Object_Definition (Node4) subtype indication/array type definition
        --  Expression (Node3) (set to Empty if not present)
        --  Handler_List_Entry (Node2-Sem)
        --  Corresponding_Generic_Association (Node5-Sem)
--- 2017,2033 ----
        --  extra temporary (with Is_True_Constant set False), and initialize
        --  this temporary as required (the temporary itself is not atomic).
  
+       --  Note: there is not node kind for object definition. Instead, the
+       --  corresponding field holds a subtype indication, an array type
+       --  definition, or (Ada 2005, AI-406) an access definition.
+ 
        --  N_Object_Declaration
        --  Sloc points to first identifier
        --  Defining_Identifier (Node1)
        --  Aliased_Present (Flag4) set if ALIASED appears
        --  Constant_Present (Flag17) set if CONSTANT appears
!       --  Null_Exclusion_Present (Flag11)
!       --  Object_Definition (Node4) subtype indic./array type def./ access def.
        --  Expression (Node3) (set to Empty if not present)
        --  Handler_List_Entry (Node2-Sem)
        --  Corresponding_Generic_Association (Node5-Sem)
*************** package Sinfo is
*** 2024,2030 ****
        --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
        --  No_Initialization (Flag13-Sem)
        --  Assignment_OK (Flag15-Sem)
!       --  Exception_Junk (Flag11-Sem)
        --  Delay_Finalize_Attach (Flag14-Sem)
        --  Is_Subprogram_Descriptor (Flag16-Sem)
  
--- 2035,2041 ----
        --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
        --  No_Initialization (Flag13-Sem)
        --  Assignment_OK (Flag15-Sem)
!       --  Exception_Junk (Flag7-Sem)
        --  Delay_Finalize_Attach (Flag14-Sem)
        --  Is_Subprogram_Descriptor (Flag16-Sem)
  
*************** package Sinfo is
*** 2062,2080 ****
        ----------------------------------
  
        --  DERIVED_TYPE_DEFINITION ::=
!       --    [abstract] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
!       --    [RECORD_EXTENSION_PART]
  
!       --  Note: ABSTRACT, record extension part not permitted in Ada 83 mode
  
        --  Note: a record extension part is required if ABSTRACT is present
  
        --  N_Derived_Type_Definition
        --  Sloc points to NEW
        --  Abstract_Present (Flag4)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Subtype_Indication (Node5)
        --  Record_Extension_Part (Node3) (set to Empty if not present)
  
        ---------------------------
        -- 3.5  Range Constraint --
--- 2073,2102 ----
        ----------------------------------
  
        --  DERIVED_TYPE_DEFINITION ::=
!       --    [abstract] [limited] new [NULL_EXCLUSION] parent_SUBTYPE_INDICATION
!       --    [[and INTERFACE_LIST] RECORD_EXTENSION_PART]
  
!    --  Note: ABSTRACT, LIMITED and record extension part are not permitted
!    --  in Ada 83 mode
  
        --  Note: a record extension part is required if ABSTRACT is present
  
        --  N_Derived_Type_Definition
        --  Sloc points to NEW
        --  Abstract_Present (Flag4)
!       --  Null_Exclusion_Present (Flag11) (set to False if not present)
        --  Subtype_Indication (Node5)
        --  Record_Extension_Part (Node3) (set to Empty if not present)
+       --  Limited_Present (Flag17)
+       --  Task_Present (Flag5) set in task interfaces
+       --  Protected_Present (Flag6) set in protected interfaces
+       --  Synchronized_Present (Flag7) set in interfaces
+       --  Interface_List (List2) (set to No_List if none)
+       --  Interface_Present (Flag16) set in abstract interfaces
+ 
+    --  Note: Task_Present, Protected_Present, Synchronized_Present,
+    --        Interface_List, and Interface_Present are used for abstract
+    --        interfaces (see comments for INTERFACE_TYPE_DEFINITION).
  
        ---------------------------
        -- 3.5  Range Constraint --
*************** package Sinfo is
*** 2364,2370 ****
        --  N_Component_Definition
        --  Sloc points to ALIASED, ACCESS or to first token of subtype mark
        --  Aliased_Present (Flag4)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Subtype_Indication (Node5) (set to Empty if not present)
        --  Access_Definition (Node3) (set to Empty if not present)
  
--- 2386,2392 ----
        --  N_Component_Definition
        --  Sloc points to ALIASED, ACCESS or to first token of subtype mark
        --  Aliased_Present (Flag4)
!       --  Null_Exclusion_Present (Flag11)
        --  Subtype_Indication (Node5) (set to Empty if not present)
        --  Access_Definition (Node3) (set to Empty if not present)
  
*************** package Sinfo is
*** 2437,2445 ****
        --  N_Discriminant_Specification
        --  Sloc points to first identifier
        --  Defining_Identifier (Node1)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
!       --  Discriminant_Type (Node5) subtype mark or
!       --    access parameter definition
        --  Expression (Node3) (set to Empty if no default expression)
        --  More_Ids (Flag5) (set to False if no more identifiers in list)
        --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
--- 2459,2466 ----
        --  N_Discriminant_Specification
        --  Sloc points to first identifier
        --  Defining_Identifier (Node1)
!       --  Null_Exclusion_Present (Flag11)
!       --  Discriminant_Type (Node5) subtype mark or access parameter definition
        --  Expression (Node3) (set to Empty if no default expression)
        --  More_Ids (Flag5) (set to False if no more identifiers in list)
        --  Prev_Ids (Flag6) (set to False if no previous identifiers in list)
*************** package Sinfo is
*** 2525,2530 ****
--- 2546,2560 ----
        --  Limited_Present (Flag17)
        --  Component_List (Node1) empty in null record case
        --  Null_Present (Flag13) set in null record case
+       --  Task_Present (Flag5) set in task interfaces
+       --  Protected_Present (Flag6) set in protected interfaces
+       --  Synchronized_Present (Flag7) set in interfaces
+       --  Interface_Present (Flag16) set in abstract interfaces
+       --  Interface_List (List2) (set to No_List if none)
+ 
+       --  Note: Task_Present, Protected_Present, Synchronized _Present,
+       --        Interface_List and Interface_Present are used for abstract
+       --        interfaces (see comments for INTERFACE_TYPE_DEFINITION).
  
        -------------------------
        -- 3.8  Component List --
*************** package Sinfo is
*** 2651,2656 ****
--- 2681,2699 ----
  
        --  Note: record extension parts are not permitted in Ada 83 mode
  
+       --------------------------------------
+       -- 3.9.4  Interface Type Definition --
+       --------------------------------------
+ 
+       --  INTERFACE_TYPE_DEFINITION ::=
+       --    [limited | task | protected | synchronized]
+       --    interface [interface_list]
+ 
+       --  Note: Interfaces are implemented with N_Record_Definition and
+       --        N_Derived_Type_Definition nodes because most of the support
+       --        for the analysis of abstract types has been reused to
+       --        analyze abstract interfaces.
+ 
        ----------------------------------
        -- 3.10  Access Type Definition --
        ----------------------------------
*************** package Sinfo is
*** 2676,2682 ****
        --  N_Access_To_Object_Definition
        --  Sloc points to ACCESS
        --  All_Present (Flag15)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Subtype_Indication (Node5)
        --  Constant_Present (Flag17)
  
--- 2719,2725 ----
        --  N_Access_To_Object_Definition
        --  Sloc points to ACCESS
        --  All_Present (Flag15)
!       --  Null_Exclusion_Present (Flag11)
        --  Subtype_Indication (Node5)
        --  Constant_Present (Flag17)
  
*************** package Sinfo is
*** 2705,2719 ****
  
        --  N_Access_Function_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
!       --  Protected_Present (Flag15)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
!       --  Subtype_Mark (Node4) result subtype
  
        --  N_Access_Procedure_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
!       --  Protected_Present (Flag15)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
  
        -----------------------------
--- 2748,2762 ----
  
        --  N_Access_Function_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag11)
!       --  Protected_Present (Flag6)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
!       --  Result_Definition (Node4) result subtype (subtype mark or access def)
  
        --  N_Access_Procedure_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag11)
!       --  Protected_Present (Flag6)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
  
        -----------------------------
*************** package Sinfo is
*** 2728,2734 ****
  
        --  N_Access_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  All_Present (Flag15)
        --  Constant_Present (Flag17)
        --  Subtype_Mark (Node4)
--- 2771,2777 ----
  
        --  N_Access_Definition
        --  Sloc points to ACCESS
!       --  Null_Exclusion_Present (Flag11)
        --  All_Present (Flag15)
        --  Constant_Present (Flag17)
        --  Subtype_Mark (Node4)
*************** package Sinfo is
*** 2739,2745 ****
        -----------------------------------------
  
        --  INCOMPLETE_TYPE_DECLARATION ::=
!       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART];
  
        --  N_Incomplete_Type_Declaration
        --  Sloc points to TYPE
--- 2782,2788 ----
        -----------------------------------------
  
        --  INCOMPLETE_TYPE_DECLARATION ::=
!       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [IS TAGGED];
  
        --  N_Incomplete_Type_Declaration
        --  Sloc points to TYPE
*************** package Sinfo is
*** 2748,2753 ****
--- 2791,2797 ----
        --   discriminant part, or if the discriminant part is an
        --   unknown discriminant part)
        --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
+       --  Tagged_Present (Flag15)
  
        ----------------------------
        -- 3.11  Declarative Part --
*************** package Sinfo is
*** 2819,2824 ****
--- 2863,2869 ----
        --  N_Explicit_Dereference
        --  Sloc points to ALL
        --  Prefix (Node3)
+       --  Actual_Designated_Subtype (Node2-Sem)
        --  plus fields for expression
  
        -------------------------------
*************** package Sinfo is
*** 2933,2943 ****
        --  i.e. digits, access, delta, range, the Attribute_Name field contains
        --  the corresponding name, even though no identifier is involved.
  
!       --  The flag OK_For_Stream is used in generated code to indicate that
!       --  a stream attribute is permissible for a limited type, and results
!       --  in the use of the stream attribute for the underlying full type,
!       --  or in the case of a protected type, the components (including any
!       --  disriminants) are merely streamed in order.
  
        --  See Exp_Attr for a complete description of which attributes are
        --  passed onto Gigi, and which are handled entirely by the front end.
--- 2978,2988 ----
        --  i.e. digits, access, delta, range, the Attribute_Name field contains
        --  the corresponding name, even though no identifier is involved.
  
!       --  Note: the generated code may contain stream attributes applied to
!       --  limited types for which no stream routines exist officially. In such
!       --  case, the result is to use the stream attribute for the underlying
!       --  full type, or in the case of a protected type, the components
!       --  (including any disriminants) are merely streamed in order.
  
        --  See Exp_Attr for a complete description of which attributes are
        --  passed onto Gigi, and which are handled entirely by the front end.
*************** package Sinfo is
*** 2964,2970 ****
        --  Associated_Node (Node4-Sem)
        --  Do_Overflow_Check (Flag17-Sem)
        --  Redundant_Use (Flag13-Sem)
-       --  OK_For_Stream (Flag4-Sem)
        --  Must_Be_Byte_Aligned (Flag14)
        --  plus fields for expression
  
--- 3009,3014 ----
*************** package Sinfo is
*** 3529,3535 ****
        --  N_Allocator
        --  Sloc points to NEW
        --  Expression (Node3) subtype indication or qualified expression
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Storage_Pool (Node1-Sem)
        --  Procedure_To_Call (Node4-Sem)
        --  No_Initialization (Flag13-Sem)
--- 3573,3579 ----
        --  N_Allocator
        --  Sloc points to NEW
        --  Expression (Node3) subtype indication or qualified expression
!       --  Null_Exclusion_Present (Flag11)
        --  Storage_Pool (Node1-Sem)
        --  Procedure_To_Call (Node4-Sem)
        --  No_Initialization (Flag13-Sem)
*************** package Sinfo is
*** 3606,3612 ****
        --  N_Label
        --  Sloc points to <<
        --  Identifier (Node1) direct name of statement identifier
!       --  Exception_Junk (Flag11-Sem)
  
        -------------------------------
        -- 5.1  Statement Identifier --
--- 3650,3656 ----
        --  N_Label
        --  Sloc points to <<
        --  Identifier (Node1) direct name of statement identifier
!       --  Exception_Junk (Flag7-Sem)
  
        -------------------------------
        -- 5.1  Statement Identifier --
*************** package Sinfo is
*** 3846,3852 ****
        --  N_Goto_Statement
        --  Sloc points to GOTO
        --  Name (Node2)
!       --  Exception_Junk (Flag11-Sem)
  
        ---------------------------------
        -- 6.1  Subprogram Declaration --
--- 3890,3896 ----
        --  N_Goto_Statement
        --  Sloc points to GOTO
        --  Name (Node2)
!       --  Exception_Junk (Flag7-Sem)
  
        ---------------------------------
        -- 6.1  Subprogram Declaration --
*************** package Sinfo is
*** 3877,3884 ****
        -----------------------------------
  
        --  SUBPROGRAM_SPECIFICATION ::=
        --    procedure DEFINING_PROGRAM_UNIT_NAME PARAMETER_PROFILE
!       --  | function DEFINING_DESIGNATOR PARAMETER_AND_RESULT_PROFILE
  
        --  Note: there are no separate nodes for the profiles, instead the
        --  information appears directly in the following nodes.
--- 3921,3930 ----
        -----------------------------------
  
        --  SUBPROGRAM_SPECIFICATION ::=
+       --    [[not] overriding]
        --    procedure DEFINING_PROGRAM_UNIT_NAME PARAMETER_PROFILE
!       --  | [[not] overriding]
!       --    function DEFINING_DESIGNATOR PARAMETER_AND_RESULT_PROFILE
  
        --  Note: there are no separate nodes for the profiles, instead the
        --  information appears directly in the following nodes.
*************** package Sinfo is
*** 3888,3895 ****
        --  Defining_Unit_Name (Node1) (the designator)
        --  Elaboration_Boolean (Node2-Sem)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
!       --  Subtype_Mark (Node4) for return type
        --  Generic_Parent (Node5-Sem)
  
        --  N_Procedure_Specification
        --  Sloc points to PROCEDURE
--- 3934,3944 ----
        --  Defining_Unit_Name (Node1) (the designator)
        --  Elaboration_Boolean (Node2-Sem)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
!       --  Null_Exclusion_Present (Flag11)
!       --  Result_Definition (Node4) for result subtype
        --  Generic_Parent (Node5-Sem)
+       --  Must_Override (Flag14) set if overriding indicator present
+       --  Must_Not_Override (Flag15) set if not_overriding indicator present
  
        --  N_Procedure_Specification
        --  Sloc points to PROCEDURE
*************** package Sinfo is
*** 3897,3902 ****
--- 3946,3956 ----
        --  Elaboration_Boolean (Node2-Sem)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
        --  Generic_Parent (Node5-Sem)
+       --  Null_Present (Flag13) set for null procedure case (Ada 2005 feature)
+       --  Must_Override (Flag14) set if overriding indicator present
+       --  Must_Not_Override (Flag15) set if not_overriding indicator present
+ 
+       --  Note: overriding indicator is an Ada 2005 feature
  
        ---------------------
        -- 6.1  Designator --
*************** package Sinfo is
*** 3916,3922 ****
        --   parent library unit package name is present.
        --  Identifier (Node1)
  
!       --  Note that the identifier can also be an operator symbol here.
  
        ------------------------------
        -- 6.1  Defining Designator --
--- 3970,3976 ----
        --   parent library unit package name is present.
        --  Identifier (Node1)
  
!       --  Note that the identifier can also be an operator symbol here
  
        ------------------------------
        -- 6.1  Defining Designator --
*************** package Sinfo is
*** 4009,4015 ****
        -- 6.1  Parameter and Result Profile --
        ---------------------------------------
  
!       --  PARAMETER_AND_RESULT_PROFILE ::= [FORMAL_PART] return SUBTYPE_MARK
  
        --  There is no explicit node in the tree for a parameter and result
        --  profile. Instead the information appears directly in the parent.
--- 4063,4071 ----
        -- 6.1  Parameter and Result Profile --
        ---------------------------------------
  
!       --  PARAMETER_AND_RESULT_PROFILE ::=
!       --    [FORMAL_PART] return [NULL_EXCLUSION] SUBTYPE_MARK
!       --  | [FORMAL_PART] return ACCESS_DEFINITION
  
        --  There is no explicit node in the tree for a parameter and result
        --  profile. Instead the information appears directly in the parent.
*************** package Sinfo is
*** 4044,4050 ****
        --  Defining_Identifier (Node1)
        --  In_Present (Flag15)
        --  Out_Present (Flag17)
!       --  Null_Exclusion_Present (Flag9) (set to False if not present)
        --  Parameter_Type (Node2) subtype mark or access definition
        --  Expression (Node3) (set to Empty if no default expression present)
        --  Do_Accessibility_Check (Flag13-Sem)
--- 4100,4106 ----
        --  Defining_Identifier (Node1)
        --  In_Present (Flag15)
        --  Out_Present (Flag17)
!       --  Null_Exclusion_Present (Flag11)
        --  Parameter_Type (Node2) subtype mark or access definition
        --  Expression (Node3) (set to Empty if no default expression present)
        --  Do_Accessibility_Check (Flag13-Sem)
*************** package Sinfo is
*** 4283,4291 ****
  
        --  PRIVATE_EXTENSION_DECLARATION ::=
        --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!       --      [abstract] new ancestor_SUBTYPE_INDICATION with private;
  
!       --  Note: private extension declarations are not allowed in Ada 83 mode
  
        --  N_Private_Extension_Declaration
        --  Sloc points to TYPE
--- 4339,4349 ----
  
        --  PRIVATE_EXTENSION_DECLARATION ::=
        --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART] is
!       --      [abstract] [limited] new ancestor_SUBTYPE_INDICATION
!       --      [and INTERFACE_LIST] with private;
  
!    --  Note: LIMITED, and private extension declarations are not allowed
!    --        in Ada 83 mode.
  
        --  N_Private_Extension_Declaration
        --  Sloc points to TYPE
*************** package Sinfo is
*** 4294,4300 ****
--- 4352,4360 ----
        --   discriminant part)
        --  Unknown_Discriminants_Present (Flag13) set if (<>) discriminant
        --  Abstract_Present (Flag4)
+       --  Limited_Present (Flag17)
        --  Subtype_Indication (Node5)
+       --  Interface_List (List2) (set to No_List if none)
  
        ---------------------
        -- 8.4  Use Clause --
*************** package Sinfo is
*** 4436,4449 ****
  
        --  TASK_TYPE_DECLARATION ::=
        --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!       --      [is TASK_DEFINITITION];
  
        --  N_Task_Type_Declaration
        --  Sloc points to TASK
        --  Defining_Identifier (Node1)
-       --  Task_Body_Procedure (Node2-Sem)
        --  Discriminant_Specifications (List4) (set to No_List if no
        --   discriminant part)
        --  Task_Definition (Node3) (set to Empty if not present)
        --  Corresponding_Body (Node5-Sem)
  
--- 4496,4509 ----
  
        --  TASK_TYPE_DECLARATION ::=
        --    task type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!       --      [is [new INTERFACE_LIST with] TASK_DEFINITITION];
  
        --  N_Task_Type_Declaration
        --  Sloc points to TASK
        --  Defining_Identifier (Node1)
        --  Discriminant_Specifications (List4) (set to No_List if no
        --   discriminant part)
+       --  Interface_List (List2) (set to No_List if none)
        --  Task_Definition (Node3) (set to Empty if not present)
        --  Corresponding_Body (Node5-Sem)
  
*************** package Sinfo is
*** 4452,4462 ****
        ----------------------------------
  
        --  SINGLE_TASK_DECLARATION ::=
!       --    task DEFINING_IDENTIFIER [is TASK_DEFINITION];
  
        --  N_Single_Task_Declaration
        --  Sloc points to TASK
        --  Defining_Identifier (Node1)
        --  Task_Definition (Node3) (set to Empty if not present)
  
        --------------------------
--- 4512,4524 ----
        ----------------------------------
  
        --  SINGLE_TASK_DECLARATION ::=
!       --    task DEFINING_IDENTIFIER
!       --      [is [new INTERFACE_LIST with] TASK_DEFINITITION];
  
        --  N_Single_Task_Declaration
        --  Sloc points to TASK
        --  Defining_Identifier (Node1)
+       --  Interface_List (List2) (set to No_List if none)
        --  Task_Definition (Node3) (set to Empty if not present)
  
        --------------------------
*************** package Sinfo is
*** 4499,4505 ****
        --      HANDLED_SEQUENCE_OF_STATEMENTS
        --    end [task_IDENTIFIER];
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Task_Body
        --  Sloc points to TASK
--- 4561,4567 ----
        --      HANDLED_SEQUENCE_OF_STATEMENTS
        --    end [task_IDENTIFIER];
  
!       --  Gigi restriction: This node never appears
  
        --  N_Task_Body
        --  Sloc points to TASK
*************** package Sinfo is
*** 4517,4523 ****
  
        --  PROTECTED_TYPE_DECLARATION ::=
        --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!       --      is PROTECTED_DEFINITION;
  
        --  Note: protected type declarations are not permitted in Ada 83 mode
  
--- 4579,4585 ----
  
        --  PROTECTED_TYPE_DECLARATION ::=
        --    protected type DEFINING_IDENTIFIER [KNOWN_DISCRIMINANT_PART]
!       --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
  
        --  Note: protected type declarations are not permitted in Ada 83 mode
  
*************** package Sinfo is
*** 4526,4531 ****
--- 4588,4594 ----
        --  Defining_Identifier (Node1)
        --  Discriminant_Specifications (List4) (set to No_List if no
        --   discriminant part)
+       --  Interface_List (List2) (set to No_List if none)
        --  Protected_Definition (Node3)
        --  Corresponding_Body (Node5-Sem)
  
*************** package Sinfo is
*** 4534,4546 ****
        ---------------------------------------
  
        --  SINGLE_PROTECTED_DECLARATION ::=
!       --    protected DEFINING_IDENTIFIER is PROTECTED_DEFINITION;
  
        --  Note: single protected declarations are not allowed in Ada 83 mode
  
        --  N_Single_Protected_Declaration
        --  Sloc points to PROTECTED
        --  Defining_Identifier (Node1)
        --  Protected_Definition (Node3)
  
        -------------------------------
--- 4597,4611 ----
        ---------------------------------------
  
        --  SINGLE_PROTECTED_DECLARATION ::=
!       --    protected DEFINING_IDENTIFIER
!       --      is [new INTERFACE_LIST with] PROTECTED_DEFINITION;
  
        --  Note: single protected declarations are not allowed in Ada 83 mode
  
        --  N_Single_Protected_Declaration
        --  Sloc points to PROTECTED
        --  Defining_Identifier (Node1)
+       --  Interface_List (List2) (set to No_List if none)
        --  Protected_Definition (Node3)
  
        -------------------------------
*************** package Sinfo is
*** 4587,4593 ****
  
        --  Note: protected bodies are not allowed in Ada 83 mode
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Protected_Body
        --  Sloc points to PROTECTED
--- 4652,4658 ----
  
        --  Note: protected bodies are not allowed in Ada 83 mode
  
!       --  Gigi restriction: This node never appears
  
        --  N_Protected_Body
        --  Sloc points to PROTECTED
*************** package Sinfo is
*** 4612,4617 ****
--- 4677,4683 ----
        ------------------------------
  
        --  ENTRY_DECLARATION ::=
+       --    [[not] overriding]
        --    entry DEFINING_IDENTIFIER
        --      [(DISCRETE_SUBTYPE_DEFINITION)] PARAMETER_PROFILE;
  
*************** package Sinfo is
*** 4621,4626 ****
--- 4687,4696 ----
        --  Discrete_Subtype_Definition (Node4) (set to Empty if not present)
        --  Parameter_Specifications (List3) (set to No_List if no formal part)
        --  Corresponding_Body (Node5-Sem)
+       --  Must_Override (Flag14) set if overriding indicator present
+       --  Must_Not_Override (Flag15) set if not_overriding indicator present
+ 
+       --  Note: overriding indicator is an Ada 2005 feature
  
        -----------------------------
        -- 9.5.2  Accept statement --
*************** package Sinfo is
*** 4632,4638 ****
        --        HANDLED_SEQUENCE_OF_STATEMENTS
        --    end [entry_IDENTIFIER]];
  
!       --  Gigi restriction: This node never appears.
  
        --  Note: there are no explicit declarations allowed in an accept
        --  statement. However, the implicit declarations for any statement
--- 4702,4708 ----
        --        HANDLED_SEQUENCE_OF_STATEMENTS
        --    end [entry_IDENTIFIER]];
  
!       --  Gigi restriction: This node never appears
  
        --  Note: there are no explicit declarations allowed in an accept
        --  statement. However, the implicit declarations for any statement
*************** package Sinfo is
*** 4671,4677 ****
        --  the ENTRY_BODY_FORMAL_PART to avoid the N_Entry_Body node getting
        --  too full (it would otherwise have too many fields)
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Entry_Body
        --  Sloc points to ENTRY
--- 4741,4747 ----
        --  the ENTRY_BODY_FORMAL_PART to avoid the N_Entry_Body node getting
        --  too full (it would otherwise have too many fields)
  
!       --  Gigi restriction: This node never appears
  
        --  N_Entry_Body
        --  Sloc points to ENTRY
*************** package Sinfo is
*** 4694,4700 ****
        --  formal part itself. Also this means that the barrier condition
        --  always has somewhere to be stored.
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Entry_Body_Formal_Part
        --  Sloc points to first token
--- 4764,4770 ----
        --  formal part itself. Also this means that the barrier condition
        --  always has somewhere to be stored.
  
!       --  Gigi restriction: This node never appears
  
        --  N_Entry_Body_Formal_Part
        --  Sloc points to first token
*************** package Sinfo is
*** 4715,4721 ****
        --  ENTRY_INDEX_SPECIFICATION ::=
        --    for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Entry_Index_Specification
        --  Sloc points to FOR
--- 4785,4791 ----
        --  ENTRY_INDEX_SPECIFICATION ::=
        --    for DEFINING_IDENTIFIER in DISCRETE_SUBTYPE_DEFINITION
  
!       --  Gigi restriction: This node never appears
  
        --  N_Entry_Index_Specification
        --  Sloc points to FOR
*************** package Sinfo is
*** 4731,4737 ****
        --  The parser may generate a procedure call for this construct. The
        --  semantic pass must correct this misidentification where needed.
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Entry_Call_Statement
        --  Sloc points to first token of name
--- 4801,4807 ----
        --  The parser may generate a procedure call for this construct. The
        --  semantic pass must correct this misidentification where needed.
  
!       --  Gigi restriction: This node never appears
  
        --  N_Entry_Call_Statement
        --  Sloc points to first token of name
*************** package Sinfo is
*** 4748,4754 ****
  
        --  Note: requeue statements are not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Requeue_Statement
        --  Sloc points to REQUEUE
--- 4818,4824 ----
  
        --  Note: requeue statements are not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears
  
        --  N_Requeue_Statement
        --  Sloc points to REQUEUE
*************** package Sinfo is
*** 4771,4777 ****
  
        --  Note: delay until statements are not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Delay_Until_Statement
        --  Sloc points to DELAY
--- 4841,4847 ----
  
        --  Note: delay until statements are not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears
  
        --  N_Delay_Until_Statement
        --  Sloc points to DELAY
*************** package Sinfo is
*** 4783,4789 ****
  
        --  DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Delay_Relative_Statement
        --  Sloc points to DELAY
--- 4853,4859 ----
  
        --  DELAY_RELATIVE_STATEMENT ::= delay delay_EXPRESSION;
  
!       --  Gigi restriction: This node never appears
  
        --  N_Delay_Relative_Statement
        --  Sloc points to DELAY
*************** package Sinfo is
*** 4814,4820 ****
        --      SEQUENCE_OF_STATEMENTS]
        --    end select;
  
!       --  Gigi restriction: This node never appears.
  
        --  Note: the guard expression, if present, appears in the node for
        --  the select alternative.
--- 4884,4890 ----
        --      SEQUENCE_OF_STATEMENTS]
        --    end select;
  
!       --  Gigi restriction: This node never appears
  
        --  Note: the guard expression, if present, appears in the node for
        --  the select alternative.
*************** package Sinfo is
*** 4849,4855 ****
        --  ACCEPT_ALTERNATIVE ::=
        --    ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Accept_Alternative
        --  Sloc points to ACCEPT
--- 4919,4925 ----
        --  ACCEPT_ALTERNATIVE ::=
        --    ACCEPT_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears
  
        --  N_Accept_Alternative
        --  Sloc points to ACCEPT
*************** package Sinfo is
*** 4866,4872 ****
        --  DELAY_ALTERNATIVE ::=
        --    DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Delay_Alternative
        --  Sloc points to DELAY
--- 4936,4942 ----
        --  DELAY_ALTERNATIVE ::=
        --    DELAY_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears
  
        --  N_Delay_Alternative
        --  Sloc points to DELAY
*************** package Sinfo is
*** 4881,4887 ****
  
        --  TERMINATE_ALTERNATIVE ::= terminate;
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Terminate_Alternative
        --  Sloc points to TERMINATE
--- 4951,4957 ----
  
        --  TERMINATE_ALTERNATIVE ::= terminate;
  
!       --  Gigi restriction: This node never appears
  
        --  N_Terminate_Alternative
        --  Sloc points to TERMINATE
*************** package Sinfo is
*** 4900,4906 ****
        --      DELAY_ALTERNATIVE
        --    end select;
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Timed_Entry_Call
        --  Sloc points to SELECT
--- 4970,4976 ----
        --      DELAY_ALTERNATIVE
        --    end select;
  
!       --  Gigi restriction: This node never appears
  
        --  N_Timed_Entry_Call
        --  Sloc points to SELECT
*************** package Sinfo is
*** 4912,4920 ****
        -----------------------------------
  
        --  ENTRY_CALL_ALTERNATIVE ::=
!       --    ENTRY_CALL_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Entry_Call_Alternative
        --  Sloc points to first token of entry call statement
--- 4982,4993 ----
        -----------------------------------
  
        --  ENTRY_CALL_ALTERNATIVE ::=
!       --    PROCEDURE_OR_ENTRY_CALL [SEQUENCE_OF_STATEMENTS]
  
!       --  PROCEDURE_OR_ENTRY_CALL ::=
!       --    PROCEDURE_CALL_STATEMENT | ENTRY_CALL_STATEMENT
! 
!       --  Gigi restriction: This node never appears
  
        --  N_Entry_Call_Alternative
        --  Sloc points to first token of entry call statement
*************** package Sinfo is
*** 4933,4939 ****
        --      SEQUENCE_OF_STATEMENTS
        --    end select;
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Conditional_Entry_Call
        --  Sloc points to SELECT
--- 5006,5012 ----
        --      SEQUENCE_OF_STATEMENTS
        --    end select;
  
!       --  Gigi restriction: This node never appears
  
        --  N_Conditional_Entry_Call
        --  Sloc points to SELECT
*************** package Sinfo is
*** 4953,4959 ****
  
        --  Note: asynchronous select is not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Asynchronous_Select
        --  Sloc points to SELECT
--- 5026,5032 ----
  
        --  Note: asynchronous select is not permitted in Ada 83 mode
  
!       --  Gigi restriction: This node never appears
  
        --  N_Asynchronous_Select
        --  Sloc points to SELECT
*************** package Sinfo is
*** 4967,4973 ****
        --  TRIGGERING_ALTERNATIVE ::=
        --    TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Triggering_Alternative
        --  Sloc points to first token of triggering statement
--- 5040,5046 ----
        --  TRIGGERING_ALTERNATIVE ::=
        --    TRIGGERING_STATEMENT [SEQUENCE_OF_STATEMENTS]
  
!       --  Gigi restriction: This node never appears
  
        --  N_Triggering_Alternative
        --  Sloc points to first token of triggering statement
*************** package Sinfo is
*** 4979,4985 ****
        -- 9.7.4  Triggering Statement --
        ---------------------------------
  
!       --  TRIGGERING_STATEMENT ::= ENTRY_CALL_STATEMENT | DELAY_STATEMENT
  
        ---------------------------
        -- 9.7.4  Abortable Part --
--- 5052,5058 ----
        -- 9.7.4  Triggering Statement --
        ---------------------------------
  
!       --  TRIGGERING_STATEMENT ::= PROCEDURE_OR_ENTRY_CALL | DELAY_STATEMENT
  
        ---------------------------
        -- 9.7.4  Abortable Part --
*************** package Sinfo is
*** 4987,4993 ****
  
        --  ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Abortable_Part
        --  Sloc points to ABORT
--- 5060,5066 ----
  
        --  ABORTABLE_PART ::= SEQUENCE_OF_STATEMENTS
  
!       --  Gigi restriction: This node never appears
  
        --  N_Abortable_Part
        --  Sloc points to ABORT
*************** package Sinfo is
*** 4999,5005 ****
  
        --  ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
  
!       --  Gigi restriction: This node never appears.
  
        --  N_Abort_Statement
        --  Sloc points to ABORT
--- 5072,5078 ----
  
        --  ABORT_STATEMENT ::= abort task_NAME {, task_NAME};
  
!       --  Gigi restriction: This node never appears
  
        --  N_Abort_Statement
        --  Sloc points to ABORT
*************** package Sinfo is
*** 5161,5166 ****
--- 5234,5241 ----
        --  Context_Installed (Flag13-Sem)
        --  Elaborate_Present (Flag4-Sem)
        --  Elaborate_All_Present (Flag14-Sem)
+       --  Elaborate_All_Desirable (Flag9-Sem)
+       --  Elaborate_Desirable (Flag11-Sem)
        --  Private_Present (Flag15) set if with_clause has private keyword
        --  Implicit_With (Flag16-Sem)
        --  Limited_Present (Flag17)  set if LIMITED is present
*************** package Sinfo is
*** 5347,5353 ****
        --  is true even in the case of an accept statement (see description of
        --  the N_Accept_Statement node).
  
!       --  End_Label refers to the containing construct.
  
        -----------------------------
        -- 11.2  Exception Handler --
--- 5422,5428 ----
        --  is true even in the case of an accept statement (see description of
        --  the N_Accept_Statement node).
  
!       --  End_Label refers to the containing construct
  
        -----------------------------
        -- 11.2  Exception Handler --
*************** package Sinfo is
*** 5393,5401 ****
--- 5468,5481 ----
  
        --  RAISE_STATEMENT ::= raise [exception_NAME];
  
+       --  In Ada 2005, we have
+ 
+       --  RAISE_STATEMENT ::= raise; | raise exception_NAME [with EXPRESSION];
+ 
        --  N_Raise_Statement
        --  Sloc points to RAISE
        --  Name (Node2) (set to Empty if no exception name present)
+       --  Expression (Node3) (set to Empty if no expression present)
  
        -------------------------------
        -- 12.1  Generic Declaration --
*************** package Sinfo is
*** 5465,5473 ****
        --  GENERIC_INSTANTIATION ::=
        --    package DEFINING_PROGRAM_UNIT_NAME is
        --      new generic_package_NAME [GENERIC_ACTUAL_PART];
!       --  | procedure DEFINING_PROGRAM_UNIT_NAME is
        --      new generic_procedure_NAME [GENERIC_ACTUAL_PART];
!       --  | function DEFINING_DESIGNATOR is
        --      new generic_function_NAME [GENERIC_ACTUAL_PART];
  
        --  N_Package_Instantiation
--- 5545,5555 ----
        --  GENERIC_INSTANTIATION ::=
        --    package DEFINING_PROGRAM_UNIT_NAME is
        --      new generic_package_NAME [GENERIC_ACTUAL_PART];
!       --  | [[not] overriding]
!       --    procedure DEFINING_PROGRAM_UNIT_NAME is
        --      new generic_procedure_NAME [GENERIC_ACTUAL_PART];
!       --  | [[not] overriding]
!       --    function DEFINING_DESIGNATOR is
        --      new generic_function_NAME [GENERIC_ACTUAL_PART];
  
        --  N_Package_Instantiation
*************** package Sinfo is
*** 5488,5493 ****
--- 5570,5577 ----
        --  Generic_Associations (List3) (set to No_List if no
        --   generic actual part)
        --  Instance_Spec (Node5-Sem)
+       --  Must_Override (Flag14) set if overriding indicator present
+       --  Must_Not_Override (Flag15) set if not_overriding indicator present
        --  ABE_Is_Certain (Flag18-Sem)
  
        --  N_Function_Instantiation
*************** package Sinfo is
*** 5498,5505 ****
--- 5582,5593 ----
        --   generic actual part)
        --  Parent_Spec (Node4-Sem)
        --  Instance_Spec (Node5-Sem)
+       --  Must_Override (Flag14) set if overriding indicator present
+       --  Must_Not_Override (Flag15) set if not_overriding indicator present
        --  ABE_Is_Certain (Flag18-Sem)
  
+       --  Note: overriding indicator is an Ada 2005 feature
+ 
        ------------------------------
        -- 12.3 Generic Actual Part --
        ------------------------------
*************** package Sinfo is
*** 5591,5596 ****
--- 5679,5685 ----
        --  | FORMAL_DECIMAL_FIXED_POINT_DEFINITION
        --  | FORMAL_ARRAY_TYPE_DEFINITION
        --  | FORMAL_ACCESS_TYPE_DEFINITION
+       --  | FORMAL_INTERFACE_TYPE_DEFINITION
  
        ---------------------------------------------
        -- 12.5.1  Formal Private Type Definition --
*************** package Sinfo is
*** 5612,5619 ****
        --------------------------------------------
  
        --  FORMAL_DERIVED_TYPE_DEFINITION ::=
!       --    [abstract] new SUBTYPE_MARK [with private]
! 
        --  Note: this construct is not allowed in Ada 83 mode
  
        --  N_Formal_Derived_Type_Definition
--- 5701,5707 ----
        --------------------------------------------
  
        --  FORMAL_DERIVED_TYPE_DEFINITION ::=
!       --    [abstract] new SUBTYPE_MARK [[and INTERFACE_LIST] with private]
        --  Note: this construct is not allowed in Ada 83 mode
  
        --  N_Formal_Derived_Type_Definition
*************** package Sinfo is
*** 5621,5626 ****
--- 5709,5715 ----
        --  Subtype_Mark (Node4)
        --  Private_Present (Flag15)
        --  Abstract_Present (Flag4)
+       --  Interface_List (List2) (set to No_List if none)
  
        ---------------------------------------------
        -- 12.5.2  Formal Discrete Type Definition --
*************** package Sinfo is
*** 5690,5695 ****
--- 5779,5790 ----
  
        --  FORMAL_ACCESS_TYPE_DEFINITION ::= ACCESS_TYPE_DEFINITION
  
+       ----------------------------------------------
+       -- 12.5.5  Formal Interface Type Definition --
+       ----------------------------------------------
+ 
+       --  FORMAL_INTERFACE_TYPE_DEFINITION ::= INTERFACE_TYPE_DEFINITION
+ 
        -----------------------------------------
        -- 12.6  Formal Subprogram Declaration --
        -----------------------------------------
*************** package Sinfo is
*** 6129,6135 ****
        --  an expanded name node to a selected component node to be done
        --  easily, see Sinfo.CN.Change_Selected_Component_To_Expanded_Name.
  
!       --  There is no special sprint syntax for an expanded name.
  
        --  N_Expanded_Name
        --  Sloc points to the period
--- 6224,6230 ----
        --  an expanded name node to a selected component node to be done
        --  easily, see Sinfo.CN.Change_Selected_Component_To_Expanded_Name.
  
!       --  There is no special sprint syntax for an expanded name
  
        --  N_Expanded_Name
        --  Sloc points to the period
*************** package Sinfo is
*** 6157,6162 ****
--- 6252,6258 ----
        --  Expression (Node3) argument to unchecked deallocation call
        --  Storage_Pool (Node1-Sem)
        --  Procedure_To_Call (Node4-Sem)
+       --  Actual_Designated_Subtype (Node2-Sem)
  
        --  Note: in the case where a debug source file is generated, the Sloc
        --  for this node points to the FREE keyword in the Sprint file output.
*************** package Sinfo is
*** 6385,6391 ****
        --  with all checks off, regardless of the current setting of scope
        --  suppress flags.
  
!       --  Sprint syntax: `(expression).
  
        --  Note: this node is always removed from the tree (and replaced by
        --  its constituent expression) on completion of analysis, so it only
--- 6481,6487 ----
        --  with all checks off, regardless of the current setting of scope
        --  suppress flags.
  
!       --  Sprint syntax: `(expression)
  
        --  Note: this node is always removed from the tree (and replaced by
        --  its constituent expression) on completion of analysis, so it only
*************** package Sinfo is
*** 6415,6421 ****
        --  clearly a function call to an instantiation of Unchecked_Conversion
        --  is not a variable in any case.
  
!       --  Sprint syntax: subtype-mark!(expression).
  
        --  N_Unchecked_Type_Conversion
        --  Sloc points to related node in source
--- 6511,6517 ----
        --  clearly a function call to an instantiation of Unchecked_Conversion
        --  is not a variable in any case.
  
!       --  Sprint syntax: subtype-mark!(expression)
  
        --  N_Unchecked_Type_Conversion
        --  Sloc points to related node in source
*************** package Sinfo is
*** 6503,6508 ****
--- 6599,6605 ----
        N_Unused_At_Start,
  
        --  N_Representation_Clause
+ 
        N_At_Clause,
        N_Component_Clause,
        N_Enumeration_Representation_Clause,
*************** package Sinfo is
*** 6510,6544 ****
--- 6607,6649 ----
        N_Record_Representation_Clause,
  
        --  N_Representation_Clause, N_Has_Chars
+ 
        N_Attribute_Definition_Clause,
  
        --  N_Has_Chars
+ 
        N_Empty,
        N_Pragma,
        N_Pragma_Argument_Association,
  
        --  N_Has_Etype
+ 
        N_Error,
  
        --  N_Entity, N_Has_Etype, N_Has_Chars
+ 
        N_Defining_Character_Literal,
        N_Defining_Identifier,
        N_Defining_Operator_Symbol,
  
        --  N_Subexpr, N_Has_Etype, N_Has_Chars, N_Has_Entity
+ 
        N_Expanded_Name,
  
        --  N_Direct_Name, N_Subexpr, N_Has_Etype,
        --  N_Has_Chars, N_Has_Entity
+ 
        N_Identifier,
        N_Operator_Symbol,
  
        --  N_Direct_Name, N_Subexpr, N_Has_Etype,
        --  N_Has_Chars, N_Has_Entity
+ 
        N_Character_Literal,
  
        --  N_Binary_Op, N_Op, N_Subexpr,
        --  N_Has_Etype, N_Has_Chars, N_Has_Entity
+ 
        N_Op_Add,
        N_Op_Concat,
        N_Op_Expon,
*************** package Sinfo is
*** 6554,6564 ****
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype
        --  N_Has_Entity, N_Has_Chars, N_Op_Boolean
        N_Op_And,
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype
!       --  N_Has_Entity, N_Has_Chars, N_Op_Boolean,
!       --  N_Op_Compare
        N_Op_Eq,
        N_Op_Ge,
        N_Op_Gt,
--- 6659,6670 ----
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype
        --  N_Has_Entity, N_Has_Chars, N_Op_Boolean
+ 
        N_Op_And,
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype
!       --  N_Has_Entity, N_Has_Chars, N_Op_Boolean, N_Op_Compare
! 
        N_Op_Eq,
        N_Op_Ge,
        N_Op_Gt,
*************** package Sinfo is
*** 6568,6578 ****
--- 6674,6686 ----
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype
        --  N_Has_Entity, N_Has_Chars, N_Op_Boolean
+ 
        N_Op_Or,
        N_Op_Xor,
  
        --  N_Binary_Op, N_Op, N_Subexpr, N_Has_Etype,
        --  N_Op_Shift, N_Has_Chars, N_Has_Entity
+ 
        N_Op_Rotate_Left,
        N_Op_Rotate_Right,
        N_Op_Shift_Left,
*************** package Sinfo is
*** 6581,6595 ****
--- 6689,6706 ----
  
        --  N_Unary_Op, N_Op, N_Subexpr, N_Has_Etype,
        --  N_Has_Chars, N_Has_Entity
+ 
        N_Op_Abs,
        N_Op_Minus,
        N_Op_Not,
        N_Op_Plus,
  
        --  N_Subexpr, N_Has_Etype, N_Has_Entity
+ 
        N_Attribute_Reference,
  
        --  N_Subexpr, N_Has_Etype
+ 
        N_And_Then,
        N_Conditional_Expression,
        N_Explicit_Dereference,
*************** package Sinfo is
*** 6626,6634 ****
--- 6737,6747 ----
        N_Unchecked_Type_Conversion,
  
        --  N_Has_Etype
+ 
        N_Subtype_Indication,
  
        --  N_Declaration
+ 
        N_Component_Declaration,
        N_Entry_Declaration,
        N_Formal_Object_Declaration,
*************** package Sinfo is
*** 6643,6682 ****
        N_Subtype_Declaration,
  
        --  N_Subprogram_Specification, N_Declaration
        N_Function_Specification,
        N_Procedure_Specification,
  
-       --  (nothing special)
-       N_Entry_Index_Specification,
-       N_Freeze_Entity,
- 
        --  N_Access_To_Subprogram_Definition
        N_Access_Function_Definition,
        N_Access_Procedure_Definition,
  
!       --  N_Later_Decl_Item,
        N_Task_Type_Declaration,
  
        --  N_Body_Stub, N_Later_Decl_Item
        N_Package_Body_Stub,
        N_Protected_Body_Stub,
        N_Subprogram_Body_Stub,
        N_Task_Body_Stub,
  
        --  N_Generic_Instantiation, N_Later_Decl_Item
        N_Function_Instantiation,
-       N_Package_Instantiation,
        N_Procedure_Instantiation,
  
        --  N_Unit_Body, N_Later_Decl_Item, N_Proper_Body
        N_Package_Body,
        N_Subprogram_Body,
  
        --  N_Later_Decl_Item, N_Proper_Body
        N_Protected_Body,
        N_Task_Body,
  
        --  N_Later_Decl_Item
        N_Implicit_Label_Declaration,
        N_Package_Declaration,
        N_Single_Task_Declaration,
--- 6756,6803 ----
        N_Subtype_Declaration,
  
        --  N_Subprogram_Specification, N_Declaration
+ 
        N_Function_Specification,
        N_Procedure_Specification,
  
        --  N_Access_To_Subprogram_Definition
+ 
        N_Access_Function_Definition,
        N_Access_Procedure_Definition,
  
!       --  N_Later_Decl_Item
! 
        N_Task_Type_Declaration,
  
        --  N_Body_Stub, N_Later_Decl_Item
+ 
        N_Package_Body_Stub,
        N_Protected_Body_Stub,
        N_Subprogram_Body_Stub,
        N_Task_Body_Stub,
  
        --  N_Generic_Instantiation, N_Later_Decl_Item
+       --  N_Subprogram_Instantiation
+ 
        N_Function_Instantiation,
        N_Procedure_Instantiation,
  
+       --  N_Generic_Instantiation, N_Later_Decl_Item
+ 
+       N_Package_Instantiation,
+ 
        --  N_Unit_Body, N_Later_Decl_Item, N_Proper_Body
+ 
        N_Package_Body,
        N_Subprogram_Body,
  
        --  N_Later_Decl_Item, N_Proper_Body
+ 
        N_Protected_Body,
        N_Task_Body,
  
        --  N_Later_Decl_Item
+ 
        N_Implicit_Label_Declaration,
        N_Package_Declaration,
        N_Single_Task_Declaration,
*************** package Sinfo is
*** 6684,6708 ****
        N_Use_Package_Clause,
  
        --  N_Generic_Declaration, N_Later_Decl_Item
        N_Generic_Package_Declaration,
        N_Generic_Subprogram_Declaration,
  
        --  N_Array_Type_Definition
        N_Constrained_Array_Definition,
        N_Unconstrained_Array_Definition,
  
        --  N_Renaming_Declaration
        N_Exception_Renaming_Declaration,
        N_Object_Renaming_Declaration,
        N_Package_Renaming_Declaration,
        N_Subprogram_Renaming_Declaration,
  
!       --  N_Generic_Renaming_Declarations, N_Renaming_Declaration
        N_Generic_Function_Renaming_Declaration,
        N_Generic_Package_Renaming_Declaration,
        N_Generic_Procedure_Renaming_Declaration,
  
        --  N_Statement_Other_Than_Procedure_Call
        N_Abort_Statement,
        N_Accept_Statement,
        N_Assignment_Statement,
--- 6805,6834 ----
        N_Use_Package_Clause,
  
        --  N_Generic_Declaration, N_Later_Decl_Item
+ 
        N_Generic_Package_Declaration,
        N_Generic_Subprogram_Declaration,
  
        --  N_Array_Type_Definition
+ 
        N_Constrained_Array_Definition,
        N_Unconstrained_Array_Definition,
  
        --  N_Renaming_Declaration
+ 
        N_Exception_Renaming_Declaration,
        N_Object_Renaming_Declaration,
        N_Package_Renaming_Declaration,
        N_Subprogram_Renaming_Declaration,
  
!       --  N_Generic_Renaming_Declaration, N_Renaming_Declaration
! 
        N_Generic_Function_Renaming_Declaration,
        N_Generic_Package_Renaming_Declaration,
        N_Generic_Procedure_Renaming_Declaration,
  
        --  N_Statement_Other_Than_Procedure_Call
+ 
        N_Abort_Statement,
        N_Accept_Statement,
        N_Assignment_Statement,
*************** package Sinfo is
*** 6711,6718 ****
--- 6837,6850 ----
        N_Case_Statement,
        N_Code_Statement,
        N_Conditional_Entry_Call,
+ 
+       --  N_Statement_Other_Than_Procedure_Call. N_Delay_Statement
+ 
        N_Delay_Relative_Statement,
        N_Delay_Until_Statement,
+ 
+       --  N_Statement_Other_Than_Procedure_Call
+ 
        N_Entry_Call_Statement,
        N_Free_Statement,
        N_Goto_Statement,
*************** package Sinfo is
*** 6725,6734 ****
--- 6857,6868 ----
        N_Timed_Entry_Call,
  
        --  N_Statement_Other_Than_Procedure_Call, N_Has_Condition
+ 
        N_Exit_Statement,
        N_If_Statement,
  
        --  N_Has_Condition
+ 
        N_Accept_Alternative,
        N_Delay_Alternative,
        N_Elsif_Part,
*************** package Sinfo is
*** 6736,6742 ****
--- 6870,6882 ----
        N_Iteration_Scheme,
        N_Terminate_Alternative,
  
+       --  N_Formal_Subprogram_Declaration
+ 
+       N_Formal_Abstract_Subprogram_Declaration,
+       N_Formal_Concrete_Subprogram_Declaration,
+ 
        --  Other nodes (not part of any subtype class)
+ 
        N_Abortable_Part,
        N_Abstract_Subprogram_Declaration,
        N_Access_Definition,
*************** package Sinfo is
*** 6758,6768 ****
        N_Enumeration_Type_Definition,
        N_Entry_Body,
        N_Entry_Call_Alternative,
        N_Exception_Declaration,
        N_Exception_Handler,
        N_Floating_Point_Definition,
-       N_Formal_Abstract_Subprogram_Declaration,
-       N_Formal_Concrete_Subprogram_Declaration,
        N_Formal_Decimal_Fixed_Point_Definition,
        N_Formal_Derived_Type_Definition,
        N_Formal_Discrete_Type_Definition,
--- 6898,6907 ----
        N_Enumeration_Type_Definition,
        N_Entry_Body,
        N_Entry_Call_Alternative,
+       N_Entry_Index_Specification,
        N_Exception_Declaration,
        N_Exception_Handler,
        N_Floating_Point_Definition,
        N_Formal_Decimal_Fixed_Point_Definition,
        N_Formal_Derived_Type_Definition,
        N_Formal_Discrete_Type_Definition,
*************** package Sinfo is
*** 6772,6777 ****
--- 6911,6917 ----
        N_Formal_Package_Declaration,
        N_Formal_Private_Type_Definition,
        N_Formal_Signed_Integer_Type_Definition,
+       N_Freeze_Entity,
        N_Generic_Association,
        N_Handled_Sequence_Of_Statements,
        N_Index_Or_Discriminant_Constraint,
*************** package Sinfo is
*** 6830,6835 ****
--- 6970,6979 ----
     --  Note: this includes all constructs normally thought of as declarations
     --  except those which are separately grouped as later declarations.
  
+    subtype N_Delay_Statement is Node_Kind range
+       N_Delay_Relative_Statement ..
+       N_Delay_Until_Statement;
+ 
     subtype N_Direct_Name is Node_Kind range
       N_Identifier ..
       N_Character_Literal;
*************** package Sinfo is
*** 6848,6854 ****
  
     subtype N_Generic_Instantiation is Node_Kind range
       N_Function_Instantiation ..
!      N_Procedure_Instantiation;
  
     subtype N_Generic_Renaming_Declaration is Node_Kind range
       N_Generic_Function_Renaming_Declaration ..
--- 6992,6998 ----
  
     subtype N_Generic_Instantiation is Node_Kind range
       N_Function_Instantiation ..
!      N_Package_Instantiation;
  
     subtype N_Generic_Renaming_Declaration is Node_Kind range
       N_Generic_Function_Renaming_Declaration ..
*************** package Sinfo is
*** 6926,6931 ****
--- 7070,7079 ----
     --  (since overloading is possible, so it needs to go through the normal
     --  overloading resolution for expressions).
  
+    subtype N_Subprogram_Instantiation is Node_Kind range
+      N_Function_Instantiation ..
+      N_Procedure_Instantiation;
+ 
     subtype N_Has_Condition is Node_Kind range
       N_Exit_Statement ..
       N_Terminate_Alternative;
*************** package Sinfo is
*** 6996,7001 ****
--- 7144,7152 ----
     function Acts_As_Spec
       (N : Node_Id) return Boolean;    -- Flag4
  
+    function Actual_Designated_Subtype
+      (N : Node_Id) return Node_Id;    -- Node2
+ 
     function Aggregate_Bounds
       (N : Node_Id) return Node_Id;    -- Node3
  
*************** package Sinfo is
*** 7215,7223 ****
--- 7366,7380 ----
     function Do_Tag_Check
       (N : Node_Id) return Boolean;    -- Flag13
  
+    function Elaborate_All_Desirable
+      (N : Node_Id) return Boolean;    -- Flag9
+ 
     function Elaborate_All_Present
       (N : Node_Id) return Boolean;    -- Flag14
  
+    function Elaborate_Desirable
+      (N : Node_Id) return Boolean;    -- Flag11
+ 
     function Elaborate_Present
       (N : Node_Id) return Boolean;    -- Flag4
  
*************** package Sinfo is
*** 7276,7282 ****
       (N : Node_Id) return List_Id;    -- List5
  
     function Exception_Junk
!      (N : Node_Id) return Boolean;    -- Flag11
  
     function Explicit_Actual_Parameter
       (N : Node_Id) return Node_Id;    -- Node3
--- 7433,7439 ----
       (N : Node_Id) return List_Id;    -- List5
  
     function Exception_Junk
!      (N : Node_Id) return Boolean;    -- Flag7
  
     function Explicit_Actual_Parameter
       (N : Node_Id) return Node_Id;    -- Node3
*************** package Sinfo is
*** 7383,7388 ****
--- 7540,7551 ----
     function Identifier
       (N : Node_Id) return Node_Id;    -- Node1
  
+    function Interface_List
+      (N : Node_Id) return List_Id;    -- List2
+ 
+    function Interface_Present
+      (N : Node_Id) return Boolean;    -- Flag16
+ 
     function Implicit_With
       (N : Node_Id) return Boolean;    -- Flag16
  
*************** package Sinfo is
*** 7494,7499 ****
--- 7657,7668 ----
     function Must_Not_Freeze
       (N : Node_Id) return Boolean;    -- Flag8
  
+    function Must_Not_Override
+      (N : Node_Id) return Boolean;    -- Flag15
+ 
+    function Must_Override
+      (N : Node_Id) return Boolean;    -- Flag14
+ 
     function Name
       (N : Node_Id) return Node_Id;    -- Node2
  
*************** package Sinfo is
*** 7531,7537 ****
       (N : Node_Id) return Boolean;    -- Flag13
  
     function Null_Exclusion_Present
!      (N : Node_Id) return Boolean;    -- Flag9
  
     function Null_Record_Present
       (N : Node_Id) return Boolean;    -- Flag17
--- 7700,7706 ----
       (N : Node_Id) return Boolean;    -- Flag13
  
     function Null_Exclusion_Present
!      (N : Node_Id) return Boolean;    -- Flag11
  
     function Null_Record_Present
       (N : Node_Id) return Boolean;    -- Flag17
*************** package Sinfo is
*** 7539,7547 ****
     function Object_Definition
       (N : Node_Id) return Node_Id;    -- Node4
  
-    function OK_For_Stream
-      (N : Node_Id) return Boolean;    -- Flag4
- 
     function Original_Discriminant
       (N : Node_Id) return Node_Id;    -- Node2
  
--- 7708,7713 ----
*************** package Sinfo is
*** 7609,7615 ****
       (N : Node_Id) return Node_Id;    -- Node3
  
     function Protected_Present
!      (N : Node_Id) return Boolean;    -- Flag15
  
     function Raises_Constraint_Error
       (N : Node_Id) return Boolean;    -- Flag7
--- 7775,7781 ----
       (N : Node_Id) return Node_Id;    -- Node3
  
     function Protected_Present
!      (N : Node_Id) return Boolean;    -- Flag6
  
     function Raises_Constraint_Error
       (N : Node_Id) return Boolean;    -- Flag7
*************** package Sinfo is
*** 7635,7640 ****
--- 7801,7809 ----
     function Redundant_Use
       (N : Node_Id) return Boolean;    -- Flag13
  
+    function Result_Definition
+      (N : Node_Id) return Node_Id;    -- Node4
+ 
     function Return_Type
       (N : Node_Id) return Node_Id;    -- Node2
  
*************** package Sinfo is
*** 7689,7706 ****
     function Subtype_Marks
       (N : Node_Id) return List_Id;    -- List2
  
     function Tagged_Present
       (N : Node_Id) return Boolean;    -- Flag15
  
     function Target_Type
       (N : Node_Id) return Entity_Id;  -- Node2
  
-    function Task_Body_Procedure
-      (N : Node_Id) return Entity_Id;  -- Node2
- 
     function Task_Definition
       (N : Node_Id) return Node_Id;    -- Node3
  
     function Then_Actions
       (N : Node_Id) return List_Id;    -- List2
  
--- 7858,7878 ----
     function Subtype_Marks
       (N : Node_Id) return List_Id;    -- List2
  
+    function Synchronized_Present
+      (N : Node_Id) return Boolean;    -- Flag7
+ 
     function Tagged_Present
       (N : Node_Id) return Boolean;    -- Flag15
  
     function Target_Type
       (N : Node_Id) return Entity_Id;  -- Node2
  
     function Task_Definition
       (N : Node_Id) return Node_Id;    -- Node3
  
+    function Task_Present
+      (N : Node_Id) return Boolean;    -- Flag5
+ 
     function Then_Actions
       (N : Node_Id) return List_Id;    -- List2
  
*************** package Sinfo is
*** 7794,7799 ****
--- 7966,7974 ----
     procedure Set_Acts_As_Spec
       (N : Node_Id; Val : Boolean := True);    -- Flag4
  
+    procedure Set_Actual_Designated_Subtype
+      (N : Node_Id; Val : Node_Id);            -- Node2
+ 
     procedure Set_Aggregate_Bounds
       (N : Node_Id; Val : Node_Id);            -- Node3
  
*************** package Sinfo is
*** 8013,8021 ****
--- 8188,8202 ----
     procedure Set_Do_Tag_Check
       (N : Node_Id; Val : Boolean := True);    -- Flag13
  
+    procedure Set_Elaborate_All_Desirable
+      (N : Node_Id; Val : Boolean := True);    -- Flag9
+ 
     procedure Set_Elaborate_All_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag14
  
+    procedure Set_Elaborate_Desirable
+      (N : Node_Id; Val : Boolean := True);    -- Flag11
+ 
     procedure Set_Elaborate_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag4
  
*************** package Sinfo is
*** 8071,8077 ****
       (N : Node_Id; Val : List_Id);            -- List5
  
     procedure Set_Exception_Junk
!      (N : Node_Id; Val : Boolean := True);    -- Flag11
  
     procedure Set_Expansion_Delayed
       (N : Node_Id; Val : Boolean := True);    -- Flag11
--- 8252,8258 ----
       (N : Node_Id; Val : List_Id);            -- List5
  
     procedure Set_Exception_Junk
!      (N : Node_Id; Val : Boolean := True);    -- Flag7
  
     procedure Set_Expansion_Delayed
       (N : Node_Id; Val : Boolean := True);    -- Flag11
*************** package Sinfo is
*** 8178,8183 ****
--- 8359,8370 ----
     procedure Set_Identifier
       (N : Node_Id; Val : Node_Id);            -- Node1
  
+    procedure Set_Interface_List
+      (N : Node_Id; Val : List_Id);            -- List2
+ 
+    procedure Set_Interface_Present
+      (N : Node_Id; Val : Boolean := True);    -- Flag16
+ 
     procedure Set_Implicit_With
       (N : Node_Id; Val : Boolean := True);    -- Flag16
  
*************** package Sinfo is
*** 8289,8294 ****
--- 8476,8487 ----
     procedure Set_Must_Not_Freeze
       (N : Node_Id; Val : Boolean := True);    -- Flag8
  
+    procedure Set_Must_Not_Override
+      (N : Node_Id; Val : Boolean := True);    -- Flag15
+ 
+    procedure Set_Must_Override
+      (N : Node_Id; Val : Boolean := True);    -- Flag14
+ 
     procedure Set_Name
       (N : Node_Id; Val : Node_Id);            -- Node2
  
*************** package Sinfo is
*** 8326,8332 ****
       (N : Node_Id; Val : Boolean := True);    -- Flag13
  
     procedure Set_Null_Exclusion_Present
!      (N : Node_Id; Val : Boolean := True);    -- Flag9
  
     procedure Set_Null_Record_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag17
--- 8519,8525 ----
       (N : Node_Id; Val : Boolean := True);    -- Flag13
  
     procedure Set_Null_Exclusion_Present
!      (N : Node_Id; Val : Boolean := True);    -- Flag11
  
     procedure Set_Null_Record_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag17
*************** package Sinfo is
*** 8334,8342 ****
     procedure Set_Object_Definition
       (N : Node_Id; Val : Node_Id);            -- Node4
  
-    procedure Set_OK_For_Stream
-      (N : Node_Id; Val : Boolean := True);    -- Flag4
- 
     procedure Set_Original_Discriminant
       (N : Node_Id; Val : Node_Id);            -- Node2
  
--- 8527,8532 ----
*************** package Sinfo is
*** 8404,8410 ****
       (N : Node_Id; Val : Node_Id);            -- Node3
  
     procedure Set_Protected_Present
!      (N : Node_Id; Val : Boolean := True);    -- Flag15
  
     procedure Set_Raises_Constraint_Error
       (N : Node_Id; Val : Boolean := True);    -- Flag7
--- 8594,8600 ----
       (N : Node_Id; Val : Node_Id);            -- Node3
  
     procedure Set_Protected_Present
!      (N : Node_Id; Val : Boolean := True);    -- Flag6
  
     procedure Set_Raises_Constraint_Error
       (N : Node_Id; Val : Boolean := True);    -- Flag7
*************** package Sinfo is
*** 8430,8435 ****
--- 8620,8628 ----
     procedure Set_Redundant_Use
       (N : Node_Id; Val : Boolean := True);    -- Flag13
  
+    procedure Set_Result_Definition
+      (N : Node_Id; Val : Node_Id);            -- Node4
+ 
     procedure Set_Return_Type
       (N : Node_Id; Val : Node_Id);            -- Node2
  
*************** package Sinfo is
*** 8484,8501 ****
     procedure Set_Subtype_Marks
       (N : Node_Id; Val : List_Id);            -- List2
  
     procedure Set_Tagged_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag15
  
     procedure Set_Target_Type
       (N : Node_Id; Val : Entity_Id);          -- Node2
  
-    procedure Set_Task_Body_Procedure
-      (N : Node_Id; Val : Entity_Id);          -- Node2
- 
     procedure Set_Task_Definition
       (N : Node_Id; Val : Node_Id);            -- Node3
  
     procedure Set_Then_Actions
       (N : Node_Id; Val : List_Id);            -- List2
  
--- 8677,8697 ----
     procedure Set_Subtype_Marks
       (N : Node_Id; Val : List_Id);            -- List2
  
+    procedure Set_Synchronized_Present
+      (N : Node_Id; Val : Boolean := True);    -- Flag7
+ 
     procedure Set_Tagged_Present
       (N : Node_Id; Val : Boolean := True);    -- Flag15
  
     procedure Set_Target_Type
       (N : Node_Id; Val : Entity_Id);          -- Node2
  
     procedure Set_Task_Definition
       (N : Node_Id; Val : Node_Id);            -- Node3
  
+    procedure Set_Task_Present
+      (N : Node_Id; Val : Boolean := True);    -- Flag5
+ 
     procedure Set_Then_Actions
       (N : Node_Id; Val : List_Id);            -- List2
  
*************** package Sinfo is
*** 8583,8588 ****
--- 8779,8785 ----
     pragma Inline (Actions);
     pragma Inline (Activation_Chain_Entity);
     pragma Inline (Acts_As_Spec);
+    pragma Inline (Actual_Designated_Subtype);
     pragma Inline (Aggregate_Bounds);
     pragma Inline (Aliased_Present);
     pragma Inline (All_Others);
*************** package Sinfo is
*** 8657,8663 ****
--- 8854,8862 ----
     pragma Inline (Do_Storage_Check);
     pragma Inline (Do_Tag_Check);
     pragma Inline (Elaborate_Present);
+    pragma Inline (Elaborate_All_Desirable);
     pragma Inline (Elaborate_All_Present);
+    pragma Inline (Elaborate_Desirable);
     pragma Inline (Elaboration_Boolean);
     pragma Inline (Else_Actions);
     pragma Inline (Else_Statements);
*************** package Sinfo is
*** 8713,8718 ****
--- 8912,8919 ----
     pragma Inline (High_Bound);
     pragma Inline (Identifier);
     pragma Inline (Implicit_With);
+    pragma Inline (Interface_List);
+    pragma Inline (Interface_Present);
     pragma Inline (Includes_Infinities);
     pragma Inline (In_Present);
     pragma Inline (Instance_Spec);
*************** package Sinfo is
*** 8749,8754 ****
--- 8950,8957 ----
     pragma Inline (More_Ids);
     pragma Inline (Must_Be_Byte_Aligned);
     pragma Inline (Must_Not_Freeze);
+    pragma Inline (Must_Not_Override);
+    pragma Inline (Must_Override);
     pragma Inline (Name);
     pragma Inline (Names);
     pragma Inline (Next_Entity);
*************** package Sinfo is
*** 8764,8770 ****
     pragma Inline (Null_Exclusion_Present);
     pragma Inline (Null_Record_Present);
     pragma Inline (Object_Definition);
-    pragma Inline (OK_For_Stream);
     pragma Inline (Original_Discriminant);
     pragma Inline (Original_Entity);
     pragma Inline (Others_Discrete_Choices);
--- 8967,8972 ----
*************** package Sinfo is
*** 8796,8801 ****
--- 8998,9004 ----
     pragma Inline (Reason);
     pragma Inline (Record_Extension_Part);
     pragma Inline (Redundant_Use);
+    pragma Inline (Result_Definition);
     pragma Inline (Return_Type);
     pragma Inline (Reverse_Present);
     pragma Inline (Right_Opnd);
*************** package Sinfo is
*** 8814,8823 ****
     pragma Inline (Subtype_Indication);
     pragma Inline (Subtype_Mark);
     pragma Inline (Subtype_Marks);
     pragma Inline (Tagged_Present);
     pragma Inline (Target_Type);
-    pragma Inline (Task_Body_Procedure);
     pragma Inline (Task_Definition);
     pragma Inline (Then_Actions);
     pragma Inline (Then_Statements);
     pragma Inline (Triggering_Alternative);
--- 9017,9027 ----
     pragma Inline (Subtype_Indication);
     pragma Inline (Subtype_Mark);
     pragma Inline (Subtype_Marks);
+    pragma Inline (Synchronized_Present);
     pragma Inline (Tagged_Present);
     pragma Inline (Target_Type);
     pragma Inline (Task_Definition);
+    pragma Inline (Task_Present);
     pragma Inline (Then_Actions);
     pragma Inline (Then_Statements);
     pragma Inline (Triggering_Alternative);
*************** package Sinfo is
*** 8846,8851 ****
--- 9050,9056 ----
     pragma Inline (Set_Actions);
     pragma Inline (Set_Activation_Chain_Entity);
     pragma Inline (Set_Acts_As_Spec);
+    pragma Inline (Set_Actual_Designated_Subtype);
     pragma Inline (Set_Aggregate_Bounds);
     pragma Inline (Set_Aliased_Present);
     pragma Inline (Set_All_Others);
*************** package Sinfo is
*** 8920,8926 ****
--- 9125,9133 ----
     pragma Inline (Set_Do_Storage_Check);
     pragma Inline (Set_Do_Tag_Check);
     pragma Inline (Set_Elaborate_Present);
+    pragma Inline (Set_Elaborate_All_Desirable);
     pragma Inline (Set_Elaborate_All_Present);
+    pragma Inline (Set_Elaborate_Desirable);
     pragma Inline (Set_Elaboration_Boolean);
     pragma Inline (Set_Else_Actions);
     pragma Inline (Set_Else_Statements);
*************** package Sinfo is
*** 8976,8981 ****
--- 9183,9190 ----
     pragma Inline (Set_Identifier);
     pragma Inline (Set_Implicit_With);
     pragma Inline (Set_Includes_Infinities);
+    pragma Inline (Set_Interface_List);
+    pragma Inline (Set_Interface_Present);
     pragma Inline (Set_In_Present);
     pragma Inline (Set_Instance_Spec);
     pragma Inline (Set_Intval);
*************** package Sinfo is
*** 9011,9016 ****
--- 9220,9227 ----
     pragma Inline (Set_More_Ids);
     pragma Inline (Set_Must_Be_Byte_Aligned);
     pragma Inline (Set_Must_Not_Freeze);
+    pragma Inline (Set_Must_Not_Override);
+    pragma Inline (Set_Must_Override);
     pragma Inline (Set_Name);
     pragma Inline (Set_Names);
     pragma Inline (Set_Next_Entity);
*************** package Sinfo is
*** 9025,9031 ****
     pragma Inline (Set_Null_Exclusion_Present);
     pragma Inline (Set_Null_Record_Present);
     pragma Inline (Set_Object_Definition);
-    pragma Inline (Set_OK_For_Stream);
     pragma Inline (Set_Original_Discriminant);
     pragma Inline (Set_Original_Entity);
     pragma Inline (Set_Others_Discrete_Choices);
--- 9236,9241 ----
*************** package Sinfo is
*** 9057,9062 ****
--- 9267,9273 ----
     pragma Inline (Set_Reason);
     pragma Inline (Set_Record_Extension_Part);
     pragma Inline (Set_Redundant_Use);
+    pragma Inline (Set_Result_Definition);
     pragma Inline (Set_Return_Type);
     pragma Inline (Set_Reverse_Present);
     pragma Inline (Set_Right_Opnd);
*************** package Sinfo is
*** 9075,9084 ****
     pragma Inline (Set_Subtype_Indication);
     pragma Inline (Set_Subtype_Mark);
     pragma Inline (Set_Subtype_Marks);
     pragma Inline (Set_Tagged_Present);
     pragma Inline (Set_Target_Type);
-    pragma Inline (Set_Task_Body_Procedure);
     pragma Inline (Set_Task_Definition);
     pragma Inline (Set_Then_Actions);
     pragma Inline (Set_Then_Statements);
     pragma Inline (Set_Triggering_Alternative);
--- 9286,9296 ----
     pragma Inline (Set_Subtype_Indication);
     pragma Inline (Set_Subtype_Mark);
     pragma Inline (Set_Subtype_Marks);
+    pragma Inline (Set_Synchronized_Present);
     pragma Inline (Set_Tagged_Present);
     pragma Inline (Set_Target_Type);
     pragma Inline (Set_Task_Definition);
+    pragma Inline (Set_Task_Present);
     pragma Inline (Set_Then_Actions);
     pragma Inline (Set_Then_Statements);
     pragma Inline (Set_Triggering_Alternative);
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-c.adb gcc-4.1.0/gcc/ada/sinput-c.adb
*** gcc-4.0.2/gcc/ada/sinput-c.adb	Thu Apr  1 10:04:40 2004
--- gcc-4.1.0/gcc/ada/sinput-c.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-c.ads gcc-4.1.0/gcc/ada/sinput-c.ads
*** gcc-4.0.2/gcc/ada/sinput-c.ads	Mon Feb 23 11:17:12 2004
--- gcc-4.1.0/gcc/ada/sinput-c.ads	Mon Sep  5 07:50:46 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,36 ****
  --  It is used by Sinput.P to load project files, and by GPrep to load
  --  preprocessor definition files and input files.
  
- with Types; use Types;
- 
  package Sinput.C is
  
     function Load_File (Path : String) return Source_File_Index;
--- 29,34 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-d.adb gcc-4.1.0/gcc/ada/sinput-d.adb
*** gcc-4.0.2/gcc/ada/sinput-d.adb	Tue Oct 21 13:42:22 2003
--- gcc-4.1.0/gcc/ada/sinput-d.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-d.ads gcc-4.1.0/gcc/ada/sinput-d.ads
*** gcc-4.0.2/gcc/ada/sinput-d.ads	Thu Apr 24 17:54:18 2003
--- gcc-4.1.0/gcc/ada/sinput-d.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-l.adb gcc-4.1.0/gcc/ada/sinput-l.adb
*** gcc-4.0.2/gcc/ada/sinput-l.adb	Mon Mar 29 12:03:22 2004
--- gcc-4.1.0/gcc/ada/sinput-l.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-l.ads gcc-4.1.0/gcc/ada/sinput-l.ads
*** gcc-4.0.2/gcc/ada/sinput-l.ads	Tue Jul  6 13:57:32 2004
--- gcc-4.1.0/gcc/ada/sinput-l.ads	Mon Sep  5 07:50:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 30,37 ****
  --  off into a child package to avoid a dependence of Sinput on Osint which
  --  would cause trouble in the tree read/write routines.
  
- with Types; use Types;
- 
  package Sinput.L is
  
     ------------------------------------------
--- 30,35 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-p.adb gcc-4.1.0/gcc/ada/sinput-p.adb
*** gcc-4.0.2/gcc/ada/sinput-p.adb	Mon Dec  8 10:33:16 2003
--- gcc-4.1.0/gcc/ada/sinput-p.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput-p.ads gcc-4.1.0/gcc/ada/sinput-p.ads
*** gcc-4.0.2/gcc/ada/sinput-p.ads	Tue Oct 21 13:42:22 2003
--- gcc-4.1.0/gcc/ada/sinput-p.ads	Mon Sep  5 07:50:46 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 29,35 ****
  --  routines to save and restore a project scan context.
  
  with Scans; use Scans;
- with Types; use Types;
  
  package Sinput.P is
  
--- 29,34 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput.adb gcc-4.1.0/gcc/ada/sinput.adb
*** gcc-4.0.2/gcc/ada/sinput.adb	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/sinput.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Sinput is
*** 86,92 ****
        LL : Physical_Line_Number;
  
     begin
!       --  Reallocate the lines tables if necessary.
  
        --  Note: the reason we do not use the normal Table package
        --  mechanism is that we have several of these tables. We could
--- 86,92 ----
        LL : Physical_Line_Number;
  
     begin
!       --  Reallocate the lines tables if necessary
  
        --  Note: the reason we do not use the normal Table package
        --  mechanism is that we have several of these tables. We could
diff -Nrcpad gcc-4.0.2/gcc/ada/sinput.ads gcc-4.1.0/gcc/ada/sinput.ads
*** gcc-4.0.2/gcc/ada/sinput.ads	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/sinput.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 655,661 ****
     --  we avoid the use of fat pointers.
  
     type Logical_Lines_Table_Ptr is access all Logical_Lines_Table_Type;
!    --  Type used for pointers to logical line tables.
  
     -----------------------
     -- Source_File Table --
--- 655,661 ----
     --  we avoid the use of fat pointers.
  
     type Logical_Lines_Table_Ptr is access all Logical_Lines_Table_Type;
!    --  Type used for pointers to logical line tables
  
     -----------------------
     -- Source_File Table --
diff -Nrcpad gcc-4.0.2/gcc/ada/snames.adb gcc-4.1.0/gcc/ada/snames.adb
*** gcc-4.0.2/gcc/ada/snames.adb	Thu Feb 10 13:50:20 2005
--- gcc-4.1.0/gcc/ada/snames.adb	Tue Nov 15 13:54:36 2005
***************
*** 1,1049 ****
! ------------------------------------------------------------------------------
! --                                                                          --
! --                         GNAT COMPILER COMPONENTS                         --
! --                                                                          --
! --                               S N A M E S                                --
! --                                                                          --
! --                                 B o d y                                  --
! --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
! --                                                                          --
! -- As a special exception,  if other files  instantiate  generics from this --
! -- unit, or you link  this unit with other files  to produce an executable, --
! -- this  unit  does not  by itself cause  the resulting  executable  to  be --
! -- covered  by the  GNU  General  Public  License.  This exception does not --
! -- however invalidate  any other reasons why  the executable file  might be --
! -- covered by the  GNU Public License.                                      --
! --                                                                          --
! -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
! --                                                                          --
! ------------------------------------------------------------------------------
! 
! with Namet; use Namet;
! with Table;
! 
! package body Snames is
! 
!    --  Table used to record convention identifiers
! 
!    type Convention_Id_Entry is record
!       Name       : Name_Id;
!       Convention : Convention_Id;
!    end record;
! 
!    package Convention_Identifiers is new Table.Table (
!      Table_Component_Type => Convention_Id_Entry,
!      Table_Index_Type     => Int,
!      Table_Low_Bound      => 1,
!      Table_Initial        => 50,
!      Table_Increment      => 200,
!      Table_Name           => "Name_Convention_Identifiers");
! 
!    --  Table of names to be set by Initialize. Each name is terminated by a
!    --  single #, and the end of the list is marked by a null entry, i.e. by
!    --  two # marks in succession. Note that the table does not include the
!    --  entries for a-z, since these are initialized by Namet itself.
! 
!    Preset_Names : constant String :=
!      "_parent#" &
!      "_tag#" &
!      "off#" &
!      "space#" &
!      "time#" &
!      "_abort_signal#" &
!      "_alignment#" &
!      "_assign#" &
!      "_atcb#" &
!      "_chain#" &
!      "_clean#" &
!      "_controller#" &
!      "_entry_bodies#" &
!      "_expunge#" &
!      "_final_list#" &
!      "_idepth#" &
!      "_init#" &
!      "_local_final_list#" &
!      "_master#" &
!      "_object#" &
!      "_priority#" &
!      "_process_atsd#" &
!      "_secondary_stack#" &
!      "_service#" &
!      "_size#" &
!      "_stack#" &
!      "_tags#" &
!      "_task#" &
!      "_task_id#" &
!      "_task_info#" &
!      "_task_name#" &
!      "_trace_sp#" &
!      "initialize#" &
!      "adjust#" &
!      "finalize#" &
!      "next#" &
!      "prev#" &
!      "_typecode#" &
!      "_from_any#" &
!      "_to_any#" &
!      "allocate#" &
!      "deallocate#" &
!      "dereference#" &
!      "decimal_io#" &
!      "enumeration_io#" &
!      "fixed_io#" &
!      "float_io#" &
!      "integer_io#" &
!      "modular_io#" &
!      "const#" &
!      "<error>#" &
!      "go#" &
!      "put#" &
!      "put_line#" &
!      "to#" &
!      "finalization#" &
!      "finalization_root#" &
!      "interfaces#" &
!      "standard#" &
!      "system#" &
!      "text_io#" &
!      "wide_text_io#" &
!      "wide_wide_text_io#" &
!      "no_dsa#" &
!      "garlic_dsa#" &
!      "polyorb_dsa#" &
!      "addr#" &
!      "async#" &
!      "get_active_partition_id#" &
!      "get_rci_package_receiver#" &
!      "get_rci_package_ref#" &
!      "origin#" &
!      "params#" &
!      "partition#" &
!      "partition_interface#" &
!      "ras#" &
!      "call#" &
!      "rci_name#" &
!      "receiver#" &
!      "result#" &
!      "rpc#" &
!      "subp_id#" &
!      "operation#" &
!      "argument#" &
!      "arg_modes#" &
!      "handler#" &
!      "target#" &
!      "req#" &
!      "obj_typecode#" &
!      "stub#" &
!      "Oabs#" &
!      "Oand#" &
!      "Omod#" &
!      "Onot#" &
!      "Oor#" &
!      "Orem#" &
!      "Oxor#" &
!      "Oeq#" &
!      "One#" &
!      "Olt#" &
!      "Ole#" &
!      "Ogt#" &
!      "Oge#" &
!      "Oadd#" &
!      "Osubtract#" &
!      "Oconcat#" &
!      "Omultiply#" &
!      "Odivide#" &
!      "Oexpon#" &
!      "ada_83#" &
!      "ada_95#" &
!      "ada_05#" &
!      "c_pass_by_copy#" &
!      "compile_time_warning#" &
!      "component_alignment#" &
!      "convention_identifier#" &
!      "detect_blocking#" &
!      "discard_names#" &
!      "elaboration_checks#" &
!      "eliminate#" &
!      "explicit_overriding#" &
!      "extend_system#" &
!      "extensions_allowed#" &
!      "external_name_casing#" &
!      "float_representation#" &
!      "initialize_scalars#" &
!      "interrupt_state#" &
!      "license#" &
!      "locking_policy#" &
!      "long_float#" &
!      "no_run_time#" &
!      "no_strict_aliasing#" &
!      "normalize_scalars#" &
!      "polling#" &
!      "persistent_data#" &
!      "persistent_object#" &
!      "profile#" &
!      "profile_warnings#" &
!      "propagate_exceptions#" &
!      "queuing_policy#" &
!      "ravenscar#" &
!      "restricted_run_time#" &
!      "restrictions#" &
!      "restriction_warnings#" &
!      "reviewable#" &
!      "source_file_name#" &
!      "source_file_name_project#" &
!      "style_checks#" &
!      "suppress#" &
!      "suppress_exception_locations#" &
!      "task_dispatching_policy#" &
!      "universal_data#" &
!      "unsuppress#" &
!      "use_vads_size#" &
!      "validity_checks#" &
!      "warnings#" &
!      "abort_defer#" &
!      "all_calls_remote#" &
!      "annotate#" &
!      "assert#" &
!      "asynchronous#" &
!      "atomic#" &
!      "atomic_components#" &
!      "attach_handler#" &
!      "comment#" &
!      "common_object#" &
!      "complex_representation#" &
!      "controlled#" &
!      "convention#" &
!      "cpp_class#" &
!      "cpp_constructor#" &
!      "cpp_virtual#" &
!      "cpp_vtable#" &
!      "debug#" &
!      "elaborate#" &
!      "elaborate_all#" &
!      "elaborate_body#" &
!      "export#" &
!      "export_exception#" &
!      "export_function#" &
!      "export_object#" &
!      "export_procedure#" &
!      "export_value#" &
!      "export_valued_procedure#" &
!      "external#" &
!      "finalize_storage_only#" &
!      "ident#" &
!      "import#" &
!      "import_exception#" &
!      "import_function#" &
!      "import_object#" &
!      "import_procedure#" &
!      "import_valued_procedure#" &
!      "inline#" &
!      "inline_always#" &
!      "inline_generic#" &
!      "inspection_point#" &
!      "interface_name#" &
!      "interrupt_handler#" &
!      "interrupt_priority#" &
!      "java_constructor#" &
!      "java_interface#" &
!      "keep_names#" &
!      "link_with#" &
!      "linker_alias#" &
!      "linker_options#" &
!      "linker_section#" &
!      "list#" &
!      "machine_attribute#" &
!      "main#" &
!      "main_storage#" &
!      "memory_size#" &
!      "no_return#" &
!      "obsolescent#" &
!      "optimize#" &
!      "optional_overriding#" &
!      "pack#" &
!      "page#" &
!      "passive#" &
!      "preelaborate#" &
!      "priority#" &
!      "psect_object#" &
!      "pure#" &
!      "pure_function#" &
!      "remote_call_interface#" &
!      "remote_types#" &
!      "share_generic#" &
!      "shared#" &
!      "shared_passive#" &
!      "source_reference#" &
!      "stream_convert#" &
!      "subtitle#" &
!      "suppress_all#" &
!      "suppress_debug_info#" &
!      "suppress_initialization#" &
!      "system_name#" &
!      "task_info#" &
!      "task_name#" &
!      "task_storage#" &
!      "thread_body#" &
!      "time_slice#" &
!      "title#" &
!      "unchecked_union#" &
!      "unimplemented_unit#" &
!      "unreferenced#" &
!      "unreserve_all_interrupts#" &
!      "volatile#" &
!      "volatile_components#" &
!      "weak_external#" &
!      "ada#" &
!      "assembler#" &
!      "cobol#" &
!      "cpp#" &
!      "fortran#" &
!      "intrinsic#" &
!      "java#" &
!      "stdcall#" &
!      "stubbed#" &
!      "asm#" &
!      "assembly#" &
!      "default#" &
!      "dll#" &
!      "win32#" &
!      "as_is#" &
!      "body_file_name#" &
!      "boolean_entry_barriers#" &
!      "casing#" &
!      "code#" &
!      "component#" &
!      "component_size_4#" &
!      "copy#" &
!      "d_float#" &
!      "descriptor#" &
!      "dot_replacement#" &
!      "dynamic#" &
!      "entity#" &
!      "external_name#" &
!      "first_optional_parameter#" &
!      "form#" &
!      "g_float#" &
!      "gcc#" &
!      "gnat#" &
!      "gpl#" &
!      "ieee_float#" &
!      "internal#" &
!      "link_name#" &
!      "lowercase#" &
!      "max_entry_queue_depth#" &
!      "max_entry_queue_length#" &
!      "max_size#" &
!      "mechanism#" &
!      "mixedcase#" &
!      "modified_gpl#" &
!      "name#" &
!      "nca#" &
!      "no#" &
!      "no_dependence#" &
!      "no_dynamic_attachment#" &
!      "no_dynamic_interrupts#" &
!      "no_requeue#" &
!      "no_requeue_statements#" &
!      "no_task_attributes#" &
!      "no_task_attributes_package#" &
!      "on#" &
!      "parameter_types#" &
!      "reference#" &
!      "restricted#" &
!      "result_mechanism#" &
!      "result_type#" &
!      "runtime#" &
!      "sb#" &
!      "secondary_stack_size#" &
!      "section#" &
!      "semaphore#" &
!      "simple_barriers#" &
!      "spec_file_name#" &
!      "static#" &
!      "stack_size#" &
!      "subunit_file_name#" &
!      "task_stack_size_default#" &
!      "task_type#" &
!      "time_slicing_enabled#" &
!      "top_guard#" &
!      "uba#" &
!      "ubs#" &
!      "ubsb#" &
!      "unit_name#" &
!      "unknown#" &
!      "unrestricted#" &
!      "uppercase#" &
!      "user#" &
!      "vax_float#" &
!      "vms#" &
!      "working_storage#" &
!      "abort_signal#" &
!      "access#" &
!      "address#" &
!      "address_size#" &
!      "aft#" &
!      "alignment#" &
!      "asm_input#" &
!      "asm_output#" &
!      "ast_entry#" &
!      "bit#" &
!      "bit_order#" &
!      "bit_position#" &
!      "body_version#" &
!      "callable#" &
!      "caller#" &
!      "code_address#" &
!      "component_size#" &
!      "compose#" &
!      "constrained#" &
!      "count#" &
!      "default_bit_order#" &
!      "definite#" &
!      "delta#" &
!      "denorm#" &
!      "digits#" &
!      "elaborated#" &
!      "emax#" &
!      "enum_rep#" &
!      "epsilon#" &
!      "exponent#" &
!      "external_tag#" &
!      "first#" &
!      "first_bit#" &
!      "fixed_value#" &
!      "fore#" &
!      "has_access_values#" &
!      "has_discriminants#" &
!      "identity#" &
!      "img#" &
!      "integer_value#" &
!      "large#" &
!      "last#" &
!      "last_bit#" &
!      "leading_part#" &
!      "length#" &
!      "machine_emax#" &
!      "machine_emin#" &
!      "machine_mantissa#" &
!      "machine_overflows#" &
!      "machine_radix#" &
!      "machine_rounds#" &
!      "machine_size#" &
!      "mantissa#" &
!      "max_size_in_storage_elements#" &
!      "maximum_alignment#" &
!      "mechanism_code#" &
!      "mod#" &
!      "model_emin#" &
!      "model_epsilon#" &
!      "model_mantissa#" &
!      "model_small#" &
!      "modulus#" &
!      "null_parameter#" &
!      "object_size#" &
!      "partition_id#" &
!      "passed_by_reference#" &
!      "pool_address#" &
!      "pos#" &
!      "position#" &
!      "range#" &
!      "range_length#" &
!      "round#" &
!      "safe_emax#" &
!      "safe_first#" &
!      "safe_large#" &
!      "safe_last#" &
!      "safe_small#" &
!      "scale#" &
!      "scaling#" &
!      "signed_zeros#" &
!      "size#" &
!      "small#" &
!      "storage_size#" &
!      "storage_unit#" &
!      "stream_size#" &
!      "tag#" &
!      "target_name#" &
!      "terminated#" &
!      "to_address#" &
!      "type_class#" &
!      "uet_address#" &
!      "unbiased_rounding#" &
!      "unchecked_access#" &
!      "unconstrained_array#" &
!      "universal_literal_string#" &
!      "unrestricted_access#" &
!      "vads_size#" &
!      "val#" &
!      "valid#" &
!      "value_size#" &
!      "version#" &
!      "wchar_t_size#" &
!      "wide_wide_width#" &
!      "wide_width#" &
!      "width#" &
!      "word_size#" &
!      "adjacent#" &
!      "ceiling#" &
!      "copy_sign#" &
!      "floor#" &
!      "fraction#" &
!      "image#" &
!      "input#" &
!      "machine#" &
!      "max#" &
!      "min#" &
!      "model#" &
!      "pred#" &
!      "remainder#" &
!      "rounding#" &
!      "succ#" &
!      "truncation#" &
!      "value#" &
!      "wide_image#" &
!      "wide_wide_image#" &
!      "wide_value#" &
!      "wide_wide_value#" &
!      "output#" &
!      "read#" &
!      "write#" &
!      "elab_body#" &
!      "elab_spec#" &
!      "storage_pool#" &
!      "base#" &
!      "class#" &
!      "ceiling_locking#" &
!      "inheritance_locking#" &
!      "fifo_queuing#" &
!      "priority_queuing#" &
!      "fifo_within_priorities#" &
!      "access_check#" &
!      "accessibility_check#" &
!      "discriminant_check#" &
!      "division_check#" &
!      "elaboration_check#" &
!      "index_check#" &
!      "length_check#" &
!      "overflow_check#" &
!      "range_check#" &
!      "storage_check#" &
!      "tag_check#" &
!      "all_checks#" &
!      "abort#" &
!      "abs#" &
!      "accept#" &
!      "and#" &
!      "all#" &
!      "array#" &
!      "at#" &
!      "begin#" &
!      "body#" &
!      "case#" &
!      "constant#" &
!      "declare#" &
!      "delay#" &
!      "do#" &
!      "else#" &
!      "elsif#" &
!      "end#" &
!      "entry#" &
!      "exception#" &
!      "exit#" &
!      "for#" &
!      "function#" &
!      "generic#" &
!      "goto#" &
!      "if#" &
!      "in#" &
!      "is#" &
!      "limited#" &
!      "loop#" &
!      "new#" &
!      "not#" &
!      "null#" &
!      "of#" &
!      "or#" &
!      "others#" &
!      "out#" &
!      "package#" &
!      "pragma#" &
!      "private#" &
!      "procedure#" &
!      "raise#" &
!      "record#" &
!      "rem#" &
!      "renames#" &
!      "return#" &
!      "reverse#" &
!      "select#" &
!      "separate#" &
!      "subtype#" &
!      "task#" &
!      "terminate#" &
!      "then#" &
!      "type#" &
!      "use#" &
!      "when#" &
!      "while#" &
!      "with#" &
!      "xor#" &
!      "divide#" &
!      "enclosing_entity#" &
!      "exception_information#" &
!      "exception_message#" &
!      "exception_name#" &
!      "file#" &
!      "import_address#" &
!      "import_largest_value#" &
!      "import_value#" &
!      "is_negative#" &
!      "line#" &
!      "rotate_left#" &
!      "rotate_right#" &
!      "shift_left#" &
!      "shift_right#" &
!      "shift_right_arithmetic#" &
!      "source_location#" &
!      "unchecked_conversion#" &
!      "unchecked_deallocation#" &
!      "to_pointer#" &
!      "abstract#" &
!      "aliased#" &
!      "protected#" &
!      "until#" &
!      "requeue#" &
!      "tagged#" &
!      "raise_exception#" &
!      "ada_roots#" &
!      "binder#" &
!      "binder_driver#" &
!      "body_suffix#" &
!      "builder#" &
!      "compiler#" &
!      "compiler_driver#" &
!      "compiler_kind#" &
!      "compute_dependency#" &
!      "cross_reference#" &
!      "default_linker#" &
!      "default_switches#" &
!      "dependency_option#" &
!      "exec_dir#" &
!      "executable#" &
!      "executable_suffix#" &
!      "extends#" &
!      "externally_built#" &
!      "finder#" &
!      "global_configuration_pragmas#" &
!      "gnatls#" &
!      "gnatstub#" &
!      "implementation#" &
!      "implementation_exceptions#" &
!      "implementation_suffix#" &
!      "include_option#" &
!      "language_processing#" &
!      "languages#" &
!      "library_dir#" &
!      "library_auto_init#" &
!      "library_gcc#" &
!      "library_interface#" &
!      "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#" &
!      "locally_removed_files#" &
!      "metrics#" &
!      "naming#" &
!      "object_dir#" &
!      "pretty_printer#" &
!      "project#" &
!      "separate_suffix#" &
!      "source_dirs#" &
!      "source_files#" &
!      "source_list_file#" &
!      "spec#" &
!      "spec_suffix#" &
!      "specification#" &
!      "specification_exceptions#" &
!      "specification_suffix#" &
!      "switches#" &
!      "unaligned_valid#" &
!      "interface#" &
!      "overriding#" &
!      "synchronized#" &
!      "#";
! 
!    ---------------------
!    -- Generated Names --
!    ---------------------
! 
!    --  This section lists the various cases of generated names which are
!    --  built from existing names by adding unique leading and/or trailing
!    --  upper case letters. In some cases these names are built recursively,
!    --  in particular names built from types may be built from types which
!    --  themselves have generated names. In this list, xxx represents an
!    --  existing name to which identifying letters are prepended or appended,
!    --  and a trailing n represents a serial number in an external name that
!    --  has some semantic significance (e.g. the n'th index type of an array).
! 
!    --    xxxA    access type for formal xxx in entry param record   (Exp_Ch9)
!    --    xxxB    tag table for tagged type xxx                      (Exp_Ch3)
!    --    xxxB    task body procedure for task xxx                   (Exp_Ch9)
!    --    xxxD    dispatch table for tagged type xxx                 (Exp_Ch3)
!    --    xxxD    discriminal for discriminant xxx                   (Sem_Ch3)
!    --    xxxDn   n'th discr check function for rec type xxx         (Exp_Ch3)
!    --    xxxE    elaboration boolean flag for task xxx              (Exp_Ch9)
!    --    xxxE    dispatch table pointer type for tagged type xxx    (Exp_Ch3)
!    --    xxxE    parameters for accept body for entry xxx           (Exp_Ch9)
!    --    xxxFn   n'th primitive of a tagged type (named xxx)        (Exp_Ch3)
!    --    xxxJ    tag table type index for tagged type xxx           (Exp_Ch3)
!    --    xxxM    master Id value for access type xxx                (Exp_Ch3)
!    --    xxxP    tag table pointer type for tagged type xxx         (Exp_Ch3)
!    --    xxxP    parameter record type for entry xxx                (Exp_Ch9)
!    --    xxxPA   access to parameter record type for entry xxx      (Exp_Ch9)
!    --    xxxPn   pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
!    --    xxxR    dispatch table pointer for tagged type xxx         (Exp_Ch3)
!    --    xxxT    tag table type for tagged type xxx                 (Exp_Ch3)
!    --    xxxT    literal table for enumeration type xxx             (Sem_Ch3)
!    --    xxxV    type for task value record for task xxx            (Exp_Ch9)
!    --    xxxX    entry index constant                               (Exp_Ch9)
!    --    xxxY    dispatch table type for tagged type xxx            (Exp_Ch3)
!    --    xxxZ    size variable for task xxx                         (Exp_Ch9)
! 
!    --  TSS names
! 
!    --    xxxDA   deep adjust routine for type xxx                   (Exp_TSS)
!    --    xxxDF   deep finalize routine for type xxx                 (Exp_TSS)
!    --    xxxDI   deep initialize routine for type xxx               (Exp_TSS)
!    --    xxxEQ   composite equality routine for record type xxx     (Exp_TSS)
!    --    xxxIP   initialization procedure for type xxx              (Exp_TSS)
!    --    xxxRA   RAs type access routine for type xxx               (Exp_TSS)
!    --    xxxRD   RAs type dereference routine for type xxx          (Exp_TSS)
!    --    xxxRP   Rep to Pos conversion for enumeration type xxx     (Exp_TSS)
!    --    xxxSA   array/slice assignment for controlled comp. arrays (Exp_TSS)
!    --    xxxSI   stream input attribute subprogram for type xxx     (Exp_TSS)
!    --    xxxSO   stream output attribute subprogram for type xxx    (Exp_TSS)
!    --    xxxSR   stream read attribute subprogram for type xxx      (Exp_TSS)
!    --    xxxSW   stream write attribute subprogram for type xxx     (Exp_TSS)
! 
!    --  Implicit type names
! 
!    --    TxxxT   type of literal table for enumeration type xxx     (Sem_Ch3)
! 
!    --  (Note: this list is not complete or accurate ???)
! 
!    ----------------------
!    -- Get_Attribute_Id --
!    ----------------------
! 
!    function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
!    begin
!       return Attribute_Id'Val (N - First_Attribute_Name);
!    end Get_Attribute_Id;
! 
!    ------------------
!    -- Get_Check_Id --
!    ------------------
! 
!    function Get_Check_Id (N : Name_Id) return Check_Id is
!    begin
!       return Check_Id'Val (N - First_Check_Name);
!    end Get_Check_Id;
! 
!    -----------------------
!    -- Get_Convention_Id --
!    -----------------------
! 
!    function Get_Convention_Id (N : Name_Id) return Convention_Id is
!    begin
!       case N is
!          when Name_Ada        => return Convention_Ada;
!          when Name_Assembler  => return Convention_Assembler;
!          when Name_C          => return Convention_C;
!          when Name_COBOL      => return Convention_COBOL;
!          when Name_CPP        => return Convention_CPP;
!          when Name_Fortran    => return Convention_Fortran;
!          when Name_Intrinsic  => return Convention_Intrinsic;
!          when Name_Java       => return Convention_Java;
!          when Name_Stdcall    => return Convention_Stdcall;
!          when Name_Stubbed    => return Convention_Stubbed;
! 
!          --  If no direct match, then we must have a convention
!          --  identifier pragma that has specified this name.
! 
!          when others          =>
!             for J in 1 .. Convention_Identifiers.Last loop
!                if N = Convention_Identifiers.Table (J).Name then
!                   return Convention_Identifiers.Table (J).Convention;
!                end if;
!             end loop;
! 
!             raise Program_Error;
!       end case;
!    end Get_Convention_Id;
! 
!    ---------------------------
!    -- Get_Locking_Policy_Id --
!    ---------------------------
! 
!    function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
!    begin
!       return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
!    end Get_Locking_Policy_Id;
! 
!    -------------------
!    -- Get_Pragma_Id --
!    -------------------
! 
!    function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
!    begin
!       if N = Name_AST_Entry then
!          return Pragma_AST_Entry;
!       elsif N = Name_Interface then
!          return Pragma_Interface;
!       elsif N = Name_Storage_Size then
!          return Pragma_Storage_Size;
!       elsif N = Name_Storage_Unit then
!          return Pragma_Storage_Unit;
!       elsif N not in First_Pragma_Name .. Last_Pragma_Name then
!          return Unknown_Pragma;
!       else
!          return Pragma_Id'Val (N - First_Pragma_Name);
!       end if;
!    end Get_Pragma_Id;
! 
!    ---------------------------
!    -- Get_Queuing_Policy_Id --
!    ---------------------------
! 
!    function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
!    begin
!       return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
!    end Get_Queuing_Policy_Id;
! 
!    ------------------------------------
!    -- Get_Task_Dispatching_Policy_Id --
!    ------------------------------------
! 
!    function Get_Task_Dispatching_Policy_Id (N : Name_Id)
!      return Task_Dispatching_Policy_Id is
!    begin
!       return Task_Dispatching_Policy_Id'Val
!         (N - First_Task_Dispatching_Policy_Name);
!    end Get_Task_Dispatching_Policy_Id;
! 
!    ----------------
!    -- Initialize --
!    ----------------
! 
!    procedure Initialize is
!       P_Index      : Natural;
!       Discard_Name : Name_Id;
! 
!    begin
!       P_Index := Preset_Names'First;
! 
!       loop
!          Name_Len := 0;
! 
!          while Preset_Names (P_Index) /= '#' loop
!             Name_Len := Name_Len + 1;
!             Name_Buffer (Name_Len) := Preset_Names (P_Index);
!             P_Index := P_Index + 1;
!          end loop;
! 
!          --  We do the Name_Find call to enter the name into the table, but
!          --  we don't need to do anything with the result, since we already
!          --  initialized all the preset names to have the right value (we
!          --  are depending on the order of the names and Preset_Names).
! 
!          Discard_Name := Name_Find;
!          P_Index := P_Index + 1;
!          exit when Preset_Names (P_Index) = '#';
!       end loop;
! 
!       --  Make sure that number of names in standard table is correct. If
!       --  this check fails, run utility program XSNAMES to construct a new
!       --  properly matching version of the body.
! 
!       pragma Assert (Discard_Name = Last_Predefined_Name);
! 
!       --  Initialize the convention identifiers table with the standard
!       --  set of synonyms that we recognize for conventions.
! 
!       Convention_Identifiers.Init;
! 
!       Convention_Identifiers.Append ((Name_Asm,      Convention_Assembler));
!       Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
! 
!       Convention_Identifiers.Append ((Name_Default,  Convention_C));
!       Convention_Identifiers.Append ((Name_External, Convention_C));
! 
!       Convention_Identifiers.Append ((Name_DLL,      Convention_Stdcall));
!       Convention_Identifiers.Append ((Name_Win32,    Convention_Stdcall));
!    end Initialize;
! 
!    -----------------------
!    -- Is_Attribute_Name --
!    -----------------------
! 
!    function Is_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Attribute_Name .. Last_Attribute_Name;
!    end Is_Attribute_Name;
! 
!    -------------------
!    -- Is_Check_Name --
!    -------------------
! 
!    function Is_Check_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Check_Name .. Last_Check_Name;
!    end Is_Check_Name;
! 
!    ------------------------
!    -- Is_Convention_Name --
!    ------------------------
! 
!    function Is_Convention_Name (N : Name_Id) return Boolean is
!    begin
!       --  Check if this is one of the standard conventions
! 
!       if N in First_Convention_Name .. Last_Convention_Name
!         or else N = Name_C
!       then
!          return True;
! 
!       --  Otherwise check if it is in convention identifier table
! 
!       else
!          for J in 1 .. Convention_Identifiers.Last loop
!             if N = Convention_Identifiers.Table (J).Name then
!                return True;
!             end if;
!          end loop;
! 
!          return False;
!       end if;
!    end Is_Convention_Name;
! 
!    ------------------------------
!    -- Is_Entity_Attribute_Name --
!    ------------------------------
! 
!    function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
!    end Is_Entity_Attribute_Name;
! 
!    --------------------------------
!    -- Is_Function_Attribute_Name --
!    --------------------------------
! 
!    function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in
!         First_Renamable_Function_Attribute ..
!           Last_Renamable_Function_Attribute;
!    end Is_Function_Attribute_Name;
! 
!    ----------------------------
!    -- Is_Locking_Policy_Name --
!    ----------------------------
! 
!    function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
!    end Is_Locking_Policy_Name;
! 
!    -----------------------------
!    -- Is_Operator_Symbol_Name --
!    -----------------------------
! 
!    function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Operator_Name .. Last_Operator_Name;
!    end Is_Operator_Symbol_Name;
! 
!    --------------------
!    -- Is_Pragma_Name --
!    --------------------
! 
!    function Is_Pragma_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Pragma_Name .. Last_Pragma_Name
!         or else N = Name_AST_Entry
!         or else N = Name_Interface
!         or else N = Name_Storage_Size
!         or else N = Name_Storage_Unit;
!    end Is_Pragma_Name;
! 
!    ---------------------------------
!    -- Is_Procedure_Attribute_Name --
!    ---------------------------------
! 
!    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
!    end Is_Procedure_Attribute_Name;
! 
!    ----------------------------
!    -- Is_Queuing_Policy_Name --
!    ----------------------------
! 
!    function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
!    end Is_Queuing_Policy_Name;
! 
!    -------------------------------------
!    -- Is_Task_Dispatching_Policy_Name --
!    -------------------------------------
! 
!    function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Task_Dispatching_Policy_Name ..
!                   Last_Task_Dispatching_Policy_Name;
!    end Is_Task_Dispatching_Policy_Name;
! 
!    ----------------------------
!    -- Is_Type_Attribute_Name --
!    ----------------------------
! 
!    function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
!    end Is_Type_Attribute_Name;
! 
!    ----------------------------------
!    -- Record_Convention_Identifier --
!    ----------------------------------
! 
!    procedure Record_Convention_Identifier
!      (Id         : Name_Id;
!       Convention : Convention_Id)
!    is
!    begin
!       Convention_Identifiers.Append ((Id, Convention));
!    end Record_Convention_Identifier;
! 
! end Snames;
--- 1,1074 ----
! ------------------------------------------------------------------------------
! --                                                                          --
! --                         GNAT COMPILER COMPONENTS                         --
! --                                                                          --
! --                               S N A M E S                                --
! --                                                                          --
! --                                 B o d y                                  --
! --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
! --                                                                          --
! -- As a special exception,  if other files  instantiate  generics from this --
! -- unit, or you link  this unit with other files  to produce an executable, --
! -- this  unit  does not  by itself cause  the resulting  executable  to  be --
! -- covered  by the  GNU  General  Public  License.  This exception does not --
! -- however invalidate  any other reasons why  the executable file  might be --
! -- covered by the  GNU Public License.                                      --
! --                                                                          --
! -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
! --                                                                          --
! ------------------------------------------------------------------------------
! 
! with Namet; use Namet;
! with Table;
! 
! package body Snames is
! 
!    --  Table used to record convention identifiers
! 
!    type Convention_Id_Entry is record
!       Name       : Name_Id;
!       Convention : Convention_Id;
!    end record;
! 
!    package Convention_Identifiers is new Table.Table (
!      Table_Component_Type => Convention_Id_Entry,
!      Table_Index_Type     => Int,
!      Table_Low_Bound      => 1,
!      Table_Initial        => 50,
!      Table_Increment      => 200,
!      Table_Name           => "Name_Convention_Identifiers");
! 
!    --  Table of names to be set by Initialize. Each name is terminated by a
!    --  single #, and the end of the list is marked by a null entry, i.e. by
!    --  two # marks in succession. Note that the table does not include the
!    --  entries for a-z, since these are initialized by Namet itself.
! 
!    Preset_Names : constant String :=
!      "_parent#" &
!      "_tag#" &
!      "off#" &
!      "space#" &
!      "time#" &
!      "_abort_signal#" &
!      "_alignment#" &
!      "_assign#" &
!      "_atcb#" &
!      "_chain#" &
!      "_clean#" &
!      "_controller#" &
!      "_entry_bodies#" &
!      "_expunge#" &
!      "_final_list#" &
!      "_idepth#" &
!      "_init#" &
!      "_local_final_list#" &
!      "_master#" &
!      "_object#" &
!      "_priority#" &
!      "_process_atsd#" &
!      "_secondary_stack#" &
!      "_service#" &
!      "_size#" &
!      "_stack#" &
!      "_tags#" &
!      "_task#" &
!      "_task_id#" &
!      "_task_info#" &
!      "_task_name#" &
!      "_trace_sp#" &
!      "_disp_asynchronous_select#" &
!      "_disp_conditional_select#" &
!      "_disp_get_prim_op_kind#" &
!      "_disp_timed_select#" &
!      "_disp_get_task_id#" &
!      "initialize#" &
!      "adjust#" &
!      "finalize#" &
!      "next#" &
!      "prev#" &
!      "_typecode#" &
!      "_from_any#" &
!      "_to_any#" &
!      "allocate#" &
!      "deallocate#" &
!      "dereference#" &
!      "decimal_io#" &
!      "enumeration_io#" &
!      "fixed_io#" &
!      "float_io#" &
!      "integer_io#" &
!      "modular_io#" &
!      "const#" &
!      "<error>#" &
!      "go#" &
!      "put#" &
!      "put_line#" &
!      "to#" &
!      "finalization#" &
!      "finalization_root#" &
!      "interfaces#" &
!      "standard#" &
!      "system#" &
!      "text_io#" &
!      "wide_text_io#" &
!      "wide_wide_text_io#" &
!      "no_dsa#" &
!      "garlic_dsa#" &
!      "polyorb_dsa#" &
!      "addr#" &
!      "async#" &
!      "get_active_partition_id#" &
!      "get_rci_package_receiver#" &
!      "get_rci_package_ref#" &
!      "origin#" &
!      "params#" &
!      "partition#" &
!      "partition_interface#" &
!      "ras#" &
!      "call#" &
!      "rci_name#" &
!      "receiver#" &
!      "result#" &
!      "rpc#" &
!      "subp_id#" &
!      "operation#" &
!      "argument#" &
!      "arg_modes#" &
!      "handler#" &
!      "target#" &
!      "req#" &
!      "obj_typecode#" &
!      "stub#" &
!      "Oabs#" &
!      "Oand#" &
!      "Omod#" &
!      "Onot#" &
!      "Oor#" &
!      "Orem#" &
!      "Oxor#" &
!      "Oeq#" &
!      "One#" &
!      "Olt#" &
!      "Ole#" &
!      "Ogt#" &
!      "Oge#" &
!      "Oadd#" &
!      "Osubtract#" &
!      "Oconcat#" &
!      "Omultiply#" &
!      "Odivide#" &
!      "Oexpon#" &
!      "ada_83#" &
!      "ada_95#" &
!      "ada_05#" &
!      "assertion_policy#" &
!      "c_pass_by_copy#" &
!      "compile_time_warning#" &
!      "component_alignment#" &
!      "convention_identifier#" &
!      "debug_policy#" &
!      "detect_blocking#" &
!      "discard_names#" &
!      "elaboration_checks#" &
!      "eliminate#" &
!      "explicit_overriding#" &
!      "extend_system#" &
!      "extensions_allowed#" &
!      "external_name_casing#" &
!      "float_representation#" &
!      "initialize_scalars#" &
!      "interrupt_state#" &
!      "license#" &
!      "locking_policy#" &
!      "long_float#" &
!      "no_run_time#" &
!      "no_strict_aliasing#" &
!      "normalize_scalars#" &
!      "polling#" &
!      "persistent_bss#" &
!      "profile#" &
!      "profile_warnings#" &
!      "propagate_exceptions#" &
!      "queuing_policy#" &
!      "ravenscar#" &
!      "restricted_run_time#" &
!      "restrictions#" &
!      "restriction_warnings#" &
!      "reviewable#" &
!      "source_file_name#" &
!      "source_file_name_project#" &
!      "style_checks#" &
!      "suppress#" &
!      "suppress_exception_locations#" &
!      "task_dispatching_policy#" &
!      "universal_data#" &
!      "unsuppress#" &
!      "use_vads_size#" &
!      "validity_checks#" &
!      "warnings#" &
!      "abort_defer#" &
!      "all_calls_remote#" &
!      "annotate#" &
!      "assert#" &
!      "asynchronous#" &
!      "atomic#" &
!      "atomic_components#" &
!      "attach_handler#" &
!      "comment#" &
!      "common_object#" &
!      "complex_representation#" &
!      "controlled#" &
!      "convention#" &
!      "cpp_class#" &
!      "cpp_constructor#" &
!      "cpp_virtual#" &
!      "cpp_vtable#" &
!      "debug#" &
!      "elaborate#" &
!      "elaborate_all#" &
!      "elaborate_body#" &
!      "export#" &
!      "export_exception#" &
!      "export_function#" &
!      "export_object#" &
!      "export_procedure#" &
!      "export_value#" &
!      "export_valued_procedure#" &
!      "external#" &
!      "finalize_storage_only#" &
!      "ident#" &
!      "import#" &
!      "import_exception#" &
!      "import_function#" &
!      "import_object#" &
!      "import_procedure#" &
!      "import_valued_procedure#" &
!      "inline#" &
!      "inline_always#" &
!      "inline_generic#" &
!      "inspection_point#" &
!      "interface_name#" &
!      "interrupt_handler#" &
!      "interrupt_priority#" &
!      "java_constructor#" &
!      "java_interface#" &
!      "keep_names#" &
!      "link_with#" &
!      "linker_alias#" &
!      "linker_constructor#" &
!      "linker_destructor#" &
!      "linker_options#" &
!      "linker_section#" &
!      "list#" &
!      "machine_attribute#" &
!      "main#" &
!      "main_storage#" &
!      "memory_size#" &
!      "no_return#" &
!      "obsolescent#" &
!      "optimize#" &
!      "optional_overriding#" &
!      "pack#" &
!      "page#" &
!      "passive#" &
!      "preelaborate#" &
!      "preelaborate_05#" &
!      "priority#" &
!      "psect_object#" &
!      "pure#" &
!      "pure_05#" &
!      "pure_function#" &
!      "remote_call_interface#" &
!      "remote_types#" &
!      "share_generic#" &
!      "shared#" &
!      "shared_passive#" &
!      "source_reference#" &
!      "stream_convert#" &
!      "subtitle#" &
!      "suppress_all#" &
!      "suppress_debug_info#" &
!      "suppress_initialization#" &
!      "system_name#" &
!      "task_info#" &
!      "task_name#" &
!      "task_storage#" &
!      "thread_body#" &
!      "time_slice#" &
!      "title#" &
!      "unchecked_union#" &
!      "unimplemented_unit#" &
!      "unreferenced#" &
!      "unreserve_all_interrupts#" &
!      "volatile#" &
!      "volatile_components#" &
!      "weak_external#" &
!      "ada#" &
!      "assembler#" &
!      "cobol#" &
!      "cpp#" &
!      "fortran#" &
!      "intrinsic#" &
!      "java#" &
!      "stdcall#" &
!      "stubbed#" &
!      "asm#" &
!      "assembly#" &
!      "default#" &
!      "dll#" &
!      "win32#" &
!      "as_is#" &
!      "attribute_name#" &
!      "body_file_name#" &
!      "boolean_entry_barriers#" &
!      "check#" &
!      "casing#" &
!      "code#" &
!      "component#" &
!      "component_size_4#" &
!      "copy#" &
!      "d_float#" &
!      "descriptor#" &
!      "dot_replacement#" &
!      "dynamic#" &
!      "entity#" &
!      "entry_count#" &
!      "external_name#" &
!      "first_optional_parameter#" &
!      "form#" &
!      "g_float#" &
!      "gcc#" &
!      "gnat#" &
!      "gpl#" &
!      "ieee_float#" &
!      "ignore#" &
!      "info#" &
!      "internal#" &
!      "link_name#" &
!      "lowercase#" &
!      "max_entry_queue_depth#" &
!      "max_entry_queue_length#" &
!      "max_size#" &
!      "mechanism#" &
!      "message#" &
!      "mixedcase#" &
!      "modified_gpl#" &
!      "name#" &
!      "nca#" &
!      "no#" &
!      "no_dependence#" &
!      "no_dynamic_attachment#" &
!      "no_dynamic_interrupts#" &
!      "no_requeue#" &
!      "no_requeue_statements#" &
!      "no_task_attributes#" &
!      "no_task_attributes_package#" &
!      "on#" &
!      "parameter_types#" &
!      "reference#" &
!      "restricted#" &
!      "result_mechanism#" &
!      "result_type#" &
!      "runtime#" &
!      "sb#" &
!      "secondary_stack_size#" &
!      "section#" &
!      "semaphore#" &
!      "simple_barriers#" &
!      "spec_file_name#" &
!      "state#" &
!      "static#" &
!      "stack_size#" &
!      "subunit_file_name#" &
!      "task_stack_size_default#" &
!      "task_type#" &
!      "time_slicing_enabled#" &
!      "top_guard#" &
!      "uba#" &
!      "ubs#" &
!      "ubsb#" &
!      "unit_name#" &
!      "unknown#" &
!      "unrestricted#" &
!      "uppercase#" &
!      "user#" &
!      "vax_float#" &
!      "vms#" &
!      "vtable_ptr#" &
!      "working_storage#" &
!      "abort_signal#" &
!      "access#" &
!      "address#" &
!      "address_size#" &
!      "aft#" &
!      "alignment#" &
!      "asm_input#" &
!      "asm_output#" &
!      "ast_entry#" &
!      "bit#" &
!      "bit_order#" &
!      "bit_position#" &
!      "body_version#" &
!      "callable#" &
!      "caller#" &
!      "code_address#" &
!      "component_size#" &
!      "compose#" &
!      "constrained#" &
!      "count#" &
!      "default_bit_order#" &
!      "definite#" &
!      "delta#" &
!      "denorm#" &
!      "digits#" &
!      "elaborated#" &
!      "emax#" &
!      "enum_rep#" &
!      "epsilon#" &
!      "exponent#" &
!      "external_tag#" &
!      "first#" &
!      "first_bit#" &
!      "fixed_value#" &
!      "fore#" &
!      "has_access_values#" &
!      "has_discriminants#" &
!      "identity#" &
!      "img#" &
!      "integer_value#" &
!      "large#" &
!      "last#" &
!      "last_bit#" &
!      "leading_part#" &
!      "length#" &
!      "machine_emax#" &
!      "machine_emin#" &
!      "machine_mantissa#" &
!      "machine_overflows#" &
!      "machine_radix#" &
!      "machine_rounding#" &
!      "machine_rounds#" &
!      "machine_size#" &
!      "mantissa#" &
!      "max_size_in_storage_elements#" &
!      "maximum_alignment#" &
!      "mechanism_code#" &
!      "mod#" &
!      "model_emin#" &
!      "model_epsilon#" &
!      "model_mantissa#" &
!      "model_small#" &
!      "modulus#" &
!      "null_parameter#" &
!      "object_size#" &
!      "partition_id#" &
!      "passed_by_reference#" &
!      "pool_address#" &
!      "pos#" &
!      "position#" &
!      "range#" &
!      "range_length#" &
!      "round#" &
!      "safe_emax#" &
!      "safe_first#" &
!      "safe_large#" &
!      "safe_last#" &
!      "safe_small#" &
!      "scale#" &
!      "scaling#" &
!      "signed_zeros#" &
!      "size#" &
!      "small#" &
!      "storage_size#" &
!      "storage_unit#" &
!      "stream_size#" &
!      "tag#" &
!      "target_name#" &
!      "terminated#" &
!      "to_address#" &
!      "type_class#" &
!      "uet_address#" &
!      "unbiased_rounding#" &
!      "unchecked_access#" &
!      "unconstrained_array#" &
!      "universal_literal_string#" &
!      "unrestricted_access#" &
!      "vads_size#" &
!      "val#" &
!      "valid#" &
!      "value_size#" &
!      "version#" &
!      "wchar_t_size#" &
!      "wide_wide_width#" &
!      "wide_width#" &
!      "width#" &
!      "word_size#" &
!      "adjacent#" &
!      "ceiling#" &
!      "copy_sign#" &
!      "floor#" &
!      "fraction#" &
!      "image#" &
!      "input#" &
!      "machine#" &
!      "max#" &
!      "min#" &
!      "model#" &
!      "pred#" &
!      "remainder#" &
!      "rounding#" &
!      "succ#" &
!      "truncation#" &
!      "value#" &
!      "wide_image#" &
!      "wide_wide_image#" &
!      "wide_value#" &
!      "wide_wide_value#" &
!      "output#" &
!      "read#" &
!      "write#" &
!      "elab_body#" &
!      "elab_spec#" &
!      "storage_pool#" &
!      "base#" &
!      "class#" &
!      "ceiling_locking#" &
!      "inheritance_locking#" &
!      "fifo_queuing#" &
!      "priority_queuing#" &
!      "fifo_within_priorities#" &
!      "access_check#" &
!      "accessibility_check#" &
!      "discriminant_check#" &
!      "division_check#" &
!      "elaboration_check#" &
!      "index_check#" &
!      "length_check#" &
!      "overflow_check#" &
!      "range_check#" &
!      "storage_check#" &
!      "tag_check#" &
!      "all_checks#" &
!      "abort#" &
!      "abs#" &
!      "accept#" &
!      "and#" &
!      "all#" &
!      "array#" &
!      "at#" &
!      "begin#" &
!      "body#" &
!      "case#" &
!      "constant#" &
!      "declare#" &
!      "delay#" &
!      "do#" &
!      "else#" &
!      "elsif#" &
!      "end#" &
!      "entry#" &
!      "exception#" &
!      "exit#" &
!      "for#" &
!      "function#" &
!      "generic#" &
!      "goto#" &
!      "if#" &
!      "in#" &
!      "is#" &
!      "limited#" &
!      "loop#" &
!      "new#" &
!      "not#" &
!      "null#" &
!      "of#" &
!      "or#" &
!      "others#" &
!      "out#" &
!      "package#" &
!      "pragma#" &
!      "private#" &
!      "procedure#" &
!      "raise#" &
!      "record#" &
!      "rem#" &
!      "renames#" &
!      "return#" &
!      "reverse#" &
!      "select#" &
!      "separate#" &
!      "subtype#" &
!      "task#" &
!      "terminate#" &
!      "then#" &
!      "type#" &
!      "use#" &
!      "when#" &
!      "while#" &
!      "with#" &
!      "xor#" &
!      "divide#" &
!      "enclosing_entity#" &
!      "exception_information#" &
!      "exception_message#" &
!      "exception_name#" &
!      "file#" &
!      "generic_dispatching_constructor#" &
!      "import_address#" &
!      "import_largest_value#" &
!      "import_value#" &
!      "is_negative#" &
!      "line#" &
!      "rotate_left#" &
!      "rotate_right#" &
!      "shift_left#" &
!      "shift_right#" &
!      "shift_right_arithmetic#" &
!      "source_location#" &
!      "unchecked_conversion#" &
!      "unchecked_deallocation#" &
!      "to_pointer#" &
!      "free#" &
!      "abstract#" &
!      "aliased#" &
!      "protected#" &
!      "until#" &
!      "requeue#" &
!      "tagged#" &
!      "raise_exception#" &
!      "ada_roots#" &
!      "binder#" &
!      "binder_driver#" &
!      "body_suffix#" &
!      "builder#" &
!      "compiler#" &
!      "compiler_driver#" &
!      "compiler_kind#" &
!      "compute_dependency#" &
!      "cross_reference#" &
!      "default_linker#" &
!      "default_switches#" &
!      "dependency_option#" &
!      "exec_dir#" &
!      "executable#" &
!      "executable_suffix#" &
!      "extends#" &
!      "externally_built#" &
!      "finder#" &
!      "global_configuration_pragmas#" &
!      "gnatls#" &
!      "gnatstub#" &
!      "implementation#" &
!      "implementation_exceptions#" &
!      "implementation_suffix#" &
!      "include_option#" &
!      "language_processing#" &
!      "languages#" &
!      "library_ali_dir#" &
!      "library_dir#" &
!      "library_auto_init#" &
!      "library_gcc#" &
!      "library_interface#" &
!      "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#" &
!      "locally_removed_files#" &
!      "metrics#" &
!      "naming#" &
!      "object_dir#" &
!      "pretty_printer#" &
!      "project#" &
!      "separate_suffix#" &
!      "source_dirs#" &
!      "source_files#" &
!      "source_list_file#" &
!      "spec#" &
!      "spec_suffix#" &
!      "specification#" &
!      "specification_exceptions#" &
!      "specification_suffix#" &
!      "switches#" &
!      "unaligned_valid#" &
!      "interface#" &
!      "overriding#" &
!      "synchronized#" &
!      "#";
! 
!    ---------------------
!    -- Generated Names --
!    ---------------------
! 
!    --  This section lists the various cases of generated names which are
!    --  built from existing names by adding unique leading and/or trailing
!    --  upper case letters. In some cases these names are built recursively,
!    --  in particular names built from types may be built from types which
!    --  themselves have generated names. In this list, xxx represents an
!    --  existing name to which identifying letters are prepended or appended,
!    --  and a trailing n represents a serial number in an external name that
!    --  has some semantic significance (e.g. the n'th index type of an array).
! 
!    --    xxxA    access type for formal xxx in entry param record   (Exp_Ch9)
!    --    xxxB    tag table for tagged type xxx                      (Exp_Ch3)
!    --    xxxB    task body procedure for task xxx                   (Exp_Ch9)
!    --    xxxD    dispatch table for tagged type xxx                 (Exp_Ch3)
!    --    xxxD    discriminal for discriminant xxx                   (Sem_Ch3)
!    --    xxxDn   n'th discr check function for rec type xxx         (Exp_Ch3)
!    --    xxxE    elaboration boolean flag for task xxx              (Exp_Ch9)
!    --    xxxE    dispatch table pointer type for tagged type xxx    (Exp_Ch3)
!    --    xxxE    parameters for accept body for entry xxx           (Exp_Ch9)
!    --    xxxFn   n'th primitive of a tagged type (named xxx)        (Exp_Ch3)
!    --    xxxJ    tag table type index for tagged type xxx           (Exp_Ch3)
!    --    xxxM    master Id value for access type xxx                (Exp_Ch3)
!    --    xxxP    tag table pointer type for tagged type xxx         (Exp_Ch3)
!    --    xxxP    parameter record type for entry xxx                (Exp_Ch9)
!    --    xxxPA   access to parameter record type for entry xxx      (Exp_Ch9)
!    --    xxxPn   pointer type for n'th primitive of tagged type xxx (Exp_Ch3)
!    --    xxxR    dispatch table pointer for tagged type xxx         (Exp_Ch3)
!    --    xxxT    tag table type for tagged type xxx                 (Exp_Ch3)
!    --    xxxT    literal table for enumeration type xxx             (Sem_Ch3)
!    --    xxxV    type for task value record for task xxx            (Exp_Ch9)
!    --    xxxX    entry index constant                               (Exp_Ch9)
!    --    xxxY    dispatch table type for tagged type xxx            (Exp_Ch3)
!    --    xxxZ    size variable for task xxx                         (Exp_Ch9)
! 
!    --  TSS names
! 
!    --    xxxDA   deep adjust routine for type xxx                   (Exp_TSS)
!    --    xxxDF   deep finalize routine for type xxx                 (Exp_TSS)
!    --    xxxDI   deep initialize routine for type xxx               (Exp_TSS)
!    --    xxxEQ   composite equality routine for record type xxx     (Exp_TSS)
!    --    xxxFA   PolyORB/DSA From_Any converter for type xxx        (Exp_TSS)
!    --    xxxIP   initialization procedure for type xxx              (Exp_TSS)
!    --    xxxRA   RAS type access routine for type xxx               (Exp_TSS)
!    --    xxxRD   RAS type dereference routine for type xxx          (Exp_TSS)
!    --    xxxRP   Rep to Pos conversion for enumeration type xxx     (Exp_TSS)
!    --    xxxSA   array/slice assignment for controlled comp. arrays (Exp_TSS)
!    --    xxxSI   stream input attribute subprogram for type xxx     (Exp_TSS)
!    --    xxxSO   stream output attribute subprogram for type xxx    (Exp_TSS)
!    --    xxxSR   stream read attribute subprogram for type xxx      (Exp_TSS)
!    --    xxxSW   stream write attribute subprogram for type xxx     (Exp_TSS)
!    --    xxxTA   PolyORB/DSA To_Any converter for type xxx          (Exp_TSS)
!    --    xxxTC   PolyORB/DSA Typecode for type xxx                  (Exp_TSS)
! 
!    --  Implicit type names
! 
!    --    TxxxT   type of literal table for enumeration type xxx     (Sem_Ch3)
! 
!    --  (Note: this list is not complete or accurate ???)
! 
!    ----------------------
!    -- Get_Attribute_Id --
!    ----------------------
! 
!    function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
!    begin
!       return Attribute_Id'Val (N - First_Attribute_Name);
!    end Get_Attribute_Id;
! 
!    ------------------
!    -- Get_Check_Id --
!    ------------------
! 
!    function Get_Check_Id (N : Name_Id) return Check_Id is
!    begin
!       return Check_Id'Val (N - First_Check_Name);
!    end Get_Check_Id;
! 
!    -----------------------
!    -- Get_Convention_Id --
!    -----------------------
! 
!    function Get_Convention_Id (N : Name_Id) return Convention_Id is
!    begin
!       case N is
!          when Name_Ada        => return Convention_Ada;
!          when Name_Assembler  => return Convention_Assembler;
!          when Name_C          => return Convention_C;
!          when Name_COBOL      => return Convention_COBOL;
!          when Name_CPP        => return Convention_CPP;
!          when Name_Fortran    => return Convention_Fortran;
!          when Name_Intrinsic  => return Convention_Intrinsic;
!          when Name_Java       => return Convention_Java;
!          when Name_Stdcall    => return Convention_Stdcall;
!          when Name_Stubbed    => return Convention_Stubbed;
! 
!          --  If no direct match, then we must have a convention
!          --  identifier pragma that has specified this name.
! 
!          when others          =>
!             for J in 1 .. Convention_Identifiers.Last loop
!                if N = Convention_Identifiers.Table (J).Name then
!                   return Convention_Identifiers.Table (J).Convention;
!                end if;
!             end loop;
! 
!             raise Program_Error;
!       end case;
!    end Get_Convention_Id;
! 
!    ---------------------------
!    -- Get_Locking_Policy_Id --
!    ---------------------------
! 
!    function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id is
!    begin
!       return Locking_Policy_Id'Val (N - First_Locking_Policy_Name);
!    end Get_Locking_Policy_Id;
! 
!    -------------------
!    -- Get_Pragma_Id --
!    -------------------
! 
!    function Get_Pragma_Id (N : Name_Id) return Pragma_Id is
!    begin
!       if N = Name_AST_Entry then
!          return Pragma_AST_Entry;
!       elsif N = Name_Interface then
!          return Pragma_Interface;
!       elsif N = Name_Storage_Size then
!          return Pragma_Storage_Size;
!       elsif N = Name_Storage_Unit then
!          return Pragma_Storage_Unit;
!       elsif N not in First_Pragma_Name .. Last_Pragma_Name then
!          return Unknown_Pragma;
!       else
!          return Pragma_Id'Val (N - First_Pragma_Name);
!       end if;
!    end Get_Pragma_Id;
! 
!    ---------------------------
!    -- Get_Queuing_Policy_Id --
!    ---------------------------
! 
!    function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id is
!    begin
!       return Queuing_Policy_Id'Val (N - First_Queuing_Policy_Name);
!    end Get_Queuing_Policy_Id;
! 
!    ------------------------------------
!    -- Get_Task_Dispatching_Policy_Id --
!    ------------------------------------
! 
!    function Get_Task_Dispatching_Policy_Id (N : Name_Id)
!      return Task_Dispatching_Policy_Id is
!    begin
!       return Task_Dispatching_Policy_Id'Val
!         (N - First_Task_Dispatching_Policy_Name);
!    end Get_Task_Dispatching_Policy_Id;
! 
!    ----------------
!    -- Initialize --
!    ----------------
! 
!    procedure Initialize is
!       P_Index      : Natural;
!       Discard_Name : Name_Id;
! 
!    begin
!       P_Index := Preset_Names'First;
! 
!       loop
!          Name_Len := 0;
! 
!          while Preset_Names (P_Index) /= '#' loop
!             Name_Len := Name_Len + 1;
!             Name_Buffer (Name_Len) := Preset_Names (P_Index);
!             P_Index := P_Index + 1;
!          end loop;
! 
!          --  We do the Name_Find call to enter the name into the table, but
!          --  we don't need to do anything with the result, since we already
!          --  initialized all the preset names to have the right value (we
!          --  are depending on the order of the names and Preset_Names).
! 
!          Discard_Name := Name_Find;
!          P_Index := P_Index + 1;
!          exit when Preset_Names (P_Index) = '#';
!       end loop;
! 
!       --  Make sure that number of names in standard table is correct. If
!       --  this check fails, run utility program XSNAMES to construct a new
!       --  properly matching version of the body.
! 
!       pragma Assert (Discard_Name = Last_Predefined_Name);
! 
!       --  Initialize the convention identifiers table with the standard
!       --  set of synonyms that we recognize for conventions.
! 
!       Convention_Identifiers.Init;
! 
!       Convention_Identifiers.Append ((Name_Asm,      Convention_Assembler));
!       Convention_Identifiers.Append ((Name_Assembly, Convention_Assembler));
! 
!       Convention_Identifiers.Append ((Name_Default,  Convention_C));
!       Convention_Identifiers.Append ((Name_External, Convention_C));
! 
!       Convention_Identifiers.Append ((Name_DLL,      Convention_Stdcall));
!       Convention_Identifiers.Append ((Name_Win32,    Convention_Stdcall));
!    end Initialize;
! 
!    -----------------------
!    -- Is_Attribute_Name --
!    -----------------------
! 
!    function Is_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Attribute_Name .. Last_Attribute_Name;
!    end Is_Attribute_Name;
! 
!    -------------------
!    -- Is_Check_Name --
!    -------------------
! 
!    function Is_Check_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Check_Name .. Last_Check_Name;
!    end Is_Check_Name;
! 
!    ------------------------
!    -- Is_Convention_Name --
!    ------------------------
! 
!    function Is_Convention_Name (N : Name_Id) return Boolean is
!    begin
!       --  Check if this is one of the standard conventions
! 
!       if N in First_Convention_Name .. Last_Convention_Name
!         or else N = Name_C
!       then
!          return True;
! 
!       --  Otherwise check if it is in convention identifier table
! 
!       else
!          for J in 1 .. Convention_Identifiers.Last loop
!             if N = Convention_Identifiers.Table (J).Name then
!                return True;
!             end if;
!          end loop;
! 
!          return False;
!       end if;
!    end Is_Convention_Name;
! 
!    ------------------------------
!    -- Is_Entity_Attribute_Name --
!    ------------------------------
! 
!    function Is_Entity_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Entity_Attribute_Name .. Last_Entity_Attribute_Name;
!    end Is_Entity_Attribute_Name;
! 
!    --------------------------------
!    -- Is_Function_Attribute_Name --
!    --------------------------------
! 
!    function Is_Function_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in
!         First_Renamable_Function_Attribute ..
!           Last_Renamable_Function_Attribute;
!    end Is_Function_Attribute_Name;
! 
!    ----------------------------
!    -- Is_Locking_Policy_Name --
!    ----------------------------
! 
!    function Is_Locking_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
!    end Is_Locking_Policy_Name;
! 
!    -----------------------------
!    -- Is_Operator_Symbol_Name --
!    -----------------------------
! 
!    function Is_Operator_Symbol_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Operator_Name .. Last_Operator_Name;
!    end Is_Operator_Symbol_Name;
! 
!    --------------------
!    -- Is_Pragma_Name --
!    --------------------
! 
!    function Is_Pragma_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Pragma_Name .. Last_Pragma_Name
!         or else N = Name_AST_Entry
!         or else N = Name_Interface
!         or else N = Name_Storage_Size
!         or else N = Name_Storage_Unit;
!    end Is_Pragma_Name;
! 
!    ---------------------------------
!    -- Is_Procedure_Attribute_Name --
!    ---------------------------------
! 
!    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Procedure_Attribute .. Last_Procedure_Attribute;
!    end Is_Procedure_Attribute_Name;
! 
!    ----------------------------
!    -- Is_Queuing_Policy_Name --
!    ----------------------------
! 
!    function Is_Queuing_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Queuing_Policy_Name .. Last_Queuing_Policy_Name;
!    end Is_Queuing_Policy_Name;
! 
!    -------------------------------------
!    -- Is_Task_Dispatching_Policy_Name --
!    -------------------------------------
! 
!    function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Task_Dispatching_Policy_Name ..
!                   Last_Task_Dispatching_Policy_Name;
!    end Is_Task_Dispatching_Policy_Name;
! 
!    ----------------------------
!    -- Is_Type_Attribute_Name --
!    ----------------------------
! 
!    function Is_Type_Attribute_Name (N : Name_Id) return Boolean is
!    begin
!       return N in First_Type_Attribute_Name .. Last_Type_Attribute_Name;
!    end Is_Type_Attribute_Name;
! 
!    ----------------------------------
!    -- Record_Convention_Identifier --
!    ----------------------------------
! 
!    procedure Record_Convention_Identifier
!      (Id         : Name_Id;
!       Convention : Convention_Id)
!    is
!    begin
!       Convention_Identifiers.Append ((Id, Convention));
!    end Record_Convention_Identifier;
! 
! end Snames;
diff -Nrcpad gcc-4.0.2/gcc/ada/snames.ads gcc-4.1.0/gcc/ada/snames.ads
*** gcc-4.0.2/gcc/ada/snames.ads	Thu Feb 10 13:50:21 2005
--- gcc-4.1.0/gcc/ada/snames.ads	Tue Nov 15 13:54:36 2005
***************
*** 1,1496 ****
! ------------------------------------------------------------------------------
! --                                                                          --
! --                         GNAT COMPILER COMPONENTS                         --
! --                                                                          --
! --                               S N A M E S                                --
! --                                                                          --
! --                                 S p e c                                  --
! --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
! --                                                                          --
! -- As a special exception,  if other files  instantiate  generics from this --
! -- unit, or you link  this unit with other files  to produce an executable, --
! -- this  unit  does not  by itself cause  the resulting  executable  to  be --
! -- covered  by the  GNU  General  Public  License.  This exception does not --
! -- however invalidate  any other reasons why  the executable file  might be --
! -- covered by the  GNU Public License.                                      --
! --                                                                          --
! -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
! --                                                                          --
! ------------------------------------------------------------------------------
! 
! with Types; use Types;
! 
! package Snames is
! 
! --  This package contains definitions of standard names (i.e. entries in the
! --  Names table) that are used throughout the GNAT compiler). It also contains
! --  the definitions of some enumeration types whose definitions are tied to
! --  the order of these preset names.
! 
! --  WARNING: There is a C file, a-snames.h which duplicates some of the
! --  definitions in this file and must be kept properly synchronized.
! 
!    ------------------
!    -- Preset Names --
!    ------------------
! 
!    --  The following are preset entries in the names table, which are
!    --  entered at the start of every compilation for easy access. Note
!    --  that the order of initialization of these names in the body must
!    --  be coordinated with the order of names in this table.
! 
!    --  Note: a name may not appear more than once in the following list.
!    --  If additional pragmas or attributes are introduced which might
!    --  otherwise cause a duplicate, then list it only once in this table,
!    --  and adjust the definition of the functions for testing for pragma
!    --  names and attribute names, and returning their ID values. Of course
!    --  everything is simpler if no such duplications occur!
! 
!    --  First we have the one character names used to optimize the lookup
!    --  process for one character identifiers (to avoid the hashing in this
!    --  case) There are a full 256 of these, but only the entries for lower
!    --  case and upper case letters have identifiers
! 
!    --  The lower case letter entries are used for one character identifiers
!    --  appearing in the source, for example in pragma Interface (C).
! 
!    Name_A         : constant Name_Id := First_Name_Id + Character'Pos ('a');
!    Name_B         : constant Name_Id := First_Name_Id + Character'Pos ('b');
!    Name_C         : constant Name_Id := First_Name_Id + Character'Pos ('c');
!    Name_D         : constant Name_Id := First_Name_Id + Character'Pos ('d');
!    Name_E         : constant Name_Id := First_Name_Id + Character'Pos ('e');
!    Name_F         : constant Name_Id := First_Name_Id + Character'Pos ('f');
!    Name_G         : constant Name_Id := First_Name_Id + Character'Pos ('g');
!    Name_H         : constant Name_Id := First_Name_Id + Character'Pos ('h');
!    Name_I         : constant Name_Id := First_Name_Id + Character'Pos ('i');
!    Name_J         : constant Name_Id := First_Name_Id + Character'Pos ('j');
!    Name_K         : constant Name_Id := First_Name_Id + Character'Pos ('k');
!    Name_L         : constant Name_Id := First_Name_Id + Character'Pos ('l');
!    Name_M         : constant Name_Id := First_Name_Id + Character'Pos ('m');
!    Name_N         : constant Name_Id := First_Name_Id + Character'Pos ('n');
!    Name_O         : constant Name_Id := First_Name_Id + Character'Pos ('o');
!    Name_P         : constant Name_Id := First_Name_Id + Character'Pos ('p');
!    Name_Q         : constant Name_Id := First_Name_Id + Character'Pos ('q');
!    Name_R         : constant Name_Id := First_Name_Id + Character'Pos ('r');
!    Name_S         : constant Name_Id := First_Name_Id + Character'Pos ('s');
!    Name_T         : constant Name_Id := First_Name_Id + Character'Pos ('t');
!    Name_U         : constant Name_Id := First_Name_Id + Character'Pos ('u');
!    Name_V         : constant Name_Id := First_Name_Id + Character'Pos ('v');
!    Name_W         : constant Name_Id := First_Name_Id + Character'Pos ('w');
!    Name_X         : constant Name_Id := First_Name_Id + Character'Pos ('x');
!    Name_Y         : constant Name_Id := First_Name_Id + Character'Pos ('y');
!    Name_Z         : constant Name_Id := First_Name_Id + Character'Pos ('z');
! 
!    --  The upper case letter entries are used by expander code for local
!    --  variables that do not require unique names (e.g. formal parameter
!    --  names in constructed procedures)
! 
!    Name_uA        : constant Name_Id := First_Name_Id + Character'Pos ('A');
!    Name_uB        : constant Name_Id := First_Name_Id + Character'Pos ('B');
!    Name_uC        : constant Name_Id := First_Name_Id + Character'Pos ('C');
!    Name_uD        : constant Name_Id := First_Name_Id + Character'Pos ('D');
!    Name_uE        : constant Name_Id := First_Name_Id + Character'Pos ('E');
!    Name_uF        : constant Name_Id := First_Name_Id + Character'Pos ('F');
!    Name_uG        : constant Name_Id := First_Name_Id + Character'Pos ('G');
!    Name_uH        : constant Name_Id := First_Name_Id + Character'Pos ('H');
!    Name_uI        : constant Name_Id := First_Name_Id + Character'Pos ('I');
!    Name_uJ        : constant Name_Id := First_Name_Id + Character'Pos ('J');
!    Name_uK        : constant Name_Id := First_Name_Id + Character'Pos ('K');
!    Name_uL        : constant Name_Id := First_Name_Id + Character'Pos ('L');
!    Name_uM        : constant Name_Id := First_Name_Id + Character'Pos ('M');
!    Name_uN        : constant Name_Id := First_Name_Id + Character'Pos ('N');
!    Name_uO        : constant Name_Id := First_Name_Id + Character'Pos ('O');
!    Name_uP        : constant Name_Id := First_Name_Id + Character'Pos ('P');
!    Name_uQ        : constant Name_Id := First_Name_Id + Character'Pos ('Q');
!    Name_uR        : constant Name_Id := First_Name_Id + Character'Pos ('R');
!    Name_uS        : constant Name_Id := First_Name_Id + Character'Pos ('S');
!    Name_uT        : constant Name_Id := First_Name_Id + Character'Pos ('T');
!    Name_uU        : constant Name_Id := First_Name_Id + Character'Pos ('U');
!    Name_uV        : constant Name_Id := First_Name_Id + Character'Pos ('V');
!    Name_uW        : constant Name_Id := First_Name_Id + Character'Pos ('W');
!    Name_uX        : constant Name_Id := First_Name_Id + Character'Pos ('X');
!    Name_uY        : constant Name_Id := First_Name_Id + Character'Pos ('Y');
!    Name_uZ        : constant Name_Id := First_Name_Id + Character'Pos ('Z');
! 
!    --  Note: the following table is read by the utility program XSNAMES and
!    --  its format should not be changed without coordinating with this program.
! 
!    N : constant Name_Id := First_Name_Id + 256;
!    --  Synonym used in standard name definitions
! 
!    --  Some names that are used by gigi, and whose definitions are reflected
!    --  in the C header file a-snames.h. They are placed at the start so that
!    --  the need to modify a-snames.h is minimized.
! 
!    Name_uParent                        : constant Name_Id := N + 000;
!    Name_uTag                           : constant Name_Id := N + 001;
!    Name_Off                            : constant Name_Id := N + 002;
!    Name_Space                          : constant Name_Id := N + 003;
!    Name_Time                           : constant Name_Id := N + 004;
! 
!    --  Some special names used by the expander. Note that the lower case u's
!    --  at the start of these names get translated to extra underscores. These
!    --  names are only referenced internally by expander generated code.
! 
!    Name_uAbort_Signal                  : constant Name_Id := N + 005;
!    Name_uAlignment                     : constant Name_Id := N + 006;
!    Name_uAssign                        : constant Name_Id := N + 007;
!    Name_uATCB                          : constant Name_Id := N + 008;
!    Name_uChain                         : constant Name_Id := N + 009;
!    Name_uClean                         : constant Name_Id := N + 010;
!    Name_uController                    : constant Name_Id := N + 011;
!    Name_uEntry_Bodies                  : constant Name_Id := N + 012;
!    Name_uExpunge                       : constant Name_Id := N + 013;
!    Name_uFinal_List                    : constant Name_Id := N + 014;
!    Name_uIdepth                        : constant Name_Id := N + 015;
!    Name_uInit                          : constant Name_Id := N + 016;
!    Name_uLocal_Final_List              : constant Name_Id := N + 017;
!    Name_uMaster                        : constant Name_Id := N + 018;
!    Name_uObject                        : constant Name_Id := N + 019;
!    Name_uPriority                      : constant Name_Id := N + 020;
!    Name_uProcess_ATSD                  : constant Name_Id := N + 021;
!    Name_uSecondary_Stack               : constant Name_Id := N + 022;
!    Name_uService                       : constant Name_Id := N + 023;
!    Name_uSize                          : constant Name_Id := N + 024;
!    Name_uStack                         : constant Name_Id := N + 025;
!    Name_uTags                          : constant Name_Id := N + 026;
!    Name_uTask                          : constant Name_Id := N + 027;
!    Name_uTask_Id                       : constant Name_Id := N + 028;
!    Name_uTask_Info                     : constant Name_Id := N + 029;
!    Name_uTask_Name                     : constant Name_Id := N + 030;
!    Name_uTrace_Sp                      : constant Name_Id := N + 031;
! 
!    --  Names of routines in Ada.Finalization, needed by expander
! 
!    Name_Initialize                     : constant Name_Id := N + 032;
!    Name_Adjust                         : constant Name_Id := N + 033;
!    Name_Finalize                       : constant Name_Id := N + 034;
! 
!    --  Names of fields declared in System.Finalization_Implementation,
!    --  needed by the expander when generating code for finalization.
! 
!    Name_Next                           : constant Name_Id := N + 035;
!    Name_Prev                           : constant Name_Id := N + 036;
! 
!    --  Names of TSS routines for implementation of DSA over PolyORB
! 
!    Name_uTypeCode                      : constant Name_Id := N + 037;
!    Name_uFrom_Any                      : constant Name_Id := N + 038;
!    Name_uTo_Any                        : constant Name_Id := N + 039;
! 
!    --  Names of allocation routines, also needed by expander
! 
!    Name_Allocate                       : constant Name_Id := N + 040;
!    Name_Deallocate                     : constant Name_Id := N + 041;
!    Name_Dereference                    : constant Name_Id := N + 042;
! 
!    --  Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
! 
!    First_Text_IO_Package               : constant Name_Id := N + 043;
!    Name_Decimal_IO                     : constant Name_Id := N + 043;
!    Name_Enumeration_IO                 : constant Name_Id := N + 044;
!    Name_Fixed_IO                       : constant Name_Id := N + 045;
!    Name_Float_IO                       : constant Name_Id := N + 046;
!    Name_Integer_IO                     : constant Name_Id := N + 047;
!    Name_Modular_IO                     : constant Name_Id := N + 048;
!    Last_Text_IO_Package                : constant Name_Id := N + 048;
! 
!    subtype Text_IO_Package_Name is Name_Id
!      range First_Text_IO_Package .. Last_Text_IO_Package;
! 
!    --  Some miscellaneous names used for error detection/recovery
! 
!    Name_Const                          : constant Name_Id := N + 049;
!    Name_Error                          : constant Name_Id := N + 050;
!    Name_Go                             : constant Name_Id := N + 051;
!    Name_Put                            : constant Name_Id := N + 052;
!    Name_Put_Line                       : constant Name_Id := N + 053;
!    Name_To                             : constant Name_Id := N + 054;
! 
!    --  Names for packages that are treated specially by the compiler
! 
!    Name_Finalization                   : constant Name_Id := N + 055;
!    Name_Finalization_Root              : constant Name_Id := N + 056;
!    Name_Interfaces                     : constant Name_Id := N + 057;
!    Name_Standard                       : constant Name_Id := N + 058;
!    Name_System                         : constant Name_Id := N + 059;
!    Name_Text_IO                        : constant Name_Id := N + 060;
!    Name_Wide_Text_IO                   : constant Name_Id := N + 061;
!    Name_Wide_Wide_Text_IO              : constant Name_Id := N + 062;
! 
!    --  Names of implementations of the distributed systems annex
! 
!    First_PCS_Name                      : constant Name_Id := N + 063;
!    Name_No_DSA                         : constant Name_Id := N + 063;
!    Name_GARLIC_DSA                     : constant Name_Id := N + 064;
!    Name_PolyORB_DSA                    : constant Name_Id := N + 065;
!    Last_PCS_Name                       : constant Name_Id := N + 065;
! 
!    subtype PCS_Names is Name_Id
!      range First_PCS_Name .. Last_PCS_Name;
! 
!    --  Names of identifiers used in expanding distribution stubs
! 
!    Name_Addr                           : constant Name_Id := N + 066;
!    Name_Async                          : constant Name_Id := N + 067;
!    Name_Get_Active_Partition_ID        : constant Name_Id := N + 068;
!    Name_Get_RCI_Package_Receiver       : constant Name_Id := N + 069;
!    Name_Get_RCI_Package_Ref            : constant Name_Id := N + 070;
!    Name_Origin                         : constant Name_Id := N + 071;
!    Name_Params                         : constant Name_Id := N + 072;
!    Name_Partition                      : constant Name_Id := N + 073;
!    Name_Partition_Interface            : constant Name_Id := N + 074;
!    Name_Ras                            : constant Name_Id := N + 075;
!    Name_Call                           : constant Name_Id := N + 076;
!    Name_RCI_Name                       : constant Name_Id := N + 077;
!    Name_Receiver                       : constant Name_Id := N + 078;
!    Name_Result                         : constant Name_Id := N + 079;
!    Name_Rpc                            : constant Name_Id := N + 080;
!    Name_Subp_Id                        : constant Name_Id := N + 081;
!    Name_Operation                      : constant Name_Id := N + 082;
!    Name_Argument                       : constant Name_Id := N + 083;
!    Name_Arg_Modes                      : constant Name_Id := N + 084;
!    Name_Handler                        : constant Name_Id := N + 085;
!    Name_Target                         : constant Name_Id := N + 086;
!    Name_Req                            : constant Name_Id := N + 087;
!    Name_Obj_TypeCode                   : constant Name_Id := N + 088;
!    Name_Stub                           : constant Name_Id := N + 089;
! 
!    --  Operator Symbol entries. The actual names have an upper case O at
!    --  the start in place of the Op_ prefix (e.g. the actual name that
!    --  corresponds to Name_Op_Abs is "Oabs".
! 
!    First_Operator_Name                 : constant Name_Id := N + 090;
!    Name_Op_Abs                         : constant Name_Id := N + 090; -- "abs"
!    Name_Op_And                         : constant Name_Id := N + 091; -- "and"
!    Name_Op_Mod                         : constant Name_Id := N + 092; -- "mod"
!    Name_Op_Not                         : constant Name_Id := N + 093; -- "not"
!    Name_Op_Or                          : constant Name_Id := N + 094; -- "or"
!    Name_Op_Rem                         : constant Name_Id := N + 095; -- "rem"
!    Name_Op_Xor                         : constant Name_Id := N + 096; -- "xor"
!    Name_Op_Eq                          : constant Name_Id := N + 097; -- "="
!    Name_Op_Ne                          : constant Name_Id := N + 098; -- "/="
!    Name_Op_Lt                          : constant Name_Id := N + 099; -- "<"
!    Name_Op_Le                          : constant Name_Id := N + 100; -- "<="
!    Name_Op_Gt                          : constant Name_Id := N + 101; -- ">"
!    Name_Op_Ge                          : constant Name_Id := N + 102; -- ">="
!    Name_Op_Add                         : constant Name_Id := N + 103; -- "+"
!    Name_Op_Subtract                    : constant Name_Id := N + 104; -- "-"
!    Name_Op_Concat                      : constant Name_Id := N + 105; -- "&"
!    Name_Op_Multiply                    : constant Name_Id := N + 106; -- "*"
!    Name_Op_Divide                      : constant Name_Id := N + 107; -- "/"
!    Name_Op_Expon                       : constant Name_Id := N + 108; -- "**"
!    Last_Operator_Name                  : constant Name_Id := N + 108;
! 
!    --  Names for all pragmas recognized by GNAT. The entries with the comment
!    --  "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.
!    --  These pragmas are fully implemented in both Ada 83 and Ada 95 modes
!    --  in GNAT.
! 
!    --  The entries marked GNAT are pragmas that are defined by GNAT
!    --  and implemented in both Ada 83 and Ada 95 modes. Full descriptions
!    --  of these implementation dependent pragmas may be found in the
!    --  appropriate section in unit Sem_Prag in file sem-prag.adb.
! 
!    --  The entries marked Ada05 are technically implementation dependent
!    --  pragmas, but they correspond to standard proposals for Ada 2005.
! 
!    --  The entries marked VMS are VMS specific pragmas that are recognized
!    --  only in OpenVMS versions of GNAT. They are ignored in other versions
!    --  with an appropriate warning.
! 
!    --  The entries marked AAMP are AAMP specific pragmas that are recognized
!    --  only in GNAT for the AAMP. They are ignored in other versions with
!    --  appropriate warnings.
! 
!    First_Pragma_Name                   : constant Name_Id := N + 109;
! 
!    --  Configuration pragmas are grouped at start
! 
!    Name_Ada_83                         : constant Name_Id := N + 109; -- GNAT
!    Name_Ada_95                         : constant Name_Id := N + 110; -- GNAT
!    Name_Ada_05                         : constant Name_Id := N + 111; -- GNAT
!    Name_C_Pass_By_Copy                 : constant Name_Id := N + 112; -- GNAT
!    Name_Compile_Time_Warning           : constant Name_Id := N + 113; -- GNAT
!    Name_Component_Alignment            : constant Name_Id := N + 114; -- GNAT
!    Name_Convention_Identifier          : constant Name_Id := N + 115; -- GNAT
!    Name_Detect_Blocking                : constant Name_Id := N + 116; -- Ada05
!    Name_Discard_Names                  : constant Name_Id := N + 117;
!    Name_Elaboration_Checks             : constant Name_Id := N + 118; -- GNAT
!    Name_Eliminate                      : constant Name_Id := N + 119; -- GNAT
!    Name_Explicit_Overriding            : constant Name_Id := N + 120;
!    Name_Extend_System                  : constant Name_Id := N + 121; -- GNAT
!    Name_Extensions_Allowed             : constant Name_Id := N + 122; -- GNAT
!    Name_External_Name_Casing           : constant Name_Id := N + 123; -- GNAT
!    Name_Float_Representation           : constant Name_Id := N + 124; -- GNAT
!    Name_Initialize_Scalars             : constant Name_Id := N + 125; -- GNAT
!    Name_Interrupt_State                : constant Name_Id := N + 126; -- GNAT
!    Name_License                        : constant Name_Id := N + 127; -- GNAT
!    Name_Locking_Policy                 : constant Name_Id := N + 128;
!    Name_Long_Float                     : constant Name_Id := N + 129; -- VMS
!    Name_No_Run_Time                    : constant Name_Id := N + 130; -- GNAT
!    Name_No_Strict_Aliasing             : constant Name_Id := N + 131; -- GNAT
!    Name_Normalize_Scalars              : constant Name_Id := N + 132;
!    Name_Polling                        : constant Name_Id := N + 133; -- GNAT
!    Name_Persistent_Data                : constant Name_Id := N + 134; -- GNAT
!    Name_Persistent_Object              : constant Name_Id := N + 135; -- GNAT
!    Name_Profile                        : constant Name_Id := N + 136; -- Ada05
!    Name_Profile_Warnings               : constant Name_Id := N + 137; -- GNAT
!    Name_Propagate_Exceptions           : constant Name_Id := N + 138; -- GNAT
!    Name_Queuing_Policy                 : constant Name_Id := N + 139;
!    Name_Ravenscar                      : constant Name_Id := N + 140;
!    Name_Restricted_Run_Time            : constant Name_Id := N + 141;
!    Name_Restrictions                   : constant Name_Id := N + 142;
!    Name_Restriction_Warnings           : constant Name_Id := N + 143; -- GNAT
!    Name_Reviewable                     : constant Name_Id := N + 144;
!    Name_Source_File_Name               : constant Name_Id := N + 145; -- GNAT
!    Name_Source_File_Name_Project       : constant Name_Id := N + 146; -- GNAT
!    Name_Style_Checks                   : constant Name_Id := N + 147; -- GNAT
!    Name_Suppress                       : constant Name_Id := N + 148;
!    Name_Suppress_Exception_Locations   : constant Name_Id := N + 149; -- GNAT
!    Name_Task_Dispatching_Policy        : constant Name_Id := N + 150;
!    Name_Universal_Data                 : constant Name_Id := N + 151; -- AAMP
!    Name_Unsuppress                     : constant Name_Id := N + 152; -- GNAT
!    Name_Use_VADS_Size                  : constant Name_Id := N + 153; -- GNAT
!    Name_Validity_Checks                : constant Name_Id := N + 154; -- GNAT
!    Name_Warnings                       : constant Name_Id := N + 155; -- GNAT
!    Last_Configuration_Pragma_Name      : constant Name_Id := N + 155;
! 
!    --  Remaining pragma names
! 
!    Name_Abort_Defer                    : constant Name_Id := N + 156; -- GNAT
!    Name_All_Calls_Remote               : constant Name_Id := N + 157;
!    Name_Annotate                       : constant Name_Id := N + 158; -- GNAT
! 
!    --  Note: AST_Entry is not in this list because its name matches the
!    --  name of the corresponding attribute. However, it is included in the
!    --  definition of the type Attribute_Id, and the functions Get_Pragma_Id
!    --  and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
!    --  AST_Entry is a VMS specific pragma.
! 
!    Name_Assert                         : constant Name_Id := N + 159; -- GNAT
!    Name_Asynchronous                   : constant Name_Id := N + 160;
!    Name_Atomic                         : constant Name_Id := N + 161;
!    Name_Atomic_Components              : constant Name_Id := N + 162;
!    Name_Attach_Handler                 : constant Name_Id := N + 163;
!    Name_Comment                        : constant Name_Id := N + 164; -- GNAT
!    Name_Common_Object                  : constant Name_Id := N + 165; -- GNAT
!    Name_Complex_Representation         : constant Name_Id := N + 166; -- GNAT
!    Name_Controlled                     : constant Name_Id := N + 167;
!    Name_Convention                     : constant Name_Id := N + 168;
!    Name_CPP_Class                      : constant Name_Id := N + 169; -- GNAT
!    Name_CPP_Constructor                : constant Name_Id := N + 170; -- GNAT
!    Name_CPP_Virtual                    : constant Name_Id := N + 171; -- GNAT
!    Name_CPP_Vtable                     : constant Name_Id := N + 172; -- GNAT
!    Name_Debug                          : constant Name_Id := N + 173; -- GNAT
!    Name_Elaborate                      : constant Name_Id := N + 174; -- Ada 83
!    Name_Elaborate_All                  : constant Name_Id := N + 175;
!    Name_Elaborate_Body                 : constant Name_Id := N + 176;
!    Name_Export                         : constant Name_Id := N + 177;
!    Name_Export_Exception               : constant Name_Id := N + 178; -- VMS
!    Name_Export_Function                : constant Name_Id := N + 179; -- GNAT
!    Name_Export_Object                  : constant Name_Id := N + 180; -- GNAT
!    Name_Export_Procedure               : constant Name_Id := N + 181; -- GNAT
!    Name_Export_Value                   : constant Name_Id := N + 182; -- GNAT
!    Name_Export_Valued_Procedure        : constant Name_Id := N + 183; -- GNAT
!    Name_External                       : constant Name_Id := N + 184; -- GNAT
!    Name_Finalize_Storage_Only          : constant Name_Id := N + 185; -- GNAT
!    Name_Ident                          : constant Name_Id := N + 186; -- VMS
!    Name_Import                         : constant Name_Id := N + 187;
!    Name_Import_Exception               : constant Name_Id := N + 188; -- VMS
!    Name_Import_Function                : constant Name_Id := N + 189; -- GNAT
!    Name_Import_Object                  : constant Name_Id := N + 190; -- GNAT
!    Name_Import_Procedure               : constant Name_Id := N + 191; -- GNAT
!    Name_Import_Valued_Procedure        : constant Name_Id := N + 192; -- GNAT
!    Name_Inline                         : constant Name_Id := N + 193;
!    Name_Inline_Always                  : constant Name_Id := N + 194; -- GNAT
!    Name_Inline_Generic                 : constant Name_Id := N + 195; -- GNAT
!    Name_Inspection_Point               : constant Name_Id := N + 196;
!    Name_Interface_Name                 : constant Name_Id := N + 197; -- GNAT
!    Name_Interrupt_Handler              : constant Name_Id := N + 198;
!    Name_Interrupt_Priority             : constant Name_Id := N + 199;
!    Name_Java_Constructor               : constant Name_Id := N + 200; -- GNAT
!    Name_Java_Interface                 : constant Name_Id := N + 201; -- GNAT
!    Name_Keep_Names                     : constant Name_Id := N + 202; -- GNAT
!    Name_Link_With                      : constant Name_Id := N + 203; -- GNAT
!    Name_Linker_Alias                   : constant Name_Id := N + 204; -- GNAT
!    Name_Linker_Options                 : constant Name_Id := N + 205;
!    Name_Linker_Section                 : constant Name_Id := N + 206; -- GNAT
!    Name_List                           : constant Name_Id := N + 207;
!    Name_Machine_Attribute              : constant Name_Id := N + 208; -- GNAT
!    Name_Main                           : constant Name_Id := N + 209; -- GNAT
!    Name_Main_Storage                   : constant Name_Id := N + 210; -- GNAT
!    Name_Memory_Size                    : constant Name_Id := N + 211; -- Ada 83
!    Name_No_Return                      : constant Name_Id := N + 212; -- GNAT
!    Name_Obsolescent                    : constant Name_Id := N + 213; -- GNAT
!    Name_Optimize                       : constant Name_Id := N + 214;
!    Name_Optional_Overriding            : constant Name_Id := N + 215;
!    Name_Pack                           : constant Name_Id := N + 216;
!    Name_Page                           : constant Name_Id := N + 217;
!    Name_Passive                        : constant Name_Id := N + 218; -- GNAT
!    Name_Preelaborate                   : constant Name_Id := N + 219;
!    Name_Priority                       : constant Name_Id := N + 220;
!    Name_Psect_Object                   : constant Name_Id := N + 221; -- VMS
!    Name_Pure                           : constant Name_Id := N + 222;
!    Name_Pure_Function                  : constant Name_Id := N + 223; -- GNAT
!    Name_Remote_Call_Interface          : constant Name_Id := N + 224;
!    Name_Remote_Types                   : constant Name_Id := N + 225;
!    Name_Share_Generic                  : constant Name_Id := N + 226; -- GNAT
!    Name_Shared                         : constant Name_Id := N + 227; -- Ada 83
!    Name_Shared_Passive                 : constant Name_Id := N + 228;
! 
!    --  Note: Storage_Size is not in this list because its name matches the
!    --  name of the corresponding attribute. However, it is included in the
!    --  definition of the type Attribute_Id, and the functions Get_Pragma_Id
!    --  and Check_Pragma_Id correctly recognize and process Name_Storage_Size.
! 
!    --  Note: Storage_Unit is also omitted from the list because of a clash
!    --  with an attribute name, and is treated similarly.
! 
!    Name_Source_Reference               : constant Name_Id := N + 229; -- GNAT
!    Name_Stream_Convert                 : constant Name_Id := N + 230; -- GNAT
!    Name_Subtitle                       : constant Name_Id := N + 231; -- GNAT
!    Name_Suppress_All                   : constant Name_Id := N + 232; -- GNAT
!    Name_Suppress_Debug_Info            : constant Name_Id := N + 233; -- GNAT
!    Name_Suppress_Initialization        : constant Name_Id := N + 234; -- GNAT
!    Name_System_Name                    : constant Name_Id := N + 235; -- Ada 83
!    Name_Task_Info                      : constant Name_Id := N + 236; -- GNAT
!    Name_Task_Name                      : constant Name_Id := N + 237; -- GNAT
!    Name_Task_Storage                   : constant Name_Id := N + 238; -- VMS
!    Name_Thread_Body                    : constant Name_Id := N + 239; -- GNAT
!    Name_Time_Slice                     : constant Name_Id := N + 240; -- GNAT
!    Name_Title                          : constant Name_Id := N + 241; -- GNAT
!    Name_Unchecked_Union                : constant Name_Id := N + 242; -- GNAT
!    Name_Unimplemented_Unit             : constant Name_Id := N + 243; -- GNAT
!    Name_Unreferenced                   : constant Name_Id := N + 244; -- GNAT
!    Name_Unreserve_All_Interrupts       : constant Name_Id := N + 245; -- GNAT
!    Name_Volatile                       : constant Name_Id := N + 246;
!    Name_Volatile_Components            : constant Name_Id := N + 247;
!    Name_Weak_External                  : constant Name_Id := N + 248; -- GNAT
!    Last_Pragma_Name                    : constant Name_Id := N + 248;
! 
!    --  Language convention names for pragma Convention/Export/Import/Interface
!    --  Note that Name_C is not included in this list, since it was already
!    --  declared earlier in the context of one-character identifier names
!    --  (where the order is critical to the fast look up process).
! 
!    --  Note: there are no convention names corresponding to the conventions
!    --  Entry and Protected, this is because these conventions cannot be
!    --  specified by a pragma.
! 
!    First_Convention_Name               : constant Name_Id := N + 249;
!    Name_Ada                            : constant Name_Id := N + 249;
!    Name_Assembler                      : constant Name_Id := N + 250;
!    Name_COBOL                          : constant Name_Id := N + 251;
!    Name_CPP                            : constant Name_Id := N + 252;
!    Name_Fortran                        : constant Name_Id := N + 253;
!    Name_Intrinsic                      : constant Name_Id := N + 254;
!    Name_Java                           : constant Name_Id := N + 255;
!    Name_Stdcall                        : constant Name_Id := N + 256;
!    Name_Stubbed                        : constant Name_Id := N + 257;
!    Last_Convention_Name                : constant Name_Id := N + 257;
! 
!    --  The following names are preset as synonyms for Assembler
! 
!    Name_Asm                            : constant Name_Id := N + 258;
!    Name_Assembly                       : constant Name_Id := N + 259;
! 
!    --  The following names are preset as synonyms for C
! 
!    Name_Default                        : constant Name_Id := N + 260;
!    --  Name_Exernal (previously defined as pragma)
! 
!    --  The following names are present as synonyms for Stdcall
! 
!    Name_DLL                            : constant Name_Id := N + 261;
!    Name_Win32                          : constant Name_Id := N + 262;
! 
!    --  Other special names used in processing pragmas
! 
!    Name_As_Is                          : constant Name_Id := N + 263;
!    Name_Body_File_Name                 : constant Name_Id := N + 264;
!    Name_Boolean_Entry_Barriers         : constant Name_Id := N + 265;
!    Name_Casing                         : constant Name_Id := N + 266;
!    Name_Code                           : constant Name_Id := N + 267;
!    Name_Component                      : constant Name_Id := N + 268;
!    Name_Component_Size_4               : constant Name_Id := N + 269;
!    Name_Copy                           : constant Name_Id := N + 270;
!    Name_D_Float                        : constant Name_Id := N + 271;
!    Name_Descriptor                     : constant Name_Id := N + 272;
!    Name_Dot_Replacement                : constant Name_Id := N + 273;
!    Name_Dynamic                        : constant Name_Id := N + 274;
!    Name_Entity                         : constant Name_Id := N + 275;
!    Name_External_Name                  : constant Name_Id := N + 276;
!    Name_First_Optional_Parameter       : constant Name_Id := N + 277;
!    Name_Form                           : constant Name_Id := N + 278;
!    Name_G_Float                        : constant Name_Id := N + 279;
!    Name_Gcc                            : constant Name_Id := N + 280;
!    Name_Gnat                           : constant Name_Id := N + 281;
!    Name_GPL                            : constant Name_Id := N + 282;
!    Name_IEEE_Float                     : constant Name_Id := N + 283;
!    Name_Internal                       : constant Name_Id := N + 284;
!    Name_Link_Name                      : constant Name_Id := N + 285;
!    Name_Lowercase                      : constant Name_Id := N + 286;
!    Name_Max_Entry_Queue_Depth          : constant Name_Id := N + 287;
!    Name_Max_Entry_Queue_Length         : constant Name_Id := N + 288;
!    Name_Max_Size                       : constant Name_Id := N + 289;
!    Name_Mechanism                      : constant Name_Id := N + 290;
!    Name_Mixedcase                      : constant Name_Id := N + 291;
!    Name_Modified_GPL                   : constant Name_Id := N + 292;
!    Name_Name                           : constant Name_Id := N + 293;
!    Name_NCA                            : constant Name_Id := N + 294;
!    Name_No                             : constant Name_Id := N + 295;
!    Name_No_Dependence                  : constant Name_Id := N + 296;
!    Name_No_Dynamic_Attachment          : constant Name_Id := N + 297;
!    Name_No_Dynamic_Interrupts          : constant Name_Id := N + 298;
!    Name_No_Requeue                     : constant Name_Id := N + 299;
!    Name_No_Requeue_Statements          : constant Name_Id := N + 300;
!    Name_No_Task_Attributes             : constant Name_Id := N + 301;
!    Name_No_Task_Attributes_Package     : constant Name_Id := N + 302;
!    Name_On                             : constant Name_Id := N + 303;
!    Name_Parameter_Types                : constant Name_Id := N + 304;
!    Name_Reference                      : constant Name_Id := N + 305;
!    Name_Restricted                     : constant Name_Id := N + 306;
!    Name_Result_Mechanism               : constant Name_Id := N + 307;
!    Name_Result_Type                    : constant Name_Id := N + 308;
!    Name_Runtime                        : constant Name_Id := N + 309;
!    Name_SB                             : constant Name_Id := N + 310;
!    Name_Secondary_Stack_Size           : constant Name_Id := N + 311;
!    Name_Section                        : constant Name_Id := N + 312;
!    Name_Semaphore                      : constant Name_Id := N + 313;
!    Name_Simple_Barriers                : constant Name_Id := N + 314;
!    Name_Spec_File_Name                 : constant Name_Id := N + 315;
!    Name_Static                         : constant Name_Id := N + 316;
!    Name_Stack_Size                     : constant Name_Id := N + 317;
!    Name_Subunit_File_Name              : constant Name_Id := N + 318;
!    Name_Task_Stack_Size_Default        : constant Name_Id := N + 319;
!    Name_Task_Type                      : constant Name_Id := N + 320;
!    Name_Time_Slicing_Enabled           : constant Name_Id := N + 321;
!    Name_Top_Guard                      : constant Name_Id := N + 322;
!    Name_UBA                            : constant Name_Id := N + 323;
!    Name_UBS                            : constant Name_Id := N + 324;
!    Name_UBSB                           : constant Name_Id := N + 325;
!    Name_Unit_Name                      : constant Name_Id := N + 326;
!    Name_Unknown                        : constant Name_Id := N + 327;
!    Name_Unrestricted                   : constant Name_Id := N + 328;
!    Name_Uppercase                      : constant Name_Id := N + 329;
!    Name_User                           : constant Name_Id := N + 330;
!    Name_VAX_Float                      : constant Name_Id := N + 331;
!    Name_VMS                            : constant Name_Id := N + 332;
!    Name_Working_Storage                : constant Name_Id := N + 333;
! 
!    --  Names of recognized attributes. The entries with the comment "Ada 83"
!    --  are attributes that are defined in Ada 83, but not in Ada 95. These
!    --  attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.
! 
!    --  The entries marked GNAT are attributes that are defined by GNAT
!    --  and implemented in both Ada 83 and Ada 95 modes. Full descriptions
!    --  of these implementation dependent attributes may be found in the
!    --  appropriate section in package Sem_Attr in file sem-attr.ads.
! 
!    --  The entries marked VMS are recognized only in OpenVMS implementations
!    --  of GNAT, and are treated as illegal in all other contexts.
! 
!    First_Attribute_Name                : constant Name_Id := N + 334;
!    Name_Abort_Signal                   : constant Name_Id := N + 334; -- GNAT
!    Name_Access                         : constant Name_Id := N + 335;
!    Name_Address                        : constant Name_Id := N + 336;
!    Name_Address_Size                   : constant Name_Id := N + 337; -- GNAT
!    Name_Aft                            : constant Name_Id := N + 338;
!    Name_Alignment                      : constant Name_Id := N + 339;
!    Name_Asm_Input                      : constant Name_Id := N + 340; -- GNAT
!    Name_Asm_Output                     : constant Name_Id := N + 341; -- GNAT
!    Name_AST_Entry                      : constant Name_Id := N + 342; -- VMS
!    Name_Bit                            : constant Name_Id := N + 343; -- GNAT
!    Name_Bit_Order                      : constant Name_Id := N + 344;
!    Name_Bit_Position                   : constant Name_Id := N + 345; -- GNAT
!    Name_Body_Version                   : constant Name_Id := N + 346;
!    Name_Callable                       : constant Name_Id := N + 347;
!    Name_Caller                         : constant Name_Id := N + 348;
!    Name_Code_Address                   : constant Name_Id := N + 349; -- GNAT
!    Name_Component_Size                 : constant Name_Id := N + 350;
!    Name_Compose                        : constant Name_Id := N + 351;
!    Name_Constrained                    : constant Name_Id := N + 352;
!    Name_Count                          : constant Name_Id := N + 353;
!    Name_Default_Bit_Order              : constant Name_Id := N + 354; -- GNAT
!    Name_Definite                       : constant Name_Id := N + 355;
!    Name_Delta                          : constant Name_Id := N + 356;
!    Name_Denorm                         : constant Name_Id := N + 357;
!    Name_Digits                         : constant Name_Id := N + 358;
!    Name_Elaborated                     : constant Name_Id := N + 359; -- GNAT
!    Name_Emax                           : constant Name_Id := N + 360; -- Ada 83
!    Name_Enum_Rep                       : constant Name_Id := N + 361; -- GNAT
!    Name_Epsilon                        : constant Name_Id := N + 362; -- Ada 83
!    Name_Exponent                       : constant Name_Id := N + 363;
!    Name_External_Tag                   : constant Name_Id := N + 364;
!    Name_First                          : constant Name_Id := N + 365;
!    Name_First_Bit                      : constant Name_Id := N + 366;
!    Name_Fixed_Value                    : constant Name_Id := N + 367; -- GNAT
!    Name_Fore                           : constant Name_Id := N + 368;
!    Name_Has_Access_Values              : constant Name_Id := N + 369; -- GNAT
!    Name_Has_Discriminants              : constant Name_Id := N + 370; -- GNAT
!    Name_Identity                       : constant Name_Id := N + 371;
!    Name_Img                            : constant Name_Id := N + 372; -- GNAT
!    Name_Integer_Value                  : constant Name_Id := N + 373; -- GNAT
!    Name_Large                          : constant Name_Id := N + 374; -- Ada 83
!    Name_Last                           : constant Name_Id := N + 375;
!    Name_Last_Bit                       : constant Name_Id := N + 376;
!    Name_Leading_Part                   : constant Name_Id := N + 377;
!    Name_Length                         : constant Name_Id := N + 378;
!    Name_Machine_Emax                   : constant Name_Id := N + 379;
!    Name_Machine_Emin                   : constant Name_Id := N + 380;
!    Name_Machine_Mantissa               : constant Name_Id := N + 381;
!    Name_Machine_Overflows              : constant Name_Id := N + 382;
!    Name_Machine_Radix                  : constant Name_Id := N + 383;
!    Name_Machine_Rounds                 : constant Name_Id := N + 384;
!    Name_Machine_Size                   : constant Name_Id := N + 385; -- GNAT
!    Name_Mantissa                       : constant Name_Id := N + 386; -- Ada 83
!    Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 387;
!    Name_Maximum_Alignment              : constant Name_Id := N + 388; -- GNAT
!    Name_Mechanism_Code                 : constant Name_Id := N + 389; -- GNAT
!    Name_Mod                            : constant Name_Id := N + 390;
!    Name_Model_Emin                     : constant Name_Id := N + 391;
!    Name_Model_Epsilon                  : constant Name_Id := N + 392;
!    Name_Model_Mantissa                 : constant Name_Id := N + 393;
!    Name_Model_Small                    : constant Name_Id := N + 394;
!    Name_Modulus                        : constant Name_Id := N + 395;
!    Name_Null_Parameter                 : constant Name_Id := N + 396; -- GNAT
!    Name_Object_Size                    : constant Name_Id := N + 397; -- GNAT
!    Name_Partition_ID                   : constant Name_Id := N + 398;
!    Name_Passed_By_Reference            : constant Name_Id := N + 399; -- GNAT
!    Name_Pool_Address                   : constant Name_Id := N + 400;
!    Name_Pos                            : constant Name_Id := N + 401;
!    Name_Position                       : constant Name_Id := N + 402;
!    Name_Range                          : constant Name_Id := N + 403;
!    Name_Range_Length                   : constant Name_Id := N + 404; -- GNAT
!    Name_Round                          : constant Name_Id := N + 405;
!    Name_Safe_Emax                      : constant Name_Id := N + 406; -- Ada 83
!    Name_Safe_First                     : constant Name_Id := N + 407;
!    Name_Safe_Large                     : constant Name_Id := N + 408; -- Ada 83
!    Name_Safe_Last                      : constant Name_Id := N + 409;
!    Name_Safe_Small                     : constant Name_Id := N + 410; -- Ada 83
!    Name_Scale                          : constant Name_Id := N + 411;
!    Name_Scaling                        : constant Name_Id := N + 412;
!    Name_Signed_Zeros                   : constant Name_Id := N + 413;
!    Name_Size                           : constant Name_Id := N + 414;
!    Name_Small                          : constant Name_Id := N + 415;
!    Name_Storage_Size                   : constant Name_Id := N + 416;
!    Name_Storage_Unit                   : constant Name_Id := N + 417; -- GNAT
!    Name_Stream_Size                    : constant Name_Id := N + 418; -- Ada 05
!    Name_Tag                            : constant Name_Id := N + 419;
!    Name_Target_Name                    : constant Name_Id := N + 420; -- GNAT
!    Name_Terminated                     : constant Name_Id := N + 421;
!    Name_To_Address                     : constant Name_Id := N + 422; -- GNAT
!    Name_Type_Class                     : constant Name_Id := N + 423; -- GNAT
!    Name_UET_Address                    : constant Name_Id := N + 424; -- GNAT
!    Name_Unbiased_Rounding              : constant Name_Id := N + 425;
!    Name_Unchecked_Access               : constant Name_Id := N + 426;
!    Name_Unconstrained_Array            : constant Name_Id := N + 427;
!    Name_Universal_Literal_String       : constant Name_Id := N + 428; -- GNAT
!    Name_Unrestricted_Access            : constant Name_Id := N + 429; -- GNAT
!    Name_VADS_Size                      : constant Name_Id := N + 430; -- GNAT
!    Name_Val                            : constant Name_Id := N + 431;
!    Name_Valid                          : constant Name_Id := N + 432;
!    Name_Value_Size                     : constant Name_Id := N + 433; -- GNAT
!    Name_Version                        : constant Name_Id := N + 434;
!    Name_Wchar_T_Size                   : constant Name_Id := N + 435; -- GNAT
!    Name_Wide_Wide_Width                : constant Name_Id := N + 436; -- Ada 05
!    Name_Wide_Width                     : constant Name_Id := N + 437;
!    Name_Width                          : constant Name_Id := N + 438;
!    Name_Word_Size                      : constant Name_Id := N + 439; -- GNAT
! 
!    --  Attributes that designate attributes returning renamable functions,
!    --  i.e. functions that return other than a universal value and that
!    --  have non-universal arguments.
! 
!    First_Renamable_Function_Attribute  : constant Name_Id := N + 440;
!    Name_Adjacent                       : constant Name_Id := N + 440;
!    Name_Ceiling                        : constant Name_Id := N + 441;
!    Name_Copy_Sign                      : constant Name_Id := N + 442;
!    Name_Floor                          : constant Name_Id := N + 443;
!    Name_Fraction                       : constant Name_Id := N + 444;
!    Name_Image                          : constant Name_Id := N + 445;
!    Name_Input                          : constant Name_Id := N + 446;
!    Name_Machine                        : constant Name_Id := N + 447;
!    Name_Max                            : constant Name_Id := N + 448;
!    Name_Min                            : constant Name_Id := N + 449;
!    Name_Model                          : constant Name_Id := N + 450;
!    Name_Pred                           : constant Name_Id := N + 451;
!    Name_Remainder                      : constant Name_Id := N + 452;
!    Name_Rounding                       : constant Name_Id := N + 453;
!    Name_Succ                           : constant Name_Id := N + 454;
!    Name_Truncation                     : constant Name_Id := N + 455;
!    Name_Value                          : constant Name_Id := N + 456;
!    Name_Wide_Image                     : constant Name_Id := N + 457;
!    Name_Wide_Wide_Image                : constant Name_Id := N + 458;
!    Name_Wide_Value                     : constant Name_Id := N + 459;
!    Name_Wide_Wide_Value                : constant Name_Id := N + 460;
!    Last_Renamable_Function_Attribute   : constant Name_Id := N + 460;
! 
!    --  Attributes that designate procedures
! 
!    First_Procedure_Attribute           : constant Name_Id := N + 461;
!    Name_Output                         : constant Name_Id := N + 461;
!    Name_Read                           : constant Name_Id := N + 462;
!    Name_Write                          : constant Name_Id := N + 463;
!    Last_Procedure_Attribute            : constant Name_Id := N + 463;
! 
!    --  Remaining attributes are ones that return entities
! 
!    First_Entity_Attribute_Name         : constant Name_Id := N + 464;
!    Name_Elab_Body                      : constant Name_Id := N + 464; -- GNAT
!    Name_Elab_Spec                      : constant Name_Id := N + 465; -- GNAT
!    Name_Storage_Pool                   : constant Name_Id := N + 466;
! 
!    --  These attributes are the ones that return types
! 
!    First_Type_Attribute_Name           : constant Name_Id := N + 467;
!    Name_Base                           : constant Name_Id := N + 467;
!    Name_Class                          : constant Name_Id := N + 468;
!    Last_Type_Attribute_Name            : constant Name_Id := N + 468;
!    Last_Entity_Attribute_Name          : constant Name_Id := N + 468;
!    Last_Attribute_Name                 : constant Name_Id := N + 468;
! 
!    --  Names of recognized locking policy identifiers
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. C for Ceiling_Locking). If new policy names are added,
!    --  the first character must be distinct.
! 
!    First_Locking_Policy_Name           : constant Name_Id := N + 469;
!    Name_Ceiling_Locking                : constant Name_Id := N + 469;
!    Name_Inheritance_Locking            : constant Name_Id := N + 470;
!    Last_Locking_Policy_Name            : constant Name_Id := N + 470;
! 
!    --  Names of recognized queuing policy identifiers.
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. F for FIFO_Queuing). If new policy names are added,
!    --  the first character must be distinct.
! 
!    First_Queuing_Policy_Name           : constant Name_Id := N + 471;
!    Name_FIFO_Queuing                   : constant Name_Id := N + 471;
!    Name_Priority_Queuing               : constant Name_Id := N + 472;
!    Last_Queuing_Policy_Name            : constant Name_Id := N + 472;
! 
!    --  Names of recognized task dispatching policy identifiers
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
!    --  are added, the first character must be distinct.
! 
!    First_Task_Dispatching_Policy_Name  : constant Name_Id := N + 473;
!    Name_FIFO_Within_Priorities         : constant Name_Id := N + 473;
!    Last_Task_Dispatching_Policy_Name   : constant Name_Id := N + 473;
! 
!    --  Names of recognized checks for pragma Suppress
! 
!    First_Check_Name                    : constant Name_Id := N + 474;
!    Name_Access_Check                   : constant Name_Id := N + 474;
!    Name_Accessibility_Check            : constant Name_Id := N + 475;
!    Name_Discriminant_Check             : constant Name_Id := N + 476;
!    Name_Division_Check                 : constant Name_Id := N + 477;
!    Name_Elaboration_Check              : constant Name_Id := N + 478;
!    Name_Index_Check                    : constant Name_Id := N + 479;
!    Name_Length_Check                   : constant Name_Id := N + 480;
!    Name_Overflow_Check                 : constant Name_Id := N + 481;
!    Name_Range_Check                    : constant Name_Id := N + 482;
!    Name_Storage_Check                  : constant Name_Id := N + 483;
!    Name_Tag_Check                      : constant Name_Id := N + 484;
!    Name_All_Checks                     : constant Name_Id := N + 485;
!    Last_Check_Name                     : constant Name_Id := N + 485;
! 
!    --  Names corresponding to reserved keywords, excluding those already
!    --  declared in the attribute list (Access, Delta, Digits, Mod, Range).
! 
!    Name_Abort                          : constant Name_Id := N + 486;
!    Name_Abs                            : constant Name_Id := N + 487;
!    Name_Accept                         : constant Name_Id := N + 488;
!    Name_And                            : constant Name_Id := N + 489;
!    Name_All                            : constant Name_Id := N + 490;
!    Name_Array                          : constant Name_Id := N + 491;
!    Name_At                             : constant Name_Id := N + 492;
!    Name_Begin                          : constant Name_Id := N + 493;
!    Name_Body                           : constant Name_Id := N + 494;
!    Name_Case                           : constant Name_Id := N + 495;
!    Name_Constant                       : constant Name_Id := N + 496;
!    Name_Declare                        : constant Name_Id := N + 497;
!    Name_Delay                          : constant Name_Id := N + 498;
!    Name_Do                             : constant Name_Id := N + 499;
!    Name_Else                           : constant Name_Id := N + 500;
!    Name_Elsif                          : constant Name_Id := N + 501;
!    Name_End                            : constant Name_Id := N + 502;
!    Name_Entry                          : constant Name_Id := N + 503;
!    Name_Exception                      : constant Name_Id := N + 504;
!    Name_Exit                           : constant Name_Id := N + 505;
!    Name_For                            : constant Name_Id := N + 506;
!    Name_Function                       : constant Name_Id := N + 507;
!    Name_Generic                        : constant Name_Id := N + 508;
!    Name_Goto                           : constant Name_Id := N + 509;
!    Name_If                             : constant Name_Id := N + 510;
!    Name_In                             : constant Name_Id := N + 511;
!    Name_Is                             : constant Name_Id := N + 512;
!    Name_Limited                        : constant Name_Id := N + 513;
!    Name_Loop                           : constant Name_Id := N + 514;
!    Name_New                            : constant Name_Id := N + 515;
!    Name_Not                            : constant Name_Id := N + 516;
!    Name_Null                           : constant Name_Id := N + 517;
!    Name_Of                             : constant Name_Id := N + 518;
!    Name_Or                             : constant Name_Id := N + 519;
!    Name_Others                         : constant Name_Id := N + 520;
!    Name_Out                            : constant Name_Id := N + 521;
!    Name_Package                        : constant Name_Id := N + 522;
!    Name_Pragma                         : constant Name_Id := N + 523;
!    Name_Private                        : constant Name_Id := N + 524;
!    Name_Procedure                      : constant Name_Id := N + 525;
!    Name_Raise                          : constant Name_Id := N + 526;
!    Name_Record                         : constant Name_Id := N + 527;
!    Name_Rem                            : constant Name_Id := N + 528;
!    Name_Renames                        : constant Name_Id := N + 529;
!    Name_Return                         : constant Name_Id := N + 530;
!    Name_Reverse                        : constant Name_Id := N + 531;
!    Name_Select                         : constant Name_Id := N + 532;
!    Name_Separate                       : constant Name_Id := N + 533;
!    Name_Subtype                        : constant Name_Id := N + 534;
!    Name_Task                           : constant Name_Id := N + 535;
!    Name_Terminate                      : constant Name_Id := N + 536;
!    Name_Then                           : constant Name_Id := N + 537;
!    Name_Type                           : constant Name_Id := N + 538;
!    Name_Use                            : constant Name_Id := N + 539;
!    Name_When                           : constant Name_Id := N + 540;
!    Name_While                          : constant Name_Id := N + 541;
!    Name_With                           : constant Name_Id := N + 542;
!    Name_Xor                            : constant Name_Id := N + 543;
! 
!    --  Names of intrinsic subprograms
! 
!    --  Note: Asm is missing from this list, since Asm is a legitimate
!    --  convention name. So is To_Adress, which is a GNAT attribute.
! 
!    First_Intrinsic_Name                : constant Name_Id := N + 544;
!    Name_Divide                         : constant Name_Id := N + 544;
!    Name_Enclosing_Entity               : constant Name_Id := N + 545;
!    Name_Exception_Information          : constant Name_Id := N + 546;
!    Name_Exception_Message              : constant Name_Id := N + 547;
!    Name_Exception_Name                 : constant Name_Id := N + 548;
!    Name_File                           : constant Name_Id := N + 549;
!    Name_Import_Address                 : constant Name_Id := N + 550;
!    Name_Import_Largest_Value           : constant Name_Id := N + 551;
!    Name_Import_Value                   : constant Name_Id := N + 552;
!    Name_Is_Negative                    : constant Name_Id := N + 553;
!    Name_Line                           : constant Name_Id := N + 554;
!    Name_Rotate_Left                    : constant Name_Id := N + 555;
!    Name_Rotate_Right                   : constant Name_Id := N + 556;
!    Name_Shift_Left                     : constant Name_Id := N + 557;
!    Name_Shift_Right                    : constant Name_Id := N + 558;
!    Name_Shift_Right_Arithmetic         : constant Name_Id := N + 559;
!    Name_Source_Location                : constant Name_Id := N + 560;
!    Name_Unchecked_Conversion           : constant Name_Id := N + 561;
!    Name_Unchecked_Deallocation         : constant Name_Id := N + 562;
!    Name_To_Pointer                     : constant Name_Id := N + 563;
!    Last_Intrinsic_Name                 : constant Name_Id := N + 563;
! 
!    --  Reserved words used only in Ada 95
! 
!    First_95_Reserved_Word              : constant Name_Id := N + 564;
!    Name_Abstract                       : constant Name_Id := N + 564;
!    Name_Aliased                        : constant Name_Id := N + 565;
!    Name_Protected                      : constant Name_Id := N + 566;
!    Name_Until                          : constant Name_Id := N + 567;
!    Name_Requeue                        : constant Name_Id := N + 568;
!    Name_Tagged                         : constant Name_Id := N + 569;
!    Last_95_Reserved_Word               : constant Name_Id := N + 569;
! 
!    subtype Ada_95_Reserved_Words is
!      Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
! 
!    --  Miscellaneous names used in semantic checking
! 
!    Name_Raise_Exception                : constant Name_Id := N + 570;
! 
!    --  Additional reserved words and identifiers used in GNAT Project Files
!    --  Note that Name_External is already previously declared
! 
!    Name_Ada_Roots                      : constant Name_Id := N + 571;
!    Name_Binder                         : constant Name_Id := N + 572;
!    Name_Binder_Driver                  : constant Name_Id := N + 573;
!    Name_Body_Suffix                    : constant Name_Id := N + 574;
!    Name_Builder                        : constant Name_Id := N + 575;
!    Name_Compiler                       : constant Name_Id := N + 576;
!    Name_Compiler_Driver                : constant Name_Id := N + 577;
!    Name_Compiler_Kind                  : constant Name_Id := N + 578;
!    Name_Compute_Dependency             : constant Name_Id := N + 579;
!    Name_Cross_Reference                : constant Name_Id := N + 580;
!    Name_Default_Linker                 : constant Name_Id := N + 581;
!    Name_Default_Switches               : constant Name_Id := N + 582;
!    Name_Dependency_Option              : constant Name_Id := N + 583;
!    Name_Exec_Dir                       : constant Name_Id := N + 584;
!    Name_Executable                     : constant Name_Id := N + 585;
!    Name_Executable_Suffix              : constant Name_Id := N + 586;
!    Name_Extends                        : constant Name_Id := N + 587;
!    Name_Externally_Built               : constant Name_Id := N + 588;
!    Name_Finder                         : constant Name_Id := N + 589;
!    Name_Global_Configuration_Pragmas   : constant Name_Id := N + 590;
!    Name_Gnatls                         : constant Name_Id := N + 591;
!    Name_Gnatstub                       : constant Name_Id := N + 592;
!    Name_Implementation                 : constant Name_Id := N + 593;
!    Name_Implementation_Exceptions      : constant Name_Id := N + 594;
!    Name_Implementation_Suffix          : constant Name_Id := N + 595;
!    Name_Include_Option                 : constant Name_Id := N + 596;
!    Name_Language_Processing            : constant Name_Id := N + 597;
!    Name_Languages                      : constant Name_Id := N + 598;
!    Name_Library_Dir                    : constant Name_Id := N + 599;
!    Name_Library_Auto_Init              : constant Name_Id := N + 600;
!    Name_Library_GCC                    : constant Name_Id := N + 601;
!    Name_Library_Interface              : constant Name_Id := N + 602;
!    Name_Library_Kind                   : constant Name_Id := N + 603;
!    Name_Library_Name                   : constant Name_Id := N + 604;
!    Name_Library_Options                : constant Name_Id := N + 605;
!    Name_Library_Reference_Symbol_File  : constant Name_Id := N + 606;
!    Name_Library_Src_Dir                : constant Name_Id := N + 607;
!    Name_Library_Symbol_File            : constant Name_Id := N + 608;
!    Name_Library_Symbol_Policy          : constant Name_Id := N + 609;
!    Name_Library_Version                : constant Name_Id := N + 610;
!    Name_Linker                         : constant Name_Id := N + 611;
!    Name_Local_Configuration_Pragmas    : constant Name_Id := N + 612;
!    Name_Locally_Removed_Files          : constant Name_Id := N + 613;
!    Name_Metrics                        : constant Name_Id := N + 614;
!    Name_Naming                         : constant Name_Id := N + 615;
!    Name_Object_Dir                     : constant Name_Id := N + 616;
!    Name_Pretty_Printer                 : constant Name_Id := N + 617;
!    Name_Project                        : constant Name_Id := N + 618;
!    Name_Separate_Suffix                : constant Name_Id := N + 619;
!    Name_Source_Dirs                    : constant Name_Id := N + 620;
!    Name_Source_Files                   : constant Name_Id := N + 621;
!    Name_Source_List_File               : constant Name_Id := N + 622;
!    Name_Spec                           : constant Name_Id := N + 623;
!    Name_Spec_Suffix                    : constant Name_Id := N + 624;
!    Name_Specification                  : constant Name_Id := N + 625;
!    Name_Specification_Exceptions       : constant Name_Id := N + 626;
!    Name_Specification_Suffix           : constant Name_Id := N + 627;
!    Name_Switches                       : constant Name_Id := N + 628;
! 
!    --  Other miscellaneous names used in front end
! 
!    Name_Unaligned_Valid                : constant Name_Id := N + 629;
! 
!    --  ----------------------------------------------------------------
!    First_2005_Reserved_Word            : constant Name_Id := N + 630;
!    Name_Interface                      : constant Name_Id := N + 630;
!    Name_Overriding                     : constant Name_Id := N + 631;
!    Name_Synchronized                   : constant Name_Id := N + 632;
!    Last_2005_Reserved_Word             : constant Name_Id := N + 632;
! 
!    subtype Ada_2005_Reserved_Words is
!      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
! 
!    --  Mark last defined name for consistency check in Snames body
! 
!    Last_Predefined_Name                : constant Name_Id := N + 632;
! 
!    subtype Any_Operator_Name is Name_Id range
!      First_Operator_Name .. Last_Operator_Name;
! 
!    ------------------------------
!    -- Attribute ID Definitions --
!    ------------------------------
! 
!    type Attribute_Id is (
!       Attribute_Abort_Signal,
!       Attribute_Access,
!       Attribute_Address,
!       Attribute_Address_Size,
!       Attribute_Aft,
!       Attribute_Alignment,
!       Attribute_Asm_Input,
!       Attribute_Asm_Output,
!       Attribute_AST_Entry,
!       Attribute_Bit,
!       Attribute_Bit_Order,
!       Attribute_Bit_Position,
!       Attribute_Body_Version,
!       Attribute_Callable,
!       Attribute_Caller,
!       Attribute_Code_Address,
!       Attribute_Component_Size,
!       Attribute_Compose,
!       Attribute_Constrained,
!       Attribute_Count,
!       Attribute_Default_Bit_Order,
!       Attribute_Definite,
!       Attribute_Delta,
!       Attribute_Denorm,
!       Attribute_Digits,
!       Attribute_Elaborated,
!       Attribute_Emax,
!       Attribute_Enum_Rep,
!       Attribute_Epsilon,
!       Attribute_Exponent,
!       Attribute_External_Tag,
!       Attribute_First,
!       Attribute_First_Bit,
!       Attribute_Fixed_Value,
!       Attribute_Fore,
!       Attribute_Has_Access_Values,
!       Attribute_Has_Discriminants,
!       Attribute_Identity,
!       Attribute_Img,
!       Attribute_Integer_Value,
!       Attribute_Large,
!       Attribute_Last,
!       Attribute_Last_Bit,
!       Attribute_Leading_Part,
!       Attribute_Length,
!       Attribute_Machine_Emax,
!       Attribute_Machine_Emin,
!       Attribute_Machine_Mantissa,
!       Attribute_Machine_Overflows,
!       Attribute_Machine_Radix,
!       Attribute_Machine_Rounds,
!       Attribute_Machine_Size,
!       Attribute_Mantissa,
!       Attribute_Max_Size_In_Storage_Elements,
!       Attribute_Maximum_Alignment,
!       Attribute_Mechanism_Code,
!       Attribute_Mod,
!       Attribute_Model_Emin,
!       Attribute_Model_Epsilon,
!       Attribute_Model_Mantissa,
!       Attribute_Model_Small,
!       Attribute_Modulus,
!       Attribute_Null_Parameter,
!       Attribute_Object_Size,
!       Attribute_Partition_ID,
!       Attribute_Passed_By_Reference,
!       Attribute_Pool_Address,
!       Attribute_Pos,
!       Attribute_Position,
!       Attribute_Range,
!       Attribute_Range_Length,
!       Attribute_Round,
!       Attribute_Safe_Emax,
!       Attribute_Safe_First,
!       Attribute_Safe_Large,
!       Attribute_Safe_Last,
!       Attribute_Safe_Small,
!       Attribute_Scale,
!       Attribute_Scaling,
!       Attribute_Signed_Zeros,
!       Attribute_Size,
!       Attribute_Small,
!       Attribute_Storage_Size,
!       Attribute_Storage_Unit,
!       Attribute_Stream_Size,
!       Attribute_Tag,
!       Attribute_Target_Name,
!       Attribute_Terminated,
!       Attribute_To_Address,
!       Attribute_Type_Class,
!       Attribute_UET_Address,
!       Attribute_Unbiased_Rounding,
!       Attribute_Unchecked_Access,
!       Attribute_Unconstrained_Array,
!       Attribute_Universal_Literal_String,
!       Attribute_Unrestricted_Access,
!       Attribute_VADS_Size,
!       Attribute_Val,
!       Attribute_Valid,
!       Attribute_Value_Size,
!       Attribute_Version,
!       Attribute_Wchar_T_Size,
!       Attribute_Wide_Wide_Width,
!       Attribute_Wide_Width,
!       Attribute_Width,
!       Attribute_Word_Size,
! 
!       --  Attributes designating renamable functions
! 
!       Attribute_Adjacent,
!       Attribute_Ceiling,
!       Attribute_Copy_Sign,
!       Attribute_Floor,
!       Attribute_Fraction,
!       Attribute_Image,
!       Attribute_Input,
!       Attribute_Machine,
!       Attribute_Max,
!       Attribute_Min,
!       Attribute_Model,
!       Attribute_Pred,
!       Attribute_Remainder,
!       Attribute_Rounding,
!       Attribute_Succ,
!       Attribute_Truncation,
!       Attribute_Value,
!       Attribute_Wide_Image,
!       Attribute_Wide_Wide_Image,
!       Attribute_Wide_Value,
!       Attribute_Wide_Wide_Value,
! 
!       --  Attributes designating procedures
! 
!       Attribute_Output,
!       Attribute_Read,
!       Attribute_Write,
! 
!       --  Entity attributes (includes type attributes)
! 
!       Attribute_Elab_Body,
!       Attribute_Elab_Spec,
!       Attribute_Storage_Pool,
! 
!       --  Type attributes
! 
!       Attribute_Base,
!       Attribute_Class);
! 
!    ------------------------------------
!    -- Convention Name ID Definitions --
!    ------------------------------------
! 
!    type Convention_Id is (
! 
!       --  The conventions that are defined by the RM come first
! 
!       Convention_Ada,
!       Convention_Intrinsic,
!       Convention_Entry,
!       Convention_Protected,
! 
!       --  The remaining conventions are foreign language conventions
! 
!       Convention_Assembler,  --  also Asm, Assembly
!       Convention_C,          --  also Default, External
!       Convention_COBOL,
!       Convention_CPP,
!       Convention_Fortran,
!       Convention_Java,
!       Convention_Stdcall,    --  also DLL, Win32
!       Convention_Stubbed);
! 
!       --  Note: Convention C_Pass_By_Copy is allowed only for record
!       --  types (where it is treated like C except that the appropriate
!       --  flag is set in the record type). Recognizion of this convention
!       --  is specially handled in Sem_Prag.
! 
!    for Convention_Id'Size use 8;
!    --  Plenty of space for expansion
! 
!    subtype Foreign_Convention is
!      Convention_Id range Convention_Assembler .. Convention_Stdcall;
! 
!    -----------------------------------
!    -- Locking Policy ID Definitions --
!    -----------------------------------
! 
!    type Locking_Policy_Id is (
!       Locking_Policy_Inheritance_Locking,
!       Locking_Policy_Ceiling_Locking);
! 
!    ---------------------------
!    -- Pragma ID Definitions --
!    ---------------------------
! 
!    type Pragma_Id is (
! 
!       --  Configuration pragmas
! 
!       Pragma_Ada_83,
!       Pragma_Ada_95,
!       Pragma_Ada_05,
!       Pragma_C_Pass_By_Copy,
!       Pragma_Compile_Time_Warning,
!       Pragma_Component_Alignment,
!       Pragma_Convention_Identifier,
!       Pragma_Detect_Blocking,
!       Pragma_Discard_Names,
!       Pragma_Elaboration_Checks,
!       Pragma_Eliminate,
!       Pragma_Explicit_Overriding,
!       Pragma_Extend_System,
!       Pragma_Extensions_Allowed,
!       Pragma_External_Name_Casing,
!       Pragma_Float_Representation,
!       Pragma_Initialize_Scalars,
!       Pragma_Interrupt_State,
!       Pragma_License,
!       Pragma_Locking_Policy,
!       Pragma_Long_Float,
!       Pragma_No_Run_Time,
!       Pragma_No_Strict_Aliasing,
!       Pragma_Normalize_Scalars,
!       Pragma_Polling,
!       Pragma_Persistent_Data,
!       Pragma_Persistent_Object,
!       Pragma_Profile,
!       Pragma_Profile_Warnings,
!       Pragma_Propagate_Exceptions,
!       Pragma_Queuing_Policy,
!       Pragma_Ravenscar,
!       Pragma_Restricted_Run_Time,
!       Pragma_Restrictions,
!       Pragma_Restriction_Warnings,
!       Pragma_Reviewable,
!       Pragma_Source_File_Name,
!       Pragma_Source_File_Name_Project,
!       Pragma_Style_Checks,
!       Pragma_Suppress,
!       Pragma_Suppress_Exception_Locations,
!       Pragma_Task_Dispatching_Policy,
!       Pragma_Universal_Data,
!       Pragma_Unsuppress,
!       Pragma_Use_VADS_Size,
!       Pragma_Validity_Checks,
!       Pragma_Warnings,
! 
!       --  Remaining (non-configuration) pragmas
! 
!       Pragma_Abort_Defer,
!       Pragma_All_Calls_Remote,
!       Pragma_Annotate,
!       Pragma_Assert,
!       Pragma_Asynchronous,
!       Pragma_Atomic,
!       Pragma_Atomic_Components,
!       Pragma_Attach_Handler,
!       Pragma_Comment,
!       Pragma_Common_Object,
!       Pragma_Complex_Representation,
!       Pragma_Controlled,
!       Pragma_Convention,
!       Pragma_CPP_Class,
!       Pragma_CPP_Constructor,
!       Pragma_CPP_Virtual,
!       Pragma_CPP_Vtable,
!       Pragma_Debug,
!       Pragma_Elaborate,
!       Pragma_Elaborate_All,
!       Pragma_Elaborate_Body,
!       Pragma_Export,
!       Pragma_Export_Exception,
!       Pragma_Export_Function,
!       Pragma_Export_Object,
!       Pragma_Export_Procedure,
!       Pragma_Export_Value,
!       Pragma_Export_Valued_Procedure,
!       Pragma_External,
!       Pragma_Finalize_Storage_Only,
!       Pragma_Ident,
!       Pragma_Import,
!       Pragma_Import_Exception,
!       Pragma_Import_Function,
!       Pragma_Import_Object,
!       Pragma_Import_Procedure,
!       Pragma_Import_Valued_Procedure,
!       Pragma_Inline,
!       Pragma_Inline_Always,
!       Pragma_Inline_Generic,
!       Pragma_Inspection_Point,
!       Pragma_Interface_Name,
!       Pragma_Interrupt_Handler,
!       Pragma_Interrupt_Priority,
!       Pragma_Java_Constructor,
!       Pragma_Java_Interface,
!       Pragma_Keep_Names,
!       Pragma_Link_With,
!       Pragma_Linker_Alias,
!       Pragma_Linker_Options,
!       Pragma_Linker_Section,
!       Pragma_List,
!       Pragma_Machine_Attribute,
!       Pragma_Main,
!       Pragma_Main_Storage,
!       Pragma_Memory_Size,
!       Pragma_No_Return,
!       Pragma_Obsolescent,
!       Pragma_Optimize,
!       Pragma_Optional_Overriding,
!       Pragma_Pack,
!       Pragma_Page,
!       Pragma_Passive,
!       Pragma_Preelaborate,
!       Pragma_Priority,
!       Pragma_Psect_Object,
!       Pragma_Pure,
!       Pragma_Pure_Function,
!       Pragma_Remote_Call_Interface,
!       Pragma_Remote_Types,
!       Pragma_Share_Generic,
!       Pragma_Shared,
!       Pragma_Shared_Passive,
!       Pragma_Source_Reference,
!       Pragma_Stream_Convert,
!       Pragma_Subtitle,
!       Pragma_Suppress_All,
!       Pragma_Suppress_Debug_Info,
!       Pragma_Suppress_Initialization,
!       Pragma_System_Name,
!       Pragma_Task_Info,
!       Pragma_Task_Name,
!       Pragma_Task_Storage,
!       Pragma_Thread_Body,
!       Pragma_Time_Slice,
!       Pragma_Title,
!       Pragma_Unchecked_Union,
!       Pragma_Unimplemented_Unit,
!       Pragma_Unreferenced,
!       Pragma_Unreserve_All_Interrupts,
!       Pragma_Volatile,
!       Pragma_Volatile_Components,
!       Pragma_Weak_External,
! 
!       --  The following pragmas are on their own, out of order, because of
!       --  the special processing required to deal with the fact that their
!       --  names match existing attribute names.
! 
!       Pragma_AST_Entry,
!       Pragma_Interface,
!       Pragma_Storage_Size,
!       Pragma_Storage_Unit,
! 
!       --  The value to represent an unknown or unrecognized pragma
! 
!       Unknown_Pragma);
! 
!    -----------------------------------
!    -- Queuing Policy ID definitions --
!    -----------------------------------
! 
!    type Queuing_Policy_Id is (
!       Queuing_Policy_FIFO_Queuing,
!       Queuing_Policy_Priority_Queuing);
! 
!    --------------------------------------------
!    -- Task Dispatching Policy ID definitions --
!    --------------------------------------------
! 
!    type Task_Dispatching_Policy_Id is (
!       Task_Dispatching_FIFO_Within_Priorities);
!    --  Id values used to identify task dispatching policies
! 
!    -----------------
!    -- Subprograms --
!    -----------------
! 
!    procedure Initialize;
!    --  Called to initialize the preset names in the names table.
! 
!    function Is_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute
! 
!    function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized entity attribute,
!    --  i.e. an attribute reference that returns an entity.
! 
!    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute that
!    --  designates a procedure (and can therefore appear as a statement).
! 
!    function Is_Function_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute
!    --  that designates a renameable function, and can therefore appear in
!    --  a renaming statement. Note that not all attributes designating
!    --  functions are renamable, in particular, thos returning a universal
!    --  value cannot be renamed.
! 
!    function Is_Type_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized type attribute,
!    --  i.e. an attribute reference that returns a type
! 
!    function Is_Check_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized suppress check
!    --  as required by pragma Suppress.
! 
!    function Is_Convention_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of one of the recognized
!    --  language conventions, as required by pragma Convention, Import,
!    --  Export, Interface. Returns True if so. Also returns True for a
!    --  name that has been specified by a Convention_Identifier pragma.
!    --  If neither case holds, returns False.
! 
!    function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized locking policy
! 
!    function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of an operator symbol
! 
!    function Is_Pragma_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized pragma. Note
!    --  that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized
!    --  as pragmas by this function even though their names are separate from
!    --  the other pragma names.
! 
!    function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized queuing policy
! 
!    function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized task
!    --  dispatching policy.
! 
!    function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
!    --  Returns Id of attribute corresponding to given name. It is an error to
!    --  call this function with a name that is not the name of a attribute.
! 
!    function Get_Convention_Id (N : Name_Id) return Convention_Id;
!    --  Returns Id of language convention corresponding to given name. It is an
!    --  to call this function with a name that is not the name of a convention,
!    --  or one previously given in a call to Record_Convention_Identifier.
! 
!    function Get_Check_Id (N : Name_Id) return Check_Id;
!    --  Returns Id of suppress check corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
!    --  Returns Id of locking policy corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Pragma_Id (N : Name_Id) return Pragma_Id;
!    --  Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
!    --  if N is not a name of a known (Ada defined or GNAT-specific) pragma.
!    --  Note that the function also works correctly for names of pragmas that
!    --  are not in the main list of pragma Names (AST_Entry, Storage_Size, and
!    --  Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
! 
!    function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
!    --  Returns Id of queuing policy corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Task_Dispatching_Policy_Id
!      (N    : Name_Id)
!       return Task_Dispatching_Policy_Id;
!    --  Returns Id of task dispatching policy corresponding to given name.
!    --  It is an error to call this function with a name that is not the
!    --  name of a check.
! 
!    procedure Record_Convention_Identifier
!      (Id         : Name_Id;
!       Convention : Convention_Id);
!    --  A call to this procedure, resulting from an occurrence of a pragma
!    --  Convention_Identifier, records that from now on an occurrence of
!    --  Id will be recognized as a name for the specified convention.
! 
! private
!    pragma Inline (Is_Attribute_Name);
!    pragma Inline (Is_Entity_Attribute_Name);
!    pragma Inline (Is_Type_Attribute_Name);
!    pragma Inline (Is_Check_Name);
!    pragma Inline (Is_Locking_Policy_Name);
!    pragma Inline (Is_Operator_Symbol_Name);
!    pragma Inline (Is_Queuing_Policy_Name);
!    pragma Inline (Is_Pragma_Name);
!    pragma Inline (Is_Task_Dispatching_Policy_Name);
! 
! end Snames;
--- 1,1535 ----
! ------------------------------------------------------------------------------
! --                                                                          --
! --                         GNAT COMPILER COMPONENTS                         --
! --                                                                          --
! --                               S N A M E S                                --
! --                                                                          --
! --                                 S p e c                                  --
! --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
! --                                                                          --
! -- GNAT is free software;  you can  redistribute it  and/or modify it under --
! -- terms of the  GNU General Public License as published  by the Free Soft- --
! -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
! -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
! -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
! -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
! -- for  more details.  You should have  received  a copy of the GNU General --
! -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
! --                                                                          --
! -- As a special exception,  if other files  instantiate  generics from this --
! -- unit, or you link  this unit with other files  to produce an executable, --
! -- this  unit  does not  by itself cause  the resulting  executable  to  be --
! -- covered  by the  GNU  General  Public  License.  This exception does not --
! -- however invalidate  any other reasons why  the executable file  might be --
! -- covered by the  GNU Public License.                                      --
! --                                                                          --
! -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
! --                                                                          --
! ------------------------------------------------------------------------------
! 
! with Types; use Types;
! 
! package Snames is
! 
! --  This package contains definitions of standard names (i.e. entries in the
! --  Names table) that are used throughout the GNAT compiler). It also contains
! --  the definitions of some enumeration types whose definitions are tied to
! --  the order of these preset names.
! 
! --  WARNING: There is a C file, a-snames.h which duplicates some of the
! --  definitions in this file and must be kept properly synchronized.
! 
!    ------------------
!    -- Preset Names --
!    ------------------
! 
!    --  The following are preset entries in the names table, which are entered
!    --  at the start of every compilation for easy access. Note that the order
!    --  of initialization of these names in the body must be coordinated with
!    --  the order of names in this table.
! 
!    --  Note: a name may not appear more than once in the following list. If
!    --  additional pragmas or attributes are introduced which might otherwise
!    --  cause a duplicate, then list it only once in this table, and adjust the
!    --  definition of the functions for testing for pragma names and attribute
!    --  names, and returning their ID values. Of course everything is simpler
!    --  if no such duplications occur!
! 
!    --  First we have the one character names used to optimize the lookup
!    --  process for one character identifiers (to avoid the hashing in this
!    --  case) There are a full 256 of these, but only the entries for lower
!    --  case and upper case letters have identifiers
! 
!    --  The lower case letter entries are used for one character identifiers
!    --  appearing in the source, for example in pragma Interface (C).
! 
!    Name_A : constant Name_Id := First_Name_Id + Character'Pos ('a');
!    Name_B : constant Name_Id := First_Name_Id + Character'Pos ('b');
!    Name_C : constant Name_Id := First_Name_Id + Character'Pos ('c');
!    Name_D : constant Name_Id := First_Name_Id + Character'Pos ('d');
!    Name_E : constant Name_Id := First_Name_Id + Character'Pos ('e');
!    Name_F : constant Name_Id := First_Name_Id + Character'Pos ('f');
!    Name_G : constant Name_Id := First_Name_Id + Character'Pos ('g');
!    Name_H : constant Name_Id := First_Name_Id + Character'Pos ('h');
!    Name_I : constant Name_Id := First_Name_Id + Character'Pos ('i');
!    Name_J : constant Name_Id := First_Name_Id + Character'Pos ('j');
!    Name_K : constant Name_Id := First_Name_Id + Character'Pos ('k');
!    Name_L : constant Name_Id := First_Name_Id + Character'Pos ('l');
!    Name_M : constant Name_Id := First_Name_Id + Character'Pos ('m');
!    Name_N : constant Name_Id := First_Name_Id + Character'Pos ('n');
!    Name_O : constant Name_Id := First_Name_Id + Character'Pos ('o');
!    Name_P : constant Name_Id := First_Name_Id + Character'Pos ('p');
!    Name_Q : constant Name_Id := First_Name_Id + Character'Pos ('q');
!    Name_R : constant Name_Id := First_Name_Id + Character'Pos ('r');
!    Name_S : constant Name_Id := First_Name_Id + Character'Pos ('s');
!    Name_T : constant Name_Id := First_Name_Id + Character'Pos ('t');
!    Name_U : constant Name_Id := First_Name_Id + Character'Pos ('u');
!    Name_V : constant Name_Id := First_Name_Id + Character'Pos ('v');
!    Name_W : constant Name_Id := First_Name_Id + Character'Pos ('w');
!    Name_X : constant Name_Id := First_Name_Id + Character'Pos ('x');
!    Name_Y : constant Name_Id := First_Name_Id + Character'Pos ('y');
!    Name_Z : constant Name_Id := First_Name_Id + Character'Pos ('z');
! 
!    --  The upper case letter entries are used by expander code for local
!    --  variables that do not require unique names (e.g. formal parameter
!    --  names in constructed procedures)
! 
!    Name_uA : constant Name_Id := First_Name_Id + Character'Pos ('A');
!    Name_uB : constant Name_Id := First_Name_Id + Character'Pos ('B');
!    Name_uC : constant Name_Id := First_Name_Id + Character'Pos ('C');
!    Name_uD : constant Name_Id := First_Name_Id + Character'Pos ('D');
!    Name_uE : constant Name_Id := First_Name_Id + Character'Pos ('E');
!    Name_uF : constant Name_Id := First_Name_Id + Character'Pos ('F');
!    Name_uG : constant Name_Id := First_Name_Id + Character'Pos ('G');
!    Name_uH : constant Name_Id := First_Name_Id + Character'Pos ('H');
!    Name_uI : constant Name_Id := First_Name_Id + Character'Pos ('I');
!    Name_uJ : constant Name_Id := First_Name_Id + Character'Pos ('J');
!    Name_uK : constant Name_Id := First_Name_Id + Character'Pos ('K');
!    Name_uL : constant Name_Id := First_Name_Id + Character'Pos ('L');
!    Name_uM : constant Name_Id := First_Name_Id + Character'Pos ('M');
!    Name_uN : constant Name_Id := First_Name_Id + Character'Pos ('N');
!    Name_uO : constant Name_Id := First_Name_Id + Character'Pos ('O');
!    Name_uP : constant Name_Id := First_Name_Id + Character'Pos ('P');
!    Name_uQ : constant Name_Id := First_Name_Id + Character'Pos ('Q');
!    Name_uR : constant Name_Id := First_Name_Id + Character'Pos ('R');
!    Name_uS : constant Name_Id := First_Name_Id + Character'Pos ('S');
!    Name_uT : constant Name_Id := First_Name_Id + Character'Pos ('T');
!    Name_uU : constant Name_Id := First_Name_Id + Character'Pos ('U');
!    Name_uV : constant Name_Id := First_Name_Id + Character'Pos ('V');
!    Name_uW : constant Name_Id := First_Name_Id + Character'Pos ('W');
!    Name_uX : constant Name_Id := First_Name_Id + Character'Pos ('X');
!    Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
!    Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
! 
!    --  Note: the following table is read by the utility program XSNAMES and
!    --  its format should not be changed without coordinating with this program.
! 
!    N : constant Name_Id := First_Name_Id + 256;
!    --  Synonym used in standard name definitions
! 
!    --  Some names that are used by gigi, and whose definitions are reflected
!    --  in the C header file a-snames.h. They are placed at the start so that
!    --  the need to modify a-snames.h is minimized.
! 
!    Name_uParent                        : constant Name_Id := N + 000;
!    Name_uTag                           : constant Name_Id := N + 001;
!    Name_Off                            : constant Name_Id := N + 002;
!    Name_Space                          : constant Name_Id := N + 003;
!    Name_Time                           : constant Name_Id := N + 004;
! 
!    --  Some special names used by the expander. Note that the lower case u's
!    --  at the start of these names get translated to extra underscores. These
!    --  names are only referenced internally by expander generated code.
! 
!    Name_uAbort_Signal                  : constant Name_Id := N + 005;
!    Name_uAlignment                     : constant Name_Id := N + 006;
!    Name_uAssign                        : constant Name_Id := N + 007;
!    Name_uATCB                          : constant Name_Id := N + 008;
!    Name_uChain                         : constant Name_Id := N + 009;
!    Name_uClean                         : constant Name_Id := N + 010;
!    Name_uController                    : constant Name_Id := N + 011;
!    Name_uEntry_Bodies                  : constant Name_Id := N + 012;
!    Name_uExpunge                       : constant Name_Id := N + 013;
!    Name_uFinal_List                    : constant Name_Id := N + 014;
!    Name_uIdepth                        : constant Name_Id := N + 015;
!    Name_uInit                          : constant Name_Id := N + 016;
!    Name_uLocal_Final_List              : constant Name_Id := N + 017;
!    Name_uMaster                        : constant Name_Id := N + 018;
!    Name_uObject                        : constant Name_Id := N + 019;
!    Name_uPriority                      : constant Name_Id := N + 020;
!    Name_uProcess_ATSD                  : constant Name_Id := N + 021;
!    Name_uSecondary_Stack               : constant Name_Id := N + 022;
!    Name_uService                       : constant Name_Id := N + 023;
!    Name_uSize                          : constant Name_Id := N + 024;
!    Name_uStack                         : constant Name_Id := N + 025;
!    Name_uTags                          : constant Name_Id := N + 026;
!    Name_uTask                          : constant Name_Id := N + 027;
!    Name_uTask_Id                       : constant Name_Id := N + 028;
!    Name_uTask_Info                     : constant Name_Id := N + 029;
!    Name_uTask_Name                     : constant Name_Id := N + 030;
!    Name_uTrace_Sp                      : constant Name_Id := N + 031;
! 
!    --  Names of routines used in the expansion of asynchronous, conditional
!    --  and timed dispatching selects.
! 
!    Name_uDisp_Asynchronous_Select      : constant Name_Id := N + 032;
!    Name_uDisp_Conditional_Select       : constant Name_Id := N + 033;
!    Name_uDisp_Get_Prim_Op_Kind         : constant Name_Id := N + 034;
!    Name_uDisp_Timed_Select             : constant Name_Id := N + 035;
! 
!    --  Names of routines used in the expansion of Abort, attributes 'Callable
!    --  and 'Terminated for task interface class-wide types.
! 
!    Name_uDisp_Get_Task_Id              : constant Name_Id := N + 036;
! 
!    --  Names of routines in Ada.Finalization, needed by expander
! 
!    Name_Initialize                     : constant Name_Id := N + 037;
!    Name_Adjust                         : constant Name_Id := N + 038;
!    Name_Finalize                       : constant Name_Id := N + 039;
! 
!    --  Names of fields declared in System.Finalization_Implementation,
!    --  needed by the expander when generating code for finalization.
! 
!    Name_Next                           : constant Name_Id := N + 040;
!    Name_Prev                           : constant Name_Id := N + 041;
! 
!    --  Names of TSS routines for implementation of DSA over PolyORB
! 
!    Name_uTypeCode                      : constant Name_Id := N + 042;
!    Name_uFrom_Any                      : constant Name_Id := N + 043;
!    Name_uTo_Any                        : constant Name_Id := N + 044;
! 
!    --  Names of allocation routines, also needed by expander
! 
!    Name_Allocate                       : constant Name_Id := N + 045;
!    Name_Deallocate                     : constant Name_Id := N + 046;
!    Name_Dereference                    : constant Name_Id := N + 047;
! 
!    --  Names of Text_IO generic subpackages (see Rtsfind.Text_IO_Kludge)
! 
!    First_Text_IO_Package               : constant Name_Id := N + 048;
!    Name_Decimal_IO                     : constant Name_Id := N + 048;
!    Name_Enumeration_IO                 : constant Name_Id := N + 049;
!    Name_Fixed_IO                       : constant Name_Id := N + 050;
!    Name_Float_IO                       : constant Name_Id := N + 051;
!    Name_Integer_IO                     : constant Name_Id := N + 052;
!    Name_Modular_IO                     : constant Name_Id := N + 053;
!    Last_Text_IO_Package                : constant Name_Id := N + 053;
! 
!    subtype Text_IO_Package_Name is Name_Id
!      range First_Text_IO_Package .. Last_Text_IO_Package;
! 
!    --  Some miscellaneous names used for error detection/recovery
! 
!    Name_Const                          : constant Name_Id := N + 054;
!    Name_Error                          : constant Name_Id := N + 055;
!    Name_Go                             : constant Name_Id := N + 056;
!    Name_Put                            : constant Name_Id := N + 057;
!    Name_Put_Line                       : constant Name_Id := N + 058;
!    Name_To                             : constant Name_Id := N + 059;
! 
!    --  Names for packages that are treated specially by the compiler
! 
!    Name_Finalization                   : constant Name_Id := N + 060;
!    Name_Finalization_Root              : constant Name_Id := N + 061;
!    Name_Interfaces                     : constant Name_Id := N + 062;
!    Name_Standard                       : constant Name_Id := N + 063;
!    Name_System                         : constant Name_Id := N + 064;
!    Name_Text_IO                        : constant Name_Id := N + 065;
!    Name_Wide_Text_IO                   : constant Name_Id := N + 066;
!    Name_Wide_Wide_Text_IO              : constant Name_Id := N + 067;
! 
!    --  Names of implementations of the distributed systems annex
! 
!    First_PCS_Name                      : constant Name_Id := N + 068;
!    Name_No_DSA                         : constant Name_Id := N + 068;
!    Name_GARLIC_DSA                     : constant Name_Id := N + 069;
!    Name_PolyORB_DSA                    : constant Name_Id := N + 070;
!    Last_PCS_Name                       : constant Name_Id := N + 070;
! 
!    subtype PCS_Names is Name_Id
!      range First_PCS_Name .. Last_PCS_Name;
! 
!    --  Names of identifiers used in expanding distribution stubs
! 
!    Name_Addr                           : constant Name_Id := N + 071;
!    Name_Async                          : constant Name_Id := N + 072;
!    Name_Get_Active_Partition_ID        : constant Name_Id := N + 073;
!    Name_Get_RCI_Package_Receiver       : constant Name_Id := N + 074;
!    Name_Get_RCI_Package_Ref            : constant Name_Id := N + 075;
!    Name_Origin                         : constant Name_Id := N + 076;
!    Name_Params                         : constant Name_Id := N + 077;
!    Name_Partition                      : constant Name_Id := N + 078;
!    Name_Partition_Interface            : constant Name_Id := N + 079;
!    Name_Ras                            : constant Name_Id := N + 080;
!    Name_Call                           : constant Name_Id := N + 081;
!    Name_RCI_Name                       : constant Name_Id := N + 082;
!    Name_Receiver                       : constant Name_Id := N + 083;
!    Name_Result                         : constant Name_Id := N + 084;
!    Name_Rpc                            : constant Name_Id := N + 085;
!    Name_Subp_Id                        : constant Name_Id := N + 086;
!    Name_Operation                      : constant Name_Id := N + 087;
!    Name_Argument                       : constant Name_Id := N + 088;
!    Name_Arg_Modes                      : constant Name_Id := N + 089;
!    Name_Handler                        : constant Name_Id := N + 090;
!    Name_Target                         : constant Name_Id := N + 091;
!    Name_Req                            : constant Name_Id := N + 092;
!    Name_Obj_TypeCode                   : constant Name_Id := N + 093;
!    Name_Stub                           : constant Name_Id := N + 094;
! 
!    --  Operator Symbol entries. The actual names have an upper case O at
!    --  the start in place of the Op_ prefix (e.g. the actual name that
!    --  corresponds to Name_Op_Abs is "Oabs".
! 
!    First_Operator_Name                 : constant Name_Id := N + 095;
!    Name_Op_Abs                         : constant Name_Id := N + 095; -- "abs"
!    Name_Op_And                         : constant Name_Id := N + 096; -- "and"
!    Name_Op_Mod                         : constant Name_Id := N + 097; -- "mod"
!    Name_Op_Not                         : constant Name_Id := N + 098; -- "not"
!    Name_Op_Or                          : constant Name_Id := N + 099; -- "or"
!    Name_Op_Rem                         : constant Name_Id := N + 100; -- "rem"
!    Name_Op_Xor                         : constant Name_Id := N + 101; -- "xor"
!    Name_Op_Eq                          : constant Name_Id := N + 102; -- "="
!    Name_Op_Ne                          : constant Name_Id := N + 103; -- "/="
!    Name_Op_Lt                          : constant Name_Id := N + 104; -- "<"
!    Name_Op_Le                          : constant Name_Id := N + 105; -- "<="
!    Name_Op_Gt                          : constant Name_Id := N + 106; -- ">"
!    Name_Op_Ge                          : constant Name_Id := N + 107; -- ">="
!    Name_Op_Add                         : constant Name_Id := N + 108; -- "+"
!    Name_Op_Subtract                    : constant Name_Id := N + 109; -- "-"
!    Name_Op_Concat                      : constant Name_Id := N + 110; -- "&"
!    Name_Op_Multiply                    : constant Name_Id := N + 111; -- "*"
!    Name_Op_Divide                      : constant Name_Id := N + 112; -- "/"
!    Name_Op_Expon                       : constant Name_Id := N + 113; -- "**"
!    Last_Operator_Name                  : constant Name_Id := N + 113;
! 
!    --  Names for all pragmas recognized by GNAT. The entries with the comment
!    --  "Ada 83" are pragmas that are defined in Ada 83, but not in Ada 95.
!    --  These pragmas are fully implemented in both Ada 83 and Ada 95 modes
!    --  in GNAT.
! 
!    --  The entries marked GNAT are pragmas that are defined by GNAT
!    --  and implemented in both Ada 83 and Ada 95 modes. Full descriptions
!    --  of these implementation dependent pragmas may be found in the
!    --  appropriate section in unit Sem_Prag in file sem-prag.adb.
! 
!    --  The entries marked Ada05 are technically implementation dependent
!    --  pragmas, but they correspond to standard proposals for Ada 2005.
! 
!    --  The entries marked VMS are VMS specific pragmas that are recognized
!    --  only in OpenVMS versions of GNAT. They are ignored in other versions
!    --  with an appropriate warning.
! 
!    --  The entries marked AAMP are AAMP specific pragmas that are recognized
!    --  only in GNAT for the AAMP. They are ignored in other versions with
!    --  appropriate warnings.
! 
!    First_Pragma_Name                   : constant Name_Id := N + 114;
! 
!    --  Configuration pragmas are grouped at start
! 
!    Name_Ada_83                         : constant Name_Id := N + 114; -- GNAT
!    Name_Ada_95                         : constant Name_Id := N + 115; -- GNAT
!    Name_Ada_05                         : constant Name_Id := N + 116; -- GNAT
!    Name_Assertion_Policy               : constant Name_Id := N + 117; -- Ada 05
!    Name_C_Pass_By_Copy                 : constant Name_Id := N + 118; -- GNAT
!    Name_Compile_Time_Warning           : constant Name_Id := N + 119; -- GNAT
!    Name_Component_Alignment            : constant Name_Id := N + 120; -- GNAT
!    Name_Convention_Identifier          : constant Name_Id := N + 121; -- GNAT
!    Name_Debug_Policy                   : constant Name_Id := N + 122; -- GNAT
!    Name_Detect_Blocking                : constant Name_Id := N + 123; -- Ada 05
!    Name_Discard_Names                  : constant Name_Id := N + 124;
!    Name_Elaboration_Checks             : constant Name_Id := N + 125; -- GNAT
!    Name_Eliminate                      : constant Name_Id := N + 126; -- GNAT
!    Name_Explicit_Overriding            : constant Name_Id := N + 127; -- Ada 05
!    Name_Extend_System                  : constant Name_Id := N + 128; -- GNAT
!    Name_Extensions_Allowed             : constant Name_Id := N + 129; -- GNAT
!    Name_External_Name_Casing           : constant Name_Id := N + 130; -- GNAT
!    Name_Float_Representation           : constant Name_Id := N + 131; -- GNAT
!    Name_Initialize_Scalars             : constant Name_Id := N + 132; -- GNAT
!    Name_Interrupt_State                : constant Name_Id := N + 133; -- GNAT
!    Name_License                        : constant Name_Id := N + 134; -- GNAT
!    Name_Locking_Policy                 : constant Name_Id := N + 135;
!    Name_Long_Float                     : constant Name_Id := N + 136; -- VMS
!    Name_No_Run_Time                    : constant Name_Id := N + 137; -- GNAT
!    Name_No_Strict_Aliasing             : constant Name_Id := N + 138; -- GNAT
!    Name_Normalize_Scalars              : constant Name_Id := N + 139;
!    Name_Polling                        : constant Name_Id := N + 140; -- GNAT
!    Name_Persistent_BSS                 : constant Name_Id := N + 141; -- GNAT
!    Name_Profile                        : constant Name_Id := N + 142; -- Ada 05
!    Name_Profile_Warnings               : constant Name_Id := N + 143; -- GNAT
!    Name_Propagate_Exceptions           : constant Name_Id := N + 144; -- GNAT
!    Name_Queuing_Policy                 : constant Name_Id := N + 145;
!    Name_Ravenscar                      : constant Name_Id := N + 146; -- Ada 05
!    Name_Restricted_Run_Time            : constant Name_Id := N + 147; -- GNAT
!    Name_Restrictions                   : constant Name_Id := N + 148;
!    Name_Restriction_Warnings           : constant Name_Id := N + 149; -- GNAT
!    Name_Reviewable                     : constant Name_Id := N + 150;
!    Name_Source_File_Name               : constant Name_Id := N + 151; -- GNAT
!    Name_Source_File_Name_Project       : constant Name_Id := N + 152; -- GNAT
!    Name_Style_Checks                   : constant Name_Id := N + 153; -- GNAT
!    Name_Suppress                       : constant Name_Id := N + 154;
!    Name_Suppress_Exception_Locations   : constant Name_Id := N + 155; -- GNAT
!    Name_Task_Dispatching_Policy        : constant Name_Id := N + 156;
!    Name_Universal_Data                 : constant Name_Id := N + 157; -- AAMP
!    Name_Unsuppress                     : constant Name_Id := N + 158; -- GNAT
!    Name_Use_VADS_Size                  : constant Name_Id := N + 159; -- GNAT
!    Name_Validity_Checks                : constant Name_Id := N + 160; -- GNAT
!    Name_Warnings                       : constant Name_Id := N + 161; -- GNAT
!    Last_Configuration_Pragma_Name      : constant Name_Id := N + 161;
! 
!    --  Remaining pragma names
! 
!    Name_Abort_Defer                    : constant Name_Id := N + 162; -- GNAT
!    Name_All_Calls_Remote               : constant Name_Id := N + 163;
!    Name_Annotate                       : constant Name_Id := N + 164; -- GNAT
! 
!    --  Note: AST_Entry is not in this list because its name matches the
!    --  name of the corresponding attribute. However, it is included in the
!    --  definition of the type Attribute_Id, and the functions Get_Pragma_Id
!    --  and Check_Pragma_Id correctly recognize and process Name_AST_Entry.
!    --  AST_Entry is a VMS specific pragma.
! 
!    Name_Assert                         : constant Name_Id := N + 165; -- Ada 05
!    Name_Asynchronous                   : constant Name_Id := N + 166;
!    Name_Atomic                         : constant Name_Id := N + 167;
!    Name_Atomic_Components              : constant Name_Id := N + 168;
!    Name_Attach_Handler                 : constant Name_Id := N + 169;
!    Name_Comment                        : constant Name_Id := N + 170; -- GNAT
!    Name_Common_Object                  : constant Name_Id := N + 171; -- GNAT
!    Name_Complex_Representation         : constant Name_Id := N + 172; -- GNAT
!    Name_Controlled                     : constant Name_Id := N + 173;
!    Name_Convention                     : constant Name_Id := N + 174;
!    Name_CPP_Class                      : constant Name_Id := N + 175; -- GNAT
!    Name_CPP_Constructor                : constant Name_Id := N + 176; -- GNAT
!    Name_CPP_Virtual                    : constant Name_Id := N + 177; -- GNAT
!    Name_CPP_Vtable                     : constant Name_Id := N + 178; -- GNAT
!    Name_Debug                          : constant Name_Id := N + 179; -- GNAT
!    Name_Elaborate                      : constant Name_Id := N + 180; -- Ada 83
!    Name_Elaborate_All                  : constant Name_Id := N + 181;
!    Name_Elaborate_Body                 : constant Name_Id := N + 182;
!    Name_Export                         : constant Name_Id := N + 183;
!    Name_Export_Exception               : constant Name_Id := N + 184; -- VMS
!    Name_Export_Function                : constant Name_Id := N + 185; -- GNAT
!    Name_Export_Object                  : constant Name_Id := N + 186; -- GNAT
!    Name_Export_Procedure               : constant Name_Id := N + 187; -- GNAT
!    Name_Export_Value                   : constant Name_Id := N + 188; -- GNAT
!    Name_Export_Valued_Procedure        : constant Name_Id := N + 189; -- GNAT
!    Name_External                       : constant Name_Id := N + 190; -- GNAT
!    Name_Finalize_Storage_Only          : constant Name_Id := N + 191; -- GNAT
!    Name_Ident                          : constant Name_Id := N + 192; -- VMS
!    Name_Import                         : constant Name_Id := N + 193;
!    Name_Import_Exception               : constant Name_Id := N + 194; -- VMS
!    Name_Import_Function                : constant Name_Id := N + 195; -- GNAT
!    Name_Import_Object                  : constant Name_Id := N + 196; -- GNAT
!    Name_Import_Procedure               : constant Name_Id := N + 197; -- GNAT
!    Name_Import_Valued_Procedure        : constant Name_Id := N + 198; -- GNAT
!    Name_Inline                         : constant Name_Id := N + 199;
!    Name_Inline_Always                  : constant Name_Id := N + 200; -- GNAT
!    Name_Inline_Generic                 : constant Name_Id := N + 201; -- GNAT
!    Name_Inspection_Point               : constant Name_Id := N + 202;
!    Name_Interface_Name                 : constant Name_Id := N + 203; -- GNAT
!    Name_Interrupt_Handler              : constant Name_Id := N + 204;
!    Name_Interrupt_Priority             : constant Name_Id := N + 205;
!    Name_Java_Constructor               : constant Name_Id := N + 206; -- GNAT
!    Name_Java_Interface                 : constant Name_Id := N + 207; -- GNAT
!    Name_Keep_Names                     : constant Name_Id := N + 208; -- GNAT
!    Name_Link_With                      : constant Name_Id := N + 209; -- GNAT
!    Name_Linker_Alias                   : constant Name_Id := N + 210; -- GNAT
!    Name_Linker_Constructor             : constant Name_Id := N + 211; -- GNAT
!    Name_Linker_Destructor              : constant Name_Id := N + 212; -- GNAT
!    Name_Linker_Options                 : constant Name_Id := N + 213;
!    Name_Linker_Section                 : constant Name_Id := N + 214; -- GNAT
!    Name_List                           : constant Name_Id := N + 215;
!    Name_Machine_Attribute              : constant Name_Id := N + 216; -- GNAT
!    Name_Main                           : constant Name_Id := N + 217; -- GNAT
!    Name_Main_Storage                   : constant Name_Id := N + 218; -- GNAT
!    Name_Memory_Size                    : constant Name_Id := N + 219; -- Ada 83
!    Name_No_Return                      : constant Name_Id := N + 220; -- GNAT
!    Name_Obsolescent                    : constant Name_Id := N + 221; -- GNAT
!    Name_Optimize                       : constant Name_Id := N + 222;
!    Name_Optional_Overriding            : constant Name_Id := N + 223; -- Ada 05
!    Name_Pack                           : constant Name_Id := N + 224;
!    Name_Page                           : constant Name_Id := N + 225;
!    Name_Passive                        : constant Name_Id := N + 226; -- GNAT
!    Name_Preelaborate                   : constant Name_Id := N + 227;
!    Name_Preelaborate_05                : constant Name_Id := N + 228; -- GNAT
!    Name_Priority                       : constant Name_Id := N + 229;
!    Name_Psect_Object                   : constant Name_Id := N + 230; -- VMS
!    Name_Pure                           : constant Name_Id := N + 231;
!    Name_Pure_05                        : constant Name_Id := N + 232; -- GNAT
!    Name_Pure_Function                  : constant Name_Id := N + 233; -- GNAT
!    Name_Remote_Call_Interface          : constant Name_Id := N + 234;
!    Name_Remote_Types                   : constant Name_Id := N + 235;
!    Name_Share_Generic                  : constant Name_Id := N + 236; -- GNAT
!    Name_Shared                         : constant Name_Id := N + 237; -- Ada 83
!    Name_Shared_Passive                 : constant Name_Id := N + 238;
! 
!    --  Note: Storage_Size is not in this list because its name matches the
!    --  name of the corresponding attribute. However, it is included in the
!    --  definition of the type Attribute_Id, and the functions Get_Pragma_Id
!    --  and Check_Pragma_Id correctly recognize and process Name_Storage_Size.
! 
!    --  Note: Storage_Unit is also omitted from the list because of a clash
!    --  with an attribute name, and is treated similarly.
! 
!    Name_Source_Reference               : constant Name_Id := N + 239; -- GNAT
!    Name_Stream_Convert                 : constant Name_Id := N + 240; -- GNAT
!    Name_Subtitle                       : constant Name_Id := N + 241; -- GNAT
!    Name_Suppress_All                   : constant Name_Id := N + 242; -- GNAT
!    Name_Suppress_Debug_Info            : constant Name_Id := N + 243; -- GNAT
!    Name_Suppress_Initialization        : constant Name_Id := N + 244; -- GNAT
!    Name_System_Name                    : constant Name_Id := N + 245; -- Ada 83
!    Name_Task_Info                      : constant Name_Id := N + 246; -- GNAT
!    Name_Task_Name                      : constant Name_Id := N + 247; -- GNAT
!    Name_Task_Storage                   : constant Name_Id := N + 248; -- VMS
!    Name_Thread_Body                    : constant Name_Id := N + 249; -- GNAT
!    Name_Time_Slice                     : constant Name_Id := N + 250; -- GNAT
!    Name_Title                          : constant Name_Id := N + 251; -- GNAT
!    Name_Unchecked_Union                : constant Name_Id := N + 252; -- GNAT
!    Name_Unimplemented_Unit             : constant Name_Id := N + 253; -- GNAT
!    Name_Unreferenced                   : constant Name_Id := N + 254; -- GNAT
!    Name_Unreserve_All_Interrupts       : constant Name_Id := N + 255; -- GNAT
!    Name_Volatile                       : constant Name_Id := N + 256;
!    Name_Volatile_Components            : constant Name_Id := N + 257;
!    Name_Weak_External                  : constant Name_Id := N + 258; -- GNAT
!    Last_Pragma_Name                    : constant Name_Id := N + 258;
! 
!    --  Language convention names for pragma Convention/Export/Import/Interface
!    --  Note that Name_C is not included in this list, since it was already
!    --  declared earlier in the context of one-character identifier names
!    --  (where the order is critical to the fast look up process).
! 
!    --  Note: there are no convention names corresponding to the conventions
!    --  Entry and Protected, this is because these conventions cannot be
!    --  specified by a pragma.
! 
!    First_Convention_Name               : constant Name_Id := N + 259;
!    Name_Ada                            : constant Name_Id := N + 259;
!    Name_Assembler                      : constant Name_Id := N + 260;
!    Name_COBOL                          : constant Name_Id := N + 261;
!    Name_CPP                            : constant Name_Id := N + 262;
!    Name_Fortran                        : constant Name_Id := N + 263;
!    Name_Intrinsic                      : constant Name_Id := N + 264;
!    Name_Java                           : constant Name_Id := N + 265;
!    Name_Stdcall                        : constant Name_Id := N + 266;
!    Name_Stubbed                        : constant Name_Id := N + 267;
!    Last_Convention_Name                : constant Name_Id := N + 267;
! 
!    --  The following names are preset as synonyms for Assembler
! 
!    Name_Asm                            : constant Name_Id := N + 268;
!    Name_Assembly                       : constant Name_Id := N + 269;
! 
!    --  The following names are preset as synonyms for C
! 
!    Name_Default                        : constant Name_Id := N + 270;
!    --  Name_Exernal (previously defined as pragma)
! 
!    --  The following names are present as synonyms for Stdcall
! 
!    Name_DLL                            : constant Name_Id := N + 271;
!    Name_Win32                          : constant Name_Id := N + 272;
! 
!    --  Other special names used in processing pragmas
! 
!    Name_As_Is                          : constant Name_Id := N + 273;
!    Name_Attribute_Name                 : constant Name_Id := N + 274;
!    Name_Body_File_Name                 : constant Name_Id := N + 275;
!    Name_Boolean_Entry_Barriers         : constant Name_Id := N + 276;
!    Name_Check                          : constant Name_Id := N + 277;
!    Name_Casing                         : constant Name_Id := N + 278;
!    Name_Code                           : constant Name_Id := N + 279;
!    Name_Component                      : constant Name_Id := N + 280;
!    Name_Component_Size_4               : constant Name_Id := N + 281;
!    Name_Copy                           : constant Name_Id := N + 282;
!    Name_D_Float                        : constant Name_Id := N + 283;
!    Name_Descriptor                     : constant Name_Id := N + 284;
!    Name_Dot_Replacement                : constant Name_Id := N + 285;
!    Name_Dynamic                        : constant Name_Id := N + 286;
!    Name_Entity                         : constant Name_Id := N + 287;
!    Name_Entry_Count                    : constant Name_Id := N + 288;
!    Name_External_Name                  : constant Name_Id := N + 289;
!    Name_First_Optional_Parameter       : constant Name_Id := N + 290;
!    Name_Form                           : constant Name_Id := N + 291;
!    Name_G_Float                        : constant Name_Id := N + 292;
!    Name_Gcc                            : constant Name_Id := N + 293;
!    Name_Gnat                           : constant Name_Id := N + 294;
!    Name_GPL                            : constant Name_Id := N + 295;
!    Name_IEEE_Float                     : constant Name_Id := N + 296;
!    Name_Ignore                         : constant Name_Id := N + 297;
!    Name_Info                           : constant Name_Id := N + 298;
!    Name_Internal                       : constant Name_Id := N + 299;
!    Name_Link_Name                      : constant Name_Id := N + 300;
!    Name_Lowercase                      : constant Name_Id := N + 301;
!    Name_Max_Entry_Queue_Depth          : constant Name_Id := N + 302;
!    Name_Max_Entry_Queue_Length         : constant Name_Id := N + 303;
!    Name_Max_Size                       : constant Name_Id := N + 304;
!    Name_Mechanism                      : constant Name_Id := N + 305;
!    Name_Message                        : constant Name_Id := N + 306;
!    Name_Mixedcase                      : constant Name_Id := N + 307;
!    Name_Modified_GPL                   : constant Name_Id := N + 308;
!    Name_Name                           : constant Name_Id := N + 309;
!    Name_NCA                            : constant Name_Id := N + 310;
!    Name_No                             : constant Name_Id := N + 311;
!    Name_No_Dependence                  : constant Name_Id := N + 312;
!    Name_No_Dynamic_Attachment          : constant Name_Id := N + 313;
!    Name_No_Dynamic_Interrupts          : constant Name_Id := N + 314;
!    Name_No_Requeue                     : constant Name_Id := N + 315;
!    Name_No_Requeue_Statements          : constant Name_Id := N + 316;
!    Name_No_Task_Attributes             : constant Name_Id := N + 317;
!    Name_No_Task_Attributes_Package     : constant Name_Id := N + 318;
!    Name_On                             : constant Name_Id := N + 319;
!    Name_Parameter_Types                : constant Name_Id := N + 320;
!    Name_Reference                      : constant Name_Id := N + 321;
!    Name_Restricted                     : constant Name_Id := N + 322;
!    Name_Result_Mechanism               : constant Name_Id := N + 323;
!    Name_Result_Type                    : constant Name_Id := N + 324;
!    Name_Runtime                        : constant Name_Id := N + 325;
!    Name_SB                             : constant Name_Id := N + 326;
!    Name_Secondary_Stack_Size           : constant Name_Id := N + 327;
!    Name_Section                        : constant Name_Id := N + 328;
!    Name_Semaphore                      : constant Name_Id := N + 329;
!    Name_Simple_Barriers                : constant Name_Id := N + 330;
!    Name_Spec_File_Name                 : constant Name_Id := N + 331;
!    Name_State                          : constant Name_Id := N + 332;
!    Name_Static                         : constant Name_Id := N + 333;
!    Name_Stack_Size                     : constant Name_Id := N + 334;
!    Name_Subunit_File_Name              : constant Name_Id := N + 335;
!    Name_Task_Stack_Size_Default        : constant Name_Id := N + 336;
!    Name_Task_Type                      : constant Name_Id := N + 337;
!    Name_Time_Slicing_Enabled           : constant Name_Id := N + 338;
!    Name_Top_Guard                      : constant Name_Id := N + 339;
!    Name_UBA                            : constant Name_Id := N + 340;
!    Name_UBS                            : constant Name_Id := N + 341;
!    Name_UBSB                           : constant Name_Id := N + 342;
!    Name_Unit_Name                      : constant Name_Id := N + 343;
!    Name_Unknown                        : constant Name_Id := N + 344;
!    Name_Unrestricted                   : constant Name_Id := N + 345;
!    Name_Uppercase                      : constant Name_Id := N + 346;
!    Name_User                           : constant Name_Id := N + 347;
!    Name_VAX_Float                      : constant Name_Id := N + 348;
!    Name_VMS                            : constant Name_Id := N + 349;
!    Name_Vtable_Ptr                     : constant Name_Id := N + 350;
!    Name_Working_Storage                : constant Name_Id := N + 351;
! 
!    --  Names of recognized attributes. The entries with the comment "Ada 83"
!    --  are attributes that are defined in Ada 83, but not in Ada 95. These
!    --  attributes are implemented in both Ada 83 and Ada 95 modes in GNAT.
! 
!    --  The entries marked GNAT are attributes that are defined by GNAT
!    --  and implemented in both Ada 83 and Ada 95 modes. Full descriptions
!    --  of these implementation dependent attributes may be found in the
!    --  appropriate section in package Sem_Attr in file sem-attr.ads.
! 
!    --  The entries marked VMS are recognized only in OpenVMS implementations
!    --  of GNAT, and are treated as illegal in all other contexts.
! 
!    First_Attribute_Name                : constant Name_Id := N + 352;
!    Name_Abort_Signal                   : constant Name_Id := N + 352; -- GNAT
!    Name_Access                         : constant Name_Id := N + 353;
!    Name_Address                        : constant Name_Id := N + 354;
!    Name_Address_Size                   : constant Name_Id := N + 355; -- GNAT
!    Name_Aft                            : constant Name_Id := N + 356;
!    Name_Alignment                      : constant Name_Id := N + 357;
!    Name_Asm_Input                      : constant Name_Id := N + 358; -- GNAT
!    Name_Asm_Output                     : constant Name_Id := N + 359; -- GNAT
!    Name_AST_Entry                      : constant Name_Id := N + 360; -- VMS
!    Name_Bit                            : constant Name_Id := N + 361; -- GNAT
!    Name_Bit_Order                      : constant Name_Id := N + 362;
!    Name_Bit_Position                   : constant Name_Id := N + 363; -- GNAT
!    Name_Body_Version                   : constant Name_Id := N + 364;
!    Name_Callable                       : constant Name_Id := N + 365;
!    Name_Caller                         : constant Name_Id := N + 366;
!    Name_Code_Address                   : constant Name_Id := N + 367; -- GNAT
!    Name_Component_Size                 : constant Name_Id := N + 368;
!    Name_Compose                        : constant Name_Id := N + 369;
!    Name_Constrained                    : constant Name_Id := N + 370;
!    Name_Count                          : constant Name_Id := N + 371;
!    Name_Default_Bit_Order              : constant Name_Id := N + 372; -- GNAT
!    Name_Definite                       : constant Name_Id := N + 373;
!    Name_Delta                          : constant Name_Id := N + 374;
!    Name_Denorm                         : constant Name_Id := N + 375;
!    Name_Digits                         : constant Name_Id := N + 376;
!    Name_Elaborated                     : constant Name_Id := N + 377; -- GNAT
!    Name_Emax                           : constant Name_Id := N + 378; -- Ada 83
!    Name_Enum_Rep                       : constant Name_Id := N + 379; -- GNAT
!    Name_Epsilon                        : constant Name_Id := N + 380; -- Ada 83
!    Name_Exponent                       : constant Name_Id := N + 381;
!    Name_External_Tag                   : constant Name_Id := N + 382;
!    Name_First                          : constant Name_Id := N + 383;
!    Name_First_Bit                      : constant Name_Id := N + 384;
!    Name_Fixed_Value                    : constant Name_Id := N + 385; -- GNAT
!    Name_Fore                           : constant Name_Id := N + 386;
!    Name_Has_Access_Values              : constant Name_Id := N + 387; -- GNAT
!    Name_Has_Discriminants              : constant Name_Id := N + 388; -- GNAT
!    Name_Identity                       : constant Name_Id := N + 389;
!    Name_Img                            : constant Name_Id := N + 390; -- GNAT
!    Name_Integer_Value                  : constant Name_Id := N + 391; -- GNAT
!    Name_Large                          : constant Name_Id := N + 392; -- Ada 83
!    Name_Last                           : constant Name_Id := N + 393;
!    Name_Last_Bit                       : constant Name_Id := N + 394;
!    Name_Leading_Part                   : constant Name_Id := N + 395;
!    Name_Length                         : constant Name_Id := N + 396;
!    Name_Machine_Emax                   : constant Name_Id := N + 397;
!    Name_Machine_Emin                   : constant Name_Id := N + 398;
!    Name_Machine_Mantissa               : constant Name_Id := N + 399;
!    Name_Machine_Overflows              : constant Name_Id := N + 400;
!    Name_Machine_Radix                  : constant Name_Id := N + 401;
!    Name_Machine_Rounding               : constant Name_Id := N + 402; -- Ada 05
!    Name_Machine_Rounds                 : constant Name_Id := N + 403;
!    Name_Machine_Size                   : constant Name_Id := N + 404; -- GNAT
!    Name_Mantissa                       : constant Name_Id := N + 405; -- Ada 83
!    Name_Max_Size_In_Storage_Elements   : constant Name_Id := N + 406;
!    Name_Maximum_Alignment              : constant Name_Id := N + 407; -- GNAT
!    Name_Mechanism_Code                 : constant Name_Id := N + 408; -- GNAT
!    Name_Mod                            : constant Name_Id := N + 409;
!    Name_Model_Emin                     : constant Name_Id := N + 410;
!    Name_Model_Epsilon                  : constant Name_Id := N + 411;
!    Name_Model_Mantissa                 : constant Name_Id := N + 412;
!    Name_Model_Small                    : constant Name_Id := N + 413;
!    Name_Modulus                        : constant Name_Id := N + 414;
!    Name_Null_Parameter                 : constant Name_Id := N + 415; -- GNAT
!    Name_Object_Size                    : constant Name_Id := N + 416; -- GNAT
!    Name_Partition_ID                   : constant Name_Id := N + 417;
!    Name_Passed_By_Reference            : constant Name_Id := N + 418; -- GNAT
!    Name_Pool_Address                   : constant Name_Id := N + 419;
!    Name_Pos                            : constant Name_Id := N + 420;
!    Name_Position                       : constant Name_Id := N + 421;
!    Name_Range                          : constant Name_Id := N + 422;
!    Name_Range_Length                   : constant Name_Id := N + 423; -- GNAT
!    Name_Round                          : constant Name_Id := N + 424;
!    Name_Safe_Emax                      : constant Name_Id := N + 425; -- Ada 83
!    Name_Safe_First                     : constant Name_Id := N + 426;
!    Name_Safe_Large                     : constant Name_Id := N + 427; -- Ada 83
!    Name_Safe_Last                      : constant Name_Id := N + 428;
!    Name_Safe_Small                     : constant Name_Id := N + 429; -- Ada 83
!    Name_Scale                          : constant Name_Id := N + 430;
!    Name_Scaling                        : constant Name_Id := N + 431;
!    Name_Signed_Zeros                   : constant Name_Id := N + 432;
!    Name_Size                           : constant Name_Id := N + 433;
!    Name_Small                          : constant Name_Id := N + 434;
!    Name_Storage_Size                   : constant Name_Id := N + 435;
!    Name_Storage_Unit                   : constant Name_Id := N + 436; -- GNAT
!    Name_Stream_Size                    : constant Name_Id := N + 437; -- Ada 05
!    Name_Tag                            : constant Name_Id := N + 438;
!    Name_Target_Name                    : constant Name_Id := N + 439; -- GNAT
!    Name_Terminated                     : constant Name_Id := N + 440;
!    Name_To_Address                     : constant Name_Id := N + 441; -- GNAT
!    Name_Type_Class                     : constant Name_Id := N + 442; -- GNAT
!    Name_UET_Address                    : constant Name_Id := N + 443; -- GNAT
!    Name_Unbiased_Rounding              : constant Name_Id := N + 444;
!    Name_Unchecked_Access               : constant Name_Id := N + 445;
!    Name_Unconstrained_Array            : constant Name_Id := N + 446;
!    Name_Universal_Literal_String       : constant Name_Id := N + 447; -- GNAT
!    Name_Unrestricted_Access            : constant Name_Id := N + 448; -- GNAT
!    Name_VADS_Size                      : constant Name_Id := N + 449; -- GNAT
!    Name_Val                            : constant Name_Id := N + 450;
!    Name_Valid                          : constant Name_Id := N + 451;
!    Name_Value_Size                     : constant Name_Id := N + 452; -- GNAT
!    Name_Version                        : constant Name_Id := N + 453;
!    Name_Wchar_T_Size                   : constant Name_Id := N + 454; -- GNAT
!    Name_Wide_Wide_Width                : constant Name_Id := N + 455; -- Ada 05
!    Name_Wide_Width                     : constant Name_Id := N + 456;
!    Name_Width                          : constant Name_Id := N + 457;
!    Name_Word_Size                      : constant Name_Id := N + 458; -- GNAT
! 
!    --  Attributes that designate attributes returning renamable functions,
!    --  i.e. functions that return other than a universal value and that
!    --  have non-universal arguments.
! 
!    First_Renamable_Function_Attribute  : constant Name_Id := N + 459;
!    Name_Adjacent                       : constant Name_Id := N + 459;
!    Name_Ceiling                        : constant Name_Id := N + 460;
!    Name_Copy_Sign                      : constant Name_Id := N + 461;
!    Name_Floor                          : constant Name_Id := N + 462;
!    Name_Fraction                       : constant Name_Id := N + 463;
!    Name_Image                          : constant Name_Id := N + 464;
!    Name_Input                          : constant Name_Id := N + 465;
!    Name_Machine                        : constant Name_Id := N + 466;
!    Name_Max                            : constant Name_Id := N + 467;
!    Name_Min                            : constant Name_Id := N + 468;
!    Name_Model                          : constant Name_Id := N + 469;
!    Name_Pred                           : constant Name_Id := N + 470;
!    Name_Remainder                      : constant Name_Id := N + 471;
!    Name_Rounding                       : constant Name_Id := N + 472;
!    Name_Succ                           : constant Name_Id := N + 473;
!    Name_Truncation                     : constant Name_Id := N + 474;
!    Name_Value                          : constant Name_Id := N + 475;
!    Name_Wide_Image                     : constant Name_Id := N + 476;
!    Name_Wide_Wide_Image                : constant Name_Id := N + 477;
!    Name_Wide_Value                     : constant Name_Id := N + 478;
!    Name_Wide_Wide_Value                : constant Name_Id := N + 479;
!    Last_Renamable_Function_Attribute   : constant Name_Id := N + 479;
! 
!    --  Attributes that designate procedures
! 
!    First_Procedure_Attribute           : constant Name_Id := N + 480;
!    Name_Output                         : constant Name_Id := N + 480;
!    Name_Read                           : constant Name_Id := N + 481;
!    Name_Write                          : constant Name_Id := N + 482;
!    Last_Procedure_Attribute            : constant Name_Id := N + 482;
! 
!    --  Remaining attributes are ones that return entities
! 
!    First_Entity_Attribute_Name         : constant Name_Id := N + 483;
!    Name_Elab_Body                      : constant Name_Id := N + 483; -- GNAT
!    Name_Elab_Spec                      : constant Name_Id := N + 484; -- GNAT
!    Name_Storage_Pool                   : constant Name_Id := N + 485;
! 
!    --  These attributes are the ones that return types
! 
!    First_Type_Attribute_Name           : constant Name_Id := N + 486;
!    Name_Base                           : constant Name_Id := N + 486;
!    Name_Class                          : constant Name_Id := N + 487;
!    Last_Type_Attribute_Name            : constant Name_Id := N + 487;
!    Last_Entity_Attribute_Name          : constant Name_Id := N + 487;
!    Last_Attribute_Name                 : constant Name_Id := N + 487;
! 
!    --  Names of recognized locking policy identifiers
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. C for Ceiling_Locking). If new policy names are added,
!    --  the first character must be distinct.
! 
!    First_Locking_Policy_Name           : constant Name_Id := N + 488;
!    Name_Ceiling_Locking                : constant Name_Id := N + 488;
!    Name_Inheritance_Locking            : constant Name_Id := N + 489;
!    Last_Locking_Policy_Name            : constant Name_Id := N + 489;
! 
!    --  Names of recognized queuing policy identifiers
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. F for FIFO_Queuing). If new policy names are added,
!    --  the first character must be distinct.
! 
!    First_Queuing_Policy_Name           : constant Name_Id := N + 490;
!    Name_FIFO_Queuing                   : constant Name_Id := N + 490;
!    Name_Priority_Queuing               : constant Name_Id := N + 491;
!    Last_Queuing_Policy_Name            : constant Name_Id := N + 491;
! 
!    --  Names of recognized task dispatching policy identifiers
! 
!    --  Note: policies are identified by the first character of the
!    --  name (e.g. F for FIFO_WIthinn_Priorities). If new policy names
!    --  are added, the first character must be distinct.
! 
!    First_Task_Dispatching_Policy_Name  : constant Name_Id := N + 492;
!    Name_FIFO_Within_Priorities         : constant Name_Id := N + 492;
!    Last_Task_Dispatching_Policy_Name   : constant Name_Id := N + 492;
! 
!    --  Names of recognized checks for pragma Suppress
! 
!    First_Check_Name                    : constant Name_Id := N + 493;
!    Name_Access_Check                   : constant Name_Id := N + 493;
!    Name_Accessibility_Check            : constant Name_Id := N + 494;
!    Name_Discriminant_Check             : constant Name_Id := N + 495;
!    Name_Division_Check                 : constant Name_Id := N + 496;
!    Name_Elaboration_Check              : constant Name_Id := N + 497;
!    Name_Index_Check                    : constant Name_Id := N + 498;
!    Name_Length_Check                   : constant Name_Id := N + 499;
!    Name_Overflow_Check                 : constant Name_Id := N + 500;
!    Name_Range_Check                    : constant Name_Id := N + 501;
!    Name_Storage_Check                  : constant Name_Id := N + 502;
!    Name_Tag_Check                      : constant Name_Id := N + 503;
!    Name_All_Checks                     : constant Name_Id := N + 504;
!    Last_Check_Name                     : constant Name_Id := N + 504;
! 
!    --  Names corresponding to reserved keywords, excluding those already
!    --  declared in the attribute list (Access, Delta, Digits, Mod, Range).
! 
!    Name_Abort                          : constant Name_Id := N + 505;
!    Name_Abs                            : constant Name_Id := N + 506;
!    Name_Accept                         : constant Name_Id := N + 507;
!    Name_And                            : constant Name_Id := N + 508;
!    Name_All                            : constant Name_Id := N + 509;
!    Name_Array                          : constant Name_Id := N + 510;
!    Name_At                             : constant Name_Id := N + 511;
!    Name_Begin                          : constant Name_Id := N + 512;
!    Name_Body                           : constant Name_Id := N + 513;
!    Name_Case                           : constant Name_Id := N + 514;
!    Name_Constant                       : constant Name_Id := N + 515;
!    Name_Declare                        : constant Name_Id := N + 516;
!    Name_Delay                          : constant Name_Id := N + 517;
!    Name_Do                             : constant Name_Id := N + 518;
!    Name_Else                           : constant Name_Id := N + 519;
!    Name_Elsif                          : constant Name_Id := N + 520;
!    Name_End                            : constant Name_Id := N + 521;
!    Name_Entry                          : constant Name_Id := N + 522;
!    Name_Exception                      : constant Name_Id := N + 523;
!    Name_Exit                           : constant Name_Id := N + 524;
!    Name_For                            : constant Name_Id := N + 525;
!    Name_Function                       : constant Name_Id := N + 526;
!    Name_Generic                        : constant Name_Id := N + 527;
!    Name_Goto                           : constant Name_Id := N + 528;
!    Name_If                             : constant Name_Id := N + 529;
!    Name_In                             : constant Name_Id := N + 530;
!    Name_Is                             : constant Name_Id := N + 531;
!    Name_Limited                        : constant Name_Id := N + 532;
!    Name_Loop                           : constant Name_Id := N + 533;
!    Name_New                            : constant Name_Id := N + 534;
!    Name_Not                            : constant Name_Id := N + 535;
!    Name_Null                           : constant Name_Id := N + 536;
!    Name_Of                             : constant Name_Id := N + 537;
!    Name_Or                             : constant Name_Id := N + 538;
!    Name_Others                         : constant Name_Id := N + 539;
!    Name_Out                            : constant Name_Id := N + 540;
!    Name_Package                        : constant Name_Id := N + 541;
!    Name_Pragma                         : constant Name_Id := N + 542;
!    Name_Private                        : constant Name_Id := N + 543;
!    Name_Procedure                      : constant Name_Id := N + 544;
!    Name_Raise                          : constant Name_Id := N + 545;
!    Name_Record                         : constant Name_Id := N + 546;
!    Name_Rem                            : constant Name_Id := N + 547;
!    Name_Renames                        : constant Name_Id := N + 548;
!    Name_Return                         : constant Name_Id := N + 549;
!    Name_Reverse                        : constant Name_Id := N + 550;
!    Name_Select                         : constant Name_Id := N + 551;
!    Name_Separate                       : constant Name_Id := N + 552;
!    Name_Subtype                        : constant Name_Id := N + 553;
!    Name_Task                           : constant Name_Id := N + 554;
!    Name_Terminate                      : constant Name_Id := N + 555;
!    Name_Then                           : constant Name_Id := N + 556;
!    Name_Type                           : constant Name_Id := N + 557;
!    Name_Use                            : constant Name_Id := N + 558;
!    Name_When                           : constant Name_Id := N + 559;
!    Name_While                          : constant Name_Id := N + 560;
!    Name_With                           : constant Name_Id := N + 561;
!    Name_Xor                            : constant Name_Id := N + 562;
! 
!    --  Names of intrinsic subprograms
! 
!    --  Note: Asm is missing from this list, since Asm is a legitimate
!    --  convention name. So is To_Adress, which is a GNAT attribute.
! 
!    First_Intrinsic_Name                 : constant Name_Id := N + 563;
!    Name_Divide                          : constant Name_Id := N + 563;
!    Name_Enclosing_Entity                : constant Name_Id := N + 564;
!    Name_Exception_Information           : constant Name_Id := N + 565;
!    Name_Exception_Message               : constant Name_Id := N + 566;
!    Name_Exception_Name                  : constant Name_Id := N + 567;
!    Name_File                            : constant Name_Id := N + 568;
!    Name_Generic_Dispatching_Constructor : constant Name_Id := N + 569;
!    Name_Import_Address                  : constant Name_Id := N + 570;
!    Name_Import_Largest_Value            : constant Name_Id := N + 571;
!    Name_Import_Value                    : constant Name_Id := N + 572;
!    Name_Is_Negative                     : constant Name_Id := N + 573;
!    Name_Line                            : constant Name_Id := N + 574;
!    Name_Rotate_Left                     : constant Name_Id := N + 575;
!    Name_Rotate_Right                    : constant Name_Id := N + 576;
!    Name_Shift_Left                      : constant Name_Id := N + 577;
!    Name_Shift_Right                     : constant Name_Id := N + 578;
!    Name_Shift_Right_Arithmetic          : constant Name_Id := N + 579;
!    Name_Source_Location                 : constant Name_Id := N + 580;
!    Name_Unchecked_Conversion            : constant Name_Id := N + 581;
!    Name_Unchecked_Deallocation          : constant Name_Id := N + 582;
!    Name_To_Pointer                      : constant Name_Id := N + 583;
!    Last_Intrinsic_Name                  : constant Name_Id := N + 583;
! 
!    --  Names used in processing intrinsic calls
! 
!    Name_Free                           : constant Name_Id := N + 584;
! 
!    --  Reserved words used only in Ada 95
! 
!    First_95_Reserved_Word              : constant Name_Id := N + 585;
!    Name_Abstract                       : constant Name_Id := N + 585;
!    Name_Aliased                        : constant Name_Id := N + 586;
!    Name_Protected                      : constant Name_Id := N + 587;
!    Name_Until                          : constant Name_Id := N + 588;
!    Name_Requeue                        : constant Name_Id := N + 589;
!    Name_Tagged                         : constant Name_Id := N + 590;
!    Last_95_Reserved_Word               : constant Name_Id := N + 590;
! 
!    subtype Ada_95_Reserved_Words is
!      Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
! 
!    --  Miscellaneous names used in semantic checking
! 
!    Name_Raise_Exception                : constant Name_Id := N + 591;
! 
!    --  Additional reserved words and identifiers used in GNAT Project Files
!    --  Note that Name_External is already previously declared
! 
!    Name_Ada_Roots                      : constant Name_Id := N + 592;
!    Name_Binder                         : constant Name_Id := N + 593;
!    Name_Binder_Driver                  : constant Name_Id := N + 594;
!    Name_Body_Suffix                    : constant Name_Id := N + 595;
!    Name_Builder                        : constant Name_Id := N + 596;
!    Name_Compiler                       : constant Name_Id := N + 597;
!    Name_Compiler_Driver                : constant Name_Id := N + 598;
!    Name_Compiler_Kind                  : constant Name_Id := N + 599;
!    Name_Compute_Dependency             : constant Name_Id := N + 600;
!    Name_Cross_Reference                : constant Name_Id := N + 601;
!    Name_Default_Linker                 : constant Name_Id := N + 602;
!    Name_Default_Switches               : constant Name_Id := N + 603;
!    Name_Dependency_Option              : constant Name_Id := N + 604;
!    Name_Exec_Dir                       : constant Name_Id := N + 605;
!    Name_Executable                     : constant Name_Id := N + 606;
!    Name_Executable_Suffix              : constant Name_Id := N + 607;
!    Name_Extends                        : constant Name_Id := N + 608;
!    Name_Externally_Built               : constant Name_Id := N + 609;
!    Name_Finder                         : constant Name_Id := N + 610;
!    Name_Global_Configuration_Pragmas   : constant Name_Id := N + 611;
!    Name_Gnatls                         : constant Name_Id := N + 612;
!    Name_Gnatstub                       : constant Name_Id := N + 613;
!    Name_Implementation                 : constant Name_Id := N + 614;
!    Name_Implementation_Exceptions      : constant Name_Id := N + 615;
!    Name_Implementation_Suffix          : constant Name_Id := N + 616;
!    Name_Include_Option                 : constant Name_Id := N + 617;
!    Name_Language_Processing            : constant Name_Id := N + 618;
!    Name_Languages                      : constant Name_Id := N + 619;
!    Name_Library_Ali_Dir                : constant Name_Id := N + 620;
!    Name_Library_Dir                    : constant Name_Id := N + 621;
!    Name_Library_Auto_Init              : constant Name_Id := N + 622;
!    Name_Library_GCC                    : constant Name_Id := N + 623;
!    Name_Library_Interface              : constant Name_Id := N + 624;
!    Name_Library_Kind                   : constant Name_Id := N + 625;
!    Name_Library_Name                   : constant Name_Id := N + 626;
!    Name_Library_Options                : constant Name_Id := N + 627;
!    Name_Library_Reference_Symbol_File  : constant Name_Id := N + 628;
!    Name_Library_Src_Dir                : constant Name_Id := N + 629;
!    Name_Library_Symbol_File            : constant Name_Id := N + 630;
!    Name_Library_Symbol_Policy          : constant Name_Id := N + 631;
!    Name_Library_Version                : constant Name_Id := N + 632;
!    Name_Linker                         : constant Name_Id := N + 633;
!    Name_Local_Configuration_Pragmas    : constant Name_Id := N + 634;
!    Name_Locally_Removed_Files          : constant Name_Id := N + 635;
!    Name_Metrics                        : constant Name_Id := N + 636;
!    Name_Naming                         : constant Name_Id := N + 637;
!    Name_Object_Dir                     : constant Name_Id := N + 638;
!    Name_Pretty_Printer                 : constant Name_Id := N + 639;
!    Name_Project                        : constant Name_Id := N + 640;
!    Name_Separate_Suffix                : constant Name_Id := N + 641;
!    Name_Source_Dirs                    : constant Name_Id := N + 642;
!    Name_Source_Files                   : constant Name_Id := N + 643;
!    Name_Source_List_File               : constant Name_Id := N + 644;
!    Name_Spec                           : constant Name_Id := N + 645;
!    Name_Spec_Suffix                    : constant Name_Id := N + 646;
!    Name_Specification                  : constant Name_Id := N + 647;
!    Name_Specification_Exceptions       : constant Name_Id := N + 648;
!    Name_Specification_Suffix           : constant Name_Id := N + 649;
!    Name_Switches                       : constant Name_Id := N + 650;
! 
!    --  Other miscellaneous names used in front end
! 
!    Name_Unaligned_Valid                : constant Name_Id := N + 651;
! 
!    --  ----------------------------------------------------------------
!    First_2005_Reserved_Word            : constant Name_Id := N + 652;
!    Name_Interface                      : constant Name_Id := N + 652;
!    Name_Overriding                     : constant Name_Id := N + 653;
!    Name_Synchronized                   : constant Name_Id := N + 654;
!    Last_2005_Reserved_Word             : constant Name_Id := N + 654;
! 
!    subtype Ada_2005_Reserved_Words is
!      Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
! 
!    --  Mark last defined name for consistency check in Snames body
! 
!    Last_Predefined_Name                : constant Name_Id := N + 654;
! 
!    subtype Any_Operator_Name is Name_Id range
!      First_Operator_Name .. Last_Operator_Name;
! 
!    ------------------------------
!    -- Attribute ID Definitions --
!    ------------------------------
! 
!    type Attribute_Id is (
!       Attribute_Abort_Signal,
!       Attribute_Access,
!       Attribute_Address,
!       Attribute_Address_Size,
!       Attribute_Aft,
!       Attribute_Alignment,
!       Attribute_Asm_Input,
!       Attribute_Asm_Output,
!       Attribute_AST_Entry,
!       Attribute_Bit,
!       Attribute_Bit_Order,
!       Attribute_Bit_Position,
!       Attribute_Body_Version,
!       Attribute_Callable,
!       Attribute_Caller,
!       Attribute_Code_Address,
!       Attribute_Component_Size,
!       Attribute_Compose,
!       Attribute_Constrained,
!       Attribute_Count,
!       Attribute_Default_Bit_Order,
!       Attribute_Definite,
!       Attribute_Delta,
!       Attribute_Denorm,
!       Attribute_Digits,
!       Attribute_Elaborated,
!       Attribute_Emax,
!       Attribute_Enum_Rep,
!       Attribute_Epsilon,
!       Attribute_Exponent,
!       Attribute_External_Tag,
!       Attribute_First,
!       Attribute_First_Bit,
!       Attribute_Fixed_Value,
!       Attribute_Fore,
!       Attribute_Has_Access_Values,
!       Attribute_Has_Discriminants,
!       Attribute_Identity,
!       Attribute_Img,
!       Attribute_Integer_Value,
!       Attribute_Large,
!       Attribute_Last,
!       Attribute_Last_Bit,
!       Attribute_Leading_Part,
!       Attribute_Length,
!       Attribute_Machine_Emax,
!       Attribute_Machine_Emin,
!       Attribute_Machine_Mantissa,
!       Attribute_Machine_Overflows,
!       Attribute_Machine_Radix,
!       Attribute_Machine_Rounding,
!       Attribute_Machine_Rounds,
!       Attribute_Machine_Size,
!       Attribute_Mantissa,
!       Attribute_Max_Size_In_Storage_Elements,
!       Attribute_Maximum_Alignment,
!       Attribute_Mechanism_Code,
!       Attribute_Mod,
!       Attribute_Model_Emin,
!       Attribute_Model_Epsilon,
!       Attribute_Model_Mantissa,
!       Attribute_Model_Small,
!       Attribute_Modulus,
!       Attribute_Null_Parameter,
!       Attribute_Object_Size,
!       Attribute_Partition_ID,
!       Attribute_Passed_By_Reference,
!       Attribute_Pool_Address,
!       Attribute_Pos,
!       Attribute_Position,
!       Attribute_Range,
!       Attribute_Range_Length,
!       Attribute_Round,
!       Attribute_Safe_Emax,
!       Attribute_Safe_First,
!       Attribute_Safe_Large,
!       Attribute_Safe_Last,
!       Attribute_Safe_Small,
!       Attribute_Scale,
!       Attribute_Scaling,
!       Attribute_Signed_Zeros,
!       Attribute_Size,
!       Attribute_Small,
!       Attribute_Storage_Size,
!       Attribute_Storage_Unit,
!       Attribute_Stream_Size,
!       Attribute_Tag,
!       Attribute_Target_Name,
!       Attribute_Terminated,
!       Attribute_To_Address,
!       Attribute_Type_Class,
!       Attribute_UET_Address,
!       Attribute_Unbiased_Rounding,
!       Attribute_Unchecked_Access,
!       Attribute_Unconstrained_Array,
!       Attribute_Universal_Literal_String,
!       Attribute_Unrestricted_Access,
!       Attribute_VADS_Size,
!       Attribute_Val,
!       Attribute_Valid,
!       Attribute_Value_Size,
!       Attribute_Version,
!       Attribute_Wchar_T_Size,
!       Attribute_Wide_Wide_Width,
!       Attribute_Wide_Width,
!       Attribute_Width,
!       Attribute_Word_Size,
! 
!       --  Attributes designating renamable functions
! 
!       Attribute_Adjacent,
!       Attribute_Ceiling,
!       Attribute_Copy_Sign,
!       Attribute_Floor,
!       Attribute_Fraction,
!       Attribute_Image,
!       Attribute_Input,
!       Attribute_Machine,
!       Attribute_Max,
!       Attribute_Min,
!       Attribute_Model,
!       Attribute_Pred,
!       Attribute_Remainder,
!       Attribute_Rounding,
!       Attribute_Succ,
!       Attribute_Truncation,
!       Attribute_Value,
!       Attribute_Wide_Image,
!       Attribute_Wide_Wide_Image,
!       Attribute_Wide_Value,
!       Attribute_Wide_Wide_Value,
! 
!       --  Attributes designating procedures
! 
!       Attribute_Output,
!       Attribute_Read,
!       Attribute_Write,
! 
!       --  Entity attributes (includes type attributes)
! 
!       Attribute_Elab_Body,
!       Attribute_Elab_Spec,
!       Attribute_Storage_Pool,
! 
!       --  Type attributes
! 
!       Attribute_Base,
!       Attribute_Class);
! 
!    ------------------------------------
!    -- Convention Name ID Definitions --
!    ------------------------------------
! 
!    type Convention_Id is (
! 
!       --  The conventions that are defined by the RM come first
! 
!       Convention_Ada,
!       Convention_Intrinsic,
!       Convention_Entry,
!       Convention_Protected,
! 
!       --  The remaining conventions are foreign language conventions
! 
!       Convention_Assembler,  --  also Asm, Assembly
!       Convention_C,          --  also Default, External
!       Convention_COBOL,
!       Convention_CPP,
!       Convention_Fortran,
!       Convention_Java,
!       Convention_Stdcall,    --  also DLL, Win32
!       Convention_Stubbed);
! 
!       --  Note: Convention C_Pass_By_Copy is allowed only for record
!       --  types (where it is treated like C except that the appropriate
!       --  flag is set in the record type). Recognizion of this convention
!       --  is specially handled in Sem_Prag.
! 
!    for Convention_Id'Size use 8;
!    --  Plenty of space for expansion
! 
!    subtype Foreign_Convention is
!      Convention_Id range Convention_Assembler .. Convention_Stdcall;
! 
!    -----------------------------------
!    -- Locking Policy ID Definitions --
!    -----------------------------------
! 
!    type Locking_Policy_Id is (
!       Locking_Policy_Inheritance_Locking,
!       Locking_Policy_Ceiling_Locking);
! 
!    ---------------------------
!    -- Pragma ID Definitions --
!    ---------------------------
! 
!    type Pragma_Id is (
! 
!       --  Configuration pragmas
! 
!       Pragma_Ada_83,
!       Pragma_Ada_95,
!       Pragma_Ada_05,
!       Pragma_Assertion_Policy,
!       Pragma_C_Pass_By_Copy,
!       Pragma_Compile_Time_Warning,
!       Pragma_Component_Alignment,
!       Pragma_Convention_Identifier,
!       Pragma_Debug_Policy,
!       Pragma_Detect_Blocking,
!       Pragma_Discard_Names,
!       Pragma_Elaboration_Checks,
!       Pragma_Eliminate,
!       Pragma_Explicit_Overriding,
!       Pragma_Extend_System,
!       Pragma_Extensions_Allowed,
!       Pragma_External_Name_Casing,
!       Pragma_Float_Representation,
!       Pragma_Initialize_Scalars,
!       Pragma_Interrupt_State,
!       Pragma_License,
!       Pragma_Locking_Policy,
!       Pragma_Long_Float,
!       Pragma_No_Run_Time,
!       Pragma_No_Strict_Aliasing,
!       Pragma_Normalize_Scalars,
!       Pragma_Polling,
!       Pragma_Persistent_BSS,
!       Pragma_Profile,
!       Pragma_Profile_Warnings,
!       Pragma_Propagate_Exceptions,
!       Pragma_Queuing_Policy,
!       Pragma_Ravenscar,
!       Pragma_Restricted_Run_Time,
!       Pragma_Restrictions,
!       Pragma_Restriction_Warnings,
!       Pragma_Reviewable,
!       Pragma_Source_File_Name,
!       Pragma_Source_File_Name_Project,
!       Pragma_Style_Checks,
!       Pragma_Suppress,
!       Pragma_Suppress_Exception_Locations,
!       Pragma_Task_Dispatching_Policy,
!       Pragma_Universal_Data,
!       Pragma_Unsuppress,
!       Pragma_Use_VADS_Size,
!       Pragma_Validity_Checks,
!       Pragma_Warnings,
! 
!       --  Remaining (non-configuration) pragmas
! 
!       Pragma_Abort_Defer,
!       Pragma_All_Calls_Remote,
!       Pragma_Annotate,
!       Pragma_Assert,
!       Pragma_Asynchronous,
!       Pragma_Atomic,
!       Pragma_Atomic_Components,
!       Pragma_Attach_Handler,
!       Pragma_Comment,
!       Pragma_Common_Object,
!       Pragma_Complex_Representation,
!       Pragma_Controlled,
!       Pragma_Convention,
!       Pragma_CPP_Class,
!       Pragma_CPP_Constructor,
!       Pragma_CPP_Virtual,
!       Pragma_CPP_Vtable,
!       Pragma_Debug,
!       Pragma_Elaborate,
!       Pragma_Elaborate_All,
!       Pragma_Elaborate_Body,
!       Pragma_Export,
!       Pragma_Export_Exception,
!       Pragma_Export_Function,
!       Pragma_Export_Object,
!       Pragma_Export_Procedure,
!       Pragma_Export_Value,
!       Pragma_Export_Valued_Procedure,
!       Pragma_External,
!       Pragma_Finalize_Storage_Only,
!       Pragma_Ident,
!       Pragma_Import,
!       Pragma_Import_Exception,
!       Pragma_Import_Function,
!       Pragma_Import_Object,
!       Pragma_Import_Procedure,
!       Pragma_Import_Valued_Procedure,
!       Pragma_Inline,
!       Pragma_Inline_Always,
!       Pragma_Inline_Generic,
!       Pragma_Inspection_Point,
!       Pragma_Interface_Name,
!       Pragma_Interrupt_Handler,
!       Pragma_Interrupt_Priority,
!       Pragma_Java_Constructor,
!       Pragma_Java_Interface,
!       Pragma_Keep_Names,
!       Pragma_Link_With,
!       Pragma_Linker_Alias,
!       Pragma_Linker_Constructor,
!       Pragma_Linker_Destructor,
!       Pragma_Linker_Options,
!       Pragma_Linker_Section,
!       Pragma_List,
!       Pragma_Machine_Attribute,
!       Pragma_Main,
!       Pragma_Main_Storage,
!       Pragma_Memory_Size,
!       Pragma_No_Return,
!       Pragma_Obsolescent,
!       Pragma_Optimize,
!       Pragma_Optional_Overriding,
!       Pragma_Pack,
!       Pragma_Page,
!       Pragma_Passive,
!       Pragma_Preelaborate,
!       Pragma_Preelaborate_05,
!       Pragma_Priority,
!       Pragma_Psect_Object,
!       Pragma_Pure,
!       Pragma_Pure_05,
!       Pragma_Pure_Function,
!       Pragma_Remote_Call_Interface,
!       Pragma_Remote_Types,
!       Pragma_Share_Generic,
!       Pragma_Shared,
!       Pragma_Shared_Passive,
!       Pragma_Source_Reference,
!       Pragma_Stream_Convert,
!       Pragma_Subtitle,
!       Pragma_Suppress_All,
!       Pragma_Suppress_Debug_Info,
!       Pragma_Suppress_Initialization,
!       Pragma_System_Name,
!       Pragma_Task_Info,
!       Pragma_Task_Name,
!       Pragma_Task_Storage,
!       Pragma_Thread_Body,
!       Pragma_Time_Slice,
!       Pragma_Title,
!       Pragma_Unchecked_Union,
!       Pragma_Unimplemented_Unit,
!       Pragma_Unreferenced,
!       Pragma_Unreserve_All_Interrupts,
!       Pragma_Volatile,
!       Pragma_Volatile_Components,
!       Pragma_Weak_External,
! 
!       --  The following pragmas are on their own, out of order, because of
!       --  the special processing required to deal with the fact that their
!       --  names match existing attribute names.
! 
!       Pragma_AST_Entry,
!       Pragma_Interface,
!       Pragma_Storage_Size,
!       Pragma_Storage_Unit,
! 
!       --  The value to represent an unknown or unrecognized pragma
! 
!       Unknown_Pragma);
! 
!    -----------------------------------
!    -- Queuing Policy ID definitions --
!    -----------------------------------
! 
!    type Queuing_Policy_Id is (
!       Queuing_Policy_FIFO_Queuing,
!       Queuing_Policy_Priority_Queuing);
! 
!    --------------------------------------------
!    -- Task Dispatching Policy ID definitions --
!    --------------------------------------------
! 
!    type Task_Dispatching_Policy_Id is (
!       Task_Dispatching_FIFO_Within_Priorities);
!    --  Id values used to identify task dispatching policies
! 
!    -----------------
!    -- Subprograms --
!    -----------------
! 
!    procedure Initialize;
!    --  Called to initialize the preset names in the names table
! 
!    function Is_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute
! 
!    function Is_Entity_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized entity attribute,
!    --  i.e. an attribute reference that returns an entity.
! 
!    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute that
!    --  designates a procedure (and can therefore appear as a statement).
! 
!    function Is_Function_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized attribute
!    --  that designates a renameable function, and can therefore appear in
!    --  a renaming statement. Note that not all attributes designating
!    --  functions are renamable, in particular, thos returning a universal
!    --  value cannot be renamed.
! 
!    function Is_Type_Attribute_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized type attribute,
!    --  i.e. an attribute reference that returns a type
! 
!    function Is_Check_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized suppress check
!    --  as required by pragma Suppress.
! 
!    function Is_Convention_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of one of the recognized
!    --  language conventions, as required by pragma Convention, Import,
!    --  Export, Interface. Returns True if so. Also returns True for a
!    --  name that has been specified by a Convention_Identifier pragma.
!    --  If neither case holds, returns False.
! 
!    function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized locking policy
! 
!    function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of an operator symbol
! 
!    function Is_Pragma_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized pragma. Note
!    --  that pragmas AST_Entry, Storage_Size, and Storage_Unit are recognized
!    --  as pragmas by this function even though their names are separate from
!    --  the other pragma names.
! 
!    function Is_Queuing_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized queuing policy
! 
!    function Is_Task_Dispatching_Policy_Name (N : Name_Id) return Boolean;
!    --  Test to see if the name N is the name of a recognized task
!    --  dispatching policy.
! 
!    function Get_Attribute_Id (N : Name_Id) return Attribute_Id;
!    --  Returns Id of attribute corresponding to given name. It is an error to
!    --  call this function with a name that is not the name of a attribute.
! 
!    function Get_Convention_Id (N : Name_Id) return Convention_Id;
!    --  Returns Id of language convention corresponding to given name. It is an
!    --  to call this function with a name that is not the name of a convention,
!    --  or one previously given in a call to Record_Convention_Identifier.
! 
!    function Get_Check_Id (N : Name_Id) return Check_Id;
!    --  Returns Id of suppress check corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Locking_Policy_Id (N : Name_Id) return Locking_Policy_Id;
!    --  Returns Id of locking policy corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Pragma_Id (N : Name_Id) return Pragma_Id;
!    --  Returns Id of pragma corresponding to given name. Returns Unknown_Pragma
!    --  if N is not a name of a known (Ada defined or GNAT-specific) pragma.
!    --  Note that the function also works correctly for names of pragmas that
!    --  are not in the main list of pragma Names (AST_Entry, Storage_Size, and
!    --  Storage_Unit (e.g. Name_Storage_Size returns Pragma_Storage_Size).
! 
!    function Get_Queuing_Policy_Id (N : Name_Id) return Queuing_Policy_Id;
!    --  Returns Id of queuing policy corresponding to given name. It is an error
!    --  to call this function with a name that is not the name of a check.
! 
!    function Get_Task_Dispatching_Policy_Id
!      (N    : Name_Id)
!       return Task_Dispatching_Policy_Id;
!    --  Returns Id of task dispatching policy corresponding to given name.
!    --  It is an error to call this function with a name that is not the
!    --  name of a check.
! 
!    procedure Record_Convention_Identifier
!      (Id         : Name_Id;
!       Convention : Convention_Id);
!    --  A call to this procedure, resulting from an occurrence of a pragma
!    --  Convention_Identifier, records that from now on an occurrence of
!    --  Id will be recognized as a name for the specified convention.
! 
! private
!    pragma Inline (Is_Attribute_Name);
!    pragma Inline (Is_Entity_Attribute_Name);
!    pragma Inline (Is_Type_Attribute_Name);
!    pragma Inline (Is_Check_Name);
!    pragma Inline (Is_Locking_Policy_Name);
!    pragma Inline (Is_Operator_Symbol_Name);
!    pragma Inline (Is_Queuing_Policy_Name);
!    pragma Inline (Is_Pragma_Name);
!    pragma Inline (Is_Task_Dispatching_Policy_Name);
! 
! end Snames;
diff -Nrcpad gcc-4.0.2/gcc/ada/snames.h gcc-4.1.0/gcc/ada/snames.h
*** gcc-4.0.2/gcc/ada/snames.h	Thu Feb 10 13:50:22 2005
--- gcc-4.1.0/gcc/ada/snames.h	Tue Nov 15 13:56:51 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
***************
*** 25,31 ****
   ****************************************************************************/
  
  /* This is the C file that corresponds to the Ada package specification
!    Snames. It was created manually from the file snames.ads. */
  
  /* Name_Id values */
  
--- 25,31 ----
   ****************************************************************************/
  
  /* This is the C file that corresponds to the Ada package specification
!    Snames. It was created automatically from the file snames.ads. */
  
  /* Name_Id values */
  
*************** extern unsigned char Get_Attribute_Id (i
*** 45,60 ****
  
  /* Define the numeric values for attributes.  */
  
! #define  Attr_Abort_Signal                   0
! #define  Attr_Access                         1
! #define  Attr_Address                        2
! #define  Attr_Address_Size                   3
! #define  Attr_Aft                            4
! #define  Attr_Alignment                      5
! #define  Attr_Asm_Input                      6
! #define  Attr_Asm_Output                     7
! #define  Attr_AST_Entry                      8
! #define  Attr_Bit                            9
  #define  Attr_Bit_Order                     10
  #define  Attr_Bit_Position                  11
  #define  Attr_Body_Version                  12
--- 45,60 ----
  
  /* Define the numeric values for attributes.  */
  
! #define  Attr_Abort_Signal                  0
! #define  Attr_Access                        1
! #define  Attr_Address                       2
! #define  Attr_Address_Size                  3
! #define  Attr_Aft                           4
! #define  Attr_Alignment                     5
! #define  Attr_Asm_Input                     6
! #define  Attr_Asm_Output                    7
! #define  Attr_AST_Entry                     8
! #define  Attr_Bit                           9
  #define  Attr_Bit_Order                     10
  #define  Attr_Bit_Position                  11
  #define  Attr_Body_Version                  12
*************** extern unsigned char Get_Attribute_Id (i
*** 95,189 ****
  #define  Attr_Machine_Mantissa              47
  #define  Attr_Machine_Overflows             48
  #define  Attr_Machine_Radix                 49
! #define  Attr_Machine_Rounds                50
! #define  Attr_Machine_Size                  51
! #define  Attr_Mantissa                      52
! #define  Attr_Max_Size_In_Storage_Elements  53
! #define  Attr_Maximum_Alignment             54
! #define  Attr_Mechanism_Code                55
! #define  Attr_Mod                           56
! #define  Attr_Model_Emin                    57
! #define  Attr_Model_Epsilon                 58
! #define  Attr_Model_Mantissa                59
! #define  Attr_Model_Small                   60
! #define  Attr_Modulus                       61
! #define  Attr_Null_Parameter                62
! #define  Attr_Object_Size                   63
! #define  Attr_Partition_ID                  64
! #define  Attr_Passed_By_Reference           65
! #define  Attr_Pool_Address                  66
! #define  Attr_Pos                           67
! #define  Attr_Position                      68
! #define  Attr_Range                         69
! #define  Attr_Range_Length                  70
! #define  Attr_Round                         71
! #define  Attr_Safe_Emax                     72
! #define  Attr_Safe_First                    73
! #define  Attr_Safe_Large                    74
! #define  Attr_Safe_Last                     75
! #define  Attr_Safe_Small                    76
! #define  Attr_Scale                         77
! #define  Attr_Scaling                       78
! #define  Attr_Signed_Zeros                  79
! #define  Attr_Size                          80
! #define  Attr_Small                         81
! #define  Attr_Storage_Size                  82
! #define  Attr_Storage_Unit                  83
! #define  Attr_Stream_Size                   84
! #define  Attr_Tag                           85
! #define  Attr_Target_Name                   86
! #define  Attr_Terminated                    87
! #define  Attr_To_Address                    88
! #define  Attr_Type_Class                    89
! #define  Attr_UET_Address                   90
! #define  Attr_Unbiased_Rounding             91
! #define  Attr_Unchecked_Access              92
! #define  Attr_Unconstrained_Array           93
! #define  Attr_Universal_Literal_String      94
! #define  Attr_Unrestricted_Access           95
! #define  Attr_VADS_Size                     96
! #define  Attr_Val                           97
! #define  Attr_Valid                         98
! #define  Attr_Value_Size                    99
! #define  Attr_Version                      100
! #define  Attr_Wchar_T_Size                 101
! #define  Attr_Wide_Wide_Width              102
! #define  Attr_Wide_Width                   103
! #define  Attr_Width                        104
! #define  Attr_Word_Size                    105
! 
! #define  Attr_Adjacent                     106
! #define  Attr_Ceiling                      107
! #define  Attr_Copy_Sign                    108
! #define  Attr_Floor                        109
! #define  Attr_Fraction                     110
! #define  Attr_Image                        111
! #define  Attr_Input                        112
! #define  Attr_Machine                      113
! #define  Attr_Max                          114
! #define  Attr_Min                          115
! #define  Attr_Model                        116
! #define  Attr_Pred                         117
! #define  Attr_Remainder                    118
! #define  Attr_Rounding                     119
! #define  Attr_Succ                         120
! #define  Attr_Truncation                   121
! #define  Attr_Value                        122
! #define  Attr_Wide_Image                   123
! #define  Attr_Wide_Wide_Image              124
! #define  Attr_Wide_Value                   125
! #define  Attr_Wide_Wide_Value              126
! 
! #define  Attr_Output                       127
! #define  Attr_Read                         128
! #define  Attr_Write                        129
  
! #define  Attr_Elab_Body                    130
! #define  Attr_Elab_Spec                    131
! #define  Attr_Storage_Pool                 132
  
! #define  Attr_Base                         133
! #define  Attr_Class                        134
  
  /* Define the function to check if a Name_Id value is a valid pragma */
  
--- 95,201 ----
  #define  Attr_Machine_Mantissa              47
  #define  Attr_Machine_Overflows             48
  #define  Attr_Machine_Radix                 49
! #define  Attr_Machine_Rounding              50
! #define  Attr_Machine_Rounds                51
! #define  Attr_Machine_Size                  52
! #define  Attr_Mantissa                      53
! #define  Attr_Max_Size_In_Storage_Elements  54
! #define  Attr_Maximum_Alignment             55
! #define  Attr_Mechanism_Code                56
! #define  Attr_Mod                           57
! #define  Attr_Model_Emin                    58
! #define  Attr_Model_Epsilon                 59
! #define  Attr_Model_Mantissa                60
! #define  Attr_Model_Small                   61
! #define  Attr_Modulus                       62
! #define  Attr_Null_Parameter                63
! #define  Attr_Object_Size                   64
! #define  Attr_Partition_ID                  65
! #define  Attr_Passed_By_Reference           66
! #define  Attr_Pool_Address                  67
! #define  Attr_Pos                           68
! #define  Attr_Position                      69
! #define  Attr_Range                         70
! #define  Attr_Range_Length                  71
! #define  Attr_Round                         72
! #define  Attr_Safe_Emax                     73
! #define  Attr_Safe_First                    74
! #define  Attr_Safe_Large                    75
! #define  Attr_Safe_Last                     76
! #define  Attr_Safe_Small                    77
! #define  Attr_Scale                         78
! #define  Attr_Scaling                       79
! #define  Attr_Signed_Zeros                  80
! #define  Attr_Size                          81
! #define  Attr_Small                         82
! #define  Attr_Storage_Size                  83
! #define  Attr_Storage_Unit                  84
! #define  Attr_Stream_Size                   85
! #define  Attr_Tag                           86
! #define  Attr_Target_Name                   87
! #define  Attr_Terminated                    88
! #define  Attr_To_Address                    89
! #define  Attr_Type_Class                    90
! #define  Attr_UET_Address                   91
! #define  Attr_Unbiased_Rounding             92
! #define  Attr_Unchecked_Access              93
! #define  Attr_Unconstrained_Array           94
! #define  Attr_Universal_Literal_String      95
! #define  Attr_Unrestricted_Access           96
! #define  Attr_VADS_Size                     97
! #define  Attr_Val                           98
! #define  Attr_Valid                         99
! #define  Attr_Value_Size                    100
! #define  Attr_Version                       101
! #define  Attr_Wchar_T_Size                  102
! #define  Attr_Wide_Wide_Width               103
! #define  Attr_Wide_Width                    104
! #define  Attr_Width                         105
! #define  Attr_Word_Size                     106
! #define  Attr_Adjacent                      107
! #define  Attr_Ceiling                       108
! #define  Attr_Copy_Sign                     109
! #define  Attr_Floor                         110
! #define  Attr_Fraction                      111
! #define  Attr_Image                         112
! #define  Attr_Input                         113
! #define  Attr_Machine                       114
! #define  Attr_Max                           115
! #define  Attr_Min                           116
! #define  Attr_Model                         117
! #define  Attr_Pred                          118
! #define  Attr_Remainder                     119
! #define  Attr_Rounding                      120
! #define  Attr_Succ                          121
! #define  Attr_Truncation                    122
! #define  Attr_Value                         123
! #define  Attr_Wide_Image                    124
! #define  Attr_Wide_Wide_Image               125
! #define  Attr_Wide_Value                    126
! #define  Attr_Wide_Wide_Value               127
! #define  Attr_Output                        128
! #define  Attr_Read                          129
! #define  Attr_Write                         130
! #define  Attr_Elab_Body                     131
! #define  Attr_Elab_Spec                     132
! #define  Attr_Storage_Pool                  133
! #define  Attr_Base                          134
! #define  Attr_Class                         135
  
! /* Define the numeric values for the conventions.  */
  
! #define  Convention_Ada                           0
! #define  Convention_Intrinsic                     1
! #define  Convention_Entry                         2
! #define  Convention_Protected                     3
! #define  Convention_Assembler                     4
! #define  Convention_C                             5
! #define  Convention_COBOL                         6
! #define  Convention_CPP                           7
! #define  Convention_Fortran                       8
! #define  Convention_Java                          9
! #define  Convention_Stdcall                       10
! #define  Convention_Stubbed                       11
  
  /* Define the function to check if a Name_Id value is a valid pragma */
  
*************** extern unsigned char Get_Pragma_Id (int)
*** 200,371 ****
  
  /* Define the numeric values for the pragmas. */
  
- /* Configuration pragmas first */
- 
  #define  Pragma_Ada_83                        0
  #define  Pragma_Ada_95                        1
  #define  Pragma_Ada_05                        2
! #define  Pragma_C_Pass_By_Copy                3
! #define  Pragma_Compile_Time_Warning          4
! #define  Pragma_Component_Alignment           5
! #define  Pragma_Convention_Identifier         6
! #define  Pragma_Detect_Blocking               7
! #define  Pragma_Discard_Names                 8
! #define  Pragma_Elaboration_Checking          9
! #define  Pragma_Eliminate                    10
! #define  Pragma_Explicit_Overriding          11
! #define  Pragma_Extend_System                12
! #define  Pragma_Extensions_Allowed           13
! #define  Pragma_External_Name_Casing         14
! #define  Pragma_Float_Representation         15
! #define  Pragma_Initialize_Scalars           16
! #define  Pragma_Interrupt_State              17
! #define  Pragma_License                      18
! #define  Pragma_Locking_Policy               19
! #define  Pragma_Long_Float                   20
! #define  Pragma_No_Run_Time                  21
! #define  Pragma_No_Strict_Aliasing           22
! #define  Pragma_Normalize_Scalars            23
! #define  Pragma_Polling                      24
! #define  Pragma_Persistent_Data              25
! #define  Pragma_Persistent_Object            26
! #define  Pragma_Profile                      27
! #define  Pragma_Profile_Warnings             28
! #define  Pragma_Propagate_Exceptions         29
! #define  Pragma_Queuing_Policy               30
! #define  Pragma_Ravenscar                    31
! #define  Pragma_Restricted_Run_Time          32
! #define  Pragma_Restrictions                 33
! #define  Pragma_Restriction_Warnings         34
! #define  Pragma_Reviewable                   35
! #define  Pragma_Source_File_Name             36
! #define  Pragma_Source_File_Name_Project     37
! #define  Pragma_Style_Checks                 38
! #define  Pragma_Suppress                     39
! #define  Pragma_Suppress_Exception_Locations 40
! #define  Pragma_Task_Dispatching_Policy      41
! #define  Pragma_Universal_Data               42
! #define  Pragma_Unsuppress                   43
! #define  Pragma_Use_VADS_Size                44
! #define  Pragma_Validity_Checks              45
! #define  Pragma_Warnings                     46
! 
! /* Remaining pragmas */
! 
! #define  Pragma_Abort_Defer                  47
! #define  Pragma_All_Calls_Remote             48
! #define  Pragma_Annotate                     49
! #define  Pragma_Assert                       50
! #define  Pragma_Asynchronous                 51
! #define  Pragma_Atomic                       52
! #define  Pragma_Atomic_Components            53
! #define  Pragma_Attach_Handler               54
! #define  Pragma_Comment                      55
! #define  Pragma_Common_Object                56
! #define  Pragma_Complex_Representation       57
! #define  Pragma_Controlled                   58
! #define  Pragma_Convention                   59
! #define  Pragma_CPP_Class                    60
! #define  Pragma_CPP_Constructor              61
! #define  Pragma_CPP_Virtual                  62
! #define  Pragma_CPP_Vtable                   63
! #define  Pragma_Debug                        64
! #define  Pragma_Elaborate                    65
! #define  Pragma_Elaborate_All                66
! #define  Pragma_Elaborate_Body               67
! #define  Pragma_Export                       68
! #define  Pragma_Export_Exception             69
! #define  Pragma_Export_Function              70
! #define  Pragma_Export_Object                71
! #define  Pragma_Export_Procedure             72
! #define  Pragma_Export_Value                 73
! #define  Pragma_Export_Valued_Procedure      74
! #define  Pragma_External                     75
! #define  Pragma_Finalize_Storage_Only        76
! #define  Pragma_Ident                        77
! #define  Pragma_Import                       78
! #define  Pragma_Import_Exception             79
! #define  Pragma_Import_Function              80
! #define  Pragma_Import_Object                81
! #define  Pragma_Import_Procedure             82
! #define  Pragma_Import_Valued_Procedure      83
! #define  Pragma_Inline                       84
! #define  Pragma_Inline_Always                85
! #define  Pragma_Inline_Generic               86
! #define  Pragma_Inspection_Point             87
! #define  Pragma_Interface_Name               88
! #define  Pragma_Interrupt_Handler            89
! #define  Pragma_Interrupt_Priority           90
! #define  Pragma_Java_Constructor             91
! #define  Pragma_Java_Interface               92
! #define  Pragma_Keep_Names                   93
! #define  Pragma_Link_With                    94
! #define  Pragma_Linker_Alias                 95
! #define  Pragma_Linker_Options               96
! #define  Pragma_Linker_Section               97
! #define  Pragma_List                         98
! #define  Pragma_Machine_Attribute            99
! #define  Pragma_Main                        100
! #define  Pragma_Main_Storage                101
! #define  Pragma_Memory_Size                 102
! #define  Pragma_No_Return                   103
! #define  Pragma_Obsolescent                 104
! #define  Pragma_Optimize                    105
! #define  Pragma_Optional_Overriding         106
! #define  Pragma_Pack                        107
! #define  Pragma_Page                        108
! #define  Pragma_Passive                     109
! #define  Pragma_Preelaborate                110
! #define  Pragma_Priority                    111
! #define  Pragma_Psect_Object                112
! #define  Pragma_Pure                        113
! #define  Pragma_Pure_Function               114
! #define  Pragma_Remote_Call_Interface       115
! #define  Pragma_Remote_Types                116
! #define  Pragma_Share_Generic               117
! #define  Pragma_Shared                      118
! #define  Pragma_Shared_Passive              119
! #define  Pragma_Source_Reference            120
! #define  Pragma_Stream_Convert              121
! #define  Pragma_Subtitle                    122
! #define  Pragma_Suppress_All                123
! #define  Pragma_Suppress_Debug_Info         124
! #define  Pragma_Suppress_Initialization     125
! #define  Pragma_System_Name                 126
! #define  Pragma_Task_Info                   127
! #define  Pragma_Task_Name                   128
! #define  Pragma_Task_Storage                129
! #define  Pragma_Thread_Body                 130
! #define  Pragma_Time_Slice                  131
! #define  Pragma_Title                       132
! #define  Pragma_Unchecked_Union             133
! #define  Pragma_Unimplemented_Unit          134
! #define  Pragma_Unreferenced                135
! #define  Pragma_Unreserve_All_Interrupts    136
! #define  Pragma_Volatile                    137
! #define  Pragma_Volatile_Components         138
! #define  Pragma_Weak_External               139
! 
! /* The following are deliberately out of alphabetical order, see Snames */
! 
! #define  Pragma_AST_Entry                   140
! #define  Pragma_Interface                   141
! #define  Pragma_Storage_Size                142
! #define  Pragma_Storage_Unit                143
! 
! /* Define the numeric values for the conventions.  */
! 
! #define  Convention_Ada                      0
! #define  Convention_Intrinsic                1
! #define  Convention_Entry                    2
! #define  Convention_Protected                3
! #define  Convention_Assembler                4
! #define  Convention_C                        5
! #define  Convention_COBOL                    6
! #define  Convention_CPP                      7
! #define  Convention_Fortran                  8
! #define  Convention_Java                     9
! #define  Convention_Stdcall                 10
! #define  Convention_Stubbed                 11
  
  /* End of snames.h (C version of Snames package spec) */
--- 212,365 ----
  
  /* Define the numeric values for the pragmas. */
  
  #define  Pragma_Ada_83                        0
  #define  Pragma_Ada_95                        1
  #define  Pragma_Ada_05                        2
! #define  Pragma_Assertion_Policy              3
! #define  Pragma_C_Pass_By_Copy                4
! #define  Pragma_Compile_Time_Warning          5
! #define  Pragma_Component_Alignment           6
! #define  Pragma_Convention_Identifier         7
! #define  Pragma_Debug_Policy                  8
! #define  Pragma_Detect_Blocking               9
! #define  Pragma_Discard_Names                 10
! #define  Pragma_Elaboration_Checks            11
! #define  Pragma_Eliminate                     12
! #define  Pragma_Explicit_Overriding           13
! #define  Pragma_Extend_System                 14
! #define  Pragma_Extensions_Allowed            15
! #define  Pragma_External_Name_Casing          16
! #define  Pragma_Float_Representation          17
! #define  Pragma_Initialize_Scalars            18
! #define  Pragma_Interrupt_State               19
! #define  Pragma_License                       20
! #define  Pragma_Locking_Policy                21
! #define  Pragma_Long_Float                    22
! #define  Pragma_No_Run_Time                   23
! #define  Pragma_No_Strict_Aliasing            24
! #define  Pragma_Normalize_Scalars             25
! #define  Pragma_Polling                       26
! #define  Pragma_Persistent_BSS                27
! #define  Pragma_Profile                       28
! #define  Pragma_Profile_Warnings              29
! #define  Pragma_Propagate_Exceptions          30
! #define  Pragma_Queuing_Policy                31
! #define  Pragma_Ravenscar                     32
! #define  Pragma_Restricted_Run_Time           33
! #define  Pragma_Restrictions                  34
! #define  Pragma_Restriction_Warnings          35
! #define  Pragma_Reviewable                    36
! #define  Pragma_Source_File_Name              37
! #define  Pragma_Source_File_Name_Project      38
! #define  Pragma_Style_Checks                  39
! #define  Pragma_Suppress                      40
! #define  Pragma_Suppress_Exception_Locations  41
! #define  Pragma_Task_Dispatching_Policy       42
! #define  Pragma_Universal_Data                43
! #define  Pragma_Unsuppress                    44
! #define  Pragma_Use_VADS_Size                 45
! #define  Pragma_Validity_Checks               46
! #define  Pragma_Warnings                      47
! #define  Pragma_Abort_Defer                   48
! #define  Pragma_All_Calls_Remote              49
! #define  Pragma_Annotate                      50
! #define  Pragma_Assert                        51
! #define  Pragma_Asynchronous                  52
! #define  Pragma_Atomic                        53
! #define  Pragma_Atomic_Components             54
! #define  Pragma_Attach_Handler                55
! #define  Pragma_Comment                       56
! #define  Pragma_Common_Object                 57
! #define  Pragma_Complex_Representation        58
! #define  Pragma_Controlled                    59
! #define  Pragma_Convention                    60
! #define  Pragma_CPP_Class                     61
! #define  Pragma_CPP_Constructor               62
! #define  Pragma_CPP_Virtual                   63
! #define  Pragma_CPP_Vtable                    64
! #define  Pragma_Debug                         65
! #define  Pragma_Elaborate                     66
! #define  Pragma_Elaborate_All                 67
! #define  Pragma_Elaborate_Body                68
! #define  Pragma_Export                        69
! #define  Pragma_Export_Exception              70
! #define  Pragma_Export_Function               71
! #define  Pragma_Export_Object                 72
! #define  Pragma_Export_Procedure              73
! #define  Pragma_Export_Value                  74
! #define  Pragma_Export_Valued_Procedure       75
! #define  Pragma_External                      76
! #define  Pragma_Finalize_Storage_Only         77
! #define  Pragma_Ident                         78
! #define  Pragma_Import                        79
! #define  Pragma_Import_Exception              80
! #define  Pragma_Import_Function               81
! #define  Pragma_Import_Object                 82
! #define  Pragma_Import_Procedure              83
! #define  Pragma_Import_Valued_Procedure       84
! #define  Pragma_Inline                        85
! #define  Pragma_Inline_Always                 86
! #define  Pragma_Inline_Generic                87
! #define  Pragma_Inspection_Point              88
! #define  Pragma_Interface_Name                89
! #define  Pragma_Interrupt_Handler             90
! #define  Pragma_Interrupt_Priority            91
! #define  Pragma_Java_Constructor              92
! #define  Pragma_Java_Interface                93
! #define  Pragma_Keep_Names                    94
! #define  Pragma_Link_With                     95
! #define  Pragma_Linker_Alias                  96
! #define  Pragma_Linker_Constructor            97
! #define  Pragma_Linker_Destructor             98
! #define  Pragma_Linker_Options                99
! #define  Pragma_Linker_Section                100
! #define  Pragma_List                          101
! #define  Pragma_Machine_Attribute             102
! #define  Pragma_Main                          103
! #define  Pragma_Main_Storage                  104
! #define  Pragma_Memory_Size                   105
! #define  Pragma_No_Return                     106
! #define  Pragma_Obsolescent                   107
! #define  Pragma_Optimize                      108
! #define  Pragma_Optional_Overriding           109
! #define  Pragma_Pack                          110
! #define  Pragma_Page                          111
! #define  Pragma_Passive                       112
! #define  Pragma_Preelaborate                  113
! #define  Pragma_Preelaborate_05               114
! #define  Pragma_Priority                      115
! #define  Pragma_Psect_Object                  116
! #define  Pragma_Pure                          117
! #define  Pragma_Pure_05                       118
! #define  Pragma_Pure_Function                 119
! #define  Pragma_Remote_Call_Interface         120
! #define  Pragma_Remote_Types                  121
! #define  Pragma_Share_Generic                 122
! #define  Pragma_Shared                        123
! #define  Pragma_Shared_Passive                124
! #define  Pragma_Source_Reference              125
! #define  Pragma_Stream_Convert                126
! #define  Pragma_Subtitle                      127
! #define  Pragma_Suppress_All                  128
! #define  Pragma_Suppress_Debug_Info           129
! #define  Pragma_Suppress_Initialization       130
! #define  Pragma_System_Name                   131
! #define  Pragma_Task_Info                     132
! #define  Pragma_Task_Name                     133
! #define  Pragma_Task_Storage                  134
! #define  Pragma_Thread_Body                   135
! #define  Pragma_Time_Slice                    136
! #define  Pragma_Title                         137
! #define  Pragma_Unchecked_Union               138
! #define  Pragma_Unimplemented_Unit            139
! #define  Pragma_Unreferenced                  140
! #define  Pragma_Unreserve_All_Interrupts      141
! #define  Pragma_Volatile                      142
! #define  Pragma_Volatile_Components           143
! #define  Pragma_Weak_External                 144
! #define  Pragma_AST_Entry                     145
! #define  Pragma_Interface                     146
! #define  Pragma_Storage_Size                  147
! #define  Pragma_Storage_Unit                  148
  
  /* End of snames.h (C version of Snames package spec) */
diff -Nrcpad gcc-4.0.2/gcc/ada/socket.c gcc-4.1.0/gcc/ada/socket.c
*** gcc-4.0.2/gcc/ada/socket.c	Mon Jan  3 15:30:02 2005
--- gcc-4.1.0/gcc/ada/socket.c	Mon Nov 21 23:32:00 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 2003-2004 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 2003-2005 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 33,39 ****
--- 33,46 ----
  /*  This file provides a portable binding to the sockets API                */
  
  #include "gsocket.h"
+ /* Include all the necessary system-specific headers and define the
+    necessary macros (shared with gen-soccon). */
+ 
  #include "raise.h"
+ /* Required for __gnat_malloc() */
+ 
+ #include <string.h>
+ /* Required for memcpy() */
  
  extern void __gnat_disable_sigpipe (int fd);
  extern void __gnat_free_socket_set (fd_set *);
*************** extern void __gnat_insert_socket_in_set 
*** 43,50 ****
--- 50,59 ----
  extern int __gnat_is_socket_in_set (fd_set *, int);
  extern fd_set *__gnat_new_socket_set (fd_set *);
  extern void __gnat_remove_socket_from_set (fd_set *, int);
+ extern int __gnat_get_h_errno (void);
  
  /* Disable the sending of SIGPIPE for writes on a broken stream */
+ 
  void
  __gnat_disable_sigpipe (int fd)
  {
*************** __gnat_remove_socket_from_set (fd_set *s
*** 146,148 ****
--- 155,202 ----
  {
    FD_CLR (socket, set);
  }
+ 
+ /* Get the value of the last host error */
+ 
+ int
+ __gnat_get_h_errno (void) {
+ #ifdef __vxworks
+   int vxw_errno = errno;
+ 
+   switch (vxw_errno) {
+     case 0:
+       return 0;
+ 
+     case S_resolvLib_HOST_NOT_FOUND:
+     case S_hostLib_UNKNOWN_HOST:
+       return HOST_NOT_FOUND;
+ 
+     case S_resolvLib_TRY_AGAIN:
+       return TRY_AGAIN;
+ 
+     case S_resolvLib_NO_RECOVERY:
+     case S_resolvLib_BUFFER_2_SMALL:
+     case S_resolvLib_INVALID_PARAMETER:
+     case S_resolvLib_INVALID_ADDRESS:
+     case S_hostLib_INVALID_PARAMETER:
+       return NO_RECOVERY;
+ 
+     case S_resolvLib_NO_DATA:
+       return NO_DATA;
+ 
+     default:
+       return -1;
+   }
+ #elif defined(VMS)
+   return errno;
+ #elif defined(__rtems__)
+   /* At this stage in the tool build, no networking .h files are available.
+      Newlib does not provide networking .h files and RTEMS is not built yet.
+      So we need to explicitly extern h_errno to access it.
+    */
+   extern int h_errno;
+   return h_errno;
+ #else
+   return h_errno;
+ #endif
+ }
diff -Nrcpad gcc-4.0.2/gcc/ada/sprint.adb gcc-4.1.0/gcc/ada/sprint.adb
*** gcc-4.0.2/gcc/ada/sprint.adb	Thu Feb 10 13:50:46 2005
--- gcc-4.1.0/gcc/ada/sprint.adb	Mon Sep  5 07:55:06 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Sprint is
*** 165,170 ****
--- 165,173 ----
     --  that is currently being written. Note that Debug_Node is always empty
     --  if a debug source file is not being written.
  
+    procedure Sprint_And_List (List : List_Id);
+    --  Print the given list with items separated by vertical "and"
+ 
     procedure Sprint_Bar_List (List : List_Id);
     --  Print the given list with items separated by vertical bars
  
*************** package body Sprint is
*** 480,495 ****
     end Source_Dump;
  
     ---------------------
     -- Sprint_Bar_List --
     ---------------------
  
     procedure Sprint_Bar_List (List : List_Id) is
        Node : Node_Id;
- 
     begin
        if Is_Non_Empty_List (List) then
           Node := First (List);
- 
           loop
              Sprint_Node (Node);
              Next (Node);
--- 483,514 ----
     end Source_Dump;
  
     ---------------------
+    -- Sprint_And_List --
+    ---------------------
+ 
+    procedure Sprint_And_List (List : List_Id) is
+       Node : Node_Id;
+    begin
+       if Is_Non_Empty_List (List) then
+          Node := First (List);
+          loop
+             Sprint_Node (Node);
+             Next (Node);
+             exit when Node = Empty;
+             Write_Str (" and ");
+          end loop;
+       end if;
+    end Sprint_And_List;
+ 
+    ---------------------
     -- Sprint_Bar_List --
     ---------------------
  
     procedure Sprint_Bar_List (List : List_Id) is
        Node : Node_Id;
     begin
        if Is_Non_Empty_List (List) then
           Node := First (List);
           loop
              Sprint_Node (Node);
              Next (Node);
*************** package body Sprint is
*** 509,515 ****
     begin
        if Is_Non_Empty_List (List) then
           Node := First (List);
- 
           loop
              Sprint_Node (Node);
              Next (Node);
--- 528,533 ----
*************** package body Sprint is
*** 520,526 ****
              then
                 Write_Str (", ");
              end if;
- 
           end loop;
        end if;
     end Sprint_Comma_List;
--- 538,543 ----
*************** package body Sprint is
*** 732,738 ****
              Write_Str_With_Col_Check ("function");
              Write_Param_Specs (Node);
              Write_Str_With_Col_Check (" return ");
!             Sprint_Node (Subtype_Mark (Node));
  
           when N_Access_Procedure_Definition =>
  
--- 749,755 ----
              Write_Str_With_Col_Check ("function");
              Write_Param_Specs (Node);
              Write_Str_With_Col_Check (" return ");
!             Sprint_Node (Result_Definition (Node));
  
           when N_Access_Procedure_Definition =>
  
*************** package body Sprint is
*** 1146,1153 ****
  
              Sprint_Node (Subtype_Indication (Node));
  
!             if Present (Record_Extension_Part (Node)) then
                 Write_Str_With_Col_Check (" with ");
                 Sprint_Node (Record_Extension_Part (Node));
              end if;
  
--- 1163,1178 ----
  
              Sprint_Node (Subtype_Indication (Node));
  
!             if Present (Interface_List (Node)) then
!                Sprint_And_List (Interface_List (Node));
                 Write_Str_With_Col_Check (" with ");
+             end if;
+ 
+             if Present (Record_Extension_Part (Node)) then
+                if No (Interface_List (Node)) then
+                   Write_Str_With_Col_Check (" with ");
+                end if;
+ 
                 Sprint_Node (Record_Extension_Part (Node));
              end if;
  
*************** package body Sprint is
*** 1521,1527 ****
              Sprint_Node (Defining_Unit_Name (Node));
              Write_Param_Specs (Node);
              Write_Str_With_Col_Check (" return ");
!             Sprint_Node (Subtype_Mark (Node));
  
           when N_Generic_Association =>
              Set_Debug_Sloc;
--- 1546,1561 ----
              Sprint_Node (Defining_Unit_Name (Node));
              Write_Param_Specs (Node);
              Write_Str_With_Col_Check (" return ");
! 
!             --  Ada 2005 (AI-231)
! 
!             if Nkind (Result_Definition (Node)) /= N_Access_Definition
!               and then Null_Exclusion_Present (Node)
!             then
!                Write_Str (" not null ");
!             end if;
! 
!             Sprint_Node (Result_Definition (Node));
  
           when N_Generic_Association =>
              Set_Debug_Sloc;
*************** package body Sprint is
*** 2149,2155 ****
              Write_Indent_Str_Sloc ("protected type ");
              Write_Id (Defining_Identifier (Node));
              Write_Discr_Specs (Node);
!             Write_Str (" is");
              Sprint_Node (Protected_Definition (Node));
              Write_Id (Defining_Identifier (Node));
              Write_Char (';');
--- 2183,2197 ----
              Write_Indent_Str_Sloc ("protected type ");
              Write_Id (Defining_Identifier (Node));
              Write_Discr_Specs (Node);
! 
!             if Present (Interface_List (Node)) then
!                Write_Str (" is new ");
!                Sprint_And_List (Interface_List (Node));
!                Write_Str (" with ");
!             else
!                Write_Str (" is");
!             end if;
! 
              Sprint_Node (Protected_Definition (Node));
              Write_Id (Defining_Identifier (Node));
              Write_Char (';');
*************** package body Sprint is
*** 2400,2405 ****
--- 2442,2454 ----
           when N_Subprogram_Declaration =>
              Write_Indent;
              Sprint_Node_Sloc (Specification (Node));
+ 
+             if Nkind (Specification (Node)) = N_Procedure_Specification
+               and then Null_Present (Specification (Node))
+             then
+                Write_Str_With_Col_Check (" is null");
+             end if;
+ 
              Write_Char (';');
  
           when N_Subprogram_Info =>
*************** package body Sprint is
*** 2471,2478 ****
              Write_Id (Defining_Identifier (Node));
              Write_Discr_Specs (Node);
  
              if Present (Task_Definition (Node)) then
!                Write_Str (" is");
                 Sprint_Node (Task_Definition (Node));
                 Write_Id (Defining_Identifier (Node));
              end if;
--- 2520,2537 ----
              Write_Id (Defining_Identifier (Node));
              Write_Discr_Specs (Node);
  
+             if Present (Interface_List (Node)) then
+                Write_Str (" is new ");
+                Sprint_And_List (Interface_List (Node));
+             end if;
+ 
              if Present (Task_Definition (Node)) then
!                if No (Interface_List (Node)) then
!                   Write_Str (" is");
!                else
!                   Write_Str (" with ");
!                end if;
! 
                 Sprint_Node (Task_Definition (Node));
                 Write_Id (Defining_Identifier (Node));
              end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/sprint.ads gcc-4.1.0/gcc/ada/sprint.ads
*** gcc-4.0.2/gcc/ada/sprint.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/sprint.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Sprint is
*** 115,121 ****
     --  does not generate any New_Line calls.
  
     procedure Sprint_Opt_Node_List (List : List_Id);
!    --  Like Sprint_Node_List, but prints nothing if List = No_List.
  
     procedure Sprint_Indented_List (List : List_Id);
     --  Like Sprint_Line_List, except that the indentation level is
--- 115,121 ----
     --  does not generate any New_Line calls.
  
     procedure Sprint_Opt_Node_List (List : List_Id);
!    --  Like Sprint_Node_List, but prints nothing if List = No_List
  
     procedure Sprint_Indented_List (List : List_Id);
     --  Like Sprint_Line_List, except that the indentation level is
diff -Nrcpad gcc-4.0.2/gcc/ada/stand.adb gcc-4.1.0/gcc/ada/stand.adb
*** gcc-4.0.2/gcc/ada/stand.adb	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/stand.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/stand.ads gcc-4.1.0/gcc/ada/stand.ads
*** gcc-4.0.2/gcc/ada/stand.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/stand.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Stand is
*** 335,341 ****
     --  This is a type used to represent the return type of procedures
  
     Standard_Exception_Type  : Entity_Id;
!    --  This is a type used to represent the Etype of exceptions.
  
     Standard_A_String   : Entity_Id;
     --  An access to String type used for building elements of tables
--- 335,341 ----
     --  This is a type used to represent the return type of procedures
  
     Standard_Exception_Type  : Entity_Id;
!    --  This is a type used to represent the Etype of exceptions
  
     Standard_A_String   : Entity_Id;
     --  An access to String type used for building elements of tables
*************** package Stand is
*** 362,374 ****
     --  is propagated to avoid cascaded errors from a single type error.
  
     Any_Access : Entity_Id;
!    --  Used to resolve the overloaded literal NULL.
  
     Any_Array : Entity_Id;
     --  Used to represent some unknown array type
  
     Any_Boolean : Entity_Id;
!    --  The context type of conditions in IF and WHILE statements.
  
     Any_Character : Entity_Id;
     --  Any_Character is used to label character literals, which in general
--- 362,374 ----
     --  is propagated to avoid cascaded errors from a single type error.
  
     Any_Access : Entity_Id;
!    --  Used to resolve the overloaded literal NULL
  
     Any_Array : Entity_Id;
     --  Used to represent some unknown array type
  
     Any_Boolean : Entity_Id;
!    --  The context type of conditions in IF and WHILE statements
  
     Any_Character : Entity_Id;
     --  Any_Character is used to label character literals, which in general
*************** package Stand is
*** 386,392 ****
     --  Used to represent some unknown fixed-point type
  
     Any_Integer : Entity_Id;
!    --  Used to represent some unknown integer type.
  
     Any_Modular : Entity_Id;
     --  Used to represent the result type of a boolean operation on an
--- 386,392 ----
     --  Used to represent some unknown fixed-point type
  
     Any_Integer : Entity_Id;
!    --  Used to represent some unknown integer type
  
     Any_Modular : Entity_Id;
     --  Used to represent the result type of a boolean operation on an
*************** package Stand is
*** 394,403 ****
     --  only legal in a modular context.
  
     Any_Numeric : Entity_Id;
!    --  Used to represent some unknown numeric type.
  
     Any_Real : Entity_Id;
!    --  Used to represent some unknown real type.
  
     Any_Scalar : Entity_Id;
     --  Used to represent some unknown scalar type
--- 394,403 ----
     --  only legal in a modular context.
  
     Any_Numeric : Entity_Id;
!    --  Used to represent some unknown numeric type
  
     Any_Real : Entity_Id;
!    --  Used to represent some unknown real type
  
     Any_Scalar : Entity_Id;
     --  Used to represent some unknown scalar type
*************** package Stand is
*** 416,422 ****
     Universal_Real : Entity_Id;
     --  Entity for universal real type. The bounds of this type correspond to
     --  to the largest supported real type (i.e. Long_Long_Real). It is the
!    --  type used for runtime calculations in type universal real.
  
     Universal_Fixed : Entity_Id;
     --  Entity for universal fixed type. This is a type with  arbitrary
--- 416,424 ----
     Universal_Real : Entity_Id;
     --  Entity for universal real type. The bounds of this type correspond to
     --  to the largest supported real type (i.e. Long_Long_Real). It is the
!    --  type used for runtime calculations in type universal real. Note that
!    --  this type is always IEEE format, even if Long_Long_Real is Vax_Float
!    --  (and in that case the bounds don't correspond exactly).
  
     Universal_Fixed : Entity_Id;
     --  Entity for universal fixed type. This is a type with  arbitrary
diff -Nrcpad gcc-4.0.2/gcc/ada/stringt.adb gcc-4.1.0/gcc/ada/stringt.adb
*** gcc-4.0.2/gcc/ada/stringt.adb	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/stringt.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/stringt.ads gcc-4.1.0/gcc/ada/stringt.ads
*** gcc-4.0.2/gcc/ada/stringt.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/stringt.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/stringt.h gcc-4.1.0/gcc/ada/stringt.h
*** gcc-4.0.2/gcc/ada/stringt.h	Tue Nov  4 12:51:46 2003
--- gcc-4.1.0/gcc/ada/stringt.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/style.ads gcc-4.1.0/gcc/ada/style.ads
*** gcc-4.0.2/gcc/ada/style.ads	Fri Nov 19 10:56:53 2004
--- gcc-4.1.0/gcc/ada/style.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Style is
*** 111,116 ****
--- 111,120 ----
       renames Style_Inst.Check_Dot_Dot;
     --  Called after scanning out dot dot to check spacing
  
+    procedure Check_EOF
+      renames Style_Inst.Check_EOF;
+    --  Called after scanning out end of file mark
+ 
     procedure Check_HT
       renames Style_Inst.Check_HT;
     --  Called with Scan_Ptr pointing to a horizontal tab character
diff -Nrcpad gcc-4.0.2/gcc/ada/styleg-c.adb gcc-4.1.0/gcc/ada/styleg-c.adb
*** gcc-4.0.2/gcc/ada/styleg-c.adb	Fri Nov 19 10:56:53 2004
--- gcc-4.1.0/gcc/ada/styleg-c.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Styleg.C is
*** 63,69 ****
              end;
           end if;
  
!          Error_Msg_N ("(style): subprogram body has no previous spec", N);
        end if;
     end Body_With_No_Spec;
  
--- 63,69 ----
              end;
           end if;
  
!          Error_Msg_N ("(style) subprogram body has no previous spec", N);
        end if;
     end Body_With_No_Spec;
  
*************** package body Styleg.C is
*** 189,195 ****
                    Cas := Mixed_Case;
                 end if;
  
!                Nlen  := Length_Of_Name (Chars (Ref));
  
                 --  Now check if we have the right casing
  
--- 189,195 ----
                    Cas := Mixed_Case;
                 end if;
  
!                Nlen := Length_Of_Name (Chars (Ref));
  
                 --  Now check if we have the right casing
  
diff -Nrcpad gcc-4.0.2/gcc/ada/styleg-c.ads gcc-4.1.0/gcc/ada/styleg-c.ads
*** gcc-4.0.2/gcc/ada/styleg-c.ads	Tue Oct 21 13:42:22 2003
--- gcc-4.1.0/gcc/ada/styleg-c.ads	Mon Sep  5 07:50:46 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 28,35 ****
  --  used by the compiler for style checking. These routines are in a separate
  --  package because they depend on the GNAT tree (Atree, Sinfo, ...).
  
- with Types;  use Types;
- 
  generic
     with procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id);
     --  Output a message at the Sloc of the given node
--- 28,33 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/styleg.adb gcc-4.1.0/gcc/ada/styleg.adb
*** gcc-4.0.2/gcc/ada/styleg.adb	Fri Nov 19 10:56:53 2004
--- gcc-4.1.0/gcc/ada/styleg.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Styleg is
*** 40,45 ****
--- 40,55 ----
  
     use ASCII;
  
+    Blank_Lines : Nat := 0;
+    --  Counts number of empty lines seen. Reset to zero if a non-empty line
+    --  is encountered. Used to check for trailing blank lines in Check_EOF,
+    --  and for multiple blank lines.
+ 
+    Blank_Line_Location : Source_Ptr;
+    --  Remembers location of first blank line in a series. Used to issue an
+    --  appropriate diagnostic if subsequent blank lines or the end of file
+    --  is encountered.
+ 
     -----------------------
     -- Local Subprograms --
     -----------------------
*************** package body Styleg is
*** 129,135 ****
  
     procedure Check_Attribute_Name (Reserved : Boolean) is
        pragma Warnings (Off, Reserved);
- 
     begin
        if Style_Check_Attribute_Casing then
           if Determine_Token_Casing /= Mixed_Case then
--- 139,144 ----
*************** package body Styleg is
*** 265,270 ****
--- 274,281 ----
           S : Source_Ptr;
  
        begin
+          --  Do we need to worry about UTF_32 line terminators here ???
+ 
           S := Scan_Ptr + 3;
           while Source (S) not in Line_Terminator loop
              S := S + 1;
*************** package body Styleg is
*** 397,402 ****
--- 408,438 ----
        end if;
     end Check_Dot_Dot;
  
+    ---------------
+    -- Check_EOF --
+    ---------------
+ 
+    --  In check blanks at end mode, check no blank lines precede the EOF
+ 
+    procedure Check_EOF is
+    begin
+       if Style_Check_Blank_Lines then
+ 
+          --  We expect one blank line, from the EOF, but no more than one
+ 
+          if Blank_Lines = 2 then
+             Error_Msg
+               ("(style) blank line not allowed at end of file",
+                Blank_Line_Location);
+ 
+          elsif Blank_Lines >= 3 then
+             Error_Msg
+               ("(style) blank lines not allowed at end of file",
+                Blank_Line_Location);
+          end if;
+       end if;
+    end Check_EOF;
+ 
     -----------------------------------
     -- Check_Exponentiation_Operator --
     -----------------------------------
*************** package body Styleg is
*** 462,531 ****
     end Check_Left_Paren;
  
     ---------------------------
     -- Check_Line_Terminator --
     ---------------------------
  
     --  In check blanks at end mode (-gnatyb), lines may not end with a
     --  trailing space.
  
-    --  In check max line length mode (-gnatym), the line length must
-    --  not exceed the permitted maximum value.
- 
     --  In check form feeds mode (-gnatyf), the line terminator may not
     --  be either of the characters FF or VT.
  
     procedure Check_Line_Terminator (Len : Int) is
        S : Source_Ptr;
  
     begin
        --  Check FF/VT terminators
  
        if Style_Check_Form_Feeds then
           if Source (Scan_Ptr) = ASCII.FF then
              Error_Msg_S ("(style) form feed not allowed");
- 
           elsif Source (Scan_Ptr) = ASCII.VT then
              Error_Msg_S ("(style) vertical tab not allowed");
           end if;
        end if;
  
!       --  We are now possibly going to check for trailing spaces and maximum
!       --  line length. There is no point in doing this if the current line is
!       --  empty. It is actually wrong in the case of trailing spaces, because
!       --  we scan backwards for this purpose, so we would end up looking at a
!       --  different line, or even at invalid buffer locations if we have the
!       --  first source line at hand.
  
!       if Len = 0 then
!          return;
        end if;
  
!       --  Check trailing space
  
!       if Style_Check_Blanks_At_End then
!          if Scan_Ptr >= First_Non_Blank_Location then
!             if Is_White_Space (Source (Scan_Ptr - 1)) then
!                S := Scan_Ptr - 1;
  
!                while Is_White_Space (Source (S - 1)) loop
!                   S := S - 1;
!                end loop;
  
!                Error_Msg ("(style) trailing spaces not permitted", S);
!             end if;
!          end if;
        end if;
  
!       --  Check max line length
  
!       if Style_Check_Max_Line_Length then
!          if Len > Style_Max_Line_Length then
              Error_Msg
!               ("(style) this line is too long",
!                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
           end if;
-       end if;
  
     end Check_Line_Terminator;
  
     --------------------------
--- 498,611 ----
     end Check_Left_Paren;
  
     ---------------------------
+    -- Check_Line_Max_Length --
+    ---------------------------
+ 
+    --  In check max line length mode (-gnatym), the line length must
+    --  not exceed the permitted maximum value.
+ 
+    procedure Check_Line_Max_Length (Len : Int) is
+    begin
+       if Style_Check_Max_Line_Length then
+          if Len > Style_Max_Line_Length then
+             Error_Msg
+               ("(style) this line is too long",
+                Current_Line_Start + Source_Ptr (Style_Max_Line_Length));
+          end if;
+       end if;
+    end Check_Line_Max_Length;
+ 
+    ---------------------------
     -- Check_Line_Terminator --
     ---------------------------
  
     --  In check blanks at end mode (-gnatyb), lines may not end with a
     --  trailing space.
  
     --  In check form feeds mode (-gnatyf), the line terminator may not
     --  be either of the characters FF or VT.
  
+    --  In check DOS line terminators node (-gnatyd), the line terminator
+    --  must be a single LF, without a following CR.
+ 
     procedure Check_Line_Terminator (Len : Int) is
        S : Source_Ptr;
  
+       L : Int := Len;
+       --  Length of line (adjusted down for blanks at end of line)
+ 
     begin
+       --  Reset count of blank lines if first line
+ 
+       if Get_Logical_Line_Number (Scan_Ptr) = 1 then
+          Blank_Lines := 0;
+       end if;
+ 
        --  Check FF/VT terminators
  
        if Style_Check_Form_Feeds then
           if Source (Scan_Ptr) = ASCII.FF then
              Error_Msg_S ("(style) form feed not allowed");
           elsif Source (Scan_Ptr) = ASCII.VT then
              Error_Msg_S ("(style) vertical tab not allowed");
           end if;
        end if;
  
!       --  Check DOS line terminator (ignore EOF, since we only get called
!       --  with an EOF if it is the last character in the buffer, and was
!       --  therefore not present in the sources
  
!       if Style_Check_DOS_Line_Terminator then
!          if Source (Scan_Ptr) = EOF then
!             null;
!          elsif Source (Scan_Ptr) /= LF
!            or else Source (Scan_Ptr + 1) = CR
!          then
!             Error_Msg_S ("(style) incorrect line terminator");
!          end if;
        end if;
  
!       --  Remove trailing spaces
  
!       S := Scan_Ptr;
!       while L > 0 and then Is_White_Space (Source (S - 1)) loop
!          S := S - 1;
!          L := L - 1;
!       end loop;
  
!       --  Issue message for blanks at end of line if option enabled
  
!       if Style_Check_Blanks_At_End and then L < Len then
!          Error_Msg
!            ("(style) trailing spaces not permitted", S);
        end if;
  
!       --  Deal with empty (blank) line
  
!       if L = 0 then
! 
!          --  Increment blank line count
! 
!          Blank_Lines := Blank_Lines + 1;
! 
!          --  If first blank line, record location for later error message
! 
!          if Blank_Lines = 1 then
!             Blank_Line_Location := Scan_Ptr;
!          end if;
! 
!       --  Non-blank line, check for previous multiple blank lines
! 
!       else
!          if Style_Check_Blank_Lines and then Blank_Lines > 1 then
              Error_Msg
!               ("(style) multiple blank lines", Blank_Line_Location);
           end if;
  
+          --  And reset blank line count
+ 
+          Blank_Lines := 0;
+       end if;
     end Check_Line_Terminator;
  
     --------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/styleg.ads gcc-4.1.0/gcc/ada/styleg.ads
*** gcc-4.0.2/gcc/ada/styleg.ads	Fri Nov 19 10:56:53 2004
--- gcc-4.1.0/gcc/ada/styleg.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Styleg is
*** 92,97 ****
--- 92,100 ----
     procedure Check_Dot_Dot;
     --  Called after scanning out dot dot to check spacing
  
+    procedure Check_EOF;
+    --  Called after scanning out EOF mark
+ 
     procedure Check_HT;
     --  Called with Scan_Ptr pointing to a horizontal tab character
  
*************** package Styleg is
*** 102,121 ****
     --  Token_Ptr is the first token on the line.
  
     procedure Check_Left_Paren;
!    --  Called after scanning out a left parenthesis to check spacing.
  
     procedure Check_Line_Terminator (Len : Int);
     --  Called with Scan_Ptr pointing to the first line terminator terminating
!    --  the current line, used to check for appropriate line terminator and
!    --  to check the line length (Len is the length of the current line).
!    --  Note that the terminator may be the EOF character.
  
     procedure Check_Pragma_Name;
     --  The current token is a pragma identifier. Check that it is spelled
     --  properly (i.e. with an appropriate casing convention).
  
     procedure Check_Right_Paren;
!    --  Called after scanning out a right parenthesis to check spacing.
  
     procedure Check_Semicolon;
     --  Called after scanning out a semicolon to check spacing
--- 105,128 ----
     --  Token_Ptr is the first token on the line.
  
     procedure Check_Left_Paren;
!    --  Called after scanning out a left parenthesis to check spacing
! 
!    procedure Check_Line_Max_Length (Len : Int);
!    --  Called with Scan_Ptr pointing to the first line terminator character
!    --  terminating the current line. Used to check for appropriate line length.
!    --  The parameter Len is the length of the current line.
  
     procedure Check_Line_Terminator (Len : Int);
     --  Called with Scan_Ptr pointing to the first line terminator terminating
!    --  the current line, used to check for appropriate line terminator usage.
!    --  The parameter Len is the length of the current line.
  
     procedure Check_Pragma_Name;
     --  The current token is a pragma identifier. Check that it is spelled
     --  properly (i.e. with an appropriate casing convention).
  
     procedure Check_Right_Paren;
!    --  Called after scanning out a right parenthesis to check spacing
  
     procedure Check_Semicolon;
     --  Called after scanning out a semicolon to check spacing
diff -Nrcpad gcc-4.0.2/gcc/ada/stylesw.adb gcc-4.1.0/gcc/ada/stylesw.adb
*** gcc-4.0.2/gcc/ada/stylesw.adb	Thu Nov 25 13:07:56 2004
--- gcc-4.1.0/gcc/ada/stylesw.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Stylesw is
*** 34,58 ****
  
     procedure Reset_Style_Check_Options is
     begin
!       Style_Check_Indentation       := 0;
!       Style_Check_Attribute_Casing  := False;
!       Style_Check_Blanks_At_End     := False;
!       Style_Check_Comments          := False;
!       Style_Check_End_Labels        := False;
!       Style_Check_Form_Feeds        := False;
!       Style_Check_Horizontal_Tabs   := False;
!       Style_Check_If_Then_Layout    := False;
!       Style_Check_Keyword_Casing    := False;
!       Style_Check_Layout            := False;
!       Style_Check_Max_Line_Length   := False;
!       Style_Check_Max_Nesting_Level := False;
!       Style_Check_Order_Subprograms := False;
!       Style_Check_Pragma_Casing     := False;
!       Style_Check_References        := False;
!       Style_Check_Specs             := False;
!       Style_Check_Standard          := False;
!       Style_Check_Tokens            := False;
!       Style_Check_Xtra_Parens       := False;
     end Reset_Style_Check_Options;
  
     ------------------------------
--- 34,60 ----
  
     procedure Reset_Style_Check_Options is
     begin
!       Style_Check_Indentation         := 0;
!       Style_Check_Attribute_Casing    := False;
!       Style_Check_Blanks_At_End       := False;
!       Style_Check_Blank_Lines         := False;
!       Style_Check_Comments            := False;
!       Style_Check_DOS_Line_Terminator := False;
!       Style_Check_End_Labels          := False;
!       Style_Check_Form_Feeds          := False;
!       Style_Check_Horizontal_Tabs     := False;
!       Style_Check_If_Then_Layout      := False;
!       Style_Check_Keyword_Casing      := False;
!       Style_Check_Layout              := False;
!       Style_Check_Max_Line_Length     := False;
!       Style_Check_Max_Nesting_Level   := False;
!       Style_Check_Order_Subprograms   := False;
!       Style_Check_Pragma_Casing       := False;
!       Style_Check_References          := False;
!       Style_Check_Specs               := False;
!       Style_Check_Standard            := False;
!       Style_Check_Tokens              := False;
!       Style_Check_Xtra_Parens         := False;
     end Reset_Style_Check_Options;
  
     ------------------------------
*************** package body Stylesw is
*** 107,112 ****
--- 109,115 ----
        Add ('a', Style_Check_Attribute_Casing);
        Add ('b', Style_Check_Blanks_At_End);
        Add ('c', Style_Check_Comments);
+       Add ('d', Style_Check_DOS_Line_Terminator);
        Add ('e', Style_Check_End_Labels);
        Add ('f', Style_Check_Form_Feeds);
        Add ('h', Style_Check_Horizontal_Tabs);
*************** package body Stylesw is
*** 119,124 ****
--- 122,128 ----
        Add ('r', Style_Check_References);
        Add ('s', Style_Check_Specs);
        Add ('t', Style_Check_Tokens);
+       Add ('u', Style_Check_Blank_Lines);
        Add ('x', Style_Check_Xtra_Parens);
  
        if Style_Check_Max_Line_Length then
*************** package body Stylesw is
*** 186,216 ****
                    := Character'Pos (C) - Character'Pos ('0');
  
              when 'a' =>
!                Style_Check_Attribute_Casing  := True;
  
              when 'b' =>
!                Style_Check_Blanks_At_End     := True;
  
              when 'c' =>
!                Style_Check_Comments          := True;
  
              when 'e' =>
!                Style_Check_End_Labels        := True;
  
              when 'f' =>
!                Style_Check_Form_Feeds        := True;
  
              when 'h' =>
!                Style_Check_Horizontal_Tabs   := True;
  
              when 'i' =>
!                Style_Check_If_Then_Layout    := True;
  
              when 'k' =>
!                Style_Check_Keyword_Casing    := True;
  
              when 'l' =>
!                Style_Check_Layout            := True;
  
              when 'L' =>
                 Style_Max_Nesting_Level := 0;
--- 190,223 ----
                    := Character'Pos (C) - Character'Pos ('0');
  
              when 'a' =>
!                Style_Check_Attribute_Casing    := True;
  
              when 'b' =>
!                Style_Check_Blanks_At_End       := True;
  
              when 'c' =>
!                Style_Check_Comments            := True;
! 
!             when 'd' =>
!                Style_Check_DOS_Line_Terminator := True;
  
              when 'e' =>
!                Style_Check_End_Labels          := True;
  
              when 'f' =>
!                Style_Check_Form_Feeds          := True;
  
              when 'h' =>
!                Style_Check_Horizontal_Tabs     := True;
  
              when 'i' =>
!                Style_Check_If_Then_Layout      := True;
  
              when 'k' =>
!                Style_Check_Keyword_Casing      := True;
  
              when 'l' =>
!                Style_Check_Layout              := True;
  
              when 'L' =>
                 Style_Max_Nesting_Level := 0;
*************** package body Stylesw is
*** 242,252 ****
                 Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
  
              when 'm' =>
!                Style_Check_Max_Line_Length   := True;
!                Style_Max_Line_Length         := 79;
  
              when 'n' =>
!                Style_Check_Standard          := True;
  
              when 'N' =>
                 Reset_Style_Check_Options;
--- 249,259 ----
                 Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
  
              when 'm' =>
!                Style_Check_Max_Line_Length     := True;
!                Style_Max_Line_Length           := 79;
  
              when 'n' =>
!                Style_Check_Standard            := True;
  
              when 'N' =>
                 Reset_Style_Check_Options;
*************** package body Stylesw is
*** 281,302 ****
                 Style_Check_Max_Line_Length   := Style_Max_Line_Length /= 0;
  
              when 'o' =>
!                Style_Check_Order_Subprograms := True;
  
              when 'p' =>
!                Style_Check_Pragma_Casing     := True;
  
              when 'r' =>
!                Style_Check_References        := True;
  
              when 's' =>
!                Style_Check_Specs             := True;
  
              when 't' =>
!                Style_Check_Tokens            := True;
  
              when 'x' =>
!                Style_Check_Xtra_Parens       := True;
  
              when ' ' =>
                 null;
--- 288,312 ----
                 Style_Check_Max_Line_Length   := Style_Max_Line_Length /= 0;
  
              when 'o' =>
!                Style_Check_Order_Subprograms   := True;
  
              when 'p' =>
!                Style_Check_Pragma_Casing       := True;
  
              when 'r' =>
!                Style_Check_References          := True;
  
              when 's' =>
!                Style_Check_Specs               := True;
  
              when 't' =>
!                Style_Check_Tokens              := True;
! 
!             when 'u' =>
!                Style_Check_Blank_Lines         := True;
  
              when 'x' =>
!                Style_Check_Xtra_Parens         := True;
  
              when ' ' =>
                 null;
diff -Nrcpad gcc-4.0.2/gcc/ada/stylesw.ads gcc-4.1.0/gcc/ada/stylesw.ads
*** gcc-4.0.2/gcc/ada/stylesw.ads	Fri Nov 19 10:56:53 2004
--- gcc-4.1.0/gcc/ada/stylesw.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Stylesw is
*** 56,61 ****
--- 56,66 ----
     --  This can be set True by using the -gnatg or -gnatyb switches. If
     --  it is True, then spaces at the end of lines are not permitted.
  
+    Style_Check_Blank_Lines : Boolean := False;
+    --  This can be set True by using the -gnatg or -gnatyu switches. If
+    --  it is True, then multiple blank lines are not permitted, and there
+    --  may not be a blank line at the end of the file.
+ 
     Style_Check_Comments : Boolean := False;
     --  This can be set True by using the -gnatg or -gnatyc switches. If
     --  it is True, then comments are style checked as follows:
*************** package Stylesw is
*** 84,89 ****
--- 89,99 ----
     --  Note: the reason for the last two conditions is to allow "boxed"
     --  comments where only a single space separates the comment characters.
  
+    Style_Check_DOS_Line_Terminator : Boolean := False;
+    --  This can be set true by using the -gnatg or -gnatyd switches. If
+    --  it is True, then the line terminator must be a single LF, without an
+    --  associated CR (e.g. DOS line terminator sequence CR/LF not allowed).
+ 
     Style_Check_End_Labels : Boolean := False;
     --  This can be set True by using the -gnatg or -gnatye switches. If
     --  it is True, then optional END labels must always be present.
*************** package Stylesw is
*** 242,248 ****
  
     procedure Set_Default_Style_Check_Options;
     --  This procedure is called to set the default style checking options
!    --  in response to a -gnatg switch or -gnaty with no suboptions.
  
     procedure Set_Style_Check_Options
       (Options  : String;
--- 252,258 ----
  
     procedure Set_Default_Style_Check_Options;
     --  This procedure is called to set the default style checking options
!    --  in response to a -gnaty switch with no suboptions.
  
     procedure Set_Style_Check_Options
       (Options  : String;
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-b.adb gcc-4.1.0/gcc/ada/switch-b.adb
*** gcc-4.0.2/gcc/ada/switch-b.adb	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/switch-b.adb	Tue Nov 15 14:04:56 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Switch.B is
*** 45,51 ****
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          raise Bad_Switch;
        else
           Ptr := Ptr + 1;
        end if;
--- 45,51 ----
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          Bad_Switch (C);
        else
           Ptr := Ptr + 1;
        end if;
*************** package body Switch.B is
*** 67,77 ****
  
           case C is
  
           --  Processing for A switch
  
           when 'A' =>
              Ptr := Ptr + 1;
- 
              Ada_Bind_File := True;
  
           --  Processing for b switch
--- 67,82 ----
  
           case C is
  
+          --  Processing for a switch
+ 
+          when 'a' =>
+             Ptr := Ptr + 1;
+             Use_Pragma_Linker_Constructor := True;
+ 
           --  Processing for A switch
  
           when 'A' =>
              Ptr := Ptr + 1;
              Ada_Bind_File := True;
  
           --  Processing for b switch
*************** package body Switch.B is
*** 117,141 ****
                 then
                    Set_Debug_Flag (C);
                 else
!                   raise Bad_Switch;
                 end if;
              end loop;
  
-             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-             --  is for backwards compatibility with old versions and usage.
- 
-             if Debug_Flag_XX then
-                Zero_Cost_Exceptions_Set := True;
-                Zero_Cost_Exceptions_Val := True;
-             end if;
- 
              return;
  
           --  Processing for D switch
  
           when 'D' =>
              Ptr := Ptr + 1;
!             Scan_Pos (Switch_Chars, Max, Ptr, Default_Sec_Stack_Size);
  
           --  Processing for e switch
  
--- 122,139 ----
                 then
                    Set_Debug_Flag (C);
                 else
!                   Bad_Switch (C);
                 end if;
              end loop;
  
              return;
  
           --  Processing for D switch
  
           when 'D' =>
              Ptr := Ptr + 1;
!             Scan_Pos
!               (Switch_Chars, Max, Ptr, Default_Sec_Stack_Size, C);
  
           --  Processing for e switch
  
*************** package body Switch.B is
*** 149,160 ****
              Ptr := Ptr + 1;
              Exception_Tracebacks := True;
  
-          --  Processing for f switch
- 
-          when 'f' =>
-             Ptr := Ptr + 1;
-             Force_RM_Elaboration_Order := True;
- 
           --  Processing for F switch
  
           when 'F' =>
--- 147,152 ----
*************** package body Switch.B is
*** 190,196 ****
  
           when 'i' =>
              if Ptr = Max then
!                raise Bad_Switch;
              end if;
  
              Ptr := Ptr + 1;
--- 182,188 ----
  
           when 'i' =>
              if Ptr = Max then
!                Bad_Switch (C);
              end if;
  
              Ptr := Ptr + 1;
*************** package body Switch.B is
*** 206,212 ****
                 Identifier_Character_Set := C;
                 Ptr := Ptr + 1;
              else
!                raise Bad_Switch;
              end if;
  
           --  Processing for K switch
--- 198,204 ----
                 Identifier_Character_Set := C;
                 Ptr := Ptr + 1;
              else
!                Bad_Switch (C);
              end if;
  
           --  Processing for K switch
*************** package body Switch.B is
*** 225,231 ****
  
           when 'm' =>
              Ptr := Ptr + 1;
!             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
  
           --  Processing for n switch
  
--- 217,223 ----
  
           when 'm' =>
              Ptr := Ptr + 1;
!             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors, C);
  
           --  Processing for n switch
  
*************** package body Switch.B is
*** 243,249 ****
              Ptr := Ptr + 1;
  
              if Output_File_Name_Present then
!                raise Too_Many_Output_Files;
  
              else
                 Output_File_Name_Present := True;
--- 235,241 ----
              Ptr := Ptr + 1;
  
              if Output_File_Name_Present then
!                Osint.Fail ("duplicate -o switch");
  
              else
                 Output_File_Name_Present := True;
*************** package body Switch.B is
*** 291,297 ****
           when 'T' =>
              Ptr := Ptr + 1;
              Time_Slice_Set := True;
!             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
              Time_Slice_Value := Time_Slice_Value * 1_000;
  
           --  Processing for v switch
--- 283,289 ----
           when 'T' =>
              Ptr := Ptr + 1;
              Time_Slice_Set := True;
!             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
              Time_Slice_Value := Time_Slice_Value * 1_000;
  
           --  Processing for v switch
*************** package body Switch.B is
*** 317,323 ****
                    Warning_Mode  := Suppress;
  
                 when others =>
!                   raise Bad_Switch;
              end case;
  
              Ptr := Ptr + 1;
--- 309,315 ----
                    Warning_Mode  := Suppress;
  
                 when others =>
!                   Bad_Switch (C);
              end case;
  
              Ptr := Ptr + 1;
*************** package body Switch.B is
*** 333,339 ****
                    exit;
  
                 elsif J = WC_Encoding_Method'Last then
!                   raise Bad_Switch;
                 end if;
              end loop;
  
--- 325,331 ----
                    exit;
  
                 elsif J = WC_Encoding_Method'Last then
!                   Bad_Switch (C);
                 end if;
              end loop;
  
*************** package body Switch.B is
*** 354,360 ****
  
           when 'X' =>
              Ptr := Ptr + 1;
!             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status);
  
           --  Processing for z switch
  
--- 346,352 ----
  
           when 'X' =>
              Ptr := Ptr + 1;
!             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
  
           --  Processing for z switch
  
*************** package body Switch.B is
*** 411,417 ****
                          RTS_Src_Path_Name := Src_Path_Name;
                          RTS_Lib_Path_Name := Lib_Path_Name;
  
!                         --  We can exit as there can not be another switch
                          --  after --RTS
  
                          exit;
--- 403,409 ----
                          RTS_Src_Path_Name := Src_Path_Name;
                          RTS_Lib_Path_Name := Lib_Path_Name;
  
!                         --  We can exit as there cannot be another switch
                          --  after --RTS
  
                          exit;
*************** package body Switch.B is
*** 438,459 ****
           --  Anything else is an error (illegal switch character)
  
           when others =>
!             raise Bad_Switch;
           end case;
        end loop;
- 
-    exception
-       when Bad_Switch =>
-          Osint.Fail ("invalid switch: ", (1 => C));
- 
-       when Bad_Switch_Value =>
-          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
- 
-       when Missing_Switch_Value =>
-          Osint.Fail ("missing numeric value for switch: ", (1 => C));
- 
-       when Too_Many_Output_Files =>
-          Osint.Fail ("duplicate -o switch");
     end Scan_Binder_Switches;
  
  end Switch.B;
--- 430,438 ----
           --  Anything else is an error (illegal switch character)
  
           when others =>
!             Bad_Switch (C);
           end case;
        end loop;
     end Scan_Binder_Switches;
  
  end Switch.B;
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-b.ads gcc-4.1.0/gcc/ada/switch-b.ads
*** gcc-4.0.2/gcc/ada/switch-b.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/switch-b.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-c.adb gcc-4.1.0/gcc/ada/switch-c.adb
*** gcc-4.0.2/gcc/ada/switch-c.adb	Fri Jun 25 16:39:33 2004
--- gcc-4.1.0/gcc/ada/switch-c.adb	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Lib;      use Lib;
*** 31,38 ****
  with Osint;    use Osint;
  with Opt;      use Opt;
  with Prepcomp; use Prepcomp;
- with Types;    use Types;
  with Validsw;  use Validsw;
  with Stylesw;  use Stylesw;
  
  with System.WCh_Con; use System.WCh_Con;
--- 31,38 ----
  with Osint;    use Osint;
  with Opt;      use Opt;
  with Prepcomp; use Prepcomp;
  with Validsw;  use Validsw;
+ with Sem_Warn; use Sem_Warn;
  with Stylesw;  use Stylesw;
  
  with System.WCh_Con; use System.WCh_Con;
*************** package body Switch.C is
*** 68,74 ****
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          raise Bad_Switch;
        else
           Ptr := Ptr + 1;
        end if;
--- 68,74 ----
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          Bad_Switch (C);
        else
           Ptr := Ptr + 1;
        end if;
*************** package body Switch.C is
*** 105,111 ****
                    Ptr := Ptr + 1;
  
                    if Ptr > Max then
!                      raise Bad_Switch;
                    end if;
  
                    --  Find out whether this is a -I- or regular -Ixxx switch
--- 105,111 ----
                    Ptr := Ptr + 1;
  
                    if Ptr > Max then
!                      Bad_Switch (C);
                    end if;
  
                    --  Find out whether this is a -I- or regular -Ixxx switch
*************** package body Switch.C is
*** 180,186 ****
                       end if;
                    end if;
                 else
!                   raise Bad_Switch;
                 end if;
  
           when True =>
--- 180,186 ----
                       end if;
                    end if;
                 else
!                   Bad_Switch (C);
                 end if;
  
           when True =>
*************** package body Switch.C is
*** 192,197 ****
--- 192,198 ----
              when 'a' =>
                 Ptr := Ptr + 1;
                 Assertions_Enabled := True;
+                Debug_Pragmas_Enabled := True;
  
              --  Processing for A switch
  
*************** package body Switch.C is
*** 261,278 ****
                       Dot := True;
  
                    else
!                      raise Bad_Switch;
                    end if;
                 end loop;
  
-                --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-                --  is for backwards compatibility with old versions and usage.
- 
-                if Debug_Flag_XX then
-                   Zero_Cost_Exceptions_Set := True;
-                   Zero_Cost_Exceptions_Val := True;
-                end if;
- 
                 return;
  
              --  Processing for D switch
--- 262,271 ----
                       Dot := True;
  
                    else
!                      Bad_Switch (C);
                    end if;
                 end loop;
  
                 return;
  
              --  Processing for D switch
*************** package body Switch.C is
*** 297,303 ****
                 --  so we must always have a character after the e.
  
                 if Ptr > Max then
!                   raise Bad_Switch;
                 end if;
  
                 case Switch_Chars (Ptr) is
--- 290,296 ----
                 --  so we must always have a character after the e.
  
                 if Ptr > Max then
!                   Bad_Switch (C);
                 end if;
  
                 case Switch_Chars (Ptr) is
*************** package body Switch.C is
*** 316,322 ****
                       end if;
  
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       declare
--- 309,315 ----
                       end if;
  
                       if Ptr > Max then
!                         Bad_Switch (C);
                       end if;
  
                       declare
*************** package body Switch.C is
*** 359,365 ****
                       Ptr := Ptr + 1;
  
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
--- 352,358 ----
                       Ptr := Ptr + 1;
  
                       if Ptr > Max then
!                         Bad_Switch (C);
                       end if;
  
                       Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
*************** package body Switch.C is
*** 386,392 ****
  
                    when 'I' =>
                       Ptr := Ptr + 1;
!                      Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index);
  
                    --  -gnatem (mapping file)
  
--- 379,386 ----
  
                    when 'I' =>
                       Ptr := Ptr + 1;
!                      Scan_Pos
!                        (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
  
                    --  -gnatem (mapping file)
  
*************** package body Switch.C is
*** 402,408 ****
                       end if;
  
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       Mapping_File_Name :=
--- 396,402 ----
                       end if;
  
                       if Ptr > Max then
!                         Bad_Switch (C);
                       end if;
  
                       Mapping_File_Name :=
*************** package body Switch.C is
*** 423,429 ****
                       end if;
  
                       if Ptr > Max then
!                         raise Bad_Switch;
                       end if;
  
                       Preprocessing_Data_File :=
--- 417,423 ----
                       end if;
  
                       if Ptr > Max then
!                         Bad_Switch (C);
                       end if;
  
                       Preprocessing_Data_File :=
*************** package body Switch.C is
*** 454,460 ****
                    --  All other -gnate? switches are unassigned
  
                    when others =>
!                      raise Bad_Switch;
                 end case;
  
              --  -gnatE (dynamic elaboration checks)
--- 448,454 ----
                    --  All other -gnate? switches are unassigned
  
                    when others =>
!                      Bad_Switch (C);
                 end case;
  
              --  -gnatE (dynamic elaboration checks)
*************** package body Switch.C is
*** 485,491 ****
                 System_Extend_Unit := Empty;
                 Warning_Mode := Treat_As_Error;
  
!                --  Set default warnings (basically -gnatwa)
  
                 Check_Unreferenced           := True;
                 Check_Unreferenced_Formals   := True;
--- 479,492 ----
                 System_Extend_Unit := Empty;
                 Warning_Mode := Treat_As_Error;
  
!                --  Set Ada 2005 mode explicitly. We don't want to rely on the
!                --  implicit setting here, since for example, we want
!                --  Preelaborate_05 treated as Preelaborate
! 
!                Ada_Version := Ada_05;
!                Ada_Version_Explicit := Ada_Version;
! 
!                --  Set default warnings for -gnatg (same set as -gnatwa)
  
                 Check_Unreferenced           := True;
                 Check_Unreferenced_Formals   := True;
*************** package body Switch.C is
*** 493,498 ****
--- 494,500 ----
                 Constant_Condition_Warnings  := True;
                 Implementation_Unit_Warnings := True;
                 Ineffective_Inline_Warnings  := True;
+                Warn_On_Bad_Fixed_Value      := True;
                 Warn_On_Constant             := True;
                 Warn_On_Export_Import        := True;
                 Warn_On_Modified_Unread      := True;
*************** package body Switch.C is
*** 502,508 ****
                 Warn_On_Unchecked_Conversion := True;
                 Warn_On_Unrecognized_Pragma  := True;
  
!                Set_Default_Style_Check_Options;
  
              --  Processing for G switch
  
--- 504,510 ----
                 Warn_On_Unchecked_Conversion := True;
                 Warn_On_Unrecognized_Pragma  := True;
  
!                Set_Style_Check_Options ("3abcdefhiklmnprstux");
  
              --  Processing for G switch
  
*************** package body Switch.C is
*** 526,532 ****
  
              when 'i' =>
                 if Ptr = Max then
!                   raise Bad_Switch;
                 end if;
  
                 Ptr := Ptr + 1;
--- 528,534 ----
  
              when 'i' =>
                 if Ptr = Max then
!                   Bad_Switch (C);
                 end if;
  
                 Ptr := Ptr + 1;
*************** package body Switch.C is
*** 544,557 ****
                    Ptr := Ptr + 1;
  
                 else
!                   raise Bad_Switch;
                 end if;
  
              --  Processing for k switch
  
              when 'k' =>
                 Ptr := Ptr + 1;
!                Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
  
              --  Processing for l switch
  
--- 546,560 ----
                    Ptr := Ptr + 1;
  
                 else
!                   Bad_Switch (C);
                 end if;
  
              --  Processing for k switch
  
              when 'k' =>
                 Ptr := Ptr + 1;
!                   Scan_Pos
!                     (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
  
              --  Processing for l switch
  
*************** package body Switch.C is
*** 563,576 ****
  
              when 'L' =>
                 Ptr := Ptr + 1;
!                Zero_Cost_Exceptions_Set := True;
!                Zero_Cost_Exceptions_Val := False;
  
              --  Processing for m switch
  
              when 'm' =>
                 Ptr := Ptr + 1;
!                Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
  
              --  Processing for n switch
  
--- 566,586 ----
  
              when 'L' =>
                 Ptr := Ptr + 1;
!                Osint.Fail
!                  ("-gnatL is no longer supported: consider using --RTS=sjlj");
  
              --  Processing for m switch
  
              when 'm' =>
                 Ptr := Ptr + 1;
! 
!                --  There may be an equal sign between -gnatm and the value
! 
!                if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
!                   Ptr := Ptr + 1;
!                end if;
! 
!                Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors, C);
  
              --  Processing for n switch
  
*************** package body Switch.C is
*** 603,609 ****
  
              when 'p' =>
                 Ptr := Ptr + 1;
!                Suppress_Options           := (others => True);
                 Validity_Checks_On         := False;
                 Opt.Suppress_Checks        := True;
                 Opt.Enable_Overflow_Checks := False;
--- 613,630 ----
  
              when 'p' =>
                 Ptr := Ptr + 1;
! 
!                --  Set all specific options as well as All_Checks in the
!                --  Suppress_Options array, excluding Elaboration_Check, since
!                --  this is treated specially because we do not want -gnatp to
!                --  disable static elaboration processing.
! 
!                for J in Suppress_Options'Range loop
!                   if J /= Elaboration_Check then
!                      Suppress_Options (J) := True;
!                   end if;
!                end loop;
! 
                 Validity_Checks_On         := False;
                 Opt.Suppress_Checks        := True;
                 Opt.Enable_Overflow_Checks := False;
*************** package body Switch.C is
*** 648,654 ****
                       List_Representation_Info_Mechanisms := True;
  
                    else
!                      raise Bad_Switch;
                    end if;
  
                    Ptr := Ptr + 1;
--- 669,675 ----
                       List_Representation_Info_Mechanisms := True;
  
                    else
!                      Bad_Switch (C);
                    end if;
  
                    Ptr := Ptr + 1;
*************** package body Switch.C is
*** 687,693 ****
  
              when 'T' =>
                 Ptr := Ptr + 1;
!                Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
  
              --  Processing for u switch
  
--- 708,714 ----
  
              when 'T' =>
                 Ptr := Ptr + 1;
!                Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
  
              --  Processing for u switch
  
*************** package body Switch.C is
*** 715,721 ****
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   raise Bad_Switch;
  
                 else
                    declare
--- 736,742 ----
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   Bad_Switch (C);
  
                 else
                    declare
*************** package body Switch.C is
*** 726,732 ****
                         (Switch_Chars (Ptr .. Max), OK, Ptr);
  
                       if not OK then
!                         raise Bad_Switch;
                       end if;
  
                       for Index in First_Char + 1 .. Max loop
--- 747,753 ----
                         (Switch_Chars (Ptr .. Max), OK, Ptr);
  
                       if not OK then
!                         Bad_Switch (C);
                       end if;
  
                       for Index in First_Char + 1 .. Max loop
*************** package body Switch.C is
*** 748,919 ****
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   raise Bad_Switch;
                 end if;
  
                 while Ptr <= Max loop
                    C := Switch_Chars (Ptr);
  
!                   case C is
!                      when 'a' =>
!                         Check_Unreferenced              := True;
!                         Check_Unreferenced_Formals      := True;
!                         Check_Withs                     := True;
!                         Constant_Condition_Warnings     := True;
!                         Implementation_Unit_Warnings    := True;
!                         Ineffective_Inline_Warnings     := True;
!                         Warn_On_Constant                := True;
!                         Warn_On_Export_Import           := True;
!                         Warn_On_Modified_Unread         := True;
!                         Warn_On_No_Value_Assigned       := True;
!                         Warn_On_Obsolescent_Feature     := True;
!                         Warn_On_Redundant_Constructs    := True;
!                         Warn_On_Unchecked_Conversion    := True;
!                         Warn_On_Unrecognized_Pragma     := True;
! 
!                      when 'A' =>
!                         Check_Unreferenced              := False;
!                         Check_Unreferenced_Formals      := False;
!                         Check_Withs                     := False;
!                         Constant_Condition_Warnings     := False;
!                         Elab_Warnings                   := False;
!                         Implementation_Unit_Warnings    := False;
!                         Ineffective_Inline_Warnings     := False;
!                         Warn_On_Constant                := False;
!                         Warn_On_Dereference             := False;
!                         Warn_On_Export_Import           := False;
!                         Warn_On_Hiding                  := False;
!                         Warn_On_Modified_Unread         := False;
!                         Warn_On_No_Value_Assigned       := False;
!                         Warn_On_Obsolescent_Feature     := False;
!                         Warn_On_Redundant_Constructs    := False;
!                         Warn_On_Unchecked_Conversion    := False;
!                         Warn_On_Unrecognized_Pragma     := False;
! 
!                      when 'c' =>
!                         Constant_Condition_Warnings     := True;
! 
!                      when 'C' =>
!                         Constant_Condition_Warnings     := False;
! 
!                      when 'd' =>
!                         Warn_On_Dereference             := True;
! 
!                      when 'D' =>
!                         Warn_On_Dereference             := False;
! 
!                      when 'e' =>
!                         Warning_Mode                    := Treat_As_Error;
! 
!                      when 'f' =>
!                         Check_Unreferenced_Formals      := True;
! 
!                      when 'F' =>
!                         Check_Unreferenced_Formals      := False;
! 
!                      when 'g' =>
!                         Warn_On_Unrecognized_Pragma     := True;
! 
!                      when 'G' =>
!                         Warn_On_Unrecognized_Pragma     := False;
! 
!                      when 'h' =>
!                         Warn_On_Hiding                  := True;
! 
!                      when 'H' =>
!                         Warn_On_Hiding                  := False;
! 
!                      when 'i' =>
!                         Implementation_Unit_Warnings    := True;
! 
!                      when 'I' =>
!                         Implementation_Unit_Warnings    := False;
! 
!                      when 'j' =>
!                         Warn_On_Obsolescent_Feature     := True;
! 
!                      when 'J' =>
!                         Warn_On_Obsolescent_Feature     := False;
! 
!                      when 'k' =>
!                         Warn_On_Constant                := True;
! 
!                      when 'K' =>
!                         Warn_On_Constant                := False;
! 
!                      when 'l' =>
!                         Elab_Warnings                   := True;
! 
!                      when 'L' =>
!                         Elab_Warnings                   := False;
! 
!                      when 'm' =>
!                         Warn_On_Modified_Unread         := True;
! 
!                      when 'M' =>
!                         Warn_On_Modified_Unread         := False;
! 
!                      when 'n' =>
!                         Warning_Mode                    := Normal;
! 
!                      when 'o' =>
!                         Address_Clause_Overlay_Warnings := True;
! 
!                      when 'O' =>
!                         Address_Clause_Overlay_Warnings := False;
! 
!                      when 'p' =>
!                         Ineffective_Inline_Warnings     := True;
! 
!                      when 'P' =>
!                         Ineffective_Inline_Warnings     := False;
! 
!                      when 'r' =>
!                         Warn_On_Redundant_Constructs    := True;
! 
!                      when 'R' =>
!                         Warn_On_Redundant_Constructs    := False;
! 
!                      when 's' =>
!                         Warning_Mode                    := Suppress;
! 
!                      when 'u' =>
!                         Check_Unreferenced              := True;
!                         Check_Withs                     := True;
!                         Check_Unreferenced_Formals      := True;
! 
!                      when 'U' =>
!                         Check_Unreferenced              := False;
!                         Check_Withs                     := False;
!                         Check_Unreferenced_Formals      := False;
! 
!                      when 'v' =>
!                         Warn_On_No_Value_Assigned       := True;
! 
!                      when 'V' =>
!                         Warn_On_No_Value_Assigned       := False;
! 
!                      when 'x' =>
!                         Warn_On_Export_Import           := True;
! 
!                      when 'X' =>
!                         Warn_On_Export_Import           := False;
! 
!                      when 'z' =>
!                         Warn_On_Unchecked_Conversion    := True;
! 
!                      when 'Z' =>
!                         Warn_On_Unchecked_Conversion    := False;
! 
!                         --  Allow and ignore 'w' so that the old
!                         --  format (e.g. -gnatwuwl) will work.
! 
!                      when 'w' =>
!                         null;
! 
!                      when others =>
!                         raise Bad_Switch;
!                   end case;
  
                    if C /= 'w' then
                       Storing (First_Stored + 1) := C;
--- 769,785 ----
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   Bad_Switch (C);
                 end if;
  
                 while Ptr <= Max loop
                    C := Switch_Chars (Ptr);
  
!                   if Set_Warning_Switch (C) then
!                      null;
!                   else
!                      Bad_Switch (C);
!                   end if;
  
                    if C /= 'w' then
                       Storing (First_Stored + 1) := C;
*************** package body Switch.C is
*** 932,938 ****
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   raise Bad_Switch;
                 end if;
  
                 for J in WC_Encoding_Method loop
--- 798,804 ----
                 Ptr := Ptr + 1;
  
                 if Ptr > Max then
!                   Bad_Switch (C);
                 end if;
  
                 for J in WC_Encoding_Method loop
*************** package body Switch.C is
*** 941,947 ****
                       exit;
  
                    elsif J = WC_Encoding_Method'Last then
!                      raise Bad_Switch;
                    end if;
                 end loop;
  
--- 807,813 ----
                       exit;
  
                    elsif J = WC_Encoding_Method'Last then
!                      Bad_Switch (C);
                    end if;
                 end loop;
  
*************** package body Switch.C is
*** 963,968 ****
--- 829,835 ----
                 Ptr := Ptr + 1;
                 Extensions_Allowed := True;
                 Ada_Version := Ada_Version_Type'Last;
+                Ada_Version_Explicit := Ada_Version;
  
              --  Processing for y switch
  
*************** package body Switch.C is
*** 985,991 ****
                         (Switch_Chars (Ptr .. Max), OK, Ptr);
  
                       if not OK then
!                         raise Bad_Switch;
                       end if;
  
                       Ptr := First_Char + 1;
--- 852,858 ----
                         (Switch_Chars (Ptr .. Max), OK, Ptr);
  
                       if not OK then
!                         Bad_Switch (C);
                       end if;
  
                       Ptr := First_Char + 1;
*************** package body Switch.C is
*** 1030,1036 ****
                          Distribution_Stub_Mode := Generate_Caller_Stub_Body;
  
                       when others =>
!                         raise Bad_Switch;
                    end case;
  
                    Ptr := Ptr + 1;
--- 897,903 ----
                          Distribution_Stub_Mode := Generate_Caller_Stub_Body;
  
                       when others =>
!                         Bad_Switch (C);
                    end case;
  
                    Ptr := Ptr + 1;
*************** package body Switch.C is
*** 1041,1095 ****
  
              when 'Z' =>
                 Ptr := Ptr + 1;
!                Zero_Cost_Exceptions_Set := True;
!                Zero_Cost_Exceptions_Val := True;
  
              --  Processing for 83 switch
  
              when '8' =>
                 if Ptr = Max then
!                   raise Bad_Switch;
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '3' then
!                   raise Bad_Switch;
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_83;
                 end if;
  
              --  Processing for 95 switch
  
              when '9' =>
                 if Ptr = Max then
!                   raise Bad_Switch;
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '5' then
!                   raise Bad_Switch;
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_95;
                 end if;
  
              --  Processing for 05 switch
  
              when '0' =>
                 if Ptr = Max then
!                   raise Bad_Switch;
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '5' then
!                   raise Bad_Switch;
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_05;
                 end if;
  
              --  Ignore extra switch character
--- 908,965 ----
  
              when 'Z' =>
                 Ptr := Ptr + 1;
!                Osint.Fail
!                  ("-gnatZ is no longer supported: consider using --RTS=zcx");
  
              --  Processing for 83 switch
  
              when '8' =>
                 if Ptr = Max then
!                   Bad_Switch (C);
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '3' then
!                   Bad_Switch (C);
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_83;
+                   Ada_Version_Explicit := Ada_Version;
                 end if;
  
              --  Processing for 95 switch
  
              when '9' =>
                 if Ptr = Max then
!                   Bad_Switch (C);
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '5' then
!                   Bad_Switch (C);
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_95;
+                   Ada_Version_Explicit := Ada_Version;
                 end if;
  
              --  Processing for 05 switch
  
              when '0' =>
                 if Ptr = Max then
!                   Bad_Switch (C);
                 end if;
  
                 Ptr := Ptr + 1;
  
                 if Switch_Chars (Ptr) /= '5' then
!                   Bad_Switch (C);
                 else
                    Ptr := Ptr + 1;
                    Ada_Version := Ada_05;
+                   Ada_Version_Explicit := Ada_Version;
                 end if;
  
              --  Ignore extra switch character
*************** package body Switch.C is
*** 1100,1106 ****
              --  Anything else is an error (illegal switch character)
  
              when others =>
!                raise Bad_Switch;
              end case;
           end case;
  
--- 970,976 ----
              --  Anything else is an error (illegal switch character)
  
              when others =>
!                Bad_Switch (C);
              end case;
           end case;
  
*************** package body Switch.C is
*** 1113,1129 ****
  
           First_Switch := False;
        end loop;
- 
-    exception
-       when Bad_Switch =>
-          Osint.Fail ("invalid switch: ", (1 => C));
- 
-       when Bad_Switch_Value =>
-          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
- 
-       when Missing_Switch_Value =>
-          Osint.Fail ("missing numeric value for switch: ", (1 => C));
- 
     end Scan_Front_End_Switches;
  
  end Switch.C;
--- 983,988 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-c.ads gcc-4.1.0/gcc/ada/switch-c.ads
*** gcc-4.0.2/gcc/ada/switch-c.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/switch-c.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-m.adb gcc-4.1.0/gcc/ada/switch-m.adb
*** gcc-4.0.2/gcc/ada/switch-m.adb	Mon May 10 16:18:53 2004
--- gcc-4.1.0/gcc/ada/switch-m.adb	Tue Nov 15 14:00:29 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Switch.M is
*** 404,409 ****
--- 404,453 ----
                          end if;
                       end loop;
  
+                   --  -gnat95 -gnat05
+ 
+                   when '0' | '9' =>
+                      Last_Stored := First_Stored;
+                      Storing (Last_Stored) := C;
+                      Ptr := Ptr + 1;
+ 
+                      if Ptr /= Max or else Switch_Chars (Ptr) /= '5' then
+ 
+                         --  Invalid switch
+ 
+                         Last := 0;
+                         return;
+ 
+                      else
+                         Last_Stored := Last_Stored + 1;
+                         Storing (Last_Stored) := '5';
+                         Add_Switch_Component
+                           (Storing (Storing'First .. Last_Stored));
+                         Ptr := Ptr + 1;
+                      end if;
+ 
+                   --  -gnat83
+ 
+                   when '8' =>
+                      Last_Stored := First_Stored;
+                      Storing (Last_Stored) := '8';
+                      Ptr := Ptr + 1;
+ 
+                      if Ptr /= Max or else Switch_Chars (Ptr) /= '3' then
+ 
+                         --  Invalid switch
+ 
+                         Last := 0;
+                         return;
+ 
+                      else
+                         Last_Stored := Last_Stored + 1;
+                         Storing (Last_Stored) := '3';
+                         Add_Switch_Component
+                           (Storing (Storing'First .. Last_Stored));
+                         Ptr := Ptr + 1;
+                      end if;
+ 
                    --  Not a valid switch
  
                    when others =>
*************** package body Switch.M is
*** 447,453 ****
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          raise Bad_Switch;
  
        else
           Ptr := Ptr + 1;
--- 491,497 ----
        --  Skip past the initial character (must be the switch character)
  
        if Ptr = Max then
!          Bad_Switch (C);
  
        else
           Ptr := Ptr + 1;
*************** package body Switch.M is
*** 537,554 ****
                 then
                    Set_Debug_Flag (C);
                 else
!                   raise Bad_Switch;
                 end if;
              end loop;
  
-             --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-             --  is for backwards compatibility with old versions and usage.
- 
-             if Debug_Flag_XX then
-                Zero_Cost_Exceptions_Set := True;
-                Zero_Cost_Exceptions_Val := True;
-             end if;
- 
              return;
  
           --  Processing for e switch
--- 581,590 ----
                 then
                    Set_Debug_Flag (C);
                 else
!                   Bad_Switch (C);
                 end if;
              end loop;
  
              return;
  
           --  Processing for e switch
*************** package body Switch.M is
*** 557,563 ****
              Ptr := Ptr + 1;
  
              if Ptr > Max then
!                raise Bad_Switch;
              end if;
  
              case Switch_Chars (Ptr) is
--- 593,599 ----
              Ptr := Ptr + 1;
  
              if Ptr > Max then
!                Bad_Switch (C);
              end if;
  
              case Switch_Chars (Ptr) is
*************** package body Switch.M is
*** 566,572 ****
  
                 when 'I' =>
                    Ptr := Ptr + 1;
!                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index);
  
                 --  processing for eL switch
  
--- 602,608 ----
  
                 when 'I' =>
                    Ptr := Ptr + 1;
!                   Scan_Pos (Switch_Chars, Max, Ptr, Main_Index, C);
  
                 --  processing for eL switch
  
*************** package body Switch.M is
*** 575,581 ****
                    Follow_Links := True;
  
                 when others =>
!                   raise Bad_Switch;
              end case;
  
           --  Processing for f switch
--- 611,617 ----
                    Follow_Links := True;
  
                 when others =>
!                   Bad_Switch (C);
              end case;
  
           --  Processing for f switch
*************** package body Switch.M is
*** 610,616 ****
              declare
                 Max_Proc : Pos;
              begin
!                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
                 Maximum_Processes := Positive (Max_Proc);
              end;
  
--- 646,652 ----
              declare
                 Max_Proc : Pos;
              begin
!                Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc, C);
                 Maximum_Processes := Positive (Max_Proc);
              end;
  
*************** package body Switch.M is
*** 643,649 ****
              Ptr := Ptr + 1;
  
              if Output_File_Name_Present then
!                raise Too_Many_Output_Files;
              else
                 Output_File_Name_Present := True;
              end if;
--- 679,685 ----
              Ptr := Ptr + 1;
  
              if Output_File_Name_Present then
!                Osint.Fail ("duplicate -o switch");
              else
                 Output_File_Name_Present := True;
              end if;
*************** package body Switch.M is
*** 671,676 ****
--- 707,731 ----
           when 'v' =>
              Ptr := Ptr + 1;
              Verbose_Mode := True;
+             Verbosity_Level := Opt.High;
+ 
+             if Ptr <= Max then
+                case Switch_Chars (Ptr) is
+                   when 'l' =>
+                      Verbosity_Level := Opt.Low;
+ 
+                   when 'm' =>
+                      Verbosity_Level := Opt.Medium;
+ 
+                   when 'h' =>
+                      Verbosity_Level := Opt.High;
+ 
+                   when others =>
+                      Osint.Fail ("invalid switch: ", Switch_Chars);
+                end case;
+ 
+                Ptr := Ptr + 1;
+             end if;
  
           --  Processing for x switch
  
*************** package body Switch.M is
*** 692,698 ****
           --  Anything else is an error (illegal switch character)
  
           when others =>
!             raise Bad_Switch;
  
           end case;
  
--- 747,753 ----
           --  Anything else is an error (illegal switch character)
  
           when others =>
!             Bad_Switch (C);
  
           end case;
  
*************** package body Switch.M is
*** 702,720 ****
  
        end Check_Switch;
  
-    exception
-       when Bad_Switch =>
-          Osint.Fail ("invalid switch: ", (1 => C));
- 
-       when Bad_Switch_Value =>
-          Osint.Fail ("numeric value out of range for switch: ", (1 => C));
- 
-       when Missing_Switch_Value =>
-          Osint.Fail ("missing numeric value for switch: ", (1 => C));
- 
-       when Too_Many_Output_Files =>
-          Osint.Fail ("duplicate -o switch");
- 
     end Scan_Make_Switches;
  
  end Switch.M;
--- 757,762 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/switch-m.ads gcc-4.1.0/gcc/ada/switch-m.ads
*** gcc-4.0.2/gcc/ada/switch-m.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/switch-m.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/switch.adb gcc-4.1.0/gcc/ada/switch.adb
*** gcc-4.0.2/gcc/ada/switch.adb	Fri Jun 25 16:39:33 2004
--- gcc-4.1.0/gcc/ada/switch.adb	Tue Nov 15 14:04:56 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,31 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
  package body Switch is
  
     -------------------------
     -- Is_Front_End_Switch --
     -------------------------
--- 16,42 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ with Osint;
+ 
  package body Switch is
  
+    ----------------
+    -- Bad_Switch --
+    ----------------
+ 
+    procedure Bad_Switch (Switch : Character) is
+    begin
+       Osint.Fail ("invalid switch: ", (1 => Switch));
+    end Bad_Switch;
+ 
     -------------------------
     -- Is_Front_End_Switch --
     -------------------------
*************** package body Switch is
*** 61,84 ****
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Nat)
     is
     begin
        Result := 0;
  
        if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
!          raise Missing_Switch_Value;
!       end if;
  
!       while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
!          Result := Result * 10 +
!            Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
!          Ptr := Ptr + 1;
  
!          if Result > Switch_Max_Value then
!             raise Bad_Switch_Value;
!          end if;
!       end loop;
     end Scan_Nat;
  
     --------------
--- 72,98 ----
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Nat;
!       Switch       : Character)
     is
     begin
        Result := 0;
  
        if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
!          Osint.Fail ("missing numeric value for switch: ", (1 => Switch));
  
!       else
!          while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
!             Result := Result * 10 +
!               Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
!             Ptr := Ptr + 1;
  
!             if Result > Switch_Max_Value then
!                Osint.Fail
!                  ("numeric value out of range for switch: ", (1 => Switch));
!             end if;
!          end loop;
!       end if;
     end Scan_Nat;
  
     --------------
*************** package body Switch is
*** 89,103 ****
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Pos)
     is
        Temp : Nat;
  
     begin
!       Scan_Nat (Switch_Chars, Max, Ptr, Temp);
  
        if Temp = 0 then
!          raise Bad_Switch_Value;
        end if;
  
        Result := Temp;
--- 103,118 ----
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Pos;
!       Switch       : Character)
     is
        Temp : Nat;
  
     begin
!       Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch);
  
        if Temp = 0 then
!          Osint.Fail ("numeric value out of range for switch: ", (1 => Switch));
        end if;
  
        Result := Temp;
diff -Nrcpad gcc-4.0.2/gcc/ada/switch.ads gcc-4.1.0/gcc/ada/switch.ads
*** gcc-4.0.2/gcc/ada/switch.ads	Tue Oct 21 13:42:22 2003
--- gcc-4.1.0/gcc/ada/switch.ads	Tue Nov 15 14:04:56 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** private
*** 62,79 ****
     --  child packages (there is one such child package for each tool that
     --  uses Switches to scan switches - Compiler/gnatbind/gnatmake/.
  
-    Bad_Switch : exception;
-    --  Exception raised if bad switch encountered
- 
-    Bad_Switch_Value : exception;
-    --  Exception raised if bad switch value encountered
- 
-    Missing_Switch_Value : exception;
-    --  Exception raised if no switch value encountered
- 
-    Too_Many_Output_Files : exception;
-    --  Exception raised if the -o switch is encountered more than once
- 
     Switch_Max_Value : constant := 999_999;
     --  Maximum value permitted in switches that take a value
  
--- 62,67 ----
*************** private
*** 81,87 ****
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Nat);
     --  Scan natural integer parameter for switch. On entry, Ptr points
     --  just past the switch character, on exit it points past the last
     --  digit of the integer value.
--- 69,76 ----
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Nat;
!       Switch       : Character);
     --  Scan natural integer parameter for switch. On entry, Ptr points
     --  just past the switch character, on exit it points past the last
     --  digit of the integer value.
*************** private
*** 90,98 ****
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Pos);
     --  Scan positive integer parameter for switch. On entry, Ptr points
     --  just past the switch character, on exit it points past the last
     --  digit of the integer value.
  
  end Switch;
--- 79,91 ----
       (Switch_Chars : String;
        Max          : Integer;
        Ptr          : in out Integer;
!       Result       : out Pos;
!       Switch       : Character);
     --  Scan positive integer parameter for switch. On entry, Ptr points
     --  just past the switch character, on exit it points past the last
     --  digit of the integer value.
  
+    procedure Bad_Switch (Switch : Character);
+    --  Fail with an appropriate message when a switch is not recognized
+ 
  end Switch;
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols-processing-vms-alpha.adb gcc-4.1.0/gcc/ada/symbols-processing-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/symbols-processing-vms-alpha.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/symbols-processing-vms-alpha.adb	Fri Jul  1 01:29:17 2005
***************
*** 0 ****
--- 1,235 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                    S Y M B O L S . P R O C E S S I N G                   --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This is the VMS Alpha version of this package
+ 
+ separate (Symbols)
+ package body Processing is
+ 
+    type Number is mod 2**16;
+    --  16 bits unsigned number for number of characters
+ 
+    GSD : constant Number := 10;
+    --  Code for the Global Symbol Definition section
+ 
+    C_SYM : constant Number := 1;
+    --  Code for a Symbol subsection
+ 
+    V_DEF_Mask  : constant Number := 2**1;
+    V_NORM_Mask : constant Number := 2**6;
+ 
+    B : Byte;
+ 
+    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;
+ 
+    Dummy : Number;
+ 
+    Nchars : Natural := 0;
+    Flags  : Number  := 0;
+ 
+    Symbol : String (1 .. 255);
+    LSymb  : Natural;
+ 
+    procedure Get (N : out Number);
+    --  Read two bytes from the object file LSB first as unsigned 16 bit number
+ 
+    procedure Get (N : out Natural);
+    --  Read two bytes from the object file, LSByte first, as a Natural
+ 
+    ---------
+    -- Get --
+    ---------
+ 
+    procedure Get (N : out Number) is
+       C : Byte;
+       LSByte : Number;
+    begin
+       Read (File, C);
+       LSByte := Byte'Pos (C);
+       Read (File, C);
+       N := LSByte + (256 * Byte'Pos (C));
+    end Get;
+ 
+    procedure Get (N : out Natural) is
+       Result : Number;
+    begin
+       Get (Result);
+       N := Natural (Result);
+    end Get;
+ 
+    -------------
+    -- Process --
+    -------------
+ 
+    procedure Process
+      (Object_File : String;
+       Success     : out Boolean)
+    is
+    begin
+       --  Open the object file with Byte_IO. Return with Success = False if
+       --  this fails.
+ 
+       begin
+          Open (File, In_File, Object_File);
+       exception
+          when others =>
+             Put_Line
+               ("*** Unable to open object file """ & Object_File & """");
+             Success := False;
+             return;
+       end;
+ 
+       --  Assume that the object file has a correct format
+ 
+       Success := True;
+ 
+       --  Get the different sections one by one from the object file
+ 
+       while not End_Of_File (File) loop
+ 
+          Get (Code);
+          Get (Number_Of_Characters);
+          Number_Of_Characters := Number_Of_Characters - 4;
+ 
+          --  If this is not a Global Symbol Definition section, skip to the
+          --  next section.
+ 
+          if Code /= GSD then
+ 
+             for J in 1 .. Number_Of_Characters loop
+                Read (File, B);
+             end loop;
+ 
+          else
+ 
+             --  Skip over the next 4 bytes
+ 
+             Get (Dummy);
+             Get (Dummy);
+             Number_Of_Characters := Number_Of_Characters - 4;
+ 
+             --  Get each subsection in turn
+ 
+             loop
+                Get (Code);
+                Get (Nchars);
+                Get (Dummy);
+                Get (Flags);
+                Number_Of_Characters := Number_Of_Characters - 8;
+                Nchars := Nchars - 8;
+ 
+                --  If this is a symbol and the V_DEF flag is set, get the
+                --  symbol.
+ 
+                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
+                   --  First, reach the symbol length
+ 
+                   for J in 1 .. 25 loop
+                      Read (File, B);
+                      Nchars := Nchars - 1;
+                      Number_Of_Characters := Number_Of_Characters - 1;
+                   end loop;
+ 
+                   Length := Byte'Pos (B);
+                   LSymb := 0;
+ 
+                   --  Get the symbol characters
+ 
+                   for J in 1 .. Nchars loop
+                      Read (File, B);
+                      Number_Of_Characters := Number_Of_Characters - 1;
+                      if Length > 0 then
+                         LSymb := LSymb + 1;
+                         Symbol (LSymb) := B;
+                         Length := Length - 1;
+                      end if;
+                   end loop;
+ 
+                   --  Create the new Symbol
+ 
+                   declare
+                      S_Data : Symbol_Data;
+                   begin
+                      S_Data.Name := new String'(Symbol (1 .. LSymb));
+ 
+                      --  The symbol kind (Data or Procedure) depends on the
+                      --  V_NORM flag.
+ 
+                      if (Flags and V_NORM_Mask) = 0 then
+                         S_Data.Kind := Data;
+ 
+                      else
+                         S_Data.Kind := Proc;
+                      end if;
+ 
+                      --  Put the new symbol in the table
+ 
+                      Symbol_Table.Increment_Last (Complete_Symbols);
+                      Complete_Symbols.Table
+                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
+                   end;
+ 
+                else
+                   --  As it is not a symbol subsection, skip to the next
+                   --  subsection.
+ 
+                   for J in 1 .. Nchars loop
+                      Read (File, B);
+                      Number_Of_Characters := Number_Of_Characters - 1;
+                   end loop;
+                end if;
+ 
+                --  Exit the GSD section when number of characters reaches 0
+ 
+                exit when Number_Of_Characters = 0;
+             end loop;
+          end if;
+       end loop;
+ 
+       --  The object file has been processed, close it
+ 
+       Close (File);
+ 
+    exception
+       --  For any exception, output an error message, close the object file
+       --  and return with Success = False.
+ 
+       when X : others =>
+          Put_Line ("unexpected exception raised while processing """
+                    & Object_File & """");
+          Put_Line (Exception_Information (X));
+          Close (File);
+          Success := False;
+    end Process;
+ 
+ end Processing;
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols-processing-vms-ia64.adb gcc-4.1.0/gcc/ada/symbols-processing-vms-ia64.adb
*** gcc-4.0.2/gcc/ada/symbols-processing-vms-ia64.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/symbols-processing-vms-ia64.adb	Fri Jul  1 01:29:17 2005
***************
*** 0 ****
--- 1,367 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                    S Y M B O L S . P R O C E S S I N G                   --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This is the VMS/IA64 version of this package
+ 
+ with Ada.IO_Exceptions;
+ 
+ with Ada.Unchecked_Deallocation;
+ 
+ separate (Symbols)
+ package body Processing is
+ 
+    type String_Array is array (Positive range <>) of String_Access;
+    type Strings_Ptr is access String_Array;
+ 
+    procedure Free is
+      new Ada.Unchecked_Deallocation (String_Array, Strings_Ptr);
+ 
+    type Section_Header is record
+       Shname   : Integer;
+       Shtype   : Integer;
+       Shoffset : Integer;
+       Shsize   : Integer;
+       Shlink   : Integer;
+    end record;
+ 
+    type Section_Header_Array is array (Natural range <>) of Section_Header;
+    type Section_Header_Ptr is access Section_Header_Array;
+ 
+    procedure Free is
+      new Ada.Unchecked_Deallocation (Section_Header_Array, Section_Header_Ptr);
+ 
+    -------------
+    -- Process --
+    -------------
+ 
+    procedure Process
+      (Object_File : String;
+       Success     : out Boolean)
+    is
+       B : Byte;
+       H : Integer;
+       W : Integer;
+ 
+       Str : String (1 .. 1000) := (others => ' ');
+       Str_Last : Natural;
+ 
+       Strings : Strings_Ptr;
+ 
+       Shoff : Integer;
+       Shnum : Integer;
+       Shentsize : Integer;
+ 
+       Shname   : Integer;
+       Shtype   : Integer;
+       Shoffset : Integer;
+       Shsize   : Integer;
+       Shlink   : Integer;
+ 
+       Symtab_Index       : Natural := 0;
+       String_Table_Index : Natural := 0;
+ 
+       End_Symtab : Integer;
+ 
+       Stname : Integer;
+       Stinfo : Character;
+       Sttype : Integer;
+       Stbind : Integer;
+       Stshndx : Integer;
+ 
+       Section_Headers : Section_Header_Ptr;
+ 
+       Offset   : Natural := 0;
+ 
+       procedure Get_Byte (B : out Byte);
+       procedure Get_Half (H : out Integer);
+       procedure Get_Word (W : out Integer);
+       procedure Reset;
+ 
+       procedure Get_Byte (B : out Byte) is
+       begin
+          Byte_IO.Read (File, B);
+          Offset := Offset + 1;
+       end Get_Byte;
+ 
+       procedure Get_Half (H : out Integer) is
+          C1, C2 : Character;
+       begin
+          Get_Byte (C1); Get_Byte (C2);
+          H :=
+            Integer'(Character'Pos (C2)) * 256 + Integer'(Character'Pos (C1));
+       end Get_Half;
+ 
+       procedure Get_Word (W : out Integer) is
+          H1, H2 : Integer;
+       begin
+          Get_Half (H1); Get_Half (H2);
+          W := H2 * 256 * 256 + H1;
+       end Get_Word;
+ 
+       procedure Reset is
+       begin
+          Offset := 0;
+          Byte_IO.Reset (File);
+       end Reset;
+ 
+    begin
+       --  Open the object file with Byte_IO. Return with Success = False if
+       --  this fails.
+ 
+       begin
+          Open (File, In_File, Object_File);
+       exception
+          when others =>
+             Put_Line
+               ("*** Unable to open object file """ & Object_File & """");
+             Success := False;
+             return;
+       end;
+ 
+       --  Assume that the object file has a correct format
+ 
+       Success := True;
+ 
+       --  Skip ELF identification
+ 
+       while Offset < 16 loop
+          Get_Byte (B);
+       end loop;
+ 
+       --  Skip e_type
+ 
+       Get_Half (H);
+ 
+       --  Skip e_machine
+ 
+       Get_Half (H);
+ 
+       --  Skip e_version
+ 
+       Get_Word (W);
+ 
+       --  Skip e_entry
+ 
+       for J in 1 .. 8 loop
+          Get_Byte (B);
+       end loop;
+ 
+       --  Skip e_phoff
+ 
+       for J in 1 .. 8 loop
+          Get_Byte (B);
+       end loop;
+ 
+       Get_Word (Shoff);
+ 
+       --  Skip upper half of Shoff
+ 
+       for J in 1 .. 4 loop
+          Get_Byte (B);
+       end loop;
+ 
+       --  Skip e_flags
+ 
+       Get_Word (W);
+ 
+       --  Skip e_ehsize
+ 
+       Get_Half (H);
+ 
+       --  Skip e_phentsize
+ 
+       Get_Half (H);
+ 
+       --  Skip e_phnum
+ 
+       Get_Half (H);
+ 
+       Get_Half (Shentsize);
+ 
+       Get_Half (Shnum);
+ 
+       Section_Headers := new Section_Header_Array (0 .. Shnum - 1);
+ 
+       --  Go to Section Headers
+ 
+       while Offset < Shoff loop
+          Get_Byte (B);
+       end loop;
+ 
+       --  Reset Symtab_Index
+ 
+       Symtab_Index := 0;
+ 
+       for J in Section_Headers'Range loop
+          --  Get the data for each Section Header
+ 
+          Get_Word (Shname);
+          Get_Word (Shtype);
+ 
+          for K in 1 .. 16 loop
+             Get_Byte (B);
+          end loop;
+ 
+          Get_Word (Shoffset);
+          Get_Word (W);
+ 
+          Get_Word (Shsize);
+          Get_Word (W);
+ 
+          Get_Word (Shlink);
+ 
+          while (Offset - Shoff) mod Shentsize /= 0 loop
+             Get_Byte (B);
+          end loop;
+ 
+          --  If this is the Symbol Table Section Header, record its index
+ 
+          if Shtype = 2 then
+             Symtab_Index := J;
+          end if;
+ 
+          Section_Headers (J) := (Shname, Shtype, Shoffset, Shsize, Shlink);
+       end loop;
+ 
+       if Symtab_Index = 0 then
+          Success := False;
+          return;
+       end if;
+ 
+       End_Symtab :=
+         Section_Headers (Symtab_Index).Shoffset +
+         Section_Headers (Symtab_Index).Shsize;
+ 
+       String_Table_Index := Section_Headers (Symtab_Index).Shlink;
+       Strings :=
+         new String_Array (1 .. Section_Headers (String_Table_Index).Shsize);
+ 
+       --  Go get the String Table section for the Symbol Table
+ 
+       Reset;
+ 
+       while Offset < Section_Headers (String_Table_Index).Shoffset loop
+          Get_Byte (B);
+       end loop;
+ 
+       Offset := 0;
+ 
+       Get_Byte (B);  --  zero
+ 
+       while Offset < Section_Headers (String_Table_Index).Shsize loop
+          Str_Last := 0;
+ 
+          loop
+             Get_Byte (B);
+             if B /= ASCII.NUL then
+                Str_Last := Str_Last + 1;
+                Str (Str_Last) := B;
+ 
+             else
+                Strings (Offset - Str_Last - 1) :=
+                  new String'(Str (1 .. Str_Last));
+                exit;
+             end if;
+          end loop;
+       end loop;
+ 
+       --  Go get the Symbol Table
+ 
+       Reset;
+ 
+       while Offset < Section_Headers (Symtab_Index).Shoffset loop
+          Get_Byte (B);
+       end loop;
+ 
+       while Offset < End_Symtab loop
+          Get_Word (Stname);
+          Get_Byte (Stinfo);
+          Get_Byte (B);
+          Get_Half (Stshndx);
+          for J in 1 .. 4 loop
+             Get_Word (W);
+          end loop;
+ 
+          Sttype := Integer'(Character'Pos (Stinfo)) mod 16;
+          Stbind := Integer'(Character'Pos (Stinfo)) / 16;
+ 
+          if (Sttype = 1 or else Sttype = 2)
+               and then Stbind /= 0
+               and then Stshndx /= 0
+          then
+             declare
+                S_Data : Symbol_Data;
+             begin
+                S_Data.Name := new String'(Strings (Stname).all);
+ 
+                if Sttype = 1 then
+                   S_Data.Kind := Data;
+ 
+                else
+                   S_Data.Kind := Proc;
+                end if;
+ 
+                --  Put the new symbol in the table
+ 
+                Symbol_Table.Increment_Last (Complete_Symbols);
+                Complete_Symbols.Table
+                  (Symbol_Table.Last (Complete_Symbols)) := S_Data;
+             end;
+          end if;
+       end loop;
+ 
+       --  The object file has been processed, close it
+ 
+       Close (File);
+ 
+       --  Free the allocated memory
+ 
+       Free (Section_Headers);
+ 
+       for J in Strings'Range loop
+          if Strings (J) /= null then
+             Free (Strings (J));
+          end if;
+       end loop;
+ 
+       Free (Strings);
+ 
+    exception
+       --  For any exception, output an error message, close the object file
+       --  and return with Success = False.
+ 
+       when Ada.IO_Exceptions.End_Error =>
+          Close (File);
+ 
+       when X : others =>
+          Put_Line ("unexpected exception raised while processing """
+                    & Object_File & """");
+          Put_Line (Exception_Information (X));
+          Close (File);
+          Success := False;
+    end Process;
+ 
+ end Processing;
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols-vms-alpha.adb gcc-4.1.0/gcc/ada/symbols-vms-alpha.adb
*** gcc-4.0.2/gcc/ada/symbols-vms-alpha.adb	Mon Jun 14 13:18:58 2004
--- gcc-4.1.0/gcc/ada/symbols-vms-alpha.adb	Thu Jan  1 00:00:00 1970
***************
*** 1,774 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                         GNAT COMPILER COMPONENTS                         --
- --                                                                          --
- --                              S Y M B O L S                               --
- --                                                                          --
- --                                 B o d y                                  --
- --                                                                          --
- --          Copyright (C) 2003-2004 Free Software Foundation, Inc.          --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- --  This is the VMS version of this package
- 
- with Ada.Exceptions;    use Ada.Exceptions;
- with Ada.Sequential_IO;
- with Ada.Text_IO;       use Ada.Text_IO;
- 
- package body Symbols is
- 
-    Case_Sensitive  : constant String := "case_sensitive=";
-    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.
- 
-    package Byte_IO is new Ada.Sequential_IO (Byte);
-    use Byte_IO;
- 
-    type Number is mod 2**16;
-    --  16 bits unsigned number for number of characters
- 
-    GSD : constant Number := 10;
-    --  Code for the Global Symbol Definition section
- 
-    C_SYM : constant Number := 1;
-    --  Code for a Symbol subsection
- 
-    V_DEF_Mask  : constant Number := 2**1;
-    V_NORM_Mask : constant Number := 2**6;
- 
-    File : Byte_IO.File_Type;
-    --  Each object file is read as a stream of bytes (characters)
- 
-    B : Byte;
- 
-    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;
- 
-    Dummy : Number;
- 
-    Nchars : Natural := 0;
-    Flags  : Number  := 0;
- 
-    Symbol : String (1 .. 255);
-    LSymb  : Natural;
- 
-    function Equal (Left, Right : Symbol_Data) return Boolean;
-    --  Test for equality of symbols
- 
-    procedure Get (N : out Number);
-    --  Read two bytes from the object file LSB first as unsigned 16 bit number
- 
-    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 --
-    -----------
- 
-    function Equal (Left, Right : Symbol_Data) return Boolean is
-    begin
-       return Left.Name /= null and then
-              Right.Name /= null and then
-              Left.Name.all = Right.Name.all and then
-              Left.Kind = Right.Kind and then
-              Left.Present = Right.Present;
-    end Equal;
- 
-    ---------
-    -- Get --
-    ---------
- 
-    procedure Get (N : out Number) is
-       C : Byte;
-       LSByte : Number;
-    begin
-       Read (File, C);
-       LSByte := Byte'Pos (C);
-       Read (File, C);
-       N := LSByte + (256 * Byte'Pos (C));
-    end Get;
- 
-    procedure Get (N : out Natural) is
-       Result : Number;
-    begin
-       Get (Result);
-       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;
-       Reference     : String;
-       Symbol_Policy : Policy;
-       Quiet         : Boolean;
-       Version       : String;
-       Success       : out Boolean)
-    is
-       File : Ada.Text_IO.File_Type;
-       Line : String (1 .. 1_000);
-       Last : Natural;
- 
-    begin
-       --  Record the symbol file name
- 
-       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);
-       Symbol_Table.Set_Last (Complete_Symbols, 0);
- 
-       --  Assume that everything will be fine
- 
-       Success := True;
- 
-       --  If policy is Compliant or Controlled, attempt to read the reference
-       --  file. If policy is Restricted, attempt to read the symbol file.
- 
-       if Sym_Policy /= Autonomous then
-          case Sym_Policy is
-             when Autonomous =>
-                null;
- 
-             when Compliant | Controlled =>
-                begin
-                   Open (File, In_File, Reference);
- 
-                exception
-                   when Ada.Text_IO.Name_Error =>
-                      Success := False;
-                      return;
- 
-                   when X : others =>
-                      if not Quiet then
-                         Put_Line ("could not open """ & Reference & """");
-                         Put_Line (Exception_Message (X));
-                      end if;
- 
-                      Success := False;
-                      return;
-                end;
- 
-             when Restricted =>
-                begin
-                   Open (File, In_File, Symbol_File);
- 
-                exception
-                   when Ada.Text_IO.Name_Error =>
-                      Success := False;
-                      return;
- 
-                   when X : others =>
-                      if not Quiet then
-                         Put_Line ("could not open """ & Symbol_File & """");
-                         Put_Line (Exception_Message (X));
-                      end if;
- 
-                      Success := False;
-                      return;
-                end;
-          end case;
- 
-          --  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
-                   Symbol_Table.Increment_Last (Original_Symbols);
-                   Original_Symbols.Table
-                     (Symbol_Table.Last (Original_Symbols)) :=
-                       (Name =>
-                          new String'(Line (Symbol_Vector'Length + 1 ..
-                                            Last - Equal_Data'Length)),
-                        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) =
-                                                               Equal_Procedure
-                then
-                   Symbol_Table.Increment_Last (Original_Symbols);
-                   Original_Symbols.Table
-                     (Symbol_Table.Last (Original_Symbols)) :=
-                     (Name =>
-                        new String'(Line (Symbol_Vector'Length + 1 ..
-                                          Last - Equal_Procedure'Length)),
-                      Kind => Proc,
-                      Present => True);
- 
-                --  Anything else is incorrectly formatted
- 
-                else
-                   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;
- 
-             --  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 """ &
-                             Reference & """");
-                   Put_Line ("""" & Line (1 .. Last) & """");
-                end if;
- 
-                Close (File);
-                Success := False;
-                return;
-             end if;
-          end loop;
- 
-          Close (File);
-       end if;
-    end Initialize;
- 
-    -------------
-    -- Process --
-    -------------
- 
-    procedure Process
-      (Object_File : String;
-       Success     : out Boolean)
-    is
-    begin
-       --  Open the object file with Byte_IO. Return with Success = False if
-       --  this fails.
- 
-       begin
-          Open (File, In_File, Object_File);
-       exception
-          when others =>
-             Put_Line
-               ("*** Unable to open object file """ & Object_File & """");
-             Success := False;
-             return;
-       end;
- 
-       --  Assume that the object file has a correct format
- 
-       Success := True;
- 
-       --  Get the different sections one by one from the object file
- 
-       while not End_Of_File (File) loop
- 
-          Get (Code);
-          Get (Number_Of_Characters);
-          Number_Of_Characters := Number_Of_Characters - 4;
- 
-          --  If this is not a Global Symbol Definition section, skip to the
-          --  next section.
- 
-          if Code /= GSD then
- 
-             for J in 1 .. Number_Of_Characters loop
-                Read (File, B);
-             end loop;
- 
-          else
- 
-             --  Skip over the next 4 bytes
- 
-             Get (Dummy);
-             Get (Dummy);
-             Number_Of_Characters := Number_Of_Characters - 4;
- 
-             --  Get each subsection in turn
- 
-             loop
-                Get (Code);
-                Get (Nchars);
-                Get (Dummy);
-                Get (Flags);
-                Number_Of_Characters := Number_Of_Characters - 8;
-                Nchars := Nchars - 8;
- 
-                --  If this is a symbol and the V_DEF flag is set, get the
-                --  symbol.
- 
-                if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
-                   --  First, reach the symbol length
- 
-                   for J in 1 .. 25 loop
-                      Read (File, B);
-                      Nchars := Nchars - 1;
-                      Number_Of_Characters := Number_Of_Characters - 1;
-                   end loop;
- 
-                   Length := Byte'Pos (B);
-                   LSymb := 0;
- 
-                   --  Get the symbol characters
- 
-                   for J in 1 .. Nchars loop
-                      Read (File, B);
-                      Number_Of_Characters := Number_Of_Characters - 1;
-                      if Length > 0 then
-                         LSymb := LSymb + 1;
-                         Symbol (LSymb) := B;
-                         Length := Length - 1;
-                      end if;
-                   end loop;
- 
-                   --  Create the new Symbol
- 
-                   declare
-                      S_Data : Symbol_Data;
-                   begin
-                      S_Data.Name := new String'(Symbol (1 .. LSymb));
- 
-                      --  The symbol kind (Data or Procedure) depends on the
-                      --  V_NORM flag.
- 
-                      if (Flags and V_NORM_Mask) = 0 then
-                         S_Data.Kind := Data;
- 
-                      else
-                         S_Data.Kind := Proc;
-                      end if;
- 
-                      --  Put the new symbol in the table
- 
-                      Symbol_Table.Increment_Last (Complete_Symbols);
-                      Complete_Symbols.Table
-                        (Symbol_Table.Last (Complete_Symbols)) := S_Data;
-                   end;
- 
-                else
-                   --  As it is not a symbol subsection, skip to the next
-                   --  subsection.
- 
-                   for J in 1 .. Nchars loop
-                      Read (File, B);
-                      Number_Of_Characters := Number_Of_Characters - 1;
-                   end loop;
-                end if;
- 
-                --  Exit the GSD section when number of characters reaches 0
- 
-                exit when Number_Of_Characters = 0;
-             end loop;
-          end if;
-       end loop;
- 
-       --  The object file has been processed, close it
- 
-       Close (File);
- 
-    exception
-       --  For any exception, output an error message, close the object file
-       --  and return with Success = False.
- 
-       when X : others =>
-          Put_Line ("unexpected exception raised while processing """
-                    & Object_File & """");
-          Put_Line (Exception_Information (X));
-          Close (File);
-          Success := False;
-    end Process;
- 
-    --------------
-    -- Finalize --
-    --------------
- 
-    procedure Finalize
-      (Quiet   : Boolean;
-       Success : out Boolean)
-    is
-       File   : Ada.Text_IO.File_Type;
-       --  The symbol file
- 
-       S_Data : Symbol_Data;
-       --  A symbol
- 
-       Cur    : Positive := 1;
-       --  Most probable index in the Complete_Symbols of the current symbol
-       --  in Original_Symbol.
- 
-       Found  : Boolean;
- 
-    begin
-       --  Nothing to be done if Initialize has never been called
- 
-       if Symbol_File_Name = null then
-          Success := False;
- 
-       else
- 
-          --  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.
- 
-          Cur := 1;
- 
-          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
-             S_Data := Original_Symbols.Table (Index_1);
-             Found := False;
- 
-             First_Object_Loop :
-             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
-                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
-                   Cur := Index_2 + 1;
-                   Complete_Symbols.Table (Index_2).Present := False;
-                   Found := True;
-                   exit First_Object_Loop;
-                end if;
-             end loop First_Object_Loop;
- 
-             --  If the symbol could not be found between Cur and Last, try
-             --  before Cur.
- 
-             if not Found then
-                Second_Object_Loop :
-                for Index_2 in 1 .. Cur - 1 loop
-                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
-                      Cur := Index_2 + 1;
-                      Complete_Symbols.Table (Index_2).Present := False;
-                      Found := True;
-                      exit Second_Object_Loop;
-                   end if;
-                end loop Second_Object_Loop;
-             end if;
- 
-             --  If the symbol is not found, mark it as such in the table
- 
-             if not Found 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 or else Sym_Policy = Restricted 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;
- 
-          if Sym_Policy /= Restricted then
- 
-             --  Append additional symbols, if any, to the Original_Symbols
-             --  table.
- 
-             for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
-                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;
-                   Complete_Symbols.Table (Index).Present := False;
-                end if;
-             end loop;
- 
-             --  Create the symbol file
- 
-             Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
- 
-             Put (File, Case_Sensitive);
-             Put_Line (File, "yes");
- 
-             --  Put a line in the symbol file for each symbol in symbol table
- 
-             for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
-                if Original_Symbols.Table (Index).Present then
-                   Put (File, Symbol_Vector);
-                   Put (File, Original_Symbols.Table (Index).Name.all);
- 
-                   if Original_Symbols.Table (Index).Kind = Data then
-                      Put_Line (File, Equal_Data);
- 
-                   else
-                      Put_Line (File, Equal_Procedure);
-                   end if;
- 
-                   Free (Original_Symbols.Table (Index).Name);
-                end if;
-             end loop;
- 
-             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
- 
-             Close (File);
- 
-             --  Reset both tables
- 
-             Symbol_Table.Set_Last (Original_Symbols, 0);
-             Symbol_Table.Set_Last (Complete_Symbols, 0);
- 
-             --  Clear the symbol file name
- 
-             Free (Symbol_File_Name);
-          end if;
- 
-          Success := True;
-       end if;
- 
-    exception
-       when X : others =>
-          Put_Line ("unexpected exception raised while finalizing """
-                    & Symbol_File_Name.all & """");
-          Put_Line (Exception_Information (X));
-          Success := False;
-    end Finalize;
- 
- end Symbols;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols-vms.adb gcc-4.1.0/gcc/ada/symbols-vms.adb
*** gcc-4.0.2/gcc/ada/symbols-vms.adb	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/symbols-vms.adb	Fri Jul  1 01:29:17 2005
***************
*** 0 ****
--- 1,606 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                         GNAT COMPILER COMPONENTS                         --
+ --                                                                          --
+ --                              S Y M B O L S                               --
+ --                                                                          --
+ --                                 B o d y                                  --
+ --                                                                          --
+ --          Copyright (C) 2003-2005 Free Software Foundation, Inc.          --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ --  This is the VMS version of this package
+ 
+ with Ada.Exceptions;    use Ada.Exceptions;
+ with Ada.Sequential_IO;
+ with Ada.Text_IO;       use Ada.Text_IO;
+ 
+ package body Symbols is
+ 
+    Case_Sensitive  : constant String := "case_sensitive=";
+    Symbol_Vector   : constant String := "SYMBOL_VECTOR=(";
+    Equal_Data      : constant String := "=DATA)";
+    Equal_Procedure : constant String := "=PROCEDURE)";
+    Gsmatch         : constant String := "gsmatch=";
+    Gsmatch_Lequal  : constant String := "gsmatch=lequal,";
+ 
+    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.
+ 
+    package Byte_IO is new Ada.Sequential_IO (Byte);
+    use Byte_IO;
+ 
+    File : Byte_IO.File_Type;
+    --  Each object file is read as a stream of bytes (characters)
+ 
+    function Equal (Left, Right : Symbol_Data) return Boolean;
+    --  Test for equality of symbols
+ 
+    function Image (N : Integer) return String;
+    --  Returns the image of N, without the initial space
+ 
+    -----------
+    -- Equal --
+    -----------
+ 
+    function Equal (Left, Right : Symbol_Data) return Boolean is
+    begin
+       return Left.Name /= null and then
+              Right.Name /= null and then
+              Left.Name.all = Right.Name.all and then
+              Left.Kind = Right.Kind and then
+              Left.Present = Right.Present;
+    end Equal;
+ 
+    -----------
+    -- 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;
+       Reference     : String;
+       Symbol_Policy : Policy;
+       Quiet         : Boolean;
+       Version       : String;
+       Success       : out Boolean)
+    is
+       File : Ada.Text_IO.File_Type;
+       Line : String (1 .. 1_000);
+       Last : Natural;
+ 
+    begin
+       --  Record the symbol file name
+ 
+       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);
+       Symbol_Table.Set_Last (Complete_Symbols, 0);
+ 
+       --  Assume that everything will be fine
+ 
+       Success := True;
+ 
+       --  If policy is Compliant or Controlled, attempt to read the reference
+       --  file. If policy is Restricted, attempt to read the symbol file.
+ 
+       if Sym_Policy /= Autonomous then
+          case Sym_Policy is
+             when Autonomous =>
+                null;
+ 
+             when Compliant | Controlled =>
+                begin
+                   Open (File, In_File, Reference);
+ 
+                exception
+                   when Ada.Text_IO.Name_Error =>
+                      Success := False;
+                      return;
+ 
+                   when X : others =>
+                      if not Quiet then
+                         Put_Line ("could not open """ & Reference & """");
+                         Put_Line (Exception_Message (X));
+                      end if;
+ 
+                      Success := False;
+                      return;
+                end;
+ 
+             when Restricted =>
+                begin
+                   Open (File, In_File, Symbol_File);
+ 
+                exception
+                   when Ada.Text_IO.Name_Error =>
+                      Success := False;
+                      return;
+ 
+                   when X : others =>
+                      if not Quiet then
+                         Put_Line ("could not open """ & Symbol_File & """");
+                         Put_Line (Exception_Message (X));
+                      end if;
+ 
+                      Success := False;
+                      return;
+                end;
+          end case;
+ 
+          --  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
+                   Symbol_Table.Increment_Last (Original_Symbols);
+                   Original_Symbols.Table
+                     (Symbol_Table.Last (Original_Symbols)) :=
+                       (Name =>
+                          new String'(Line (Symbol_Vector'Length + 1 ..
+                                            Last - Equal_Data'Length)),
+                        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) =
+                                                               Equal_Procedure
+                then
+                   Symbol_Table.Increment_Last (Original_Symbols);
+                   Original_Symbols.Table
+                     (Symbol_Table.Last (Original_Symbols)) :=
+                     (Name =>
+                        new String'(Line (Symbol_Vector'Length + 1 ..
+                                          Last - Equal_Procedure'Length)),
+                      Kind => Proc,
+                      Present => True);
+ 
+                --  Anything else is incorrectly formatted
+ 
+                else
+                   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;
+ 
+             --  Lines with "gsmatch=lequal," or "gsmatch=equal,"
+ 
+             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
+                   --  First, look for the first coma
+ 
+                   loop
+                      if Start >= Last - 1 then
+                         OK := False;
+                         exit;
+ 
+                      elsif Line (Start) = ',' then
+                         Start := Start + 1;
+                         exit;
+ 
+                      else
+                         Start := Start + 1;
+                      end if;
+                   end loop;
+ 
+                   Finish := Start;
+ 
+                   --  If the comma is found, get the Major and the Minor IDs
+ 
+                   if OK then
+                      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;
+                   end if;
+ 
+                   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 """ &
+                             Reference & """");
+                   Put_Line ("""" & Line (1 .. Last) & """");
+                end if;
+ 
+                Close (File);
+                Success := False;
+                return;
+             end if;
+          end loop;
+ 
+          Close (File);
+       end if;
+    end Initialize;
+ 
+    ----------------
+    -- Processing --
+    ----------------
+ 
+    package body Processing is separate;
+ 
+    --------------
+    -- Finalize --
+    --------------
+ 
+    procedure Finalize
+      (Quiet   : Boolean;
+       Success : out Boolean)
+    is
+       File   : Ada.Text_IO.File_Type;
+       --  The symbol file
+ 
+       S_Data : Symbol_Data;
+       --  A symbol
+ 
+       Cur    : Positive := 1;
+       --  Most probable index in the Complete_Symbols of the current symbol
+       --  in Original_Symbol.
+ 
+       Found  : Boolean;
+ 
+    begin
+       --  Nothing to be done if Initialize has never been called
+ 
+       if Symbol_File_Name = null then
+          Success := False;
+ 
+       else
+ 
+          --  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.
+ 
+          Cur := 1;
+ 
+          for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
+             S_Data := Original_Symbols.Table (Index_1);
+             Found := False;
+ 
+             First_Object_Loop :
+             for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
+                if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
+                   Cur := Index_2 + 1;
+                   Complete_Symbols.Table (Index_2).Present := False;
+                   Found := True;
+                   exit First_Object_Loop;
+                end if;
+             end loop First_Object_Loop;
+ 
+             --  If the symbol could not be found between Cur and Last, try
+             --  before Cur.
+ 
+             if not Found then
+                Second_Object_Loop :
+                for Index_2 in 1 .. Cur - 1 loop
+                   if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
+                      Cur := Index_2 + 1;
+                      Complete_Symbols.Table (Index_2).Present := False;
+                      Found := True;
+                      exit Second_Object_Loop;
+                   end if;
+                end loop Second_Object_Loop;
+             end if;
+ 
+             --  If the symbol is not found, mark it as such in the table
+ 
+             if not Found 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 or else Sym_Policy = Restricted then
+                   Success := False;
+                   return;
+ 
+                --  Any symbol that is undefined in the reference symbol file
+                --  triggers an increase of the Major ID, because the new
+                --  version of the library is no longer compatible with
+                --  existing executables.
+ 
+                elsif Soft_Major_ID then
+                   Major_ID := Major_ID + 1;
+                   Minor_ID := 0;
+                   Soft_Major_ID := False;
+                   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;
+ 
+          if Sym_Policy /= Restricted then
+ 
+             --  Append additional symbols, if any, to the Original_Symbols
+             --  table.
+ 
+             for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
+                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;
+                   Complete_Symbols.Table (Index).Present := False;
+                end if;
+             end loop;
+ 
+             --  Create the symbol file
+ 
+             Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
+ 
+             Put (File, Case_Sensitive);
+             Put_Line (File, "yes");
+ 
+             --  Put a line in the symbol file for each symbol in symbol table
+ 
+             for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
+                if Original_Symbols.Table (Index).Present then
+                   Put (File, Symbol_Vector);
+                   Put (File, Original_Symbols.Table (Index).Name.all);
+ 
+                   if Original_Symbols.Table (Index).Kind = Data then
+                      Put_Line (File, Equal_Data);
+ 
+                   else
+                      Put_Line (File, Equal_Procedure);
+                   end if;
+ 
+                   Free (Original_Symbols.Table (Index).Name);
+                end if;
+             end loop;
+ 
+             Put (File, Case_Sensitive);
+             Put_Line (File, "NO");
+ 
+             --  Put the version IDs
+ 
+             Put (File, Gsmatch_Lequal);
+             Put (File, Image (Major_ID));
+             Put (File, ',');
+             Put_Line  (File, Image (Minor_ID));
+ 
+             --  And we are done
+ 
+             Close (File);
+ 
+             --  Reset both tables
+ 
+             Symbol_Table.Set_Last (Original_Symbols, 0);
+             Symbol_Table.Set_Last (Complete_Symbols, 0);
+ 
+             --  Clear the symbol file name
+ 
+             Free (Symbol_File_Name);
+          end if;
+ 
+          Success := True;
+       end if;
+ 
+    exception
+       when X : others =>
+          Put_Line ("unexpected exception raised while finalizing """
+                    & Symbol_File_Name.all & """");
+          Put_Line (Exception_Information (X));
+          Success := False;
+    end Finalize;
+ 
+ end Symbols;
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols.adb gcc-4.1.0/gcc/ada/symbols.adb
*** gcc-4.0.2/gcc/ada/symbols.adb	Thu Nov 20 09:54:03 2003
--- gcc-4.1.0/gcc/ada/symbols.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Symbols is
*** 54,71 ****
        Success := False;
     end Initialize;
  
!    -------------
!    -- Process --
!    -------------
  
!    procedure Process
!      (Object_File : String;
!       Success     : out Boolean)
!    is
!       pragma Unreferenced (Object_File);
!    begin
!       Success := False;
!    end Process;
  
     --------------
     -- Finalize --
--- 54,79 ----
        Success := False;
     end Initialize;
  
!    ----------------
!    -- Processing --
!    ----------------
  
!    package body Processing is
! 
!       -------------
!       -- Process --
!       -------------
! 
!       procedure Process
!         (Object_File : String;
!          Success     : out Boolean)
!       is
!          pragma Unreferenced (Object_File);
!       begin
!          Success := False;
!       end Process;
! 
!    end Processing;
  
     --------------
     -- Finalize --
diff -Nrcpad gcc-4.0.2/gcc/ada/symbols.ads gcc-4.1.0/gcc/ada/symbols.ads
*** gcc-4.0.2/gcc/ada/symbols.ads	Fri Jun 11 10:47:39 2004
--- gcc-4.1.0/gcc/ada/symbols.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with GNAT.OS_Lib;         use GNAT.OS_Li
*** 34,40 ****
  package Symbols is
  
     type Policy is
!    --  Symbol policy:
  
       (Autonomous,
        --  Create a symbol file without considering any reference
--- 34,40 ----
  package Symbols is
  
     type Policy is
!    --  Symbol policy
  
       (Autonomous,
        --  Create a symbol file without considering any reference
*************** package Symbols is
*** 44,50 ****
        --  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
  
        Restricted);
--- 44,50 ----
        --  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
  
        Restricted);
*************** package Symbols is
*** 86,96 ****
     --  Processing any object file. Depending on the platforms and the
     --  circumstances, additional messages may be issued if Quiet is False.
  
!    procedure Process
!      (Object_File : String;
!       Success     : out Boolean);
!    --  Get the symbols from an object file. Success is set to True if the
!    --  object file exists and has the expected format.
  
     procedure Finalize
       (Quiet   : Boolean;
--- 86,105 ----
     --  Processing any object file. Depending on the platforms and the
     --  circumstances, additional messages may be issued if Quiet is False.
  
!    package Processing is
! 
!    --  This package, containing a single visible procedure Process, exists so
!    --  that it can be a subunits, for some platforms (such as VMS Alpha and
!    --  IA64), the body of package Symbols is common, while the subunit
!    --  Processing is not.
! 
!       procedure Process
!         (Object_File : String;
!          Success     : out Boolean);
!       --  Get the symbols from an object file. Success is set to True if the
!       --  object file exists and has the expected format.
! 
!    end Processing;
  
     procedure Finalize
       (Quiet   : Boolean;
diff -Nrcpad gcc-4.0.2/gcc/ada/sysdep.c gcc-4.1.0/gcc/ada/sysdep.c
*** gcc-4.0.2/gcc/ada/sysdep.c	Wed Oct 27 12:28:44 2004
--- gcc-4.1.0/gcc/ada/sysdep.c	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-2004 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *          Copyright (C) 1992-2005 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** get_gmtoff (void)
*** 655,670 ****
  
  /* Definition of __gnat_locatime_r used by a-calend.adb */
  
! #if defined (_AIX) || defined (__EMX__)
  #define Lock_Task system__soft_links__lock_task
  extern void (*Lock_Task) (void);
  
  #define Unlock_Task system__soft_links__unlock_task
  extern void (*Unlock_Task) (void);
  
! /* Provide reentrant version of localtime on Aix and OS/2. Note that AiX does
!    provide localtime_r, but in the library libc_r which doesn't get included
!    systematically, so we can't use it. */
  
  extern struct tm *__gnat_localtime_r (const time_t *, struct tm *);
  
--- 655,668 ----
  
  /* Definition of __gnat_locatime_r used by a-calend.adb */
  
! #if defined (__EMX__)
  #define Lock_Task system__soft_links__lock_task
  extern void (*Lock_Task) (void);
  
  #define Unlock_Task system__soft_links__unlock_task
  extern void (*Unlock_Task) (void);
  
! /* Provide reentrant version of localtime on OS/2. */
  
  extern struct tm *__gnat_localtime_r (const time_t *, struct tm *);
  
diff -Nrcpad gcc-4.0.2/gcc/ada/system-aix.ads gcc-4.1.0/gcc/ada/system-aix.ads
*** gcc-4.0.2/gcc/ada/system-aix.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-aix.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                            (AIX/PPC Version)                             --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                            (AIX/PPC Version)                             --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-darwin-ppc.ads gcc-4.1.0/gcc/ada/system-darwin-ppc.ads
*** gcc-4.0.2/gcc/ada/system-darwin-ppc.ads	Fri Jan 14 15:12:29 2005
--- gcc-4.1.0/gcc/ada/system-darwin-ppc.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (Darwin/PPC Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (Darwin/PPC Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 144,149 ****
--- 145,151 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-freebsd-x86.ads gcc-4.1.0/gcc/ada/system-freebsd-x86.ads
*** gcc-4.0.2/gcc/ada/system-freebsd-x86.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-freebsd-x86.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (FreeBSD/x86 Version)                          --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (FreeBSD/x86 Version)                          --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-hpux-ia64.ads gcc-4.1.0/gcc/ada/system-hpux-ia64.ads
*** gcc-4.0.2/gcc/ada/system-hpux-ia64.ads	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gcc/ada/system-hpux-ia64.ads	Tue Nov 15 14:06:45 2005
***************
*** 0 ****
--- 1,153 ----
+ ------------------------------------------------------------------------------
+ --                                                                          --
+ --                        GNAT RUN-TIME COMPONENTS                          --
+ --                                                                          --
+ --                               S Y S T E M                                --
+ --                                                                          --
+ --                                 S p e c                                  --
+ --                            (HP-UX/ia64 Version)                          --
+ --                                                                          --
+ --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+ --                                                                          --
+ -- This specification is derived from the Ada Reference Manual for use with --
+ -- GNAT. The copyright notice above, and the license provisions that follow --
+ -- apply solely to the  contents of the part following the private keyword. --
+ --                                                                          --
+ -- GNAT is free software;  you can  redistribute it  and/or modify it under --
+ -- terms of the  GNU General Public License as published  by the Free Soft- --
+ -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+ -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+ -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+ -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+ -- for  more details.  You should have  received  a copy of the GNU General --
+ -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+ -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+ -- Boston, MA 02110-1301, USA.                                              --
+ --                                                                          --
+ -- As a special exception,  if other files  instantiate  generics from this --
+ -- unit, or you link  this unit with other files  to produce an executable, --
+ -- this  unit  does not  by itself cause  the resulting  executable  to  be --
+ -- covered  by the  GNU  General  Public  License.  This exception does not --
+ -- however invalidate  any other reasons why  the executable file  might be --
+ -- covered by the  GNU Public License.                                      --
+ --                                                                          --
+ -- GNAT was originally developed  by the GNAT team at  New York University. --
+ -- Extensive contributions were provided by Ada Core Technologies Inc.      --
+ --                                                                          --
+ ------------------------------------------------------------------------------
+ 
+ package System is
+    pragma Pure;
+    --  Note that we take advantage of the implementation permission to make
+    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
+    --  2005, this is Pure in any case (AI-362).
+ 
+    type Name is (SYSTEM_NAME_GNAT);
+    System_Name : constant Name := SYSTEM_NAME_GNAT;
+ 
+    --  System-Dependent Named Numbers
+ 
+    Min_Int               : constant := Long_Long_Integer'First;
+    Max_Int               : constant := Long_Long_Integer'Last;
+ 
+    Max_Binary_Modulus    : constant := 2 ** Long_Long_Integer'Size;
+    Max_Nonbinary_Modulus : constant := Integer'Last;
+ 
+    Max_Base_Digits       : constant := Long_Long_Float'Digits;
+    Max_Digits            : constant := Long_Long_Float'Digits;
+ 
+    Max_Mantissa          : constant := 63;
+    Fine_Delta            : constant := 2.0 ** (-Max_Mantissa);
+ 
+    Tick                  : constant := 0.01;
+ 
+    --  Storage-related Declarations
+ 
+    type Address is private;
+    Null_Address : constant Address;
+ 
+    Storage_Unit : constant := 8;
+    Word_Size    : constant := 64;
+    Memory_Size  : constant := 2 ** 64;
+ 
+    --  Address comparison
+ 
+    function "<"  (Left, Right : Address) return Boolean;
+    function "<=" (Left, Right : Address) return Boolean;
+    function ">"  (Left, Right : Address) return Boolean;
+    function ">=" (Left, Right : Address) return Boolean;
+    function "="  (Left, Right : Address) return Boolean;
+ 
+    pragma Import (Intrinsic, "<");
+    pragma Import (Intrinsic, "<=");
+    pragma Import (Intrinsic, ">");
+    pragma Import (Intrinsic, ">=");
+    pragma Import (Intrinsic, "=");
+ 
+    --  Other System-Dependent Declarations
+ 
+    type Bit_Order is (High_Order_First, Low_Order_First);
+    Default_Bit_Order : constant Bit_Order := High_Order_First;
+ 
+    --  Priority-related Declarations (RM D.1)
+ 
+    Max_Priority           : constant Positive := 30;
+    Max_Interrupt_Priority : constant Positive := 31;
+ 
+    subtype Any_Priority       is Integer      range  0 .. 31;
+    subtype Priority           is Any_Priority range  0 .. 30;
+    subtype Interrupt_Priority is Any_Priority range 31 .. 31;
+ 
+    Default_Priority : constant Priority := 15;
+ 
+ private
+ 
+    type Address is mod Memory_Size;
+    Null_Address : constant Address := 0;
+ 
+    --------------------------------------
+    -- System Implementation Parameters --
+    --------------------------------------
+ 
+    --  These parameters provide information about the target that is used
+    --  by the compiler. They are in the private part of System, where they
+    --  can be accessed using the special circuitry in the Targparm unit
+    --  whose source should be consulted for more detailed descriptions
+    --  of the individual switch values.
+ 
+    AAMP                      : constant Boolean := False;
+    Backend_Divide_Checks     : constant Boolean := False;
+    Backend_Overflow_Checks   : constant Boolean := False;
+    Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
+    Configurable_Run_Time     : constant Boolean := False;
+    Denorm                    : constant Boolean := True;
+    Duration_32_Bits          : constant Boolean := False;
+    Exit_Status_Supported     : constant Boolean := True;
+    Fractional_Fixed_Ops      : constant Boolean := False;
+    Frontend_Layout           : constant Boolean := False;
+    Functions_Return_By_DSP   : constant Boolean := False;
+    Machine_Overflows         : constant Boolean := False;
+    Machine_Rounds            : constant Boolean := True;
+    OpenVMS                   : constant Boolean := False;
+    Preallocated_Stacks       : constant Boolean := False;
+    Signed_Zeros              : constant Boolean := True;
+    Stack_Check_Default       : constant Boolean := False;
+    Stack_Check_Probes        : constant Boolean := False;
+    Support_64_Bit_Divides    : constant Boolean := True;
+    Support_Aggregates        : constant Boolean := True;
+    Support_Composite_Assign  : constant Boolean := True;
+    Support_Composite_Compare : constant Boolean := True;
+    Support_Long_Shifts       : constant Boolean := True;
+    Suppress_Standard_Library : constant Boolean := False;
+    Use_Ada_Main_Program_Name : constant Boolean := False;
+    ZCX_By_Default            : constant Boolean := False;
+    GCC_ZCX_Support           : constant Boolean := False;
+    Front_End_ZCX_Support     : constant Boolean := False;
+ 
+    --  Obsolete entries, to be removed eventually (bootstrap issues!)
+ 
+    High_Integrity_Mode       : constant Boolean := False;
+    Long_Shifts_Inlined       : constant Boolean := True;
+ 
+ end System;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-hpux.ads gcc-4.1.0/gcc/ada/system-hpux.ads
*** gcc-4.0.2/gcc/ada/system-hpux.ads	Thu Apr  7 20:03:51 2005
--- gcc-4.1.0/gcc/ada/system-hpux.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                             (HP-UX Version)                              --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                             (HP-UX Version)                              --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-interix.ads gcc-4.1.0/gcc/ada/system-interix.ads
*** gcc-4.0.2/gcc/ada/system-interix.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-interix.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                        (OpenNT/Interix Version)                          --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                        (OpenNT/Interix Version)                          --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-irix-n32.ads gcc-4.1.0/gcc/ada/system-irix-n32.ads
*** gcc-4.0.2/gcc/ada/system-irix-n32.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-irix-n32.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (SGI Irix, n32 ABI)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (SGI Irix, n32 ABI)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 130,135 ****
--- 131,137 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-irix-o32.ads gcc-4.1.0/gcc/ada/system-irix-o32.ads
*** gcc-4.0.2/gcc/ada/system-irix-o32.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-irix-o32.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (SGI Irix, o32 ABI)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (SGI Irix, o32 ABI)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-alpha.ads gcc-4.1.0/gcc/ada/system-linux-alpha.ads
*** gcc-4.0.2/gcc/ada/system-linux-alpha.ads	Thu Jan 20 18:27:10 2005
--- gcc-4.1.0/gcc/ada/system-linux-alpha.ads	Mon Aug 15 23:38:44 2005
***************
*** 5,13 ****
  --                               S Y S T E M                                --
  --                                                                          --
  --                                 S p e c                                  --
! --                         (GNU-Linux/ia64 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 5,13 ----
  --                               S Y S T E M                                --
  --                                                                          --
  --                                 S p e c                                  --
! --                        (GNU-Linux/alpha Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 118,123 ****
--- 118,124 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-hppa.ads gcc-4.1.0/gcc/ada/system-linux-hppa.ads
*** gcc-4.0.2/gcc/ada/system-linux-hppa.ads	Thu Apr  7 20:03:51 2005
--- gcc-4.1.0/gcc/ada/system-linux-hppa.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU/Linux-HPPA Version)                        --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU/Linux-HPPA Version)                        --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-ia64.ads gcc-4.1.0/gcc/ada/system-linux-ia64.ads
*** gcc-4.0.2/gcc/ada/system-linux-ia64.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-linux-ia64.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                         (GNU-Linux/ia64 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                         (GNU-Linux/ia64 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-ppc.ads gcc-4.1.0/gcc/ada/system-linux-ppc.ads
*** gcc-4.0.2/gcc/ada/system-linux-ppc.ads	Tue Jan 18 21:37:25 2005
--- gcc-4.1.0/gcc/ada/system-linux-ppc.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU-Linux/PPC Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU-Linux/PPC Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-s390.ads gcc-4.1.0/gcc/ada/system-linux-s390.ads
*** gcc-4.0.2/gcc/ada/system-linux-s390.ads	Tue Jan 11 23:29:24 2005
--- gcc-4.1.0/gcc/ada/system-linux-s390.ads	Fri Jul  1 01:29:17 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU-Linux/s390 Version)                        --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU-Linux/s390 Version)                        --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 118,123 ****
--- 118,124 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-s390x.ads gcc-4.1.0/gcc/ada/system-linux-s390x.ads
*** gcc-4.0.2/gcc/ada/system-linux-s390x.ads	Tue Jan 11 23:29:24 2005
--- gcc-4.1.0/gcc/ada/system-linux-s390x.ads	Fri Jul  1 01:29:17 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU-Linux/s390x Version)                       --
  --                                                                          --
! --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU-Linux/s390x Version)                       --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 118,123 ****
--- 118,124 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-sparc.ads gcc-4.1.0/gcc/ada/system-linux-sparc.ads
*** gcc-4.0.2/gcc/ada/system-linux-sparc.ads	Tue Mar  8 21:22:47 2005
--- gcc-4.1.0/gcc/ada/system-linux-sparc.ads	Fri Jul  1 01:29:17 2005
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** private
*** 118,123 ****
--- 118,124 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-x86.ads gcc-4.1.0/gcc/ada/system-linux-x86.ads
*** gcc-4.0.2/gcc/ada/system-linux-x86.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-linux-x86.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU-Linux/x86 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU-Linux/x86 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-linux-x86_64.ads gcc-4.1.0/gcc/ada/system-linux-x86_64.ads
*** gcc-4.0.2/gcc/ada/system-linux-x86_64.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-linux-x86_64.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (GNU-Linux/x86-64 Version)                      --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (GNU-Linux/x86-64 Version)                      --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-lynxos-ppc.ads gcc-4.1.0/gcc/ada/system-lynxos-ppc.ads
*** gcc-4.0.2/gcc/ada/system-lynxos-ppc.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-lynxos-ppc.ads	Tue Nov 15 13:51:38 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (LynxOS PPC Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (LynxOS PPC Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** pragma Pure (System);
*** 90,103 ****
  
     --  Priority-related Declarations (RM D.1)
  
!    Max_Priority           : constant Positive := 254;
     Max_Interrupt_Priority : constant Positive := 255;
  
     subtype Any_Priority       is Integer      range   0 .. 255;
!    subtype Priority           is Any_Priority range   0 .. 254;
!    subtype Interrupt_Priority is Any_Priority range 255 .. 255;
  
!    Default_Priority : constant Priority := 15;
  
  private
  
--- 91,118 ----
  
     --  Priority-related Declarations (RM D.1)
  
!    --  17 is the system determined default priority for user applications
!    --  running on LynxOS.
! 
!    --  The standard (Rm 13.7) requires that Default_Priority has the value:
! 
!    --  (Priority'First + Priority'Last) / 2.
! 
!    --  To allow an appropriate value for Default_Priority and expose a useful
!    --  range of priorities to the user, we use a range of 0 .. 34 for subtype
!    --  Priority.
! 
!    --  The rest of the range allowed by the system from 35 to 255 is made
!    --  available here in Interrupt_Priority.
! 
!    Max_Priority           : constant Positive := 34;
     Max_Interrupt_Priority : constant Positive := 255;
  
     subtype Any_Priority       is Integer      range   0 .. 255;
!    subtype Priority           is Any_Priority range   0 .. 34;
!    subtype Interrupt_Priority is Any_Priority range  35 .. 255;
  
!    Default_Priority : constant Priority := 17;
  
  private
  
*************** private
*** 118,123 ****
--- 133,139 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-lynxos-x86.ads gcc-4.1.0/gcc/ada/system-lynxos-x86.ads
*** gcc-4.0.2/gcc/ada/system-lynxos-x86.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-lynxos-x86.ads	Tue Nov 15 13:51:38 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (LynxOS x86 Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (LynxOS x86 Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** pragma Pure (System);
*** 90,103 ****
  
     --  Priority-related Declarations (RM D.1)
  
!    Max_Priority           : constant Positive := 254;
     Max_Interrupt_Priority : constant Positive := 255;
  
     subtype Any_Priority       is Integer      range   0 .. 255;
!    subtype Priority           is Any_Priority range   0 .. 254;
!    subtype Interrupt_Priority is Any_Priority range 255 .. 255;
  
!    Default_Priority : constant Priority := 15;
  
  private
  
--- 91,118 ----
  
     --  Priority-related Declarations (RM D.1)
  
!    --  17 is the system determined default priority for user applications
!    --  running on LynxOS.
! 
!    --  The standard (Rm 13.7) requires that Default_Priority has the value:
! 
!    --  (Priority'First + Priority'Last) / 2.
! 
!    --  To allow an appropriate value for Default_Priority and expose a useful
!    --  range of priorities to the user, we use a range of 0 .. 34 for subtype
!    --  Priority.
! 
!    --  The rest of the range allowed by the system from 35 to 255 is made
!    --  available here in Interrupt_Priority.
! 
!    Max_Priority           : constant Positive := 34;
     Max_Interrupt_Priority : constant Positive := 255;
  
     subtype Any_Priority       is Integer      range   0 .. 255;
!    subtype Priority           is Any_Priority range   0 .. 34;
!    subtype Interrupt_Priority is Any_Priority range  35 .. 255;
  
!    Default_Priority : constant Priority := 17;
  
  private
  
*************** private
*** 118,123 ****
--- 133,139 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-mingw.ads gcc-4.1.0/gcc/ada/system-mingw.ads
*** gcc-4.0.2/gcc/ada/system-mingw.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-mingw.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                               (NT Version)                               --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                               (NT Version)                               --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-os2.ads gcc-4.1.0/gcc/ada/system-os2.ads
*** gcc-4.0.2/gcc/ada/system-os2.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-os2.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                             (OS/2 Version)                               --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                             (OS/2 Version)                               --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-solaris-sparc.ads gcc-4.1.0/gcc/ada/system-solaris-sparc.ads
*** gcc-4.0.2/gcc/ada/system-solaris-sparc.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-solaris-sparc.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (SUN Solaris Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (SUN Solaris Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-solaris-sparcv9.ads gcc-4.1.0/gcc/ada/system-solaris-sparcv9.ads
*** gcc-4.0.2/gcc/ada/system-solaris-sparcv9.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-solaris-sparcv9.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                        (Solaris Sparcv9 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                        (Solaris Sparcv9 Version)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-solaris-x86.ads gcc-4.1.0/gcc/ada/system-solaris-x86.ads
*** gcc-4.0.2/gcc/ada/system-solaris-x86.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-solaris-x86.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (x86 Solaris Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (x86 Solaris Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-tru64.ads gcc-4.1.0/gcc/ada/system-tru64.ads
*** gcc-4.0.2/gcc/ada/system-tru64.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-tru64.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                           (DEC Unix Version)                             --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                           (DEC Unix Version)                             --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-unixware.ads gcc-4.1.0/gcc/ada/system-unixware.ads
*** gcc-4.0.2/gcc/ada/system-unixware.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-unixware.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                         (SCO UnixWare Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                         (SCO UnixWare Version)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vms-zcx.ads gcc-4.1.0/gcc/ada/system-vms-zcx.ads
*** gcc-4.0.2/gcc/ada/system-vms-zcx.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vms-zcx.ads	Tue Nov 15 14:06:45 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                   (OpenVMS GCC_ZCX DEC Threads Version)                  --
  --                                                                          --
! --          Copyright (C) 2002-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                   (OpenVMS GCC_ZCX DEC Threads Version)                  --
  --                                                                          --
! --          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vms.ads gcc-4.1.0/gcc/ada/system-vms.ads
*** gcc-4.0.2/gcc/ada/system-vms.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vms.ads	Tue Nov 15 13:52:00 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                       (OpenVMS DEC Threads Version)                      --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                       (OpenVMS DEC Threads Version)                      --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 118,123 ****
--- 119,125 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
*************** private
*** 234,237 ****
--- 236,244 ----
     --  {Import,Export}_Exception. Put here because this is the only
     --  VMS specific package that doesn't drag in tasking.
  
+    ADA_GNAT : constant Boolean := True;
+    pragma Export_Object (ADA_GNAT, "ADA$GNAT");
+    --  Uniquitous global symbol identifing a GNAT compiled image to VMS Debug.
+    --  Do not remove!
+ 
  end System;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vms_64.ads gcc-4.1.0/gcc/ada/system-vms_64.ads
*** gcc-4.0.2/gcc/ada/system-vms_64.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vms_64.ads	Tue Nov 15 13:52:00 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                (OpenVMS 64bit GCC_ZCX DEC Threads Version)               --
  --                                                                          --
! --             Copyright (C) 2004 Free Software Foundation, Inc.            --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                (OpenVMS 64bit GCC_ZCX DEC Threads Version)               --
  --                                                                          --
! --          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 137,142 ****
--- 138,144 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := True;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
*************** private
*** 253,256 ****
--- 255,263 ----
     --  {Import,Export}_Exception. Put here because this is the only
     --  VMS specific package that doesn't drag in tasking.
  
+    ADA_GNAT : constant Boolean := True;
+    pragma Export_Object (ADA_GNAT, "ADA$GNAT");
+    --  Uniquitous global symbol identifing a GNAT compiled image to VMS Debug.
+    --  Do not remove!
+ 
  end System;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-alpha.ads gcc-4.1.0/gcc/ada/system-vxworks-alpha.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-alpha.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-alpha.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                         (VxWorks Version Alpha)                          --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                         (VxWorks Version Alpha)                          --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 126,131 ****
--- 127,133 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-m68k.ads gcc-4.1.0/gcc/ada/system-vxworks-m68k.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-m68k.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-m68k.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (VxWorks version M68K)                          --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (VxWorks version M68K)                          --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 126,131 ****
--- 127,133 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-mips.ads gcc-4.1.0/gcc/ada/system-vxworks-mips.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-mips.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-mips.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                         (VxWorks Version Mips)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                         (VxWorks Version Mips)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 126,131 ****
--- 127,133 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := False;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-ppc.ads gcc-4.1.0/gcc/ada/system-vxworks-ppc.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-ppc.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-ppc.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                          (VxWorks Version PPC)                           --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                          (VxWorks Version PPC)                           --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 126,131 ****
--- 127,133 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-sparcv9.ads gcc-4.1.0/gcc/ada/system-vxworks-sparcv9.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-sparcv9.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-sparcv9.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                       (VxWorks Version Sparc/64)                         --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                       (VxWorks Version Sparc/64)                         --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 128,133 ****
--- 129,135 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-x86.ads gcc-4.1.0/gcc/ada/system-vxworks-x86.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-x86.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-x86.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                         (VxWorks Version x86)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                         (VxWorks Version x86)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 37,45 ****
  ------------------------------------------------------------------------------
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 37,46 ----
  ------------------------------------------------------------------------------
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
*************** private
*** 126,131 ****
--- 127,133 ----
     Backend_Divide_Checks     : constant Boolean := False;
     Backend_Overflow_Checks   : constant Boolean := False;
     Command_Line_Args         : constant Boolean := False;
+    Compiler_System_Version   : constant Boolean := False;
     Configurable_Run_Time     : constant Boolean := False;
     Denorm                    : constant Boolean := True;
     Duration_32_Bits          : constant Boolean := False;
diff -Nrcpad gcc-4.0.2/gcc/ada/system-vxworks-xscale.ads gcc-4.1.0/gcc/ada/system-vxworks-xscale.ads
*** gcc-4.0.2/gcc/ada/system-vxworks-xscale.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system-vxworks-xscale.ads	Thu Jan  1 00:00:00 1970
***************
*** 1,159 ****
- ------------------------------------------------------------------------------
- --                                                                          --
- --                        GNAT RUN-TIME COMPONENTS                          --
- --                                                                          --
- --                               S Y S T E M                                --
- --                                                                          --
- --                                 S p e c                                  --
- --                         (VxWorks Version Xscale)                         --
- --                                                                          --
- --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
- --                                                                          --
- -- This specification is derived from the Ada Reference Manual for use with --
- -- GNAT. The copyright notice above, and the license provisions that follow --
- -- apply solely to the  contents of the part following the private keyword. --
- --                                                                          --
- -- GNAT is free software;  you can  redistribute it  and/or modify it under --
- -- terms of the  GNU General Public License as published  by the Free Soft- --
- -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
- -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
- -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
- -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
- -- for  more details.  You should have  received  a copy of the GNU General --
- -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
- -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
- -- MA 02111-1307, USA.                                                      --
- --                                                                          --
- -- As a special exception,  if other files  instantiate  generics from this --
- -- unit, or you link  this unit with other files  to produce an executable, --
- -- this  unit  does not  by itself cause  the resulting  executable  to  be --
- -- covered  by the  GNU  General  Public  License.  This exception does not --
- -- however invalidate  any other reasons why  the executable file  might be --
- -- covered by the  GNU Public License.                                      --
- --                                                                          --
- -- GNAT was originally developed  by the GNAT team at  New York University. --
- -- Extensive contributions were provided by Ada Core Technologies Inc.      --
- --                                                                          --
- ------------------------------------------------------------------------------
- 
- package System is
- pragma Pure (System);
- --  Note that we take advantage of the implementation permission to
- --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
- 
-    type Name is (SYSTEM_NAME_GNAT);
-    System_Name : constant Name := SYSTEM_NAME_GNAT;
- 
-    --  System-Dependent Named Numbers
- 
-    Min_Int               : constant := Long_Long_Integer'First;
-    Max_Int               : constant := Long_Long_Integer'Last;
- 
-    Max_Binary_Modulus    : constant := 2 ** Long_Long_Integer'Size;
-    Max_Nonbinary_Modulus : constant := Integer'Last;
- 
-    Max_Base_Digits       : constant := Long_Long_Float'Digits;
-    Max_Digits            : constant := Long_Long_Float'Digits;
- 
-    Max_Mantissa          : constant := 63;
-    Fine_Delta            : constant := 2.0 ** (-Max_Mantissa);
- 
-    Tick                  : constant := 1.0 / 60.0;
- 
-    --  Storage-related Declarations
- 
-    type Address is private;
-    Null_Address : constant Address;
- 
-    Storage_Unit : constant := 8;
-    Word_Size    : constant := 32;
-    Memory_Size  : constant := 2 ** 32;
- 
-    --  Address comparison
- 
-    function "<"  (Left, Right : Address) return Boolean;
-    function "<=" (Left, Right : Address) return Boolean;
-    function ">"  (Left, Right : Address) return Boolean;
-    function ">=" (Left, Right : Address) return Boolean;
-    function "="  (Left, Right : Address) return Boolean;
- 
-    pragma Import (Intrinsic, "<");
-    pragma Import (Intrinsic, "<=");
-    pragma Import (Intrinsic, ">");
-    pragma Import (Intrinsic, ">=");
-    pragma Import (Intrinsic, "=");
- 
-    --  Other System-Dependent Declarations
- 
-    type Bit_Order is (High_Order_First, Low_Order_First);
-    Default_Bit_Order : constant Bit_Order := Low_Order_First;
- 
-    --  Priority-related Declarations (RM D.1)
- 
-    --  256        is reserved for the VxWorks kernel
-    --  248 - 255  correspond to hardware interrupt levels 0 .. 7
-    --  247        is a catchall default "interrupt" priority for signals,
-    --             allowing higher priority than normal tasks, but lower than
-    --             hardware priority levels.  Protected Object ceilings can
-    --             override these values.
-    --  246        is used by the Interrupt_Manager task
- 
-    Max_Priority           : constant Positive := 245;
-    Max_Interrupt_Priority : constant Positive := 255;
- 
-    subtype Any_Priority       is Integer      range   0 .. 255;
-    subtype Priority           is Any_Priority range   0 .. 245;
-    subtype Interrupt_Priority is Any_Priority range 246 .. 255;
- 
-    Default_Priority : constant Priority := 122;
- 
- private
- 
-    type Address is mod Memory_Size;
-    Null_Address : constant Address := 0;
- 
-    --------------------------------------
-    -- System Implementation Parameters --
-    --------------------------------------
- 
-    --  These parameters provide information about the target that is used
-    --  by the compiler. They are in the private part of System, where they
-    --  can be accessed using the special circuitry in the Targparm unit
-    --  whose source should be consulted for more detailed descriptions
-    --  of the individual switch values.
- 
-    AAMP                      : constant Boolean := False;
-    Backend_Divide_Checks     : constant Boolean := False;
-    Backend_Overflow_Checks   : constant Boolean := False;
-    Command_Line_Args         : constant Boolean := False;
-    Configurable_Run_Time     : constant Boolean := False;
-    Denorm                    : constant Boolean := True;
-    Duration_32_Bits          : constant Boolean := False;
-    Exit_Status_Supported     : constant Boolean := True;
-    Fractional_Fixed_Ops      : constant Boolean := False;
-    Frontend_Layout           : constant Boolean := False;
-    Functions_Return_By_DSP   : constant Boolean := False;
-    Machine_Overflows         : constant Boolean := False;
-    Machine_Rounds            : constant Boolean := True;
-    OpenVMS                   : constant Boolean := False;
-    Preallocated_Stacks       : constant Boolean := False;
-    Signed_Zeros              : constant Boolean := True;
-    Stack_Check_Default       : constant Boolean := False;
-    Stack_Check_Probes        : constant Boolean := False;
-    Support_64_Bit_Divides    : constant Boolean := True;
-    Support_Aggregates        : constant Boolean := True;
-    Support_Composite_Assign  : constant Boolean := True;
-    Support_Composite_Compare : constant Boolean := True;
-    Support_Long_Shifts       : constant Boolean := True;
-    Suppress_Standard_Library : constant Boolean := False;
-    Use_Ada_Main_Program_Name : constant Boolean := True;
-    ZCX_By_Default            : constant Boolean := False;
-    GCC_ZCX_Support           : constant Boolean := False;
-    Front_End_ZCX_Support     : constant Boolean := False;
- 
-    --  Obsolete entries, to be removed eventually (bootstrap issues!)
- 
-    High_Integrity_Mode       : constant Boolean := False;
-    Long_Shifts_Inlined       : constant Boolean := False;
- 
- end System;
--- 0 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/system.ads gcc-4.1.0/gcc/ada/system.ads
*** gcc-4.0.2/gcc/ada/system.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/system.ads	Mon Sep  5 07:51:25 2005
***************
*** 7,13 ****
  --                                 S p e c                                  --
  --                            (Compiler Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
--- 7,13 ----
  --                                 S p e c                                  --
  --                            (Compiler Version)                            --
  --                                                                          --
! --          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
  --                                                                          --
  -- This specification is derived from the Ada Reference Manual for use with --
  -- GNAT. The copyright notice above, and the license provisions that follow --
***************
*** 21,28 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 21,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 42,50 ****
  --  about most System parameters, this generic version works fine.
  
  package System is
! pragma Pure (System);
! --  Note that we take advantage of the implementation permission to
! --  make this unit Pure instead of Preelaborable, see RM 13.7(36)
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
--- 42,51 ----
  --  about most System parameters, this generic version works fine.
  
  package System is
!    pragma Pure;
!    --  Note that we take advantage of the implementation permission to make
!    --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
!    --  2005, this is Pure in any case (AI-362).
  
     type Name is (SYSTEM_NAME_GNAT);
     System_Name : constant Name := SYSTEM_NAME_GNAT;
diff -Nrcpad gcc-4.0.2/gcc/ada/table.adb gcc-4.1.0/gcc/ada/table.adb
*** gcc-4.0.2/gcc/ada/table.adb	Fri Mar  5 10:58:58 2004
--- gcc-4.1.0/gcc/ada/table.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/table.ads gcc-4.1.0/gcc/ada/table.ads
*** gcc-4.0.2/gcc/ada/table.ads	Tue Oct 21 13:42:22 2003
--- gcc-4.1.0/gcc/ada/table.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 43,49 ****
  with Types; use Types;
  
  package Table is
! pragma Elaborate_Body (Table);
  
     generic
        type Table_Component_Type is private;
--- 43,49 ----
  with Types; use Types;
  
  package Table is
!    pragma Elaborate_Body;
  
     generic
        type Table_Component_Type is private;
*************** pragma Elaborate_Body (Table);
*** 174,184 ****
  
        procedure Increment_Last;
        pragma Inline (Increment_Last);
!       --  Adds 1 to Last (same as Set_Last (Last + 1).
  
        procedure Decrement_Last;
        pragma Inline (Decrement_Last);
!       --  Subtracts 1 from Last (same as Set_Last (Last - 1).
  
        procedure Append (New_Val : Table_Component_Type);
        pragma Inline (Append);
--- 174,184 ----
  
        procedure Increment_Last;
        pragma Inline (Increment_Last);
!       --  Adds 1 to Last (same as Set_Last (Last + 1)
  
        procedure Decrement_Last;
        pragma Inline (Decrement_Last);
!       --  Subtracts 1 from Last (same as Set_Last (Last - 1)
  
        procedure Append (New_Val : Table_Component_Type);
        pragma Inline (Append);
diff -Nrcpad gcc-4.0.2/gcc/ada/targparm.adb gcc-4.1.0/gcc/ada/targparm.adb
*** gcc-4.0.2/gcc/ada/targparm.adb	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/targparm.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Targparm is
*** 44,50 ****
        BDC,  --   Backend_Divide_Checks
        BOC,  --   Backend_Overflow_Checks
        CLA,  --   Command_Line_Args
!       CRT,  --   Configurable_Run_Time
        D32,  --   Duration_32_Bits
        DEN,  --   Denorm
        DSP,  --   Functions_Return_By_DSP
--- 44,51 ----
        BDC,  --   Backend_Divide_Checks
        BOC,  --   Backend_Overflow_Checks
        CLA,  --   Command_Line_Args
!       CRT,  --   Configurable_Run_Times
!       CSV,  --   Compiler_System_Version
        D32,  --   Duration_32_Bits
        DEN,  --   Denorm
        DSP,  --   Functions_Return_By_DSP
*************** package body Targparm is
*** 66,80 ****
        UAM,  --   Use_Ada_Main_Program_Name
        VMS,  --   OpenVMS
        ZCD,  --   ZCX_By_Default
!       ZCG,  --   GCC_ZCX_Support
!       ZCF,  --   Front_End_ZCX_Support
! 
!    --  The following entries are obsolete and can eventually be removed
! 
!       HIM,  --   High_Integrity_Mode
!       LSI); --   Long_Shifts_Inlined
  
!    subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCF;
     --  Range excluding obsolete entries
  
     Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
--- 67,75 ----
        UAM,  --   Use_Ada_Main_Program_Name
        VMS,  --   OpenVMS
        ZCD,  --   ZCX_By_Default
!       ZCG); --   GCC_ZCX_Support
  
!    subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCG;
     --  Range excluding obsolete entries
  
     Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
*************** package body Targparm is
*** 87,92 ****
--- 82,88 ----
     BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
     CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
     CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
+    CSV_Str : aliased constant Source_Buffer := "Compiler_System_Version";
     D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
     DEN_Str : aliased constant Source_Buffer := "Denorm";
     DSP_Str : aliased constant Source_Buffer := "Functions_Return_By_DSP";
*************** package body Targparm is
*** 109,120 ****
     VMS_Str : aliased constant Source_Buffer := "OpenVMS";
     ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
     ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
-    ZCF_Str : aliased constant Source_Buffer := "Front_End_ZCX_Support";
- 
-    --  Obsolete entries
- 
-    HIM_Str : aliased constant Source_Buffer := "High_Integrity_Mode";
-    LSI_Str : aliased constant Source_Buffer := "Long_Shifts_Inlined";
  
     --  The following defines a set of pointers to the above strings,
     --  indexed by the tag values.
--- 105,110 ----
*************** package body Targparm is
*** 126,131 ****
--- 116,122 ----
        BOC_Str'Access,
        CLA_Str'Access,
        CRT_Str'Access,
+       CSV_Str'Access,
        D32_Str'Access,
        DEN_Str'Access,
        DSP_Str'Access,
*************** package body Targparm is
*** 147,159 ****
        UAM_Str'Access,
        VMS_Str'Access,
        ZCD_Str'Access,
!       ZCG_Str'Access,
!       ZCF_Str'Access,
! 
!       --  Obsolete entries
! 
!       HIM_Str'Access,
!       LSI_Str'Access);
  
     -----------------------
     -- Local Subprograms --
--- 138,144 ----
        UAM_Str'Access,
        VMS_Str'Access,
        ZCD_Str'Access,
!       ZCG_Str'Access);
  
     -----------------------
     -- Local Subprograms --
*************** package body Targparm is
*** 237,242 ****
--- 222,229 ----
           Parameters_Obtained := True;
        end if;
  
+       Opt.Address_Is_Private := False;
+ 
        P := Source_First;
        Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop
  
*************** package body Targparm is
*** 245,250 ****
--- 232,244 ----
           if System_Text (P) = '-' then
              goto Line_Loop_Continue;
  
+          --  Test for type Address is private
+ 
+          elsif System_Text (P .. P + 26) = "   type Address is private;" then
+             Opt.Address_Is_Private := True;
+             P := P + 26;
+             goto Line_Loop_Continue;
+ 
           --  Test for pragma Profile (Ravenscar);
  
           elsif System_Text (P .. P + 26) =
*************** package body Targparm is
*** 252,258 ****
           then
              Set_Profile_Restrictions (Ravenscar);
              Opt.Task_Dispatching_Policy := 'F';
!             Opt.Locking_Policy     := 'C';
              P := P + 27;
              goto Line_Loop_Continue;
  
--- 246,252 ----
           then
              Set_Profile_Restrictions (Ravenscar);
              Opt.Task_Dispatching_Policy := 'F';
!             Opt.Locking_Policy          := 'C';
              P := P + 27;
              goto Line_Loop_Continue;
  
*************** package body Targparm is
*** 513,519 ****
                 then
                    P := P + 3 + Targparm_Str (K)'Length;
  
- 
                    if Targparm_Flags (K) then
                       Set_Standard_Error;
                       Write_Line
--- 507,512 ----
*************** package body Targparm is
*** 552,557 ****
--- 545,551 ----
                       when BOC => Backend_Overflow_Checks_On_Target   := Result;
                       when CLA => Command_Line_Args_On_Target         := Result;
                       when CRT => Configurable_Run_Time_On_Target     := Result;
+                      when CSV => Compiler_System_Version             := Result;
                       when D32 => Duration_32_Bits_On_Target          := Result;
                       when DEN => Denorm_On_Target                    := Result;
                       when DSP => Functions_Return_By_DSP_On_Target   := Result;
*************** package body Targparm is
*** 574,588 ****
                       when VMS => OpenVMS_On_Target                   := Result;
                       when ZCD => ZCX_By_Default_On_Target            := Result;
                       when ZCG => GCC_ZCX_Support_On_Target           := Result;
-                      when ZCF => Front_End_ZCX_Support_On_Target     := Result;
- 
-                      --  Obsolete entries
- 
-                      when HIM => null;
-                      when LSI => null;
  
                       goto Line_Loop_Continue;
                    end case;
                 end if;
              end loop Config_Param_Loop;
           end if;
--- 568,581 ----
                       when VMS => OpenVMS_On_Target                   := Result;
                       when ZCD => ZCX_By_Default_On_Target            := Result;
                       when ZCG => GCC_ZCX_Support_On_Target           := Result;
  
                       goto Line_Loop_Continue;
                    end case;
+ 
+                   --  Here we are seeing a parameter we do not understand. We
+                   --  simply ignore this (will happen when an old compiler is
+                   --  used to compile a newer version of GNAT which does not
+                   --  support the
                 end if;
              end loop Config_Param_Loop;
           end if;
*************** package body Targparm is
*** 610,633 ****
           end if;
        end loop Line_Loop;
  
!       --  Check no missing target parameter settings
  
!       for K in Targparm_Tags_OK loop
!          if not Targparm_Flags (K) then
!             Set_Standard_Error;
!             Write_Line
!               ("fatal error: system.ads is incorrectly formatted");
!             Write_Str ("missing line for parameter: ");
  
!             for J in Targparm_Str (K)'Range loop
!                Write_Char (Targparm_Str (K).all (J));
!             end loop;
  
!             Write_Eol;
!             Set_Standard_Output;
!             Fatal := True;
!          end if;
!       end loop;
  
        if Fatal then
           raise Unrecoverable_Error;
--- 603,628 ----
           end if;
        end loop Line_Loop;
  
!       --  Check no missing target parameter settings (skip for compiler vsn)
  
!       if not Compiler_System_Version then
!          for K in Targparm_Tags_OK loop
!             if not Targparm_Flags (K) then
!                Set_Standard_Error;
!                Write_Line
!                  ("fatal error: system.ads is incorrectly formatted");
!                Write_Str ("missing line for parameter: ");
  
!                for J in Targparm_Str (K)'Range loop
!                   Write_Char (Targparm_Str (K).all (J));
!                end loop;
  
!                Write_Eol;
!                Set_Standard_Output;
!                Fatal := True;
!             end if;
!          end loop;
!       end if;
  
        if Fatal then
           raise Unrecoverable_Error;
diff -Nrcpad gcc-4.0.2/gcc/ada/targparm.ads gcc-4.1.0/gcc/ada/targparm.ads
*** gcc-4.0.2/gcc/ada/targparm.ads	Mon Oct  4 14:51:16 2004
--- gcc-4.1.0/gcc/ada/targparm.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1999-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 48,54 ****
  --  computed and set in the ali file. This partially negates points 1 and 2
  --  above although just parsing is quick and does not impact debugging much.
  
! --  The parameters acquired by this routine from system.ads fall into three
  --  categories:
  
  --     1. Configuration pragmas, that must appear at the start of the file.
--- 48,54 ----
  --  computed and set in the ali file. This partially negates points 1 and 2
  --  above although just parsing is quick and does not impact debugging much.
  
! --  The parameters acquired by this routine from system.ads fall into four
  --  categories:
  
  --     1. Configuration pragmas, that must appear at the start of the file.
***************
*** 66,71 ****
--- 66,74 ----
  --        line may be ommitted for a version of system.ads to be used with
  --        the full Ada 95 run time.
  
+ --     4. Other characterisitics of package System. At the current time the
+ --        only item in this category is whether type Address is private.
+ 
  with Rident; use Rident;
  with Types;  use Types;
  
*************** package Targparm is
*** 115,120 ****
--- 118,127 ----
     --  that in this context, only one restriction can be specified in a single
     --  pragma, and the pragma must appear on its own on a single source line.
  
+    --  If package System contains exactly the line "type Address is private;"
+    --  then the flag Opt.Address_Is_Private is set True, otherwise this flag
+    --  is set False.
+ 
     Restrictions_On_Target : Restrictions_Info;
     --  Records restrictions specified by system.ads. Only the Set and Value
     --  members are modified. The Violated and Count fields are never modified.
*************** package Targparm is
*** 161,175 ****
     --  Get_Target_Parameters routine which reads the values from a provided
     --  text buffer containing the source of the system package.
  
     ----------------------------
     -- Special Target Control --
     ----------------------------
  
     --  The great majority of GNAT ports are based on GCC. The switches in
!    --  This section indicate the use of some non-standard target back end.
  
!    AAMP_On_Target : Boolean;
!    --  Set to True if target is AAMP.
  
     -------------------------------
     -- Backend Arithmetic Checks --
--- 168,206 ----
     --  Get_Target_Parameters routine which reads the values from a provided
     --  text buffer containing the source of the system package.
  
+    --  The default values here are used if no value is found in system.ads.
+    --  This should normally happen only if the special version of system.ads
+    --  used by the compiler itself is in use. The default values are suitable
+    --  for use by the compiler itself in normal environments. This approach
+    --  allows the possibility of new versions of the compiler (possibly with
+    --  new system parameters added) being used to compile older versions of
+    --  the compiler sources. This is not guaranteed to work, but often will
+    --  and by setting appropriate default values, we make it more likely that
+    --  this can succeed.
+ 
+    Compiler_System_Version : Boolean := True;
+    --  This is set False in all target dependent versions of System. In the
+    --  compiler default version, it is omitted entirely, meaning that the
+    --  above default value of True will be set. If the flag is False, then
+    --  the scanning circuits in the body of this package do an error check to
+    --  ensure that all parameters other than this one are specified and not
+    --  defaulted. If the parameter is set True, then this check is omitted,
+    --  and any parameters not present in system.ads are left set to their
+    --  default value as described above.
+ 
     ----------------------------
     -- Special Target Control --
     ----------------------------
  
     --  The great majority of GNAT ports are based on GCC. The switches in
!    --  This section indicate the use of some non-standard target back end
!    --  or other special targetting requirements.
  
!    AAMP_On_Target : Boolean := False;
!    --  Set to True if target is AAMP
! 
!    OpenVMS_On_Target : Boolean := False;
!    --  Set to True if target is OpenVMS
  
     -------------------------------
     -- Backend Arithmetic Checks --
*************** package Targparm is
*** 181,192 ****
     --  end will generate the required checks (or that the checks are
     --  automatically performed by the hardware in an appropriate form).
  
!    Backend_Divide_Checks_On_Target : Boolean;
     --  Set True if the back end generates divide checks, or if the hardware
     --  checks automatically. Set False if the front end must generate the
     --  required tests using explicit expanded code.
  
!    Backend_Overflow_Checks_On_Target : Boolean;
     --  Set True if the back end generates arithmetic overflow checks, or if
     --  the hardware checks automatically. Set False if the front end must
     --  generate the required tests using explicit expanded code.
--- 212,223 ----
     --  end will generate the required checks (or that the checks are
     --  automatically performed by the hardware in an appropriate form).
  
!    Backend_Divide_Checks_On_Target : Boolean := False;
     --  Set True if the back end generates divide checks, or if the hardware
     --  checks automatically. Set False if the front end must generate the
     --  required tests using explicit expanded code.
  
!    Backend_Overflow_Checks_On_Target : Boolean := False;
     --  Set True if the back end generates arithmetic overflow checks, or if
     --  the hardware checks automatically. Set False if the front end must
     --  generate the required tests using explicit expanded code.
*************** package Targparm is
*** 247,300 ****
  
     --    Controlling the selection of methods
  
!    --      The Front-End Longjmp/Setjmp approach is always available in
!    --      all implementations. If it is not the default method, then it
!    --      may be explicitly specified by the use of -gnatL. Note however
!    --      that there is a requirement that all Ada units in a partition
!    --      be compiled with this overriding option if it is not the default.
! 
!    --      On some, but not all, implementations of GNAT, one of the two
!    --      ZCX approaches (but not both) is implemented. If this is the
!    --      case, and ZCX is not the default mechanism, then ZCX handling
!    --      (front-end or back-end according to the implementation) may be
!    --      specified by use of the -gnatZ switch. Again, this switch must
!    --      be used to compile all Ada units in a partition. The use of
!    --      the -gnatZ switch will cause termination with a fatal error.
! 
!    --      Finally the debug option -gnatdX can be used to force the
!    --      compiler to operate in front-end ZCX exception mode and force
!    --      the front end to generate exception tables. This is only useful
!    --      for debugging purposes for implementations which do not provide
!    --      the possibility of front-end ZCX mode. The resulting object file
!    --      is unusable, but this debug switch may still be useful (e.g. in
!    --      conjunction with -gnatG) for front-end debugging purposes.
  
     --    Control of Available Methods and Defaults
  
!    --      The following switches specify which of the two ZCX methods
!    --      (if any) is available in an implementation, and which method
!    --      is the default method.
  
!    ZCX_By_Default_On_Target : Boolean;
     --  Indicates if zero cost exceptions are active by default. If this
     --  variable is False, then the only possible exception method is the
     --  front-end setjmp/longjmp approach, and this is the default. If
!    --  this variable is True, then one of the following two flags must
!    --  be True, and represents the method to be used by default.
! 
!    GCC_ZCX_Support_On_Target  : Boolean;
!    --  Indicates that when ZCX is active, the mechanism to be used is the
!    --  back-end ZCX exception approach. If this variable is set to True,
!    --  then Front_End_ZCX_Support_On_Target must be False.
  
!    Front_End_ZCX_Support_On_Target : Boolean;
!    --  Indicates that when ZCX is active, the mechanism to be used is the
!    --  front-end ZCX exception approach. If this variable is set to True,
!    --  then GCC_ZCX_Support_On_Target must be False.
  
!    --------------------------------
!    -- Configurable Run-Time Mode --
!    --------------------------------
  
     --  In configurable run-time mode, the system run-time may not support
     --  the full Ada language. The effect of setting this switch is to let
--- 278,305 ----
  
     --    Controlling the selection of methods
  
!    --      On most implementations, back-end zero-cost exceptions are used.
!    --      Otherwise, Front-End Longjmp/Setjmp approach is used.
!    --      Note that there is a requirement that all Ada units in a partition
!    --      be compiled with the same exception model.
  
     --    Control of Available Methods and Defaults
  
!    --      The following switches specify whether ZCX is available, and
!    --      whether it is enabled by default.
  
!    ZCX_By_Default_On_Target : Boolean := False;
     --  Indicates if zero cost exceptions are active by default. If this
     --  variable is False, then the only possible exception method is the
     --  front-end setjmp/longjmp approach, and this is the default. If
!    --  this variable is True, then GCC ZCX is used.
  
!    GCC_ZCX_Support_On_Target  : Boolean := False;
!    --  Indicates that the target supports GCC Exceptions
  
!    ------------------------------------
!    -- Run-Time Library Configuration --
!    ------------------------------------
  
     --  In configurable run-time mode, the system run-time may not support
     --  the full Ada language. The effect of setting this switch is to let
*************** package Targparm is
*** 302,308 ****
     --  misconfigured) if run-time library units or entities within units are
     --  not present in the run-time.
  
!    Configurable_Run_Time_On_Target : Boolean;
     --  Indicates that the system.ads file is for a configurable run-time
     --
     --  This has some specific effects as follows
--- 307,313 ----
     --  misconfigured) if run-time library units or entities within units are
     --  not present in the run-time.
  
!    Configurable_Run_Time_On_Target : Boolean := False;
     --  Indicates that the system.ads file is for a configurable run-time
     --
     --  This has some specific effects as follows
*************** package Targparm is
*** 323,329 ****
     --    The variable __gnat_exit_status is generated within the binder file
     --    instead of being imported from the run-time library.
  
!    Suppress_Standard_Library_On_Target : Boolean;
     --  If this flag is True, then the standard library is not included by
     --  default in the executable (see unit System.Standard_Library in file
     --  s-stalib.ads for details of what this includes). This is for example
--- 328,334 ----
     --    The variable __gnat_exit_status is generated within the binder file
     --    instead of being imported from the run-time library.
  
!    Suppress_Standard_Library_On_Target : Boolean := False;
     --  If this flag is True, then the standard library is not included by
     --  default in the executable (see unit System.Standard_Library in file
     --  s-stalib.ads for details of what this includes). This is for example
*************** package Targparm is
*** 336,351 ****
     --    with the exception of the priority of the environment task, which
     --    is needed by the Ravenscar run-time.
     --
-    --    The generation of exception tables is suppressed for front end
-    --    ZCX exception handling (since we assume no exception handling).
-    --
     --    The calls to __gnat_initialize and __gnat_finalize are omitted
     --
     --    All finalization and initialization (controlled types) is omitted
     --
     --    The routine __gnat_handler_installed is not imported
  
!    Preallocated_Stacks_On_Target : Boolean;
     --  If this flag is True, then the expander preallocates all task stacks
     --  at compile time. If the flag is False, then task stacks are not pre-
     --  allocated, and task stack allocation is the responsibility of the
--- 341,353 ----
     --    with the exception of the priority of the environment task, which
     --    is needed by the Ravenscar run-time.
     --
     --    The calls to __gnat_initialize and __gnat_finalize are omitted
     --
     --    All finalization and initialization (controlled types) is omitted
     --
     --    The routine __gnat_handler_installed is not imported
  
!    Preallocated_Stacks_On_Target : Boolean := False;
     --  If this flag is True, then the expander preallocates all task stacks
     --  at compile time. If the flag is False, then task stacks are not pre-
     --  allocated, and task stack allocation is the responsibility of the
*************** package Targparm is
*** 360,366 ****
     --  and small of 10**(-9) (i.e. it is a count in nanoseconds. This flag
     --  allows that standard format to be modified.
  
!    Duration_32_Bits_On_Target : Boolean;
     --  If True, then Duration is represented in 32 bits and the delta and
     --  small values are set to 20.0*(10**(-3)) (i.e. it is a count in units
     --  of 20 milliseconds.
--- 362,368 ----
     --  and small of 10**(-9) (i.e. it is a count in nanoseconds. This flag
     --  allows that standard format to be modified.
  
!    Duration_32_Bits_On_Target : Boolean := False;
     --  If True, then Duration is represented in 32 bits and the delta and
     --  small values are set to 20.0*(10**(-3)) (i.e. it is a count in units
     --  of 20 milliseconds.
*************** package Targparm is
*** 375,381 ****
     --  used at the source level, and the corresponding flag is false, then an
     --  error message will be issued saying the feature is not supported.
  
!    Support_64_Bit_Divides_On_Target : Boolean;
     --  If True, the back end supports 64-bit divide operations. If False, then
     --  the source program may not contain 64-bit divide operations. This is
     --  specifically useful in the zero foot-print case, where the issue is
--- 377,383 ----
     --  used at the source level, and the corresponding flag is false, then an
     --  error message will be issued saying the feature is not supported.
  
!    Support_64_Bit_Divides_On_Target : Boolean := True;
     --  If True, the back end supports 64-bit divide operations. If False, then
     --  the source program may not contain 64-bit divide operations. This is
     --  specifically useful in the zero foot-print case, where the issue is
*************** package Targparm is
*** 383,396 ****
     --  no run-time support is required. It should always be set True if the
     --  necessary run-time support is present.
  
!    Support_Aggregates_On_Target : Boolean;
     --  In the general case, the use of aggregates may generate calls
     --  to run-time routines in the C library, including memset, memcpy,
     --  memmove, and bcopy. This flag is set to True if these routines
     --  are available. If any of these routines is not available, then
     --  this flag is False, and the use of aggregates is not permitted.
  
!    Support_Composite_Assign_On_Target : Boolean;
     --  The assignment of composite objects other than small records and
     --  arrays whose size is 64-bits or less and is set by an explicit
     --  size clause may generate calls to memcpy, memmove, and bcopy.
--- 385,398 ----
     --  no run-time support is required. It should always be set True if the
     --  necessary run-time support is present.
  
!    Support_Aggregates_On_Target : Boolean := True;
     --  In the general case, the use of aggregates may generate calls
     --  to run-time routines in the C library, including memset, memcpy,
     --  memmove, and bcopy. This flag is set to True if these routines
     --  are available. If any of these routines is not available, then
     --  this flag is False, and the use of aggregates is not permitted.
  
!    Support_Composite_Assign_On_Target : Boolean := True;
     --  The assignment of composite objects other than small records and
     --  arrays whose size is 64-bits or less and is set by an explicit
     --  size clause may generate calls to memcpy, memmove, and bcopy.
*************** package Targparm is
*** 398,411 ****
     --  is set to True. If any of these routines is not available, then
     --  the flag is set False, and composite assignments are not allowed.
  
!    Support_Composite_Compare_On_Target : Boolean;
     --  If this flag is True, then the back end supports bit-wise comparison
     --  of composite objects for equality, either generating inline code or
     --  calling appropriate (and available) run-time routines. If this flag
     --  is False, then the back end does not provide this support, and the
     --  front end uses component by component comparison for composites.
  
!    Support_Long_Shifts_On_Target : Boolean;
     --  If True, the back end supports 64-bit shift operations. If False, then
     --  the source program may not contain explicit 64-bit shifts. In addition,
     --  the code generated for packed arrays will avoid the use of long shifts.
--- 400,413 ----
     --  is set to True. If any of these routines is not available, then
     --  the flag is set False, and composite assignments are not allowed.
  
!    Support_Composite_Compare_On_Target : Boolean := True;
     --  If this flag is True, then the back end supports bit-wise comparison
     --  of composite objects for equality, either generating inline code or
     --  calling appropriate (and available) run-time routines. If this flag
     --  is False, then the back end does not provide this support, and the
     --  front end uses component by component comparison for composites.
  
!    Support_Long_Shifts_On_Target : Boolean := True;
     --  If True, the back end supports 64-bit shift operations. If False, then
     --  the source program may not contain explicit 64-bit shifts. In addition,
     --  the code generated for packed arrays will avoid the use of long shifts.
*************** package Targparm is
*** 441,451 ****
     --      default on systems that lack complete support for
     --      probing.
  
!    Stack_Check_Probes_On_Target : Boolean;
     --  Indicates if stack check probes are used, as opposed to the standard
     --  target independent comparison method.
  
!    Stack_Check_Default_On_Target : Boolean;
     --  Indicates if stack checking is on by default
  
     ----------------------------
--- 443,453 ----
     --      default on systems that lack complete support for
     --      probing.
  
!    Stack_Check_Probes_On_Target : Boolean := False;
     --  Indicates if stack check probes are used, as opposed to the standard
     --  target independent comparison method.
  
!    Stack_Check_Default_On_Target : Boolean := False;
     --  Indicates if stack checking is on by default
  
     ----------------------------
*************** package Targparm is
*** 457,463 ****
     --  command line arguments (VxWorks and AAMP). Note that support of
     --  command line arguments is not required on such targets (RM A.15(13)).
  
!    Command_Line_Args_On_Target : Boolean;
     --  Set False if no command line arguments on target. Note that if this
     --  is False in with Configurable_Run_Time_On_Target set to True, then
     --  this causes suppression of generation of the argv/argc variables
--- 459,465 ----
     --  command line arguments (VxWorks and AAMP). Note that support of
     --  command line arguments is not required on such targets (RM A.15(13)).
  
!    Command_Line_Args_On_Target : Boolean := True;
     --  Set False if no command line arguments on target. Note that if this
     --  is False in with Configurable_Run_Time_On_Target set to True, then
     --  this causes suppression of generation of the argv/argc variables
*************** package Targparm is
*** 466,476 ****
     --  Similarly, most ports support the use of an exit status, but AAMP
     --  is an exception (as allowed by RM A.15(18-20))
  
!    Exit_Status_Supported_On_Target : Boolean;
     --  Set False if returning of an exit status is not supported on target.
     --  Note that if this False in with Configurable_Run_Time_On_Target
     --  set to True, then this causes suppression of the gnat_exit_status
!    --  variable used to recod the exit status.
  
     -----------------------
     -- Main Program Name --
--- 468,478 ----
     --  Similarly, most ports support the use of an exit status, but AAMP
     --  is an exception (as allowed by RM A.15(18-20))
  
!    Exit_Status_Supported_On_Target : Boolean := True;
     --  Set False if returning of an exit status is not supported on target.
     --  Note that if this False in with Configurable_Run_Time_On_Target
     --  set to True, then this causes suppression of the gnat_exit_status
!    --  variable used to record the exit status.
  
     -----------------------
     -- Main Program Name --
*************** package Targparm is
*** 483,489 ****
     --  name (just the name of the child if the main program is a child unit).
     --  In either case, this value can be overridden using -M name.
  
!    Use_Ada_Main_Program_Name_On_Target : Boolean;
     --  Set True to use the Ada main program name as the main name
  
     ----------------------------------------------
--- 485,491 ----
     --  name (just the name of the child if the main program is a child unit).
     --  In either case, this value can be overridden using -M name.
  
!    Use_Ada_Main_Program_Name_On_Target : Boolean := False;
     --  Set True to use the Ada main program name as the main name
  
     ----------------------------------------------
*************** package Targparm is
*** 504,532 ****
     --  the partition. We probably should add such consistency checks in future,
     --  but for now we don't do this.
  
!    Denorm_On_Target : Boolean;
!    --  Set to False on targets that do not reliably support denormals.
!    --  Reliably here means for all settings of the relevant -m flag, so
!    --  for example, this is False on the Alpha where denormals are not
!    --  supported unless -mieee is used.
  
!    Machine_Rounds_On_Target : Boolean;
     --  Set to False for targets where S'Machine_Rounds is False
  
!    Machine_Overflows_On_Target : Boolean;
     --  Set to True for targets where S'Machine_Overflows is True
  
!    Signed_Zeros_On_Target : Boolean;
!    --  Set to False on targets that do not reliably support signed zeros.
! 
!    OpenVMS_On_Target : Boolean;
!    --  Set to True if target is OpenVMS.
  
     -------------------------------------------
     -- Boolean-Valued Fixed-Point Attributes --
     -------------------------------------------
  
!    Fractional_Fixed_Ops_On_Target : Boolean;
     --  Set to True for targets that support fixed-by-fixed multiplication
     --  and division for fixed-point types with a small value equal to
     --  2 ** (-(T'Object_Size - 1)) and whose values have an absolute
--- 506,535 ----
     --  the partition. We probably should add such consistency checks in future,
     --  but for now we don't do this.
  
!    --  Note: the compiler itself does not use floating-point, so the
!    --  settings of the defaults here are not really relevant.
  
!    --  Note: in some cases, proper support of some of these floating point
!    --  features may require a specific switch (e.g. -mieee on the Alpha)
!    --  to be used to obtain full RM compliant support.
! 
!    Denorm_On_Target : Boolean := False;
!    --  Set to False on targets that do not reliably support denormals
! 
!    Machine_Rounds_On_Target : Boolean := True;
     --  Set to False for targets where S'Machine_Rounds is False
  
!    Machine_Overflows_On_Target : Boolean := False;
     --  Set to True for targets where S'Machine_Overflows is True
  
!    Signed_Zeros_On_Target : Boolean := True;
!    --  Set to False on targets that do not reliably support signed zeros
  
     -------------------------------------------
     -- Boolean-Valued Fixed-Point Attributes --
     -------------------------------------------
  
!    Fractional_Fixed_Ops_On_Target : Boolean := False;
     --  Set to True for targets that support fixed-by-fixed multiplication
     --  and division for fixed-point types with a small value equal to
     --  2 ** (-(T'Object_Size - 1)) and whose values have an absolute
*************** package Targparm is
*** 568,574 ****
     --      the returned value. The caller must then pop the main stack when
     --      this value is consumed.
  
!    Functions_Return_By_DSP_On_Target : Boolean;
     --  Set to True if target permits functions to return with using the
     --  DSP (depressed stack pointer) approach.
  
--- 571,577 ----
     --      the returned value. The caller must then pop the main stack when
     --      this value is consumed.
  
!    Functions_Return_By_DSP_On_Target : Boolean := False;
     --  Set to True if target permits functions to return with using the
     --  DSP (depressed stack pointer) approach.
  
*************** package Targparm is
*** 581,587 ****
     --  parameter Backend_Layout is set to False, then the front end must
     --  perform all data layout. For further details see the package Layout.
  
!    Frontend_Layout_On_Target : Boolean;
     --  Set True if front end does layout
  
     -----------------
--- 584,590 ----
     --  parameter Backend_Layout is set to False, then the front end must
     --  perform all data layout. For further details see the package Layout.
  
!    Frontend_Layout_On_Target : Boolean := False;
     --  Set True if front end does layout
  
     -----------------
diff -Nrcpad gcc-4.0.2/gcc/ada/targtyps.c gcc-4.1.0/gcc/ada/targtyps.c
*** gcc-4.0.2/gcc/ada/targtyps.c	Wed Apr 21 10:10:32 2004
--- gcc-4.1.0/gcc/ada/targtyps.c	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/tb-alvms.c gcc-4.1.0/gcc/ada/tb-alvms.c
*** gcc-4.0.2/gcc/ada/tb-alvms.c	Wed Dec  3 11:47:53 2003
--- gcc-4.1.0/gcc/ada/tb-alvms.c	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *              Copyright (C) 2003 Ada Core Technologies, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *                     Copyright (C) 2003-2005, AdaCore                     *
   *                                                                          *
   * 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
***************
*** 39,48 ****
     Most of the contents is directed by the OpenVMS/Alpha Conventions (ABI)
     document, sections of which we will refer to as ABI-<section_number>.  */
  
! #include <pdscdef.h>
! #include <libicb.h>
! #include <chfctxdef.h>
! #include <chfdef.h>
  
  /* A couple of items missing from the header file included above.  */
  extern void * SYS$GL_CALL_HANDL;
--- 39,48 ----
     Most of the contents is directed by the OpenVMS/Alpha Conventions (ABI)
     document, sections of which we will refer to as ABI-<section_number>.  */
  
! #include <vms/pdscdef.h>
! #include <vms/libicb.h>
! #include <vms/chfctxdef.h>
! #include <vms/chfdef.h>
  
  /* A couple of items missing from the header file included above.  */
  extern void * SYS$GL_CALL_HANDL;
diff -Nrcpad gcc-4.0.2/gcc/ada/tb-alvxw.c gcc-4.1.0/gcc/ada/tb-alvxw.c
*** gcc-4.0.2/gcc/ada/tb-alvxw.c	Fri Oct 31 01:08:43 2003
--- gcc-4.1.0/gcc/ada/tb-alvxw.c	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *            Copyright (C) 2000-2003 Ada Core Technologies, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *                     Copyright (C) 2000-2005, AdaCore                     *
   *                                                                          *
   * 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
diff -Nrcpad gcc-4.0.2/gcc/ada/tb-gcc.c gcc-4.1.0/gcc/ada/tb-gcc.c
*** gcc-4.0.2/gcc/ada/tb-gcc.c	Thu Nov 25 13:11:09 2004
--- gcc-4.1.0/gcc/ada/tb-gcc.c	Tue Nov 15 13:54:25 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *              Copyright (C) 2004 Ada Core Technologies, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *                     Copyright (C) 2004-2005, AdaCore                     *
   *                                                                          *
   * 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** typedef struct {
*** 54,63 ****
   * trace_callback *
   ******************/
  
  static _Unwind_Reason_Code
  trace_callback (struct _Unwind_Context * uw_context, uw_data_t * uw_data)
  {
!   void * pc = (void *) _Unwind_GetIP (uw_context);
  
    if (uw_data->n_frames_skipped < uw_data->n_frames_to_skip)
      {
--- 54,74 ----
   * trace_callback *
   ******************/
  
+ #if defined (__ia64__) && defined (__hpux__)
+ #include <uwx.h>
+ #endif
+ 
  static _Unwind_Reason_Code
  trace_callback (struct _Unwind_Context * uw_context, uw_data_t * uw_data)
  {
!   void * pc;
! 
! #if defined (__ia64__) && defined (__hpux__)
!   /* Work around problem with _Unwind_GetIP on ia64 HP-UX. */
!   uwx_get_reg ((struct uwx_env *) uw_context, UWX_REG_IP, (uint64_t *) &pc);
! #else
!   pc = (void *) _Unwind_GetIP (uw_context);
! #endif
  
    if (uw_data->n_frames_skipped < uw_data->n_frames_to_skip)
      {
diff -Nrcpad gcc-4.0.2/gcc/ada/tbuild.adb gcc-4.1.0/gcc/ada/tbuild.adb
*** gcc-4.0.2/gcc/ada/tbuild.adb	Fri Nov 19 10:56:37 2004
--- gcc-4.1.0/gcc/ada/tbuild.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,31 ****
--- 26,32 ----
  
  with Atree;    use Atree;
  with Einfo;    use Einfo;
+ with Elists;   use Elists;
  with Lib;      use Lib;
  with Namet;    use Namet;
  with Nlists;   use Nlists;
*************** package body Tbuild is
*** 169,208 ****
  
        return
          Unchecked_Convert_To (
!           New_Occurrence_Of (Etype (Access_Disp_Table (Full_Type)), Loc),
            Make_Selected_Component (Loc,
              Prefix => New_Copy (Rec),
              Selector_Name =>
!               New_Reference_To (Tag_Component (Full_Type), Loc)));
     end Make_DT_Access;
  
-    -----------------------
-    -- Make_DT_Component --
-    -----------------------
- 
-    function Make_DT_Component
-      (Loc : Source_Ptr;
-       Typ : Entity_Id;
-       I   : Positive) return Node_Id
-    is
-       X : Node_Id;
-       Full_Type : Entity_Id := Typ;
- 
-    begin
-       if Is_Private_Type (Typ) then
-          Full_Type := Underlying_Type (Typ);
-       end if;
- 
-       X := First_Component (
-              Designated_Type (Etype (Access_Disp_Table (Full_Type))));
- 
-       for J in 2 .. I loop
-          X := Next_Component (X);
-       end loop;
- 
-       return New_Reference_To (X, Loc);
-    end Make_DT_Component;
- 
     --------------------------------
     -- Make_Implicit_If_Statement --
     --------------------------------
--- 170,183 ----
  
        return
          Unchecked_Convert_To (
!           New_Occurrence_Of
!             (Etype (Node (First_Elmt (Access_Disp_Table (Full_Type)))), Loc),
            Make_Selected_Component (Loc,
              Prefix => New_Copy (Rec),
              Selector_Name =>
!               New_Reference_To (First_Tag_Component (Full_Type), Loc)));
     end Make_DT_Access;
  
     --------------------------------
     -- Make_Implicit_If_Statement --
     --------------------------------
*************** package body Tbuild is
*** 216,221 ****
--- 191,197 ----
     is
     begin
        Check_Restriction (No_Implicit_Conditionals, Node);
+ 
        return Make_If_Statement (Sloc (Node),
          Condition,
          Then_Statements,
*************** package body Tbuild is
*** 234,240 ****
     is
        N : constant Node_Id :=
              Make_Implicit_Label_Declaration (Loc, Defining_Identifier);
- 
     begin
        Set_Label_Construct (N, Label_Construct);
        return N;
--- 210,215 ----
*************** package body Tbuild is
*** 281,286 ****
--- 256,292 ----
        return Make_Integer_Literal (Loc, UI_From_Int (Intval));
     end Make_Integer_Literal;
  
+    --------------------------------
+    -- Make_Linker_Section_Pragma --
+    --------------------------------
+ 
+    function Make_Linker_Section_Pragma
+      (Ent : Entity_Id;
+       Loc : Source_Ptr;
+       Sec : String) return Node_Id
+    is
+       LS : Node_Id;
+ 
+    begin
+       LS :=
+         Make_Pragma
+           (Loc,
+            Name_Linker_Section,
+            New_List
+              (Make_Pragma_Argument_Association
+                 (Sloc => Loc,
+                  Expression => New_Occurrence_Of (Ent, Loc)),
+               Make_Pragma_Argument_Association
+                 (Sloc => Loc,
+                  Expression =>
+                    Make_String_Literal
+                      (Sloc => Loc,
+                       Strval => Sec))));
+ 
+       Set_Has_Gigi_Rep_Item (Ent);
+       return LS;
+    end Make_Linker_Section_Pragma;
+ 
     ---------------------------------
     -- Make_Raise_Constraint_Error --
     ---------------------------------
diff -Nrcpad gcc-4.0.2/gcc/ada/tbuild.ads gcc-4.1.0/gcc/ada/tbuild.ads
*** gcc-4.0.2/gcc/ada/tbuild.ads	Fri Nov 19 10:56:37 2004
--- gcc-4.1.0/gcc/ada/tbuild.ads	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Tbuild is
*** 69,88 ****
     --  Must_Be_Byte_Aligned is set in the attribute reference node. The
     --  Attribute_Name must be Name_Address or Name_Unrestricted_Access.
  
-    function Make_DT_Component
-      (Loc  : Source_Ptr;
-       Typ  : Entity_Id;
-       I    : Positive) return Node_Id;
-    --  Gives a reference to the Ith component of the Dispatch Table of
-    --  a given Tagged Type.
-    --
-    --  I = 1    --> Inheritance_Depth
-    --  I = 2    --> Tags (array of ancestors)
-    --  I = 3, 4 --> predefined primitive
-    --            function _Size (X : Typ) return Long_Long_Integer;
-    --            function _Equality (X : Typ; Y : Typ'Class) return Boolean;
-    --  I >= 5   --> User-Defined Primitive Operations
- 
     function Make_DT_Access
       (Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
     --  Create an access to the Dispatch Table by using the Tag field
--- 69,74 ----
*************** package Tbuild is
*** 132,137 ****
--- 118,130 ----
     pragma Inline (Make_Integer_Literal);
     --  A convenient form of Make_Integer_Literal taking Int instead of Uint
  
+    function Make_Linker_Section_Pragma
+      (Ent : Entity_Id;
+       Loc : Source_Ptr;
+       Sec : String) return Node_Id;
+    --  Construct a Linker_Section pragma for entity Ent, using string Sec as
+    --  the section name. Loc is the Sloc value to use in building the pragma.
+ 
     function Make_Raise_Constraint_Error
       (Sloc      : Source_Ptr;
        Condition : Node_Id := Empty;
diff -Nrcpad gcc-4.0.2/gcc/ada/tempdir.adb gcc-4.1.0/gcc/ada/tempdir.adb
*** gcc-4.0.2/gcc/ada/tempdir.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/tempdir.adb	Tue Nov 15 14:05:07 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** begin
*** 114,120 ****
        Dir : String_Access := Getenv (Tmpdir);
  
     begin
!       if Dir'Length > 0 and then Is_Absolute_Path (Dir.all) then
           Temp_Dir := new String'(Normalize_Pathname (Dir.all));
        end if;
  
--- 114,123 ----
        Dir : String_Access := Getenv (Tmpdir);
  
     begin
!       if Dir'Length > 0 and then
!         Is_Absolute_Path (Dir.all) and then
!         Is_Directory (Dir.all)
!       then
           Temp_Dir := new String'(Normalize_Pathname (Dir.all));
        end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/tempdir.ads gcc-4.1.0/gcc/ada/tempdir.ads
*** gcc-4.0.2/gcc/ada/tempdir.ads	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/tempdir.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/text_io.ads gcc-4.1.0/gcc/ada/text_io.ads
*** gcc-4.0.2/gcc/ada/text_io.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/text_io.ads	Thu Jun 16 08:26:28 2005
***************
*** 1,6 ****
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUNTIME COMPONENTS                          --
  --                                                                          --
  --                              T E X T _ I O                               --
  --                                                                          --
--- 1,6 ----
  ------------------------------------------------------------------------------
  --                                                                          --
! --                         GNAT RUN-TIME COMPONENTS                         --
  --                                                                          --
  --                              T E X T _ I O                               --
  --                                                                          --
diff -Nrcpad gcc-4.0.2/gcc/ada/tracebak.c gcc-4.1.0/gcc/ada/tracebak.c
*** gcc-4.0.2/gcc/ada/tracebak.c	Wed Oct 27 13:55:31 2004
--- gcc-4.1.0/gcc/ada/tracebak.c	Tue Nov 15 13:54:25 2005
***************
*** 6,12 ****
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *           Copyright (C) 2000-2004 Ada Core Technologies, 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- *
--- 6,12 ----
   *                                                                          *
   *                          C Implementation File                           *
   *                                                                          *
!  *                     Copyright (C) 2000-2005, AdaCore                     *
   *                                                                          *
   * 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- *
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * As a  special  exception,  if you  link  this file  with other  files to *
   * produce an executable,  this file does not by itself cause the resulting *
*************** extern void (*Unlock_Task) (void);
*** 191,199 ****
  
    */
  
! /*------------------------------ PPC AIX -------------------------------*/
  
! #if defined (_AIX)
  
  #define USE_GENERIC_UNWINDER
  
--- 191,199 ----
  
    */
  
! /*--------------------------- PPC AIX/Darwin ----------------------------*/
  
! #if (defined (__ppc__) && ((defined (_AIX) || defined (__APPLE__))))
  
  #define USE_GENERIC_UNWINDER
  
*************** struct layout
*** 212,218 ****
     function is located in it's caller's frame, and the save operation only
     takes place if the function performs a call.
  
!    To have __gnat_backtrace retrieve it's own return address, we then
     define ... */
  
  #define FORCE_CALL
--- 212,218 ----
     function is located in it's caller's frame, and the save operation only
     takes place if the function performs a call.
  
!    To have __gnat_backtrace retrieve its own return address, we then
     define ... */
  
  #define FORCE_CALL
*************** struct layout
*** 242,248 ****
  
  #define BASE_SKIP 1
  
! /*-------------------------- Sparc Solaris -----------------------------*/
  
  #elif defined (sun) && defined (sparc)
  
--- 242,248 ----
  
  #define BASE_SKIP 1
  
! /*-------------------------- SPARC Solaris -----------------------------*/
  
  #elif defined (sun) && defined (sparc)
  
*************** struct layout
*** 257,264 ****
    void *return_address;
  };
  
  #define FRAME_LEVEL 0
! #define FRAME_OFFSET (14 * (sizeof (void*)))
  #define PC_ADJUST 0
  #define STOP_FRAME(CURRENT, TOP_STACK) \
    ((CURRENT)->return_address == 0|| (CURRENT)->next == 0 \
--- 257,270 ----
    void *return_address;
  };
  
+ #ifdef __arch64__
+ #define STACK_BIAS 2047 /* V9 ABI */
+ #else
+ #define STACK_BIAS 0    /* V8 ABI */
+ #endif
+ 
  #define FRAME_LEVEL 0
! #define FRAME_OFFSET (14 * sizeof (void*) + STACK_BIAS)
  #define PC_ADJUST 0
  #define STOP_FRAME(CURRENT, TOP_STACK) \
    ((CURRENT)->return_address == 0|| (CURRENT)->next == 0 \
*************** struct layout
*** 294,300 ****
  };
  
  #define LOWEST_ADDR 0
! #define FRAME_LEVEL 0
  #define FRAME_OFFSET 0
  #define PC_ADJUST -2
  #define STOP_FRAME(CURRENT, TOP_STACK) \
--- 300,310 ----
  };
  
  #define LOWEST_ADDR 0
! #define FRAME_LEVEL 1
! /* builtin_frame_address (1) is expected to work on this target, and (0) might
!    return the soft stack pointer, which does not designate a location where a
!    backchain and a return address might be found.  */
! 
  #define FRAME_OFFSET 0
  #define PC_ADJUST -2
  #define STOP_FRAME(CURRENT, TOP_STACK) \
*************** struct layout
*** 303,309 ****
     || (CURRENT)->return_address == 0|| (CURRENT)->next == 0  \
     || (void *) (CURRENT) < (TOP_STACK))
  
! #define BASE_SKIP 1
  
  /* On i386 architecture we check that at the call point we really have a call
     insn. Possible call instructions are:
--- 313,319 ----
     || (CURRENT)->return_address == 0|| (CURRENT)->next == 0  \
     || (void *) (CURRENT) < (TOP_STACK))
  
! #define BASE_SKIP (1+FRAME_LEVEL)
  
  /* On i386 architecture we check that at the call point we really have a call
     insn. Possible call instructions are:
*************** struct layout
*** 324,335 ****
          || ((*((ptr) - 1) & 0xff) == 0xff) \
          || (((*(ptr) & 0xd0ff) == 0xd0ff))))
  
! /*------------------------------- mips-irix -------------------------------*/
  
! #elif defined (__mips) && defined (__sgi)
  
  #define USE_GCC_UNWINDER
! #define PC_ADJUST -8
  
  #endif
  
--- 334,370 ----
          || ((*((ptr) - 1) & 0xff) == 0xff) \
          || (((*(ptr) & 0xd0ff) == 0xd0ff))))
  
! /*----------------------------- x86_64 ---------------------------------*/
  
! #elif defined (__x86_64__)
  
  #define USE_GCC_UNWINDER
! /* The generic unwinder is not used for this target because it is based
!    on frame layout assumptions that are not reliable on this target (the
!    rbp register is very likely used for something else than storing the
!    frame pointer in optimized code). Hence, we use the GCC unwinder
!    based on DWARF 2 call frame information, although it has the drawback
!    of not being able to unwind through frames compiled without DWARF 2
!    information.
! */
! 
! #define PC_ADJUST -2
! /* The minimum size of call instructions on this architecture is 2 bytes */
! 
! /*----------------------------- ia64 ---------------------------------*/
! 
! #elif defined (__ia64__) && (defined (linux) || defined (__hpux__))
! 
! #define USE_GCC_UNWINDER
! /* Use _Unwind_Backtrace driven exceptions on ia64 HP-UX and ia64
!    GNU/Linux, where _Unwind_Backtrace is provided by the system unwind
!    library. On HP-UX 11.23 this requires patch PHSS_33352, which adds
!    _Unwind_Backtrace to the system unwind library. */
! 
! #define PC_ADJUST -16
! /* Every call on ia64 is part of a 128 bit bundle, so an adjustment of
!    minus 16 bytes from the point of return finds the address of the
!    previous bundle. */
  
  #endif
  
*************** struct layout
*** 344,350 ****
     libgcc, and the stage1 compiler is unlikely to be linked against a post 3.3
     library.  It actually disables the support for backtraces in this compiler
     for targets defining USE_GCC_UNWINDER, which is OK since we don't use the
!    traceback capablity in the compiler anyway.
  
     The condition is expressed the way above because we cannot reliably rely on
     any other macro from the base compiler when compiling stage1.  */
--- 379,385 ----
     libgcc, and the stage1 compiler is unlikely to be linked against a post 3.3
     library.  It actually disables the support for backtraces in this compiler
     for targets defining USE_GCC_UNWINDER, which is OK since we don't use the
!    traceback capability in the compiler anyway.
  
     The condition is expressed the way above because we cannot reliably rely on
     any other macro from the base compiler when compiling stage1.  */
diff -Nrcpad gcc-4.0.2/gcc/ada/trans.c gcc-4.1.0/gcc/ada/trans.c
*** gcc-4.0.2/gcc/ada/trans.c	Thu Mar 17 19:53:07 2005
--- gcc-4.1.0/gcc/ada/trans.c	Thu Nov 17 21:03:50 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
***************
*** 35,40 ****
--- 35,41 ----
  #include "rtl.h"
  #include "expr.h"
  #include "ggc.h"
+ #include "cgraph.h"
  #include "function.h"
  #include "except.h"
  #include "debug.h"
*************** static tree pos_to_constructor (Node_Id,
*** 164,169 ****
--- 165,171 ----
  static tree maybe_implicit_deref (tree);
  static tree gnat_stabilize_reference_1 (tree, bool);
  static void annotate_with_node (tree, Node_Id);
+ static void build_global_cdtor (int, tree *);
  
  
  /* This is the main program of the back-end.  It sets up all the table
*************** gigi (Node_Id gnat_root, int max_gnat_no
*** 232,238 ****
  #endif
  
    /* If we are using the GCC exception mechanism, let GCC know.  */
!   if (Exception_Mechanism == GCC_ZCX)
      gnat_init_gcc_eh ();
  
    gcc_assert (Nkind (gnat_root) == N_Compilation_Unit);
--- 234,240 ----
  #endif
  
    /* If we are using the GCC exception mechanism, let GCC know.  */
!   if (Exception_Mechanism == Back_End_Exceptions)
      gnat_init_gcc_eh ();
  
    gcc_assert (Nkind (gnat_root) == N_Compilation_Unit);
*************** gnat_init_stmt_group ()
*** 283,290 ****
    /* Enable GNAT stack checking method if needed */
    if (!Stack_Check_Probes_On_Target)
      set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
- 
-   gcc_assert (Exception_Mechanism != Front_End_ZCX);
  }
  
  /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
--- 285,290 ----
*************** Identifier_to_gnu (Node_Id gnat_node, tr
*** 348,354 ****
      }
    else
      {
!       /* Expand the type of this identitier first, in case it is an enumeral
  	 literal, which only get made when the type is expanded.  There is no
  	 order-of-elaboration issue here.  We want to use the Actual_Subtype if
  	 it has already been elaborated, otherwise the Etype.  Avoid using
--- 348,354 ----
      }
    else
      {
!       /* Expand the type of this identifier first, in case it is an enumeral
  	 literal, which only get made when the type is expanded.  There is no
  	 order-of-elaboration issue here.  We want to use the Actual_Subtype if
  	 it has already been elaborated, otherwise the Etype.  Avoid using
*************** Identifier_to_gnu (Node_Id gnat_node, tr
*** 393,399 ****
  	      && DECL_BY_COMPONENT_PTR_P (gnu_result))))
      {
        bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
!       tree initial;
  
        if (TREE_CODE (gnu_result) == PARM_DECL
  	  && DECL_BY_COMPONENT_PTR_P (gnu_result))
--- 393,399 ----
  	      && DECL_BY_COMPONENT_PTR_P (gnu_result))))
      {
        bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
!       tree renamed_obj;
  
        if (TREE_CODE (gnu_result) == PARM_DECL
  	  && DECL_BY_COMPONENT_PTR_P (gnu_result))
*************** Identifier_to_gnu (Node_Id gnat_node, tr
*** 402,435 ****
  			    convert (build_pointer_type (gnu_result_type),
  				     gnu_result));
  
!       /* If the object is constant, we try to do the dereference directly
! 	 through the DECL_INITIAL.  This is actually required in order to get
! 	 correct aliasing information for renamed objects that are components
! 	 of non-aliased aggregates, because the type of the renamed object and
! 	 that of the aggregate don't alias.
! 
! 	 Note that we expect the initial value to have been stabilized.
! 	 If it contains e.g. a variable reference, we certainly don't want
! 	 to re-evaluate the variable each time the renaming is used.
! 
! 	 Stabilization is currently not performed at the global level but
! 	 create_var_decl avoids setting DECL_INITIAL if the value is not
! 	 constant then, and we get to the pointer dereference below.
! 
! 	 ??? Couldn't the aliasing issue show up again in this case ?
! 	 There is no obvious reason why not.  */
!       else if (TREE_READONLY (gnu_result)
! 	       && DECL_INITIAL (gnu_result)
! 	       /* Strip possible conversion to reference type.  */
! 	       && ((initial = TREE_CODE (DECL_INITIAL (gnu_result))
! 		    == NOP_EXPR
! 		    ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0)
! 		    : DECL_INITIAL (gnu_result), 1))
! 	       && TREE_CODE (initial) == ADDR_EXPR
! 	       && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF
! 		   || (TREE_CODE (TREE_OPERAND (initial, 0))
! 		       == COMPONENT_REF)))
! 	gnu_result = TREE_OPERAND (initial, 0);
        else
  	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
  				     fold (gnu_result));
--- 402,415 ----
  			    convert (build_pointer_type (gnu_result_type),
  				     gnu_result));
  
!       /* If it's a renaming pointer and we are at the right binding level,
! 	 we can reference the renamed object directly, since the renamed
! 	 expression has been protected against multiple evaluations.  */
!       else if (TREE_CODE (gnu_result) == VAR_DECL
! 	       && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) != 0
! 	       && (! DECL_RENAMING_GLOBAL_P (gnu_result)
! 		   || global_bindings_p ()))
! 	gnu_result = renamed_obj;
        else
  	gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
  				     fold (gnu_result));
*************** Attribute_to_gnu (Node_Id gnat_node, tre
*** 610,616 ****
  
        /* If we are taking 'Address of an unconstrained object, this is the
  	 pointer to the underlying array.  */
!       gnu_prefix = maybe_unconstrained_array (gnu_prefix);
  
        /* ... fall through ... */
  
--- 590,597 ----
  
        /* If we are taking 'Address of an unconstrained object, this is the
  	 pointer to the underlying array.  */
!       if (attribute == Attr_Address)
! 	gnu_prefix = maybe_unconstrained_array (gnu_prefix);
  
        /* ... fall through ... */
  
*************** Attribute_to_gnu (Node_Id gnat_node, tre
*** 732,737 ****
--- 713,733 ----
  		  = size_binop (MAX_EXPR, gnu_result,
  				DECL_SIZE (TREE_OPERAND (gnu_expr, 1)));
  	    }
+ 	  else if (Nkind (Prefix (gnat_node)) == N_Explicit_Dereference)
+ 	    {
+ 	      Node_Id gnat_deref = Prefix (gnat_node);
+ 	      Node_Id gnat_actual_subtype = Actual_Designated_Subtype (gnat_deref);
+ 	      tree gnu_ptr_type = TREE_TYPE (gnat_to_gnu (Prefix (gnat_deref)));
+ 	      if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type)
+ 	  	&& Present (gnat_actual_subtype))
+ 	        {
+ 		  tree gnu_actual_obj_type = gnat_to_gnu_type (gnat_actual_subtype);
+ 		  gnu_type = build_unc_object_type_from_ptr (gnu_ptr_type,
+ 			       gnu_actual_obj_type, get_identifier ("SIZE"));
+ 	        }
+ 
+ 	      gnu_result = TYPE_SIZE (gnu_type);
+ 	    }
  	  else
  	    gnu_result = TYPE_SIZE (gnu_type);
  	}
*************** Attribute_to_gnu (Node_Id gnat_node, tre
*** 746,753 ****
        if (CONTAINS_PLACEHOLDER_P (gnu_result))
  	{
  	  if (TREE_CODE (gnu_prefix) != TYPE_DECL)
! 	    gnu_result = substitute_placeholder_in_expr (gnu_result,
! 							 gnu_expr);
  	  else
  	    gnu_result = max_size (gnu_result, true);
  	}
--- 742,748 ----
        if (CONTAINS_PLACEHOLDER_P (gnu_result))
  	{
  	  if (TREE_CODE (gnu_prefix) != TYPE_DECL)
! 	    gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
  	  else
  	    gnu_result = max_size (gnu_result, true);
  	}
*************** Subprogram_Body_to_gnu (Node_Id gnat_nod
*** 1354,1360 ****
    /* Save debug output mode in case it is reset.  */
    enum debug_info_type save_write_symbols = write_symbols;
    const struct gcc_debug_hooks *const save_debug_hooks = debug_hooks;
!   /* Definining identifier of a parameter to the subprogram.  */
    Entity_Id gnat_param;
    /* The defining identifier for the subprogram body. Note that if a
       specification has appeared before for this body, then the identifier
--- 1349,1355 ----
    /* Save debug output mode in case it is reset.  */
    enum debug_info_type save_write_symbols = write_symbols;
    const struct gcc_debug_hooks *const save_debug_hooks = debug_hooks;
!   /* Defining identifier of a parameter to the subprogram.  */
    Entity_Id gnat_param;
    /* The defining identifier for the subprogram body. Note that if a
       specification has appeared before for this body, then the identifier
*************** Subprogram_Body_to_gnu (Node_Id gnat_nod
*** 1470,1478 ****
  	gnu_retval = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
  
        add_stmt_with_node
! 	(build1 (RETURN_EXPR, void_type_node,
! 		 build2 (MODIFY_EXPR, TREE_TYPE (gnu_retval),
! 			 DECL_RESULT (current_function_decl), gnu_retval)),
  	 gnat_node);
        gnat_poplevel ();
        gnu_result = end_stmt_group ();
--- 1465,1471 ----
  	gnu_retval = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_retval);
  
        add_stmt_with_node
! 	(build_return_expr (DECL_RESULT (current_function_decl), gnu_retval),
  	 gnat_node);
        gnat_poplevel ();
        gnu_result = end_stmt_group ();
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1580,1587 ****
  			      0, Etype (Name (gnat_node)), "PAD", false,
  			      false, false);
  
! 	  gnu_target = create_tmp_var_raw (gnu_obj_type, "LR");
! 	  gnat_pushdecl (gnu_target, gnat_node);
  	}
  
        gnu_actual_list
--- 1573,1587 ----
  			      0, Etype (Name (gnat_node)), "PAD", false,
  			      false, false);
  
! 	  /* ??? We may be about to create a static temporary if we happen to
! 	     be at the global binding level.  That's a regression from what
! 	     the 3.x back-end would generate in the same situation, but we
! 	     don't have a mechanism in Gigi for creating automatic variables
! 	     in the elaboration routines.  */
! 	  gnu_target
! 	    = create_var_decl (create_tmp_var_name ("LR"), NULL, gnu_obj_type,
! 			       NULL, false, false, false, false, NULL,
! 			       gnat_node);
  	}
  
        gnu_actual_list
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1618,1623 ****
--- 1618,1624 ----
        tree gnu_formal
  	= (present_gnu_tree (gnat_formal)
  	   ? get_gnu_tree (gnat_formal) : NULL_TREE);
+       tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
        /* We treat a conversion between aggregate types as if it is an
  	 unchecked conversion.  */
        bool unchecked_convert_p
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1629,1635 ****
        tree gnu_name = gnat_to_gnu (gnat_name);
        tree gnu_name_type = gnat_to_gnu_type (Etype (gnat_name));
        tree gnu_actual;
-       tree gnu_formal_type;
  
        /* If it's possible we may need to use this expression twice, make sure
  	 than any side-effects are handled via SAVE_EXPRs. Likewise if we need
--- 1630,1635 ----
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1642,1647 ****
--- 1642,1648 ----
        if (Ekind (gnat_formal) != E_In_Parameter)
  	{
  	  gnu_name = gnat_stabilize_reference (gnu_name, true);
+ 
  	  if (!addressable_p (gnu_name)
  	      && gnu_formal
  	      && (DECL_BY_REF_P (gnu_formal)
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1652,1657 ****
--- 1653,1679 ----
  	      tree gnu_copy = gnu_name;
  	      tree gnu_temp;
  
+ 	      /* For users of Starlet we issue a warning because the
+ 		 interface apparently assumes that by-ref parameters
+ 		 outlive the procedure invocation.  The code still
+ 		 will not work as intended, but we cannot do much
+ 		 better since other low-level parts of the back-end
+ 		 would allocate temporaries at will because of the
+ 		 misalignment if we did not do so here.  */
+ 
+ 	      if (Is_Valued_Procedure (Entity (Name (gnat_node))))
+ 		{
+ 		  post_error
+ 		    ("?possible violation of implicit assumption",
+ 		     gnat_actual);
+ 		  post_error_ne
+ 		    ("?made by pragma Import_Valued_Procedure on &",
+ 		     gnat_actual, Entity (Name (gnat_node)));
+ 		  post_error_ne
+ 		    ("?because of misalignment of &",
+ 		     gnat_actual, gnat_formal);
+ 		}
+ 
  	      /* Remove any unpadding on the actual and make a copy.  But if
  		 the actual is a justified modular type, first convert
  		 to it.  */
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1678,1687 ****
  		}
  
  	      /* Set up to move the copy back to the original.  */
! 	      gnu_temp = build2 (MODIFY_EXPR, TREE_TYPE (gnu_copy),
! 				 gnu_copy, gnu_actual);
  	      annotate_with_node (gnu_temp, gnat_actual);
  	      append_to_statement_list (gnu_temp, &gnu_after_list);
  	    }
  	}
  
--- 1700,1712 ----
  		}
  
  	      /* Set up to move the copy back to the original.  */
! 	      gnu_temp = build_binary_op (MODIFY_EXPR, NULL_TREE,
! 					  gnu_copy, gnu_actual);
  	      annotate_with_node (gnu_temp, gnat_actual);
  	      append_to_statement_list (gnu_temp, &gnu_after_list);
+ 
+ 	      /* Account for next statement just below.  */
+ 	      gnu_name = gnu_actual;
  	    }
  	}
  
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1733,1738 ****
--- 1758,1766 ----
  	gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
  			      gnu_actual);
  
+       if (TREE_CODE (gnu_actual) != SAVE_EXPR)
+ 	gnu_actual = convert (gnu_formal_type, gnu_actual);
+ 
        /* If we have not saved a GCC object for the formal, it means it is an
  	 OUT parameter not passed by reference and that does not need to be
  	 copied in. Otherwise, look at the PARM_DECL to see if it is passed by
*************** call_to_gnu (Node_Id gnat_node, tree *gn
*** 1981,1987 ****
  		      && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
  		  gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
  	      }
! 		
  	    gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
  					  gnu_actual, gnu_result);
  	    annotate_with_node (gnu_result, gnat_actual);
--- 2009,2015 ----
  		      && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
  		  gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
  	      }
! 
  	    gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
  					  gnu_actual, gnu_result);
  	    annotate_with_node (gnu_result, gnat_actual);
*************** Handled_Sequence_Of_Statements_to_gnu (N
*** 2011,2017 ****
    /* If just annotating, ignore all EH and cleanups.  */
    bool gcc_zcx = (!type_annotate_only
  		  && Present (Exception_Handlers (gnat_node))
! 		  && Exception_Mechanism == GCC_ZCX);
    bool setjmp_longjmp
      = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
         && Exception_Mechanism == Setjmp_Longjmp);
--- 2039,2045 ----
    /* If just annotating, ignore all EH and cleanups.  */
    bool gcc_zcx = (!type_annotate_only
  		  && Present (Exception_Handlers (gnat_node))
! 		  && Exception_Mechanism == Back_End_Exceptions);
    bool setjmp_longjmp
      = (!type_annotate_only && Present (Exception_Handlers (gnat_node))
         && Exception_Mechanism == Setjmp_Longjmp);
*************** Exception_Handler_to_gnu_zcx (Node_Id gn
*** 2335,2341 ****
  	 is integer_zero_node.  It would not work, however, because GCC's
  	 notion of "catch all" is stronger than our notion of "others".  Until
  	 we correctly use the cleanup interface as well, doing that would
! 	 prevent the "all others" handlers from beeing seen, because nothing
  	 can be caught beyond a catch all from GCC's point of view.  */
        gnu_etypes_list = tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
      }
--- 2363,2369 ----
  	 is integer_zero_node.  It would not work, however, because GCC's
  	 notion of "catch all" is stronger than our notion of "others".  Until
  	 we correctly use the cleanup interface as well, doing that would
! 	 prevent the "all others" handlers from being seen, because nothing
  	 can be caught beyond a catch all from GCC's point of view.  */
        gnu_etypes_list = tree_cons (NULL_TREE, gnu_etype, gnu_etypes_list);
      }
*************** Compilation_Unit_to_gnu (Node_Id gnat_no
*** 2402,2408 ****
    Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
    cfun = 0;
  
!       /* For a body, first process the spec if there is one. */
    if (Nkind (Unit (gnat_node)) == N_Package_Body
        || (Nkind (Unit (gnat_node)) == N_Subprogram_Body
  	      && !Acts_As_Spec (gnat_node)))
--- 2430,2436 ----
    Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
    cfun = 0;
  
!   /* For a body, first process the spec if there is one. */
    if (Nkind (Unit (gnat_node)) == N_Package_Body
        || (Nkind (Unit (gnat_node)) == N_Subprogram_Body
  	      && !Acts_As_Spec (gnat_node)))
*************** Compilation_Unit_to_gnu (Node_Id gnat_no
*** 2442,2447 ****
--- 2470,2484 ----
    /* Generate elaboration code for this unit, if necessary, and say whether
       we did or not.  */
    pop_stack (&gnu_elab_proc_stack);
+ 
+   /* Generate functions to call static constructors and destructors
+      for targets that do not support .ctors/.dtors sections.  These
+      functions have magic names which are detected by collect2.  */
+   if (static_ctors)
+     build_global_cdtor ('I', &static_ctors);
+ 
+   if (static_dtors)
+     build_global_cdtor ('D', &static_dtors);
  }
  
  /* This function is the driver of the GNAT to GCC tree transformation
*************** Compilation_Unit_to_gnu (Node_Id gnat_no
*** 2450,2456 ****
     If this is an expression, return the GCC equivalent of the expression.  If
     it is a statement, return the statement.  In the case when called for a
     statement, it may also add statements to the current statement group, in
!    which case anything it returns is to be interpreted as occuring after
     anything `it already added.  */
  
  tree
--- 2487,2493 ----
     If this is an expression, return the GCC equivalent of the expression.  If
     it is a statement, return the statement.  In the case when called for a
     statement, it may also add statements to the current statement group, in
!    which case anything it returns is to be interpreted as occurring after
     anything `it already added.  */
  
  tree
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2480,2504 ****
      return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
  		   build_call_raise (CE_Range_Check_Failed));
  
!   /* If this is a Statement and we are at top level, it must be part of
!      the elaboration procedure, so mark us as being in that procedure
!      and push our context.  */
!   if (!current_function_decl
!       && ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
! 	   && Nkind (gnat_node) != N_Null_Statement)
! 	  || Nkind (gnat_node) == N_Procedure_Call_Statement
! 	  || Nkind (gnat_node) == N_Label
! 	  || Nkind (gnat_node) == N_Implicit_Label_Declaration
! 	  || Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
! 	  || ((Nkind (gnat_node) == N_Raise_Constraint_Error
! 	       || Nkind (gnat_node) == N_Raise_Storage_Error
! 	       || Nkind (gnat_node) == N_Raise_Program_Error)
! 	      && (Ekind (Etype (gnat_node)) == E_Void))))
      {
!       current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
!       start_stmt_group ();
!       gnat_pushlevel ();
!       went_into_elab_proc = true;
      }
  
    switch (Nkind (gnat_node))
--- 2517,2556 ----
      return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
  		   build_call_raise (CE_Range_Check_Failed));
  
!   /* If this is a Statement and we are at top level, it must be part of the
!      elaboration procedure, so mark us as being in that procedure and push our
!      context.
! 
!      If we are in the elaboration procedure, check if we are violating a a
!      No_Elaboration_Code restriction by having a statement there.  */
!   if ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
!        && Nkind (gnat_node) != N_Null_Statement)
!       || Nkind (gnat_node) == N_Procedure_Call_Statement
!       || Nkind (gnat_node) == N_Label
!       || Nkind (gnat_node) == N_Implicit_Label_Declaration
!       || Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
!       || ((Nkind (gnat_node) == N_Raise_Constraint_Error
! 	   || Nkind (gnat_node) == N_Raise_Storage_Error
! 	   || Nkind (gnat_node) == N_Raise_Program_Error)
! 	  && (Ekind (Etype (gnat_node)) == E_Void)))
      {
!       if (!current_function_decl)
! 	{
! 	  current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
! 	  start_stmt_group ();
! 	  gnat_pushlevel ();
! 	  went_into_elab_proc = true;
! 	}
! 
!       /* Don't check for a possible No_Elaboration_Code restriction violation
! 	 on N_Handled_Sequence_Of_Statements, as we want to signal an error on
! 	 every nested real statement instead.  This also avoids triggering
! 	 spurious errors on dummy (empty) sequences created by the front-end
! 	 for package bodies in some cases.  */
! 
!       if (current_function_decl == TREE_VALUE (gnu_elab_proc_stack)
! 	  && Nkind (gnat_node) != N_Handled_Sequence_Of_Statements)
! 	Check_Elaboration_Code_Allowed (gnat_node);
      }
  
    switch (Nkind (gnat_node))
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2965,2971 ****
  				   ? Designated_Type (Etype
  						      (Prefix (gnat_node)))
  				   : Etype (Prefix (gnat_node))))
! 	      gnu_prefix = gnat_stabilize_reference (gnu_prefix, 0);
  
  	    gnu_result
  	      = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
--- 3017,3023 ----
  				   ? Designated_Type (Etype
  						      (Prefix (gnat_node)))
  				   : Etype (Prefix (gnat_node))))
! 	      gnu_prefix = gnat_stabilize_reference (gnu_prefix, false);
  
  	    gnu_result
  	      = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3101,3107 ****
  
  	  if (align != 0 && align < oalign && !TYPE_ALIGN_OK (gnu_obj_type))
  	    post_error_ne_tree_2
! 	      ("?source alignment (^) < alignment of & (^)",
  	       gnat_node, Designated_Type (Etype (gnat_node)),
  	       size_int (align / BITS_PER_UNIT), oalign / BITS_PER_UNIT);
  	}
--- 3153,3159 ----
  
  	  if (align != 0 && align < oalign && !TYPE_ALIGN_OK (gnu_obj_type))
  	    post_error_ne_tree_2
! 	      ("?source alignment (^) '< alignment of & (^)",
  	       gnat_node, Designated_Type (Etype (gnat_node)),
  	       size_int (align / BITS_PER_UNIT), oalign / BITS_PER_UNIT);
  	}
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3338,3343 ****
--- 3390,3396 ----
        {
  	tree gnu_init = 0;
  	tree gnu_type;
+ 	bool ignore_init_type = false;
  
  	gnat_temp = Expression (gnat_node);
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3353,3358 ****
--- 3406,3412 ----
  	    Entity_Id gnat_desig_type
  	      = Designated_Type (Underlying_Type (Etype (gnat_node)));
  
+ 	    ignore_init_type = Has_Constrained_Partial_View (gnat_desig_type);
  	    gnu_init = gnat_to_gnu (Expression (gnat_temp));
  
  	    gnu_init = maybe_unconstrained_array (gnu_init);
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3380,3386 ****
  	gnu_result_type = get_unpadded_type (Etype (gnat_node));
  	return build_allocator (gnu_type, gnu_init, gnu_result_type,
  				Procedure_To_Call (gnat_node),
! 				Storage_Pool (gnat_node), gnat_node);
        }
        break;
  
--- 3434,3441 ----
  	gnu_result_type = get_unpadded_type (Etype (gnat_node));
  	return build_allocator (gnu_type, gnu_init, gnu_result_type,
  				Procedure_To_Call (gnat_node),
! 				Storage_Pool (gnat_node), gnat_node,
! 				ignore_init_type);
        }
        break;
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3406,3413 ****
  
        /* If the type has a size that overflows, convert this into raise of
  	 Storage_Error: execution shouldn't have gotten here anyway.  */
!       if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_lhs))) == INTEGER_CST
! 	   && TREE_OVERFLOW (TYPE_SIZE (TREE_TYPE (gnu_lhs))))
  	gnu_result = build_call_raise (SE_Object_Too_Large);
        else if (Nkind (Expression (gnat_node)) == N_Function_Call
  	       && !Do_Range_Check (Expression (gnat_node)))
--- 3461,3468 ----
  
        /* If the type has a size that overflows, convert this into raise of
  	 Storage_Error: execution shouldn't have gotten here anyway.  */
!       if (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))) == INTEGER_CST
! 	   && TREE_OVERFLOW (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
  	gnu_result = build_call_raise (SE_Object_Too_Large);
        else if (Nkind (Expression (gnat_node)) == N_Function_Call
  	       && !Do_Range_Check (Expression (gnat_node)))
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3500,3507 ****
  	tree gnu_ret_val = NULL_TREE;
  	/* The place to put the return value.  */
  	tree gnu_lhs;
- 	/* Avoid passing error_mark_node to RETURN_EXPR.  */
- 	gnu_result = NULL_TREE;
  
  	/* If we are dealing with a "return;" from an Ada procedure with
  	   parameters passed by copy in copy out, we need to return a record
--- 3555,3560 ----
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3557,3563 ****
  
  		if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
  		  /* The original return type was unconstrained so dereference
! 		     the TARGET pointer in the return value's type. */
  		  gnu_lhs
  		    = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
  				      DECL_ARGUMENTS (current_function_decl));
--- 3610,3616 ----
  
  		if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
  		  /* The original return type was unconstrained so dereference
! 		     the TARGET pointer in the actual return value's type. */
  		  gnu_lhs
  		    = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val),
  				      DECL_ARGUMENTS (current_function_decl));
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3595,3601 ****
  			= build_allocator (TREE_TYPE (gnu_ret_val),
  					   gnu_ret_val,
  					   TREE_TYPE (gnu_subprog_type),
! 					   0, -1, gnat_node);
  		    else
  		      gnu_ret_val
  			= build_allocator (TREE_TYPE (gnu_ret_val),
--- 3648,3654 ----
  			= build_allocator (TREE_TYPE (gnu_ret_val),
  					   gnu_ret_val,
  					   TREE_TYPE (gnu_subprog_type),
! 					   0, -1, gnat_node, false);
  		    else
  		      gnu_ret_val
  			= build_allocator (TREE_TYPE (gnu_ret_val),
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3603,3624 ****
  					   TREE_TYPE (gnu_subprog_type),
  					   Procedure_To_Call (gnat_node),
  					   Storage_Pool (gnat_node),
! 					   gnat_node);
  		  }
  	      }
  	  }
! 
! 	if (gnu_ret_val)
! 	  gnu_result = build2 (MODIFY_EXPR, TREE_TYPE (gnu_ret_val),
! 			       gnu_lhs, gnu_ret_val);
  
  	if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
  	  {
  	    add_stmt_with_node (gnu_result, gnat_node);
! 	    gnu_result = NULL_TREE;
  	  }
  
! 	gnu_result = build1 (RETURN_EXPR, void_type_node, gnu_result);
        }
        break;
  
--- 3656,3679 ----
  					   TREE_TYPE (gnu_subprog_type),
  					   Procedure_To_Call (gnat_node),
  					   Storage_Pool (gnat_node),
! 					   gnat_node, false);
  		  }
  	      }
  	  }
! 	else
! 	  /* If the Ada subprogram is a regular procedure, just return.  */
! 	  gnu_lhs = NULL_TREE;
  
  	if (TYPE_RETURNS_BY_TARGET_PTR_P (gnu_subprog_type))
  	  {
+ 	    if (gnu_ret_val)
+ 	      gnu_result = build_binary_op (MODIFY_EXPR, NULL_TREE,
+ 					    gnu_lhs, gnu_ret_val);
  	    add_stmt_with_node (gnu_result, gnat_node);
! 	    gnu_lhs = NULL_TREE;
  	  }
  
! 	gnu_result = build_return_expr (gnu_lhs, gnu_ret_val);
        }
        break;
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3660,3666 ****
  
      case N_Defining_Program_Unit_Name:
        /* For a child unit identifier go up a level to get the
!          specificaton.  We get this when we try to find the spec of
  	 a child unit package that is the compilation unit being compiled. */
        gnu_result = gnat_to_gnu (Parent (gnat_node));
        break;
--- 3715,3721 ----
  
      case N_Defining_Program_Unit_Name:
        /* For a child unit identifier go up a level to get the
!          specification.  We get this when we try to find the spec of
  	 a child unit package that is the compilation unit being compiled. */
        gnu_result = gnat_to_gnu (Parent (gnat_node));
        break;
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3779,3785 ****
      case N_Exception_Handler:
        if (Exception_Mechanism == Setjmp_Longjmp)
  	gnu_result = Exception_Handler_to_gnu_sjlj (gnat_node);
!       else if (Exception_Mechanism == GCC_ZCX)
  	gnu_result = Exception_Handler_to_gnu_zcx (gnat_node);
        else
  	gcc_unreachable ();
--- 3834,3840 ----
      case N_Exception_Handler:
        if (Exception_Mechanism == Setjmp_Longjmp)
  	gnu_result = Exception_Handler_to_gnu_sjlj (gnat_node);
!       else if (Exception_Mechanism == Back_End_Exceptions)
  	gnu_result = Exception_Handler_to_gnu_zcx (gnat_node);
        else
  	gcc_unreachable ();
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3907,3913 ****
--- 3962,3970 ----
        if (!type_annotate_only)
  	{
  	  tree gnu_ptr = gnat_to_gnu (Expression (gnat_node));
+ 	  tree gnu_ptr_type = TREE_TYPE (gnu_ptr);
  	  tree gnu_obj_type;
+ 	  tree gnu_actual_obj_type = 0;
  	  tree gnu_obj_size;
  	  int align;
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3932,3938 ****
  			 gnu_ptr);
  
  	  gnu_obj_type = TREE_TYPE (TREE_TYPE (gnu_ptr));
! 	  gnu_obj_size = TYPE_SIZE_UNIT (gnu_obj_type);
  	  align = TYPE_ALIGN (gnu_obj_type);
  
  	  if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
--- 3989,4009 ----
  			 gnu_ptr);
  
  	  gnu_obj_type = TREE_TYPE (TREE_TYPE (gnu_ptr));
! 
! 	  if (Present (Actual_Designated_Subtype (gnat_node)))
! 	    {
! 	      gnu_actual_obj_type = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_node));
! 
! 	      if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type))
! 	        gnu_actual_obj_type
! 	          = build_unc_object_type_from_ptr (gnu_ptr_type,
! 		      gnu_actual_obj_type,
! 		      get_identifier ("DEALLOC"));
! 	    }
! 	  else
! 	    gnu_actual_obj_type = gnu_obj_type;
! 
! 	  gnu_obj_size = TYPE_SIZE_UNIT (gnu_actual_obj_type);
  	  align = TYPE_ALIGN (gnu_obj_type);
  
  	  if (TREE_CODE (gnu_obj_type) == RECORD_TYPE
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3988,3994 ****
        /* If the result is a pointer type, see if we are either converting
           from a non-pointer or from a pointer to a type with a different
   	 alias set and warn if so.  If the result defined in the same unit as
!  	 this unchecked convertion, we can allow this because we can know to
   	 make that type have alias set 0.  */
        {
   	tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
--- 4059,4065 ----
        /* If the result is a pointer type, see if we are either converting
           from a non-pointer or from a pointer to a type with a different
   	 alias set and warn if so.  If the result defined in the same unit as
!  	 this unchecked conversion, we can allow this because we can know to
   	 make that type have alias set 0.  */
        {
   	tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
*************** gnat_to_gnu (Node_Id gnat_node)
*** 4012,4017 ****
--- 4083,4109 ----
                ("\\?or use `pragma No_Strict_Aliasing (&);`",
                 gnat_node, Target_Type (gnat_node));
  	  }
+ 
+ 	/* The No_Strict_Aliasing flag is not propagated to the back-end for
+ 	   fat pointers so unconditionally warn in problematic cases.  */
+ 	else if (TYPE_FAT_POINTER_P (gnu_target_type))
+ 	  {
+ 	    tree array_type
+ 	      = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
+ 
+ 	    if (get_alias_set (array_type) != 0
+ 		&& (!TYPE_FAT_POINTER_P (gnu_source_type)
+ 		    || (get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type))))
+ 			!= get_alias_set (array_type))))
+ 	      {
+ 		post_error_ne
+ 		  ("?possible aliasing problem for type&",
+ 		   gnat_node, Target_Type (gnat_node));
+ 		post_error
+ 		  ("\\?use -fno-strict-aliasing switch for references",
+ 		   gnat_node);
+ 	      }
+ 	  }
        }
        gnu_result = alloc_stmt_list ();
        break;
*************** gnat_to_gnu (Node_Id gnat_node)
*** 4038,4044 ****
      }
  
    /* Set the location information into the result.  Note that we may have
!      no result if we just expanded a procedure with no side-effects.  */
    if (gnu_result && EXPR_P (gnu_result))
      annotate_with_node (gnu_result, gnat_node);
  
--- 4130,4137 ----
      }
  
    /* Set the location information into the result.  Note that we may have
!      no result if we tried to build a CALL_EXPR node to a procedure with
!      no side-effects and optimization is enabled.  */
    if (gnu_result && EXPR_P (gnu_result))
      annotate_with_node (gnu_result, gnat_node);
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 4064,4070 ****
    if (TREE_SIDE_EFFECTS (gnu_result)
        && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
  	  || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
!     gnu_result = gnat_stabilize_reference (gnu_result, 0);
  
    /* Now convert the result to the proper type.  If the type is void or if
       we have no result, return error_mark_node to show we have no result.
--- 4157,4163 ----
    if (TREE_SIDE_EFFECTS (gnu_result)
        && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
  	  || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
!     gnu_result = gnat_stabilize_reference (gnu_result, false);
  
    /* Now convert the result to the proper type.  If the type is void or if
       we have no result, return error_mark_node to show we have no result.
*************** add_decl_expr (tree gnu_decl, Entity_Id 
*** 4258,4264 ****
  	}
      }
  
!   /* If this is a DECL_EXPR for a variable with DECL_INITIAl set,
       there are two cases we need to handle here.  */
    if (TREE_CODE (gnu_decl) == VAR_DECL && DECL_INITIAL (gnu_decl))
      {
--- 4351,4357 ----
  	}
      }
  
!   /* If this is a DECL_EXPR for a variable with DECL_INITIAL set,
       there are two cases we need to handle here.  */
    if (TREE_CODE (gnu_decl) == VAR_DECL && DECL_INITIAL (gnu_decl))
      {
*************** int
*** 4477,4482 ****
--- 4570,4576 ----
  gnat_gimplify_expr (tree *expr_p, tree *pre_p, tree *post_p ATTRIBUTE_UNUSED)
  {
    tree expr = *expr_p;
+   tree op;
  
    if (IS_ADA_STMT (expr))
      return gnat_gimplify_stmt (expr_p);
*************** gnat_gimplify_expr (tree *expr_p, tree *
*** 4507,4530 ****
        return GS_OK;
  
      case ADDR_EXPR:
        /* If we're taking the address of a constant CONSTRUCTOR, force it to
  	 be put into static memory.  We know it's going to be readonly given
  	 the semantics we have and it's required to be static memory in
! 	 the case when the reference is in an elaboration procedure.  */
!       if (TREE_CODE (TREE_OPERAND (expr, 0)) == CONSTRUCTOR
! 	  && TREE_CONSTANT (TREE_OPERAND (expr, 0)))
  	{
! 	  tree new_var
! 	    = create_tmp_var (TREE_TYPE (TREE_OPERAND (expr, 0)), "C");
  
  	  TREE_READONLY (new_var) = 1;
  	  TREE_STATIC (new_var) = 1;
  	  TREE_ADDRESSABLE (new_var) = 1;
! 	  DECL_INITIAL (new_var) = TREE_OPERAND (expr, 0);
  
  	  TREE_OPERAND (expr, 0) = new_var;
  	  return GS_ALL_DONE;
  	}
        return GS_UNHANDLED;
  
      case COMPONENT_REF:
--- 4601,4650 ----
        return GS_OK;
  
      case ADDR_EXPR:
+       op = TREE_OPERAND (expr, 0);
+ 
        /* If we're taking the address of a constant CONSTRUCTOR, force it to
  	 be put into static memory.  We know it's going to be readonly given
  	 the semantics we have and it's required to be static memory in
! 	 the case when the reference is in an elaboration procedure.   */
!       if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
  	{
! 	  tree new_var = create_tmp_var (TREE_TYPE (op), "C");
  
  	  TREE_READONLY (new_var) = 1;
  	  TREE_STATIC (new_var) = 1;
  	  TREE_ADDRESSABLE (new_var) = 1;
! 	  DECL_INITIAL (new_var) = op;
  
  	  TREE_OPERAND (expr, 0) = new_var;
+ 	  recompute_tree_invarant_for_addr_expr (expr);
  	  return GS_ALL_DONE;
  	}
+ 
+       /* Otherwise, if we are taking the address of something that is neither
+ 	 reference, declaration, or constant, make a variable for the operand
+ 	 here and then take its address.  If we don't do it this way, we may
+ 	 confuse the gimplifier because it needs to know the variable is
+ 	 addressable at this point.  This duplicates code in
+ 	 internal_get_tmp_var, which is unfortunate.  */
+       else if (TREE_CODE_CLASS (TREE_CODE (op)) != tcc_reference
+ 	       && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_declaration
+ 	       && TREE_CODE_CLASS (TREE_CODE (op)) != tcc_constant)
+ 	{
+ 	  tree new_var = create_tmp_var (TREE_TYPE (op), "A");
+ 	  tree mod = build (MODIFY_EXPR, TREE_TYPE (op), new_var, op);
+ 
+ 	  TREE_ADDRESSABLE (new_var) = 1;
+ 
+ 	  if (EXPR_HAS_LOCATION (op))
+ 	    SET_EXPR_LOCUS (mod, EXPR_LOCUS (op));
+ 
+ 	  gimplify_and_add (mod, pre_p);
+ 	  TREE_OPERAND (expr, 0) = new_var;
+ 	  recompute_tree_invarant_for_addr_expr (expr);
+ 	  return GS_ALL_DONE;
+ 	}
+ 
        return GS_UNHANDLED;
  
      case COMPONENT_REF:
*************** process_freeze_entity (Node_Id gnat_node
*** 4750,4760 ****
  
    /* Don't do anything for subprograms that may have been elaborated before
       their freeze nodes.  This can happen, for example because of an inner call
!      in an instance body.  */
!   if (gnu_old
!        && TREE_CODE (gnu_old) == FUNCTION_DECL
!        && (Ekind (gnat_entity) == E_Function
            || Ekind (gnat_entity) == E_Procedure))
      return;
  
    /* If we have a non-dummy type old tree, we have nothing to do.   Unless
--- 4870,4884 ----
  
    /* Don't do anything for subprograms that may have been elaborated before
       their freeze nodes.  This can happen, for example because of an inner call
!      in an instance body, or a previous compilation of a spec for inlining
!      purposes.  */
!   if  ((gnu_old
!         && TREE_CODE (gnu_old) == FUNCTION_DECL
!         && (Ekind (gnat_entity) == E_Function
            || Ekind (gnat_entity) == E_Procedure))
+     || (gnu_old
+         && (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
+         && Ekind (gnat_entity) == E_Subprogram_Type)))
      return;
  
    /* If we have a non-dummy type old tree, we have nothing to do.   Unless
*************** process_freeze_entity (Node_Id gnat_node
*** 4794,4799 ****
--- 4918,4933 ----
      {
        gnu_new = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 1);
  
+       /* Propagate back-annotations from full view to partial view.  */
+       if (Unknown_Alignment (gnat_entity))
+ 	Set_Alignment (gnat_entity, Alignment (Full_View (gnat_entity)));
+ 
+       if (Unknown_Esize (gnat_entity))
+ 	Set_Esize (gnat_entity, Esize (Full_View (gnat_entity)));
+ 
+       if (Unknown_RM_Size (gnat_entity))
+ 	Set_RM_Size (gnat_entity, RM_Size (Full_View (gnat_entity)));
+ 
        /* The above call may have defined this entity (the simplest example
    	 of this is when we have a private enumeral type since the bounds
    	 will have the public view.  */
*************** process_inlined_subprograms (Node_Id gna
*** 4824,4830 ****
  
    /* If we can inline, generate RTL for all the inlined subprograms.
       Define the entity first so we set DECL_EXTERNAL.  */
!   if (optimize > 0 && !flag_no_inline)
      for (gnat_entity = First_Inlined_Subprogram (gnat_node);
  	 Present (gnat_entity);
  	 gnat_entity = Next_Inlined_Subprogram (gnat_entity))
--- 4958,4964 ----
  
    /* If we can inline, generate RTL for all the inlined subprograms.
       Define the entity first so we set DECL_EXTERNAL.  */
!   if (optimize > 0 && !flag_really_no_inline)
      for (gnat_entity = First_Inlined_Subprogram (gnat_node);
  	 Present (gnat_entity);
  	 gnat_entity = Next_Inlined_Subprogram (gnat_entity))
*************** convert_with_check (Entity_Id gnat_type,
*** 5284,5292 ****
  }
  
  /* Return 1 if GNU_EXPR can be directly addressed.  This is the case unless
!    it is an expression involving computation or if it involves a bitfield
!    reference.  This returns the same as gnat_mark_addressable in most
!    cases.  */
  
  static bool
  addressable_p (tree gnu_expr)
--- 5418,5425 ----
  }
  
  /* Return 1 if GNU_EXPR can be directly addressed.  This is the case unless
!    it is an expression involving computation or if it involves a reference
!    to a bitfield or to a field not sufficiently aligned for its type.  */
  
  static bool
  addressable_p (tree gnu_expr)
*************** addressable_p (tree gnu_expr)
*** 5310,5317 ****
  
      case COMPONENT_REF:
        return (!DECL_BIT_FIELD (TREE_OPERAND (gnu_expr, 1))
! 	      && (!DECL_NONADDRESSABLE_P (TREE_OPERAND (gnu_expr, 1))
! 		  || !flag_strict_aliasing)
  	      && addressable_p (TREE_OPERAND (gnu_expr, 0)));
  
      case ARRAY_REF:  case ARRAY_RANGE_REF:
--- 5443,5457 ----
  
      case COMPONENT_REF:
        return (!DECL_BIT_FIELD (TREE_OPERAND (gnu_expr, 1))
! 	      && (!STRICT_ALIGNMENT
! 	          /* If the field was marked as "semantically" addressable
! 		     in create_field_decl, we are guaranteed that it can
! 		     be directly addressed.  */
! 		  || !DECL_NONADDRESSABLE_P (TREE_OPERAND (gnu_expr, 1))
! 		  /* Otherwise it can nevertheless be directly addressed
! 		     if it has been sufficiently aligned in the record.  */
! 		  || DECL_ALIGN (TREE_OPERAND (gnu_expr, 1))
! 		       >= TYPE_ALIGN (TREE_TYPE (gnu_expr)))
  	      && addressable_p (TREE_OPERAND (gnu_expr, 0)));
  
      case ARRAY_REF:  case ARRAY_RANGE_REF:
*************** addressable_p (tree gnu_expr)
*** 5348,5354 ****
  
  /* Do the processing for the declaration of a GNAT_ENTITY, a type.  If
     a separate Freeze node exists, delay the bulk of the processing.  Otherwise
!    make a GCC type for GNAT_ENTITY and set up the correspondance.  */
  
  void
  process_type (Entity_Id gnat_entity)
--- 5488,5494 ----
  
  /* Do the processing for the declaration of a GNAT_ENTITY, a type.  If
     a separate Freeze node exists, delay the bulk of the processing.  Otherwise
!    make a GCC type for GNAT_ENTITY and set up the correspondence.  */
  
  void
  process_type (Entity_Id gnat_entity)
*************** extract_values (tree values, tree record
*** 5567,5573 ****
        else if (DECL_INTERNAL_P (field))
  	{
  	  value = extract_values (values, TREE_TYPE (field));
! 	  if (TREE_CODE (value) == CONSTRUCTOR && !CONSTRUCTOR_ELTS (value))
  	    value = 0;
  	}
        else
--- 5707,5714 ----
        else if (DECL_INTERNAL_P (field))
  	{
  	  value = extract_values (values, TREE_TYPE (field));
! 	  if (TREE_CODE (value) == CONSTRUCTOR
! 	      && VEC_empty (constructor_elt, CONSTRUCTOR_ELTS (value)))
  	    value = 0;
  	}
        else
*************** protect_multiple_eval (tree exp)
*** 5645,5661 ****
  						 exp)));
  }
  
! /* This is equivalent to stabilize_reference in GCC's tree.c, but we know
!    how to handle our new nodes and we take an extra argument that says
!    whether to force evaluation of everything.  */
  
  tree
! gnat_stabilize_reference (tree ref, bool force)
  {
    tree type = TREE_TYPE (ref);
    enum tree_code code = TREE_CODE (ref);
    tree result;
  
    switch (code)
      {
      case VAR_DECL:
--- 5786,5811 ----
  						 exp)));
  }
  
! /* This is equivalent to stabilize_reference in GCC's tree.c, but we know how
!    to handle our new nodes and we take extra arguments:
! 
!    FORCE says whether to force evaluation of everything,
! 
!    SUCCESS we set to true unless we walk through something we don't know how
!    to stabilize, or through something which is not an lvalue and LVALUES_ONLY
!    is true, in which cases we set to false.  */
  
  tree
! maybe_stabilize_reference (tree ref, bool force, bool lvalues_only,
! 			   bool *success)
  {
    tree type = TREE_TYPE (ref);
    enum tree_code code = TREE_CODE (ref);
    tree result;
  
+   /* Assume we'll success unless proven otherwise.  */
+   *success = true;
+ 
    switch (code)
      {
      case VAR_DECL:
*************** gnat_stabilize_reference (tree ref, bool
*** 5664,5669 ****
--- 5814,5828 ----
        /* No action is needed in this case.  */
        return ref;
  
+     case ADDR_EXPR:
+       /*  A standalone ADDR_EXPR is never an lvalue, and this one can't
+ 	  be nested inside an outer INDIRECT_REF, since INDIREC_REF goes
+ 	  straight to stabilize_1.  */
+       if (lvalues_only)
+ 	goto failure;
+ 
+       /* ... Fallthru ... */
+ 
      case NOP_EXPR:
      case CONVERT_EXPR:
      case FLOAT_EXPR:
*************** gnat_stabilize_reference (tree ref, bool
*** 5672,5681 ****
      case FIX_ROUND_EXPR:
      case FIX_CEIL_EXPR:
      case VIEW_CONVERT_EXPR:
-     case ADDR_EXPR:
        result
  	= build1 (code, type,
! 		  gnat_stabilize_reference (TREE_OPERAND (ref, 0), force));
        break;
  
      case INDIRECT_REF:
--- 5831,5840 ----
      case FIX_ROUND_EXPR:
      case FIX_CEIL_EXPR:
      case VIEW_CONVERT_EXPR:
        result
  	= build1 (code, type,
! 		  maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
! 					     lvalues_only, success));
        break;
  
      case INDIRECT_REF:
*************** gnat_stabilize_reference (tree ref, bool
*** 5686,5700 ****
        break;
  
      case COMPONENT_REF:
!       result = build3 (COMPONENT_REF, type,
! 		       gnat_stabilize_reference (TREE_OPERAND (ref, 0),
! 						 force),
! 		       TREE_OPERAND (ref, 1), NULL_TREE);
        break;
  
      case BIT_FIELD_REF:
        result = build3 (BIT_FIELD_REF, type,
! 		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
  						   force),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
--- 5845,5860 ----
        break;
  
      case COMPONENT_REF:
!      result = build3 (COMPONENT_REF, type,
! 		      maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
! 						 lvalues_only, success),
! 		      TREE_OPERAND (ref, 1), NULL_TREE);
        break;
  
      case BIT_FIELD_REF:
        result = build3 (BIT_FIELD_REF, type,
! 		       maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
! 						  lvalues_only, success),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
  						   force),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
*************** gnat_stabilize_reference (tree ref, bool
*** 5704,5710 ****
      case ARRAY_REF:
      case ARRAY_RANGE_REF:
        result = build4 (code, type,
! 		       gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
  						   force),
  		       NULL_TREE, NULL_TREE);
--- 5864,5871 ----
      case ARRAY_REF:
      case ARRAY_RANGE_REF:
        result = build4 (code, type,
! 		       maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
! 						  lvalues_only, success),
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
  						   force),
  		       NULL_TREE, NULL_TREE);
*************** gnat_stabilize_reference (tree ref, bool
*** 5714,5730 ****
        result = build2 (COMPOUND_EXPR, type,
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
  						   force),
! 		       gnat_stabilize_reference (TREE_OPERAND (ref, 1),
! 						 force));
        break;
  
        /* If arg isn't a kind of lvalue we recognize, make no change.
  	 Caller should recognize the error for an invalid lvalue.  */
      default:
        return ref;
- 
-     case ERROR_MARK:
-       return error_mark_node;
      }
  
    TREE_READONLY (result) = TREE_READONLY (ref);
--- 5875,5895 ----
        result = build2 (COMPOUND_EXPR, type,
  		       gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
  						   force),
! 		       maybe_stabilize_reference (TREE_OPERAND (ref, 1), force,
! 						  lvalues_only, success));
        break;
  
+     case ERROR_MARK:
+       ref = error_mark_node;
+ 
+       /* ...  Fallthru to failure ... */
+ 
        /* If arg isn't a kind of lvalue we recognize, make no change.
  	 Caller should recognize the error for an invalid lvalue.  */
      default:
+     failure:
+       *success = false;
        return ref;
      }
  
    TREE_READONLY (result) = TREE_READONLY (ref);
*************** gnat_stabilize_reference (tree ref, bool
*** 5744,5749 ****
--- 5909,5925 ----
    return result;
  }
  
+ /* Wrapper around maybe_stabilize_reference, for common uses without
+    lvalue restrictions and without need to examine the success
+    indication.  */
+ 
+ tree
+ gnat_stabilize_reference (tree ref, bool force)
+ {
+   bool stabilized;
+   return maybe_stabilize_reference (ref, force, false, &stabilized);
+ }
+ 
  /* Similar to stabilize_reference_1 in tree.c, but supports an extra
     arg to force a SAVE_EXPR for everything.  */
  
*************** gnat_stabilize_reference_1 (tree e, bool
*** 5816,5821 ****
--- 5992,6019 ----
    TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
    return result;
  }
+ 
+ /* Build a global constructor or destructor function.  METHOD_TYPE gives
+    the type of the function and CDTORS points to the list of constructor
+    or destructor functions to be invoked.  FIXME: Migrate into cgraph.  */
+ 
+ static void
+ build_global_cdtor (int method_type, tree *cdtors)
+ {
+   tree body = 0;
+ 
+   for (; *cdtors; *cdtors = TREE_CHAIN (*cdtors))
+     {
+       tree fn = TREE_VALUE (*cdtors);
+       tree fntype = TREE_TYPE (fn);
+       tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), fn);
+       tree fncall = build3 (CALL_EXPR, TREE_TYPE (fntype), fnaddr, NULL_TREE,
+ 			    NULL_TREE);
+       append_to_statement_list (fncall, &body);
+     }
+ 
+   cgraph_build_static_cdtor (method_type, body, DEFAULT_INIT_PRIORITY);
+ }
  
  extern char *__gnat_to_canonical_file_spec (char *);
  
*************** post_error_ne_tree_2 (const char *msg,
*** 5979,5992 ****
    Error_Msg_Uint_2 = UI_From_Int (num);
    post_error_ne_tree (msg, node, ent, t);
  }
- 
- /* Set the node for a second '&' in the error message.  */
- 
- void
- set_second_error_entity (Entity_Id e)
- {
-   Error_Msg_Node_2 = e;
- }
  
  /* Initialize the table that maps GNAT codes to GCC codes for simple
     binary and unary operations.  */
--- 6177,6182 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_gen.adb gcc-4.1.0/gcc/ada/tree_gen.adb
*** gcc-4.0.2/gcc/ada/tree_gen.adb	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/tree_gen.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_gen.ads gcc-4.1.0/gcc/ada/tree_gen.ads
*** gcc-4.0.2/gcc/ada/tree_gen.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/tree_gen.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_in.adb gcc-4.1.0/gcc/ada/tree_in.adb
*** gcc-4.0.2/gcc/ada/tree_in.adb	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/tree_in.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_in.ads gcc-4.1.0/gcc/ada/tree_in.ads
*** gcc-4.0.2/gcc/ada/tree_in.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/tree_in.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_io.adb gcc-4.1.0/gcc/ada/tree_io.adb
*** gcc-4.0.2/gcc/ada/tree_io.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/tree_io.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/tree_io.ads gcc-4.1.0/gcc/ada/tree_io.ads
*** gcc-4.0.2/gcc/ada/tree_io.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/tree_io.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1999 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Tree_IO is
*** 96,102 ****
     --  Writes a single integer value to the current tree file
  
     procedure Tree_Write_Str (S : String_Ptr);
!    --  Write out string value referenced by S. Low bound must be 1.
  
     procedure Tree_Write_Terminate;
     --  Terminates writing of the file (flushing the buffer), but does not
--- 96,102 ----
     --  Writes a single integer value to the current tree file
  
     procedure Tree_Write_Str (S : String_Ptr);
!    --  Write out string value referenced by S (low bound of S must be 1)
  
     procedure Tree_Write_Terminate;
     --  Terminates writing of the file (flushing the buffer), but does not
diff -Nrcpad gcc-4.0.2/gcc/ada/treepr.adb gcc-4.1.0/gcc/ada/treepr.adb
*** gcc-4.0.2/gcc/ada/treepr.adb	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/treepr.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/treepr.ads gcc-4.1.0/gcc/ada/treepr.ads
*** gcc-4.0.2/gcc/ada/treepr.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/treepr.ads	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/treeprs.adt gcc-4.1.0/gcc/ada/treeprs.adt
*** gcc-4.0.2/gcc/ada/treeprs.adt	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/treeprs.adt	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                             T e m p l a t e                              --
  --                                                                          --
! --          Copyright (C) 1992-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- --
--- 6,12 ----
  --                                                                          --
  --                             T e m p l a t e                              --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,29 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
- 
  --  This file is a template used as input to the utility program XTreeprs,
  --  which reads this template, and the spec of Sinfo (sinfo.ads) and generates
  --  the spec for the Treeprs package (file treeprs.ads)
--- 16,28 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  --  This file is a template used as input to the utility program XTreeprs,
  --  which reads this template, and the spec of Sinfo (sinfo.ads) and generates
  --  the spec for the Treeprs package (file treeprs.ads)
diff -Nrcpad gcc-4.0.2/gcc/ada/ttypef.ads gcc-4.1.0/gcc/ada/ttypef.ads
*** gcc-4.0.2/gcc/ada/ttypef.ads	Thu Apr 24 17:54:19 2003
--- gcc-4.1.0/gcc/ada/ttypef.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  --                                                                          --
  -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  -- terms of the  GNU General Public License as published  by the Free Soft- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Ttypef is
*** 143,150 ****
     IEEEL_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
     IEEEX_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
     VAXFF_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
!    VAXDF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FF8#E-38;
!    VAXGF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FC#E-256;
     AAMPS_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
     AAMPL_Safe_First        : constant := -16#0.7FFF_FFFF_FF8#E+32;
  
--- 143,150 ----
     IEEEL_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
     IEEEX_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
     VAXFF_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
!    VAXDF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FC0#E+32;
!    VAXGF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256;
     AAMPS_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
     AAMPL_Safe_First        : constant := -16#0.7FFF_FFFF_FF8#E+32;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/ttypes.ads gcc-4.1.0/gcc/ada/ttypes.ads
*** gcc-4.0.2/gcc/ada/ttypes.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/ttypes.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Ttypes is
*** 143,149 ****
  
     Standard_Wide_Character_Size        : constant Pos := 16;
     Standard_Wide_Wide_Character_Size   : constant Pos := 32;
!    --  Standard wide character sizes.
  
     --  Note: there is no specific control over the representation of
     --  enumeration types. The convention used is that if an enumeration
--- 143,149 ----
  
     Standard_Wide_Character_Size        : constant Pos := 16;
     Standard_Wide_Wide_Character_Size   : constant Pos := 32;
!    --  Standard wide character sizes
  
     --  Note: there is no specific control over the representation of
     --  enumeration types. The convention used is that if an enumeration
diff -Nrcpad gcc-4.0.2/gcc/ada/types.adb gcc-4.1.0/gcc/ada/types.adb
*** gcc-4.0.2/gcc/ada/types.adb	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/types.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/types.ads gcc-4.1.0/gcc/ada/types.ads
*** gcc-4.0.2/gcc/ada/types.ads	Thu Feb 10 13:50:39 2005
--- gcc-4.1.0/gcc/ada/types.ads	Tue Nov 15 13:51:09 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
***************
*** 31,41 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
- with Unchecked_Deallocation;
- 
- package Types is
- pragma Preelaborate (Types);
- 
  --  This package contains host independent type definitions which are used
  --  in more than one unit in the compiler. They are gathered here for easy
  --  reference, though in some cases the full description is found in the
--- 31,36 ----
*************** pragma Preelaborate (Types);
*** 45,57 ****
  --  dependencies would have to be dealt with.
  
  --  WARNING: There is a C version of this package. Any changes to this
! --  source file must be properly reflected in the C header file a-types.h
  
  --  Note: the declarations in this package reflect an expectation that the
  --  host machine has an efficient integer base type with a range at least
  --  32 bits 2s-complement. If there are any machines for which this is not
  --  a correct assumption, a significant number of changes will be required!
  
     -------------------------------
     -- General Use Integer Types --
     -------------------------------
--- 40,57 ----
  --  dependencies would have to be dealt with.
  
  --  WARNING: There is a C version of this package. Any changes to this
! --  source file must be properly reflected in the C header file types.h
  
  --  Note: the declarations in this package reflect an expectation that the
  --  host machine has an efficient integer base type with a range at least
  --  32 bits 2s-complement. If there are any machines for which this is not
  --  a correct assumption, a significant number of changes will be required!
  
+ with Unchecked_Deallocation;
+ 
+ package Types is
+    pragma Preelaborate;
+ 
     -------------------------------
     -- General Use Integer Types --
     -------------------------------
*************** pragma Preelaborate (Types);
*** 311,324 ****
     --  is in practice infinite and there is no need to check the range.
  
     Ureal_Low_Bound : constant := 500_000_000;
!    --  Low bound for Ureal values.
  
     Ureal_High_Bound : constant := 599_999_999;
     --  Maximum number of Ureal values stored is 100_000_000 which is in
     --  practice infinite so that no check is required.
  
     Uint_Low_Bound : constant := 600_000_000;
!    --  Low bound for Uint values.
  
     Uint_Table_Start : constant := 2_000_000_000;
     --  Location where table entries for universal integers start (see
--- 311,324 ----
     --  is in practice infinite and there is no need to check the range.
  
     Ureal_Low_Bound : constant := 500_000_000;
!    --  Low bound for Ureal values
  
     Ureal_High_Bound : constant := 599_999_999;
     --  Maximum number of Ureal values stored is 100_000_000 which is in
     --  practice infinite so that no check is required.
  
     Uint_Low_Bound : constant := 600_000_000;
!    --  Low bound for Uint values
  
     Uint_Table_Start : constant := 2_000_000_000;
     --  Location where table entries for universal integers start (see
*************** pragma Preelaborate (Types);
*** 479,485 ****
     --  are not valid.
  
     First_Elist_Id : constant Elist_Id := No_Elist + 1;
!    --  Subscript of first allocated Elist header.
  
     --  Element Id values are used to identify individual elements of an
     --  element list (see package Elists for further details).
--- 479,485 ----
     --  are not valid.
  
     First_Elist_Id : constant Elist_Id := No_Elist + 1;
!    --  Subscript of first allocated Elist header
  
     --  Element Id values are used to identify individual elements of an
     --  element list (see package Elists for further details).
*************** pragma Preelaborate (Types);
*** 696,707 ****
        Tag_Check,
        All_Checks);
  
!    --  The following record contains an entry for each recognized check name
     --  for pragma Suppress. It is used to represent current settings of scope
     --  based suppress actions from pragma Suppress or command line settings.
  
!    type Suppress_Array is
!      array (Check_Id range Access_Check .. Tag_Check) of Boolean;
     pragma Pack (Suppress_Array);
  
     --  To add a new check type to GNAT, the following steps are required:
--- 696,714 ----
        Tag_Check,
        All_Checks);
  
!    --  The following array contains an entry for each recognized check name
     --  for pragma Suppress. It is used to represent current settings of scope
     --  based suppress actions from pragma Suppress or command line settings.
  
!    --  Note: when Suppress_Array (All_Checks) is True, then generally all other
!    --  specific check entries are set True, except for the Elaboration_Check
!    --  entry which is set only if an explicit Suppress for this check is given.
!    --  The reason for this non-uniformity is that we do not want All_Checks to
!    --  suppress elaboration checking when using the static elaboration model.
!    --  We recognize only an explicit suppress of Elaboration_Check as a signal
!    --  that the static elaboration checking should skip a compile time check.
! 
!    type Suppress_Array is array (Check_Id) of Boolean;
     pragma Pack (Suppress_Array);
  
     --  To add a new check type to GNAT, the following steps are required:
diff -Nrcpad gcc-4.0.2/gcc/ada/types.h gcc-4.1.0/gcc/ada/types.h
*** gcc-4.0.2/gcc/ada/types.h	Thu Feb 10 13:50:40 2005
--- gcc-4.1.0/gcc/ada/types.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/ug_words gcc-4.1.0/gcc/ada/ug_words
*** gcc-4.0.2/gcc/ada/ug_words	Mon Jan  3 15:43:22 2005
--- gcc-4.1.0/gcc/ada/ug_words	Tue Nov 15 14:05:45 2005
*************** gcc -c          ^ GNAT COMPILE
*** 105,110 ****
--- 105,112 ----
  -gnatw          ^ /WARNINGS
  -gnatwa         ^ /WARNINGS=OPTIONAL
  -gnatwA         ^ /WARNINGS=NOOPTIONAL
+ -gnatwb         ^ /WARNINGS=BAD_FIXED_VALUES
+ -gnatwB         ^ /WARNINGS=NO_BAD_FIXED_VALUES
  -gnatwc         ^ /WARNINGS=CONDITIONALS
  -gnatwC         ^ /WARNINGS=NOCONDITIONALS
  -gnatwd         ^ /WARNINGS=IMPLICIT_DEREFERENCE
*************** gcc -c          ^ GNAT COMPILE
*** 140,145 ****
--- 142,149 ----
  -gnatwV         ^ /WARNINGS=NOVARIABLES_UNINITIALIZED
  -gnatwx         ^ /WARNINGS=IMPORT_EXPORT_PRAGMAS
  -gnatwX         ^ /WARNINGS=NOIMPORT_EXPORT_PRAGMAS
+ -gnatwy         ^ /WARNINGS=ADA_2005_COMPATIBILITY
+ -gnatwY         ^ /WARNINGS=NOADA_2005_COMPATIBILITY
  -gnatwz         ^ /WARNINGS=UNCHECKED_CONVERSIONS
  -gnatwZ         ^ /WARNINGS=NOUNCHECKED_CONVERSIONS
  -gnatW8         ^ /WIDE_CHARACTER_ENCODING=UTF8
*************** gcc -c          ^ GNAT COMPILE
*** 149,154 ****
--- 153,160 ----
  -gnatzc         ^ /DISTRIBUTION_STUBS=CALLER
  -gnatzr         ^ /DISTRIBUTION_STUBS=RECEIVER
  -gnat83         ^ /83
+ -gnat95         ^ /95
+ -gnat05         ^ /05
  -gnatx          ^ /XREF=SUPPRESS
  -gnatX          ^ /EXTENSIONS_ALLOWED
  --RTS           ^ /RUNTIME_SYSTEM
diff -Nrcpad gcc-4.0.2/gcc/ada/uintp.adb gcc-4.1.0/gcc/ada/uintp.adb
*** gcc-4.0.2/gcc/ada/uintp.adb	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/uintp.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Uintp is
*** 50,56 ****
     --  value, since the issue is host representation of integer values.
  
     Uint_Int_Last : Uint;
!    --  Uint value containing Int'Last value set by Initialize.
  
     UI_Power_2 : array (Int range 0 .. 64) of Uint;
     --  This table is used to memoize exponentiations by powers of 2. The Nth
--- 50,56 ----
     --  value, since the issue is host representation of integer values.
  
     Uint_Int_Last : Uint;
!    --  Uint value containing Int'Last value set by Initialize
  
     UI_Power_2 : array (Int range 0 .. 64) of Uint;
     --  This table is used to memoize exponentiations by powers of 2. The Nth
*************** package body Uintp is
*** 727,735 ****
     --  Mathematically: assume base congruent to 1 and compute an equivelent
     --  integer to Left.
  
!    --  If Sign = -1 return the alternating sum of the "digits".
  
!    --     D1 - D2 + D3 - D4 + D5 . . .
  
     --  (where D1 is Least Significant Digit)
  
--- 727,735 ----
     --  Mathematically: assume base congruent to 1 and compute an equivelent
     --  integer to Left.
  
!    --  If Sign = -1 return the alternating sum of the "digits"
  
!    --     D1 - D2 + D3 - D4 + D5 ...
  
     --  (where D1 is Least Significant Digit)
  
*************** package body Uintp is
*** 761,767 ****
  
                 if Tmp_Int >= Base then
  
!                   --  Sign must be 1.
  
                    Tmp_Int := (Tmp_Int / Base) + 1;
  
--- 761,767 ----
  
                 if Tmp_Int >= Base then
  
!                   --  Sign must be 1
  
                    Tmp_Int := (Tmp_Int / Base) + 1;
  
*************** package body Uintp is
*** 1328,1334 ****
                    Carry        := Tmp_Int / Base;
                 end loop;
  
!                --  Multiply Divisor by d.
  
                 Carry := 0;
                 for J in reverse Divisor'Range loop
--- 1328,1334 ----
                    Carry        := Tmp_Int / Base;
                 end loop;
  
!                --  Multiply Divisor by d
  
                 Carry := 0;
                 for J in reverse Divisor'Range loop
*************** package body Uintp is
*** 1338,1351 ****
                 end loop;
              end if;
  
!             --  Main loop of long division algorithm.
  
              Divisor_Dig1 := Divisor (1);
              Divisor_Dig2 := Divisor (2);
  
              for J in Quotient'Range loop
  
!                --  [ CALCULATE Q (hat) ] (step D3 in the algorithm).
  
                 Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
  
--- 1338,1351 ----
                 end loop;
              end if;
  
!             --  Main loop of long division algorithm
  
              Divisor_Dig1 := Divisor (1);
              Divisor_Dig2 := Divisor (2);
  
              for J in Quotient'Range loop
  
!                --  [ CALCULATE Q (hat) ] (step D3 in the algorithm)
  
                 Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
  
*************** package body Uintp is
*** 1474,1480 ****
        if Right = Uint_0 then
           return Uint_1;
  
!       --  0 to any positive power is 0.
  
        elsif Left = Uint_0 then
           return Uint_0;
--- 1474,1480 ----
        if Right = Uint_0 then
           return Uint_1;
  
!       --  0 to any positive power is 0
  
        elsif Left = Uint_0 then
           return Uint_0;
*************** package body Uintp is
*** 1664,1670 ****
     -- UI_GCD --
     ------------
  
!    --  Lehmer's algorithm for GCD.
  
     --  The idea is to avoid using multiple precision arithmetic wherever
     --  possible, substituting Int arithmetic instead. See Knuth volume II,
--- 1664,1670 ----
     -- UI_GCD --
     ------------
  
!    --  Lehmer's algorithm for GCD
  
     --  The idea is to avoid using multiple precision arithmetic wherever
     --  possible, substituting Int arithmetic instead. See Knuth volume II,
*************** package body Uintp is
*** 1712,1718 ****
  
           loop
              --  We might overflow and get division by zero here. This just
!             --  means we can not take the single precision step
  
              Den1 := V_Hat + C;
              Den2 := V_Hat + D;
--- 1712,1718 ----
  
           loop
              --  We might overflow and get division by zero here. This just
!             --  means we cannot take the single precision step
  
              Den1 := V_Hat + C;
              Den2 := V_Hat + D;
*************** package body Uintp is
*** 1745,1758 ****
  
           if B = Int_0 then
  
!             --  No single precision steps take a regular Euclid step.
  
              Tmp_UI := U rem V;
              U := V;
              V := Tmp_UI;
  
           else
!             --  Use prior single precision steps to compute this Euclid step.
  
              --  Fixed bug 1415-008 spends 80% of its time working on this
              --  step. Perhaps we need a special case Int / Uint dot
--- 1745,1758 ----
  
           if B = Int_0 then
  
!             --  No single precision steps take a regular Euclid step
  
              Tmp_UI := U rem V;
              U := V;
              V := Tmp_UI;
  
           else
!             --  Use prior single precision steps to compute this Euclid step
  
              --  Fixed bug 1415-008 spends 80% of its time working on this
              --  step. Perhaps we need a special case Int / Uint dot
*************** package body Uintp is
*** 2257,2263 ****
                    --  and replace the rem with simpler operations where
                    --  possible.
  
!                   --  Least_Sig_Digit might return Negative numbers.
  
                    when 2 =>
                       return UI_From_Int (
--- 2257,2263 ----
                    --  and replace the rem with simpler operations where
                    --  possible.
  
!                   --  Least_Sig_Digit might return Negative numbers
  
                    when 2 =>
                       return UI_From_Int (
*************** package body Uintp is
*** 2357,2363 ****
  
              end if;
  
!             --  Else fall through to general case.
  
              --  ???This needs to be improved. We have the Rem when we do the
              --  Div. Div throws it away!
--- 2357,2363 ----
  
              end if;
  
!             --  Else fall through to general case
  
              --  ???This needs to be improved. We have the Rem when we do the
              --  Div. Div throws it away!
diff -Nrcpad gcc-4.0.2/gcc/ada/uintp.ads gcc-4.1.0/gcc/ada/uintp.ads
*** gcc-4.0.2/gcc/ada/uintp.ads	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/uintp.ads	Tue Nov 15 14:06:45 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Uintp is
*** 64,70 ****
--- 64,73 ----
     Uint_8   : constant Uint;
     Uint_9   : constant Uint;
     Uint_10  : constant Uint;
+    Uint_11  : constant Uint;
     Uint_12  : constant Uint;
+    Uint_13  : constant Uint;
+    Uint_14  : constant Uint;
     Uint_15  : constant Uint;
     Uint_16  : constant Uint;
     Uint_24  : constant Uint;
*************** package Uintp is
*** 110,121 ****
  
     function UI_Abs (Right : Uint) return Uint;
     pragma Inline (UI_Abs);
!    --  Returns abs function of universal integer.
  
     function UI_Add (Left : Uint; Right : Uint) return Uint;
     function UI_Add (Left : Int;  Right : Uint) return Uint;
     function UI_Add (Left : Uint; Right : Int)  return Uint;
!    --  Returns sum of two integer values.
  
     function UI_Decimal_Digits_Hi (U : Uint) return Nat;
     --  Returns an estimate of the number of decimal digits required to
--- 113,124 ----
  
     function UI_Abs (Right : Uint) return Uint;
     pragma Inline (UI_Abs);
!    --  Returns abs function of universal integer
  
     function UI_Add (Left : Uint; Right : Uint) return Uint;
     function UI_Add (Left : Int;  Right : Uint) return Uint;
     function UI_Add (Left : Uint; Right : Int)  return Uint;
!    --  Returns sum of two integer values
  
     function UI_Decimal_Digits_Hi (U : Uint) return Nat;
     --  Returns an estimate of the number of decimal digits required to
*************** package Uintp is
*** 140,183 ****
     function UI_Eq (Left : Int;  Right : Uint) return Boolean;
     function UI_Eq (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Eq);
!    --  Compares integer values for equality.
  
     function UI_Expon (Left : Uint; Right : Uint) return Uint;
     function UI_Expon (Left : Int;  Right : Uint) return Uint;
     function UI_Expon (Left : Uint; Right : Int)  return Uint;
     function UI_Expon (Left : Int;  Right : Int)  return Uint;
!    --  Returns result of exponentiating two integer values
     --  Fatal error if Right is negative.
  
     function UI_GCD (Uin, Vin : Uint) return Uint;
!    --  Computes GCD of input values. Assumes Uin >= Vin >= 0.
  
     function UI_Ge (Left : Uint; Right : Uint) return Boolean;
     function UI_Ge (Left : Int;  Right : Uint) return Boolean;
     function UI_Ge (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Ge);
!    --  Compares integer values for greater than or equal.
  
     function UI_Gt (Left : Uint; Right : Uint) return Boolean;
     function UI_Gt (Left : Int;  Right : Uint) return Boolean;
     function UI_Gt (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Gt);
!    --  Compares integer values for greater than.
  
     function UI_Is_In_Int_Range (Input : Uint) return Boolean;
     pragma Inline (UI_Is_In_Int_Range);
!    --  Determines if universal integer is in Int range.
  
     function UI_Le (Left : Uint; Right : Uint) return Boolean;
     function UI_Le (Left : Int;  Right : Uint) return Boolean;
     function UI_Le (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Le);
!    --  Compares integer values for less than or equal.
  
     function UI_Lt (Left : Uint; Right : Uint) return Boolean;
     function UI_Lt (Left : Int;  Right : Uint) return Boolean;
     function UI_Lt (Left : Uint; Right : Int)  return Boolean;
!    --  Compares integer values for less than.
  
     function UI_Max (Left : Uint; Right : Uint) return Uint;
     function UI_Max (Left : Int;  Right : Uint) return Uint;
--- 143,186 ----
     function UI_Eq (Left : Int;  Right : Uint) return Boolean;
     function UI_Eq (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Eq);
!    --  Compares integer values for equality
  
     function UI_Expon (Left : Uint; Right : Uint) return Uint;
     function UI_Expon (Left : Int;  Right : Uint) return Uint;
     function UI_Expon (Left : Uint; Right : Int)  return Uint;
     function UI_Expon (Left : Int;  Right : Int)  return Uint;
!    --  Returns result of exponentiating two integer values.
     --  Fatal error if Right is negative.
  
     function UI_GCD (Uin, Vin : Uint) return Uint;
!    --  Computes GCD of input values. Assumes Uin >= Vin >= 0
  
     function UI_Ge (Left : Uint; Right : Uint) return Boolean;
     function UI_Ge (Left : Int;  Right : Uint) return Boolean;
     function UI_Ge (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Ge);
!    --  Compares integer values for greater than or equal
  
     function UI_Gt (Left : Uint; Right : Uint) return Boolean;
     function UI_Gt (Left : Int;  Right : Uint) return Boolean;
     function UI_Gt (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Gt);
!    --  Compares integer values for greater than
  
     function UI_Is_In_Int_Range (Input : Uint) return Boolean;
     pragma Inline (UI_Is_In_Int_Range);
!    --  Determines if universal integer is in Int range
  
     function UI_Le (Left : Uint; Right : Uint) return Boolean;
     function UI_Le (Left : Int;  Right : Uint) return Boolean;
     function UI_Le (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Le);
!    --  Compares integer values for less than or equal
  
     function UI_Lt (Left : Uint; Right : Uint) return Boolean;
     function UI_Lt (Left : Int;  Right : Uint) return Boolean;
     function UI_Lt (Left : Uint; Right : Int)  return Boolean;
!    --  Compares integer values for less than
  
     function UI_Max (Left : Uint; Right : Uint) return Uint;
     function UI_Max (Left : Int;  Right : Uint) return Uint;
*************** package Uintp is
*** 187,199 ****
     function UI_Min (Left : Uint; Right : Uint) return Uint;
     function UI_Min (Left : Int;  Right : Uint) return Uint;
     function UI_Min (Left : Uint; Right : Int)  return Uint;
!    --  Returns minimum of two integer values.
  
     function UI_Mod (Left : Uint; Right : Uint) return Uint;
     function UI_Mod (Left : Int;  Right : Uint) return Uint;
     function UI_Mod (Left : Uint; Right : Int)  return Uint;
     pragma Inline (UI_Mod);
!    --  Returns mod function of two integer values.
  
     function UI_Mul (Left : Uint; Right : Uint) return Uint;
     function UI_Mul (Left : Int;  Right : Uint) return Uint;
--- 190,202 ----
     function UI_Min (Left : Uint; Right : Uint) return Uint;
     function UI_Min (Left : Int;  Right : Uint) return Uint;
     function UI_Min (Left : Uint; Right : Int)  return Uint;
!    --  Returns minimum of two integer values
  
     function UI_Mod (Left : Uint; Right : Uint) return Uint;
     function UI_Mod (Left : Int;  Right : Uint) return Uint;
     function UI_Mod (Left : Uint; Right : Int)  return Uint;
     pragma Inline (UI_Mod);
!    --  Returns mod function of two integer values
  
     function UI_Mul (Left : Uint; Right : Uint) return Uint;
     function UI_Mul (Left : Int;  Right : Uint) return Uint;
*************** package Uintp is
*** 204,219 ****
     function UI_Ne (Left : Int;  Right : Uint) return Boolean;
     function UI_Ne (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Ne);
!    --  Compares integer values for inequality.
  
     function UI_Negate (Right : Uint) return Uint;
     pragma Inline (UI_Negate);
!    --  Returns negative of universal integer.
  
     function UI_Rem (Left : Uint; Right : Uint) return Uint;
     function UI_Rem (Left : Int;  Right : Uint) return Uint;
     function UI_Rem (Left : Uint; Right : Int)  return Uint;
!    --  Returns rem of two integer values.
  
     function UI_Sub (Left : Uint; Right : Uint) return Uint;
     function UI_Sub (Left : Int;  Right : Uint) return Uint;
--- 207,222 ----
     function UI_Ne (Left : Int;  Right : Uint) return Boolean;
     function UI_Ne (Left : Uint; Right : Int)  return Boolean;
     pragma Inline (UI_Ne);
!    --  Compares integer values for inequality
  
     function UI_Negate (Right : Uint) return Uint;
     pragma Inline (UI_Negate);
!    --  Returns negative of universal integer
  
     function UI_Rem (Left : Uint; Right : Uint) return Uint;
     function UI_Rem (Left : Int;  Right : Uint) return Uint;
     function UI_Rem (Left : Uint; Right : Int)  return Uint;
!    --  Returns rem of two integer values
  
     function UI_Sub (Left : Uint; Right : Uint) return Uint;
     function UI_Sub (Left : Int;  Right : Uint) return Uint;
*************** private
*** 430,436 ****
--- 433,442 ----
     Uint_8   : constant Uint := Uint (Uint_Direct_Bias + 8);
     Uint_9   : constant Uint := Uint (Uint_Direct_Bias + 9);
     Uint_10  : constant Uint := Uint (Uint_Direct_Bias + 10);
+    Uint_11  : constant Uint := Uint (Uint_Direct_Bias + 11);
     Uint_12  : constant Uint := Uint (Uint_Direct_Bias + 12);
+    Uint_13  : constant Uint := Uint (Uint_Direct_Bias + 13);
+    Uint_14  : constant Uint := Uint (Uint_Direct_Bias + 14);
     Uint_15  : constant Uint := Uint (Uint_Direct_Bias + 15);
     Uint_16  : constant Uint := Uint (Uint_Direct_Bias + 16);
     Uint_24  : constant Uint := Uint (Uint_Direct_Bias + 24);
diff -Nrcpad gcc-4.0.2/gcc/ada/uintp.h gcc-4.1.0/gcc/ada/uintp.h
*** gcc-4.0.2/gcc/ada/uintp.h	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/uintp.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/uname.adb gcc-4.1.0/gcc/ada/uname.adb
*** gcc-4.0.2/gcc/ada/uname.adb	Tue Jul  6 13:57:32 2004
--- gcc-4.1.0/gcc/ada/uname.adb	Fri Jul  1 01:29:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package body Uname is
*** 527,534 ****
  
     function New_Child
       (Old  : Unit_Name_Type;
!       Newp : Unit_Name_Type)
!       return Unit_Name_Type
     is
        P : Natural;
  
--- 527,533 ----
  
     function New_Child
       (Old  : Unit_Name_Type;
!       Newp : Unit_Name_Type) return Unit_Name_Type
     is
        P : Natural;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/uname.ads gcc-4.1.0/gcc/ada/uname.ads
*** gcc-4.0.2/gcc/ada/uname.ads	Thu Apr 24 17:54:20 2003
--- gcc-4.1.0/gcc/ada/uname.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-1998, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Uname is
*** 74,80 ****
     --  corresponding body, i.e. characters %s replaced by %b
  
     function Get_Parent_Body_Name (N : Unit_Name_Type) return Unit_Name_Type;
!    --  Given the name of a subunit, returns the name of the parent body.
  
     function Get_Parent_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type;
     --  Given the name of a child unit spec or body, returns the unit name
--- 74,80 ----
     --  corresponding body, i.e. characters %s replaced by %b
  
     function Get_Parent_Body_Name (N : Unit_Name_Type) return Unit_Name_Type;
!    --  Given the name of a subunit, returns the name of the parent body
  
     function Get_Parent_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type;
     --  Given the name of a child unit spec or body, returns the unit name
*************** package Uname is
*** 140,147 ****
  
     function New_Child
       (Old  : Unit_Name_Type;
!       Newp : Unit_Name_Type)
!       return Unit_Name_Type;
     --   Old is a child unit name (for either a body or spec). Newp is the
     --   unit name of the actual parent (this may be different from the
     --   parent in old). The returned unit name is formed by taking the
--- 140,146 ----
  
     function New_Child
       (Old  : Unit_Name_Type;
!       Newp : Unit_Name_Type) return Unit_Name_Type;
     --   Old is a child unit name (for either a body or spec). Newp is the
     --   unit name of the actual parent (this may be different from the
     --   parent in old). The returned unit name is formed by taking the
diff -Nrcpad gcc-4.0.2/gcc/ada/urealp.adb gcc-4.1.0/gcc/ada/urealp.adb
*** gcc-4.0.2/gcc/ada/urealp.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/urealp.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
diff -Nrcpad gcc-4.0.2/gcc/ada/urealp.ads gcc-4.1.0/gcc/ada/urealp.ads
*** gcc-4.0.2/gcc/ada/urealp.ads	Mon Jan  3 15:43:24 2005
--- gcc-4.1.0/gcc/ada/urealp.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** package Urealp is
*** 148,166 ****
     --  Table.Tree_Write routines.
  
     function Rbase (Real : Ureal) return Nat;
!    --  Return the base of the universal real.
  
     function Denominator (Real : Ureal) return Uint;
!    --  Return the denominator of the universal real.
  
     function Numerator (Real : Ureal) return Uint;
!    --  Return the numerator of the universal real.
  
     function Norm_Den (Real : Ureal) return Uint;
!    --  Return the denominator of the universal real after a normalization.
  
     function Norm_Num (Real : Ureal) return Uint;
!    --  Return the numerator of the universal real after a normalization.
  
     function UR_From_Uint (UI : Uint) return Ureal;
     --  Returns real corresponding to universal integer value
--- 148,166 ----
     --  Table.Tree_Write routines.
  
     function Rbase (Real : Ureal) return Nat;
!    --  Return the base of the universal real
  
     function Denominator (Real : Ureal) return Uint;
!    --  Return the denominator of the universal real
  
     function Numerator (Real : Ureal) return Uint;
!    --  Return the numerator of the universal real
  
     function Norm_Den (Real : Ureal) return Uint;
!    --  Return the denominator of the universal real after a normalization
  
     function Norm_Num (Real : Ureal) return Uint;
!    --  Return the numerator of the universal real after a normalization
  
     function UR_From_Uint (UI : Uint) return Ureal;
     --  Returns real corresponding to universal integer value
*************** package Urealp is
*** 234,240 ****
     --  Returns negative of real
  
     function UR_Eq (Left, Right : Ureal) return Boolean;
!    --  Compares reals for equality.
  
     function UR_Max (Left, Right : Ureal) return Ureal;
     --  Returns the maximum of two reals
--- 234,240 ----
     --  Returns negative of real
  
     function UR_Eq (Left, Right : Ureal) return Boolean;
!    --  Compares reals for equality
  
     function UR_Max (Left, Right : Ureal) return Ureal;
     --  Returns the maximum of two reals
*************** package Urealp is
*** 243,261 ****
     --  Returns the minimum of two reals
  
     function UR_Ne (Left, Right : Ureal) return Boolean;
!    --  Compares reals for inequality.
  
     function UR_Lt (Left, Right : Ureal) return Boolean;
!    --  Compares reals for less than.
  
     function UR_Le (Left, Right : Ureal) return Boolean;
!    --  Compares reals for less than or equal.
  
     function UR_Gt (Left, Right : Ureal) return Boolean;
!    --  Compares reals for greater than.
  
     function UR_Ge (Left, Right : Ureal) return Boolean;
!    --  Compares reals for greater than or equal.
  
     function UR_Is_Zero (Real : Ureal) return Boolean;
     --  Tests if real value is zero
--- 243,261 ----
     --  Returns the minimum of two reals
  
     function UR_Ne (Left, Right : Ureal) return Boolean;
!    --  Compares reals for inequality
  
     function UR_Lt (Left, Right : Ureal) return Boolean;
!    --  Compares reals for less than
  
     function UR_Le (Left, Right : Ureal) return Boolean;
!    --  Compares reals for less than or equal
  
     function UR_Gt (Left, Right : Ureal) return Boolean;
!    --  Compares reals for greater than
  
     function UR_Ge (Left, Right : Ureal) return Boolean;
!    --  Compares reals for greater than or equal
  
     function UR_Is_Zero (Real : Ureal) return Boolean;
     --  Tests if real value is zero
diff -Nrcpad gcc-4.0.2/gcc/ada/urealp.h gcc-4.1.0/gcc/ada/urealp.h
*** gcc-4.0.2/gcc/ada/urealp.h	Thu Oct 23 11:57:52 2003
--- gcc-4.1.0/gcc/ada/urealp.h	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
diff -Nrcpad gcc-4.0.2/gcc/ada/usage.adb gcc-4.1.0/gcc/ada/usage.adb
*** gcc-4.0.2/gcc/ada/usage.adb	Thu Feb 10 13:56:59 2005
--- gcc-4.1.0/gcc/ada/usage.adb	Tue Nov 15 14:05:30 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 26,31 ****
--- 26,32 ----
  
  with Hostparm;
  with Namet;          use Namet;
+ with Opt;            use Opt;
  with Osint;          use Osint;
  with Output;         use Output;
  with System.WCh_Con; use System.WCh_Con;
*************** begin
*** 161,167 ****
  
     --  Line for -gnateI switch
  
!    Write_Switch_Char ("eInnn");
     Write_Line ("Index in multi-unit source, e.g. -gnateI2");
  
     --  Line for -gnatem switch
--- 162,168 ----
  
     --  Line for -gnateI switch
  
!    Write_Switch_Char ("eInn");
     Write_Line ("Index in multi-unit source, e.g. -gnateI2");
  
     --  Line for -gnatem switch
*************** begin
*** 212,233 ****
     --  Line for -gnatk switch
  
     Write_Switch_Char ("k");
!    Write_Line ("Limit file names to nnn characters (k = krunch)");
  
     --  Line for -gnatl switch
  
     Write_Switch_Char ("l");
     Write_Line ("Output full source listing with embedded error messages");
  
-    --  Line for -gnatL switch
- 
-    Write_Switch_Char ("L");
-    Write_Line ("Use longjmp/setjmp for exception handling");
- 
     --  Line for -gnatm switch
  
!    Write_Switch_Char ("mnnn");
!    Write_Line ("Limit number of detected errors to nnn (1-999999)");
  
     --  Line for -gnatn switch
  
--- 213,229 ----
     --  Line for -gnatk switch
  
     Write_Switch_Char ("k");
!    Write_Line ("Limit file names to nn characters (k = krunch)");
  
     --  Line for -gnatl switch
  
     Write_Switch_Char ("l");
     Write_Line ("Output full source listing with embedded error messages");
  
     --  Line for -gnatm switch
  
!    Write_Switch_Char ("mnn");
!    Write_Line ("Limit number of detected errors to nn (1-999999)");
  
     --  Line for -gnatn switch
  
*************** begin
*** 293,300 ****
  
     --  Line for -gnatT switch
  
!    Write_Switch_Char ("Tnnn");
!    Write_Line ("All compiler tables start at nnn times usual starting size");
  
     --  Line for -gnatu switch
  
--- 289,296 ----
  
     --  Line for -gnatT switch
  
!    Write_Switch_Char ("Tnn");
!    Write_Line ("All compiler tables start at nn times usual starting size");
  
     --  Line for -gnatu switch
  
*************** begin
*** 345,350 ****
--- 341,350 ----
     Write_Line ("Enable selected warning modes, xx = list of parameters:");
     Write_Line ("        a    turn on all optional warnings (except d,h,l)");
     Write_Line ("        A    turn off all optional warnings");
+    Write_Line ("        b    turn on warnings for bad fixed value " &
+                                                   "(not multiple of small)");
+    Write_Line ("        B*   turn off warnings for bad fixed value " &
+                                                   "(not multiple of small)");
     Write_Line ("        c    turn on warnings for constant conditional");
     Write_Line ("        C*   turn off warnings for constant conditional");
     Write_Line ("        d    turn on warnings for implicit dereference");
*************** begin
*** 385,391 ****
     Write_Line ("        v*   turn on warnings for unassigned variable");
     Write_Line ("        V    turn off warnings for unassigned variable");
     Write_Line ("        x*   turn on warnings for export/import");
!    Write_Line ("        X*   turn off warnings for export/import");
     Write_Line ("        z*   turn on size/align warnings for " &
                                                    "unchecked conversion");
     Write_Line ("        Z    turn off size/align warnings for " &
--- 385,393 ----
     Write_Line ("        v*   turn on warnings for unassigned variable");
     Write_Line ("        V    turn off warnings for unassigned variable");
     Write_Line ("        x*   turn on warnings for export/import");
!    Write_Line ("        X    turn off warnings for export/import");
!    Write_Line ("        y*   turn on warnings for Ada 2005 incompatibility");
!    Write_Line ("        Y    turn off warnings for Ada 2005 incompatibility");
     Write_Line ("        z*   turn on size/align warnings for " &
                                                    "unchecked conversion");
     Write_Line ("        Z    turn off size/align warnings for " &
*************** begin
*** 429,449 ****
     Write_Line ("        a    check attribute casing");
     Write_Line ("        b    check no blanks at end of lines");
     Write_Line ("        c    check comment format");
     Write_Line ("        e    check end/exit labels present");
     Write_Line ("        f    check no form feeds/vertical tabs in source");
     Write_Line ("        h    check no horizontal tabs in source");
     Write_Line ("        i    check if-then layout");
     Write_Line ("        k    check casing rules for keywords");
     Write_Line ("        l    check reference manual layout");
!    Write_Line ("        Lnnn check max nest level < nnn");
     Write_Line ("        m    check line length <= 79 characters");
     Write_Line ("        n    check casing of package Standard identifiers");
!    Write_Line ("        Mnnn check line length <= nnn characters");
     Write_Line ("        o    check subprogram bodies in alphabetical order");
     Write_Line ("        p    check pragma casing");
     Write_Line ("        r    check casing for identifier references");
     Write_Line ("        s    check separate subprogram specs present");
     Write_Line ("        t    check token separation rules");
     Write_Line ("        x    check extra parens around conditionals");
  
     --  Lines for -gnatyN switch
--- 431,453 ----
     Write_Line ("        a    check attribute casing");
     Write_Line ("        b    check no blanks at end of lines");
     Write_Line ("        c    check comment format");
+    Write_Line ("        d    check no DOS line terminators");
     Write_Line ("        e    check end/exit labels present");
     Write_Line ("        f    check no form feeds/vertical tabs in source");
     Write_Line ("        h    check no horizontal tabs in source");
     Write_Line ("        i    check if-then layout");
     Write_Line ("        k    check casing rules for keywords");
     Write_Line ("        l    check reference manual layout");
!    Write_Line ("        Lnn  check max nest level < nn ");
     Write_Line ("        m    check line length <= 79 characters");
     Write_Line ("        n    check casing of package Standard identifiers");
!    Write_Line ("        Mnn  check line length <= nn  characters");
     Write_Line ("        o    check subprogram bodies in alphabetical order");
     Write_Line ("        p    check pragma casing");
     Write_Line ("        r    check casing for identifier references");
     Write_Line ("        s    check separate subprogram specs present");
     Write_Line ("        t    check token separation rules");
+    Write_Line ("        u    check no unnecessary blank lines");
     Write_Line ("        x    check extra parens around conditionals");
  
     --  Lines for -gnatyN switch
*************** begin
*** 456,474 ****
     Write_Switch_Char ("z");
     Write_Line ("Distribution stub generation (r/c for receiver/caller stubs)");
  
-    --  Line for -gnatZ switch
- 
-    Write_Switch_Char ("Z");
-    Write_Line ("Use zero cost exception handling");
- 
     --  Line for -gnat83 switch
  
     Write_Switch_Char ("83");
     Write_Line ("Enforce Ada 83 restrictions");
  
     --  Line for -gnat05 switch
  
     Write_Switch_Char ("05");
!    Write_Line ("Allow Ada 2005 extensions");
  
  end Usage;
--- 460,488 ----
     Write_Switch_Char ("z");
     Write_Line ("Distribution stub generation (r/c for receiver/caller stubs)");
  
     --  Line for -gnat83 switch
  
     Write_Switch_Char ("83");
     Write_Line ("Enforce Ada 83 restrictions");
  
+    --  Line for -gnat95 switch
+ 
+    Write_Switch_Char ("95");
+ 
+    if Ada_Version_Default = Ada_95 then
+       Write_Line ("Ada 95 mode (default)");
+    else
+       Write_Line ("Enforce Ada 95 restrictions");
+    end if;
+ 
     --  Line for -gnat05 switch
  
     Write_Switch_Char ("05");
! 
!    if Ada_Version_Default = Ada_05 then
!       Write_Line ("Ada 2005 mode (default)");
!    else
!       Write_Line ("Allow Ada 2005 extensions");
!    end if;
  
  end Usage;
diff -Nrcpad gcc-4.0.2/gcc/ada/usage.ads gcc-4.1.0/gcc/ada/usage.ads
*** gcc-4.0.2/gcc/ada/usage.ads	Thu Apr 24 17:54:20 2003
--- gcc-4.1.0/gcc/ada/usage.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --        Copyright (C) 1992,1993,1994 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/utils.c gcc-4.1.0/gcc/ada/utils.c
*** gcc-4.0.2/gcc/ada/utils.c	Mon Apr  4 15:46:22 2005
--- gcc-4.1.0/gcc/ada/utils.c	Tue Nov 15 13:53:22 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
*************** tree gnat_std_decls[(int) ADT_LAST];
*** 74,79 ****
--- 74,84 ----
  /* Functions to call for each of the possible raise reasons.  */
  tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
  
+ /* List of functions called automatically at the beginning and
+    end of execution, on targets without .ctors/.dtors sections.  */
+ tree static_ctors;
+ tree static_dtors;
+ 
  /* Associates a GNAT tree node to a GCC tree node. It is used in
     `save_gnu_tree', `get_gnu_tree' and `present_gnu_tree'. See documentation
     of `save_gnu_tree' for more info.  */
*************** gnat_pushdecl (tree decl, Node_Id gnat_n
*** 319,325 ****
    if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
      DECL_CONTEXT (decl) = 0;
    else
!     DECL_CONTEXT (decl) = current_function_decl;
  
    TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
  
--- 324,336 ----
    if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
      DECL_CONTEXT (decl) = 0;
    else
!     {
!       DECL_CONTEXT (decl) = current_function_decl;
! 
!       /* Functions imported in another function are not really nested.  */
!       if (TREE_CODE (decl) == FUNCTION_DECL && TREE_PUBLIC (decl))
! 	DECL_NO_STATIC_CHAIN (decl) = 1;
!     }
  
    TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
  
*************** gnat_pushdecl (tree decl, Node_Id gnat_n
*** 359,366 ****
  	      && !DECL_ARTIFICIAL (decl))))
      TYPE_NAME (TREE_TYPE (decl)) = decl;
  
!   if (TREE_CODE (decl) != CONST_DECL)
!     rest_of_decl_compilation (decl, global_bindings_p (), 0);
  }
  
  /* Do little here.  Set up the standard declarations later after the
--- 370,377 ----
  	      && !DECL_ARTIFICIAL (decl))))
      TYPE_NAME (TREE_TYPE (decl)) = decl;
  
!   /*  if (TREE_CODE (decl) != CONST_DECL)
!       rest_of_decl_compilation (decl, global_bindings_p (), 0); */
  }
  
  /* Do little here.  Set up the standard declarations later after the
*************** finish_record_type (tree record_type, tr
*** 707,713 ****
        tree this_ada_size = DECL_SIZE (field);
  
        /* We need to make an XVE/XVU record if any field has variable size,
! 	 whether or not the record does.  For example, if we have an union,
  	 it may be that all fields, rounded up to the alignment, have the
  	 same size, in which case we'll use that size.  But the debug
  	 output routines (except Dwarf2) won't be able to output the fields,
--- 718,724 ----
        tree this_ada_size = DECL_SIZE (field);
  
        /* We need to make an XVE/XVU record if any field has variable size,
! 	 whether or not the record does.  For example, if we have a union,
  	 it may be that all fields, rounded up to the alignment, have the
  	 same size, in which case we'll use that size.  But the debug
  	 output routines (except Dwarf2) won't be able to output the fields,
*************** finish_record_type (tree record_type, tr
*** 806,961 ****
      }
  
    if (!defer_debug)
      {
!       /* If this record is of variable size, rename it so that the
! 	 debugger knows it is and make a new, parallel, record
! 	 that tells the debugger how the record is laid out.  See
! 	 exp_dbug.ads.  But don't do this for records that are padding
! 	 since they confuse GDB.  */
!       if (var_size
! 	  && !(TREE_CODE (record_type) == RECORD_TYPE
! 	       && TYPE_IS_PADDING_P (record_type)))
  	{
! 	  tree new_record_type
! 	    = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
! 			 ? UNION_TYPE : TREE_CODE (record_type));
! 	  tree orig_name = TYPE_NAME (record_type);
! 	  tree orig_id
! 	    = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
! 	       : orig_name);
! 	  tree new_id
! 	    = concat_id_with_name (orig_id,
! 				   TREE_CODE (record_type) == QUAL_UNION_TYPE
! 				   ? "XVU" : "XVE");
! 	  tree last_pos = bitsize_zero_node;
! 	  tree old_field;
! 	  tree prev_old_field = 0;
! 
! 	  TYPE_NAME (new_record_type) = new_id;
! 	  TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
! 	  TYPE_STUB_DECL (new_record_type)
! 	    = build_decl (TYPE_DECL, NULL_TREE, new_record_type);
! 	  DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
! 	  DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
! 	    = DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
! 	  TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
! 	  TYPE_SIZE_UNIT (new_record_type)
!   	    = size_int (TYPE_ALIGN (record_type) / BITS_PER_UNIT);
  
! 	  /* Now scan all the fields, replacing each field with a new
! 	     field corresponding to the new encoding.  */
! 	  for (old_field = TYPE_FIELDS (record_type); old_field;
! 	       old_field = TREE_CHAIN (old_field))
! 	    {
! 	      tree field_type = TREE_TYPE (old_field);
! 	      tree field_name = DECL_NAME (old_field);
! 	      tree new_field;
! 	      tree curpos = bit_position (old_field);
! 	      bool var = false;
! 	      unsigned int align = 0;
! 	      tree pos;
  
! 	      /* See how the position was modified from the last position.
  
! 		 There are two basic cases we support: a value was added
! 		 to the last position or the last position was rounded to
! 		 a boundary and they something was added.  Check for the
! 		 first case first.  If not, see if there is any evidence
! 		 of rounding.  If so, round the last position and try
! 		 again.
  
! 		 If this is a union, the position can be taken as zero. */
  
! 	      if (TREE_CODE (new_record_type) == UNION_TYPE)
! 		pos = bitsize_zero_node, align = 0;
! 	      else
! 		pos = compute_related_constant (curpos, last_pos);
  
! 	      if (!pos && TREE_CODE (curpos) == MULT_EXPR
! 		  && TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST)
! 		{
! 		  align = TREE_INT_CST_LOW (TREE_OPERAND (curpos, 1));
! 		  pos = compute_related_constant (curpos,
! 						  round_up (last_pos, align));
! 		}
! 	      else if (!pos && TREE_CODE (curpos) == PLUS_EXPR
! 		       && TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST
! 		       && TREE_CODE (TREE_OPERAND (curpos, 0)) == MULT_EXPR
! 		       && host_integerp (TREE_OPERAND
! 					 (TREE_OPERAND (curpos, 0), 1),
! 					 1))
! 		{
! 		  align
! 		    = tree_low_cst
! 		      (TREE_OPERAND (TREE_OPERAND (curpos, 0), 1), 1);
! 		  pos = compute_related_constant (curpos,
! 						  round_up (last_pos, align));
! 		}
!  	      else if (potential_alignment_gap (prev_old_field, old_field,
! 						pos))
!  		{
!  		  align = TYPE_ALIGN (field_type);
!  		  pos = compute_related_constant (curpos,
!  						  round_up (last_pos, align));
!  		}
  
! 	      /* If we can't compute a position, set it to zero.
  
! 		 ??? We really should abort here, but it's too much work
! 		 to get this correct for all cases.  */
  
! 	      if (!pos)
! 		pos = bitsize_zero_node;
  
! 	      /* See if this type is variable-size and make a new type
! 		 and indicate the indirection if so.  */
! 	      if (TREE_CODE (DECL_SIZE (old_field)) != INTEGER_CST)
! 		{
! 		  field_type = build_pointer_type (field_type);
! 		  var = true;
! 		}
  
! 	      /* Make a new field name, if necessary.  */
! 	      if (var || align != 0)
! 		{
! 		  char suffix[6];
  
! 		  if (align != 0)
! 		    sprintf (suffix, "XV%c%u", var ? 'L' : 'A',
! 			     align / BITS_PER_UNIT);
! 		  else
! 		    strcpy (suffix, "XVL");
  
! 		  field_name = concat_id_with_name (field_name, suffix);
! 		}
  
! 	      new_field = create_field_decl (field_name, field_type,
! 					     new_record_type, 0,
! 					     DECL_SIZE (old_field), pos, 0);
! 	      TREE_CHAIN (new_field) = TYPE_FIELDS (new_record_type);
! 	      TYPE_FIELDS (new_record_type) = new_field;
  
! 	      /* If old_field is a QUAL_UNION_TYPE, take its size as being
! 		 zero.  The only time it's not the last field of the record
! 		 is when there are other components at fixed positions after
! 		 it (meaning there was a rep clause for every field) and we
! 		 want to be able to encode them.  */
! 	      last_pos = size_binop (PLUS_EXPR, bit_position (old_field),
! 				     (TREE_CODE (TREE_TYPE (old_field))
! 				      == QUAL_UNION_TYPE)
! 				     ? bitsize_zero_node
! 				     : DECL_SIZE (old_field));
!  	      prev_old_field = old_field;
  	    }
  
! 	  TYPE_FIELDS (new_record_type)
! 	    = nreverse (TYPE_FIELDS (new_record_type));
  
! 	  rest_of_type_compilation (new_record_type, global_bindings_p ());
  	}
  
!       rest_of_type_compilation (record_type, global_bindings_p ());
      }
  }
  
  /* Utility function of above to merge LAST_SIZE, the previous size of a record
--- 817,997 ----
      }
  
    if (!defer_debug)
+     write_record_type_debug_info (record_type);
+ }
+ 
+ /* Output the debug information associated to a record type.  */
+ 
+ void
+ write_record_type_debug_info (tree record_type)
+ {
+   tree fieldlist = TYPE_FIELDS (record_type);
+   tree field;
+   bool var_size = false;
+ 
+   for (field = fieldlist; field; field = TREE_CHAIN (field))
      {
!       /* We need to make an XVE/XVU record if any field has variable size,
! 	 whether or not the record does.  For example, if we have a union,
! 	 it may be that all fields, rounded up to the alignment, have the
! 	 same size, in which case we'll use that size.  But the debug
! 	 output routines (except Dwarf2) won't be able to output the fields,
! 	 so we need to make the special record.  */
!       if (TREE_CODE (DECL_SIZE (field)) != INTEGER_CST)
  	{
! 	  var_size = true;
! 	  break;
! 	}
!     }
  
!   /* If this record is of variable size, rename it so that the
!      debugger knows it is and make a new, parallel, record
!      that tells the debugger how the record is laid out.  See
!      exp_dbug.ads.  But don't do this for records that are padding
!      since they confuse GDB.  */
!   if (var_size
!       && !(TREE_CODE (record_type) == RECORD_TYPE
! 	   && TYPE_IS_PADDING_P (record_type)))
!     {
!       tree new_record_type
! 	= make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
! 		     ? UNION_TYPE : TREE_CODE (record_type));
!       tree orig_name = TYPE_NAME (record_type);
!       tree orig_id
! 	= (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
! 	   : orig_name);
!       tree new_id
! 	= concat_id_with_name (orig_id,
! 			       TREE_CODE (record_type) == QUAL_UNION_TYPE
! 			       ? "XVU" : "XVE");
!       tree last_pos = bitsize_zero_node;
!       tree old_field;
!       tree prev_old_field = 0;
  
!       TYPE_NAME (new_record_type) = new_id;
!       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
!       TYPE_STUB_DECL (new_record_type)
! 	= build_decl (TYPE_DECL, NULL_TREE, new_record_type);
!       DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
!       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
! 	= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
!       TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
!       TYPE_SIZE_UNIT (new_record_type)
! 	= size_int (TYPE_ALIGN (record_type) / BITS_PER_UNIT);
  
!       /* Now scan all the fields, replacing each field with a new
! 	 field corresponding to the new encoding.  */
!       for (old_field = TYPE_FIELDS (record_type); old_field;
! 	   old_field = TREE_CHAIN (old_field))
! 	{
! 	  tree field_type = TREE_TYPE (old_field);
! 	  tree field_name = DECL_NAME (old_field);
! 	  tree new_field;
! 	  tree curpos = bit_position (old_field);
! 	  bool var = false;
! 	  unsigned int align = 0;
! 	  tree pos;
  
! 	  /* See how the position was modified from the last position.
  
! 	  There are two basic cases we support: a value was added
! 	  to the last position or the last position was rounded to
! 	  a boundary and they something was added.  Check for the
! 	  first case first.  If not, see if there is any evidence
! 	  of rounding.  If so, round the last position and try
! 	  again.
  
! 	  If this is a union, the position can be taken as zero. */
  
! 	  if (TREE_CODE (new_record_type) == UNION_TYPE)
! 	    pos = bitsize_zero_node, align = 0;
! 	  else
! 	    pos = compute_related_constant (curpos, last_pos);
  
! 	  if (!pos && TREE_CODE (curpos) == MULT_EXPR
! 	      && TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST)
! 	    {
! 	      align = TREE_INT_CST_LOW (TREE_OPERAND (curpos, 1));
! 	      pos = compute_related_constant (curpos,
! 					      round_up (last_pos, align));
! 	    }
! 	  else if (!pos && TREE_CODE (curpos) == PLUS_EXPR
! 		   && TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST
! 		   && TREE_CODE (TREE_OPERAND (curpos, 0)) == MULT_EXPR
! 		   && host_integerp (TREE_OPERAND
! 				     (TREE_OPERAND (curpos, 0), 1),
! 				     1))
! 	    {
! 	      align
! 		= tree_low_cst
! 		(TREE_OPERAND (TREE_OPERAND (curpos, 0), 1), 1);
! 	      pos = compute_related_constant (curpos,
! 					      round_up (last_pos, align));
! 	    }
! 	  else if (potential_alignment_gap (prev_old_field, old_field,
! 					    pos))
! 	    {
! 	      align = TYPE_ALIGN (field_type);
! 	      pos = compute_related_constant (curpos,
! 					      round_up (last_pos, align));
! 	    }
  
! 	  /* If we can't compute a position, set it to zero.
  
! 	  ??? We really should abort here, but it's too much work
! 	  to get this correct for all cases.  */
  
! 	  if (!pos)
! 	    pos = bitsize_zero_node;
  
! 	  /* See if this type is variable-size and make a new type
! 	     and indicate the indirection if so.  */
! 	  if (TREE_CODE (DECL_SIZE (old_field)) != INTEGER_CST)
! 	    {
! 	      field_type = build_pointer_type (field_type);
! 	      var = true;
! 	    }
  
! 	  /* Make a new field name, if necessary.  */
! 	  if (var || align != 0)
! 	    {
! 	      char suffix[6];
  
! 	      if (align != 0)
! 		sprintf (suffix, "XV%c%u", var ? 'L' : 'A',
! 			 align / BITS_PER_UNIT);
! 	      else
! 		strcpy (suffix, "XVL");
  
! 	      field_name = concat_id_with_name (field_name, suffix);
  	    }
  
! 	  new_field = create_field_decl (field_name, field_type,
! 					 new_record_type, 0,
! 					 DECL_SIZE (old_field), pos, 0);
! 	  TREE_CHAIN (new_field) = TYPE_FIELDS (new_record_type);
! 	  TYPE_FIELDS (new_record_type) = new_field;
  
! 	  /* If old_field is a QUAL_UNION_TYPE, take its size as being
! 	     zero.  The only time it's not the last field of the record
! 	     is when there are other components at fixed positions after
! 	     it (meaning there was a rep clause for every field) and we
! 	     want to be able to encode them.  */
! 	  last_pos = size_binop (PLUS_EXPR, bit_position (old_field),
! 				 (TREE_CODE (TREE_TYPE (old_field))
! 				  == QUAL_UNION_TYPE)
! 				 ? bitsize_zero_node
! 				 : DECL_SIZE (old_field));
! 	  prev_old_field = old_field;
  	}
  
!       TYPE_FIELDS (new_record_type)
! 	= nreverse (TYPE_FIELDS (new_record_type));
! 
!       rest_of_type_compilation (new_record_type, global_bindings_p ());
      }
+ 
+   rest_of_type_compilation (record_type, global_bindings_p ());
  }
  
  /* Utility function of above to merge LAST_SIZE, the previous size of a record
*************** create_var_decl (tree var_name, tree asm
*** 1247,1258 ****
        || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
      var_init = NULL_TREE;
  
    /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
       try to fiddle with DECL_COMMON.  However, on platforms that don't
       support global BSS sections, uninitialized global variables would
       go in DATA instead, thus increasing the size of the executable.  */
  #if !defined(ASM_OUTPUT_BSS) && !defined(ASM_OUTPUT_ALIGNED_BSS)
!   DECL_COMMON   (var_decl) = !flag_no_common;
  #endif
    DECL_INITIAL  (var_decl) = var_init;
    TREE_READONLY (var_decl) = const_flag;
--- 1283,1301 ----
        || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
      var_init = NULL_TREE;
  
+   /* At the global level, an initializer requiring code to be generated
+      produces elaboration statements.  Check that such statements are allowed,
+      that is, not violating a No_Elaboration_Code restriction.  */
+   if (global_bindings_p () && var_init != 0 && ! init_const)
+     Check_Elaboration_Code_Allowed (gnat_node);
+ 
    /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
       try to fiddle with DECL_COMMON.  However, on platforms that don't
       support global BSS sections, uninitialized global variables would
       go in DATA instead, thus increasing the size of the executable.  */
  #if !defined(ASM_OUTPUT_BSS) && !defined(ASM_OUTPUT_ALIGNED_BSS)
!   if (TREE_CODE (var_decl) == VAR_DECL)
!     DECL_COMMON   (var_decl) = !flag_no_common;
  #endif
    DECL_INITIAL  (var_decl) = var_init;
    TREE_READONLY (var_decl) = const_flag;
*************** create_var_decl (tree var_name, tree asm
*** 1269,1275 ****
    TREE_STATIC (var_decl)
      = public_flag || (global_bindings_p () ? !extern_flag : static_flag);
  
!   if (asm_name)
      SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
  
    process_attributes (var_decl, attr_list);
--- 1312,1318 ----
    TREE_STATIC (var_decl)
      = public_flag || (global_bindings_p () ? !extern_flag : static_flag);
  
!   if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
      SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
  
    process_attributes (var_decl, attr_list);
*************** create_var_decl (tree var_name, tree asm
*** 1282,1287 ****
--- 1325,1334 ----
  
    if (TREE_CODE (var_decl) != CONST_DECL)
      rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
+   else
+     /* expand CONST_DECLs to set their MODE, ALIGN, SIZE and SIZE_UNIT,
+        which we need for later back-annotations.  */
+     expand_decl (var_decl);
  
    return var_decl;
  }
*************** create_param_decl (tree param_name, tree
*** 1464,1470 ****
      }
  
    DECL_ARG_TYPE (param_decl) = param_type;
-   DECL_ARG_TYPE_AS_WRITTEN (param_decl) = param_type;
    TREE_READONLY (param_decl) = readonly;
    return param_decl;
  }
--- 1511,1516 ----
*************** process_attributes (tree decl, struct at
*** 1484,1491 ****
  	break;
  
        case ATTR_LINK_ALIAS:
! 	TREE_STATIC (decl) = 1;
! 	assemble_alias (decl, attr_list->name);
  	break;
  
        case ATTR_WEAK_EXTERNAL:
--- 1530,1540 ----
  	break;
  
        case ATTR_LINK_ALIAS:
!         if (! DECL_EXTERNAL (decl))
! 	  {
! 	    TREE_STATIC (decl) = 1;
! 	    assemble_alias (decl, attr_list->name);
! 	  }
  	break;
  
        case ATTR_WEAK_EXTERNAL:
*************** process_attributes (tree decl, struct at
*** 1508,1513 ****
--- 1557,1572 ----
  	  post_error ("?section attributes are not supported for this target",
  		      attr_list->error_point);
  	break;
+ 
+       case ATTR_LINK_CONSTRUCTOR:
+ 	DECL_STATIC_CONSTRUCTOR (decl) = 1;
+ 	TREE_USED (decl) = 1;
+ 	break;
+ 
+       case ATTR_LINK_DESTRUCTOR:
+ 	DECL_STATIC_DESTRUCTOR (decl) = 1;
+ 	TREE_USED (decl) = 1;
+ 	break;
        }
  }
  
*************** value_factor_p (tree value, HOST_WIDE_IN
*** 1529,1535 ****
  
  /* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true
     unless we can prove these 2 fields are laid out in such a way that no gap
!    exist between the end of PREV_FIELD and the begining of CURR_FIELD.  OFFSET
     is the distance in bits between the end of PREV_FIELD and the starting
     position of CURR_FIELD. It is ignored if null. */
  
--- 1588,1594 ----
  
  /* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true
     unless we can prove these 2 fields are laid out in such a way that no gap
!    exist between the end of PREV_FIELD and the beginning of CURR_FIELD.  OFFSET
     is the distance in bits between the end of PREV_FIELD and the starting
     position of CURR_FIELD. It is ignored if null. */
  
*************** potential_alignment_gap (tree prev_field
*** 1548,1554 ****
    if (TREE_CODE (TREE_TYPE (prev_field)) == QUAL_UNION_TYPE)
      return false;
  
!   /* If the distance between the end of prev_field and the begining of
       curr_field is constant, then there is a gap if the value of this
       constant is not null. */
    if (offset && host_integerp (offset, 1))
--- 1607,1613 ----
    if (TREE_CODE (TREE_TYPE (prev_field)) == QUAL_UNION_TYPE)
      return false;
  
!   /* If the distance between the end of prev_field and the beginning of
       curr_field is constant, then there is a gap if the value of this
       constant is not null. */
    if (offset && host_integerp (offset, 1))
*************** potential_alignment_gap (tree prev_field
*** 1564,1570 ****
  	    % DECL_ALIGN (curr_field) != 0);
  
    /* If both the position and size of the previous field are multiples
!      of the current field alignment, there can not be any gap. */
    if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field))
        && value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field)))
      return false;
--- 1623,1629 ----
  	    % DECL_ALIGN (curr_field) != 0);
  
    /* If both the position and size of the previous field are multiples
!      of the current field alignment, there cannot be any gap. */
    if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field))
        && value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field)))
      return false;
*************** end_subprog_body (tree body)
*** 1703,1708 ****
--- 1762,1775 ----
    if (type_annotate_only)
      return;
  
+   /* If we don't have .ctors/.dtors sections, and this is a static
+      constructor or destructor, it must be recorded now.  */
+   if (DECL_STATIC_CONSTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
+     static_ctors = tree_cons (NULL_TREE, fndecl, static_ctors);
+ 
+   if (DECL_STATIC_DESTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
+     static_dtors = tree_cons (NULL_TREE, fndecl, static_dtors);
+ 
    /* We do different things for nested and non-nested functions.
       ??? This should be in cgraph.  */
    if (!DECL_CONTEXT (fndecl))
*************** build_unc_object_type (tree template_typ
*** 2393,2398 ****
--- 2460,2481 ----
  
    return type;
  }
+ 
+ /* Same, taking a thin or fat pointer type instead of a template type. */
+ 
+ tree
+ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, tree name)
+ {
+   tree template_type;
+ 
+   gcc_assert (TYPE_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
+ 
+   template_type
+     = (TYPE_FAT_POINTER_P (thin_fat_ptr_type)
+        ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
+        : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
+   return build_unc_object_type (template_type, object_type, name);
+ }
  
  /* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE.  In
     the normal case this is just two adjustments, but we have more to do
*************** update_pointer_to (tree old_type, tree n
*** 2453,2480 ****
        for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
  	for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
  	     ptr1 = TYPE_NEXT_VARIANT (ptr1))
! 	  {
! 	    TREE_TYPE (ptr1) = new_type;
! 
! 	    if (TYPE_NAME (ptr1)
! 		&& TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL
! 		&& TREE_CODE (new_type) != ENUMERAL_TYPE)
! 	      rest_of_decl_compilation (TYPE_NAME (ptr1),
! 					global_bindings_p (), 0);
! 	  }
  
!       for (; ref; ref = TYPE_NEXT_PTR_TO (ref))
  	for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
  	     ref1 = TYPE_NEXT_VARIANT (ref1))
! 	  {
! 	    TREE_TYPE (ref1) = new_type;
! 
! 	    if (TYPE_NAME (ref1)
! 		&& TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL
! 		&& TREE_CODE (new_type) != ENUMERAL_TYPE)
! 	      rest_of_decl_compilation (TYPE_NAME (ref1),
! 					global_bindings_p (), 0);
! 	  }
      }
  
    /* Now deal with the unconstrained array case. In this case the "pointer"
--- 2536,2547 ----
        for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
  	for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
  	     ptr1 = TYPE_NEXT_VARIANT (ptr1))
! 	  TREE_TYPE (ptr1) = new_type;
  
!       for (; ref; ref = TYPE_NEXT_REF_TO (ref))
  	for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
  	     ref1 = TYPE_NEXT_VARIANT (ref1))
! 	  TREE_TYPE (ref1) = new_type;
      }
  
    /* Now deal with the unconstrained array case. In this case the "pointer"
*************** convert (tree type, tree expr)
*** 2668,2676 ****
        /* If we have just converted to this padded type, just get
  	 the inner expression.  */
        if (TREE_CODE (expr) == CONSTRUCTOR
! 	  && CONSTRUCTOR_ELTS (expr)
! 	  && TREE_PURPOSE (CONSTRUCTOR_ELTS (expr)) == TYPE_FIELDS (etype))
! 	return TREE_VALUE (CONSTRUCTOR_ELTS (expr));
        else
  	return convert (type,
  			build_component_ref (expr, NULL_TREE,
--- 2735,2744 ----
        /* If we have just converted to this padded type, just get
  	 the inner expression.  */
        if (TREE_CODE (expr) == CONSTRUCTOR
! 	  && !VEC_empty (constructor_elt, CONSTRUCTOR_ELTS (expr))
! 	  && VEC_index (constructor_elt, CONSTRUCTOR_ELTS (expr), 0)->index
! 	     == TYPE_FIELDS (etype))
! 	return VEC_index (constructor_elt, CONSTRUCTOR_ELTS (expr), 0)->value;
        else
  	return convert (type,
  			build_component_ref (expr, NULL_TREE,
*************** convert (tree type, tree expr)
*** 2696,2702 ****
  
        /* If the result type is a padded type with a self-referentially-sized
  	 field and the expression type is a record, do this as an
! 	 unchecked converstion.  */
        else if (TREE_CODE (etype) == RECORD_TYPE
  	       && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
  	return unchecked_convert (type, expr, false);
--- 2764,2770 ----
  
        /* If the result type is a padded type with a self-referentially-sized
  	 field and the expression type is a record, do this as an
! 	 unchecked conversion.  */
        else if (TREE_CODE (etype) == RECORD_TYPE
  	       && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
  	return unchecked_convert (type, expr, false);
*************** convert (tree type, tree expr)
*** 2719,2729 ****
  						      expr)),
  					TYPE_MIN_VALUE (etype))));
  
!   /* If the input is a justified modular type, we need to extract
!      the actual object before converting it to any other type with the
!      exception of an unconstrained array.  */
    if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
!       && code != UNCONSTRAINED_ARRAY_TYPE)
      return convert (type, build_component_ref (expr, NULL_TREE,
  					       TYPE_FIELDS (etype), false));
  
--- 2787,2801 ----
  						      expr)),
  					TYPE_MIN_VALUE (etype))));
  
!   /* If the input is a justified modular type, we need to extract the actual
!      object before converting it to any other type with the exceptions of an
!      unconstrained array or of a mere type variant.  It is useful to avoid the
!      extraction and conversion in the type variant case because it could end
!      up replacing a VAR_DECL expr by a constructor and we might be about the
!      take the address of the result.  */
    if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
!       && code != UNCONSTRAINED_ARRAY_TYPE
!       && TYPE_MAIN_VARIANT (type) != TYPE_MAIN_VARIANT (etype))
      return convert (type, build_component_ref (expr, NULL_TREE,
  					       TYPE_FIELDS (etype), false));
  
*************** convert (tree type, tree expr)
*** 2768,2776 ****
  	 just make a new one in the proper type.  */
        if (code == ecode && AGGREGATE_TYPE_P (etype)
  	  && !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
! 	       && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
! 	  && (TREE_CODE (expr) == STRING_CST
! 	      || get_alias_set (etype) == get_alias_set (type)))
  	{
  	  expr = copy_node (expr);
  	  TREE_TYPE (expr) = type;
--- 2840,2846 ----
  	 just make a new one in the proper type.  */
        if (code == ecode && AGGREGATE_TYPE_P (etype)
  	  && !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
! 	       && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST))
  	{
  	  expr = copy_node (expr);
  	  TREE_TYPE (expr) = type;
*************** convert (tree type, tree expr)
*** 2790,2798 ****
        break;
  
      case VIEW_CONVERT_EXPR:
!       if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)
! 	  && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
! 	return convert (type, TREE_OPERAND (expr, 0));
        break;
  
      case INDIRECT_REF:
--- 2860,2899 ----
        break;
  
      case VIEW_CONVERT_EXPR:
!       {
! 	/* GCC 4.x is very sensitive to type consistency overall, and view
! 	   conversions thus are very frequent.  Eventhough just "convert"ing
! 	   the inner operand to the output type is fine in most cases, it
! 	   might expose unexpected input/output type mismatches in special
! 	   circumstances so we avoid such recursive calls when we can.  */
! 
! 	tree op0 = TREE_OPERAND (expr, 0);
! 
! 	/* If we are converting back to the original type, we can just
! 	   lift the input conversion.  This is a common occurence with
! 	   switches back-and-forth amongst type variants.  */
! 	if (type == TREE_TYPE (op0))
! 	  return op0;
! 
! 	/* Otherwise, if we're converting between two aggregate types, we
! 	   might be allowed to substitute the VIEW_CONVERT target type in
! 	   place or to just convert the inner expression.  */
! 	if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
! 	  {
! 	    /* If we are converting between type variants, we can just
! 	       substitute the VIEW_CONVERT in place.  */
! 	    if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
! 	      return build1 (VIEW_CONVERT_EXPR, type, op0);
! 
! 	    /* Otherwise, we may just bypass the input view conversion unless
! 	       one of the types is a fat pointer, or we're converting to an
! 	       unchecked union type.  Both are handled by specialized code
! 	       below and the latter relies on exact type matching.  */
! 	    else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)
! 		     && !(code == UNION_TYPE && TYPE_UNCHECKED_UNION_P (type)))
! 	      return convert (type, op0);
! 	  }
!       }
        break;
  
      case INDIRECT_REF:
*************** convert (tree type, tree expr)
*** 2921,2933 ****
  	    {
  	      if (TREE_TYPE (tem) == etype)
  		return build1 (CONVERT_EXPR, type, expr);
! 
! 	      /* Accept slight type variations.  */
! 	      if (TREE_TYPE (tem) == TYPE_MAIN_VARIANT (etype)
! 		  || (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
! 		      && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
! 			  || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
! 		      && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype))
  		return build1 (CONVERT_EXPR, type,
  			       convert (TREE_TYPE (tem), expr));
  	    }
--- 3022,3031 ----
  	    {
  	      if (TREE_TYPE (tem) == etype)
  		return build1 (CONVERT_EXPR, type, expr);
! 	      else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
! 		       && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
! 			   || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
! 		       && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
  		return build1 (CONVERT_EXPR, type,
  			       convert (TREE_TYPE (tem), expr));
  	    }
*************** remove_conversions (tree exp, bool true_
*** 2990,2996 ****
        if (true_address
  	  && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
  	  && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
! 	return remove_conversions (TREE_VALUE (CONSTRUCTOR_ELTS (exp)), true);
        break;
  
      case COMPONENT_REF:
--- 3088,3096 ----
        if (true_address
  	  && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
  	  && TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
! 	return remove_conversions (VEC_index (constructor_elt,
! 					      CONSTRUCTOR_ELTS (exp), 0)->value,
! 				   true);
        break;
  
      case COMPONENT_REF:
*************** maybe_unconstrained_array (tree exp)
*** 3066,3072 ****
    return exp;
  }
  
! /* Return an expression that does an unchecked converstion of EXPR to TYPE.
     If NOTRUNC_P is true, truncation operations should be suppressed.  */
  
  tree
--- 3166,3172 ----
    return exp;
  }
  
! /* Return an expression that does an unchecked conversion of EXPR to TYPE.
     If NOTRUNC_P is true, truncation operations should be suppressed.  */
  
  tree
diff -Nrcpad gcc-4.0.2/gcc/ada/utils2.c gcc-4.1.0/gcc/ada/utils2.c
*** gcc-4.0.2/gcc/ada/utils2.c	Thu Mar 17 15:35:04 2005
--- gcc-4.1.0/gcc/ada/utils2.c	Tue Nov 15 13:53:22 2005
***************
*** 16,23 ****
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
!  * MA 02111-1307, USA.                                                      *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
--- 16,23 ----
   * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
   * for  more details.  You should have  received  a copy of the GNU General *
   * Public License  distributed with GNAT;  see file COPYING.  If not, write *
!  * to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, *
!  * Boston, MA 02110-1301, USA.                                              *
   *                                                                          *
   * GNAT was originally developed  by the GNAT team at  New York University. *
   * Extensive contributions were provided by Ada Core Technologies Inc.      *
*************** known_alignment (tree exp)
*** 170,182 ****
      case NON_LVALUE_EXPR:
        /* Conversions between pointers and integers don't change the alignment
  	 of the underlying object.  */
!       this_alignment = known_alignment (TREE_OPERAND (exp, 0));	
        break;
  
      case PLUS_EXPR:
      case MINUS_EXPR:
        /* If two address are added, the alignment of the result is the
! 	 minimum of the two aligments.  */
        lhs = known_alignment (TREE_OPERAND (exp, 0));
        rhs = known_alignment (TREE_OPERAND (exp, 1));
        this_alignment = MIN (lhs, rhs);
--- 170,182 ----
      case NON_LVALUE_EXPR:
        /* Conversions between pointers and integers don't change the alignment
  	 of the underlying object.  */
!       this_alignment = known_alignment (TREE_OPERAND (exp, 0));
        break;
  
      case PLUS_EXPR:
      case MINUS_EXPR:
        /* If two address are added, the alignment of the result is the
! 	 minimum of the two alignments.  */
        lhs = known_alignment (TREE_OPERAND (exp, 0));
        rhs = known_alignment (TREE_OPERAND (exp, 1));
        this_alignment = MIN (lhs, rhs);
*************** contains_save_expr_p (tree exp)
*** 263,275 ****
        return contains_save_expr_p (TREE_OPERAND (exp, 0));
  
      case CONSTRUCTOR:
!       return (CONSTRUCTOR_ELTS (exp)
! 	      && contains_save_expr_p (CONSTRUCTOR_ELTS (exp)));
  
!     case TREE_LIST:
!       return (contains_save_expr_p (TREE_VALUE (exp))
! 	      || (TREE_CHAIN (exp)
! 		  && contains_save_expr_p (TREE_CHAIN (exp))));
  
      default:
        return false;
--- 263,277 ----
        return contains_save_expr_p (TREE_OPERAND (exp, 0));
  
      case CONSTRUCTOR:
!       {
! 	tree value;
! 	unsigned HOST_WIDE_INT ix;
  
! 	FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (exp), ix, value)
! 	  if (contains_save_expr_p (value))
! 	    return true;
! 	return false;
!       }
  
      default:
        return false;
*************** nonbinary_modular_operation (enum tree_c
*** 504,510 ****
      rhs = fold (build2 (MINUS_EXPR, type, modulus, rhs)), op_code = MINUS_EXPR;
  
    /* For the logical operations, we only need PRECISION bits.  For
!      addition and subraction, we need one more and for multiplication we
       need twice as many.  But we never want to make a size smaller than
       our size. */
    if (op_code == PLUS_EXPR || op_code == MINUS_EXPR)
--- 506,512 ----
      rhs = fold (build2 (MINUS_EXPR, type, modulus, rhs)), op_code = MINUS_EXPR;
  
    /* For the logical operations, we only need PRECISION bits.  For
!      addition and subtraction, we need one more and for multiplication we
       need twice as many.  But we never want to make a size smaller than
       our size. */
    if (op_code == PLUS_EXPR || op_code == MINUS_EXPR)
*************** build_binary_op (enum tree_code op_code,
*** 654,693 ****
        if (!operation_type)
  	operation_type = left_type;
  
-       /* If the RHS has a conversion between record and array types and
- 	 an inner type is no worse, use it.  Note we cannot do this for
- 	 modular types or types with TYPE_ALIGN_OK, since the latter
- 	 might indicate a conversion between a root type and a class-wide
- 	 type, which we must not remove.  */
-       while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR
- 	     && (((TREE_CODE (right_type) == RECORD_TYPE
- 		   || TREE_CODE (right_type) == UNION_TYPE)
- 		  && !TYPE_JUSTIFIED_MODULAR_P (right_type)
- 		  && !TYPE_ALIGN_OK (right_type)
- 		  && !TYPE_IS_FAT_POINTER_P (right_type))
- 		 || TREE_CODE (right_type) == ARRAY_TYPE)
- 	     && ((((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
- 		    == RECORD_TYPE)
- 		   || (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
- 		       == UNION_TYPE))
- 		  && !(TYPE_JUSTIFIED_MODULAR_P
- 		       (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
- 		  && !(TYPE_ALIGN_OK
- 		       (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
- 		  && !(TYPE_IS_FAT_POINTER_P
- 		       (TREE_TYPE (TREE_OPERAND (right_operand, 0)))))
- 		 || (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
- 		     == ARRAY_TYPE))
- 	     && (0 == (best_type
- 		       = find_common_type (right_type,
- 					   TREE_TYPE (TREE_OPERAND
- 					   (right_operand, 0))))
- 		 || right_type != best_type))
- 	{
- 	  right_operand = TREE_OPERAND (right_operand, 0);
- 	  right_type = TREE_TYPE (right_operand);
- 	}
- 
        /* If we are copying one array or record to another, find the best type
  	 to use.  */
        if (((TREE_CODE (left_type) == ARRAY_TYPE
--- 656,661 ----
*************** build_binary_op (enum tree_code op_code,
*** 884,891 ****
  	 just compare the data pointer.  */
        else if (TYPE_FAT_POINTER_P (left_base_type)
  	       && TREE_CODE (right_operand) == CONSTRUCTOR
! 	       && integer_zerop (TREE_VALUE
! 				 (CONSTRUCTOR_ELTS (right_operand))))
  	{
  	  right_operand = build_component_ref (left_operand, NULL_TREE,
  					       TYPE_FIELDS (left_base_type),
--- 852,860 ----
  	 just compare the data pointer.  */
        else if (TYPE_FAT_POINTER_P (left_base_type)
  	       && TREE_CODE (right_operand) == CONSTRUCTOR
! 	       && integer_zerop (VEC_index (constructor_elt,
! 					    CONSTRUCTOR_ELTS (right_operand),
! 					    0)->value))
  	{
  	  right_operand = build_component_ref (left_operand, NULL_TREE,
  					       TYPE_FIELDS (left_base_type),
*************** build_unary_op (enum tree_code op_code, 
*** 1138,1146 ****
  	     a pointer to our type.  */
  	  if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
  	    {
  	      result
! 		= build_unary_op (ADDR_EXPR, NULL_TREE,
! 				  TREE_VALUE (CONSTRUCTOR_ELTS (operand)));
  	      result = convert (build_pointer_type (TREE_TYPE (operand)),
  				result);
  	      break;
--- 1107,1117 ----
  	     a pointer to our type.  */
  	  if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
  	    {
+ 	      result = VEC_index (constructor_elt,
+ 				  CONSTRUCTOR_ELTS (operand),
+ 				  0)->value;
  	      result
! 		= build_unary_op (ADDR_EXPR, NULL_TREE, result);
  	      result = convert (build_pointer_type (TREE_TYPE (operand)),
  				result);
  	      break;
*************** build_unary_op (enum tree_code op_code, 
*** 1154,1165 ****
  	    return build_unary_op (ADDR_EXPR, result_type,
  				   TREE_OPERAND (operand, 0));
  
! 	  /* If this NOP_EXPR doesn't change the mode, get the result type
! 	     from this type and go down.  We need to do this in case
! 	     this is a conversion of a CONST_DECL.  */
! 	  if (TYPE_MODE (type) != BLKmode
! 	      && (TYPE_MODE (type)
! 		  == TYPE_MODE (TREE_TYPE (TREE_OPERAND (operand, 0)))))
  	    return build_unary_op (ADDR_EXPR,
  				   (result_type ? result_type
  				    : build_pointer_type (type)),
--- 1125,1142 ----
  	    return build_unary_op (ADDR_EXPR, result_type,
  				   TREE_OPERAND (operand, 0));
  
! 	  /* ... fallthru ... */
! 
! 	case VIEW_CONVERT_EXPR:
! 	  /* If this just a variant conversion or if the conversion doesn't
! 	     change the mode, get the result type from this type and go down.
! 	     This is needed for conversions of CONST_DECLs, to eventually get
! 	     to the address of their CORRESPONDING_VARs.  */
! 	  if ((TYPE_MAIN_VARIANT (type)
! 	       == TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (operand, 0))))
! 	      || (TYPE_MODE (type) != BLKmode
! 		  && (TYPE_MODE (type)
! 		      == TYPE_MODE (TREE_TYPE (TREE_OPERAND (operand, 0))))))
  	    return build_unary_op (ADDR_EXPR,
  				   (result_type ? result_type
  				    : build_pointer_type (type)),
*************** build_cond_expr (tree result_type, tree 
*** 1373,1380 ****
  
    return result;
  }
- 
  
  /* Build a CALL_EXPR to call FUNDECL with one argument, ARG.  Return
     the CALL_EXPR.  */
  
--- 1350,1399 ----
  
    return result;
  }
  
+ /* Similar, but for RETURN_EXPR.  If RESULT_DECL is non-zero, build
+    a RETURN_EXPR around the assignment of RET_VAL to RESULT_DECL.
+    If RESULT_DECL is zero, build a bare RETURN_EXPR.  */
+ 
+ tree
+ build_return_expr (tree result_decl, tree ret_val)
+ {
+   tree result_expr;
+ 
+   if (result_decl)
+     {
+       /* The gimplifier explicitly enforces the following invariant:
+ 
+            RETURN_EXPR
+                |
+            MODIFY_EXPR
+            /        \
+           /          \
+       RESULT_DECL    ...
+ 
+       As a consequence, type-homogeneity dictates that we use the type
+       of the RESULT_DECL as the operation type.  */
+ 
+       tree operation_type = TREE_TYPE (result_decl);
+ 
+       /* Convert the right operand to the operation type.  Note that
+          it's the same transformation as in the MODIFY_EXPR case of
+          build_binary_op with the additional guarantee that the type
+          cannot involve a placeholder, since otherwise the function
+          would use the "target pointer" return mechanism.  */
+ 
+       if (operation_type != TREE_TYPE (ret_val))
+ 	ret_val = convert (operation_type, ret_val);
+ 
+       result_expr
+ 	= build2 (MODIFY_EXPR, operation_type, result_decl, ret_val);
+     }
+   else
+     result_expr = NULL_TREE;
+ 
+   return build1 (RETURN_EXPR, void_type_node, result_expr);
+ }
+ 
  /* Build a CALL_EXPR to call FUNDECL with one argument, ARG.  Return
     the CALL_EXPR.  */
  
*************** tree
*** 1430,1436 ****
  build_call_raise (int msg)
  {
    tree fndecl = gnat_raise_decls[msg];
!   const char *str = Debug_Flag_NN ? "" : ref_filename;
    int len = strlen (str) + 1;
    tree filename = build_string (len, str);
  
--- 1449,1456 ----
  build_call_raise (int msg)
  {
    tree fndecl = gnat_raise_decls[msg];
!   const char *str
!     = (Debug_Flag_NN || Exception_Locations_Suppressed) ? "" : ref_filename;
    int len = strlen (str) + 1;
    tree filename = build_string (len, str);
  
*************** build_call_raise (int msg)
*** 1445,1461 ****
  		       build_int_cst (NULL_TREE, input_line));
  }
  
  /* Return a CONSTRUCTOR of TYPE whose list is LIST.  */
  
  tree
  gnat_build_constructor (tree type, tree list)
  {
    tree elmt;
    bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
    bool side_effects = false;
    tree result;
  
!   for (elmt = list; elmt; elmt = TREE_CHAIN (elmt))
      {
        if (!TREE_CONSTANT (TREE_VALUE (elmt))
  	  || (TREE_CODE (type) == RECORD_TYPE
--- 1465,1505 ----
  		       build_int_cst (NULL_TREE, input_line));
  }
  
+ /* qsort comparer for the bit positions of two constructor elements
+    for record components.  */
+ 
+ static int
+ compare_elmt_bitpos (const PTR rt1, const PTR rt2)
+ {
+   tree elmt1 = * (tree *) rt1;
+   tree elmt2 = * (tree *) rt2;
+ 
+   tree pos_field1 = bit_position (TREE_PURPOSE (elmt1));
+   tree pos_field2 = bit_position (TREE_PURPOSE (elmt2));
+ 
+   if (tree_int_cst_equal (pos_field1, pos_field2))
+     return 0;
+   else if (tree_int_cst_lt (pos_field1, pos_field2))
+     return -1;
+   else
+     return 1;
+ }
+ 
  /* Return a CONSTRUCTOR of TYPE whose list is LIST.  */
  
  tree
  gnat_build_constructor (tree type, tree list)
  {
    tree elmt;
+   int n_elmts;
    bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
    bool side_effects = false;
    tree result;
  
!   /* Scan the elements to see if they are all constant or if any has side
!      effects, to let us set global flags on the resulting constructor.  Count
!      the elements along the way for possible sorting purposes below.  */
!   for (n_elmts = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), n_elmts ++)
      {
        if (!TREE_CONSTANT (TREE_VALUE (elmt))
  	  || (TREE_CODE (type) == RECORD_TYPE
*************** gnat_build_constructor (tree type, tree 
*** 1477,1506 ****
  	return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
      }
  
!   /* If TYPE is a RECORD_TYPE and the fields are not in the
!      same order as their bit position, don't treat this as constant
!      since varasm.c can't handle it.  */
!   if (allconstant && TREE_CODE (type) == RECORD_TYPE)
      {
!       tree last_pos = bitsize_zero_node;
!       tree field;
  
!       for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
! 	{
! 	  tree this_pos = bit_position (field);
  
! 	  if (TREE_CODE (this_pos) != INTEGER_CST
! 	      || tree_int_cst_lt (this_pos, last_pos))
! 	    {
! 	      allconstant = false;
! 	      break;
! 	    }
  
! 	  last_pos = this_pos;
  	}
      }
  
!   result = build_constructor (type, list);
    TREE_CONSTANT (result) = TREE_INVARIANT (result)
      = TREE_STATIC (result) = allconstant;
    TREE_SIDE_EFFECTS (result) = side_effects;
--- 1521,1554 ----
  	return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
      }
  
!   /* For record types with constant components only, sort field list
!      by increasing bit position.  This is necessary to ensure the
!      constructor can be output as static data, which the gimplifier
!      might force in various circumstances. */
!   if (allconstant && TREE_CODE (type) == RECORD_TYPE && n_elmts > 1)
      {
!       /* Fill an array with an element tree per index, and ask qsort to order
! 	 them according to what a bitpos comparison function says.  */
  
!       tree *gnu_arr = (tree *) alloca (sizeof (tree) * n_elmts);
!       int i;
  
!       for (i = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), i++)
! 	gnu_arr[i] = elmt;
  
!       qsort (gnu_arr, n_elmts, sizeof (tree), compare_elmt_bitpos);
! 
!       /* Then reconstruct the list from the sorted array contents.  */
! 
!       list = NULL_TREE;
!       for (i = n_elmts - 1; i >= 0; i--)
! 	{
! 	  TREE_CHAIN (gnu_arr[i]) = list;
! 	  list = gnu_arr[i];
  	}
      }
  
!   result = build_constructor_from_list (type, list);
    TREE_CONSTANT (result) = TREE_INVARIANT (result)
      = TREE_STATIC (result) = allconstant;
    TREE_SIDE_EFFECTS (result) = side_effects;
*************** build_call_alloc_dealloc (tree gnu_obj, 
*** 1751,1761 ****
     initial value is INIT, if INIT is nonzero.  Convert the expression to
     RESULT_TYPE, which must be some type of pointer.  Return the tree.
     GNAT_PROC and GNAT_POOL optionally give the procedure to call and
!    the storage pool to use.  */
  
  tree
  build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
!                  Entity_Id gnat_pool, Node_Id gnat_node)
  {
    tree size = TYPE_SIZE_UNIT (type);
    tree result;
--- 1799,1813 ----
     initial value is INIT, if INIT is nonzero.  Convert the expression to
     RESULT_TYPE, which must be some type of pointer.  Return the tree.
     GNAT_PROC and GNAT_POOL optionally give the procedure to call and
!    the storage pool to use.  GNAT_NODE is used to provide an error
!    location for restriction violations messages.  If IGNORE_INIT_TYPE is
!    true, ignore the type of INIT for the purpose of determining the size;
!    this will cause the maximum size to be allocated if TYPE is of
!    self-referential size.  */
  
  tree
  build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
!                  Entity_Id gnat_pool, Node_Id gnat_node, bool ignore_init_type)
  {
    tree size = TYPE_SIZE_UNIT (type);
    tree result;
*************** build_allocator (tree type, tree init, t
*** 1769,1781 ****
       fill in the parts that are known.  */
    else if (TYPE_FAT_OR_THIN_POINTER_P (result_type))
      {
-       tree template_type
- 	= (TYPE_FAT_POINTER_P (result_type)
- 	   ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (result_type))))
- 	   : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (result_type))));
        tree storage_type
! 	= build_unc_object_type (template_type, type,
! 				 get_identifier ("ALLOC"));
        tree storage_ptr_type = build_pointer_type (storage_type);
        tree storage;
        tree template_cons = NULL_TREE;
--- 1821,1830 ----
       fill in the parts that are known.  */
    else if (TYPE_FAT_OR_THIN_POINTER_P (result_type))
      {
        tree storage_type
! 	= build_unc_object_type_from_ptr (result_type, type,
! 					  get_identifier ("ALLOC"));
!       tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
        tree storage_ptr_type = build_pointer_type (storage_type);
        tree storage;
        tree template_cons = NULL_TREE;
*************** build_allocator (tree type, tree init, t
*** 1839,1845 ****
  
    /* If we have an initializing expression, see if its size is simpler
       than the size from the type.  */
!   if (init && TYPE_SIZE_UNIT (TREE_TYPE (init))
        && (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (init))) == INTEGER_CST
  	  || CONTAINS_PLACEHOLDER_P (size)))
      size = TYPE_SIZE_UNIT (TREE_TYPE (init));
--- 1888,1894 ----
  
    /* If we have an initializing expression, see if its size is simpler
       than the size from the type.  */
!   if (!ignore_init_type && init && TYPE_SIZE_UNIT (TREE_TYPE (init))
        && (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (init))) == INTEGER_CST
  	  || CONTAINS_PLACEHOLDER_P (size)))
      size = TYPE_SIZE_UNIT (TREE_TYPE (init));
*************** build_allocator (tree type, tree init, t
*** 1850,1856 ****
       the maximum size.  */
    if (CONTAINS_PLACEHOLDER_P (size))
      {
!       if (init)
  	size = substitute_placeholder_in_expr (size, init);
        else
  	size = max_size (size, true);
--- 1899,1905 ----
       the maximum size.  */
    if (CONTAINS_PLACEHOLDER_P (size))
      {
!       if (!ignore_init_type && init)
  	size = substitute_placeholder_in_expr (size, init);
        else
  	size = max_size (size, true);
diff -Nrcpad gcc-4.0.2/gcc/ada/validsw.adb gcc-4.1.0/gcc/ada/validsw.adb
*** gcc-4.0.2/gcc/ada/validsw.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/validsw.adb	Fri Jul  1 01:29:17 2005
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff -Nrcpad gcc-4.0.2/gcc/ada/validsw.ads gcc-4.1.0/gcc/ada/validsw.ads
*** gcc-4.0.2/gcc/ada/validsw.ads	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/validsw.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2001-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Validsw is
*** 48,58 ****
     --  expressions in object declarations are checked for validity.
  
     Validity_Check_Default : Boolean := True;
!    --  Controls default (reference manual) validity checking. If this switch
!    --  is set to True using -gnatVd or a 'd' in the argument of a Validity_
!    --  Checks pragma then left side subscripts and case statement arguments
!    --  are checked for validity. This switch is also set by default if no
!    --  -gnatV switch is used and no Validity_Checks pragma is processed.
  
     Validity_Check_Floating_Point : Boolean := False;
     --  Normally validity checking applies only to discrete values (integer
--- 48,59 ----
     --  expressions in object declarations are checked for validity.
  
     Validity_Check_Default : Boolean := True;
!    --  Controls default (reference manual) validity checking. If this switch is
!    --  set to True using -gnatVd or a 'd' in the argument of a Validity_ Checks
!    --  pragma (or the initial default value is used, set True), then left side
!    --  subscripts and case statement arguments are checked for validity. This
!    --  switch is also set by default if no -gnatV switch is used and no
!    --  Validity_Checks pragma is processed.
  
     Validity_Check_Floating_Point : Boolean := False;
     --  Normally validity checking applies only to discrete values (integer
diff -Nrcpad gcc-4.0.2/gcc/ada/vms_conv.adb gcc-4.1.0/gcc/ada/vms_conv.adb
*** gcc-4.0.2/gcc/ada/vms_conv.adb	Thu Feb 10 14:05:21 2005
--- gcc-4.1.0/gcc/ada/vms_conv.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body VMS_Conv is
*** 207,213 ****
              Unixcmd  => new S'("gnatbind"),
              Unixsws  => null,
              Switches => Bind_Switches'Access,
!             Params   => new Parameter_Array'(1 => File),
              Defext   => "ali"),
  
           Chop =>
--- 207,213 ----
              Unixcmd  => new S'("gnatbind"),
              Unixsws  => null,
              Switches => Bind_Switches'Access,
!             Params   => new Parameter_Array'(1 => Unlimited_Files),
              Defext   => "ali"),
  
           Chop =>
*************** package body VMS_Conv is
*** 274,290 ****
              Params   => new Parameter_Array'(1 => File),
              Defext   => "   "),
  
-          Library =>
-            (Cname    => new S'("LIBRARY"),
-             Usage    => new S'("GNAT LIBRARY /[CREATE | SET | DELETE]"
-                                & "=directory [/CONFIG=file]"),
-             VMS_Only => True,
-             Unixcmd  => new S'("gnatlbr"),
-             Unixsws  => null,
-             Switches => Lbr_Switches'Access,
-             Params   => new Parameter_Array'(1 .. 0 => File),
-             Defext   => "   "),
- 
           Link =>
             (Cname    => new S'("LINK"),
              Usage    => new S'("GNAT LINK file[.ali]"
--- 274,279 ----
*************** package body VMS_Conv is
*** 662,668 ****
     begin
        Put ("GNAT ");
        Put_Line (Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1996-2005 Free Software Foundation, Inc.");
     end Output_Version;
  
     -----------
--- 651,657 ----
     begin
        Put ("GNAT ");
        Put_Line (Gnatvsn.Gnat_Version_String);
!       Put_Line ("Copyright 1996-2005, Free Software Foundation, Inc.");
     end Output_Version;
  
     -----------
diff -Nrcpad gcc-4.0.2/gcc/ada/vms_conv.ads gcc-4.1.0/gcc/ada/vms_conv.ads
*** gcc-4.0.2/gcc/ada/vms_conv.ads	Mon Aug  9 12:24:22 2004
--- gcc-4.1.0/gcc/ada/vms_conv.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package VMS_Conv is
*** 101,107 ****
        Elim,
        Find,
        Krunch,
-       Library,
        Link,
        List,
        Make,
--- 101,106 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/vms_data.ads gcc-4.1.0/gcc/ada/vms_data.ads
*** gcc-4.0.2/gcc/ada/vms_data.ads	Thu Feb 10 13:50:32 2005
--- gcc-4.1.0/gcc/ada/vms_data.ads	Tue Nov 15 13:59:30 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1996-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package VMS_Data is
*** 1800,1805 ****
--- 1800,1807 ----
                                                 "-gnatyb "                  &
                                              "COMMENTS "                    &
                                                 "-gnatyc "                  &
+                                             "DOS_LINE_ENDINGS "            &
+                                                "-gnatyd "                  &
                                              "END "                         &
                                                 "-gnatye "                  &
                                              "VTABS "                       &
*************** package VMS_Data is
*** 1822,1829 ****
                                                 "-gnatyn "                  &
                                              "ORDERED_SUBPROGRAMS "         &
                                                 "-gnatyo "                  &
-                                             "NONE "                        &
-                                                "!-gnatg,!-gnaty* "         &
                                              "PRAGMA "                      &
                                                 "-gnatyp "                  &
                                              "REFERENCES "                  &
--- 1824,1829 ----
*************** package VMS_Data is
*** 1832,1837 ****
--- 1832,1839 ----
                                                 "-gnatys "                  &
                                              "TOKEN "                       &
                                                 "-gnatyt "                  &
+                                             "UNNECESSARY_BLANK_LINES "     &
+                                                "-gnatyu "                  &
                                              "XTRA_PARENS "                 &
                                                 "-gnatyx ";
     --        /NOSTYLE_CHECKS (D)
*************** package VMS_Data is
*** 1915,1920 ****
--- 1917,1927 ----
     --                               -- This is a box comment --
     --                               ---------------------------
     --
+    --      DOS_LINE_ENDINGS     Check that no DOS line terminators are present
+    --                           All lines must be terminated by a single
+    --                           ASCII.LF character. In particular the DOS line
+    --                           terminator sequence CR / LF is not allowed).
+    --
     --      END                  Check end/exit labels.
     --                           Optional labels on end statements ending
     --                           subprograms and on exit statements exiting
*************** package VMS_Data is
*** 2044,2051 ****
     --                           in the ordering (e.g. Junk2 comes before
     --                           Junk10).
     --
-    --      NONE                 The default behavior.  Same as /NOSTYLE_CHECKS.
-    --
     --      PRAGMA               Check pragma casing.
     --                           Pragma names must be written in mixed case,
     --                           that is, the initial letter and any letter
--- 2051,2056 ----
*************** package VMS_Data is
*** 2059,2073 ****
     --                           identifiers. The only requirement is for
     --                           consistency of references with declarations.
     --
-    --      RM_COLUMN_LAYOUT     Enforce the layout conventions suggested by
-    --                           the examples and syntax rules of the Ada
-    --                           Language Reference Manual. For example, an
-    --                           "else" must line up with an "if" and code in
-    --                           the "then" and "else" parts must be indented.
-    --                           The compiler considers violations of the
-    --                           layout rules a syntax error if you specify
-    --                           this keyword.
-    --
     --      SPECS                Check separate specs.
     --                           Separate declarations ("specs") are required
     --                           for subprograms (a body is not allowed to serve
--- 2064,2069 ----
*************** package VMS_Data is
*** 2138,2146 ****
--- 2134,2153 ----
     --                           or as meeting a requirement for no following
     --                           space.
     --
+    --      UNNECESSARY_BLANK_LINES
+    --                           Check for unnecessary blank lines.
+    --                           A blank line is considered unnecessary if it
+    --                           appears at the end of the file, or if more
+    --                           than one blank line occurs in sequence.
+    --
     --      VTABS                No form feeds or vertical tabs.
     --                           Form feeds or vertical tab characters are not
     --                           permitted in the source text.
+    --
+    --      XTRA_PARENS          Check for the use of an unnecessary extra
+    --                           level of parentheses (C - style) around
+    --                           conditions in if statements, while statements
+    --                           and exit statements.
  
     S_GCC_StyleX  : aliased constant S := "/NOSTYLE_CHECKS "                &
                                              "!-gnatg,!-gnaty*";
*************** package VMS_Data is
*** 2357,2362 ****
--- 2364,2373 ----
                                                 "-gnatwA "                  &
                                              "ALL_GCC "                     &
                                                 "-Wall "                    &
+                                             "BAD_FIXED_VALUES "            &
+                                                "-gnatwb "                  &
+                                             "NO_BAD_FIXED_VALUES "         &
+                                                "-gnatwB "                  &
                                              "CONDITIONALS "                &
                                                 "-gnatwc "                  &
                                              "NOCONDITIONALS "              &
*************** package VMS_Data is
*** 2433,2438 ****
--- 2444,2453 ----
                                                 "-gnatwx "                  &
                                              "NOIMPORT_EXPORT_PRAGMAS "     &
                                                 "-gnatwX "                  &
+                                             "ADA_2005_COMPATIBILITY "      &
+                                                "-gnatwy "                  &
+                                             "NOADA_2005_COMPATIBILITY "    &
+                                                "-gnatwY "                  &
                                              "UNCHECKED_CONVERSIONS "       &
                                                 "-gnatwz "                  &
                                              "NOUNCHECKED_CONVERSIONS "     &
*************** package VMS_Data is
*** 3192,3231 ****
     Krunch_Switches : aliased constant Switches  :=
       (1 .. 1 => S_Krunch_Count  'Access);
  
-    -------------------------------
-    -- Switches for GNAT LIBRARY --
-    -------------------------------
- 
-    S_Lbr_Config    : aliased constant S := "/CONFIG=@"                     &
-                                             "--config=@";
-    --        /CONFIG=file
-    --
-    --   File containing configuration pragmas.
- 
-    S_Lbr_Create    : aliased constant S := "/CREATE=%"                     &
-                                             "--create=%";
-    --        /CREATE=directory
-    --
-    --   Directory to create and build alternate library in.
- 
-    S_Lbr_Delete    : aliased constant S := "/DELETE=%"                     &
-                                             "--delete=%";
-    --        /DELETE=directory
-    --
-    --   Directory containing alternate library to be deleted.
- 
-    S_Lbr_Set       : aliased constant S := "/SET=%"                        &
-                                             "--set=%";
-    --        /SET=directory
-    --
-    --   Directory containing alternate library to be made the current library.
- 
-    Lbr_Switches : aliased constant Switches  :=
-      (S_Lbr_Config 'Access,
-       S_Lbr_Create 'Access,
-       S_Lbr_Delete 'Access,
-       S_Lbr_Set    'Access);
- 
     ----------------------------
     -- Switches for GNAT LINK --
     ----------------------------
--- 3207,3212 ----
*************** package VMS_Data is
*** 3644,3650 ****
     --
     --   Implies /Unique.
     --   When used without project files, it is equivalent to /UNIQUE.
!    --   When used with a project file wit no main (neither on the command
     --   line nor in the attribute Main) check every source of every project,
     --   recompile all sources that are not up to date and rebuild libraries
     --   if necessary.
--- 3625,3631 ----
     --
     --   Implies /Unique.
     --   When used without project files, it is equivalent to /UNIQUE.
!    --   When used with a project file with no main (neither on the command
     --   line nor in the attribute Main) check every source of every project,
     --   recompile all sources that are not up to date and rebuild libraries
     --   if necessary.
*************** package VMS_Data is
*** 3779,3784 ****
--- 3760,3773 ----
     --   /VERBOSE), then error lines start with the full path name of the
     --   project file, rather than its simple file name.
  
+    S_Make_Hi_Verb : aliased constant S := "/HIGH_VERBOSITY "               &
+                                           "-vh";
+    --        /NOHIGH_VERBOSITY (D)
+    --        /HIGH_VERBOSITY
+    --
+    --   Displays the reason for all recompilations GNAT MAKE decides are
+    --   necessary, in high verbosity. Equivalent to /VERBOSE.
+ 
     S_Make_Inplace : aliased constant S := "/IN_PLACE "                     &
                                              "-i";
     --        /NOIN_PLACE (D)
*************** package VMS_Data is
*** 3817,3822 ****
--- 3806,3820 ----
     --   /COMPILER_QUALIFIERS, /BINDER_QUALIFIERS and /MAKE_QUALIFIERS will be
     --   passed to any GNAT LINK commands generated by GNAT LINK.
  
+    S_Make_Low_Verb : aliased constant S := "/LOW_VERBOSITY "               &
+                                            "-vl";
+    --        /NOLOW_VERBOSITY (D)
+    --        /LOW_VERBOSITY
+    --
+    --   Displays the reason for all recompilations GNAT MAKE decides are
+    --   necessary, in low verbosity, that is with less output than
+    --   /MEDIUM_VERBOSITY, /HIGH_VERBOSITY or /VERBOSE.
+ 
     S_Make_Make    : aliased constant S := "/MAKE_QUALIFIERS=?"             &
                                              "-margs MAKE";
     --        /MAKE_QUALIFIERS
*************** package VMS_Data is
*** 3841,3846 ****
--- 3839,3853 ----
     --   the mapping file. This will improve the source search during the next
     --   invocations of the compiler
  
+    S_Make_Med_Verb : aliased constant S := "/MEDIUM_VERBOSITY "            &
+                                            "-vm";
+    --        /NOMEDIUM_VERBOSITY (D)
+    --        /MEDIUM_VERBOSITY
+    --
+    --   Displays the reason for all recompilations GNAT MAKE decides are
+    --   necessary, in medium verbosity, that is with potentially less output
+    --   than /HIGH_VERBOSITY or /VERBOSE.
+ 
     S_Make_Mess    : aliased constant S := "/MESSAGES_PROJECT_FILE="        &
                                              "DEFAULT "                     &
                                                 "-vP0 "                     &
*************** package VMS_Data is
*** 4036,4047 ****
--- 4043,4057 ----
        S_Make_Ext     'Access,
        S_Make_Force   'Access,
        S_Make_Full    'Access,
+       S_Make_Hi_Verb 'Access,
        S_Make_Inplace 'Access,
        S_Make_Index   'Access,
        S_Make_Library 'Access,
        S_Make_Link    'Access,
+       S_Make_Low_Verb'Access,
        S_Make_Make    'Access,
        S_Make_Mapping 'Access,
+       S_Make_Med_Verb'Access,
        S_Make_Mess    'Access,
        S_Make_Minimal 'Access,
        S_Make_Nolink  'Access,
*************** package VMS_Data is
*** 4068,4073 ****
--- 4078,4091 ----
     -- Switches for GNAT METRIC --
     ------------------------------
  
+    S_Metric_All_Prjs : aliased constant S := "/ALL_PROJECTS "              &
+                                                "-U";
+    --        /NOALL_PROJECTS (D)
+    --        /ALL_PROJECTS
+    --   When GNAT METRIC is used with a Project File and no source is
+    --   specified, the underlying tool gnatmetric is called for all the
+    --   sources of all the Project Files in the project tree.
+ 
     S_Metric_Debug    : aliased constant S := "/DEBUG_OUTPUT "               &
                                               "-dv";
     --      /DEBUG_OUTPUT
*************** package VMS_Data is
*** 4288,4294 ****
     --   Place the XML output into the specified file
  
     Metric_Switches : aliased constant Switches :=
!      (S_Metric_Debug    'Access,
        S_Metric_Direct   'Access,
        S_Metric_Element  'Access,
        S_Metric_Ext      'Access,
--- 4306,4313 ----
     --   Place the XML output into the specified file
  
     Metric_Switches : aliased constant Switches :=
!      (S_Metric_All_Prjs 'Access,
!       S_Metric_Debug    'Access,
        S_Metric_Direct   'Access,
        S_Metric_Element  'Access,
        S_Metric_Ext      'Access,
*************** package VMS_Data is
*** 4462,4467 ****
--- 4481,4494 ----
     --   Preprocessor lines and deleted lines are completely removed from the
     --   output.
  
+    S_Prep_Replace : aliased constant S := "/REPLACE_IN_COMMENTS "          &
+                                             "-C";
+    --        /NOREPLACE_IN_COMMENTS (D)
+    --        /REPLACE_IN_COMMENTS
+    --
+    --   Causes preprocessor to scan comments and perform replacements on
+    --   any $symbol occurrences within the comment text.
+ 
     S_Prep_Symbols : aliased constant S := "/SYMBOLS "                      &
                                              "-s";
     --        /NOSYMBOLS (D)
*************** package VMS_Data is
*** 4481,4486 ****
--- 4508,4514 ----
        S_Prep_Com     'Access,
        S_Prep_Ref     'Access,
        S_Prep_Remove  'Access,
+       S_Prep_Replace 'Access,
        S_Prep_Symbols 'Access,
        S_Prep_Undef   'Access);
  
*************** package VMS_Data is
*** 4523,4528 ****
--- 4551,4564 ----
     --   Specifying one of the ON options without first specifying the OFF
     --   option has no effect, because by default all alignments are set to ON.
  
+    S_Pretty_All_Prjs : aliased constant S := "/ALL_PROJECTS "             &
+                                               "-U";
+    --        /NOALL_PROJECTS (D)
+    --        /ALL_PROJECTS
+    --   When GNAT PRETTY is used with a Project File and no source is
+    --   specified, the underlying tool gnatpp is called for all the
+    --   sources of all the Project Files in the project tree.
+ 
     S_Pretty_Attrib : aliased constant S := "/ATTRIBUTE_CASING="            &
                                             "MIXED_CASE "                   &
                                                 "-aM "                      &
*************** package VMS_Data is
*** 4664,4669 ****
--- 4700,4730 ----
     --   unless the indentation is set to 1: in that case the default value for
     --   continuation line indentation is also 1.
  
+    S_Pretty_Compact_Is : aliased constant S := "/NO_SEPARATE_IS "          &
+                                                  "--no-separate-is";
+    --        /NO_SEPARATE_IS
+    --
+    --   Do not place the IS keyword on a separate line in a subprogram body in
+    --   case if the specification occupies more then one line.
+ 
+    S_Pretty_Eol       : aliased constant S := "/END_OF_LINE="              &
+                                                 "DOS "                     &
+                                                    "--eol=dos "            &
+                                                 "UNIX "                    &
+                                                    "--eol=unix "           &
+                                                 "CRLF "                    &
+                                                    "--eol=crlf "           &
+                                                 "LF "                      &
+                                                    "--eol=lf";
+    --        /END_OF_LINE=[option]
+    --
+    --   Specifies the form of the line terminators in the produced source.
+    --   By default, the form of the line terminator depends on the platforms.
+    --   On Unix and VMS, it is a Line Feed (LF) chararcter. On Windows (DOS),
+    --   It is a Carriage Return (CR) followed by a Line Feed.
+    --   The Options DOS and CRLF are equivalent. The options UNIX and LF are
+    --   also equivalent.
+ 
     S_Pretty_Ext       : aliased constant S := "/EXTERNAL_REFERENCE=" & '"' &
                                              "-X" & '"';
     --        /EXTERNAL_REFERENCE="name=val"
*************** package VMS_Data is
*** 4920,4933 ****
  
     Pretty_Switches : aliased constant Switches :=
       (S_Pretty_Align     'Access,
        S_Pretty_Attrib    'Access,
        S_Pretty_Comments  'Access,
        S_Pretty_Config    'Access,
        S_Pretty_Constr    'Access,
        S_Pretty_Comind    'Access,
-       S_Pretty_Ext       'Access,
        S_Pretty_Current   'Access,
        S_Pretty_Dico      'Access,
        S_Pretty_Files     'Access,
        S_Pretty_Forced    'Access,
        S_Pretty_Formfeed  'Access,
--- 4981,4997 ----
  
     Pretty_Switches : aliased constant Switches :=
       (S_Pretty_Align     'Access,
+       S_Pretty_All_Prjs  'Access,
        S_Pretty_Attrib    'Access,
        S_Pretty_Comments  'Access,
+       S_Pretty_Compact_Is'Access,
        S_Pretty_Config    'Access,
        S_Pretty_Constr    'Access,
        S_Pretty_Comind    'Access,
        S_Pretty_Current   'Access,
        S_Pretty_Dico      'Access,
+       S_Pretty_Eol       'Access,
+       S_Pretty_Ext       'Access,
        S_Pretty_Files     'Access,
        S_Pretty_Forced    'Access,
        S_Pretty_Formfeed  'Access,
diff -Nrcpad gcc-4.0.2/gcc/ada/vxaddr2line.adb gcc-4.1.0/gcc/ada/vxaddr2line.adb
*** gcc-4.0.2/gcc/ada/vxaddr2line.adb	Wed Dec  8 11:49:07 2004
--- gcc-4.1.0/gcc/ada/vxaddr2line.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --            Copyright (C) 2002-2004 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --                     Copyright (C) 2002-2005, AdaCore                     --
  --                                                                          --
  -- 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure VxAddr2Line is
*** 83,95 ****
     type Architecture is
       (SOLARIS_I586,
        WINDOWS_POWERPC,
        WINDOWS_M68K,
        SOLARIS_POWERPC,
        DEC_ALPHA);
  
     type Arch_Record is record
        Addr2line_Binary : String_Access;
!       --  Name of the addr2line utility to use.
  
        Nm_Binary : String_Access;
        --  Name of the host nm utility, which will be used to find out the
--- 83,96 ----
     type Architecture is
       (SOLARIS_I586,
        WINDOWS_POWERPC,
+       WINDOWS_I586,
        WINDOWS_M68K,
        SOLARIS_POWERPC,
        DEC_ALPHA);
  
     type Arch_Record is record
        Addr2line_Binary : String_Access;
!       --  Name of the addr2line utility to use
  
        Nm_Binary : String_Access;
        --  Name of the host nm utility, which will be used to find out the
*************** procedure VxAddr2Line is
*** 121,126 ****
--- 122,132 ----
           Nm_Binary           => null,
           Addr_Digits_To_Skip => 0,
           Bt_Offset_From_Call => -4),
+       WINDOWS_I586 =>
+         (Addr2line_Binary    => null,
+          Nm_Binary           => null,
+          Addr_Digits_To_Skip => 0,
+          Bt_Offset_From_Call => -2),
        SOLARIS_POWERPC =>
          (Addr2line_Binary    => null,
           Nm_Binary           => null,
*************** procedure VxAddr2Line is
*** 288,294 ****
              return Value;
        end;
  
!       --  We can not get here
  
        raise Program_Error;
  
--- 294,300 ----
              return Value;
        end;
  
!       --  We cannot get here
  
        raise Program_Error;
  
*************** begin
*** 402,408 ****
        Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
     end if;
  
!    --  The first argument specifies the image file. Check if it exists.
  
     if not Is_Regular_File (Argument (1)) then
        Error ("Couldn't find the executable " & Argument (1));
--- 408,414 ----
        Error ("Couldn't find " & Arch_List (Cur_Arch).Addr2line_Binary.all);
     end if;
  
!    --  The first argument specifies the image file. Check if it exists
  
     if not Is_Regular_File (Argument (1)) then
        Error ("Couldn't find the executable " & Argument (1));
diff -Nrcpad gcc-4.0.2/gcc/ada/widechar.adb gcc-4.1.0/gcc/ada/widechar.adb
*** gcc-4.0.2/gcc/ada/widechar.adb	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/widechar.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with System.WCh_Con; use System.WCh_Con;
*** 42,1584 ****
  
  package body Widechar is
  
-    pragma Style_Checks (Off);
-    --  Allow long lines in this unit
- 
-    -----------------------------------------------
-    -- Tables for UTF_32 Categorization Routines --
-    -----------------------------------------------
- 
-    --  Note these tables are derived from those given in AI-285. For details
-    --  see //www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00285.TXT?rev=1.22.
- 
-    type UTF_32_Range is record
-       Lo : Char_Code;
-       Hi : Char_Code;
-    end record;
- 
-    type UTF_32_Ranges is array (Positive range <>) of UTF_32_Range;
- 
-    --  The following array includes all characters considered digits, i.e.
-    --  all characters from the Unicode table with categories:
- 
-    --    Number, Decimal Digit (Nd)
- 
-    UTF_32_Digits : constant UTF_32_Ranges := (
-      (16#00030#, 16#00039#),  -- DIGIT ZERO .. DIGIT NINE
-      (16#00660#, 16#00669#),  -- ARABIC-INDIC DIGIT ZERO .. ARABIC-INDIC DIGIT NINE
-      (16#006F0#, 16#006F9#),  -- EXTENDED ARABIC-INDIC DIGIT ZERO .. EXTENDED ARABIC-INDIC DIGIT NINE
-      (16#00966#, 16#0096F#),  -- DEVANAGARI DIGIT ZERO .. DEVANAGARI DIGIT NINE
-      (16#009E6#, 16#009EF#),  -- BENGALI DIGIT ZERO .. BENGALI DIGIT NINE
-      (16#00A66#, 16#00A6F#),  -- GURMUKHI DIGIT ZERO .. GURMUKHI DIGIT NINE
-      (16#00AE6#, 16#00AEF#),  -- GUJARATI DIGIT ZERO .. GUJARATI DIGIT NINE
-      (16#00B66#, 16#00B6F#),  -- ORIYA DIGIT ZERO .. ORIYA DIGIT NINE
-      (16#00BE7#, 16#00BEF#),  -- TAMIL DIGIT ONE .. TAMIL DIGIT NINE
-      (16#00C66#, 16#00C6F#),  -- TELUGU DIGIT ZERO .. TELUGU DIGIT NINE
-      (16#00CE6#, 16#00CEF#),  -- KANNADA DIGIT ZERO .. KANNADA DIGIT NINE
-      (16#00D66#, 16#00D6F#),  -- MALAYALAM DIGIT ZERO .. MALAYALAM DIGIT NINE
-      (16#00E50#, 16#00E59#),  -- THAI DIGIT ZERO .. THAI DIGIT NINE
-      (16#00ED0#, 16#00ED9#),  -- LAO DIGIT ZERO .. LAO DIGIT NINE
-      (16#00F20#, 16#00F29#),  -- TIBETAN DIGIT ZERO .. TIBETAN DIGIT NINE
-      (16#01040#, 16#01049#),  -- MYANMAR DIGIT ZERO .. MYANMAR DIGIT NINE
-      (16#01369#, 16#01371#),  -- ETHIOPIC DIGIT ONE .. ETHIOPIC DIGIT NINE
-      (16#017E0#, 16#017E9#),  -- KHMER DIGIT ZERO .. KHMER DIGIT NINE
-      (16#01810#, 16#01819#),  -- MONGOLIAN DIGIT ZERO .. MONGOLIAN DIGIT NINE
-      (16#01946#, 16#0194F#),  -- LIMBU DIGIT ZERO .. LIMBU DIGIT NINE
-      (16#0FF10#, 16#0FF19#),  -- FULLWIDTH DIGIT ZERO .. FULLWIDTH DIGIT NINE
-      (16#104A0#, 16#104A9#),  -- OSMANYA DIGIT ZERO .. OSMANYA DIGIT NINE
-      (16#1D7CE#, 16#1D7FF#)); -- MATHEMATICAL BOLD DIGIT ZERO .. MATHEMATICAL MONOSPACE DIGIT NINE
- 
-    --  The following table includes all characters considered letters, i.e.
-    --  all characters from the Unicode table with categories:
- 
-    --    Letter, Uppercase (Lu)
-    --    Letter, Lowercase (Ll)
-    --    Letter, Titlecase (Lt)
-    --    Letter, Modifier (Lm)
-    --    Letter, Other (Lo)
-    --    Number, Letter (Nl)
- 
-    UTF_32_Letters : constant UTF_32_Ranges := (
-      (16#00041#, 16#0005A#),  -- LATIN CAPITAL LETTER A .. LATIN CAPITAL LETTER Z
-      (16#00061#, 16#0007A#),  -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
-      (16#000AA#, 16#000AA#),  -- FEMININE ORDINAL INDICATOR .. FEMININE ORDINAL INDICATOR
-      (16#000B5#, 16#000B5#),  -- MICRO SIGN .. MICRO SIGN
-      (16#000BA#, 16#000BA#),  -- MASCULINE ORDINAL INDICATOR .. MASCULINE ORDINAL INDICATOR
-      (16#000C0#, 16#000D6#),  -- LATIN CAPITAL LETTER A WITH GRAVE .. LATIN CAPITAL LETTER O WITH DIAERESIS
-      (16#000D8#, 16#000F6#),  -- LATIN CAPITAL LETTER O WITH STROKE .. LATIN SMALL LETTER O WITH DIAERESIS
-      (16#000F8#, 16#00236#),  -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER T WITH CURL
-      (16#00250#, 16#002C1#),  -- LATIN SMALL LETTER TURNED A .. MODIFIER LETTER REVERSED GLOTTAL STOP
-      (16#002C6#, 16#002D1#),  -- MODIFIER LETTER CIRCUMFLEX ACCENT .. MODIFIER LETTER HALF TRIANGULAR COLON
-      (16#002E0#, 16#002E4#),  -- MODIFIER LETTER SMALL GAMMA .. MODIFIER LETTER SMALL REVERSED GLOTTAL STOP
-      (16#002EE#, 16#002EE#),  -- MODIFIER LETTER DOUBLE APOSTROPHE .. MODIFIER LETTER DOUBLE APOSTROPHE
-      (16#0037A#, 16#0037A#),  -- GREEK YPOGEGRAMMENI .. GREEK YPOGEGRAMMENI
-      (16#00386#, 16#00386#),  -- GREEK CAPITAL LETTER ALPHA WITH TONOS .. GREEK CAPITAL LETTER ALPHA WITH TONOS
-      (16#00388#, 16#0038A#),  -- GREEK CAPITAL LETTER EPSILON WITH TONOS .. GREEK CAPITAL LETTER IOTA WITH TONOS
-      (16#0038C#, 16#0038C#),  -- GREEK CAPITAL LETTER OMICRON WITH TONOS .. GREEK CAPITAL LETTER OMICRON WITH TONOS
-      (16#0038E#, 16#003A1#),  -- GREEK CAPITAL LETTER UPSILON WITH TONOS .. GREEK CAPITAL LETTER RHO
-      (16#003A3#, 16#003CE#),  -- GREEK CAPITAL LETTER SIGMA .. GREEK SMALL LETTER OMEGA WITH TONOS
-      (16#003D0#, 16#003F5#),  -- GREEK BETA SYMBOL .. GREEK LUNATE EPSILON SYMBOL
-      (16#003F7#, 16#003FB#),  -- GREEK CAPITAL LETTER SHO .. GREEK SMALL LETTER SAN
-      (16#00400#, 16#00481#),  -- CYRILLIC CAPITAL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER KOPPA
-      (16#0048A#, 16#004CE#),  -- CYRILLIC CAPITAL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL
-      (16#004D0#, 16#004F5#),  -- CYRILLIC CAPITAL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS
-      (16#004F8#, 16#004F9#),  -- CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS
-      (16#00500#, 16#0050F#),  -- CYRILLIC CAPITAL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI TJE
-      (16#00531#, 16#00556#),  -- ARMENIAN CAPITAL LETTER AYB .. ARMENIAN CAPITAL LETTER FEH
-      (16#00559#, 16#00559#),  -- ARMENIAN MODIFIER LETTER LEFT HALF RING .. ARMENIAN MODIFIER LETTER LEFT HALF RING
-      (16#00561#, 16#00587#),  -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LIGATURE ECH YIWN
-      (16#005D0#, 16#005EA#),  -- HEBREW LETTER ALEF .. HEBREW LETTER TAV
-      (16#005F0#, 16#005F2#),  -- HEBREW LIGATURE YIDDISH DOUBLE VAV .. HEBREW LIGATURE YIDDISH DOUBLE YOD
-      (16#00621#, 16#0063A#),  -- ARABIC LETTER HAMZA .. ARABIC LETTER GHAIN
-      (16#00640#, 16#0064A#),  -- ARABIC TATWEEL .. ARABIC LETTER YEH
-      (16#0066E#, 16#0066F#),  -- ARABIC LETTER DOTLESS BEH .. ARABIC LETTER DOTLESS QAF
-      (16#00671#, 16#006D3#),  -- ARABIC LETTER ALEF WASLA .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE
-      (16#006D5#, 16#006D5#),  -- ARABIC LETTER AE .. ARABIC LETTER AE
-      (16#006E5#, 16#006E6#),  -- ARABIC SMALL WAW .. ARABIC SMALL YEH
-      (16#006EE#, 16#006EF#),  -- ARABIC LETTER DAL WITH INVERTED V .. ARABIC LETTER REH WITH INVERTED V
-      (16#006FA#, 16#006FC#),  -- ARABIC LETTER SHEEN WITH DOT BELOW .. ARABIC LETTER GHAIN WITH DOT BELOW
-      (16#006FF#, 16#006FF#),  -- ARABIC LETTER HEH WITH INVERTED V .. ARABIC LETTER HEH WITH INVERTED V
-      (16#00710#, 16#00710#),  -- SYRIAC LETTER ALAPH .. SYRIAC LETTER ALAPH
-      (16#00712#, 16#0072F#),  -- SYRIAC LETTER BETH .. SYRIAC LETTER PERSIAN DHALATH
-      (16#0074D#, 16#0074F#),  -- SYRIAC LETTER SOGDIAN ZHAIN .. SYRIAC LETTER SOGDIAN FE
-      (16#00780#, 16#007A5#),  -- THAANA LETTER HAA .. THAANA LETTER WAAVU
-      (16#007B1#, 16#007B1#),  -- THAANA LETTER NAA .. THAANA LETTER NAA
-      (16#00904#, 16#00939#),  -- DEVANAGARI LETTER SHORT A .. DEVANAGARI LETTER HA
-      (16#0093D#, 16#0093D#),  -- DEVANAGARI SIGN AVAGRAHA .. DEVANAGARI SIGN AVAGRAHA
-      (16#00950#, 16#00950#),  -- DEVANAGARI OM .. DEVANAGARI OM
-      (16#00958#, 16#00961#),  -- DEVANAGARI LETTER QA .. DEVANAGARI LETTER VOCALIC LL
-      (16#00985#, 16#0098C#),  -- BENGALI LETTER A .. BENGALI LETTER VOCALIC L
-      (16#0098F#, 16#00990#),  -- BENGALI LETTER E .. BENGALI LETTER AI
-      (16#00993#, 16#009A8#),  -- BENGALI LETTER O .. BENGALI LETTER NA
-      (16#009AA#, 16#009B0#),  -- BENGALI LETTER PA .. BENGALI LETTER RA
-      (16#009B2#, 16#009B2#),  -- BENGALI LETTER LA .. BENGALI LETTER LA
-      (16#009B6#, 16#009B9#),  -- BENGALI LETTER SHA .. BENGALI LETTER HA
-      (16#009BD#, 16#009BD#),  -- BENGALI SIGN AVAGRAHA .. BENGALI SIGN AVAGRAHA
-      (16#009DC#, 16#009DD#),  -- BENGALI LETTER RRA .. BENGALI LETTER RHA
-      (16#009DF#, 16#009E1#),  -- BENGALI LETTER YYA .. BENGALI LETTER VOCALIC LL
-      (16#009F0#, 16#009F1#),  -- BENGALI LETTER RA WITH MIDDLE DIAGONAL .. BENGALI LETTER RA WITH LOWER DIAGONAL
-      (16#00A05#, 16#00A0A#),  -- GURMUKHI LETTER A .. GURMUKHI LETTER UU
-      (16#00A0F#, 16#00A10#),  -- GURMUKHI LETTER EE .. GURMUKHI LETTER AI
-      (16#00A13#, 16#00A28#),  -- GURMUKHI LETTER OO .. GURMUKHI LETTER NA
-      (16#00A2A#, 16#00A30#),  -- GURMUKHI LETTER PA .. GURMUKHI LETTER RA
-      (16#00A32#, 16#00A33#),  -- GURMUKHI LETTER LA .. GURMUKHI LETTER LLA
-      (16#00A35#, 16#00A36#),  -- GURMUKHI LETTER VA .. GURMUKHI LETTER SHA
-      (16#00A38#, 16#00A39#),  -- GURMUKHI LETTER SA .. GURMUKHI LETTER HA
-      (16#00A59#, 16#00A5C#),  -- GURMUKHI LETTER KHHA .. GURMUKHI LETTER RRA
-      (16#00A5E#, 16#00A5E#),  -- GURMUKHI LETTER FA .. GURMUKHI LETTER FA
-      (16#00A72#, 16#00A74#),  -- GURMUKHI IRI .. GURMUKHI EK ONKAR
-      (16#00A85#, 16#00A8D#),  -- GUJARATI LETTER A .. GUJARATI VOWEL CANDRA E
-      (16#00A8F#, 16#00A91#),  -- GUJARATI LETTER E .. GUJARATI VOWEL CANDRA O
-      (16#00A93#, 16#00AA8#),  -- GUJARATI LETTER O .. GUJARATI LETTER NA
-      (16#00AAA#, 16#00AB0#),  -- GUJARATI LETTER PA .. GUJARATI LETTER RA
-      (16#00AB2#, 16#00AB3#),  -- GUJARATI LETTER LA .. GUJARATI LETTER LLA
-      (16#00AB5#, 16#00AB9#),  -- GUJARATI LETTER VA .. GUJARATI LETTER HA
-      (16#00ABD#, 16#00ABD#),  -- GUJARATI SIGN AVAGRAHA .. GUJARATI SIGN AVAGRAHA
-      (16#00AD0#, 16#00AD0#),  -- GUJARATI OM .. GUJARATI OM
-      (16#00AE0#, 16#00AE1#),  -- GUJARATI LETTER VOCALIC RR .. GUJARATI LETTER VOCALIC LL
-      (16#00B05#, 16#00B0C#),  -- ORIYA LETTER A .. ORIYA LETTER VOCALIC L
-      (16#00B0F#, 16#00B10#),  -- ORIYA LETTER E .. ORIYA LETTER AI
-      (16#00B13#, 16#00B28#),  -- ORIYA LETTER O .. ORIYA LETTER NA
-      (16#00B2A#, 16#00B30#),  -- ORIYA LETTER PA .. ORIYA LETTER RA
-      (16#00B32#, 16#00B33#),  -- ORIYA LETTER LA .. ORIYA LETTER LLA
-      (16#00B35#, 16#00B39#),  -- ORIYA LETTER VA .. ORIYA LETTER HA
-      (16#00B3D#, 16#00B3D#),  -- ORIYA SIGN AVAGRAHA .. ORIYA SIGN AVAGRAHA
-      (16#00B5C#, 16#00B5D#),  -- ORIYA LETTER RRA .. ORIYA LETTER RHA
-      (16#00B5F#, 16#00B61#),  -- ORIYA LETTER YYA .. ORIYA LETTER VOCALIC LL
-      (16#00B71#, 16#00B71#),  -- ORIYA LETTER WA .. ORIYA LETTER WA
-      (16#00B83#, 16#00B83#),  -- TAMIL SIGN VISARGA .. TAMIL SIGN VISARGA
-      (16#00B85#, 16#00B8A#),  -- TAMIL LETTER A .. TAMIL LETTER UU
-      (16#00B8E#, 16#00B90#),  -- TAMIL LETTER E .. TAMIL LETTER AI
-      (16#00B92#, 16#00B95#),  -- TAMIL LETTER O .. TAMIL LETTER KA
-      (16#00B99#, 16#00B9A#),  -- TAMIL LETTER NGA .. TAMIL LETTER CA
-      (16#00B9C#, 16#00B9C#),  -- TAMIL LETTER JA .. TAMIL LETTER JA
-      (16#00B9E#, 16#00B9F#),  -- TAMIL LETTER NYA .. TAMIL LETTER TTA
-      (16#00BA3#, 16#00BA4#),  -- TAMIL LETTER NNA .. TAMIL LETTER TA
-      (16#00BA8#, 16#00BAA#),  -- TAMIL LETTER NA .. TAMIL LETTER PA
-      (16#00BAE#, 16#00BB5#),  -- TAMIL LETTER MA .. TAMIL LETTER VA
-      (16#00BB7#, 16#00BB9#),  -- TAMIL LETTER SSA .. TAMIL LETTER HA
-      (16#00C05#, 16#00C0C#),  -- TELUGU LETTER A .. TELUGU LETTER VOCALIC L
-      (16#00C0E#, 16#00C10#),  -- TELUGU LETTER E .. TELUGU LETTER AI
-      (16#00C12#, 16#00C28#),  -- TELUGU LETTER O .. TELUGU LETTER NA
-      (16#00C2A#, 16#00C33#),  -- TELUGU LETTER PA .. TELUGU LETTER LLA
-      (16#00C35#, 16#00C39#),  -- TELUGU LETTER VA .. TELUGU LETTER HA
-      (16#00C60#, 16#00C61#),  -- TELUGU LETTER VOCALIC RR .. TELUGU LETTER VOCALIC LL
-      (16#00C85#, 16#00C8C#),  -- KANNADA LETTER A .. KANNADA LETTER VOCALIC L
-      (16#00C8E#, 16#00C90#),  -- KANNADA LETTER E .. KANNADA LETTER AI
-      (16#00C92#, 16#00CA8#),  -- KANNADA LETTER O .. KANNADA LETTER NA
-      (16#00CAA#, 16#00CB3#),  -- KANNADA LETTER PA .. KANNADA LETTER LLA
-      (16#00CB5#, 16#00CB9#),  -- KANNADA LETTER VA .. KANNADA LETTER HA
-      (16#00CBD#, 16#00CBD#),  -- KANNADA SIGN AVAGRAHA .. KANNADA SIGN AVAGRAHA
-      (16#00CDE#, 16#00CDE#),  -- KANNADA LETTER FA .. KANNADA LETTER FA
-      (16#00CE0#, 16#00CE1#),  -- KANNADA LETTER VOCALIC RR .. KANNADA LETTER VOCALIC LL
-      (16#00D05#, 16#00D0C#),  -- MALAYALAM LETTER A .. MALAYALAM LETTER VOCALIC L
-      (16#00D0E#, 16#00D10#),  -- MALAYALAM LETTER E .. MALAYALAM LETTER AI
-      (16#00D12#, 16#00D28#),  -- MALAYALAM LETTER O .. MALAYALAM LETTER NA
-      (16#00D2A#, 16#00D39#),  -- MALAYALAM LETTER PA .. MALAYALAM LETTER HA
-      (16#00D60#, 16#00D61#),  -- MALAYALAM LETTER VOCALIC RR .. MALAYALAM LETTER VOCALIC LL
-      (16#00D85#, 16#00D96#),  -- SINHALA LETTER AYANNA .. SINHALA LETTER AUYANNA
-      (16#00D9A#, 16#00DB1#),  -- SINHALA LETTER ALPAPRAANA KAYANNA .. SINHALA LETTER DANTAJA NAYANNA
-      (16#00DB3#, 16#00DBB#),  -- SINHALA LETTER SANYAKA DAYANNA .. SINHALA LETTER RAYANNA
-      (16#00DBD#, 16#00DBD#),  -- SINHALA LETTER DANTAJA LAYANNA .. SINHALA LETTER DANTAJA LAYANNA
-      (16#00DC0#, 16#00DC6#),  -- SINHALA LETTER VAYANNA .. SINHALA LETTER FAYANNA
-      (16#00E01#, 16#00E30#),  -- THAI CHARACTER KO KAI .. THAI CHARACTER SARA A
-      (16#00E32#, 16#00E33#),  -- THAI CHARACTER SARA AA .. THAI CHARACTER SARA AM
-      (16#00E40#, 16#00E46#),  -- THAI CHARACTER SARA E .. THAI CHARACTER MAIYAMOK
-      (16#00E81#, 16#00E82#),  -- LAO LETTER KO .. LAO LETTER KHO SUNG
-      (16#00E84#, 16#00E84#),  -- LAO LETTER KHO TAM .. LAO LETTER KHO TAM
-      (16#00E87#, 16#00E88#),  -- LAO LETTER NGO .. LAO LETTER CO
-      (16#00E8A#, 16#00E8A#),  -- LAO LETTER SO TAM .. LAO LETTER SO TAM
-      (16#00E8D#, 16#00E8D#),  -- LAO LETTER NYO .. LAO LETTER NYO
-      (16#00E94#, 16#00E97#),  -- LAO LETTER DO .. LAO LETTER THO TAM
-      (16#00E99#, 16#00E9F#),  -- LAO LETTER NO .. LAO LETTER FO SUNG
-      (16#00EA1#, 16#00EA3#),  -- LAO LETTER MO .. LAO LETTER LO LING
-      (16#00EA5#, 16#00EA5#),  -- LAO LETTER LO LOOT .. LAO LETTER LO LOOT
-      (16#00EA7#, 16#00EA7#),  -- LAO LETTER WO .. LAO LETTER WO
-      (16#00EAA#, 16#00EAB#),  -- LAO LETTER SO SUNG .. LAO LETTER HO SUNG
-      (16#00EAD#, 16#00EB0#),  -- LAO LETTER O .. LAO VOWEL SIGN A
-      (16#00EB2#, 16#00EB3#),  -- LAO VOWEL SIGN AA .. LAO VOWEL SIGN AM
-      (16#00EBD#, 16#00EBD#),  -- LAO SEMIVOWEL SIGN NYO .. LAO SEMIVOWEL SIGN NYO
-      (16#00EC0#, 16#00EC4#),  -- LAO VOWEL SIGN E .. LAO VOWEL SIGN AI
-      (16#00EC6#, 16#00EC6#),  -- LAO KO LA .. LAO KO LA
-      (16#00EDC#, 16#00EDD#),  -- LAO HO NO .. LAO HO MO
-      (16#00F00#, 16#00F00#),  -- TIBETAN SYLLABLE OM .. TIBETAN SYLLABLE OM
-      (16#00F40#, 16#00F47#),  -- TIBETAN LETTER KA .. TIBETAN LETTER JA
-      (16#00F49#, 16#00F6A#),  -- TIBETAN LETTER NYA .. TIBETAN LETTER FIXED-FORM RA
-      (16#00F88#, 16#00F8B#),  -- TIBETAN SIGN LCE TSA CAN .. TIBETAN SIGN GRU MED RGYINGS
-      (16#01000#, 16#01021#),  -- MYANMAR LETTER KA .. MYANMAR LETTER A
-      (16#01023#, 16#01027#),  -- MYANMAR LETTER I .. MYANMAR LETTER E
-      (16#01029#, 16#0102A#),  -- MYANMAR LETTER O .. MYANMAR LETTER AU
-      (16#01050#, 16#01055#),  -- MYANMAR LETTER SHA .. MYANMAR LETTER VOCALIC LL
-      (16#010A0#, 16#010C5#),  -- GEORGIAN CAPITAL LETTER AN .. GEORGIAN CAPITAL LETTER HOE
-      (16#010D0#, 16#010F8#),  -- GEORGIAN LETTER AN .. GEORGIAN LETTER ELIFI
-      (16#01100#, 16#01159#),  -- HANGUL CHOSEONG KIYEOK .. HANGUL CHOSEONG YEORINHIEUH
-      (16#0115F#, 16#011A2#),  -- HANGUL CHOSEONG FILLER .. HANGUL JUNGSEONG SSANGARAEA
-      (16#011A8#, 16#011F9#),  -- HANGUL JONGSEONG KIYEOK .. HANGUL JONGSEONG YEORINHIEUH
-      (16#01200#, 16#01206#),  -- ETHIOPIC SYLLABLE HA .. ETHIOPIC SYLLABLE HO
-      (16#01208#, 16#01246#),  -- ETHIOPIC SYLLABLE LA .. ETHIOPIC SYLLABLE QO
-      (16#01248#, 16#01248#),  -- ETHIOPIC SYLLABLE QWA .. ETHIOPIC SYLLABLE QWA
-      (16#0124A#, 16#0124D#),  -- ETHIOPIC SYLLABLE QWI .. ETHIOPIC SYLLABLE QWE
-      (16#01250#, 16#01256#),  -- ETHIOPIC SYLLABLE QHA .. ETHIOPIC SYLLABLE QHO
-      (16#01258#, 16#01258#),  -- ETHIOPIC SYLLABLE QHWA .. ETHIOPIC SYLLABLE QHWA
-      (16#0125A#, 16#0125D#),  -- ETHIOPIC SYLLABLE QHWI .. ETHIOPIC SYLLABLE QHWE
-      (16#01260#, 16#01286#),  -- ETHIOPIC SYLLABLE BA .. ETHIOPIC SYLLABLE XO
-      (16#01288#, 16#01288#),  -- ETHIOPIC SYLLABLE XWA .. ETHIOPIC SYLLABLE XWA
-      (16#0128A#, 16#0128D#),  -- ETHIOPIC SYLLABLE XWI .. ETHIOPIC SYLLABLE XWE
-      (16#01290#, 16#012AE#),  -- ETHIOPIC SYLLABLE NA .. ETHIOPIC SYLLABLE KO
-      (16#012B0#, 16#012B0#),  -- ETHIOPIC SYLLABLE KWA .. ETHIOPIC SYLLABLE KWA
-      (16#012B2#, 16#012B5#),  -- ETHIOPIC SYLLABLE KWI .. ETHIOPIC SYLLABLE KWE
-      (16#012B8#, 16#012BE#),  -- ETHIOPIC SYLLABLE KXA .. ETHIOPIC SYLLABLE KXO
-      (16#012C0#, 16#012C0#),  -- ETHIOPIC SYLLABLE KXWA .. ETHIOPIC SYLLABLE KXWA
-      (16#012C2#, 16#012C5#),  -- ETHIOPIC SYLLABLE KXWI .. ETHIOPIC SYLLABLE KXWE
-      (16#012C8#, 16#012CE#),  -- ETHIOPIC SYLLABLE WA .. ETHIOPIC SYLLABLE WO
-      (16#012D0#, 16#012D6#),  -- ETHIOPIC SYLLABLE PHARYNGEAL A .. ETHIOPIC SYLLABLE PHARYNGEAL O
-      (16#012D8#, 16#012EE#),  -- ETHIOPIC SYLLABLE ZA .. ETHIOPIC SYLLABLE YO
-      (16#012F0#, 16#0130E#),  -- ETHIOPIC SYLLABLE DA .. ETHIOPIC SYLLABLE GO
-      (16#01310#, 16#01310#),  -- ETHIOPIC SYLLABLE GWA .. ETHIOPIC SYLLABLE GWA
-      (16#01312#, 16#01315#),  -- ETHIOPIC SYLLABLE GWI .. ETHIOPIC SYLLABLE GWE
-      (16#01318#, 16#0131E#),  -- ETHIOPIC SYLLABLE GGA .. ETHIOPIC SYLLABLE GGO
-      (16#01320#, 16#01346#),  -- ETHIOPIC SYLLABLE THA .. ETHIOPIC SYLLABLE TZO
-      (16#01348#, 16#0135A#),  -- ETHIOPIC SYLLABLE FA .. ETHIOPIC SYLLABLE FYA
-      (16#013A0#, 16#013F4#),  -- CHEROKEE LETTER A .. CHEROKEE LETTER YV
-      (16#01401#, 16#0166C#),  -- CANADIAN SYLLABICS E .. CANADIAN SYLLABICS CARRIER TTSA
-      (16#0166F#, 16#01676#),  -- CANADIAN SYLLABICS QAI .. CANADIAN SYLLABICS NNGAA
-      (16#01681#, 16#0169A#),  -- OGHAM LETTER BEITH .. OGHAM LETTER PEITH
-      (16#016A0#, 16#016EA#),  -- RUNIC LETTER FEHU FEOH FE F .. RUNIC LETTER X
-      (16#016EE#, 16#016F0#),  -- RUNIC ARLAUG SYMBOL .. RUNIC BELGTHOR SYMBOL
-      (16#01700#, 16#0170C#),  -- TAGALOG LETTER A .. TAGALOG LETTER YA
-      (16#0170E#, 16#01711#),  -- TAGALOG LETTER LA .. TAGALOG LETTER HA
-      (16#01720#, 16#01731#),  -- HANUNOO LETTER A .. HANUNOO LETTER HA
-      (16#01740#, 16#01751#),  -- BUHID LETTER A .. BUHID LETTER HA
-      (16#01760#, 16#0176C#),  -- TAGBANWA LETTER A .. TAGBANWA LETTER YA
-      (16#0176E#, 16#01770#),  -- TAGBANWA LETTER LA .. TAGBANWA LETTER SA
-      (16#01780#, 16#017B3#),  -- KHMER LETTER KA .. KHMER INDEPENDENT VOWEL QAU
-      (16#017D7#, 16#017D7#),  -- KHMER SIGN LEK TOO .. KHMER SIGN LEK TOO
-      (16#017DC#, 16#017DC#),  -- KHMER SIGN AVAKRAHASANYA .. KHMER SIGN AVAKRAHASANYA
-      (16#01820#, 16#01877#),  -- MONGOLIAN LETTER A .. MONGOLIAN LETTER MANCHU ZHA
-      (16#01880#, 16#018A8#),  -- MONGOLIAN LETTER ALI GALI ANUSVARA ONE .. MONGOLIAN LETTER MANCHU ALI GALI BHA
-      (16#01900#, 16#0191C#),  -- LIMBU VOWEL-CARRIER LETTER .. LIMBU LETTER HA
-      (16#01950#, 16#0196D#),  -- TAI LE LETTER KA .. TAI LE LETTER AI
-      (16#01970#, 16#01974#),  -- TAI LE LETTER TONE-2 .. TAI LE LETTER TONE-6
-      (16#01D00#, 16#01D6B#),  -- LATIN LETTER SMALL CAPITAL A .. LATIN SMALL LETTER UE
-      (16#01E00#, 16#01E9B#),  -- LATIN CAPITAL LETTER A WITH RING BELOW .. LATIN SMALL LETTER LONG S WITH DOT ABOVE
-      (16#01EA0#, 16#01EF9#),  -- LATIN CAPITAL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER Y WITH TILDE
-      (16#01F00#, 16#01F15#),  -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA
-      (16#01F18#, 16#01F1D#),  -- GREEK CAPITAL LETTER EPSILON WITH PSILI .. GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA
-      (16#01F20#, 16#01F45#),  -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA
-      (16#01F48#, 16#01F4D#),  -- GREEK CAPITAL LETTER OMICRON WITH PSILI .. GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA
-      (16#01F50#, 16#01F57#),  -- GREEK SMALL LETTER UPSILON WITH PSILI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI
-      (16#01F59#, 16#01F59#),  -- GREEK CAPITAL LETTER UPSILON WITH DASIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA
-      (16#01F5B#, 16#01F5B#),  -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA
-      (16#01F5D#, 16#01F5D#),  -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA .. GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA
-      (16#01F5F#, 16#01F7D#),  -- GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER OMEGA WITH OXIA
-      (16#01F80#, 16#01FB4#),  -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
-      (16#01FB6#, 16#01FBC#),  -- GREEK SMALL LETTER ALPHA WITH PERISPOMENI .. GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
-      (16#01FBE#, 16#01FBE#),  -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI
-      (16#01FC2#, 16#01FC4#),  -- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
-      (16#01FC6#, 16#01FCC#),  -- GREEK SMALL LETTER ETA WITH PERISPOMENI .. GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
-      (16#01FD0#, 16#01FD3#),  -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
-      (16#01FD6#, 16#01FDB#),  -- GREEK SMALL LETTER IOTA WITH PERISPOMENI .. GREEK CAPITAL LETTER IOTA WITH OXIA
-      (16#01FE0#, 16#01FEC#),  -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK CAPITAL LETTER RHO WITH DASIA
-      (16#01FF2#, 16#01FF4#),  -- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
-      (16#01FF6#, 16#01FFC#),  -- GREEK SMALL LETTER OMEGA WITH PERISPOMENI .. GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
-      (16#02071#, 16#02071#),  -- SUPERSCRIPT LATIN SMALL LETTER I .. SUPERSCRIPT LATIN SMALL LETTER I
-      (16#0207F#, 16#0207F#),  -- SUPERSCRIPT LATIN SMALL LETTER N .. SUPERSCRIPT LATIN SMALL LETTER N
-      (16#02102#, 16#02102#),  -- DOUBLE-STRUCK CAPITAL C .. DOUBLE-STRUCK CAPITAL C
-      (16#02107#, 16#02107#),  -- EULER CONSTANT .. EULER CONSTANT
-      (16#0210A#, 16#02113#),  -- SCRIPT SMALL G .. SCRIPT SMALL L
-      (16#02115#, 16#02115#),  -- DOUBLE-STRUCK CAPITAL N .. DOUBLE-STRUCK CAPITAL N
-      (16#02119#, 16#0211D#),  -- DOUBLE-STRUCK CAPITAL P .. DOUBLE-STRUCK CAPITAL R
-      (16#02124#, 16#02124#),  -- DOUBLE-STRUCK CAPITAL Z .. DOUBLE-STRUCK CAPITAL Z
-      (16#02126#, 16#02126#),  -- OHM SIGN .. OHM SIGN
-      (16#02128#, 16#02128#),  -- BLACK-LETTER CAPITAL Z .. BLACK-LETTER CAPITAL Z
-      (16#0212A#, 16#0212D#),  -- KELVIN SIGN .. BLACK-LETTER CAPITAL C
-      (16#0212F#, 16#02131#),  -- SCRIPT SMALL E .. SCRIPT CAPITAL F
-      (16#02133#, 16#02139#),  -- SCRIPT CAPITAL M .. INFORMATION SOURCE
-      (16#0213D#, 16#0213F#),  -- DOUBLE-STRUCK SMALL GAMMA .. DOUBLE-STRUCK CAPITAL PI
-      (16#02145#, 16#02149#),  -- DOUBLE-STRUCK ITALIC CAPITAL D .. DOUBLE-STRUCK ITALIC SMALL J
-      (16#02160#, 16#02183#),  -- ROMAN NUMERAL ONE .. ROMAN NUMERAL REVERSED ONE HUNDRED
-      (16#03005#, 16#03007#),  -- IDEOGRAPHIC ITERATION MARK .. IDEOGRAPHIC NUMBER ZERO
-      (16#03021#, 16#03029#),  -- HANGZHOU NUMERAL ONE .. HANGZHOU NUMERAL NINE
-      (16#03031#, 16#03035#),  -- VERTICAL KANA REPEAT MARK .. VERTICAL KANA REPEAT MARK LOWER HALF
-      (16#03038#, 16#0303C#),  -- HANGZHOU NUMERAL TEN .. MASU MARK
-      (16#03041#, 16#03096#),  -- HIRAGANA LETTER SMALL A .. HIRAGANA LETTER SMALL KE
-      (16#0309D#, 16#0309F#),  -- HIRAGANA ITERATION MARK .. HIRAGANA DIGRAPH YORI
-      (16#030A1#, 16#030FA#),  -- KATAKANA LETTER SMALL A .. KATAKANA LETTER VO
-      (16#030FC#, 16#030FF#),  -- KATAKANA-HIRAGANA PROLONGED SOUND MARK .. KATAKANA DIGRAPH KOTO
-      (16#03105#, 16#0312C#),  -- BOPOMOFO LETTER B .. BOPOMOFO LETTER GN
-      (16#03131#, 16#0318E#),  -- HANGUL LETTER KIYEOK .. HANGUL LETTER ARAEAE
-      (16#031A0#, 16#031B7#),  -- BOPOMOFO LETTER BU .. BOPOMOFO FINAL LETTER H
-      (16#031F0#, 16#031FF#),  -- KATAKANA LETTER SMALL KU .. KATAKANA LETTER SMALL RO
-      (16#03400#, 16#04DB5#),  -- <CJK Ideograph Extension A, First> .. <CJK Ideograph Extension A, Last>
-      (16#04E00#, 16#09FA5#),  -- <CJK Ideograph, First> .. <CJK Ideograph, Last>
-      (16#0A000#, 16#0A48C#),  -- YI SYLLABLE IT .. YI SYLLABLE YYR
-      (16#0AC00#, 16#0D7A3#),  -- <Hangul Syllable, First> .. <Hangul Syllable, Last>
-      (16#0F900#, 16#0FA2D#),  -- CJK COMPATIBILITY IDEOGRAPH-F900 .. CJK COMPATIBILITY IDEOGRAPH-FA2D
-      (16#0FA30#, 16#0FA6A#),  -- CJK COMPATIBILITY IDEOGRAPH-FA30 .. CJK COMPATIBILITY IDEOGRAPH-FA6A
-      (16#0FB00#, 16#0FB06#),  -- LATIN SMALL LIGATURE FF .. LATIN SMALL LIGATURE ST
-      (16#0FB13#, 16#0FB17#),  -- ARMENIAN SMALL LIGATURE MEN NOW .. ARMENIAN SMALL LIGATURE MEN XEH
-      (16#0FB1D#, 16#0FB1D#),  -- HEBREW LETTER YOD WITH HIRIQ .. HEBREW LETTER YOD WITH HIRIQ
-      (16#0FB1F#, 16#0FB28#),  -- HEBREW LIGATURE YIDDISH YOD YOD PATAH .. HEBREW LETTER WIDE TAV
-      (16#0FB2A#, 16#0FB36#),  -- HEBREW LETTER SHIN WITH SHIN DOT .. HEBREW LETTER ZAYIN WITH DAGESH
-      (16#0FB38#, 16#0FB3C#),  -- HEBREW LETTER TET WITH DAGESH .. HEBREW LETTER LAMED WITH DAGESH
-      (16#0FB3E#, 16#0FB3E#),  -- HEBREW LETTER MEM WITH DAGESH .. HEBREW LETTER MEM WITH DAGESH
-      (16#0FB40#, 16#0FB41#),  -- HEBREW LETTER NUN WITH DAGESH .. HEBREW LETTER SAMEKH WITH DAGESH
-      (16#0FB43#, 16#0FB44#),  -- HEBREW LETTER FINAL PE WITH DAGESH .. HEBREW LETTER PE WITH DAGESH
-      (16#0FB46#, 16#0FBB1#),  -- HEBREW LETTER TSADI WITH DAGESH .. ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM
-      (16#0FBD3#, 16#0FD3D#),  -- ARABIC LETTER NG ISOLATED FORM .. ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM
-      (16#0FD50#, 16#0FD8F#),  -- ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM .. ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM
-      (16#0FD92#, 16#0FDC7#),  -- ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM .. ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM
-      (16#0FDF0#, 16#0FDFB#),  -- ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM .. ARABIC LIGATURE JALLAJALALOUHOU
-      (16#0FE70#, 16#0FE74#),  -- ARABIC FATHATAN ISOLATED FORM .. ARABIC KASRATAN ISOLATED FORM
-      (16#0FE76#, 16#0FEFC#),  -- ARABIC FATHA ISOLATED FORM .. ARABIC LIGATURE LAM WITH ALEF FINAL FORM
-      (16#0FF21#, 16#0FF3A#),  -- FULLWIDTH LATIN CAPITAL LETTER A .. FULLWIDTH LATIN CAPITAL LETTER Z
-      (16#0FF41#, 16#0FF5A#),  -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
-      (16#0FF66#, 16#0FFBE#),  -- HALFWIDTH KATAKANA LETTER WO .. HALFWIDTH HANGUL LETTER HIEUH
-      (16#0FFC2#, 16#0FFC7#),  -- HALFWIDTH HANGUL LETTER A .. HALFWIDTH HANGUL LETTER E
-      (16#0FFCA#, 16#0FFCF#),  -- HALFWIDTH HANGUL LETTER YEO .. HALFWIDTH HANGUL LETTER OE
-      (16#0FFD2#, 16#0FFD7#),  -- HALFWIDTH HANGUL LETTER YO .. HALFWIDTH HANGUL LETTER YU
-      (16#0FFDA#, 16#0FFDC#),  -- HALFWIDTH HANGUL LETTER EU .. HALFWIDTH HANGUL LETTER I
-      (16#10000#, 16#1000B#),  -- LINEAR B SYLLABLE B008 A .. LINEAR B SYLLABLE B046 JE
-      (16#1000D#, 16#10026#),  -- LINEAR B SYLLABLE B036 JO .. LINEAR B SYLLABLE B032 QO
-      (16#10028#, 16#1003A#),  -- LINEAR B SYLLABLE B060 RA .. LINEAR B SYLLABLE B042 WO
-      (16#1003C#, 16#1003D#),  -- LINEAR B SYLLABLE B017 ZA .. LINEAR B SYLLABLE B074 ZE
-      (16#1003F#, 16#1004D#),  -- LINEAR B SYLLABLE B020 ZO .. LINEAR B SYLLABLE B091 TWO
-      (16#10050#, 16#1005D#),  -- LINEAR B SYMBOL B018 .. LINEAR B SYMBOL B089
-      (16#10080#, 16#100FA#),  -- LINEAR B IDEOGRAM B100 MAN .. LINEAR B IDEOGRAM VESSEL B305
-      (16#10300#, 16#1031E#),  -- OLD ITALIC LETTER A .. OLD ITALIC LETTER UU
-      (16#10330#, 16#1034A#),  -- GOTHIC LETTER AHSA .. GOTHIC LETTER NINE HUNDRED
-      (16#10380#, 16#1039D#),  -- UGARITIC LETTER ALPA .. UGARITIC LETTER SSU
-      (16#10400#, 16#1049D#),  -- DESERET CAPITAL LETTER LONG I .. OSMANYA LETTER OO
-      (16#10800#, 16#10805#),  -- CYPRIOT SYLLABLE A .. CYPRIOT SYLLABLE JA
-      (16#10808#, 16#10808#),  -- CYPRIOT SYLLABLE JO .. CYPRIOT SYLLABLE JO
-      (16#1080A#, 16#10835#),  -- CYPRIOT SYLLABLE KA .. CYPRIOT SYLLABLE WO
-      (16#10837#, 16#10838#),  -- CYPRIOT SYLLABLE XA .. CYPRIOT SYLLABLE XE
-      (16#1083C#, 16#1083C#),  -- CYPRIOT SYLLABLE ZA .. CYPRIOT SYLLABLE ZA
-      (16#1083F#, 16#1083F#),  -- CYPRIOT SYLLABLE ZO .. CYPRIOT SYLLABLE ZO
-      (16#1D400#, 16#1D454#),  -- MATHEMATICAL BOLD CAPITAL A .. MATHEMATICAL ITALIC SMALL G
-      (16#1D456#, 16#1D49C#),  -- MATHEMATICAL ITALIC SMALL I .. MATHEMATICAL SCRIPT CAPITAL A
-      (16#1D49E#, 16#1D49F#),  -- MATHEMATICAL SCRIPT CAPITAL C .. MATHEMATICAL SCRIPT CAPITAL D
-      (16#1D4A2#, 16#1D4A2#),  -- MATHEMATICAL SCRIPT CAPITAL G .. MATHEMATICAL SCRIPT CAPITAL G
-      (16#1D4A5#, 16#1D4A6#),  -- MATHEMATICAL SCRIPT CAPITAL J .. MATHEMATICAL SCRIPT CAPITAL K
-      (16#1D4A9#, 16#1D4AC#),  -- MATHEMATICAL SCRIPT CAPITAL N .. MATHEMATICAL SCRIPT CAPITAL Q
-      (16#1D4AE#, 16#1D4B9#),  -- MATHEMATICAL SCRIPT CAPITAL S .. MATHEMATICAL SCRIPT SMALL D
-      (16#1D4BB#, 16#1D4BB#),  -- MATHEMATICAL SCRIPT SMALL F .. MATHEMATICAL SCRIPT SMALL F
-      (16#1D4BD#, 16#1D4C3#),  -- MATHEMATICAL SCRIPT SMALL H .. MATHEMATICAL SCRIPT SMALL N
-      (16#1D4C5#, 16#1D505#),  -- MATHEMATICAL SCRIPT SMALL P .. MATHEMATICAL FRAKTUR CAPITAL B
-      (16#1D507#, 16#1D50A#),  -- MATHEMATICAL FRAKTUR CAPITAL D .. MATHEMATICAL FRAKTUR CAPITAL G
-      (16#1D50D#, 16#1D514#),  -- MATHEMATICAL FRAKTUR CAPITAL J .. MATHEMATICAL FRAKTUR CAPITAL Q
-      (16#1D516#, 16#1D51C#),  -- MATHEMATICAL FRAKTUR CAPITAL S .. MATHEMATICAL FRAKTUR CAPITAL Y
-      (16#1D51E#, 16#1D539#),  -- MATHEMATICAL FRAKTUR SMALL A .. MATHEMATICAL DOUBLE-STRUCK CAPITAL B
-      (16#1D53B#, 16#1D53E#),  -- MATHEMATICAL DOUBLE-STRUCK CAPITAL D .. MATHEMATICAL DOUBLE-STRUCK CAPITAL G
-      (16#1D540#, 16#1D544#),  -- MATHEMATICAL DOUBLE-STRUCK CAPITAL I .. MATHEMATICAL DOUBLE-STRUCK CAPITAL M
-      (16#1D546#, 16#1D546#),  -- MATHEMATICAL DOUBLE-STRUCK CAPITAL O .. MATHEMATICAL DOUBLE-STRUCK CAPITAL O
-      (16#1D54A#, 16#1D550#),  -- MATHEMATICAL DOUBLE-STRUCK CAPITAL S .. MATHEMATICAL DOUBLE-STRUCK CAPITAL Y
-      (16#1D552#, 16#1D6A3#),  -- MATHEMATICAL DOUBLE-STRUCK SMALL A .. MATHEMATICAL MONOSPACE SMALL Z
-      (16#1D6A8#, 16#1D6C0#),  -- MATHEMATICAL BOLD CAPITAL ALPHA .. MATHEMATICAL BOLD CAPITAL OMEGA
-      (16#1D6C2#, 16#1D6DA#),  -- MATHEMATICAL BOLD SMALL ALPHA .. MATHEMATICAL BOLD SMALL OMEGA
-      (16#1D6DC#, 16#1D6FA#),  -- MATHEMATICAL BOLD EPSILON SYMBOL .. MATHEMATICAL ITALIC CAPITAL OMEGA
-      (16#1D6FC#, 16#1D714#),  -- MATHEMATICAL ITALIC SMALL ALPHA .. MATHEMATICAL ITALIC SMALL OMEGA
-      (16#1D716#, 16#1D734#),  -- MATHEMATICAL ITALIC EPSILON SYMBOL .. MATHEMATICAL BOLD ITALIC CAPITAL OMEGA
-      (16#1D736#, 16#1D74E#),  -- MATHEMATICAL BOLD ITALIC SMALL ALPHA .. MATHEMATICAL BOLD ITALIC SMALL OMEGA
-      (16#1D750#, 16#1D76E#),  -- MATHEMATICAL BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA
-      (16#1D770#, 16#1D788#),  -- MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA
-      (16#1D78A#, 16#1D7A8#),  -- MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA
-      (16#1D7AA#, 16#1D7C2#),  -- MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA .. MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA
-      (16#1D7C4#, 16#1D7C9#),  -- MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL .. MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL
-      (16#20000#, 16#2A6D6#),  -- <CJK Ideograph Extension B, First> .. <CJK Ideograph Extension B, Last>
-      (16#2F800#, 16#2FA1D#)); -- CJK COMPATIBILITY IDEOGRAPH-2F800 .. CJK COMPATIBILITY IDEOGRAPH-2FA1D
- 
-    --  The following table includes all characters considered spaces, i.e.
-    --  all characters from the Unicode table with categories:
- 
-    --    Separator, Space (Zs)
- 
-    UTF_32_Spaces : constant UTF_32_Ranges := (
-      (16#00020#, 16#00020#),  -- SPACE .. SPACE
-      (16#000A0#, 16#000A0#),  -- NO-BREAK SPACE .. NO-BREAK SPACE
-      (16#01680#, 16#01680#),  -- OGHAM SPACE MARK .. OGHAM SPACE MARK
-      (16#0180E#, 16#0180E#),  -- MONGOLIAN VOWEL SEPARATOR .. MONGOLIAN VOWEL SEPARATOR
-      (16#02000#, 16#0200B#),  -- EN QUAD .. ZERO WIDTH SPACE
-      (16#0202F#, 16#0202F#),  -- NARROW NO-BREAK SPACE .. NARROW NO-BREAK SPACE
-      (16#0205F#, 16#0205F#),  -- MEDIUM MATHEMATICAL SPACE .. MEDIUM MATHEMATICAL SPACE
-      (16#03000#, 16#03000#)); -- IDEOGRAPHIC SPACE .. IDEOGRAPHIC SPACE
- 
-    --  The following table includes all characters considered punctuation,
-    --  i.e. all characters from the Unicode table with categories:
- 
-    --    Punctuation, Connector (Pc)
- 
-    UTF_32_Punctuation : constant UTF_32_Ranges := (
-      (16#0005F#, 16#0005F#),  -- LOW LINE .. LOW LINE
-      (16#0203F#, 16#02040#),  -- UNDERTIE .. CHARACTER TIE
-      (16#02054#, 16#02054#),  -- INVERTED UNDERTIE .. INVERTED UNDERTIE
-      (16#030FB#, 16#030FB#),  -- KATAKANA MIDDLE DOT .. KATAKANA MIDDLE DOT
-      (16#0FE33#, 16#0FE34#),  -- PRESENTATION FORM FOR VERTICAL LOW LINE .. PRESENTATION FORM FOR VERTICAL WAVY LOW LINE
-      (16#0FE4D#, 16#0FE4F#),  -- DASHED LOW LINE .. WAVY LOW LINE
-      (16#0FF3F#, 16#0FF3F#),  -- FULLWIDTH LOW LINE .. FULLWIDTH LOW LINE
-      (16#0FF65#, 16#0FF65#)); -- HALFWIDTH KATAKANA MIDDLE DOT .. HALFWIDTH KATAKANA MIDDLE DOT
- 
-    --  The following table includes all characters considered as other format,
-    --  i.e. all characters from the Unicode table with categories:
- 
-    --    Other, Format (Cf)
- 
-    UTF_32_Other_Format : constant UTF_32_Ranges := (
-      (16#000AD#, 16#000AD#),  -- SOFT HYPHEN .. SOFT HYPHEN
-      (16#00600#, 16#00603#),  -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA
-      (16#006DD#, 16#006DD#),  -- ARABIC END OF AYAH .. ARABIC END OF AYAH
- 
-                                                     (16#0070F#, 16#0070F#),  -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK
-      (16#017B4#, 16#017B5#),  -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA
-      (16#0200C#, 16#0200F#),  -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK
-      (16#0202A#, 16#0202E#),  -- LEFT-TO-RIGHT EMBEDDING .. RIGHT-TO-LEFT OVERRIDE
-      (16#02060#, 16#02063#),  -- WORD JOINER .. INVISIBLE SEPARATOR
-      (16#0206A#, 16#0206F#),  -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES
-      (16#0FEFF#, 16#0FEFF#),  -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE
-      (16#0FFF9#, 16#0FFFB#),  -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR
-      (16#1D173#, 16#1D17A#),  -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE
-      (16#E0001#, 16#E0001#),  -- LANGUAGE TAG .. LANGUAGE TAG
-      (16#E0020#, 16#E007F#)); -- TAG SPACE .. CANCEL TAG
- 
-    --  The following table includes all characters considered marks i.e.
-    --  all characters from the Unicode table with categories:
- 
-    --    Mark, Nonspacing (Mn)
-    --    Mark, Spacing Combining (Mc)
- 
-    UTF_32_Marks : constant UTF_32_Ranges := (
-      (16#00300#, 16#00357#),  -- COMBINING GRAVE ACCENT .. COMBINING RIGHT HALF RING ABOVE
-      (16#0035D#, 16#0036F#),  -- COMBINING DOUBLE BREVE .. COMBINING LATIN SMALL LETTER X
-      (16#00483#, 16#00486#),  -- COMBINING CYRILLIC TITLO .. COMBINING CYRILLIC PSILI PNEUMATA
-      (16#00591#, 16#005A1#),  -- HEBREW ACCENT ETNAHTA .. HEBREW ACCENT PAZER
-      (16#005A3#, 16#005B9#),  -- HEBREW ACCENT MUNAH .. HEBREW POINT HOLAM
-      (16#005BB#, 16#005BD#),  -- HEBREW POINT QUBUTS .. HEBREW POINT METEG
-      (16#005BF#, 16#005BF#),  -- HEBREW POINT RAFE .. HEBREW POINT RAFE
-      (16#005C1#, 16#005C2#),  -- HEBREW POINT SHIN DOT .. HEBREW POINT SIN DOT
-      (16#005C4#, 16#005C4#),  -- HEBREW MARK UPPER DOT .. HEBREW MARK UPPER DOT
-      (16#00610#, 16#00615#),  -- ARABIC SIGN SALLALLAHOU ALAYHE WASSALLAM .. ARABIC SMALL HIGH TAH
-      (16#0064B#, 16#00658#),  -- ARABIC FATHATAN .. ARABIC MARK NOON GHUNNA
-      (16#00670#, 16#00670#),  -- ARABIC LETTER SUPERSCRIPT ALEF .. ARABIC LETTER SUPERSCRIPT ALEF
-      (16#006D6#, 16#006DC#),  -- ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA .. ARABIC SMALL HIGH SEEN
-      (16#006DF#, 16#006E4#),  -- ARABIC SMALL HIGH ROUNDED ZERO .. ARABIC SMALL HIGH MADDA
-      (16#006E7#, 16#006E8#),  -- ARABIC SMALL HIGH YEH .. ARABIC SMALL HIGH NOON
-      (16#006EA#, 16#006ED#),  -- ARABIC EMPTY CENTRE LOW STOP .. ARABIC SMALL LOW MEEM
-      (16#00711#, 16#00711#),  -- SYRIAC LETTER SUPERSCRIPT ALAPH .. SYRIAC LETTER SUPERSCRIPT ALAPH
-      (16#00730#, 16#0074A#),  -- SYRIAC PTHAHA ABOVE .. SYRIAC BARREKH
-      (16#007A6#, 16#007B0#),  -- THAANA ABAFILI .. THAANA SUKUN
-      (16#00901#, 16#00903#),  -- DEVANAGARI SIGN CANDRABINDU .. DEVANAGARI SIGN VISARGA
-      (16#0093C#, 16#0093C#),  -- DEVANAGARI SIGN NUKTA .. DEVANAGARI SIGN NUKTA
-      (16#0093E#, 16#0094D#),  -- DEVANAGARI VOWEL SIGN AA .. DEVANAGARI SIGN VIRAMA
-      (16#00951#, 16#00954#),  -- DEVANAGARI STRESS SIGN UDATTA .. DEVANAGARI ACUTE ACCENT
-      (16#00962#, 16#00963#),  -- DEVANAGARI VOWEL SIGN VOCALIC L .. DEVANAGARI VOWEL SIGN VOCALIC LL
-      (16#00981#, 16#00983#),  -- BENGALI SIGN CANDRABINDU .. BENGALI SIGN VISARGA
-      (16#009BC#, 16#009BC#),  -- BENGALI SIGN NUKTA .. BENGALI SIGN NUKTA
-      (16#009BE#, 16#009C4#),  -- BENGALI VOWEL SIGN AA .. BENGALI VOWEL SIGN VOCALIC RR
-      (16#009C7#, 16#009C8#),  -- BENGALI VOWEL SIGN E .. BENGALI VOWEL SIGN AI
-      (16#009CB#, 16#009CD#),  -- BENGALI VOWEL SIGN O .. BENGALI SIGN VIRAMA
-      (16#009D7#, 16#009D7#),  -- BENGALI AU LENGTH MARK .. BENGALI AU LENGTH MARK
-      (16#009E2#, 16#009E3#),  -- BENGALI VOWEL SIGN VOCALIC L .. BENGALI VOWEL SIGN VOCALIC LL
-      (16#00A01#, 16#00A03#),  -- GURMUKHI SIGN ADAK BINDI .. GURMUKHI SIGN VISARGA
-      (16#00A3C#, 16#00A3C#),  -- GURMUKHI SIGN NUKTA .. GURMUKHI SIGN NUKTA
-      (16#00A3E#, 16#00A42#),  -- GURMUKHI VOWEL SIGN AA .. GURMUKHI VOWEL SIGN UU
-      (16#00A47#, 16#00A48#),  -- GURMUKHI VOWEL SIGN EE .. GURMUKHI VOWEL SIGN AI
-      (16#00A4B#, 16#00A4D#),  -- GURMUKHI VOWEL SIGN OO .. GURMUKHI SIGN VIRAMA
-      (16#00A70#, 16#00A71#),  -- GURMUKHI TIPPI .. GURMUKHI ADDAK
-      (16#00A81#, 16#00A83#),  -- GUJARATI SIGN CANDRABINDU .. GUJARATI SIGN VISARGA
-      (16#00ABC#, 16#00ABC#),  -- GUJARATI SIGN NUKTA .. GUJARATI SIGN NUKTA
-      (16#00ABE#, 16#00AC5#),  -- GUJARATI VOWEL SIGN AA .. GUJARATI VOWEL SIGN CANDRA E
-      (16#00AC7#, 16#00AC9#),  -- GUJARATI VOWEL SIGN E .. GUJARATI VOWEL SIGN CANDRA O
-      (16#00ACB#, 16#00ACD#),  -- GUJARATI VOWEL SIGN O .. GUJARATI SIGN VIRAMA
-      (16#00AE2#, 16#00AE3#),  -- GUJARATI VOWEL SIGN VOCALIC L .. GUJARATI VOWEL SIGN VOCALIC LL
-      (16#00B01#, 16#00B03#),  -- ORIYA SIGN CANDRABINDU .. ORIYA SIGN VISARGA
-      (16#00B3C#, 16#00B3C#),  -- ORIYA SIGN NUKTA .. ORIYA SIGN NUKTA
-      (16#00B3E#, 16#00B43#),  -- ORIYA VOWEL SIGN AA .. ORIYA VOWEL SIGN VOCALIC R
-      (16#00B47#, 16#00B48#),  -- ORIYA VOWEL SIGN E .. ORIYA VOWEL SIGN AI
-      (16#00B4B#, 16#00B4D#),  -- ORIYA VOWEL SIGN O .. ORIYA SIGN VIRAMA
-      (16#00B56#, 16#00B57#),  -- ORIYA AI LENGTH MARK .. ORIYA AU LENGTH MARK
-      (16#00B82#, 16#00B82#),  -- TAMIL SIGN ANUSVARA .. TAMIL SIGN ANUSVARA
-      (16#00BBE#, 16#00BC2#),  -- TAMIL VOWEL SIGN AA .. TAMIL VOWEL SIGN UU
-      (16#00BC6#, 16#00BC8#),  -- TAMIL VOWEL SIGN E .. TAMIL VOWEL SIGN AI
-      (16#00BCA#, 16#00BCD#),  -- TAMIL VOWEL SIGN O .. TAMIL SIGN VIRAMA
-      (16#00BD7#, 16#00BD7#),  -- TAMIL AU LENGTH MARK .. TAMIL AU LENGTH MARK
-      (16#00C01#, 16#00C03#),  -- TELUGU SIGN CANDRABINDU .. TELUGU SIGN VISARGA
-      (16#00C3E#, 16#00C44#),  -- TELUGU VOWEL SIGN AA .. TELUGU VOWEL SIGN VOCALIC RR
-      (16#00C46#, 16#00C48#),  -- TELUGU VOWEL SIGN E .. TELUGU VOWEL SIGN AI
-      (16#00C4A#, 16#00C4D#),  -- TELUGU VOWEL SIGN O .. TELUGU SIGN VIRAMA
-      (16#00C55#, 16#00C56#),  -- TELUGU LENGTH MARK .. TELUGU AI LENGTH MARK
-      (16#00C82#, 16#00C83#),  -- KANNADA SIGN ANUSVARA .. KANNADA SIGN VISARGA
-      (16#00CBC#, 16#00CBC#),  -- KANNADA SIGN NUKTA .. KANNADA SIGN NUKTA
-      (16#00CBE#, 16#00CC4#),  -- KANNADA VOWEL SIGN AA .. KANNADA VOWEL SIGN VOCALIC RR
-      (16#00CC6#, 16#00CC8#),  -- KANNADA VOWEL SIGN E .. KANNADA VOWEL SIGN AI
-      (16#00CCA#, 16#00CCD#),  -- KANNADA VOWEL SIGN O .. KANNADA SIGN VIRAMA
-      (16#00CD5#, 16#00CD6#),  -- KANNADA LENGTH MARK .. KANNADA AI LENGTH MARK
-      (16#00D02#, 16#00D03#),  -- MALAYALAM SIGN ANUSVARA .. MALAYALAM SIGN VISARGA
-      (16#00D3E#, 16#00D43#),  -- MALAYALAM VOWEL SIGN AA .. MALAYALAM VOWEL SIGN VOCALIC R
-      (16#00D46#, 16#00D48#),  -- MALAYALAM VOWEL SIGN E .. MALAYALAM VOWEL SIGN AI
-      (16#00D4A#, 16#00D4D#),  -- MALAYALAM VOWEL SIGN O .. MALAYALAM SIGN VIRAMA
-      (16#00D57#, 16#00D57#),  -- MALAYALAM AU LENGTH MARK .. MALAYALAM AU LENGTH MARK
-      (16#00D82#, 16#00D83#),  -- SINHALA SIGN ANUSVARAYA .. SINHALA SIGN VISARGAYA
-      (16#00DCA#, 16#00DCA#),  -- SINHALA SIGN AL-LAKUNA .. SINHALA SIGN AL-LAKUNA
-      (16#00DCF#, 16#00DD4#),  -- SINHALA VOWEL SIGN AELA-PILLA .. SINHALA VOWEL SIGN KETTI PAA-PILLA
-      (16#00DD6#, 16#00DD6#),  -- SINHALA VOWEL SIGN DIGA PAA-PILLA .. SINHALA VOWEL SIGN DIGA PAA-PILLA
-      (16#00DD8#, 16#00DDF#),  -- SINHALA VOWEL SIGN GAETTA-PILLA .. SINHALA VOWEL SIGN GAYANUKITTA
-      (16#00DF2#, 16#00DF3#),  -- SINHALA VOWEL SIGN DIGA GAETTA-PILLA .. SINHALA VOWEL SIGN DIGA GAYANUKITTA
-      (16#00E31#, 16#00E31#),  -- THAI CHARACTER MAI HAN-AKAT .. THAI CHARACTER MAI HAN-AKAT
-      (16#00E34#, 16#00E3A#),  -- THAI CHARACTER SARA I .. THAI CHARACTER PHINTHU
-      (16#00E47#, 16#00E4E#),  -- THAI CHARACTER MAITAIKHU .. THAI CHARACTER YAMAKKAN
-      (16#00EB1#, 16#00EB1#),  -- LAO VOWEL SIGN MAI KAN .. LAO VOWEL SIGN MAI KAN
-      (16#00EB4#, 16#00EB9#),  -- LAO VOWEL SIGN I .. LAO VOWEL SIGN UU
-      (16#00EBB#, 16#00EBC#),  -- LAO VOWEL SIGN MAI KON .. LAO SEMIVOWEL SIGN LO
-      (16#00EC8#, 16#00ECD#),  -- LAO TONE MAI EK .. LAO NIGGAHITA
-      (16#00F18#, 16#00F19#),  -- TIBETAN ASTROLOGICAL SIGN -KHYUD PA .. TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS
-      (16#00F35#, 16#00F35#),  -- TIBETAN MARK NGAS BZUNG NYI ZLA .. TIBETAN MARK NGAS BZUNG NYI ZLA
-      (16#00F37#, 16#00F37#),  -- TIBETAN MARK NGAS BZUNG SGOR RTAGS .. TIBETAN MARK NGAS BZUNG SGOR RTAGS
-      (16#00F39#, 16#00F39#),  -- TIBETAN MARK TSA -PHRU .. TIBETAN MARK TSA -PHRU
-      (16#00F3E#, 16#00F3F#),  -- TIBETAN SIGN YAR TSHES .. TIBETAN SIGN MAR TSHES
-      (16#00F71#, 16#00F84#),  -- TIBETAN VOWEL SIGN AA .. TIBETAN MARK HALANTA
-      (16#00F86#, 16#00F87#),  -- TIBETAN SIGN LCI RTAGS .. TIBETAN SIGN YANG RTAGS
-      (16#00F90#, 16#00F97#),  -- TIBETAN SUBJOINED LETTER KA .. TIBETAN SUBJOINED LETTER JA
-      (16#00F99#, 16#00FBC#),  -- TIBETAN SUBJOINED LETTER NYA .. TIBETAN SUBJOINED LETTER FIXED-FORM RA
-      (16#00FC6#, 16#00FC6#),  -- TIBETAN SYMBOL PADMA GDAN .. TIBETAN SYMBOL PADMA GDAN
-      (16#0102C#, 16#01032#),  -- MYANMAR VOWEL SIGN AA .. MYANMAR VOWEL SIGN AI
-      (16#01036#, 16#01039#),  -- MYANMAR SIGN ANUSVARA .. MYANMAR SIGN VIRAMA
-      (16#01056#, 16#01059#),  -- MYANMAR VOWEL SIGN VOCALIC R .. MYANMAR VOWEL SIGN VOCALIC LL
-      (16#01712#, 16#01714#),  -- TAGALOG VOWEL SIGN I .. TAGALOG SIGN VIRAMA
-      (16#01732#, 16#01734#),  -- HANUNOO VOWEL SIGN I .. HANUNOO SIGN PAMUDPOD
-      (16#01752#, 16#01753#),  -- BUHID VOWEL SIGN I .. BUHID VOWEL SIGN U
-      (16#01772#, 16#01773#),  -- TAGBANWA VOWEL SIGN I .. TAGBANWA VOWEL SIGN U
-      (16#017B6#, 16#017D3#),  -- KHMER VOWEL SIGN AA .. KHMER SIGN BATHAMASAT
-      (16#017DD#, 16#017DD#),  -- KHMER SIGN ATTHACAN .. KHMER SIGN ATTHACAN
-      (16#0180B#, 16#0180D#),  -- MONGOLIAN FREE VARIATION SELECTOR ONE .. MONGOLIAN FREE VARIATION SELECTOR THREE
-      (16#018A9#, 16#018A9#),  -- MONGOLIAN LETTER ALI GALI DAGALGA .. MONGOLIAN LETTER ALI GALI DAGALGA
-      (16#01920#, 16#0192B#),  -- LIMBU VOWEL SIGN A .. LIMBU SUBJOINED LETTER WA
-      (16#01930#, 16#0193B#),  -- LIMBU SMALL LETTER KA .. LIMBU SIGN SA-I
-      (16#020D0#, 16#020DC#),  -- COMBINING LEFT HARPOON ABOVE .. COMBINING FOUR DOTS ABOVE
-      (16#020E1#, 16#020E1#),  -- COMBINING LEFT RIGHT ARROW ABOVE .. COMBINING LEFT RIGHT ARROW ABOVE
-      (16#020E5#, 16#020EA#),  -- COMBINING REVERSE SOLIDUS OVERLAY .. COMBINING LEFTWARDS ARROW OVERLAY
-      (16#0302A#, 16#0302F#),  -- IDEOGRAPHIC LEVEL TONE MARK .. HANGUL DOUBLE DOT TONE MARK
-      (16#03099#, 16#0309A#),  -- COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK .. COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK
-      (16#0FB1E#, 16#0FB1E#),  -- HEBREW POINT JUDEO-SPANISH VARIKA .. HEBREW POINT JUDEO-SPANISH VARIKA
-      (16#0FE00#, 16#0FE0F#),  -- VARIATION SELECTOR-1 .. VARIATION SELECTOR-16
-      (16#0FE20#, 16#0FE23#),  -- COMBINING LIGATURE LEFT HALF .. COMBINING DOUBLE TILDE RIGHT HALF
-      (16#1D165#, 16#1D169#),  -- MUSICAL SYMBOL COMBINING STEM .. MUSICAL SYMBOL COMBINING TREMOLO-3
-      (16#1D16D#, 16#1D172#),  -- MUSICAL SYMBOL COMBINING AUGMENTATION DOT .. MUSICAL SYMBOL COMBINING FLAG-5
-      (16#1D17B#, 16#1D182#),  -- MUSICAL SYMBOL COMBINING ACCENT .. MUSICAL SYMBOL COMBINING LOURE
-      (16#1D185#, 16#1D18B#),  -- MUSICAL SYMBOL COMBINING DOIT .. MUSICAL SYMBOL COMBINING TRIPLE TONGUE
-      (16#1D1AA#, 16#1D1AD#),  -- MUSICAL SYMBOL COMBINING DOWN BOW .. MUSICAL SYMBOL COMBINING SNAP PIZZICATO
-      (16#E0100#, 16#E01EF#)); -- VARIATION SELECTOR-17 .. VARIATION SELECTOR-256
- 
-    --  The following table includes all characters considered non-graphic,
-    --  i.e. all characters from the Unicode table with categories:
- 
-    --    Other, Control (Cc)
-    --    Other, Private Use (Co)
-    --    Other, Surrogate (Cs)
-    --    Other, Format (Cf)
-    --    Separator, Line (Zl)
-    --    Separator, Paragraph (Zp)
- 
-    --  In addition, the characters FFFE and FFFF are excluded. Note that the
-    --  defined Ada category of format effector is subsumed by the above set
-    --  of Unicode categories.
- 
-    UTF_32_Non_Graphic : constant UTF_32_Ranges := (
-      (16#00000#, 16#0001F#),  -- <control> .. <control>
-      (16#0007F#, 16#0009F#),  -- <control> .. <control>
-      (16#000AD#, 16#000AD#),  -- SOFT HYPHEN .. SOFT HYPHEN
-      (16#00600#, 16#00603#),  -- ARABIC NUMBER SIGN .. ARABIC SIGN SAFHA
-      (16#006DD#, 16#006DD#),  -- ARABIC END OF AYAH .. ARABIC END OF AYAH
-      (16#0070F#, 16#0070F#),  -- SYRIAC ABBREVIATION MARK .. SYRIAC ABBREVIATION MARK
-      (16#017B4#, 16#017B5#),  -- KHMER VOWEL INHERENT AQ .. KHMER VOWEL INHERENT AA
-      (16#0200C#, 16#0200F#),  -- ZERO WIDTH NON-JOINER .. RIGHT-TO-LEFT MARK
-      (16#02028#, 16#0202E#),  -- LINE SEPARATOR .. RIGHT-TO-LEFT OVERRIDE
-      (16#02060#, 16#02063#),  -- WORD JOINER .. INVISIBLE SEPARATOR
-      (16#0206A#, 16#0206F#),  -- INHIBIT SYMMETRIC SWAPPING .. NOMINAL DIGIT SHAPES
-      (16#0D800#, 16#0F8FF#),  -- <Non Private Use High Surrogate, First> .. <Private Use, Last>
-      (16#0FEFF#, 16#0FEFF#),  -- ZERO WIDTH NO-BREAK SPACE .. ZERO WIDTH NO-BREAK SPACE
-      (16#0FFF9#, 16#0FFFB#),  -- INTERLINEAR ANNOTATION ANCHOR .. INTERLINEAR ANNOTATION TERMINATOR
-      (16#0FFFE#, 16#0FFFF#),  -- excluded code positions
-      (16#1D173#, 16#1D17A#),  -- MUSICAL SYMBOL BEGIN BEAM .. MUSICAL SYMBOL END PHRASE
-      (16#E0001#, 16#E0001#),  -- LANGUAGE TAG .. LANGUAGE TAG
-      (16#E0020#, 16#E007F#),  -- TAG SPACE .. CANCEL TAG
-      (16#F0000#, 16#FFFFD#),  -- <Plane 15 Private Use, First> .. <Plane 15 Private Use, Last>
-      (16#100000#, 16#10FFFD#)); -- <Plane 16 Private Use, First> .. <Plane 16 Private Use, Last>
- 
-    --  The following two tables define the mapping to upper case. The first
-    --  table gives the ranges of lower case letters. The corresponding entry
-    --  in Uppercase_Adjust shows the amount to be added (or subtracted) from
-    --  the code value to get the corresponding upper case letter.
- 
-    --  Note that this folding is not reversible, for example lower case
-    --  dotless i folds to normal upper case I, and that cannot be reversed.
- 
-    Lower_Case_Letters : constant UTF_32_Ranges := (
-      (16#00061#, 16#0007A#),  -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
-      (16#000B5#, 16#000B5#),  -- MICRO SIGN .. MICRO SIGN
-      (16#000E0#, 16#000F6#),  -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS
-      (16#000F8#, 16#000FE#),  -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN
-      (16#000FF#, 16#000FF#),  -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS
-      (16#00101#, 16#00101#),  -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON
-      (16#00103#, 16#00103#),  -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE
-      (16#00105#, 16#00105#),  -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK
-      (16#00107#, 16#00107#),  -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE
-      (16#00109#, 16#00109#),  -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX
-      (16#0010B#, 16#0010B#),  -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE
-      (16#0010D#, 16#0010D#),  -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON
-      (16#0010F#, 16#0010F#),  -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON
-      (16#00111#, 16#00111#),  -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE
-      (16#00113#, 16#00113#),  -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON
-      (16#00115#, 16#00115#),  -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE
-      (16#00117#, 16#00117#),  -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE
-      (16#00119#, 16#00119#),  -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK
-      (16#0011B#, 16#0011B#),  -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON
-      (16#0011D#, 16#0011D#),  -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX
-      (16#0011F#, 16#0011F#),  -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE
-      (16#00121#, 16#00121#),  -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE
-      (16#00123#, 16#00123#),  -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA
-      (16#00125#, 16#00125#),  -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX
-      (16#00127#, 16#00127#),  -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE
-      (16#00129#, 16#00129#),  -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE
-      (16#0012B#, 16#0012B#),  -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON
-      (16#0012D#, 16#0012D#),  -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE
-      (16#0012F#, 16#0012F#),  -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK
-      (16#00131#, 16#00131#),  -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I
-      (16#00133#, 16#00133#),  -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ
-      (16#00135#, 16#00135#),  -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX
-      (16#00137#, 16#00137#),  -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA
-      (16#0013A#, 16#0013A#),  -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE
-      (16#0013C#, 16#0013C#),  -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA
-      (16#0013E#, 16#0013E#),  -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON
-      (16#00140#, 16#00140#),  -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT
-      (16#00142#, 16#00142#),  -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE
-      (16#00144#, 16#00144#),  -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE
-      (16#00146#, 16#00146#),  -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA
-      (16#00148#, 16#00148#),  -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON
-      (16#0014B#, 16#0014B#),  -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG
-      (16#0014D#, 16#0014D#),  -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON
-      (16#0014F#, 16#0014F#),  -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE
-      (16#00151#, 16#00151#),  -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE
-      (16#00153#, 16#00153#),  -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE
-      (16#00155#, 16#00155#),  -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE
-      (16#00157#, 16#00157#),  -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA
-      (16#00159#, 16#00159#),  -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON
-      (16#0015B#, 16#0015B#),  -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE
-      (16#0015D#, 16#0015D#),  -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX
-      (16#0015F#, 16#0015F#),  -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA
-      (16#00161#, 16#00161#),  -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON
-      (16#00163#, 16#00163#),  -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA
-      (16#00165#, 16#00165#),  -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON
-      (16#00167#, 16#00167#),  -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE
-      (16#00169#, 16#00169#),  -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE
-      (16#0016B#, 16#0016B#),  -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON
-      (16#0016D#, 16#0016D#),  -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE
-      (16#0016F#, 16#0016F#),  -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE
-      (16#00171#, 16#00171#),  -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE
-      (16#00173#, 16#00173#),  -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK
-      (16#00175#, 16#00175#),  -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX
-      (16#00177#, 16#00177#),  -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX
-      (16#0017A#, 16#0017A#),  -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE
-      (16#0017C#, 16#0017C#),  -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE
-      (16#0017E#, 16#0017E#),  -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON
-      (16#0017F#, 16#0017F#),  -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S
-      (16#00183#, 16#00183#),  -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR
-      (16#00185#, 16#00185#),  -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX
-      (16#00188#, 16#00188#),  -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK
-      (16#0018C#, 16#0018C#),  -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR
-      (16#00192#, 16#00192#),  -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK
-      (16#00195#, 16#00195#),  -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV
-      (16#00199#, 16#00199#),  -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK
-      (16#0019E#, 16#0019E#),  -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG
-      (16#001A1#, 16#001A1#),  -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN
-      (16#001A3#, 16#001A3#),  -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI
-      (16#001A5#, 16#001A5#),  -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK
-      (16#001A8#, 16#001A8#),  -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO
-      (16#001AD#, 16#001AD#),  -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK
-      (16#001B0#, 16#001B0#),  -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN
-      (16#001B4#, 16#001B4#),  -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK
-      (16#001B6#, 16#001B6#),  -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE
-      (16#001B9#, 16#001B9#),  -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED
-      (16#001BD#, 16#001BD#),  -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE
-      (16#001BF#, 16#001BF#),  -- LATIN LETTER WYNN .. LATIN LETTER WYNN
-      (16#001C5#, 16#001C5#),  -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
-      (16#001C6#, 16#001C6#),  -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON
-      (16#001C8#, 16#001C8#),  -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J
-      (16#001C9#, 16#001C9#),  -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ
-      (16#001CB#, 16#001CB#),  -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J
-      (16#001CC#, 16#001CC#),  -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ
-      (16#001CE#, 16#001CE#),  -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON
-      (16#001D0#, 16#001D0#),  -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON
-      (16#001D2#, 16#001D2#),  -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON
-      (16#001D4#, 16#001D4#),  -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON
-      (16#001D6#, 16#001D6#),  -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON
-      (16#001D8#, 16#001D8#),  -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE
-      (16#001DA#, 16#001DA#),  -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON
-      (16#001DC#, 16#001DC#),  -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE
-      (16#001DD#, 16#001DD#),  -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E
-      (16#001DF#, 16#001DF#),  -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON
-      (16#001E1#, 16#001E1#),  -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON
-      (16#001E3#, 16#001E3#),  -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON
-      (16#001E5#, 16#001E5#),  -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE
-      (16#001E7#, 16#001E7#),  -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON
-      (16#001E9#, 16#001E9#),  -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON
-      (16#001EB#, 16#001EB#),  -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK
-      (16#001ED#, 16#001ED#),  -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON
-      (16#001EF#, 16#001EF#),  -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON
-      (16#001F2#, 16#001F2#),  -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z
-      (16#001F3#, 16#001F3#),  -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ
-      (16#001F5#, 16#001F5#),  -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE
-      (16#001F9#, 16#001F9#),  -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE
-      (16#001FB#, 16#001FB#),  -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE
-      (16#001FD#, 16#001FD#),  -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE
-      (16#001FF#, 16#001FF#),  -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE
-      (16#00201#, 16#00201#),  -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE
-      (16#00203#, 16#00203#),  -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE
-      (16#00205#, 16#00205#),  -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE
-      (16#00207#, 16#00207#),  -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE
-      (16#00209#, 16#00209#),  -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE
-      (16#0020B#, 16#0020B#),  -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE
-      (16#0020D#, 16#0020D#),  -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE
-      (16#0020F#, 16#0020F#),  -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE
-      (16#00211#, 16#00211#),  -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE
-      (16#00213#, 16#00213#),  -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE
-      (16#00215#, 16#00215#),  -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE
-      (16#00217#, 16#00217#),  -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE
-      (16#00219#, 16#00219#),  -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW
-      (16#0021B#, 16#0021B#),  -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW
-      (16#0021D#, 16#0021D#),  -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH
-      (16#0021F#, 16#0021F#),  -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON
-      (16#00223#, 16#00223#),  -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU
-      (16#00225#, 16#00225#),  -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK
-      (16#00227#, 16#00227#),  -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE
-      (16#00229#, 16#00229#),  -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA
-      (16#0022B#, 16#0022B#),  -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON
-      (16#0022D#, 16#0022D#),  -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON
-      (16#0022F#, 16#0022F#),  -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE
-      (16#00231#, 16#00231#),  -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON
-      (16#00233#, 16#00233#),  -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON
-      (16#00253#, 16#00253#),  -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK
-      (16#00254#, 16#00254#),  -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O
-      (16#00256#, 16#00257#),  -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK
-      (16#00259#, 16#00259#),  -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA
-      (16#0025B#, 16#0025B#),  -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E
-      (16#00260#, 16#00260#),  -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK
-      (16#00263#, 16#00263#),  -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA
-      (16#00268#, 16#00268#),  -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE
-      (16#00269#, 16#00269#),  -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA
-      (16#0026F#, 16#0026F#),  -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M
-      (16#00272#, 16#00272#),  -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK
-      (16#00275#, 16#00275#),  -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O
-      (16#00280#, 16#00280#),  -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R
-      (16#00283#, 16#00283#),  -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH
-      (16#00288#, 16#00288#),  -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK
-      (16#0028A#, 16#0028B#),  -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK
-      (16#00292#, 16#00292#),  -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH
-      (16#003AC#, 16#003AC#),  -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS
-      (16#003AD#, 16#003AF#),  -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS
-      (16#003B1#, 16#003C1#),  -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO
-      (16#003C2#, 16#003C2#),  -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA
-      (16#003C3#, 16#003CB#),  -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA
-      (16#003CC#, 16#003CC#),  -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS
-      (16#003CD#, 16#003CE#),  -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS
-      (16#003D0#, 16#003D0#),  -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL
-      (16#003D1#, 16#003D1#),  -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL
-      (16#003D5#, 16#003D5#),  -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL
-      (16#003D6#, 16#003D6#),  -- GREEK PI SYMBOL .. GREEK PI SYMBOL
-      (16#003D9#, 16#003D9#),  -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA
-      (16#003DB#, 16#003DB#),  -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA
-      (16#003DD#, 16#003DD#),  -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA
-      (16#003DF#, 16#003DF#),  -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA
-      (16#003E1#, 16#003E1#),  -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI
-      (16#003E3#, 16#003E3#),  -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI
-      (16#003E5#, 16#003E5#),  -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI
-      (16#003E7#, 16#003E7#),  -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI
-      (16#003E9#, 16#003E9#),  -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI
-      (16#003EB#, 16#003EB#),  -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA
-      (16#003ED#, 16#003ED#),  -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA
-      (16#003EF#, 16#003EF#),  -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI
-      (16#003F0#, 16#003F0#),  -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL
-      (16#003F1#, 16#003F1#),  -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL
-      (16#003F2#, 16#003F2#),  -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL
-      (16#003F5#, 16#003F5#),  -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL
-      (16#00430#, 16#0044F#),  -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA
-      (16#00450#, 16#0045F#),  -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE
-      (16#00461#, 16#00461#),  -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA
-      (16#00463#, 16#00463#),  -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT
-      (16#00465#, 16#00465#),  -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E
-      (16#00467#, 16#00467#),  -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS
-      (16#00469#, 16#00469#),  -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS
-      (16#0046B#, 16#0046B#),  -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS
-      (16#0046D#, 16#0046D#),  -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS
-      (16#0046F#, 16#0046F#),  -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI
-      (16#00471#, 16#00471#),  -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI
-      (16#00473#, 16#00473#),  -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA
-      (16#00475#, 16#00475#),  -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA
-      (16#00477#, 16#00477#),  -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
-      (16#00479#, 16#00479#),  -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK
-      (16#0047B#, 16#0047B#),  -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA
-      (16#0047D#, 16#0047D#),  -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO
-      (16#0047F#, 16#0047F#),  -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT
-      (16#00481#, 16#00481#),  -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA
-      (16#0048B#, 16#0048B#),  -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL
-      (16#0048D#, 16#0048D#),  -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN
-      (16#0048F#, 16#0048F#),  -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK
-      (16#00491#, 16#00491#),  -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN
-      (16#00493#, 16#00493#),  -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE
-      (16#00495#, 16#00495#),  -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK
-      (16#00497#, 16#00497#),  -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER
-      (16#00499#, 16#00499#),  -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER
-      (16#0049B#, 16#0049B#),  -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER
-      (16#0049D#, 16#0049D#),  -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE
-      (16#0049F#, 16#0049F#),  -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE
-      (16#004A1#, 16#004A1#),  -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA
-      (16#004A3#, 16#004A3#),  -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER
-      (16#004A5#, 16#004A5#),  -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE
-      (16#004A7#, 16#004A7#),  -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK
-      (16#004A9#, 16#004A9#),  -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA
-      (16#004AB#, 16#004AB#),  -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER
-      (16#004AD#, 16#004AD#),  -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER
-      (16#004AF#, 16#004AF#),  -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U
-      (16#004B1#, 16#004B1#),  -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE
-      (16#004B3#, 16#004B3#),  -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER
-      (16#004B5#, 16#004B5#),  -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE
-      (16#004B7#, 16#004B7#),  -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER
-      (16#004B9#, 16#004B9#),  -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE
-      (16#004BB#, 16#004BB#),  -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA
-      (16#004BD#, 16#004BD#),  -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE
-      (16#004BF#, 16#004BF#),  -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER
-      (16#004C2#, 16#004C2#),  -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE
-      (16#004C4#, 16#004C4#),  -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK
-      (16#004C6#, 16#004C6#),  -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL
-      (16#004C8#, 16#004C8#),  -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK
-      (16#004CA#, 16#004CA#),  -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL
-      (16#004CC#, 16#004CC#),  -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE
-      (16#004CE#, 16#004CE#),  -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL
-      (16#004D1#, 16#004D1#),  -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE
-      (16#004D3#, 16#004D3#),  -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS
-      (16#004D5#, 16#004D5#),  -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE
-      (16#004D7#, 16#004D7#),  -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE
-      (16#004D9#, 16#004D9#),  -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA
-      (16#004DB#, 16#004DB#),  -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS
-      (16#004DD#, 16#004DD#),  -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS
-      (16#004DF#, 16#004DF#),  -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS
-      (16#004E1#, 16#004E1#),  -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE
-      (16#004E3#, 16#004E3#),  -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON
-      (16#004E5#, 16#004E5#),  -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS
-      (16#004E7#, 16#004E7#),  -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS
-      (16#004E9#, 16#004E9#),  -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O
-      (16#004EB#, 16#004EB#),  -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS
-      (16#004ED#, 16#004ED#),  -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS
-      (16#004EF#, 16#004EF#),  -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON
-      (16#004F1#, 16#004F1#),  -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS
-      (16#004F3#, 16#004F3#),  -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE
-      (16#004F5#, 16#004F5#),  -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS
-      (16#004F9#, 16#004F9#),  -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS
-      (16#00501#, 16#00501#),  -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE
-      (16#00503#, 16#00503#),  -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE
-      (16#00505#, 16#00505#),  -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE
-      (16#00507#, 16#00507#),  -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE
-      (16#00509#, 16#00509#),  -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE
-      (16#0050B#, 16#0050B#),  -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE
-      (16#0050D#, 16#0050D#),  -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE
-      (16#0050F#, 16#0050F#),  -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE
-      (16#00561#, 16#00586#),  -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH
-      (16#01E01#, 16#01E01#),  -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW
-      (16#01E03#, 16#01E03#),  -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE
-      (16#01E05#, 16#01E05#),  -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW
-      (16#01E07#, 16#01E07#),  -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW
-      (16#01E09#, 16#01E09#),  -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE
-      (16#01E0B#, 16#01E0B#),  -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE
-      (16#01E0D#, 16#01E0D#),  -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW
-      (16#01E0F#, 16#01E0F#),  -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW
-      (16#01E11#, 16#01E11#),  -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA
-      (16#01E13#, 16#01E13#),  -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW
-      (16#01E15#, 16#01E15#),  -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE
-      (16#01E17#, 16#01E17#),  -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE
-      (16#01E19#, 16#01E19#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW
-      (16#01E1B#, 16#01E1B#),  -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW
-      (16#01E1D#, 16#01E1D#),  -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE
-      (16#01E1F#, 16#01E1F#),  -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE
-      (16#01E21#, 16#01E21#),  -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON
-      (16#01E23#, 16#01E23#),  -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE
-      (16#01E25#, 16#01E25#),  -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW
-      (16#01E27#, 16#01E27#),  -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS
-      (16#01E29#, 16#01E29#),  -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA
-      (16#01E2B#, 16#01E2B#),  -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW
-      (16#01E2D#, 16#01E2D#),  -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW
-      (16#01E2F#, 16#01E2F#),  -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE
-      (16#01E31#, 16#01E31#),  -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE
-      (16#01E33#, 16#01E33#),  -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW
-      (16#01E35#, 16#01E35#),  -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW
-      (16#01E37#, 16#01E37#),  -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW
-      (16#01E39#, 16#01E39#),  -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON
-      (16#01E3B#, 16#01E3B#),  -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW
-      (16#01E3D#, 16#01E3D#),  -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW
-      (16#01E3F#, 16#01E3F#),  -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE
-      (16#01E41#, 16#01E41#),  -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE
-      (16#01E43#, 16#01E43#),  -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW
-      (16#01E45#, 16#01E45#),  -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE
-      (16#01E47#, 16#01E47#),  -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW
-      (16#01E49#, 16#01E49#),  -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW
-      (16#01E4B#, 16#01E4B#),  -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW
-      (16#01E4D#, 16#01E4D#),  -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE
-      (16#01E4F#, 16#01E4F#),  -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS
-      (16#01E51#, 16#01E51#),  -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE
-      (16#01E53#, 16#01E53#),  -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE
-      (16#01E55#, 16#01E55#),  -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE
-      (16#01E57#, 16#01E57#),  -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE
-      (16#01E59#, 16#01E59#),  -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE
-      (16#01E5B#, 16#01E5B#),  -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW
-      (16#01E5D#, 16#01E5D#),  -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON
-      (16#01E5F#, 16#01E5F#),  -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW
-      (16#01E61#, 16#01E61#),  -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE
-      (16#01E63#, 16#01E63#),  -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW
-      (16#01E65#, 16#01E65#),  -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE
-      (16#01E67#, 16#01E67#),  -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE
-      (16#01E69#, 16#01E69#),  -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE
-      (16#01E6B#, 16#01E6B#),  -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE
-      (16#01E6D#, 16#01E6D#),  -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW
-      (16#01E6F#, 16#01E6F#),  -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW
-      (16#01E71#, 16#01E71#),  -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW
-      (16#01E73#, 16#01E73#),  -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW
-      (16#01E75#, 16#01E75#),  -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW
-      (16#01E77#, 16#01E77#),  -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW
-      (16#01E79#, 16#01E79#),  -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE
-      (16#01E7B#, 16#01E7B#),  -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS
-      (16#01E7D#, 16#01E7D#),  -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE
-      (16#01E7F#, 16#01E7F#),  -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW
-      (16#01E81#, 16#01E81#),  -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE
-      (16#01E83#, 16#01E83#),  -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE
-      (16#01E85#, 16#01E85#),  -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS
-      (16#01E87#, 16#01E87#),  -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE
-      (16#01E89#, 16#01E89#),  -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW
-      (16#01E8B#, 16#01E8B#),  -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE
-      (16#01E8D#, 16#01E8D#),  -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS
-      (16#01E8F#, 16#01E8F#),  -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE
-      (16#01E91#, 16#01E91#),  -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX
-      (16#01E93#, 16#01E93#),  -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW
-      (16#01E95#, 16#01E95#),  -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW
-      (16#01E9B#, 16#01E9B#),  -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE
-      (16#01EA1#, 16#01EA1#),  -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW
-      (16#01EA3#, 16#01EA3#),  -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE
-      (16#01EA5#, 16#01EA5#),  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
-      (16#01EA7#, 16#01EA7#),  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
-      (16#01EA9#, 16#01EA9#),  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
-      (16#01EAB#, 16#01EAB#),  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
-      (16#01EAD#, 16#01EAD#),  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
-      (16#01EAF#, 16#01EAF#),  -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE
-      (16#01EB1#, 16#01EB1#),  -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE
-      (16#01EB3#, 16#01EB3#),  -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
-      (16#01EB5#, 16#01EB5#),  -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE
-      (16#01EB7#, 16#01EB7#),  -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
-      (16#01EB9#, 16#01EB9#),  -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW
-      (16#01EBB#, 16#01EBB#),  -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE
-      (16#01EBD#, 16#01EBD#),  -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE
-      (16#01EBF#, 16#01EBF#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
-      (16#01EC1#, 16#01EC1#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
-      (16#01EC3#, 16#01EC3#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
-      (16#01EC5#, 16#01EC5#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
-      (16#01EC7#, 16#01EC7#),  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
-      (16#01EC9#, 16#01EC9#),  -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE
-      (16#01ECB#, 16#01ECB#),  -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW
-      (16#01ECD#, 16#01ECD#),  -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW
-      (16#01ECF#, 16#01ECF#),  -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE
-      (16#01ED1#, 16#01ED1#),  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
-      (16#01ED3#, 16#01ED3#),  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
-      (16#01ED5#, 16#01ED5#),  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
-      (16#01ED7#, 16#01ED7#),  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
-      (16#01ED9#, 16#01ED9#),  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
-      (16#01EDB#, 16#01EDB#),  -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE
-      (16#01EDD#, 16#01EDD#),  -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE
-      (16#01EDF#, 16#01EDF#),  -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
-      (16#01EE1#, 16#01EE1#),  -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE
-      (16#01EE3#, 16#01EE3#),  -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW
-      (16#01EE5#, 16#01EE5#),  -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW
-      (16#01EE7#, 16#01EE7#),  -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE
-      (16#01EE9#, 16#01EE9#),  -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE
-      (16#01EEB#, 16#01EEB#),  -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE
-      (16#01EED#, 16#01EED#),  -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
-      (16#01EEF#, 16#01EEF#),  -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE
-      (16#01EF1#, 16#01EF1#),  -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW
-      (16#01EF3#, 16#01EF3#),  -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE
-      (16#01EF5#, 16#01EF5#),  -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW
-      (16#01EF7#, 16#01EF7#),  -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE
-      (16#01EF9#, 16#01EF9#),  -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE
-      (16#01F00#, 16#01F07#),  -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI
-      (16#01F10#, 16#01F15#),  -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA
-      (16#01F20#, 16#01F27#),  -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI
-      (16#01F30#, 16#01F37#),  -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI
-      (16#01F40#, 16#01F45#),  -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA
-      (16#01F51#, 16#01F51#),  -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA
-      (16#01F53#, 16#01F53#),  -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA
-      (16#01F55#, 16#01F55#),  -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA
-      (16#01F57#, 16#01F57#),  -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI
-      (16#01F60#, 16#01F67#),  -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI
-      (16#01F70#, 16#01F71#),  -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA
-      (16#01F72#, 16#01F75#),  -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA
-      (16#01F76#, 16#01F77#),  -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA
-      (16#01F78#, 16#01F79#),  -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA
-      (16#01F7A#, 16#01F7B#),  -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA
-      (16#01F7C#, 16#01F7D#),  -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA
-      (16#01F80#, 16#01F87#),  -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-      (16#01F90#, 16#01F97#),  -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-      (16#01FA0#, 16#01FA7#),  -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-      (16#01FB0#, 16#01FB1#),  -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON
-      (16#01FB3#, 16#01FB3#),  -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
-      (16#01FBE#, 16#01FBE#),  -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI
-      (16#01FC3#, 16#01FC3#),  -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
-      (16#01FD0#, 16#01FD1#),  -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON
-      (16#01FE0#, 16#01FE1#),  -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON
-      (16#01FE5#, 16#01FE5#),  -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA
-      (16#01FF3#, 16#01FF3#),  -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
-      (16#0FF41#, 16#0FF5A#),  -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
-      (16#10428#, 16#1044D#)); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG
- 
-    Upper_Case_Adjust : constant array
-                          (Lower_Case_Letters'Range) of Char_Code'Base := (
-        -32,  -- LATIN SMALL LETTER A .. LATIN SMALL LETTER Z
-        743,  -- MICRO SIGN .. MICRO SIGN
-        -32,  -- LATIN SMALL LETTER A WITH GRAVE .. LATIN SMALL LETTER O WITH DIAERESIS
-        -32,  -- LATIN SMALL LETTER O WITH STROKE .. LATIN SMALL LETTER THORN
-        121,  -- LATIN SMALL LETTER Y WITH DIAERESIS .. LATIN SMALL LETTER Y WITH DIAERESIS
-         -1,  -- LATIN SMALL LETTER A WITH MACRON .. LATIN SMALL LETTER A WITH MACRON
-         -1,  -- LATIN SMALL LETTER A WITH BREVE .. LATIN SMALL LETTER A WITH BREVE
-         -1,  -- LATIN SMALL LETTER A WITH OGONEK .. LATIN SMALL LETTER A WITH OGONEK
-         -1,  -- LATIN SMALL LETTER C WITH ACUTE .. LATIN SMALL LETTER C WITH ACUTE
-         -1,  -- LATIN SMALL LETTER C WITH CIRCUMFLEX .. LATIN SMALL LETTER C WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER C WITH DOT ABOVE .. LATIN SMALL LETTER C WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER C WITH CARON .. LATIN SMALL LETTER C WITH CARON
-         -1,  -- LATIN SMALL LETTER D WITH CARON .. LATIN SMALL LETTER D WITH CARON
-         -1,  -- LATIN SMALL LETTER D WITH STROKE .. LATIN SMALL LETTER D WITH STROKE
-         -1,  -- LATIN SMALL LETTER E WITH MACRON .. LATIN SMALL LETTER E WITH MACRON
-         -1,  -- LATIN SMALL LETTER E WITH BREVE .. LATIN SMALL LETTER E WITH BREVE
-         -1,  -- LATIN SMALL LETTER E WITH DOT ABOVE .. LATIN SMALL LETTER E WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER E WITH OGONEK .. LATIN SMALL LETTER E WITH OGONEK
-         -1,  -- LATIN SMALL LETTER E WITH CARON .. LATIN SMALL LETTER E WITH CARON
-         -1,  -- LATIN SMALL LETTER G WITH CIRCUMFLEX .. LATIN SMALL LETTER G WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER G WITH BREVE .. LATIN SMALL LETTER G WITH BREVE
-         -1,  -- LATIN SMALL LETTER G WITH DOT ABOVE .. LATIN SMALL LETTER G WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER G WITH CEDILLA .. LATIN SMALL LETTER G WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER H WITH CIRCUMFLEX .. LATIN SMALL LETTER H WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER H WITH STROKE .. LATIN SMALL LETTER H WITH STROKE
-         -1,  -- LATIN SMALL LETTER I WITH TILDE .. LATIN SMALL LETTER I WITH TILDE
-         -1,  -- LATIN SMALL LETTER I WITH MACRON .. LATIN SMALL LETTER I WITH MACRON
-         -1,  -- LATIN SMALL LETTER I WITH BREVE .. LATIN SMALL LETTER I WITH BREVE
-         -1,  -- LATIN SMALL LETTER I WITH OGONEK .. LATIN SMALL LETTER I WITH OGONEK
-       -232,  -- LATIN SMALL LETTER DOTLESS I .. LATIN SMALL LETTER DOTLESS I
-         -1,  -- LATIN SMALL LIGATURE IJ .. LATIN SMALL LIGATURE IJ
-         -1,  -- LATIN SMALL LETTER J WITH CIRCUMFLEX .. LATIN SMALL LETTER J WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER K WITH CEDILLA .. LATIN SMALL LETTER K WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER L WITH ACUTE .. LATIN SMALL LETTER L WITH ACUTE
-         -1,  -- LATIN SMALL LETTER L WITH CEDILLA .. LATIN SMALL LETTER L WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER L WITH CARON .. LATIN SMALL LETTER L WITH CARON
-         -1,  -- LATIN SMALL LETTER L WITH MIDDLE DOT .. LATIN SMALL LETTER L WITH MIDDLE DOT
-         -1,  -- LATIN SMALL LETTER L WITH STROKE .. LATIN SMALL LETTER L WITH STROKE
-         -1,  -- LATIN SMALL LETTER N WITH ACUTE .. LATIN SMALL LETTER N WITH ACUTE
-         -1,  -- LATIN SMALL LETTER N WITH CEDILLA .. LATIN SMALL LETTER N WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER N WITH CARON .. LATIN SMALL LETTER N WITH CARON
-         -1,  -- LATIN SMALL LETTER ENG .. LATIN SMALL LETTER ENG
-         -1,  -- LATIN SMALL LETTER O WITH MACRON .. LATIN SMALL LETTER O WITH MACRON
-         -1,  -- LATIN SMALL LETTER O WITH BREVE .. LATIN SMALL LETTER O WITH BREVE
-         -1,  -- LATIN SMALL LETTER O WITH DOUBLE ACUTE .. LATIN SMALL LETTER O WITH DOUBLE ACUTE
-         -1,  -- LATIN SMALL LIGATURE OE .. LATIN SMALL LIGATURE OE
-         -1,  -- LATIN SMALL LETTER R WITH ACUTE .. LATIN SMALL LETTER R WITH ACUTE
-         -1,  -- LATIN SMALL LETTER R WITH CEDILLA .. LATIN SMALL LETTER R WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER R WITH CARON .. LATIN SMALL LETTER R WITH CARON
-         -1,  -- LATIN SMALL LETTER S WITH ACUTE .. LATIN SMALL LETTER S WITH ACUTE
-         -1,  -- LATIN SMALL LETTER S WITH CIRCUMFLEX .. LATIN SMALL LETTER S WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER S WITH CEDILLA .. LATIN SMALL LETTER S WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER S WITH CARON .. LATIN SMALL LETTER S WITH CARON
-         -1,  -- LATIN SMALL LETTER T WITH CEDILLA .. LATIN SMALL LETTER T WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER T WITH CARON .. LATIN SMALL LETTER T WITH CARON
-         -1,  -- LATIN SMALL LETTER T WITH STROKE .. LATIN SMALL LETTER T WITH STROKE
-         -1,  -- LATIN SMALL LETTER U WITH TILDE .. LATIN SMALL LETTER U WITH TILDE
-         -1,  -- LATIN SMALL LETTER U WITH MACRON .. LATIN SMALL LETTER U WITH MACRON
-         -1,  -- LATIN SMALL LETTER U WITH BREVE .. LATIN SMALL LETTER U WITH BREVE
-         -1,  -- LATIN SMALL LETTER U WITH RING ABOVE .. LATIN SMALL LETTER U WITH RING ABOVE
-         -1,  -- LATIN SMALL LETTER U WITH DOUBLE ACUTE .. LATIN SMALL LETTER U WITH DOUBLE ACUTE
-         -1,  -- LATIN SMALL LETTER U WITH OGONEK .. LATIN SMALL LETTER U WITH OGONEK
-         -1,  -- LATIN SMALL LETTER W WITH CIRCUMFLEX .. LATIN SMALL LETTER W WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER Y WITH CIRCUMFLEX .. LATIN SMALL LETTER Y WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER Z WITH ACUTE .. LATIN SMALL LETTER Z WITH ACUTE
-         -1,  -- LATIN SMALL LETTER Z WITH DOT ABOVE .. LATIN SMALL LETTER Z WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER Z WITH CARON .. LATIN SMALL LETTER Z WITH CARON
-       -300,  -- LATIN SMALL LETTER LONG S .. LATIN SMALL LETTER LONG S
-         -1,  -- LATIN SMALL LETTER B WITH TOPBAR .. LATIN SMALL LETTER B WITH TOPBAR
-         -1,  -- LATIN SMALL LETTER TONE SIX .. LATIN SMALL LETTER TONE SIX
-         -1,  -- LATIN SMALL LETTER C WITH HOOK .. LATIN SMALL LETTER C WITH HOOK
-         -1,  -- LATIN SMALL LETTER D WITH TOPBAR .. LATIN SMALL LETTER D WITH TOPBAR
-         -1,  -- LATIN SMALL LETTER F WITH HOOK .. LATIN SMALL LETTER F WITH HOOK
-         97,  -- LATIN SMALL LETTER HV .. LATIN SMALL LETTER HV
-         -1,  -- LATIN SMALL LETTER K WITH HOOK .. LATIN SMALL LETTER K WITH HOOK
-        130,  -- LATIN SMALL LETTER N WITH LONG RIGHT LEG .. LATIN SMALL LETTER N WITH LONG RIGHT LEG
-         -1,  -- LATIN SMALL LETTER O WITH HORN .. LATIN SMALL LETTER O WITH HORN
-         -1,  -- LATIN SMALL LETTER OI .. LATIN SMALL LETTER OI
-         -1,  -- LATIN SMALL LETTER P WITH HOOK .. LATIN SMALL LETTER P WITH HOOK
-         -1,  -- LATIN SMALL LETTER TONE TWO .. LATIN SMALL LETTER TONE TWO
-         -1,  -- LATIN SMALL LETTER T WITH HOOK .. LATIN SMALL LETTER T WITH HOOK
-         -1,  -- LATIN SMALL LETTER U WITH HORN .. LATIN SMALL LETTER U WITH HORN
-         -1,  -- LATIN SMALL LETTER Y WITH HOOK .. LATIN SMALL LETTER Y WITH HOOK
-         -1,  -- LATIN SMALL LETTER Z WITH STROKE .. LATIN SMALL LETTER Z WITH STROKE
-         -1,  -- LATIN SMALL LETTER EZH REVERSED .. LATIN SMALL LETTER EZH REVERSED
-         -1,  -- LATIN SMALL LETTER TONE FIVE .. LATIN SMALL LETTER TONE FIVE
-         56,  -- LATIN LETTER WYNN .. LATIN LETTER WYNN
-         -1,  -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
-         -2,  -- LATIN SMALL LETTER DZ WITH CARON .. LATIN SMALL LETTER DZ WITH CARON
-         -1,  -- LATIN CAPITAL LETTER L WITH SMALL LETTER J .. LATIN CAPITAL LETTER L WITH SMALL LETTER J
-         -2,  -- LATIN SMALL LETTER LJ .. LATIN SMALL LETTER LJ
-         -1,  -- LATIN CAPITAL LETTER N WITH SMALL LETTER J .. LATIN CAPITAL LETTER N WITH SMALL LETTER J
-         -2,  -- LATIN SMALL LETTER NJ .. LATIN SMALL LETTER NJ
-         -1,  -- LATIN SMALL LETTER A WITH CARON .. LATIN SMALL LETTER A WITH CARON
-         -1,  -- LATIN SMALL LETTER I WITH CARON .. LATIN SMALL LETTER I WITH CARON
-         -1,  -- LATIN SMALL LETTER O WITH CARON .. LATIN SMALL LETTER O WITH CARON
-         -1,  -- LATIN SMALL LETTER U WITH CARON .. LATIN SMALL LETTER U WITH CARON
-         -1,  -- LATIN SMALL LETTER U WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER U WITH DIAERESIS AND MACRON
-         -1,  -- LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE
-         -1,  -- LATIN SMALL LETTER U WITH DIAERESIS AND CARON .. LATIN SMALL LETTER U WITH DIAERESIS AND CARON
-         -1,  -- LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE .. LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE
-        -79,  -- LATIN SMALL LETTER TURNED E .. LATIN SMALL LETTER TURNED E
-         -1,  -- LATIN SMALL LETTER A WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER A WITH DIAERESIS AND MACRON
-         -1,  -- LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON
-         -1,  -- LATIN SMALL LETTER AE WITH MACRON .. LATIN SMALL LETTER AE WITH MACRON
-         -1,  -- LATIN SMALL LETTER G WITH STROKE .. LATIN SMALL LETTER G WITH STROKE
-         -1,  -- LATIN SMALL LETTER G WITH CARON .. LATIN SMALL LETTER G WITH CARON
-         -1,  -- LATIN SMALL LETTER K WITH CARON .. LATIN SMALL LETTER K WITH CARON
-         -1,  -- LATIN SMALL LETTER O WITH OGONEK .. LATIN SMALL LETTER O WITH OGONEK
-         -1,  -- LATIN SMALL LETTER O WITH OGONEK AND MACRON .. LATIN SMALL LETTER O WITH OGONEK AND MACRON
-         -1,  -- LATIN SMALL LETTER EZH WITH CARON .. LATIN SMALL LETTER EZH WITH CARON
-         -1,  -- LATIN CAPITAL LETTER D WITH SMALL LETTER Z .. LATIN CAPITAL LETTER D WITH SMALL LETTER Z
-         -2,  -- LATIN SMALL LETTER DZ .. LATIN SMALL LETTER DZ
-         -1,  -- LATIN SMALL LETTER G WITH ACUTE .. LATIN SMALL LETTER G WITH ACUTE
-         -1,  -- LATIN SMALL LETTER N WITH GRAVE .. LATIN SMALL LETTER N WITH GRAVE
-         -1,  -- LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE .. LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE
-         -1,  -- LATIN SMALL LETTER AE WITH ACUTE .. LATIN SMALL LETTER AE WITH ACUTE
-         -1,  -- LATIN SMALL LETTER O WITH STROKE AND ACUTE .. LATIN SMALL LETTER O WITH STROKE AND ACUTE
-         -1,  -- LATIN SMALL LETTER A WITH DOUBLE GRAVE .. LATIN SMALL LETTER A WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER A WITH INVERTED BREVE .. LATIN SMALL LETTER A WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER E WITH DOUBLE GRAVE .. LATIN SMALL LETTER E WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER E WITH INVERTED BREVE .. LATIN SMALL LETTER E WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER I WITH DOUBLE GRAVE .. LATIN SMALL LETTER I WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER I WITH INVERTED BREVE .. LATIN SMALL LETTER I WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER O WITH DOUBLE GRAVE .. LATIN SMALL LETTER O WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER O WITH INVERTED BREVE .. LATIN SMALL LETTER O WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER R WITH DOUBLE GRAVE .. LATIN SMALL LETTER R WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER R WITH INVERTED BREVE .. LATIN SMALL LETTER R WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER U WITH DOUBLE GRAVE .. LATIN SMALL LETTER U WITH DOUBLE GRAVE
-         -1,  -- LATIN SMALL LETTER U WITH INVERTED BREVE .. LATIN SMALL LETTER U WITH INVERTED BREVE
-         -1,  -- LATIN SMALL LETTER S WITH COMMA BELOW .. LATIN SMALL LETTER S WITH COMMA BELOW
-         -1,  -- LATIN SMALL LETTER T WITH COMMA BELOW .. LATIN SMALL LETTER T WITH COMMA BELOW
-         -1,  -- LATIN SMALL LETTER YOGH .. LATIN SMALL LETTER YOGH
-         -1,  -- LATIN SMALL LETTER H WITH CARON .. LATIN SMALL LETTER H WITH CARON
-         -1,  -- LATIN SMALL LETTER OU .. LATIN SMALL LETTER OU
-         -1,  -- LATIN SMALL LETTER Z WITH HOOK .. LATIN SMALL LETTER Z WITH HOOK
-         -1,  -- LATIN SMALL LETTER A WITH DOT ABOVE .. LATIN SMALL LETTER A WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER E WITH CEDILLA .. LATIN SMALL LETTER E WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER O WITH DIAERESIS AND MACRON .. LATIN SMALL LETTER O WITH DIAERESIS AND MACRON
-         -1,  -- LATIN SMALL LETTER O WITH TILDE AND MACRON .. LATIN SMALL LETTER O WITH TILDE AND MACRON
-         -1,  -- LATIN SMALL LETTER O WITH DOT ABOVE .. LATIN SMALL LETTER O WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON .. LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON
-         -1,  -- LATIN SMALL LETTER Y WITH MACRON .. LATIN SMALL LETTER Y WITH MACRON
-       -210,  -- LATIN SMALL LETTER B WITH HOOK .. LATIN SMALL LETTER B WITH HOOK
-       -206,  -- LATIN SMALL LETTER OPEN O .. LATIN SMALL LETTER OPEN O
-       -205,  -- LATIN SMALL LETTER D WITH TAIL .. LATIN SMALL LETTER D WITH HOOK
-       -202,  -- LATIN SMALL LETTER SCHWA .. LATIN SMALL LETTER SCHWA
-       -203,  -- LATIN SMALL LETTER OPEN E .. LATIN SMALL LETTER OPEN E
-       -205,  -- LATIN SMALL LETTER G WITH HOOK .. LATIN SMALL LETTER G WITH HOOK
-       -207,  -- LATIN SMALL LETTER GAMMA .. LATIN SMALL LETTER GAMMA
-       -209,  -- LATIN SMALL LETTER I WITH STROKE .. LATIN SMALL LETTER I WITH STROKE
-       -211,  -- LATIN SMALL LETTER IOTA .. LATIN SMALL LETTER IOTA
-       -211,  -- LATIN SMALL LETTER TURNED M .. LATIN SMALL LETTER TURNED M
-       -213,  -- LATIN SMALL LETTER N WITH LEFT HOOK .. LATIN SMALL LETTER N WITH LEFT HOOK
-       -214,  -- LATIN SMALL LETTER BARRED O .. LATIN SMALL LETTER BARRED O
-       -218,  -- LATIN LETTER SMALL CAPITAL R .. LATIN LETTER SMALL CAPITAL R
-       -218,  -- LATIN SMALL LETTER ESH .. LATIN SMALL LETTER ESH
-       -218,  -- LATIN SMALL LETTER T WITH RETROFLEX HOOK .. LATIN SMALL LETTER T WITH RETROFLEX HOOK
-       -217,  -- LATIN SMALL LETTER UPSILON .. LATIN SMALL LETTER V WITH HOOK
-       -219,  -- LATIN SMALL LETTER EZH .. LATIN SMALL LETTER EZH
-        -38,  -- GREEK SMALL LETTER ALPHA WITH TONOS .. GREEK SMALL LETTER ALPHA WITH TONOS
-        -37,  -- GREEK SMALL LETTER EPSILON WITH TONOS .. GREEK SMALL LETTER IOTA WITH TONOS
-        -32,  -- GREEK SMALL LETTER ALPHA .. GREEK SMALL LETTER RHO
-        -31,  -- GREEK SMALL LETTER FINAL SIGMA .. GREEK SMALL LETTER FINAL SIGMA
-        -32,  -- GREEK SMALL LETTER SIGMA .. GREEK SMALL LETTER UPSILON WITH DIALYTIKA
-        -64,  -- GREEK SMALL LETTER OMICRON WITH TONOS .. GREEK SMALL LETTER OMICRON WITH TONOS
-        -63,  -- GREEK SMALL LETTER UPSILON WITH TONOS .. GREEK SMALL LETTER OMEGA WITH TONOS
-        -62,  -- GREEK BETA SYMBOL .. GREEK BETA SYMBOL
-        -57,  -- GREEK THETA SYMBOL .. GREEK THETA SYMBOL
-        -47,  -- GREEK PHI SYMBOL .. GREEK PHI SYMBOL
-        -54,  -- GREEK PI SYMBOL .. GREEK PI SYMBOL
-         -1,  -- GREEK SMALL LETTER ARCHAIC KOPPA .. GREEK SMALL LETTER ARCHAIC KOPPA
-         -1,  -- GREEK SMALL LETTER STIGMA .. GREEK SMALL LETTER STIGMA
-         -1,  -- GREEK SMALL LETTER DIGAMMA .. GREEK SMALL LETTER DIGAMMA
-         -1,  -- GREEK SMALL LETTER KOPPA .. GREEK SMALL LETTER KOPPA
-         -1,  -- GREEK SMALL LETTER SAMPI .. GREEK SMALL LETTER SAMPI
-         -1,  -- COPTIC SMALL LETTER SHEI .. COPTIC SMALL LETTER SHEI
-         -1,  -- COPTIC SMALL LETTER FEI .. COPTIC SMALL LETTER FEI
-         -1,  -- COPTIC SMALL LETTER KHEI .. COPTIC SMALL LETTER KHEI
-         -1,  -- COPTIC SMALL LETTER HORI .. COPTIC SMALL LETTER HORI
-         -1,  -- COPTIC SMALL LETTER GANGIA .. COPTIC SMALL LETTER GANGIA
-         -1,  -- COPTIC SMALL LETTER SHIMA .. COPTIC SMALL LETTER SHIMA
-         -1,  -- COPTIC SMALL LETTER DEI .. COPTIC SMALL LETTER DEI
-        -86,  -- GREEK KAPPA SYMBOL .. GREEK KAPPA SYMBOL
-        -80,  -- GREEK RHO SYMBOL .. GREEK RHO SYMBOL
-        -79,  -- GREEK LUNATE SIGMA SYMBOL .. GREEK LUNATE SIGMA SYMBOL
-        -96,  -- GREEK LUNATE EPSILON SYMBOL .. GREEK LUNATE EPSILON SYMBOL
-        -32,  -- CYRILLIC SMALL LETTER A .. CYRILLIC SMALL LETTER YA
-        -80,  -- CYRILLIC SMALL LETTER IE WITH GRAVE .. CYRILLIC SMALL LETTER DZHE
-         -1,  -- CYRILLIC SMALL LETTER OMEGA .. CYRILLIC SMALL LETTER OMEGA
-         -1,  -- CYRILLIC SMALL LETTER YAT .. CYRILLIC SMALL LETTER YAT
-         -1,  -- CYRILLIC SMALL LETTER IOTIFIED E .. CYRILLIC SMALL LETTER IOTIFIED E
-         -1,  -- CYRILLIC SMALL LETTER LITTLE YUS .. CYRILLIC SMALL LETTER LITTLE YUS
-         -1,  -- CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS .. CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS
-         -1,  -- CYRILLIC SMALL LETTER BIG YUS .. CYRILLIC SMALL LETTER BIG YUS
-         -1,  -- CYRILLIC SMALL LETTER IOTIFIED BIG YUS .. CYRILLIC SMALL LETTER IOTIFIED BIG YUS
-         -1,  -- CYRILLIC SMALL LETTER KSI .. CYRILLIC SMALL LETTER KSI
-         -1,  -- CYRILLIC SMALL LETTER PSI .. CYRILLIC SMALL LETTER PSI
-         -1,  -- CYRILLIC SMALL LETTER FITA .. CYRILLIC SMALL LETTER FITA
-         -1,  -- CYRILLIC SMALL LETTER IZHITSA .. CYRILLIC SMALL LETTER IZHITSA
-         -1,  -- CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT .. CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT
-         -1,  -- CYRILLIC SMALL LETTER UK .. CYRILLIC SMALL LETTER UK
-         -1,  -- CYRILLIC SMALL LETTER ROUND OMEGA .. CYRILLIC SMALL LETTER ROUND OMEGA
-         -1,  -- CYRILLIC SMALL LETTER OMEGA WITH TITLO .. CYRILLIC SMALL LETTER OMEGA WITH TITLO
-         -1,  -- CYRILLIC SMALL LETTER OT .. CYRILLIC SMALL LETTER OT
-         -1,  -- CYRILLIC SMALL LETTER KOPPA .. CYRILLIC SMALL LETTER KOPPA
-         -1,  -- CYRILLIC SMALL LETTER SHORT I WITH TAIL .. CYRILLIC SMALL LETTER SHORT I WITH TAIL
-         -1,  -- CYRILLIC SMALL LETTER SEMISOFT SIGN .. CYRILLIC SMALL LETTER SEMISOFT SIGN
-         -1,  -- CYRILLIC SMALL LETTER ER WITH TICK .. CYRILLIC SMALL LETTER ER WITH TICK
-         -1,  -- CYRILLIC SMALL LETTER GHE WITH UPTURN .. CYRILLIC SMALL LETTER GHE WITH UPTURN
-         -1,  -- CYRILLIC SMALL LETTER GHE WITH STROKE .. CYRILLIC SMALL LETTER GHE WITH STROKE
-         -1,  -- CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK
-         -1,  -- CYRILLIC SMALL LETTER ZHE WITH DESCENDER .. CYRILLIC SMALL LETTER ZHE WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER ZE WITH DESCENDER .. CYRILLIC SMALL LETTER ZE WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER KA WITH DESCENDER .. CYRILLIC SMALL LETTER KA WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE
-         -1,  -- CYRILLIC SMALL LETTER KA WITH STROKE .. CYRILLIC SMALL LETTER KA WITH STROKE
-         -1,  -- CYRILLIC SMALL LETTER BASHKIR KA .. CYRILLIC SMALL LETTER BASHKIR KA
-         -1,  -- CYRILLIC SMALL LETTER EN WITH DESCENDER .. CYRILLIC SMALL LETTER EN WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LIGATURE EN GHE .. CYRILLIC SMALL LIGATURE EN GHE
-         -1,  -- CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK .. CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK
-         -1,  -- CYRILLIC SMALL LETTER ABKHASIAN HA .. CYRILLIC SMALL LETTER ABKHASIAN HA
-         -1,  -- CYRILLIC SMALL LETTER ES WITH DESCENDER .. CYRILLIC SMALL LETTER ES WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER TE WITH DESCENDER .. CYRILLIC SMALL LETTER TE WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER STRAIGHT U .. CYRILLIC SMALL LETTER STRAIGHT U
-         -1,  -- CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE .. CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE
-         -1,  -- CYRILLIC SMALL LETTER HA WITH DESCENDER .. CYRILLIC SMALL LETTER HA WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LIGATURE TE TSE .. CYRILLIC SMALL LIGATURE TE TSE
-         -1,  -- CYRILLIC SMALL LETTER CHE WITH DESCENDER .. CYRILLIC SMALL LETTER CHE WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE .. CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE
-         -1,  -- CYRILLIC SMALL LETTER SHHA .. CYRILLIC SMALL LETTER SHHA
-         -1,  -- CYRILLIC SMALL LETTER ABKHASIAN CHE .. CYRILLIC SMALL LETTER ABKHASIAN CHE
-         -1,  -- CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER .. CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER
-         -1,  -- CYRILLIC SMALL LETTER ZHE WITH BREVE .. CYRILLIC SMALL LETTER ZHE WITH BREVE
-         -1,  -- CYRILLIC SMALL LETTER KA WITH HOOK .. CYRILLIC SMALL LETTER KA WITH HOOK
-         -1,  -- CYRILLIC SMALL LETTER EL WITH TAIL .. CYRILLIC SMALL LETTER EL WITH TAIL
-         -1,  -- CYRILLIC SMALL LETTER EN WITH HOOK .. CYRILLIC SMALL LETTER EN WITH HOOK
-         -1,  -- CYRILLIC SMALL LETTER EN WITH TAIL .. CYRILLIC SMALL LETTER EN WITH TAIL
-         -1,  -- CYRILLIC SMALL LETTER KHAKASSIAN CHE .. CYRILLIC SMALL LETTER KHAKASSIAN CHE
-         -1,  -- CYRILLIC SMALL LETTER EM WITH TAIL .. CYRILLIC SMALL LETTER EM WITH TAIL
-         -1,  -- CYRILLIC SMALL LETTER A WITH BREVE .. CYRILLIC SMALL LETTER A WITH BREVE
-         -1,  -- CYRILLIC SMALL LETTER A WITH DIAERESIS .. CYRILLIC SMALL LETTER A WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LIGATURE A IE .. CYRILLIC SMALL LIGATURE A IE
-         -1,  -- CYRILLIC SMALL LETTER IE WITH BREVE .. CYRILLIC SMALL LETTER IE WITH BREVE
-         -1,  -- CYRILLIC SMALL LETTER SCHWA .. CYRILLIC SMALL LETTER SCHWA
-         -1,  -- CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS .. CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER ZHE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZHE WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER ZE WITH DIAERESIS .. CYRILLIC SMALL LETTER ZE WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER ABKHASIAN DZE .. CYRILLIC SMALL LETTER ABKHASIAN DZE
-         -1,  -- CYRILLIC SMALL LETTER I WITH MACRON .. CYRILLIC SMALL LETTER I WITH MACRON
-         -1,  -- CYRILLIC SMALL LETTER I WITH DIAERESIS .. CYRILLIC SMALL LETTER I WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER O WITH DIAERESIS .. CYRILLIC SMALL LETTER O WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER BARRED O .. CYRILLIC SMALL LETTER BARRED O
-         -1,  -- CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS .. CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER E WITH DIAERESIS .. CYRILLIC SMALL LETTER E WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER U WITH MACRON .. CYRILLIC SMALL LETTER U WITH MACRON
-         -1,  -- CYRILLIC SMALL LETTER U WITH DIAERESIS .. CYRILLIC SMALL LETTER U WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE .. CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE
-         -1,  -- CYRILLIC SMALL LETTER CHE WITH DIAERESIS .. CYRILLIC SMALL LETTER CHE WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER YERU WITH DIAERESIS .. CYRILLIC SMALL LETTER YERU WITH DIAERESIS
-         -1,  -- CYRILLIC SMALL LETTER KOMI DE .. CYRILLIC SMALL LETTER KOMI DE
-         -1,  -- CYRILLIC SMALL LETTER KOMI DJE .. CYRILLIC SMALL LETTER KOMI DJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI ZJE .. CYRILLIC SMALL LETTER KOMI ZJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI DZJE .. CYRILLIC SMALL LETTER KOMI DZJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI LJE .. CYRILLIC SMALL LETTER KOMI LJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI NJE .. CYRILLIC SMALL LETTER KOMI NJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI SJE .. CYRILLIC SMALL LETTER KOMI SJE
-         -1,  -- CYRILLIC SMALL LETTER KOMI TJE .. CYRILLIC SMALL LETTER KOMI TJE
-        -48,  -- ARMENIAN SMALL LETTER AYB .. ARMENIAN SMALL LETTER FEH
-         -1,  -- LATIN SMALL LETTER A WITH RING BELOW .. LATIN SMALL LETTER A WITH RING BELOW
-         -1,  -- LATIN SMALL LETTER B WITH DOT ABOVE .. LATIN SMALL LETTER B WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER B WITH DOT BELOW .. LATIN SMALL LETTER B WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER B WITH LINE BELOW .. LATIN SMALL LETTER B WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER C WITH CEDILLA AND ACUTE .. LATIN SMALL LETTER C WITH CEDILLA AND ACUTE
-         -1,  -- LATIN SMALL LETTER D WITH DOT ABOVE .. LATIN SMALL LETTER D WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER D WITH DOT BELOW .. LATIN SMALL LETTER D WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER D WITH LINE BELOW .. LATIN SMALL LETTER D WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER D WITH CEDILLA .. LATIN SMALL LETTER D WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER E WITH MACRON AND GRAVE .. LATIN SMALL LETTER E WITH MACRON AND GRAVE
-         -1,  -- LATIN SMALL LETTER E WITH MACRON AND ACUTE .. LATIN SMALL LETTER E WITH MACRON AND ACUTE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER E WITH TILDE BELOW .. LATIN SMALL LETTER E WITH TILDE BELOW
-         -1,  -- LATIN SMALL LETTER E WITH CEDILLA AND BREVE .. LATIN SMALL LETTER E WITH CEDILLA AND BREVE
-         -1,  -- LATIN SMALL LETTER F WITH DOT ABOVE .. LATIN SMALL LETTER F WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER G WITH MACRON .. LATIN SMALL LETTER G WITH MACRON
-         -1,  -- LATIN SMALL LETTER H WITH DOT ABOVE .. LATIN SMALL LETTER H WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER H WITH DOT BELOW .. LATIN SMALL LETTER H WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER H WITH DIAERESIS .. LATIN SMALL LETTER H WITH DIAERESIS
-         -1,  -- LATIN SMALL LETTER H WITH CEDILLA .. LATIN SMALL LETTER H WITH CEDILLA
-         -1,  -- LATIN SMALL LETTER H WITH BREVE BELOW .. LATIN SMALL LETTER H WITH BREVE BELOW
-         -1,  -- LATIN SMALL LETTER I WITH TILDE BELOW .. LATIN SMALL LETTER I WITH TILDE BELOW
-         -1,  -- LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE .. LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE
-         -1,  -- LATIN SMALL LETTER K WITH ACUTE .. LATIN SMALL LETTER K WITH ACUTE
-         -1,  -- LATIN SMALL LETTER K WITH DOT BELOW .. LATIN SMALL LETTER K WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER K WITH LINE BELOW .. LATIN SMALL LETTER K WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER L WITH DOT BELOW .. LATIN SMALL LETTER L WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER L WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER L WITH DOT BELOW AND MACRON
-         -1,  -- LATIN SMALL LETTER L WITH LINE BELOW .. LATIN SMALL LETTER L WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER M WITH ACUTE .. LATIN SMALL LETTER M WITH ACUTE
-         -1,  -- LATIN SMALL LETTER M WITH DOT ABOVE .. LATIN SMALL LETTER M WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER M WITH DOT BELOW .. LATIN SMALL LETTER M WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER N WITH DOT ABOVE .. LATIN SMALL LETTER N WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER N WITH DOT BELOW .. LATIN SMALL LETTER N WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER N WITH LINE BELOW .. LATIN SMALL LETTER N WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER O WITH TILDE AND ACUTE .. LATIN SMALL LETTER O WITH TILDE AND ACUTE
-         -1,  -- LATIN SMALL LETTER O WITH TILDE AND DIAERESIS .. LATIN SMALL LETTER O WITH TILDE AND DIAERESIS
-         -1,  -- LATIN SMALL LETTER O WITH MACRON AND GRAVE .. LATIN SMALL LETTER O WITH MACRON AND GRAVE
-         -1,  -- LATIN SMALL LETTER O WITH MACRON AND ACUTE .. LATIN SMALL LETTER O WITH MACRON AND ACUTE
-         -1,  -- LATIN SMALL LETTER P WITH ACUTE .. LATIN SMALL LETTER P WITH ACUTE
-         -1,  -- LATIN SMALL LETTER P WITH DOT ABOVE .. LATIN SMALL LETTER P WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER R WITH DOT ABOVE .. LATIN SMALL LETTER R WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER R WITH DOT BELOW .. LATIN SMALL LETTER R WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER R WITH DOT BELOW AND MACRON .. LATIN SMALL LETTER R WITH DOT BELOW AND MACRON
-         -1,  -- LATIN SMALL LETTER R WITH LINE BELOW .. LATIN SMALL LETTER R WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER S WITH DOT ABOVE .. LATIN SMALL LETTER S WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER S WITH DOT BELOW .. LATIN SMALL LETTER S WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE .. LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE
-         -1,  -- LATIN SMALL LETTER S WITH CARON AND DOT ABOVE .. LATIN SMALL LETTER S WITH CARON AND DOT ABOVE
-         -1,  -- LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE .. LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE
-         -1,  -- LATIN SMALL LETTER T WITH DOT ABOVE .. LATIN SMALL LETTER T WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER T WITH DOT BELOW .. LATIN SMALL LETTER T WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER T WITH LINE BELOW .. LATIN SMALL LETTER T WITH LINE BELOW
-         -1,  -- LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER U WITH DIAERESIS BELOW .. LATIN SMALL LETTER U WITH DIAERESIS BELOW
-         -1,  -- LATIN SMALL LETTER U WITH TILDE BELOW .. LATIN SMALL LETTER U WITH TILDE BELOW
-         -1,  -- LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW .. LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW
-         -1,  -- LATIN SMALL LETTER U WITH TILDE AND ACUTE .. LATIN SMALL LETTER U WITH TILDE AND ACUTE
-         -1,  -- LATIN SMALL LETTER U WITH MACRON AND DIAERESIS .. LATIN SMALL LETTER U WITH MACRON AND DIAERESIS
-         -1,  -- LATIN SMALL LETTER V WITH TILDE .. LATIN SMALL LETTER V WITH TILDE
-         -1,  -- LATIN SMALL LETTER V WITH DOT BELOW .. LATIN SMALL LETTER V WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER W WITH GRAVE .. LATIN SMALL LETTER W WITH GRAVE
-         -1,  -- LATIN SMALL LETTER W WITH ACUTE .. LATIN SMALL LETTER W WITH ACUTE
-         -1,  -- LATIN SMALL LETTER W WITH DIAERESIS .. LATIN SMALL LETTER W WITH DIAERESIS
-         -1,  -- LATIN SMALL LETTER W WITH DOT ABOVE .. LATIN SMALL LETTER W WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER W WITH DOT BELOW .. LATIN SMALL LETTER W WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER X WITH DOT ABOVE .. LATIN SMALL LETTER X WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER X WITH DIAERESIS .. LATIN SMALL LETTER X WITH DIAERESIS
-         -1,  -- LATIN SMALL LETTER Y WITH DOT ABOVE .. LATIN SMALL LETTER Y WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER Z WITH CIRCUMFLEX .. LATIN SMALL LETTER Z WITH CIRCUMFLEX
-         -1,  -- LATIN SMALL LETTER Z WITH DOT BELOW .. LATIN SMALL LETTER Z WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER Z WITH LINE BELOW .. LATIN SMALL LETTER Z WITH LINE BELOW
-        -59,  -- LATIN SMALL LETTER LONG S WITH DOT ABOVE .. LATIN SMALL LETTER LONG S WITH DOT ABOVE
-         -1,  -- LATIN SMALL LETTER A WITH DOT BELOW .. LATIN SMALL LETTER A WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER A WITH HOOK ABOVE .. LATIN SMALL LETTER A WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
-         -1,  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
-         -1,  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
-         -1,  -- LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER A WITH BREVE AND ACUTE .. LATIN SMALL LETTER A WITH BREVE AND ACUTE
-         -1,  -- LATIN SMALL LETTER A WITH BREVE AND GRAVE .. LATIN SMALL LETTER A WITH BREVE AND GRAVE
-         -1,  -- LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE .. LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER A WITH BREVE AND TILDE .. LATIN SMALL LETTER A WITH BREVE AND TILDE
-         -1,  -- LATIN SMALL LETTER A WITH BREVE AND DOT BELOW .. LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER E WITH DOT BELOW .. LATIN SMALL LETTER E WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER E WITH HOOK ABOVE .. LATIN SMALL LETTER E WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER E WITH TILDE .. LATIN SMALL LETTER E WITH TILDE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
-         -1,  -- LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER I WITH HOOK ABOVE .. LATIN SMALL LETTER I WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER I WITH DOT BELOW .. LATIN SMALL LETTER I WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER O WITH DOT BELOW .. LATIN SMALL LETTER O WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER O WITH HOOK ABOVE .. LATIN SMALL LETTER O WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
-         -1,  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
-         -1,  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
-         -1,  -- LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW .. LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER O WITH HORN AND ACUTE .. LATIN SMALL LETTER O WITH HORN AND ACUTE
-         -1,  -- LATIN SMALL LETTER O WITH HORN AND GRAVE .. LATIN SMALL LETTER O WITH HORN AND GRAVE
-         -1,  -- LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER O WITH HORN AND TILDE .. LATIN SMALL LETTER O WITH HORN AND TILDE
-         -1,  -- LATIN SMALL LETTER O WITH HORN AND DOT BELOW .. LATIN SMALL LETTER O WITH HORN AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER U WITH DOT BELOW .. LATIN SMALL LETTER U WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER U WITH HOOK ABOVE .. LATIN SMALL LETTER U WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER U WITH HORN AND ACUTE .. LATIN SMALL LETTER U WITH HORN AND ACUTE
-         -1,  -- LATIN SMALL LETTER U WITH HORN AND GRAVE .. LATIN SMALL LETTER U WITH HORN AND GRAVE
-         -1,  -- LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE .. LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER U WITH HORN AND TILDE .. LATIN SMALL LETTER U WITH HORN AND TILDE
-         -1,  -- LATIN SMALL LETTER U WITH HORN AND DOT BELOW .. LATIN SMALL LETTER U WITH HORN AND DOT BELOW
-         -1,  -- LATIN SMALL LETTER Y WITH GRAVE .. LATIN SMALL LETTER Y WITH GRAVE
-         -1,  -- LATIN SMALL LETTER Y WITH DOT BELOW .. LATIN SMALL LETTER Y WITH DOT BELOW
-         -1,  -- LATIN SMALL LETTER Y WITH HOOK ABOVE .. LATIN SMALL LETTER Y WITH HOOK ABOVE
-         -1,  -- LATIN SMALL LETTER Y WITH TILDE .. LATIN SMALL LETTER Y WITH TILDE
-          8,  -- GREEK SMALL LETTER ALPHA WITH PSILI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI
-          8,  -- GREEK SMALL LETTER EPSILON WITH PSILI .. GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA
-          8,  -- GREEK SMALL LETTER ETA WITH PSILI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI
-          8,  -- GREEK SMALL LETTER IOTA WITH PSILI .. GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI
-          8,  -- GREEK SMALL LETTER OMICRON WITH PSILI .. GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA
-          8,  -- GREEK SMALL LETTER UPSILON WITH DASIA .. GREEK SMALL LETTER UPSILON WITH DASIA
-          8,  -- GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA
-          8,  -- GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA .. GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA
-          8,  -- GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI .. GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI
-          8,  -- GREEK SMALL LETTER OMEGA WITH PSILI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI
-         74,  -- GREEK SMALL LETTER ALPHA WITH VARIA .. GREEK SMALL LETTER ALPHA WITH OXIA
-         86,  -- GREEK SMALL LETTER EPSILON WITH VARIA .. GREEK SMALL LETTER ETA WITH OXIA
-        100,  -- GREEK SMALL LETTER IOTA WITH VARIA .. GREEK SMALL LETTER IOTA WITH OXIA
-        128,  -- GREEK SMALL LETTER OMICRON WITH VARIA .. GREEK SMALL LETTER OMICRON WITH OXIA
-        112,  -- GREEK SMALL LETTER UPSILON WITH VARIA .. GREEK SMALL LETTER UPSILON WITH OXIA
-        126,  -- GREEK SMALL LETTER OMEGA WITH VARIA .. GREEK SMALL LETTER OMEGA WITH OXIA
-          8,  -- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-          8,  -- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-          8,  -- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
-          8,  -- GREEK SMALL LETTER ALPHA WITH VRACHY .. GREEK SMALL LETTER ALPHA WITH MACRON
-          9,  -- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
-      -7205,  -- GREEK PROSGEGRAMMENI .. GREEK PROSGEGRAMMENI
-          9,  -- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
-          8,  -- GREEK SMALL LETTER IOTA WITH VRACHY .. GREEK SMALL LETTER IOTA WITH MACRON
-          8,  -- GREEK SMALL LETTER UPSILON WITH VRACHY .. GREEK SMALL LETTER UPSILON WITH MACRON
-          7,  -- GREEK SMALL LETTER RHO WITH DASIA .. GREEK SMALL LETTER RHO WITH DASIA
-          9,  -- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI .. GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
-        -32,  -- FULLWIDTH LATIN SMALL LETTER A .. FULLWIDTH LATIN SMALL LETTER Z
-        -40); -- DESERET SMALL LETTER LONG I .. DESERET SMALL LETTER ENG
- 
-    -----------------------
-    -- Local Subprograms --
-    -----------------------
- 
-    function Range_Search (U : Char_Code; R : UTF_32_Ranges) return Natural;
-    --  Searches the given ranges (which must be in ascending order by Lo value)
-    --  and returns the index of the matching range in R if U matches one of the
-    --  ranges. If U matches none of the ranges, returns zero.
- 
-    ---------------------
-    -- Is_UTF_32_Digit --
-    ---------------------
- 
-    function Is_UTF_32_Digit (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Digits) /= 0;
-    end Is_UTF_32_Digit;
- 
-    ----------------------
-    -- Is_UTF_32_Letter --
-    ----------------------
- 
-    function Is_UTF_32_Letter (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Letters) /= 0;
-    end Is_UTF_32_Letter;
- 
-    -------------------------------
-    -- Is_UTF_32_Line_Terminator --
-    -------------------------------
- 
-    function Is_UTF_32_Line_Terminator (U : Char_Code) return Boolean is
-    begin
-       return U in 10 .. 13     -- Ascii.LF Ascii.VT Ascii.FF Ascii.CR
-         or else U = 16#02028#  -- LINE SEPARATOR
-         or else U = 16#02029#; -- PARAGRAPH SEPARATOR
-    end Is_UTF_32_Line_Terminator;
- 
-    --------------------
-    -- Is_UTF_32_Mark --
-    --------------------
- 
-    function Is_UTF_32_Mark (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Marks) /= 0;
-    end Is_UTF_32_Mark;
- 
-    ---------------------------
-    -- Is_UTF_32_Non_Graphic --
-    ---------------------------
- 
-    function Is_UTF_32_Non_Graphic (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Non_Graphic) /= 0;
-    end Is_UTF_32_Non_Graphic;
- 
-    ---------------------
-    -- Is_UTF_32_Other --
-    ---------------------
- 
-    function Is_UTF_32_Other (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Other_Format) /= 0;
-    end Is_UTF_32_Other;
- 
-    ---------------------------
-    -- Is_UTF_32_Punctuation --
-    ---------------------------
- 
-    function Is_UTF_32_Punctuation (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Punctuation) /= 0;
-    end Is_UTF_32_Punctuation;
- 
-    ---------------------
-    -- Is_UTF_32_Space --
-    ---------------------
- 
-    function Is_UTF_32_Space (U : Char_Code) return Boolean is
-    begin
-       return Range_Search (U, UTF_32_Spaces) /= 0;
-    end Is_UTF_32_Space;
- 
     ---------------------------
     -- Is_Start_Of_Wide_Char --
     ---------------------------
--- 42,47 ----
*************** package body Widechar is
*** 1615,1656 ****
        return WC_Longest_Sequence;
     end Length_Wide;
  
-    ------------------
-    -- Range_Search --
-    ------------------
- 
-    function Range_Search (U : Char_Code; R : UTF_32_Ranges) return Natural is
-       Lo  : Integer;
-       Hi  : Integer;
-       Mid : Integer;
- 
-    begin
-       Lo := R'First;
-       Hi := R'Last;
- 
-       loop
-          Mid := (Lo + Hi) / 2;
- 
-          if U < R (Mid).Lo then
-             Hi := Mid - 1;
- 
-             if Hi < Lo then
-                return 0;
-             end if;
- 
-          elsif R (Mid).Hi < U then
-             Lo := Mid + 1;
- 
-             if Hi < Lo then
-                return 0;
-             end if;
- 
-          else
-             return Mid;
-          end if;
-       end loop;
-    end Range_Search;
- 
     ---------------
     -- Scan_Wide --
     ---------------
--- 78,83 ----
*************** package body Widechar is
*** 1661,1666 ****
--- 88,95 ----
        C   : out Char_Code;
        Err : out Boolean)
     is
+       P_Init : constant Source_Ptr := P;
+ 
        function In_Char return Character;
        --  Function to obtain characters of wide character escape sequence
  
*************** package body Widechar is
*** 1681,1686 ****
--- 110,116 ----
     begin
        C := Char_Code (WC_In (In_Char, Wide_Character_Encoding_Method));
        Err := False;
+       Wide_Char_Byte_Count := Wide_Char_Byte_Count + Nat (P - P_Init - 1);
  
     exception
        when Constraint_Error =>
*************** package body Widechar is
*** 1724,1729 ****
--- 154,161 ----
     ---------------
  
     procedure Skip_Wide (S : String; P : in out Natural) is
+       P_Init : constant Natural := P;
+ 
        function Skip_Char return Character;
        --  Function to skip one character of wide character escape sequence
  
*************** package body Widechar is
*** 1746,1751 ****
--- 178,184 ----
  
     begin
        Discard := WC_Skip (Skip_Char, Wide_Character_Encoding_Method);
+       Wide_Char_Byte_Count := Wide_Char_Byte_Count + Nat (P - P_Init - 1);
     end Skip_Wide;
  
     ---------------
*************** package body Widechar is
*** 1753,1758 ****
--- 186,193 ----
     ---------------
  
     procedure Skip_Wide (S : Source_Buffer_Ptr; P : in out Source_Ptr) is
+       P_Init : constant Source_Ptr := P;
+ 
        function Skip_Char return Character;
        --  Function to skip one character of wide character escape sequence
  
*************** package body Widechar is
*** 1775,1794 ****
  
     begin
        Discard := WC_Skip (Skip_Char, Wide_Character_Encoding_Method);
     end Skip_Wide;
  
-    --------------------------
-    -- UTF_32_To_Upper_Case --
-    --------------------------
- 
-    function UTF_32_To_Upper_Case (U : Char_Code) return Char_Code is
-       Index : constant Integer := Range_Search (U, Lower_Case_Letters);
-    begin
-       if Index = 0 then
-          return U;
-       else
-          return U + Upper_Case_Adjust (Index);
-       end if;
-    end UTF_32_To_Upper_Case;
- 
  end Widechar;
--- 210,216 ----
  
     begin
        Discard := WC_Skip (Skip_Char, Wide_Character_Encoding_Method);
+       Wide_Char_Byte_Count := Wide_Char_Byte_Count + Nat (P - P_Init - 1);
     end Skip_Wide;
  
  end Widechar;
diff -Nrcpad gcc-4.0.2/gcc/ada/widechar.ads gcc-4.1.0/gcc/ada/widechar.ads
*** gcc-4.0.2/gcc/ada/widechar.ads	Thu Feb 10 13:50:48 2005
--- gcc-4.1.0/gcc/ada/widechar.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- As a special exception,  if other files  instantiate  generics from this --
  -- unit, or you link  this unit with other files  to produce an executable, --
*************** with Types; use Types;
*** 40,45 ****
--- 40,52 ----
  
  package Widechar is
  
+    Wide_Char_Byte_Count : Nat := 0;
+    --  This value is incremented whenever Scan_Wide or Skip_Wide is called.
+    --  The amount added is the length of the wide character sequence minus
+    --  one. This means that the count that accululates here represents the
+    --  difference between the length in characters and the length in bytes.
+    --  This is used for checking the line length in characters.
+ 
     function Length_Wide return Nat;
     --  Returns the maximum length in characters for the escape sequence that
     --  is used to encode wide character literals outside the ASCII range. Used
*************** package Widechar is
*** 90,167 ****
        P : Source_Ptr) return Boolean;
     --  Determines if S (P) is the start of a wide character sequence
  
-    function Is_UTF_32_Letter (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Letter);
-    --  Returns true iff U is a letter that can be used to start an identifier.
-    --  This means that it is in one of the following categories:
-    --    Letter, Uppercase (Lu)
-    --    Letter, Lowercase (Ll)
-    --    Letter, Titlecase (Lt)
-    --    Letter, Modifier  (Lm)
-    --    Letter, Other     (Lo)
-    --    Number, Letter    (Nl)
- 
-    function Is_UTF_32_Digit (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Digit);
-    --  Returns true iff U is a digit that can be used to extend an identifer,
-    --  which means it is in one of the following categories:
-    --    Number, Decimal_Digit (Nd)
- 
-    function Is_UTF_32_Line_Terminator (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Line_Terminator);
-    --  Returns true iff U is an allowed line terminator for source programs,
-    --  which means it is in one of the following categories:
-    --    Separator, Line (Zl)
-    --    Separator, Paragraph (Zp)
-    --  or that it is a conventional line terminator (CR, LF, VT, FF)
- 
-    function Is_UTF_32_Mark (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Mark);
-    --  Returns true iff U is a mark character which can be used to extend
-    --  an identifier. This means it is in one of the following categories:
-    --    Mark, Non-Spacing (Mn)
-    --    Mark, Spacing Combining (Mc)
- 
-    function Is_UTF_32_Other (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Other);
-    --  Returns true iff U is an other format character, which means that it
-    --  can be used to extend an identifier, but is ignored for the purposes of
-    --  matching of identiers. This means that it is in one of the following
-    --  categories:
-    --    Other, Format (Cf)
- 
-    function Is_UTF_32_Punctuation (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Punctuation);
-    --  Returns true iff U is a punctuation character that can be used to
-    --  separate pices of an identifier. This means that it is in one of the
-    --  following categories:
-    --    Punctuation, Connector (Pc)
- 
-    function Is_UTF_32_Space (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Space);
-    --  Returns true iff U is considered a space to be ignored, which means
-    --  that it is in one of the following categories:
-    --    Separator, Space (Zs)
- 
-    function Is_UTF_32_Non_Graphic (U : Char_Code) return Boolean;
-    pragma Inline (Is_UTF_32_Non_Graphic);
-    --  Returns true iff U is considered to be a non-graphic character,
-    --  which means that it is in one of the following categories:
-    --    Other, Control (Cc)
-    --    Other, Private Use (Co)
-    --    Other, Surrogate (Cs)
-    --    Other, Format (Cf)
-    --    Separator, Line (Zl)
-    --    Separator, Paragraph (Zp)
-    --
-    --  Note that the Ada category format effector is subsumed by the above
-    --  list of Unicode categories.
- 
-    function UTF_32_To_Upper_Case (U : Char_Code) return Char_Code;
-    pragma Inline (UTF_32_To_Upper_Case);
-    --  If U represents a lower case letter, returns the corresponding upper
-    --  case letter, otherwise U is returned unchanged. The folding is locale
-    --  independent as defined by documents referenced in the note in section
-    --  1 of ISO/IEC 10646:2003
- 
  end Widechar;
--- 97,100 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/xeinfo.adb gcc-4.1.0/gcc/ada/xeinfo.adb
*** gcc-4.0.2/gcc/ada/xeinfo.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/xeinfo.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
***************
*** 25,31 ****
  ------------------------------------------------------------------------------
  
  --  Program to construct C header file a-einfo.h (C version of einfo.ads spec)
! --  for use by Gigi. This header file contaInF all definitions and access
  --  functions, but does not contain set procedures, since Gigi is not allowed
  --  to modify the GNAT tree)
  
--- 25,31 ----
  ------------------------------------------------------------------------------
  
  --  Program to construct C header file a-einfo.h (C version of einfo.ads spec)
! --  for use by Gigi. This header file contains all definitions and access
  --  functions, but does not contain set procedures, since Gigi is not allowed
  --  to modify the GNAT tree)
  
diff -Nrcpad gcc-4.0.2/gcc/ada/xgnatugn.adb gcc-4.1.0/gcc/ada/xgnatugn.adb
*** gcc-4.0.2/gcc/ada/xgnatugn.adb	Mon Aug  9 12:24:22 2004
--- gcc-4.1.0/gcc/ada/xgnatugn.adb	Tue Nov 15 14:05:17 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 2003-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  ------------------------------------------------------------------------------
  
*************** procedure Xgnatugn is
*** 180,187 ****
     Target : Target_Type;
     --  The Target variable is initialized using the command line
  
!    Valid_Characters : constant Character_Set
!      := To_Set (Span => (' ',  '~'));
     --  This array controls which characters are permitted in the input
     --  file (after line breaks have been removed). Valid characters
     --  are all printable ASCII characters and the space character.
--- 180,187 ----
     Target : Target_Type;
     --  The Target variable is initialized using the command line
  
!    Valid_Characters : constant Character_Set :=
!                         To_Set (Span => (' ',  '~'));
     --  This array controls which characters are permitted in the input
     --  file (after line breaks have been removed). Valid characters
     --  are all printable ASCII characters and the space character.
*************** procedure Xgnatugn is
*** 748,754 ****
  
                       else
  
!                         --  Extend Seq to cover the current (known) word.
  
                          Seq.Last := Token.Span.Last;
                          Next_Token;
--- 748,754 ----
  
                       else
  
!                         --  Extend Seq to cover the current (known) word
  
                          Seq.Last := Token.Span.Last;
                          Next_Token;
*************** procedure Xgnatugn is
*** 1045,1051 ****
  
              if (not Have_Conditional) or (Flag in Edition_Type) then
  
!                --  The ordinary case.
  
                 if not Currently_Excluding then
                    Put_Line (Output_File, Rewritten);
--- 1045,1051 ----
  
              if (not Have_Conditional) or (Flag in Edition_Type) then
  
!                --  The ordinary case
  
                 if not Currently_Excluding then
                    Put_Line (Output_File, Rewritten);
*************** procedure Xgnatugn is
*** 1068,1074 ****
        --  case).
  
        procedure Add (Extension, Replacement : String);
!       --  Adds an extension with a custom replacement.
  
        ---------
        -- Add --
--- 1068,1074 ----
        --  case).
  
        procedure Add (Extension, Replacement : String);
!       --  Adds an extension with a custom replacement
  
        ---------
        -- Add --
*************** begin
*** 1294,1300 ****
        begin
           Target := Flag_Type'Value (Argument (1));
  
!          if Target not in Target_Type then
              Valid_Command_Line := False;
           end if;
  
--- 1294,1300 ----
        begin
           Target := Flag_Type'Value (Argument (1));
  
!          if not Target'Valid then
              Valid_Command_Line := False;
           end if;
  
diff -Nrcpad gcc-4.0.2/gcc/ada/xnmake.adb gcc-4.1.0/gcc/ada/xnmake.adb
*** gcc-4.0.2/gcc/ada/xnmake.adb	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/xnmake.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Ada.Strings.Unbounded;         use 
*** 53,58 ****
--- 53,59 ----
  with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
  with Ada.Strings.Maps;              use Ada.Strings.Maps;
  with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
+ with Ada.Streams.Stream_IO;         use Ada.Streams.Stream_IO;
  with Ada.Text_IO;                   use Ada.Text_IO;
  
  with GNAT.Spitbol;                  use GNAT.Spitbol;
*************** procedure XNmake is
*** 76,82 ****
     Synonym    : VString := Nul;
     X          : VString := Nul;
  
-    Lineno : Natural;
     NWidth : Natural;
  
     FileS : VString := V ("nmake.ads");
--- 77,82 ----
*************** procedure XNmake is
*** 86,95 ****
     Given_File : VString := Nul;
     --  File name given by command line argument
  
!    InS,  InT  : File_Type;
!    OutS, OutB : File_Type;
  
!    wsp   : Pattern := Span (' ' & ASCII.HT);
  
     Body_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  body only";
     Spec_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  spec only";
--- 86,97 ----
     Given_File : VString := Nul;
     --  File name given by command line argument
  
!    subtype Sfile is Ada.Streams.Stream_IO.File_Type;
  
!    InS,  InT  : Ada.Text_IO.File_Type;
!    OutS, OutB : Sfile;
! 
!    wsp : Pattern := Span (' ' & ASCII.HT);
  
     Body_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  body only";
     Spec_Only : Pattern := BreakX (' ') * X & Span (' ') & "--  spec only";
*************** procedure XNmake is
*** 130,135 ****
--- 132,141 ----
     V_Elist_Id  : constant VString := V ("Elist_Id");
     V_Boolean   : constant VString := V ("Boolean");
  
+    procedure Put_Line (F : Sfile; S : String);
+    procedure Put_Line (F : Sfile; S : VString);
+    --  Local version of Put_Line ensures Unix style line endings
+ 
     procedure WriteS  (S : String);
     procedure WriteB  (S : String);
     procedure WriteBS (S : String);
*************** procedure XNmake is
*** 188,197 ****
        end if;
     end WriteS;
  
  --  Start of processing for XNmake
  
  begin
-    Lineno := 0;
     NWidth := 28;
     Anchored_Mode := True;
  
--- 194,213 ----
        end if;
     end WriteS;
  
+    procedure Put_Line (F : Sfile; S : String) is
+    begin
+       String'Write (Stream (F), S);
+       Character'Write (Stream (F), ASCII.LF);
+    end Put_Line;
+ 
+    procedure Put_Line (F : Sfile; S : VString) is
+    begin
+       Put_Line (F, To_String (S));
+    end Put_Line;
+ 
  --  Start of processing for XNmake
  
  begin
     NWidth := 28;
     Anchored_Mode := True;
  
*************** begin
*** 267,274 ****
--- 283,294 ----
           end loop;
        end if;
  
+       --  Loop keeps going until "package" keyword written
+ 
        exit when Match (Line, "package");
  
+       --  Deal with WITH lines, writing to body or spec as appropriate
+ 
        if Match (Line, Body_Only, M) then
           Replace (M, X);
           WriteB (Line);
*************** begin
*** 277,282 ****
--- 297,304 ----
           Replace (M, X);
           WriteS (Line);
  
+       --  Change header from Template to Spec and write to spec file
+ 
        else
           if Match (Line, Templ, M) then
              Replace (M, A &  "    S p e c    ");
*************** begin
*** 284,289 ****
--- 306,313 ----
  
           WriteS (Line);
  
+          --  Write header line to body file
+ 
           if Match (Line, Spec, M) then
              Replace (M, A &  "B o d y");
           end if;
diff -Nrcpad gcc-4.0.2/gcc/ada/xr_tabls.adb gcc-4.1.0/gcc/ada/xr_tabls.adb
*** gcc-4.0.2/gcc/ada/xr_tabls.adb	Wed Jan 21 10:35:18 2004
--- gcc-4.1.0/gcc/ada/xr_tabls.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Xr_Tabls is
*** 131,137 ****
     --  Column. This key should be used for lookup in Entity_HTable
  
     function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean;
!    --  Compare two declarations. The comparison is case-insensitive.
  
     function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean;
     --  Compare two references
--- 131,137 ----
     --  Column. This key should be used for lookup in Entity_HTable
  
     function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean;
!    --  Compare two declarations (the comparison is case-insensitive)
  
     function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean;
     --  Compare two references
*************** package body Xr_Tabls is
*** 144,157 ****
        Get_Declaration : Boolean := False;
        Arr             : in out Reference_Array;
        Index           : in out Natural);
!    --  Store in Arr, starting at Index, all the references to Decl.
!    --  The Get_* parameters can be used to indicate which references should be
!    --  stored.
     --  Constraint_Error will be raised if Arr is not big enough.
  
     procedure Sort (Arr : in out Reference_Array);
!    --  Sort an array of references.
!    --  Arr'First must be 1.
  
     --------------
     -- Set_Next --
--- 144,155 ----
        Get_Declaration : Boolean := False;
        Arr             : in out Reference_Array;
        Index           : in out Natural);
!    --  Store in Arr, starting at Index, all the references to Decl. The Get_*
!    --  parameters can be used to indicate which references should be stored.
     --  Constraint_Error will be raised if Arr is not big enough.
  
     procedure Sort (Arr : in out Reference_Array);
!    --  Sort an array of references (Arr'First must be 1)
  
     --------------
     -- Set_Next --
*************** package body Xr_Tabls is
*** 556,563 ****
     -------------------------
  
     procedure Create_Project_File (Name : String) is
-       use Ada.Strings.Unbounded;
- 
        Obj_Dir     : Unbounded_String := Null_Unbounded_String;
        Src_Dir     : Unbounded_String := Null_Unbounded_String;
        Build_Dir   : GNAT.OS_Lib.String_Access := new String'("");
--- 554,559 ----
diff -Nrcpad gcc-4.0.2/gcc/ada/xr_tabls.ads gcc-4.1.0/gcc/ada/xr_tabls.ads
*** gcc-4.0.2/gcc/ada/xr_tabls.ads	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/xr_tabls.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --         Copyright (C) 1998-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Xr_Tabls is
*** 35,41 ****
     -------------------
  
     function ALI_File_Name (Ada_File_Name : String) return String;
!    --  Returns the ali file name corresponding to Ada_File_Name.
  
     procedure Create_Project_File (Name : String);
     --  Open and parse a new project file. If the file Name could not be
--- 35,41 ----
     -------------------
  
     function ALI_File_Name (Ada_File_Name : String) return String;
!    --  Returns the ali file name corresponding to Ada_File_Name
  
     procedure Create_Project_File (Name : String);
     --  Open and parse a new project file. If the file Name could not be
*************** package Xr_Tabls is
*** 82,95 ****
        Remove_Only  : Boolean := False;
        Symbol_Match : Boolean := True)
        return         Declaration_Reference;
!    --  Add a new declaration in the table and return the index to it.
!    --  Decl_Type is the type of the entity Any previous instance of this
!    --  entity in the htable is removed. If Remove_Only is True, then any
!    --  previous instance is removed, but the new entity is never inserted.
!    --  Symbol_Match should be set to False if the name of the symbol doesn't
!    --  match the pattern from the command line. In that case, the entity will
!    --  not be output by gnatfind. If Symbol_Match is True, the entity will only
!    --  be output if the file name itself matches.
  
     procedure Add_Parent
       (Declaration : in out Declaration_Reference;
--- 82,95 ----
        Remove_Only  : Boolean := False;
        Symbol_Match : Boolean := True)
        return         Declaration_Reference;
!    --  Add a new declaration in the table and return the index to it. Decl_Type
!    --  is the type of the entity Any previous instance of this entity in the
!    --  htable is removed. If Remove_Only is True, then any previous instance is
!    --  removed, but the new entity is never inserted. Symbol_Match should be
!    --  set to False if the name of the symbol doesn't match the pattern from
!    --  the command line. In that case, the entity will not be output by
!    --  gnatfind. If Symbol_Match is True, the entity will only be output if the
!    --  file name itself matches.
  
     procedure Add_Parent
       (Declaration : in out Declaration_Reference;
*************** package Xr_Tabls is
*** 160,169 ****
        Get_Writes : Boolean := False;
        Get_Bodies : Boolean := False)
        return       Reference_Array_Access;
!    --  Return a sorted list of all references to the entity in decl.
!    --  The parameters Get_* are used to specify what kind of references
!    --  should be merged and returned (read-only accesses, write accesses
!    --  and bodies).
  
     function Get_Column (Decl : Declaration_Reference) return String;
     function Get_Column (Ref : Reference) return String;
--- 160,168 ----
        Get_Writes : Boolean := False;
        Get_Bodies : Boolean := False)
        return       Reference_Array_Access;
!    --  Return a sorted list of all references to the entity in decl. The
!    --  parameters Get_* are used to specify what kind of references should be
!    --  merged and returned (read-only accesses, write accesses and bodies).
  
     function Get_Column (Decl : Declaration_Reference) return String;
     function Get_Column (Ref : Reference) return String;
*************** package Xr_Tabls is
*** 216,229 ****
       (File     : File_Reference;
        With_Dir : Boolean := False;
        Strip    : Natural := 0) return String;
!    --  Returns the file name (and its directory if With_Dir is True or the
!    --  user has used the -f switch on the command line. If Strip is not 0,
!    --  then the last Strip-th "-..." substrings are removed first. For
!    --  instance, with Strip=2, a file name "parent-child1-child2-child3.ali"
!    --  would be returned as "parent-child1.ali". This is used when looking
!    --  for the ALI file to use for a package, since for separates with have
!    --  to use the parent's ALI. The null string is returned if there is no
!    --  such parent unit.
     --
     --  Note that this version of Get_File is not inlined
  
--- 215,227 ----
       (File     : File_Reference;
        With_Dir : Boolean := False;
        Strip    : Natural := 0) return String;
!    --  Returns the file name (and its directory if With_Dir is True or the user
!    --  has used the -f switch on the command line. If Strip is not 0, then the
!    --  last Strip-th "-..." substrings are removed first. For instance, with
!    --  Strip=2, a file name "parent-child1-child2-child3.ali" would be returned
!    --  as "parent-child1.ali". This is used when looking for the ALI file to
!    --  use for a package, since for separates with have to use the parent's
!    --  ALI. The null string is returned if there is no such parent unit.
     --
     --  Note that this version of Get_File is not inlined
  
*************** package Xr_Tabls is
*** 240,255 ****
     --  Return the source line associated with the reference
  
     procedure Grep_Source_Files;
!    --  Parse all the source files which have at least one reference,
!    --  and grep the appropriate source lines so that we'll be able to
!    --  display them.  This function should be called once all the .ali
!    --  files have been parsed, and only if the appropriate user switch
     --  has been used (gnatfind -s).
     --
!    --  Note: To save memory, the strings for the source lines are shared.
!    --  Thus it is no longer possible to free the references, or we would
!    --  free the same chunk multiple times. It doesn't matter, though, since
!    --  this is only called once, prior to exiting gnatfind.
  
     function Longest_File_Name return Natural;
     --  Returns the longest file name found
--- 238,253 ----
     --  Return the source line associated with the reference
  
     procedure Grep_Source_Files;
!    --  Parse all the source files which have at least one reference, and grep
!    --  the appropriate source lines so that we'll be able to display them. This
!    --  function should be called once all the .ali files have been parsed, and
!    --  only if the appropriate user switch
     --  has been used (gnatfind -s).
     --
!    --  Note: To save memory, the strings for the source lines are shared. Thus
!    --  it is no longer possible to free the references, or we would free the
!    --  same chunk multiple times. It doesn't matter, though, since this is only
!    --  called once, prior to exiting gnatfind.
  
     function Longest_File_Name return Natural;
     --  Returns the longest file name found
*************** package Xr_Tabls is
*** 266,274 ****
     --  by the user
  
     function Next_Unvisited_File return File_Reference;
!    --  Returns the next unvisited library file in the list
!    --  If there is no more unvisited file, return Empty_File.
!    --  Two calls to this subprogram will return different files.
  
     procedure Set_Default_Match (Value : Boolean);
     --  Set the default value for match in declarations.
--- 264,272 ----
     --  by the user
  
     function Next_Unvisited_File return File_Reference;
!    --  Returns the next unvisited library file in the list If there is no more
!    --  unvisited file, return Empty_File. Two calls to this subprogram will
!    --  return different files.
  
     procedure Set_Default_Match (Value : Boolean);
     --  Set the default value for match in declarations.
*************** package Xr_Tabls is
*** 276,298 ****
     --  command line, then every file match
  
     procedure Reset_Directory (File : File_Reference);
!    --  Reset the cached directory for file. Next time Get_File is
!    --  called, the directory willl be recomputed.
  
     procedure Set_Unvisited (File_Ref : File_Reference);
!    --  Set File_Ref as unvisited. So Next_Unvisited_File will return it.
  
     procedure Read_File
       (File_Name : String;
        Contents  : out GNAT.OS_Lib.String_Access);
!    --  Reads File_Name into the newly allocated strig Contents. A
!    --  Types.EOF character will be added to the returned Contents to
!    --  simplify parsing. Name_Error is raised if the file was not found.
!    --  End_Error is raised if the file could not be read correctly. For
!    --  most systems correct reading means that the number of bytes read
!    --  is equal to the file size. The exception is OpenVMS where correct
!    --  reading means that the number of bytes read is less than or equal
!    --  to the file size.
  
  private
     type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record
--- 274,295 ----
     --  command line, then every file match
  
     procedure Reset_Directory (File : File_Reference);
!    --  Reset the cached directory for file. Next time Get_File is called, the
!    --  directory willl be recomputed.
  
     procedure Set_Unvisited (File_Ref : File_Reference);
!    --  Set File_Ref as unvisited. So Next_Unvisited_File will return it
  
     procedure Read_File
       (File_Name : String;
        Contents  : out GNAT.OS_Lib.String_Access);
!    --  Reads File_Name into the newly allocated strig Contents. Types.EOF
!    --  character will be added to the returned Contents to simplify parsing.
!    --  Name_Error is raised if the file was not found. End_Error is raised if
!    --  the file could not be read correctly. For most systems correct reading
!    --  means that the number of bytes read is equal to the file size. The
!    --  exception is OpenVMS where correct reading means that the number of
!    --  bytes read is less than or equal to the file size.
  
  private
     type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record
diff -Nrcpad gcc-4.0.2/gcc/ada/xref_lib.adb gcc-4.1.0/gcc/ada/xref_lib.adb
*** gcc-4.0.2/gcc/ada/xref_lib.adb	Mon Jan  5 15:20:47 2004
--- gcc-4.1.0/gcc/ada/xref_lib.adb	Tue Nov 15 13:56:03 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package body Xref_Lib is
*** 372,378 ****
  
           if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then
  
!             --  The first project file found is the good one.
  
              Close (My_Dir);
              return Dir_Ent (1 .. Last);
--- 372,378 ----
  
           if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then
  
!             --  The first project file found is the good one
  
              Close (My_Dir);
              return Dir_Ent (1 .. Last);
*************** package body Xref_Lib is
*** 755,760 ****
--- 755,764 ----
        --  to parse the ali file again because the parent entity is not in
        --  the declaration table if it did not match the search pattern.
  
+       procedure Skip_To_Matching_Closing_Bracket;
+       --  When Ptr points to an opening square bracket, moves it to the
+       --  character following the matching closing bracket
+ 
        ---------------------
        -- Get_Symbol_Name --
        ---------------------
*************** package body Xref_Lib is
*** 806,811 ****
--- 810,836 ----
           return "???";
        end Get_Symbol_Name;
  
+       --------------------------------------
+       -- Skip_To_Matching_Closing_Bracket --
+       --------------------------------------
+ 
+       procedure Skip_To_Matching_Closing_Bracket is
+          Num_Brackets : Natural;
+ 
+       begin
+          Num_Brackets := 1;
+          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 Skip_To_Matching_Closing_Bracket;
+ 
     --  Start of processing for Parse_Identifier_Info
  
     begin
*************** package body Xref_Lib is
*** 862,867 ****
--- 887,896 ----
        Decl_Ref := Add_Declaration
          (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type);
  
+       if Ali (Ptr) = '[' then
+          Skip_To_Matching_Closing_Bracket;
+       end if;
+ 
        if Ali (Ptr) = '<'
          or else Ali (Ptr) = '('
          or else Ali (Ptr) = '{'
*************** package body Xref_Lib is
*** 918,937 ****
                 --  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 '>'
--- 947,953 ----
                 --  Skip the information for generics instantiations
  
                 if Ali (Ptr) = '[' then
!                   Skip_To_Matching_Closing_Bracket;
                 end if;
  
                 --  Skip '>', or ')' or '>'
*************** package body Xref_Lib is
*** 1169,1174 ****
--- 1185,1191 ----
                       or else Source (Ptr) = ASCII.HT
                       or else Source (Ptr) = '<'
                       or else Source (Ptr) = '{'
+                      or else Source (Ptr) = '['
                       or else Source (Ptr) = '='
                       or else Source (Ptr) = '('))
          and then Source (Ptr) >= ' '
*************** package body Xref_Lib is
*** 1459,1465 ****
        --  Go to start of new line
  
        procedure Print80 (S : in String);
!       --  Print the text, respecting the 80 columns rule.
  
        procedure Print_Ref (Line, Column : String);
        --  The beginning of the output is aligned on a column multiple of 9
--- 1476,1482 ----
        --  Go to start of new line
  
        procedure Print80 (S : in String);
!       --  Print the text, respecting the 80 columns rule
  
        procedure Print_Ref (Line, Column : String);
        --  The beginning of the output is aligned on a column multiple of 9
diff -Nrcpad gcc-4.0.2/gcc/ada/xref_lib.ads gcc-4.1.0/gcc/ada/xref_lib.ads
*** gcc-4.0.2/gcc/ada/xref_lib.ads	Tue Oct 21 13:42:23 2003
--- gcc-4.1.0/gcc/ada/xref_lib.ads	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --       Copyright (C) 1998-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 S p e c                                  --
  --                                                                          --
! --          Copyright (C) 1998-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** package Xref_Lib is
*** 95,101 ****
     ------------------------
  
     function Default_Project_File (Dir_Name : in String) return String;
!    --  Returns the default Project file name for the directory Dir_Name.
  
     procedure Search
       (Pattern       : Search_Pattern;
--- 95,101 ----
     ------------------------
  
     function Default_Project_File (Dir_Name : in String) return String;
!    --  Returns the default Project file name for the directory Dir_Name
  
     procedure Search
       (Pattern       : Search_Pattern;
*************** private
*** 144,159 ****
     type Dependencies is new Dependencies_Tables.Instance;
  
     type ALI_File is limited record
!       Buffer         : String_Access := null;
        --  Buffer used to read the whole file at once
  
!       Current_Line   : Positive;
        --  Start of the current line in Buffer
  
!       Xref_Line      : Positive;
        --  Start of the xref lines in Buffer
  
!       X_File         : Xr_Tabls.File_Reference;
        --  Stores the cross-referencing file-name ("X..." lines), as an
        --  index into the dependencies table
  
--- 144,159 ----
     type Dependencies is new Dependencies_Tables.Instance;
  
     type ALI_File is limited record
!       Buffer : String_Access := null;
        --  Buffer used to read the whole file at once
  
!       Current_Line : Positive;
        --  Start of the current line in Buffer
  
!       Xref_Line : Positive;
        --  Start of the xref lines in Buffer
  
!       X_File : Xr_Tabls.File_Reference;
        --  Stores the cross-referencing file-name ("X..." lines), as an
        --  index into the dependencies table
  
*************** private
*** 171,180 ****
        --  line, it is stored as "Entity_Name Declaration_File:line:column"
  
        File_Ref : Xr_Tabls.File_Reference;
!       --  A reference to the source file, if any.
  
        Initialized : Boolean := False;
!       --  Set to True when Entity has been initialized.
     end record;
!    --  Stores all the pattern that are search for.
  end Xref_Lib;
--- 171,180 ----
        --  line, it is stored as "Entity_Name Declaration_File:line:column"
  
        File_Ref : Xr_Tabls.File_Reference;
!       --  A reference to the source file, if any
  
        Initialized : Boolean := False;
!       --  Set to True when Entity has been initialized
     end record;
! 
  end Xref_Lib;
diff -Nrcpad gcc-4.0.2/gcc/ada/xsinfo.adb gcc-4.1.0/gcc/ada/xsinfo.adb
*** gcc-4.0.2/gcc/ada/xsinfo.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/xsinfo.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** procedure XSinfo is
*** 88,96 ****
  
     M : Match_Result;
  
- 
     procedure Getline;
!    --  Get non-comment, non-blank line. Also skips "for " rep clauses.
  
     procedure Getline is
     begin
--- 88,99 ----
  
     M : Match_Result;
  
     procedure Getline;
!    --  Get non-comment, non-blank line. Also skips "for " rep clauses
! 
!    -------------
!    -- Getline --
!    -------------
  
     procedure Getline is
     begin
diff -Nrcpad gcc-4.0.2/gcc/ada/xsnames.adb gcc-4.1.0/gcc/ada/xsnames.adb
*** gcc-4.0.2/gcc/ada/xsnames.adb	Thu Feb 10 13:57:00 2005
--- gcc-4.1.0/gcc/ada/xsnames.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,33 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This utility is used to make a new version of the Snames package when
! --  new names are added to the spec, the existing versions of snames.ads and
! --  snames.adb are read, and updated to match the set of names in snames.ads.
! --  The updated versions are written to snames.ns and snames.nb (new spec/body)
  
  with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
  with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
--- 16,34 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
! --  This utility is used to make a new version of the Snames package when new
! --  names are added to the spec, the existing versions of snames.ads and
! --  snames.adb and snames.h are read, and updated to match the set of names in
! --  snames.ads. The updated versions are written to snames.ns, snames.nb (new
! --  spec/body), and snames.nh (new header file).
  
  with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
  with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
*************** procedure XSnames is
*** 44,49 ****
--- 45,52 ----
     InS  : File_Type;
     OutS : File_Type;
     OutB : File_Type;
+    InH  : File_Type;
+    OutH : File_Type;
  
     A, B    : VString := Nul;
     Line    : VString := Nul;
*************** procedure XSnames is
*** 74,85 ****
--- 77,166 ----
  
     M : Match_Result;
  
+    type Header_Symbol is (None, Attr, Conv, Prag);
+    --  A symbol in the header file
+ 
+    --  Prefixes used in the header file
+ 
+    Header_Attr : aliased String := "Attr";
+    Header_Conv : aliased String := "Convention";
+    Header_Prag : aliased String := "Pragma";
+ 
+    type String_Ptr is access all String;
+    Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
+                      (null,
+                       Header_Attr'Access,
+                       Header_Conv'Access,
+                       Header_Prag'Access);
+ 
+    --  Patterns used in the spec file
+ 
+    Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1;
+    Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1;
+    Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1;
+ 
+    type Header_Symbol_Counter is array (Header_Symbol) of Natural;
+    Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
+ 
+    Header_Current_Symbol : Header_Symbol := None;
+    Header_Pending_Line : VString := Nul;
+ 
+    ------------------------
+    -- Output_Header_Line --
+    ------------------------
+ 
+    procedure Output_Header_Line (S : Header_Symbol) is
+    begin
+       --  Skip all the #define for S-prefixed symbols in the header.
+       --  Of course we are making implicit assumptions:
+       --   (1) No newline between symbols with the same prefix.
+       --   (2) Prefix order is the same as in snames.ads.
+ 
+       if Header_Current_Symbol /= S then
+          declare
+             Pat : String := "#define  " & Header_Prefix (S).all;
+             In_Pat : Boolean := False;
+ 
+          begin
+             if Header_Current_Symbol /= None then
+                Put_Line (OutH, Header_Pending_Line);
+             end if;
+ 
+             loop
+                Line := Get_Line (InH);
+ 
+                if Match (Line, Pat) then
+                   In_Pat := true;
+                elsif In_Pat then
+                   Header_Pending_Line := Line;
+                   exit;
+                else
+                   Put_Line (OutH, Line);
+                end if;
+             end loop;
+ 
+             Header_Current_Symbol := S;
+          end;
+       end if;
+ 
+       --  Now output the line
+ 
+       Put_Line (OutH, "#define  " & Header_Prefix (S).all
+                   & "_" & Name1 & (30 - Length (Name1)) * ' '
+                   & Header_Counter (S));
+       Header_Counter (S) := Header_Counter (S) + 1;
+    end Output_Header_Line;
+ 
+ --  Start of processing for XSnames
+ 
  begin
     Open (InB, In_File, "snames.adb");
     Open (InS, In_File, "snames.ads");
+    Open (InH, In_File, "snames.h");
  
     Create (OutS, Out_File, "snames.ns");
     Create (OutB, Out_File, "snames.nb");
+    Create (OutH, Out_File, "snames.nh");
  
     Anchored_Mode := True;
     Oname := Nul;
*************** begin
*** 99,104 ****
--- 180,192 ----
        if not Match (Line, Name_Ref) then
           Put_Line (OutS, Line);
  
+          if Match (Line, Get_Attr) then
+             Output_Header_Line (Attr);
+          elsif Match (Line, Get_Conv) then
+             Output_Header_Line (Conv);
+          elsif Match (Line, Get_Prag) then
+             Output_Header_Line (Prag);
+          end if;
        else
           Oval := Lpad (V (Val), 3, '0');
  
*************** begin
*** 144,149 ****
     Put_Line (OutB, Line);
  
     while not End_Of_File (InB) loop
!       Put_Line (OutB, Get_Line (InB));
     end loop;
  end XSnames;
--- 232,244 ----
     Put_Line (OutB, Line);
  
     while not End_Of_File (InB) loop
!       Line := Get_Line (InB);
!       Put_Line (OutB, Line);
!    end loop;
! 
!    Put_Line (OutH, Header_Pending_Line);
!    while not End_Of_File (InH) loop
!       Line := Get_Line (InH);
!       Put_Line (OutH, Line);
     end loop;
  end XSnames;
diff -Nrcpad gcc-4.0.2/gcc/ada/xtreeprs.adb gcc-4.1.0/gcc/ada/xtreeprs.adb
*** gcc-4.0.2/gcc/ada/xtreeprs.adb	Fri Jun 25 16:39:33 2004
--- gcc-4.1.0/gcc/ada/xtreeprs.adb	Tue Nov 15 14:06:45 2005
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2004 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2005, 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- --
***************
*** 16,23 ****
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
! -- MA 02111-1307, USA.                                                      --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
--- 16,23 ----
  -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  -- for  more details.  You should have  received  a copy of the GNU General --
  -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
! -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
! -- Boston, MA 02110-1301, USA.                                              --
  --                                                                          --
  -- GNAT was originally developed  by the GNAT team at  New York University. --
  -- Extensive contributions were provided by Ada Core Technologies Inc.      --
*************** with Ada.Command_Line;              use 
*** 45,50 ****
--- 45,51 ----
  with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
  with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
  with Ada.Text_IO;                   use Ada.Text_IO;
+ with Ada.Streams.Stream_IO;         use Ada.Streams.Stream_IO;
  
  with GNAT.Spitbol;                  use GNAT.Spitbol;
  with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
*************** procedure XTreeprs is
*** 75,87 ****
     Synonym    : VString := Nul;
     Term       : VString := Nul;
  
!    OutS : File_Type;
     --  Output file
  
!    InS : File_Type;
     --  Read sinfo.ads
  
!    InT : File_Type;
     --  Read treeprs.adt
  
     Special : TB.Table (20);
--- 76,90 ----
     Synonym    : VString := Nul;
     Term       : VString := Nul;
  
!    subtype Sfile is Ada.Streams.Stream_IO.File_Type;
! 
!    OutS : Sfile;
     --  Output file
  
!    InS : Ada.Text_IO.File_Type;
     --  Read sinfo.ads
  
!    InT : Ada.Text_IO.File_Type;
     --  Read treeprs.adt
  
     Special : TB.Table (20);
*************** procedure XTreeprs is
*** 137,142 ****
--- 140,162 ----
  
     M : Match_Result;
  
+    procedure Put_Line (F : Sfile; S : String);
+    procedure Put_Line (F : Sfile; S : VString);
+    --  Local version of Put_Line ensures Unix style line endings
+ 
+    procedure Put_Line (F : Sfile; S : String) is
+    begin
+       String'Write (Stream (F), S);
+       Character'Write (Stream (F), ASCII.LF);
+    end Put_Line;
+ 
+    procedure Put_Line (F : Sfile; S : VString) is
+    begin
+       Put_Line (F, To_String (S));
+    end Put_Line;
+ 
+ --  Start of processing for XTreeprs
+ 
  begin
     Anchored_Mode := True;
  
diff -Nrcpad gcc-4.0.2/gnattools/ChangeLog gcc-4.1.0/gnattools/ChangeLog
*** gcc-4.0.2/gnattools/ChangeLog	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gnattools/ChangeLog	Tue Feb 28 08:30:13 2006
***************
*** 0 ****
--- 1,52 ----
+ 2006-02-28  Release Manager
+ 
+ 	* GCC 4.1.0 released.
+ 
+ 2005-03-09  Arnaud Charlet  <charlet@adacore.com>
+ 
+ 	* Makefile.in: Fix incorrect use of ' in shell command
+ 
+ 2005-02-02  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 
+         * Makefile.in: Remove use of cc_set_by_configure; just use
+         plain old CC from the top level in this case.
+ 
+ 2005-01-30  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 	Merge from mainline at tag libada-gnattools-merge-20050129:
+ 	* configure.ac: Changes propagated from gcc/ada/Makefile.in.
+ 	* Makefile.in: Changes relocated from gcc/ada/Makefile.in.
+ 
+ 2004-12-13  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 
+         * Makefile.in: Reinstate stamp-gnatlib check.
+ 
+ 2004-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 
+ 	* Makefile.in: Inline gnattools{1,1-re,2,3,4} targets from
+ 	gcc/ada/configure.ac into gnattools-native and gnattools-cross
+ 	targets, collecting flags as appropriate from here,
+ 	gcc/ada/Makefile.in, gcc/ada/configure.ac, etc.  Attempt to retain
+ 	identical behavior.
+ 	* configure.ac: Add necessary configure bits from
+ 	gcc/ada/configure.ac.
+ 	* configure: Regenerate.
+ 
+ 2004-08-16  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 
+ 	* configure.ac: Replace AC_CANONICAL_SYSTEM with _BUILD, _HOST,
+ 	_TARGET.  Replace _GCC_TOPLEV_NONCANONICAL_TARGET with
+ 	ACX_NONCANONICAL_TARGET, and replace now-redundant AC_SUBST.
+ 	* configure: Regenerate.
+ 
+ 2004-07-18  Nathanael Nerode  <neroden@gcc.gnu.org>
+ 
+ 	* Makefile.in, configure.ac: Remove libada-specific targets and
+ 	variables.
+ 	* configure: Regenerate.
+ 	* New directory, cloned from libada.
+ 
+ Copyright 2004, 2005 Free Software Foundation, Inc.
+ 
+ This ChangeLog is free software; the Free Software Foundation gives
+ unlimited permission to copy, distribute, and modify it.
+ 
diff -Nrcpad gcc-4.0.2/gnattools/Makefile.in gcc-4.1.0/gnattools/Makefile.in
*** gcc-4.0.2/gnattools/Makefile.in	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gnattools/Makefile.in	Wed Mar 30 08:56:55 2005
***************
*** 0 ****
--- 1,338 ----
+ # Makefile for gnattools
+ #   Copyright 2003, 2004 Free Software Foundation, Inc.
+ #
+ # This file is free software; you can redistribute it and/or modify
+ # it under the terms of the GNU General Public License as published by
+ # the Free Software Foundation; either version 2 of the License, or
+ # (at your option) any later version.
+ # 
+ # This program is distributed in the hope that it will be useful,
+ # but WITHOUT ANY WARRANTY; without even the implied warranty of
+ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ # GNU General Public License for more details.
+ # 
+ # You should have received a copy of the GNU General Public License
+ # along with this program; if not, write to the Free Software
+ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ 
+ # Default target; must be first.
+ all: gnattools
+ 
+ # Standard autoconf-set variables.
+ SHELL = @SHELL@
+ srcdir = @srcdir@
+ build = @build@
+ target = @target@
+ prefix = @prefix@
+ INSTALL = @INSTALL@
+ INSTALL_DATA = @INSTALL_DATA@
+ INSTALL_PROGRAM = @INSTALL_PROGRAM@
+ 
+ # Nonstandard autoconf-set variables.
+ LN_S=@LN_S@
+ target_noncanonical=@target_noncanonical@
+ 
+ # Variables for the user (or the top level) to override.
+ objext=.o
+ TRACE=no
+ ADA_FOR_BUILD=
+ ADA_FOR_TARGET=
+ LDFLAGS=
+ STAGE_PREFIX=
+ PWD_COMMAND = $${PWDCMD-pwd}
+ 
+ # The tedious process of getting CFLAGS right.
+ CFLAGS=-g
+ LOOSE_WARN = -W -Wall -Wwrite-strings -Wstrict-prototypes -Wmissing-prototypes
+ GCC_WARN_CFLAGS = $(LOOSE_WARN) $(NOCOMMON_FLAG)
+ 
+ ADA_CFLAGS=
+ T_ADA_CFLAGS=
+ # HPPA is literally the only target which sets X_ADA_CFLAGS
+ X_ADA_CFLAGS=@x_ada_cflags@
+ ALL_ADA_CFLAGS=$(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS)
+ 
+ # Variables for gnattools.
+ ADAFLAGS= -gnatpg -gnata
+ ADA_INCLUDE_DIR = $(libsubdir)/adainclude
+ ADA_RTL_OBJ_DIR = $(libsubdir)/adalib
+ 
+ # For finding the GCC build dir, which is used far too much
+ GCC_DIR=../gcc
+ # Include fragment generated by GCC configure; shared with libada for now.
+ include $(GCC_DIR)/libada-mk
+ # Variables based on those gleaned from the GCC makefile.  :-P
+ libsubdir=$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)
+ 
+ # Get possible host-specific override for libsubdir (ick).
+ xmake_file=$(subst /config,/../gcc/config,$(gcc_xmake_file))
+ ifneq ($(xmake_file),)
+ include $(xmake_file)
+ endif
+ 
+ # Absolute srcdir for gcc/ada (why do we want absolute?  I dunno)
+ fsrcdir := $(shell cd $(srcdir)/../gcc/ada/; ${PWD_COMMAND})
+ 
+ # Useful "subroutines" for the excess includes
+ INCLUDES_FOR_SUBDIR = -I. -I.. -I../.. -I$(fsrcdir) -I$(fsrcdir)/../config \
+ 	-I$(fsrcdir)/../../include -I$(fsrcdir)/..
+ ADA_INCLUDES_FOR_SUBDIR = -I. -I$(fsrcdir)
+ 
+ # Variables for gnattools1, native
+ TOOLS_FLAGS_TO_PASS_1= \
+ 	"CC=../../xgcc -B../../" \
+ 	"CFLAGS=$(CFLAGS) $(WARN_CFLAGS)" \
+ 	"LDFLAGS=$(LDFLAGS)" \
+ 	"ADAFLAGS=$(ADAFLAGS)" \
+ 	"INCLUDES=$(INCLUDES_FOR_SUBDIR)" \
+ 	"ADA_INCLUDES=-I- -I../rts $(ADA_INCLUDES_FOR_SUBDIR)"\
+ 	"exeext=$(exeext)" \
+ 	"fsrcdir=$(fsrcdir)" \
+ 	"srcdir=$(fsrcdir)" \
+ 	"GNATBIND=../../gnatbind" \
+ 	"TOOLSCASE=native"
+ 
+ # Variables for regnattools
+ TOOLS_FLAGS_TO_PASS_1re= \
+ 	"CC=../../xgcc -B../../" \
+ 	"CFLAGS=$(CFLAGS)" \
+ 	"ADAFLAGS=$(ADAFLAGS)" \
+ 	"INCLUDES=$(INCLUDES_FOR_SUBDIR)" \
+ 	"ADA_INCLUDES=-I../rts $(ADA_INCLUDES_FOR_SUBDIR)"\
+ 	"exeext=$(exeext)" \
+ 	"fsrcdir=$(fsrcdir)" \
+ 	"srcdir=$(fsrcdir)" \
+ 	"GNATMAKE=../../gnatmake" \
+ 	"GNATLINK=../../gnatlink" \
+ 	"GNATBIND=../../gnatbind" \
+ 	"TOOLSCASE=cross" \
+ 	"INCLUDES="
+ 
+ # Variables for gnattools2, native
+ TOOLS_FLAGS_TO_PASS_NATIVE= \
+ 	"CC=../../xgcc -B../../" \
+ 	"CFLAGS=$(CFLAGS)" \
+ 	"ADAFLAGS=$(ADAFLAGS)" \
+ 	"INCLUDES=$(INCLUDES_FOR_SUBDIR)" \
+ 	"ADA_INCLUDES=-I../rts $(ADA_INCLUDES_FOR_SUBDIR)" \
+ 	"exeext=$(exeext)" \
+ 	"fsrcdir=$(fsrcdir)" \
+ 	"srcdir=$(fsrcdir)" \
+ 	"GNATMAKE=../../gnatmake" \
+ 	"GNATLINK=../../gnatlink" \
+ 	"GNATBIND=../../gnatbind" \
+ 	"TOOLSCASE=native"
+ 
+ # Variables for gnattools, cross
+ TOOLS_FLAGS_TO_PASS_CROSS= \
+ 	"CC=$(CC)" \
+ 	"CFLAGS=$(CFLAGS) $(WARN_CFLAGS)" \
+ 	"LDFLAGS=$(LDFLAGS)" \
+ 	"ADAFLAGS=$(ADAFLAGS)"	\
+ 	"INCLUDES=$(INCLUDES_FOR_SUBDIR)" \
+ 	"ADA_INCLUDES=-I$(RTS_DIR)../adainclude -I$(RTS_DIR) $(ADA_INCLUDES_FOR_SUBDIR)" \
+ 	"exeext=$(exeext)" \
+ 	"fsrcdir=$(fsrcdir)" \
+ 	"srcdir=$(fsrcdir)" \
+ 	"GNATMAKE=gnatmake" \
+ 	"GNATLINK=gnatlink" \
+ 	"GNATBIND=gnatbind" \
+ 	"TOOLSCASE=cross" \
+ 	"LIBGNAT="
+ 
+ # File lists
+ # ----------
+ 
+ # File associations set by configure
+ EXTRA_GNATTOOLS = @EXTRA_GNATTOOLS@
+ TOOLS_TARGET_PAIRS = @TOOLS_TARGET_PAIRS@
+ 
+ # These are built by gnatmake, and in both native and cross configurations.
+ GNATTOOLS2_FILES = \
+ 	../../gnatchop$(exeext) \
+ 	../../gnat$(exeext) \
+ 	../../gnatkr$(exeext) \
+ 	../../gnatls$(exeext) \
+ 	../../gnatprep$(exeext) \
+ 	../../gnatxref$(exeext) \
+ 	../../gnatfind$(exeext) \
+ 	../../gnatname$(exeext) \
+ 	../../gnatclean$(exeext) \
+ 	../../gprmake$(exeext)
+ 
+ # Makefile targets
+ # ----------------
+ 
+ .PHONY: gnattools gnattools-native gnattools-cross regnattools
+ gnattools: @default_gnattools_target@
+ 
+ # Sanity check
+ $(GCC_DIR)/stamp-gnatlib:
+ 	@if [ ! -f $(GCC_DIR)/stamp-gnatlib ] ; \
+         then \
+           echo "Cannot build gnattools while gnatlib is out of date or unbuilt" ; \
+           false; \
+         else \
+           true; \
+         fi
+ 
+ 
+ # Build directory for the tools. Let's copy the target-dependent
+ # sources using the same mechanism as for gnatlib. The other sources are
+ # accessed using the vpath directive in ada/Makefile.in
+ 
+ $(GCC_DIR)/stamp-tools:
+ 	-rm -rf $(GCC_DIR)/ada/tools
+ 	-mkdir -p $(GCC_DIR)/ada/tools
+ 	-(cd $(GCC_DIR)/ada/tools; $(LN_S) ../sdefault.adb .)
+ 	-$(foreach PAIR,$(TOOLS_TARGET_PAIRS), \
+ 	          rm -f $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));\
+ 	          $(LN_S) $(fsrcdir)/$(word 2,$(subst <, ,$(PAIR))) \
+ 	                $(GCC_DIR)/ada/tools/$(word 1,$(subst <, ,$(PAIR)));)
+ 	touch $(GCC_DIR)/stamp-tools
+ 
+ # gnatmake/link tools cannot always be built with gnatmake/link for bootstrap 
+ # reasons: gnatmake should be built with a recent compiler, a recent compiler
+ # may not generate ALI files compatible with an old gnatmake so it is important
+ # to be able to build gnatmake without a version of gnatmake around. Once 
+ # everything has been compiled once, gnatmake can be recompiled with itself 
+ # (see target regnattools) 
+ gnattools-native: $(GCC_DIR)/stamp-tools $(GCC_DIR)/stamp-gnatlib
+ 	# gnattools1
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_1) \
+ 	  ../../gnatmake$(exeext) ../../gnatlink$(exeext) ../../gnatbl$(exeext)
+ 	# gnattools2
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_NATIVE) \
+ 	  $(GNATTOOLS2_FILES)
+ 
+ # gnatmake/link can be built with recent gnatmake/link if they are available.
+ # This is especially convenient for building cross tools or for rebuilding
+ # the tools when the original bootstrap has already be done.
+ regnattools: $(GCC_DIR)/stamp-gnatlib
+ 	# gnattools1-re
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_1re) \
+ 	  gnatmake-re gnatlink-re
+ 	# gnattools2
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_NATIVE) \
+ 	  $(GNATTOOLS2_FILES)
+ 
+ # For cross builds of gnattools,
+ # put the host RTS dir first in the PATH to hide the default runtime
+ # files that are among the sources
+ # FIXME: This should be done in configure.
+ RTS_DIR:=$(strip $(subst \,/,$(shell gnatls -v | grep adalib )))
+ gnattools-cross: $(GCC_DIR)/stamp-tools
+ 	# gnattools1-re
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_CROSS) INCLUDES="" \
+ 	  gnatmake-re gnatlink-re
+ 	# gnattools2
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_CROSS) \
+ 	  $(GNATTOOLS2_FILES)
+ 	# gnattools4 (cross only)
+ 	$(MAKE) -C $(GCC_DIR)/ada/tools -f ../Makefile \
+ 	  $(TOOLS_FLAGS_TO_PASS_CROSS) \
+ 	  top_buildir=../../.. \
+            ../../vxaddr2line$(exeext)
+ 	# Rename cross tools to where the GCC makefile wants them when
+ 	# installing.  FIXME: installation should be done elsewhere.
+ 	if [ -f $(GCC_DIR)/gnatbind$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatbind$(exeext) $(GCC_DIR)/gnatbind-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatbl$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatbl$(exeext) $(GCC_DIR)/gnatbl-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatchop$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatchop$(exeext) $(GCC_DIR)/gnatchop-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnat$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnat$(exeext) $(GCC_DIR)/gnat-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatkr$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatkr$(exeext) $(GCC_DIR)/gnatkr-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatlink$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatlink$(exeext) $(GCC_DIR)/gnatlink-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatls$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatls$(exeext) $(GCC_DIR)/gnatls-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatmake$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatmake$(exeext) $(GCC_DIR)/gnatmake-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatmem$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatmem$(exeext) $(GCC_DIR)/gnatmem-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatname$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatname$(exeext) $(GCC_DIR)/gnatname-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatprep$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatprep$(exeext) $(GCC_DIR)/gnatprep-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatxref$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatxref$(exeext) $(GCC_DIR)/gnatxref-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatfind$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatfind$(exeext) $(GCC_DIR)/gnatfind-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatclean$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatclean$(exeext) $(GCC_DIR)/gnatclean-cross$(exeext); \
+ 	fi
+ 	if [ -f $(GCC_DIR)/gnatsym$(exeext) ] ; then \
+ 	  mv $(GCC_DIR)/gnatsym$(exeext) $(GCC_DIR)/gnatsym-cross$(exeext); \
+ 	fi
+ 
+ # Other
+ # -----
+ 
+ # Check uninstalled version.
+ check:
+ 
+ # Check installed version.
+ installcheck:
+ 
+ # Build info (none here).
+ info:
+ 
+ # Build DVI (none here).
+ dvi:
+ 
+ # Build TAGS (none here).
+ TAGS:
+ 
+ # Installation rules.
+ install:
+ 
+ install-info:
+ 
+ # Cleaning rules.
+ mostlyclean:
+ 
+ clean:
+ 
+ distclean:
+ 	$(RM) Makefile config.status config.log
+ 
+ maintainer-clean:
+ 
+ # Rules for rebuilding this Makefile.
+ Makefile: $(srcdir)/Makefile.in config.status
+ 	CONFIG_FILES=$@ ; \
+ 	CONFIG_HEADERS= ; \
+ 	$(SHELL) ./config.status
+ 
+ config.status: $(srcdir)/configure
+ 	$(SHELL) ./config.status --recheck
+ 
+ $(srcdir)/configure: @MAINT@ $(srcdir)/configure.ac
+ 	cd $(srcdir) && autoconf
+ 
+ # Don't export variables to the environment, in order to not confuse
+ # configure.
+ .NOEXPORT:
+ 
diff -Nrcpad gcc-4.0.2/gnattools/configure gcc-4.1.0/gnattools/configure
*** gcc-4.0.2/gnattools/configure	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gnattools/configure	Sat Feb 26 21:43:33 2005
***************
*** 0 ****
--- 1,2574 ----
+ #! /bin/sh
+ # Guess values for system-dependent variables and create Makefiles.
+ # Generated by GNU Autoconf 2.59.
+ #
+ # Copyright (C) 2003 Free Software Foundation, Inc.
+ # This configure script is free software; the Free Software Foundation
+ # gives unlimited permission to copy, distribute and modify it.
+ ## --------------------- ##
+ ## M4sh Initialization.  ##
+ ## --------------------- ##
+ 
+ # Be Bourne compatible
+ if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+   emulate sh
+   NULLCMD=:
+   # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+   # is contrary to our usage.  Disable this feature.
+   alias -g '${1+"$@"}'='"$@"'
+ elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+   set -o posix
+ fi
+ DUALCASE=1; export DUALCASE # for MKS sh
+ 
+ # Support unset when possible.
+ if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+   as_unset=unset
+ else
+   as_unset=false
+ fi
+ 
+ 
+ # Work around bugs in pre-3.0 UWIN ksh.
+ $as_unset ENV MAIL MAILPATH
+ PS1='$ '
+ PS2='> '
+ PS4='+ '
+ 
+ # NLS nuisances.
+ for as_var in \
+   LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+   LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+   LC_TELEPHONE LC_TIME
+ do
+   if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+     eval $as_var=C; export $as_var
+   else
+     $as_unset $as_var
+   fi
+ done
+ 
+ # Required to use basename.
+ if expr a : '\(a\)' >/dev/null 2>&1; then
+   as_expr=expr
+ else
+   as_expr=false
+ fi
+ 
+ if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+   as_basename=basename
+ else
+   as_basename=false
+ fi
+ 
+ 
+ # Name of the executable.
+ as_me=`$as_basename "$0" ||
+ $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ 	 X"$0" : 'X\(//\)$' \| \
+ 	 X"$0" : 'X\(/\)$' \| \
+ 	 .     : '\(.\)' 2>/dev/null ||
+ echo X/"$0" |
+     sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+   	  /^X\/\(\/\/\)$/{ s//\1/; q; }
+   	  /^X\/\(\/\).*/{ s//\1/; q; }
+   	  s/.*/./; q'`
+ 
+ 
+ # PATH needs CR, and LINENO needs CR and PATH.
+ # Avoid depending upon Character Ranges.
+ as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+ as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+ as_cr_digits='0123456789'
+ as_cr_alnum=$as_cr_Letters$as_cr_digits
+ 
+ # The user is always right.
+ if test "${PATH_SEPARATOR+set}" != set; then
+   echo "#! /bin/sh" >conf$$.sh
+   echo  "exit 0"   >>conf$$.sh
+   chmod +x conf$$.sh
+   if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+     PATH_SEPARATOR=';'
+   else
+     PATH_SEPARATOR=:
+   fi
+   rm -f conf$$.sh
+ fi
+ 
+ 
+   as_lineno_1=$LINENO
+   as_lineno_2=$LINENO
+   as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+   test "x$as_lineno_1" != "x$as_lineno_2" &&
+   test "x$as_lineno_3"  = "x$as_lineno_2"  || {
+   # Find who we are.  Look in the path if we contain no path at all
+   # relative or not.
+   case $0 in
+     *[\\/]* ) as_myself=$0 ;;
+     *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in $PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+ 
+        ;;
+   esac
+   # We did not find ourselves, most probably we were run as `sh COMMAND'
+   # in which case we are not to be found in the path.
+   if test "x$as_myself" = x; then
+     as_myself=$0
+   fi
+   if test ! -f "$as_myself"; then
+     { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+    { (exit 1); exit 1; }; }
+   fi
+   case $CONFIG_SHELL in
+   '')
+     as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   for as_base in sh bash ksh sh5; do
+ 	 case $as_dir in
+ 	 /*)
+ 	   if ("$as_dir/$as_base" -c '
+   as_lineno_1=$LINENO
+   as_lineno_2=$LINENO
+   as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+   test "x$as_lineno_1" != "x$as_lineno_2" &&
+   test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
+ 	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ 	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ 	     CONFIG_SHELL=$as_dir/$as_base
+ 	     export CONFIG_SHELL
+ 	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ 	   fi;;
+ 	 esac
+        done
+ done
+ ;;
+   esac
+ 
+   # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+   # uniformly replaced by the line number.  The first 'sed' inserts a
+   # line-number line before each line; the second 'sed' does the real
+   # work.  The second script uses 'N' to pair each line-number line
+   # with the numbered line, and appends trailing '-' during
+   # substitution so that $LINENO is not a special case at line end.
+   # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+   # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
+   sed '=' <$as_myself |
+     sed '
+       N
+       s,$,-,
+       : loop
+       s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+       t loop
+       s,-$,,
+       s,^['$as_cr_digits']*\n,,
+     ' >$as_me.lineno &&
+   chmod +x $as_me.lineno ||
+     { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+    { (exit 1); exit 1; }; }
+ 
+   # Don't try to exec as it changes $[0], causing all sort of problems
+   # (the dirname of $[0] is not the place where we might find the
+   # original and so on.  Autoconf is especially sensible to this).
+   . ./$as_me.lineno
+   # Exit status is that of the last command.
+   exit
+ }
+ 
+ 
+ case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+   *c*,-n*) ECHO_N= ECHO_C='
+ ' ECHO_T='	' ;;
+   *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+   *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ esac
+ 
+ if expr a : '\(a\)' >/dev/null 2>&1; then
+   as_expr=expr
+ else
+   as_expr=false
+ fi
+ 
+ rm -f conf$$ conf$$.exe conf$$.file
+ echo >conf$$.file
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
+   # We could just check for DJGPP; but this test a) works b) is more generic
+   # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+   if test -f conf$$.exe; then
+     # Don't use ln at all; we don't have any links
+     as_ln_s='cp -p'
+   else
+     as_ln_s='ln -s'
+   fi
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+   as_ln_s=ln
+ else
+   as_ln_s='cp -p'
+ fi
+ rm -f conf$$ conf$$.exe conf$$.file
+ 
+ if mkdir -p . 2>/dev/null; then
+   as_mkdir_p=:
+ else
+   test -d ./-p && rmdir ./-p
+   as_mkdir_p=false
+ fi
+ 
+ as_executable_p="test -f"
+ 
+ # Sed expression to map a string onto a valid CPP name.
+ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+ 
+ # Sed expression to map a string onto a valid variable name.
+ as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+ 
+ 
+ # IFS
+ # We need space, tab and new line, in precisely that order.
+ as_nl='
+ '
+ IFS=" 	$as_nl"
+ 
+ # CDPATH.
+ $as_unset CDPATH
+ 
+ 
+ # Name of the host.
+ # hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+ # so uname gets run too.
+ ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+ 
+ exec 6>&1
+ 
+ #
+ # Initializations.
+ #
+ ac_default_prefix=/usr/local
+ ac_config_libobj_dir=.
+ cross_compiling=no
+ subdirs=
+ MFLAGS=
+ MAKEFLAGS=
+ SHELL=${CONFIG_SHELL-/bin/sh}
+ 
+ # Maximum number of lines to put in a shell here document.
+ # This variable seems obsolete.  It should probably be removed, and
+ # only ac_max_sed_lines should be used.
+ : ${ac_max_here_lines=38}
+ 
+ # Identity of this package.
+ PACKAGE_NAME=
+ PACKAGE_TARNAME=
+ PACKAGE_VERSION=
+ PACKAGE_STRING=
+ PACKAGE_BUGREPORT=
+ 
+ ac_unique_file="Makefile.in"
+ ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S x_ada_cflags default_gnattools_target TOOLS_TARGET_PAIRS EXTRA_GNATTOOLS LIBOBJS LTLIBOBJS'
+ ac_subst_files=''
+ 
+ # Initialize some variables set by options.
+ ac_init_help=
+ ac_init_version=false
+ # The variables have the same names as the options, with
+ # dashes changed to underlines.
+ cache_file=/dev/null
+ exec_prefix=NONE
+ no_create=
+ no_recursion=
+ prefix=NONE
+ program_prefix=NONE
+ program_suffix=NONE
+ program_transform_name=s,x,x,
+ silent=
+ site=
+ srcdir=
+ verbose=
+ x_includes=NONE
+ x_libraries=NONE
+ 
+ # Installation directory options.
+ # These are left unexpanded so users can "make install exec_prefix=/foo"
+ # and all the variables that are supposed to be based on exec_prefix
+ # by default will actually change.
+ # Use braces instead of parens because sh, perl, etc. also accept them.
+ bindir='${exec_prefix}/bin'
+ sbindir='${exec_prefix}/sbin'
+ libexecdir='${exec_prefix}/libexec'
+ datadir='${prefix}/share'
+ sysconfdir='${prefix}/etc'
+ sharedstatedir='${prefix}/com'
+ localstatedir='${prefix}/var'
+ libdir='${exec_prefix}/lib'
+ includedir='${prefix}/include'
+ oldincludedir='/usr/include'
+ infodir='${prefix}/info'
+ mandir='${prefix}/man'
+ 
+ ac_prev=
+ for ac_option
+ do
+   # If the previous option needs an argument, assign it.
+   if test -n "$ac_prev"; then
+     eval "$ac_prev=\$ac_option"
+     ac_prev=
+     continue
+   fi
+ 
+   ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+ 
+   # Accept the important Cygnus configure options, so we can diagnose typos.
+ 
+   case $ac_option in
+ 
+   -bindir | --bindir | --bindi | --bind | --bin | --bi)
+     ac_prev=bindir ;;
+   -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+     bindir=$ac_optarg ;;
+ 
+   -build | --build | --buil | --bui | --bu)
+     ac_prev=build_alias ;;
+   -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+     build_alias=$ac_optarg ;;
+ 
+   -cache-file | --cache-file | --cache-fil | --cache-fi \
+   | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+     ac_prev=cache_file ;;
+   -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+   | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+     cache_file=$ac_optarg ;;
+ 
+   --config-cache | -C)
+     cache_file=config.cache ;;
+ 
+   -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+     ac_prev=datadir ;;
+   -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+   | --da=*)
+     datadir=$ac_optarg ;;
+ 
+   -disable-* | --disable-*)
+     ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+     # Reject names that are not valid shell variable names.
+     expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+       { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+    { (exit 1); exit 1; }; }
+     ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+     eval "enable_$ac_feature=no" ;;
+ 
+   -enable-* | --enable-*)
+     ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+     # Reject names that are not valid shell variable names.
+     expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+       { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+    { (exit 1); exit 1; }; }
+     ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+     case $ac_option in
+       *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+       *) ac_optarg=yes ;;
+     esac
+     eval "enable_$ac_feature='$ac_optarg'" ;;
+ 
+   -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+   | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+   | --exec | --exe | --ex)
+     ac_prev=exec_prefix ;;
+   -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+   | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+   | --exec=* | --exe=* | --ex=*)
+     exec_prefix=$ac_optarg ;;
+ 
+   -gas | --gas | --ga | --g)
+     # Obsolete; use --with-gas.
+     with_gas=yes ;;
+ 
+   -help | --help | --hel | --he | -h)
+     ac_init_help=long ;;
+   -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+     ac_init_help=recursive ;;
+   -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+     ac_init_help=short ;;
+ 
+   -host | --host | --hos | --ho)
+     ac_prev=host_alias ;;
+   -host=* | --host=* | --hos=* | --ho=*)
+     host_alias=$ac_optarg ;;
+ 
+   -includedir | --includedir | --includedi | --included | --include \
+   | --includ | --inclu | --incl | --inc)
+     ac_prev=includedir ;;
+   -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+   | --includ=* | --inclu=* | --incl=* | --inc=*)
+     includedir=$ac_optarg ;;
+ 
+   -infodir | --infodir | --infodi | --infod | --info | --inf)
+     ac_prev=infodir ;;
+   -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+     infodir=$ac_optarg ;;
+ 
+   -libdir | --libdir | --libdi | --libd)
+     ac_prev=libdir ;;
+   -libdir=* | --libdir=* | --libdi=* | --libd=*)
+     libdir=$ac_optarg ;;
+ 
+   -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+   | --libexe | --libex | --libe)
+     ac_prev=libexecdir ;;
+   -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+   | --libexe=* | --libex=* | --libe=*)
+     libexecdir=$ac_optarg ;;
+ 
+   -localstatedir | --localstatedir | --localstatedi | --localstated \
+   | --localstate | --localstat | --localsta | --localst \
+   | --locals | --local | --loca | --loc | --lo)
+     ac_prev=localstatedir ;;
+   -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+   | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+   | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+     localstatedir=$ac_optarg ;;
+ 
+   -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+     ac_prev=mandir ;;
+   -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+     mandir=$ac_optarg ;;
+ 
+   -nfp | --nfp | --nf)
+     # Obsolete; use --without-fp.
+     with_fp=no ;;
+ 
+   -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+   | --no-cr | --no-c | -n)
+     no_create=yes ;;
+ 
+   -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+   | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+     no_recursion=yes ;;
+ 
+   -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+   | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+   | --oldin | --oldi | --old | --ol | --o)
+     ac_prev=oldincludedir ;;
+   -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+   | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+   | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+     oldincludedir=$ac_optarg ;;
+ 
+   -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+     ac_prev=prefix ;;
+   -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+     prefix=$ac_optarg ;;
+ 
+   -program-prefix | --program-prefix | --program-prefi | --program-pref \
+   | --program-pre | --program-pr | --program-p)
+     ac_prev=program_prefix ;;
+   -program-prefix=* | --program-prefix=* | --program-prefi=* \
+   | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+     program_prefix=$ac_optarg ;;
+ 
+   -program-suffix | --program-suffix | --program-suffi | --program-suff \
+   | --program-suf | --program-su | --program-s)
+     ac_prev=program_suffix ;;
+   -program-suffix=* | --program-suffix=* | --program-suffi=* \
+   | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+     program_suffix=$ac_optarg ;;
+ 
+   -program-transform-name | --program-transform-name \
+   | --program-transform-nam | --program-transform-na \
+   | --program-transform-n | --program-transform- \
+   | --program-transform | --program-transfor \
+   | --program-transfo | --program-transf \
+   | --program-trans | --program-tran \
+   | --progr-tra | --program-tr | --program-t)
+     ac_prev=program_transform_name ;;
+   -program-transform-name=* | --program-transform-name=* \
+   | --program-transform-nam=* | --program-transform-na=* \
+   | --program-transform-n=* | --program-transform-=* \
+   | --program-transform=* | --program-transfor=* \
+   | --program-transfo=* | --program-transf=* \
+   | --program-trans=* | --program-tran=* \
+   | --progr-tra=* | --program-tr=* | --program-t=*)
+     program_transform_name=$ac_optarg ;;
+ 
+   -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+   | -silent | --silent | --silen | --sile | --sil)
+     silent=yes ;;
+ 
+   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+     ac_prev=sbindir ;;
+   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+   | --sbi=* | --sb=*)
+     sbindir=$ac_optarg ;;
+ 
+   -sharedstatedir | --sharedstatedir | --sharedstatedi \
+   | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+   | --sharedst | --shareds | --shared | --share | --shar \
+   | --sha | --sh)
+     ac_prev=sharedstatedir ;;
+   -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+   | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+   | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+   | --sha=* | --sh=*)
+     sharedstatedir=$ac_optarg ;;
+ 
+   -site | --site | --sit)
+     ac_prev=site ;;
+   -site=* | --site=* | --sit=*)
+     site=$ac_optarg ;;
+ 
+   -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+     ac_prev=srcdir ;;
+   -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+     srcdir=$ac_optarg ;;
+ 
+   -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+   | --syscon | --sysco | --sysc | --sys | --sy)
+     ac_prev=sysconfdir ;;
+   -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+   | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+     sysconfdir=$ac_optarg ;;
+ 
+   -target | --target | --targe | --targ | --tar | --ta | --t)
+     ac_prev=target_alias ;;
+   -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+     target_alias=$ac_optarg ;;
+ 
+   -v | -verbose | --verbose | --verbos | --verbo | --verb)
+     verbose=yes ;;
+ 
+   -version | --version | --versio | --versi | --vers | -V)
+     ac_init_version=: ;;
+ 
+   -with-* | --with-*)
+     ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+     # Reject names that are not valid shell variable names.
+     expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+       { echo "$as_me: error: invalid package name: $ac_package" >&2
+    { (exit 1); exit 1; }; }
+     ac_package=`echo $ac_package| sed 's/-/_/g'`
+     case $ac_option in
+       *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+       *) ac_optarg=yes ;;
+     esac
+     eval "with_$ac_package='$ac_optarg'" ;;
+ 
+   -without-* | --without-*)
+     ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+     # Reject names that are not valid shell variable names.
+     expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+       { echo "$as_me: error: invalid package name: $ac_package" >&2
+    { (exit 1); exit 1; }; }
+     ac_package=`echo $ac_package | sed 's/-/_/g'`
+     eval "with_$ac_package=no" ;;
+ 
+   --x)
+     # Obsolete; use --with-x.
+     with_x=yes ;;
+ 
+   -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+   | --x-incl | --x-inc | --x-in | --x-i)
+     ac_prev=x_includes ;;
+   -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+   | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+     x_includes=$ac_optarg ;;
+ 
+   -x-libraries | --x-libraries | --x-librarie | --x-librari \
+   | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+     ac_prev=x_libraries ;;
+   -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+   | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+     x_libraries=$ac_optarg ;;
+ 
+   -*) { echo "$as_me: error: unrecognized option: $ac_option
+ Try \`$0 --help' for more information." >&2
+    { (exit 1); exit 1; }; }
+     ;;
+ 
+   *=*)
+     ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+     # Reject names that are not valid shell variable names.
+     expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+       { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+    { (exit 1); exit 1; }; }
+     ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+     eval "$ac_envvar='$ac_optarg'"
+     export $ac_envvar ;;
+ 
+   *)
+     # FIXME: should be removed in autoconf 3.0.
+     echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+     expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+       echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+     : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+     ;;
+ 
+   esac
+ done
+ 
+ if test -n "$ac_prev"; then
+   ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+   { echo "$as_me: error: missing argument to $ac_option" >&2
+    { (exit 1); exit 1; }; }
+ fi
+ 
+ # Be sure to have absolute paths.
+ for ac_var in exec_prefix prefix
+ do
+   eval ac_val=$`echo $ac_var`
+   case $ac_val in
+     [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+     *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+    { (exit 1); exit 1; }; };;
+   esac
+ done
+ 
+ # Be sure to have absolute paths.
+ for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ 	      localstatedir libdir includedir oldincludedir infodir mandir
+ do
+   eval ac_val=$`echo $ac_var`
+   case $ac_val in
+     [\\/$]* | ?:[\\/]* ) ;;
+     *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+    { (exit 1); exit 1; }; };;
+   esac
+ done
+ 
+ # There might be people who depend on the old broken behavior: `$host'
+ # used to hold the argument of --host etc.
+ # FIXME: To remove some day.
+ build=$build_alias
+ host=$host_alias
+ target=$target_alias
+ 
+ # FIXME: To remove some day.
+ if test "x$host_alias" != x; then
+   if test "x$build_alias" = x; then
+     cross_compiling=maybe
+     echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+     If a cross compiler is detected then cross compile mode will be used." >&2
+   elif test "x$build_alias" != "x$host_alias"; then
+     cross_compiling=yes
+   fi
+ fi
+ 
+ ac_tool_prefix=
+ test -n "$host_alias" && ac_tool_prefix=$host_alias-
+ 
+ test "$silent" = yes && exec 6>/dev/null
+ 
+ 
+ # Find the source files, if location was not specified.
+ if test -z "$srcdir"; then
+   ac_srcdir_defaulted=yes
+   # Try the directory containing this script, then its parent.
+   ac_confdir=`(dirname "$0") 2>/dev/null ||
+ $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ 	 X"$0" : 'X\(//\)[^/]' \| \
+ 	 X"$0" : 'X\(//\)$' \| \
+ 	 X"$0" : 'X\(/\)' \| \
+ 	 .     : '\(.\)' 2>/dev/null ||
+ echo X"$0" |
+     sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+   	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+   	  /^X\(\/\/\)$/{ s//\1/; q; }
+   	  /^X\(\/\).*/{ s//\1/; q; }
+   	  s/.*/./; q'`
+   srcdir=$ac_confdir
+   if test ! -r $srcdir/$ac_unique_file; then
+     srcdir=..
+   fi
+ else
+   ac_srcdir_defaulted=no
+ fi
+ if test ! -r $srcdir/$ac_unique_file; then
+   if test "$ac_srcdir_defaulted" = yes; then
+     { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+    { (exit 1); exit 1; }; }
+   else
+     { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+    { (exit 1); exit 1; }; }
+   fi
+ fi
+ (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+   { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+    { (exit 1); exit 1; }; }
+ srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ ac_env_build_alias_set=${build_alias+set}
+ ac_env_build_alias_value=$build_alias
+ ac_cv_env_build_alias_set=${build_alias+set}
+ ac_cv_env_build_alias_value=$build_alias
+ ac_env_host_alias_set=${host_alias+set}
+ ac_env_host_alias_value=$host_alias
+ ac_cv_env_host_alias_set=${host_alias+set}
+ ac_cv_env_host_alias_value=$host_alias
+ ac_env_target_alias_set=${target_alias+set}
+ ac_env_target_alias_value=$target_alias
+ ac_cv_env_target_alias_set=${target_alias+set}
+ ac_cv_env_target_alias_value=$target_alias
+ 
+ #
+ # Report the --help message.
+ #
+ if test "$ac_init_help" = "long"; then
+   # Omit some internal or obsolete options to make the list less imposing.
+   # This message is too long to be a string in the A/UX 3.1 sh.
+   cat <<_ACEOF
+ \`configure' configures this package to adapt to many kinds of systems.
+ 
+ Usage: $0 [OPTION]... [VAR=VALUE]...
+ 
+ To assign environment variables (e.g., CC, CFLAGS...), specify them as
+ VAR=VALUE.  See below for descriptions of some of the useful variables.
+ 
+ Defaults for the options are specified in brackets.
+ 
+ Configuration:
+   -h, --help              display this help and exit
+       --help=short        display options specific to this package
+       --help=recursive    display the short help of all the included packages
+   -V, --version           display version information and exit
+   -q, --quiet, --silent   do not print \`checking...' messages
+       --cache-file=FILE   cache test results in FILE [disabled]
+   -C, --config-cache      alias for \`--cache-file=config.cache'
+   -n, --no-create         do not create output files
+       --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+ 
+ _ACEOF
+ 
+   cat <<_ACEOF
+ Installation directories:
+   --prefix=PREFIX         install architecture-independent files in PREFIX
+ 			  [$ac_default_prefix]
+   --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+ 			  [PREFIX]
+ 
+ By default, \`make install' will install all the files in
+ \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+ an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+ for instance \`--prefix=\$HOME'.
+ 
+ For better control, use the options below.
+ 
+ Fine tuning of the installation directories:
+   --bindir=DIR           user executables [EPREFIX/bin]
+   --sbindir=DIR          system admin executables [EPREFIX/sbin]
+   --libexecdir=DIR       program executables [EPREFIX/libexec]
+   --datadir=DIR          read-only architecture-independent data [PREFIX/share]
+   --sysconfdir=DIR       read-only single-machine data [PREFIX/etc]
+   --sharedstatedir=DIR   modifiable architecture-independent data [PREFIX/com]
+   --localstatedir=DIR    modifiable single-machine data [PREFIX/var]
+   --libdir=DIR           object code libraries [EPREFIX/lib]
+   --includedir=DIR       C header files [PREFIX/include]
+   --oldincludedir=DIR    C header files for non-gcc [/usr/include]
+   --infodir=DIR          info documentation [PREFIX/info]
+   --mandir=DIR           man documentation [PREFIX/man]
+ _ACEOF
+ 
+   cat <<\_ACEOF
+ 
+ System types:
+   --build=BUILD     configure for building on BUILD [guessed]
+   --host=HOST       cross-compile to build programs to run on HOST [BUILD]
+   --target=TARGET   configure for building compilers for TARGET [HOST]
+ _ACEOF
+ fi
+ 
+ if test -n "$ac_init_help"; then
+ 
+   cat <<\_ACEOF
+ 
+ Optional Features:
+   --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+   --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+   --enable-maintainer-mode
+                           enable make rules and dependencies not useful (and
+                           sometimes confusing) to the casual installer
+ 
+ _ACEOF
+ fi
+ 
+ if test "$ac_init_help" = "recursive"; then
+   # If there are subdirs, report their specific --help.
+   ac_popdir=`pwd`
+   for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+     test -d $ac_dir || continue
+     ac_builddir=.
+ 
+ if test "$ac_dir" != .; then
+   ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+   # A "../" for each directory in $ac_dir_suffix.
+   ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+ else
+   ac_dir_suffix= ac_top_builddir=
+ fi
+ 
+ case $srcdir in
+   .)  # No --srcdir option.  We are building in place.
+     ac_srcdir=.
+     if test -z "$ac_top_builddir"; then
+        ac_top_srcdir=.
+     else
+        ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+     fi ;;
+   [\\/]* | ?:[\\/]* )  # Absolute path.
+     ac_srcdir=$srcdir$ac_dir_suffix;
+     ac_top_srcdir=$srcdir ;;
+   *) # Relative path.
+     ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+     ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ esac
+ 
+ # Do not use `cd foo && pwd` to compute absolute paths, because
+ # the directories may not exist.
+ case `pwd` in
+ .) ac_abs_builddir="$ac_dir";;
+ *)
+   case "$ac_dir" in
+   .) ac_abs_builddir=`pwd`;;
+   [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+   *) ac_abs_builddir=`pwd`/"$ac_dir";;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *)
+   case ${ac_top_builddir}. in
+   .) ac_abs_top_builddir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+   *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_srcdir=$ac_srcdir;;
+ *)
+   case $ac_srcdir in
+   .) ac_abs_srcdir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+   *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *)
+   case $ac_top_srcdir in
+   .) ac_abs_top_srcdir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+   *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+   esac;;
+ esac
+ 
+     cd $ac_dir
+     # Check for guested configure; otherwise get Cygnus style configure.
+     if test -f $ac_srcdir/configure.gnu; then
+       echo
+       $SHELL $ac_srcdir/configure.gnu  --help=recursive
+     elif test -f $ac_srcdir/configure; then
+       echo
+       $SHELL $ac_srcdir/configure  --help=recursive
+     elif test -f $ac_srcdir/configure.ac ||
+ 	   test -f $ac_srcdir/configure.in; then
+       echo
+       $ac_configure --help
+     else
+       echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+     fi
+     cd "$ac_popdir"
+   done
+ fi
+ 
+ test -n "$ac_init_help" && exit 0
+ if $ac_init_version; then
+   cat <<\_ACEOF
+ 
+ Copyright (C) 2003 Free Software Foundation, Inc.
+ This configure script is free software; the Free Software Foundation
+ gives unlimited permission to copy, distribute and modify it.
+ _ACEOF
+   exit 0
+ fi
+ exec 5>config.log
+ cat >&5 <<_ACEOF
+ This file contains any messages produced by compilers while
+ running configure, to aid debugging if configure makes a mistake.
+ 
+ It was created by $as_me, which was
+ generated by GNU Autoconf 2.59.  Invocation command line was
+ 
+   $ $0 $@
+ 
+ _ACEOF
+ {
+ cat <<_ASUNAME
+ ## --------- ##
+ ## Platform. ##
+ ## --------- ##
+ 
+ hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+ uname -m = `(uname -m) 2>/dev/null || echo unknown`
+ uname -r = `(uname -r) 2>/dev/null || echo unknown`
+ uname -s = `(uname -s) 2>/dev/null || echo unknown`
+ uname -v = `(uname -v) 2>/dev/null || echo unknown`
+ 
+ /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+ /bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+ 
+ /bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+ /usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+ /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+ hostinfo               = `(hostinfo) 2>/dev/null               || echo unknown`
+ /bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+ /usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+ /bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+ 
+ _ASUNAME
+ 
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in $PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   echo "PATH: $as_dir"
+ done
+ 
+ } >&5
+ 
+ cat >&5 <<_ACEOF
+ 
+ 
+ ## ----------- ##
+ ## Core tests. ##
+ ## ----------- ##
+ 
+ _ACEOF
+ 
+ 
+ # Keep a trace of the command line.
+ # Strip out --no-create and --no-recursion so they do not pile up.
+ # Strip out --silent because we don't want to record it for future runs.
+ # Also quote any args containing shell meta-characters.
+ # Make two passes to allow for proper duplicate-argument suppression.
+ ac_configure_args=
+ ac_configure_args0=
+ ac_configure_args1=
+ ac_sep=
+ ac_must_keep_next=false
+ for ac_pass in 1 2
+ do
+   for ac_arg
+   do
+     case $ac_arg in
+     -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+     -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+     | -silent | --silent | --silen | --sile | --sil)
+       continue ;;
+     *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+       ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+     esac
+     case $ac_pass in
+     1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+     2)
+       ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+       if test $ac_must_keep_next = true; then
+ 	ac_must_keep_next=false # Got value, back to normal.
+       else
+ 	case $ac_arg in
+ 	  *=* | --config-cache | -C | -disable-* | --disable-* \
+ 	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ 	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ 	  | -with-* | --with-* | -without-* | --without-* | --x)
+ 	    case "$ac_configure_args0 " in
+ 	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ 	    esac
+ 	    ;;
+ 	  -* ) ac_must_keep_next=true ;;
+ 	esac
+       fi
+       ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+       # Get rid of the leading space.
+       ac_sep=" "
+       ;;
+     esac
+   done
+ done
+ $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+ $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+ 
+ # When interrupted or exit'd, cleanup temporary files, and complete
+ # config.log.  We remove comments because anyway the quotes in there
+ # would cause problems or look ugly.
+ # WARNING: Be sure not to use single quotes in there, as some shells,
+ # such as our DU 5.0 friend, will then `close' the trap.
+ trap 'exit_status=$?
+   # Save into config.log some information that might help in debugging.
+   {
+     echo
+ 
+     cat <<\_ASBOX
+ ## ---------------- ##
+ ## Cache variables. ##
+ ## ---------------- ##
+ _ASBOX
+     echo
+     # The following way of writing the cache mishandles newlines in values,
+ {
+   (set) 2>&1 |
+     case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+     *ac_space=\ *)
+       sed -n \
+ 	"s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ 	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+       ;;
+     *)
+       sed -n \
+ 	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+       ;;
+     esac;
+ }
+     echo
+ 
+     cat <<\_ASBOX
+ ## ----------------- ##
+ ## Output variables. ##
+ ## ----------------- ##
+ _ASBOX
+     echo
+     for ac_var in $ac_subst_vars
+     do
+       eval ac_val=$`echo $ac_var`
+       echo "$ac_var='"'"'$ac_val'"'"'"
+     done | sort
+     echo
+ 
+     if test -n "$ac_subst_files"; then
+       cat <<\_ASBOX
+ ## ------------- ##
+ ## Output files. ##
+ ## ------------- ##
+ _ASBOX
+       echo
+       for ac_var in $ac_subst_files
+       do
+ 	eval ac_val=$`echo $ac_var`
+ 	echo "$ac_var='"'"'$ac_val'"'"'"
+       done | sort
+       echo
+     fi
+ 
+     if test -s confdefs.h; then
+       cat <<\_ASBOX
+ ## ----------- ##
+ ## confdefs.h. ##
+ ## ----------- ##
+ _ASBOX
+       echo
+       sed "/^$/d" confdefs.h | sort
+       echo
+     fi
+     test "$ac_signal" != 0 &&
+       echo "$as_me: caught signal $ac_signal"
+     echo "$as_me: exit $exit_status"
+   } >&5
+   rm -f core *.core &&
+   rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+     exit $exit_status
+      ' 0
+ for ac_signal in 1 2 13 15; do
+   trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+ done
+ ac_signal=0
+ 
+ # confdefs.h avoids OS command line length limits that DEFS can exceed.
+ rm -rf conftest* confdefs.h
+ # AIX cpp loses on an empty file, so make sure it contains at least a newline.
+ echo >confdefs.h
+ 
+ # Predefined preprocessor variables.
+ 
+ cat >>confdefs.h <<_ACEOF
+ #define PACKAGE_NAME "$PACKAGE_NAME"
+ _ACEOF
+ 
+ 
+ cat >>confdefs.h <<_ACEOF
+ #define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+ _ACEOF
+ 
+ 
+ cat >>confdefs.h <<_ACEOF
+ #define PACKAGE_VERSION "$PACKAGE_VERSION"
+ _ACEOF
+ 
+ 
+ cat >>confdefs.h <<_ACEOF
+ #define PACKAGE_STRING "$PACKAGE_STRING"
+ _ACEOF
+ 
+ 
+ cat >>confdefs.h <<_ACEOF
+ #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+ _ACEOF
+ 
+ 
+ # Let the site file select an alternate cache file if it wants to.
+ # Prefer explicitly selected file to automatically selected ones.
+ if test -z "$CONFIG_SITE"; then
+   if test "x$prefix" != xNONE; then
+     CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+   else
+     CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+   fi
+ fi
+ for ac_site_file in $CONFIG_SITE; do
+   if test -r "$ac_site_file"; then
+     { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+ echo "$as_me: loading site script $ac_site_file" >&6;}
+     sed 's/^/| /' "$ac_site_file" >&5
+     . "$ac_site_file"
+   fi
+ done
+ 
+ if test -r "$cache_file"; then
+   # Some versions of bash will fail to source /dev/null (special
+   # files actually), so we avoid doing that.
+   if test -f "$cache_file"; then
+     { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+ echo "$as_me: loading cache $cache_file" >&6;}
+     case $cache_file in
+       [\\/]* | ?:[\\/]* ) . $cache_file;;
+       *)                      . ./$cache_file;;
+     esac
+   fi
+ else
+   { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+ echo "$as_me: creating cache $cache_file" >&6;}
+   >$cache_file
+ fi
+ 
+ # Check that the precious variables saved in the cache have kept the same
+ # value.
+ ac_cache_corrupted=false
+ for ac_var in `(set) 2>&1 |
+ 	       sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+   eval ac_old_set=\$ac_cv_env_${ac_var}_set
+   eval ac_new_set=\$ac_env_${ac_var}_set
+   eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+   eval ac_new_val="\$ac_env_${ac_var}_value"
+   case $ac_old_set,$ac_new_set in
+     set,)
+       { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+ echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+       ac_cache_corrupted=: ;;
+     ,set)
+       { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+ echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+       ac_cache_corrupted=: ;;
+     ,);;
+     *)
+       if test "x$ac_old_val" != "x$ac_new_val"; then
+ 	{ echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+ echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ 	{ echo "$as_me:$LINENO:   former value:  $ac_old_val" >&5
+ echo "$as_me:   former value:  $ac_old_val" >&2;}
+ 	{ echo "$as_me:$LINENO:   current value: $ac_new_val" >&5
+ echo "$as_me:   current value: $ac_new_val" >&2;}
+ 	ac_cache_corrupted=:
+       fi;;
+   esac
+   # Pass precious variables to config.status.
+   if test "$ac_new_set" = set; then
+     case $ac_new_val in
+     *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+       ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+     *) ac_arg=$ac_var=$ac_new_val ;;
+     esac
+     case " $ac_configure_args " in
+       *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+       *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+     esac
+   fi
+ done
+ if $ac_cache_corrupted; then
+   { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+ echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+   { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+ echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+    { (exit 1); exit 1; }; }
+ fi
+ 
+ ac_ext=c
+ ac_cpp='$CPP $CPPFLAGS'
+ ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ ac_compiler_gnu=$ac_cv_c_compiler_gnu
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ # Command-line options.
+ # Very limited version of AC_MAINTAINER_MODE.
+ # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
+ if test "${enable_maintainer_mode+set}" = set; then
+   enableval="$enable_maintainer_mode"
+   case ${enable_maintainer_mode} in
+      yes) MAINT='' ;;
+      no) MAINT='#' ;;
+      *) { { echo "$as_me:$LINENO: error: --enable-maintainer-mode must be yes or no" >&5
+ echo "$as_me: error: --enable-maintainer-mode must be yes or no" >&2;}
+    { (exit 1); exit 1; }; } ;;
+    esac
+    maintainer_mode=${enableval}
+ else
+   MAINT='#'
+ fi;
+ 
+ # Start of actual configure tests
+ 
+ ac_aux_dir=
+ for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+   if test -f $ac_dir/install-sh; then
+     ac_aux_dir=$ac_dir
+     ac_install_sh="$ac_aux_dir/install-sh -c"
+     break
+   elif test -f $ac_dir/install.sh; then
+     ac_aux_dir=$ac_dir
+     ac_install_sh="$ac_aux_dir/install.sh -c"
+     break
+   elif test -f $ac_dir/shtool; then
+     ac_aux_dir=$ac_dir
+     ac_install_sh="$ac_aux_dir/shtool install -c"
+     break
+   fi
+ done
+ if test -z "$ac_aux_dir"; then
+   { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5
+ echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}
+    { (exit 1); exit 1; }; }
+ fi
+ ac_config_guess="$SHELL $ac_aux_dir/config.guess"
+ ac_config_sub="$SHELL $ac_aux_dir/config.sub"
+ ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
+ 
+ # Find a good install program.  We prefer a C program (faster),
+ # so one script is as good as another.  But avoid the broken or
+ # incompatible versions:
+ # SysV /etc/install, /usr/sbin/install
+ # SunOS /usr/etc/install
+ # IRIX /sbin/install
+ # AIX /bin/install
+ # AmigaOS /C/install, which installs bootblocks on floppy discs
+ # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+ # AFS /usr/afsws/bin/install, which mishandles nonexistent args
+ # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+ # OS/2's system install, which has a completely different semantic
+ # ./install, which can be erroneously created by make from ./install.sh.
+ echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
+ echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
+ if test -z "$INSTALL"; then
+ if test "${ac_cv_path_install+set}" = set; then
+   echo $ECHO_N "(cached) $ECHO_C" >&6
+ else
+   as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in $PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   # Account for people who put trailing slashes in PATH elements.
+ case $as_dir/ in
+   ./ | .// | /cC/* | \
+   /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+   ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \
+   /usr/ucb/* ) ;;
+   *)
+     # OSF1 and SCO ODT 3.0 have their own names for install.
+     # Don't use installbsd from OSF since it installs stuff as root
+     # by default.
+     for ac_prog in ginstall scoinst install; do
+       for ac_exec_ext in '' $ac_executable_extensions; do
+ 	if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ 	  if test $ac_prog = install &&
+ 	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ 	    # AIX install.  It has an incompatible calling convention.
+ 	    :
+ 	  elif test $ac_prog = install &&
+ 	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ 	    # program-specific install script used by HP pwplus--don't use.
+ 	    :
+ 	  else
+ 	    ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ 	    break 3
+ 	  fi
+ 	fi
+       done
+     done
+     ;;
+ esac
+ done
+ 
+ 
+ fi
+   if test "${ac_cv_path_install+set}" = set; then
+     INSTALL=$ac_cv_path_install
+   else
+     # As a last resort, use the slow shell script.  We don't cache a
+     # path for INSTALL within a source directory, because that will
+     # break other packages using the cache if that directory is
+     # removed, or if the path is relative.
+     INSTALL=$ac_install_sh
+   fi
+ fi
+ echo "$as_me:$LINENO: result: $INSTALL" >&5
+ echo "${ECHO_T}$INSTALL" >&6
+ 
+ # Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+ # It thinks the first close brace ends the variable substitution.
+ test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+ 
+ test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+ 
+ test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+ 
+ 
+ # Make sure we can run config.sub.
+ $ac_config_sub sun4 >/dev/null 2>&1 ||
+   { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5
+ echo "$as_me: error: cannot run $ac_config_sub" >&2;}
+    { (exit 1); exit 1; }; }
+ 
+ echo "$as_me:$LINENO: checking build system type" >&5
+ echo $ECHO_N "checking build system type... $ECHO_C" >&6
+ if test "${ac_cv_build+set}" = set; then
+   echo $ECHO_N "(cached) $ECHO_C" >&6
+ else
+   ac_cv_build_alias=$build_alias
+ test -z "$ac_cv_build_alias" &&
+   ac_cv_build_alias=`$ac_config_guess`
+ test -z "$ac_cv_build_alias" &&
+   { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5
+ echo "$as_me: error: cannot guess build type; you must specify one" >&2;}
+    { (exit 1); exit 1; }; }
+ ac_cv_build=`$ac_config_sub $ac_cv_build_alias` ||
+   { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5
+ echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;}
+    { (exit 1); exit 1; }; }
+ 
+ fi
+ echo "$as_me:$LINENO: result: $ac_cv_build" >&5
+ echo "${ECHO_T}$ac_cv_build" >&6
+ build=$ac_cv_build
+ build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+ build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+ build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+ 
+ 
+ echo "$as_me:$LINENO: checking host system type" >&5
+ echo $ECHO_N "checking host system type... $ECHO_C" >&6
+ if test "${ac_cv_host+set}" = set; then
+   echo $ECHO_N "(cached) $ECHO_C" >&6
+ else
+   ac_cv_host_alias=$host_alias
+ test -z "$ac_cv_host_alias" &&
+   ac_cv_host_alias=$ac_cv_build_alias
+ ac_cv_host=`$ac_config_sub $ac_cv_host_alias` ||
+   { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5
+ echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;}
+    { (exit 1); exit 1; }; }
+ 
+ fi
+ echo "$as_me:$LINENO: result: $ac_cv_host" >&5
+ echo "${ECHO_T}$ac_cv_host" >&6
+ host=$ac_cv_host
+ host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+ host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+ host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+ 
+ 
+ echo "$as_me:$LINENO: checking target system type" >&5
+ echo $ECHO_N "checking target system type... $ECHO_C" >&6
+ if test "${ac_cv_target+set}" = set; then
+   echo $ECHO_N "(cached) $ECHO_C" >&6
+ else
+   ac_cv_target_alias=$target_alias
+ test "x$ac_cv_target_alias" = "x" &&
+   ac_cv_target_alias=$ac_cv_host_alias
+ ac_cv_target=`$ac_config_sub $ac_cv_target_alias` ||
+   { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_target_alias failed" >&5
+ echo "$as_me: error: $ac_config_sub $ac_cv_target_alias failed" >&2;}
+    { (exit 1); exit 1; }; }
+ 
+ fi
+ echo "$as_me:$LINENO: result: $ac_cv_target" >&5
+ echo "${ECHO_T}$ac_cv_target" >&6
+ target=$ac_cv_target
+ target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+ target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+ target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+ 
+ 
+ # The aliases save the names the user supplied, while $host etc.
+ # will get canonicalized.
+ test -n "$target_alias" &&
+   test "$program_prefix$program_suffix$program_transform_name" = \
+     NONENONEs,x,x, &&
+   program_prefix=${target_alias}-
+ 
+ # Autoconf M4 include file defining utility macros for complex Canadian
+ # cross builds.
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ ####
+ # _NCN_TOOL_PREFIXES:  Some stuff that oughtta be done in AC_CANONICAL_SYSTEM
+ # or AC_INIT.
+ # These demand that AC_CANONICAL_SYSTEM be called beforehand.
+ 
+ ####
+ # NCN_CHECK_TARGET_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
+ # Like AC_CHECK_TOOL, but tries a prefix of the target, not the host.
+ # Code is pretty much lifted from autoconf2.53.
+ 
+ 
+ 
+ ####
+ # NCN_STRICT_CHECK_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
+ # Like AC_CHECK_TOOL, but requires the prefix if build!=host.
+ 
+ 
+ 
+ ####
+ # NCN_STRICT_CHECK_TARGET_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
+ # Like NCN_CHECK_TARGET_TOOL, but requires the prefix if build!=target.
+ 
+ 
+ ###
+ # AC_PROG_CPP_WERROR
+ # Used for autoconf 2.5x to force AC_PREPROC_IFELSE to reject code which
+ # triggers warnings from the preprocessor.  Will be in autoconf 2.58.
+ # For now, using this also overrides header checks to use only the
+ # preprocessor (matches 2.13 behavior; matching 2.58's behavior is a
+ # bit harder from here).
+ # Eventually autoconf will default to checking headers with the compiler
+ # instead, and we'll have to do this differently.
+ 
+ # AC_PROG_CPP_WERROR
+ 
+ # Test for GNAT.
+ # We require the gnatbind program, and a compiler driver that
+ # understands Ada.  We use the user's CC setting, already found.
+ #
+ # Sets the shell variable have_gnat to yes or no as appropriate, and
+ # substitutes GNATBIND.
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+  case ${build_alias} in
+   "") build_noncanonical=${build} ;;
+   *) build_noncanonical=${build_alias} ;;
+ esac
+ 
+  case ${host_alias} in
+   "") host_noncanonical=${build_noncanonical} ;;
+   *) host_noncanonical=${host_alias} ;;
+ esac
+ 
+  case ${target_alias} in
+   "") target_noncanonical=${host_noncanonical} ;;
+   *) target_noncanonical=${target_alias} ;;
+ esac
+ 
+ 
+ 
+ 
+ # Need to pass this down for now :-P
+ echo "$as_me:$LINENO: checking whether ln -s works" >&5
+ echo $ECHO_N "checking whether ln -s works... $ECHO_C" >&6
+ LN_S=$as_ln_s
+ if test "$LN_S" = "ln -s"; then
+   echo "$as_me:$LINENO: result: yes" >&5
+ echo "${ECHO_T}yes" >&6
+ else
+   echo "$as_me:$LINENO: result: no, using $LN_S" >&5
+ echo "${ECHO_T}no, using $LN_S" >&6
+ fi
+ 
+ 
+ # Determine x_ada_cflags
+ case $host in
+   hppa*) x_ada_cflags=-mdisable-indexing ;;
+   *) x_ada_cflags= ;;
+ esac
+ 
+ 
+ # Determine what to build for 'gnattools'
+ if test $build = $target ; then
+   # Note that build=target is almost certainly the wrong test; FIXME
+   default_gnattools_target="gnattools-native"
+ else
+   default_gnattools_target="gnattools-cross"
+ fi
+ 
+ 
+ # Target-specific stuff (defaults)
+ TOOLS_TARGET_PAIRS=
+ 
+ EXTRA_GNATTOOLS=
+ 
+ 
+ # Per-target case statement
+ # -------------------------
+ case "${target}" in
+   alpha*-dec-vx*) # Unlike all other Vxworks
+     ;;
+   m68k*-wrs-vx* \
+   | powerpc*-wrs-vxworks \
+   | sparc*-wrs-vx* \
+   | *86-wrs-vxworks \
+   | xscale*-wrs-vx* \
+   | xscale*-wrs-coff \
+   | mips*-wrs-vx*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-vxworks.adb"
+     ;;
+   sparc-sun-solaris*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-solaris.adb"
+     ;;
+   *86-*-solaris2*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-solaris.adb"
+     ;;
+   *86-*-linux* \
+   | powerpc*-*-linux*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb \
+     indepsw.adb<indepsw-linux.adb"
+     ;;
+   *ia64-*-linux* \
+   | alpha*-*-linux )
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb \
+     indepsw.adb<indepsw-linux.adb"
+     ;;
+   *x86_64-*-linux* \
+   | s390*-*-linux*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-linux.adb"
+     ;;
+   *86-*-freebsd*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb"
+     ;;
+   mips-sgi-irix*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-irix.adb"
+     ;;
+   hppa*-hp-hpux10*) # Unlike hpux11
+     ;;
+   hppa*-hp-hpux11*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-hpux.adb"
+     ;;
+   *-ibm-aix*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-aix.adb \
+     indepsw.adb<indepsw-aix.adb"
+     ;;
+   alpha*-dec-osf*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-tru64.adb"
+     ;;
+   alpha*-dec-vms* | alpha*-dec-openvms* | alpha*-dec-vms* \
+   | alpha*-hp-vms* | alpha*-hp-openvms* | alpha*-hp-vms*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-vms-alpha.adb \
+     symbols.adb<symbols-vms-alpha.adb"
+ 
+     EXTRA_GNATTOOLS='../../gnatlbr$(exeext) ../../gnatsym$(exeext)'
+     ;;
+   ia64*-dec-vms* | ia64*-dec-openvms* | ia64*-dec-vms* \
+   | ia64*-hp-vms* | ia64*-hp-openvms* | ia64*-hp-vms*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-vms-ia64.adb \
+     symbols.adb<symbols-vms-ia64.adb"
+ 
+     EXTRA_GNATTOOLS='../../gnatlbr$(exeext) ../../gnatsym$(exeext)'
+     ;;
+   *-*-cygwin32* | *-*-mingw32* | *-*-pe)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-mingw.adb \
+     indepsw.adb<indepsw-mingw.adb"
+     EXTRA_GNATTOOLS='../../gnatdll$(exeext)'
+     ;;
+   powerpc-*-darwin*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-darwin.adb"
+     ;;
+   *-*-lynxos)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-lynxos.adb"
+     ;;
+ esac
+ 
+ # Output: create a Makefile.
+           ac_config_files="$ac_config_files Makefile"
+ 
+ 
+ cat >confcache <<\_ACEOF
+ # This file is a shell script that caches the results of configure
+ # tests run on this system so they can be shared between configure
+ # scripts and configure runs, see configure's option --config-cache.
+ # It is not useful on other systems.  If it contains results you don't
+ # want to keep, you may remove or edit it.
+ #
+ # config.status only pays attention to the cache file if you give it
+ # the --recheck option to rerun configure.
+ #
+ # `ac_cv_env_foo' variables (set or unset) will be overridden when
+ # loading this file, other *unset* `ac_cv_foo' will be assigned the
+ # following values.
+ 
+ _ACEOF
+ 
+ # The following way of writing the cache mishandles newlines in values,
+ # but we know of no workaround that is simple, portable, and efficient.
+ # So, don't put newlines in cache variables' values.
+ # Ultrix sh set writes to stderr and can't be redirected directly,
+ # and sets the high bit in the cache file unless we assign to the vars.
+ {
+   (set) 2>&1 |
+     case `(ac_space=' '; set | grep ac_space) 2>&1` in
+     *ac_space=\ *)
+       # `set' does not quote correctly, so add quotes (double-quote
+       # substitution turns \\\\ into \\, and sed turns \\ into \).
+       sed -n \
+ 	"s/'/'\\\\''/g;
+ 	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+       ;;
+     *)
+       # `set' quotes correctly as required by POSIX, so do not add quotes.
+       sed -n \
+ 	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+       ;;
+     esac;
+ } |
+   sed '
+      t clear
+      : clear
+      s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+      t end
+      /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+      : end' >>confcache
+ if diff $cache_file confcache >/dev/null 2>&1; then :; else
+   if test -w $cache_file; then
+     test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+     cat confcache >$cache_file
+   else
+     echo "not updating unwritable cache $cache_file"
+   fi
+ fi
+ rm -f confcache
+ 
+ test "x$prefix" = xNONE && prefix=$ac_default_prefix
+ # Let make expand exec_prefix.
+ test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+ 
+ # VPATH may cause trouble with some makes, so we remove $(srcdir),
+ # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+ # trailing colons and then remove the whole line if VPATH becomes empty
+ # (actually we leave an empty line to preserve line numbers).
+ if test "x$srcdir" = x.; then
+   ac_vpsub='/^[	 ]*VPATH[	 ]*=/{
+ s/:*\$(srcdir):*/:/;
+ s/:*\${srcdir}:*/:/;
+ s/:*@srcdir@:*/:/;
+ s/^\([^=]*=[	 ]*\):*/\1/;
+ s/:*$//;
+ s/^[^=]*=[	 ]*$//;
+ }'
+ fi
+ 
+ # Transform confdefs.h into DEFS.
+ # Protect against shell expansion while executing Makefile rules.
+ # Protect against Makefile macro expansion.
+ #
+ # If the first sed substitution is executed (which looks for macros that
+ # take arguments), then we branch to the quote section.  Otherwise,
+ # look for a macro that doesn't take arguments.
+ cat >confdef2opt.sed <<\_ACEOF
+ t clear
+ : clear
+ s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\),-D\1=\2,g
+ t quote
+ s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\),-D\1=\2,g
+ t quote
+ d
+ : quote
+ s,[	 `~#$^&*(){}\\|;'"<>?],\\&,g
+ s,\[,\\&,g
+ s,\],\\&,g
+ s,\$,$$,g
+ p
+ _ACEOF
+ # We use echo to avoid assuming a particular line-breaking character.
+ # The extra dot is to prevent the shell from consuming trailing
+ # line-breaks from the sub-command output.  A line-break within
+ # single-quotes doesn't work because, if this script is created in a
+ # platform that uses two characters for line-breaks (e.g., DOS), tr
+ # would break.
+ ac_LF_and_DOT=`echo; echo .`
+ DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
+ rm -f confdef2opt.sed
+ 
+ 
+ ac_libobjs=
+ ac_ltlibobjs=
+ for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+   # 1. Remove the extension, and $U if already installed.
+   ac_i=`echo "$ac_i" |
+ 	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+   # 2. Add them.
+   ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+   ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+ done
+ LIBOBJS=$ac_libobjs
+ 
+ LTLIBOBJS=$ac_ltlibobjs
+ 
+ 
+ 
+ : ${CONFIG_STATUS=./config.status}
+ ac_clean_files_save=$ac_clean_files
+ ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+ { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+ echo "$as_me: creating $CONFIG_STATUS" >&6;}
+ cat >$CONFIG_STATUS <<_ACEOF
+ #! $SHELL
+ # Generated by $as_me.
+ # Run this file to recreate the current configuration.
+ # Compiler output produced by configure, useful for debugging
+ # configure, is in config.log if it exists.
+ 
+ debug=false
+ ac_cs_recheck=false
+ ac_cs_silent=false
+ SHELL=\${CONFIG_SHELL-$SHELL}
+ _ACEOF
+ 
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ ## --------------------- ##
+ ## M4sh Initialization.  ##
+ ## --------------------- ##
+ 
+ # Be Bourne compatible
+ if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+   emulate sh
+   NULLCMD=:
+   # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+   # is contrary to our usage.  Disable this feature.
+   alias -g '${1+"$@"}'='"$@"'
+ elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+   set -o posix
+ fi
+ DUALCASE=1; export DUALCASE # for MKS sh
+ 
+ # Support unset when possible.
+ if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+   as_unset=unset
+ else
+   as_unset=false
+ fi
+ 
+ 
+ # Work around bugs in pre-3.0 UWIN ksh.
+ $as_unset ENV MAIL MAILPATH
+ PS1='$ '
+ PS2='> '
+ PS4='+ '
+ 
+ # NLS nuisances.
+ for as_var in \
+   LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+   LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+   LC_TELEPHONE LC_TIME
+ do
+   if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+     eval $as_var=C; export $as_var
+   else
+     $as_unset $as_var
+   fi
+ done
+ 
+ # Required to use basename.
+ if expr a : '\(a\)' >/dev/null 2>&1; then
+   as_expr=expr
+ else
+   as_expr=false
+ fi
+ 
+ if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+   as_basename=basename
+ else
+   as_basename=false
+ fi
+ 
+ 
+ # Name of the executable.
+ as_me=`$as_basename "$0" ||
+ $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ 	 X"$0" : 'X\(//\)$' \| \
+ 	 X"$0" : 'X\(/\)$' \| \
+ 	 .     : '\(.\)' 2>/dev/null ||
+ echo X/"$0" |
+     sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+   	  /^X\/\(\/\/\)$/{ s//\1/; q; }
+   	  /^X\/\(\/\).*/{ s//\1/; q; }
+   	  s/.*/./; q'`
+ 
+ 
+ # PATH needs CR, and LINENO needs CR and PATH.
+ # Avoid depending upon Character Ranges.
+ as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+ as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+ as_cr_digits='0123456789'
+ as_cr_alnum=$as_cr_Letters$as_cr_digits
+ 
+ # The user is always right.
+ if test "${PATH_SEPARATOR+set}" != set; then
+   echo "#! /bin/sh" >conf$$.sh
+   echo  "exit 0"   >>conf$$.sh
+   chmod +x conf$$.sh
+   if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+     PATH_SEPARATOR=';'
+   else
+     PATH_SEPARATOR=:
+   fi
+   rm -f conf$$.sh
+ fi
+ 
+ 
+   as_lineno_1=$LINENO
+   as_lineno_2=$LINENO
+   as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+   test "x$as_lineno_1" != "x$as_lineno_2" &&
+   test "x$as_lineno_3"  = "x$as_lineno_2"  || {
+   # Find who we are.  Look in the path if we contain no path at all
+   # relative or not.
+   case $0 in
+     *[\\/]* ) as_myself=$0 ;;
+     *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in $PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+ 
+        ;;
+   esac
+   # We did not find ourselves, most probably we were run as `sh COMMAND'
+   # in which case we are not to be found in the path.
+   if test "x$as_myself" = x; then
+     as_myself=$0
+   fi
+   if test ! -f "$as_myself"; then
+     { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+ echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+    { (exit 1); exit 1; }; }
+   fi
+   case $CONFIG_SHELL in
+   '')
+     as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+ do
+   IFS=$as_save_IFS
+   test -z "$as_dir" && as_dir=.
+   for as_base in sh bash ksh sh5; do
+ 	 case $as_dir in
+ 	 /*)
+ 	   if ("$as_dir/$as_base" -c '
+   as_lineno_1=$LINENO
+   as_lineno_2=$LINENO
+   as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+   test "x$as_lineno_1" != "x$as_lineno_2" &&
+   test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
+ 	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ 	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ 	     CONFIG_SHELL=$as_dir/$as_base
+ 	     export CONFIG_SHELL
+ 	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ 	   fi;;
+ 	 esac
+        done
+ done
+ ;;
+   esac
+ 
+   # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+   # uniformly replaced by the line number.  The first 'sed' inserts a
+   # line-number line before each line; the second 'sed' does the real
+   # work.  The second script uses 'N' to pair each line-number line
+   # with the numbered line, and appends trailing '-' during
+   # substitution so that $LINENO is not a special case at line end.
+   # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+   # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
+   sed '=' <$as_myself |
+     sed '
+       N
+       s,$,-,
+       : loop
+       s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+       t loop
+       s,-$,,
+       s,^['$as_cr_digits']*\n,,
+     ' >$as_me.lineno &&
+   chmod +x $as_me.lineno ||
+     { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+ echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+    { (exit 1); exit 1; }; }
+ 
+   # Don't try to exec as it changes $[0], causing all sort of problems
+   # (the dirname of $[0] is not the place where we might find the
+   # original and so on.  Autoconf is especially sensible to this).
+   . ./$as_me.lineno
+   # Exit status is that of the last command.
+   exit
+ }
+ 
+ 
+ case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+   *c*,-n*) ECHO_N= ECHO_C='
+ ' ECHO_T='	' ;;
+   *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+   *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ esac
+ 
+ if expr a : '\(a\)' >/dev/null 2>&1; then
+   as_expr=expr
+ else
+   as_expr=false
+ fi
+ 
+ rm -f conf$$ conf$$.exe conf$$.file
+ echo >conf$$.file
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
+   # We could just check for DJGPP; but this test a) works b) is more generic
+   # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+   if test -f conf$$.exe; then
+     # Don't use ln at all; we don't have any links
+     as_ln_s='cp -p'
+   else
+     as_ln_s='ln -s'
+   fi
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+   as_ln_s=ln
+ else
+   as_ln_s='cp -p'
+ fi
+ rm -f conf$$ conf$$.exe conf$$.file
+ 
+ if mkdir -p . 2>/dev/null; then
+   as_mkdir_p=:
+ else
+   test -d ./-p && rmdir ./-p
+   as_mkdir_p=false
+ fi
+ 
+ as_executable_p="test -f"
+ 
+ # Sed expression to map a string onto a valid CPP name.
+ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+ 
+ # Sed expression to map a string onto a valid variable name.
+ as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+ 
+ 
+ # IFS
+ # We need space, tab and new line, in precisely that order.
+ as_nl='
+ '
+ IFS=" 	$as_nl"
+ 
+ # CDPATH.
+ $as_unset CDPATH
+ 
+ exec 6>&1
+ 
+ # Open the log real soon, to keep \$[0] and so on meaningful, and to
+ # report actual input values of CONFIG_FILES etc. instead of their
+ # values after options handling.  Logging --version etc. is OK.
+ exec 5>>config.log
+ {
+   echo
+   sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+ ## Running $as_me. ##
+ _ASBOX
+ } >&5
+ cat >&5 <<_CSEOF
+ 
+ This file was extended by $as_me, which was
+ generated by GNU Autoconf 2.59.  Invocation command line was
+ 
+   CONFIG_FILES    = $CONFIG_FILES
+   CONFIG_HEADERS  = $CONFIG_HEADERS
+   CONFIG_LINKS    = $CONFIG_LINKS
+   CONFIG_COMMANDS = $CONFIG_COMMANDS
+   $ $0 $@
+ 
+ _CSEOF
+ echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+ echo >&5
+ _ACEOF
+ 
+ # Files that config.status was made for.
+ if test -n "$ac_config_files"; then
+   echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+ fi
+ 
+ if test -n "$ac_config_headers"; then
+   echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+ fi
+ 
+ if test -n "$ac_config_links"; then
+   echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+ fi
+ 
+ if test -n "$ac_config_commands"; then
+   echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+ fi
+ 
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ 
+ ac_cs_usage="\
+ \`$as_me' instantiates files from templates according to the
+ current configuration.
+ 
+ Usage: $0 [OPTIONS] [FILE]...
+ 
+   -h, --help       print this help, then exit
+   -V, --version    print version number, then exit
+   -q, --quiet      do not print progress messages
+   -d, --debug      don't remove temporary files
+       --recheck    update $as_me by reconfiguring in the same conditions
+   --file=FILE[:TEMPLATE]
+ 		   instantiate the configuration file FILE
+ 
+ Configuration files:
+ $config_files
+ 
+ Report bugs to <bug-autoconf@gnu.org>."
+ _ACEOF
+ 
+ cat >>$CONFIG_STATUS <<_ACEOF
+ ac_cs_version="\\
+ config.status
+ configured by $0, generated by GNU Autoconf 2.59,
+   with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+ 
+ Copyright (C) 2003 Free Software Foundation, Inc.
+ This config.status script is free software; the Free Software Foundation
+ gives unlimited permission to copy, distribute and modify it."
+ srcdir=$srcdir
+ INSTALL="$INSTALL"
+ _ACEOF
+ 
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # If no file are specified by the user, then we need to provide default
+ # value.  By we need to know if files were specified by the user.
+ ac_need_defaults=:
+ while test $# != 0
+ do
+   case $1 in
+   --*=*)
+     ac_option=`expr "x$1" : 'x\([^=]*\)='`
+     ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+     ac_shift=:
+     ;;
+   -*)
+     ac_option=$1
+     ac_optarg=$2
+     ac_shift=shift
+     ;;
+   *) # This is not an option, so the user has probably given explicit
+      # arguments.
+      ac_option=$1
+      ac_need_defaults=false;;
+   esac
+ 
+   case $ac_option in
+   # Handling of the options.
+ _ACEOF
+ cat >>$CONFIG_STATUS <<\_ACEOF
+   -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+     ac_cs_recheck=: ;;
+   --version | --vers* | -V )
+     echo "$ac_cs_version"; exit 0 ;;
+   --he | --h)
+     # Conflict between --help and --header
+     { { echo "$as_me:$LINENO: error: ambiguous option: $1
+ Try \`$0 --help' for more information." >&5
+ echo "$as_me: error: ambiguous option: $1
+ Try \`$0 --help' for more information." >&2;}
+    { (exit 1); exit 1; }; };;
+   --help | --hel | -h )
+     echo "$ac_cs_usage"; exit 0 ;;
+   --debug | --d* | -d )
+     debug=: ;;
+   --file | --fil | --fi | --f )
+     $ac_shift
+     CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+     ac_need_defaults=false;;
+   --header | --heade | --head | --hea )
+     $ac_shift
+     CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+     ac_need_defaults=false;;
+   -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+   | -silent | --silent | --silen | --sile | --sil | --si | --s)
+     ac_cs_silent=: ;;
+ 
+   # This is an error.
+   -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+ Try \`$0 --help' for more information." >&5
+ echo "$as_me: error: unrecognized option: $1
+ Try \`$0 --help' for more information." >&2;}
+    { (exit 1); exit 1; }; } ;;
+ 
+   *) ac_config_targets="$ac_config_targets $1" ;;
+ 
+   esac
+   shift
+ done
+ 
+ ac_configure_extra_args=
+ 
+ if $ac_cs_silent; then
+   exec 6>/dev/null
+   ac_configure_extra_args="$ac_configure_extra_args --silent"
+ fi
+ 
+ _ACEOF
+ cat >>$CONFIG_STATUS <<_ACEOF
+ if \$ac_cs_recheck; then
+   echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+   exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ fi
+ 
+ _ACEOF
+ 
+ 
+ 
+ 
+ 
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ for ac_config_target in $ac_config_targets
+ do
+   case "$ac_config_target" in
+   # Handling of arguments.
+   "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+   *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+ echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+    { (exit 1); exit 1; }; };;
+   esac
+ done
+ 
+ # If the user did not use the arguments to specify the items to instantiate,
+ # then the envvar interface is used.  Set only those that are not.
+ # We use the long form for the default assignment because of an extremely
+ # bizarre bug on SunOS 4.1.3.
+ if $ac_need_defaults; then
+   test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+ fi
+ 
+ # Have a temporary directory for convenience.  Make it in the build tree
+ # simply because there is no reason to put it here, and in addition,
+ # creating and moving files from /tmp can sometimes cause problems.
+ # Create a temporary directory, and hook for its removal unless debugging.
+ $debug ||
+ {
+   trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+   trap '{ (exit 1); exit 1; }' 1 2 13 15
+ }
+ 
+ # Create a (secure) tmp directory for tmp files.
+ 
+ {
+   tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+   test -n "$tmp" && test -d "$tmp"
+ }  ||
+ {
+   tmp=./confstat$$-$RANDOM
+   (umask 077 && mkdir $tmp)
+ } ||
+ {
+    echo "$me: cannot create a temporary directory in ." >&2
+    { (exit 1); exit 1; }
+ }
+ 
+ _ACEOF
+ 
+ cat >>$CONFIG_STATUS <<_ACEOF
+ 
+ #
+ # CONFIG_FILES section.
+ #
+ 
+ # No need to generate the scripts if there are no CONFIG_FILES.
+ # This happens for instance when ./config.status config.h
+ if test -n "\$CONFIG_FILES"; then
+   # Protect against being on the right side of a sed subst in config.status.
+   sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+    s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+ s,@SHELL@,$SHELL,;t t
+ s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+ s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
+ s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+ s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+ s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
+ s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+ s,@exec_prefix@,$exec_prefix,;t t
+ s,@prefix@,$prefix,;t t
+ s,@program_transform_name@,$program_transform_name,;t t
+ s,@bindir@,$bindir,;t t
+ s,@sbindir@,$sbindir,;t t
+ s,@libexecdir@,$libexecdir,;t t
+ s,@datadir@,$datadir,;t t
+ s,@sysconfdir@,$sysconfdir,;t t
+ s,@sharedstatedir@,$sharedstatedir,;t t
+ s,@localstatedir@,$localstatedir,;t t
+ s,@libdir@,$libdir,;t t
+ s,@includedir@,$includedir,;t t
+ s,@oldincludedir@,$oldincludedir,;t t
+ s,@infodir@,$infodir,;t t
+ s,@mandir@,$mandir,;t t
+ s,@build_alias@,$build_alias,;t t
+ s,@host_alias@,$host_alias,;t t
+ s,@target_alias@,$target_alias,;t t
+ s,@DEFS@,$DEFS,;t t
+ s,@ECHO_C@,$ECHO_C,;t t
+ s,@ECHO_N@,$ECHO_N,;t t
+ s,@ECHO_T@,$ECHO_T,;t t
+ s,@LIBS@,$LIBS,;t t
+ s,@MAINT@,$MAINT,;t t
+ s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t
+ s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t
+ s,@INSTALL_DATA@,$INSTALL_DATA,;t t
+ s,@build@,$build,;t t
+ s,@build_cpu@,$build_cpu,;t t
+ s,@build_vendor@,$build_vendor,;t t
+ s,@build_os@,$build_os,;t t
+ s,@host@,$host,;t t
+ s,@host_cpu@,$host_cpu,;t t
+ s,@host_vendor@,$host_vendor,;t t
+ s,@host_os@,$host_os,;t t
+ s,@target@,$target,;t t
+ s,@target_cpu@,$target_cpu,;t t
+ s,@target_vendor@,$target_vendor,;t t
+ s,@target_os@,$target_os,;t t
+ s,@target_noncanonical@,$target_noncanonical,;t t
+ s,@LN_S@,$LN_S,;t t
+ s,@x_ada_cflags@,$x_ada_cflags,;t t
+ s,@default_gnattools_target@,$default_gnattools_target,;t t
+ s,@TOOLS_TARGET_PAIRS@,$TOOLS_TARGET_PAIRS,;t t
+ s,@EXTRA_GNATTOOLS@,$EXTRA_GNATTOOLS,;t t
+ s,@LIBOBJS@,$LIBOBJS,;t t
+ s,@LTLIBOBJS@,$LTLIBOBJS,;t t
+ CEOF
+ 
+ _ACEOF
+ 
+   cat >>$CONFIG_STATUS <<\_ACEOF
+   # Split the substitutions into bite-sized pieces for seds with
+   # small command number limits, like on Digital OSF/1 and HP-UX.
+   ac_max_sed_lines=48
+   ac_sed_frag=1 # Number of current file.
+   ac_beg=1 # First line for current file.
+   ac_end=$ac_max_sed_lines # Line after last line for current file.
+   ac_more_lines=:
+   ac_sed_cmds=
+   while $ac_more_lines; do
+     if test $ac_beg -gt 1; then
+       sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+     else
+       sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+     fi
+     if test ! -s $tmp/subs.frag; then
+       ac_more_lines=false
+     else
+       # The purpose of the label and of the branching condition is to
+       # speed up the sed processing (if there are no `@' at all, there
+       # is no need to browse any of the substitutions).
+       # These are the two extra sed commands mentioned above.
+       (echo ':t
+   /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+       if test -z "$ac_sed_cmds"; then
+ 	ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+       else
+ 	ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+       fi
+       ac_sed_frag=`expr $ac_sed_frag + 1`
+       ac_beg=$ac_end
+       ac_end=`expr $ac_end + $ac_max_sed_lines`
+     fi
+   done
+   if test -z "$ac_sed_cmds"; then
+     ac_sed_cmds=cat
+   fi
+ fi # test -n "$CONFIG_FILES"
+ 
+ _ACEOF
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+   # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+   case $ac_file in
+   - | *:- | *:-:* ) # input from stdin
+ 	cat >$tmp/stdin
+ 	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ 	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+   *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ 	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+   * )   ac_file_in=$ac_file.in ;;
+   esac
+ 
+   # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+   ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+ $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ 	 X"$ac_file" : 'X\(//\)[^/]' \| \
+ 	 X"$ac_file" : 'X\(//\)$' \| \
+ 	 X"$ac_file" : 'X\(/\)' \| \
+ 	 .     : '\(.\)' 2>/dev/null ||
+ echo X"$ac_file" |
+     sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+   	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+   	  /^X\(\/\/\)$/{ s//\1/; q; }
+   	  /^X\(\/\).*/{ s//\1/; q; }
+   	  s/.*/./; q'`
+   { if $as_mkdir_p; then
+     mkdir -p "$ac_dir"
+   else
+     as_dir="$ac_dir"
+     as_dirs=
+     while test ! -d "$as_dir"; do
+       as_dirs="$as_dir $as_dirs"
+       as_dir=`(dirname "$as_dir") 2>/dev/null ||
+ $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ 	 X"$as_dir" : 'X\(//\)[^/]' \| \
+ 	 X"$as_dir" : 'X\(//\)$' \| \
+ 	 X"$as_dir" : 'X\(/\)' \| \
+ 	 .     : '\(.\)' 2>/dev/null ||
+ echo X"$as_dir" |
+     sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+   	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+   	  /^X\(\/\/\)$/{ s//\1/; q; }
+   	  /^X\(\/\).*/{ s//\1/; q; }
+   	  s/.*/./; q'`
+     done
+     test ! -n "$as_dirs" || mkdir $as_dirs
+   fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+ echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+    { (exit 1); exit 1; }; }; }
+ 
+   ac_builddir=.
+ 
+ if test "$ac_dir" != .; then
+   ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+   # A "../" for each directory in $ac_dir_suffix.
+   ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+ else
+   ac_dir_suffix= ac_top_builddir=
+ fi
+ 
+ case $srcdir in
+   .)  # No --srcdir option.  We are building in place.
+     ac_srcdir=.
+     if test -z "$ac_top_builddir"; then
+        ac_top_srcdir=.
+     else
+        ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+     fi ;;
+   [\\/]* | ?:[\\/]* )  # Absolute path.
+     ac_srcdir=$srcdir$ac_dir_suffix;
+     ac_top_srcdir=$srcdir ;;
+   *) # Relative path.
+     ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+     ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ esac
+ 
+ # Do not use `cd foo && pwd` to compute absolute paths, because
+ # the directories may not exist.
+ case `pwd` in
+ .) ac_abs_builddir="$ac_dir";;
+ *)
+   case "$ac_dir" in
+   .) ac_abs_builddir=`pwd`;;
+   [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+   *) ac_abs_builddir=`pwd`/"$ac_dir";;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *)
+   case ${ac_top_builddir}. in
+   .) ac_abs_top_builddir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+   *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_srcdir=$ac_srcdir;;
+ *)
+   case $ac_srcdir in
+   .) ac_abs_srcdir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+   *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+   esac;;
+ esac
+ case $ac_abs_builddir in
+ .) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *)
+   case $ac_top_srcdir in
+   .) ac_abs_top_srcdir=$ac_abs_builddir;;
+   [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+   *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+   esac;;
+ esac
+ 
+ 
+   case $INSTALL in
+   [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+   *) ac_INSTALL=$ac_top_builddir$INSTALL ;;
+   esac
+ 
+   # Let's still pretend it is `configure' which instantiates (i.e., don't
+   # use $as_me), people would be surprised to read:
+   #    /* config.h.  Generated by config.status.  */
+   if test x"$ac_file" = x-; then
+     configure_input=
+   else
+     configure_input="$ac_file.  "
+   fi
+   configure_input=$configure_input"Generated from `echo $ac_file_in |
+ 				     sed 's,.*/,,'` by configure."
+ 
+   # First look for the input files in the build tree, otherwise in the
+   # src tree.
+   ac_file_inputs=`IFS=:
+     for f in $ac_file_in; do
+       case $f in
+       -) echo $tmp/stdin ;;
+       [\\/$]*)
+ 	 # Absolute (can't be DOS-style, as IFS=:)
+ 	 test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+ echo "$as_me: error: cannot find input file: $f" >&2;}
+    { (exit 1); exit 1; }; }
+ 	 echo "$f";;
+       *) # Relative
+ 	 if test -f "$f"; then
+ 	   # Build tree
+ 	   echo "$f"
+ 	 elif test -f "$srcdir/$f"; then
+ 	   # Source tree
+ 	   echo "$srcdir/$f"
+ 	 else
+ 	   # /dev/null tree
+ 	   { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+ echo "$as_me: error: cannot find input file: $f" >&2;}
+    { (exit 1); exit 1; }; }
+ 	 fi;;
+       esac
+     done` || { (exit 1); exit 1; }
+ 
+   if test x"$ac_file" != x-; then
+     { echo "$as_me:$LINENO: creating $ac_file" >&5
+ echo "$as_me: creating $ac_file" >&6;}
+     rm -f "$ac_file"
+   fi
+ _ACEOF
+ cat >>$CONFIG_STATUS <<_ACEOF
+   sed "$ac_vpsub
+ $extrasub
+ _ACEOF
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ :t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+ s,@configure_input@,$configure_input,;t t
+ s,@srcdir@,$ac_srcdir,;t t
+ s,@abs_srcdir@,$ac_abs_srcdir,;t t
+ s,@top_srcdir@,$ac_top_srcdir,;t t
+ s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+ s,@builddir@,$ac_builddir,;t t
+ s,@abs_builddir@,$ac_abs_builddir,;t t
+ s,@top_builddir@,$ac_top_builddir,;t t
+ s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
+ s,@INSTALL@,$ac_INSTALL,;t t
+ " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+   rm -f $tmp/stdin
+   if test x"$ac_file" != x-; then
+     mv $tmp/out $ac_file
+   else
+     cat $tmp/out
+     rm -f $tmp/out
+   fi
+ 
+ done
+ _ACEOF
+ 
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ 
+ { (exit 0); exit 0; }
+ _ACEOF
+ chmod +x $CONFIG_STATUS
+ ac_clean_files=$ac_clean_files_save
+ 
+ 
+ # configure is writing to config.log, and then calls config.status.
+ # config.status does its own redirection, appending to config.log.
+ # Unfortunately, on DOS this fails, as config.log is still kept open
+ # by configure, so config.status won't be able to write to it; its
+ # output is simply discarded.  So we exec the FD to /dev/null,
+ # effectively closing config.log, so it can be properly (re)opened and
+ # appended to by config.status.  When coming back to configure, we
+ # need to make the FD available again.
+ if test "$no_create" != yes; then
+   ac_cs_success=:
+   ac_config_status_args=
+   test "$silent" = yes &&
+     ac_config_status_args="$ac_config_status_args --quiet"
+   exec 5>/dev/null
+   $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+   exec 5>>config.log
+   # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+   # would make configure fail if this is the last instruction.
+   $ac_cs_success || { (exit 1); exit 1; }
+ fi
+ 
diff -Nrcpad gcc-4.0.2/gnattools/configure.ac gcc-4.1.0/gnattools/configure.ac
*** gcc-4.0.2/gnattools/configure.ac	Thu Jan  1 00:00:00 1970
--- gcc-4.1.0/gnattools/configure.ac	Sat Feb 26 21:43:33 2005
***************
*** 0 ****
--- 1,163 ----
+ # Configure script for libada.
+ #   Copyright 2003, 2004 Free Software Foundation, Inc.
+ #
+ # This file is free software; you can redistribute it and/or modify it
+ # under the terms of the GNU General Public License as published by
+ # the Free Software Foundation; either version 2 of the License, or
+ # (at your option) any later version.
+ #
+ # This program is distributed in the hope that it will be useful, but
+ # WITHOUT ANY WARRANTY; without even the implied warranty of
+ # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ # General Public License for more details.
+ #
+ # You should have received a copy of the GNU General Public License
+ # along with this program; if not, write to the Free Software
+ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ 
+ AC_INIT
+ AC_PREREQ([2.59])
+ 
+ AC_CONFIG_SRCDIR([Makefile.in])
+ 
+ # Command-line options.
+ # Very limited version of AC_MAINTAINER_MODE.
+ AC_ARG_ENABLE([maintainer-mode],
+   [AC_HELP_STRING([--enable-maintainer-mode],
+                  [enable make rules and dependencies not useful (and
+                   sometimes confusing) to the casual installer])],
+   [case ${enable_maintainer_mode} in
+      yes) MAINT='' ;;
+      no) MAINT='#' ;;
+      *) AC_MSG_ERROR([--enable-maintainer-mode must be yes or no]) ;;
+    esac
+    maintainer_mode=${enableval}],
+   [MAINT='#'])
+ AC_SUBST([MAINT])dnl
+ 
+ # Start of actual configure tests
+ 
+ AC_PROG_INSTALL
+ 
+ AC_CANONICAL_BUILD
+ AC_CANONICAL_HOST
+ AC_CANONICAL_TARGET
+ 
+ sinclude(../config/acx.m4)
+ ACX_NONCANONICAL_TARGET
+ 
+ # Need to pass this down for now :-P
+ AC_PROG_LN_S
+ 
+ # Determine x_ada_cflags
+ case $host in
+   hppa*) x_ada_cflags=-mdisable-indexing ;;
+   *) x_ada_cflags= ;;
+ esac
+ AC_SUBST([x_ada_cflags])
+ 
+ # Determine what to build for 'gnattools'
+ if test $build = $target ; then
+   # Note that build=target is almost certainly the wrong test; FIXME
+   default_gnattools_target="gnattools-native"
+ else
+   default_gnattools_target="gnattools-cross"
+ fi
+ AC_SUBST([default_gnattools_target])
+ 
+ # Target-specific stuff (defaults)
+ TOOLS_TARGET_PAIRS=
+ AC_SUBST(TOOLS_TARGET_PAIRS)
+ EXTRA_GNATTOOLS=
+ AC_SUBST(EXTRA_GNATTOOLS)
+ 
+ # Per-target case statement
+ # -------------------------
+ case "${target}" in
+   alpha*-dec-vx*) # Unlike all other Vxworks
+     ;;
+   m68k*-wrs-vx* \
+   | powerpc*-wrs-vxworks \
+   | sparc*-wrs-vx* \
+   | *86-wrs-vxworks \
+   | xscale*-wrs-vx* \
+   | xscale*-wrs-coff \
+   | mips*-wrs-vx*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-vxworks.adb"
+     ;;
+   sparc-sun-solaris*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-solaris.adb"
+     ;;
+   *86-*-solaris2*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-solaris.adb"
+     ;;
+   *86-*-linux* \
+   | powerpc*-*-linux*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb \
+     indepsw.adb<indepsw-linux.adb"
+     ;;
+   *ia64-*-linux* \
+   | alpha*-*-linux )
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb \
+     indepsw.adb<indepsw-linux.adb"
+     ;;
+   *x86_64-*-linux* \
+   | s390*-*-linux*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-linux.adb"
+     ;;
+   *86-*-freebsd*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-linux.adb"
+     ;;
+   mips-sgi-irix*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-irix.adb"
+     ;;
+   hppa*-hp-hpux10*) # Unlike hpux11
+     ;;
+   hppa*-hp-hpux11*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-hpux.adb"
+     ;;
+   *-ibm-aix*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-aix.adb \
+     indepsw.adb<indepsw-aix.adb"
+     ;;
+   alpha*-dec-osf*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-tru64.adb"
+     ;;
+   alpha*-dec-vms* | alpha*-dec-openvms* | alpha*-dec-vms* \
+   | alpha*-hp-vms* | alpha*-hp-openvms* | alpha*-hp-vms*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-vms-alpha.adb \
+     symbols.adb<symbols-vms-alpha.adb"
+ 
+     EXTRA_GNATTOOLS='../../gnatlbr$(exeext) ../../gnatsym$(exeext)'
+     ;;
+   ia64*-dec-vms* | ia64*-dec-openvms* | ia64*-dec-vms* \
+   | ia64*-hp-vms* | ia64*-hp-openvms* | ia64*-hp-vms*)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-vms-ia64.adb \
+     symbols.adb<symbols-vms-ia64.adb"
+ 
+     EXTRA_GNATTOOLS='../../gnatlbr$(exeext) ../../gnatsym$(exeext)'
+     ;;
+   *-*-cygwin32* | *-*-mingw32* | *-*-pe)
+     TOOLS_TARGET_PAIRS="\
+     mlib-tgt.adb<mlib-tgt-mingw.adb \
+     indepsw.adb<indepsw-mingw.adb"
+     EXTRA_GNATTOOLS='../../gnatdll$(exeext)'
+     ;;
+   powerpc-*-darwin*)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-darwin.adb"
+     ;;
+   *-*-lynxos)
+     TOOLS_TARGET_PAIRS="mlib-tgt.adb<mlib-tgt-lynxos.adb"
+     ;;
+ esac
+ 
+ # Output: create a Makefile.
+ AC_CONFIG_FILES([Makefile])
+ 
+ AC_OUTPUT
diff -Nrcpad gcc-4.0.2/libada/ChangeLog gcc-4.1.0/libada/ChangeLog
*** gcc-4.0.2/libada/ChangeLog	Wed Sep 21 03:57:43 2005
--- gcc-4.1.0/libada/ChangeLog	Tue Feb 28 08:28:55 2006
***************
*** 1,18 ****
! 2005-09-20  Release Manager
  
! 	* GCC 4.0.2 released.
  
! 2005-07-07  Release Manager
  
! 	* GCC 4.0.1 released.
  
  2005-04-27  James E Wilson  <wilson@specifixinc.com>
  
  	* Makefile.in (html): New.
  
! 2005-04-20  Release Manager
  
! 	* GCC 4.0.0 released.
  
  2004-05-25  Daniel Jacobowitz  <drow@false.org>
  
--- 1,44 ----
! 2006-02-28  Release Manager
  
! 	* GCC 4.1.0 released.
  
! 2006-02-23  Mark Mitchell  <mark@codesourcery.com>
  
! 	Backport:
! 	2005-12-05  Paolo Bonzini  <bonzini@gnu.org>
! 	* Makefile.in (FLAGS_TO_PASS): Add GCC_FOR_TARGET.
  
  2005-04-27  James E Wilson  <wilson@specifixinc.com>
  
  	* Makefile.in (html): New.
  
! 2005-02-28  Paolo Bonzini  <bonzini@gnu.org>
  
! 	PR bootstrap/17383
! 	* Makefile.in (GCC_DIR): Add $(HOST_SUBDIR) to the definition.
! 
! 2004-12-03  Nathanael Nerode  <neroden@gcc.gnu.org>
! 
! 	* Makefile.in: Add stamp file for building libada, to avoid
! 	duplicate builds every time all-gnattools is called.
! 
! 2004-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
! 
! 	* Makefile.in: Build gcc/ada/Makefile (by running gcc/ada/configure)
! 	here.
! 
! 2004-08-16  Nathanael Nerode  <neroden@gcc.gnu.org>
! 
! 	* configure.ac: Replace AC_CANONICAL_SYSTEM with _BUILD, _HOST,
! 	_TARGET.
! 	* configure: Regenerate.
! 
! 2004-07-18  Nathanael Nerode  <neroden@gcc.gnu.org>
! 
! 	* configure.ac, Makefile.in: Remove gnattools-specific code
! 	(see gnattools directory).
! 	* Makefile.in: Remove dead rts-* targets.
! 	* configure: Regenerate.
  
  2004-05-25  Daniel Jacobowitz  <drow@false.org>
  
diff -Nrcpad gcc-4.0.2/libada/Makefile.in gcc-4.1.0/libada/Makefile.in
*** gcc-4.0.2/libada/Makefile.in	Thu Apr 28 01:38:01 2005
--- gcc-4.1.0/libada/Makefile.in	Fri Feb 24 03:49:43 2006
***************
*** 16,22 ****
  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  
  # Default target; must be first.
! all: gnatlib gnattools
  
  # Standard autoconf-set variables.
  SHELL = @SHELL@
--- 16,22 ----
  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  
  # Default target; must be first.
! all: gnatlib
  
  # Standard autoconf-set variables.
  SHELL = @SHELL@
*************** srcdir = @srcdir@
*** 24,46 ****
  build = @build@
  target = @target@
  prefix = @prefix@
- INSTALL = @INSTALL@
- INSTALL_DATA = @INSTALL_DATA@
- INSTALL_PROGRAM = @INSTALL_PROGRAM@
  
  # Nonstandard autoconf-set variables.
  enable_shared = @enable_shared@
  LN_S=@LN_S@
- target_noncanonical=@target_noncanonical@
  
  # Variables for the user (or the top level) to override.
  objext=.o
  GNATLIBFLAGS= -W -Wall -gnatpg
  THREAD_KIND=native
  TRACE=no
- GNATLIBLDFLAGS=
- ADA_FOR_BUILD=
- ADA_FOR_TARGET=
  LDFLAGS=
  STAGE_PREFIX=
  
--- 24,39 ----
*************** T_ADA_CFLAGS=
*** 55,71 ****
  X_ADA_CFLAGS=@x_ada_cflags@
  ALL_ADA_CFLAGS=$(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS)
  
- # Variables for gnattools.
- ADAFLAGS= -gnatpg -gnata
- ADA_INCLUDE_DIR = $(libsubdir)/adainclude
- ADA_RTL_OBJ_DIR = $(libsubdir)/adalib
- 
  # For finding the GCC build dir, which is used far too much
! GCC_DIR=../../gcc
  # Include fragment generated by GCC configure.
  include $(GCC_DIR)/libada-mk
- # Variables based on those gleaned from the GCC makefile.  :-P
- libsubdir=$(libdir)/gcc/$(target_noncanonical)/$(gcc_version)
  
  TARGET_LIBGCC2_CFLAGS=
  GNATLIBCFLAGS= -g -O2
--- 48,57 ----
  X_ADA_CFLAGS=@x_ada_cflags@
  ALL_ADA_CFLAGS=$(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS)
  
  # For finding the GCC build dir, which is used far too much
! GCC_DIR=../../$(HOST_SUBDIR)/gcc
  # Include fragment generated by GCC configure.
  include $(GCC_DIR)/libada-mk
  
  TARGET_LIBGCC2_CFLAGS=
  GNATLIBCFLAGS= -g -O2
*************** ifneq ($(tmake_file),)
*** 79,90 ****
  include $(tmake_file)
  endif
  
- # Get possible host-specific override for libsubdir (ick).
- xmake_file=$(subst /config,/../gcc/config,$(gcc_xmake_file))
- ifneq ($(xmake_file),)
- include $(xmake_file)
- endif
- 
  FLAGS_TO_PASS = \
          "MAKEOVERRIDES=" \
          "LDFLAGS=$(LDFLAGS)" \
--- 65,70 ----
*************** FLAGS_TO_PASS = \
*** 94,232 ****
          "objext=$(objext)" \
          "prefix=$(prefix)" \
          "STAGE_PREFIX=$(STAGE_PREFIX)" \
! 	"CC=$(cc_set_by_configure)" \
          "CFLAGS=$(CFLAGS) $(WARN_CFLAGS)"
  
- ADA_FLAGS_TO_PASS = \
-         "ADA_FOR_BUILD=$(ADA_FOR_BUILD)"        \
-         "ADA_INCLUDE_DIR=$(ADA_INCLUDE_DIR)"    \
-         "ADA_RTL_OBJ_DIR=$(ADA_RTL_OBJ_DIR)"    \
-         "ADAFLAGS=$(ADAFLAGS)"                  \
-         "ADA_FOR_TARGET=$(ADA_FOR_TARGET)"      \
-         "INSTALL=$(INSTALL)"                    \
-         "INSTALL_DATA=$(INSTALL_DATA)"          \
-         "INSTALL_PROGRAM=$(INSTALL_PROGRAM)"
- 
- ADA_TOOLS_FLAGS_TO_PASS=\
-         "CC=../../xgcc -B../../"        \
-         "CFLAGS=$(CFLAGS)"              \
-         "exeext=$(exeext)"              \
-         "ADAFLAGS=$(ADAFLAGS)"          \
-         "ADA_INCLUDES=-I../rts"         \
-         "GNATMAKE=../../gnatmake"       \
-         "GNATLINK=../../gnatlink"       \
-         "GNATBIND=../../gnatbind"
- 
  # Rules to build gnatlib.
  .PHONY: gnatlib gnatlib-plain gnatlib-sjlj gnatlib-zcx gnatlib-shared
  gnatlib: @default_gnatlib_target@
  
! gnatlib-plain:
  	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) \
  	  GNATLIBFLAGS="$(GNATLIBFLAGS)" \
  	  GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
  	  TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
  	  THREAD_KIND="$(THREAD_KIND)" \
  	  TRACE="$(TRACE)" \
! 	  gnatlib
  
! gnatlib-sjlj gnatlib-zcx gnatlib-shared:
  	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) \
  	  GNATLIBFLAGS="$(GNATLIBFLAGS)" \
  	  GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
  	  TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
  	  THREAD_KIND="$(THREAD_KIND)" \
  	  TRACE="$(TRACE)" \
! 	  $@
! 
! .PHONY: rts-zfp rts-ravenscar
! rts-zfp rts-ravenscar:
! 	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) \
! 	  GNATMAKE=../gnatmake-cross \
! 	  $@
! 
! # Rules to build gnattools.
! .PHONY: gnattools gnattools-native gnattools-cross regnattools
! gnattools: @default_gnattools_target@
! 
! gnattools-native: gnatlib
! 	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS) \
! 	  ADA_INCLUDES="-I- -I../rts" \
! 	  CC="../../xgcc -B../../" STAGE_PREFIX=../../  gnattools1
! 	$(MAKE) -C $(GCC_DIR)/ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools2
! 	$(MAKE) -C $(GCC_DIR)/ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools3
! 
! # For cross builds of gnattools,
! # put the host RTS dir first in the PATH to hide the default runtime
! # files that are among the sources
! # FIXME: This should be done in configure.
! RTS_DIR:=$(strip $(subst \,/,$(shell gnatls -v | grep adalib )))
! gnattools-cross: gnatlib
! 	$(MAKE)  -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) $(ADA_FLAGS_TO_PASS) \
! 	  ADA_INCLUDES="-I$(RTS_DIR)../adainclude -I$(RTS_DIR)" \
! 	  GNATMAKE="gnatmake" \
! 	  GNATBIND="gnatbind" \
! 	  GNATLINK="gnatlink" \
! 	  LIBGNAT="" \
! 	  gnattools1-re gnattools2 gnattools4
! 	# Rename cross tools to where the GCC makefile wants them when
! 	# installing.  FIXME: installation should be done elsewhere.
! 	if [ -f $(GCC_DIR)/gnatbind$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatbind$(exeext) $(GCC_DIR)/gnatbind-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatbl$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatbl$(exeext) $(GCC_DIR)/gnatbl-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatchop$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatchop$(exeext) $(GCC_DIR)/gnatchop-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnat$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnat$(exeext) $(GCC_DIR)/gnat-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatkr$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatkr$(exeext) $(GCC_DIR)/gnatkr-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatlink$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatlink$(exeext) $(GCC_DIR)/gnatlink-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatls$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatls$(exeext) $(GCC_DIR)/gnatls-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatmake$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatmake$(exeext) $(GCC_DIR)/gnatmake-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatmem$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatmem$(exeext) $(GCC_DIR)/gnatmem-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatname$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatname$(exeext) $(GCC_DIR)/gnatname-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatprep$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatprep$(exeext) $(GCC_DIR)/gnatprep-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatxref$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatxref$(exeext) $(GCC_DIR)/gnatxref-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatfind$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatfind$(exeext) $(GCC_DIR)/gnatfind-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatclean$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatclean$(exeext) $(GCC_DIR)/gnatclean-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gnatsym$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gnatsym$(exeext) $(GCC_DIR)/gnatsym-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gpr2make$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gpr2make$(exeext) $(GCC_DIR)/gpr2make-cross$(exeext); \
! 	fi
! 	if [ -f $(GCC_DIR)/gprcmd$(exeext) ] ; then \
! 	  mv $(GCC_DIR)/gprcmd$(exeext) $(GCC_DIR)/gprcmd-cross$(exeext); \
! 	fi
! 
! regnattools:
! 	$(MAKE) -C $(GCC_DIR)/ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools1-re
! 	$(MAKE) -C $(GCC_DIR)/ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools2
! 	$(MAKE) -C $(GCC_DIR)/ada $(ADA_TOOLS_FLAGS_TO_PASS) gnattools3
  
  # Check uninstalled version.
  check:
--- 74,108 ----
          "objext=$(objext)" \
          "prefix=$(prefix)" \
          "STAGE_PREFIX=$(STAGE_PREFIX)" \
! 	"CC=$(host_cc_for_libada)" \
! 	"GCC_FOR_TARGET=$(CC)" \
          "CFLAGS=$(CFLAGS) $(WARN_CFLAGS)"
  
  # Rules to build gnatlib.
  .PHONY: gnatlib gnatlib-plain gnatlib-sjlj gnatlib-zcx gnatlib-shared
  gnatlib: @default_gnatlib_target@
  
! gnatlib-plain: $(GCC_DIR)/ada/Makefile
! 	test -f stamp-libada || \
  	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) \
  	  GNATLIBFLAGS="$(GNATLIBFLAGS)" \
  	  GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
  	  TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
  	  THREAD_KIND="$(THREAD_KIND)" \
  	  TRACE="$(TRACE)" \
! 	  gnatlib \
! 	&& touch stamp-libada
  
! gnatlib-sjlj gnatlib-zcx gnatlib-shared: $(GCC_DIR)/ada/Makefile
! 	test -f stamp-libada || \
  	$(MAKE) -C $(GCC_DIR)/ada $(FLAGS_TO_PASS) \
  	  GNATLIBFLAGS="$(GNATLIBFLAGS)" \
  	  GNATLIBCFLAGS="$(GNATLIBCFLAGS)" \
  	  TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
  	  THREAD_KIND="$(THREAD_KIND)" \
  	  TRACE="$(TRACE)" \
! 	  $@ \
! 	&& touch stamp-libada
  
  # Check uninstalled version.
  check:
diff -Nrcpad gcc-4.0.2/libada/configure gcc-4.1.0/libada/configure
*** gcc-4.0.2/libada/configure	Sun Apr 25 21:29:37 2004
--- gcc-4.1.0/libada/configure	Sat Feb 26 21:43:33 2005
*************** PACKAGE_STRING=
*** 272,278 ****
  PACKAGE_BUGREPORT=
  
  ac_unique_file="Makefile.in"
! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT enable_shared INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os target_noncanonical LN_S x_ada_cflags default_gnatlib_target default_gnattools_target LIBOBJS LTLIBOBJS'
  ac_subst_files=''
  
  # Initialize some variables set by options.
--- 272,278 ----
  PACKAGE_BUGREPORT=
  
  ac_unique_file="Makefile.in"
! ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT enable_shared build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os LN_S x_ada_cflags default_gnatlib_target LIBOBJS LTLIBOBJS'
  ac_subst_files=''
  
  # Initialize some variables set by options.
*************** ac_config_guess="$SHELL $ac_aux_dir/conf
*** 1300,1385 ****
  ac_config_sub="$SHELL $ac_aux_dir/config.sub"
  ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
  
- # Find a good install program.  We prefer a C program (faster),
- # so one script is as good as another.  But avoid the broken or
- # incompatible versions:
- # SysV /etc/install, /usr/sbin/install
- # SunOS /usr/etc/install
- # IRIX /sbin/install
- # AIX /bin/install
- # AmigaOS /C/install, which installs bootblocks on floppy discs
- # AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
- # AFS /usr/afsws/bin/install, which mishandles nonexistent args
- # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
- # OS/2's system install, which has a completely different semantic
- # ./install, which can be erroneously created by make from ./install.sh.
- echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
- echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
- if test -z "$INSTALL"; then
- if test "${ac_cv_path_install+set}" = set; then
-   echo $ECHO_N "(cached) $ECHO_C" >&6
- else
-   as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
- for as_dir in $PATH
- do
-   IFS=$as_save_IFS
-   test -z "$as_dir" && as_dir=.
-   # Account for people who put trailing slashes in PATH elements.
- case $as_dir/ in
-   ./ | .// | /cC/* | \
-   /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
-   ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \
-   /usr/ucb/* ) ;;
-   *)
-     # OSF1 and SCO ODT 3.0 have their own names for install.
-     # Don't use installbsd from OSF since it installs stuff as root
-     # by default.
-     for ac_prog in ginstall scoinst install; do
-       for ac_exec_ext in '' $ac_executable_extensions; do
- 	if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
- 	  if test $ac_prog = install &&
- 	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- 	    # AIX install.  It has an incompatible calling convention.
- 	    :
- 	  elif test $ac_prog = install &&
- 	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- 	    # program-specific install script used by HP pwplus--don't use.
- 	    :
- 	  else
- 	    ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
- 	    break 3
- 	  fi
- 	fi
-       done
-     done
-     ;;
- esac
- done
- 
- 
- fi
-   if test "${ac_cv_path_install+set}" = set; then
-     INSTALL=$ac_cv_path_install
-   else
-     # As a last resort, use the slow shell script.  We don't cache a
-     # path for INSTALL within a source directory, because that will
-     # break other packages using the cache if that directory is
-     # removed, or if the path is relative.
-     INSTALL=$ac_install_sh
-   fi
- fi
- echo "$as_me:$LINENO: result: $INSTALL" >&5
- echo "${ECHO_T}$INSTALL" >&6
- 
- # Use test -z because SunOS4 sh mishandles braces in ${var-val}.
- # It thinks the first close brace ends the variable substitution.
- test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
- 
- test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
- 
- test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
- 
- 
  # Make sure we can run config.sub.
  $ac_config_sub sun4 >/dev/null 2>&1 ||
    { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5
--- 1300,1305 ----
*************** test -n "$target_alias" &&
*** 1463,1536 ****
      NONENONEs,x,x, &&
    program_prefix=${target_alias}-
  
- # Autoconf M4 include file defining utility macros for complex Canadian
- # cross builds.
- 
- 
- 
- 
- 
- 
- ####
- # _NCN_TOOL_PREFIXES:  Some stuff that oughtta be done in AC_CANONICAL_SYSTEM
- # or AC_INIT.
- # These demand that AC_CANONICAL_SYSTEM be called beforehand.
- 
- ####
- # NCN_CHECK_TARGET_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
- # Like AC_CHECK_TOOL, but tries a prefix of the target, not the host.
- # Code is pretty much lifted from autoconf2.53.
- 
- 
- 
- ####
- # NCN_STRICT_CHECK_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
- # Like AC_CHECK_TOOL, but requires the prefix if build!=host.
- 
- 
- 
- ####
- # NCN_STRICT_CHECK_TARGET_TOOL(variable, prog-to-check-for,[value-if-not-found],[path])
- # Like NCN_CHECK_TARGET_TOOL, but requires the prefix if build!=target.
- 
- 
- ###
- # AC_PROG_CPP_WERROR
- # Used for autoconf 2.5x to force AC_PREPROC_IFELSE to reject code which
- # triggers warnings from the preprocessor.  Will be in autoconf 2.58.
- # For now, using this also overrides header checks to use only the
- # preprocessor (matches 2.13 behavior; matching 2.58's behavior is a
- # bit harder from here).
- # Eventually autoconf will default to checking headers with the compiler
- # instead, and we'll have to do this differently.
- 
- # AC_PROG_CPP_WERROR
- 
- # Test for GNAT.
- # We require the gnatbind program, and a compiler driver that
- # understands Ada.  We use the user's CC setting, already found.
- #
- # Sets the shell variable have_gnat to yes or no as appropriate, and
- # substitutes GNATBIND.
- 
- 
-  case ${build_alias} in
-   "") build_noncanonical=${build} ;;
-   *) build_noncanonical=${build_alias} ;;
- esac
- 
-  case ${host_alias} in
-   "") host_noncanonical=${build_noncanonical} ;;
-   *) host_noncanonical=${host_alias} ;;
- esac
- 
-  case ${target_alias} in
-   "") target_noncanonical=${host_noncanonical} ;;
-   *) target_noncanonical=${target_alias} ;;
- esac
- 
- 
- 
  # Need to pass this down for now :-P
  echo "$as_me:$LINENO: checking whether ln -s works" >&5
  echo $ECHO_N "checking whether ln -s works... $ECHO_C" >&6
--- 1383,1388 ----
*************** else
*** 1561,1575 ****
  fi
  
  
- # Determine what to build for 'gnattools'
- if test $build = $target ; then
-   # Note that build=target is almost certainly the wrong test; FIXME
-   default_gnattools_target="gnattools-native"
- else
-   default_gnattools_target="gnattools-cross"
- fi
- 
- 
  # Output: create a Makefile.
            ac_config_files="$ac_config_files Makefile"
  
--- 1413,1418 ----
*************** Copyright (C) 2003 Free Software Foundat
*** 2030,2036 ****
  This config.status script is free software; the Free Software Foundation
  gives unlimited permission to copy, distribute and modify it."
  srcdir=$srcdir
- INSTALL="$INSTALL"
  _ACEOF
  
  cat >>$CONFIG_STATUS <<\_ACEOF
--- 1873,1878 ----
*************** s,@ECHO_T@,$ECHO_T,;t t
*** 2211,2219 ****
  s,@LIBS@,$LIBS,;t t
  s,@MAINT@,$MAINT,;t t
  s,@enable_shared@,$enable_shared,;t t
- s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t
- s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t
- s,@INSTALL_DATA@,$INSTALL_DATA,;t t
  s,@build@,$build,;t t
  s,@build_cpu@,$build_cpu,;t t
  s,@build_vendor@,$build_vendor,;t t
--- 2053,2058 ----
*************** s,@target@,$target,;t t
*** 2226,2236 ****
  s,@target_cpu@,$target_cpu,;t t
  s,@target_vendor@,$target_vendor,;t t
  s,@target_os@,$target_os,;t t
- s,@target_noncanonical@,$target_noncanonical,;t t
  s,@LN_S@,$LN_S,;t t
  s,@x_ada_cflags@,$x_ada_cflags,;t t
  s,@default_gnatlib_target@,$default_gnatlib_target,;t t
- s,@default_gnattools_target@,$default_gnattools_target,;t t
  s,@LIBOBJS@,$LIBOBJS,;t t
  s,@LTLIBOBJS@,$LTLIBOBJS,;t t
  CEOF
--- 2065,2073 ----
*************** case $ac_abs_builddir in
*** 2394,2403 ****
  esac
  
  
-   case $INSTALL in
-   [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
-   *) ac_INSTALL=$ac_top_builddir$INSTALL ;;
-   esac
  
    # Let's still pretend it is `configure' which instantiates (i.e., don't
    # use $as_me), people would be surprised to read:
--- 2231,2236 ----
*************** s,@builddir@,$ac_builddir,;t t
*** 2460,2466 ****
  s,@abs_builddir@,$ac_abs_builddir,;t t
  s,@top_builddir@,$ac_top_builddir,;t t
  s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
- s,@INSTALL@,$ac_INSTALL,;t t
  " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
    rm -f $tmp/stdin
    if test x"$ac_file" != x-; then
--- 2293,2298 ----
diff -Nrcpad gcc-4.0.2/libada/configure.ac gcc-4.1.0/libada/configure.ac
*** gcc-4.0.2/libada/configure.ac	Sun Apr 25 21:29:37 2004
--- gcc-4.1.0/libada/configure.ac	Sat Feb 26 21:43:33 2005
*************** AC_SUBST([enable_shared])
*** 58,70 ****
  
  # Start of actual configure tests
  
! AC_PROG_INSTALL
! 
! AC_CANONICAL_SYSTEM
! 
! sinclude(../config/acx.m4)
! _GCC_TOPLEV_NONCANONICAL_TARGET
! AC_SUBST(target_noncanonical)
  
  # Need to pass this down for now :-P
  AC_PROG_LN_S
--- 58,66 ----
  
  # Start of actual configure tests
  
! AC_CANONICAL_BUILD
! AC_CANONICAL_HOST
! AC_CANONICAL_TARGET
  
  # Need to pass this down for now :-P
  AC_PROG_LN_S
*************** else
*** 86,100 ****
  fi
  AC_SUBST([default_gnatlib_target])
  
- # Determine what to build for 'gnattools'
- if test $build = $target ; then
-   # Note that build=target is almost certainly the wrong test; FIXME
-   default_gnattools_target="gnattools-native"
- else
-   default_gnattools_target="gnattools-cross"
- fi
- AC_SUBST([default_gnattools_target])
- 
  # Output: create a Makefile.
  AC_CONFIG_FILES([Makefile])
  
--- 82,87 ----
